`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JN^ˡvg TWOD.TEXTr=vgJPRETTYPAS.TEXTg{ BLIZZARD.CODEvg GROCERY.TEXTvg MASTER.TEXTvg, PIG3.TEXTr=vg#VjBURTS-DUMP.TEXTܡjt EIGHTQ.TEXTvgtx DATE.TEXTr=vgx MASTERCA.TEXTvgaTIGER.UNIT.CODE蠍 TIGER.TEXT=vgq SCRNBYT.TEXTvgq PRINTSET.TEXTvg MASTERMI.TEXTvg PILOT.TEXT=PSCAL18  BIOSDOC.TEXTvgˡ  BIOSDEMO.TEXTvg$BIOSSTUFF.TEXTg$( BIOSUNIT.TEXTvg(4 XUNASM.CODEvg4:UNASM.INFO.TEXT:F X.TRACE.TEXTvgFL X.SPY.TEXT=vgLVSETUPMX80.TEXTg&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&9PROGRAM AUTHOR: DAVID NEUMANN   %THE BIOSSTUFF FILE CONTAINS ASSEMBLY LANGUAGE CODE THAT CORRESPONDS TO  THE FOLLOWING PASCAL PROCEDURES AND FUNCTIONS:   FUNCTION CURH:INTEGER; EXTERNAL;  FUNCTION CURV:INTEGER; EXTERNAL;  PROCEDURE HORZSHFT(H:NCTION CHLEFT:INTEGER; EXTERNAL;  PROCEDURE STUFF(CH:CHAR); EXTERNAL;  PROCEDURE STUFFS(S:STRING); EXTERNAL;  PROCEDURE WINDOW(TOP,BOT:SCRANGE); EXTERNAL;  PROCEDURE WAIT(T:INTEGER);  VAR (I: INTEGER;  BEGIN  FOR I:=1 TO T DO;  END;  BEGIN  GOTO PROCEDURE HORZSHFT(H:INTEGER); EXTERNAL;  PROCEDURE INVERSE; EXTERNAL;  PROCEDURE NORMAL; EXTERNAL;  PROCEDURE FLASH; EXTERNAL;  FUNCTION GETFLGS:INTEGER; EXTERNAL;  PROCEDURE ONFLG(F:INTEGER); EXTERNAL;  PROCEDURE OFFFLG(F:INTEGER); EXTERNAL;  FUPROGRAM BIOSDEMO;  CONST (AUTO = 1; (FLUSH = 64; (STOP = 128;  RETURN = 13;  TYPE (SCRANGE = 0..23;  VAR (I,J: INTEGER;  S: STRING;  TOP,BOT: SCRANGE;  FUNCTION CURH:INTEGER; EXTERNAL;  FUNCTION CURV:INTEGER; EXTERNAL; B E N^:AM WILL ILLUSTRATE ALL OF THESE FUNCTIONS.  %THE CODE FILES FOR BIOSUNIT AND BIOSSTUFF MAY BE INSTALLED IN  SYSTEM.LIBRARY. THIS ALLOWS SUBSEQUENT PROGRAMS TO "USES BIOSUNIT". BIT (OFFFLG - TURNS OFF FLAG BIT (STUFF - PUTS A SINGLE CHARACTER IN THE TYPE-AHEAD BUFFER (STUFFS - PUTS A STRING IN THE TYPE-AHEAD BUFFER (WINDOW - SETS THE TOP AND BOTTOM OF THE SCROLL WINDOW % %THE BIOSDEMO PROGRNG CHARACTERS OUTPUT IN INVERSE MODE (FLASH - OUTPUT IN FLASH MODE (NORMAL - RESTORES OUTPUT TO NORMAL CHARACTERS (GETFLGS - RETURNS FLAG BYTE THAT CONTAINS BITS FOR 9FLUSH, STOP AND AUTO FOLLOW (ONFLG - TURNS ON FLAG ( SHIFTS BEYOND COLUMN 1 OR 80 CAUSE WRAP-AROUND 9SHIFT COUNTS GREATER THAN 40 SEEM TO CAUSE PROBLEMS (CHLEFT - RETURNS THE NUMBER OF CHARACTERS TO THE LEFT OF THE ; VISIBLE SCREEN 9USED WITH HORZSHFT (INVERSE - FOLLOWINS CURSOR VERTICAL POSITION (HORZSHFT - SHIFTS THE SCREEN HORIZONTALLY 9SHIFT COUNT IS POSITIVE FOR SHIFT RIGHT 9SHIFT COUNT IS NEGATIVE FOR SHIFT LEFT 9HORZSHFT(40) DISPLAYS COLUMNS 41-80 9HORZSHFT(-40) WOULD RESTORE COLUMNS 1-40 EXTERNAL;  PROCEDURE STUFF(CH:CHAR); EXTERNAL;  PROCEDURE STUFFS(S:STRING); EXTERNAL;  PROCEDURE WINDOW(TOP,BOT:SCRANGE); EXTERNAL;  %THEY DO THE FOLLOWING THINGS:  CURH - RETURNS CURSOR HORIZONTAL POSITION (CURV - RETURINTEGER); EXTERNAL;  PROCEDURE INVERSE; EXTERNAL;  PROCEDURE NORMAL; EXTERNAL;  PROCEDURE FLASH; EXTERNAL;  FUNCTION GETFLGS:INTEGER; EXTERNAL;  PROCEDURE ONFLG(F:INTEGER); EXTERNAL;  PROCEDURE OFFFLG(F:INTEGER); EXTERNAL;  FUNCTION CHLEFT:INTEGER; XY(20,15);  FOR I:=1 TO 10 DO "BEGIN $GOTOXY(CURH,CURV-1);  WRITE('V'); $GOTOXY(CURH-1,CURV); "END;  J := CURH + 1;  FOR I:=1 TO 10 DO "BEGIN $GOTOXY(CURH-1,CURV);  WRITE('H'); $GOTOXY(CURH-1,CURV); "END;  GOTOXY(J,CURV);  FOR I:=1 TO 3 DO "BEGIN $INVERSE; $WRITE('INVERSE'); $NORMAL; $WRITE(' '); $FLASH; $WRITE('FLASH'); $NORMAL; $WRITE(' NORMAL');  END;  WRITELN;  FOR J:=1 TO 10 DO "BEGIN $HORZSHFT(8);  WAIT(500); "END;  FOR J:=1 TO 10 DO "BEGIN $C083 ;SELECT 2ND 4K BANK (.ENDM  ;*************************************** (.MACRO BANK2WRITE (LDA 0C083 ;SELECT 2ND 4K BANK (LDA 0C083 ;AND WRITE-ENABLE (.ENDM  ;*************************************** (.MACRO BANK1PROTECT (LDA ******************** (.MACRO PUSH (LDA %1+1 (PHA (LDA %1 (PHA (.ENDM  ;*************************************** (.MACRO DISCARDBIAS (PLA (PLA (PLA (PLA (.ENDM ;*************************************** (.MACRO BANK2PROTECT (LDA 0 ;***************************************  ;* BIOS-STUFF *  ;* PROGRAM AUTHOR: DAVID NEUMANN *  ;*************************************** (.MACRO POP (PLA (STA %1 (PLA (STA %1+1 (.ENDM  ;*******************B E N^TELN('OF THE BOOT VOLUME.');  STUFFS('FE#4');  STUFF(CHR(RETURN));  WRITELN('THIS WILL LEAVE YOU IN THE FILER.');  WAIT(5000);  END.  "BEGIN $WRITE('THIS IS PART WINDOW SCROLL'); $WRITELN(' ',I:2); $WAIT(500); "END;  WINDOW(0,23);  PAGE(OUTPUT);  WRITELN('CHARACTERS WILL NOW BE PUT IN');  WRITELN('THE TYPE-AHEAD BUFFER TO GET');  WRITELN('AN EXTENDED DIRECTORY LISTING');  WRI; "END;  WINDOW(8,17);  GOTOXY(0,8); (* GO INSIDE WINDOW *)  FOR I:=1 TO 30 DO "BEGIN $WRITE('THIS IS PART WINDOW SCROLL'); $WRITELN(' ',I:2); $WAIT(150); "END;  WINDOW(17,23);  GOTOXY(0,17); (* GO INSIDE WINDOW *)  FOR I:=1 TO 30 DO I:=1 TO 30 DO "BEGIN $WRITE('THIS IS FULL WINDOW SCROLL'); $WRITELN(' ',I:2); $WAIT(500); "END;  WINDOW(0,9);  GOTOXY(0,0); (* GO INSIDE WINDOW *)  FOR I:=1 TO 30 DO "BEGIN $WRITE('THIS IS PART WINDOW SCROLL'); $WRITELN(' ',I:2); $WAIT(150)HORZSHFT(-8); $WAIT(500);  END;  ONFLG(AUTO);  WRITELN('TO ILLUSTRATE AUTO-FOLLOW');  WRITELN('THE CTRL-Z OPTION OF THE EDITOR');  WRITE('TYPE IN SOME CHARACTERS NOW ');  READLN(S);  OFFFLG(AUTO);  HORZSHFT(-CHLEFT);  WINDOW(0,23);  FOR 0C088 ;SELECT 1ST BANK AND WRITE-PROTECT (.ENDM  ;***************************************  RETURN .EQU 0 ;TEMP TO SAVE RETURN  SADR .EQU 2 ;TEMP TO SAVE STRING ADDRESS  COUNT .EQU 4 ;TEMP TO SAVE NUMBER OF CHARACTERS IN STRING  CH .EQU 0F4 ;CURSOR HORIZONTAL  CV .EQU 0F5 ;CURSOR VERTICAL  CONBUF .EQU 03B1 ;ADDRESS OF THE TYPE AHEAD BUFFER  NLEFT .EQU 0BF11 ;NUMBER OF PARE TO READ POINTER (BEQ IGNORE ; IF POINTERS =, BUFFER IS FULL (STX WPTR ; ROOM FOR CHARCTER, SAVE POINTER (PLA ; GET LSB OF PARM, WHICH IS CHARACTER TO STORE (STA CONBUF,X ; STORE IN BUFFER (PLA ; DISCARADDRESS (LDX WPTR ; GET WRITE POINTER (INX ; INCREMENT TO NEXT AVAILABLE SPOT (CPX #78. ; AT END OF BUFFER? (BCC $1 ; BRANCH IF NO (LDX #0 ; WRAP AROUND TO BEGINNING OF BUFFER  $1 CPX RPTR ; COM ; THERE IS A LIMIT OF 78 CHARACTERS  ; CHARACTERS BEYOND THE LIMIT ARE IGNORED  ;***************************************  ; STUFF A SINGLE CHARACTER INTO THE TYPE AHEAD BUFFER (.PROC STUFF,1 (POP RETURN ; SAVE PASCAL RETURN RETURN (RTS  ;***************************************  ; TWO ROUTINES TO PUT CHARACTERS INTO THE TYPE AHEAD BUFFER  ; STUFF - TO PUT A SINGLE CHARACTER IN THE BUFFER  ; STUFFS - TO PUT A STRING IN THE BUFFER FLGS ;TURN OFF BIT (STA CONFLGS (PLA ;DISCARD MSB OF PARM (PUSH RETURN (RTS  ;*************************************** (.FUNC CHLEFT (POP RETURN (DISCARDBIAS (LDA #0 ; MSB = 0 (PHA (LDA NLEFT (PHA (PUSH *******************************  ; POSSIBLE VALUES ARE:  ; AUTO FOLLOW = 01  ; FLUSH = 40  ; STOP = 80 (.PROC OFFFLG,1 (POP RETURN (PLA ;LSB OF PARM (EOR #0FF ;REVERSE BITS (AND CON ; AUTO FOLLOW = 01  ; FLUSH = 40  ; STOP = 80 (.PROC ONFLG,1 (POP RETURN (PLA ;LSB OF PARM (ORA CONFLGS (STA CONFLGS (PLA ;DISCARD MSB OF PARM (PUSH RETURN (RTS  ;************************************ (.FUNC GETFLGS (POP RETURN (DISCARDBIAS (LDA #0 ; MSB = 0 (PHA (LDA CONFLGS (PHA (PUSH RETURN (RTS  ;***************************************  ; POSSIBLE VALUES ARE: R NORMAL MODE (STA MODE (BANK1PROTECT (RTS ;RETURN  ;*************************************** (.PROC FLASH (BANK2WRITE (LDA #40 ;SET BIT 6 FOR FLASH MODE (STA MODE (BANK1PROTECT (RTS ;RETURN  ;*************************************** (.PROC INVERSE (BANK2WRITE (LDA #00 ;CLEAR BITS 6 & 7 (STA MODE (BANK1PROTECT (RTS ;RETURN  ;*************************************** (.PROC NORMAL (BANK2WRITE (LDA #80 ;SET BIT 7 FO(RTS  ;*************************************** (.PROC HORZSHFT,1 (POP RETURN (BANK2PROTECT (PLA ; GET SHIFT AMOUNT (JSR HSHIFT (PLA ; DISCARD MSB OF PARM  BANK1PROTECT (PUSH RETURN (RTS  ;***********URN (DISCARDBIAS (LDA #0 ; MSB = 0 (PHA (LDA CH (PHA (PUSH RETURN (RTS  ;*************************************** (.FUNC CURV (POP RETURN (DISCARDBIAS (LDA #0 ; MSB = 0 (PHA (LDA CV (PHA (PUSH RETURN AE3 ;BIOS LOCATION FOR LINE FEED BOTTOM LINE  SCRTOP .EQU 0DAEF ;BIOS SCROLL TOP  SCRBOT .EQU 0DB0C ;BIOS SCROLL BOTTOM  HSHIFT .EQU 0DBFE ;BIOS HORIZONTAL SHIFT  ;*************************************** (.FUNC CURH (POP RETCHARS TO LEFT OF SCREEN  CONFLGS .EQU 0BF15 ;CONSOLE FLAGS  RPTR .EQU 0BF18 ;ADDRESS OF THE READ POINTER  WPTR .EQU 0BF19 ;ADDRESS OF THE WRITE POINTER  MODE .EQU 0DAB0 ;BIOS LOCATION FOR CHARACTER MODE  LFBOT .EQU 0DD MSB OF PARM  JMP EXIT ; ALL DONE  IGNORE PLA ; DISCARD LSB OF PARM (PLA ; DISCARD MSB OF PARM EXIT PUSH RETURN ; RESTORE PASCAL RETURN ADDRESS (RTS ; RETURN TO PASCAL  ;***************************************  ; STUFF A STRING INTO THE TYPE AHEAD BUFFER (.PROC STUFFS,1 (POP RETURN ; SAVE PASCAL RETURN ADDRESS (POP SADR ; SAVE STRING ADDRESS (LDY #0 ; INITIALIZE POINTER INTO STRING (LDURH; EXTERNAL;  FUNCTION CURV; EXTERNAL;  PROCEDURE HORZSHFT; EXTERNAL;  PROCEDURE INVERSE; EXTERNAL;  PROCEDURE NORMAL; EXTERNAL;  PROCEDURE FLASH; EXTERNAL;  FUNCTION GETFLGS; EXTERNAL;  PROCEDURE ONFLG; EXTERNAL;  PROCEDURE OFFFLG; EXTERNAL;  FRE FLASH;  FUNCTION GETFLGS:INTEGER;  PROCEDURE ONFLG(F:INTEGER);  PROCEDURE OFFFLG(F:INTEGER);  FUNCTION CHLEFT:INTEGER;  PROCEDURE STUFF(CH:CHAR);  PROCEDURE STUFFS(S:STRING);  PROCEDURE WINDOW(TOP,BOT:SCRANGE);   IMPLEMENTATION   FUNCTION C(*$S+*)  UNIT BIOSUNIT;   INTERFACE   CONST (AUTO = 1; (FLUSH = 64; (STOP = 128;   TYPE (SCRANGE = 0..23;   FUNCTION CURH:INTEGER;  FUNCTION CURV:INTEGER;  PROCEDURE HORZSHFT(H:INTEGER);  PROCEDURE INVERSE;  PROCEDURE NORMAL;  PROCEDUN^RN TO PASCAL (.END  ATION (STA SCRBOT ;SET BIOS LOCATION (PLA ;DISCARD MSB (PLA ;LSB OF TOP LINE (STA SCRTOP ;SET BIOS LOCATION (PLA ;DISCARD MSB (PUSH RETURN ;RESTORE PASCAL RETURN (BANK1PROTECT (RTS ;RETU SEXIT PUSH RETURN ; RESTORE PASCAL RETURN ADDRESS (RTS ; RETURN TO PASCAL  ;*************************************** (.PROC WINDOW,2 (BANK2WRITE (POP RETURN (PLA ;LSB OF BOTTOM LINE (STA LFBOT ;SET BIOS LOCINTER (INY ; INCREMENT POINTER INTO STRING (LDA @SADR,Y ; GET CHARACTER FROM STRING (STA CONBUF,X ; PUT INTO BUFFER CPY COUNT ; ALL CHARACTERS STORED? (BCC LOOP ; BRANCH IF NO ; AT END OF BUFFER? (BCC $1 ; BRANCH IF NO (LDX #0 ; WRAP AROUND TO BEGINNING OF BUFFER  $1 CPX RPTR ; COMPARE TO READ POINTER (BEQ SEXIT ; IF POINTERS =, BUFFER IS FULL (STX WPTR ; ROOM FOR CHARCTER, SAVE POA @SADR,Y ; 1ST BYTE OF STRING IS STRING LENGTH  BEQ SEXIT ; DONE IF ZERO LENGTH (STA COUNT ; SAVE STRING LENGTH  LOOP LDX WPTR ; GET WRITE POINTER (INX ; INCREMENT TO NEXT AVAILABLE SPOT (CPX #78. UNCTION CHLEFT; EXTERNAL;  PROCEDURE STUFF; EXTERNAL;  PROCEDURE STUFFS; EXTERNAL;  PROCEDURE WINDOW; EXTERNAL;   BEGIN  END.  UNASM ڳ0 A  +Ǚ K@[( ȡ$צENTER TITLE FOR LISTING \$ d~  ˡá7   * i(ۂ Ɓ ,ۂƁ (ۂƁ (ۂ cY v    ? Ɓ  Ɓ  ۂƁ 5ۂƁ  ̂ʂȡ Ɓ   Ɓ  Ɓ ۂ Ɓ  Ɓ  ̂ʂȡ ڏƁ (ۂƁ  Ɓ ۂ   Ɓ ۂ̂ʂȡ̂ʂȡqƁ ۚ ښƁ  ̂ʂȡDƁ ڏ ۂ    ȡȡȡn    5   &    6 .   7  8       SBC צPHPPLPPHAPLADEYTAYINYINX BPLBMIBVCBVSBCCBCSBNEBEQ צCLCSECCLISEITYACLVCLDSED ASLROLLSRRORSTXLDXDECINC צBRKJSRRTIRTSSTYLDYCPYCPX TXATAXDEXNOPTXSTSXBITJMP    PsQsRPT>    تPš+8++5B ORAANDEORADCSTALDACMPتPR(צ0123456789ABCDEFP*+*+ȡ"s*,*,**+PTHE PRINTER IS ON.צOFF.f0؂߭G@PšB^áH᥂( PAGE  ⥂⩃>ġ BתPީ Pצ: RPT8,٪PتP,šUUPU,ǠUP šUUPUǠUPޭFp,٪PتP,šUUPU,ǠUP  šUUPUǠUPޭFzع޹@ER. THE T COMMAND DEFINES  A TITLE FOR THE LISTING.  #THE I AND W COMMANDS PROMPT FOR A  STARTING ADDRESS AND AN ENDING ADDRESS.  THE I COMMAND GENERATES INSTRUCTIONS  IN THE PASCAL ASSEMBLER FORMAT. THE  W COMMAND GENERATES .WORD COMMANDS AND DS  #P AND B TOGGLE THE MODES ON AND OFF.  IN BIOS MODE, THE I AND W COMMANDS  ACCESS BIOS ADDRESSES IN THE RANGE OF  D000 TO EFFF. WHEN BIOS IS OFF, THE  NORMAL ADDRESS SPACE IS ACCESSED.  WHEN THE PRINTER IS ON, ALL OUTPUT GOES  TO THE PRINT XUNASM IS A 6502 MACHINE CODE  DISASSEMBLER. IT IS CONTROLLED BY  SINGLE LETTER COMMANDS:  (Q -- QUIT  (B -- BIOS SELECT  (P -- PRINTER SELECT  (T -- SET TITLE FOR LISTING  (I -- DISASSEMBLE INSTRUCTIONS  (W -- DISASSEMBLE WORN^INITIALIZING... צPRINTER:PASCAL DISASSEMBLER VERSION 1.0תP:CMD: I(NSTRUCTIONS, W(ORDS, P(RINTER, B(IOS, T(ITLE, Q(UIT ߑੂHD@73BW,% *0 "$/(*BQáP ^hhhhЅୀHH`:JLp X <`h4t SELECTED.INITIALIZING... צPRINTER:PASCAL DISASSEMBLER VERSION 1.0תP:CMD: I(NSTRUCTIONS, W(ORDS, P(RINTER, B(IOS, T(ITLE, Q(UIT ߑੂ .WORD WP  ޶>Ʉ P}X צTHE PRINTER IS צON.OFF. BIOS IS NOT  SELECTED. TP>Ʉ P\ JצENTER START ADDRESS:ݶENTER END ADDRESS:ܶݫ޶ ީȡ^P צENTER START ADDRESS:ݶENTER END ADDRESS:ܶݫ޶ ީȡá 1P8Sצ,Xצ#צצ@צ,Yצ,Xצ,Yצ,X@צšق ޹mצ,YaPצ.BYTE VP ޹" i_&Z  IS USEFUL FOR DISASSEMBLING JUMP TABLES.  0BUGS  #YOU CANNOT DISASSEMBLE HEX LOCATION  8000. THIS IS DUE TO THE LIMITATIONS  OF PASCAL INTEGERS. HEX 8001 IS OK.  YOU CANNOT DISASSEMBLE AN INTERVAL  WHICH INCLUDES HEX 8000 EITHER.  #THE LISTING FORMAT ASSUMES THAT THE  PRINTER PAGE LENGTH IS 66.  DA @PCL,Y (CLC (LDY PCH (TAX (BPL $1 (DEY  $1 ADC PCL  BCC $2 (INY (CLC  $2 STA PCL  STY PCH (BCC ADJ  ;---------------------------------------  ; JSR -- STACK PC AND JUMP  ;  JSROPS JSR JINFO (CLC (LDX PCH (LDEQ RTIOPS (CMP #60 (BEQ RTSOPS  BREAK LDY #1 (LDA #0 (STA XEQ (BEQ SETUP  ;---------------------------------------  ; BRANCHING OPS  ;  BCOPS LDY #1 (STY LEN (LDA STATUS (PHA (PLP  XBC BEQ BCTRUE (SEC (BCS ADJSET BCTRUE LDY #1 (L ADJ SEC  ADJSET LDA PCL (ADC LEN (BCC $1 (INC PCH (CLC  $1 STA PCL (BCC STEP  ;---------------------------------------  ; SPECIAL: JSR, RTS, RTI, AND BREAK  ;  SPECIAL LDY #1 (LDA XEQ (BMI SETUP (CMP #20 (BEQ JSROPS (CMP #40 (B#1F (BEQ SPECIAL (CMP #10 (BEQ BCOPS (TAX (LDY LTAB,X (BMI BREAK SETUP STY LEN (LDA #0EA (STA XEQ+1 (STA XEQ+2 (CPY #0 (BEQ RUN  $1 LDA @PCL,Y (STA XEQ,Y (DEY (BNE $1 RUN JSR PREST  XEQ NOP (NOP (NOP (JSR PSAVE MOVW AATAB,PATAB (MOVW AOTAB,POTAB (LDA #0 (STA NOPS (STA NOPS+1 (INC PCL (BNE STEP (INC PCH  STEP LDY #0  LDA SPKR (LDA @PCL,Y (CMP #4C (BNE $1 (JMP JMPOPS  $1 CMP #6C (BNE $2 (JMP JMPIOPS  $2 STA XEQ (STA XBC (AND 1 (.ENDM  ;---------------------------------------  ; PROCEDURE TRACE  ; (.PROC TRACE (.PUBLIC ATAB,CTAB,OTAB,NOPS  PCL .EQU 3A  PCH .EQU 3B  ACL .EQU 3C  ACH .EQU 3D  SPKR .EQU 0C030  ;  ENTER JSR PSAVE (CLD (POP PCL (;---------------------------------------  ; TRACE CALLS, JUMPS, AND RETURNS  ;---------------------------------------  ; MACROS  ; (.MACRO POP (PLA (STA %1 (PLA (STA %1+1 (.ENDM  ; (.MACRO MOVW (LDA %1 (STA %2 (LDA %1+1 (STA %2+N^!A PCL (ADC #2 (BCC $1 (INX (CLC  $1 TAY  TXA (PHA (TYA (PHA (LDY #2 (BCC DOJUMP  ;---------------------------------------  ; RTS AND RTI -- POP STACK TO PC  ;  RTIOPS PLA (STA STATUS (LDA XEQ  RTSOPS JSR RINFO1 (POP PCL (INC PCL (BNE $1 (INC PCH  $1 JSR RINFO2 (JMP STEP  ;---------------------------------------  ; JUMP -- RESET PC TO ARG  ;  JMPOPS JSR JINFO (LDY #2 DOJUMP CLC  LOADI LDA @PCL,Y  TAX (DEY (LDA @PCL,Y (STX PCH (STA PCL (BCSN^!C .WORD  ACC .BYTE  XREG .BYTE  YREG .BYTE  STATUS .BYTE  LEN .BYTE  ; (.END (  E 0,2,0,0FF,2,2,2,0FF  ;---------------------------------------  ; ADDRESS CONSTANTS AND STORAGE  ;  AATAB .WORD ATAB  ACTAB .WORD CTAB  AOTAB .WORD OTAB  AENTER .WORD ENTER  PATAB .WORD  POTAB .WORD  HPC .WORD  HPP .WORD  HA(PHA (MOVW PCL,HPC (MOVW HPP,PCL (LDA ACC (LDX XREG (LDY YREG (PLP (RTS  ;---------------------------------------  ; INSTRUCTION LENGTH TABLE  ;  LTAB .BYTE 1,1,1,0FF,1,1,1,0FF (.BYTE 0,1,0,0FF,2,2,2,0FF (.BYTE 0,1,0FF,0FF,1,1,1,0FF (.BYT--------------------------------  ; SAVE PROGRAM STATE  ;  PSAVE STA ACC (STX XREG (STY YREG (PHP (PLA (STA STATUS (MOVW PCL,HPP (MOVW HPC,PCL (RTS  ;---------------------------------------  ; RESTORE PROGRAM STATE  ;  PREST LDA STATUS C #2 (BNE $1 (INX  $1 STA PATAB  STX PATAB+1 (RTS  ;---------------------------------------  ; RECORD PC AS OPERAND  ;  RINFO2 LDY #0  MOVW POTAB,ACL (LDA PCL (STA @ACL,Y (INY (LDA PCH (STA @ACL,Y (JMP INCPO  ;-------(TAX (MOVW ACL,HAC (LDA ACTAB (CLC (ADC NOPS (STA ACL (LDA ACTAB+1 (ADC NOPS+1 (STA ACH (TXA (STA @ACL,Y (INC NOPS (BNE $2 (INC NOPS+1  $2 MOVW PATAB,ACL (LDA PCL (STA @ACL,Y (INY (LDA PCH (STA @ACL,Y (CLC (LDA ACL (LDX ACH (AD(STA @ACL,Y (LDA @PCL,Y (DEY (STA @ACL,Y (CLC  INCPO LDA ACL  LDX ACH (ADC #2 (BCC $1 (INX  $1 STA POTAB (STX POTAB+1 (MOVW HAC,ACL (RTS  ;---------------------------------------  ; RECORD PC AND OPCODE  ;  RINFO1 LDY #0 (INC PCL (BNE $1 (INC PCH  $1 JSR PREST (JSR GOTO (JSR PSAVE (MOVW HAC,ACL (JMP STEP  GOTO JMP @ACL  ;---------------------------------------  ; RECORD JUMP INFO  ;  JINFO JSR RINFO1 (MOVW POTAB,ACL (LDY #2 (LDA @PCL,Y (DEY Y #2 (SEC (BCS LOADI  ;---------------------------------------  ; EXIT -- RESTORE AND RTS  ;  EXIT JSR PREST (RTS ;---------------------------------------  ; NOTRACE -- DO ACTUAL CALL  ;  NOTRACE MOVW ACL,HAC  MOVW PCL,ACL (POP PCL  DOJUMP ;TWICE FOR INDIRECT (CMP AENTER (TXA (SBC AENTER+1 (BEQ EXIT ;SIGNAL TO STOP TRACE (TXA (AND #0F0 (CMP #0C0 (BEQ NOTRACE (JMP STEP  ;---------------------------------------  ; JUMP INDIRECT -- SET CARRY AS SIGNAL  JMPIOPS JSR JINFO (LDPROGRAM SPY1;  CONST NS=1024;  VAR ATAB,OTAB:ARRAY[0..NS] OF INTEGER; $CTAB:PACKED ARRAY[0..NS] OF 0..255; $P:TEXT; $NOPS:INTEGER; $HEX:STRING; $I,J,K:INTEGER; $  PROCEDURE TRACE; EXTERNAL;   PROCEDURE PHEX(I:INTEGER);  VAR J:INTEGER;  CO included the funny business in this program. *)  (* *)  (* ---------------------------------------------------------------- *)  (* Programmed by Burton S. Chambers III March 1981 *)  (* NOTE: The MX-80 generally remembers what the software settings *)  (* you send are. However, Epson intentionally allows the *)  (* option "DOUBLE WIDTH" to be turned off. This is why I *)  (* have(* LPRINTER:*)  (*$S+*) (* Q+*)   PROGRAM setupmx80;  (*------------------------------------------------------------------*)  (* Program to set up Epson MX-80 printer while using Pascal. *)  (* O^#(P,'HI'); #TRACE; #WRITELN(NOPS,' OPERATIONS:'); #PTRACE  END.  1END ,END; )PHEX(OTAB[N]); )IF IC=108 THEN BEGIN WRITE(P,' '); ,C.NUM:=OTAB[N]; ,PHEX(C.PTR^) )END; )WRITELN(P) # END  END;   BEGIN (*SPY1*) #REWRITE(P,'PRINTER:'); #HEX:='0123456789ABCDEF'; #WRITELN('STARTING TRACE...'); #TRACE; #WRITE(P,' JMP '); /IF IC=108 THEN WRITE(P,'@') ,END )ELSE ,CASE IC DIV 32 OF /1:BEGIN WRITE(P,' JSR '); 4LEVEL:=LEVEL+1 1END; /2:BEGIN WRITE(P,'RTI '); 4IF LEVEL>0 THEN LEVEL:=LEVEL-1 1END; /3:BEGIN WRITE(P,'RTS '); 4IF LEVEL>0 THEN LEVEL:=LEVEL-1 C:RECORD CASE BOOLEAN OF )TRUE:(NUM:INTEGER); (FALSE:(PTR:^INTEGER) &END;  BEGIN #LEVEL:=0; #FOR N:=0 TO NOPS-1 DO &BEGIN )PHEX(ATAB[N]); )WRITE(P,':'); )IF LEVEL>0 THEN WRITE(P,' ':LEVEL); )IC:=CTAB[N]; )IF IC MOD 16 = 12 THEN ,BEGIN /WRITEM:RECORD CASE BOOLEAN OF $ TRUE:(NUM:INTEGER); *FALSE:(NIB:PACKED ARRAY[0..3] OF 0..15) (END;  BEGIN  COM.NUM:=I; #FOR J:=3 DOWNTO 0 DO &WRITE(P,HEX[COM.NIB[J]+1])  END;   PROCEDURE PTRACE;  VAR N,IC:INTEGER;  LEVEL:INTEGER;  *)  (*------------------------------------------------------------------*)   CONST xcol = 35;   VAR doublewidth,compressed,emphasized,doublestrike,done: BOOLEAN; $ch: CHAR; $pr: TEXT;  (*------------------------------------------------------------------*) "PROCEDURE form; " "BEGIN $GOTOXY(0,3); $WRITELN(' 0 quit value '); $WRITELN; $WRITELN(' 1"toggle"DOUBLE WIDTH mode (*) '); $WRITELN(' 2 toggle COMN^<ܡIL done; "setvalues; "CLOSE(pr);  END.  -----*)  BEGIN "doublewidth := FALSE; compressed := FALSE; "emphasized := FALSE; doublestrike := FALSE; "REWRITE(pr,'#6:'); "PAGE(OUTPUT); "WRITELN('>Pascal[1.1] set up mx-80 bsc[1.1]'); "WRITELN; "form; done := FALSE; "REPEAT $menu; "UNT ('1': doublewidth := NOT doublewidth; ('2': compressed := NOT compressed; ('3': emphasized := NOT emphasized; ('4': doublestrike := NOT doublestrike; &END; (* case *) "END; (* menu *)  (*-------------------------------------------------------------$GOTOXY(0,13); WRITELN('since double width must be set each line'); $GOTOXY(0,15); WRITE(' which one ? [ 0..4 ] '); $REPEAT &READ(KEYBOARD,ch); IF NOT (ch IN ['0'..'4']) THEN WRITE(CHR(7)) $UNTIL ch IN ['0'..'4']; $CASE ch OF ('0': done := TRUE; ELSE WRITE('off'); $GOTOXY(xcol,8); IF doublestrike THEN WRITE(' ON') ELSE WRITE('off'); $GOTOXY(0,10); WRITELN('double width above implies # chars = ',n:3); $GOTOXY(0,12); WRITELN('*NOTE: actual number per line will = ',m:3); the double width setting shown *) $GOTOXY(xcol,5); IF doublewidth THEN WRITE(' ON') ELSE WRITE('off'); $(* above is of course a lie *) $GOTOXY(xcol,6); IF compressed THEN WRITE(' ON') ELSE WRITE('off'); $GOTOXY(xcol,7); IF emphasized THEN WRITE(' ON');  (*------------------------------------------------------------------*) "PROCEDURE menu; "VAR n,m: INTEGER; " "BEGIN $IF compressed THEN n := 132 ELSE n := 80; $m := n; $IF doublewidth THEN n := n DIV 2; !(* n will be the number of columns using$(* the above write won't make any difference in the final setting *) $IF compressed THEN WRITE(pr,ccon) ELSE WRITE(pr,ccoff); $IF emphasized THEN WRITE(pr,emon) ELSE WRITE(pr,emoff); $IF doublestrike THEN WRITE(pr,dson) ELSE WRITE(pr,dsoff); "ENDon[1] := CHR(15); ccoff[1] := CHR(18); $emon[1] := esc; emoff[1] := esc; $dson[1] := esc; dsoff[1] := esc; $ $IF doublewidth THEN WRITE(pr,dwon) ELSE WRITE(pr,dwoff); RING[1]; &emon, emoff, dson, dsoff: STRING[2]; &esc: CHAR; " "BEGIN esc := CHR(27); $dwon := ' '; dwoff := ' '; ccon := ' '; ccoff := ' '; $emon := ' E'; emoff := ' F'; dson := ' G'; dsoff := ' H'; " $dwon[1] := CHR(14); dwoff[1] := CHR(20); $ccPRESSED CHAR mode '); $WRITELN(' 3 toggle EMPHASIZED mode '); $WRITELN(' 4 toggle DOUBLE STRIKE mode '); "END;  (*------------------------------------------------------------------*) "PROCEDURE setvalues; "VAR dwon, dwoff, ccon, ccoff: ST(* LREMOUT:*)  (*$S+*) (* Q+*) (*$V-*)   PROGRAM Pagedumper;   (* Original by Tom Woteki Dec 1980 *)  (* Modified by Burton S. Chambers III *)  (* Version: 29-Dec-80 *)   CONST #cleol = 29; cleos = 11; radix = 256;  header = '>Pascal[1.-------------'); .mpage.addr := baseaddress; .FOR linenumber := 0 TO 15 DO 0BEGIN 2tohex(linenumber,msb,lsb); 2WRITE(f,lsb,'_: '); 2FOR chcount := 0 TO 15 DO 4BEGIN 6tohex(mpage.contents^[linenumber,chcount],msb,lsb); 6WRITE(f,msb,lsb); 6WRITE(f,THEN WRITELN(f,'This is the I/O Page. NO DISPLAY.') *ELSE ,BEGIN .WRITE(f,' _0 _1 _2 _3 _4 _5 _6 _7 _8 _9 _A _B _C _D _E _F '); .WRITELN(f,' 0123456789ABCDEF'); .WRITE(f,' -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- '); .WRITELN(f,' ---(WRITELN(f); WRITELN(f); (WRITELN(f); WRITELN(f); (tohex(pagenumber,msb,lsb); (WRITE(f,'Writing page number: ',msb,lsb,' (',pagenumber,')'); (WRITELN(f); WRITELN(f); (WRITELN(f,'Base address = ',baseaddress); (WRITELN(f); (IF pagenumber = iopage *4END; #VAR &mpage: memorypage; &okset: SET OF CHAR; &i,j,baseaddress,linenumber,chcount: INTEGER; &ch,msb,lsb: CHAR; # #(*----------------------------------------------------------------*) &PROCEDURE totheprinter; & &BEGIN ---------------------------------------------*) #PROCEDURE hexplay(pagenumber:INTEGER); #CONST iopage = 192; #TYPE &buffer = PACKED ARRAY [0..15,0..15] OF 0..255; &memorypage = RECORD CASE BOOLEAN OF 5TRUE:(addr:INTEGER); 5FALSE:(contents:^buffer); ----------------------------------------------------------*) #PROCEDURE tohex(i: INTEGER; VAR msb,lsb: CHAR); #VAR j: INTEGER; # #BEGIN %j := i mod 16; i := i div 16; %msb := numerals[i+1]; %lsb := numerals[j+1]; #END;  (*-------------------------3IF ch IN okset THEN WRITE(ch) ELSE WRITE('.'); 1END; /WRITE(' '); /FOR chcount := 16 TO 31 DO 1BEGIN 3ch := mpage.contents^[linenumber,chcount]; 3IF ch IN okset THEN WRITE(ch) ELSE WRITE('.'); 1END; /WRITELN; -END; )END; #END;  (*------------ F 0 (16-31) F'); +WRITELN(' ---------------- ----------------'); +mpage.addr := baseaddress; +FOR linenumber := 0 TO 7 DO -BEGIN /WRITE(linenumber,': '); /FOR chcount := 0 TO 15 DO 1BEGIN 3ch := mpage.contents^[linenumber,chcount]; ix * pagenumber 'ELSE baseaddress := radix * (pagenumber - radix); %WRITELN; WRITELN(CHR(cleol),'Base address = ',baseaddress); WRITELN; %IF pagenumber = iopage 'THEN WRITELN('This is the I/O Page. NO DISPLAY.') 'ELSE )BEGIN +WRITELN(' 0 ( 0-15)emorypage; &okset: SET OF CHAR; &baseaddress,linenumber,chcount: INTEGER; &ch: CHAR; # #BEGIN %okset := [CHR(32)..CHR(126)]; %GOTOXY(0,5); %WRITE(CHR(cleol),'Writing page number ',pagenumber); %IF pagenumber < (radix DIV 2) THEN baseaddress := rad#PROCEDURE display(pagenumber:INTEGER); #CONST iopage = 192; (* Wo had 208. Woe is Wo *) #TYPE &buffer = PACKED ARRAY [0..7,0..31] OF CHAR; &memorypage = RECORD CASE BOOLEAN OF 5TRUE:(addr:INTEGER); 5FALSE:(contents:^buffer); 4END; #VAR &mpage: m-*) #PROCEDURE getpgenum (VAR mesg: STRING; VAR pgenum: INTEGER); # #BEGIN %WRITE(CHR(cleos),mesg); READLN(pgenum); %IF NOT (pgenum IN [0..255]) THEN pgenum := 0; #END;  (*----------------------------------------------------------------------*) ) #PROCEDURE prompt; # #BEGIN %UNITCLEAR(1); GOTOXY(0,0); %WRITELN(CHR(cleol),header); %WRITELN; WRITELN; %WRITE(CHR(cleol),'View, Flip, Hxview, Print, Remout, Quit?'); #END;  (*---------------------------------------------------------------------1] BURT''S DUMP BSC[2.2]'; #  VAR #message: STRING; ch: CHAR; pagenumber:INTEGER; #numerals: STRING[16]; #f:text; (* output device *) #pr: (console,printer,remout);   (*----------------------------------------------------------------------*' '); 4END; 2WRITE(f,' '); 2FOR chcount := 0 TO 15 DO 4BEGIN 6ch := CHR(mpage.contents^[linenumber,chcount]); 6IF ch IN okset THEN WRITE(f,ch) ELSE WRITE(f,'.'); 4END; 2WRITELN(f); 0END; ,END; &END; #(*----------------------------------------------------------------*) #BEGIN %okset := [CHR(32)..CHR(126)]; %GOTOXY(0,5); %tohex(pagenumber,msb,lsb); %WRITE(CHR(cleol),'Writing page number ',msb,lsb,' (',pagenumber,')'); %IF pagenumber < (radix DIV 23); )END; %UNTIL ch = escape; #END;  (*----------------------------------------------------------------------*)  BEGIN "numerals := '0123456789ABCDEF'; "message := ''; "ch := ' '; "pagenumber := 0; "PAGE(OUTPUT); "pr := console; " "REPEAT $p; %REPEAT 'READ(KEYBOARD,ch); 'IF ch IN [up,down] THEN )BEGIN +IF ch = up THEN pagenumber := (pagenumber + 1) MOD radix -ELSE IF pagenumber = 0 THEN pagenumber := 255 -ELSE pagenumber := (pagenumber - 1) MOD radix; +display(pagenumber); +GOTOXY(0,%getpgenum(message,pagenumber); %GOTOXY(0,3); %WRITE(CHR(cleos),'FLIPPING PAGES:'); %display(pagenumber); %WRITELN; %WRITELN('Press to stop flipping,'); %WRITELN('Left arrow to go to low memory'); %WRITELN('Right arrow to go to high memory.')--*) #PROCEDURE flippages; #CONST &esc = 27; downcntrl = 8; upcntrl = 21; #VAR &ch, escape, up, down: CHAR; # #BEGIN %escape := CHR(esc); up := CHR(upcntrl); down := CHR(downcntrl); %GOTOXY(0,5); %message := 'Enter starting page (Decimal)..'; ---*) #PROCEDURE hexapage; # #BEGIN %WRITE(CHR(cleos)); %GOTOXY(0,5); %message := 'Enter page number (Decimal)..'; %getpgenum(message,pagenumber); %hexplay(pagenumber); #END;  (*------------------------------------------------------------------------*) #PROCEDURE viewpage; # #BEGIN %WRITE(CHR(cleos)); %GOTOXY(0,5); %message := 'Enter page number (Decimal)..'; %getpgenum(message,pagenumber); %display(pagenumber); #END;  (*-------------------------------------------------------------------%FOR pagenumber := 0 TO 255 DO 'BEGIN )WRITE(CHR(cleos)); )GOTOXY(0,5); )IF ((pagenumber mod 3) = 0) THEN PAGE(f); )hexplay(pagenumber); 'END; %CLOSE(f); %pr := console; #END;  (*------------------------------------------------------------------REWRITE(f,'REMOUT:'); %pr := remout; %hexplay(pagenumber); %CLOSE(f); %pr := console; #END;  (*----------------------------------------------------------------------*) #PROCEDURE dumppage; # #BEGIN %REWRITE(f,'REMOUT:'); %pr := remout; ); %pr := console; #END;  (*----------------------------------------------------------------------*) #PROCEDURE remoutpage; # #BEGIN %WRITE(CHR(cleos)); %GOTOXY(0,5); %message := 'Enter page number (Decimal)..'; %getpgenum(message,pagenumber); %------------------------------*) #PROCEDURE printpage; # #BEGIN %WRITE(CHR(cleos)); %GOTOXY(0,5); %message := 'Enter page number (Decimal)..'; %getpgenum(message,pagenumber); %REWRITE(f,'PRINTER:'); %pr := printer; %hexplay(pagenumber); %CLOSE(f/FOR chcount := 0 TO 15 DO 1BEGIN 3ch := CHR(mpage.contents^[linenumber,chcount]); 3IF ch IN okset THEN WRITE(ch) ELSE WRITE('.'); 1END; /WRITELN; -END; )END; %IF pr <> console THEN totheprinter; #END;  (*----------------------------------------+FOR linenumber := 0 TO 15 DO -BEGIN /tohex(linenumber,msb,lsb); /WRITE(lsb,'_: '); /FOR chcount := 0 TO 15 DO 1BEGIN 3tohex(mpage.contents^[linenumber,chcount],msb,lsb); 3WRITE(msb,lsb); 3WRITE(' '); 1END; /WRITE(' '); NO DISPLAY.') 'ELSE )BEGIN +WRITE(' _0 _1 _2 _3 _4 _5 _6 _7 _8 _9 _a _b _c _d _e _f '); +WRITELN(' 0123456789abcdef'); +WRITE(' -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- '); +WRITELN(' ----------------'); +mpage.addr := baseaddress; 2) THEN baseaddress := radix * pagenumber 'ELSE baseaddress := radix * (pagenumber - radix); %WRITELN(CHR(cleol)); %WRITELN(CHR(cleol)); %WRITELN('Base address = ',baseaddress); %WRITELN; %IF pagenumber = iopage 'THEN WRITELN('This is the I/O Page. rompt; $READ(ch); $CASE ch OF &'D','d':dumppage; &'H','h':hexapage; &'P','p':printpage; &'R','r':remoutpage; &'V','v':viewpage; &'F','f':flippages; %END; "UNTIL ch IN ['Q','q']; "PAGE(OUTPUT); "GOTOXY(0,5); "WRITELN('That''s all folks!...');  END.  #quiet := FALSE; #initturtle; #board; #moveto(73, 173); wstring('Eight Queens Problem'); #moveto(XMAX + 14, 135); wstring('Keys Menu'); #moveto(XMAX + 14, 127); wstring('---------'); #moveto(XMAX + 14, 111); wstring('E: Exit'); #moveto(XMAX : integer);  begin #moveto(col * 15 + 70, row * 15 + 24); #wchar(chr(27))  end;   procedure removequeen(col, row: integer);  begin #moveto(col * 15 + 70, row * 15 + 24); #wchar(' ')  end;  procedure setupgraphics;  begin #quick := FALSE;  moveto(XMAX, i * 15 + 20); #end; #pencolor(NONE); #for i:=8 downto 1 do begin moveto(XMIN - 15, i * 15 + 20); wchar(chr(i + 48)); moveto(i * 15 + 72, YMIN - 15); &wchar(chr(i + 48)) #end  end;  procedure drawqueen(col, rowor i := 1 to 9 do begin pencolor(NONE); moveto(i * 15 + 65, YMAX); pencolor(BLUE); moveto(i * 15 + 65, YMIN); #end; #for i:=9 downto 1 do begin pencolor(NONE); moveto(XMIN, i * 15 + 20); pencolor(BLUE); : quiet := FALSE; &'S', 's': quick := FALSE; &'F', 'f': quick := TRUE #end  end;  procedure wait(time:integer);  var #delay: integer;  begin #for delay := 1 to time do &(* nothing *)  end;  procedure board;  var #i: integer;  begin #f; #i, count: integer; #quick, quiet: boolean; $ procedure goodbye; begin #textmode; #exit(program)  end;  procedure checkchar;  var #ch: char;  begin #read(keyboard, ch); #case ch of &'E', 'e': goodbye; &'Q', 'q': quiet := TRUE; &'N', 'n'program eightqueens; (*$s+*)  uses turtlegraphics, applestuff;  const #XMAX = 200; #YMAX = 155; #XMIN = 80; #YMIN = 35; #  var #a: array [1..8] of boolean; #b: array [2..16] of boolean; #c: array [-7..7] of boolean; #x: array [1..8] of integerN^+ 14, 95); wstring('F: Fast'); #moveto(XMAX + 14, 79); wstring('S: Slow'); #moveto(XMAX + 14, 63); wstring('Q: Quiet'); #moveto(XMAX + 14, 47); wstring('N: Notes');  end;   procedure showsolution; begin #if keypress then &checkchar; #count := count + 1; #moveto(35, 3); #wstring('Solution '); #if count > 9 then &wchar(chr(48 + count div 10)) #else # wchar(' '); #wchar(chr(48 + count mod 10)); #wstring(' is'); #for i:=1 to 8 do begin &wchar(' '); &wchar(chr(x[i] + 48)); &) 1dnumfiles: dirrange; (*num files in dir*) 1dloadtime: integer; (*time of last access*) 1dlastboot: daterec; (*most recent date setting*) .end (*direntry*) ; var %a: direntry; %d, m, y: string;  begin #unitread(4, a, sizeof(di: 0..12; 0day: 0..31; 0year: 0..100 -end; #dirrange = 0..MAXDIR; #direntry = packed record 1dfirstblk: integer; 1dlastblk: integer; 1filler1 : 0..2048; 1dvid: string[VIDLENG]; (*name of disk volume*) 1deovblk: integer; (*lastblk of volume*program datetest;   (* Test of date routine *)   var #d: string;   procedure date(var s:string);  const #MAXDIR = 77; #VIDLENG = 7; #DIRBLK = 2; #MONTHSTR = 'JanFebMarAprMayJunJulAugSepOctNovDec';   type #daterec = packed record 0monthN^&(* Nothing *) #until keypress; #goodbye  end.  #end  end;   begin #setupgraphics; #count := 0; #for i := 1 to 8 do &a[i] := TRUE; #for i := 2 to 16 do &b[i] := TRUE; #for i := -7 to 7 do &c[i] := TRUE; #try(1); #moveto(35, 3); wstring('That''s all! (Hit any key to exit.)'); #repeat c[i - j] then begin )x[i] := j; )a[j] := FALSE; )b[i + j] := FALSE;  c[i - j] := FALSE; )if i < 8 then ,try(i + 1) )else (* Found solution *) ,showsolution; )a[j] := TRUE; )b[i + j] := TRUE; )c[i - j] := TRUE &end; &removequeen(i, j)if not quiet then )note(5 * x[i], 70) #end; #if not quick then &wait(6500); #if keypress then &checkchar  end;   procedure try(i: integer);   var #j: integer;   begin #for j := 1 to 8 do begin &drawqueen(i, j); &if a[j] and b[i + j] andrentry), DIRBLK); #with a.dlastboot do begin &m := copy(MONTHSTR, month * 3 - 2, 3); &str(day, d); &str(year, y); &s:=concat(d,' ',m,' ',y) #end  end;   begin #date(d); #writeln(d)  end.  /^)ae : DATE; " (* date diskette was formatted *) "D : INTEGER; "E : INTEGER; "END;   FileInfo = RECORD "Starting : INTEGER; $(* the block the file starts in *) "Ending : INTEGER; $(* block after the end of the file *) "FileType : 0..7; $(* NILING[7]; " (* this field is 8 bytes long *) $(* the first byte contains the *) $(* length of the name, the next 7 *) $(* contain the name of the disk *) "B : INTEGER; "Files : INTEGER; " (* files on the diskette *) "C : INTEGER; "DiskDat"Year : 1..99; "END;   DiskInfo = RECORD "(* many of these fields have an *) "(* unknown function. the ones that *) "(* have a single letter for their *) "(* name are unknown *) "A : ARRAY[0..2] OF INTEGER; "DiskName : STR by its members and affiliates *)  (* *)  (**************************************)   TYPE (* DECLARATIONS *)   Date = "(* MONTH, DAY AND YEAR IN 16 BITS *) "PACKED RECORD "Month : 1..12; "Day : 1..31; ****************************)   (**************************************)  (* *)  (* This program has been provided to *)  (* the San Francisco APPLE Core for *)  (* distribution to and non-commercial *)  (* usel Rights Reserved *)  (*$C No part of this program mat be *)  (*$C translated, reproduced or stored *)  (*$C in any form without the prior *)  (*$C written consent of Stephen Lloyd *)  (* *)  (********** THE DISK, AN OPTIONAL ALIAS NAME IS REQUESTED  FOR EACH DISKETTE.  *)   PROGRAM MasterCatalog;   (**************************************)  (* *)  (*$C Copyright (c) 1980 Stephen Lloyd *)  (*$C AlS ON THE DISKETTE  DIRECTORY ARE WRITTEN ONTO THE MASTER CATALOG  FILE FOLLOWING THE VOLUME NAME OF THE  DISKETTE.  %SINCE THE DISKETTES CAN BE PHYSICALLY  CALLED BY A NAME OTHER THAN THE NAME STORED ON LE IS WRITTEN ON THE DISKETTE IN DRIVE TWO  AND CAN BE GIVEN ANY FILE NAME. IF THAT FILE  EXISTS, THE THE MASTER CATALOG IS APPENDED TO  THE END. THE DISKETTES TO BE CATALOGED ARE  INSERTED INTO DRIVE ONE IN RESPONSE TO THE  PROMPTS. ALL ACTIVE FILEhe procedure called  "ListFile " in the main program. I've marked  it with a big sign to help you locate it. *)  %(* THIS PROGRAM CREATES A MASTER CATALOG  OF AS MANY DISKETTE DIRECTORIES AS CAN BE  WRITTEN INTO THE CATALOG FILE. THE CATALOG  FI (* The comment block following this comment  block must be written into a file called  "CAT.INTRO.TEXT". The easiest way to do that  is with the editor. If you don't want to look  at that silly message every time the program  runs, then delete t,BAD,CODE,TEXT,  INFO,DATA,GRAF,FOTO *) "FileName : STRING[15]; $(* the file name pyhsicaly *) $(* occupies 16 bytes in the *) $(* directory. the first byte *) $(* indicates the length of the *) $(* name the next 15 bytes contain *) $(* the ascii REPRESENTATION OF *) " (* THE NAME *) "UNKNOWN : INTEGER; $(* your guess is as good as mine *) "FileDate : DATE; $(* this is the date the file was *) $(* last written to   PROCEDURE Reminder;   BEGIN (* REMINDER *)  WRITELN;  WRITELN;  WRITELN;  WRITELN  ('THE MASTER CATALOG FILE HAS BEEN');  WRITELN  ('PLACED ON DRIVE 2.');  WRITELN;  WRITELN  ('USE THE EDITOR TO REVIEW ITS CONTENTS');  WRITELN  ('OR USETTE TO BE INCLUDED IN');  WRITELN  ('MASTER CATALOG IN DRIVE 1.');  WRITELN  ('PRESS "RETURN" TO CONTINUE,');  WRITE  ('"Q" TO TERMINATE : ');  READ(CH);  IF (CH='Q') OR (CH='q') "THEN Quit := TRUE  ELSE Quit := FALSE;  END; (* PROMPT *)  "END; (* FILES *)    BEGIN (* CATALOG *)   (* READ DIRECTORY FROM DRIVE 1 *)  UNITREAD(4,Directory,2048,2);   Header;  Alias;  Files;  END; (* CATALOG *)    PROCEDURE Prompt;   BEGIN (* PROMPT *)  WRITELN;  WRITELN  ('INSERT DISK 2)=1 (THEN BEGIN (WRITE ((F,Directory.Files[I].FileName); (FOR J := 20 DOWNTO (LENGTH(Directory.Files[I].FileName) *DO WRITE(F,' '); (END *ELSE WRITELN *(F,Directory.Files[I].FileName); &WRITE('.'); &END; $END; "WRITELN(F);  WRITELN(F); F,'-'); $WRITELN(F); $END; "END; (* ALIAS *)    PROCEDURE Files;   BEGIN (* FILES *) "(* WRITE FILE NAMES ONTO %MASTER CATALOG FILE *) "IF Directory.Disk.Files>0 $THEN BEGIN $FOR I := 1 TO $Directory.Disk.Files &DO BEGIN &IF (I MODTTE NAME : '); "READLN(AliasName); "(* WRITE DISKETTE NAME %ONTO MASTER CATALOG FILE *) "IF LENGTH(AliasName)>0 $THEN BEGIN $WRITELN $(F,'DISKETTE NAME : ',AliasName); $WRITE $(F,'------------- '); $FOR I := 1 TO (LENGTH(AliasName) (DO WRITE("IF LENGTH(Directory.Disk.DiskName)>0 $THEN BEGIN $WRITELN(F,'DISK NAME : ', $ Directory.Disk.DiskName); $WRITELN(F); $END;  END; (* HEADER *) "   PROCEDURE Alias; " "VAR AliasName : STRING[32]; " "BEGIN (* ALIAS *) "WRITE('DISKEE(OUTPUT); "WRITELN('ERROR IN OPENING FILE'); "WRITELN('PROGRAM TERMINATED'); "END;  END;    PROCEDURE Catalog;   PROCEDURE Header; " "BEGIN (* HEADER *) "(* WRITE DISK HEADER ONTO " MASTER CATALOG FILE *) FileName);  IF IORESULT<>0 "THEN BEGIN "REWRITE(F,FileName); "END  ELSE BEGIN $WRITE('FILE EXISTS..APPENDING'); $REPEAT $READLN(F,Line); $WRITE('.'); $UNTIL EOF(F);  END;  (*$I+*)   IF IORESULT<>0 "THEN BEGIN "Quit := TRUE;  PAG#5:',FileName); "IF LENGTH(FileName)<19 $THEN GoodFile := TRUE &ELSE BEGIN &GoodFile := FALSE; &WRITE &('File name must be less than '); &WRITELN &('10 characters !'); &END; "END $ELSE GoodFile := FALSE;  UNTIL GoodFile;   (*$I-*)  RESET(F, WRITE('master catalog file name : ');  READLN(FileName);  IF LENGTH(FileName)>0 "THEN BEGIN "IF (POS('.TEXT',FileName)=0) OR " (POS('.text',FileName)=0) $THEN FileName := CONCAT(FileName, $ '.TEXT'); "FileName := CONCAT('ess "RETURN" to continue : '); "READLN; "UNTIL EOF(F);  CLOSE(F);  END;    PROCEDURE OpenMaster;   VAR GoodFile : BOOLEAN;  Line : STRING[132];   (* OPEN MASTER CATALOG FILE ON DRIVE 2 *)  BEGIN  GoodFile := FALSE;  REPEAT DURE ListFile(TextFile : STRING);   VAR F : TEXT; $I : INTEGER; $Line : STRING[80]; $  BEGIN  RESET(F,CONCAT(TextFile,'.TEXT')); "REPEAT "PAGE(OUTPUT); "FOR I := 1 TO 20 $DO BEGIN $READLN(F,Line); $WRITELN(Line); $END; "WRITELN; "WRITE('pr the disk *) "END;    VAR (* VARIABLE DECLARATIONS *)   Directory : RECORD "Disk : DiskInfo; "Files : ARRAY[1..77] OF FileInfo; "END;   CH : CHAR;  FileName : STRING[15];  F : TEXT;  I,J,K,L : INTEGER;  Quit : BOOLEAN;    PROCEE THE FILER TO TRANSFER IT TO');  WRITELN  ('THE PRINTER.');  END; (* REMINDER *)    BEGIN (* MASTER CATALOG *)  #(*******************) !(* *)  (* This is it, this is *)  (* what you want to get *)  (* rid of if you don't *)  (* want to be introduced *)  (* to the program every *)  (* time it runs *) !(* *) #(*******************)  ListFile('#5:CAT.INTRO');  (*******************) #  PAGE(OUTPUT);  Quit := (*$S+*) UNIT TIGER; INTRINSIC CODE 25; INTERFACE PROCEDURE PRINTHIRES; IMPLEMENTATION FUNCTION SCRNBYT(X,Y: INTEGER): INTEGER; EXTERNAL; PROCEDURE PRINTHIRES; (* DUMP HIRES GRAPHICS PAGE TO THE PAPER TIGER PRINTER *) CONST PRINTEN^qq) #i `g6 PPb6 *,, TIGER.CODETEM.SWAPDISKQܡ ޢۆTIGER.TEXT/(tT-  TIGER.CODEK.CODE[*]^APPLE2:SYSTEM.SWAPDISK{  ȡ& á   ǿš `Z h4h5hhhhhhhh G)% 8fHJH5H4H`H)JJh & & fAPPLE2T TIGER.CODEz6 z|z6 PPb6 *,, TIGER.CODETEM.SWAPDISKQܡ ޢۆTIGER.TEXT/(tT-  TIGER.CODEK.CODE[*]^APPLE2:SYSTEM.SWAPDISK{ PROCEDURE PRINTHIRES; IMPLEMENTATION E .CODE.CODEPDISKWAPDISKԍ֍br r b^br APP`b6 6 ^``Pb6 r  G@ TIGER ND. (* MASTER CATALOG *)   FALSE;  OpenMaster;  (* OPEN MASTER CATALOG FILE ON DRIVE 2 *)  WHILE NOT Quit "DO BEGIN "Prompt; "WHILE (CH<>'Q') AND (CH<>'q') $DO BEGIN $Catalog; $Prompt; (* FOR NEXT DISKETTE *) $END; "PAGE(OUTPUT); "Reminder;  END;  CLOSE(F,LOCK);  ER=6; VAR SEND: PACKED ARRAY[0..3] OF 0..255; N,X,Y: INTEGER; BEGIN SEND[0]:=3; SEND[1]:=11; UNITWRITE(PRINTER,SEND,1,0,12); (* SEND[0] = CHANGE PRINTER TO GRAPHICS MODE *) Y:=0; REPEAT FOR X:= 0 TO 279 DO BEGIN N:=SCRNBYT(X,Y); UNITWRITE(PRINTER,N,1,0,12); IF N=3 THEN UNITWRITE(PRINTER,N,1,0,12); END; UNITWRITE(PRINTER,SEND,2,0,12); (* SEND[0..1] = NEW LINE OR CR *) Y:=Y+6; UNTIL Y>191; SEND[1]:=2; ASL A ROL ADDR+1 ASL A ROR ADDR LDA ADDR+1 AND #01F ORA #020 NOP STA ADDR+1 ; ; CALCULATE OFFSET ; FORMULA IS ? ; IF XUB1 PHA AND #0C0 STA ADDR LSR A LSR A ORA ADDR STA ADDR PLA STA ADDR+1 ASL A ASL A ASL A ROL ADDR+1 PHA ;MSB OF RETURN VALUE=0 LDA VALUE LSR A PHA ;LSB OF RETURN LDA RETURN+1 ;RESTORE PASCAL RETURN ADDR PHA LDA RETURN PHA RTS S @ADDR,Y AND #7F CLC AND MASK BEQ ISZERO SEC ; SWITCH THE CLC AND SEC ABOVE FOR NEGATIVE ISZERO ROR VALUE INC YCOORD DEC COUNT BNE LOOP LDA #0 STA VALUE PLA STA XCOORD PLA STA XCOORD+1 LOOP LDX XCOORD ;LSB OF X COORD LDY XCOORD+1 ;MSB OF X COORD LDA YCOORD JSR SUB1 LDY OFFSET LDA ;STACK BIAS (FUNC) PLA PLA LDA #06 ;6 BIT SCAN STA COUNT PLA ;LSB OF Y COORD STA YCOORD PLA ;DISCARD MSB OF Y LDA #0 IT ;USES 6 & 7 ;CALCULATED BY SUB1 OFFSET .EQU 8 ;OFFSET PAST ADDR OF BIT MASK .EQU 9 ;MASK TO GET BIT POP RETURN PLA ;DISCARD 4 BYTE PLA CRNBYT(X,Y: INTEGER); ; ; RETURN .EQU 034 ;TEMP FOR RETURN ADDR COUNT .EQU 0 ;HOW MANY BITS TO SCAN YCOORD .EQU 1 XCOORD .EQU 2 ;BYTES 2 & 3 VALUE .EQU 4 ;RETURN VALUE ADDR .EQU 6 ;ADDRESS OF SCREEN B; ; ; MACRO POPS 16 BIT ARGUMENT ; .MACRO POP PLA STA %1 PLA STA %1+1 .ENDM .FUNC SCRNBYT,2 ; ; THIS FUNCTION SCANS 6 BITS FROM ; THE HIGH RESOLUTION SCREEN ; ; FUNCTION SN^qq UNITWRITE(PRINTER,SEND,2,0,12); (* RESTORE TO NORMAL PRINTER MODE *) END; (* PRINTHIRES *) BEGIN; END.  COORD<256 THEN ; OFFSET=XCOORD DIV 7 ; ELSE ; OFFSET=23 + (XCOORD+4) DIV 7 ; ; ALSO CALCULATE MASK ; XCOORD MOD 7 = 0 MASK=81 ; 1 82 ; 2 84 ; 3 88 ; 4 90 ; 5 A0 ; 6 C0 ; TXA CPY'S^:=CHR(ESCAPE);PUT(S); 'S^:=CHR(NORMAL);PUT(S) &END; " "'B':BEGIN 'S^:=CHR(ESCAPE);PUT(S); 'S^:=CHR(PROPORTIONAL);PUT(S) &END; " "'C':BEGIN 'S^:=CHR(ESCAPE);PUT(S); 'S^:=CHR(CONDENSED);PUT(S) &END; " "END; (*OF THE CASE*) "  LINE:='THIS   REWRITE(S,'PRINTER:');  (*HERE IS THE CRUX OF THE PROGRAM. HOW TO  SEND OUTPUT TO THE PRINTER. PG.133 OF THE  WHITE MANUAL INDICATES THAT RESET WOULD  ALSO WORK. IT AIN'T SO. A RUN-TIME  ERROR RESULTS.*)   CASE ANSWER OF " "'A':BEGIN ) PROPORTIONAL');  WRITELN(' C) CONDENSED');  WRITELN;  WRITELN('PRESS KEY A,B, OR C TO CHOOSE PRINTSET');  WRITELN('PRESS ANY OTHER KEY TO EXIT PROGRAM.');   READ(KEYBOARD,ANSWER);   IF NOT (ANSWER IN ['A','B','C'])  THEN EXIT(PRINTSET); CHAR;  $I (*INDEX*): INTEGER; $ $LINE: STRING; $ $S (*SWITCHES*): FILE OF CHAR;   BEGIN  PAGE(OUTPUT);  GOTOXY(0,8);  WRITELN('SELECT THE PRINTSET THAT YOU WANT');  WRITELN;  WRITELN(' A) NORMAL');  WRITELN(' BPROGRAM PRINTSET;  (*$C PAUL NORRIS, 752-7926, SEPT. 1980 *)   CONST ESCAPE=27; (*INITIALIZE FOR SOFTWARE SWITCH*) (NORMAL=19; (*SOFTWARE SWITCHES*) (PROPORTIONAL=17; (CONDENSED=20; (CR=13; (*CARRIAGE RETURN*) (  VAR ANSWER: N^ X MOD 7 = 1 --> -6 = FA ; ... ; X MOD 7 = 6 --> -1 = FF ; ; THUS THE TABLE ENTRY CORRESPONDING ; TO 0 IS TABLE+0 ; = TBL-0F9+0F9 ; OR LDA TABLE,X ; .END LDA TABLE,X STA MASK RTS ; ; TABLE OF MASK VALUES ; TBL .BYTE 081,082,084,088 .BYTE 090,0A0,0C0 TABLE .EQU TBL-0F9 ; CALCULATION FINDS (X-COORD MOD 7) -7 ; X MOD 7 = 0 --> -7 = F9 ; #0 ;IS TOP BYTE OF XCOORD=0? BEQ $01 ;YES LDY #023 ;NO, ADD 23 TO OFFSET ADC #04 ; AND ADD 4 TO XCOORD $02 INY $01 SBC #07 BCS $02 STY OFFSET TAX LINE IS OUTPUT IN THE PRINTSET YOU HAVE CHOSEN.';   FOR I:=1 TO LENGTH(LINE) DO #BEGIN %S^:=LINE[I]; %PUT(S) #END; #  S^:=CHR(CR);PUT(S); (*OUTPUT CARRIAGE RETURN*)   CLOSE(S)   END.(*PRINTSET*)   T"( 8);"BOOT THE EAMON MASTER DISK"0 :_ " NON COMMERCIAL DISTRIBUTION ENCOURAGED"e PAP  "*****************************************";38);"**";((38(A$))2));A$;((38(A$))2)((A$)2((A$)2)));"**";38);"*****************************************": 13);"BY ";A2$ h: 0" TO GO ON THIS ADVENTURE YOU MUST FIRSf 4xA3$"THE WONDERFUL WORLD OF EAMON"K@A1$"DONALD BROWN"cA$"THE DEATH STAR"zA2$"DONALD BROWN"NUM6` 7);A3$( "----------------------------------------"; 13);"BY ";A1$ :: 15);"ADVENTURE ";NUM H    30NORTH,N,SOUTH,S,EAST,E,WEST,W,UP,U,DOWN,D,GET,TAKE,DROP,PUT,LOOK,EXAMINE,ATTACK,FLEE,RETREAT,ESCAPE,GIVE,INVENTORY,I,SMILE,READY,TAKE-OFF,EAT,DESTROY 173,48,192,136,208,4,198,1,240,8,202,208,246,166,0,76,2,3,96///DONE WITH GAME>(0,9)1:MD%(0,11)AD%(1,7):MD%(0,12)AD%(1,8)NjNC:C$(NC):C1NC:C$(C):otV%(90),S%(90),B%(90):ROOM1~S%(72)6:S%(8)200:S190200(1):R(77(1)2):S%(R)S%(R)1::S%(17)0:S%(16)0:S%(24)0:S%(49)0A770788:P:A,P:l100v:DK$;"DELETE FRESH MEAT"v$DK$;"OPEN EAMON.DESC,L256":DK$;"OPEN EAMON.ROOM NAMES,L64":DK$;"OPEN EAMON.ROOMS,L64"8WT2LMD%(0,8)2:EA15VMD%(0,10)0:EAAEMD%(0,10)EAAE-`MD%(0,10)MD%(0,10)AD%(1,5)WA%(5)2MD%(0,2):MD%(0,7)10:MD%;"CLOSE"DK$;"OPEN FRESH MEAT":DK$;"READ FRESH MEAT":REC:MN$(0),MD%(0,1),MD%(0,2),CH:A14:SA%(A)::A15:WA%(A)::AE,SEX$,GOLD,BANK,ACNW4:WN$(NW),WT%(NW),WO%(NW),WD%(NW),WP%(NW):A14:WN$(A),WT%(A),WO%(A),WD%(A),WS%(A)::DK$;"CLOSE"),AD%(NA4,9):A1NA:DK$;"READ EAMON.ARTIFACTS,R";A:AN$(A):A214:AD%(A,A2):A2:AD%(A,2)1āA258:AD%(A,A2):A2A:DK$;"OPEN EAMON.MONSTERS,L128":MN$(NM),MD%(NM,15):A1NM:DK$;"READ EAMON.MONSTERS,R";A:MN$(A):A2112:MD%(A,A2):A2,A:DK$D%(3,5)R2:ROOMRZ:ROOMR2900^R3ROOM:3600::"DARTH VADER JUST ENTERED THE ROOM!"::g100///INITIALIZE DATADK$;"OPEN EAMON.DESC":DK$;"READ EAMON.DESC":NR,NZ,NE,NM:DK$;"CLOSE":NANZwDK$;"OPEN EAMON.ARTIFACTS,L128":AN$(NA4OF99:M21NM:MD%(M2,5)ROOMMD%(M2,14)3(1).25DFM2:7500:M2200:M2:600dM2:DF0:7500XNBTL(FD%(1)TD%(1)):NBTLĂSD///WALK OF DARTH VADERMD%(3,5)0MD%(3,5)ROOM900RZROOM:ROOMMD%(3,5)8500:R217R224723 M)ROOMMD%(M2,14)3(1).25DFM2:7500:M2200:M2:490P|M2:DF0:7500:490YOFMM21NM:MD%(M2,5)ROOMMD%(M2,14)1DFM2:7500:M2200:M2:490M2:DF99:7500NBTL(FD%(1)TD%(1)):NBTLĂMS%(ROOM)0700SD1S%(ROOM)Q41(1)20)TMD%(M,4)MRĺ:MN$(M);" FLEES OUT AN EXIT."::8500:MD%(M,5)R2:M2MD%(M,14):TD%(M2)TD%(M2)MD%(M,1):FD%(M2)FD%(M2)MD%(M,13):490YMD%(M,14)2490^MD%(M,14)3390hOFM:TD%(3)MD%(0,1)DF0:7500:4908rM21NM:MD%(M2,5000,5000,6000,6000,7000,8000,8000,8000,9000,10000,10000,11000,12000,13000,14000,15000,15000,16000,17000 ,///COMMANDS RETURN TO HERE 6NBTL(FD%(1)TD%(1)):NBTL700 @M1NM:MD%(M,5)ROOM490 JM2MD%(M,14)(MD%(M,14)2):MRFD%(M2)TD%(M2)()" "S$(S$,2):260 C1NC:C$(C)V$C$(C)S$Ă::"HUH? I ONLY UNDERSTAND THESE COMMANDS-- ";:C1NC:C$(C);20(C$(C)));::::210 C$(C)S$S$V$:V$C$(C)g "C3000,3000,3000,3000,3000,3000,3000,3000,3000,3000,3000,3000,4000,4000,5OM)ĺ"THERE ARE ";B%(ROOM);" BLASTERS HERE."P V%(ROOM)1:ROOM17DIE1:2000l :" YOUR COMMAND?";A$ (A$,1)" "A$(A$,2):220 A$""A$CZ$:(37):17:A$ CZ$A$:A2(A$):(A$,A,1)" "Ă V$(A$,A1):S$(A$,A1) (S$,1ON.DESC,R";M300:A$:DK$:A$:MD%(M,15)1:e M:A1NZ:AD%(A,4)ROOMAD%(A,9)ĺ"YOU SEE ";AN$(A) AD%(A,4)ROOMAD%(A,9)ĺDK$;"READ EAMON.DESC,R";A100:A$:DK$:A$:AD%(A,9)1: A:S%(ROOM)ĺ"THERE ARE ";S%(ROOM);" SOLDIERS HERE.", B%(ROQ V%(ROOM)ĺDK$;"READ EAMON.ROOM NAMES,R";ROOM:A$:DK$:"YOU ARE ":" ";A$: V%(ROOM)ĺDK$;"READ EAMON.DESC,R";ROOM:A$:DK$:A$::V%(ROOM)1 M1NM:MD%(M,5)ROOMMD%(M,15)ĺMN$(M);" IS HERE.":+ MD%(M,5)ROOMMD%(M,15)ĺDK$;"READ EAM-7 EAMON ADVENTURE #6<-> THE DEATH STAR <-B[ BY DONALD BROWNat2DK$(4):1000F///TONE ROUTINEPCN1CF:TAABAM:0,TA:1,DN:770:TA,CN:d///MAIN LOOP. FIRST GIVE ROOM DESC, THEN GET COMMANDn x                    Ġ΍ĠóύĠҲIJĠȠҮĠŠҍĠōĠӠĠҠ͠ԮԠҍĠҠ٠ԍĠΠ̠ԍΠ̠ԮҠ͠ԮĠˠԍĠΠԍĠΠԍĠԍĠĠȍĠÍĠԍĠĠōӍōōčĠӍǍōӍˍōӍԍ٠ō     ՠŠԠŠȠĠƠҮΠŠ̠ϠŠȠӠΠӬŠҠҠ˧ՠŠΠȯȠҮՠŠΠΠȯȠҬȠƠҭ٠ήՠŠΠŠǠͮԠӠŠĠԠΠӠĠŠŮŠ٠ԠӠˠϠȮՠŠԠŠȠĠƠҮΠŠȠ̬ŠӠҮՠŠΠŠȠӬǠͧՠŠΠȯȠҬԠȠƠҭ٠ήӠՠҠŠͬԠӠӠԠŠΠԠ͠ӠӧՠŠנĮŠ٠ԠӠˠȠŠҠϠŠԮՠŠԠŠԠĠƠҮŠ̠ӠˠϠŠԮŠӠҠΠŠԠ̬ȠΠŠԠԠӠԠӧҠ˿ՠŠΠΠԯԠҮՠŠΠҭ٠ήӠϠƠȬȬԠĠԮՠŠΠΠԯԠҮŠҠӠϠԠȯȠҠϠŠԮՠŠΠǠԯԠҮŠȠӠҠĠŠŠՠŠΠŠΠҠˮӠĠȠĠԬҠՠ٠ŭŠ͠Π٠ǠРԮŠŠ٠ȠӠΠŠĠŠҠӠ٠ˠĠήՠŠΠŠ͠ήŠӠҠΠŠ͠ƠŠРӠŠԠϠŠȠҮ                                            ҲIJ΍ŠҍóаԍōȠҍˠԍΠԍΠԍԍȍÍ   ŠȠҍΠΠԯԠҮԠĠΠŠһΠĠ׮ΠȯȠҮΠȯȠҮԠŠРƠŠŠΠŠҠ̠ͮΠΠԯԠҮΠΠԯԠҮΠŠŠҠŠҠŮΠŠҠ͠ŮΠȯȠҮԠŠȠĠƠҮԠŠȠĠƠҮΠŠҠ٠ͮΠȯȠҮΠȯȠҮΠΠԯԠҮΠԭλίӠĠԮΠȯȠҮΠȯȠҮΠŠΠ̠ͮԠŠԠĠƠҮΠΠԯԠҍΠΠԯԠҮԠĠΠŠһΠĠ׮ԠŠȠĠƠҮΠŠŮԠŠ͠ƠŠŠԠŠ͠ƠŠŠΠΠԯԠҮΠԭλůנĠȮΠΠԯԠҮΠŠŠҮΠȯȠҮΠȯȠҮΠӯŠĠΠŠҮΠԭλίӠĠōΠԯԠҮΠԭλίӠĠ׮ԠŠȠĠƠҮΠŠŠҮΠŠȠŮΠŠŠƠŠŠΠȯȠҮΠȯȠҮΠȯȠҮԠŠȠĠƠҮΠŠŠҠҠˍΠŠ͠ӠӮΠȯȠҮԠȠĠƠҮΠŠǠͮΠΠԯԠҮΠҭ٠΍ΠΠԯԠҍԠԠĠƠҮΠŠ͠ήΠŠΠҠˮΠΠůנҠȠŠō                     HE":" 'EAMON MASTER DISKETTE'.":::DK$;"CLOSE":9"YOU ARE EQUIPPED WITH A LIGHT-SABRE.":::"(HIT ANY KEY TO CONTINUE) ";:A$: :5:"GOOD LUCK, ";N$:::DK$;"RUN DEATH STAR2"  (222)5ĺDK$;"CLOSE"5:5:"I'M SORRY, BUT YOU MUST ONLY ENTER THIS PROGRAM FROM THE MAIN HALL OF T"WHICH HAS JUST BEEN DRAGGED INTO THE" Z"EMPIRE'S EVIL MACHINE OF DESTRUCTION,THE":"DEATH STAR! TO ESCAPE, YOU WILL HAVE TO":"FIND DESTROY THE EQUIPMENT IN EITHER THE":"TRACTOR BEAM MACHINERY SECTION, OR THE":"POWER MACHINERY ROOM."::R dAME.":"HOWEVER, NONE OF YOUR OLD SPELLS WILL":"WORK."::v F"(HIT ANY KEY TO CONTINUE) ";:A$::A$(27)900+ P"BY SEARCHING NEW 'MEMORIES', YOU FIND":"OUT YOUR SITUATION, WHICH ISN'T GOOD!":::"YOU ARE ABOARD THE MILLENIUM FALCON,":UGH A REALITY SHIFT!":::"(HIT ANY KEY TO CONTINUE) ";:A$::A$(27)900 7"YOU ARE IN A PARALLEL UNIVERSE. YOU MUST":"STAY IN THIS UNIVERSE UNTIL YOU FULLFILL":"SOME QUEST. ALTHOUGH YOU HAVE NO ACCESS"> <"TO YOUR OLD GEAR, YOUR BODY IS THE S HALL, YOU SUDDENLY":"FELT A QUEER WRENCH IN YOUR STOMACH, AS":"IF YOU HAD BEEN TURNED INSIDE-OUT, THEN" ("RIGHT AGAIN. WHEN THINGS BECAME CLEAR":"AGAIN, YOU FOUND YOURSELF AT THE HELM OF":"A SPACESHIP! YOU REALIZE YOU HAVE GONE"M 2"THRO6 EAMON ADVENTURE #6<-> THE DEATH STAR <-B[ BY DONALD BROWNa| START-UP PROGRAM 1000DK$(4):DK$;"OPEN FRESH MEAT":DK$;"READ FRESH MEAT":REC,N$DK$;"CLOSE"m ::"AS YOU LEFT THE MAIN     ԍ͍ԍōǠҍŠōԍ͍ԍōǠҍŠō