`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JO^[[DIR.CODErE^oPTOGRAM.TEXTSPLTSCREEN.TEXTSPLTSCREEN.CODERANDALPHAX.TEXTRANDALPHAX.CODERANDALPHA1.TEXTRANDALPHA1.CODERANDALPHA2.TEXTRANDALPHA2.CODEDIR.TEXTrE^oEXTE^o PRINTSET.TEXT^oLOCASE.ART.TEXTFILEPATCH.TEXTo ROMTEST.CODE^o ROMTEST.TEXT^o MASTCAT.TEXT^o MASTCAT.CODE^oCAT.INTRO.TEXToCRYPTOGRAM.CODECRYXT^oY\^ CRAWLER1.CODE^oY^dWINDCHILL.TEXTodgWINDCHILL.CODEogmDEMOFUNCT1.TEXTmpDEMOFUNCT1.CODEpv ERASERS.TEXT^ovy ERASERS.CODE^oyPCNTSOLVER.TEXTPCNTSOLVER.CODE PR737.T(* POWER.CODEE^o*0DECIMALROM.TEXT03DECIMALROM.CODE39ADDFRACTNS.TEXT9<ADDFRACTNS.CODE<H DISC.TEXTrE^oHN DISC.CODErE^oNTSLOMESSAGE.TEXTTVSLOMESSAGE.CODEV\ CRAWLER1.TEPSCAL211[  LINEDEMO.TEXT^o[  LINEDEMO.CODE^o[  ROMANUMS.TEXT^o[ ROMANUMS.CODE^o[ TABDEMO.TEXT^oƠ TABDEMO.CODE^oƠ NOWDATE.CODE^o$ NOWDATE.TEXT^o$( POWER.TEXTE^ó7́8ʁ8́9ʁ9ˡ  not codeʁ81ʁ9"ˡ Bad block #01Ɓ5aݡ9צ Linking...ܡ #צMust L(ink firstƁ5ƀ:`ݤۼ: TڪƁƁ"áB̂2ʁ ʁ "ˡ%  Ɓ Ɓ^rުP"ˡCۡ>"áIllegal file nameצNo file ) (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&PROGRAM LINEDEMO;   (* by A. Tyro *)   VAR COUNT, (* Counter for lines *) (I:INTEGER;(*Loop index variable*)  PROCEDURE LINELIMIT; #VAR CH:CHAR; (*For space key*) #BEGIN (*Linelimit*) &COUNT:=COUNT + 1; (*Counts Lines*) &IF (COUNT=20)0; -'L': Y:= 50; -'C': Y:= 100; -'D': Y:= 500; -'M': Y:=1000; - ,END; (*case*) , ,BEGIN .IF Y < Z THEN , SUM:=SUM-Y  ELSE 1SUM:=SUM+Y; . Z:=Y; .P:=P-1;(*peeling letters 5from right to left*) ,END; (*sum statement*) )UN (*position of char in string*) )Y,Z,SUM :INTEGER; (*numerical values*) $BEGIN )WRITELN; )WRITELN ('ENTER ROMAN NUMERAL':29); )READLN (S); )P:= LENGTH (S); )SUM:=0; )Y:=0;Z:=0; )REPEAT ,CASE S[P] OF -'I': Y:= 1; -'V': Y:= 5; -'X': Y:= 1PROGRAM ROMANUMS;(*converts Roman numerals  to decimals*) $ $(* by Max J. Nareff *) $ $VAR 'CH :CHAR;(*for repeat control*)  $PROCEDURE TRANSLATE; (*converts the .letters after selection *) 'VAR )S :STRING; )P, N^[צ)Name of output file ( to return) -->ƂPƂáƂ̂.ʂ.ȡƂƂ۾ .TEXTƂƂƂȍƂƂ.˄%Ƃ̂.Ƃ.ƂPƂ..TEXTUƂ.PƂƂ.á ƂƂƂצ*SYSTEM.WRK.TEXTPáEPRESS SPACE BAR TO CONTINUE š`Aȡ,LINE- 3FL  RáEáꥂNWá" LINEDEMO it-Main*) #COUNT :=0; (* Init. Counter *) #FOR I :=1 TO 65 DO (*Print loop *) &BEGIN (*Loop*) )WRITELN('LINE-':25,I:2); )LINELIMIT; &END; (*Loop*)  END. (*Linedemo*)  THEN )BEGIN (* 20 line action*) ,WRITELN('PRESS SPACE BAR TO CONTINUE':31); ,READ(CH); ,PAGE(OUTPUT); (*Clears screen*) )END (* 20 line action*) &ELSE )IF (COUNT>20) THEN ,COUNT:=0; (*Reinitialize*)  END; (* Linelimit*) &  BEGIN (*LinelimTIL (P=0); )WRITELN (S:14,' = ',SUM:7); )WRITELN; $END; (*translate*) ,  BEGIN (*main block*) $WRITELN (CHR(12)); (*clears screen*) $REPEAT )TRANSLATE; )WRITE )('ANOTHER NUMERAL?--Y/N':31); )READ (KEYBOARD,CH); )WRITELN (CHR(12)); $UNTIL (CH='N'); $WRITELN ('THE END':23)   END. (*of program*) , le *)   GOTOXY(9,18);  WRITE ('APPLE');  WRITELN ('(TABS 9 THEN PRINTS)':24);  WRITE ('APPLE':9);  WRITELN ('(ENDS PRINT AT COL. 9)':29);   END. (* program *) ELN ('WRITELN:':9,'GOTOXY':30);  FOR N:= 0 TO 10 DO $BEGIN &GOTOXY(35,N+4); &WRITELN(N); (* 1st char. at 35 *) $END;   GOTOXY(0,4); (* move cursor up/left *)  FOR N:= 0 TO 10 DO $BEGIN &WRITELN(N:5); (* max. field=5 *) $END;   (* string sampPROGRAM TABDEMO;   (* by A. Tyro *)  (* modified by G.W. *)   (*Demonstrates the difference between "the field tab of GOTOXY(X,Y) and the "WRITELN('':) *) " #VAR N : INTEGER; (* loop index *) #  BEGIN (* examples *)   WRITELN;  WRITN^ƠƠZ׶ ANOTHER NUMERAL?--Y/N NáTHE ENDb ~̂.Ƃ.ƂPƂ..TEXTUƂ.PƂƂ.á ƂƂƂצ*SYSTEM.WRK.TEXTPENTER ROMAN NUMERALP-*,+-',V,Q ,L2,Gd,B,;,4CX, ;2# "$&P*O,+ɡ *,**,*,+---á = * " ROMANUMS  TABDEMO and converts it into the string #parameter S *) # ((* by JEFFREY Y. SUE 8 JUN 80 *)   CONST #MASDIR =77; (* max number of entries in a directory *) #VIDLENG = 7; (* number of chars in a volume id *) #DIRBLK = 2; (* disk address olater output. *)   VAR CURRENT:STRING; (* Will be passed to procedure DATE *)    PROCEDURE DATE(VAR S:STRING);   (* This procedure reads the date stored in the first block of the #disk directory by the filer,PROGRAM NOWDATE;  (* Procedure date by Jeffrey Sue-Envelope by Gene Wilson*)  (* Procedure can be used easily in any of your programs, #and will give current date strored by Filer. Remember #to declare a VARiable of type STRING which can be used #in N^ƠRRXutput file ( to return) -->ƂPƂáƂ̂.ʂ.ȡƂƂ۾ .TEXTƂƂƂȍƂƂ.˄%Ƃ̂.Ƃ.ƂPƂ..TEXTUƂ.PƂƂ.á ƂƂƂצ*SYSTEM.WRK.TEXTP6$JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDECƀ ƀP _P    P ̀ƀ_Pƀצ Qƀ6ǡƀצ Ǣƀ ƀPACurrent date in Filer is H"@* NOWDATE  GC .צE&Save as :. ? 瓡צSave asצ[š C?/צTEXT#CODE#饀!׶WRITELN: GOTOXY ȡ #  ȡ  צAPPLE(TABS 9 THEN PRINTS)APPLE צ(ENDS PRINT AT COL. 9)"f directory *) #  TYPE   (* archival info...the date *) 0 " DATEREC = PACKED RECORD .MONTH: 0..12; (* 0 implies date not meaningful *) .DAY : 0..31; (* day of month *) .YEAR : 0..100; (* 100 is temp disk flag *) -END; (* daterec *) # # (* disk directories *) #DIRRANGE= 0..MASDIR; #DIRENTRY= PACKED RECORD # DFIRSTBLK :INTEGER; (* first physical disk addrB); &ATOPOWEROFB := EXP(B*LN(A)); &WRITELN(ATOPOWEROFB:15:2); &(* Tabs result to 15 minimum field width )and mantissa to 2 digits*)  WRITELN; &WRITELN('Another value? -->Y/N'); &READ (KEYBOARD,CH); #UNTIL (CH='N') OR (CH='n')  END. #ATOPOWEROFB := 0;(*Initialize *) #REPEAT &PAGE(OUTPUT); (* Clear screen*) &GOTOXY(5,10); (* Tabs to x,y *) &WRITELN('EXAMPLE OF EXPONENTIATION'); &WRITELN; &WRITE('ENTER NUMBER TO BE RAISED: '); &READLN(A); &WRITE('To what power?: '); &READLN(PROGRAM POWER;  (* Demonstrates exponentiation by use " of EXP & LN* - by A. Tyro *)  (* REPEAT..UNTIL Loop added by Gene Wilson *)  USES TRANSCENT;  VAR #ATOPOWEROFB,A,B: REAL;  CH : CHAR; (* Loop control *)  BEGIN O^[is ',CURRENT)  END.(*Sample*)  $STR(DAY,D); (* convert day to string *) $STR(YEAR,Y);(* convert year to string*) $ $S:=CONCAT(D,' ',M,' ',Y); $ "END; (* with a.blastboot *) "  END; (* date *)   BEGIN (*Sample Program*)  DATE(CURRENT);  WRITELN('Current date in Filer re *)  "(* read first entry in disk directory *)  "UNITREAD(4,A,SIZEOF(DIRENTRY),DIRBLK);  "WITH A.DLASTBOOT DO  BEGIN " $(* convert month number to month name *) $M:=COPY('JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC', 'MONTH*3-2,3); $ 1DNUMFILES: DIRRANGE; (* num files in dir *) 1DLOADTIME: INTEGER; (* time of last access *) 1DLASTBOOT: DATEREC; (* most recent date set *) .END; (* direntry *)   VAR "A :DIRENTRY; "D,M,Y :STRING; "  BEGIN (* date procedu *) .DLASTBLK :INTEGER; (* points at block following *) 0(* only in DIR[0]...VOLUME INFO *) 0FILLER1 : 0..2048;(* for downward compatibility, E13 bits *) 1DVID:STRING[VIDLENG];(* name of disk volume *) 1DEOVBLK: INTEGER; (* lastblk of volume *) V POWER Enter Year->Range:1-3000':32); $WRITELN; $WRITE(' ':10); $READLN (DIGITS); $ANALYZE (DIGITS); $WRITELN;WRITELN; $WRITELN $('Another Conversion?-->Y/N':32); $READ (KEYBOARD,CH); $WRITELN; "UNTIL (CH='N'); "WRITELN ('The End':23)  END. (* PROGRA00; "T:=X MOD 1000 MOD 100 DIV 10; "S:=X MOD 1000 MOD 100 MOD 10; "IF DIGITS>0 THEN %SELECTROMANUM;  END; (* ANALYZE *)     BEGIN (* MAIN PROGRAM *) "PAGE(OUTPUT); "WRITELN "('DECIMAL TO ROMAN NUMERAL':32); "WRITELN; "REPEAT $WRITELN $('(3: WRITE('III' ); (4: WRITE('IV' ); (5: WRITE('V' ); (6: WRITE('VI' ); (7: WRITE('VII' ); (8: WRITE('VIII'); (9: WRITE('IX' ); " END; (* CASE S *) "END; (* SELECTROMANUM *) '  BEGIN (* ANALYZE *) "M:=X DIV 1000; "D:=X MOD 1000 DIV 1X' ); (3: WRITE('XXX' ); (4: WRITE('XL' ); (5: WRITE('L' ); (6: WRITE('LX' ); (7: WRITE('LXX' ); (8: WRITE('LXXX'); (9: WRITE('XC' ); 'END; (* CASE T *) $ $IF S>0 THEN 'CASE S OF (1: WRITE('I' ); (2: WRITE('II' ); 2: WRITE('CC' ); (3: WRITE('CCC' ); (4: WRITE('CD' ); (5: WRITE('D' );  6: WRITE('DC' ); (7: WRITE('DCC' );  8: WRITE('DCCC'); (9: WRITE('CM' ); 'END; (* CASE D *)  $IF T>0 THEN 'CASE T OF (1: WRITE('X' ); (2: WRITE('XZE(X:RANGE); "VAR $M,D,T,S :INTEGER; $ "PROCEDURE SELECTROMANUM; "BEGIN $IF M>0 THEN 'CASE M OF (1: WRITE('M' :18); (2: WRITE('MM' :19); (3: WRITE('MMM' :20); 'END; (* CASE M *)   IF D>0 THEN 'CASE D OF (1: WRITE('C' );  PROGRAM DECIMALROM;   (*Converts decimals to Roman Numerals*)   (* by Max J. Nareff, San Francisco, CA /6/80 *) /  TYPE RANGE = 0..3000;   VAR DIGITS :RANGE;  CH :CHAR; (* REPEAT CONTROL *) & &  PROCEDURE ANALYN^>Y/N NnÍS@>&N̂.ʂ.ȡƂƂ۾ .TEXTƂƂƂȍƂƂ.˄%Ƃ̂.Ƃ.ƂPƂ..TEXTUƂ.PƂƂ.á ƂƂƂצ*SYSTEM.WRK.TEXTP  צEXAMPLE OF EXPONENTIATIONENTER NUMBER TO BE RAISED: To what power?: Another value? --"*M *)    (  DECIMALR &D3:=D3 DIV Y; $END "ELSE $BEGIN &X:=Y; &Y:=COMMONFACTOR; &RESTRUCTURE; $END  END; (*RESTRUCTURE*)    PROCEDURE PRINTOUT;  BEGIN "IF (D3=1) THEN %WRITELN %('THE SUM OF THE TWO FRACTIONS= ',N3) "ELSE %WRITELN %('THE SUM OF THE TWO FRACT"X :=N3; "Y :=D3;  END; (*COMMONBASE*)    PROCEDURE RESTRUCTURE;   VAR "QUOTIENT, "COMMONFACTOR :INTEGER;   BEGIN (*RESTRUCTURE*) "QUOTIENT:=X DIV Y; "COMMONFACTOR:=X-(QUOTIENT * Y); "IF (COMMONFACTOR = 0) THEN $BEGIN &N3:=N3 DIV Y; .............'); "READ (NUMER1,DENOM1); "WRITE $('ENTER SECOND FRACTION SIMILARLY:'); "READ (NUMER2,DENOM2);  END; (* DATAENTRY *)    PROCEDURE COMMONBASE;  BEGIN "N3:=0; D3:=0; "N3:=(DENOM2*NUMER1) + (DENOM1*NUMER2);  D3:=(DENOM1*DENOM2); N3,D3 :INTEGER; "CH :CHAR; (* ESCAPE CONTROL *) "X,Y :INTEGER; (* REPLACEMENT VARS *)    PROCEDURE DATAENTRY;  BEGIN "WRITELN; "WRITELN  ('ENTER FIRST FRACTION AS 2 INTEGERS'); "WRITE $('SEPARATED BY A :PROGRAM ADDFRACTNS;   (* Adds fractions. Adapted to Pascal from  a "Basic Approach to Basic", by Henry  Mullish, 1976. *)   (* Prepared by Max J. Nareff, San Francisco, 3CA. 6/80 *)    VAR "NUMER1,DENOM1, "NUMER2,DENOM2, "N^ear->Range:1-3000   Ǹ Another Conversion?-->Y/N NáThe End RIIIyצIViV]צVIMצVII<VIII*IX |m_UG8( rtvdd d šM6׶ DECIMAL TO ROMAN NUMERAL Enter YXXXXXXyצXLiL]צLXMצLXX<LXXX*XC |m_UG8(šIIIIIIyצIViV]š?-M.MMMMM 4*šCCCCCCyצCDiD]צDCMצDCC<DCCC*CM |m_UG8(š"IONS= ', %N3,'/',D3);  END; (*PRINTOUT*)     BEGIN (*MAIN*) "PAGE (OUTPUT); "WRITELN('THE SUM OF FRACTIONS':30); "WRITELN; "REPEAT $DATAENTRY; $COMMONBASE; $RESTRUCTURE; $PRINTOUT; $WRITELN; $WRITELN $('ANOTHER CALCULATION?-->Y/N':32); $READ (KEYBOARD,CH); $PAGE(OUTPUT); "UNTIL (CH='N'); "WRITELN('THE END':23)  END. (* PROGRAM *)   ITELN;  WRITE('It displays the information in');  WRITELN(' both ASCII and HEX format.');  WRITE('The ASCII format displays only');  WRITELN(' the printable characters, con-');  WRITE('verting all others to a "!"');  WRITELN(' The HEX format convert,N : INTEGER; $QUIT,FIRST,FLAG : BOOLEAN; $OFFSET,INDEX : INTEGER; $INPCH,CH : CHAR; $  PROCEDURE PROMPT;   VAR INPCH : CHAR;   BEGIN  PAGE(OUTPUT);  WRITE('This program allows access to any');  WRITELN(' block on either of the disks.');  WRPROGRAM DISC;  (* #written by Steve Lloyd $and given to the San $Francisco Apple Core "for general distribution  *)   VAR BUFFER : PACKED ARRAY[0..4095] OF CHAR; $UNIT0,DRIVE,BLOCK0,BLOCK1 : INTEGER; $USRBLK,DSKBLK,BUFBLK : INTEGER; $I,J,K,L,MN^Ƞá  ث I.á>צTHE SUM OF THE TWO FRACTIONS=  PצTHE SUM OF THE TWO FRACTIONS=  / C׶ THE SUM OF FRACTIONSANOTHER CALCULATION?-->Y/N   NáצTHE ENDt` ECOND FRACTION SIMILARLY:  폂쏫 "á  ث I.á>צTHE SUM OF THE TWO FRACTIONS=  PצTHE SUM OF THE TWO FRACTIONS=  / C׶ THE SUM OF FRACTIONS"ENTER FIRST FRACTION AS 2 INTEGERS"SEPARATED BY A :.............   ENTER SECOND FRACTION SIMILARLY:  폂쏫 "" ADDFRACT s every ');  WRITELN('byte to its equivalent hexidecimal form.');  WRITELN;  WRITE('The output will begin with the');  WRITELN(' specified block and continue');  WRITE('to the end of the disk. You may');  WRITELN(' terminate the listing at the ');  WRITE('end of a screen simply by press');  WRITELN('ing ESC. To continue listing ');  WRITELN('press the SPACE BAR.');  WRITELN;  END;    PROCEDURE GETBUF;   BEGIN   IF NOT(FIRST) THEN "BEGIN "INPCH := ' '; "WHILE (INPCH<>'Y') AND (INP; "READLN; "END;  END. (* DISC *)   FIRST := FALSE;  WHILE FLAG AND NOT(QUIT) DO "BEGIN "SHOW; "PROMPT; "GETBUF; "END;  IF QUIT THEN "BEGIN "PAGE(OUTPUT); "WRITE('PLEASE CHECK DISK.'); "WRITELN(' ERROR IN READING DISK.'); "WRITELN; "WRITELN('Press RETURN to return to system.')&BEGIN &PAGE(OUTPUT); &WRITE('PLEASE CHECK DISK.'); &WRITELN(' ERROR IN READING DISK.'); &UNITREAD(UNIT0,BUFFER,4096,DSKBLK); " END; $END; "END;  END; (* SHOW *) "  BEGIN  FIRST := TRUE;  FLAG := TRUE;  QUIT := FALSE;  PROMPT;  GETBUF; $END;  "USRBLK := USRBLK + 1; "BUFBLK := BUFBLK + 1; "IF BUFBLK=8 THEN $BEGIN $BUFBLK := 0; $DSKBLK := DSKBLK + 8; $IF DSKBLK=280 THEN &BEGIN $ DSKBLK := 0; $ USRBLK := 0; &END; $UNITREAD(UNIT0,BUFFER,4096,DSKBLK); $WHILE IORESULT<>0 DO HILE INPCH<>ESCAPE DO "BEGIN $(* 2 SCREENS 256 BYTES PER SCREEN *) $FOR K := 0 TO 1 DO $BEGIN $IF INPCH<>ESCAPE THEN &BEGIN &SHOWBUF; &READ(INPCH); &WRITELN; &WRITE('PRESS: SPACE BAR to'); +WRITELN(' continue ESC to terminate'); &END; $IF M>127 THEN M := M - 128; $IF (M>31) AND (M<127) THEN &WRITE(CHR(M)) ELSE (WRITE('!'); $END; "WRITELN; "END;  END;    PROCEDURE SHOW;   VAR ESCAPE : CHAR;   BEGIN  ESCAPE := CHR(27);  INPCH := ' ';  BUFBLK := (USRBLK - DSKBLK);  W '); "OFFSET := BUFBLK*512 + INDEX; " "(* HEX DUMP *) "FOR J := 0 TO 15 DO $BEGIN $N := OFFSET + J; $HEX(ORD(BUFFER[N])); $END; "WRITE(' '); " "(* ASCII DUMP *) "FOR J := 0 TO 15 DO $BEGIN $N := OFFSET + J; $M := ORD(BUFFER[N]); OTOXY(23,2); WRITE('HEX DUMP');  GOTOXY(60,2); WRITE('ASCII DUMP');  GOTOXY(0,3); WRITE('====');  GOTOXY(23,3); WRITE('========');  GOTOXY(60,3); WRITELN('==========');   FOR I := 0 TO 15 DO "BEGIN "INDEX := K*256 + I*16; "WRITE(INDEX:4,' :(CHS[B+1]) ELSE $WRITE('?');  WRITE(' ');  END; (* HEX *)    PROCEDURE SHOWBUF;   BEGIN  PAGE(OUTPUT);   (* DISPLAY SCREEN HEADER *)  WRITE('UNIT = ',UNIT0);  WRITELN(' BLOCK = ',USRBLK);  WRITELN;  GOTOXY(0,2); WRITE('INDEX');  G (* DISPLAY N AS A HEX STRING *)   VAR A,B : INTEGER; $CHS : STRING[16]; $  BEGIN  CHS := '0123456789ABCDEF';  A := TRUNC(N/16);  B := N-A*16;  IF (A>=0) AND (A<=15) THEN "WRITE(CHS[A+1]) ELSE $WRITE('?');  IF (B>=0) AND (B<=15) THEN "WRITE DRIVE <1..2> '); $READLN(UNIT0); $IF UNIT0=1 THEN UNIT0 := 4; $IF UNIT0=2 THEN UNIT0 := 5; " END; " "UNITREAD(UNIT0,BUFFER,4096,DSKBLK); "IF IORESULT<>0 THEN QUIT := TRUE; "END;   END; (* GETBUF *)    PROCEDURE HEX(N : INTEGER); G THEN "BEGIN "USRBLK := -1; "WHILE (USRBLK<0) OR (USRBLK>279) DO $BEGIN $WRITE('ENTER BEGINING BLOCK <0..279> '); $READLN(USRBLK); " END; "DSKBLK := 8 * TRUNC(USRBLK/8); " "UNIT0 := 0; "WHILE (UNIT0<>4) AND (UNIT0<>5) DO $BEGIN $WRITE('WHICHCH<>'y') $AND (INPCH<>'N') AND (INPCH<>'n') DO $BEGIN $WRITE('DO YOU WISH TO LOOK AT '); +WRITE('ANOTHER BLOCK ? '); $READ(INPCH); $IF (INPCH='Y') OR (INPCH='y') THEN &FLAG := TRUE ELSE (FLAG := FALSE; $WRITELN; $END;  END;   IF FLAx DISC N^ DISK.!Press RETURN to return to system.( >J\ RESS: SPACE BAR to continue ESC to terminate   áá "ˡd PLEASE CHECK DISK. ERROR IN READING DISK.At9` צPLEASE CHECK DISK.צ ERROR IN READINGpx  ˡ  ȡyˡhPRESS: SPACE BAR to continue ESC to terminate   ááצ ==========ȡ  צ : ȡ!  צ ȡX   š ǀ ũ Ʉ  ! ?  UNIT =  צ BLOCK =  צINDEXצHEX DUMP< ASCII DUMPצ============< ˩˄JWHICH DRIVE <1..2>  áá"ˡ upצ0123456789ABCDEFȄ ?ȄU Y˩y˄N˄n˄rצDO YOU WISH TO LOOK AT ANOTHER BLOCK ? YéyÍ ɩ ō?ENTER BEGINING BLOCK <0..279>  block and continue to the end of the disk. You may terminate the listing at the end of a screen simply by pressצing ESC. To continue listing צpress the SPACE BAR.intable characters, con-צverting all others to a "!" The HEX format converts every צ(byte to its equivalent hexidecimal form.צThe output will begin with theצ specified  !This program allows access to anyצ block on either of the disks.צIt displays the information inצ both ASCII and HEX format.The ASCII format displays only the pr"PROGRAM SLOMESSAGE;   (* Repeats short string at slow speed, #line after line. Abort by keypress, #by Max J. Nareff, San Francisco, Ca., .8/80  *)   USES APPLESTUFF; (* for keypress function*)  VAR #S :STRING; #L,N :INTEGER; #ANYCHAR:N^YYpXzC .צE&Save as :. ? 瓡צSave asצ[š C?/צTEXT#CODE#饀!ȡ,--ȡ&,,, š.Sp] zf #ENTER SHORT MESSAGE:ANY KEY TO STOP%P%"@*$ SLOMESSA #WRITELN(CHR(12)); (*clearscreen*) #WRITELN  ('ENTER SHORT MESSAGE:ANY KEY TO STOP':37); #READLN(S); #SNAIL(0,4,37)  END. (*program*) # - (*one more for ^ space*) %IF (X>Z) THEN (*emulate PEEK(36) in 5Basic*) 1 (*for rt. margin*) *BEGIN -X:= 0; -Y:= Y+1; *END; (*if*) %UNTIL KEYPRESS; %READ(KEYBOARD,ANYCHAR); "END; (*snail*) "  BEGIN (*main*) PEAT %N:= 1; (*initialize to start of S*) %L:= LENGTH(S); %GOTOXY(X,Y); %FOR I:= 1 TO L DO 'BEGIN *WRITE(S[N]); *DELAY(250); *N:= N+1; (*next letter*) *X:= X+1; (*counts HTABS*) 'END; (*loop*) %WRITE(' '); (*space after string*)  X:= X+1; CHAR; (*repeat control*)   PROCEDURE DELAY(X:INTEGER); #VAR I:INTEGER; (*loop index var.*)  BEGIN #FOR I:=1 TO X DO  END; (*delay*)   PROCEDURE SNAIL(X,Y,Z:INTEGER);  (*Z=rt. margin parameter*) #VAR I:INTEGER;(*loop index var.*)  BEGIN #REPROGRAM CRAWLER1;   (*Repeats short string, one char at a  time, creeping slowly to left. Abort "by keypress... 'by Max J. Nareff, San Francisco /8/80  *)   USES APPLESTUFF; (*for keypress function*)  VAR "S:STRING; "ANYCHAR:CHAR; (*repeatN^' pTzrn) -->ƂPƂáƂ̂.ʂ.ȡƂƂ۾ .TEXTƂƂƂȍƂƂ.˄%Ƃ̂.Ƃ.ƂPƂ..TEXTUƂ.PƂƂ.á ƂƂƂצ*SYSTEM.WRK.TEXTPȡȡJۛdɡɡ  ',td  ~e #Enter Short Message:Any Key to Stop%P"@*( CRAWLER1 "WRITELN  ('Enter Short Message:Any Key to Stop':37); "READLN(S); "SPELLER(39,12);  END. (*program*) $ + +   *creep 1 space to left*) *IF (X<1) THEN ,BEGIN .WRITE(CHR(12)); .X:= 39; (*restart line at RT*) ,END; (*if*) &END;(*loop*) $UNTIL KEYPRESS; $READ(KEYBOARD,ANYCHAR); "END;(*speller*) "  BEGIN (*main*) "WRITELN(CHR(12));(*clearscreen*) 1; (*init. char. counter*) &L:= LENGTH(S); &P:= L; (*peels chars from S *) &FOR I:= 1 TO L DO (BEGIN *GOTOXY(X,Y); *WRITE(S[P]); *DELAY(100); *N:=N+1; *P:=P-1;(*peels chars R-L*) *IF (LB̳>t>ffV<슐B :킫šꂫšn )The End 6@FLצActual Thermometer Reading (F)#  킫š'.......................................צ Equivalent Chill Temperature (F)(צ'.......................................b צ צ Upper Value:$ צStep Rise:(1,5,10,etc.):$ E~'***************************************צV-MPH:צActual Thermometer Reading (F)#  CHART ENTRIES-LOW-HIGH-STEP RISE&Temperature(F):Lower Value:$ צ Upper Value:$ צStep Rise:(5,10,etc.):$ צWind Velocity:Lower Value:$" * WINDCHIL BEGIN (*main*) "VALUES; "CHARTHEADERS; "COMPUTCHILL; "WRITELN ('The End':23)  END.  CHILLTEMP:=91.4-(0.288*SQRT(LOWV) 4+0.45-0.019*LOWV) 4*(91.4-LOWT); )WRITE  (ROUND(CHILLTEMP):6,':'); )LOWT:=LOWT + STEPT;(*steps up*) 'UNTIL (LOWT > HIT); 'WRITELN; 'LOWV:=LOWV + STEPV;(*steps up*) %UNTIL (LOWV > HIV); #END; (*computchill*) ! ...................'); %(*adjust line length*) #END;(*chartheaders*) # !PROCEDURE COMPUTCHILL; #VAR %CHILLTEMP :REAL; #BEGIN %REPEAT (*outer loop*) 'LOWT:=ORIGLOWT; (*initialize*) 'CHILLTEMP:=0; (*initialize*) 'WRITE (LOWV:2,':->'); 'REPEAT )%REPEAT  WRITE (LOWT:7); 'LOWT:= LOWT + STEPT; %UNTIL (LOWT>HIT); %WRITELN; %WRITELN  ('.......................................'); %(*adjust line length*) %WRITELN ('Equivalent Chill Temperature (F)':40); %WRITELN  ('....................OCEDURE CHARTHEADERS; (*formats chart*) #BEGIN %WRITELN  ('***************************************'); %(*adjust line length*) %WRITE('V-MPH:'); %WRITELN  ('Actual Thermometer Reading (F)':35); %LOWT:=ORIGLOWT; (*initialize*) %WRITE(' '); %WRITE &('Step Rise:(5,10,etc.):':36); %READLN(STEPT); %WRITE  ('Wind Velocity:Lower Value:':36);  READLN (LOWV); %WRITE('Upper Value:':36); %READLN (HIV); %WRITE &('Step Rise:(1,5,10,etc.):':36); %READLN (STEPV); #END; (*values*) "  PR(*velocity ranges*) $:INTEGER; $  PROCEDURE VALUES; #BEGIN %PAGE (OUTPUT); %WRITELN  ('CHART ENTRIES-LOW-HIGH-STEP RISE':38); %WRITELN; %WRITE  ('Temperature(F):Lower Value:':36); %READLN (ORIGLOWT); %WRITE('Upper Value:':36); %READLN (HIT);  --VBצOriginal Price Discount (%)dAt Saleprice ofצ Savings= (A Demonstration of the use of a FunctionAnother Bargain?->Y/N:NáצTotal Saved at Sale =The EndڪP = --VBצOriginal Price Discount (%)dAt Saleprice ofצ Savings="*  DEMOFUNC $WRITELN; "UNTIL (CH ='N'); "(*Max: I changed format here to continue $on any keypress except 'N'. Gene*) "WRITELN  ('Total Saved at Sale =':27, TOTALSAVED:5:2); "WRITELN ('The End':23);  END. " $    % :2);  END;(*register*)   BEGIN (*main*) "PAGE (OUTPUT); (*clears screen*) "TOTALSAVED := 0; "WRITELN  ('A Demonstration of the use of a Function'); "WRITELN; "REPEAT $REGISTER; $WRITE ('Another Bargain?->Y/N:':30); $READ (KEYBOARD,CH); GPRICE := ENTER ('Original Price'); "DISCOUNT := ENTER ('Discount (%)'); "SAVING := ORIGPRICE*(DISCOUNT/100); "SALEPRICE := ORIGPRICE-SAVING; " "TOTALSAVED:=TOTALSAVED+SAVING; " "WRITELN  ('At Saleprice of',SALEPRICE:5:2, -' Savings=',SAVING:5SE); "ENTER := RESPONSE;  END;(*enter*)   PROCEDURE REGISTER; "VAR ORIGPRICE,DISCOUNT,SAVING, &SALEPRICE :REAL;   BEGIN $(*initializing variables*) "ORIGPRICE := 0; "DISCOUNT := 0; "SALEPRICE := 0; "SAVING := 0; &(*computations*) "ORIPROGRAM DEMOFUNCT1;   (*Demonstrates use of a Function. %by Max J. Nareff, 9/80  *)  VAR CH:CHAR; (*repeat control*) %TOTALSAVED:REAL; %  FUNCTION ENTER (STR:STRING):REAL; "VAR RESPONSE :REAL; "  BEGIN "WRITE (STR:20,' = '); "READLN (RESPON (A Demonstration of the use of a FunctionAnother Bargain?->Y/N:NáצTotal Saved at Sale =The EndN^ ȡ$ȡ.צ Line # -> צDemo #1-Clear screen from צ line 10 downצ Press Return"N ERASERS #END;(*demo2*) #  BEGIN (*main*) "WRITELN(CHR(12)); "DEMO1; "DEMO2; "GOTOXY(0,12); "WRITELN('The End.':23);  END.  %WRITELN('Press Return to':27); #END;(*end*) # "PROCEDURE DEMO2; #BEGIN %WRITE('Demo #2-Clear screen top '); %WRITELN('to line 10'); %READLN; %CLEARTO(10); %GOTOXY(0,18); %WRITELN('Now erase the board.':30); %READLN; %WRITE(CHR(12)); DEMO1; #BEGIN %FOR I:= 0 TO 18 DO 'BEGIN (WRITELN('Line # ->':22,I:2); 'END; %WRITELN; %WRITE '('Demo #1-Clear screen from ');  WRITELN('line 10 down');  WRITELN('Press Return':26); %READLN; %CLEARFROM(10); %WRITELN('It Works!':23); EOL(LINE:INTEGER); #BEGIN %GOTOXY(0,LINE); %WRITE(CHR(29)); #END;(*cleareol*) # "PROCEDURE CLEARTO(LINE:INTEGER); %VAR I:INTEGER; % #BEGIN %FOR I:= 0 TO LINE DO 'BEGIN (GOTOXY(0,I); (CLEAREOL(I); & END;(*do*) #END;(*clearto*)  "PROCEDURE PROGRAM ERASERS; # #(* by Max J. Nareff *) #(* Beginner's Notes-->On Erasing the Page*) # #VAR I:INTEGER; # "PROCEDURE CLEARFROM(LINE:INTEGER); #BEGIN %GOTOXY(0,LINE); %WRITE(CHR(11)); #END;(*clearfrom*) # "PROCEDURE CLEAR  It Works!צPress Return toDemo #2-Clear screen top צ to line 10 צNow erase the board. e׶  צThe End.BH. $ȡ.צ Line # -> צDemo #1-Clear screen from צ line 10 downצ Press Return PCNTSOLV While*)  END; (*Pencil*)   BEGIN (*Main*) "PAGE (OUTPUT); "PENCIL; "WRITELN ('The End':23);  END.  N ,A := ALPHA (' Enter Amount'); ,P := ALPHA (' Enter Percent'); ,B := BASE (A,P); *END; (* Z *) &END; (* CASE *)  WRITELN  (A:10:2,' IS ',P:4:2,' % OF ',B:4:2); &WRITELN; &WRITE ('X,Y, OR Z ?':25); &READ (KEYBOARD,CH); &WRITELN; "END; (*SE CH OF ('X': *BEGIN ,B := ALPHA ('Enter Base'); ,P := ALPHA ('Enter Percent'); ,A := AMOUNT (B,P); *END; (* X *) ('Y': *BEGIN ,A := ALPHA (' Enter Amount'); ,B := ALPHA (' Enter Base'); ,P := PERCENT (A,B); *END; (* Y *)  'Z': *BEGI"WRITELN  ('[Y] Y is X% of Base (A is what% of Base)'); "WRITELN  ('[Z] A is P% of X (A is P% of what?)'); "WRITELN; "WRITE  ('Select problem solver:(Other CH to Leave)'); "READ (KEYBOARD,CH); "PAGE (OUTPUT); "WHILE (CH IN CHOICE) DO $BEGIN &CA  PROCEDURE PENCIL;  BEGIN "CHOICE := ['X'..'Z']; "WRITELN $('A(mount) IS P % OF B)ase':32); "WRITELN; "WRITELN  (' This program solves percent problems'); "WRITELN ('such as....'); "WRITELN  ('[X] X is P% of Base (What is P% of Base)'); 00; "AMOUNT := X;  END; (*Amount*)   FUNCTION PERCENT (A,B:REAL):REAL;  BEGIN "X := (100*A)/B; "PERCENT := X;  END; (*Percent*)   FUNCTION BASE (A,P:REAL):REAL;  BEGIN "X := (100*A)/P; "BASE := X;  END; (*Base*)  "(*Selecton and Output*) :CHAR; %(*Data Input*)  FUNCTION ALPHA (S:STRING):REAL; "VAR REPLY:REAL;  BEGIN "WRITE (S:23,'>>'); "READLN (REPLY); "ALPHA := REPLY;  END; (*ALPHA*)  "(*Computation for each problem*)  FUNCTION AMOUNT (B,P:REAL):REAL;  BEGIN "X := (B*P)/1PROGRAM PCNTSOLVER;  (*Solves percent problems. $by Max J. Nareff, 9/80 *) $  TYPE "CHOICESET = SET OF CHAR; "  VAR "CHOICE :CHOICESET; (*Menu Selection*) "A, (*Amount*) "P, (*Percent*) "B, (*Base*) "X (*Temp Hold*) :REAL;  CH O^  It Works!צPress Return toDemo #2-Clear screen top צ to line 10 צNow erase the board. e׶ "*ڪP>>--V@d  d  d  צA(mount) IS P % OF B)ase צ'  WHITE MANUAL INDICATES THAT RESET WOULD  ALSO WORK. IT AIN'T SO. A RUN-TIME  ERROR RESULTS.*)   CASE ANSWER OF " "'A':BEGIN 'S^:=CHR(ESCAPE);PUT(S); 'S^:=CHR(NORMAL);PUT(S) &END; " "'B':BEGIN 'S^:=CHR(ESCAPE);PUT(S); 'S^:=CHR(PROPORTIONALLN('PRESS ANY OTHER KEY TO EXIT PROGRAM.');   READ(KEYBOARD,ANSWER);   IF NOT (ANSWER IN ['A','B','C'])  THEN EXIT(PR737);   REWRITE(S,'PRINTER:');  (*HERE IS THE CRUX OF THE PROGRAM. HOW TO  SEND OUTPUT TO THE PRINTER. PG.133 OF THE OUTPUT);  GOTOXY(0,8);  WRITELN('SELECT THE PRINTSET THAT YOU WANT');  WRITELN;  WRITELN(' A) NORMAL');  WRITELN(' B) PROPORTIONAL');  WRITELN(' C) CONDENSED');  WRITELN;  WRITELN('PRESS KEY A,B, OR C TO CHOOSE PRINTSET');  WRITENORMAL=19; (*SOFTWARE SWITCHES*) (PROPORTIONAL=17; (CONDENSED=20; (CR=13; (*CARRIAGE RETURN*) (  VAR ANSWER: CHAR;  $I (*INDEX*): INTEGER; $ $LINE: STRING; $ $S (*SWITCHES*): FILE OF CHAR;   BEGIN  PAGE(  PROGRAM PR737; (* BY PAUL NORRIS *)   (* WORKS FOR CENTRONICS 737 PRINTER.*)  (* SIMPLY CHANGING THE FOLLOWING CONSTANTS  SHOULD MAKE THIS ROUTINE WORK FOR #ANY OTHER PRINTER. *) #  CONST ESCAPE=27; (*INITIALIZE FOR SOFTWARE SWITCH*) (N^Zter Percent XZN  IS  % OF  X,Y, OR Z ?i, The End42>Db m solver:(Other CH to Leave)  Enter Baseצ Enter Percentצ Enter Amountצ Enter BasePצ Enter Amountצ Enter Percent XZN  IS  % OF  X,Y, OR Z ?i, The End)Select problem solver:(Other CH to Leave)  Enter Baseצ Enter Percentצ Enter Amountצ Enter BasePצ Enter Amountצ En This program solves percent problems such as....צ([X] X is P% of Base (What is P% of Base)צ([Y] Y is X% of Base (A is what% of Base)צ#[Z] A is P% of X (A is P% of what?));PUT(S) &END; " "'C':BEGIN 'S^:=CHR(ESCAPE);PUT(S); 'S^:=CHR(CONDENSED);PUT(S) &END; " "END; (*OF THE CASE*) "  LINE:='THIS 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.(*PR737*)   N^J"'C':WRITELN(S,CHR(CONDENSED)) "  END; (*OF THE CASE*) "  WRITELN(S,'THIS LINE IS OUTPUT IN THE PRINTSET YOU HAVE CHOSEN.');   CLOSE(S)   END.(*PRINTSET*)   EXIT(PRINTSET);   RESET(S,'PRINTER:');  (*REWRITE ALSO WORKS HERE. RESET ONLY WORKS BECAUSE FILE  S IS INTERACTIVE. *)   WRITE(S,CHR(ESCAPE));   CASE ANSWER OF " "'A':WRITELN(S,CHR(NORMAL)); " "'B':WRITELN(S,CHR(PROPORTIONAL)); " RITELN(' B) 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 AL=17; (CONDENSED=20; (  VAR ANSWER: CHAR;  $I (*INDEX*): INTEGER; $ $S (*SWITCHES*): INTERACTIVE; $   BEGIN  PAGE(OUTPUT);  GOTOXY(0,8);  WRITELN('SELECT THE PRINTSET THAT YOU WANT');  WRITELN;  WRITELN(' A) NORMAL');  W   PROGRAM PRINTSET; (*INTERACTIVE SOLUTION *)  (* BY PAUL NORRIS - IDEA BY STEVE LLOYD *)  (* WORKS FOR A CENTRONICS 737 PRINTER *)   CONST ESCAPE=27; (*INITIALIZE FOR SOFTWARE SWITCH*) (NORMAL=19; (*SOFTWARE SWITCHES*) (PROPORTIONN^ZPROGRAM FILEPATCH;  (* BY STEPHEN L. BILLARD *)  (* FOR LOWER CASE CHANGES*)   USES APPLESTUFF;   VAR "BUF:PACKED ARRAY[0..511] OF 0..255; "TMP,FN,STR:STRING; "FIL:FILE; "BLOCK,DISP,VAL,I,J:INTEGER; "HEXD:PACKED ARRAY[0..15] OF CHAR; "STP:BOOX 8N^&o lower case -AA TAX -AD 15 BF up LDA conflg -0A ASL -09 DF ORA #$DF -2D 15 BF AND conflg -8D 15 BF STA conflg -8A TXA -4C AA D6 JMP notk  tore & go -AA TAX  A9 20 LDA #$20 -2C 15 BF BIT conflg -D0 0C BNE up -8A TXA -C9 41 CMP "A" -90 07 BCC up -C9 5B CMP "[" -B0 03 BCS up -69 20 ADC #$20 shift t7 no CMP ctrl-W -D0 16 BNE lc -A9 20 LDA #$20 -2C 15 BF BIT conflg -F0 09 BEQ sh -A9 10 LDA #$10 -2C 15 BF BIT conflg -F0 02 BEQ sh -A9 39 LDA #$30 -4D 15 BF sh EOR conflg -4C C5 D6 JMP s"3 A6 4C BE DA JMP freespace " "4 EB EA NOP (defeat -EA NOP lowercase -29 7F AND #$7F shift E Gon output)  5 BE D0 02 BNE no  A9 5B LDA "[" -C9 1e. Control-W is  required to escape from shift lock  mode.   Any other control key (of any key for  that matter) can be used for shift  control. Just change the constant to  whatever your heart desires.   Block Byte Change Comments  ER and  lower case characters.   Typing is notquite like a typewriter,  since thecontrol-W key is used as a  shift key. A single control-W causes  a single character upper case shift.  Two control-W's in a row will lock the  case into upper case, you can  now do so.   Use the Filepatch program listed below  and make the following changes to  System.Apple. Once you have booted  your Pascal system with this version  of the system, Pascal will display all  its messages in a mixture of UPP LOWER CASE FOR APPLE PASCAL  'by Stephen L. Billard '    Have you always wanted to be able to  use upper and lower case letters with  apple Pascal? With the help of the  Dan Paymar Lower Case Adapter and the  following patch to System.ApplLEAN; "CH:CHAR;  FUNCTION GETLINE:BOOLEAN; "BEGIN "READLN(FN); "GETLINE:=LENGTH(FN)>0; "END;  FUNCTION YORN(M:STRING):BOOLEAN;  VAR CH:CHAR; "BEGIN "REPEAT $NOTE(50,10); $WRITE(M,' (Y/N)? '); $READ(CH); $WRITELN; $UNITCLEAR(1) "UNTIL CH IN ['Y','N',' ']; "YORN:= CH IN ['Y',' ']; "END;  FUNCTION HEXV(S:STRING):INTEGER;  VAR V,I:INTEGER; "BEGIN "V:= 0; "FOR I:= 1 TO LENGTH(S) DO "FOR J:=0 TO 15 DO "IF HEXD[J]=S[I] THEN V:=16*V+J; "HEXV:= V "END;  PROCEDURE PRX(I:INTEGER); "BEGIN .^٠ ȡ`ˡ<SCAN ERROR AT ADDRESS  i@ǀɡ.) <BƂצ*SYSTEM.WRK.TEXTP@ צPeripheral card ROM diagnostic 17ō9WHICH Slot <1..7> : 0Address of on-board ROM is  " ROMTEST 2DISP:= DISP+1; 2END; ,END; *IF DISP>I THEN ,HEXOUT(I,DISP); & END (ELSE *DISP:= DISP+8 &UNTIL STP; &I:= BLOCKWRITE(FIL,BUF,1,BLOCK); $UNTIL NOT YORN('ANOTHER BLOCK'); $CLOSE(FIL); "UNTIL NOT YORN('ANOTHER FILE');  END. " (HEXOUT(DISP,DISP+8); (NOTE(50,10); (IF GETLINE THEN *BEGIN *I:= DISP; *WHILE GET(CH,J,FN) DO ,BEGIN ,IF CH=':' THEN .BEGIN .DISP:= J; .I:= DISP; .END ,ELSE .IF CH='/' THEN 0STP:= TRUE .ELSE 0IF LENGTH(STR)<>0 THEN 2BEGIN 2BUF[DISP]:= J;NOTE(50,10); $READLN(FN); $RESET(FIL,FN); $REPEAT (* MODIFY A BLOCK *) &DISP:=0;  WRITE('BLOCK (DECIMAL): '); &NOTE(50,10); &READLN(BLOCK); &I:= BLOCKREAD(FIL,BUF,1,BLOCK); &STP:= FALSE; &REPEAT (* GET MODIFICATIONS *) := I; $IF DONE THEN &BEGIN &J:= J-1; &CH:= ST[I]; &END; $IF J>0 THEN &BEGIN &STR:= COPY(ST,1,J); &OPT:= HEXV(STR); $ END; $DELETE(ST,1,I); $END; "END; "BEGIN "HEXD:='0123456789ABCDEF'; "REPEAT (* PER FILE NAME *) $WRITE('FILE NAME: '); $LEAN; " STR:STRING; "BEGIN "CH:=' '; "IF LENGTH(ST)=0 THEN $GET:= FALSE "ELSE $BEGIN $GET:= TRUE; $I:= 1; $DONE:= FALSE; $OPT:= 0; $REPEAT &DONE:= NOT (ST[I] IN .['0'..'9','A'..'F']); &I:= I+1 $UNTIL DONE OR (I>LENGTH(ST)); $I:= I-1; $J$IF I MOD 8=0 THEN &BEGIN &IF I>0 THEN (WRITELN; &PRX(I); &WRITE(': '); &END; $PRX(BUF[I]); $WRITE(' '); $I:= I+1; $END; "WRITELN; "END;  FUNCTION GET(VAR CH:CHAR; -VAR OPT:INTEGER; -VAR ST:STRING):BOOLEAN;  VAR I,J:INTEGER;  DONE:BOO IF I>255 THEN $BEGIN $PRX(I DIV 256); $I:= I MOD 256; $END; "WRITE(HEXD[I DIV 16]); "WRITE(HEXD[I MOD 16]); "END;  PROCEDURE HEXOUT(I,J:INTEGER); "BEGIN "IF I MOD 8<>0 THEN $BEGIN $PRX(I); $WRITE(': '); $END; "WHILE ICard.Mem^[I] $THEN BEGIN $Bell; $WRITELN; $WRITE  ('SCAN ERROR AT ADDRESS ',Card.Adr+I);  END; END; END; (* LittleTest *)    BEGIN (* ROMTestND;   Card.Adr := Base + 256*(ORD(CH)-48);  (* This equates Card.Mem with the on- #board ROM *)   WRITELN  ('Address of on-board ROM is ',Card.Adr);  WRITELN;  Bell; Bell;  END; (* Slot *)    PROCEDURE LittleTest;  OM's *)   WRITELN(CHR(12));  (* Clear screen
*)   WRITELN  ('Peripheral card ROM diagnostic');  WRITELN;  CH := ' ';  WHILE (CH<'1') OR (CH>'7') "DO BEGIN "GOTOXY(0,5); "WRITE "('WHICH Slot <1..7> : '); "READ(CH); "WRITELN; "E! $Card : ROM256; $ $CH : CHAR; $I,Base : INTEGER;    PROCEDURE Bell;   BEGIN (* Bell *)  WRITE(CHR(7));  END; (* Bell *)    PROCEDURE Slot;   VAR CH : CHAR;   BEGIN (* Slot *)   Base := -16384;  (* Base address of onboard R%Strobe = PACKED ARRAY[0..0] OF 0..255; +  VAR CopyOfROM : Page; $ $KeyBoard : $(* This does the same thing as KEYPRESS 'in APPLESTUFF *) /RECORD CASE BOOLEAN OF /TRUE : (Addr : INTEGER); /FALSE : (Press : ^Strobe); /END; (**************************************)  CONST C000 = -16384;   TYPE Page = PACKED ARRAY[0..255] OF CHAR;  %ROM256 = %(* used to access peripheral ROM *) .RECORD CASE BOOLEAN OF .TRUE : (Adr : INTEGER); .FALSE : (Mem : ^Page); .END; . *)  (* This program has been provided to *)  (* the San Francisco APPLE Core for *)  (* distribution to and non-commercial *)  (* use by its members and affiliates. *)  (* *)  eproduced or stored *)  (* in any form without the prior *)  (* written consent of Stephen Lloyd *)  (* *)  (**************************************)    (**************************************)  (* PROGRAM ROMTEST;   (**************************************)  (* *)  (* Copyright (c) 1980 - Stephen Lloyd *)  (* All rights reserved *)  (* NO part of this program may be *)  (* translated, r 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('#5:',FileName); "IF LENGTH(FileName)<19; "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  WRITE('master catalog file name : '); 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('press "RETURN" to continue : '); "READLN 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;    PROCEDURE ListFile(TextFile : STRING);   $(* 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 the disk *) "END;    VAR (*) "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 *) ) "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; $(* NIL,BAD,CODE,TEXT,  INFO,DATA,GRAF,FOTO **) $(* 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; "DiskDate : DATE; " (* date diskette was formatted *"(* 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 : STRING[7]; " (* this field is 8 bytes long *)  (**************************************)   TYPE (* DECLARATIONS *)   Date = "(* MONTH, DAY AND YEAR IN 16 BITS *) "PACKED RECORD "Month : 1..12; "Day : 1..31; "Year : 1..99; "END;   DiskInfo = RECORD **)  (* *)  (* This program has been provided to *)  (* the San Francisco APPLE Core for *)  (* distribution to and non-commercial *)  (* use by its members and affiliates *)  (* (*$C translated, reproduced or stored *)  (*$C in any form without the prior *)  (*$C written consent of Stephen Lloyd *)  (* *)  (**************************************)   (************************************  PROGRAM MASTERCATALOG;   (**************************************)  (* *)  (*$C Copyright (c) 1980 Stephen Lloyd *)  (*$C All Rights Reserved *)  (*$C No part of this program mat be *)  $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,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;  PAGE(OUTPUT); "WRITELN('ERROR IN OPENING F: MASTERCA 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);  END. (* MASTER CATALOG *)    (* to the program every *)  (* time it runs *) !(* *) #(*******************)  ListFile('#5:CAT.INTRO');  (*******************) #  PAGE(OUTPUT);  Quit := FALSE;  OpenMaster;  (* OPEN MASTER CATALOG FILE ON DRIVE 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 *) )  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 USE THE FILER TO TRANSFER IT TO');  WRITELN  ('THEALOG 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 *)    PROCEDURE Reminder;   BEGIN (* REMINDER * (* READ DIRECTORY FROM DRIVE 1 *)  UNITREAD(4,Directory,2048,2);   Header;  Alias;  Files;  END; (* CATALOG *)    PROCEDURE Prompt;   BEGIN (* PROMPT *)  WRITELN;  WRITELN  ('INSERT DISKETTE TO BE INCLUDED IN');  WRITELN  ('MASTER CATileName); (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); "END; (* FILES *)    BEGIN (* CATALOG *)   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 MOD 2)=1 (THEN BEGIN (WRITE ((F,Directory.Files[I].FTTE 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(F,'-'); $WRITELN(F); $END; "END; (* ALIAS *)  $WRITELN(F,'DISK NAME : ', $ Directory.Disk.DiskName); $WRITELN(F); $END;  END; (* HEADER *) "   PROCEDURE Alias; " "VAR AliasName : STRING[32]; " "BEGIN (* ALIAS *) "WRITE('DISKETTE NAME : '); "READLN(AliasName); "(* WRITE DISKEILE'); "WRITELN('PROGRAM TERMINATED'); "END;  END;    PROCEDURE Catalog;   PROCEDURE Header; " "BEGIN (* HEADER *) "(* WRITE DISK HEADER ONTO " MASTER CATALOG FILE *) "IF LENGTH(Directory.Disk.DiskName)>0 $THEN BEGIN " written consent of Stephen Lloyd END;    PROCEDURE Catalog;   PROCEDتP+ƁW+́ƁPƁ.TEXTUƁ ́X́ʁXʁȡ0+ƁYP+ƁYʁX́Xpress "RETURN" to continue : + ++Vצmaster catalog filewing  the volume name of the diskette.   Since the diskettes can be physically called by a  name other than the name stored on the disk, an  optional alias name is requested for each diskette. *)  name. If that file exists, 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 files on the diskette directory  are written onto the master catalog file follo(* Introduction to Master Catalog Program *)   (* This program creates a master catalog of as many  diskette directories as can be written into the  catalog file. The catalog file is written on the  diskette in drive two and can be given any file  O^ <6b v|\hR "Q" TO TERMINATE : QéqÍ33h THE MASTER CATALOG FILE HAS BEENPLACED ON DRIVE 2.%USE THE EDITOR TO REVIEW ITS CONTENTSצ"OR USE THE FILER TO TRANSFER IT TOצ THE PRINTER. .צ #5:CAT.INTRO 33#Q˩q˄ IN DRIVE 1.צPRESS "RETURN" TO CONTINUE,"Q" TO TERMINATE : QéqÍ33h THE MASTER CATALOG FILE HAS BEENPLACED ON DRIVE 2.12M 1ġ 112M .22i!INSERT DISKETTE TO BE INCLUDED INצMASTER CATALOG DDISKETTE NAME :  šyצDISKETTE NAME : ------------- 22ȡ-22&$š22ȡ2áJ2M "ˡ CFILE EXISTS..APPENDINGDŽ. "ˡ]3 צERROR IN OPENING FILEPROGRAM TERMINATED š3 DISK NAME :  name : š.TEXTץæ.textץÍ!EEE.TEXTEEE#5:EEɡNצFile name must be less than צ10 characters !ء CRYPTOGR lving, Etc." Pgs 78-87*)   VAR #ALPHABET, CODE, NEWCODE :STRING [26]; #MESSAGE, SECRETWORD :STRING; #I,POSITION :INTEGER; #CH:CHAR; #  PROCEDURE INITIALIZE;  BEGIN (*INITIALIZE*) #ALPHABET := %'ABCDEFGHIJKLMNOPQRSTUVWXYZ'; #SECRETWORD := ' 4, 1981*)   (* Debugged and reconstructed by the  SF Apple Core Pascal Special Interest  Group-Nov. 17, 1980 *)   (* For details of the string intrinsics,  'POS', 'COPY', 'CONCAT', see (1) Apple Ref.  Manual-Pgs 130-131. (2) Bowles, "Problem  SoPROGRAM CRYPTOGRAM;  (* by Max J. Nareff *)   (* Generates a coded message from a  string input.  Adapted from a standard Pascal program,  by Max J. Nareff, 11/80, from "Program  Solving & Structured Programming in  Pascal", by E. Koffman, Pg. AP2O^PצTHE CRYPTOGRAM IS DECODED TO""-"T׶  WANT TO DECODE YOUR SECRET?->Y/N#NˡTHE ENDHE CRYPTOGRAM IS"-"TV-P- PVȡuVˡ'--PƀƀjP(--PVƀƀǠPצTHE CRYPTOGRAM IS DECODED TO""-"T׶  WANT TO DECODE YOUR SECRET?->Y/N#NˡTHE ENDTHE CRYPTOGRAM IS"-"TV-P- PVȡuVˡ'--PƀƀjP(--PVƀƀǠENTER MESSAGE TO BE CODED VP|VȡuVˡ'--PƀƀjP(--PVƀƀǠPצABCDEFGHIJKLMNOPQRSTUVWXYZ- PA CRYPTOGRAPHING PROGRAM UTILIZING STRING INTRINSICS!צENTER YOUR CODE-26 LETTERS! ˡN%26 CHARACTERS REQUIRED IN CODE STRING"'; #WRITELN &('A CRYPTOGRAPHING PROGRAM':32); #WRITELN &('UTILIZING STRING INTRINSICS':33); # &(*Enter code and original message*) #WRITELN &('ENTER YOUR CODE-26 LETTERS':33); #WRITE (' ':7); #READLN(CODE); # #(*Check for full code length*) #WHILE LENGTH (CODE) <> 26 DO &BEGIN )WRITELN  ('26 CHARACTERS REQUIRED IN CODE STRING'); )READLN (CODE); &END; (*While*) #WRITELN; #WRITELN #('ENTER MESSAGE TO BE CODED':32); #WRITELN; #READLN (MESSAGE)  END; (*Initialize*)   (*Perform EncrWRITELN '('LEFT','RIGHT':75); ' #X := 20; (*INITIAL TABS*) #Y := 2; # #CHALKMARK (20); (*OUTPUTS 20 LINES*) #WRITELN !('TO SHIFT OUTPUT TO RIGHT, CNTRL/A+ANYKEY'); #READ (KEYBOARD,ANYCHAR); # #X := 60; (*READJUST TABS FOR RT SCREEN*) #Y := 2; PROCEDURE CHALKMARK (LINES:INTEGER); #VAR I :INTEGER;  BEGIN #FOR I := 1 TO LINES DO &BEGIN )GOTOXY(X,Y); )WRITELN ('#',I); )Y := Y+1; &END; (*LOOP*)  END; (*CHALK*)   BEGIN (*MAIN*) #PAGE (OUTPUT); #WRITELN '('A SPLIT SCREEN DEMO':29); #PROGRAM SPLITSCREEN;   (*DEMONSTRATES ONE METHOD OF WRITING,  SUCCESSIVELY, TO EACH OF THE TWO FORTY  COLUMN SCREENS. BY MAX J. NAREFF, 11/80*)   VAR #ANYCHAR :CHAR; #X,Y :INTEGER; (*FOR TABBING*) # !(*FORMATS & OUTPUTS DEMO LINES*) O^[ END':23);  END.(*Cryptogram*) #  # ); #WRITELN; #WRITELN('"',SECRETWORD,'"');  END; (*Decode*)   BEGIN (*Main*) #PAGE(OUTPUT); #INITIALIZE; #ENCODE; #WRITELN; #WRITELN &('WANT TO DECODE YOUR SECRET?->Y/N':35); #READ (KEYBOARD,CH); #IF (CH <> 'N') THEN &DECODE; #WRITELN ('THE POS(COPY(MESSAGE,I,1),ALPHABET); )IF POSITION <> 0 THEN ,SECRETWORD :=  CONCAT(SECRETWORD,COPY(NEWCODE,POSITION,1)) ,ELSE /SECRETWORD := #CONCAT(SECRETWORD,COPY(MESSAGE,I,1)); #END; (*For*) #WRITELN; #WRITELN &('THE CRYPTOGRAM IS DECODED TO':34ECRETWORD,'"');  END; (*Encode*)   PROCEDURE DECODE;  BEGIN (*Reinitialize*) #MESSAGE :=SECRETWORD; #NEWCODE :=ALPHABET; #ALPHABET:=CODE; #SECRETWORD:=' '; #  FOR I :=1 TO LENGTH (MESSAGE) DO &BEGIN )POSITION := d code char*) ,SECRETWORD := /CONCAT (SECRETWORD,COPY(CODE,POSITION,1)) )ELSE /(*Append orig. symbol*) ,SECRETWORD := /CONCAT(SECRETWORD,COPY(MESSAGE,I,1)) &END; (*For*) # #WRITELN; #WRITELN &('THE CRYPTOGRAM IS':28); #WRITELN; #WRITELN ('"',Syption*)  PROCEDURE ENCODE;  BEGIN #(*Substitute code char for )each char in message*) #FOR I:=1 TO LENGTH (MESSAGE) DO &BEGIN ,(*Find current char in :alphabet*) & POSITION := ,POS(COPY(MESSAGE,I,1),ALPHABET); )IF POSITION <> 0 THEN /(*Appen # #CHALKMARK (20); #WRITELN &('ANYKEY TO SHIFT TO LEFT':71); #READ (KEYBOARD,ANYCHAR); #UNITCLEAR (1); (*RETURN TO LEFT SCREEN*) #WRITELN &('LEFT','FINI':19,'RIGHT':56);  END.  ~ SPLITSCR E (ġ šPF\ditor without updatingצ% W(rite to a file name and return  RáEáꥂNWá"@*d RANDALPH #REPEAT # $(*GENERATES NUMBERS FROM 1 TO 26*) %NUMBER := RANDOM MOD 26 + 1; % %COUNTER := COUNTER + 1; %WRITE (NUMBER:5); % '(*FORMATTING OUTPUT*) %X := X +5; %IF (X >=40) THEN 'BEGIN *WRITELN; *X := 0; 'END #UNTIL (COUNTER >26)  END. PROGRAM RANDALPHAX;  (*GENERATES RANDOM NUMBERS +BY MAX J.NAREFF,11/80*)   USES APPLESTUFF; (*FOR RANDOM FUNCTIONS*)   VAR #NUMBER, COUNTER : INTEGER; #X (*FORMATTER*) : INTEGER; #  BEGIN #COUNTER := 1; #NUMBER := 0; #X := 0; #RANDOMIZE; N^lNYKEY TO SHIFT TO LEFTG&LEFTFINIRIGHT8.4ƂƂƂȍƂƂ.˄%Ƃ̂.Ƃ.ƂPƂ..TEXTUƂ.PƂƂ.á ƂƂƂצ*SYSTEM.WRK.TEXTPȡ-# 4B׶ A SPLIT SCREEN DEMOצLEFTצRIGHTKצ(TO SHIFT OUTPUT TO RIGHT, CNTRL/A+ANYKEY<A"צ)Name of output file ( to return) -->ƂPƂáƂ̂.ʂ.ȡƂƂ۾ .TEXTƂƂƂȍƂƂ.˄%Ƃ̂.Ƃ.ƂPƂ..TEXTUƂ.PƂƂ.á ƂƂƂצ*SYSTEM.WRK.TEXTPN^| צ$ALPHABET GENERATED AT RANDOM WITHOUT%צREPETITION-USING "SET UNION""/@ꗜ(ġ  "@* RANDALPH $(*SERIES COMPLETED WHEN ALL 8LETTERS LISTED*) #UNTIL (SERIES = [1..ALPHABET])  END. IES) THEN )BEGIN ,WRITE (CHR(64 + NUMBER):5); , $(*SET UNION OPERATION-OPERATOR (+)*) ,SERIES := SERIES + [NUMBER]; , ,X := X + 5; (*FORMATTER*) ,IF (X>=40) THEN .BEGIN 1WRITELN; 1X := 0; .END (*IF X*) )END (*IF*) "SET UNION"':34); #WRITELN; #RANDOMIZE; #X := 0; #SERIES := [ ]; (*INITIALIZE-EMPTY SET*) #REPEAT # #(*GENERATES RANDOMS FROM 1 TO 26*) &NUMBER := RANDOM MOD 26 + 1; & #(*NUMBER PERMITTED IN SERIES /ONLY IF NOT YET USED*) &IF NOT (NUMBER IN SERHABET; #RANK = SET OF DIGITS; #  VAR #NUMBER : DIGITS; #SERIES : RANK; #X : INTEGER; (*FORMATTING*) #  BEGIN (*MAIN*) #WRITELN (CHR(12)); #GOTOXY (0,8); #WRITELN  ('ALPHABET GENERATED AT RANDOM WITHOUT':37); #WRITELN  ('REPETITION-USING PROGRAM RANDALPHA1;  (*GENERATES RANDOM SEQUENCE OF ALPHABET  WITHOUT REPETITION USING THE "SET UNION"  OPERATION AS A FILTER. 1BY MAX J.NAREFF,12/80*)   USES APPLESTUFF; (*FOR RANDOM FUNCTION*) #  CONST ALPHABET = 26; #  TYPE #DIGITS = 1..ALPjutput file ( to return) -->ƂPƂáƂ̂.ʂ.ȡƂƂ۾ .TEXTƂƂƂȍƂƂ.˄%Ƃ̂.Ƃ.ƂPƂ..TEXTUƂ.PƂƂ.á ƂƂƂצ*SYSTEM.WRK.TEXTPN^ צ$ALPHABET GENERATED AT RANDOM WITHOUT%צREPETITION.USING ARRAY  ȡˡS7@(ġ "@*, RANDALPH .J := J + 1; '(*CHR(64) + (1..26) = 'A'..'Z'*) .WRITE (CHR(64+I):5); . .X := X + 5; .IF (X>=40) THEN 0BEGIN 3WRITELN; 3X := 0 0END (*IF X*) +END (*IF NOT*) &END (*WHILE*)  END. BERS*) #WHILE J <> LETTERS DO &BEGIN & %(*MOD 26 GENERATES RANDOM NUMBERS*) *(*FROM 0 TO 25*) /(*PLUS 1 = FROM 1 TO 26*) (I := RANDOM MOD 26 + 1 ; ( "(*IF NUMBER NOT IN ARRAY THEN SELECT*) (IF NOT (ALPHA[I]) THEN +BEGIN .ALPHA[I] := TRUE; RITELN; #RANDOMIZE; #J := 0; (*COUNTER FOR FINAL ARRAY*) #X := 0; (*COUNTER FOR FORMATTING*) # #(*GENERATES BOOLEAN ARRAY*) #FOR I := 1 TO LETTERS DO &BEGIN )ALPHA[I] := FALSE; &END; &  (*FILLS ARRAY WITH NON-REPETITIVE NUMUNCTIONS*)   CONST LETTERS = 26;   VAR #ALPHA : ARRAY[1..26] OF BOOLEAN; #I, J, X : INTEGER; #  BEGIN #WRITELN (CHR(12)); #GOTOXY (0,8); #WRITELN  ('ALPHABET GENERATED AT RANDOM WITHOUT':37); #WRITELN ('REPETITION.USING ARRAY':31); #WPROGRAM RANDALPHA2;  (*A RANDOM,NON-REPETITIVE SEQUENCE OF  THE ALPHABET,USING A BOOLEAN ARRAY.  ALGORITHM DEVELOPED BY STEVE LLOYD,LEADER  OF THE SF APPLE CORE PASCAL STUDY GROUP. 'PREPARED BY MAX J.NAREFF,12/80*)   USES APPLESTUFF; (*FOR RANDOM F l<$ -->ƂPƂáƂ̂.ʂ.ȡƂƂ۾ .TEXTƂƂƂȍƂƂ.˄%Ƃ̂.Ƃ.ƂPƂ..TEXTUƂ.PƂƂ.á ƂƂƂצ*SYSTEM.WRK.TEXTP.^)isk.Files #DO BEGIN #FileName := 'ZZZZZZZZZZZZZZZZ'; # #(* find smallest file name *) #FOR K := 1 TO Disk.Files $DO BEGIN $IF Files[K].FileName0 "THEN BEGIN "FOR I := 1 TO D (* Read the directory information on the  specified drive. *)  UNITREAD(DRIVE,Directory,2048,2);   (* Clear a line at top of screen *)  WRITELN;   (* Show volume name from directory *)  WRITELN('Volume : ',Directory.Disk.DiskName);   (* Dis: ARRAY[1..77] OF 4FileInfo; END;   I,J,K,  K1,M, (* these are various counters *)  DRIVE (* this is the directory wanted *) &: INTEGER;  FileName : STRING[16];   PROCEDURE Catalog;   BEGIN (* CATALOG *)  is made up of two different  types of records. The first one describes  information pertaining to the diskette  itself. The records that follow, 77 in all,  describe the files contained on the disk. *)   Directory : RECORD Disk : DiskInfo; ,Files : STRING[15]; "UNKNOWN : INTEGER; "FileDate : DATE; "END;    VAR (* VARIABLE DECLARATIONS *)   (* These variables declared here are known  to the entire program, they can accessed at  almost any time during execution. *)   (* The directory"A : ARRAY[0..2] OF INTEGER; "DiskName : STRING[7]; "B : INTEGER; "Files : INTEGER; "C : INTEGER; "DiskDate : DATE; "D : INTEGER; "E : INTEGER; "END;   FileInfo = RECORD "Starting : INTEGER; "Ending : INTEGER; "FileType : 0..7; "FileName LARATIONS *)   (* The following declarations describe the  information contained in the directory of  every Pascal diskette. *)  Date = "PACKED RECORD "Month : 1..12; "Day : 1..31; "Year : 1..99; "END;   DiskInfo = RECORD has been provided to *)  (* the San Francisco APPLE Core for *)  (* distribution to and non-commercial *)  (* use by its members and affiliates *)  (* *)  (**************************************)   TYPE (* DECeproduced or stored *)  (*$C in any form without the prior *)  (*$C written consent of Stephen Lloyd *)  (* *)  (**************************************)  (* *)  (* This program   PROGRAM Dir;   (**************************************)  (* *)  (*$C Copyright (c) 1980 Stephen Lloyd *)  (*$C All Rights Reserved *)  (*$C No part of this program may be *)  (*$C translated, rctory entry to &largest filename possible *) #Files[K1].FileName := # 'ZZZZZZZZZZZZZZZ'; # #(* print them in two columns *) #IF (I MOD 2)=1 $THEN BEGIN (* left column *) $WRITE(FileName); $FOR J := 20 DOWNTO LENGTH(FileName) %DO WRITE(' '); $END %ELSE (* right column *) %WRITELN(FileName); # #END; "END; !END;  WRITELN;  END; (* CATALOG *)    PROCEDURE Prompt;   VAR CH : CHAR; (* the input variable *)   BEGIN (* Prompt *)   DRIVE := 4; (* Default to boot disk *)   WRIe LFDirectory for which unit ? ع  45`׶   "(Ƃצ*SYSTEM.WRK.TEXTPצ Volume : šȡZZZZZZZZZZZZZZZZתȡ8M M M צZZZZZZZZZZZZZZZá4ġ " written consent of Stephen Lloyd y naive sorting routine. It  is used mainly t DIR t; "PAGE(OUTPUT); "Catalog;   END. (* Dir *)   TELN;  WRITE ('Directory for which unit ? ');   READ(CH) (* select drive simply by ,pressing the proper key *); " "CASE CH OF "'4' : DRIVE := 4; "'5' : DRIVE := 5; "END;   END; (* Prompt *)    BEGIN (* Dir *)  "PAGE(OUTPUT); "Promp