`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JN^OP.TEXTgEPICYCLOID.TEXT7 HYPO.THREE.TEXT7 CYL.TEXTr=vgG RND.SORT.TEXTvgRANDOMPLOT.TEXTPRINT.OUT.TEXTg젵SHELL.SORT.TEXT FIGURE.TEXTvgաCOLOR.BAR.TEXTg POLOR.EX.TEXTvgFREALSTR.PC.TEXTPOLORGRAPH.TEXTPOLORLOIuMUD.CODErE^oI SIEVE.CODEE^o FILEIO.TEXT^of FILEIO.CODE^ofLCM.TEXTrE^o;LCM.CODErE^o; GCD2.CODErE^oy GCD2.TEXTrE^oy README.TEXT SIEVE.TEXTWPSCAL03   DRAWLINE.TEXT^o  DRAWLINE.CODE^o& MOTGEN.TEXT^o&. MOTGEN.CODE^o.>MUD.GUIDE.TEXToH>H MUD.PROC.TEXT^oHHK MUD.PROC.CODE^oHKS MORE.MUD.TEXT^oSuMUD.TEXTrE^o&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&PROGRAM DRAWLINE;   USES TURTLEGRAPHICS;   VAR XA,XB,YA,YB:INTEGER;  S:STRING;   PROCEDURE PLOT (X,Y:INTEGER); #  BEGIN # #PENCOLOR(BLACK); #MOVETO(X,Y); #PENCOLOR(WHITE); #MOVE(1); #  END (* PLOT *);   PROCEDURE DDA(X1,Y1,X2,Y2:A B ]O^ENTINUEPNjǴP Z>ƂƂ۾ .TEXTƂƂƂȍƂƂ.˄%Ƃ̂.Ƃ.ƂPƂ..TEXTUƂ.PƂƂ.á ƂƂƂצ*SYSTEM.WRK.TEXTPەڕšڕ ە݊ڕ݊ ۳o? ڳS?ȡ/     6  2ljZצDRAWN BY THE POINTצPUSH TO CO"0*` DRAWLINE  S := 'PUSH TO CONTINUE';  MOVETO(139-7*(LENGTH(S) DIV 2),180);  WSTRING(S);   READLN(S);  TEXTMODE;   END.  INCREMENT; *Y := Y+YINCREMENT; *END   END (* DDA *);   BEGIN (* MAIN PROGRAM *)   INITTURTLE;   XA := 10; YA := 10;  XB := 250; YB := 50;   DDA(XA,YA,XB,YB);  MOVETO(137,90);  WSTRING('DRAWN BY THE POINT');  PENCOLOR(NONE);   BEGIN $ $LENGTH := ABS(X2-X1); $IF ABS(Y2-Y1)>LENGTH THEN (LENGTH := ABS(Y2-Y1); $XINCREMENT := (X2-X1)/LENGTH; $YINCREMENT := (Y2-Y1)/LENGTH; $X := X1 + 0.5 ; Y := Y1 + 0.5; $FOR I := 1 TO LENGTH DO (BEGIN *PLOT(TRUNC(X),TRUNC(Y)); *X := X+XINTEGER); " "(* PROGRAM FROM 'PRINCIPLES OF %INTERACTIVE COMPUTER GRAPHICS' BY %NEWMAN AND SPROULL % %ENTERED 9 OCT 80 BY LEE MEADOR %WITH ACCOMPANYING ROUTINES TO %CALL IT, ETC. *) % "VAR LENGTH,I:INTEGER; &X,Y,XINCREMENT,YINCREMENT:REAL; &  (*$G+*)  PROGRAM MOTGEN;  (*********************************************************)  (* *)  (* DISKIO PROGRAM MODIFIED TO GENERATE MACHINE OPCODE *)  (* TABLE (MOT) TO BE USED BY THE MUD DISTRING ENTERED, DEFAULT AND PRINT PREVIOUS VALUE. *)  (* *)  (***************************************************************)  VAR S1: STRING[1];  STEMP: STRING[80];  OKSET: SET OF RING(VAR S: STRING; MAXLEN: INTEGER);  (***************************************************************)  (* *)  (* GET AND ECHO A STRING UP TO MAXLEN CHARS LONG. *)  (* IF NULL  GOOD: BOOLEAN;  BEGIN  REPEAT $READ(KEYBOARD,CH); $IF EOLN(KEYBOARD) THEN CH:=CHR(13); $GOOD:= CH IN OKSET; $IF NOT GOOD THEN WRITE(CHR(7)) &ELSE IF CH IN [' '..'}'] THEN WRITE(CH); "UNTIL GOOD; "GETCHAR:=CH;  END;    PROCEDURE GETST *)  (* GET A CHARACTER, BEEP IF NOT IN OKSET, ECHO ONLY IF PRINTING *)  (* *)  (******************************************************************)  VAR CH: CHAR; AT(Y: INTEGER; S: STRING);  BEGIN "GOTOXY(0,Y); "WRITE(S); "CRT(ERASEOL);  END;    FUNCTION GETCHAR(OKSET: SETOFCHAR): CHAR;  (******************************************************************)  (* *)  (*****************************************************************)  BEGIN "IF PREFIXED[C] THEN UNITWRITE(1,CRTINFO[LEADIN],1,0,12); "UNITWRITE(1,CRTINFO[C],1,0,12);  END;    PROCEDURE PROMPTPROCEDURE CRT(C: CRTCOMMAND);  (*****************************************************************)  (* *)  (* CRT COMMANDS ARE: ERASEOS,ERASEOL,UP,DOWN,RIGHT,LEFT. *)  (* :=BUFFER[66]; PREFIXED[RIGHT]:=ODD(BYTE DIV 2); "CRTINFO[UP]:=BUFFER[67]; PREFIXED[UP]:=ODD(BYTE); "CRTINFO[LEFT]:=BUFFER[68]; PREFIXED[LEFT]:=ODD(BYTE DIV 32);  CRTINFO[DOWN]:=CHR(10); PREFIXED[DOWN]:=FALSE;  END;    D(BUFFER[72]); (* PREFIX INFORMATION BYTE *) "CRTINFO[LEADIN]:=BUFFER[62]; PREFIXED[LEADIN]:=FALSE; "CRTINFO[ERASEOS]:=BUFFER[64]; PREFIXED[ERASEOS]:=ODD(BYTE DIV 8); "CRTINFO[ERASEOL]:=BUFFER[65]; PREFIXED[ERASEOL]:=ODD(BYTE DIV 4);  CRTINFO[RIGHT] *)  (****************************************************************)  VAR BUFFER: PACKED ARRAY[0..511] OF CHAR; $I,BYTE: INTEGER;  F: FILE;  BEGIN "RESET(F,'*SYSTEM.MISCINFO'); "I:=BLOCKREAD(F,BUFFER,1); "CLOSE(F); "BYTE:=OR (****************************************************************)  (* *)  (* READ SYSTEM.MISCINFO AND GET CRT CONTROL CHARACTER INFO *)  (* H: CHAR; $RECNUM: INTEGER; $LASTCHANGE: BOOLEAN; $DATAFILE: FILE OF OP;  CRTINFO: PACKED ARRAY[CRTCOMMAND] OF CHAR; $PREFIXED: ARRAY[CRTCOMMAND] OF BOOLEAN; $ $   PROCEDURE GETCRTINFO; **********)   CONST INDEXLEN=2; &TYPELEN=2; &  TYPE SETOFCHAR=SET OF CHAR;  CRTCOMMAND= (ERASEOS,ERASEOL,UP,DOWN,RIGHT,LEFT,LEADIN); %  (**OPCODE INFO FOR MOT**)  %OP=PACKED RECORD 1NAMEINDEX:1..57; 1ADDRSTYPE:1..14; /END;    VAR CSASSEMBLER *)  (* *)  (* *)  (* *)  (***********************************************CHAR;  BEGIN "OKSET:=[' '..'}']; "S1:=' '; "STEMP:=''; "REPEAT " IF LENGTH(STEMP) = 0 THEN S1[1]:=GETCHAR(OKSET + [CHR(13)]) &ELSE IF LENGTH(STEMP)=MAXLEN THEN S1[1]:=GETCHAR([CHR(13),CHR(8)]) -ELSE S1[1]:=GETCHAR(OKSET + [CHR(13),CHR(8)]); $IF S1[1] IN OKSET THEN STEMP:=CONCAT(STEMP,S1) &ELSE IF S1[1]=CHR(8) THEN (BEGIN *CRT(LEFT); WRITE(' '); CRT(LEFT); *DELETE(STEMP,LENGTH(STEMP),1); (END; "UNTIL S1[1] = CHR(13); "IF LENGTH(STEMP) <> 0 THEN S:=STEMP "ELSE WRITE(S);  END;   * CHANGEREC *) " "  PROCEDURE NEWFILE;  VAR SUCESSFUL: BOOLEAN; $FILENAME: STRING[30];  IREC,MAXREC: INTEGER;  BEGIN "CLOSE(DATAFILE,LOCK); (* IN CASE IT'S ALREADY OPEN *) "(*$I-*) "REPEAT $GOTOXY(0,1); CRT(ERASEOS); $PROMPTAT(8,'File NameINDEX:=INDEX; &WRITELN; & &REPEAT 'CRT(ERASEOL);WRITE('ADDRSTYPE: '); 'GETSTRING(SADDRSTYPE,TYPELEN);WRITELN; 'CRT(UP); 'ATYPE:=INT(SADDRSTYPE); &UNTIL ((ATYPE<=14) AND (ATYPE>0)) -OR (LENGTH(SADDRSTYPE)=0); &ADDRSTYPE:=ATYPE; $END;  END; ( (**READ IN INTEGER THEN CONVERT TO SCALAR SUBRANGE**) & &REPEAT 'CRT(ERASEOL);WRITE('NAMEINDEX: '); 'GETSTRING(SNAMEINDEX,INDEXLEN);WRITELN; 'CRT(UP); 'INDEX:=INT(SNAMEINDEX); &UNTIL ((INDEX<=57) AND (INDEX>0)) , OR (LENGTH(SNAMEINDEX)=0); &NAME,ATYPE:INTEGER;   BEGIN "GOTOXY(0,12); CRT(ERASEOS); "PROMPTAT(12,'NAMEINDEX 1..57, ADDRSTYPE 1..14'); "WITH REC DO $BEGIN &GOTOXY(0,14); &STR(NAMEINDEX,SNAMEINDEX); &STR(ADDRSTYPE,SADDRSTYPE);  'IMP'); '9:WRITELN('IND'); '10:WRITELN('REL'); '11:WRITELN('ZER'); '12:WRITELN('ZERX'); '13:WRITELN('ZERY'); '14:WRITELN('NI'); &END; (*CASE*) #END;  END;    PROCEDURE CHANGEREC(VAR REC: OP);   VAR SNAMEINDEX,SADDRSTYPE:STRING;  INDEXWRITELN('Name : ',COPY(NAMETABLE,3*NAMEINDEX-2,3)); &WRITE('ADDRSTYPE: '); &CASE ADDRSTYPE OF '1:WRITELN('ABS'); '2:WRITELN('ABSX'); '3:WRITELN('ACC'); '4:WRITELN('ABSY'); '5:WRITELN('INDX'); '6:WRITELN('INDY'); '7:WRITELN('IMM'); '8:WRITELN("NAME3:='PLPROLRORRTIRTSSBCSECSEDSEISTASTXSTYTAXTAYTSXTXATXSTYA???'; "NAMETABLE:=CONCAT(NAME1,NAME2,NAME3); " "GOTOXY(0,4); CRT(ERASEOS); "WITH REC DO $BEGIN   (**CONVERT NAMEINDEX TO LITERAL NAME**)  (**AND ADDRSTYPE TO LITERAL TYPE **) $ &$INDEX:INTEGER;   BEGIN   (**STRING LITERALS MUST BE <= 80 CHARS**)  "NAME1:='ADCANDASLBCCBCSBEQBITBMIBNEBPLBRKBVCBVSCLCCLDCLICLVCMPCPX'; "NAME2:='CPYDECDEXDEYEORINCINXINYJMPJSRLDALDXLDYLSRNOPORAPHAPHPPLA'; $BEGIN &CH:=STRNUM[STRPTR]; &DIGIT:=(ORD(CH)-ORD('0')); &N:=N+(DIGIT*POWEROFTEN); &STRPTR:=STRPTR-1; &POWEROFTEN:=POWEROFTEN*10; $END; "INT:=N;  END; $   PROCEDURE SHOWREC(REC: OP);   VAR NAMETABLE:STRING[171]; $NAME1,NAME2,NAME3:STRING; AM**) &DUMMY:=ADDRSTYPE; &CHECK(DUMMY,14); $END;  END; (* VALIDATE *)    FUNCTION INT(STRNUM:STRING):INTEGER;   VAR DIGIT,N,POWEROFTEN,STRPTR:INTEGER; $CH:CHAR; $  BEGIN "POWEROFTEN:=1; "STRPTR:=LENGTH(STRNUM); "N:=0; "WHILE STRPTR>0 DO "(**IS NUMBER TOO LARGE?**) " $IF I>MAXVAL THEN %BEGIN 'ZEROREC(REC); EXIT(VALIDATE); %END; " "END; (* CHECK *) "  BEGIN (* VALIDATE *) "WITH REC DO $BEGIN $ DUMMY:=NAMEINDEX; (**CONVERT TO INTEGER**) &CHECK(DUMMY,57); (**THEN PASS AS PARLDS ARE VALID. *)  (* *)  (*********************************************************) " "VAR DUMMY:INTEGER; " "PROCEDURE CHECK(VAR I:INTEGER; MAXVAL: INTEGER); "BEGIN " D;    PROCEDURE VALIDATE(VAR REC: OP);  (*********************************************************)  (* *)  (* TRIES TO DETECT AND ZERO AN UNINITIALIZED RECORD *)  (* NO CHANGE IF ALL FIE FUNCTION YES: BOOLEAN;  BEGIN "YES:= GETCHAR(['Y','y','N','n']) IN ['Y','y'];  END;    PROCEDURE ZEROREC(VAR REC: OP);  BEGIN "WITH REC DO $BEGIN &NAMEINDEX:=57; (** 57='???' **) &ADDRSTYPE:=14; (** 14='NI' (NOT IMPLEMENTED) **) $END;  EN: '); READLN(FILENAME); $RESET(DATAFILE,FILENAME); (* TRY TO OPEN AN OLD FILE *) $SUCESSFUL := (IORESULT=0); $IF NOT SUCESSFUL THEN (* START A NEW FILE? *) &BEGIN (PROMPTAT(10,'Start a new file ? '); (IF YES THEN *BEGIN ,REWRITE(DATAFILE,FILENAME); ,PROMPTAT(12,'Reserve how many records ? '); ,READLN(MAXREC); ,SEEK(DATAFILE,MAXREC); ,ZEROREC(DATAFILE^); ,(*$I-*) ,PUT(DATAFILE); ,(*$I+*) ,IF (IORESULT<>0) OR EOF(DATAFILE) THEN .BEGIN 0PROMPTAT(14,'Not enough roƁƂ/Ɓצ*SYSTEM.MISCINFOƁ́ƁH́3>73@7ʁ3A7ʁ3B7ʁ3C7ʁ3D"* DISKIO D.   (['N','n','F','f','V','v','C','c','Q','q']); $CRT(ERASEOS); $CASE CH OF &'N','n': NEXT; &'F','f': NEWFILE; &'V','v': VIEW; &'C','c': CHANGE; $END; "UNTIL CH IN ['Q','q']; " "CLOSE(DATAFILE,LOCK);  PROMPTAT(12,'THAT''S ALL FOLKS...');  ENRITELN('Use Filer K(runch command to make space after file.'); (END; $END;  END; " "  BEGIN (* MAIN PROGRAM *) "GETCRTINFO; "GOTOXY(0,0); CRT(ERASEOS); "NEWFILE; "REPEAT $PROMPTAT(0,'>DISKIO: V(iew, C(hange, N(ext, F(ile, Q(uit '); $CH:=GETCHAR IF LASTCHANGE THEN $BEGIN &CHANGEREC(DATAFILE^); &SEEK(DATAFILE,RECNUM); &(*$I-*) &PUT(DATAFILE); $ (*$I+*) &IF (IORESULT<>0) OR EOF(DATAFILE) THEN (BEGIN *GOTOXY(0,20); *WRITELN(CHR(7),'UNABLE TO EXTEND FILE, NO DATA WRITTEN'); $ W $BEGIN &ZEROREC(DATAFILE^); &IF NOT LASTCHANGE THEN (BEGIN *GOTOXY(0,4); *WRITE('Record ',RECNUM,' not in file.'); ( EXIT(NEXT); (END; $END;  GOTOXY(0,2); WRITE('Record number ',RECNUM); "VALIDATE(DATAFILE^); "SHOWREC(DATAFILE^); END "ELSE $BEGIN &VALIDATE(DATAFILE^); &SHOWREC(DATAFILE^);  END; "LASTCHANGE:=FALSE;  END; " "  PROCEDURE NEXT;  (* VIEW OR CHANGE NEXT RECORD *)  BEGIN "RECNUM:=RECNUM+1; "SEEK(DATAFILE,RECNUM); "GET(DATAFILE); "IF EOF(DATAFILE) THEN VIEW;  BEGIN "(*$I-*) "REPEAT $PROMPTAT(2,'View which record ? '); $READLN(RECNUM); "UNTIL IORESULT=0; "(*$I+*) "SEEK(DATAFILE,RECNUM); "GET(DATAFILE); "IF EOF(DATAFILE) THEN $BEGIN &GOTOXY(0,4); &WRITE('Record ',RECNUM,' not in file.'); $ (*$I+*) "IF (IORESULT<>0) OR EOF(DATAFILE) THEN $BEGIN &GOTOXY(0,20); &WRITELN(CHR(7),'UNABLE TO EXTEND FILE, NO DATA WRITTEN'); &WRITELN('Use Filer K(runch command to make space after file.'); $END; "LASTCHANGE:=TRUE;  END; "   PROCEDURETIL IORESULT=0; "(*$I+*) "SEEK(DATAFILE,RECNUM); "GET(DATAFILE); "IF EOF(DATAFILE) THEN (* EXTENDING FILE *) ZEROREC(DATAFILE^); "VALIDATE(DATAFILE^); "SHOWREC(DATAFILE^); "CHANGEREC(DATAFILE^); "SEEK(DATAFILE,RECNUM); "(*$I-*) "PUT(DATAFILE); LENAME); . SUCESSFUL := (IORESULT = 0); .END; & END; &END; "UNTIL SUCESSFUL; "(*$I+*) "RECNUM:=-1;  LASTCHANGE:=FALSE;  END;    PROCEDURE CHANGE;  BEGIN "(*$I-*) "REPEAT $PROMPTAT(2,'Change which record ? '); $READLN(RECNUM); "UNom. Press return '); 0READLN; 0SUCESSFUL:=FALSE; .END ,ELSE .BEGIN 0(* INITIALIZE CONTENTS OF FILE *) 0FOR IREC:=0 TO MAXREC DO 2BEGIN 4SEEK(DATAFILE,IREC); 4PUT(DATAFILE); 2END; 0CLOSE(DATAFILE,LOCK); (* LOCK IT IN PLACE *) 0RESET(DATAFILE,FI7ʁ 3 7ƁT 27 3 3 .تPR    #? `$ h-? צPá- 0á - -==P=Q=P#á  áˡP  @@O^H THAT'S ALL FOLKS...1 )v#HN@T  . P ~  F "&UNABLE TO EXTEND FILE, NO DATA WRITTEN3Use Filer K(runch command to make space after file. P2צ->DISKIO: V(iew, C(hange, N(ext, F(ile, Q(uit BH@BH@{wsoCvh  - "$&5*,.02468:<>@KDFYJLNPRTVmZ\^`bdfu not in file.Record number  "˥ &UNABLE TO EXTEND FILE, NO DATA WRITTEN3Use Filer K(runch command to make space after file. View which record ?  "á =צRecord   not in file.  F쓡?צRecord  K(BChange which record ?  "á  "˥ &UNABLE TO EXTEND FILE, NO DATA WRITTEN3Use Filer K(runch command to make space after file."ؓ צStart a new file ?  צReserve how many records ?  "˥ 1צNot enough room. Press return ?ȡ"ء,+P VP צ NAMEINDEX: ++ UU9Uń+ÍVU9צ ADDRSTYPE:  TTTńÍVTP   File Name: צRELZERoצZERXUצZERY;צNI#jS;$ iQ9'    NAMEINDEX 1..57, ADDRSTYPE 1..14VV ADDRSTYPE: ABSצABSXצACCABSYINDXINDYIMMצIMPINDBVCBVSCLCCLDCLICLVCMPCPXPƀ9CPYDECDEXDEYEORINCINXINYJMPJSRLDALDXLDYLSRNOPORAPHAPHPPLAתPY9PLPROLRORRTIRTSSBCSECSEDSEISTASTXSTYTAXTAYTSXTXATXSTYA???תP̀ƀƀPƀƀǠƀYƀժצ Name : ƀƀ 899š   9  " ڪP.-/-š&-1100/0./--. ./3\ L بƀצ9ADCANDASLBCCBCSBEQBITBMIBNEBPLBRK        BNE E03F )E010: F0 12 BEQ E024 )E012: 20 C7 DF JSR DFC7 )E015: 4C 61 E0 JMP E061 )E018: 20 C7 DF JSR DFC7 )E01B: B0 03 BCS E020 )E01D: 38 SEC )E01E: B0 01 BCS E021 )E020: 18 CLC )E021: 4C 61 E0 JMP E061 )E024: 20 70 DF JSR , Q(UIT   RESPONSE: T   PROMPT: STARTADDR[H] ==>   RESPONSE: E000   DISPLAY: E000: D0 03 BNE E005 )E002: 4C 12 E0 JMP E012 )E005: C9 06 CMP #06 )E007: D0 03 BNE E00C )E009: 4C 18 E0 JMP E018 )E00C: C9 03 CMP #03 )E00E: D0 2F  IN WHICH CASE BOTH THE STARTING AND ENDING ADDRESSES ARE SPECIFIED BY THE  USER. IF TWENTY LINES OF DISASSEMBLY STARTING AT E000 IS DESIRED, THEN THE  FOLLOWING EXCHANGE MIGHT TAKE PLACE:   PROMPT: >DISASSEM: T(WENTY LINES DISPLAY, O(UTPUT TO FILE    D(ISASSEM   THE DISASSEMBLER IS REACHED BY TYPING 'D' WHEN THE MUD PROMPT LINE IS  DISPLAYED. TWO OPTIONS ARE AVAILABLE INT THE DISASSEMBLE MODE: TWENTY LINES  MAY BE DISPLAYED ON THE VIDEO SCREEN, OR OUTPUT MAY BE DIRECTED TO A TEXTFILE, INDICATES THE PRESENT INPUT MODE TO BE HEXADECIMAL. CHANGING THE  RADIX TO DECIMAL CAN BE ACCOMPLISHED AS FOLLOWS:   PROMPT: >RADIX[H]: H(EX, D(EC   RESPONSE: D   PROMPT: >MUD:C(HANGE, D(ISASSEM, E(XAMINE, H(EXDUMP, R(ADIX[D], S(EARCH, Q(UIT GITS OR A DEC BYTE (0..255) WITH MORE THAN THREE DECIMAL  DIGITS.     R(ADIX[H]   THIS OPTION SPECIFIES THE RADIX OF THE STARTING AND ENDING ADDRESSES WHICH  MAY BE REQUIRED IN SOME OF THE OTHER OPTIONS. THE 'H' INSIDE THE SQUARE  BRACKETS TREATED THIS WAY SO THAT THE USER IS IMMEDIATELY MADE AWARE THAT HE IS  ATTEMPTING TO INPUT ILLEGAL SYMBOLS. FURTHERMORE, LEGAL LENGTH LIMITS ARE  ALSO ESTABLISHED. FOR EXAMPLE, MUD WILL NOT ACCEPT A HEXADECIMAL ADDRESS WITH  MORE THAN FOUR HEX DIE IS DISPLAYED, THE USER MAY SELECT ANY ONE OF THE  SEVEN OPTIONS LISTED BY TYPING C, D, E, H, R, S, OR Q. ALL OTHER CHARACTERS  ARE NOT ACCEPTED AND CAUSE A BELL TO RING. IN FACT, ALL ILLEGAL INPUT IS   MUD   THE ABOVE DIAGRAM GIVES A GENERAL OVER-VIEW OF THE COMMAND TREE STRUCTURE OF  MUD. WHEN EXECUTED, MUD DISPLAYS THE FOLLOWING PROMPT LINE:   >MUD: C(HANGE, D(ISASSEM, E(XAMINE, H(EXDUMP, RADIX[H], S(EARCH, Q(UIT   WHEN THIS PROMPT LIN  ^------- ------ ----- --- --- --- --- --- ----  ^TWENTY OUTPUT HEX & DEC HEX DEC HEX DEC CHAR  ^LINES FILE CHAR --- --- --- --- --- ----  ^DISPLAY ------ -----  ^-------    ^ DISASSEMBLE EXAMINE CHANGE SEARCH HEXDUMP  ^ ----------- ------- ------ ------ -------  ^  ^  ^  ^ ----------- ------- ------ ------ ------- ED SET OF ROUTINES DESIGNED  TO ALLOW THE USER TO EASILY ACCESS AND DIRECTLY MANIPULATE MEMORY UNDER THE  PASCAL OPERATING SYSTEM.   ?^---------------- ?^MUD COMMAND TREE ?^----------------  ^  ^            APPLE PASCAL MEMORY UTILITY DELIGHT  -----------------------------------  USER'S GUIDE BY RON DEGROAT    THE MEMORY UTILITY DELIGHT (MUD) IS A SELF-CONTAINDF70 )E027: A6 74 LDX 74 )E029: A4 7E LDY 7E )E02B: F0 0C BEQ E039    S(EARCH   THE SEARCH MODE IS INITIATED BY TYPING 'S' WHILE THE MUD PROMPT LINE IS  VISIBLE. THE USER MAY SEARCH MEMORY FOR A HEX, DEC, OR CHAR SEQUENCE OF TWO  OR THREE.   EXAMPLE:   PROMPT: >SEARCH[3]: H(EX, D(EC, C(HAR, Q(UIT   THE THREE INSIDE THE SQUARE BRACKETS INDICATES THE SEARCH IS SET FOR A  SEQUENCE OF THREE VALUES. SUPPOSE THE USER ONLY WANTS TO LOOK FOR A SEQUENCE  OF TWO HEX VALUES (SN^ƠH USER RESPONDS BY TYPING IN THE HEX VALUE HE WOULD LIKE AT MEMORY LOCATION  D8E0. THE NEXT PROMPT WILL BE 'D8E1:'. HE MAY CONTINUE TO MAKE CHANGES OR  HE MAY TERMINATE THE SEQUENCE AT ANY TIME BY HITTING THE RETURN KEY.  SUPPOSE THE USER WANTS TO CHANGE THE CONTENTS OF D8E0. A DIALOGUE SOMETHING  LIKE THE FOLLOWING MIGHT TAKE PLACE.   PROMPT: >CHANGE: (PRESS TO TERMINATE OR QUIT)   PROMPT: STARTADDR[H] ==>   RESPONSE: D8E0   PROMPT: D8E0:   THEEMORY.    THE CHANGE MODE IS REACHED BY TYPING 'C' FOR C(HANGE WHILE AT THE MUD LEVEL.  ON ENTERING THE CHANGE MODE THE FOLLOWING PROMPT LINE APPEARS.   PROMPT: >CHANGE: (PRESS TO TERMINATE OR QUIT)  THE MUD PROMPT LINE IS VISIBLE.  STARTING WITH THE ADDRESS SPECIFIED BY THE USER, ONE HUNDRED AND SIXTY BYTES  OF MEMORY IS DISPLAYED UNDER A HEX & CHAR OR DECIMAL REPRESENTATION.    C(HANGE  THE CHANGE MODE ALLOWS THE USER TO DIRECTLY CHANGE MDE, THE USER IS PROMPTED FOR AN OUTPUT FILE NAME  (RESPONDING WITH 'CONSOLE:' CAUSES THE HEXDUMP TO BE DISPLAYED ON THE VIDEO  SCREEN). A STARTING AND ENDING ADDRESS MUST ALSO BE SPECIFIED.    E(XAMINE   TO REACH THIS OPTION, TYPE AN 'E' WHEN CONTAINS SOFT SWITCHES WHICH ACTIVATE DIFFERENT I/O FUNCTIONS, WHICH WOULD  OTHERWISE RESULT IN A LOSS OF NORMAL TEXT DISPLAY.     H(EXDUMP   THIS OPTION IS ACTIVATED BY TYPING 'H' WHEN THE MUD PROMPT LINE IS DISPLAYED.  UPON ENTERING THIS MO HAD NOT EXISTED, THE SEARCH WOULD HAVE CONTINUED UNTIL ALL OF MEMORY  HAD BEEN SEARCHED THROUGH, THEN THE PROCEDURE WOULD TERMINATE WITH 'SEQUENCE  NOT FOUND'. A SMALL PORTION OF MEMORY IS PURPOSELY SKIPPED OVER BECAUSE IT   DISPLAY: NOW SEARCHING MEMORY )(PRESS ANY KEY TO ABORT)  )********************************  )SEQUENCE F7 C9 )FOUND AT MEMORY LOCATION FF84 (IN HEX) )   IN THE ABOVE EXAMPLE, EACH STAR REPRESENTS 2000 MEMORY LOCATIONS. IF THE  SEQUENCEUCH AS C9F7, AN ADDRESS).   RESPONSE: 2   PROMPT: >SEARCH[2]: H(EX, D(EC, C(HAR, Q(UIT  RESPONSE: H   PROMPT: LOOK FOR THE SEQUENCE (FIRST ==>   RESPONSE: F7 (FOR ADDRESSES, LOBYTE COMES FIRST)  PROMPT: SECOND ==>   RESPONSE: C9  ;---------------------------------------  ;  ; THE FOLLOWING EXTERNAL PROCEDURES AND  ; FUNCTIONS ARE USED BY THE PROGRAM MEM  ;  ;---------------------------------------  ).MACRO POP ;POP RETURN ADDR )PLA )STA %1 )PLA )STA %1+1 ).ENDM ) END PHA ;PUSH LSB OF RESULT )PUSH RETURN )RTS ;RETURN TO PASCAL HOST ).END )  NOCARRY LDA ADDR+1 ;SKIP SOFT SWITCHES )CMP #0C0 ;FROM $C030 TO $C100 )BNE LOOP )LDA ADDR )CMP #30 )BCC LOOP )LDA #0C1 )STA ADDR+1 )LDA #00 )STA ADDR ) )CLC )BCC LOOP ;DO IT AGAIN )  ABORT LDA #00 ;MAKE RESULT FALSE  )LDA #0AA ;CHR($AA)='*' )STA 05A8,X ;12TH TEXT LINE )INX ;COLUMN COUNT )  NOSTAR LDA ADDR+1 ;IF MSB OF ADDR = )CMP ORIGIN+1 ;MSB OF ORIGIN )BNE NOCARRY )LDA ADDR ;THEN CHECK LSB )CMP ORIGIN )BEQ ABORT ;IF = THEN ABORT R ;BUMP LSB OF ADDR AND  BNE NOSTAR ;BRANCH IF NO CARRY ) )LDA KEYBD ;IF KEYPRESS )BMI ABORT ;THEN ABORT ) )INC ADDR+1 ;BUMP MSB OF ADDR ) )LDA ADDR+1 )AND #07 ;EVERY 2048 TIMES )CMP #07 ;PRINT STAR )BNE NOSTAR TCH )FIND SECOND ;ONLY IF 1ST MATCHES )LDA NOTHIRD ;IS THERE A 3RD? )CMP #01 )BEQ MATCH ;IF NOTHIRD THEN MATCH )FIND THIRD ;ELSE CHECK 3RD )  MATCH LDA #01 ;SET FOUND = TRUE )CLC ;AND GOTO END )BCC END )  NOMATCH INC ADD)PULL FIRST )PLA )STA ADDR )STA ORIGIN )PLA )STA ADDR+1 )STA ORIGIN+1 ) )LDA #00 ;PUSH MSB OF )PHA ;FUNCTION RESULT ) )TAX ;INITIALIZE X ONCE  LOOP LDY #00 ;INITIALIZE Y EACH TIME  )FIND FIRST ;CHECK FOR MA .EQU 18 ;STARTING ADDR OF SEARCH  KEYBD .EQU 0C000 ;KEYBOARD OUTPUT PORT ) )POP RETURN ;PASCAL RETURN ADDR ) )PLA ;DISCARD OFFSET )PLA )PLA )PLA ) )PULL NOTHIRD ;GET PARAMETERS )PULL THIRD ;AND STORE VALUES )PULL SECOND 0  ;---------------------------------------    ).FUNC FOUND,5 )  THIRD .EQU 12  SECOND .EQU 13 ;SEQUENCE TO SEARCH FOR  FIRST .EQU 15  NOTHIRD .EQU 14 ;IS THERE A THIRD NO.?  ADDR .EQU 16 ;CURRENT ADDR OF SEARCH  ORIGINTXA 'STA (2),Y 'PUSH RETURN 'RTS  ;---------------------------------------  ;FUNCTION FOUND(ADDR:INTEGER; FIRST,  ; SECOND,THIRD:BYTE;  ; NOTHIRD:BOOLEAN):BYTE;  ;(BYTE:0..255)  ;  ;WRITTEN BY RON DEGROAT 15-JUN-8 ; ROUTINE TO POKE A GIVEN VALUE INTO A  ; SPECIFIED MEMORY LOCATION  ;  ; PROCEDURE POKE(ADDR:INTEGER; VALUE:BYTE);  ;  ;---------------------------------------  '.PROC POKE,2 'POP RETURN 'PLA 'TAX 'PLA 'PLA 'STA 2 'PLA 'STA 3 'LDY #0 'R):BYTE;  ;  ;---------------------------------------   .FUNC PEEK,1 'POPF RETURN 'PLA 'STA 2 'PLA 'STA 3 'LDA #0 'PHA 'TAY 'LDA (2),Y 'PHA 'PUSH RETURN 'RTS    ;---------------------------------------  ; ND PARAMETER )LDA @ADDR,Y )CMP %1 )BNE NOMATCH )INY ).ENDM )  RETURN .EQU 10 ;PASCAL RETURN ADDR '  ;-------------------------------------  ;  ; ROUTINE TO PEEK AT CONTENTS OF  ; SPECIFIED MEMORY LOCATION  ;  ; FUNCTION PEEK(ADDR:INTEGE).MACRO POPF ;POP RETURN AND )POP %1 )PLA ;REMOVE OFSET )PLA )PLA )PLA ).ENDM ).MACRO PUSH ;PUSH RETURN ADDR )LDA %1+1 )PHA )LDA %1 )PHA ).ENDM ) ).MACRO PULL ;PULL & STORE PARAMETER )PLA )STA %1 )PLA ).ENDM ) ).MACRO FIND ;FI PEEK  (* CRT COMMANDS ARE: ERASEOS,ERASEOL,UP,DOWN,RIGHT,LEFT. *)  (*****************************************************************)  PROCEDURE CRT(C: CRTCOMMAND);  BEGIN "IF PREFIXED[C] THEN UNITWRITE(1,CRTINFO[LEADIN],1,0,12); "UNITWRITE(1,CR); "CRTINFO[LEFT]:=BUFFER[68]; PREFIXED[LEFT]:=ODD(BYTE DIV 32);  CRTINFO[DOWN]:=CHR(10); PREFIXED[DOWN]:=FALSE;  END;    (*****************************************************************) CRTINFO[ERASEOS]:=BUFFER[64]; PREFIXED[ERASEOS]:=ODD(BYTE DIV 8); "CRTINFO[ERASEOL]:=BUFFER[65]; PREFIXED[ERASEOL]:=ODD(BYTE DIV 4);  CRTINFO[RIGHT]:=BUFFER[66]; PREFIXED[RIGHT]:=ODD(BYTE DIV 2); "CRTINFO[UP]:=BUFFER[67]; PREFIXED[UP]:=ODD(BYTEACKED ARRAY[0..511] OF CHAR; $I,BYTE: INTEGER;  F: FILE;  BEGIN "RESET(F,'*SYSTEM.MISCINFO'); "I:=BLOCKREAD(F,BUFFER,1); "CLOSE(F); "BYTE:=ORD(BUFFER[72]); (* PREFIX INFORMATION BYTE *) "CRTINFO[LEADIN]:=BUFFER[62]; PREFIXED[LEADIN]:=FALSE; " $  (****************************************************************)  (* READ SYSTEM.MISCINFO AND GET CRT CONTROL CHARACTER INFO *)  (****************************************************************)   PROCEDURE GETCRTINFO;   VAR BUFFER: PN^PEEK PEEK POKE POKE FOUND FOUND  hhhhhhhhHHHH`&hhhhhhHH`$hhhhhhhhhhhhhhhhHȱȥȩ>03)г0HHH`'II.0 [d.4]TINFO[C],1,0,12);  END;    (***********************************)  (* PRINT LINE AT SPECIFIED Y COORD *)  (***********************************)   PROCEDURE PROMPTAT(Y: INTEGER; S: STRING);  BEGIN "GOTOXY(0,Y); "WRITE(S); "CRT(ERASEOL);  END;    (******************************************************************)  (* GET A CHARACTER, BEEP IF NOT IN OKSET, ECHO ONLY IF PRINTING *)  (******************************************************************)   FUNCTION GETCHAR(OKSET: SETOFCH PROCEDURE MOVEBANK2;  EXTERNAL; $  (*$IMORE.MUD.TEXT*)   (************************************)  (* CONVERT HEX (STRING) TO INTEGER *)  (************************************)   FUNCTION XINT(STRNUM:STRING):INTEGER;   VAR DIGIT,N,POWER,STRPUTINES STORED IN MUD.PROC*)  (* FILE MUST BE L(INKED MANUALLY *)   FUNCTION PEEK(M:INTEGER):BYTE;  EXTERNAL;   PROCEDURE POKE(M:INTEGER;N:BYTE);  EXTERNAL;   FUNCTION FOUND(A:INTEGER; F,S,T:BYTE; N:BOOLEAN):BOOLEAN;  EXTERNAL;  G; $ $CHRSET,OKSET,HEXSET,DECSET,SAVESET:SET OF CHAR; $ $CRTINFO: PACKED ARRAY[CRTCOMMAND] OF CHAR; $PREFIXED: ARRAY[CRTCOMMAND] OF BOOLEAN; $ $F:INTERACTIVE; $FILENAME:STRING[20]; $SADDR:STRING[6]; (*ADDR IN STRING FORM*) $ (* EXTERNAL ROD; % %CRTCOMMAND= (ERASEOS,ERASEOL,UP,DOWN,RIGHT,LEFT,LEADIN); %  VAR CH,INPUTMODE:CHAR; $I,MEMADDR,ENDADDR,SLEN,LINE:INTEGER; $ $M:FILE; $MOTNEEDED:BOOLEAN; $OPCODE:PACKED ARRAY[0..255] OF OP; $ $NAMETABLE:STRING[171]; $NAME1,NAME2,NAME3:STRIN  PROGRAM MUD;   CONST XDIGITS='0123456789ABCDEF'; &  TYPE SETOFCHAR=SET OF CHAR; %BYTE=0..255; %TYPES=1..14; (*ADDR TYPES*) %INDICES=1..57; (*NAME INDICES*) %LONG=INTEGER[6]; % %OP=PACKED RECORD 'NAMEINDEX:INDICES; 'ADDRSTYPE:TYPES; &ENA A1 A2 B8N^ILETE(STEMP,LENGTH(STEMP),1); (END; "UNTIL S1[1] = CHR(13); "IF LENGTH(STEMP) <> 0 THEN S:=STEMP "ELSE EXIT(DOIT);  END;   [CHR(13)]) &ELSE IF LENGTH(STEMP)=MAXLEN THEN S1[1]:=GETCHAR([CHR(13),CHR(8)]) -ELSE S1[1]:=GETCHAR(OKSET + [CHR(13),CHR(8)]); $IF S1[1] IN OKSET THEN STEMP:=CONCAT(STEMP,S1) &ELSE IF S1[1]=CHR(8) THEN (BEGIN *CRT(LEFT); WRITE(' '); CRT(LEFT); *DE***********************************************)   PROCEDURE GETSTRING(VAR S: STRING; MAXLEN: INTEGER);   VAR S1: STRING[1];  STEMP: STRING[80];   BEGIN "S1:=' '; "STEMP:=''; "REPEAT " IF LENGTH(STEMP) = 0 THEN S1[1]:=GETCHAR(OKSET +"GETCHAR:=CH;  END;    PROCEDURE DOIT; FORWARD;    (********************************************************)  (* GET AND ECHO A STRING UP TO MAXLEN CHARS LONG. *)  (* IF NULL STRING ENTERED, THEN RETURN TO OUTER LEVEL *)  (*********AR): CHAR;   VAR CH: CHAR;  GOOD: BOOLEAN;   BEGIN  REPEAT $READ(KEYBOARD,CH); $IF EOLN(KEYBOARD) THEN CH:=CHR(13); $GOOD:= CH IN OKSET; $IF NOT GOOD THEN WRITE(CHR(7)) &ELSE IF CH IN [' '..'}'] THEN WRITE(CH); "UNTIL GOOD; TR:INTEGER; $S1:STRING[1]; $  BEGIN " "POWER:=1; "STRPTR:=LENGTH(STRNUM); "N:=0; "S1:='0'; " "WHILE STRPTR>0 DO $BEGIN &S1[1]:=STRNUM[STRPTR]; &DIGIT:=POS(S1,XDIGITS)-1; &N:=N+(DIGIT*POWER); &STRPTR:=STRPTR-1; &POWER:=POWER*16; $END; "XINT:=N;  END;    (***************************************)  (* CONVERT DECIMAL (STRING) TO INTEGER *)  (***************************************)   FUNCTION DINT(STRNUM:STRING):INTEGER;   VAR DIGIT,N,POWER,STRPTR:INTEGER; $CH:CHAR; $NEG:BOOLEA"I:=I+OFFSET+1; "  END; (*DECODE*)   (***********************************)  (* GETS MACHINE OPCODE TABLE (MOT) *)  (***********************************)   PROCEDURE GETOPCODES;   BEGIN !PROMPTAT(0,'READING MACHINE OPCODE TABLE...');CRT(ERAS SYMBOLIC ADDRESSING MODE*) & #ADDRSMODE(ADDRSTYPE,LOBYTE,HIBYTE);   (*ADJUST LOCATION COUNTER*) " "IF ADDRSTYPE IN SETOF2BYTES THEN OFFSET:=2 #ELSE IF NOT (ADDRSTYPE IN SETOFNOBYTE) THEN OFFSET:=1 $ELSE OFFSET:=0; $ "END; (*WITH*) " *PRINT MNEMONIC NAME*) # #WRITE(F,COPY(NAMETABLE,NAMEINDEX*3-2,3)); #  (*IF RELATIVE ADDR THEN CALCULATE EFF. ADDR*) # #IF ADDRSTYPE=10 THEN $BEGIN %IF BYTE2>127 THEN &EA:=BYTE2-256+LC+2 &ELSE EA:=BYTE2+LC+2; %HEX(EA,LOBYTE); $END; &  (*PRINTE(F,' ') %ELSE #IF ADDRSTYPE IN SETOF2BYTES THEN $BEGIN %HEX(BYTE2,LOBYTE); %HEX(BYTE3,HIBYTE); %WRITE(F,' ',LOBYTE,' ',HIBYTE,' '); $END $ELSE (*JUST PRINT THE LOBYTE*) %BEGIN &HEX(BYTE2,LOBYTE); &WRITE(F,' ',LOBYTE,' '); %END; #  (! "BEGIN #IF I<0 THEN LC:=I+65536 $ELSE LC:=I; $  (*PRINT LOCATION AND HEX OPCODE*) # #HEX(LC,LOCATION); #HEX(BYTE1,HEXOPCODE); #WRITE(F,LOCATION:4,': ',HEXOPCODE); #  (*PRINT MACHINE CODE OPERANDS*) # #IF ADDRSTYPE IN SETOFNOBYTE THEN $WRITRING[2];  LC,EA:LONG; $OFFSET:INTEGER; $SETOFNOBYTE, $SETOF2BYTES:SET OF TYPES; $  BEGIN ! !SETOF2BYTES:=[1,2,4,9]; (*HAS 2 BYTE OPERAND*) !SETOFNOBYTE:=[3,8,14]; (*HAS NO OPERAND*)  LOBYTE:=''; !HIBYTE:=''; ! !WITH OPCODE[BYTE1] DO *********************)  (* DECODES AND PRINTS SYMBOLIC EQUIVALENT OF MACHINE CODE *)  (**********************************************************)  $  PROCEDURE DECODE(BYTE1,BYTE2,BYTE3:BYTE); "  VAR LOCATION:STRING[4]; $HEXOPCODE,HIBYTE,LOBYTE:STRITELN(F,' ',HIBYTE,LOBYTE); $10:WRITELN(F,' ',LOBYTE); $11:WRITELN(F,' ',LOBYTE); $12:WRITELN(F,' ',LOBYTE,',X'); $13:WRITELN(F,' ',LOBYTE,',Y'); $14:WRITELN(F); #END; (*CASE*)  END; (*ADDRSMODE*)    (*************************************$1:WRITELN(F,' ',HIBYTE,LOBYTE); $2:WRITELN(F,' ',HIBYTE,LOBYTE,',X'); $3:WRITELN(F,' A'); $4:WRITELN(F,' ',HIBYTE,LOBYTE,',Y'); $5:WRITELN(F,' (',LOBYTE,',X)'); $6:WRITELN(F,' (',LOBYTE,'),Y'); $7:WRITELN(F,' #',LOBYTE); $8:WRITELN(F); $9:WO X:=CONCAT('0',X);  END; (*HEX*)   (**********************************)  (* PRINT SYMBOLIC ADDRESSING MODE *)  (**********************************)   PROCEDURE ADDRSMODE(ADDRSTYPE:TYPES;LOBYTE,HIBYTE:STRING); !  BEGIN #CASE ADDRSTYPE OF (*CONVERT TO HEX THRU REPEATED DIVISION*) ! !REPEAT (*UNTIL DEC=0*) "DIVIDEND:=DEC DIV 16; "REMAINDER:=TRUNC(DEC-DIVIDEND*16); "HEXDIGIT:=COPY(XDIGITS,REMAINDER+1,1); "X:=CONCAT(HEXDIGIT,X); "DEC:=DEC DIV 16; !UNTIL DEC=0; ! !WHILE LENGTH(X)<2 D****************************)   PROCEDURE HEX(DEC:LONG; VAR X:STRING);   VAR DIVIDEND:LONG; $REMAINDER:INTEGER; $HEXDIGIT:STRING[1]; $  BEGIN !X:=''; !HEXDIGIT:='0'; !  (*CONVERT DEC TO POS EQUIVALENT*) ! !IF DEC<0 THEN DEC:=DEC+65536; ! &DIGIT:=(ORD(CH)-ORD('0')); &N:=N+(DIGIT*POWER); &STRPTR:=STRPTR-1; &POWER:=POWER*10; $END; " "IF NEG THEN DINT:=-N #ELSE $DINT:=N; $  END; (*DINT*) $   (***********************************)  (* CONVERT INTEGER TO HEX (STRING) *)  (*******N; $  BEGIN " "IF STRNUM[1]='-' THEN (*TAKE CARE OF NEG SIGN*) #BEGIN $DELETE(STRNUM,1,1); $NEG:=TRUE; #END $ELSE %NEG:=FALSE; " "POWER:=1; "N:=0; "STRPTR:=LENGTH(STRNUM); " "WHILE STRPTR>0 DO $BEGIN &CH:=STRNUM[STRPTR]; EOL); !RESET(M,'OPCODES'); !I:=BLOCKREAD(M,OPCODE,1,0); !CLOSE(M,NORMAL);   (*SET UP NAME TABLE*)  (*STRING LITERALS MUST BE <= 80 CHARS*)  "NAME1:='ADCANDASLBCCBCSBEQBITBMIBNEBPLBRKBVCBVSCLCCLDCLICLVCMPCPX'; "NAME2:='CPYDECDEXDEYEORINCINXINYJMPJSRLDALDXLDYLSRNOPORAPHAPHPPLA'; "NAME3:='PLPROLRORRTIRTSSBCSECSEDSEISTASTXSTYTAXTAYTSXTXATXSTYA???'; "NAMETABLE:=CONCAT(NAME1,NAME2,NAME3); "  END; (*GETOPCODES*) "  (***********************************************************)  (* GETS MEMORY ADD (*EQUIVALENT ASCII CHAR REPRESENTATIONS *) # #FOR J:=I TO I+7 DO $BEGIN %HEX(PEEK(MEMADDR+J),NEXTBYTE); %LINEOF8:=CONCAT(LINEOF8,' ',NEXTBYTE); %S1[1]:=CHR(PEEK(MEMADDR+J)); %ORDVAL:=ORD(S1[1]);   (*ELIMINATE CONTROL CHARACTERS*) % %CTRLCHR:=$NEXTBYTE:STRING[2]; $S1:STRING[1]; $ORDVAL,J:INTEGER; $CTRLCHR:BOOLEAN; !  BEGIN !S1:=' '; !WHILE I<160 DO "BEGIN #HEX(MEMADDR+I,LINEOF8); #LINEOF8:=CONCAT(LINEOF8,':'); #LINEOFCH:=' '; #  (*GENERATE LINE OF 8 HEX BYTES AND THEIR*) D; !UNTIL CH='Q'; %  END; (*DISASSM*)  (**********************************************)  (* EXAMINE MEMORY AND DISPLAY IN HEX AND CHAR *)  (**********************************************)   PROCEDURE EXHEX;   VAR LINEOF8,LINEOFCH:STRING[40]; ISPLAY 20 LINES, O(UTPUT TO FILE,'); " WRITE(' S(ECOND BANK, Q(UIT'); "CH:=GETCHAR(['D','O','S','Q']); "IF CH<>'Q' THEN " BEGIN $CRT(ERASEOS); $ $CASE CH OF $'D':DISPLAY; $'O':OUTDISASSEM; $'S':SECONDBANK; $END; (*CASE*) $ $CLOSE(F,LOCK); #EN (*******************************)  (* OUTER LEVEL OF DISASSEMBLER *)  (*******************************)   PROCEDURE DISASSEM;   VAR CH:CHAR;   BEGIN " !IF MOTNEEDED THEN GETOPCODES; !MOTNEEDED:=FALSE; ! !REPEAT "PROMPTAT(0,'>DISASSEM: D(PLAY;   BEGIN !PROMPTAT(0,'STARTADDR['); !WRITE(INPUTMODE,'] ==> '); !GETMEMADDR; !I:=MEMADDR; !REWRITE(F,'CONSOLE:'); !FOR LINE:=1 TO 20 DO DECODE(PEEK(I),PEEK(I+1),PEEK(I+2)); !CLOSE(F,LOCK);  END; (*DISPLAY*) $  =ENDADDR) DO DECODE(PEEK(I),PEEK(I+1),PEEK(I+2)); #CLOSE(F,LOCK); # "END;  END; (*OUTDISASSEM*)    (***************************************)  (* DISPLAY TWENTY LINES OF DISASSEMBLY *)  (***************************************)   PROCEDURE DISITE(INPUTMODE,'] ==> '); #GETMEMADDR; #I:=MEMADDR; #PROMPTAT(4,'ENDADDR['); #WRITE(INPUTMODE,'] ==> '); #GETMEMADDR; #ENDADDR:=MEMADDR; # #FILENAME:=CONCAT(FILENAME,'.TEXT'); #CLOSE(F,LOCK); (*IN CASE IT'S OPEN*) #REWRITE(F,FILENAME); #WHILE (I< (* OUTPUT DISASSEMBLY TO TEXTFILE *)  (**********************************)   PROCEDURE OUTDISASSEM;   BEGIN !PROMPTAT(0,'>DISASSEM: OUTPUT FILE NAME ==> '); !READLN(FILENAME); !IF LENGTH(FILENAME)>0 THEN "BEGIN #PROMPTAT(2,'STARTADDR['); #WRADDR< 12288) THEN #VALID:=TRUE $ELSE %WRITE(CHR(7)); !UNTIL VALID; " !REWRITE(F,'CONSOLE:'); !WHILE (I<=ENDADDR) DO "DECODE(PEEK(I),PEEK(I+1),PEEK(I+2)); !CLOSE(F); !  END; (*SECONDBANK*)    (**********************************) =MEMADDR+20480; "IF (I>= 8192) AND (I< 12288) THEN #VALID:=TRUE $ELSE %WRITE(CHR(7)); !UNTIL VALID; ! !VALID:=FALSE; ! !REPEAT "PROMPTAT(4,'ENDADDR['); "WRITE(INPUTMODE,'] ==> '); "GETMEMADDR; "ENDADDR:=MEMADDR+20480; "IF (ENDADDR>I) AND (END ! !MOVEBANK2; (*FROM D000..DFFF TO 2000..2FFF*) !VALID:=FALSE; ! !REPEAT "PROMPTAT(0,'DISASSEMBLE SECOND 4K BANK (D000..DFFF)'); "PROMPTAT(1,'BY COPYING INTO 2000..3000'); "PROMPTAT(3,'STARTADDR['); "WRITE(INPUTMODE,'] ==> '); "GETMEMADDR; "I:#ELSE (*IT MUST BE DECIMAL*) $BEGIN %GETSTRING(SADDR,6); %MEMADDR:=DINT(SADDR); $END; "WRITELN;WRITELN;  END; (*GETMEMADDR*)    (* DISASSEMBLE 2ND 4K BANK LOCATED ON SYSTEM.APPLE *)   PROCEDURE SECONDBANK;   VAR VALID:BOOLEAN;   BEGINRESS (HEX OR DEC DEPENDING ON INPUTMODE) *)  (***********************************************************) "  PROCEDURE GETMEMADDR;   BEGIN "IF INPUTMODE='H' THEN (*IT MUST BE HEX*) #BEGIN $GETSTRING(SADDR,4); $MEMADDR:=XINT(SADDR); #END (ORDVAL<32) OR .((ORDVAL>127) AND (ORDVAL<160)); . %IF CTRLCHR THEN &S1:=' '; & %LINEOFCH:=CONCAT(LINEOFCH,S1); $END; $ #WRITE(LINEOF8,LINEOFCH); #WRITELN; #I:=I+8; "END; (*WHILE I<160*)  END; (*EXHEX*)    (*****************************************)  (* EXAMINE MEMORY AND DISPLAY IN DECIMAL *)  (*****************************************)   PROCEDURE EXDEC;   VAR J:INTEGER;   BEGIN !WHILE I<160 DO "BEGIN #WRITE(MEMADDR+I:6); #FOR J:=I TO I+7 DO #WRITE(PEEK(MEMADDR+J):4); # (**************************************************************)  (* CHANGES MEMORY BY POKING HEX VALUES INTO DESIRED LOCATIONS *)  (**************************************************************)   PROCEDURE CHANGE;   VAR VALUE:STRING[2];   BSEOL); !WRITE('>RADIX[',INPUTMODE,']: H(EX, D(EC'); !INPUTMODE:=GETCHAR(['H','D']); !IF INPUTMODE = 'H' THEN "BEGIN " OKSET:=HEXSET; #SLEN:=4; "END #ELSE $BEGIN %OKSET:=DECSET; %SLEN:=6; $END; !SAVESET:=OKSET;  END; (*RADIX*)   H='Q';  END; (*SEARCH*)    (**********************************************)  (* DEFINE INPUTMODE ACCORDING TO RADIX CHOSEN *)  (**********************************************)   PROCEDURE RADIX;   VAR CH:CHAR;   BEGIN !GOTOXY(0,0);CRT(ERARST:4,SSECOND:4); 'IF NOTHIRD=FALSE THEN (WRITELN(STHIRD:4) (ELSE )WRITELN; 'ADDR:=PEEK(23)*256+PEEK(22); 'HEX(ADDR,XADDR); 'WRITELN('FOUND AT MEMORY LOCATION ',XADDR,' (IN HEX)'); &END % %ELSE &WRITELN('SEQUENCE NOT FOUND'); & #END; !UNTIL C'END; # %PROMPTAT(8,'NOW SEARCHING MEMORY');WRITELN; %WRITE('(PRESS ANY KEY TO ABORT)'); %GOTOXY(0,13);   (*ACTUAL SEARCHING PERFORMED IN EXTERNAL PROCEDURE FOUND*) % %IF (FOUND(ADDR,FIRST,SECOND,THIRD,NOTHIRD))THEN &BEGIN 'WRITE('SEQUENCE',SFID:=XINT(SSECOND); 'THIRD:=XINT(STHIRD); &END & %ELSE &IF CH='D' THEN 'BEGIN (FIRST:=DINT(SFIRST); (SECOND:=DINT(SSECOND); (THIRD:=DINT(STHIRD); 'END ' &ELSE 'BEGIN (FIRST:=ORD(SFIRST[1]); (SECOND:=ORD(SSECOND[1]); (THIRD:=ORD(STHIRD[1]); RING(SSECOND,SLEN);WRITELN; %IF NOTHIRD=FALSE THEN &BEGIN 'WRITE('THIRD ==> '); 'GETSTRING(STHIRD,SLEN);WRITELN; &END; ! %OKSET:=SAVESET; (*RESTORE OKSET*) !  (*CONVERT TO INTEGER*) ! %IF CH='H' THEN &BEGIN 'FIRST:=XINT(SFIRST); 'SECON2; END; &'D':BEGIN OKSET:=DECSET; SLEN:=3; END; &'C':BEGIN OKSET:=CHRSET; SLEN:=1; END; %END; (*CASE*) #  (*GET THE SEQUENCE*) # %WRITELN('LOOK FOR SEQUENCE'); %WRITE('FIRST ==> '); %GETSTRING(SFIRST,SLEN);WRITELN; %WRITE('SECOND ==> '); %GETST(FOR2OR3:=3; 'END; "END (*CASE*) " "ELSE #IF CH<>'Q' THEN $BEGIN %PROMPTAT(0,'BEGIN SEARCH AT STARTADDR['); %WRITE(INPUTMODE,'] ==> ');CRT(ERASEOS); %GETMEMADDR; %ADDR:=MEMADDR; %SAVESET:=OKSET; % %CASE CH OF &'H':BEGIN OKSET:=HEXSET; SLEN:= !GOTOXY(0,0); CRT(ERASEOL); !WRITE('>SEARCH[',FOR2OR3,']: H(EX, D(EC, C(HAR, Q(UIT'); !CH:=GETCHAR(['H','D','C','Q','2','3']); ! !IF CH IN ['2','3'] THEN "CASE CH OF #'2':BEGIN (NOTHIRD:=TRUE; (FOR2OR3:=2; 'END; #'3':BEGIN (NOTHIRD:=FALSE; **) "  PROCEDURE SEARCH;   VAR FIRST,SECOND,THIRD:BYTE; $ADDR:INTEGER; $NOTHIRD:BOOLEAN; $CH:CHAR;  SFIRST,SSECOND,STHIRD,XADDR:STRING[4];  FOR2OR3:INTEGER; $  BEGIN !NOTHIRD:=FALSE; !THIRD:=0; !STHIRD:='0'; !FOR2OR3:=3; ! !REPEAT #END; (*IF CH<>'Q'*) !UNTIL CH='Q';  END; (*EXAMINE*) " "  (********************************************)  (* SEARCH MEMORY FOR SEQUENCE OF 2 OR 3 *)  (* HEXADECIMAL, DECIMAL OR CHARACTER VALUES *)  (****************************************** BEGIN !REPEAT "PROMPTAT(0,'>EXAMINE: H(EX & CHAR, D(EC, Q(UIT'); "CH:=GETCHAR(['H','D','Q']); "CRT(ERASEOS); "IF CH<>'Q' THEN #BEGIN $PROMPTAT(0,'STARTADDR['); $WRITE(INPUTMODE,'] ==> '); $GETMEMADDR; $I:=0; $IF CH='H' THEN EXHEX %ELSE EXDEC;WRITELN; #I:=I+8; "END; (*WHILE I<160*)  END; (*EXDEC*)    (*******************************************)  (* EXAMINE MEMORY AS HEX & CHAR OR DECIMAL *)  (*******************************************)   PROCEDURE EXAMINE;   VAR CH:CHAR;  EGIN !PROMPTAT(0,'>CHANGE: (PRESS TO TERMINATE OR QUIT)'); !I:=0; !CRT(ERASEOS); !WRITELN;WRITELN; !WRITE('STARTADDR[',INPUTMODE,'] ( TO QUIT) ==> '); !GETMEMADDR; !WRITELN(' TO TERMINATE CHANGE SEQUENCE'); !WRITELN; !REPEAT "HEX(MEMADDR+I,SADDR); "WRITE(SADDR,': '); "GETSTRING(VALUE,2); "WRITELN; "IF LENGTH(VALUE)>0 THEN #BEGIN $POKE(MEMADDR+I,XINT(VALUE)); $I:=I+1; #END; !UNTIL LENGTH(VALUE)=0;  END; (*CHANGE*)    (*****************************************)  (* DUתPá4  1á  4  4--P-Q-P#á  áˡP  ڪP.-/10-šA1-10123456789AXʁ T XƁT 2X T T .تPR    #? `$ h  ƁƂ/Ɓצ*SYSTEM.MISCINFOƁ́ƁH́T>XT@XʁTAXʁTBXʁTCXʁTD' MUD L FOLKS...');  END. "WRITE('R(ADIX[',INPUTMODE,'], S(EARCH, Q(UIT'); "CH:=GETCHAR(['C','D','E','H','R','S','Q']); "CRT(LEFT);CRT(ERASEOL); "DOIT; "OKSET:=SAVESET; (*RESTORE IN CASE OF ABORT*) !UNTIL CH = 'Q'; ! !GOTOXY(0,0);CRT(ERASEOS); !PROMPTAT(12,' THAT''S AL[' '..'}']; !DECSET:=['0'..'9'] + ['-']; !HEXSET:=['0'..'9'] + ['A'..'F'];  OKSET:=HEXSET; !SAVESET:=HEXSET; !INPUTMODE:='H'; (*HEX*)  !REPEAT "GOTOXY(0,0); CRT(ERASEOL); "WRITE('>MUD: C(HANGE, D(ISASSEM, E(XAMINE, H(EXDUMP, '); P*)   PROCEDURE DOIT;  !BEGIN " "CASE CH OF #'C':CHANGE; #'D':DISASSEM; #'E':EXAMINE; #'H':HEXDUMP; #'S':SEARCH; #'R':RADIX; "END; (*CASE*) " !END; (*DOIT*) ! !  BEGIN (*MAIN PROGRAM*)  !GETCRTINFO; ! !MOTNEEDED:=TRUE; !CHRSET:='S OPEN*) #REWRITE(F,FILENAME); #WHILE (I<=ENDADDR) DO $BEGIN %HEX(I,SADDR); %WRITE(F,SADDR,':'); &FOR J:=0 TO 7 DO 'BEGIN (HEX(PEEK(I+J),XBYTE); (WRITE(F,' ',XBYTE); 'END; %I:=I+8; %WRITELN(F); $END; #CLOSE(F,LOCK); # "END;  END; (*HEXDUM!IF LENGTH(FILENAME)>0 THEN "BEGIN #PROMPTAT(2,'STARTADDR['); #WRITE(INPUTMODE,'] ==> '); #GETMEMADDR; #I:=MEMADDR; #PROMPTAT(4,'ENDADDR ==> '); #GETMEMADDR; #ENDADDR:=MEMADDR; # #FILENAME:=CONCAT(FILENAME,'.TEXT'); #CLOSE(F,LOCK); (*IN CASE ITMPS MEMORY TO SPECIFIED OUTPUT FILE *)  (*****************************************)   PROCEDURE HEXDUMP;   VAR J:INTEGER; $XBYTE:STRING[2];   BEGIN !PROMPTAT(0,'>HEXDUMP: OUTPUT FILE NAME ==> '); !CRT(ERASEOS); !READLN(FILENAME); BCDEF0/0./--../N\ l ڪP-á 22./--š&-1100/0./--. .2//=^n ئתP 0+Ǚ   0123456789ABCDEF    Q P  ɡ 0 Q P$\ -٪PتPڹ_ __-__ _ צ SECOND ==>  $צ THIRD ==>  4Há)   RDá)   $  NOW SEARCHING M ݹ 23QˡצBEGIN SEARCH AT STARTADDR[צ] ==> 4ݹ64$74%4DCH - GLOOK FOR SEQUENCEצ FIRST ==> AR, D(EC, Q(UIT Qˡ<צ STARTADDR[צ] ==>  HáQá 0צ>SEARCH[ ]: H(EX, D(EC, C(HAR, Q(UIT  ݳ 2++2(-.-// //ǠɄ00- 22(2-)2(.. + Ǡɡ? ȡ؂  H/ R">EXAMINE: H(EX & CHBANK, Q(UIT  QˡCع 0,(DS  &*_Qá- Ǡɡ11(1:)1( ת(.1.1ȡ.+22(2 )_8  STARTADDR[] ==>  _צCONSOLE:ȡ+_< 22צ.>DISASSEM: D(ISPLAY 20 LINES, O(UTPUT TO FILE,צ S(ECOND  >DISASSEM: OUTPUT FILE NAME ==> šצ STARTADDR[צ] ==>  ENDADDR[] ==> צ.TEXT__ȡ& STARTADDR[] ==> P 0Ʉ ءצENDADDR[צ] ==> P0Ʉ ء_צCONSOLE:ȡ&_6C PLRORRTIRTSSBCSECSEDSEISTASTXSTYTAXTAYTSXTXATXSTYA???תP3PǠHHá  >צ'DISASSEMBLE SECOND 4K BANK (D000..DFFF)BY COPYING INTO 2000..3000  READING MACHINE OPCODE TABLE... צOPCODES 3 ۦ9ADCANDASLBCCBCSBEQBITBMIBNEBPLBRKBVCBVSCLCCLDCLICLVCMPCPXתPצ9CPYDECDEXDEYEORINCINXINYJMPJSRLDALDXLDYLSRNOPORAPHAPHPPLAP9PLPRO__ _ _ 3_ __ _3 áSš&     LAצ ת3ɡ-Ǚ  __צ: _ _צ R _ __ __-__ _-__ _-__ _-_,X_Z_ _-_צ,Y_-_#l< V+'_-_צ,X__צ A__ __-_,Y__ (_-_צ,X)__ (_-_צ),Y__ #_-_EMORY(PRESS ANY KEY TO ABORT) צSEQUENCE  צFOUND AT MEMORY LOCATION צ (IN HEX)&SEQUENCE NOT FOUNDQáI 4&>RADIX[צ ]: H(EX, D(EC Há4$44+>CHANGE: (PRESS TO TEN^f #[.GC .צE&Save as :. ? 瓡צSave asצ[š C?/צTEXT#CODE#饀!dȡMɡ$šá DONElc  ~צ *SYSTEM.WRK.,C:[.," SIEVE ٣ @(٣ ٣  z|>'ˡġ ,C /Ǐ600000Pl$6 6 V 0|0|lX0|03) $]~4$$Hצ.>MUD: C(HANGE, D(ISASSEM, E(XAMINE, H(EXDUMP, צR(ADIX[], S(EARCH, Q(UIT8  4Qáȡ0؂_ _ __T P=951-)CS" )/L _ 62D?á_0>HEXDUMP: OUTPUT FILE NAME ==> šצ STARTADDR[צ] ==>   ENDADDR ==> צ.TEXT__ȡo__:RMINATE OR QUIT) צ STARTADDR[צ] ( TO QUIT) ==> צ" TO TERMINATE CHANGE SEQUENCE:  š  PROGRAM TESTFILES;  TYPE "RESIDENT=RECORD ,NAME: STRING[10]; ,STRNUM: INTEGER; ,STREET: STRING[13]; ,MEMBER: BOOLEAN; +END; +  VAR "RES: RESIDENT; "RESFILE: FILE OF RESIDENT; "MAXREC,RECNUM: INTEGER; "FILENAME: STRING[10]; "SUCCESSFUL: BOOLEAN^;;צSTREET:  MEMBER: (T/F) VVTáצ צ OMNAME: צ ADDRESS:    TVFVצMEMBER: V1 JO"ëUUSTART NEW FILE? VVYáOMNAME:  צ STREET NUM:  צSTREET:  MEMBER: (T/F) VVTáצ צ OMNAME: צ ADDRESS:    TVFVצ>NM צENTER FILENAME: O O"ëUUSTART NEW FILE? VVYáOMNAME:  צ STREET NUM:  "*R TESTFILE TH RES DO $BEGIN &WRITELN('NAME: ',NAME); &WRITELN('ADDRESS: ',STRNUM,' ',STREET); &IF MEMBER THEN CH:='T' )ELSE CH:='F'; &WRITELN('MEMBER: ',CH); &WRITELN $END; "CLOSE(RESFILE,LOCK)  (*$I+*) (* TURN ON IO CHECKING *)  END. LE^:=RES; *PUT(RESFILE); *WRITELN (END $END; "CLOSE(RESFILE,LOCK); "WITH RES DO $BEGIN &NAME:=''; STRNUM:=0;STREET:='' $END; "(* NOW OPEN FILE FOR READING *) "RESET(RESFILE,FILENAME); "SEEK(RESFILE,RECNUM); "GET(RESFILE); "RES:=RESFILE^; "WI-WRITE('STREET NUM: ');READ(STRNUM);READLN; -WRITE('STREET: ');READ(STREET);READLN; -WRITE('MEMBER: (T/F) ');READ(CH);READLN; -IF CH='T' THEN MEMBER:=TRUE 0ELSE MEMBER:=FALSE; +(* NOTE YOU CANNOT READ OR WRITE BOOLEAN VARS DIRECTLY *) +END; *RESFIEADLN(CH); &IF CH='Y' THEN (BEGIN *REWRITE(RESFILE,FILENAME);(* THIS PREPARES NEW FILE FOR REWRITING*) *SEEK(RESFILE,RECNUM); (* POSITION READ/WRITE HEAD *) *WITH RES DO +BEGIN (* ENTER DATA FOR RECORD *) -WRITE('NAME: ');READ(NAME);READLN; T I-, PROGRAM WILL END & SYSTEM RE-INIT *) " "RESET(RESFILE,FILENAME); (* TRY TO OPEN OLD FILE *) "SUCCESSFUL:=(IORESULT=0); (* IF FILE NOT PRESENT THEN IORESULT=0 *) "IF NOT SUCCESSFUL THEN (* START NEW FILE *) $BEGIN &WRITELN('START NEW FILE? ');RN; "CH: CHAR; "  BEGIN "MAXREC:=5;RECNUM:=0; "CLOSE(RESFILE,LOCK); (* IN CASE IT'S OPEN *) "PAGE(OUTPUT); (* CLEAR SCREEN *) "WRITELN('ENTER FILENAME: ');READLN(FILENAME); " "(*$I-*) (* TURN OFF IO CHECK IN CASE FILE DOESN'T EXIST *) "(* WITHOUN^yy Í1צZEROES NOT ALLOWED;EXIT PGMš   áGCD OF  צ &  = ÍE*SYSTEM.WRK.TEXTPš  š š  צGCD OF   AND  צ IS  צENTER ZEROS TO QUIT INPUT TWO POSITIVE INTEGERS--->  " GCD UG le ( to return) -->ƂPƂáƂ̂.ʂ.ȡƂƂ۾ .TEXTƂƂƂȍƂƂ.˄%Ƃ̂.Ƃ.ƂPƂ..TEXTUƂ.PƂƂ.á ƂƂƂצ*SYSTEM.WRK.TEXTP׶INPUT 2 INTEGERSENTER THE LARGER ONE FIRST/TYPE NUMBER,PRESS RETURN,THEN TYPE OTHER,RETURN   ȡNɡ á&צLCM= " LCM =0; (WHILE (M2J THEN BEGIN LARGE:=I;SMALL:=J; END +ELSE BEGIN LARGE:=J;SMALL:=I; END; )REPEAT *BEGIN +Q:=TRUNC(LARGE/SMALL); +R:=LARGE-(Q*SMALL); +LARGE:=SMALL; +SMALL:=R; *END; )UNTIL (R=0); )WRITELN; LN('GCD OF ',I,' AND ',J,' IS ',LARGE);   (* DIVISION METHOD *) $ "REPEAT #BEGIN $WRITELN; $WRITELN('ENTER ZEROS TO QUIT'); $WRITELN('INPUT TWO POSITIVE INTEGERS---> '); $READ(INPUT,I);READ(INPUT,J); $IF ((I=0) OR (J=0)) THEN WRITELN('ZEROES NOT$IF I>J THEN BEGIN LARGE:=I;SMALL:=J; END +ELSE BEGIN LARGE:=J;SMALL:=I; END; $WHILE (SMALL>0) DO &BEGIN (* LARGE-SMALL IS DIVISIBLE BY GCD *) (LARGE:=LARGE-SMALL; (IF SMALL>LARGE THEN +BEGIN COPY:=LARGE;LARGE:=SMALL;SMALL:=COPY END &END; $WRITEPROGRAM GCD;   (* PGM TO CALCULATE GREATEST COMMON DIVISOR OF TWO INTEGERS *)  (* USING 3 DIFFERENT METHODS. *)   VAR I,J,Q,R,COPY: INTEGER; $LARGE,SMALL: INTEGER;   (* SUBTRACTION METHOD *) "BEGIN $I:=18;J:=15;  BOWLES BOOK 'PROBLEM "SOLVING USING PASCAL. "  (DRAWLINE AND STARS WERE ENTERED BY "LEE MEADOR.) "  MUD - MEMORY UTILITY DELIGHT "BY RON DEGROAT "READ THE INSTRUCTIONS TEXT FILE TO "FIND OUT MORE ABOUT THIS PROGRAM "TO LET YOU LOOK AROUND IN MEMORY, "DISASSEMBLE, ETC. (MOTGEN AND THE "VARIOUS MUD FILES BELONG TO THIS "GROUP) "  SIEVE - USES A SIEVE TO FIND PRIME "NUMBERS. "  FILEIO - DEMONSTRATES HOW TO DO DISK "INPUT AND OUTPUT. "  LCM - FINDS THE LEAST COMMON MULTIPLE "OF TWO NUMBPROGRAM RANDOMPLOT;  USES TURTLEGRAPHICS, APPLESTUFF;  VAR NUMBEROF : INTEGER; (* NUMBER OF ELEMENTS *)  RANDOMARRAY : ARRAY[1..1000] OF INTEGER; 0I : INTEGER; (SORTARRAY : ARRAY[0..1000] OF REAL; (  PROCEDURE RANDOMNUMBERS;  VAR I : IN^e&IF (DI=0) THEN WRITELN(J); &J:=J+2 $END; (* END OF WHILE J<=N *) $WRITELN('DONE')  END. (* END SIEVE *)  ND PRINT ONLY THOSE *) $BEGIN (* THAT ARE NOT DIVISIBLE BY ANY PREVIOUS ODD INTEGER *) &I:=3; DI:=0; &WHILE (I0 THEN I:=I+2 -ELSE BEGIN 4DI:=1; 4I:=J 2END (END; (* END OF WHILE I 0) AND (T < SORTARRAY [I])) DO ,BEGIN PROGRAM SHELL;  USES APPLESTUFF;  VAR NUMBEROF : INTEGER; (* NUMBER OF ELEMENTS *)  A : ARRAY[0..1000] OF INTEGER; -J, I : INTEGER; (   PROCEDURE RANDOMNUMBERS(VAR LAST : INTEGER);   BEGIN "FOR I := 1 TO LAST DO $BEGIN N^e); "READLN(NUMBEROF); "RANDOMNUMBERS; "WRITELN ('PRESS RETURN TO SORT SORT NUMBERS'); "READLN; "SORTBUBBLE; "WRITELN ('BYE....');   END. (* END MAIN *)  EPEAT $I := I + 1; $WRITELN (PRINTOUT, ' I=', I, ' NO.=', SORTARRAY [I]); "UNTIL (I = NUMBEROF);  END; (* SORTBUBBLE, END *)     BEGIN; (* MAIN PROGRAM *) " " "REWRITE (PRINTOUT, 'PRINTER:'); " "WRITELN (' ENTER NUMBER OF ELEMENTS: '*WHILE ((I > 0) AND (T < SORTARRAY [I])) DO ,BEGIN .SORTARRAY [I+1] := SORTARRAY [I]; .I := I -1; ,END; *SORTARRAY [I+1] := T; (END; &J := J +1; $END; " "WRITELN(PRINTOUT,'************ END BUBBLE SORT ******'); (*************) " "I := 0; "RJ : INTEGER; 'T : REAL;   BEGIN "WRITELN('********** BEGIN BUBBLE SORT ******'); (*************) "J := 1; "WHILE J < NUMBEROF DO "BEGIN &IF (SORTARRAY [J+1] < SORTARRAY [J]) THEN & (BEGIN *T := SORTARRAY [J+1]; *I := J;   PROCEDURE SORTBUBBLE;  (**************************************)  (* *)  (* BUBBLE SORT *)  (* *)  (**************************************)   VAR I, TPUT; (  PROCEDURE RANDOMNUMBERS;  VAR I : INTEGER;   BEGIN "FOR I := 1 TO NUMBEROF DO $BEGIN &RANDOMARRAY [I] := RANDOM; &SORTARRAY [I] := RANDOMARRAY [I]/32767; $END; "WRITELN (' NUMBER OF =', NUMBEROF);  END; (* RANDOM NUMBERS, END *)  PROGRAM RANDOMPLOT;  USES APPLESTUFF;  TYPE OUTPUT = INTERACTIVE (*OR TEXT*);  VAR NUMBEROF : INTEGER; (* NUMBER OF ELEMENTS *)  RANDOMARRAY : ARRAY[1..1000] OF INTEGER; 0I : INTEGER; (SORTARRAY : ARRAY[0..1000] OF REAL; (PRINTOUT : OU&A [I] := RANDOM; $END;  END; (* RANDOM NUMBERS, END *)    PROCEDURE SORTBUBBLE(VAR NB, KB : INTEGER);  (**************************************)  (* *)  (* BUBBLE SORT *)  (* *)  (**************************************)   VAR T, IB, JB : INTEGER;   BEGIN "WRITELN('********** BEGIN BUBBLE SORT ******'); (*************) "JB := 1; "WHILE ((JB + KB) < NB) DO "BEGIN &IF (A [JB+KB] < A [JB]) T"READLN;  END;   PROCEDURE FILLARRAYS;  CONST RADIANS = 57.29957795;  XRADIUS = 139; &YRADIUS = 95; &XMID = 139; &YMID = 95;  VAR I : INTEGER;  MAXANGLE : REAL;  BEGIN "MAXANGLE := 360/RADIANS; "DELTAANGLE := (360.0/RADIANS   PROCEDURE WRITECHARS;  VAR HORIZ,VERT,ASCII: INTEGER;  BEGIN "INITTURTLE; "ASCII:=0; "FOR VERT:=0 TO 18 DO $BEGIN &MOVETO(0,180-VERT*10); &FOR HORIZ:=0 TO 39 DO (BEGIN *WCHAR(CHR(ASCII)); *ASCII:=(ASCII+1) MOD 128; (END; " END; GTH(S); "B:=Y-2; T:=Y+10; "VIEWPORT(L,R,B,T); "FILLSCREEN(BLACK); "VIEWPORT(0,279,0,191);  PENCOLOR(NONE); MOVETO(L,B); "PENCOLOR(WHITE); MOVETO(L,T); "MOVETO(R,T); MOVETO(R,B); MOVETO(L,B); "PENCOLOR(NONE); MOVETO(L+3,B+2); "WSTRING(S);  END; *********************)  (* *)  (* WRITE A STRING IN ERASED BOX *)  (* *)  (********************************)  VAR L,R,B,T: INTEGER;  BEGIN "PENCOLOR(NONE); MOVETO(X,Y); "L:=X-3; R:=X+2+7*LEN  PROGRAM FIGURE;   USES TRANSCEND, TURTLEGRAPHICS;   VAR X : ARRAY [0..360] OF INTEGER; $Y : ARRAY [0..360] OF INTEGER; $I : INTEGER; $ANGLE, DELTAANGLE, NUMBEROFPOINTS : REAL;   PROCEDURE BOXSTRING(X,Y: INTEGER; S: STRING);  (***********N^աELEMENTS: '); "READLN(NUMBEROF); "RANDOMNUMBERS(NUMBEROF); "WRITELN ('PRESS RETURN TO SORT NUMBERS'); "READLN; "SORTSHELL(NUMBEROF); "WRITELN ('BYE....');   END. (* END MAIN *)  ND; "I := 0; "REPEAT $I := I + 1; $WRITELN (' I=', I, ' NO.=', A [I]); "UNTIL (I = N); "WRITELN('************ END SHELL SORT ******'); (*************)  END; (* END SORTSHELL *)   BEGIN; (* MAIN PROGRAM *) " "WRITELN (' ENTER NUMBER OF  VAR I, J, K : INTEGER;   BEGIN "K := 1; "REPEAT K := 3*K+1 UNTIL K >= N; "K := (((K - 1) DIV 3) - 1) DIV 3; "WHILE (K > 0) DO $BEGIN &J := 1; &WHILE (J <= K) DO (BEGIN & SORTBUBBLE(N, K); *J := J + 1; (END; % K := (K - 1) DIV 3;  E END; (* SORTBUBBLE, END *)    PROCEDURE SORTSHELL(VAR N : INTEGER);  (******************************************************)  (* SHELL SORT *)  (******************************************************) HEN & (BEGIN & T := A [JB+KB]; *IB := JB; *WHILE ((IB > 0) AND (T < A [IB])) DO ,BEGIN & A [IB+KB] := A [IB]; .IB := IB - KB; , IF (IB < 0) 0THEN 2IB := 0; ,END; *A [IB+KB] := T; (END; &JB := JB + KB; $END; ) / NUMBEROFPOINTS; "I := 0; "ANGLE := 0; "REPEAT " BEGIN &X [I] := ROUND(XRADIUS * COS (ANGLE) + XMID); &Y [I] := ROUND(YRADIUS * SIN (ANGLE) + YMID); &I := I +1; &ANGLE := I * DELTAANGLE; $ WRITELN(I,' ANGLE=',ANGLE*RADIANS,' X=',X[I],' Y=',Y[I]); $END;  UNTIL (ANGLE >= MAXANGLE);  END;   PROCEDURE CIRCLE;  VAR K, N, M :INTEGER;  BEGIN "K := TRUNC(NUMBEROFPOINTS) - 1; "FOR N := 0 TO K DO $BEGIN $FOR M := N TO K DO &BEGIN (PENCOLOR (NONE); (MOVETO (X[N],Y[N]); (PENCOLOR (BLACK)&FOR HORIZ:=0 TO 39 DO (BEGIN *WCHAR(CHR(ASCII)); *ASCII:=(ASCII+1) MOD 128; (END; " END; "READLN;  END;    BEGIN; (* MAIN PROGRAM *) "WRITELN('HIT RETURN TO START: '); "GOTOXY (22,2); "READLN; "INITTURTLE; " "(**********************); MOVETO(R,B); MOVETO(L,B); "PENCOLOR(NONE); MOVETO(L+3,B+2); "WSTRING(S);  END;    PROCEDURE WRITECHARS;  VAR HORIZ,VERT,ASCII: INTEGER;  BEGIN "INITTURTLE; "ASCII:=0; "FOR VERT:=0 TO 18 DO $BEGIN &MOVETO(0,180-VERT*10);  VAR L,R,B,T: INTEGER;  BEGIN "PENCOLOR(NONE); MOVETO(X,Y); "L:=X-3; R:=X+2+7*LENGTH(S); "B:=Y-2; T:=Y+10; "VIEWPORT(L,R,B,T); "FILLSCREEN(BLACK); "VIEWPORT(0,279,0,191);  PENCOLOR(NONE); MOVETO(L,B); "PENCOLOR(WHITE); MOVETO(L,T); "MOVETO(R,TNMODE : SCREENCODE;   PROCEDURE BOXSTRING(X,Y: INTEGER; S: STRING);  (********************************)  (* *)  (* WRITE A STRING IN ERASED BOX *)  (* *)  (********************************)   PROGRAM FIGURE;   USES TRANSCEND, TURTLEGRAPHICS;   CONST XWIDTH = 23; &YWIDTH = 16;   VAR X : ARRAY [0..360] OF INTEGER; $Y : ARRAY [0..360] OF INTEGER; $I, XLOCATE, YLOCATE : INTEGER; $ANGLE, DELTAANGLE, NUMBEROFPOINTS : REAL;  PEO^"BOXSTRING(10,90,'FILLING ARRAY'); "FILLARRAYS; "FILLSCREEN(WHITE ); "CIRCLE; "REPEAT I := I + 1 UNTIL (I > 2000); "BOXSTRING(60, 90, 'HIT RETURN TO CONTINUE'); "READLN; "TEXTMODE; "WRITELN('THAT''S ALL FOLKS...');  END.   ; (MOVETO (X[M],Y[M]); &END; # $END;  END;   BEGIN; (* MAIN PROGRAM *) "WRITELN('INTER NUMBER OF POINTS: '); "GOTOXY (24,2); "READLN(NUMBEROFPOINTS); "INITTURTLE; "FILLSCREEN(WHITE); "VIEWPORT(1,278,1,190); *************) "(*FILL SCREEN WITH BANDS 12 POSIBLE*) "(*"COLORS". *) "(***********************************) "YLOCATE := 0; " "FOR I := 1 TO 12 DO $BEGIN " VIEWPORT(0,279,YLOCATE,YLOCATE+YWIDTH); " FILLSCREEN(PENMODE); " YLOCATE := YLOCATE + YWIDTH; " IF (PENMODE <> WHITE2) THEN PENMODE := SUCC(PENMODE); &IF (PENMODE = RADAR) THEN PENMODE := SUCC(PENMODE); $END; " "(***********************************) "(*FILL SCREEN WITH BANDS 12 POSIBLE*) "(*"COLORS" VN^FF"BOXSTRING(60, 90, 'HIT RETURN TO CONTINUE'); "READLN; "TEXTMODE; "WRITELN('THAT''S ALL FOLKS...');  END.   "VIEWPORT(0,279,YLOCATE,YLOCATE+YWIDTH); "FILLSCREEN(ORANGE); "YLOCATE := YLOCATE + YWIDTH; "VIEWPORT(0,279,YLOCATE,YLOCATE+YWIDTH); "FILLSCREEN(BLUE); "YLOCATE := YLOCATE + YWIDTH; "VIEWPORT(0,279,YLOCATE,YLOCATE+YWIDTH); "FILLSCREEN(WHITE2); "  "YLOCATE := YLOCATE + YWIDTH; "VIEWPORT(0,279,YLOCATE,YLOCATE+YWIDTH); "FILLSCREEN(WHITE1); "YLOCATE := YLOCATE + YWIDTH; "VIEWPORT(0,279,YLOCATE,YLOCATE+YWIDTH); "FILLSCREEN(BLACK2); "YLOCATE := YLOCATE + YWIDTH; TH; "VIEWPORT(0,279,YLOCATE,YLOCATE+YWIDTH); "FILLSCREEN(BLACK1); "YLOCATE := YLOCATE + YWIDTH; "VIEWPORT(0,279,YLOCATE,YLOCATE+YWIDTH); "FILLSCREEN(GREEN); "YLOCATE := YLOCATE + YWIDTH; "VIEWPORT(0,279,YLOCATE,YLOCATE+YWIDTH); "FILLSCREEN(VIOLET);,YLOCATE+YWIDTH); "FILLSCREEN(WHITE); "YLOCATE := YLOCATE + YWIDTH; "VIEWPORT(0,279,YLOCATE,YLOCATE+YWIDTH); "FILLSCREEN(BLACK); "YLOCATE := YLOCATE + YWIDTH; "VIEWPORT(0,279,YLOCATE,YLOCATE+YWIDTH); "FILLSCREEN(REVERSE); "YLOCATE := YLOCATE + YWID"(*FILL SCREEN WITH BANDS 12 POSIBLE*) "(*"COLORS". *) "(***********************************) "YLOCATE := 0; " "VIEWPORT(0,279,YLOCATE,YLOCATE+YWIDTH); "FILLSCREEN(NONE); "YLOCATE := YLOCATE + YWIDTH; "VIEWPORT(0,279,YLOCATE := XLOCATE + XWIDTH; "VIEWPORT(XLOCATE,XLOCATE+XWIDTH,0,191); "FILLSCREEN(BLUE); "XLOCATE := XLOCATE + XWIDTH; "VIEWPORT(XLOCATE,XLOCATE+XWIDTH,0,191); "FILLSCREEN(WHITE2); " "(***********************************) ORT(XLOCATE,XLOCATE+XWIDTH,0,191); "FILLSCREEN(WHITE1); "XLOCATE := XLOCATE + XWIDTH; "VIEWPORT(XLOCATE,XLOCATE+XWIDTH,0,191); "FILLSCREEN(BLACK2); "XLOCATE := XLOCATE + XWIDTH; "VIEWPORT(XLOCATE,XLOCATE+XWIDTH,0,191); "FILLSCREEN(ORANGE); "XLOCATE,191); "FILLSCREEN(BLACK1); "XLOCATE := XLOCATE + XWIDTH; "VIEWPORT(XLOCATE,XLOCATE+XWIDTH,0,191); "FILLSCREEN(GREEN); "XLOCATE := XLOCATE + XWIDTH; "VIEWPORT(XLOCATE,XLOCATE+XWIDTH,0,191); "FILLSCREEN(VIOLET); "XLOCATE := XLOCATE + XWIDTH; "VIEWP"YLOCATE := XLOCATE + XWIDTH; "VIEWPORT(XLOCATE,XLOCATE+XWIDTH,0,191); "FILLSCREEN(BLACK); "XLOCATE := XLOCATE + XWIDTH; "VIEWPORT(XLOCATE,XLOCATE+XWIDTH,0,191); "FILLSCREEN(REVERSE); "XLOCATE := XLOCATE + XWIDTH; "VIEWPORT(XLOCATE,XLOCATE+XWIDTH,0ERTICALY. *) "(***********************************) "XLOCATE := 0; " "VIEWPORT(XLOCATE,XLOCATE+XWIDTH,0,191); "FILLSCREEN(NONE); "XLOCATE := XLOCATE + XWIDTH; "VIEWPORT(XLOCATE,XLOCATE+XWIDTH,0,191); "FILLSCREEN(WHITE);  FIXSTRING (INN, OUT);  WRITELN (' IN = ',INN,' OUT = ',OUT);  END;  END;  UNTIL (INN = 0);  END.  HEN &STG := CONCAT (INTEGERSTRING, '.', DECIMALSTRING) $ELSE &STG := INTEGERSTRING; "END; (* FIXSTRING *)    BEGIN  REPEAT  BEGIN  READLN (INN);  IF (INN <> 0)  THEN  BEGIN NG := ''; "I := 1; "WHILE ((TESTSTRING [I] <> '0') AND (I <= (TESTLENGTH - 1))) DO &BEGIN (DECIMALSTRING := CONCAT (DECIMALSTRING, COPY (TESTSTRING, I, 1)); (I := SUCC (I); &END; "DECIMALLENGTH := LENGTH (DECIMALSTRING); "IF (DECIMALLENGTH > 0) $T TESTSTRING : STRING; $  BEGIN "INTEGERVALUE := TRUNC (NUMBER); "DECIMALVALUE := ROUND ((NUMBER - INTEGERVALUE ) * DECIMALPLACES); "STR (INTEGERVALUE, INTEGERSTRING); "STR (DECIMALVALUE, TESTSTRING); "TESTLENGTH := LENGTH (TESTSTRING); "DECIMALSTRIPROGRAM TESTPROCD;   VAR INN : REAL; $OUT : STRING; $  PROCEDURE FIXSTRING (NUMBER : REAL; VAR STG : STRING);   CONST DECIMALPLACES = 100;   VAR INTEGERVALUE, DECIMALVALUE, DECIMALLENGTH, TESTLENGTH, I : INTEGER; $INTEGERSTRING, DECIMALSTRING,STARTP ENDP ;tN^N (B); 0XX := TRUNC (C) + 95; 0YY := TRUNC (D) +139; 0MOVETO (XX, YY); 0B := B + INC; .END; *END; $END; $READLN; $TEXTMODE;  END.  UNC (Q); &SUM := IP + IQ; &IF (ODD (SUM)) (THEN *MAXVAL := Q * TWOPI (ELSE *MAXVAL := Q * PI; &INITTURTLE; &PENCOLOR (WHITE); &IF (A = 'S') (THEN *BEGIN ,WHILE (B <= MAXVAL) DO .BEGIN 0R := 110 * SIN (N * B); 0C := R * COS (B); 0D := R * SITWOPI/200; &B := 0.0; &WRITELN ('ENTER "S" FOR SINE, "C" FOR COSINE; THEN "P" & "Q"'); &READLN (A); &READLN (P); &READLN (Q); &IF (Q = 0.0) THEN EXIT (POLORGRAPHICS); &N := P/Q; &IF (N = 0.0) THEN EXIT (POLORGRAPHICS); &IP := TRUNC (P); &IQ := TRPROGRAM POLORGRAPHS;  USES TURTLEGRAPHICS, TRANSCEND;   CONST PI = 3.14159; &TWOPI = 6.28318;   VAR B, C, D, INC, MAXVAL, N, P, Q, R, X : REAL; $IP, IQ, SUM, XX, YY : INTEGER; $A : CHAR;   BEGIN "N := 1.0; "WHILE (N > 0) DO $BEGIN &INC := "FOR BLANKLINES := 1 TO 10 DO " WRITELN(' '); "GOTOXY (0,0); "WRITELN; "WRITELN; "WRITELN ('INPUT INTERATIONS(0 TO QUIT):'); "GOTOXY (30,2); "READLN (NPTS);  WRITELN ('INPUT B :'); "(INTEGERSTRING, '.', DECIMALSTRING) $ELSE &STG := INTEGERSTRING; "END; (* FIXSTRING *)   PROCEDURE READIN;   VAR BLANKLINES : INTEGER;    BEGIN "GOTOXY (0,0); "WRITELN('R = A * (B * SIN (C * ANGLE)); '); "WHILE ((TESTSTRING [I] <> '0') AND (I <= (TESTLENGTH - 1))) DO &BEGIN (DECIMALSTRING := CONCAT (DECIMALSTRING, COPY (TESTSTRING, I, 1)); (I := SUCC (I); &END; "DECIMALLENGTH := LENGTH (DECIMALSTRING); "IF (DECIMALLENGTH > 0) $THEN &STG := CONCAT ; $  BEGIN "INTEGERVALUE := TRUNC (NUMBER); "DECIMALVALUE := ROUND ((NUMBER - INTEGERVALUE ) * DECIMALPLACES); "STR (INTEGERVALUE, INTEGERSTRING); "STR (DECIMALVALUE, TESTSTRING); "TESTLENGTH := LENGTH (TESTSTRING); "DECIMALSTRING := ''; "I := 1; "CHARTYPE(6); "WSTRING(S);  END;   PROCEDURE FIXSTRING (NUMBER : REAL; VAR STG : STRING);   CONST DECIMALPLACES = 100;   VAR INTEGERVALUE, DECIMALVALUE, DECIMALLENGTH, TESTLENGTH, I : INTEGER; $INTEGERSTRING, DECIMALSTRING, TESTSTRING : STRING "B:=Y-2; T:=Y+10; "(* VIEWPORT(L,R,B,T) *); "(* FILLSCREEN(BLACK) *); "VIEWPORT(0,279,0,191);  PENCOLOR(NONE); MOVETO(L,B); "PENCOLOR(WHITE); MOVETO(L,T); "MOVETO(R,T); MOVETO(R,B); MOVETO(L,B); "PENCOLOR(NONE); MOVETO(L+3,B+2); **************)  (* *)  (* WRITE A STRING IN ERASED BOX *)  (* *)  (********************************)  VAR L,R,B,T: INTEGER;  BEGIN "PENCOLOR(NONE); MOVETO(X,Y); "L:=X-3; R:=X+2+7*LENGTH(S);F INTEGER; $Y : ARRAY[0..MAXPOINTS] OF INTEGER;   FUNCTION POWER (X, Y : REAL) : REAL;   VAR Z : REAL;   BEGIN "Z := EXP (Y * LN (X));  POWER := Z;  END; (* POWER *)   PROCEDURE BOXSTRING(X,Y: INTEGER; S: STRING);  (******************PROGRAM POLORGRAPH;   USES TURTLEGRAPHICS,TRANSCEND;   CONST RADIAN = 57.2957795;  A = 95;  MAXPOINTS = 2002;   VAR QSTART, QEND, QDELTA,  TIMESSIN, TIMESANGLE, $NPTS, R : REAL; $K : INTEGER; $X : ARRAY[0..MAXPOINTS] ON^FGOTOXY (30,3); "READLN (TIMESSIN); "WRITELN ('INPUT C :'); "GOTOXY (30,4); "READLN (TIMESANGLE); "IF (NPTS > MAXPOINTS) THEN NPTS := MAXPOINTS - 2;  END;    PROCEDURE PARAMETERS;   BEGIN "QSTART := 0; "QEND := 360; "QDELTA := (QEND - QSTART)/NPTS;  WRITELN('NPTS =',NPTS); "WRITELN('QSTART=',QSTART);  WRITELN('QEND =',QEND);  WRITELN('QDELTA=',QDELTA);  END;   PROCEDURE FUNCT;   VAR RSQR, ANGLE : REAL;   BEGIN "QDELTA := QDELTA/RADIAN; "ANGLE :=PROGRAM POLORGRAPH;   USES TURTLEGRAPHICS,TRANSCEND;   CONST RADIAN = 57.2957795;  A = 95;  MAXPOINTS = 2002;   VAR QSTART, QEND, QDELTA,  TIMESSIN, TIMESANGLE, $NPTS, R : REAL; $K, INTERVALNPTS : INTEGER; $X : ARRAY[0N^F BEGIN " PARAMETERS; " FUNCT; (PLOT; " READLN; " TEXTMODE;  END; "UNTIL (NPTS = 0);  END.  "FIXSTRING (TIMESSIN, B); "FIXSTRING (TIMESANGLE, C); "FIXSTRING (A, ASTR); "STRG := CONCAT ('R = ',ASTR,' * COS (',B,' * SIN (',C,' * ANGLE))'); "BOXSTRING (0,0,STRG)  END;    BEGIN (* MAIN *) "REPEAT " READIN; " IF (NPTS <> 0) THEN $ 1],Y[1]); "PENCOLOR (WHITE); "KMINUS1 := K - 1; "FOR I := 0 TO KMINUS1 DO $ MOVETO (X[I],Y[I]);  PENCOLOR (NONE); "MOVETO (X[K],Y[K]); "FIXSTRING (NPTS, STRNPTS); "STRG := CONCAT ('NPTS=',STRNPTS); "BOXSTRING (0,169,STRG); (A) * COS (2 * ANGLE); *) $(* IF (RSQR < 0) THEN RSQR := -RSQR; *) $(* R := SQRT (RSQR); *)  END;    PROCEDURE PLOT;   VAR I, KMINUS1 : INTEGER;  STRG, ASTR, B, C,STRNPTS : STRING;   BEGIN "INITTURTLE; "PENCOLOR (NONE); "MOVETO (X[$(* ARCHIMEDEAN SPRIAL ? *) $(* R := (A * ANGLE)/100; *) $(* RECTANGULAR HYPERBOLA A = 15 *) $(* RSQR := SQR (A)/COS (2 * ANGLE); *) $(* IF (RSQR < 0) THEN RSQR := -RSQR; *) $(* R := SQRT (RSQR); *) $(* RSQR := SQR $(* CARDIOID A = 73 0) $(* R := A * (1 + COS (ANGLE)); *) $(* ELLIPSE A = 85 *) $(* R := A * (1 + ((1/2) * COS (ANGLE))); *) $(* LIMACON A =105 *) $(* R := A * ((1/2) + COS (ANGLE)) *);  QSTART/RADIAN; "K := 0; "REPEAT $R := A * COS (TIMESSIN * SIN (TIMESANGLE * ANGLE)); $X[K] := ROUND(R * COS (ANGLE)) +139; $Y[K] := ROUND(R * SIN (ANGLE)) + 95; $ANGLE := ANGLE + QDELTA; $K := K + 1; "UNTIL (K >= (NPTS + 1)) ..MAXPOINTS] OF INTEGER; $Y : ARRAY[0..MAXPOINTS] OF INTEGER;   FUNCTION POWER (X, Y : REAL) : REAL;   VAR Z : REAL;   BEGIN "Z := EXP (Y * LN (X));  POWER := Z;  END; (* POWER *)   PROCEDURE BOXSTRING(X,Y: INTEGER; S: STRING);  (********************************)  (* *)  (* WRITE A STRING IN ERASED BOX *)  (* *)  (********************************)  VAR L,R,B,T: INTEGER;  BEGIN "PENCOLOR(NONE); MOVETO(X,Y); "L:=X-3; R:=X+"STRG := CONCAT ('INTERVAL=',STRNPTS); "BOXSTRING (0,181,STRG); "FIXSTRING (TIMESSIN, B); "FIXSTRING (TIMESANGLE, C); "FIXSTRING (A, ASTR); "STRG := CONCAT ('R = ',ASTR,' * COS (',B,' * SIN (',C,' * ANGLE))'); "BOXSTRING (0,0,STRG)  END;    BE= INTERVAL; "WHILE (I <= KMINUS1) DO $BEGIN " MOVETO (X[I],Y[I]);  I := I + INTERVAL; $END; "READLN; "FIXSTRING (NPTS, STRNPTS); "STRG := CONCAT ('NPTS=',STRNPTS); "BOXSTRING (0,169,STRG); "FIXSTRING (INTERVAL, STRNPTS); := SQRT (RSQR); *)  END;    PROCEDURE PLOT (INTERVAL : INTEGER);   VAR I, KMINUS1 : INTEGER;  STRG, ASTR, B, C,STRNPTS : STRING;   BEGIN "INITTURTLE; "PENCOLOR (NONE); "MOVETO (X[0],Y[0]); "PENCOLOR (WHITE); "KMINUS1 := K - 1; "I :LAR HYPERBOLA A = 15 *) $(* RSQR := SQR (A)/COS (2 * ANGLE); *) $(* IF (RSQR < 0) THEN RSQR := -RSQR; *) $(* R := SQRT (RSQR); *) $(* RSQR := SQR (A) * COS (2 * ANGLE); *) $(* IF (RSQR < 0) THEN RSQR := -RSQR; *) $(* R$(* ELLIPSE A = 85 *) $(* R := A * (1 + ((1/2) * COS (ANGLE))); *) $(* LIMACON A =105 *) $(* R := A * ((1/2) + COS (ANGLE)) *); $(* ARCHIMEDEAN SPRIAL ? *) $(* R := (A * ANGLE)/100; *) $(* RECTANGUSSIN * SIN (TIMESANGLE * ANGLE)); $X[K] := ROUND(R * COS (ANGLE)) +139; $Y[K] := ROUND(R * SIN (ANGLE)) + 95; $ANGLE := ANGLE + QDELTA; $K := K + 1; "UNTIL (K >= (NPTS + 1)) $(* CARDIOID A = 73 0) $(* R := A * (1 + COS (ANGLE)); *) RE PARAMETERS;   BEGIN "QSTART := 0; "QEND := 360; "QDELTA := (QEND - QSTART)/NPTS;  END;   PROCEDURE FUNCT;   VAR RSQR, ANGLE : REAL;   BEGIN "QDELTA := QDELTA/RADIAN; "ANGLE := QSTART/RADIAN; "K := 0; "REPEAT $R := A * COS (TIMEDLN (NPTS);  WRITELN ('INPUT B :'); "GOTOXY (30,3); "READLN (TIMESSIN); "WRITELN ('INPUT C :'); "GOTOXY (30,4); "READLN (TIMESANGLE); "IF (NPTS > MAXPOINTS) THEN NPTS := MAXPOINTS - 2;  END;    PROCEDU"WRITELN('R = A * (B * SIN (C * ANGLE)); '); "FOR BLANKLINES := 1 TO 10 DO " WRITELN(' '); "GOTOXY (0,0); "WRITELN; "WRITELN; "WRITELN ('INPUT INTERATIONS(0 TO QUIT):'); "GOTOXY (30,2); "REALENGTH > 0) $THEN &STG := CONCAT (INTEGERSTRING, '.', DECIMALSTRING) $ELSE &STG := INTEGERSTRING; "END; (* FIXSTRING *)   PROCEDURE READIN;   VAR BLANKLINES : INTEGER;    BEGIN "GOTOXY (0,0); ; "DECIMALSTRING := ''; "I := 1; "WHILE ((TESTSTRING [I] <> '0') AND (I <= (TESTLENGTH - 1))) DO &BEGIN (DECIMALSTRING := CONCAT (DECIMALSTRING, COPY (TESTSTRING, I, 1)); (I := SUCC (I); &END; "DECIMALLENGTH := LENGTH (DECIMALSTRING); "IF (DECIMAL DECIMALSTRING, TESTSTRING : STRING; $  BEGIN "INTEGERVALUE := TRUNC (NUMBER); "DECIMALVALUE := ROUND ((NUMBER - INTEGERVALUE ) * DECIMALPLACES); "STR (INTEGERVALUE, INTEGERSTRING); "STR (DECIMALVALUE, TESTSTRING); "TESTLENGTH := LENGTH (TESTSTRING)"PENCOLOR(NONE); MOVETO(L+3,B+2); "CHARTYPE(6); "WSTRING(S);  END;   PROCEDURE FIXSTRING (NUMBER : REAL; VAR STG : STRING);   CONST DECIMALPLACES = 100;   VAR INTEGERVALUE, DECIMALVALUE, DECIMALLENGTH, TESTLENGTH, I : INTEGER; $INTEGERSTRING,2+7*LENGTH(S); "B:=Y-2; T:=Y+10; "(* VIEWPORT(L,R,B,T) *); "(* FILLSCREEN(BLACK) *); "VIEWPORT(0,279,0,191);  PENCOLOR(NONE); MOVETO(L,B); "PENCOLOR(WHITE); MOVETO(L,T); "MOVETO(R,T); MOVETO(R,B); MOVETO(L,B); GIN (* MAIN *) "REPEAT " READIN; " IF (NPTS <> 0) THEN $ BEGIN " PARAMETERS; " FUNCT; (REPEAT ( WRITELN (' INTERVAL OF NPTS'); ( READLN (INTERVALNPTS); ( IF (INTERVALNPTS <> 0) THEN * BEGIN * PLOT (INTERVALNPTS); " READLN; " TEXTMODE;  END; (UNTIL (INTERVALNPTS = 0); &END; "UNTIL (NPTS = 0);  END.  "DECIMALLENGTH := LENGTH (DECIMALSTRING); "IF (DECIMALLENGTH > 0) $THEN &STG := CONCAT (INTEGERSTRING, '.', DECIMALSTRING) $ELSE &STG := INTEGERSTRING; "END; (* FIXSTRING *)   PROCEDURE READIN;   VAR BLANKLINES : INTEGER;    BEGIN "G (TESTSTRING); "DECIMALSTRING := ''; "I := 1; "WHILE ((TESTSTRING [I] <> '0') AND (I <= (TESTLENGTH - 1))) DO &BEGIN (DECIMALSTRING := CONCAT (DECIMALSTRING, COPY (TESTSTRING, I, 1)); (I := SUCC (I); &END; NTEGERSTRING, DECIMALSTRING, TESTSTRING : STRING; $  BEGIN "INTEGERVALUE := TRUNC (NUMBER); "DECIMALVALUE := ROUND ((NUMBER - INTEGERVALUE ) * DECIMALPLACES); "STR (INTEGERVALUE, INTEGERSTRING); "STR (DECIMALVALUE, TESTSTRING); "TESTLENGTH := LENGTHMOVETO(L,B); "PENCOLOR(NONE); MOVETO(L+3,B+2); "CHARTYPE(6); "WSTRING(S);  END;   PROCEDURE FIXSTRING (NUMBER : REAL; VAR STG : STRING);   CONST DECIMALPLACES = 100;   VAR INTEGERVALUE, DECIMALVALUE, DECIMALLENGTH, TESTLENGTH, I : INTEGER; $I"PENCOLOR(NONE); MOVETO(X,Y); "L:=X-3; R:=X+2+7*LENGTH(S); "B:=Y-2; T:=Y+10; "(* VIEWPORT(L,R,B,T) *); "(* FILLSCREEN(BLACK) *); "VIEWPORT(0,279,0,191);  PENCOLOR(NONE); MOVETO(L,B); "PENCOLOR(WHITE); MOVETO(L,T); "MOVETO(R,T); MOVETO(R,B); (X,Y: INTEGER; S: STRING);  (********************************)  (* *)  (* WRITE A STRING IN ERASED BOX *)  (* *)  (********************************)  VAR L,R,B,T: INTEGER;  BEGIN IVE := TRUE; &END $ELSE &XNEGATIVE := FALSE; "IF (X <> 0) $THEN $ Z := EXP (Y * LN (X)) $ELSE &Z := 0;  IF (XNEGATIVE) $THEN &BEGIN (IF (ODD (ROUND (Y))) *THEN ,Z := -Z; $END; "POWER := Z;  END; (* POWER *)   PROCEDURE BOXSTRING : INTEGER; $XFUN, YFUN :STRING; $X : ARRAY[0..MAXPOINTS] OF INTEGER; $Y : ARRAY[0..MAXPOINTS] OF INTEGER;   FUNCTION POWER (X, Y : REAL) : REAL;   VAR Z : REAL;  XNEGATIVE : BOOLEAN;   BEGIN "IF (X < 0) $THEN &BEGIN (X := -X; (XNEGATPROGRAM POLORGRAPH;   USES TURTLEGRAPHICS,TRANSCEND;   CONST RADIAN = 57.2957795;  XCENTER = 139; &YCENTER = 95;  MAXPOINTS = 2002;   VAR QSTART, QEND, QDELTA,  PANGLE, PDELTA, $A, B, $NPTS, R : REAL; $K, INTERVALNPTSN^F7OTOXY (0,0); "WRITELN(XFUN); "WRITELN(YFUN); "FOR BLANKLINES := 1 TO 14 DO " WRITELN(' '); "GOTOXY (0,3); "WRITELN ('INPUT INTERATIONS(0 TO QUIT):'); "GOTOXY (30,3); "READLN (NPTS);  WRITELN ('INPUT A(RAD OF INTER CIRCLE):'); "GOTOXY (30,4); "READLN (A); "IF (NPTS > MAXPOINTS) THEN NPTS := MAXPOINTS - 2;  END;    PROCEDURE PARAMETERS;   BEGIN "QSTART := 0; "QEND := 360; "IF (NPTS <> 0) THEN " QDELTA := (QEND - QSTART)/NPTS;  IF (B <>N^F7" TEXTMODE;  END; (UNTIL (B = 0); &END; "UNTIL (NPTS = 0);  END.  0,7); *WRITELN (' '); *GOTOXY (0,7); *WRITELN ('NUMBER OF FIGURES:'); ( GOTOXY (19,7); *READLN (B); ( IF (B <> 0) THEN * BEGIN " PARAMETERS; * PLOT (1); " READLN; TRG := YFUN; "BOXSTRING (3,2,STRG);   END;    BEGIN (* MAIN *) "XFUN := 'X = A * COS ** 3 (Q)'; "YFUN := 'Y = A * SIN ** 3 (Q)'; "B := 0; "REPEAT " READIN; $PARAMETERS; $IF (NPTS <> 0) THEN $ BEGIN " FUNCT; (REPEAT ( GOTOXY (STRING); "STRG := CONCAT ('A=',ASTRING); "BOXSTRING (3, 27,STRG); " (* "B" *) "FIXSTRING (B, BSTRING); "STRG := CONCAT ('B=',BSTRING); "BOXSTRING (3,157,STRG); " (* "X" *) "STRG := XFUN; "BOXSTRING (3,14,STRG);  (* "Y" *) "S"FIXSTRING (NPTS, STRNPTS); "STRG := CONCAT ('NPTS=',STRNPTS); "BOXSTRING (3,169,STRG); (* "INTERVAL" *) "FIXSTRING (INTERVALNPTS, STRNPTS); "STRG := CONCAT ('INTERVAL=',STRNPTS); "BOXSTRING (3,181,STRG); (* "A" *) "FIXSTRING (A, A *RY := Y[I] * COS (PANGLE) - X[I] * SIN (PANGLE); *PX := ROUND(RX + XCENTER); *PY := ROUND(RY + YCENTER); *MOVETO (PX, PY);  I := I + INTERVAL; $ END; " PANGLE := PANGLE + PDELTA; $END; "READLN; " (* "NPTS" *) * SIN (PANGLE); &PX := ROUND(RX + XCENTER); &PY := ROUND(RY + YCENTER); &MOVETO (PX, PY); " PENCOLOR (WHITE); " KMINUS1 := K - 1; " I := INTERVAL; " WHILE (I <= KMINUS1) DO $ BEGIN *RX := X[I] * COS (PANGLE) + Y[I] * SIN (PANGLE); ASTR, BSTRING, ASTRING, STRNPTS : STRING;   BEGIN "BINTEGER := ROUND (B); "INITTURTLE; "PANGLE := 0; "FOR J := 1 TO BINTEGER DO $BEGIN " PENCOLOR (NONE); " RX := X[0] * COS (PANGLE) + Y[0] * SIN (PANGLE); &RY := Y[0] * COS (PANGLE) - X[0]$Y[K] := ROUND (A * POWER (SIN (ANGLE), 3)) ; $ANGLE := ANGLE + QDELTA; $K := K + 1; "UNTIL (K >= (NPTS + 1)) $END;    PROCEDURE PLOT (INTERVAL : INTEGER);   VAR I, J, BINTEGER, KMINUS1,  PX, PY : INTEGER; $RX, RY : REAL; $STRG, RYSTRG, 0) THEN " PDELTA := 90/B/RADIAN;  END;  PROCEDURE FUNCT;   VAR ANGLE : REAL;   BEGIN "QDELTA := QDELTA/RADIAN; "ANGLE := QSTART/RADIAN; "K := 0; "REPEAT $X[K] := ROUND (A * POWER (COS (ANGLE), 3)) ;