`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JN^qqT^oq SKETCH2.TEXT^oEQP.TEXTrE^o DISKDATE.TEXT^oMODEMTEST.TEXToFILEPATCH.TEXToCHECKBOOK.TEXToCHECKBOOK.TEXTolBHRANDALPHAX.TEXTAHNRANDALPHA1.TEXTNTRANDALPHA2.TEXT|TZRANDALPHA3.TEXTZ`RANDALPHA4.TEXT`r MASTERCA.TEXTvgar| NEWDIR.TEXTvgq|TIGER.UNIT.CODE TIGER.TEXTE^oq SCRNBYT.TEXPSCAL25 INDEX.TO.VOLUMEq CRYPTOGRAM.TEXT+SPLITSCRN.TEXTg{ SUMOFNUMS.TEXTg & MINIMAX.TEXTvg&,ROOTNUMBER.TEXT ,2LOGANDBASE.TEXTl2:PERMNCOMB1.TEXT:BBIGCOMBIN1.TEXT&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&7February 1981 "Disk of the Month" ;San Francisco Apple Core   BMax Nareff   CRYPTOGRAM.TEXT - generates coded message from string input  SPLITSCRN.TEXT - split screen demo SUMOFNUMS.TEXT - finds sum of numbers (long integer demo) MINIMAX.TEXT, CODE, NEWCODE :STRING[26]; #MESSAGE, SECRETWORD :STRING; #I, POSITION :INTEGER; #CH :CHAR; # #PROCEDURE INITIALIZE; #BEGIN ((*INITIALIZE*) &ALPHABET := ('ABCDEFGHIJKLMNOPQRSTUVWXYZ'; &SECRETWORD := ' '; &WRITELN %('A CRYPTOGRAPHING PROGRAM':ONSTRUCTED 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 !SOLVING ETC."PGS 78-87*) "  VAR #ALPHABETPROGRAM CRYPTOGRAM; !(*GENERATES A CODED MESSAGE FROM A !STRING INPUT. ! !ADAPTED FROM A STANDARD PASCAL PROGRAM !BY MAX J.NAREFF,11/80.FROM "PROBLEM !SOLVING & STRUCTURED PROGRAMMING IN !PASCAL",BY E.KOFFMAN,PG AP24,1981*) ! !(*DEBUGGED AND RECN+ub.  HJeffrey Sue HPascal Librarian HSan Francisco Apple Core  change any byte on the disk  CHECKBOOK.TEXT - EXACTLY what you think, an excellent checkbook   %Thanks again to everyone who contributed to this month's Disk of  the Every-Other-Month (DOEOM). Special thanks to the Washington (D.C.)  Apple Pi Cl.C.) Apple Pi Club   SKETCH2.TEXT - "Etch-a-Sketch" EQP.TEXT - Eight queens problem  DISKDATE.TEXT - change date without going into the Filer  MODEMTEST.TEXT - Pascal version of D.C. Hayes modem test (nice)  FILEPATCH.TEXT - examine and4use APPLE3:LIBRARY to put this into your SYSTEM.LIBRARY 4In your program, include USES TIGER; 4To print, type PRINTHIRES; TIGER.TEXT - text of Pascal unit SCRNBYT.TEXT - Assembly language interface to read Hires screen 3from the Washington (DERCA.TEXT - creates Master Catalog from many diskette directories  NEWDIR.TEXT - derivative of Master Catalog  3Greg Sue, Jeff Sue and Roland Gustafsson   TIGER.UNIT.CODE - unit for dumping Hires screen to Paper Tiger printer tition  RANDALPHA1.TEXT - random number generators without repetition;  RANDALPHA2.TEXT these are examples of use of array of boolean  RANDALPHA3.TEXT and set operations (union, difference, equality)  RANDALPHA4.TEXT  BSteve Lloyd   MAST - finds minimum and maximum  ROOTNUMBER.TEXT - calculates specified root of a number  LOGANDBASE.TEXT - calculates log and base  PERMNCOMB1.TEXT - permutations and combinations  BIGCOMBIN1.TEXT  RANDALPHAX.TEXT - random number generator with repe32); &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 ENCRYPTION*) #PROCEDURE ENCODE; #BEGIN LY.'); &WRITELN; &WRITELN  (' FIRST,THIS (LEFT) SIDE WILL DISPLAY'); &WRITELN; &WRITELN  ('TEXT.CONTROL-A ON PROMPT WILL SHIFT TO'); &WRITELN; &WRITELN  ('RIGHT SIDE.A KEYPRESS WILL DISPLAY TEXT.'); &WRITELN; &WRITELN  (' AFTER A 3 SEC.TEGER; #BEGIN &FOR I := 0 TO Y DO #END; (*WAIT*) $ #PROCEDURE INTRODUCTION; #BEGIN &PAGE (OUTPUT); &WRITELN )('A SPLIT SCREEN DEMO':29); &WRITELN; &WRITELN  (' SHOWS USE OF BOTH 40 COL SIDES OF'); &WRITELN; &WRITELN -('SCREEN,-SUCCESSIVEPROGRAM 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*) # $ #PROCEDURE WAIT (Y:INTEGER); &VAR I:INN^[{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 END':23);  END. ,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':34); &WRITELN; &WRITELN ('"',& #PROCEDURE DECODE; #BEGIN *(*REINITIALIZE*) &MESSAGE := SECRETWORD; &NEWCODE := ALPHABET; &ALPHABET := CODE; &SECRETWORD := ' '; * &FOR I := 1 TO LENGTH (MESSAGE) DO )BEGIN ,POSITION := &POS(COPY(MESSAGE,I,1),ALPHABET); CAT(SECRETWORD,COPY(CODE,POSITION,1)) ,ELSE 1(*APPEND ORIG SYMBOL*) .SECRETWORD :=  CONCAT (SECRETWORD,COPY(MESSAGE,I,1)); )END; (*FOR*) ) &WRITELN; &WRITELN ,('THE CRYPTOGRAM IS':28); &WRITELN; &WRITELN ('"',SECRETWORD,'"'); #END; (*ENCODE*) ((*SUBSTITUTE CODE CHAR FOR .EACH CHAR IN MESSAGE*) & &FOR I := 1 TO LENGTH (MESSAGE) DO )BEGIN *(*FIND CURRENT CHAR IN  0 THEN 2(*APPEND CODE CHAR*) .SECRETWORD :=  CONPAUSE,THE SCREEN WILL'); &WRITELN;WRITELN 0('RETURN TO THE LEFT.'); &WRITELN;WRITELN  (' ACCOMPLISHED BY GOTOXY & UNITCLEAR.'); &WRITELN;WRITELN *('PRESS ANY KEY TO START':31); &READ (KEYBOARD,ANYCHAR);; &PAGE (OUTPUT); #END; (*INTRO*)  $(*FORMATS & OUTPUTS DEMO LINES*) #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*) #INTRODUCTION; #WR FOR NEXT OP*) +NUMBER := NUMBER + 1; )END; (*WHILE LOOP*) ) #END; (*OPERATOR*) $ $PROCEDURE DISPLAY; $BEGIN &WRITELN  ('THE SUM OF ',ODDCOUNTER, )' ODD NUMBERS THROUGH ',RANGE); &WRITELN ('IS ':18, SUMODD); &WRITELN ('AND':22); &WRITELN  ('T (OUTPUT); &NUMBER := 1; ) &(* FOR LOOP CONTROL VARIABLE *) &WRITELN  ('ENTER HIGHEST NUMBER TO BE ADDED':36); &WRITE (' ':18); &READLN (RANGE); & &WHILE (NUMBER <= RANGE) DO )BEGIN +IF ODD (NUMBER) THEN -ADDODDS +ELSE -ADDEVES; /(*INCREMENT1:= EVECOUNTER + 1; &END; (*ADDEVES*) + &PROCEDURE ADDODDS; +(*ADD THE ODD NUMBERS*) &VAR )ODDNUM :INTEGER; &BEGIN )ODDNUM := NUMBER; )SUMODD := SUMODD + ODDNUM; )ODDCOUNTER 2:= ODDCOUNTER + 1; &END; (*ADDODDS*) ) #BEGIN (*OPERATOR*) &PAGE(27)) THEN (EXIT (PROGRAM) &ELSE #END; (*INIT*) ( #PROCEDURE OPERATOR; #VAR &NUMBER :INTEGER; & &PROCEDURE ADDEVES; *(*ADD THE EVEN NUMBERS*) &VAR )EVENUM :INTEGER; &BEGIN )EVENUM := NUMBER; )SUMEVE := SUMEVE + EVENUM; )EVECOUNTER DD AND ALL THE EVEN'); &WRITELN *('NUMBERS IN A GIVEN RANGE.'); &WRITELN  ('USES THE INTRINSIC FUNCTION "ODD" AND A'); &WRITELN ('LONG INTEGER ATTRIBUTE.'); &WRITELN; WRITELN  ('PRESS TO CONTINUE. TO ABORT.'); &READ (CH); &IF (CH = CHR :INTEGER; #CH (*PROGRAM CONTROL*) :CHAR; # #PROCEDURE INITIALIZE; #BEGIN &SUMEVE := 0; &SUMODD := 0; &ODDCOUNTER := 0; &EVECOUNTER := 0; &GOTOXY (0,3); &WRITELN ('THE SUM OF NUMBERS':29); &GOTOXY (0,8); &WRITELN  (' COUNTS ALL THE OPROGRAM SUMOFNUMS;  (*SUMS ALL ODD AND ALL EVEN NUMBERS UP &THROUGH A GIVEN NUMBER. *BY MAX J.NAREFF,11/80*)   VAR !(*LONG INTEGER ATTRIBUTE OF 10 DIGITS*) #SUMODD, SUMEVE :INTEGER[10]; #ODDCOUNTER, EVECOUNTER :INTEGER; #RANGE N^# #CHALKMARK (20); #WAIT (5000); #UNITCLEAR (1); (*RETURN TO LEFT SCREEN*) #WRITELN &('LEFT',' ':19,'RIGHT':56); #WRITELN ('THE END':25);  END.  ITELN )('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; HE SUM OF ',EVECOUNTER, )' EVEN NUMBERS THROUGH ',RANGE); &WRITELN ('IS ':18, SUMEVE); $END; (*DISPLAY*) $ BEGIN (*MAIN*) #PAGE (OUTPUT); #INITIALIZE; #OPERATOR; #DISPLAY; #WRITELN +('THE END':23)  END.  N^ˡN^ HE ':15,COUNT, ' NUMBERS ENTERED'); #WRITELN '('THE SMALLEST WAS ':27,MINIMUM); #WRITELN (('THE LARGEST WAS ':27,MAXIMUM); #WRITELN;WRITELN ('THE END':23);  END. (*MINIMAX*) 3(*STORE MINIMUM*) 1MINIMUM := NUMBER; /IF NUMBER > MAXIMUM THEN 3(*STORE MAXIMUM*) 1MAXIMUM := NUMBER; .END; (*ELSE*) *END; (*WHILE*) *WRITELN; &END; (*SELECTION*) )  BEGIN (*MAIN*) #PAGE (OUTPUT); #INITIALIZE; #SELECTION; #WRITELN  ('OF TMAXINT; &MAXIMUM := -MAXINT; &COUNT := 0; #END; (*INITIALIZE*)  #PROCEDURE SELECTION; &BEGIN (WHILE READING DO *BEGIN ,READ (NUMBER); ,IF (NUMBER = 0) THEN .READING := FALSE ,ELSE .BEGIN 1COUNT := COUNT + 1; /IF NUMBER < MINIMUM THEN AND'); &WRITELN;WRITELN  ('DOUBLE ALTERNATIVE DECISION STEPS.'); &WRITELN;WRITELN; &WRITELN  ('ENTER A SERIES OF INTEGERS':33); &WRITELN ('0 TO STOP':24); &WRITELN;WRITELN  ('AFTER EACH INTEGER,PRESS .':35); & &READING := TRUE; &MINIMUM := PROCEDURE INITIALIZE; #BEGIN &WRITELN ('MINIMUM-MAXIMUM':27); &WRITELN; &WRITELN  (' THIS IS A SIMPLE "SWAPPING" PROGRAM,'); &WRITELN;WRITELN  ('USING A "WHILE" LOOP,THE PREDETERMINED'); &WRITELN;WRITELN  ('STANDARD CONSTANT(MAXINT) AND SINGLE PROGRAM MINIMAX;  (*ADAPTED FROM A STANDARD PASCAL PROGRAM  IN "PROGRAMMING IN PASCAL",BY P.GROGONO  1980,ADDISON-WESLEY PUB.CO.*)  (*PREPARED BY MAX J.NAREFF,11/80*)   VAR #READING : BOOLEAN; #NUMBER, MINIMUM, MAXIMUM, COUNT >: INTEGER; # # #PROGRAM ROOTNUMBER;  (*CALCULATES THE BASE NUMBER FROM WHICH  AN NTH ROOT WILL GENERATE A GIVEN NUMBER.  ALGORITHM SPAWNED BY STEVE LLOYD AND THE  PASCAL SPECIAL GROUP IN RESPONSE TO A  QUESTION BY THE SUBMITTER,MAX J.NAREFF 12/80*)  USES TRANSCEND; :REAL; #VAR HOLD :REAL; #BEGIN &HOLD := LOG (NUMBER) / LOG (BASE); &LOGOFNUMBER := HOLD; #END; (*LOG*) # #PROCEDURE START; #BEGIN &PAGE (OUTPUT); &WRITELN +('LOGARITHMS AND BASES':30); &WRITELN;WRITELN  (' THIS PROGRAM COMPUTES THE LOBER, BASE :REAL; (*INPUTS*) %CH :CHAR; % #FUNCTION DATA (S:STRING) :REAL; ((*DATA INPUTS*) #VAR RESPONSE :REAL; #BEGIN &WRITE (S:26,'>>'); &READLN (RESPONSE); &DATA := RESPONSE; #END; (*DATA*)  #FUNCTION LOGOFNUMBER(VAR X,Y:REAL)PROGRAM LOGANDBASE;  (*COMPUTES LOGARITHM OF ANY NUMBER TO  ANY BASE.  ADAPTED BY MAX J.NAREFF,12/80-FROM  "BASIC COMPUTER PROGRAMS IN SCIENCE &  ENGINEERING",J.H.GILDER,1980,HAYDEN BOOK  CO.*)   USES TRANSCEND; (*FOR LOG FUNCTION*)   VAR NUMN^ll%WRITELN;WRITE  ('ANOTHER COMPUTATION?->Y/N':32); # READ (KEYBOARD,CH); %PAGE (OUTPUT) "UNTIL (CH <> 'Y'); "WRITELN ('THE END':23);  END. LN (NUMBER); &WRITELN;WRITE  ('ENTER THE DESIRED ROOT.>':33); &READLN (NTHROOT); # *(*X = Y^(1/N)*) # &BASENUMBER := EXP(K/NTHROOT * :LN (NUMBER)); &WRITELN;WRITELN  ('THE',NTHROOT:4:2,'TH ROOT OF', %NUMBER:9:2,' IS',BASENUMBER:8:4); ; #WRITELN;WRITELN  ('(FOR EX.WHAT IS THE BASE OF THE 8TH ROOT'); #WRITELN;WRITELN  ('OF 65536 OR WHAT NUMBER TO THE 8TH POWER'); #WRITELN;WRITELN  ('WILL YIELD 65536?)');  #REPEAT &WRITELN;WRITE  ('ENTER THE NUMBER TO BE ANALYZED.>':33); &READ!  CONST #K = 1;   VAR #BASENUMBER, #NUMBER, #NTHROOT :REAL; #CH :CHAR; #  BEGIN #PAGE (OUTPUT); #BASENUMBER := 0; #WRITELN  (' THIS PROGRAM COMPUTES THE BASE OF A'); #WRITELN; #WRITELN  (' GIVEN NUMBER AND A GIVEN ROOT.')GARITHM'); &WRITELN;WRITELN  ('OF ANY NUMBER TO ANY BASE.'); &WRITELN;WRITELN  (' THE LOG OF ANY NUMBER IS THE POWER'); &WRITELN;WRITELN  ('TO WHICH THE BASE OF THE LOG MUST BE'); &WRITELN;WRITELN  ('RAISED TO YIELD THAT NUMBER.'); &WRITELN;WRITELN  (' MERELY ENTER ANY NUMBER AND A BASE'); &WRITELN;WRITELN  ('-THE LOG OF THAT NUMBER TO THAT BASE IS'); &WRITELN;WRITELN  ('THE RESULT.'); &WRITELN;WRITE  (' TO CONTINUE:: TO ABORT.'); &READ (KEYBOARD,CH); &IF (C +IF (NUMBITEMS < NUMPERGROUP) -OR (NUMPERGROUP < 1) OR 2(NUMBITEMS > 34) THEN .BEGIN 0WRITELN 0('ERROR-REPEAT INPUT':29); 0NUMBITEMS := )DATA('ENTER NUMBER OF ITEMS'); +NUMPERGROUP := )DATA('ENTER NUMBER PER GROUP'); .END (*IF*) 0 &END (*ELSECONTINUE:: TO ABORT.':37); &READ (KEYBOARD,CH); &IF (CH = CHR (27)) THEN *EXIT (PROGRAM) &ELSE *BEGIN *PAGE (OUTPUT); -NUMBITEMS := +DATA('ENTER NUMBER OF ITEMS'); -NUMPERGROUP := +DATA('ENTER NUMBER PER GROUP'); + -(*INPUT ERRORS NOTIFY*) ('COMBINATION--DIFFERENT WAYS IN WHICH N'); &WRITELN;WRITELN  ('ITEMS CAN BE GROUPED WITHOUT REGARD TO'); &WRITELN;WRITELN  ('THE ORDER OF ARRANGEMENT WITHIN THE GP.'); &WRITELN;WRITELN  ('NUMBER NOT TO EXCEED 34':32); &WRITELN;WRITE  (' TO UTATIONS AND COMBINATIONS':34); &WRITELN;WRITELN  ('PERMUTATIONS--DIFFERENT WAYS IN WHICH N'); &WRITELN;WRITELN  ('ITEMS CAN BE ARRANGED WITH REGARD TO THE'); &WRITELN;WRITELN  ('ORDER WITHIN THE GROUP.'); &WRITELN;WRITELN :CHAR; # #FUNCTION DATA(S:STRING) : INTEGER; *(*INPUT PROMPTS*) #VAR &REPLY : INTEGER; #BEGIN &WRITE (S:24,'>>'); &READLN (REPLY); &DATA := REPLY; #END; (*DATA*) # #PROCEDURE INTRO; #BEGIN &PAGE (OUTPUT); &WRITELN  ('PERM CONTROL*) #NUMBITEMS, #NUMPERGROUP, #TEMPVAR :INTEGER; # #(*PROGRAM VARIABLES-TEMPORARY*) #ITEMFACTOR, #DIFFERFACTOR, #GROUPFACTOR, #COMPUTEDFACTOR :REAL; # ((*OUTPUT VARIABLES*) #PERMUTATION, #COMBINATION :REAL; #CHPROGRAM PERMNCOMB;  (*COMPUTES PERMUTATIONS AND COMBINATIONS  ADAPTED FROM A SERIES OF PROGRAMS IN  "BASIC COMPUTER PROGRAMS IN SCIENCE AND  ENGINEERING-J.H.GILDER;HAYDEN BOOK CO.1980  PREPARED BY MAX J.NAREFF,12/80*)   VAR #(*INPUT VARIABLES-LOOPN^L'TO THE',  ' BASE',BASE:4:2); #WRITELN  ('=':17,LOGOFNUMBER (NUMBER, BASE):6:2); #WRITELN ('OR':21); #WRITELN ((BASE:4:2,' TO THE POWER OF',  LOGOFNUMBER(NUMBER,BASE):6:2,' =',NUMBER:6:2); #WRITELN ('THE END':23)  END. $ H=CHR(27)) THEN (EXIT (PROGRAM) &ELSE (PAGE (OUTPUT) #END; (*START*) #  BEGIN (*MAIN*) #START; #NUMBER := # DATA ('ENTER NUMBER OF LOGARITHM'); #BASE := $DATA ('ENTER BASE OF LOGARITHM'); #WRITELN; #WRITELN  ('THE LOGARITHM OF',NUMBER:6:2,*) #END; (*INTRO*) # # #PROCEDURE FACTOR(VAR LOOPLIMIT:INTEGER); ((*FACTORS INPUT VALUES*) #VAR &K (*LOOP INDEX VARIABLE*) :INTEGER; #BEGIN &COMPUTEDFACTOR := 1; &FOR K := 1 TO LOOPLIMIT DO )BEGIN ,COMPUTEDFACTOR := 5K * COMPUTEDFACTOR; )END; (*FOR*) #END; (*FACTOR*) )  BEGIN (*MAIN*) #INTRO; ( #FACTOR(NUMBITEMS); #ITEMFACTOR := COMPUTEDFACTOR; # #TEMPVAR := NUMBITEMS - NUMPERGROUP; #FACTOR(TEMPVAR); #DIFFERFACTOR := COMPUTEDFACTOR; # #FACTOR(NUMPERGROUP); #GROUPFACTOR := CER NUMBER PER GROUP'); , .(*ERROR NOTIFY*) -IF (NUMITEMS > 120) THEN /BEGIN 0WRITELN '('INPUT RANGE EXCEEDED-REPEAT':35); 0NUMITEMS := ,DATA('ENTER NUMBER OF ITEMS'); 0NUMPERGROUP := ,DATA('ENTER PER GROUP'); /END (*IF ERROR*) *END (*ELSE*) #E.'); &WRITELN;WRITE  (' TO CONTINUE:: TO ABORT':37); # READ (KEYBOARD,CH); &IF (CH = CHR(27)) THEN (EXIT (PROGRAM) &ELSE *BEGIN -PAGE (OUTPUT); -GOTOXY (0,8); -NUMITEMS := + DATA('ENTER NUMBER OF ITEMS'); +NUMPERGROUP := ,DATA('ENT&WRITELN;WRITELN  (' THIS PROGRAM COMPLEMENTS THE "PERMUT'); # WRITELN;WRITELN  ('ATION & COMBINATION" PROGRAM IN THAT NUM'); &WRITELN;WRITELN  ('BERS LARGER THAN 34 CAN BE HANDLED.'); &WRITELN;WRITELN  (' DO NOT EXCEED 120 TO PREVENT OVERFLOWLN;WRITELN  ('THE ORDER OF ARRANGEMENT OF THESE ITEMS'); &WRITELN;WRITELN  ('WITHIN ANY GROUP.IN CONTRAST,IN PERMUT-'); &WRITELN;WRITELN  ('ATIONS,THE ORDER OF INTRAGROUP ALIGNMENT'); &WRITELN;WRITELN  ('IS OBSERVED AND NECESSARY.'); SPONSE #END; (*DATA*) # #PROCEDURE INTRO; #BEGIN &PAGE (OUTPUT); &WRITELN #('COMBINATIONS OF LARGE NUMBERS':35); &WRITELN;WRITELN  ('COMBINATIONS--DIFFERENT WAYS IN WHICH N'); &WRITELN;WRITELN  ('ITEMS CAN BE GROUPED WITHOUT REGARD TO'); &WRITE*)   VAR #NUMITEMS, NUMPERGROUP, (*INPUTS*) #COMBINATION (*OUTPUT*) :REAL; #CH :CHAR; # ((*INPUT PROMPTS*) #FUNCTION DATA(S:STRING):REAL; #VAR &RESPONSE :REAL; #BEGIN &WRITE (S:24,'>>'); &READLN (RESPONSE); &DATA := REPROGRAM BIGCOMBINS;  (*COMPUTES RELATIVELY LARGE COMBINATIONS.  COMPLEMENTS PERMNCOMB PROGRAM.ADAPTED  FROM A SERIES OF PROGRAMS BY J.H.GILDER,  "BASIC COMPUTER PROGRAMS IN SCIENCE AND  ENGINEERING,1980;HAYDEN BOOK CO.  PREEARED BY MAX J.NAREFF,12/80N^LlONS = ',PERMUTATIONN); #WRITELN  ('NUMBER OF COMBINATIONS = ',COMBINATION); #WRITELN;WRITELN ('THE END':23);  END. OMPUTEDFACTOR; # #PERMUTATION := ITEMFACTOR / ;DIFFERFACTOR; #COMBINATION := ITEMFACTOR (/ DIFFERFACTOR / GROUPFACTOR; ( #WRITELN ('NUMBER OF OBJECTS = ',NUMBITEMS); #WRITELN  ('NUMBER PER GROUP = ',NUMPERGROUP); #WRITELN  ('NUMBER OF PERMUTATIND; (*INTRO*) + #(*IF NUMBER OF ITEMS < 2* SUBGROUP*) #PROCEDURE LESSTHAN2X; #VAR &NUMBER, I :INTEGER; (*LOOP VARS*) &TEMP1, TEMP2 :REAL; (*PROGRAM VARS*) & #BEGIN &NUMBER := ROUND(NUMITEMS - ;NUMPERGROUP); &TEMP1 := NUMPERGROUP + 1; &FOR I := 2 TO NUMBER DO )BEGIN ,TEMP2 := #TEMP1 * (NUMPERGROUP + I)/I; ,TEMP1 := TEMP2; )END; (*FOR*) &COMBINATION := TEMP2; #END; (*LESSTHAN*) ; #(*IF NUMBER OF ITEMS > 2* SUBROUP*) #PROCEDURE MORETHAN2X; #VAR &NUMBER, J :INTEGER; &TEMP1&END; (*WHILE*) #WRITELN; #WRITELN ('THE END':23); #WRITELN;WRITELN $('PRESS "U" FOR ANOTHER SERIES':34);  END. (*PROGRAM*) N %(*GENERATES NUMBERS FROM 1 TO 26*) )I := RANDOM MOD 26 + 1; +(*CONVERTS ORDINAL TO CHAR*) )WRITE (CHR(64+I):5); )J := J+1; (*LOOP COUNTER*) ) )(*FORMATTER*) )X := X + 5; )IF (X>=40) THEN +BEGIN .WRITELN; .X := 0; +END (*IF*) + #WRITELN (CHR(12)); #GOTOXY (0,8); #WRITELN  ('RANDOM ALPHABET ILLUSTRATING NORMAL':37); #WRITELN  ('OCCURENCE OF REPETITION IN EACH SERIES'); #WRITELN; #RANDOMIZE; #J := 0; #X := 0; #(*LOOP FOR 26 RANDOM NUMBERS*) #WHILE J <> ALPHABET DO &BEGIES,WHICH ILLUS-  TRATE SOME OF THE METHODS OF AVOIDING  THIS NORMAL REPETITION. !BY MAX J.NAREFF,1/81*)   USES APPLESTUFF; (*FOR RANDOM FUNCTION*)   CONST ALPHABET = 26;   VAR I, +J, X (*COUNTERS*) : INTEGER;   BEGIN (*MAIN*) PROGRAM RANDALPHAX;  (*A SIMPLE EXERCISE INVOLVING RANDOM GEN  ERATION OF THE LETTERS OF THE ALPHABET,  ILLUSTRATING THE NORMAL,BOTHERSOME PHEN-  OMENON OF REPETITION.THIS IS USED AS A  BASIS OF COMPARISON WITH THE 4 PROGRAMS  IN THE "RANDALPHA" SERIN^AA;COMBINATION);  WRITELN;WRITELN ('THE END':23)  END. - #INTRO; #IF (NUMITEMS < 2 * NUMPERGROUP) THEN %LESSTHAN2X #ELSE %MORETHAN2X; #WRITELN; #WRITELN  ('THE NUMBER OF ITEMS = ':26,NUMITEMS:5:2); #WRITELN  ('THE NUMBER PER GROUP = ':26,NUMPERGROUP:5:2); #WRITELN  ('NUMBER OF COMBINATIONS = ':26, , TEMP2 :REAL; & #BEGIN &TEMP1 := NUMITEMS; &NUMBER := ROUND(NUMPERGROUP); &FOR J := 2 TO NUMBER DO )BEGIN ,TEMP2 := TEMP1 * )((NUMITEMS +1 - J) / J); ,TEMP1 := TEMP2; )END; (*FOR*) &COMBINATION := TEMP2; #END; (*MORETHAN*) #  BEGIN (*MAIN*)N^|N^|$(*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..ALPPROGRAM 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 FN  ('REPETITION---USING "SET INEQUALITY"':38); #WRITELN; #RANDOMIZE; #X := 0; #SERIES := [ ]; (*INITIALIZE-*) #SEQUENCE := [ ]; (*EMPTY SETS*) #REPEAT # #(*GENERATES RANDOMS FROM 1 TO 26*) &NUMBER := RANDOM MOD 26 + 1; & $(*SET UNION OPERATION ..ALPHABET; #RANK = SET OF DIGITS; #  VAR #NUMBER : DIGITS; #SERIES, SEQUENCE : RANK; (*TWO SETS*) #X (*FORMATTING*) : INTEGER; #  BEGIN (*MAIN*) #WRITELN (CHR(12)); #GOTOXY (0,8); #WRITELN  ('ALPHABET GENERATED AT RANDOM WITHOUT':37); #WRITELPROGRAM RANDALPHA3;  (*GENERATES RANDOM SEQUENCE OF ALPHABET  WITHOUT REPETITION USING THE "SET  INEQUALITY" OPERATION AS A FILTER. /BY MAX J.NAREFF,12/80*)   USES APPLESTUFF; (*FOR RANDOM FUNCTION*) #  CONST ALPHABET = 26; #  TYPE #DIGITS = 1N^|.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); #WTO FILL SET*) &SERIES := SERIES + [NUMBER]; &  (*NUMBER PERMITTED IN (SEQUENCE) SET 2ONLY IF NOT YET USED*) #(*SET INEQUALITY IS THE TEST USED*) &IF (SEQUENCE <> SERIES) THEN )BEGIN ,WRITE (CHR(64 + NUMBER):5); ,SEQUENCE := SERIES; , ,X := X + 5; (*FORMATTER*) ,IF (X>=40) THEN .BEGIN 1WRITELN; 1X := 0; .END (*IF X*) )END (*IF*) $(*SERIES COMPLETED WHEN ALL 8LETTERS LISTED*) #UNTIL (SEQUENCE = [1..ALPHABET])  END. )END (*IF*) $(*SERIES COMPLETE WHEN ALL LETTERS -LISTED AND SERIES EMPTY*) #UNTIL (SERIES = [])  END. (CHR(64 + NUMBER):5); ,  (*SET DIFFERENCE OPERATION-OPERATOR(-)*)  (*NUMBER "SUBTRACTED" FROM SERIES IF DUSED*) ,SERIES := SERIES - [NUMBER]; , ,X := X + 5; (*FORMATTER*) ,IF (X>=40) THEN .BEGIN 1WRITELN; 1X := 0; .END (*IF X*) SING "SET DIFFERENCE':36); #WRITELN; #RANDOMIZE; #X := 0; "(*INITIALIZE SET TO FULL (UNIVERSAL)*) #SERIES := [1..ALPHABET]; #REPEAT # #(*GENERATES RANDOMS FROM 1 TO 26*) &NUMBER := RANDOM MOD 26 + 1; & &IF (NUMBER IN SERIES) THEN )BEGIN ,WRITE..ALPHABET; #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-UPROGRAM RANDALPHA4;  (*GENERATES RANDOM SEQUENCE OF ALPHABET  WITHOUT REPETITION USING THE "SET DIFFERENCE"  OPERATION AS A FILTER. 1BY MAX J.NAREFF,12/80*)   USES APPLESTUFF; (*FOR RANDOM FUNCTION*) #  CONST ALPHABET = 26; #  TYPE #DIGITS = 1N^|/^)ae : DATE; " (* date diskette was formatted *) "D : INTEGER; "E : INTEGER; "END;   FileInfo = RECORD "Starting : INTEGER; $(* the block the file starts in *) "Ending : INTEGER; $(* block after the end of the file *) "FileType : 0..7; $(* NILING[7]; " (* this field is 8 bytes long *) $(* the first byte contains the *) $(* length of the name, the next 7 *) $(* contain the name of the disk *) "B : INTEGER; "Files : INTEGER; " (* files on the diskette *) "C : INTEGER; "DiskDat"Year : 1..99; "END;   DiskInfo = RECORD "(* many of these fields have an *) "(* unknown function. the ones that *) "(* have a single letter for their *) "(* name are unknown *) "A : ARRAY[0..2] OF INTEGER; "DiskName : STR by its members and affiliates *)  (* *)  (**************************************)   TYPE (* DECLARATIONS *)   Date = "(* MONTH, DAY AND YEAR IN 16 BITS *) "PACKED RECORD "Month : 1..12; "Day : 1..31; ****************************)   (**************************************)  (* *)  (* This program has been provided to *)  (* the San Francisco APPLE Core for *)  (* distribution to and non-commercial *)  (* usel Rights Reserved *)  (*$C No part of this program mat be *)  (*$C translated, reproduced or stored *)  (*$C in any form without the prior *)  (*$C written consent of Stephen Lloyd *)  (* *)  (********** THE DISK, AN OPTIONAL ALIAS NAME IS REQUESTED  FOR EACH DISKETTE.  *)   PROGRAM MasterCatalog;   (**************************************)  (* *)  (*$C Copyright (c) 1980 Stephen Lloyd *)  (*$C AlS ON THE DISKETTE  DIRECTORY ARE WRITTEN ONTO THE MASTER CATALOG  FILE FOLLOWING THE VOLUME NAME OF THE  DISKETTE.  %SINCE THE DISKETTES CAN BE PHYSICALLY  CALLED BY A NAME OTHER THAN THE NAME STORED ON LE IS WRITTEN ON THE DISKETTE IN DRIVE TWO  AND CAN BE GIVEN ANY FILE NAME. IF THAT FILE  EXISTS, THE THE MASTER CATALOG IS APPENDED TO  THE END. THE DISKETTES TO BE CATALOGED ARE  INSERTED INTO DRIVE ONE IN RESPONSE TO THE  PROMPTS. ALL ACTIVE FILEhe procedure called  "ListFile " in the main program. I've marked  it with a big sign to help you locate it. *)  %(* THIS PROGRAM CREATES A MASTER CATALOG  OF AS MANY DISKETTE DIRECTORIES AS CAN BE  WRITTEN INTO THE CATALOG FILE. THE CATALOG  FI (* The comment block following this comment  block must be written into a file called  "CAT.INTRO.TEXT". The easiest way to do that  is with the editor. If you don't want to look  at that silly message every time the program  runs, then delete t,BAD,CODE,TEXT,  INFO,DATA,GRAF,FOTO *) "FileName : STRING[15]; $(* the file name pyhsicaly *) $(* occupies 16 bytes in the *) $(* directory. the first byte *) $(* indicates the length of the *) $(* name the next 15 bytes contain *) $(* the ascii REPRESENTATION OF *) " (* THE NAME *) "UNKNOWN : INTEGER; $(* your guess is as good as mine *) "FileDate : DATE; $(* this is the date the file was *) $(* last written to   PROCEDURE Reminder;   BEGIN (* REMINDER *)  WRITELN;  WRITELN;  WRITELN;  WRITELN  ('THE MASTER CATALOG FILE HAS BEEN');  WRITELN  ('PLACED ON DRIVE 2.');  WRITELN;  WRITELN  ('USE THE EDITOR TO REVIEW ITS CONTENTS');  WRITELN  ('OR USETTE TO BE INCLUDED IN');  WRITELN  ('MASTER CATALOG IN DRIVE 1.');  WRITELN  ('PRESS "RETURN" TO CONTINUE,');  WRITE  ('"Q" TO TERMINATE : ');  READ(CH);  IF (CH='Q') OR (CH='q') "THEN Quit := TRUE  ELSE Quit := FALSE;  END; (* PROMPT *)  "END; (* FILES *)    BEGIN (* CATALOG *)   (* READ DIRECTORY FROM DRIVE 1 *)  UNITREAD(4,Directory,2048,2);   Header;  Alias;  Files;  END; (* CATALOG *)    PROCEDURE Prompt;   BEGIN (* PROMPT *)  WRITELN;  WRITELN  ('INSERT DISK 2)=1 (THEN BEGIN (WRITE ((F,Directory.Files[I].FileName); (FOR J := 20 DOWNTO (LENGTH(Directory.Files[I].FileName) *DO WRITE(F,' '); (END *ELSE WRITELN *(F,Directory.Files[I].FileName); &WRITE('.'); &END; $END; "WRITELN(F);  WRITELN(F); F,'-'); $WRITELN(F); $END; "END; (* ALIAS *)    PROCEDURE Files;   BEGIN (* FILES *) "(* WRITE FILE NAMES ONTO %MASTER CATALOG FILE *) "IF Directory.Disk.Files>0 $THEN BEGIN $FOR I := 1 TO $Directory.Disk.Files &DO BEGIN &IF (I MODTTE NAME : '); "READLN(AliasName); "(* WRITE DISKETTE NAME %ONTO MASTER CATALOG FILE *) "IF LENGTH(AliasName)>0 $THEN BEGIN $WRITELN $(F,'DISKETTE NAME : ',AliasName); $WRITE $(F,'------------- '); $FOR I := 1 TO (LENGTH(AliasName) (DO WRITE("IF LENGTH(Directory.Disk.DiskName)>0 $THEN BEGIN $WRITELN(F,'DISK NAME : ', $ Directory.Disk.DiskName); $WRITELN(F); $END;  END; (* HEADER *) "   PROCEDURE Alias; " "VAR AliasName : STRING[32]; " "BEGIN (* ALIAS *) "WRITE('DISKEE(OUTPUT); "WRITELN('ERROR IN OPENING FILE'); "WRITELN('PROGRAM TERMINATED'); "END;  END;    PROCEDURE Catalog;   PROCEDURE Header; " "BEGIN (* HEADER *) "(* WRITE DISK HEADER ONTO " MASTER CATALOG FILE *) FileName);  IF IORESULT<>0 "THEN BEGIN "REWRITE(F,FileName); "END  ELSE BEGIN $WRITE('FILE EXISTS..APPENDING'); $REPEAT $READLN(F,Line); $WRITE('.'); $UNTIL EOF(F);  END;  (*$I+*)   IF IORESULT<>0 "THEN BEGIN "Quit := TRUE;  PAG#5:',FileName); "IF LENGTH(FileName)<19 $THEN GoodFile := TRUE &ELSE BEGIN &GoodFile := FALSE; &WRITE &('File name must be less than '); &WRITELN &('10 characters !'); &END; "END $ELSE GoodFile := FALSE;  UNTIL GoodFile;   (*$I-*)  RESET(F, WRITE('master catalog file name : ');  READLN(FileName);  IF LENGTH(FileName)>0 "THEN BEGIN "IF (POS('.TEXT',FileName)=0) OR " (POS('.text',FileName)=0) $THEN FileName := CONCAT(FileName, $ '.TEXT'); "FileName := CONCAT('ess "RETURN" to continue : '); "READLN; "UNTIL EOF(F);  CLOSE(F);  END;    PROCEDURE OpenMaster;   VAR GoodFile : BOOLEAN;  Line : STRING[132];   (* OPEN MASTER CATALOG FILE ON DRIVE 2 *)  BEGIN  GoodFile := FALSE;  REPEAT DURE ListFile(TextFile : STRING);   VAR F : TEXT; $I : INTEGER; $Line : STRING[80]; $  BEGIN  RESET(F,CONCAT(TextFile,'.TEXT')); "REPEAT "PAGE(OUTPUT); "FOR I := 1 TO 20 $DO BEGIN $READLN(F,Line); $WRITELN(Line); $END; "WRITELN; "WRITE('pr the disk *) "END;    VAR (* VARIABLE DECLARATIONS *)   Directory : RECORD "Disk : DiskInfo; "Files : ARRAY[1..77] OF FileInfo; "END;   CH : CHAR;  FileName : STRING[15];  F : TEXT;  I,J,K,L : INTEGER;  Quit : BOOLEAN;    PROCEE THE FILER TO TRANSFER IT TO');  WRITELN  ('THE PRINTER.');  END; (* REMINDER *)    BEGIN (* MASTER CATALOG *)  #(*******************) !(* *)  (* This is it, this is *)  (* what you want to get *)  (* rid of if you don't *)  (* want to be introduced *)  (* to the program every *)  (* time it runs *) !(* *) #(*******************)  ListFile('#5:CAT.INTRO');  (*******************) #  PAGE(OUTPUT);  Quit := A : ARRAY[0..2] OF INTEGER; "DiskName : STRING[7]; " (* this field is 8 bytes long *) $(* the first byte contains the *) $(* length of the name, the next 7 *) $(* contain the name of the disk *) "B : INTEGER; "Files : INTEGER; " (* filesCKED RECORD "Month : 1..12; "Day : 1..31; "Year : 1..99; "END;   DiskInfo = RECORD "(* many of these fields have an *) "(* unknown function. the ones that *) "(* have a single letter for their *) "(* name are unknown *) " (* distribution to and non-commercial *)  (* use by its members and affiliates *)  (* *)  (**************************************)   TYPE (* DECLARATIONS *)   Date = "(* MONTH, DAY AND YEAR IN 16 BITS *) "PA *)  (**************************************)   (**************************************)  (* *)  (* This program has been provided to *)  (* the San Francisco APPLE Core for *) t (c) 1980 Stephen Lloyd *)  (*$C All Rights Reserved *)  (*$C No part of this program mat be *)  (*$C translated, reproduced or stored *)  (*$C in any form without the prior *)  (*$C written consent of Stephen Lloyd *)  (* THE MASTER *)  (* CATALOG PROGRAM. *)  (* *)  (**************************************)    (**************************************)  (* *)  (*$C Copyrigh PROGRAM DIR;   (**************************************)  (* *)  (* THIS PROGRAM WAS WRITTEN BY STEVE *)  (* LLOYD. IT IS BASED ON A PROGRAM *)  (* DEMONSTRATED BY GEORGE GOLDEN AND *)  (* IS AN OFFSHOOT OF /^)qND. (* MASTER CATALOG *)   FALSE;  OpenMaster;  (* OPEN MASTER CATALOG FILE ON DRIVE 2 *)  WHILE NOT Quit "DO BEGIN "Prompt; "WHILE (CH<>'Q') AND (CH<>'q') $DO BEGIN $Catalog; $Prompt; (* FOR NEXT DISKETTE *) $END; "PAGE(OUTPUT); "Reminder;  END;  CLOSE(F,LOCK);  E on the diskette *) "C : INTEGER; "DiskDate : DATE; " (* date diskette was formatted *) "D : INTEGER; "E : INTEGER; "END;   FileInfo = RECORD "Starting : INTEGER; $(* the block the file starts in *) "Ending : INTEGER; $(* block after the end of the file *) "FileType : 0..7; $(* NIL,BAD,CODE,TEXT,  INFO,DATA,GRAF,FOTO *) "FileName : STRING[15]; $(* the file name pyhsicaly *) $(* occupies 16 bytes in the *) $(* directory. the first byte *)N^qq) #i `g6 PPb6 *,, TIGER.CODETEM.SWAPDISKQܡ ޢۆTIGER.TEXT/(tT-  TIGER.CODEK.CODE[*]^APPLE2:SYSTEM.SWAPDISK{  ȡ& á   ǿš `Z h4h5hhhhhhhh G)% 8fHJH5H4H`H)JJh & & fAPPLE2T TIGER.CODEz6 z|z6 PPb6 *,, TIGER.CODETEM.SWAPDISKQܡ ޢۆTIGER.TEXT/(tT-  TIGER.CODEK.CODE[*]^APPLE2:SYSTEM.SWAPDISK{ PROCEDURE PRINTHIRES; IMPLEMENTATION E .CODE.CODEPDISKWAPDISKԍ֍br r b^br APP`b6 6 ^``Pb6 r  G@ TIGER  MASTER CATALOG *)   *)  WRITELN;  WRITE('DIRECTORY FOR WHICH UNIT ? ');  READ(CH); "CASE CH OF "'1' : DRIVE := 11; "'4' : DRIVE := 4; "'5' : DRIVE := 5; "END;  END; (* PROMPT *)    BEGIN (* DIR *)  "PAGE(OUTPUT); "PROMPT; "PAGE(OUTPUT); "Catalog;  END. (*&(Directory.Files[I].FileName); &FOR J := 20 DOWNTO &LENGTH(Directory.Files[I].FileName) (DO WRITE(' '); &END (ELSE WRITELN ((Directory.Files[I].FileName); $END; "END;  WRITELN;  END; (* CATALOG *)    PROCEDURE Prompt;   BEGIN (* PROMPT talog;   BEGIN (* CATALOG *)  (* READ DIRECTORY FROM DRIVE 1 *)  UNITREAD(DRIVE,Directory,2048,2);  WRITELN;  IF Directory.Disk.Files>0 "THEN BEGIN "FOR I := 1 TO "Directory.Disk.Files $DO BEGIN $IF (I MOD 2)=1 &THEN BEGIN &WRITE ate the file was *) $(* last written to the disk *) "END;    VAR (* VARIABLE DECLARATIONS *)   Directory : RECORD "Disk : DiskInfo; "Files : ARRAY[1..77] OF FileInfo; "END;   CH : CHAR;  I,J,K,  DRIVE : INTEGER;    PROCEDURE Ca $(* indicates the length of the *) $(* name the next 15 bytes contain *) $(* the ascii REPRESENTATION OF *) " (* THE NAME *) "UNKNOWN : INTEGER; $(* your guess is as good as mine *) "FileDate : DATE; $(* this is the d STA VALUE PLA STA XCOORD PLA STA XCOORD+1 LOOP LDX XCOORD ;LSB OF X COORD LDY XCOORD+1 ;MSB OF X COORD LDA YCOORD JSR SUB1 LDY OFFSET LDA ;STACK BIAS (FUNC) PLA PLA LDA #06 ;6 BIT SCAN STA COUNT PLA ;LSB OF Y COORD STA YCOORD PLA ;DISCARD MSB OF Y LDA #0 IT ;USES 6 & 7 ;CALCULATED BY SUB1 OFFSET .EQU 8 ;OFFSET PAST ADDR OF BIT MASK .EQU 9 ;MASK TO GET BIT POP RETURN PLA ;DISCARD 4 BYTE PLA CRNBYT(X,Y: INTEGER); ; ; RETURN .EQU 034 ;TEMP FOR RETURN ADDR COUNT .EQU 0 ;HOW MANY BITS TO SCAN YCOORD .EQU 1 XCOORD .EQU 2 ;BYTES 2 & 3 VALUE .EQU 4 ;RETURN VALUE ADDR .EQU 6 ;ADDRESS OF SCREEN B; ; ; MACRO POPS 16 BIT ARGUMENT ; .MACRO POP PLA STA %1 PLA STA %1+1 .ENDM .FUNC SCRNBYT,2 ; ; THIS FUNCTION SCANS 6 BITS FROM ; THE HIGH RESOLUTION SCREEN ; ; FUNCTION SN^qq UNITWRITE(PRINTER,SEND,2,0,12); (* RESTORE TO NORMAL PRINTER MODE *) END; (* PRINTHIRES *) BEGIN; END.  279 DO BEGIN N:=SCRNBYT(X,Y); UNITWRITE(PRINTER,N,1,0,12); IF N=3 THEN UNITWRITE(PRINTER,N,1,0,12); END; UNITWRITE(PRINTER,SEND,2,0,12); (* SEND[0..1] = NEW LINE OR CR *) Y:=Y+6; UNTIL Y>191; SEND[1]:=2; R=6; VAR SEND: PACKED ARRAY[0..3] OF 0..255; N,X,Y: INTEGER; BEGIN SEND[0]:=3; SEND[1]:=11; UNITWRITE(PRINTER,SEND,1,0,12); (* SEND[0] = CHANGE PRINTER TO GRAPHICS MODE *) Y:=0; REPEAT FOR X:= 0 TO (*$S+*) UNIT TIGER; INTRINSIC CODE 25; INTERFACE PROCEDURE PRINTHIRES; IMPLEMENTATION FUNCTION SCRNBYT(X,Y: INTEGER): INTEGER; EXTERNAL; PROCEDURE PRINTHIRES; (* DUMP HIRES GRAPHICS PAGE TO THE PAPER TIGER PRINTER *) CONST PRINTE @ADDR,Y AND #7F CLC AND MASK BEQ ISZERO SEC ; SWITCH THE CLC AND SEC ABOVE FOR NEGATIVE ISZERO ROR VALUE INC YCOORD DEC COUNT BNE LOOP LDA #0 PHA ;MSB OF RETURN VALUE=0 LDA VALUE LSR A PHA ;LSB OF RETURN LDA RETURN+1 ;RESTORE PASCAL RETURN ADDR PHA LDA RETURN PHA RTS SPROGRAM ETCH;   USES TURTLEGRAPHICS, APPLESTUFF;   (*$G+,C PASCAL ETCH-A-SKETCH BY ROGER SOLES*)   VAR "X,Y,DELAY: INTEGER;  PCOLOR: SCREENCOLOR; "  PROCEDURE COPYWRITE;   BEGIN  "PAGE(OUTPUT); "GOTOXY(10,7); "WRITELN('PASCAL ETCH-A-N^ " X MOD 7 = 1 --> -6 = FA ; ... ; X MOD 7 = 6 --> -1 = FF ; ; THUS THE TABLE ENTRY CORRESPONDING ; TO 0 IS TABLE+0 ; = TBL-0F9+0F9 ; OR LDA TABLE,X ; .END LDA TABLE,X STA MASK RTS ; ; TABLE OF MASK VALUES ; TBL .BYTE 081,082,084,088 .BYTE 090,0A0,0C0 TABLE .EQU TBL-0F9 ; CALCULATION FINDS (X-COORD MOD 7) -7 ; X MOD 7 = 0 --> -7 = F9 ; #0 ;IS TOP BYTE OF XCOORD=0? BEQ $01 ;YES LDY #023 ;NO, ADD 23 TO OFFSET ADC #04 ; AND ADD 4 TO XCOORD $02 INY $01 SBC #07 BCS $02 STY OFFSET TAX 2 84 ; 3 88 ; 4 90 ; 5 A0 ; 6 C0 ; TXA CPYCOORD<256 THEN ; OFFSET=XCOORD DIV 7 ; ELSE ; OFFSET=23 + (XCOORD+4) DIV 7 ; ; ALSO CALCULATE MASK ; XCOORD MOD 7 = 0 MASK=81 ; 1 82 ; ASL A ROL ADDR+1 ASL A ROR ADDR LDA ADDR+1 AND #01F ORA #020 NOP STA ADDR+1 ; ; CALCULATE OFFSET ; FORMULA IS ? ; IF XUB1 PHA AND #0C0 STA ADDR LSR A LSR A ORA ADDR STA ADDR PLA STA ADDR+1 ASL A ASL A ASL A ROL ADDR+1 SKETCH'); "GOTOXY(13,10); "WRITELN('BY ROGER SOLES');  FOR DELAY:=1 TO 5000 DO;   END;   PROCEDURE INSTRUCTIONS;   BEGIN  "PAGE(OUTPUT); "WRITELN('PASCAL ETCH-A-SKETCH -- BY ROGER SOLES'); WRITELN; WRITELN; "WRITELN('THIS PROGRAM WILL SIMULATE AN ETCH-A-'); "WRITELN('SKETCH.'); WRITELN; "WRITELN('TO CHANGE THE PCOLOR TYPE:'); "WRITELN(' N: NONE'); "WRITELN(' W: WHITE'); "WRITELN(' B: BLACK'); "WRITELN(' G: GREEN'); "WRITELN(' V: VIOLET'); "WRITELN(' O: ORANGE'); "WRITELN("PENCOLOR(NONE); "FOR I:=8 DOWNTO 1 DO $BEGIN &MOVETO(XMIN-15,I*15+20); &WCHAR(CHR(I+48)); &MOVETO(I*15+72,YMIN-15); &WCHAR(CHR(I+48)) $END "END; "PROCEDURE DRAWQUEEN(COL,ROW:COLROW); "BEGIN $PENCOLOR(NONE); $MOVETO(COL*15+70,ROW*15+24); $WCHN "FOR I:=1 TO 9 DO $BEGIN &PENCOLOR(NONE); &MOVETO(I*15+65,YMAX); &PENCOLOR(BLUE); &MOVETO(I*15+65,YMIN); $END; "FOR I:=9 DOWNTO 1 DO $BEGIN &PENCOLOR(NONE); &MOVETO(XMIN,I*15+20); &PENCOLOR(BLUE); &MOVETO(XMAX,I*15+20); $END; :DISPLAY:=TRUE; %'F':DISPLAY:=FALSE $END  END;  PROCEDURE WAIT(TIME:INTEGER);  VAR DELAY:INTEGER;  BEGIN "DELAY:=1; "REPEAT DELAY:=DELAY+1 UNTIL(DELAY>=TIME)OR KEYPRESS; "IF KEYPRESS THEN CHECKCHAR  END;  PROCEDURE BOARD;  VAR I:INTEGER;  BEGIN "TEXTMODE; "WRITELN(CHR(12)); "WRITELN; "WRITELN('SO LONG FOR NOW.....'); "EXIT(PROGRAM) "END;  PROCEDURE CHECKCHAR;  VAR CH:CHAR;  BEGIN "READ(KEYBOARD,CH); "IF CH=CHR(27)THEN GOODBYE; "CASE CH OF %'Q':QUIET:=TRUE; %'N':QUIET:=FALSE; %'S'PROGRAM EIGHTQUEENS;  USES TURTLEGRAPHICS,APPLESTUFF;  CONST XMAX=200; &YMAX=155; &XMIN=80; &YMIN=35; &N=8;  TYPE COLROW=1..N;  VAR I:COLROW; $B:ARRAY[COLROW]OF COLROW; $COUNT,L:INTEGER; $ATTACK,DISPLAY,QUIET:BOOLEAN;  PROCEDURE GOODBYE;  BEGIN^àIN (*MAIN PROGRAM*);  "COPYWRITE; "INSTRUCTIONS; "INITTURTLE; "PENCOLOR(NONE); "SKETCH; "PAGE(OUTPUT); "TEXTMODE; "  END.  ONE; $'W': PCOLOR:=WHITE; $'B': PCOLOR:=BLACK; $'G': PCOLOR:=GREEN; $'V': PCOLOR:=VIOLET; $'O': PCOLOR:=ORANGE; $'T': PCOLOR:=BLUE; $'F': FILLSCREEN(REVERSE); $'C': FILLSCREEN(BLACK); $'Q': EXIT(SKETCH); $ "END; "  GOTO 1;   END;   BEGL 1;   VAR  "CH: CHAR;  "  BEGIN   1:  "WHILE NOT KEYPRESS DO BEGIN $ $X:= PADDLE(0); $FOR DELAY:=1 TO 100 DO;  Y:= PADDLE(1); $PENCOLOR(PCOLOR); $MOVETO(X,Y); $CURSOR; $ "END; " "READ(CH); " "CASE CH OF " $'N': PCOLOR:=N  PROCEDURE CURSOR;   VAR "J,I: INTEGER; "  BEGIN  "FOR J:=0 TO 1 DO BEGIN " FOR I:=0 TO 3 DO BEGIN $ PENCOLOR(REVERSE); &TURN(90); $ MOVE(10); $ PENCOLOR(NONE); &MOVETO(X,Y); " END; "END;   END;   PROCEDURE SKETCH;   LABE' T: TURQUOISE'); "WRITELN; WRITELN(' F: FILLS THE SCREEN WITH REVERSE'); "WRITELN; WRITELN(' C: CLEARS THE SCREEN TO BLACK'); "WRITELN; WRITELN(' Q: QUIT, ENDS THE ETCH-A-SKETCH'); "WRITELN; WRITELN('HIT RETURN TO BEGIN'); "READLN; "  END;  AR(CHR(27)) "END; "PROCEDURE REMOVEQUEEN(COL,ROW:COLROW); "BEGIN $PENCOLOR(NONE); $MOVETO(COL*15+70,ROW*15+24); $WCHAR(' ') "END; "PROCEDURE SETUPGRAPHICS; "BEGIN $DISPLAY:=TRUE; $QUIET:=FALSE; $INITTURTLE; $FILLSCREEN(BLACK2); $BOARD; $PENCOLOR(NONE); $MOVETO(3,173); $WSTRING('EIGHT QUEENS PROBLEM'); $MOVETO(XMAX+14,135); $WSTRING('KEYS MENU'); $MOVETO(XMAX+14,127); $WSTRING('---------'); $MOVETO(XMAX+14,111); $WSTRING('ESC:EXIT'); $MOVETO(XMAX+14,95); $WSTRING('F:FAST'); $MOVETO(*WRITE('ENTER MONTH (1..12) --> '); *READLN(TEMP); *DATE.MONTH:=TEMP; *WRITE('ENTER YEAR (00..99) --> '); *READLN(TEMP); *DATE.YEAR:=TEMP; *FOR I:=1 TO 77 DO DIRX[I].DACCESS:=DATE; ( UNITWRITE(UNITNUM,DIRX[0],2048,2); (END (ELSE WRITELN('UNIT NO$PAGE(OUTPUT); $WRITE('ENTER UNIT --> '); $READLN(UNITNUM); $IF UNITNUM IN [4,5,9..12] $THEN BEGIN $ UNITREAD(UNITNUM,DIRX[0],2048,2); $ IF IORESULT=0 (THEN BEGIN $ WRITE('ENTER DAY (1..31) --> '); *READLN(TEMP); *DATE.DAY:=TEMP; RAF,FOTO: *(DTID:TID; *DLASTBYTE:1..512; *DACCESS:DATEREC) (END; (  DIRP=^DIRECTORY;  DIRECTORY=ARRAY[DIRRANGE] OF DIRENTRY;    VAR I,UNITNUM,TEMP:INTEGER; $BUFR:PACKED ARRAY[0..2048] OF CHAR; $DIRX:DIRECTORY;  DATE:DATEREC;   BEGIN TEXT, *INFO,DATA,GRAF,FOTO,SECUREDIR); *  DIRENTRY=RECORD (DFIRSTBLK:INTEGER; (DLASTBLK:INTEGER; (CASE DFKIND:FILEKIND OF )SECUREDIR,UNTYPED: )(DVID:VID; *DEOVBLK:INTEGER; *DLOADTIME:INTEGER; *DLASTBOOT:DATEREC); (XDISK,CODE,TEXT,INFO,DATA, (G PROGRAM DISKDATE;   (* DISK DIRECTORY ROUTINE *)  (* BY ROGER L. SOLES *)   TYPE   DATEREC=PACKED RECORD (MONTH:0..12; (DAY:0..31; (YEAR:0..100 &END; &  DIRRANGE=0..77;   VID=STRING[7];  TID=STRING[15];  FILEKIND=(UNTYPED,XDISK,CODE,N^"GIN *L:=L+1; *B[L]:=1 (END; $WHILE ATTACK AND(L>0)DO &BEGIN (REMOVEQUEEN(L,B[L]); $IF B[L]=N THEN L:=L-1 &ELSE (BEGIN *B[L]:=B[L]+1; *ATTACK:=FALSE (END #END !UNTIL ATTACK; !GOODBYE  END.  NOT ATTACK DO 'BEGIN )ATTACK:=(B[L]=B[I])OR(ABS(B[L]-B[I])=L-I); )I:=I+1 'END; $IF NOT ATTACK THEN 'IF L=N THEN *BEGIN ,COUNT:=COUNT+1; ,FILLSCREEN(REVERSE); ,IF DISPLAY THEN SHOWSOLUTIONS; ,FILLSCREEN(REVERSE); ,ATTACK:=TRUE *END 'ELSE (BE; "MOVETO(35,3); "WSTRING(' '); "VIEWPORT(XMIN,XMAX,YMIN,YMAX)  END;  BEGIN "COUNT:=0; "L:=1; "B[1]:=1; "ATTACK:=FALSE; "SETUPGRAPHICS; "REPEAT %IF KEYPRESS THEN CHECKCHAR; %I:=1; %DRAWQUEEN(L,B[L]); %WHILE(I9)THEN WCHAR(CHR(48+COUNT DIV 10)) ,ELSE WCHAR(' '); "WCHAR(CHR(48+COUNT MOD 10)); "WSTRING('IS'); "FOR I:=1 TO 9 DO $BEGIN &WCHAR(' '); &WCHAR(CHR(B[I]+48)); &IF NOT QUIET THEN NOTE(B[I]*6,70) $END; "WAIT(6500)XMAX+14,79); $WSTRING('S:SLOW'); $MOVETO(XMAX+14,63); $WSTRING('Q:QUIET'); $MOVETO(XMAX+14,47); $WSTRING('N:NOTES'); $VIEWPORT(XMIN,XMAX,YMIN,YMAX)  END;  PROCEDURE SHOWSOLUTIONS;  BEGIN "VIEWPORT(0,279,0,191); "PENCOLOR(NONE); "MOVETO(35,3); T ONLINE') $END $ELSE WRITELN('UNIT NOT BLK-DEVICE');  END.  !TESTMODE[ORIGINATE,THRHUND]:='ORIGINATE MODE, 300 BAUD';  DOTCOUNT:=0;   END;   PROCEDURE RESETMODEM;  BEGIN !PAGE(OUTPUT); !SKIPLINES(5); !WRITELN('RESETTING MODEM'); !WRITE('PLEASE WAIT... '); !MEMORY.ADDRS:=MODEM; !MEMORY.PNTR^[0]:=OFF;!WRITELN('FROM THE MICROCOUPLER.'); !WRITE(' TO CONTINUE-->');READLN; ' !TESTMODE[ANSWER,ONETEN]:='ANSWER MODE, 110 BAUD'; !TESTMODE[ORIGINATE,ONETEN]:='ORIGINATE MODE, 110 BAUD'; !TESTMODE[ANSWER,THRHUND]:='ANSWER MODE, 300 BAUD'; UNT+1; !IF DOTCOUNT MOD 4=0 "THEN WRITE('.');  END;   FUNCTION CARRIER:BOOLEAN;  BEGIN !MEMORY.ADDRS:=ACIA; !CARRIER:=MEMORY.PNTR^[0]<4;  END;   PROCEDURE INIT;  BEGIN !PAGE(OUTPUT);SKIPLINES(5); & !WRITELN('PLEASE DISCONNECT THE MODEM'); %CHANGE:BOOLEAN;  TESTMODE:ARRAY[ANSWER..ORIGINATE,ONETEN..THRHUND] OF STRING;  MEMORY:TWOFACE;  DOTCOUNT:INTEGER;    PROCEDURE CALL(LOC:INTEGER);  EXTERNAL;   PROCEDURE DOTTEDLINE(VAR DOTCOUNT:INTEGER);  BEGIN !DOTCOUNT:=DOTCO TYPE MODE=(ANSWER,ORIGINATE); %BAUDRATE=(ONETEN,THRHUND);   WORD=PACKED ARRAY[0..1] OF 0..255; % %TWOFACE=RECORD CASE BOOLEAN OF .TRUE:(ADDRS:INTEGER); .FALSE:(PNTR:^WORD); .END; .   VAR MD:MODE; %BR:BAUDRATE;  ERRORS:INTEGER; IOSTUFF;   CONST SLOT= 2; &BASE= -16327; &DATA= -16217; (*HEX $C089*) &ACIA= -16218; &MODEM= -16219;  OUTA= -15870; &CHAR=1912; &OFF= 8;  CLEAR= 3; &NORMAL= 21;  NOCARR= 4;  RCVFULL= 1; &TRNSEMPTY= 2;  BOARD. "  NOTE TO THE USER: YOU MAY OCCASIONAL-  LY FLAG AN ERROR SENDING CTRL-E AND  CNTRL-F CHARACTERS (ASCI 5 AND 6). I  HAVE AND DON'T KNOW WHY. " "BLAISE AWAY! " *DR. WO *  ***************************************)  PROGRAM MODTEST;  USES %WASHINGTON APPLE PI % %LAST UPDATE: APR 18 1980 %  PLEASE NOTE THE INCREASED READABILITY  OF THE MODULAR PASCAL PROGRAM COMPARED  TO THE BASIC PROGRAM APPEARING IN THE  MANUAL. "  THE PROGRAM ASSUMES THE MICROMODEM IS  IN SLOT 2 ON THE APPLE'S  (**************************************   PROGRAM MODEMTEST "  A PROGRAM TO TEST THE D.C.HAYES  MICROMODEM. MODELLED AFTER THE BASIC  PROGRAM WRITTEN BY D.F. HYDE AND  APPEARING IN THE MICROMODEM OWNER'S  MANUAL. " "WRITTEN BY " %TOM WOTEKI '^q !MEMORY.ADDRS:=ACIA; !MEMORY.PNTR^[0]:=CLEAR; !REPEAT DOTTEDLINE(DOTCOUNT) UNTIL NOT CARRIER;  SKIPLINES(5);  END;   PROCEDURE SETTEST(MD:MODE;BR:BAUDRATE);  VAR VAL:INTEGER;  BEGIN !WRITELN('SETTING TEST CONDITIONS FOR'); !WRITELN; !WRITELN(' ',TESTMODE[MD,BR]); !WRITELN; !WRITE('PLEASE WAIT... '); !MEMORY.ADDRS:=MODEM; !MEMORY.PNTR^[0]:=154+4*ORD(MD)+ORD(BR); !REPEAT DOTTEDLINE(DOTCOUNT) UNTIL CARRIER;  WRITELN;WRITELN;  END;(* SETTEST *) ! ! !  PROCEDURE TEST;  VAR COUNTEPROGRAM FILEPATCH;   (*************************************)  (* *)  (* A PROGRAM TO MODIFY ANY BYTE IN *)  (* ANY PASCAL FILE. *)  (* *)  (* WRITTEN BY PHIL WAYN^); %READLN; $END; !WRITELN('THAT''S ALL FOLKS!'); !  END. % "WRITELN; "WRITELN(NUMOFERRORS,' ERRORS FLAGGED'); !END;(* TEST *) ! ' ' '  BEGIN(*MAIN*)  ' "INIT; " "FOR MD:=ANSWER TO ORIGINATE DO #FOR BR:=ONETEN TO THRHUND DO $BEGIN %RESETMODEM; %SETTEST(MD,BR); %TEST; %WRITELN(' TO CONTINUE'S:=NUMOFERRORS+1; # END; #END; ! ! !BEGIN(*TEST*) " "INITIALIZE; " "REPEAT #IF RCVRREGFULL $THEN GETCHAR(NUMRCVD,NUMOFERRORS,NUMSENT) $ELSE IF TRANSREGEMPTY *THEN SENDCHAR(NUMSENT,COUNTER); "UNTIL COUNTER=128; " ! WRITELN; END; # # # #PROCEDURE GETCHAR(VAR NUMRCVD,NUMOFERRORS:INTEGER;NUMSENT:INTEGER); #BEGIN $MEMORY.ADDRS:=DATA; $NUMRCVD:=MEMORY.PNTR^[0]; $IF NUMSENT<>NUMRCVD $ THEN BEGIN +WRITELN; +WRITELN('ERROR: SENT= ',NUMSENT,' RECVD= ',NUMRCVD); +NUMOFERROR:=(NOT ODD(MEMORY.PNTR^[0]) AND (MEMORY.PNTR^[0]<>0)); #END; # #PROCEDURE SENDCHAR(VAR NUMSENT,COUNTER:INTEGER); #BEGIN $MEMORY.ADDRS:=DATA; $MEMORY.PNTR^[0]:=COUNTER; $CALL(OUTA); $NUMSENT:=COUNTER; $COUNTER:=COUNTER+1; $DOTTEDLINE(DOTCOUNT); #$MEMORY.PNTR^[0]:=NORMAL; $ $WRITELN('BEGIN TEST...'); #END; # #FUNCTION RCVRREGFULL:BOOLEAN; #BEGIN $MEMORY.ADDRS:=ACIA; $RCVRREGFULL:=ODD(MEMORY.PNTR^[0]); #END; # #FUNCTION TRANSREGEMPTY:BOOLEAN; #BEGIN $MEMORY.ADDRS:=ACIA; $TRANSREGEMPTYR,NUMSENT,NUMRCVD,NUMOFERRORS:INTEGER;  #PROCEDURE INITIALIZE; #BEGIN $NUMOFERRORS:=0; $NUMSENT:=0; $NUMRCVD:=0; $COUNTER:=0; $ $MEMORY.ADDRS:=DATA; $MEMORY.PNTR^[0]:=0; $MEMORY.PNTR^[1]:=0; $ $MEMORY.ADDRS:=ACIA; $MEMORY.PNTR^[0]:=CLEAR; NE AND PUB- *)  (* LISHED IN ISSUE #5, JAN 1980 OF: *)  (* *)  (* THE APPLE SHOPPE *)  (* *)  (* P.O. BOX 701 *)  (* PLACENTIA, CA. *)  (* 92670 *)  (* *)  (* TRANSCRIBED BY TOM WOTEKI,WASH- *)  (* INGTON APPLE-PI *)  (* *)  (***************************** (**************************************  !PROGRAM CHECKBOOK;   A PROGRAM TO COLLECT INFORMATION ABOUT  YOUR CHECKBOOK SPENDING HABITS. RUN  THE PROGRAM EACH TIME YOU RECEIVE A  CHECKING ACCOUNT STATEMENT.   THE PROGRAM ASKS YOU TO ENTER YOUN^ĠCK'); # #CLOSE(FIL); "UNTIL NOT YORN('ANOTHER FILE?'); !END.  %UNTIL CH IN ['Y','N',' ']; % %IF CH IN ['Y',' '] &THEN BEGIN ,WRITE('CHANGE TO (HEX): '); ,READLN(STR); ,BUF[DISP]:=HEXV(STR); +END; % %WRITELN; $UNTIL NOT YORN('ANOTHER BYTE'); $ $I:=BLOCKWRITE(FIL,BUF,1,BLOCK); #UNTIL NOT YORN('ANOTHER BLOE('BYTE DISP (HEX): '); %READLN(STR); %IF LENGTH(STR)=0 &THEN DISP:=DISP+1 &ELSE DISP:=HEXV(STR); %WRITE('BYTE IS '); %PRX(BUF[DISP]); %WRITELN; % %REPEAT (* GET Y OR N *) &WRITE('O.K. TO CHANGE? (Y/N) '); &READ(CH); &WRITELN; &UNITCLEAR(1); N(CHR(7)); #WRITE('FILENAME: '); #READLN(FN); #RESET(FIL,FN); # #REPEAT (* MODIFYING A BLOCK *) $WRITELN(CHR(7)); $WRITE('BLOCK (DECIMAL): '); $READLN(BLOCK); $I:=BLOCKREAD(FIL,BUF,1,BLOCK); $ $REPEAT (* MODIFY BYTES *) %WRITELN(CHR(7)); %WRITS[I] THEN V:=16*V+J; "HEXV:=V; !END; ! !PROCEDURE PRX(I:INTEGER); !BEGIN "IF I<16 " THEN WRITE(HEXD[I]) #ELSE BEGIN )PRX(I DIV 16); )WRITE(HEXD[I MOD 16]); (END; !END;  !BEGIN "HEXD:='0123456789ABCDEF'; "REPEAT (* PER FILE NAME *) #WRITEL#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]=********)   VAR BUF:PACKED ARRAY[0..511] OF 0..255; $FN,STR:STRING; $FIL:FILE; $BLOCK,DISP,VAL,I,J:INTEGER; $HEXD:PACKED ARRAY[0..15] OF CHAR; $CH:CHAR; $ !FUNCTION YORN(M:STRING):BOOLEAN; !VAR CH:CHAR; !BEGIN "REPEAT #WRITELN(CHR(7)); R  CHECKS WHILE IT SORTS THE ENTRIES BY  NUMBER. AFTER ALL CHECKS HAVE BEEN  ENTERED IT LISTS THE ENTRIES AND ASKS  FOR CORRECTIONS INCLUDING ADDITIONS.  WHEN YOU ARE FINALLY SATISFIED WITH  THE ENTRIES IT THEN ASKS FOR THE  DEPOSITS YOU MADE. FOLLOWING THIS IT  SUMMARIZES YOUR CASHFLOW, SHOOTS THE  SUMMARY TO THE SCREEN AND THEN TO  DISK.   HOWEVER... BEFORE ASKING FOR CHECKS  THE PROGRAM ASKS FOR THE NAME OF YOUR  CHECKBOOK. IT EXPECTS TO FIND IT ON A  DSIK CALLLED < CKBOOK: >.$THEN BEGIN *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) 2ELSE EXNUE-->'); "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 TO 9 DO %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 CONTI %END; $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%IOERROR:BOOLEAN; %YEAR: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);DIGITS:=['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; RYES:BOOLEAN;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; ":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 ANSWE&CHARSET=SET OF CHAR; & (  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,FYEAR,FMEMOCODE,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; & ER] OF CHECKMEMO; & &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*************)  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[CODENUMB DRIVE PLEASE MAKE SURE THE CODE AND  YOUR CHECKBOOK DISK FILE ARE BOTH ON  THE DISK NAMED CKBOOK:.   WRITTEN BY ! $TOM WOTEKI $WASHINGTON APPLE PI $ $LAST UPDATE: APRIL 18 1980    BLAISE AWAY! ! %DR. WO    ************************ IF IT CAN'T  FIND IT IT WILL ASK YOU TO INTIALIZE  A CHECKBOOK FILE. IF FOR SOME REASON  INITILIZATION FAILS THE PROGRAM  EXECUTES AN ORDERLY ABORT.   THE PROGRAM USES SEGMENTED PROCEDURES.  THEREFORE, IF YOU HAVE ONLY ONE DISK IT(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:=GETNUMBER(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 " "X[1]:=.WRITE('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); ,REAS.'); ! 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 CHECKS(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 CHECK2; !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 READING$ 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 HECK 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.'); 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 OF $FNUM: WRITE('ENTER C  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;  BEGIN  !(*$I-*) !REPEAT 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; '; "X[34]:=' CLOTHING '; "X[36]:=' '; "X[37]:=' '; "X[38]:=' '; "X[39]:=' '; "X[40]:=' CASH UNKNOWN '; !END; "   BEGIN !PARTONE; !PARTTWO; !GETBOOK; !GETYEAR; !PARTTHR; "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[33]:=' FURNISHINGS C '; "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]:=' JOURNALS, DUES '; "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[19]:=' BOOKS,NEWS,ET' 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 '; DLN(AMOUNT); ,WRITELN; ,WRITELN('ENTER THE EXPENDITURE CODE.'); ,WRITELN('ENTER 0 IF YOU WISH'); ,WRITE('TO REVIEW THE CODES-->'); ,CODE:=GETNUMBER(0,MAXCODE,FMEMOCODE); ,IF CODE=0 -THEN SHOWCODES(CODE); ,MEMO:=MEMOLIST[CODE]; ,COUNT:=COUNT+1; ,TOTAL:=TOTAL+AMOUNT; +END;  END;  END;(* READINGCHECKS *) %  PROCEDURE SORTBYNUMBER(NEWCHECK:CHECK;VAR FIRST:CHECKPOINTER);  VAR LEADER,FOLLOWER,NEWENTRY:CHECKPOINTER;  SEARCHING:BOOLEAN;   BEGIN ! !LEADER:=FIRST;SEARCHING:=TRUE; .FILTERINPUT(DIGITS); .READLN(AMOUNT); .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'IF FIXFIELD('DATE') (THEN 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; 'FIXFIELD:=FALSE; 'WRITE('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); TOBADCHECK:CHECKPOINTER; $ $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 PROCEDURE CORRECTERRORS(VAR FIRSTERROR:ERRORLINK;VAR FIRSTCHECK:CHECKPOINTER; 7VAR CHECKCOUNT:SERIALNUMBER;VAR TOTAL:REAL);  VAR NEXTERROR:ERRORLINK; $STARTCHK,NEXTCHK:CHECKPOINTER; $CHECKNOTFOUND,DONESHOWING:BOOLEAN; $BADNUMBER:SERIALNUMBER; $POIN; $UNTIL INPUT^=ESC; #END(* FLAGBYNUMBER *); $  BEGIN(* FLAGERRORS *) !SKIPLINES(2); !WRITELN('ANY CORRECTIONS'); !WRITE('TO THIS LIST? (Y/N)-->'); !IF ANSWERYES "THEN FLAGBYNUMBER;  END;   THEN BEGIN -READLN(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); ,ENDN %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 '#UNTIL ((COUNTER=LISTLENGTH) OR (LISTHEAD=NIL)); #DONELISTING:=LISTHEAD=NIL; "END; " !  PROCEDURE FLAGERRORS(VAR ERRORSNOTED:BOOLEAN;VAR FIRSTERROR:ERRORLINK); " $PROCEDURE FLAGBYNUMBER; $VAR NEWERROR:ERRORLINK; $ NEWNUM:SERIALNUMBER; $BEGITELN('----------------------------------------'); # #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; :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'); #WRIRORLINK=^ERRORLIST; %ERRORLIST=RECORD 0NUMBER:SERIALNUMBER; 0NEXTNUM:ERRORLINK; 0END; 0  VAR LISTHEAD:CHECKPOINTER;  FIRSTERROR:ERRORLINK; $ERRORSNOTED,DONELISTING:BOOLEAN;  "PROCEDURE LISTSOMECHECKS(VAR LISTHEAD:CHECKPOINTER;VAR DONELISTING#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);  TYPE ER WHILE SEARCHING AND (LEADER<>NIL) DO " "WITH LEADER^ DO #IF NEWCHECK.NUMBER'); 'IF ANSWERYES )THEN BEGIN /CHECKCOUNT:=CHECKCOUNT-1; /IF X=FIRST 1THEN 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(!SEEK(F,(THISYEAR-BASEYR)); !GET(F); !FOR 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:FL NEXT=NIL;  WRITELN;  END; !  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')); ISMONTH,0]:=DEPOSITS; !NEXT:=FIRST; !REPEAT "WITH NEXT^.CHECKPART DO $WITH DATE DO %BEGIN &MM:=MONTH; &IF YEAR'); !UNTIL ANSWERYES;  DOLLARS:=X;  END;   PROCEDURE BUILDCASHFLOW(VAR X:FLOWMATRIX;FIRST:CHECKPOINTER;DEPOSITS:REAL);  VAR NEXT:CHECKPOINTER;  MM:INTEGER;  BEGIN !WRITELN('PLEASE WAIT FOR CASHFLOW MATRIX.'); !X[TH BEGIN !REPEAT; "PAGE(OUTPUT); "SKIPLINES(5); "WRITELN(BELL,'ENTER THE TOTAL DEPOSITS'); "WRITE('FOR THIS STATEMENT......'); "FILTERINPUT(DIGITS); "READLN(X);WRITELN; "WRITELN('PLEASE CONFIRM-->'); "WRITELN; "WRITELN(' DEPOSITS= ',X:10:2); "ISTSOMECHECKS(LISTHEAD,DONELISTING); #FLAGERRORS(ERRORSNOTED,FIRSTERROR); "UNTIL DONELISTING; "IF ERRORSNOTED #THEN CORRECTERRORS(FIRSTERROR,FIRSTCHECK,CHECKCOUNT,TOTAL); !UNTIL NOT ERRORSNOTED;  END;    FUNCTION DOLLARS:REAL;  VAR X:REAL; CHECK(BADNUMBER,FIRSTCHECK,CHECKCOUNT,TOTAL) #ELSE GETCORRECTIONS(POINTOBADCHECK,FIRSTCHECK,CHECKCOUNT,TOTAL); !UNTIL DONESHOWING;  END;    BEGIN(*REVIEWCHECKS*) !REPEAT "LISTHEAD:=FIRSTCHECK; "ERRORSNOTED:=FALSE; "FIRSTERROR:=NIL; "REPEAT #LEWCHECK,CHECKCOUNT,TOTAL); +SORTBYNUMBER(NEWCHECK,FIRSTCHECK); *END; #END;   BEGIN(* CORRECTERRORS *) !NEXTERROR:=FIRSTERROR; !REPEAT "SHOWABADCHECK(NEXTERROR,CHECKNOTFOUND,POINTOBADCHECK,DONESHOWING,BADNUMBER); "IF CHECKNOTFOUND #THEN ASKFORNEW#VAR SEARCHING:BOOLEAN; # NEWCHECK:CHECK; #BEGIN $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(N UNTIL (NOT CHECKNOTFOUND) OR (NEXTCHECK=NIL); !NEXTERROR:=NEXTERROR^.NEXTNUM;  DONESHOWING:=NEXTERROR=NIL;  END;  , #PROCEDURE ASKFORNEWCHECK(NUMBER:SERIALNUMBER;VAR FIRSTCHECK:CHECKPOINTER; '); &IF ANSWERYES 'THEN DELETE(BADCHECK,FIRSTCHECK,CHECKCOUNT,TOTAL) LOWMATRIX);  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; ! !FOR 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); '^qT ONLINE') $END $ELSE WRITELN('UNIT NOT BLK-DEVICE');  END.  *WRITE('ENTER MONTH (1..12) --> '); *READLN(TEMP); *DATE.MONTH:=TEMP; *WRITE('ENTER YEAR (00..99) --> '); *READLN(TEMP); *DATE.YEAR:=TEMP; *FOR I:=1 TO 77 DO DIRX[I].DACCESS:=DATE; ( UNITWRITE(UNITNUM,DIRX[0],2048,2); (END (ELSE WRITELN('UNIT NO$PAGE(OUTPUT); $WRITE('ENTER UNIT --> '); $READLN(UNITNUM); $IF UNITNUM IN [4,5,9..12] $THEN BEGIN $ UNITREAD(UNITNUM,DIRX[0],2048,2); $ IF IORESULT=0 (THEN BEGIN $ WRITE('ENTER DAY (1..31) --> '); *READLN(TEMP); *DATE.DAY:=TEMP; RAF,FOTO: *(DTID:TID; *DLASTBYTE:1..512; *DACCESS:DATEREC) (END; (  DIRP=^DIRECTORY;  DIRECTORY=ARRAY[DIRRANGE] OF DIRENTRY;    VAR I,UNITNUM,TEMP:INTEGER; $BUFR:PACKED ARRAY[0..2048] OF CHAR; $DIRX:DIRECTORY;  DATE:DATEREC;   BEGIN !END.  TCHECK); # #REVIEWCHECKS(FIRSTCHECK,CHECKCOUNT,TOTAL); !  #DEPOSITS:=DOLLARS; # #BUILDCASHFLOW(CASHFLOW,FIRSTCHECK,DEPOSITS); #DISPLAYFLOW(CASHFLOW); #UPDATEFLOWFILE(CASHFLOW,NAMEOFBOOK); ! #WRITELN; #WRITELN(BELL,BELL,'THAT''S ALL FOLKS');!WRITE(' SPLITS, CONTINUES'); !READLN;  END;    BEGIN(* MAIN *)  #GLOBALINITITIALIZE(NAMEOFBOOK,MEMOLIST, 6FIRSTCHECK,CHECKCOUNT,TOTAL,CASHFLOW); # #WHILE READINGCHECKS(NEWCHECK,CHECKCOUNT,TOTAL) $DO SORTBYNUMBERK(NEWCHECK,FIRS! !K:=MAXCODE 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);  (**************************************   PROGRAM MODEMTEST "  A PROGRAM TO TEST THE D.C.HAYES  MICROMODEM. MODELLED AFTER THE BASIC  PROGRAM WRITTEN BY D.F. HYDE AND  APPEARING IN THE MICROMODEM OWNER'S  MANUAL. " "WRITTEN BY " %TOM WOTEKI END; # # # #PROCEDURE GETCHAR(VAR NUMRCVD,NUMOFERRORS:INTEGER;NUMSENT:INTEGER); #BEGIN $MEMORY.ADDRS:=DATA; $NUMRCVD:=MEMORY.PNTR^[0]; $IF NUMSENT<>NUMRCVD $ THEN BEGIN +WRITELN; +WRITELN('ERROR: SENT= ',NUMSENT,' RECVD= ',NUMRCVD); +NUMOFERROR:=(NOT ODD(MEMORY.PNTR^[0]) AND (MEMORY.PNTR^[0]<>0)); #END; # #PROCEDURE SENDCHAR(VAR NUMSENT,COUNTER:INTEGER); #BEGIN $MEMORY.ADDRS:=DATA; $MEMORY.PNTR^[0]:=COUNTER; $CALL(OUTA); $NUMSENT:=COUNTER; $COUNTER:=COUNTER+1; $DOTTEDLINE(DOTCOUNT); #$MEMORY.PNTR^[0]:=NORMAL; $ $WRITELN('BEGIN TEST...'); #END; # #FUNCTION RCVRREGFULL:BOOLEAN; #BEGIN $MEMORY.ADDRS:=ACIA; $RCVRREGFULL:=ODD(MEMORY.PNTR^[0]); #END; # #FUNCTION TRANSREGEMPTY:BOOLEAN; #BEGIN $MEMORY.ADDRS:=ACIA; $TRANSREGEMPTYR,NUMSENT,NUMRCVD,NUMOFERRORS:INTEGER;  #PROCEDURE INITIALIZE; #BEGIN $NUMOFERRORS:=0; $NUMSENT:=0; $NUMRCVD:=0; $COUNTER:=0; $ $MEMORY.ADDRS:=DATA; $MEMORY.PNTR^[0]:=0; $MEMORY.PNTR^[1]:=0; $ $MEMORY.ADDRS:=ACIA; $MEMORY.PNTR^[0]:=CLEAR; (' ',TESTMODE[MD,BR]); !WRITELN; !WRITE('PLEASE WAIT... '); !MEMORY.ADDRS:=MODEM; !MEMORY.PNTR^[0]:=154+4*ORD(MD)+ORD(BR); !REPEAT DOTTEDLINE(DOTCOUNT) UNTIL CARRIER;  WRITELN;WRITELN;  END;(* SETTEST *) ! ! !  PROCEDURE TEST;  VAR COUNTE !MEMORY.ADDRS:=ACIA; !MEMORY.PNTR^[0]:=CLEAR; !REPEAT DOTTEDLINE(DOTCOUNT) UNTIL NOT CARRIER;  SKIPLINES(5);  END;   PROCEDURE SETTEST(MD:MODE;BR:BAUDRATE);  VAR VAL:INTEGER;  BEGIN !WRITELN('SETTING TEST CONDITIONS FOR'); !WRITELN; !WRITELN!TESTMODE[ORIGINATE,THRHUND]:='ORIGINATE MODE, 300 BAUD';  DOTCOUNT:=0;   END;   PROCEDURE RESETMODEM;  BEGIN !PAGE(OUTPUT); !SKIPLINES(5); !WRITELN('RESETTING MODEM'); !WRITE('PLEASE WAIT... '); !MEMORY.ADDRS:=MODEM; !MEMORY.PNTR^[0]:=OFF;!WRITELN('FROM THE MICROCOUPLER.'); !WRITE(' TO CONTINUE-->');READLN; ' !TESTMODE[ANSWER,ONETEN]:='ANSWER MODE, 110 BAUD'; !TESTMODE[ORIGINATE,ONETEN]:='ORIGINATE MODE, 110 BAUD'; !TESTMODE[ANSWER,THRHUND]:='ANSWER MODE, 300 BAUD'; UNT+1; !IF DOTCOUNT MOD 4=0 "THEN WRITE('.');  END;   FUNCTION CARRIER:BOOLEAN;  BEGIN !MEMORY.ADDRS:=ACIA; !CARRIER:=MEMORY.PNTR^[0]<4;  END;   PROCEDURE INIT;  BEGIN !PAGE(OUTPUT);SKIPLINES(5); & !WRITELN('PLEASE DISCONNECT THE MODEM'); %CHANGE:BOOLEAN;  TESTMODE:ARRAY[ANSWER..ORIGINATE,ONETEN..THRHUND] OF STRING;  MEMORY:TWOFACE;  DOTCOUNT:INTEGER;    PROCEDURE CALL(LOC:INTEGER);  EXTERNAL;   PROCEDURE DOTTEDLINE(VAR DOTCOUNT:INTEGER);  BEGIN !DOTCOUNT:=DOTCO TYPE MODE=(ANSWER,ORIGINATE); %BAUDRATE=(ONETEN,THRHUND);   WORD=PACKED ARRAY[0..1] OF 0..255; % %TWOFACE=RECORD CASE BOOLEAN OF .TRUE:(ADDRS:INTEGER); .FALSE:(PNTR:^WORD); .END; .   VAR MD:MODE; %BR:BAUDRATE;  ERRORS:INTEGER; IOSTUFF;   CONST SLOT= 2; &BASE= -16327; &DATA= -16217; (*HEX $C089*) &ACIA= -16218; &MODEM= -16219;  OUTA= -15870; &CHAR=1912; &OFF= 8;  CLEAR= 3; &NORMAL= 21;  NOCARR= 4;  RCVFULL= 1; &TRNSEMPTY= 2;  BOARD. "  NOTE TO THE USER: YOU MAY OCCASIONAL-  LY FLAG AN ERROR SENDING CTRL-E AND  CNTRL-F CHARACTERS (ASCI 5 AND 6). I  HAVE AND DON'T KNOW WHY. " "BLAISE AWAY! " *DR. WO *  ***************************************)  PROGRAM MODTEST;  USES %WASHINGTON APPLE PI % %LAST UPDATE: APR 18 1980 %  PLEASE NOTE THE INCREASED READABILITY  OF THE MODULAR PASCAL PROGRAM COMPARED  TO THE BASIC PROGRAM APPEARING IN THE  MANUAL. "  THE PROGRAM ASSUMES THE MICROMODEM IS  IN SLOT 2 ON THE APPLE'S S:=NUMOFERRORS+1; # END; #END; ! ! !BEGIN(*TEST*) " "INITIALIZE; " "REPEAT #IF RCVRREGFULL $THEN GETCHAR(NUMRCVD,NUMOFERRORS,NUMSENT) $ELSE IF TRANSREGEMPTY *THEN SENDCHAR(NUMSENT,COUNTER); "UNTIL COUNTER=128; " ! WRITELN; "WRITELN; "WRITELN(NUMOFERRORS,' ERRORS FLAGGED'); !END;(* TEST *) ! ' ' '  BEGIN(*MAIN*)  ' "INIT; " "FOR MD:=ANSWER TO ORIGINATE DO #FOR BR:=ONETEN TO THRHUND DO $BEGIN %RESETMODEM; %SETTEST(MD,BR); %TEST; %WRITELN(' TO CONTINUE'N(CHR(7)); #WRITE('FILENAME: '); #READLN(FN); #RESET(FIL,FN); # #REPEAT (* MODIFYING A BLOCK *) $WRITELN(CHR(7)); $WRITE('BLOCK (DECIMAL): '); $READLN(BLOCK); $I:=BLOCKREAD(FIL,BUF,1,BLOCK); $ $REPEAT (* MODIFY BYTES *) %WRITELN(CHR(7)); %WRITS[I] THEN V:=16*V+J; "HEXV:=V; !END; ! !PROCEDURE PRX(I:INTEGER); !BEGIN "IF I<16 " THEN WRITE(HEXD[I]) #ELSE BEGIN )PRX(I DIV 16); )WRITE(HEXD[I MOD 16]); (END; !END;  !BEGIN "HEXD:='0123456789ABCDEF'; "REPEAT (* PER FILE NAME *) #WRITEL#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]=********)   VAR BUF:PACKED ARRAY[0..511] OF 0..255; $FN,STR:STRING; $FIL:FILE; $BLOCK,DISP,VAL,I,J:INTEGER; $HEXD:PACKED ARRAY[0..15] OF CHAR; $CH:CHAR; $ !FUNCTION YORN(M:STRING):BOOLEAN; !VAR CH:CHAR; !BEGIN "REPEAT #WRITELN(CHR(7)); *)  (* 92670 *)  (* *)  (* TRANSCRIBED BY TOM WOTEKI,WASH- *)  (* INGTON APPLE-PI *)  (* *)  (*****************************NE AND PUB- *)  (* LISHED IN ISSUE #5, JAN 1980 OF: *)  (* *)  (* THE APPLE SHOPPE *)  (* *)  (* P.O. BOX 701 *)  (* PLACENTIA, CA. PROGRAM FILEPATCH;   (*************************************)  (* *)  (* A PROGRAM TO MODIFY ANY BYTE IN *)  (* ANY PASCAL FILE. *)  (* *)  (* WRITTEN BY PHIL WAYN^); %READLN; $END; !WRITELN('THAT''S ALL FOLKS!'); !  END. % E('BYTE DISP (HEX): '); %READLN(STR); %IF LENGTH(STR)=0 &THEN DISP:=DISP+1 &ELSE DISP:=HEXV(STR); %WRITE('BYTE IS '); %PRX(BUF[DISP]); %WRITELN; % %REPEAT (* GET Y OR N *) &WRITE('O.K. TO CHANGE? (Y/N) '); &READ(CH); &WRITELN; &UNITCLEAR(1); %UNTIL CH IN ['Y','N',' ']; % %IF CH IN ['Y',' '] &THEN BEGIN ,WRITE('CHANGE TO (HEX): '); ,READLN(STR); ,BUF[DISP]:=HEXV(STR); +END; % %WRITELN; $UNTIL NOT YORN('ANOTHER BYTE'); $ $I:=BLOCKWRITE(FIL,BUF,1,BLOCK); #UNTIL NOT YORN('ANOTHER BLOER] OF CHECKMEMO; & &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*************)  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[CODENUMB DRIVE PLEASE MAKE SURE THE CODE AND  YOUR CHECKBOOK DISK FILE ARE BOTH ON  THE DISK NAMED CKBOOK:.   WRITTEN BY ! $TOM WOTEKI $WASHINGTON APPLE PI $ $LAST UPDATE: APRIL 18 1980    BLAISE AWAY! ! %DR. WO    ************************ IF IT CAN'T  FIND IT IT WILL ASK YOU TO INTIALIZE  A CHECKBOOK FILE. IF FOR SOME REASON  INITILIZATION FAILS THE PROGRAM  EXECUTES AN ORDERLY ABORT.   THE PROGRAM USES SEGMENTED PROCEDURES.  THEREFORE, IF YOU HAVE ONLY ONE DISK FOLLOWING THIS IT  SUMMARIZES YOUR CASHFLOW, SHOOTS THE  SUMMARY TO THE SCREEN AND THEN TO  DISK.   HOWEVER... BEFORE ASKING FOR CHECKS  THE PROGRAM ASKS FOR THE NAME OF YOUR  CHECKBOOK. IT EXPECTS TO FIND IT ON A  DSIK CALLLED < CKBOOK: >.R  CHECKS WHILE IT SORTS THE ENTRIES BY  NUMBER. AFTER ALL CHECKS HAVE BEEN  ENTERED IT LISTS THE ENTRIES AND ASKS  FOR CORRECTIONS INCLUDING ADDITIONS.  WHEN YOU ARE FINALLY SATISFIED WITH  THE ENTRIES IT THEN ASKS FOR THE  DEPOSITS YOU MADE. (**************************************  !PROGRAM CHECKBOOK;   A PROGRAM TO COLLECT INFORMATION ABOUT  YOUR CHECKBOOK SPENDING HABITS. RUN  THE PROGRAM EACH TIME YOU RECEIVE A  CHECKING ACCOUNT STATEMENT.   THE PROGRAM ASKS YOU TO ENTER YOUN^ĠCK'); # #CLOSE(FIL); "UNTIL NOT YORN('ANOTHER FILE?'); !END.  ,FYEAR,FMEMOCODE,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; & (  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"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[33]:=' FURNISHINGS C '; "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]:=' JOURNALS, DUES '; "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[19]:=' BOOKS,NEWS,ET' 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 '; 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 " "X[1]:=IT(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:=GETNUMBER($THEN BEGIN *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) 2ELSE EXNUE-->'); "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 TO 9 DO %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 CONTI %END; $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%IOERROR:BOOLEAN; %YEAR: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);DIGITS:=['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; RYES:BOOLEAN;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; ":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);