`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JN^ʟ!XTvgv CUBE.TEXTr=vgE DOODLER.TEXTvg INTDAT.TEXTvg PIG1.TEXTtM{TMICROMODEM.TEXTSCHECKBOOK.TEXT`h BIOSDEMO.TEXTvghz MENU.TEXTr=vg۠zDIR.TEXTr=vg MENUDOC.TEXTvgˡ DIRDOC.TEXTvgˡ BIOSDOC.TEXTvgˡBIOSSTUFF.TEXTgˡCRECHARSET.TEXTCRECHARDOC.TEXT SERENDIP.TEPSCAL28 DSPCHRSET.TEXTg!  DEFCHARS.TEXTvgɡ8CHECKBOOK.TEXTg8DMINIFILER.TEXTgDH PEEKPOKE.TEXTvgˠHNTIMERSTUFF.TEXT8NT PRINT.TEXT=vgjT\ FILEDUMP.TEXTvg\` BIOSUNIT.TEXTvg&꽌ɪɖ'*&%&,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 READCHARS;   (* $THIS PROGRAM READS THE DATA IN $SYSTEM.CHARSET (USED IN SCREEN $GRAPHIC CHARACTERS) AND DISPLAYS $THEM ON THE SCREEN. $CHARACTERS ARE EXPRESSED BY A $DOT MATRIX SEVEN ACROSS BY EIGHT $DOWN. EACH CHARACTER IS REPRESENTED "BEGIN $IF NOT (CH IN ['W','E','R','S','F','X','C','V','B','D','M']) 'THEN EXIT(MOVE); $DX:=0; DY:=0; $IF CH IN ['D','B','M'] &THEN MODE:=CH & &ELSE (BEGIN *CASE CH OF , ,'W': BEGIN DY:=-1; DX:=-1 END; ,'E': DY:=-1; ,'R': BEGIN DX:=1; DY:=-OP:ARRAY[0..7] OF INTEGER; $ $ $  PROCEDURE PUTCHAR; "BEGIN $BLK:=(CHARID DIV 64); $I1:=BLOCKREAD(G,BUF,1,BLK); $I:=(CHARID MOD 64) * 8; $FOR J:=0 TO 7 DO &BUF[J+I]:=CHR(CHARINT[J]); $I1:=BLOCKWRITE(G,BUF,1,BLK) "END; " "  PROCEDURE MOVE;  PROGRAM DEFCHARS;   CONST X0=10; Y0=10; XM=16; YM=17;   VAR CHARINT:ARRAY[0..7] OF INTEGER; $BLK,I,I1,J,CHARID:INTEGER; $F,G:FILE; $X,Y,DX,DY:INTEGER; $CHARBOOL:ARRAY[0..7,0..6] OF BOOLEAN; $BUF:PACKED ARRAY[0..511] OF CHAR; $CH,MODE:CHAR; $TWVAR N^ɡIN ,READLN(I1); ,I1:=(I1-1)*8 *END; (IF CH='%' THEN EXIT(PROGRAM) (END $END  END. .FOR I2:=8 DOWNTO 1 DO 0BEGIN 2REM:=NUM DIV TWOP[I2]; 2IF REM > 0 THEN CH:='*' 4ELSE CH:='.'; 2NUM:=NUM - (REM*TWOP[I2]); 2S[VERTMAX+1-K,I2]:=CH 0END; .I1:=I1+1; ,END; (FOR K:=1 TO VERTMAX DO *WRITELN(S[K]); (READLN(CH); (IF CH='#' THEN *BEGDO $TWOP[I]:=TWOP[I-1]*2; "RESET(F,'*SYSTEM.CHARSET'); "FOR LOOP:=1 TO 2 DO $BEGIN &I:=BLOCKREAD(F,BUF,1); &PAGE(OUTPUT); &I1:=0; &WHILE I1 <= 511 DO (BEGIN *GOTOXY(0,10); *FOR K:=1 TO VERTMAX DO ,BEGIN .NUM:=ORD(BUF[I1]); "VERTCHAR = 1..VERTMAX;   VAR "BUF:PACKED ARRAY[0..511] OF CHAR; "LOOP,I,I1,I2,K,NUM,REM:INTEGER; "CH,CH1:CHAR; "F:FILE; "S,S1:ARRAY[VERTCHAR] OF PACKED ARRAY[1..8] OF CHAR; "TWOP:ARRAY[1..8] OF INTEGER; "  BEGIN "TWOP[1]:=1; "FOR I:=2 TO 8 $BY EIGHT BYTES, EACH OF WHICH CON- $TAINS A ROW (I.E. SEVEN BITS) OF $DATA. OF EACH GROUP OF EIGHT BYTES $THE LEFT-HAND BYTE REPRESENTS THE $BOTTOM ROW AND THE RIGHTMOST BIT $REPRESENTS THE LEFTMOST DOT. $  *)   CONST "VERTMAX = 8;   TYPE 1 END; ,'S': DX:=-1; ,'F': DX:=1; ,'X': BEGIN DX:=-1; DY:=1 END; ,'C': DY:=1; ,'V': BEGIN DX:=1; DY:=1 END; , ,END; (* CASE *) * *CASE MODE OF * ,'D': BEGIN 3CHARBOOL[Y-Y0,X-X0]:=TRUE; 3WRITE('+') 3END; 3 ,'B': BEGIN 3CHARBOOL[Y-Y0,X-X0]:=FALSE; 3WRITE('.') 3END; 3 ) END; (* CASE MODE *) - +X:=X+DX; Y:=Y+DY; +IF XXM THEN X:=XM; +IF YYM THEN Y:=YM; + +GOTOXY(X,Y) (END "END; " " "BEGIN (* MAIN *) E,FOTHER); &CHECKPOINTER=^CHECKRECORD; & &CHECKRECORD=RECORD (CHECKPART:CHECK; (NEXTCHECK:CHECKPOINTER; (END; & &BOOKTITLE=STRING[30]; & &FLOWMATRIX= (ARRAY[-2..12,0..MAXCODE] OF REAL; & &FLOWFILE=FILE OF FLOWMATRIX; & &CHARSET=SET OF CHAR; O; & &DATAYEARS=FIRSTYR..LASTYR; &DATERECORD=RECORD & MONTH:1..12; (YEAR:DATAYEARS; (END; & &CHECK=RECORD & NUMBER:SERIALNUMBER; (DATE:DATERECORD; (AMOUNT:REAL; (CODE:CODENUMBER; (MEMO:CHECKMEMO; (END; & &FIELD=(FNUM,FMONTH,FYEAR,FMEMOCOD PROGRAM CHECKBOOK;  !CONST MAXCODE=40; 'MAXNUM=10000; 'FIRSTYR=78; 'LASTYR=99; ! NO='N';YES='Y'; ! BASEYR=79; ! !TYPE SERIALNUMBER=0..MAXNUM; &CODENUMBER=0..MAXCODE; &CHECKMEMO=STRING[16]; &MEMOVECTOR=ARRAY[CODENUMBER] OF CHECKMEMN^Ġ(END; &PUTCHAR $UNTIL CH='%'; $CLOSE(G,LOCK) "END. AT (GOTOXY(X0,YM+3); (WRITE('CHAR NUMBER (DEC, 0-127) = '); (READLN(CHARID) &UNTIL (CHARID >=-1) AND (CHARID <= 127); & &FOR I:=0 TO 7 DO (BEGIN *CHARINT[I]:=0; *FOR J:=0 TO 6 DO ,IF CHARBOOL[7-I,J]=TRUE .THEN CHARINT[I]:=CHARINT[I]+TWOP[J] (OUTPUT); &FOR I:=Y0 TO YM DO (BEGIN *GOTOXY(X0,I); *WRITE('.......') (END; &MODE:='M'; &X:=X0; Y:=Y0; GOTOXY(X,Y); &FOR I:=0 TO 7 DO *FOR J:=0 TO 6 DO ,CHARBOOL[I,J]:=FALSE; &REPEAT (READ(KEYBOARD,CH); (MOVE &UNTIL CH IN ['*','%']; & &REPE$PAGE(OUTPUT); $RESET(F,'#4:SYSTEM.CHARSET'); $REWRITE(G,'#5:NEW.CHARSET'); $FOR I:=1 TO 2 DO &BEGIN (I1:=BLOCKREAD(F,BUF,1); (I1:=BLOCKWRITE(G,BUF,1) &END; $CLOSE(F,LOCK); $TWOP[0]:=1; $FOR I:=1 TO 7 DO &TWOP[I]:=TWOP[I-1]*2; & $REPEAT &PAGE& (  VAR NEWCHECK:CHECK; $CODE:CODENUMBER; $MEMOLIST:MEMOVECTOR; $FIRSTCHECK:CHECKPOINTER; $CH,BELL,ESC:CHAR; $NAMEOFBOOK:BOOKTITLE; $THISYEAR:DATAYEARS; $THISMONTH:1..12; $CHECKCOUNT:SERIALNUMBER; $TOTAL:REAL; $DEPOSITS:REAL; $CASHFLOW:FLOWMATRIX; $TWOYRS:BOOLEAN; $DIGITS:CHARSET; $ $   FUNCTION GETNUMBER(LO,HI:INTEGER;TAG:FIELD):INTEGER;  FORWARD;   PROCEDURE FILTERINPUT(OKSET:CHARSET);FORWARD;   PROCEDURE SKIPLINES(X:INTEGER);FORWARD;   FUNCTION ANSWERYES:BO"X[33]:=' FURNISHINGS '; "X[34]:=' CLOTHING '; "X[36]:=' '; "X[37]:=' '; "X[38]:=' '; "X[39]:=' '; "X[40]:=' CASH UNKNOWN '; !END; "   BEGIN !PARTONE; !PARTTWO; !GETBOOK; ]:=' JOURNALS, DUES '; "X[30]:=' MEETINGS,TRIPS '; "X[27]:=' LAWYER '; "X[28]:=' OTHER SERVICES '; "X[35]:=' MERCHANDISE '; "X[32]:=' COMPUTING '; "X[22]:=' BALLET,THEATER '; "X[14]:=' CONTRIBUTIONS '; "X[31]:=' BOOKS & EQPT. '; "X[19]:=' BOOKS,NEWS,ETC '; "X[20]:=' RECORDS, HI-FI '; "X[21]:=' RESTAURANTS '; " !END; ! !PROCEDURE PARTFOUR; !BEGIN "X[23]:=' VACATIONS ';  X[24]:=' TOMS ALLOWANCE '; "X[25]:=' KAYS ALLOWANCE '; "X[26]:=' DOCTOR,DENTIST ';  X[29"X[10]:=' SAVINGS '; "X[11]:=' INVESTMENTS '; "X[12]:=' LIFE INSURANCE '; "X[13]:=' TAXES '; "X[15]:=' VEHCL INSURE '; "X[16]:=' VEHCL UPKEEP '; "X[17]:=' FOOD '; "X[18]:=' BEER & WINE '; "X[1]:=' MORTGAGE '; "X[2]:=' HOME MAINT. '; "X[3]:=' HOME IMPROVE '; "X[4]:=' UTILITY GAS ';  X[5]:=' ELECTRICITY '; "X[6]:=' GASOLINE '; "X[7]:=' TELEPHONE '; "X[8]:=' LOAN ACCOUNTS '; "X[9]:=' CHARGE ACCNTS '; ETNUMBER(1,12,FMONTH); #WRITELN; #WRITE(' YEAR....'); #THISYEAR:=GETNUMBER(FIRSTYR,LASTYR,FYEAR); #SKIPLINES(3); #WRITELN('ARE THERE CHECKS FROM'); #WRITE('LAST YEAR? (Y/N)-->'); #TWOYRS:=ANSWERYES; "END;    !PROCEDURE PARTTHR; !BEGIN "2ELSE EXIT(PROGRAM); ) END; )END; ! UNTIL NOT IOERROR; " "CLOSE(F,LOCK); "(*$I+*) !END; " !PROCEDURE GETYEAR; "BEGIN #PAGE(OUTPUT); #SKIPLINES(3); #WRITELN('ENTER THE STATEMENT DATE:'); #WRITELN; #WRITE(' MONTH...'); #THISMONTH:=G*IOERROR:=TRUE; *WRITELN(BELL,'CAN''T FIND ',T,'.'); *WRITE('IS THE NAME CORRECT? (Y/N)'); *IF ANSWERYES +THEN BEGIN 1WRITELN; 1WRITELN('CREATE A NEW CHECK BOOK FILE?'); 1WRITE('(Y/N)-->'); 1IF ANSWERYES 2THEN CREATEFILE(T) ; "READLN;SKIPLINES(3); " "REPEAT #PAGE(OUTPUT); #SKIPLINES(5); #IOERROR:=FALSE; #WRITELN('ENTER THE NAME OF YOUR CHECKBOOK'); #WRITELN; #WRITE('-->'); #READLN(T); #U:=CONCAT('CKBOOK:',T,'.FLOWFILE'); #RESET(F,U); #IF IORESULT<>0 $THEN BEGIN %BEGIN &WRITE('.'); &PUT(F); $ END; $WRITELN; $CLOSE(F,LOCK); # EXIT(GETBOOK); #(*$I+*) #END; ! ! !BEGIN "(*$I-*) "PAGE(OUTPUT);SKIPLINES(3); "WRITELN(BELL,'PLEASE INSERT VOLUME CKBOOK: IN DRIVE 2'); "WRITE('AND TYPE TO CONTINUE-->')$WRITELN('SETTING UP ',CONCAT('CKBOOK:',T,'.FLOWFILE')); $REWRITE(F,CONCAT('CKBOOK:',T,'.FLOWFILE')); $SEEK(F,9); $IF IORESULT<>0 %THEN BEGIN +WRITELN(BELL,'I-O ERROR, PROGRAM ABORTED'); +EXIT(PROGRAM); *END; $RESET(F); $F^:=Y; $FOR I:=0 TO 9 DOYEAR:DATAYEARS; # #PROCEDURE CREATEFILE(VAR T:STRING); #VAR I:INTEGER; #BEGIN $(*$I-*) $WHILE LENGTH(T)>7 DO %BEGIN &WRITELN; &WRITELN(BELL,'CHECK BOOK NAME TOO LONG'); &WRITE('7 CHARACTERS ONLY. ENTER NAME-->'); &READLN(T); %END; =['0'..'9']; "BELL:=CHR(7); "ESC:=CHR(27); !END; ! !PROCEDURE PARTTWO; !VAR ROW,COL:INTEGER; !BEGIN "FOR ROW:=-2 TO 12 DO #FOR COL:=0 TO MAXCODE DO $Y[ROW,COL]:=0; !END; ! !PROCEDURE GETBOOK; !VAR U:BOOKTITLE;F:FLOWFILE; %IOERROR:BOOLEAN; %OLEAN;FORWARD;   SEGMENT PROCEDURE GLOBALINITIALIZE(VAR T:BOOKTITLE;VAR X:MEMOVECTOR; CVAR FIRST:CHECKPOINTER; CVAR COUNT:SERIALNUMBER;VAR TOTAL:REAL; CVAR Y:FLOWMATRIX);  !PROCEDURE PARTONE; !BEGIN "FIRST:=NIL; "COUNT:=0; "TOTAL:=0; "DIGITS:!GETYEAR; !PARTTHR;  PARTFOUR;  END; " "  PROCEDURE FILTERINPUT;  BEGIN !REPEAT "GET(INPUT); "IF NOT (INPUT^ IN OKSET) #THEN BEGIN )WRITE(CHR(8)); )WRITE(' '); )WRITE(CHR(8)); )WRITE(BELL); ! END; !UNTIL INPUT^ IN OKSET;  END;   PROCEDURE SKIPLINES;  VAR L:INTEGER;  BEGIN !FOR L:=1 TO X DO WRITELN;  END;   FUNCTION ANSWERYES;  VAR CH:CHAR;  BEGIN !FILTERINPUT([YES,NO]); !READ(CH); !WRITELN; !ANSWERYES:=CH=YES;  END;   FUNCTION GETNUMBER;  VAR X:INTEGER;  BE'); #WRITELN('----------------------------------------'); # #REPEAT %WITH LISTHEAD^.CHECKPART DO &WITH DATE DO 'WRITELN(NUMBER:4,MONTH:3,'/',YEAR,CODE:3,MEMO,AMOUNT:8:2); %COUNTER:=COUNTER+1; %LISTHEAD:=LISTHEAD^.NEXTCHECK; #UNTIL ((COUNTER=LISTLENELISTING:BOOLEAN); "CONST LISTLENGTH=8; "VAR COUNTER:0..LISTLENGTH; "BEGIN(* LISTSOMECHECKS *) #COUNTER:=0; #PAGE(OUTPUT); #WRITELN('COUNTED-->',CHECKCOUNT:5,' CHECKS FOR-->',TOTAL:9:2); #WRITELN; #WRITELN('NUM. DATE CHECK MEMO AMOUNT TYPE ERRORLINK=^ERRORLIST; %ERRORLIST=RECORD 0NUMBER:SERIALNUMBER; 0NEXTNUM:ERRORLINK; 0END; 0  VAR LISTHEAD:CHECKPOINTER;  FIRSTERROR:ERRORLINK; $ERRORSNOTED,DONELISTING:BOOLEAN;  "PROCEDURE LISTSOMECHECKS(VAR LISTHEAD:CHECKPOINTER;VAR DOCK; #NEXTCHECK:=LEADER; "END; " !IF LEADER=FIRST "THEN FIRST:=NEWENTRY "ELSE FOLLOWER^.NEXTCHECK:=NEWENTRY; "  END;(* SORTBYNUMBER *)      PROCEDURE REVIEWCHECKS(VAR FIRSTCHECK:CHECKPOINTER;CHECKCOUNT:SERIALNUMBER; 7VAR TOTAL:REAL); UE;  WHILE SEARCHING AND (LEADER<>NIL) DO " "WITH LEADER^ DO #IF NEWCHECK.NUMBER'); ,CODE:=GETNUMBER(0,MAXCODE,FMEMOCODE); ,IF CODE=0 -THEN SHOWCODES(CODE); ,MEMO:=MEMOLIST[CODE]; ,COUNT:=COUNT+MONTH.............'); .MONTH:=GETNUMBER(1,12,FMONTH); .IF TWOYRS /THEN BEGIN 5WRITE('YEAR..............'); 5YEAR:=GETNUMBER(FIRSTYR,LASTYR,FYEAR); 4END .ELSE YEAR:=THISYEAR; -END; ,WRITE('AMOUNT............'); ,FILTERINPUT(DIGITS); ); ! WRITELN; #WRITE('NUMBER OR ...'); #FILTERINPUT(DIGITS+[ESC]); #IF INPUT^=ESC $THEN BEGIN *READ(CH);WRITELN; *READINGCHECKS:=FALSE; )END $ELSE BEGIN *WITH X DO +BEGIN ,NUMBER:=GETNUMBER(0,MAXNUM,FNUM); ,WITH DATE DO -BEGIN .WRITE('CKS(VAR X:CHECK;VAR COUNT:SERIALNUMBER;VAR TOTAL:REAL):BOOLEAN;  BEGIN ! #READINGCHECKS:=TRUE; #PAGE(OUTPUT); #SKIPLINES(3); #WRITELN('ENTER A CHECK BEGINNING WITH THE'); #WRITELN('CHECKNUMBER. ENTER IF THERE ARE'); #WRITELN('NO MORE CHECKS.'!PAGE(OUTPUT); !FOR J:=1 TO I DO %BEGIN %K:=I+J; %WRITELN(J:2,MEMOLIST[J],K:2,MEMOLIST[K]);  END; # #SKIPLINES(2); #WRITE('ENTER THE EXPENDITURE CODE-->'); #X:=GETNUMBER(1,MAXCODE,FMEMOCODE);  END;(* SHOWCODES *)    FUNCTION READINGCHE WRITE('ENTER 0 TO REVIEW THE CODES-->'); .END;  END; $ #FILTERINPUT(DIGITS); #READLN(X); # "END; !GETNUMBER:=X;  END; (* GETNUMBER *)    PROCEDURE SHOWCODES(VAR X:CODENUMBER);  VAR I,J,K:CODENUMBER;  BEGIN !I:=MAXCODE DIV 2; OF $FNUM: WRITE('ENTER CHECK NUMBER-->'); $FMONTH: WRITE('ENTER MONTH NUMBER-->');  FYEAR: BEGIN ,WRITELN('ENTER THE LAST TWO'); ,WRITE('DIGITS OF THE YEAR-->'); +END; $FMEMOCODE: BEGIN $ WRITELN('ENTER THE CODE NUMBER.'); $ GIN  !(*$I-*) !REPEAT READLN(X) UNTIL IORESULT=0; !(*$I+*) ! !WHILE ((XHI)) DO ! BEGIN " #PAGE(OUTPUT);SKIPLINES(5); #WRITELN(BELL,'INVALID ENTRY!!'); #SKIPLINES(2); #WRITELN('VALUES BETWEEN ',LO,' AND ',HI,' ONLY!'); # #CASE TAG NGTH) OR (LISTHEAD=NIL)); #DONELISTING:=LISTHEAD=NIL; "END; " !  PROCEDURE FLAGERRORS(VAR ERRORSNOTED:BOOLEAN;VAR FIRSTERROR:ERRORLINK); " $PROCEDURE FLAGBYNUMBER; $VAR NEWERROR:ERRORLINK; $ NEWNUM:SERIALNUMBER; $BEGIN %SKIPLINES(2); %WRITELN('ENTER, BY NUMBER, THE CHECKS TO BE'); %WRITELN('CORRECTED. ENTER A NEW NUMBER IF YOU'); %WRITELN('FORGOT ANY CHECKS, WHEN YOU ARE'); %WRITE('THROUGH-->'); %REPEAT &FILTERINPUT(DIGITS+[ESC]); &IF INPUT^ IN DIGITS 'THEN BEGIN -READL); !NEXTERROR:=NEXTERROR^.NEXTNUM;  DONESHOWING:=NEXTERROR=NIL;  END;  , #PROCEDURE ASKFORNEWCHECK(NUMBER:SERIALNUMBER;VAR FIRSTCHECK:CHECKPOINTER; '); &IF ANSWERYES 'THEN DELETE(BADCHECK,FIRSTCHECK,CHECKCOUNT,TOTAL) & ELSE REPAIR(BADCHECK^.CHECKPART,TOTAL); ( $END; , ,EN FIRST:=X^.NEXTCHECK 1ELSE BEGIN 6JUMPER:=FIRST; 6WHILE JUMPER^.NEXTCHECK<>X DO 7JUMPER:=JUMPER^.NEXTCHECK; 6JUMPER^.NEXTCHECK:=X^.NEXTCHECK; 6END; /WITH X^.CHECKPART DO 0BEGIN 1TOTAL:=TOTAL-AMOUNT; 1WRITELN('CHECK',NUMBER:5,' DELETED.'); 0END&PROCEDURE DELETE(X:CHECKPOINTER;VAR FIRST:CHECKPOINTER; 7VAR CHECKCOUNT:SERIALNUMBER;TOTAL:REAL); &VAR JUMPER:CHECKPOINTER; &BEGIN 'WRITELN; 'WRITE('PLEASE CONFIRM (Y/N)-->'); 'IF ANSWERYES )THEN BEGIN /CHECKCOUNT:=CHECKCOUNT-1; /IF X=FIRST 1TH.TOTAL:=TOTAL+AMOUNT; -END; 'IF FIXFIELD('EXPENDITURE CODE') (THEN BEGIN .WRITELN('ENTER 0 TO REVIEW-->'); .CODE:=GETNUMBER(0,MAXCODE,FMEMOCODE); .IF CODE=0 THEN SHOWCODES(CODE); .MEMO:=MEMOLIST[CODE]; -END; $ END; $END;(* REPAIR *) & & WITH DATE DO .BEGIN /WRITELN; /WRITE('MONTH...'); /MONTH:=GETNUMBER(1,12,FMONTH); /WRITE('YEAR....'); /YEAR:=GETNUMBER(FIRSTYR,LASTYR,FYEAR); .END; 'IF FIXFIELD('AMOUNT') (THEN BEGIN .TOTAL:=TOTAL-AMOUNT; .FILTERINPUT(DIGITS); .READLN(AMOUNT); 'CORRECT THE ',S,'? (Y/N)'); 'IF ANSWERYES (THEN BEGIN .FIXFIELD:=TRUE; .WRITELN; .WRITE('ENTER THE ',S,'-->'); -END; &END; # $BEGIN %WITH X DO &BEGIN 'IF FIXFIELD('NUMBER') (THEN NUMBER:=GETNUMBER(0,MAXNUM,FNUM); 'IF FIXFIELD('DATE') (THEN $PROCEDURE GETCORRECTIONS(BADCHECK:CHECKPOINTER;VAR FIRSTCHECK:CHECKPOINTER; =VAR CHECKCOUNT:SERIALNUMBER;VAR TOTAL:REAL); $ $ $PROCEDURE REPAIR(VAR X:CHECK;VAR TOTAL:REAL); # &FUNCTION FIXFIELD(S:STRING):BOOLEAN; &BEGIN 'FIXFIELD:=FALSE; 'WRITE(ECKPOINTER; 7VAR CHECKCOUNT:SERIALNUMBER;VAR TOTAL:REAL);  VAR NEXTERROR:ERRORLINK; $STARTCHK,NEXTCHK:CHECKPOINTER; $CHECKNOTFOUND,DONESHOWING:BOOLEAN; $BADNUMBER:SERIALNUMBER; $POINTOBADCHECK:CHECKPOINTER; $ SC; #END(* FLAGBYNUMBER *); $  BEGIN(* FLAGERRORS *) !SKIPLINES(2); !WRITELN('ANY CORRECTIONS'); !WRITE('TO THIS LIST? (Y/N)-->'); !IF ANSWERYES "THEN FLAGBYNUMBER;  END;    PROCEDURE CORRECTERRORS(VAR FIRSTERROR:ERRORLINK;VAR FIRSTCHECK:CHN(NEWNUM); -NEW(NEWERROR); -WITH NEWERROR^ DO .BEGIN /NUMBER:=NEWNUM; /NEXTNUM:=FIRSTERROR; .END; -FIRSTERROR:=NEWERROR; , ERRORSNOTED:=TRUE; , WRITE(' -->'); ,END 'ELSE BEGIN -READ(CH);WRITELN; -EXIT(FLAGERRORS); ,END; $UNTIL INPUT^=EN $PAGE(OUTPUT); $SKIPLINES(3); $WRITELN(BELL,'COULDNT FIND-->',NUMBER:5); $WRITELN('DO YOU WANT TO ENTER'); $WRITE('A NEW CHECK? (Y/N)-->'); $IF ANSWERYES %THEN BEGIN +SEARCHING:=READINGCHECKS(NEWCHECK,CHECKCOUNT,TOTAL); +SORTBYNUMBER(NEWCHECK,FIRSTCHECK); *END; #END;   BEGIN(* CORRECTERRORS *) !NEXTERROR:=FIRSTERROR; !REPEAT "SHOWABADCHECK(NEXTERROR,CHECKNOTFOUND,POINTOBADCHECK,DONESHOWING,BADNUMBER); "IF CHECKNOTFOUND #THEN ASKFORNEWCHECK(BADNUMBER,FIRSTCHECK,#REVIEWCHECKS(FIRSTCHECK,CHECKCOUNT,TOTAL); !  #DEPOSITS:=DOLLARS; # #BUILDCASHFLOW(CASHFLOW,FIRSTCHECK,DEPOSITS); #DISPLAYFLOW(CASHFLOW); #UPDATEFLOWFILE(CASHFLOW,NAMEOFBOOK); ! #WRITELN; #WRITELN(BELL,BELL,'THAT''S ALL FOLKS'); !END.  EADLN;  END;    BEGIN(* MAIN *)  #GLOBALINITITIALIZE(NAMEOFBOOK,MEMOLIST, 6FIRSTCHECK,CHECKCOUNT,TOTAL,CASHFLOW); # #WHILE READINGCHECKS(NEWCHECK,CHECKCOUNT,TOTAL) $DO SORTBYNUMBERK(NEWCHECK,FIRSTCHECK); # ODE DIV 2; !FOR I:=1 TO K DO "BEGIN #J:=I+K; #WRITELN(I:3,MEMOLIST[I],COLTOTS[I]:10:2,COLPCNTS[I]:8:1, +J:6,MEMOLIST[J],COLTOTS[J]:10:2,COLPCNTS[J]:8:1); "END; ! !WRITELN('DEPOSITS= ',DEPOSITS:10:2); !WRITE(' SPLITS, CONTINUES'); !ROR I:=1 TO MAXCODE DO #BEGIN $FOR J:=-2 TO 12 DO %COLTOTS[I]:=COLTOTS[I]+FLOW[J,I]; ! WRITE('.'); ! END;  WRITELN; ! !FOR I:=1 TO MAXCODE DO "COLPCNTS[I]:=100*COLTOTS[I]/DEPOSITS; !PAGE(OUTPUT); !WRITELN(S1,S1); !WRITELN(S2,S2); ! !K:=MAXC VAR COLPCNTS,COLTOTS:ARRAY[1..MAXCODE] OF REAL;  I,J,K:INTEGER;  S1,S2:STRING[40];  BEGIN !S1:=' CHECK % OF '; !S2:=' CATEGORY AMOUNT DEPOSITS '; ! !FOR I:=1 TO MAXCODE DO #COLTOTS[I]:=0.0; ! !FFOR ROW:=-2 TO 12 DO "BEGIN #WRITE('.'); #FOR COL:=0 TO MAXCODE DO %F^[ROW,COL]:=F^[ROW,COL]+X[ROW,COL]; "END; !SEEK(F,(THISYEAR-BASEYR)); !PUT(F); !CLOSE(F,LOCK);  END;    PROCEDURE DISPLAYFLOW(FLOW:FLOWMATRIX); !  PROCEDURE UPDATEFLOWFILE(X:FLOWMATRIX;T:BOOKTITLE);  VAR F:FLOWFILE; $ROW,COL:INTEGER;  BEGIN !PAGE(OUTPUT); !SKIPLINES(5); !WRITE('UPDATING CASH FLOW FILE'); !RESET(F,CONCAT('CKBOOK:',T,'.FLOWFILE')); !SEEK(F,(THISYEAR-BASEYR)); !GET(F); !FIRST; !REPEAT "WITH NEXT^.CHECKPART DO $WITH DATE DO %BEGIN &MM:=MONTH; &IF YEAR'); "WRITELN; "WRITELN(' DEPOSITS= ',X:10:2); "WRITELN; "WRITE('Y/N? -->'); LISTING); #FLAGERRORS(ERRORSNOTED,FIRSTERROR); "UNTIL DONELISTING; "IF ERRORSNOTED #THEN CORRECTERRORS(FIRSTERROR,FIRSTCHECK,CHECKCOUNT,TOTAL); !UNTIL NOT ERRORSNOTED;  END;    FUNCTION DOLLARS:REAL;  VAR X:REAL;  BEGIN !REPEAT; "PAGE(OUTPUTCHECKCOUNT,TOTAL) #ELSE GETCORRECTIONS(POINTOBADCHECK,FIRSTCHECK,CHECKCOUNT,TOTAL); !UNTIL DONESHOWING;  END;    BEGIN(*REVIEWCHECKS*) !REPEAT "LISTHEAD:=FIRSTCHECK; "ERRORSNOTED:=FALSE; "FIRSTERROR:=NIL; "REPEAT #LISTSOMECHECKS(LISTHEAD,DONEN^ơeln; #END; !UNTIL key IN ['Y','y','N','n']; # !IF key IN ['Y','y'] "THEN BEGIN (unitclear(unitnumber); (unitwrite(unitnumber,catalog[0],onerecord,startcatalog,0);  writeln; (writeln('Directory zeroed.'); 'END; #  END; "  PROCEDURE krumber,catalog[0],onerecord,startcatalog,0); ! !REPEAT "WITH catalog[0].master DO #BEGIN $page(output); $stats[0]:=0; $writeln('Zero the directory of'); $writeln('#',unitnumber,':',volname,'?'); $write('Please confirm (Y/N)-->'); $read(key); $writ END;  PROCEDURE zero;  CONST onerecord=26;  VAR name:STRING;  BEGIN !REPEAT "page(output); "gotoxy(0,3);  writeln('Zero the directory of'); "write('which unit, 4 or 5?'); "readln(unitnumber); !UNTIL unitnumber IN [4,5];  !unitread(unitnuwrite('data'); %graf:write('graf'); %foto:write('foto'); %END; $writeln(nextstart-startblock:3); # oldstart:=nextstart; $blocksleft:=blocksleft-(nextstart-startblock); # linecount:=linecount+1; #END;  writeln('',blocksleft:10,' left'); . ',name,' ':16-length(name), *date[0] MOD 16:2,'-', *(date[0] DIV 16)+16*(date[1] MOD 2):2,'-', *date[1] DIV 2:2,' '); $CASE kind OF %volid:write('volid'); %bad:write('bad '); %code:write('code'); %text:write('text'); %info:write('info'); %data:atalog[entrynumber],entry DO #BEGIN $IF (linecount MOD 21)=0 THEN readln; $IF startblock<>oldstart %THEN BEGIN +writeln('',startblock-oldstart:10,' blocks'); $ blocksleft:=blocksleft-(startblock-oldstart); *END; $write(entrynumber:2,'!WITH catalog[0],master DO #BEGIN $numoffiles:=stats[0]; $writeln(volname,' contains ',numoffiles,' files.'); ! END; ! !linecount:=1; !oldstart:=startuserfiles; !blocksleft:=maxblocks-startuserfiles; !FOR entrynumber:=1 TO numoffiles DO "WITH cldstart,blocksleft:INTEGER;  BEGIN !REPEAT "page(output); "gotoxy(0,3); "writeln('List contents of'); "write('which unit, 4 or 5?'); "readln(unitnumber); !UNTIL unitnumber IN [4,5]; !unitread(unitnumber,catalog[0],fourblocks,startcatalog,0); ! er:volheader); 4FALSE:(entry:fileheader); 4END; 2  VAR catalog:PACKED ARRAY[0..maxentries] OF catalogentry; $entrynumber,numoffiles,unitnumber:INTEGER; $key:CHAR; $  PROCEDURE list;  CONST startuserfiles=6;  maxblocks=280;  VAR linecount,o] OF bytesize; /END; % %fileheader=RECORD 1name:STRING[15]; 1notyetknown:INTEGER; 1date:PACKED ARRAY[0..1] OF bytesize; 1END; % %catalogentry=RECORD 3nextstart,startblock:INTEGER;  kind:filetype; 3CASE BOOLEAN OF 4TRUE:(mastPROGRAM filer;  CONST maxentries=78;  fourblocks=2048; &startcatalog=2;   TYPE bytesize=0..255; %filetype=(volid,bad,code,text,info,data,graf,foto); % %volheader=RECORD 0volname:STRING[7]; 0blocks_per_vol:INTEGER; 0stats:PACKED ARRAY[0..6nch;  VAR gapsize:INTEGER;  !FUNCTION blankblocks(entry,entryplusone:INTEGER;VAR gap:INTEGER):BOOLEAN; !BEGIN "gap:=catalog[entryplusone].startblock-catalog[entry].nextstart; "IF gap=0 THEN blankblocks:=FALSE #ELSE blankblocks:=TRUE; !END; !  PROCEDURE move(entry,gap:INTEGER); !CONST buffsize=4096; 'blocksinbuffer=16; !VAR buffer:PACKED ARRAY[1..buffsize] OF 0..255; %buffcount,bytecount,index:INTEGER; !BEGIN "WITH catalog[entry] DO #BEGIN $buffcount:=(nextstart-startblock) DIV blocksEK*); "(* *) "PROCEDURE POKE(*ADDRESS,VALUE:INTEGER*); "BEGIN $MEMORY.LOCATION:=ADDRESS; $MEMORY.CONTENTS^[0]:=VALUE; "END (*POKE*);  (* *)  BEGIN  END (*PEEKPOKE*).  R MEMORY : RECORD CASE BOOLEAN OF (TRUE : (LOCATION:INTEGER); (FALSE : (CONTENTS:^BYTEWORD); END;  (* *) "FUNCTION PEEK(*ADDRESS:INTEGER*); "BEGIN $MEMORY.LOCATION:=ADDRESS; $PEEK:=MEMORY.CONTENTS^[0]; "END (*PE(*$S+*)  UNIT PEEKPOKE; INTRINSIC CODE 25;  INTERFACE "FUNCTION PEEK(ADDRESS:INTEGER): INTEGER; "PROCEDURE POKE(ADDRESS,VALUE:INTEGER);  (* *)  IMPLEMENTATION "TYPE BYTEWORD = PACKED ARRAY[0..1] 3 OF 0..255; "VAN^ˠro,K)runch,Q)uit?'); "read(key); "writeln; " "CASE key OF #'L','l':list; #'Z','z':zero; #'K','k':krunch; #'Q','q':exit(program); #END; !UNTIL key IN ['Q','q'];  END. ! rynumber:=entrynumber+1; "END;  !IF numoffiles>0 THEN unitwrite(unitnumber,catalog[0],fourblocks,startcatalog,0); !writeln; !writeln(catalog[0].master.volname,' crunched.');  END;   BEGIN !page(output); !REPEAT "gotoxy(0,0); "write('L)ist,Z)e!unitread(unitnumber,catalog[0],fourblocks,startcatalog,0); !numoffiles:=catalog[0].master.stats[0]; !entrynumber:=0; !WHILE entrynumber0 %THEN BEGIN +unitread(unitnumber,buffer,bytecount, 4startblock+blocksinbuffer*index,0); # unitwrite(unitnumber,buffer,bytecount, 5startblock+blocksinbuffer*index-gap); # END; $starinbuffer; $bytecount:=(nextstart-startblock) MOD buffsize; # index:=0; $WHILE index curblock then begin &junk := blockread(f, buffer, 1, blockno); &curblock := blockno; &if eof(f) then )lastpage := 2 * blockno + 1 #end  end;   procedure getpage;  (* Get page into memory *)   begin #blockno := pag program filedump;  (* Dump file in hex and ASCII *)  var #f: file; #alldone: boolean; #buffer: packed array[0..511] of char; #pageno, blockno, lastpage, curblock: integer;   procedure getblock;  (* Get block into memory *)  var #junk: integerN^l END.  THEN &SKIP(PAGELEN - LINENO)  END;   BEGIN #REWRITE(PRINTER, 'PRINTER:'); #WRITE('FILE TO PRINT?:'); #READLN(NAME); #WHILE NAME <> '' DO BEGIN &RESET(INFILE, NAME); &FPRINT; &WRITE('FILE TO PRINT?:'); &READLN(NAME); &CLOSE(INFILE) #END 'PAGE ', PAGENO); )SKIP(MARGIN2); )LINENO := MARGIN1 + MARGIN2 + 1 &END; &READLN(INFILE, LINE); &WRITELN(PRINTER, ' ', LINE); &LINENO := LINENO + 1; &IF LINENO >= BOTTOM THEN BEGIN )SKIP(PAGELEN - LINENO); )LINENO := 0 &END #END; #IF LINENO > 0 = 62; #PAGELEN = 66;   VAR #PAGENO, LINENO: INTEGER; #LINE: STRING;   BEGIN #PAGENO := 0; #LINENO := 0; #WHILE NOT EOF(INFILE) DO BEGIN &IF LINENO = 0 THEN BEGIN )SKIP(MARGIN1); )PAGENO := PAGENO + 1; )WRITELN(PRINTER, NAME: 22, ' ': 48, tpage  end;   procedure displaypage;   const #NLINES = 16; #NCOLS = 16;   var #c: char; #s: string; #i, j, k, firstbyte: integer;  hexstr: string;   begin #hexstr := '0123456789ABCDEF'; #page(output); #writeln('Block ',blockno); #firstbyte := 256 * (pageno - 2 * blockno); #for i := 1 to NLINES do begin &writeln; &k := firstbyte mod 256; &write(hexstr[firstbyte div 256 + 1]); &write(hexstr[k div 16 + 1]); &write(hexstr[k mod 16 + 1]); &write(': '); &for j := 1 to NCOLS do RH; EXTERNAL;  FUNCTION CURV; EXTERNAL;  PROCEDURE HORZSHFT; EXTERNAL;  PROCEDURE INVERSE; EXTERNAL;  PROCEDURE NORMAL; EXTERNAL;  PROCEDURE FLASH; EXTERNAL;  FUNCTION GETFLGS; EXTERNAL;  PROCEDURE ONFLG; EXTERNAL;  PROCEDURE OFFFLG; EXTERNAL;  FUE FLASH;  FUNCTION GETFLGS:INTEGER;  PROCEDURE ONFLG(F:INTEGER);  PROCEDURE OFFFLG(F:INTEGER);  FUNCTION CHLEFT:INTEGER;  PROCEDURE STUFF(CH:CHAR);  PROCEDURE STUFFS(S:STRING);  PROCEDURE WINDOW(TOP,BOT:SCRANGE);   IMPLEMENTATION   FUNCTION CU(*S+*)  UNIT BIOSUNIT;   INTERFACE   CONST (AUTO = 1; (FLUSH = 64; (STOP = 128;   TYPE (SCRANGE = 0..23;   FUNCTION CURH:INTEGER;  FUNCTION CURV:INTEGER;  PROCEDURE HORZSHFT(H:INTEGER);  PROCEDURE INVERSE;  PROCEDURE NORMAL;  PROCEDURN^&getpage; &displaypage; &getdir #until alldone  end.  no - 1; &if pageno < 0 then )pageno := 0 #end #else if cval = 21 then begin &pageno := pageno + 1; &if pageno > lastpage then )pageno := lastpage #end #else if cval = 3 then &alldone := true  end;   begin (* filedump *) #init; #repeat ,write('.') &end; &firstbyte := firstbyte + NCOLS #end  end;   procedure getdir;   var #ch: char; #cval: integer;   begin #repeat &read(keyboard, ch); &cval := ord(ch) #until cval in [3, 8, 21]; #if cval = 8 then begin &pageno := pagebegin )k := ord(buffer[firstbyte + j - 1]); )write(hexstr[k div 16 + 1]); )write(hexstr[k mod 16 + 1]); )write(' '); &end; &for j := 1 to NCOLS do begin )c := buffer[firstbyte + j - 1]; )if (ord(c) >= 32) and (ord(c) <= 126) then ,write(c) )else NCTION CHLEFT; EXTERNAL;  PROCEDURE STUFF; EXTERNAL;  PROCEDURE STUFFS; EXTERNAL;  PROCEDURE WINDOW; EXTERNAL;   BEGIN  END.  B E N^:TELN('OF THE BOOT VOLUME.');  STUFFS('FE#4');  STUFF(CHR(RETURN));  WRITELN('THIS WILL LEAVE YOU IN THE FILER.');  WAIT(5000);  END.  "BEGIN $WRITE('THIS IS PART WINDOW SCROLL'); $WRITELN(' ',I:2); $WAIT(500); "END;  WINDOW(0,23);  PAGE(OUTPUT);  WRITELN('CHARACTERS WILL NOW BE PUT IN');  WRITELN('THE TYPE-AHEAD BUFFER TO GET');  WRITELN('AN EXTENDED DIRECTORY LISTING');  WRI; "END;  WINDOW(8,17);  GOTOXY(0,8); (* GO INSIDE WINDOW *)  FOR I:=1 TO 30 DO "BEGIN $WRITE('THIS IS PART WINDOW SCROLL'); $WRITELN(' ',I:2); $WAIT(150); "END;  WINDOW(17,23);  GOTOXY(0,17); (* GO INSIDE WINDOW *)  FOR I:=1 TO 30 DO I:=1 TO 30 DO "BEGIN $WRITE('THIS IS FULL WINDOW SCROLL'); $WRITELN(' ',I:2); $WAIT(500); "END;  WINDOW(0,9);  GOTOXY(0,0); (* GO INSIDE WINDOW *)  FOR I:=1 TO 30 DO "BEGIN $WRITE('THIS IS PART WINDOW SCROLL'); $WRITELN(' ',I:2); $WAIT(150)HORZSHFT(-8); $WAIT(500);  END;  ONFLG(AUTO);  WRITELN('TO ILLUSTRATE AUTO-FOLLOW');  WRITELN('THE CTRL-Z OPTION OF THE EDITOR');  WRITE('TYPE IN SOME CHARACTERS NOW ');  READLN(S);  OFFFLG(AUTO);  HORZSHFT(-CHLEFT);  WINDOW(0,23);  FOR FOR I:=1 TO 3 DO "BEGIN $INVERSE; $WRITE('INVERSE'); $NORMAL; $WRITE(' '); $FLASH; $WRITE('FLASH'); $NORMAL; $WRITE(' NORMAL');  END;  WRITELN;  FOR J:=1 TO 10 DO "BEGIN $HORZSHFT(8);  WAIT(500); "END;  FOR J:=1 TO 10 DO "BEGIN $XY(20,15);  FOR I:=1 TO 10 DO "BEGIN $GOTOXY(CURH,CURV-1);  WRITE('V'); $GOTOXY(CURH-1,CURV); "END;  J := CURH + 1;  FOR I:=1 TO 10 DO "BEGIN $GOTOXY(CURH-1,CURV);  WRITE('H'); $GOTOXY(CURH-1,CURV); "END;  GOTOXY(J,CURV); NCTION CHLEFT:INTEGER; EXTERNAL;  PROCEDURE STUFF(CH:CHAR); EXTERNAL;  PROCEDURE STUFFS(S:STRING); EXTERNAL;  PROCEDURE WINDOW(TOP,BOT:SCRANGE); EXTERNAL;  PROCEDURE WAIT(T:INTEGER);  VAR (I: INTEGER;  BEGIN  FOR I:=1 TO T DO;  END;  BEGIN  GOTO PROCEDURE HORZSHFT(H:INTEGER); EXTERNAL;  PROCEDURE INVERSE; EXTERNAL;  PROCEDURE NORMAL; EXTERNAL;  PROCEDURE FLASH; EXTERNAL;  FUNCTION GETFLGS:INTEGER; EXTERNAL;  PROCEDURE ONFLG(F:INTEGER); EXTERNAL;  PROCEDURE OFFFLG(F:INTEGER); EXTERNAL;  FUPROGRAM BIOSDEMO;  CONST (AUTO = 1; (FLUSH = 64; (STOP = 128;  RETURN = 13;  TYPE (SCRANGE = 0..23;  VAR (I,J: INTEGER;  S: STRING;  TOP,BOT: SCRANGE;  FUNCTION CURH:INTEGER; EXTERNAL;  FUNCTION CURV:INTEGER; EXTERNAL; GN 1 N^Ǡ۠ODEFILE, TEXTFILE, INFOFILE, >DATAFILE, GRAFFILE, FOTOFILE *) ,END (* CASE DFKIND; DIRENTRY *); , *DIRECTORY = ,ARRAY[DIRRANGE] OF DIRENTRY; (  (*------------------------------------*) (  FILEINDEX = 1..MAXDIR; (NAMETYPE = PACKED RECORD WARD COMP *) 2STATUS: BOOLEAN; (* FOR FILER WILDCARDS *) 2DTID: TID; (* TITLE OF FILE *) 2DLASTBYTE: 1..FBLKSIZE; (* NUMBER OF BYTES IN LAST BLK *) 2DACCESS: DATEREC (* DATE OF LAST MODIFICATION *) 0) (* END CASE XDSKFILE, C2DLASTBOOT: DATEREC (* MOST RECENT DATE SETTING *) 0) (* END CASE SECUREDIR, UNTYPEDFILE *); 0 .XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, .DATAFILE, GRAFFILE, FOTOFILE: .(* REGULAR FILE INFO *) 0( FILLER2: 0..1024; (* WASTE 12 BITS FOR DOWNID; (* NAME OF DISK VOLUME *) 2DEOVBLK: INTEGER; (* LAST BLK OF VOLUME *) 2DNUMFILES: DIRRANGE; (* NUMBER OF FILES IN DIRECTORY *) 2DLOADTIME: INTEGER; (* TIME OF LAST ACCESS *) SS *) ,DLASTBLK: INTEGER; (* POINTS AT BLOCK FOLLOWING LAST USED BLOCK *) ,CASE DFKIND: FILEKIND OF .SECUREDIR, .UNTYPEDFILE: .(* ONLY IN DIR[0] - THIS IS VOLUME INFO *) 0( FILLER1: 0..2048; (* WASTE 13 BITS FOR DOWNWARD COMP *) 2DVID: V(* TITLE ID *) (TID = *STRING[TIDLENG]; * (FILEKIND = *(UNTYPEDFILE,XDSKFILE,CODEFILE,TEXTFILE,INFOFILE,DATAFILE, +GRAFFILE,FOTOFILE,SECUREDIR); + ((* DIRECTORY LAYOUT *) (DIRENTRY = *PACKED RECORD ,DFIRSTBLK: INTEGER; (* 1ST PHYSICAL DISK ADDRE,MONTH: 0..12; (* 0 IMPLIES MEANINGLESS DATA *) ,DAY: 0..31; (* DAY OF THE MONTH *) ,YEAR: 0..100; (* 100 IMPLIES THE DATED VOLUME IS TEMPORARY *) *END (* DATEREC *); * ((* VOLUME ID *) (VID = *STRING[VIDLENG]; * (DIRRANGE = *0..MAXDIR; * (DDRESS *) (  (*------------------------------------*) ( (LASTBLOCK = 280; (MAXNAMES = 154; (* TWICE MAXDIR *) (MAXSYSTEM = 6;  RETURN = 13;   TYPE ((* VOLUME/FILE DATE MARK *) (DATEREC = *PACKED RECORD AXIMUM NUMBER OF ENTRIES IN DIRECTORY *) (VIDLENG = 7; (* NUMBER OF CHARACTERS IN VOLUME ID *) (TIDLENG = 15; (* NUMBER OF CHARACTERS IN TITLE ID *) (FBLKSIZE = 512; (* STANDARD DISK BLOCK LENGTH *) (DIRBLK = 2; (* DIRECTORY STARTS AT THIS DISK-BLOCK A************************************)  (* THIS IS THE NEW VERSION THAT *) (* USES THE DIRECTORY VALUES *)  (* SUPPLIED BY APPLE. *)  (*************************************)   PROGRAM NEWMENU;   CONST (MAXDIR = 77; (* M (*************************************)  (* PROGRAM TO PRESENT A MENU *)  (* OF THE CODE FILES FROM BOTH *)  (* DISKS ONLINE. *)  (*************************************)  (* AUTHOR: DAVID NEUMANN *)  (*5VOLUME: INTEGER; 5NAME: TID; 5DATE: DATEREC; 3 SELECT: CHAR; 3 SYSFILE: BOOLEAN; 3END; (SYSTEMTYPE = PACKED RECORD 7NAME: TID; 7SELECT: CHAR; 5END;   VAR (CURNAME:INTEGER;  I:INTEGER; (DAY,MONTH,YEAR:INTEGER;  FILES: PACKED ARRAY[1..MAXNAMES] OF NAMETYPE; (SYSTEMS: PACKED ARRAY[1..MAXSYSTEM] OF SYSTEMTYPE; (SELECT:SET OF CHAR; (NAMECOUNT:0..MAXNAMES;  ANS:CHAR;  FOUND:BOOLEAN;   SEGMENT PROCEDURE INITIALIZE;  BEGIN  SELECT := FF(CH:CHAR); EXTERNAL;  PROCEDURE STUFFS(S:STRING); EXTERNAL;   BEGIN (* NEWMENU *)  INITIALIZE;  GETFILES;  FOR CURNAME:=1 TO NAMECOUNT DO "FILELINE(CURNAME);  REPEAT "GOTOXY(0,0); "WRITE('HIT RETURN TO EXIT. EXECUTE WHICH? '); "READ(ANS); ")  (* THEY STORE A CHARACTER OR STRING INTO THE TYPE AHEAD BUFFER. *)  (* STUFF STORES ONE CHARACTER *)  (* STUFFS STORES A STRING *)  (* BOTH ARE NEEDED BECAUSE STRINGS CAN'T CONTAIN $SPECIAL CHARACTERS LIKE CARRIAGE RETURN *)  PROCEDURE STU FILES[INDEX].SELECT := SL;  FILES[INDEX].SYSFILE := SYSNAME;  WRITE(' [',SL,'] ');  END;   PROCEDURE FILELINE;  BEGIN  FILECTD(INDEX);  FILENAME(INDEX);  FILEDATE(INDEX);  WRITELN;  END;   (* TWO EXTERNAL PROCEDURES IN FILE 'BIOSSTUFF' *CHARACTER *) $SL := SYSTEMS[S].SELECT "ELSE $BEGIN &(* NOT SPECIAL SO FIND NEXT AVAILABLE SELECTION CHARACTER *) &SL := 'A'; &WHILE NOT(SL IN SELECT) DO (IF SL = 'Z' *THEN ,SL := '1' *ELSE ,SL := SUCC(SL); &SELECT := SELECT - [SL]; $END; E;  S := 0;  (* CHECK FOR A SPECIAL 'SYSTEM.' NAME *)  REPEAT "S := S + 1; "IF FILES[INDEX].NAME = SYSTEMS[S].NAME $THEN &SYSNAME := TRUE;  UNTIL SYSNAME OR (S = MAXSYSTEM);  IF SYSNAME "THEN $(* SYSTEM NAMES HAVE THEIR OWN SPECIAL SELECTION INDEX);  BEGIN  WITH FILES[INDEX].DATE DO "DISPLAYDATE(DAY,MONTH,YEAR);  END;   PROCEDURE FILELINE(INDEX:FILEINDEX); FORWARD;   PROCEDURE FILECTD(INDEX:FILEINDEX);  VAR (S:INTEGER;  SL:CHAR; (SYSNAME:BOOLEAN;  BEGIN  SYSNAME := FALS"4: WRITE('Apr'); "5: WRITE('May'); "6: WRITE('Jun'); "7: WRITE('Jul'); "8: WRITE('Aug'); "9: WRITE('Sep'); !10: WRITE('Oct'); !11: WRITE('Nov'); !12: WRITE('Dec');  END; (* OF CASE *)  WRITE('-',YEAR);  END;   PROCEDURE FILEDATE(INDEX:FILEEX].NAME) < TIDLENG "THEN $WRITE(' ':(TIDLENG-LENGTH(FILES[INDEX].NAME)));  END;   PROCEDURE DISPLAYDATE(DAY,MONTH,YEAR:INTEGER);  BEGIN  WRITE(DAY:3,'-');  CASE MONTH OF "1: WRITE('Jan'); "2: WRITE('Feb'); "3: WRITE('Mar'); [CURDIR] DO .BEGIN 0VOLUME := UNITNUM; . NAME := DTID; 0DATE := DACCESS; .END; *END; "END;  END;   PROCEDURE FILENAME(INDEX:FILEINDEX);  BEGIN  WRITE(FILES[INDEX].NAME);  (* ADD SPACES AFTER NAME TO LINE UP LISTING *)  IF LENGTH(FILES[INDD DIRECTORY OF DISKETTE *) $UNITREAD(UNITNUM,DIR,SIZEOF(DIR),DIRBLK); $FOR CURDIR:=1 TO DIR[0].DNUMFILES DO &(* LOOKING FOR ONLY CODE FILES *) &IF DIR[CURDIR].DFKIND = CODEFILE (THEN *BEGIN ,NAMECOUNT := NAMECOUNT + 1; ,WITH FILES[NAMECOUNT],DIR SELECT := SELECT - ['C','A','L','E','F','R','D','U','H','I'];  END;   SEGMENT PROCEDURE GETFILES;  VAR (DIR:DIRECTORY;  CURDIR,UNITNUM:INTEGER;  BEGIN  NAMECOUNT := 0;  FOR UNITNUM:=4 TO 5 DO (* ASSUMES TWO DRIVES *) "BEGIN $(* REAECT := 'R';  (* REMOVE SPECIAL SELECTION CHARACTERS FROM AVAILABLE SET *)  (* SOME SPECIAL CHARACTERS REMOVED ARE FOR PROGRAMS *)  (* NOT DISPLAYED SUCH AS DEBUGGER, USER RESTART, *)  (* HALT AND INITIALIZE *) CT := 'A';  SYSTEMS[3].NAME := 'SYSTEM.LINKER'; SYSTEMS[3].SELECT := 'L';  SYSTEMS[4].NAME := 'SYSTEM.EDITOR'; SYSTEMS[4].SELECT := 'E';  SYSTEMS[5].NAME := 'SYSTEM.FILER'; SYSTEMS[5].SELECT := 'F';  SYSTEMS[6].NAME := 'SYSTEM.WRK.CODE'; SYSTEMS[6].SEL['A'..'Z','1'..'9']; (* INITIAL SET OF SELECTION CHARACTERS *)  (* SET UP STANDARD NAMES AND THEIR SPECIAL SELECTION CHARACTERS *)  SYSTEMS[1].NAME := 'SYSTEM.COMPILER';  SYSTEMS[1].SELECT := 'C';  SYSTEMS[2].NAME := 'SYSTEM.ASSMBLER'; SYSTEMS[2].SELEIF EOLN THEN EXIT(NEWMENU); "CURNAME := 0; "FOUND := FALSE; "REPEAT $CURNAME := CURNAME + 1; $IF (ANS = FILES[CURNAME].SELECT) &THEN FOUND := TRUE; "UNTIL (CURNAME = NAMECOUNT) OR FOUND; "IF FOUND  THEN &WITH FILES[CURNAME] DO (IF SYSFILE *THEN ,(* ONLY NEED ONE CHARACTER TO EXECUTE SYSTEM FILES *) ,STUFF(SELECT) *ELSE ,BEGIN .STUFFS('X#'); (* X = EXECUTE, # FOR VOLUME NUMBER *) .(* ADD VOLUME NUMBER *) .STUFF(CHR( ORD('0') + VOLUME)); .STUFF(':'); (* END OF VOLUME SPECIFICATLLOWING LAST USED BLOCK *) ,CASE DFKIND: FILEKIND OF .SECUREDIR, .UNTYPEDFILE: .(* ONLY IN DIR[0] - THIS IS VOLUME INFO *) 0( FILLER1: 0..2048; (* WASTE 13 BITS FOR DOWNWARD COMP *) 2DVID: VID; (* NAME OF DISK VOLUME *) 2DEOVBLK: LEKIND = *(UNTYPEDFILE,XDSKFILE,CODEFILE,TEXTFILE,INFOFILE,DATAFILE, +GRAFFILE,FOTOFILE,SECUREDIR); + ((* DIRECTORY LAYOUT *) (DIRENTRY = *PACKED RECORD ,DFIRSTBLK: INTEGER; (* 1ST PHYSICAL DISK ADDRESS *) ,DLASTBLK: INTEGER; (* POINTS AT BLOCK FO,DAY: 0..31; (* DAY OF THE MONTH *) ,YEAR: 0..100; (* 100 IMPLIES THE DATED VOLUME IS TEMPORARY *) *END (* DATEREC *); * ((* VOLUME ID *) (VID = *STRING[VIDLENG]; * (DIRRANGE = *0..MAXDIR; * ((* TITLE ID *) (TID = *STRING[TIDLENG]; * (FI*) (  (*------------------------------------*) ( (FIRST = 1; (LAST = 2; (LASTBLOCK = 280; (VOLUMEENTRY = 0;   TYPE ((* VOLUME/FILE DATE MARK *) (DATEREC = *PACKED RECORD ,MONTH: 0..12; (* 0 IMPLIES MEANINGLESS DATA *) NUMBER OF ENTRIES IN DIRECTORY *) (VIDLENG = 7; (* NUMBER OF CHARACTERS IN VOLUME ID *) (TIDLENG = 15; (* NUMBER OF CHARACTERS IN TITLE ID *) (FBLKSIZE = 512; (* STANDARD DISK BLOCK LENGTH *) (DIRBLK = 2; (* DIRECTORY STARTS AT THIS DISK-BLOCK ADDRESS **********************************)  (* THIS IS THE NEW FORMAT, USING*)  (* THE DIRECTORY DECLARATIONS *)  (* SUPPLIED BY APPLE. *)  (*************************************)   PROGRAM DIR;  CONST (MAXDIR = 77; (* MAXIMUM (*************************************)  (* PROGRAM TO DUPLICATE THE *)  (* EXTENDED DIRECTORY LISTING *)  (* OF THE FILER. *)  (*************************************)  (* AUTHOR: DAVID NEUMANN *)  (***FB B E PB PE   N^ION *) .(* EXECUTE DOESN'T WANT '.CODE' AS PART OF NAME *) .DELETE(NAME,POS('.CODE',NAME),LENGTH('.CODE')); .STUFFS(NAME); (* STORE FILE NAME *) .STUFF(CHR(RETURN)); (* END WITH CARRIAGE RETURN *) ,END;  UNTIL FOUND;  END. INTEGER; (* LAST BLK OF VOLUME *) 2DNUMFILES: DIRRANGE; (* NUMBER OF FILES IN DIRECTORY *) 2DLOADTIME: INTEGER; (* TIME OF LAST ACCESS *) 2DLASTBOOT: DATEREC (* MOST RECENT DATE SETTING *) 0) (* END CASE SECUREDIR, UNTYPEDFILE *); 0 .XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, .DATAFILE, GRAFFILE, FOTOFILE: .(* REGULAR FILE INFO *) 0( FILLER2: 0..1024; (* WASTE 12 BITS FOR DOWNWARD COMP *) 2STATUS: BOOLEAN; (* FOR FILER WILDCARDS *) 2DTID: TID; (* TITLE DATEOFVOLUME;  WRITELN;  FOR I:=1 TO 2000 DO;  PAGE(OUTPUT);  VOLUME;  CURDIR := 1;  WHILE CURDIR <= NUMOFILES DO "BEGIN $STARTCURRENT := BLOCKS(CURDIR,FIRST); $IF (STARTCURRENT - ENDPREVIOUS) <> 0 &THEN (BEGIN *FREESPACE := TRUE; *FREEBLOCKSREAD(UNITNUM,DIREC,SIZEOF(DIREC),DIRBLK);  ENDPREVIOUS := BLOCKS(VOLUMEENTRY,LAST);  NUMOFILES := DIREC[VOLUMEENTRY].DNUMFILES;  UNUSED := 0;  LARGEST := 0;  IF UNITNUM = 4 "THEN $WRITE('The current date = ')  ELSE $WRITE('Date on volume = ');  WRITE(NUMOFILES,'/',NUMOFILES,' files,');  WRITE(' ',UNUSED,' unused,');  WRITE(' ',LARGEST,' in largest');  WRITELN;  END;   BEGIN  WRITE('WHAT UNIT? 4 OR 5? ');  READLN(UNITNUM);  IF NOT ((UNITNUM = 4) OR (UNITNUM = 5)) THEN EXIT(DIR);  UNITNDPREVIOUS) <> 0 "THEN $BEGIN &FREESPACE := TRUE; &FREEBLOCKS := LASTBLOCK - ENDPREVIOUS; &UNUSED := UNUSED + FREEBLOCKS; &IF FREEBLOCKS > LARGEST THEN LARGEST := FREEBLOCKS; $ STARTBLOCK := ENDPREVIOUS; &FILELINE; $END; (FOTOFILE: WRITELN('Foto'); (SECUREDIR: WRITELN(' '); &END; (* OF CASE *)  END;  END;   PROCEDURE FILELINE;  BEGIN  FILENAME;  FILESIZE;  FILEDATE;  FILESTART;  FILECTD;  END;   PROCEDURE SUMMARY;  BEGIN  IF (LASTBLOCK - E&CASE DIREC[CURDIR].DFKIND OF (UNTYPEDFILE: WRITELN(' '); (XDSKFILE: WRITELN('Bad '); (CODEFILE: WRITELN('Code'); (TEXTFILE: WRITELN('Text'); (INFOFILE: WRITELN('Info'); (DATAFILE: WRITELN('Data'); & GRAFFILE: WRITELN('Graf'); WITH DIREC[VOLUMEENTRY].DLASTBOOT DO "DISPLAYDATE(DAY,MONTH,YEAR);  END;   PROCEDURE FILESTART;  BEGIN  WRITE(' ');  WRITE(STARTBLOCK:3);  END;   PROCEDURE FILECTD;  BEGIN  IF FREESPACE "THEN $WRITELN(' ':5) "ELSE $BEGIN &WRITE(' '); END; (* OF CASE *)  WRITE('-',YEAR);  END;   PROCEDURE FILEDATE;  BEGIN  IF FREESPACE "THEN $WRITE(' ':10) "ELSE $BEGIN  WITH DIREC[CURDIR].DACCESS DO (DISPLAYDATE(DAY,MONTH,YEAR); $END;  END;   PROCEDURE DATEOFVOLUME;  BEGIN 3,'-');  CASE MONTH OF "1: WRITE('Jan'); "2: WRITE('Feb'); "3: WRITE('Mar'); "4: WRITE('Apr'); "5: WRITE('May'); "6: WRITE('Jun'); "7: WRITE('Jul'); "8: WRITE('Aug'); "9: WRITE('Sep'); !10: WRITE('Oct'); !11: WRITE('Nov'); !12: WRITE('Dec');  PROCEDURE FILESIZE;  VAR SIZE:INTEGER;  BEGIN  IF FREESPACE "THEN $SIZE := FREEBLOCKS  ELSE  SIZE := BLOCKS(CURDIR,LAST) - BLOCKS(CURDIR,FIRST);  WRITE(SIZE:3);  END;   PROCEDURE DISPLAYDATE(DAY,MONTH,YEAR:INTEGER);  BEGIN  WRITE(DAY: WRITE(DIREC[VOLUMEENTRY].DVID);  WRITELN(':');  END;   PROCEDURE FILENAME;  BEGIN  IF FREESPACE "THEN $WRITE('< UNUSED > ') "ELSE  BEGIN &WRITE(DIREC[CURDIR].DTID); &WRITE(' ':(17-LENGTH(DIREC[CURDIR].DTID)));  END;  END;  FREEBLOCKS:INTEGER; (UNUSED,LARGEST:INTEGER;   FUNCTION BLOCKS(INDEX,OFFSET:INTEGER):INTEGER;  BEGIN  IF OFFSET = FIRST "THEN $BLOCKS := DIREC[INDEX].DFIRSTBLK "ELSE $BLOCKS := DIREC[INDEX].DLASTBLK;  END;   PROCEDURE VOLUME;  BEGIN *DIRECTORY = ,ARRAY[DIRRANGE] OF DIRENTRY; (  VAR  DIREC: DIRECTORY; (UNITNUM:INTEGER; (I,CURDIR:INTEGER;  ENDPREVIOUS,STARTCURRENT:INTEGER;  NUMOFILES:INTEGER;  STARTBLOCK:INTEGER; (FREESPACE:BOOLEAN;  OF FILE *) 2DLASTBYTE: 1..FBLKSIZE; (* NUMBER OF BYTES IN LAST BLK *) 2DACCESS: DATEREC (* DATE OF LAST MODIFICATION *) 0) (* END CASE XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, >DATAFILE, GRAFFILE, FOTOFILE *) ,END (* CASE DFKIND; DIRENTRY *); , := STARTCURRENT - ENDPREVIOUS; *UNUSED := UNUSED + FREEBLOCKS; *IF FREEBLOCKS > LARGEST THEN LARGEST := FREEBLOCKS; *STARTBLOCK := ENDPREVIOUS; *FILELINE (END &ELSE (BEGIN *FREESPACE := FALSE; *STARTBLOCK := BLOCKS(CURDIR,FIRST); *FILELINE; (END; $IF FREESPACE &THEN (ENDPREVIOUS := STARTCURRENT &ELSE (BEGIN *ENDPREVIOUS := BLOCKS(CURDIR,LAST); *CURDIR := CURDIR + 1; (END; "END;  SUMMARY;  END. ERS IN TITLE ID *) (FBLKSIZE = 512; (* STANDARD DISK BLOCK LENGTH *) (DIRBLK = 2; (* DIRECTORY STARTS AT THIS DISK-BLOCK ADDRESS *)   TYPE ((* VOLUME/FILE DATE MARK *) (DATEREC = *PACKED RECORD ,MONTH: 0..12; (* 0 IMPLIES MEANINGLESS DATA *) ,DAYARE AFTER THE DASHED COMMENT LINE. %THE DECLARATIONS AND COMMENTS SUPPLIED BY APPLE ARE:  CONST (MAXDIR = 77; (* MAXIMUM NUMBER OF ENTRIES IN DIRECTORY *) (VIDLENG = 7; (* NUMBER OF CHARACTERS IN VOLUME ID *) (TIDLENG = 15; (* NUMBER OF CHARACT%THE DISK DIRECTORY IS READ USING THE DIRECTORY DECLARATIONS SUPPLIED BY  APPLE. THE DIR PROGRAM ALSO USES THESE DECLARATIONS TO DUPLICATE THE EXTENDED  DIRECTORY OPTION OF THE FILER. ANY EXTRA CONST OR TYPE STATEMENTS THAT WERE  NEEDED BY THE PROGRAM NDARD CHARACTERS FOR SYSTEM  FILES ( SUCH AS C FOR SYSTEM.COMPILER) AND THE NEXT AVAILABLE LETTER FOR NON-  SYSTEM PROGRAMS. THE DATE OF CREATION IS ALSO SUPPLIED WITH EACH CODE FILE.  OPRIATE PROGRAM AND THE PROGRAM  INSERTS THE CHARACTERS INTO THE TYPE-AHEAD BUFFER THAT WILL CAUSE THE  PROGRAM TO BE EXECUTED AFTER MENU EXITS. THIS ESSENTIALLY CHAINS THE PROGRAM  FROM THE MENU PROGRAM.  %THE SELECTION LETTERS PRESENTED ARE THE STAPT TO RECOMPILE MENU WITHOUT HAVING THESE PROCEDURES  AVAILABLE. %THE MENU PROGRAM READS THE DIRECTORIES ON UNITS 4 AND 5 (IT ASSUMES  THESE TWO DRIVES) AND PRESENTS A MENU OF THE CODE FILES AVAILABLE. THE USE  SELECTS THE LETTER REPRESENTING THE APPR9PROGRAM AUTHOR: DAVID NEUMANN 8  8********** WARNING ***********  THE MENU PROGRAM REQUIRES TWO EXTERNAL PROCEDURES NAMED STUFF AND STUFFS THAT  INSERT CHARACTERS INTO THE TYPE-AHEAD BUFFER. THEY ARE AVAILABLE IN THE FILE  BIOSSTUFF. DO NOT ATTEMN^ˡˡ: 0..31; (* DAY OF THE MONTH *) ,YEAR: 0..100; (* 100 IMPLIES THE DATED VOLUME IS TEMPORARY *) *END (* DATEREC *); * ((* VOLUME ID *) (VID = *STRING[VIDLENG]; * (DIRRANGE = *0..MAXDIR; * ((* TITLE ID *) (TID = *STRING[TIDLENG]; * (FILEKIND = *(UNTYPEDFILE,XDSKFILE,CODEFILE,TEXTFILE,INFOFILE,DATAFILE, +GRAFFILE,FOTOFILE,SECUREDIR); + ((* DIRECTORY LAYOUT *) (DIRENTRY = *PACKED RECORD ,DFIRSTBLK: INTEGER; (* 1ST PHYSICAL DISK ADDRESS *) ,DLASTBLK: INTEGER; (* POINTS AT BLOC IS THE CURRENT DATE AS SET IN THE FILER. %THE APPLE SUPPLIED DECLARATIONS ARE:   CONST (MAXDIR = 77; (* MAXIMUM NUMBER OF ENTRIES IN DIRECTORY *) (VIDLENG = 7; (* NUMBER OF CHARACTERS IN VOLUME ID *) (TIDLENG = 15; (* NUMBER OF CHARACTERS ITRA  CONST AND TYPE USED BY THE PROGRAM ARE BELOW THE DASHED COMMENT LINE. %THE PROGRAM ASSUMES TWO DISK DRIVES #4 AND #5. THE DATE ON THE NON-BOOT  VOLUME IS THE DATE SET BY THE FORMAT PROGRAM WHEN THE DISK WAS FORMATTED.  THE DATE ON THE BOOT VOLUME9PROGRAM AUTHOR: DAVID NEUMANN % %THIS PROGRAM ILLUSTRATES THE USE OF THE FOLLOWING DIRECTORY  DECLARATIONS. IT WILL DUPLICATE THE EXTENDED DIRECTORY OPTION OF THE FILER.  THE DECLARATIONS AND COMMENTS ON THEM ARE THOSE SUPPLIED BY APPLE. ANY EXN^ˡEND (* CASE DFKIND; DIRENTRY *); , *DIRECTORY = ,ARRAY[DIRRANGE] OF DIRENTRY; ( 2DTID: TID; (* TITLE OF FILE *) 2DLASTBYTE: 1..FBLKSIZE; (* NUMBER OF BYTES IN LAST BLK *) 2DACCESS: DATEREC (* DATE OF LAST MODIFICATION *) 0) (* END CASE XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, >DATAFILE, GRAFFILE, FOTOFILE *) , 0 .XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, .DATAFILE, GRAFFILE, FOTOFILE: .(* REGULAR FILE INFO *) 0( FILLER2: 0..1024; (* WASTE 12 BITS FOR DOWNWARD COMP *) 2STATUS: BOOLEAN; (* FOR FILER WILDCARDS *) LK: INTEGER; (* LAST BLK OF VOLUME *) 2DNUMFILES: DIRRANGE; (* NUMBER OF FILES IN DIRECTORY *) 2DLOADTIME: INTEGER; (* TIME OF LAST ACCESS *) 2DLASTBOOT: DATEREC (* MOST RECENT DATE SETTING *) 0) (* END CASE SECUREDIR, UNTYPEDFILE *);K FOLLOWING LAST USED BLOCK *) ,CASE DFKIND: FILEKIND OF .SECUREDIR, .UNTYPEDFILE: .(* ONLY IN DIR[0] - THIS IS VOLUME INFO *) 0( FILLER1: 0..2048; (* WASTE 13 BITS FOR DOWNWARD COMP *) 2DVID: VID; (* NAME OF DISK VOLUME *) 2DEOVBN TITLE ID *) (FBLKSIZE = 512; (* STANDARD DISK BLOCK LENGTH *) (DIRBLK = 2; (* DIRECTORY STARTS AT THIS DISK-BLOCK ADDRESS *)   TYPE ((* VOLUME/FILE DATE MARK *) (DATEREC = *PACKED RECORD ,MONTH: 0..12; (* 0 IMPLIES MEANINGLESS DATA *) ,DAY: 0..31; (* DAY OF THE MONTH *) ,YEAR: 0..100; (* 100 IMPLIES THE DATED VOLUME IS TEMPORARY *) *END (* DATEREC *); * ((* VOLUME ID *) (VID = *STRING[VIDLENG]; * (DIRRANGE = *0..MAXDIR; * ((* TITLE ID *) (TID = *STRING[TIDLENG]; * (FIEXTERNAL;  PROCEDURE STUFF(CH:CHAR); EXTERNAL;  PROCEDURE STUFFS(S:STRING); EXTERNAL;  PROCEDURE WINDOW(TOP,BOT:SCRANGE); EXTERNAL;  %THEY DO THE FOLLOWING THINGS:  CURH - RETURNS CURSOR HORIZONTAL POSITION (CURV - RETURINTEGER); EXTERNAL;  PROCEDURE INVERSE; EXTERNAL;  PROCEDURE NORMAL; EXTERNAL;  PROCEDURE FLASH; EXTERNAL;  FUNCTION GETFLGS:INTEGER; EXTERNAL;  PROCEDURE ONFLG(F:INTEGER); EXTERNAL;  PROCEDURE OFFFLG(F:INTEGER); EXTERNAL;  FUNCTION CHLEFT:INTEGER; 9PROGRAM AUTHOR: DAVID NEUMANN   %THE BIOSSTUFF FILE CONTAINS ASSEMBLY LANGUAGE CODE THAT CORRESPONDS TO  THE FOLLOWING PASCAL PROCEDURES AND FUNCTIONS:   FUNCTION CURH:INTEGER; EXTERNAL;  FUNCTION CURV:INTEGER; EXTERNAL;  PROCEDURE HORZSHFT(H:N^ˡ *DIRECTORY = ,ARRAY[DIRRANGE] OF DIRENTRY; ( OF FILE *) 2DLASTBYTE: 1..FBLKSIZE; (* NUMBER OF BYTES IN LAST BLK *) 2DACCESS: DATEREC (* DATE OF LAST MODIFICATION *) 0) (* END CASE XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, >DATAFILE, GRAFFILE, FOTOFILE *) ,END (* CASE DFKIND; DIRENTRY *); ,0 .XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, .DATAFILE, GRAFFILE, FOTOFILE: .(* REGULAR FILE INFO *) 0( FILLER2: 0..1024; (* WASTE 12 BITS FOR DOWNWARD COMP *) 2STATUS: BOOLEAN; (* FOR FILER WILDCARDS *) 2DTID: TID; (* TITLE INTEGER; (* LAST BLK OF VOLUME *) 2DNUMFILES: DIRRANGE; (* NUMBER OF FILES IN DIRECTORY *) 2DLOADTIME: INTEGER; (* TIME OF LAST ACCESS *) 2DLASTBOOT: DATEREC (* MOST RECENT DATE SETTING *) 0) (* END CASE SECUREDIR, UNTYPEDFILE *); LLOWING LAST USED BLOCK *) ,CASE DFKIND: FILEKIND OF .SECUREDIR, .UNTYPEDFILE: .(* ONLY IN DIR[0] - THIS IS VOLUME INFO *) 0( FILLER1: 0..2048; (* WASTE 13 BITS FOR DOWNWARD COMP *) 2DVID: VID; (* NAME OF DISK VOLUME *) 2DEOVBLK: LEKIND = *(UNTYPEDFILE,XDSKFILE,CODEFILE,TEXTFILE,INFOFILE,DATAFILE, +GRAFFILE,FOTOFILE,SECUREDIR); + ((* DIRECTORY LAYOUT *) (DIRENTRY = *PACKED RECORD ,DFIRSTBLK: INTEGER; (* 1ST PHYSICAL DISK ADDRESS *) ,DLASTBLK: INTEGER; (* POINTS AT BLOCK FONS CURSOR VERTICAL POSITION (HORZSHFT - SHIFTS THE SCREEN HORIZONTALLY 9SHIFT COUNT IS POSITIVE FOR SHIFT RIGHT 9SHIFT COUNT IS NEGATIVE FOR SHIFT LEFT 9HORZSHFT(40) DISPLAYS COLUMNS 41-80 9HORZSHFT(-40) WOULD RESTORE COLUMNS 1-40 ( SHIFTS BEYOND COLUMN 1 OR 80 CAUSE WRAP-AROUND 9SHIFT COUNTS GREATER THAN 40 SEEM TO CAUSE PROBLEMS (CHLEFT - RETURNS THE NUMBER OF CHARACTERS TO THE LEFT OF THE ; VISIBLE SCREEN 9USED WITH HORZSHFT (INVERSE - FOLLOWI ;BIOS HORIZONTAL SHIFT  SAVERET .EQU 0FF24 ;SAVE PASCAL RETURN AND FOLD IN BIOS  GOBACK .EQU 0FF40 ;FOLD IN INTERP AND RETURN  ;*************************************** (.FUNC CURH (POP RETURN (DISCARDBIAS (LDA #0 ; MSB =HE WRITE POINTER  MODE .EQU 0D8ED ;BIOS LOCATION FOR CHARACTER MODE  LFBOT .EQU 0D920 ;BIOS LOCATION FOR LINE FEED BOTTOM LINE  SCRTOP .EQU 0D92C ;BIOS SCROLL TOP  SCRBOT .EQU 0D949 ;BIOS SCROLL BOTTOM  HSHIFT .EQU 0DA23 CONBUF .EQU 03B1 ;ADDRESS OF THE TYPE AHEAD BUFFER  NLEFT .EQU 0BF11 ;NUMBER OF CHARS TO LEFT OF SCREEN  CONFLGS .EQU 0BF15 ;CONSOLE FLAGS  RPTR .EQU 0BF18 ;ADDRESS OF THE READ POINTER  WPTR .EQU 0BF19 ;ADDRESS OF T 0 ;TEMP TO SAVE RETURN  SADR .EQU 2 ;TEMP TO SAVE STRING ADDRESS  COUNT .EQU 4 ;TEMP TO SAVE NUMBER OF CHARACTERS IN STRING  CH .EQU 0F4 ;CURSOR HORIZONTAL  CV .EQU 0F5 ;CURSOR VERTICAL C083 ;SELECT 2ND 4K BANK (LDA 0C083 ;AND WRITE-ENABLE (.ENDM  ;*************************************** (.MACRO BANK1PROTECT (LDA 0C088 ;SELECT 1ST BANK AND WRITE-PROTECT (.ENDM  ;***************************************  RETURN .EQU ******************** (.MACRO PUSH (LDA %1+1 (PHA (LDA %1 (PHA (.ENDM  ;*************************************** (.MACRO DISCARDBIAS (PLA (PLA (PLA (PLA (.ENDM  ;*************************************** (.MACRO BANK2WRITE (LDA 0 ;***************************************  ;* BIOS-STUFF *  ;* PROGRAM AUTHOR: DAVID NEUMANN *  ;*************************************** (.MACRO POP (PLA (STA %1 (PLA (STA %1+1 (.ENDM  ;*******************B E N^ˡAM WILL ILLUSTRATE ALL OF THESE FUNCTIONS.  %THE CODE FILES FOR BIOSUNIT AND BIOSSTUFF MAY BE INSTALLED IN  SYSTEM.LIBRARY. THIS ALLOWS SUBSEQUENT PROGRAMS TO "USES BIOSUNIT". BIT (OFFFLG - TURNS OFF FLAG BIT (STUFF - PUTS A SINGLE CHARACTER IN THE TYPE-AHEAD BUFFER (STUFFS - PUTS A STRING IN THE TYPE-AHEAD BUFFER (WINDOW - SETS THE TOP AND BOTTOM OF THE SCROLL WINDOW % %THE BIOSDEMO PROGRNG CHARACTERS OUTPUT IN INVERSE MODE (FLASH - OUTPUT IN FLASH MODE (NORMAL - RESTORES OUTPUT TO NORMAL CHARACTERS (GETFLGS - RETURNS FLAG BYTE THAT CONTAINS BITS FOR 9FLUSH, STOP AND AUTO FOLLOW (ONFLG - TURNS ON FLAG 0 (PHA (LDA CH (PHA (PUSH RETURN (RTS  ;*************************************** (.FUNC CURV (POP RETURN (DISCARDBIAS (LDA #0 ; MSB = 0 (PHA (LDA CV (PHA (PUSH RETURN (RTS  ;*************************************** (.PROC HORZSHFT,1 (JSR SAVERET (PLA ; GET SHIFT AMOUNT (JSR HSHIFT (PLA ; DISCARD MSB OF PARM (JMP GOBACK  ;*************************************** (.PROC INVERSE (NCH IF NO (LDX #0 ; WRAP AROUND TO BEGINNING OF BUFFER  $1 CPX RPTR ; COMPARE TO READ POINTER (BEQ SEXIT ; IF POINTERS =, BUFFER IS FULL (STX WPTR ; ROOM FOR CHARCTER, SAVE POINTER (INY ; INCREMENT POINTERG LENGTH  BEQ SEXIT ; DONE IF ZERO LENGTH (STA COUNT ; SAVE STRING LENGTH  LOOP LDX WPTR ; GET WRITE POINTER (INX ; INCREMENT TO NEXT AVAILABLE SPOT (CPX #78. ; AT END OF BUFFER? (BCC $1 ; BRA ; STUFF A STRING INTO THE TYPE AHEAD BUFFER (.PROC STUFFS,1 (POP RETURN ; SAVE PASCAL RETURN ADDRESS (POP SADR ; SAVE STRING ADDRESS (LDY #0 ; INITIALIZE POINTER INTO STRING (LDA @SADR,Y ; 1ST BYTE OF STRING IS STRINL DONE  IGNORE PLA ; DISCARD LSB OF PARM (PLA ; DISCARD MSB OF PARM EXIT PUSH RETURN ; RESTORE PASCAL RETURN ADDRESS (RTS ; RETURN TO PASCAL  ;*************************************** POINTERS =, BUFFER IS FULL (STX WPTR ; ROOM FOR CHARCTER, SAVE POINTER (PLA ; GET LSB OF PARM, WHICH IS CHARACTER TO STORE (STA CONBUF,X ; STORE IN BUFFER (PLA ; DISCARD MSB OF PARM  JMP EXIT ; ALR (INX ; INCREMENT TO NEXT AVAILABLE SPOT (CPX #78. ; AT END OF BUFFER? (BCC $1 ; BRANCH IF NO (LDX #0 ; WRAP AROUND TO BEGINNING OF BUFFER  $1 CPX RPTR ; COMPARE TO READ POINTER (BEQ IGNORE ; IF  ; CHARACTERS BEYOND THE LIMIT ARE IGNORED  ;***************************************  ; STUFF A SINGLE CHARACTER INTO THE TYPE AHEAD BUFFER (.PROC STUFF,1 (POP RETURN ; SAVE PASCAL RETURN ADDRESS (LDX WPTR ; GET WRITE POINTE*  ; TWO ROUTINES TO PUT CHARACTERS INTO THE TYPE AHEAD BUFFER  ; STUFF - TO PUT A SINGLE CHARACTER IN THE BUFFER  ; STUFFS - TO PUT A STRING IN THE BUFFER  ; THERE IS A LIMIT OF 78 CHARACTERS ;DISCARD MSB OF PARM (PUSH RETURN (RTS  ;*************************************** (.FUNC CHLEFT (POP RETURN (DISCARDBIAS (LDA #0 ; MSB = 0 (PHA (LDA NLEFT (PHA (PUSH RETURN (RTS  ;**************************************UES ARE:  ; AUTO FOLLOW = 01  ; FLUSH = 40  ; STOP = 80 (.PROC OFFFLG,1 (POP RETURN (PLA ;LSB OF PARM (EOR #0FF ;REVERSE BITS (AND CONFLGS ;TURN OFF BIT (STA CONFLGS (PLA  ; STOP = 80 (.PROC ONFLG,1 (POP RETURN (PLA ;LSB OF PARM (ORA CONFLGS (STA CONFLGS (PLA ;DISCARD MSB OF PARM (PUSH RETURN (RTS  ;***************************************  ; POSSIBLE VALPOP RETURN (DISCARDBIAS (LDA #0 ; MSB = 0 (PHA (LDA CONFLGS (PHA (PUSH RETURN (RTS  ;***************************************  ; POSSIBLE VALUES ARE:  ; AUTO FOLLOW = 01  ; FLUSH = 40 ;RETURN  ;*************************************** (.PROC FLASH (BANK2WRITE (LDA #40 ;SET BIT 6 FOR FLASH MODE (STA MODE (BANK1PROTECT (RTS ;RETURN  ;*************************************** (.FUNC GETFLGS (BANK2WRITE (LDA #00 ;CLEAR BITS 6 & 7 (STA MODE (BANK1PROTECT (RTS ;RETURN  ;*************************************** (.PROC NORMAL (BANK2WRITE (LDA #80 ;SET BIT 7 FOR NORMAL MODE (STA MODE (BANK1PROTECT (RTS INTO STRING (LDA @SADR,Y ; GET CHARACTER FROM STRING (STA CONBUF,X ; PUT INTO BUFFER CPY COUNT ; ALL CHARACTERS STORED? (BCC LOOP ; BRANCH IF NO  SEXIT PUSH RETURN ; RESTORE PASCAL RETURN ADDRESS (RTS ; RETURN TO PASCAL  ;*************************************** (.PROC WINDOW,2 (BANK2WRITE (POP RETURN (PLA ;LSB OF BOTTOM LINE (STA LFBOT ;SET BIOS LOCATION (STA SCRBOT ;SET BIOS LOCATION (PLA S*)  (**************************************)  PROGRAM CRECHARSET;  USES TURTLEGRAPHICS;  CONST (ESC = 27; (DOTSHORZ = 7; (DOTSVERT = 10; (BEGCH = 0; (ENDCH = 127; (OLDX = 20; (OLDY = 125; (NEWX = 208; (NEWY = 125; (OLDPATX = 60; (OLDPATY = )  (* OF THIS PACKED BOOLEAN ARRAY *)  (* IS PUT ON A WORD BOUNDARY, AND*)  (* THIS MAKES EACH ROW TWO BYTES *)  (* WIDE. A BYTE OF DATA AND A *)  (* BYTE OF HOLE. THE FILE WITH *)  (* THE CHARACTER SET HAS NO HOLE (**************************************)  (* THE WHOLE CHARACTER SET CAN *)  (* NOT BE READ INTO A 128 X 8 X 8*)  (* BOOLEAN ARRAY BECAUSE ARRAY *)  (* ELEMENTS ARE NOT PACKED ACROSS*)  (* WORD BOUNDARIES. THE 3RD DIM. * *)  (* A BOOLEAN ARRAY. BOOLEAN ARRAY*)  (* ELEMENTS ARE NUMBERED FROM THE*)  (* LEFT OF A WORD. *)  (* EACH CHARACTER IS AN 8 X 8 *)  (* BOOLEAN ARRAY. *) *)  (* 8TH COLUMN OF CHARACTER *)  (* CAN NOT BE SET. *)  (* BYTE SET TO 127 WILL TURN ON *)  (* ALL BITS IN A ROW. *)  (* BITS ARE REVERSED BECAUSE THE *)  (* CHARACTER SET IS CONSIDERED)  (* CHARACTERS ARE 8 BYTES EACH. *)  (* 1ST BYTE IS ON BOTTOM ROW. *)  (* 8TH BYTE IS ON TOP ROW. *)  (* BITS ARE REVERSED. *)  (* 1 SETS 7TH COLUMN. *)  (* 64 SETS 1ST COLUMN.  (**************************************)  (* PROGRAM TO CREATE A NEW FILE *)  (* TO REPLACE SYSTEM.CHARSET. *)  (**************************************)  (* AUTHOR: DAVID NEUMANN *)  (**************************************BEG 1 2YN^6 ;DISCARD MSB (PLA ;LSB OF TOP LINE (STA SCRTOP ;SET BIOS LOCATION (PLA ;DISCARD MSB (PUSH RETURN ;RESTORE PASCAL RETURN (BANK1PROTECT (RTS ;RETURN TO PASCAL (.END  90;  NEWPATX = 140; (NEWPATY = 90;  TYPE BYTE = 0..255;   (* TYPECHAR WAS CHANGED FROM BYTE TO $BOOLEAN BECAUSE THERE APPARENTLY $IS NOT ENOUGH DATA SPACE WHEN $MIXEDSET IS BYTE. *) %TYPECHAR = PACKED ARRAY[0..7,0..6] OF BOOLEAN;  MIXEDTYPE = RECORD 3CHANGED: BOOLEAN; 3OLDCHAR: TYPECHAR; 3NEWCHAR: TYPECHAR; 1END;  VAR  CHARPOS:INTEGER; $ANS:CHAR;  LI:INTEGER[3]; $S:STRING; $OLDSET:PACKED ARRAY[0..127,0..7] OF ); * DISPLAYCHAR(CHINDX,MIXEDSET[CHINDX]); *END; $'S' : BEGIN ,MOVETO(20,40); ,WSTRING('I=UP J=LEFT K=RIGHT M=DOWN '); ,(* MOVE TO LOWER LEFT CORNER OF PATTERN *) ,(* DRAW INVERSE CHARACTER TO SHOW CURSOR POSITION *) ,MOVETO(XPAT,YPAT); ,CHASET[CHINDX].NEWCHAR[CY,CX] := TRUE; ,FORMCHAR(CHINDX); * DISPLAYCHAR(CHINDX,MIXEDSET[CHINDX]); *END; $'Z' : BEGIN ,MIXEDSET[CHINDX].CHANGED := TRUE; ,FOR CY:=0 TO 7 DO .FOR CX:=0 TO 6 DO 0MIXEDSET[CHINDX].NEWCHAR[CY,CX] := FALSE; ,FORMCHAR(CHINDX"YMIN := YPAT; "MOVETO(20,30); "CLEAR(38); "WSTRING('O(NES Z(EROES S(INGLE R(ESTORE '); "READANDECHO(ANS); "(* GET TYPE OF CHANGE *) "CASE ANS OF $'O' : BEGIN ,MIXEDSET[CHINDX].CHANGED := TRUE; ,FOR CY:=0 TO 7 DO .FOR CX:=0 TO 6 DO 0MIXED= OLDPATX; (YPAT := OLDPATY; &END; "(* CHARACTERS ARE 7 BITS WIDE *) "(* PATTERNS ARE 7 CHARACTERS WIDE *) "XMAX := XPAT + 6 * DOTSHORZ; "(* VERTICAL DISTANCE BETWEEN CHARACTERS IS 10 BITS *) "YMAX := YPAT + DOTSVERT * DOTSHORZ; "XMIN := XPAT; MIN:INTEGER;  XPAT,YPAT,CX,CY:INTEGER; $I:INTEGER; $DIR:CHAR;  BEGIN  REPEAT "IF MIXEDSET[CHINDX].CHANGED $THEN &BEGIN ((* START ON NEW PATTERN *) (XPAT := NEWPATX; (YPAT := NEWPATY; &END $ELSE &BEGIN ((* START ON OLD PATTERN *) (XPAT :OCEDURE CLEAR(LNG:INTEGER);  VAR $SAVEX,SAVEY:INTEGER; $I:INTEGER;  BEGIN  SAVEX := TURTLEX;  SAVEY := TURTLEY;  FOR I:=1 TO LNG DO "WCHAR(' ');  MOVETO(SAVEX,SAVEY);  END;   PROCEDURE UPDATE(CHINDX:INTEGER);  VAR $XLOC,YLOC,XMAX,YMAX,XMIN,Y$POWEROFTWO := 1; $FOR COL:=0 TO 6 DO &BEGIN ((* CHANGE FROM BOOLEAN TO INTEGER *) (IF MIXEDSET[CHINDX].NEWCHAR[ROW,COL] *THEN ,TEMP := TEMP + POWEROFTWO; (POWEROFTWO := POWEROFTWO * 2; &END;  NEWSET[CHINDX,ROW] := TEMP; "END;  END;   PRN *) &DRAWBLOCK(NEWSET[CHINDX],1,0,0,8,8,NEWX,NEWY,10); &DRAWPAT(CH.NEWCHAR,NEWPATX,NEWPATY);  END;  END;  PROCEDURE FORMCHAR(CHINDX:INTEGER);  VAR $ROW,COL,TEMP,POWEROFTWO:INTEGER;  BEGIN  FOR ROW:=0 TO 7 DO "BEGIN $TEMP := 0; (THEN WCHAR('1') (ELSE WCHAR('0'); "END;  END;   BEGIN  (* DRAW OLD CHARACTER AND PATTERN *)  DRAWBLOCK(OLDSET[CHINDX],1,0,0,8,8,OLDX,OLDY,10);  DRAWPAT(CH.OLDCHAR,OLDPATX,OLDPATY);  IF CH.CHANGED "THEN $BEGIN &(* DRAW NEW CHARACTER AND PATTERAR(CHINDX:INTEGER; CH:MIXEDTYPE);   PROCEDURE DRAWPAT(CH:TYPECHAR;PATX,PATY:INTEGER);  VAR $J,K:INTEGER;  BEGIN  (* DRAW 7X6 PATTERN OF 1'S AND 0'S *)  FOR J:= 0 TO 7 DO "BEGIN $MOVETO(PATX,PATY+DOTSVERT*J); $FOR K:= 0 TO 6 DO " IF CH[J,K] ,MIXEDSET[I].NEWCHAR[J,K] := ODD(TEMP); ,TEMP := TEMP DIV 2; *END;  END; "END;  INITTURTLE;  END;   PROCEDURE READANDECHO(VAR ANS:CHAR);  BEGIN  READ(KEYBOARD,ANS);  IF ORD(ANS) <> ESC "THEN $WCHAR(ANS);  END;   PROCEDURE DISPLAYCHS NOT BEEN CHANGED *) $MIXEDSET[I].CHANGED := FALSE; $FOR J:=0 TO 7 DO &BEGIN (TEMP := OLDSET[I,J]; (FOR K:=0 TO 6 DO *BEGIN ,(* OLDCHAR AND NEWCHAR SAME AS OLDSET *) ,MIXEDSET[I].OLDCHAR[J,K] := ODD(TEMP);  (* READ SYSTEM.CHARSET INTO OLDSET *)  I := BLOCKREAD(INFILE,OLDSET,2);  NEWSET := OLDSET;  PAGE(OUTPUT);  WRITE('INITIALIZING CHARACTER ');  (* INITIALIZE MIXEDSET *)  FOR I:=BEGCH TO ENDCH DO "BEGIN $GOTOXY(23,0); $WRITE(I); $(* CHARACTER HABYTE;  NEWSET:PACKED ARRAY[0..127,0..7] OF BYTE; $MIXEDSET:PACKED ARRAY[0..127] OF MIXEDTYPE; $INFILE,OUTFILE:FILE;   PROCEDURE INITIALIZE;  VAR $I,J,K,TEMP:INTEGER;  BEGIN  RESET(INFILE,'*:SYSTEM.CHARSET');  REWRITE(OUTFILE,'*:NEWCHARSET');RTYPE(3); ,WCHAR(' '); ,MOVETO(XPAT,YPAT); ,XLOC := XPAT; ,YLOC := YPAT; ,REPEAT ,READ(KEYBOARD,DIR); ,(* CHECK DIRECTION OF MOVE *) ,(* CHECK FOR LIMITS OF PATTERN *) ,CASE DIR OF .'I' : BEGIN 6YLOC := YLOC + DOTSVERT; 6IF YLOC > YMAX 8THEN YLOC := YMAX; 4END; .'M' : BEGIN 6YLOC := YLOC - DOTSVERT; 6IF YLOC < YMIN 8THEN YLOC := YMIN; 4END; .'J' : BEGIN 6XLOC := XLOC - DOTSHORZ; 6IF XLOC < XMIN 8THEN XLOC := XMIN; 4END; .'K' : BEGIN 6XLOC := XLOC + DOTSHORZ; 6IF XLOC > XMA  WRITELN('RENAME TO SYSTEM.CHARSET TO USE');  WRITELN('WITH WCHAR AND WSTRING PROCEDURES.');  END.  2THEN CHARPOS := ENDCH; *END; "END; (* OF CASE *)  UNTIL ORD(ANS) = ESC;  TEXTMODE;  (* WRITE NEW CHARACTER SET FILE *)  CHARPOS := BLOCKWRITE(OUTFILE,NEWSET,2);  CLOSE(OUTFILE,LOCK);  GOTOXY(0,10);  WRITELN('FILE NEWCHARSET HAS BEEN CREATED.');N CHARPOS := BEGCH; ,IF CHARPOS > ENDCH .THEN CHARPOS := ENDCH;  END; $'J' : BEGIN $ MOVETO(20,10); ,CLEAR(40); ,WSTRING('JUMP WHERE (B/E) ?'); ,READANDECHO(ANS); ,IF ANS = 'B' .THEN CHARPOS := BEGCH .ELSE 0IF ANS = 'E' UST CONVERT DIGITS INSTEAD OF READING AN INTEGER *) ,CHARPOS := 0; ,READANDECHO(ANS); ,WHILE (NOT EOLN(KEYBOARD)) AND (ANS IN ['0'..'9']) DO .BEGIN 0CHARPOS := 10 * CHARPOS + (ORD(ANS) - ORD('0')); 0READANDECHO(ANS); ,END; ,IF CHARPOS < BEGCH .THEPOS < BEGCH .THEN CHARPOS := BEGCH; *END; $'F' : BEGIN ,CHARPOS := CHARPOS + 1; ,IF CHARPOS > ENDCH .THEN CHARPOS := ENDCH; *END; $'P' : BEGIN ,MOVETO(20,10); ,CLEAR(40); ,WSTRING('POSITION WHERE? '); ,(* WANT TO ECHO NUMBERS TYPED *) ,(* SO M UPDATE(CHARPOS); "MOVETO(20,10);  CLEAR(40); "WSTRING('F(RWRD B(CKWRD P(OSITION J(UMP '); "READANDECHO(ANS); "(* GET MOVEMENT INDICATOR WITHIN CHARACTER SET *) "CASE ANS OF $'B' : BEGIN  CHARPOS := CHARPOS - 1; ,IF CHAR TO LONG INTEGER, THEN STRING *) "(* IN ORDER TO DISPLAY INTEGER IN GRAPHICS MODE *) "LI := CHARPOS; "STR(LI,S); "WSTRING(S); "MOVETO(20,10); "CLEAR(40); "WSTRING('DO YOU WANT TO CHANGE (Y/N)?'); "READANDECHO(ANS); "IF ANS = 'Y' $THEN OF OUTER CASE *)  UNTIL (ORD(ANS) = ESC);  MOVETO(20,30);  CLEAR(38);  END;  BEGIN  INITIALIZE;  CHARPOS := BEGCH;  REPEAT "FILLSCREEN(BLACK); "DISPLAYCHAR(CHARPOS,MIXEDSET[CHARPOS]); "MOVETO(20,40); "CLEAR(9); "WSTRING('INDEX='); "(* CONVERTCHAR := MIXEDSET[CHINDX].OLDCHAR; ,(* CLEAR PORTION OF SCREEN THAT CONTAINED NEW CHARACTER *) ,VIEWPORT(NEWPATX,279,NEWPATY,191); ,FILLSCREEN(BLACK); ,VIEWPORT(0,279,0,191); ,FORMCHAR(CHINDX); ,DISPLAYCHAR(CHINDX,MIXEDSET[CHINDX]); *END; "END; (* ,MIXEDSET[CHINDX].CHANGED := TRUE; ,FORMCHAR(CHINDX); ,CHARTYPE(10); * DISPLAYCHAR(CHINDX,MIXEDSET[CHINDX]); ,MOVETO(20,40); ,CLEAR(32); *END; " 'R' : BEGIN ,(* RESTORE OLD CHARACTER *) ,MIXEDSET[CHINDX].CHANGED := FALSE; ,MIXEDSET[CHINDX].NEW,MOVETO(XLOC,YLOC); ,WCHAR(' '); ,MOVETO(XLOC,YLOC); ,UNTIL (ORD(DIR) = ESC); ,XPAT := NEWPATX; ,YPAT := NEWPATY; ,XMAX := XPAT + 6 * DOTSHORZ; ,YMAX := YPAT + DOTSVERT * DOTSHORZ; ,XMIN := XPAT; ,YMIN := YPAT; COMPLEMENT CHARACTER TO ERASE CURSOR *) :CHARTYPE(5); :WCHAR(DIR); :CHARTYPE(3); :MOVETO(XLOC,YLOC); 8END; ,END; (* OF INNER CASE *) ,(* DRAW NEW CHARACTER *) ,DRAWBLOCK(NEWSET[CHINDX],1,0,0,8,8,NEWX,NEWY,10); ,WCHAR(' '); ,(* DISPLAY CURSOR *) X 8THEN XLOC := XMAX; 4END; .(* 0 AND 1 CHANGE PATTERN *) .'0','1' : BEGIN :MIXEDSET[CHINDX].CHANGED := TRUE; :CY := (YLOC-YPAT) DIV DOTSVERT; :CX := (XLOC-XPAT) DIV DOTSHORZ; :MIXEDSET[CHINDX].NEWCHAR[CY,CX] := DIR = '1'; :FORMCHAR(CHINDX); :(* (^YSTEM.CHARSET to some  other name and change *NEWCHARSET to  *SYSTEM.CHARSET  character in the character set. This  number is in the range 0 to 127. A  return, space or non-digit will end the  number.  % - this ends the program. A  file named *NEWCHARSET has been  created. To use it with WCHAR and  WSTRING, change *SB(CKWRD P(OSITION J(UMP  %This allows you to:  %F - move forward one character  %B - move backward one charcter  %J - jump to the beginning or end  of the character set  %P - position yourself at any of  single bit changes. The character and  pattern for both the old and new  character are displayed. %If you respond N for no to the  change the character prompt, you are  asked which character to look at next  by the following prompt: !F(RWRD the cursor on the pattern. When  the cursor is on the bit you want to  change, hit a 1 or 0 to turn the bit on  or off. Changes made to the pattern  will be reflected in the new character  which is also displayed.  % - this ends the the cycle%S - this means that you want to  change single bits of the new  character. The cursor is then moved  onto the pattern of the character and a  new prompt line is displayed:  I=UP J=LEFT K=RIGHT M=DOWN %Type in the appropriate letter to  movese options mean:  %O - the new character will be all  1's or a solid white block  %Z - the new character will be all  0's or a solid black block %R - the new character is restored  to the value of the old character  ed pattern  of 1's and 0's that represents this  character. You are then asked:  !DO YOU WANT TO CHANGE (Y/N)?  %If you respond Y for yes, you are  then asked what type of change you want  to make:  !O(NES Z(EROES S(INGLE R(ESTORE %Theed  with WCHAR and WSTRING.  %It takes some time to initialize  the characters, so the index of the  character being initialized is  displayed to let you know the program  is running. %The program then displays the  first character and an expandNOTES ON USING CRECHARSET  %The program CRECHARSET allows you  to modify the characters which are  displayed by the graphics procedures  WCHAR and WSTRING. The program creates  the file *NEWCHARSET which must be  renamed to *SYSTEM.CHARSET to be usN^VvN^5EZE ORIGIN *) (X:= RANDOM MOD 50; (Y:= RANDOM MOD 50 " END "UNTIL ORD(CH)=27; "TEXTMODE; "WRITELN('BACK TO PASCAL')  END.  & MID; &MAKEDOT(A,B); &MAKEDOT(XMAX-A,B); &MAKEDOT(XMAX-A,YMAX-B); &MAKEDOT(A,YMAX-B) $UNTIL KEYPRESS; $READ(KEYBOARD,CH); $IF CH IN ['1'..'9'] THEN &BEGIN (* NEW PICTURE *) (FILLSCREEN(BLACK); (K:=ORD(CH)-ORD('0') &END $ELSE $ BEGIN (* RANDOMI"INITTURTLE; "FRAME(WHITE); "X:=21; Y:=13; "REPEAT $REPEAT &X:=X-Y/V[K]; &IF X<1 THEN X:=X+XMAX ELSE IF X>XMAX THEN X:=X-XMAX; &Y:=Y+X/W[K]; &IF Y>YMAX THEN Y:=Y-YMAX ELSE IF Y<1 THEN Y:=Y+YMAX; &A:=TRUNC(X) DIV 2 + XMID; &B:=TRUNC(Y) DIV 2 + YSTOP'); "FOR A:=1 TO 2000 DO; "V[1]:=3; W[1]:=1.5; "V[2]:=2; W[2]:=2.1; "V[3]:=0.5; W[3]:=1.1; "V[4]:=2; W[4]:=4; "V[5]:=1; W[5]:=2; "V[6]:=0.9; W[6]:=3; "V[7]:=7; W[7]:=8; "V[8]:=-2; W[8]:=-2; "V[9]:=8; W[9]:=-8; "K:=1;  BEGIN "PENCOLOR(NONE); "MOVETO(X,Y); "PENCOLOR(WHITE); "MOVE(1);  END;   BEGIN (*MAIN*) "RANDOMIZE; "WRITELN('HIT SPACE TO RANDOMIZE'); "FOR A:=1 TO 1000 DO; "WRITELN('HIT DIGIT FOR NEW PATTERN'); "FOR A:=1 TO 1000 DO; "WRITELN('HIT ESC TO TEGER; (CH:CHAR;   PROCEDURE FRAME(COLOR:SCREENCOLOR);  BEGIN "PENCOLOR(NONE);MOVETO(0,0); "PENCOLOR(COLOR); "MOVETO(0,YMAX);MOVETO(XMAX,YMAX); "MOVETO(XMAX,0);MOVETO(0,0); "VIEWPORT(2,XMAX-2,2,YMAX-2)  END;   PROCEDURE MAKEDOT(X,Y:INTEGER); PROGRAM SERENDIP;  USES TURTLEGRAPHICS,APPLESTUFF;   CONST XMAX=279; (YMAX=191; (XMID=140; (YMID=96;  (* TO BE SAFE, MAKE THIS A COMMENT WHICH QUICKLY BECOMES INVISIBLE*)   VAR X,Y:REAL; (V,W:ARRAY [1..9] OF REAL; (A,B:INTEGER; (K:IN(*$S+*) (* ENABLE SWAPPING *)   PROGRAM CUBE;   USES TURTLEGRAPHICS, TRANSCEND, APPLESTUFF;   CONST XMAX = 279; (YMAX = 191; (XMID = 140; (YMID = 96; (PI = 3.145926; (DIST = 6.0; (SF = 0.6; (  TYPE POINT = 1..8; (EDGE = 1..12; (C "DRAWCUBE(NEWPIC,WHITE1);  END;   BEGIN (* CUBE *) "VLIM:=1/DIST; "YSF:=SF*YMID*(DIST-1); "XSF:=YSF*0.75*XMID/YMID; "DTOR:=PI/180; "INITCUBE; "WITH NEWPIC DO $BEGIN M:=1; &MV[M].PX:=XMID; &MV[M].PY:=YMID; &MV[M].DRAW:=FALSE $END; "AD:=0;.PX; &OP.MV[I].PY:=NP.MV[I].PY; &OP.MV[I].DRAW:=NP.MV[I].DRAW $END; "OP.M:=NP.M  END;   PROCEDURE ROTATE(A,B,C: REAL);  BEGIN "COPYPIC(NEWPIC,OLDPIC); "MATRIX(A,B,C); "POINTS; "PROJECT; "VISIBILITY; "LINES(NEWPIC); "DRAWCUBE(OLDPIC,BLACK1);&FOR I:=1 TO M DO (WITH MV[I] DO *BEGIN ,IF DRAW THEN .PENCOLOR(C) ,ELSE .PENCOLOR(NONE); ,MOVETO(PX,PY) *END $END  END;   PROCEDURE COPYPIC(VAR NP,OP: PICTURE);  VAR I: INTEGER;  BEGIN "FOR I:=1 TO NP.M DO $BEGIN &OP.MV[I].PX:=NP.MV[I]PY:=SP[HERE].SY; .END; ,M:=M+1; ,MV[M].DRAW:=TRUE; ,MV[M].PX:=SP[THERE].SX; ,MV[M].PY:=SP[THERE].SY; ,L:=THERE *END $END  END;   PROCEDURE DRAWCUBE(VAR PIC:PICTURE; C:SCREENCOLOR);  VAR I: INTEGER;  BEGIN "WITH PIC DO $BEGIN E LINES(VAR PIC: PICTURE);  VAR L: POINT; E: EDGE;  BEGIN L:=1; "WITH PIC DO $BEGIN M:=0; &FOR E:=1 TO 12 DO IF E IN VIS THEN (WITH ED[E] DO *BEGIN ,IF (L<>HERE) OR (M=0) THEN .BEGIN 0M:=M+1; 0MV[M].DRAW:=FALSE; 0MV[M].PX:=SP[HERE].SX; 0MV[M].S:=VIS+[1,2,3,4] "ELSE IF -M11>=VLIM THEN VIS:=VIS+[5,6,7,8]; "IF M21>=VLIM THEN VIS:=VIS+[3,7,11,12] "ELSE IF -M21>=VLIM THEN VIS:=VIS+[1,5,9,10]; "IF M31>=VLIM THEN VIS:=VIS+[2,6,10,11] "ELSE IF -M31>=VLIM THEN VIS:=VIS+[4,8,9,12]  END;  PROCEDUR END;   PROCEDURE PROJECT;  VAR I: POINT;  BEGIN "FOR I:=1 TO 8 DO WITH P[I] DO $BEGIN &SP[I].SX:=TRUNC(Y*XSF/(DIST-X))+XMID; &SP[I].SY:=TRUNC(Z*YSF/(DIST-X))+YMID; $END  END;   PROCEDURE VISIBILITY;  BEGIN "VIS:=[]; "IF M11>=VLIM THEN VI:=-P[2].Z; "P[3].X:=M11+M21+M31; P[5].X:=-P[3].X; "P[3].Y:=M12+M22+M32; P[5].Y:=-P[3].Y; "P[3].Z:=M13+M23+M33; P[5].Z:=-P[3].Z; "P[4].X:=M11+M21-M31; P[6].X:=-P[4].X; "P[4].Y:=M12+M22-M32; P[6].Y:=-P[4].Y; "P[4].Z:=M13+M23-M33; P[6].Z:=-P[4].Z; PROCEDURE POINTS;  BEGIN "P[1].X:=M11-M21-M31; P[7].X:=-P[1].X; "P[1].Y:=M12-M22-M32; P[7].Y:=-P[1].Y; "P[1].Z:=M13-M23-M33; P[7].Z:=-P[1].Z; "P[2].X:=M11-M21+M31; P[8].X:=-P[2].X; "P[2].Y:=M12-M22+M32; P[8].Y:=-P[2].Y; "P[2].Z:=M13-M23+M33; P[8].ZIN "SA:=SIN(A); SB:=SIN(B); SC:= SIN(C); "CA:=COS(A); CB:=COS(B); CC:= COS(C); "T1:=SB*CC; T2:=SB*SC; "M11:=CB*CC; M21:=CB*SC; M31:=-SB; "M12:=SA*T1-CA*SC; "M22:=CA*CC+SA*T2; M32:=SA*CB; "M13:=SA*SC+CA*T1; "M23:=CA*T2-SA*CC; M33:=CA*CB;  END;  "ED[8].HERE:=8; ED[8].THERE:=5; "ED[9].HERE:=1; ED[9].THERE:=5; "ED[10].HERE:=2; ED[10].THERE:=6; "ED[11].HERE:=3; ED[11].THERE:=7; "ED[12].HERE:=4; ED[12].THERE:=8;  END;   PROCEDURE MATRIX(A,B,C: REAL);  VAR T1,T2,SA,CA,SB,CB,SC,CC: REAL;  BEGBEGIN "ED[1].HERE:=1; ED[1].THERE:=2; "ED[2].HERE:=2; ED[2].THERE:=3; "ED[3].HERE:=3; ED[3].THERE:=4; "ED[4].HERE:=4; ED[4].THERE:=1; "ED[5].HERE:=5; ED[5].THERE:=6; "ED[6].HERE:=6; ED[6].THERE:=7; "ED[7].HERE:=7; ED[7].THERE:=8; ICTURE; (P: ARRAY [POINT] OF COORD; (ED: ARRAY [EDGE] OF ENDS; (SP: ARRAY [POINT] OF SCOORD; (VIS: SET OF EDGE; (AD,BD,CD: INTEGER; (VLIM,DTOR,XSF,YSF: REAL;  M11,M12,M13,M21,M22,M23,M31,M32,M33: REAL; (CH: CHAR; (  PROCEDURE INITCUBE;  OORD = RECORD X,Y,Z: REAL END; (ENDS = RECORD HERE,THERE: POINT END; (SCOORD = RECORD SX,SY: INTEGER END; (PENMOVE = RECORD PX,PY: INTEGER; DRAW: BOOLEAN END; (PICTURE = RECORD M: INTEGER; MV: ARRAY [1..18] OF PENMOVE END;   VAR NEWPIC,OLDPIC: P BD:=0; CD:=0; "INITTURTLE; "REPEAT $ROTATE(AD*DTOR,BD*DTOR,CD*DTOR); " AD:=(AD+2) MOD 360; $BD:=(BD+5) MOD 360; $CD:=(CD+10) MOD 360 "UNTIL KEYPRESS; "READ(KEYBOARD,CH); "TEXTMODE;WRITELN('BYE...')  END. N^U"COLORS[1]:=GREEN; "COLORS[2]:=VIOLET; "COLORS[3]:=ORANGE; "COLORS[4]:=BLUE; "COLORS[5]:=REVERSE; "REPEAT RANDFIGURE UNTIL KEYPRESS; "THATSALL  END.  ER *) "WRITE('WOULD YOU LIKE RANDOM COLORS ? '); "READ(CH);COLORFUL:=(CH = 'Y');WRITELN; "WRITELN('PRESS ANY KEY TO QUIT.'); "WRITELN('PLEASE WAIT FOR FIRST FIGURE.'); "INITSINTAB; "INITTURTLE; "FRAME(WHITE); "RANDOMIZE; "COLORS[0]:=WHITE; &B:= (B+C) MOD 256; &Z:= SINTAB[ A*B MOD 256 ] + 127; &IF I=2 THEN PENCOLOR(RANDCOLOR); &MOVETO(Z*SINTAB[ (B+64) MOD 256 ] DIV XADJ + XMID, -Z*SINTAB[B] DIV YADJ + YMID) $END; "FOR I:=1 TO DELAY DO $FOR C:=1 TO DELAY DO;  END;   BEGIN (* DOODLBLACK); "A:=RANDOM MOD 127 + 1; "C:=RANDOM MOD 255 + 1; "PENCOLOR(NONE);MOVETO(4,4);PENCOLOR(WHITE);WINT(C); "PENCOLOR(NONE);MOVETO(4,12);PENCOLOR(WHITE);WINT(A); "PENCOLOR(NONE); "IF ODD(A) THEN B:=0 ELSE B:=64; "FOR I:=1 TO LOOPEND(C) DO " BEGIN FUNCTION LOOPEND(INC:INTEGER):INTEGER;  VAR LOOP:INTEGER;  BEGIN "LOOP:=256; "WHILE NOT ODD(INC) DO "BEGIN $INC:=INC DIV 2; $LOOP:=LOOP DIV 2 "END; "LOOPEND:=LOOP+1  END;   PROCEDURE RANDFIGURE;  VAR A,C,I,Z:INTEGER;  BEGIN "FILLSCREEN(   FUNCTION RANDCOLOR:SCREENCOLOR;  BEGIN "IF COLORFUL THEN $RANDCOLOR:=COLORS[RANDOM MOD 6]  ELSE RANDCOLOR:=WHITE  END;   PROCEDURE WINT(N:INTEGER);  VAR D:INTEGER[8]; %S:STRING;  BEGIN "D:=N;STR(D,S);WSTRING(S)  END;  ND;   PROCEDURE INITSINTAB;  VAR F:REAL; %I:INTEGER;  BEGIN "F:=PI/128; "FOR I:=0 TO 255 DO SINTAB[I]:=TRUNC(SIN(F*I)*128)  END;   PROCEDURE THATSALL;  VAR CH:CHAR;  BEGIN "TEXTMODE; "READ(KEYBOARD,CH); "WRITELN;WRITELN('BYE...')  END;] OF INTEGER; (COLORFUL:BOOLEAN; (CH:CHAR; (B:INTEGER;   PROCEDURE FRAME(COLOR:SCREENCOLOR);  BEGIN "PENCOLOR(NONE);MOVETO(0,0); "PENCOLOR(COLOR); "MOVETO(0,YMAX);MOVETO(XMAX,YMAX); "MOVETO(XMAX,0);MOVETO(0,0); "VIEWPORT(1,XMAX-1,1,YMAX-1);  E(*$s+*)  PROGRAM DOODLER;   USES TURTLEGRAPHICS,TRANSCEND,APPLESTUFF;   CONST XMAX=279; (YMAX=191; (XMID=140; (YMID=96; (XADJ=260; (YADJ=350; (PI=3.1415936; (DELAY=40;   VAR COLORS:ARRAY[0..5] OF SCREENCOLOR; (SINTAB:ARRAY[0..255N^TRINT(TXT,DATINT,ALL_OK); IF ALL_OK THEN BEGIN IF (DATINT>31999) THEN ALL_OK := FALSE ELSE BEGIN IF LST3MOS THEN DATINT := -DATINT; END; END; END; IF EGIN IF TXT[1] = '0' THEN LST3MOS := FALSE ELSE LST3MOS := TRUE; DELETE(TXT,1,1); END; CHR1 := COPY(TXT,1,1); DELETE(TXT,1,1); INSERT(CHR1,TXT,3);(*WE NOW HAVE A TXT OF DDMYY*) S BEGIN IF (LENSTR=7) OR (LENSTR=8) THEN BEGIN DELETE(TXT,LENSTR-2,1); DELETE(TXT,LENSTR-5,1); LENSTR := LENSTR-2; END; IF LENSTR = 5 THEN LST3MOS := FALSE ELSE B to 0.*) (*THE PROCEDURE STRINT IS USED IN THIS ROUTINE*) VAR CHR1: STRING[1]; LST3MOS: BOOLEAN; LENSTR: INTEGER; BEGIN ALL_OK := TRUE; LENSTR := LENGTH(TXT); IF (LENSTR<5) OR (LENSTR>8) THEN ALL_OK := FALSE ELSE procedure takes a string in the form mmddyy or mm/dd/yy*) (*and returns an integer form ddmyy where m is the 2nd m of mm*) (*If the first m is not 0, then the integer form is negative*) (*ALL_OK = false if an error is found*) (*An error sets datint OR (LONGINT > 32767) THEN BEGIN INT := 0; ALL_OK := FALSE; END ELSE INT := TRUNC(LONGINT); END; END;(*STRINT*) PROCEDURE CHRDATINT (TXT:STRING; VAR DATINT:INTEGER; VAR ALL_OK:BOOLEAN); (*this (*THIS PROCEDURE CHANGES A STRING INTO AN INTEGER*) (*PROCEDURE STRINTL IS NECESSARY TO USE THIS*) VAR LONGINT: INTEGER[10]; BEGIN ALL_OK := TRUE; STRINTL(TXT,LONGINT,ALL_OK); IF ALL_OK THEN BEGIN IF (LONGINT < -32768)END; END(*IF ALL_OK*); END(*FOR I*); END(*ELSE*); IF NOT ALL_OK THEN LONGINT := 0; END(*STRINTL*); PROCEDURE STRINT(TXT:STRING; VAR INT:INTEGER; VAR ALL_OK:BOOLEAN); BEGIN IF (TXT[I] < '0') OR (TXT[I] > '9') THEN ALL_OK := FALSE ELSE BEGIN LONGINT := LONGINT+J*(ORD(TXT[I])-48); J := J*10; I: INTEGER; J: INTEGER[10]; BEGIN ALL_OK := TRUE; IF LENGTH(TXT) > 10 THEN ALL_OK := FALSE ELSE BEGIN J := 1; LONGINT := 0; FOR I := LENGTH(TXT) DOWNTO 1 DO BEGIN IF ALL_OK THEN PROCEDURE STRINTL (TXT:STRING; VAR LONGINT:LONG10; VAR ALL_OK:BOOLEAN); (*THIS PROCEDURE CHANGES A STRING INTO A LONG10 INTEGER*) (*OF UP TO 10 DIGITS. AN ERROR GIVES NOT ALL_OK*) (*THE TYPE LONG10 = INTEGER[10] MUST BE DECLARED GLOBALLY*) VAR NOT ALL_OK THEN DATINT := 0; END;(*CHRDATINT*) PROCEDURE INTDATCHR (INTDATE: INTEGER; VAR S: STRING); (*this procedure takes an integer date of form ddmyy and returns a string*) (*of mm/dd/yy. the m in intdate is the 2nd pos. if intdate is negative,*) (*then the 1st pos is '1'. Little error checking is done.*) VAR CHR1: STRING[1]; POSM1: STRING[1]; BEGIN IF (ABS(INTDATE)<1100) OR (ABS(INTDATE)>31999) THEN S :done on a 7 x 8 dot matrix. Periods signify off bits, plus signs designate  on bits. One creates a new character by moving the cursor through the dot  matrix, turning the individual bits on or off as necessary. Single key  commands are easy to masterr sets. When the  program is started, SYSTEM.CHARSET is read from drive #4: and copied to a  file NEW.CHARSET on drive #5:. (Obviously, those with one drive will have to  tinker with this code before using it.) All editing of the character set is   you type in a number greater than 64, the second block is read in. There is  no provision to go back to the first block. %DEFCHARS.TEXT - (Bill Wurzel) A logical sequel to the preceding program,  DEFCHARS allows you to generate new graphics characteother character, type '#', , , . When  done, simply type '%', and the program ends. Note that Bill's program  keeps only one block of the two in SYSTEM.CHARSET in memory at once, so when eads the data in  SYSTEM.CHARSET, which holds the graphics character set used by the Pascal  turtlegraphics routines. It displays any of those characters on the text  screen. When started, the program displays character '0' on the screen. To  see anthat have no internal  directions. I hope you enjoy the use of these routines and that everybody  comes up with contributions to next month's disk. Grateful thanks to this  month's contributors.   %DSPCHARSET.TEXT - (Bill Wurzel) This program r=Pascal Interest Group @Library Disk 1  %The following is a description of the programs available on this disk.  Each program is provided in source code form. The purpose of this minimal  documentation is to explain the use of those programs N^T CHR1 := COPY(S,3,1); DELETE(S,3,1); INSERT(CHR1,S,1); INSERT(POSM1,S,1); INSERT('/',S,3); INSERT('/',S,6); END; END;(*INTDATCHR*) = '00/00/00' ELSE BEGIN IF INTDATE < 0 THEN BEGIN INTDATE := ABS(INTDATE); POSM1 := '1'; END ELSE POSM1 := '0'; STR(INTDATE,S); IF LENGTH(S) = 4 THEN INSERT('0',S,1); : The keys W, E, R, S, F, X, C, V form a cursor  pad, moving the cursor in the direction corresponding to the location of the  key in the pad. For expample, E moves the cursor up, V right and down. The  D, B, and M keys are mode-changing keys. D causes bits landed on by the  cursor to be turned on, B causes them to be turned off, and the M key causes  no change.  %Finally, when the character is finished, type '*' (if you want to edit  more charahese files contain the results of  David's attempts to figure out how to make Pascal programs do the neat things  that are not obvious: inverse characters, horizontal scrolling, and so on.  Note that the version on this disk works for Apple Pascal vnumber each page. When started the program  will ask for a file to print. When done, it will ask for another. When  done, just reply with a to this request.  BIOSUNIT.TEXT %BIOSDEMO.TEXT %BIOSDOC.TEXT %BIOSSTUFF.TEXT - (David Neumann) T very clean interface. But they do work, so if you aren't fussy...  %PRINT.TEXT - (Paul Sand) Another simple program, but I use it more than  any other. All it does it print out a series of text files on the printer,  skipping over page breaks and ) - starts timer #i  %stoptimer(i) - stops timer #i  %reporttimers - outputs a table showing the cumulative times, etc.  %I don't like these routines much any more - Too much stuff to make a time recorded by each timer and the  number of times each timer was turned on. ('You mean this procedure is  called TWENTY THOUSAND TIMES?!'). Procedures included in this unit are:  %inittimers - sets everything up, zeroes timers.  %starttimer(idware Apple Clock. They are meant to be used in the program  development process to find out where your big, complex program is spending  all its time. You can specify timing of up to twenty different porions of  code and report at any point the total arrow keys to display other blocks: back-arrow dispays the previous block,  forward arrow displays the next block. Control - C gets you out of the  program.  %TIMERSTUFF.TEXT - (Paul Sand) These routines are offered to anyone with  a Mountain Hargram that allows you to  see what is really in those files on your disks. It dumps any file in hex  and ASCII, block by block. When started, it asks for a file name. If the  file is found, it will display the first half of the first block. Use the of  memory location addr. Poke(addr, value: integer) puts value in the memory  location specified by addr. Mike has written these routines in a unit so  they can be incorporated into your library.  %FILEDUMP.TEXT - (Paul Sand) This is a simple prontained on your disks. I expect a lot of useful  utility programs next month based on the ideas here.  %PEEKPOKE.TEXT - (Michael Hartman) Here are two familiar routines from  good old Basic: peek(addr: integer) returns an integer with the contents  the UCSD Filer: L)ist Directory, K)runch, and Z)ero Directory. Unlike the  Filer, however, you have the source code of this program. From perusing  Tom's program, you can learn all sorts of interesting stuff about how  directories and files are mai program is (more or less) self explanatory; running it should pose no problem  for you smart guys.  %MINIFILER.TEXT - (Tom Woteki) This program duplicates three functions of r another character or exit.  %CHECKBOOK.TEXT - (Tom Woteki) Tom's checkbook program was presented at  the November meeting, and here it is in machine-readable form. It is a  program to analyze your checking account cashflow on a monthly basis. The cters) or '%' (if you want to exit the program). The program will  ask for the number of the character you just defined, and save the new  definition in NEW.CHARSET. Then, depending on whether you typed '*' or '%'  the pr