`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JN^jjEXT{[DOM-NOTES.TEXT{[[zCAT.CODEr F[MAKELESSON.TEXTʢMAKELESSON.CODEʢHOWTOUSEIT.TEXTʢ FRENCH20.TEXTvg MORSE.CODE=vg MORSE.TEXT=vgDOM-NOTES.TEXT{[DOM-NOTES.TEXT{[DOM-NOTES.TPSCAL26ڢ MAKEMENU.TEXT^ojCENTERDEMO.TEXT+$ARROWSMITH.TEXT$*FORMATTER2.TEXT٢*0STEPLOOPS2.TEXTH06CHARCOUNT.TEXToJ6BFLASHCARD5.TEXTڢBX XREF1.TEXT=vgFXzCAT.TEXTtM{&꽌ɪɖ'*&%&,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 MAKEMENU;   (*COPIED FROM CREATIVE COMPUTING-NOV.81 FROM AN ARTICLE BY*)  (*AL EVANS,'SIDE BY SIDE:PASCAL AND BASIC' *)   CONST #PAGESIZE = 20; #MAXCHAR = 36; #  TYPE #TEXTPAGE = ARRAY[1..PAGESIZE] OF STRING; #  VAR #N^++WRITELN; &WRITELN  ('PRESS "C" TO CONTINUE;OTHER KEY TO QUIT'); &READ (KEYBOARD,CH) #UNTIL (CH<>'C'); #WRITELN ('THE END.':24)  END. # &UNTIL (CH=CHR(32)) (* OR *)  END; (*SELECT*)   BEGIN (*MAIN*) #FORMAT (MENU); #REPEAT &INDEX := 1; &SELECT (MENU,MENUITEMS,INDEX); &PAGE (OUTPUT); &GOTOXY (0,8); &WRITELN ('ITEM SELECTED WAS '); &WRITELN; &WRITELN (MENU[INDEX]); &+ 1; .IF (POINTER>ITEMS) THEN 0POINTER := POINTER - ITEMS +END; # IF (CH=CHR(8)) (*LEFT ARROW*) THEN +BEGIN .POINTER := POINTER - 1; .IF (POINTER<1) THEN 0POINTER := POINTER + ITEMS +END; )MARKITEM (POINTER,OLDPOINTER); )READ (KEYBOARD,CH) #END; (*MARKITEM*) #  BEGIN (*SELECT*) #TOP := (24-ITEMS) DIV 2; #DISPLAY; #MARKITEM (POINTER,POINTER); #READ (KEYBOARD,CH); #IF (CH<>CHR(32)) THEN &REPEAT )OLDPOINTER := POINTER; )IF (CH=CHR(21)) (*RT ARROW*) THEN +BEGIN .POINTER := POINTER :INTEGER); #CONST &LEFT = 0; &RIGHT= 38; #BEGIN &GOTOXY(LEFT,TOP-1+OLDINDEX); &WRITE (' '); &GOTOXY (RIGHT,TOP-1+OLDINDEX); &WRITE (' '); &GOTOXY (LEFT,TOP-1+INDEX); &WRITE ('=>'); &GOTOXY (RIGHT,TOP-1+INDEX); &WRITE ('<=') INTEGER; #BEGIN &PAGE (OUTPUT); &WRITELN  ('USE ARROWS TO LOCATE MENU ITEM WANTED.'); &WRITELN ((' OR TO SELECT':32); &GOTOXY (0,TOP); &FOR I := 1 TO ITEMS DO )WRITELN (TEXT[I]) #END; (*DISPLAY*) # #PROCEDURE MARKITEM(INDEX,OLDINDEXCTERS,PLEASE') )UNTIL (LENGTH(TEXT[I])=1) AND (MENUITEMS<=PAGESIZE); #WRITELN; #WRITELN ('ENTER EACH LINE OF MENU'); #FOR I := 1 TO MENUITEMS DO &BEGIN )REPEAT ,WRITE (I,'.'); ,READLN (TEXT[I]); ,IF (LENGTH(TEXT[I])>MAXCHAR) THEN .WRITELN ('MAXIMUM ',MAXCHAR,' CHARAR); #WRITELN  ('CHARACTERS EACH'); #WRITELN; #REPEAT &WRITE ('ENTER NUMBER OF MENU LINES: '); &READLN (MENUITEMS); &IF (MENUITEMS<1) OR (MENUITEMS>PAGESIZE) THEN )WRITELN ('BETWEEN 1 AND ',PAGESIZE, 'PLEASE') )S := CONCAT (SPACE,S) #END; (*CENTER*)   BEGIN (*FORMAT*) #PAGE (OUTPUT); #WRITELN ('***FORMAT A MENU***':29); #WRITELN;WRITELN  (' THIS PROGRAM WILL PRODUCE A MENU'); #WRITELN;WRITELN  ('YOU MAY USE UP TO ',PAGESIZE,' LINES OF UP TO ',MAXCHAMENUITEMS, INDEX : INTEGER; #MENU : TEXTPAGE; #CH : CHAR;   PROCEDURE FORMAT (VAR TEXT:TEXTPAGE);  VAR #I : INTEGER; # #PROCEDURE CENTER (VAR S:STRING); #CONST &SPACE = ' '; #VAR &I : INTEGER; #BEGIN &FOR I := 0 TO (38-LENGTH(S)) DIV 2 DO PROGRAM CENTERDEMO;   (*EXTRACTED AND MODIFIED FROM "SIDE BY SIDE:BASIC AND PASCAL"*)  (*ARTICLE BY AL EVANS,CREATIVE COMPUTING-NOV.81.ARTICLE COPY-*)  (*RIGHT BY CREATIVE COMPUTING,39 E.HANOVER AVE.MORRIS PLAINS,*)  (*NJ 07950.SAMPLE ISSUE $2.50,12-S; $DECISIONS = ARRAY[SUBSCRIPT] OF BOOLEAN; $THESAURUS = RECORD 2Q : PACKED ARRAY[SUBSCRIPT] OF STRING[25]; 2A : PACKED ARRAY[SUBSCRIPT,CHOICES] OF STRING[25]; 2D : PACKED ARRAY[SUBSCRIPT,CHOICES] OF STRING[25] 0END; $  VAR $F : TEXT; $BOD BY MAX J.NAREFF 10/81 *)   USES APPLESTUFF; (*FOR RANDOM FUNCTION*)   CONST $MAXSIZE = 50; (*LIMIT OF Q AND A IN ARRAY*) $ALTERNATES = 5; (*NO.OF ALTERNATE CHOICES*) '  TYPE $SUBSCRIPT = 1..MAXSIZE; $CHOICES = 1..ALTERNATE PROGRAM ARROWSMITH; ! !(*A MULTIPLE-CHOICE FLASHCARD PROGRAM.THE USER *) !(*IS REQUIRED TO POINT TO CORRECT RESPONSE.FIVE *) !(*CHOICES ARE PRESENTED FOR EACH "QUESTION".IF *) !(*INCORRECT,THE ATTEMPT MUST BE REPEATED. *) !(*PREPAREN^##UNTIL (LENGTH (STR) <= MAXLENGTH); # #GOTOXY (0,10); #WRITELN (CHR(11)); (*ERASE TO END OF SCREEN*) #CENTER (STR); #WRITELN (STR)  END.  :34); # #REPEAT &GOTOXY (0,10); &READLN (STR); &IF (LENGTH (STR) > MAXLENGTH) THEN )BEGIN ,WRITELN (('EXCEEDED 40 CHARACTERS.REPEAT INPUT'); ,GOTOXY (0,10); ,WRITELN (CHR(29)) (*ERASE TO END OF LINE*) )END (*IF*) #CONST &SPACE = ' '; #VAR &I : INTEGER; #BEGIN &FOR I := 0 TO (38-LENGTH(S)) DIV 2 DO )S := CONCAT (SPACE,S) #END; (*CENTER*) #  BEGIN (*MAIN*) #PAGE (OUTPUT); #WRITELN ('A CENTERING DEMO':28); #WRITELN;WRITELN %('ENTER STRING-UP TO 40 CHARS.'ISSUE SUBSCRIPTION $20 *)  (*ADAPTION BY MAX J.NAREFF,11/81 *)   (*CENTERS STRING INPUTS *)  CONST #MAXLENGTH = 40;   VAR #STR : STRING;  #PROCEDURE CENTER (VAR S:STRING); OL : DECISIONS; $WORD : THESAURUS; $STR, $TEMPNAME : STRING; $FILENAME : STRING[23];  I, LOCATION, $LESSONSIZE : INTEGER;   (*DETERMINES DIMENSION OF LESSON MODULE FOR LOOP INDEX*)  FUNCTION NUMOFQUES(VAR NAME:STRING):INTEGER;  VAR #I, DIGITS : INTEGER;  BEGIN #DIGITS := 0; #FOR I := 1 TO LENGTH (NAME) DO &IF (NAME[I] IN ['0'..'9']) THEN )DIGITS := DIGITS * 10 + ORD(NAME[I])-ORD('0'); #NUMOFQUES := DIGITS  END; (*NUMOFQUES*) $  PROCEDURE NAMEFILE;  VAR $ERROR : STRINER*) #  (*SELECT RANDOM NOS.AND WRITE QUESTIONS*) #REPEAT &PAGE (OUTPUT); &INDEX := [ ]; (*INITIALIZE SET*) &LOCATION := 1; (*INITIALIZE LOCATER*) & *(*GENERATES NOS.FROM 1 TO NO.OF QUESTIONS*) &X := RANDOM MOD LESSONSIZE + 1;   (*A2READLN (F, Q[I]); 2FOR J := 1 TO ALTERNATES DO 5READLN (F, A[I,J]) /END (*FOR*) )END (*WITH*) #END; (*READARRAY*) )  BEGIN #RANDOMIZE;  LESSONSIZE := NUMOFQUES(TEMPNAME); #INITBOOLARRAY; #READARRAY; # #K := 0; (*INITIALIZE OUTERLOOP COUNT#ELEMENTS = SET OF CHOICES;  VAR #INDEX : ELEMENTS; #X, J, K, L : INTEGER; #Y : CHOICES; # ((*READS ARRAY FROM FILENAME*) #PROCEDURE READARRAY; #VAR &I : INTEGER; #BEGIN &WITH WORD DO )BEGIN ,FOR I := 1 TO LESSONSIZE DO /BEGIN POINTER); ,READ (KEYBOARD,CH) )UNTIL (CH=CHR(32))  END; (*SELECT*)   PROCEDURE INITBOOLARRAY;  VAR #I : INTEGER;  BEGIN #FOR I := 1 TO LESSONSIZE DO &BOOL [I] := FALSE  END; (*INITBOOLARRAY*)   PROCEDURE FLASHER;  TYPE 1POINTER := POINTER + 1; 1IF (POINTER>ALTERNATES) THEN 3POINTER := POINTER - ALTERNATES .END; ,IF (CH=CHR(8)) THEN (*LEFT ARROW*) .BEGIN 1POINTER := POINTER - 1; 1IF (POINTER<1) THEN 3POINTER := POINTER + ALTERNATES .END; ,THISONE(POINTER,OLDEAD (KEYBOARD,CH); #IF (CH=CHR(27)) THEN &BEGIN )GOTOXY (12,17); )WRITELN ('PROGRAM ABORTED!'); )EXIT (PROGRAM) &END #ELSE &IF (CH<>CHR(32)) THEN (* OR *) )REPEAT ,OLDPOINTER := POINTER; ,IF (CH=CHR(21)) THEN (*RT.ARROW*) .BEGIN &GOTOXY (RIGHT, TOP-1+OLDLOCATION); &WRITE (' '); &GOTOXY (LEFT, TOP-1+LOCATION); &WRITE ('=>'); &GOTOXY (RIGHT, TOP-1+LOCATION); &WRITE ('<=') #END; (*THISONE*) #  BEGIN (*SELECT*) #TOP := (24-ALTERNATES) DIV 2; #THISONE (POINTER,POINTER); #R:THESAURUS;ITEMS:INTEGER;VAR POINTER:INTEGER);  VAR #OLDPOINTER, TOP : INTEGER; #CH : CHAR; # #PROCEDURE THISONE(LOCATION,OLDLOCATION:INTEGER); #CONST &LEFT = 0; &RIGHT= 38; #BEGIN &GOTOXY (LEFT, TOP-1+OLDLOCATION); &WRITE (' '); ,'); #WRITELN;WRITELN  ('EACH FOLLOWED BY FIVE CHOICES.USE THE '); #WRITELN;WRITELN  ('ARROWS FOR YOUR CHOICE AND OR'); #WRITELN;WRITELN  ('TO CONFIRM. TO ABORT ON NEW CARD.'); #NAMEFILE  END; (*HEADER*) )   PROCEDURE SELECT(WORDPUT'); +WRITELN (ERROR:30); ((*$I+*) (END; (*ELSE*) (FOR I := 1 TO 3000 DO #UNTIL (SUCCESSFUL)  END; (*NAMEFILE*)   PROCEDURE HEADER;  BEGIN #WRITELN;WRITELN  ('A FLASHCARD PROGRAM':29); #WRITELN;WRITELN  (' PRESENTS A SERIES OF "QUESTIONS"+CASE IORESULT OF -2,5,9 : ERROR := 'DISK DRIVE NOT ON LINE'; -7 : ERROR := 'ILLEGAL FILE NAME'; -10 : ERROR := 'FILE NOT ON DISK' +END; (*CASE*) + +WRITELN (CHR(7),CHR(7),CHR(7)); +WRITELN  ('I/O ERROR CODE # ':18,IORESULT,' USE CORRECT IN; &RESET (F, FILENAME); &IF (IORESULT = 0) THEN )BEGIN ,SUCCESSFUL := TRUE; ,PAGE (OUTPUT); ,GOTOXY (2,12); ,WRITELN /('DELAY =>...',TEMPNAME,' BEING LOADED') )END &ELSE (BEGIN +ERROR := 'ERROR IN FILENAME OR DISK DRIVE'; & . #5:SPANISH10':28); &WRITE (' ':15); &READLN (FILENAME); +(*$R-*) (*RANGE CHECK OFF*) &TEMPNAME := FILENAME; +(*$R+*) &IF POS('.TEXT',FILENAME)=0 THEN +FILENAME := CONCAT(FILENAME,'.TEXT'); ( ((*$I-*) (*AUTO IO CHECK OFF*) &SUCCESSFUL := FALSEG; $SUCCESSFUL : BOOLEAN;  BEGIN #REPEAT &WRITELN;WRITELN  ('ENTER ''VOL:FILENAME'' OF THE FILE TO BE'); &WRITELN;WRITELN  ('READ.LAST 1 OR 2 CHARS.IN FILENAME MUST '); &WRITELN;WRITELN  ('BE NO.OF QUESTIONS ENTERED INTO MODULE.'); &WRITELN ('EX.LL ELEMENTS IN THE ARRAY "BOOL" HAVE BEEN *)  (*INITIALIZED TO FALSE.WHEN AN ELEMENT SUBSCRIPT*)  (*IS GENERATED AT RANDOM IT IS USED TO CALL A *)  (*RECORD IN THE LESSON.ONCE USED, THE ELEMENT *)  (*IS LABELED TRUE AND IS NOT USED AGAIN.THUS A *)  (*CARD IS FLASHED ONLY ONCE. *)  &IF NOT (BOOL[X]) THEN )WITH WORD DO -BEGIN 0GOTOXY (8,6); 0WRITE('Q>>> '); 8(*QUESTION*) 0WRITELN (Q[X],'..'); , WRITELN;WRITELN; 0BOORRAY = PACKED ARRAY[0..1] OF 0..255; $TRIXPOINTER = ^TRIXARRAY; $TRIX = RECORD CASE BOOLEAN OF .FALSE: (LOCATION:INTEGER); .TRUE : (PTR:TRIXPOINTER) ,END;  VAR $TRICK : TRIX; $  BEGIN $TRICK.LOCATION := ADDRESS; $PEEK := TRICK.PTR^[0]  END; (*PRENCES- *)  (*RON KENNEDY-APRIL DOM;"FORMATUNIT" *)  (*DAN SOKOL -INT.APPLE CORPS;APNOTES *)  (* -BYTE;SEPT.1980;PG.324 *)   VAR $I : INTEGER; $  FUNCTION PEEK (ADDRESS : INTEGER):INTEGER;  TYPE $TRIXAPROGRAM FORMATTER2;   (*A DEMO OF A SCREEN FORMATTER USING A PEEK*)  (*FUNCTION DERIVED FROM A TRIX RECORD(A VARIANT*)  (*RECORD) WHICH ALLOWS A SPECIFIC MEMORY LOCATION*)  (*TO BE TREATED AS A DATA STRUCTURE.*) &(*BY MAX J.NAREFF;9/81*)   (*REFEN^y٢#WRITELN ('THE END')  END.  ATION]) 5END 3UNTIL (D[X,LOCATION]=A[X,1]); 0 0FOR I := 1 TO 750 DO 3 -END;(*WITH*) #UNTIL (K=LESSONSIZE); #PAGE (OUTPUT); #CLOSE (F,LOCK)  END; (*FLASHER*)   BEGIN (*MAIN*) #PAGE (OUTPUT); #HEADER; #FLASHER; #GOTOXY (17,12); 8,D[X,LOCATION]);  TO CONTINUE, TO ABORT'); $READ (KEYBOARD, CH); $IF (CH = CHR(27)) THEN &EXIT (PROGRAM) $ELSE &PAGE (OUTPUT)  END; (*PAUSE*) #  BEGIN (*MAIN*) #PAGE (OUTPUT); #WRITELN  ('A DEMO OF FORMATTING USING ABSOLUTE POS.'); #WRITELN  ('OF HORIZONTAL AND VERTICAL CURSORS.'); #WRITELN  ('PASCAL IS "FOOLED" INTO ALLOWING ACCESS'); #WRITELN  ('TO THE SPECIFIC MEMORY LOCATIONS WHERE'); #WRITELN  ('THESE ARE STORED.AELSE %DECREMENTSTEP; #WRITELN;  END; (*LOOPSELECT*)   BEGIN (*MAIN*) #PAGE (OUTPUT); #WRITELN  ('DEMONSTRATES IN-DECREMENTAL "STEP" LOOPS'); #WRITELN; #REPEAT %ENTERVALUES; %LOOPSELECT; %WRITE (('ANOTHER RANGE?==>(Y/N): ':32); %READ (KEYBOA (STEP);  END; (*ENTERVALUES*) &  PROCEDURE LOOPSELECT;  BEGIN #WRITELN; #WRITELN !('[A]:INCREMENTAL LOOP? (+ STEP)':35); #WRITELN; #WRITELN !('[B]:DECREMENTAL LOOP? (- STEP)':35); ! #READ (KEYBOARD, CH); #IF (CH = 'A') THEN %INCREMENTSTEP # END; (*DECREMENTSTEP*) &  PROCEDURE ENTERVALUES;  BEGIN #WRITELN; #WRITE $('ENTER LOW VALUE OF LOOP RANGE: '); #READLN (LOWVALUE); #WRITE #('ENTER HIGH VALUE OF LOOP RANGE: '); #READLN (HIGHVALUE); #WRITE ('ENTER "STEP" INCREMENT: '); #READLNE := HIGHVALUE; # #WHILE (VALUE >= LOWVALUE) DO &BEGIN )WRITE (VALUE:TAB); )VALUE := VALUE - STEP; ) +(*FORMATTER*) )COUNT := COUNT + 1; )IF (COUNT=8) THEN +BEGIN .WRITELN; .COUNT := 0 +END (*IF*) &END; (*WHILE*) #WRITELN; UE := VALUE + STEP; ) +(*FORMATTER*) )COUNT := COUNT + 1; )IF (COUNT=8) THEN +BEGIN .WRITELN; .COUNT := 0 +END; (*IF*) &END; (*WHILE*) #WRITELN;  END; (*INCREMENTSTEP*) & ((*MIMICS - STEP*)  PROCEDURE DECREMENTSTEP; BEGIN #COUNT := 0; #VALUTAB = 5; #  VAR #LOWVALUE, VALUE, COUNT, #HIGHVALUE, STEP : INTEGER; #CH : CHAR; # ((*MIMICS + STEP*)  PROCEDURE INCREMENTSTEP;  BEGIN #COUNT := 0; #VALUE := LOWVALUE; # #WHILE (VALUE <= HIGHVALUE) DO &BEGIN )WRITE (VALUE:TAB); )VALPROGRAM STEPLOOPS2;   (*A DEMO OF IN-&-DECREMENTAL LOOPS SIM-*)  (*ULATING THE "STEP" MODE OF "BASIC'S" *)  (*"FOR" LOOPS.ALGORITHM SUGGESTED BY *)  (*STEVE LLOYD,PASCAL STUDY GROUP LEADER*)  (*PROGRAM PREPARED BY MAX J.NAREFF,8/81*)   CONST #N^H = 40 THEN +WRITELN; +  (*PEEKS AT ABSOLUTE VERTICAL POS OF CURSOR*) )IF PEEK (245) = 23 THEN +PAUSE &END; (*FOR*) #WRITELN;WRITELN ('THE END.':24)  END. VARIETY OF A VARIANT'); #WRITELN  ('RECORD KNOWN AS A "TRIX RECORD" IS USED'); #WRITELN  ('TO PERFORM THIS TRICK.'); #WRITELN;WRITELN; #FOR I := 1 TO 250 DO &BEGIN )WRITE ('A':5); )  (*PEEKS AT ABSOLUTE HORIZONTAL POS.OF CURSOR*) )IF PEEK (244)RD, CH); %PAGE (OUTPUT) #UNTIL (CH='N'); #GOTOXY (16,12); #WRITELN ('THE END')  END. $ N^:JN^#ڢL F L F L F L F L F L F'); #WRITELN ('....................................'); #FOR CH := 'A' TO'Z' DO &BEGIN )WRITE (CH:3,FREQUENCY[CH]:2); )I := I + 1; )IF (I MOD 7 = 0) THEN ,WRITELN &END  END. #FOR CH := 'A' TO 'Z' DO &FREQUENCY[CH] := 0; # #(*READ LETTERS IN SENTENCE AND COUNT*) #FOR I := 1 TO LENGTH (STR) DO &IF (STR[I] IN ['A'..'Z']) THEN )FREQUENCY[STR[I]] := 2FREQUENCY[STR[I]] + 1; # #I := 0; #WRITELN;WRITELN;WRITELN  (' L F N;WRITELN  (' THIS PROGRAM WILL COUNT THE LETTERS'); #WRITELN ('IN A SENTENCE.'); #WRITELN;WRITELN +('ENTER A LONG SENTENCE.':31); #WRITELN; #READLN (STR); # #(*INITIALIZE ARRAY ELEMENTS TO 0*) %(*EACH LETTER IS A SUBSCRIPT*)   TYPE #ALPHABET = 'A'..'Z'; #COUNTER = ARRAY[ALPHABET] OF INTEGER; #  VAR #FREQUENCY : COUNTER; #STR : STRING; #I : INTEGER; #CH : CHAR; #  BEGIN #PAGE (OUTPUT); #WRITELN  ('USING AN ARRAY AS A COUNTER.':34); #WRITELRRENCE OF LETTERS IN A SENTENCE IS*)  (*STORED AS THE ARRAY ELEMENT CORRESPOND-*)  (*ING TO EACH LETTER OF THE ALPHABET. *)  (*CAN BE ADAPTED TO READING A TEXT FILE.*)  (*USEFUL FOR COUNTING MULTIPLE ITEMS. *)  (*PREPARED BY MAX J.NAREFF 10/81**) PROGRAM CHARCOUNT;   (*ILLUSTRATES USE OF AN ARRAY AS A COUNT-*)  (*ER.THE SUBSCRIPT OF THE ARRAY IS THE *)  (*ITEM BEING COUNTED.THE ELEMENT OR CON-*)  (*TENT OF EACH MEMORY CELL IS THE COUNT *)  (*ITSELF.IN THIS CASE,THE FREQUENCY OF *)  (*OCCUPROGRAM FLASHCARD5; ! !(*A FLASHCARD PROGRAM IN WHICH A SERIES OF ENGLISH*) !(*WORDS ARE FLASHED.THE USER HAS TWO OPTIONS,ONE *) !(*TYPING IN THE CORRECT MATCHING FOREIGN WORD.IF *) !(*INCORRECT,THE ATTEMPT MUST BE REPEATED.SECONDLY *) !(*AFTER A BEND (*FOR*) &END;(*WITH*) # #J := 0; (*INITIALIZE COUNTER*) #  (*SELECT RANDOM NOS.AND WRITE ENGLISH WORDS*) #REPEAT *(*GENERATES NOS.FROM 1 TO NUMOF QUESTIONS*) &X := RANDOM MOD LESSONSIZE + 1;   (*ALL ELEMENTS IN THE ARRAY "BOOL" HEDURE FLASHER;  VAR #I, X, J : INTEGER; #CH : CHAR;  BEGIN #RANDOMIZE; #LESSONSIZE := NUMOFQUES(TEMPNAME);  INITARRAY; ( ((*READ ARRAY*) #WITH WORD DO &BEGIN )FOR I := 1 TO LESSONSIZE DO ,BEGIN /READLN (F, Q[I]); /READLN (F, A[I]) ,&IF (MODESELECT='A') THEN )BEGIN ,INTERACTMODE := TRUE; ,NAMEFILE )END (*ELSE*) &ELSE )NAMEFILE  END; (*HEADER*)   PROCEDURE INITARRAY;  VAR #I : INTEGER;  BEGIN #FOR I := 1 TO LESSONSIZE DO &BOOL [I] := FALSE  END; (*INITARRAY*)   PROCPES RESPONSE'); #WRITELN;WRITELN  (' [B]: PASSIVE-USER KEYS FOR NEXT'); #WRITELN ('WORD':22); #WRITELN;WRITE  (' TO CONTINUE:: TO STOP. '); #READ (KEYBOARD, MODESELECT); #IF (MODESELECT=CHR(27)) THEN &EXIT (PROGRAM) #ELSE ); #WRITELN;WRITELN  (' PRESENTS A SERIES OF ENGLISH WORDS,'); #WRITELN;WRITELN  ('EACH FOLLOWED BY ITS FOREIGN LANGUAGE '); #WRITELN;WRITELN  ('EQUIVALENT.'); #WRITELN;WRITELN 3('SELECT FROM':26); #WRITELN;WRITELN  (' [A]: INTERACTIVE-USER TY('I/O ERROR CODE # ':18,IORESULT,' USE CORRECT INPUT'); +WRITELN (ERROR:30); +DELAY (3500) ((*$I+*) (END (*ELSE*) #UNTIL (SUCCESSFUL)  END; (*NAMEFILE*)   PROCEDURE HEADER;  BEGIN #INTERACT := FALSE; #WRITELN;WRITELN  ('A FLASHCARD PROGRAM':29+ERROR := 'ERROR IN FILENAME OR DISK DRIVE'; & +CASE IORESULT OF -2,5,9 : ERROR := 'DISK DRIVE NOT ON LINE'; -7 : ERROR := 'ILLEGAL FILE NAME'; -10 : ERROR := 'FILE NOT ON DISK' +END; (*CASE*) + +WRITELN (CHR(7),CHR(7),CHR(7)); +WRITELN  = FILENAME; ,(*$R+*) &IF POS('.TEXT',FILENAME)=0 THEN +FILENAME := CONCAT(FILENAME,'.TEXT'); ( ((*$I-*) (*AUTO IO CHECK OFF*) &SUCCESSFUL := FALSE; &RESET (F, FILENAME); &IF (IORESULT = 0) THEN (SUCCESSFUL := TRUE &ELSE (BEGIN HE FILE TO BE'); &WRITELN  ('READ.LAST 1 OR 2 CHARS.IN FILENAME MUST'); &WRITELN  ('BE NO. OF WORD-PAIRS IN MODULE CALLED.'); &WRITELN ('EX.. #4:SPANISH10':28); &WRITELN;WRITE (' ':16); &READLN (FILENAME); ,(*$R-*) (*RANGE CHECK OFF*) &TEMPNAME :S*) $  PROCEDURE DELAY (X:INTEGER);  VAR #I : INTEGER;  BEGIN #FOR I := 1 TO X DO  END;   PROCEDURE NAMEFILE;  VAR $ERROR : STRING; $SUCCESSFUL : BOOLEAN;  BEGIN #REPEAT &PAGE (OUTPUT); &WRITELN;WRITELN  ('ENTER ''VOL:FILENAME'' OF T FUNCTION NUMOFQUES (VAR NAME:STRING) : INTEGER;  VAR #I, DIGITS : INTEGER;  BEGIN #DIGITS := 0; #FOR I := 1 TO LENGTH(NAME) DO &IF (NAME[I] IN ['0'..'9']) THEN )DIGITS := DIGITS * 10 + ORD(NAME[I])-ORD('0'); #NUMOFQUES := DIGITS  END; (*NUMOFQUE : STRING; $FILENAME : STRING[23]; $TEMPNAME : STRING; $MODESELECT : CHAR; $INTERACTMODE : BOOLEAN;  LESSONSIZE : INTEGER;   (*DIMENSIONS LOOPS TO MATCH ARRAYS IN LESSONS*)  (*SELECTED BY FILENAME*) S*) '  TYPE $DECISIONS = ARRAY[1..MAXSIZE] OF BOOLEAN; $THESAURUS = RECORD 2Q : PACKED ARRAY[1..MAXSIZE] OF STRING; 2A : PACKED ARRAY[1..MAXSIZE] OF STRING 0END; $  VAR $F : TEXT; $BOOL : DECISIONS; $WORD : THESAURUS; $STR RIEF DELAY,THE FOREIGN WORD APPEARS.THE*) !(*USER KEYS FOR THE NEXT CARD. *)  (*PREPARED BY MAX J.NAREFF 10/81 *)   USES APPLESTUFF; (*FOR RANDOM FUNCTION*)   CONST $MAXSIZE = 99; (*LIMIT OF WORD PAIRS IN ARRAYAVE BEEN *)  (*INITIALIZED TO FALSE.WHEN AN ELEMENT SUBSCRIPT*)  (*IS GENERATED AT RANDOM IT IS USED TO CALL A *)  (*RECORD IN THE LESSON.ONCE USED, THE ELEMENT *)  (*IS LABELED TRUE AND IS NOT USED AGAIN.THUS A *)  (*CARD IS FLASHED ONLY ONCE. *)  &IF NOT (BOOL[X]) THEN )WITH WORD DO -BEGIN 0WRITE('Q>> ':8); 5(*ENGLISH WORD*) 0WRITE (Q[X],'..'); , $(*A MODE*) IF INTERACTMODE THEN 3BEGIN 8(*USER TYPES EQUIVALENT FOREIGN WORD CORRECTLYREEN:=FALSE;  END;   PROCEDURE PG;  BEGIN "IF NOTPAGE THEN $BEGIN &WRITELN(G);WRITELN(G); $END "ELSE $PAGE(G);  END;   PROCEDURE SEARCH(VAR W1: WORDREF);  VAR W: WORDREF; X: ITEMREF;  BEGIN W:=W1; "IF W=NIL THEN " BEGIN &NEW(W); &ID,RESERVED,OPEN2, %SCREEN,COMMENT: BOOLEAN; % %  PROCEDURE DEST_BLOCK;  BEGIN  IF (DEST=UNBLKVOL[2]) OR (DEST=UNBLKVOL[5]) THEN $NOTPAGE:=FALSE "ELSE $NOTPAGE:=TRUE;  IF (DEST=UNBLKVOL[1]) OR (DEST=UNBLKVOL[4]) THEN $SCREEN:=TRUE "ELSE $SC%CURSOR, {CHAR POS IN SCANNED LINE} %N: INTEGER; (* CURRENT LINE NUMBER *) %ID: ALPHA; %F1,F2,G: TEXT; %A: PACKED ARRAY[1..C1] OF CHAR; %ST_COM_CH: CHAR; %CURSTR:STRING; %VOL,SOURCE,FILENAME,DEST: STRING[20]; %NOTPAGE,SECONDFILE,COMMANA; ,FIRST,LAST: ITEMREF; ,LEFT,RIGHT: WORDREF; *END; %ITEM=PACKED RECORD 3LNO: 0..C4; 3NEXT: ITEMREF; 1END; 1 !VAR %UNBLKVOL:UNBLOCKED; %ROOT: WORDREF; %COUNT,WHOZAT,ENDNAME, %LNLENGTH,ENDCMD,LEN,I,K,K1: INTEGER; * DIGITS PER NUMBER *) &C4=9999; (* MAX LINE NUMBER *) &L1=6; (* NUMBER OF UNBLOCKED OUTPUT TITLES*) &  TYPE ALPHA=PACKED ARRAY[1..C1] OF CHAR; %UNBLOCKED=ARRAY[1..L1] OF STRING[8]; %WORDREF=^WORD; %ITEMREF=^ITEM; %WORD=RECORD ,KEY: ALPHHMS+DATA STRUCTURES=PROGRAMS,P206 *)  (* *)  (********************************************************)   CONST C1=20; (* LENGTH OF WORDS *) &C2=10; (* NUMBERS PER LINE *) &C3= 5; ({ $L COMPILE:XREF.LIST.TEXT}  PROGRAM CROSSREF;  (********************************************************)  (* *)  (* CROSS REFERENCE GENERATOR USING BINARY TREE. *)  (* FROM WIRTH,ALGORIT4 O^F BEGIN (*MAIN*) #PAGE (OUTPUT); #HEADER; #FLASHER; #WRITELN ('THE END':23)  END.  0-LENGTH(Q[X]),'..',A[X],' '); 6READ (KEYBOARD, CH); 6IF (CH=CHR(27)) THEN 9EXIT (PROGRAM); 6WRITELN 3END; / 0BOOL[X] := TRUE; (*SO IT WILL NOT REPEAT*) 0J := J + 1; -END (*WITH*) #UNTIL (J=LESSONSIZE); # #CLOSE (F,LOCK)  END; (*FLASHER*)  *) 6REPEAT 9WRITE (' ':10-LENGTH(Q[X]),'..ANS>> '); 9READLN (STR); 9IF (STR[1]=CHR(27)) THEN W^.KEY THEN SEARCH(W^.RIGHT) &ELSE $ IF W^.LAST <> NIL THEN *BEGIN ,NEW(X); X^.LNO:=N; X^.NEXT:=NIL; ,W^.LAST^.NEXT:=X; W^.LAST:=X; *END;  END; (* SEARCH *)   PROCEDURE PRINTTREE(W: WORDREF); " "PROCEDURE PRINTWORD(W: WORD); "V"UNTIL(CURSTR[CURSOR]=CHR(39));  END;   PROCEDURE SET_COMMENT;   BEGIN "COMMENT:=TRUE; "ST_COM_CH:=CURSTR[CURSOR]; "SKIP_COMMENT;  CURSOR:=CURSOR+1;  END;  { $L CONSOLE: }  PROCEDURE SCANLN;   BEGIN "CURSOR :=1;{WRITELN(LNLENGTH);} ; 'IF I>1 THEN )IF((ST_COM_CH='(') AND (CURSTR[CURSOR]=')') AND ' (CURSTR[CURSOR-1]='*')) THEN *BEGIN ,COMMENT:= FALSE; EXIT(SKIP_COMMENT) *END; 'CURSOR:= CURSOR+1; %END;  END;   PROCEDURE SKIP_STR_CONST;   BEGIN "REPEAT $CURSOR:=CURSOR+1 $END  END; {PADWORD}   PROCEDURE SKIP_COMMENT;   VAR START:INTEGER;   BEGIN " START:=CURSOR; #FOR I:=START TO LNLENGTH DO %BEGIN 'IF ((ST_COM_CH='{') AND (CURSTR[CURSOR]='}')) THEN )BEGIN +COMMENT:= FALSE; EXIT(SKIP_COMMENT); " ENDEGIN "WHILE CURSTR[CURSOR] IN ['A'..'Z','a'..'z','0'..'9','.','_','^'] DO $BEGIN &BUILDWORD; &IF CURSOR>LNLENGTH THEN *EXIT(BLDWRD2); $END  END;   PROCEDURE PADWORD;   BEGIN  WHILE COUNT' '; *ENDNAME:=0; *REPEAT ,ENDNAME:=ENDNAME+1 *UNTIL CURSTR[CURSOR+WHOZAT+3+ENDNAME] IN [' ','}']; *FILENAME:= COPY(CURSTR,CURSOR+*WHOZAT := -1; *REPEAT ,WHOZAT := WHOZAT+1 *UNTIL CURSTR[CURSOR+WHOZAT+4]<>' '; *ENDNAME:=0; *REPEAT ,ENDNAME:=ENDNAME+1 *UNTIL CURSTR[CURSOR+WHOZAT+4+ENDNAME] IN [' ','*']; *FILENAME:= COPY(CURSTR,CURSOR+WHOZAT+4,ENDNAME); *SECONDFILE := TRUE (UNBLKVOL[6]:='REMOUT:';  END;  {}  PROCEDURE ALTFILE;  BEGIN "IF SECONDFILE THEN $BEGIN &WRITELN(G,'ERROR ********** NESTED INCLUDE FILES'); &WRITELN(G); &EXIT(ALTFILE); $END "ELSE $BEGIN  IF CURSTR[CURSOR]='(' THEN (BEGIN ER('THEN');ENTER('TO');ENTER('TRUE'); "ENTER('UNIT');ENTER('UNTIL'); "ENTER('WHILE');ENTER('WRITE');ENTER('WRITELN'); " "RESERVED:=FALSE; UNBLKVOL[1]:='#1:'; UNBLKVOL[2]:='#6:'; UNBLKVOL[3]:='#8:'; UNBLKVOL[4]:='CONSOLE:'; UNBLKVOL[5]:='PRINTER:'; "ENTER('MOD');ENTER('NIL'); "ENTER('NOT');ENTER('OF'); "ENTER('OR');ENTER('PACKED'); "ENTER('READ');ENTER('READLN');ENTER('REAL');ENTER('RECORD'); "ENTER('REPEAT');ENTER('RESET');ENTER('REWRITE');ENTER('SEPERATE'); "ENTER('SET');ENTER('STRING'); "ENT"ENTER('DIV');ENTER('DO'); "ENTER('DOWNTO');ENTER('ELSE'); "ENTER('END');ENTER('EOF');ENTER('FALSE');ENTER('FILE'); "ENTER('FOR');ENTER('FORWARD'); "ENTER('GOTO');ENTER('IF'); "ENTER('IMPLEMENTA');ENTER('IN'); "ENTER('INTEGER');ENTER('INTERFACE');  '; "FOR I:=1 TO LENGTH(WORD) DO $ID[I]:=WORD[I]; "SEARCH(ROOT);  END;   PROCEDURE INITIAL;  BEGIN "COMMAND:=FALSE; COMMENT:=FALSE; RESERVED:=TRUE; "ENTER('AND');ENTER('ARRAY'); "ENTER('BEGIN');ENTER('BOOLEAN'); "ENTER('CASE');ENTER('CHAR');   BEGIN (* PRINTTREE *) "IF W<> NIL THEN $BEGIN &PRINTTREE(W^.LEFT); &IF W^.FIRST<>NIL THEN PRINTWORD(W^); &PRINTTREE(W^.RIGHT); $END;  END; (* PRINTTREE *)   PROCEDURE ENTER(WORD:STRING);  VAR I:INTEGER;  BEGIN "ID:=' AR L: INTEGER; X: ITEMREF; "BEGIN $WRITE(G,' ',W.KEY); X:=W.FIRST; L:=0;  REPEAT &IF L=C2 THEN (BEGIN *WRITELN(G); *L:=0; WRITE(G,' ':C1+1) (END; &L:=L+1; WRITE(G,X^.LNO:C3); X:=X^.NEXT; $UNTIL X=NIL; $WRITELN(G); "END; (* PRINTWORD *)"WHILE CURSOR<= LNLENGTH DO $BEGIN &{WRITE(CURSOR,' ');} &IF COMMENT THEN (BEGIN *SKIP_COMMENT; & CURSOR:=CURSOR+1; (END &ELSE & IF CURSTR[CURSOR]=CHR(39) THEN *BEGIN ,SKIP_STR_CONST; ( IF CURSOR=LNLENGTH THEN .EXIT(SCANLN) ,ELSE .CURSOR:=CURSOR+1 ( END (ELSE &IF (CURSTR[CURSOR] IN ['A'..'Z','a'..'z','^']) THEN (BEGIN *COUNT :=0; *BLDWRD2; *PADWORD; *SEARCH(ROOT); (END &ELSE IF CURSTR[CURSOR]='(' THEN (BEGIN *IF CURSOR+1<=LNLENGTH THEN ,BEGIN .IF CURSTR[CURSOR+1]="WRITE('DESTINATION FILE? '); "READLN(DEST); "DEST_BLOCK; "IF POS('.TEXT',DEST)=0 THEN DEST:=CONCAT(DEST,'.TEXT'); "REWRITE(G,DEST);  PAGE(OUTPUT); "WRITELN('WORKING.........'); "SCANTEXT;  END.  OT:=NIL; N:=0; K1:=0; "OPEN2:=FALSE;SECONDFILE:=FALSE; "WRITELN('WORKING.........'); "INITIAL; "WRITE('INPUT FILE? '); "READLN(SOURCE); "IF POS('.TEXT',SOURCE)=0 THEN SOURCE:=CONCAT(SOURCE,'.TEXT'); "RESET(F1,SOURCE); ING LINE NUMBER ',N); $WRITE(G,': '); $WRITELN(G,CURSTR); $LNLENGTH := LENGTH(CURSTR); $IF LNLENGTH>0 THEN SCANLN; "IF SECONDFILE THEN INCLUSION; "UNTIL EOF(F1); "PG; PRINTTREE(ROOT);  PG; PG;  CLOSE(G,LOCK);  END; "  BEGIN (* MAIN *) "ROLENAME);WRITELN(G); &SECONDFILE:=FALSE; $ OPEN2:=FALSE;  CLOSE(F2);  END;  {$L-}  PROCEDURE SCANTEXT;  BEGIN "REPEAT $IF N=C4 THEN N:=0; $READLN(F1,CURSTR); $N:=N+1; WRITE(G,N:C3); $IF (NOT SCREEN) AND (N MOD 100=0) THEN &WRITELN('SCANN(READLN(F2,CURSTR); (N:=N+1; (IF (NOT SCREEN) AND (N MOD 100=0) THEN *WRITELN('SCANNING LINE NUMBER ',N); (WRITELN(G,N:C3,': ',CURSTR); (LNLENGTH :=LENGTH(CURSTR); (IF LNLENGTH>0 THEN SCANLN &UNTIL EOF(F2); &WRITELN(G,'END OF INCLUDE FILE --> ',FIERROR IN OPENING INCLUDE FILE --> ',FILENAME,' IORESULT= ', 5K1); *WRITELN(G,'END OF INCLUDE FILE --> ',FILENAME);WRITELN(G); ( SECONDFILE:=FALSE; *EXIT(INCLUSION) (END $ ELSE (OPEN2:=TRUE; $END; &REPEAT (IF N=C4 THEN N:=0; ; *IF COMMENT THEN EXIT(SCANLN); (END $END "ELSE $CURSOR := CURSOR +1;  END;  END;   PROCEDURE INCLUSION;   BEGIN "IF NOT OPEN2 THEN $BEGIN ${$I-} &RESET(F2,FILENAME);  K1:= IORESULT; ${$I+} &IF K1<>0 THEN (BEGIN *WRITELN(G,'= LNLENGTH) OR (CURSTR[ENDCMD]='}'); .COUNT :=0; .REPEAT 0BUILDWORD .UNTIL (CURSOR=LNLENGTH) OR (CURSOR=ENDCMD); .PADWORD; .SEARCH(ROOT); ,END *ELSE ,BEGIN .SET_COMMENT; .IF COMMENT THEN EXIT(SCANLN); ,END (END " ELSE (BEGIN *SET_COMMENT(BEGIN *IF CURSTR[CURSOR+1]='$' THEN ,BEGIN .COMMAND := TRUE; .IF (CURSTR[CURSOR+2] IN ['I','i']) AND (NOT (CURSTR[CURSOR+3] 3IN ['+','-'])) THEN ALTFILE .ELSE; {SOME OTHER COMMAND} .ENDCMD := CURSOR; .REPEAT 0ENDCMD := ENDCMD+1 .UNTIL (ENDCMDMMENT THEN EXIT(SCANLN); 4END 0 ELSE 3BEGIN 5SET_COMMENT; 5IF COMMENT THEN EXIT(SCANLN); 0END $ END ,ELSE CURSOR:=CURSOR+1; *END (ELSE CURSOR:=CURSOR+1 $END "ELSE IF CURSTR[CURSOR]='{' THEN $BEGIN &IF CURSOR+3 <= LNLENGTH THEN EAT 8ENDCMD :=ENDCMD+1; 6UNTIL ((CURSTR[ENDCMD]='}') AND (CURSTR[ENDCMD-1]='*')) EOR (ENDCMD=LNLENGTH); 6COUNT:=0; 6REPEAT 8BUILDWORD 6UNTIL (CURSOR=ENDCMD) OR (CURSOR=LNLENGTH); 6PADWORD; 6SEARCH(ROOT); 4END 2ELSE 4BEGIN 6SET_COMMENT; 6IF CO'*' THEN 0BEGIN 2IF CURSOR+2<=LNLENGTH THEN 3IF CURSTR[CURSOR+2]='$' THEN 4BEGIN 6COMMAND := TRUE; 6IF (CURSTR[CURSOR+3] IN ['I','i']) AND 6(NOT (CURSTR[CURSOR+4] IN ['+','-'])) THEN 6 ALTFILE 6ELSE {SOME OTHER COMMAND}; 6ENDCMD:=CURSOR; 6REPO^g[ one? (y/n) '); +REPEAT -READLN(ch) +UNTIL (ch IN ['Y','y','N','n']); +IF (ch IN ['n','N']) THEN EXIT(PROGRAM); +FOR dex:='A' TO 'Z' DO dexray[dex]:=0; +REWRITE(dexfile,pfilename); +dexfile^:=dexray; +PUT(dexfile); +CLOSE(dexfile,LOCK); +WRITELN(t[i]; /PUT(catfile); .END; ,CLOSE(catfile,LOCK) *END $ELSE WRITELN(nfilename,' already exists on this volume.'); $ $IF NOT lookup(pfilename) %THEN BEGIN +WRITELN('There is no file named ',pfilename,' on this disk.'); +WRITE('Do you wish to create1file_name:=' '; 1file_kind:=untyped; 1file_date.month:=0; 1file_date.day:=0; 1file_date.year:=0; 1file_size:=0; /END; ,FOR i:=1 TO maxrec DO cat[i]:=cat[0]; ,REWRITE(catfile,nfilename); -FOR i:=0 TO maxrec DO .BEGIN /catfile^:=ca' on this disk.'); -WRITE('Do you wish to create one? (y/n) '); -REPEAT .READLN(ch) -UNTIL (ch IN ['Y','y','n','N']); -IF (ch IN ['N','n']) THEN EXIT(PROGRAM); -WRITELN('Initializing.....'); -WITH cat[0] DO /BEGIN 1vol_name:=' '; atarray; ' ' !FUNCTION lookup(fn:filen):BOOLEAN;FORWARD; ! !SEGMENT PROCEDURE initialize; %VAR *i:recnum; *cat:catarray; *dexfile:FILE OF indexarray; * $BEGIN &IF NOT lookup(nfilename) 'THEN BEGIN -WRITELN('There is no file named ',nfilename,rec,olrec,drec,dlrec:recnum; 'ntotrec,ototrec:0..2047; 'remov,nfileend,ofileend,done:BOOLEAN; 'ch:CHAR; 'dex:index; 'dexray:indexarray; 'p:FILE OF CHAR; 'vol,test,systemvolume:vol_id; 'catfile,ocatfile,ncatfile:FILE OF catalog_record; 'ncat,ocat:c;file_size:0..988; 9END; 9 (directory = ARRAY [dir_size] OF dir_record; (catarray = ARRAY [0..maxrec] OF catalog_record; (filen = STRING[20]; (recnum = 0..maxrec_1; (index = 'A'..'Z'; (indexarray = ARRAY [index] OF INTEGER; (  VAR 'nrec,nlrec,o5xdisk,code,text,info,data,graf,foto: :(dir_file_name:file_id; ;lastbyte:1..512; ;dir_file_date:date_record) 5END; 5 (catalog_record = PACKED RECORD ;vol_name:vol_id; ;file_name:file_id; ;file_kind:file_type; ;file_date:date_record; o,data,graf,foto,securedir); 'dir_record = RECORD 5first_block:INTEGER; 5last_block:INTEGER; 4CASE dir_file_kind:file_type OF 5securedir,untyped: :(dir_vol_name:vol_id; ;zero_block, ;num_of_files, ;total_blocks:INTEGER; ;last_boot:date_record); a'; (pfilename = '#5:cat.point.data'; (clearscreen = 12; (  TYPE (date_record = PACKED RECORD Amonth:0..12; Aday:0..31; Ayear:0..100 >END; 'dir_size = 0..77; 'vol_id = STRING[7]; 'file_id = STRING[15]; 'file_type = (untyped,xdisk,code,text,inf {$S+}  {$C WRITTEN BY EDWARD HEYMAN }  { typed and adapted for APPLE ][ by Mark Snow }    PROGRAM catalog;   CONST (blanks = ' '; (maxrec = 200; (maxrec_1 = 201; (nfilename = '#5:mastcat.data'; (ofilename = '#5:backcat.datpfilename,' written to disk') *END $ELSE WRITELN('File ',pfilename,' exists.'); "END; {INIT} " " "FUNCTION lookup; $VAR ior:0..15; $ $BEGIN &{$I-} &RESET(catfile,fn); &ior:=IORESULT; &CLOSE(catfile); &{$I+} &IF ior=0 'THEN lookup:=TRUE 'ELSE BEGIN .lookup:=FALSE; .IF ior<>10 THEN WRITELN('I/O result for ',fn,' is ',ior); + END; $END; $ "PROCEDURE wait; $BEGIN %GOTOXY(10,24); %WRITE('Press space bar to continue'); %READ(ch); $END; $ "PROCEDURE MEM(pn:STRING); #BEGIN %IF FAnew_cat; -FOR i:=1 TO nrec DO print_record(ncat[i]); ,UNTIL nfileend; ,CLOSE(ncatfile); +END &ELSE WRITELN(nfilename,' not present'); %WRITELN('The master catalog contains ',ntotrec,' records.'); %CLOSE(p); %wait; $END; { display } $ $PROCEDURE c:=ntotrec+nrec; %nrec:=0; %IF done THEN CLOSE(ncatfile,LOCK); #END; { writecat } # # #PROCEDURE display; $VAR i:recnum; % $BEGIN %REWRITE(p,'console:'); %IF lookup(nfilename) &THEN BEGIN ,nrec:=0; ,RESET(ncatfile,nfilename); ,REPEAT -read_8file_kind:=untyped; 8file_date.month:=0; 8file_date.day:=0; 8file_date.year:=0; 8file_size:=0; 8ncatfile^:=ncat[0]; 8PUT(ncatfile); 7END; &FOR i:=1 TO nrec DO 'BEGIN (ncatfile^:=ncat[i]; (PUT(ncatfile); (WRITE('.'); 'END; %WRITELN; %ntotreT(ocatfile); &END; &orec:=i-1; &ototrec:=ototrec+orec; &ofileend:=TRUE; #END; # "PROCEDURE writecat; #VAR i:recnum; # #BEGIN $IF (ntotrec=0) THEN WITH ncat[0] DO 7BEGIN 8vol_name:=' '; 8file_name:=' '; 'ocat[i]:=ocatfile^; 'IF (ocat[i].vol_name=' ') (THEN BEGIN /orec:=i-1; /ototrec:=ototrec+orec; /ofileend:=TRUE; /EXIT(read_old_cat); -END; 'IF i=nlrec (THEN BEGIN .orec:=i; .ototrec:=ototrec+i; .EXIT(read_old_cat); -END; 'i:=i+1; 'GE(read_new_cat); -END; 'i:=i+1; 'GET(ncatfile); &END; &nrec:=i-1; &ntotrec:=ntotrec+nrec; &nfileend:=TRUE; #END; # $ #PROCEDURE read_old_cat; # $VAR i:recnum; $ $BEGIN %i:=1; %orec:=0; %GET(ocatfile); %WHILE NOT EOF(ocatfile) DO &BEGIN %WHILE NOT EOF(ncatfile) DO &BEGIN 'ncat[i]:=ncatfile^; 'IF (ncat[i].vol_name=' ') (THEN BEGIN /nrec:=i-1; /ntotrec:=ntotrec+nrec; /nfileend:=TRUE; /EXIT(read_new_cat); -END; 'IF i=nlrec (THEN BEGIN .nrec:=i; .ntotrec:=ntotrec+i; .EXIT'WRITE(p,vol_name,' ':8-LENGTH(vol_name)); 'WRITE(p,file_size:4); 'print_date(file_date); 'print_kind(file_kind); 'WRITELN(p); &END; $END; $ $ #PROCEDURE read_new_cat; # $VAR i:recnum; $ $BEGIN %i:=1; %nrec:=0; %GET(ncatfile); t fileInfo fileData fileGraf fileFoto file'; $VAR t:STRING[10]; $ $BEGIN %WRITE(p,COPY(types,ORD(file_kind)*9-8,9)); $END; $ #PROCEDURE print_record(cat1:catalog_record); $BEGIN %WITH cat1 DO &BEGIN 'WRITE(p,file_name,' ':18-LENGTH(file_name)); ; %VAR m:STRING[5]; ' % %BEGIN &WITH rec DO 'BEGIN (WRITE(p,day:3,'-'); (m:=COPY(months,month*3-2,3); (WRITE(p,m); (WRITE(p,'-',year:2,' ':3); 'END; %END; ' #PROCEDURE print_kind(file_kind:file_type); $CONST types = $ 'Bad blockCode fileTex&IF (POS(':',vol)<>0) THEN DELETE(vol,POS(':',vol),1); &sps:=COPY(blanks,1,7-LENGTH(vol)); &vol:=CONCAT(vol,sps); &WRITELN(vol,'|'); &drec:=0; $ END; % #PROCEDURE print_date (rec:date_record); %CONST months = 'JanFebMarAprMayJunJulAugSepOctNovDec'le); $END; $ #PROCEDURE enter_vol_name; %VAR (sps:vol_id; ( %BEGIN &vol:=' '; &REPEAT (PAGE(OUTPUT); (WRITE('Enter name of volume to be removed --> '); (READLN(vol); &UNTIL (LENGTH(vol)<=8); ,2); $vol:=dir[0].dir_vol_name; $ $sps:=COPY(blanks,1,7-LENGTH(vol)); $avol:=CONCAT(vol,sps); "END; " " "PROCEDURE readdex; $VAR (dexfile:FILE OF indexarray; $ $BEGIN %RESET(dexfile,pfilename); %dexray:=dexfile^; %GET(dexfile); %CLOSE(dexfiLSE { TEMPORARILY REMOVED } *THEN WRITELN('Memory available at procedure ',pn,' is ',MEMAVAIL*2); #END; # # "PROCEDURE get_sys_vol(VAR vol:vol_id); #VAR 'i,j:INTEGER; 'sps:STRING; 'avol:vol_id; 'dir:directory; ' "BEGIN $UNITREAD (4,dir[0],2048backup; &VAR pass,unback:BOOLEAN; +n:recnum; + 'BEGIN (pass:=FALSE; (unback:=FALSE; (REWRITE(p,'console:'); (IF lookup(nfilename) *THEN BEGIN 0PAGE(OUTPUT); 0WRITELN(' The following files are not backed up:'); 0RESET(ncatfile,nfilename); 0REPEAT 1IF (pass AND unback) 3THEN IF (ncat[0].file_name <> ncat[1].file_name) 5THEN print_record(ncat[0]); 1read_new_cat; 1FOR n:=1 TO nrec-1 DO 3IF ((ncat[n].file_name <> ncat[n-1].file_name) AND 9(ncat[n].file_name <> ncat[n+1].file_name)) = dex &THEN BEGIN -IF ncat[nrec].file_name[1] > dex /THEN REPEAT 6dexray[dex]:=0; 6IF dex='Z' THEN EXIT(setdex); 6dex:=SUCC(dex); 4UNTIL ncat[nrec].file_name[1] = dexat[drec] DO ' BEGIN *vol_name:=vol; *file_name:='FREE.SPACE'; *sps:=COPY(blanks,1,15-LENGTH(file_name)); *file_name:=CONCAT(file_name,sps); *file_kind:=info; *file_date:=dirx[0].last_boot; *file_size:=dirx[0].total_blocks - blocks_used; )END; CAT(file_name,sps); -file_kind:=dir_file_kind; -file_date:=dir_file_date; -file_size:=last_block - first_block; -blocks_used:=blocks_used + file_size; ,END; { with } )END; { if length } 'END; { with dirx } %END; { for } % 'drec:=drec+1; 'WITH dc TO dirx[0].num_of_files DO %BEGIN &WITH dirx[i] DO 'BEGIN (IF LENGTH(dir_file_name)>0 )THEN *BEGIN +drec:=drec+1; +WITH dcat[drec] DO ,BEGIN -vol_name:=vol; -file_name:=dir_file_name; -sps:=COPY(blanks,1,15-LENGTH(file_name)); -file_name:=CON$UNTIL unitnum in [4,5,9,10]; $UNITREAD(unitnum,dirx[0],2048,2); $IF IORESULT <> 0 %THEN &BEGIN 'WRITELN('Unit not on line'); 'EXIT(catalog); &END; $vol:=dirx[0].dir_vol_name; $sps:=COPY(blanks,1,7-LENGTH(vol)); $vol:=CONCAT(vol,sps); $FOR i:=1sps:STRING[16]; &blocks_used:0..988; & "BEGIN #blocks_used:=6 ; { for apple single directory =6 blocks } #drec:=0; $mem('Getdir'); $REPEAT %WRITE('Enter unit number for required directory --> '); %READLN(unitnum); %WRITELN uf:=dcat[i]; 0dcat[i]:=dcat[i-1]; 0dcat[i-1]:=buf; 0flag:=FALSE; .END; 'WRITE('.'); %UNTIL flag; %WRITELN; %WRITELN('Done sorting'); #END; { sort } # !PROCEDURE getdir; "VAR &dirx:directory; &unitnum,i:INTEGER; &chbuf:CHAR; &vol:vol_id; &ex } $ #PROCEDURE sort; $VAR i:recnum; (buf:catalog_record; (flag:BOOLEAN; ( $BEGIN %WRITELN('Sorting ',drec,' records.'); %REPEAT &flag:=TRUE; &FOR i:=drec DOWNTO 2 DO (IF (dcat[i].file_name < dcat[i-1].file_name) )THEN BEGIN { exchange } 0b+THEN dir_file_name:='BACKCAT.DATA'; )END; 'UNITWRITE(5,dir[0],2048,2); %END; % #PROCEDURE writedex; $VAR dexfile:FILE OF indexarray; $ $BEGIN %REWRITE(dexfile,pfilename); %dexfile^:=dexray; %PUT(dexfile); %CLOSE(dexfile,LOCK); $END; { writedBEGIN 'UNITREAD(5,dir[0],2048,2,12); 'vol:=dir[0].dir_vol_name; 'sps:=COPY(blanks,1,7-LENGTH(vol)); 'avol:=CONCAT(vol,sps); 'FOR i:=1 TO dir[0].num_of_files DO (WITH dir[i] DO )BEGIN *IF (dir_file_name='MASTCAT.DATA') filename,' not present.'); 'CLOSE(p); 'wait; %END; { backup } % % "PROCEDURE update; " #VAR dcat:ARRAY [dir_size] OF catalog_record; (rn:recnum; ( #PROCEDURE rename; $VAR (i:INTEGER; (sps:STRING[16]; (vol,avol:vol_id; (dir:directory; ( %EN print_record(ncat[n]); 1pass:=true; 1IF (ncat[nrec].file_name <> ncat[nrec-1].file_name) 5THEN unback:=TRUE; 1ncat[0]:=ncat[nrec]; 0 IF (nfileend AND unback) THEN print_record(ncat[nrec]); 0UNTIL nfileend; 0CLOSE(ncatfile); /END )ELSE WRITELN(n) +THEN y:=1 +ELSE IF (vol_name = ocat[orec].vol_name) 3THEN y:=2 3ELSE y:=3; 3 )z:=x+y; )IF ((orec=0) OR (orec >o)) THEN z:=11; ) )CASE z OF +11,12,13,21 :BEGIN :nrec:=nrec+1; :ncat[nrec]:=dcat[d]; :d:=d+1; :WRITE('Add ',ncat[nrec].file_name:18); :WRITELN(ncat[nrec].vol_name:10) 8END; ,22 :BEGIN :nrec:=nrec+1; :ncat[nrec]:=dcat[d]; :orec:=orec+1; :d:=d+1 8END; ,23,31,33 :BEGIN 9nrec:=nrec+1; 9ncat[nrec]:=ocat[orec]; 9orec:=orec+1; 8EN (POS(target,cat.file_name) >= 1)) ?THEN BEGIN Fprint_record(cat); Ffound:=TRUE; DEND; (IF ((cat.file_name[1] > tar1 ) OR (cat.file_name[2] > tar2 )) .THEN stop := TRUE; (GET(ncatfile); &UNTIL (stop OR EOF(ncatfile)); &IF NOT found THEN WRITELN('F1THEN start:=dexray['Z'] 1ELSE start:=dexray[tar1]; &SEEK(ncatfile,start); &GET(ncatfile); &REPEAT (cat:=ncatfile^; (IF ((wildcard=0) AND (POS(target,cat.file_name) =1)) ATHEN BEGIN Gprint_record(cat); Gfound:=TRUE; FEND; (IF ((wildcard >1) AND&wildcard:=POS('=',target); &IF wildcard=1 THEN longsearch; &IF wildcard >1 THEN target:=COPY(target,1,wildcard-1); &tar1:=target[1]; &IF (wildcard <>2) *THEN tar2:=target[2] *ELSE tar2:='Z'; &IF tar1 < 'A' )THEN start:=0 )ELSE IF (tar1 > 'Z') o long!'); &UNTIL LENGTH(target) <= 16; &IF POS('<',target) = 1 THEN -BEGIN /DELETE(target,1,1); /REWRITE(p,'printer:'); -END (ELSE REWRITE(p,'console:'); &RESET(ncatfile,nfilename); &IF POS(':',target) <> 0 THEN search_for_volume; ncat[n]); (UNTIL nfileend; (CLOSE (ncatfile); (wait; (CLOSE(p); (EXIT(search); &END; {vsearch} & %BEGIN &stop:=FALSE;found:=stop; &REPEAT (WRITE('Enter name of file to find -->'); (READLN(target); (IF LENGTH(target) > 16 THEN WRITELN('Name tocnum; * &BEGIN (blks:=' '; (DELETE(target,POS(':',target),1); (sps:=COPY(blks,1,7-LENGTH(target)); (target:=CONCAT(target,sps); (WRITELN(target); (REPEAT *read_new_cat; *FOR n:=1 TO nrec DO +IF ncat[n].vol_name = target THEN print_record((FOR n:=1 TO nrec DO IF POS (target,ncat[n].file_name) <> 0 ATHEN print_record(ncat[n]); &UNTIL (nfileend); &CLOSE(ncatfile); &wait; &CLOSE(p); &EXIT(search); %END; { longsearch } % $PROCEDURE search_for_volume; &VAR *blks,sps:STRING[7]; *n:reRE search; #VAR (stop,found:BOOLEAN; (tar1,tar2:CHAR; (start:INTEGER; (wildcard:0..16; (cat:catalog_record; (target,sps:STRING; ( $PROCEDURE longsearch; %VAR n:recnum; % %BEGIN &DELETE(target,1,1); &WRITELN(target); &REPEAT (read_new_cat; c:=0; #REWRITE(ncatfile,nfilename); #nrec:=0; #merge; #CLOSE(ocatfile); #CLOSE(p); #WRITELN('Backcat contains ',ototrec, ' records'); #WRITELN('Mastcat contains ',ntotrec,' records'); #CLOSE(ncatfile,LOCK); #wait; "END; { update } " " !PROCEDU,ofilename); ,CLOSE(ocatfile,PURGE); *END; # #rename; #IF NOT remov (THEN BEGIN /getdir; /sort; /FOR rn:=1 TO drec DO print_record(dcat[rn]); -END; #IF lookup(ofilename) &THEN BEGIN -RESET(ocatfile,ofilename); -read_old_cat; +END % ELSE ore$UNTIL NOT continue; $IF dex < 'Z' 'THEN FOR ch:=dex TO 'Z' DO dexray[ch] := dexray[PRED(dex)]; $done:=TRUE; $writecat; $writedex; "END; { merge } " " "BEGIN { update } #REWRITE(p,'console:'); #IF lookup(ofilename) %THEN BEGIN ,RESET(ocatfile ;setdex; 9END 4ELSE BEGIN :WRITE('Delete ',ocat[oo].filename:18); :WRITELN(ocat[oo].vol_name:10); 9END; %IF NOT ofileend THEN BEGIN  vol ) 4THEN BEGIN ;nrec:=nrec+1; ;ncat[nrec]:=ocat[oo]; ;IF nrec=nlrec THEN writecat;D; 8 ,32 :BEGIN :WRITE('Delete ',ocat[orec].file_name:18); :WRITELN(ocat[orec].vol_name:10); :orec:=orec+1; 8END; *END; { CASE z } & &setdex; %END; { with } #IF (nrec=nlrec) THEN writecat; #IF ((orec >olrec ) AND NOT ofileend) %THEN BEile ',target,' not found'); &CLOSE(ncatfile); &CLOSE(p); &wait %END; { search } % #BEGIN { main } $IF (NOT lookup(nfilename) OR NOT lookup(pfilename)) THEN initialize; $get_sys_vol(systemvolume); $dlrec:=maxrec;olrec:=maxrec;nlrec:=maxrec; $readdex; $REPEAT &remov:=FALSE;nfileend:=remov;ofileend:=remov;done:=remov; &nrec:=0;orec:=0;drec:=0; &ntotrec:=0;ototrec:=0; &vol:=' '; &REPEAT (PAGE(OUTPUT); (mem('Main'); (WRITE('CATALOG --> S(earch D(isplay B(ackup U(pdate R(emove Q(ui צ'Enter name of volume to be removed --> ``ȡ:ץ`ˡ`צ:`צ ````|ب+ צ is ( Rj1M 1M צ Ƅ'Ƅ'P-̄'Ƅ'Ƅ'WƄ'jƁ-#5:cat.point.dataب H` תڪ"áP ˡHצI/O result for צ is   צPress space bar to continue>تPZMemory available at procedure eate one? (y/n) @@@@AAZZAZ̍ʍȡAZAƋצ#5:cat.point.dataʋɥƋƋצ#5:cat.point.data written to diskJFile צ#5:cat.point.data exists.ƋT<7ib#5:cat.point.dataצThere is no file named #5:cat.point.dataצ on this disk.צ!Do you wish to create one? (y/n) @@@@AAZZAZ̍ʍȡAZAƋצ#5:cat.point.dataʋɥƋƋצ#5:cat.point.data written to diskJFNצ#5:mastcat.data already exists on this volume.#5:cat.point.dataצThere is no file named #5:cat.point.dataצ on this disk.צ!Do you wish to crizing.....̍ʍ תʍצ ʍ ʍ  ʍ ʍ  dʍ ̍ʍȡڦ#5:mastcat.data̍ʍȡƋƌצ#5:mastcat.dataThere is no file named צ#5:mastcat.data on this disk.!Do you wish to create one? (y/n) @@@@InitialBB*WRITTEN BY EDWARD HEYMAN pjCATALOG INITIALI )'Q','q':REPEAT 2get_sys_vol(test); 2IF (test = systemvolume) 7THEN EXIT(PROGRAM) 7ELSE WRITELN('Insert system disk and hit return '); 2READLN(ch); 1UNTIL FALSE; (END; { case } #UNTIL FALSE; !END. F & " ' ' " ) - % % 5 " p t'); (READ(KEYBOARD,ch); (WRITELN; &UNTIL (ch IN ['S','D','B','U','R','Q','s','d','b','u','r','q']); &CASE ch OF )'U','u':update; )'s','S':search; )'D','d':display; )'R','r':BEGIN 3remov:=TRUE; 3enter_vol_name; 3update 0 END; )'B','b':backup; +-$JanFebMarAprMayJunJulAugSepOctNovDec++-+  + .+צ?Bad blockCode fileText fileInfo fileData fileGraf fileFoto file  L` ب++ ++ +   +X dd sdצ    á؂  d     ۡ$ۓZɡ*ZȡAZAAZA .oq>F~z+צconsole:צ#5:backcat.data%#5:backcat.data5Τ 6 !.,.0 @ "$&(á 󓄡 ȡȡ쥅`-á EצDelete MAdd  MצDelete AZáAZRAAZ`MɡMߢ !"ߢ!!ߥ!ߥ!!ق!ō !عREE.SPACEתƃ Ƅ ʄƄ ʄ̄ Ƅ ʄƄ ƃƄ ʄ ʄ M ʄ M ʄ4ġdš1AZAZáAZáAZʃM ̄ ʄ šM̄ ʄ ƃʄ ʄ ƃ Ƅ ʄ Ƅ ʄ ̄ Ƅ ʄ Ƅ ƃƄ ʄ ʄ ʄ ʄ ʄ  ʄ ʄ ʄʄ  ̄ʃ̃M̄ʄƃʄ Fer for required directory --> ƃ ʃ0ʃM "ˡ(צUnit not on lineƃM ƃ ƄƃƄƃ̄ƄƃƄƃƄ̃M ̄ʃʄȡ records.ġXMM5MMMM. Done sorting$ ̄Getdir-Enter unit numb ̄ Ƅ Ƅ Ƅ M ̄ ʄ ȡ@M ̄ ʄ  MASTCAT.DATAׯʄ  BACKCAT.DATAתM Z(Ɓ-#5:cat.point.dataإ HSorting  ؄  d<צ#5:mastcat.data not present.+IE M  M  Ƅ Ƅ  ' The following files are not backed up:dצ#5:mastcat.data؄+  ȡS  ȡ d;צ#5:mastcat.data not presentThe master catalog contains   records.+ *+צconsole:צ#5:mastcat.data٢  d٢ ddȡ)dd.  dW +צconsole:צ#5:mastcat.data]d#5:mastcat.data  sצ    á؂     áx٦ ת٢צ ٢ ٢  ٢ ̄̄ʄʄȡʄM ʄ̄צ#5:backcat.data #5:backcat.data d#5:mastcat.data+צBackcat contains   recordsMastcat contains  צ recordsd)( ?? ȡ-?ˡ  d+`P צ ?:ײ? ?*)  FUNCTION NUMOFQUES (VAR NAME:STRING) : INTEGER;  VAR #I, DIGITS : INTEGER;  BEGIN #DIGITS := 0; #DELETE (NAME,1,LENGTH(NAME)-2); #FOR I := 1 TO LENGTH (NAME) DO &DIGITS := DIGITS * 10 + ORD(NAME[I])-ORD('0'); #NUMOFQUES := DIGITS  END; (*NUAY[1..MAXSIZE] OF STRING /END;  VAR $F : TEXT; $WORD : THESAURUS; $I : INTEGER; $STR : STRING; $FILENAME : STRING[23]; $TEMPNAME : STRING; $ !(*DETERMINES NO.OF WORD PAIRS IN THIS*)  (*LESSON BY PEELING NON-NUMERICAL CHARSPROGRAM MAKELESSON;   (*PREPARES MODULES FOR USE WITH FLASHCARD*)  (*PROGRAM BY MAX J.NAREFF 9/81*)   CONST #MAXSIZE = 99; (*LIMIT OF WORD PAIRS IN ARRAY*) '  TYPE #THESAURUS = RECORD 2Q : PACKED ARRAY[1..MAXSIZE] OF STRING; 2A : PACKED ARRN^#ʢ{\\X6צ"Insert system disk and hit return pBuhn &*,.02468:<>@DHJLNPRTVXZ\^fd+b 0@97vn znb ~rv42  `צ  צMainצ:CATALOG --> S(earch D(isplay B(ackup U(pdate R(emove Q(uit..{\\X6צ"Insert system disk and hit return pBuhn &*,.02468:<>@DHJLNPRTVXZ\^f#5:cat.point.dataX   `צ  צMainצ:CATALOG --> S(earch D(isplay B(ackup U(pdate R(emove Q(uit..d? Ä ? Ą   ōd٥d ؓ:File ? not foundd+  dڥ+Wצ#5:mastcat.data?ȡ?P?š"צName too long!MOFQUES*)   PROCEDURE NAMEFILE;  VAR $ERROR : STRING; $SUCCESSFUL : BOOLEAN;  BEGIN #REPEAT &WRITELN;WRITELN  (' NOTE-LAST 2 CHARS IN FILENAME MUST BE'); # WRITELN;WRITELN  ('N0.OF WORD PAIRS ENTERED INTO MODULE.'); &WRITELN;WRITELN +('RANGE 10-99.':26); &WRITELN;WRITELN 1('EX: #4:SPANISH20':28); &WRITELN;WRITELN  ('ENTER ''VOL:FILENAME'' OF THE FILE TO BE'); &WRITELN ('OPENED.'); &WRITE (' ':15); &READLN (FILENAME); )(*$R-*) (*RANGE CHECK OFF*) &TEMPNAME := FILENAME; )(*$P c)PצINPUT COMPLETE% n楡ȡB0c) c)Shץ/ THE ENDENTER   WORD-PAIRS AS QUESTION צTHEN ANSWER ,ETC.楡ȡצ Q  P0c)Pצ A  DISK DRIVEתP"RDISK DRIVE NOT ON LINEתPLצILLEGAL FILE NAMEP2צFILE NOT ON DISKP Y_ Dg0I/O ERROR CODE # "  USE CORRECT INPUT* r SPANISH20צ&ENTER 'VOL:FILENAME' OF THE FILE TO BEצOPENED. Pצ.TEXTá!+++.TEXT+*"á*ERROR IN FILENAME OR ȡ ܛ0:( NOTE-LAST 2 CHARS IN FILENAME MUST BE%N0.OF WORD PAIRS ENTERED INTO MODULE.צ RANGE 10-99.צEX: #4:B*MAKELESS ; (*STORAGE*)   BEGIN (*MAIN*) #PAGE (OUTPUT); #NAMEFILE; #DATAINPUT; #STORAGE; #WRITELN ('THE END':23)  END.  *WITH*) &WRITELN ('INPUT COMPLETE':27)  END; (*DATAINPUT*)   PROCEDURE STORAGE;  BEGIN #WITH WORD DO &BEGIN )FOR I := 1 TO NUMOFQUES(TEMPNAME) DO ,BEGIN /WRITELN (F, Q[I]); /WRITELN (F, A[I]) ,END (*FOR*) &END; (*WITH*) #CLOSE (F,LOCK)  END#WRITELN ('THEN ANSWER ,ETC.'); #WRITELN; #WITH WORD DO &BEGIN )FOR I := 1 TO NUMOFQUES(TEMPNAME) DO ,BEGIN /WRITE (' Q':5,I,' '); /READLN (STR); /Q[I] := STR; / /WRITE (' A':5,I,' '); /READLN (STR); /A[I] := STR ,END (*FOR I*) &END; (USE CORRECT INPUT'); +WRITELN (ERROR:30) ((*$I+*) (END (*IF*) #UNTIL (SUCCESSFUL)  END; (*NAMEFILE*)   PROCEDURE DATAINPUT;  BEGIN #WRITELN;WRITELN  ('ENTER ',NUMOFQUES(TEMPNAME),' WORD-PAIRS AS QUESTION '); OR DISK DRIVE'; & +CASE IORESULT OF -2,5,9 : ERROR := .'DISK DRIVE NOT ON LINE'; -7 : ERROR := 3'ILLEGAL FILE NAME'; -10 : ERROR := 4'FILE NOT ON DISK' +END; (*CASE*) + +WRITELN (CHR(7)); +WRITELN  ('I/O ERROR CODE # ':18,IORESULT, 0' R+*) &IF POS('.TEXT',FILENAME)=0 THEN +FILENAME := CONCAT(FILENAME,'.TEXT'); ( ((*$I-*) (*AUTO IO CHECK OFF*) &SUCCESSFUL := FALSE; &REWRITE (F, FILENAME); &IF (IORESULT = 0) THEN (SUCCESSFUL := TRUE &ELSE (BEGIN +ERROR := ('ERROR IN FILENAME B HN0 AIRS AS QUESTION צTHEN ANSWER ,ETC.楡ȡצ Q  P0c)Pצ A  )^zʢUIS  AFTERWARD  ENSUITE  ALREADY  DEJA  ESPECIALLY  SUR TOUT  EACH  CHAQUE  NEAR  PRES DE  TIME  TEMPS  AFTER  APRES  BEHIND  DERRIERE  OFTEN  SOUVENT  BEFORE  AVANT  AT ONCE  TOUT DE SUITE  LATE  TARD  EARLY  EN AVANCE  AS LONG AS  TANT QUE  QUICKLY  VITE  WHILE  PENDANT QUE  ALWAYS  TOURJOURS  TOO MANY  TROP  LESS  MOINS  THEN  PN^ T FILE.  OR USE MAKELESSON PROGRAM, WHICH HAS  THE ADVANTAGE OF PROMPTING THE USER. $THE FLASHCARD PROGRAM OFFERS TWO  OPTIONS: ONE CALLS FOR TYPING CORRECT  ANSWER. TO STOP.THE SECOND IS  A SIMPLER DELAYED RESPONSE MODE. TO  ABORT.O  INDEX IT'S LOOPS, SO THAT SIZE CAN BE  CHANGED .FILENAMES, INCLUDING TERMINAL  DIGITS,MAY NOT EXCEED 10 CHARS.  PROGRAM WILL HANDLE 50 WORD PAIRS,BUT  CAN BE ADJUSTED FOR 99.   THE Q AND A PAIRS ARE PREPARED USING  THE EDITOR AND SAVED AS A TEX-HOWTOUSEIT.TEXT  $THE FLASHCARD5 PROGRAM HANDLES AL-  TERNATING QUESTION AND ANSWER PAIRS.NOTE  THE EXACT NUMBER OF WORD-PAIRS AND  INCLUDE THAT NUMBER AT THE END OF THE  OUTPUT FILENAME. EX-SPANISH10.THIS  DEVICE ENABLES THE FLASHCARD PROGRAM T MORSE MAIN SETENV EXEC INSTR 8ByJ N^ۡ \P\11ȡ91122Qá 11 \ z`|v \ \\$$<B6Z FQ $SPEED (1-100): 0 0áe00צTYPE TO BEGIN צMORSE CODE SENDER----------------- MESSAGE:  P  OR Q(UIT? 22@22צ FILENAME? 3P\3"ˡ]צ CAN'T OPEN 3צTYPE TO CONTINUE & FQ UPT THE PROGRAM DURINGצ THE CODE TRANSMISSION, TYPE 'Q'.צTYPE TO CONTINUE MORSE CODE SENDERצ-----------------K(EYBOARD, F(ILE,EFOR THE SOURCE, OR PRACTICE ONEצ!LINE AT A TIME FROM THE KEYBOARD.YOU CAN SELECT THE SPEED AND צ!PITCH OF THE CODE STREAM. DEFAULT PITCH IS 40.TO INTERRMORSE CODE SENDERצ-----------------INSTRUCTIONS (Y/N)? 222YáצTHIS PROGRAM PRODUCES AUDIBLE MORSE CODE FOR RECOGNITION PRAC- TICE. YOU CAN SELECT A TEXT FIL +-k} ]m:<>B}{umg_W 6צTYPE TO CONTINUEp ~X Zv ȡR "ع϶SET SPECIAL PARAMETERS (Y/N)? 222Yˡ (צ DELAY BASE?  צ TONE PITCH?  צ DOT LENGTH?  צ DASH LENGTH?  ؏0"@* (*$I-*)  PROGRAM MORSE;  (*U *:SYSTEM.LIBRARY*)  USES APPLESTUFF;    VAR "BASE : INTEGER; "PITCH : INTEGER; "DOTLEN : INTEGER; "DASHLEN : INTEGER;  "MESSAGE : STRING; "SPEED : INTEGER; "I : INTEGER; "COMMAND : CHAR; "FILEE SOURCE, OR PRACTICE ONE'); $WRITELN('LINE AT A TIME FROM THE KEYBOARD.'); $WRITELN; $WRITELN('YOU CAN SELECT THE SPEED AND '); $WRITELN('PITCH OF THE CODE STREAM. DEFAULT'); $WRITELN('PITCH IS 40.'); $WRITELN; $WRITELN('TO INTERRUPT THE PROGRAM DU'INSTRUCTIONS (Y/N)? '); "READ(KEYBOARD,COMMAND); "WRITELN(COMMAND); "IF COMMAND = 'Y' THEN BEGIN $WRITELN('THIS PROGRAM PRODUCES AUDIBLE'); $WRITELN('MORSE CODE FOR RECOGNITION PRAC-'); $WRITELN('TICE. YOU CAN SELECT A TEXT FILE'); $WRITELN('FOR TH"DOT; DASH; DOT; DASH; DOT; "WRITELN; "WRITELN('TYPE TO CONTINUE'); "READLN; "  END; (* ENDMESSAGE *)    PROCEDURE INSTRUCT;   BEGIN  "PAGE(OUTPUT); "WRITELN('MORSE CODE SENDER'); "WRITELN('-----------------'); "WRITELN; WRITE(H; DOT; DOT; DOT; END; $'(', $')': BEGIN DASH; DOT; DASH; DASH; DOT; DASH; END; $' ': BEGIN DELAY(3); END; $ "END; (* CASE *)   END; (* LETTER *)    PROCEDURE ENDMESSAGE;   BEGIN  "WRITELN; WRITELN(''); "DELAY(3); ; DASH; DASH; DOT; END; $'.': BEGIN DOT; DASH; DOT; DASH; DOT; DASH; END; $',': BEGIN DASH; DASH; DOT; DOT; DASH; DASH; END; $'?': BEGIN DOT; DOT; DASH; DASH; DOT; DOT; END; $';': BEGIN DASH; DOT; DASH; DOT; DASH; DOT; END; $':': BEGIN DASH; DASH; DASDASH; END; $'4': BEGIN DOT; DOT; DOT; DOT; DASH; END; $'5': BEGIN DOT; DOT; DOT; DOT; DOT; END; $'6': BEGIN DASH; DOT; DOT; DOT; DOT; END; $'7': BEGIN DASH; DASH; DOT; DOT; DOT; END; $'8': BEGIN DASH; DASH; DASH; DOT; DOT; END; $'9': BEGIN DASH; DASH$'Y': BEGIN DASH; DOT; DASH; DASH; END; $'Z': BEGIN DASH; DASH; DOT; DOT; END; $'0': BEGIN DASH; DASH; DASH; DASH; DASH; END; $'1': BEGIN DOT; DASH; DASH; DASH; DASH; END; $'2': BEGIN DOT; DOT; DASH; DASH; DASH; END; $'3': BEGIN DOT; DOT; DOT; DASH; DASH; DOT; END; $'S': BEGIN DOT; DOT; DOT; END; $'T': BEGIN DASH; END; $'U': BEGIN DOT; DOT; DASH; END; $'V': BEGIN DOT; DOT; DOT; DASH; END; $'W': BEGIN DOT; DASH; DASH; END; $'X': BEGIN DASH; DOT; DOT; DASH; END; N DASH; DOT; DASH; END; $'L': BEGIN DOT; DASH; DOT; DOT; END; $'M': BEGIN DASH; DASH; END; $'N': BEGIN DASH; DOT; END; $'O': BEGIN DASH; DASH; DASH; END; $'P': BEGIN DOT; DASH; DASH; DOT; END; $'Q': BEGIN DASH; DASH; DOT; DASH; END; $'R': BEGIN DOT;; END; $'D': BEGIN DASH; DOT; DOT; END; $'E': BEGIN DOT; END; $'F': BEGIN DOT; DOT; DASH; DOT; END; $'G': BEGIN DASH; DASH; DOT; END; $'H': BEGIN DOT; DOT; DOT; DOT; END; $'I': BEGIN DOT; DOT; END; $'J': BEGIN DOT; DASH; DASH; DASH; END; $'K': BEGI PROCEDURE DASH;   BEGIN  "NOTE(PITCH,DASHLEN); "DELAY(1); "  END; (* DASH *)    PROCEDURE LETTER(CH : CHAR);   BEGIN  "CASE CH OF " $'A': BEGIN DOT; DASH; END; $'B': BEGIN DASH; DOT; DOT; DOT; END; $'C': BEGIN DASH; DOT; DASH; DOTTENV *)    PROCEDURE DELAY(LEN : INTEGER);   VAR TIME : INTEGER;   BEGIN  "FOR TIME := 1 TO (BASE*LEN*SPEED) DO; "  END; (* DELAY *)    PROCEDURE DOT;   BEGIN  "NOTE(PITCH,DOTLEN); "DELAY(1); "  END; (* DOT *)   $DOTLEN := 7; $DASHLEN := 25; "END "ELSE BEGIN $WRITELN; $WRITE('DELAY BASE? '); $READLN(BASE); $WRITE('TONE PITCH? '); $READLN(PITCH); $WRITE('DOT LENGTH? '); $READLN(DOTLEN); $WRITE('DASH LENGTH? '); $READLN(DASHLEN); "END; "  END; (* SENAME: STRING; "F : TEXT; "INTERACTIVE *: BOOLEAN; " "  PROCEDURE SETENV;   BEGIN  "WRITE('SET SPECIAL PARAMETERS (Y/N)? '); "READ(KEYBOARD,COMMAND); "WRITE(COMMAND); "IF COMMAND <> 'Y' THEN BEGIN $WRITELN; $BASE := 10; $PITCH := 40;RING'); $WRITELN('THE CODE TRANSMISSION, TYPE ''Q''.'); $WRITELN; WRITELN; WRITELN; $WRITELN('TYPE TO CONTINUE'); $READLN; "END; "  END; (* INSTRUCT *) " "  PROCEDURE EXECUTE;   BEGIN  "PAGE(OUTPUT); "WRITELN('MORSE CODE SENDER'); "WRITELN('-----------------'); "WRITE('K(EYBOARD, F(ILE, OR Q(UIT? '); "REPEAT $READ(KEYBOARD,COMMAND); "UNTIL COMMAND IN ['K','F','Q']; "WRITE(COMMAND); "CASE COMMAND OF $ $'K': BEGIN $ INTERACTIVE := TRUE; TRIX RECORD TO PEEK INTO MEMORY  LOCATIONS OF THE CURRENT HORIZONTAL AND VERTICAL  POSITIONS OF THE CURSOR. USES THESE LOCATIONS TO  FORMAT SCREEN OUTPUT.   STEPLOOPS2.TEXT-  A SECOND EXCURSION INTO ADAPTING "FOR" LOOPS FOR  STEP-UP AND STEP-DOWN FLASHCARD5.TEXT-A FLASHCARD PROGRAM  WITH TWO OPTIONS.   FRENCH20.TEXT-AN EXAMPLE OF A TEXT FILE  USED WITH FLASHCARD PROGRAM.  MAKELESSON.TEXT-A PROGRAM FOR ENTERING  LESSONS FOR THE FLASHCARD5 PROGRAM. .  FORMATTER2.TEXT-  DEMOS THE USE OF A 0DOM-NOTES   REALPROOF2.TEXT-AN EXPERIMENT IN FAIL-  SAFE REAL NUMBER INPUT.CONVERTS ALL  REAL NUMBER FORMS,INCLUDING SCIENTIFIC  TO STANDARD.   HOWTOUSEIT.TEXT-DOCUMENTATION FOR THE  FLASHCARD AND IT'S PREPARATORY MAKE-  LESSON PROGRAM.   (^z[D; $  END. (* MAIN *)  XECUTE); &END; $END; $WRITELN; $IF INTERACTIVE THEN BEGIN &ENDMESSAGE; &EXIT(EXECUTE); $END; "UNTIL EOF(F); " "ENDMESSAGE;   END; (* EXECUTE *)     BEGIN (* MAIN *)  "INSTRUCT; "WHILE TRUE DO BEGIN " EXECUTE; $CLOSE(F,LOCK); "EN"ELSE GOTOXY(0,6); " "REPEAT $IF NOT INTERACTIVE THEN &READLN(F,MESSAGE); $FOR I := 1 TO LENGTH(MESSAGE) DO BEGIN &LETTER(MESSAGE[I]); &DELAY(2); &WRITE(MESSAGE[I]); &IF KEYPRESS THEN BEGIN (READ(KEYBOARD,COMMAND); (IF COMMAND = 'Q' THEN EXIT(ETYPE TO BEGIN'); "READLN; "PAGE(OUTPUT); "WRITELN('MORSE CODE SENDER'); "WRITELN('-----------------'); "GOTOXY(0,4); WRITELN('MESSAGE: '); "IF INTERACTIVE THEN BEGIN $GOTOXY(9,4); $READLN(MESSAGE); $GOTOXY(9,4); "END -EXIT(EXECUTE); +END; )END; ) $'Q': EXIT(PROGRAM); " "END; (* CASE *) " "SETENV; - "WRITE('SPEED (1-100): '); "READLN(SPEED); "IF SPEED = 0 THEN EXIT(PROGRAM); "SPEED := 101 - SPEED; (*USE AS DELAY FACTOR *) "WRITELN; WRITELN; "WRITELN('+WRITELN; )END; $'F': BEGIN +INTERACTIVE := FALSE; +WRITELN; +WRITE('FILENAME? '); +READLN(FILENAME); +RESET(F,FILENAME); +IF IORESULT <> 0 THEN BEGIN -WRITELN('CAN''T OPEN ',FILENAME); -WRITELN; -WRITELN('TYPE TO CONTINUE'); -READLN;OPERATIONS.  CSUBMITTED BY MAX J.NAREFF   CAT.TEXT/CODE-  A disk cataloging program from Mark  Snow. Uses disk on unit 5. Change  program for other units.   XREF1.TEXT-  Corrections and additions to the  crossref program on APPLE3.   MORSE.CODE/TEXT-  A program for practicing your ... what  else?   And others by MAX J. Nareff with  internal documentation. 0DOM-NOTES   REALPROOF2.TEXT-AN EXPERIMENT IN FAIL-  SAFE REAL NUMBER INPUT.CONVERTS ALL  REAL NUMBER FORMS,INCLUDING SCIENTIFIC  TO STANDARD.   HOWTOUSEIT.TEXT-DOCUMENTATION FOR THE  FLASHCARD AND IT'S PREPARATORY MAKE-  LESSON PROGRAM.    MORSE.CODE/TEXT-  A program for practicing your ... what  else?   And others by MAX J. Nareff with  internal documentation. OPERATIONS.  CSUBMITTED BY MAX J.NAREFF   CAT.TEXT/CODE-  A disk cataloging program from Mark  Snow. Uses disk on unit 5. Change  program for other units.   XREF1.TEXT-  Corrections and additions to the  crossref program on APPLE3.  TRIX RECORD TO PEEK INTO MEMORY  LOCATIONS OF THE CURRENT HORIZONTAL AND VERTICAL  POSITIONS OF THE CURSOR. USES THESE LOCATIONS TO  FORMAT SCREEN OUTPUT.   STEPLOOPS2.TEXT-  A SECOND EXCURSION INTO ADAPTING "FOR" LOOPS FOR  STEP-UP AND STEP-DOWN FLASHCARD5.TEXT-A FLASHCARD PROGRAM  WITH TWO OPTIONS.   FRENCH20.TEXT-AN EXAMPLE OF A TEXT FILE  USED WITH FLASHCARD PROGRAM.  MAKELESSON.TEXT-A PROGRAM FOR ENTERING  LESSONS FOR THE FLASHCARD5 PROGRAM. .  FORMATTER2.TEXT-  DEMOS THE USE OF A 0DOM-NOTES   REALPROOF2.TEXT-AN EXPERIMENT IN FAIL-  SAFE REAL NUMBER INPUT.CONVERTS ALL  REAL NUMBER FORMS,INCLUDING SCIENTIFIC  TO STANDARD.   HOWTOUSEIT.TEXT-DOCUMENTATION FOR THE  FLASHCARD AND IT'S PREPARATORY MAKE-  LESSON PROGRAM.   FLASHCARD5.TEXT-A FLASHCARD PROGRAM  WITH TWO OPTIONS.   FRENCH20.TEXT-AN EXAMPLE OF A TEXT FILE  USED WITH FLASHCARD PROGRAM.  MAKELESSON.TEXT-A PROGRAM FOR ENTERING  LESSONS FOR THE FLASHCARD5 PROGRAM. .  FORMATTER2.TEXT-  DEMOS THE USE OF A TRIX RECORD TO PEEK INTO MEMORY  LOCATIONS OF THE CURRENT HORIZONTAL AND VERTICAL  POSITIONS OF THE CURSOR. USES THESE LOCATIONS TO  FORMAT SCREEN OUTPUT.   STEPLOOPS2.TEXT-  A SECOND EXCURSION INTO ADAPTING "FOR" LOOPS FOR  STEP-UP AND STEP-DOWN CAT(file_name,sps); -file_kind:=dir_file_kind; -file_date:=dir_file_date; -file_size:=last_block - first_block; -blocks_used:=blocks_used + file_size; ,END; { with } )END; { if length } 'END; { with dirx } %END; { for } % 'drec:=drec+1; 'WITH dc TO dirx[0].num_of_files DO %BEGIN &WITH dirx[i] DO 'BEGIN (IF LENGTH(dir_file_name)>0 )THEN *BEGIN +drec:=drec+1; +WITH dcat[drec] DO ,BEGIN -vol_name:=vol; -file_name:=dir_file_name; -sps:=COPY(blanks,1,15-LENGTH(file_name)); -file_name:=CON$UNTIL unitnum in [4,5,9,10]; $UNITREAD(unitnum,dirx[0],2048,2); $IF IORESULT <> 0 %THEN &BEGIN 'WRITELN('Unit not on line'); 'EXIT(catalog); &END; $vol:=dirx[0].dir_vol_name; $sps:=COPY(blanks,1,7-LENGTH(vol)); $vol:=CONCAT(vol,sps); $FOR i:=1sps:STRING[16]; &blocks_used:0..988; & "BEGIN #blocks_used:=6 ; { for apple single directory =6 blocks } #drec:=0; $mem('Getdir'); $REPEAT %WRITE('Enter unit number for required directory --> '); %READLN(unitnum); %WRITELN uf:=dcat[i]; 0dcat[i]:=dcat[i-1]; 0dcat[i-1]:=buf; 0flag:=FALSE; .END; 'WRITE('.'); %UNTIL flag; %WRITELN; %WRITELN('Done sorting'); #END; { sort } # !PROCEDURE getdir; "VAR &dirx:directory; &unitnum,i:INTEGER; &chbuf:CHAR; &vol:vol_id; &ex } $ #PROCEDURE sort; $VAR i:recnum; (buf:catalog_record; (flag:BOOLEAN; ( $BEGIN %WRITELN('Sorting ',drec,' records.'); %REPEAT &flag:=TRUE; &FOR i:=drec DOWNTO 2 DO (IF (dcat[i].file_name < dcat[i-1].file_name) )THEN BEGIN { exchange } 0b+THEN dir_file_name:='BACKCAT.DATA'; )END; 'UNITWRITE(5,dir[0],2048,2); %END; % #PROCEDURE writedex; $VAR dexfile:FILE OF indexarray; $ $BEGIN %REWRITE(dexfile,pfilename); %dexfile^:=dexray; %PUT(dexfile); %CLOSE(dexfile,LOCK); $END; { writedBEGIN 'UNITREAD(5,dir[0],2048,2,12); 'vol:=dir[0].dir_vol_name; 'sps:=COPY(blanks,1,7-LENGTH(vol)); 'avol:=CONCAT(vol,sps); 'FOR i:=1 TO dir[0].num_of_files DO (WITH dir[i] DO )BEGIN *IF (dir_file_name='MASTCAT.DATA') filename,' not present.'); 'CLOSE(p); 'wait; %END; { backup } % % "PROCEDURE update; " #VAR dcat:ARRAY [dir_size] OF catalog_record; (rn:recnum; ( #PROCEDURE rename; $VAR (i:INTEGER; (sps:STRING[16]; (vol,avol:vol_id; (dir:directory; ( %EN print_record(ncat[n]); 1pass:=true; 1IF (ncat[nrec].file_name <> ncat[nrec-1].file_name) 5THEN unback:=TRUE; 1ncat[0]:=ncat[nrec]; 0 IF (nfileend AND unback) THEN print_record(ncat[nrec]); 0UNTIL nfileend; 0CLOSE(ncatfile); /END )ELSE WRITELN(n0REPEAT 1IF (pass AND unback) 3THEN IF (ncat[0].file_name <> ncat[1].file_name) 5THEN print_record(ncat[0]); 1read_new_cat; 1FOR n:=1 TO nrec-1 DO 3IF ((ncat[n].file_name <> ncat[n-1].file_name) AND 9(ncat[n].file_name <> ncat[n+1].file_name)) = dex &THEN BEGIN -IF ncat[nrec].file_name[1] > dex /THEN REPEAT 6dexray[dex]:=0; 6IF dex='Z' THEN EXIT(setdex); 6dex:=SUCC(dex); 4UNTIL ncat[nrec].file_name[1] = dexncat[n]); (UNTIL nfileend; (CLOSE (ncatfile); (wait; (CLOSE(p); (EXIT(search); &END; {vsearch} & %BEGIN &stop:=FALSE;found:=stop; &REPEAT (WRITE('Enter name of file to find -->'); (READLN(target); (IF LENGTH(target) > 16 THEN WRITELN('Name tocnum; * &BEGIN (blks:=' '; (DELETE(target,POS(':',target),1); (sps:=COPY(blks,1,7-LENGTH(target)); (target:=CONCAT(target,sps); (WRITELN(target); (REPEAT *read_new_cat; *FOR n:=1 TO nrec DO +IF ncat[n].vol_name = target THEN print_record((FOR n:=1 TO nrec DO IF POS (target,ncat[n].file_name) <> 0 ATHEN print_record(ncat[n]); &UNTIL (nfileend); &CLOSE(ncatfile); &wait; &CLOSE(p); &EXIT(search); %END; { longsearch } % $PROCEDURE search_for_volume; &VAR *blks,sps:STRING[7]; *n:reRE search; #VAR (stop,found:BOOLEAN; (tar1,tar2:CHAR; (start:INTEGER; (wildcard:0..16; (cat:catalog_record; (target,sps:STRING; ( $PROCEDURE longsearch; %VAR n:recnum; % %BEGIN &DELETE(target,1,1); &WRITELN(target); &REPEAT (read_new_cat; c:=0; #REWRITE(ncatfile,nfilename); #nrec:=0; #merge; #CLOSE(ocatfile); #CLOSE(p); #WRITELN('Backcat contains ',ototrec, ' records'); #WRITELN('Mastcat contains ',ntotrec,' records'); #CLOSE(ncatfile,LOCK); #wait; "END; { update } " " !PROCEDU,ofilename); ,CLOSE(ocatfile,PURGE); *END; # #rename; #IF NOT remov (THEN BEGIN /getdir; /sort; /FOR rn:=1 TO drec DO print_record(dcat[rn]); -END; #IF lookup(ofilename) &THEN BEGIN -RESET(ocatfile,ofilename); -read_old_cat; +END % ELSE ore$UNTIL NOT continue; $IF dex < 'Z' 'THEN FOR ch:=dex TO 'Z' DO dexray[ch] := dexray[PRED(dex)]; $done:=TRUE; $writecat; $writedex; "END; { merge } " " "BEGIN { update } #REWRITE(p,'console:'); #IF lookup(ofilename) %THEN BEGIN ,RESET(ocatfile ;setdex; 9END 4ELSE BEGIN :WRITE('Delete ',ocat[oo].filename:18); :WRITELN(ocat[oo].vol_name:10); 9END; %IF NOT ofileend THEN BEGIN  vol ) 4THEN BEGIN ;nrec:=nrec+1; ;ncat[nrec]:=ocat[oo]; ;IF nrec=nlrec THEN writecat;D; 8 ,32 :BEGIN :WRITE('Delete ',ocat[orec].file_name:18); :WRITELN(ocat[orec].vol_name:10); :orec:=orec+1; 8END; *END; { CASE z } & &setdex; %END; { with } #IF (nrec=nlrec) THEN writecat; #IF ((orec >olrec ) AND NOT ofileend) %THEN BE:WRITE('Add ',ncat[nrec].file_name:18); :WRITELN(ncat[nrec].vol_name:10) 8END; ,22 :BEGIN :nrec:=nrec+1; :ncat[nrec]:=dcat[d]; :orec:=orec+1; :d:=d+1 8END; ,23,31,33 :BEGIN 9nrec:=nrec+1; 9ncat[nrec]:=ocat[orec]; 9orec:=orec+1; 8EN) +THEN y:=1 +ELSE IF (vol_name = ocat[orec].vol_name) 3THEN y:=2 3ELSE y:=3; 3 )z:=x+y; )IF ((orec=0) OR (orec >o)) THEN z:=11; ) )CASE z OF +11,12,13,21 :BEGIN :nrec:=nrec+1; :ncat[nrec]:=dcat[d]; :d:=d+1; v THEN vol:=dcat[1].vol_name; % %WHILE (d < drec+1 ) DO &BEGIN 'WITH dcat[d] DO (BEGIN )IF (file_name < ocat[orec].file_name) +THEN x:=10 +ELSE IF (file_name = ocat[orec].file_name) 3THEN x:=20 3ELSE x:=30; 3 )IF (vol_name < ocat[orec].vol_name; -dexray[dex] :=ntotrec+nrec; -IF dex='Z' THEN EXIT(setdex); -dex:=SUCC(dex); +END; %END; { setdex } % "PROCEDURE merge; $VAR (x,y,z:1..33; (continue:BOOLEAN; (oo,o,d:recnum; ( $BEGIN %dex:='A'; %o:=orec; %orec:=1; %d:=1; % %IF NOT remoo long!'); &UNTIL LENGTH(target) <= 16; &IF POS('<',target) = 1 THEN -BEGIN /DELETE(target,1,1); /REWRITE(p,'printer:'); -END (ELSE REWRITE(p,'console:'); &RESET(ncatfile,nfilename); &IF POS(':',target) <> 0 THEN search_for_volume; &wildcard:=POS('=',target); &IF wildcard=1 THEN longsearch; &IF wildcard >1 THEN target:=COPY(target,1,wildcard-1); &tar1:=target[1]; &IF (wildcard <>2) *THEN tar2:=target[2] *ELSE tar2:='Z'; &IF tar1 < 'A' )THEN start:=0 )ELSE IF (tar1 > 'Z') ile צ#5:cat.point.data exists.ƋT<7ib#5:cat.point.dataצThere is no file named #5:cat.point.dataצ on this disk.צ!Do you wish to create one? (y/n) @@@@AAZZAZ̍ʍȡAZAƋצ#5:cat.point.dataʋɥƋƋצ#5:cat.point.data written to diskJFNצ#5:mastcat.data already exists on this volume.#5:cat.point.dataצThere is no file named #5:cat.point.dataצ on this disk.צ!Do you wish to crizing.....̍ʍ תʍצ ʍ ʍ  ʍ ʍ  dʍ ̍ʍȡڦ#5:mastcat.data̍ʍȡƋƌצ#5:mastcat.dataThere is no file named צ#5:mastcat.data on this disk.!Do you wish to create one? (y/n) @@@@InitialBB*WRITTEN BY EDWARD HEYMAN pjCATALOG INITIALI )'Q','q':REPEAT 2get_sys_vol(test); 2IF (test = systemvolume) 7THEN EXIT(PROGRAM) 7ELSE WRITELN('Insert system disk and hit return '); 2READLN(ch); 1UNTIL FALSE; (END; { case } #UNTIL FALSE; !END. F & " ' ' " ) - % % 5 " p t'); (READ(KEYBOARD,ch); (WRITELN; &UNTIL (ch IN ['S','D','B','U','R','Q','s','d','b','u','r','q']); &CASE ch OF )'U','u':update; )'s','S':search; )'D','d':display; )'R','r':BEGIN 3remov:=TRUE; 3enter_vol_name; 3update 0 END; )'B','b':backup; $readdex; $REPEAT &remov:=FALSE;nfileend:=remov;ofileend:=remov;done:=remov; &nrec:=0;orec:=0;drec:=0; &ntotrec:=0;ototrec:=0; &vol:=' '; &REPEAT (PAGE(OUTPUT); (mem('Main'); (WRITE('CATALOG --> S(earch D(isplay B(ackup U(pdate R(emove Q(uiile ',target,' not found'); &CLOSE(ncatfile); &CLOSE(p); &wait %END; { search } % #BEGIN { main } $IF (NOT lookup(nfilename) OR NOT lookup(pfilename)) THEN initialize; $get_sys_vol(systemvolume); $dlrec:=maxrec;olrec:=maxrec;nlrec:=maxrec; (POS(target,cat.file_name) >= 1)) ?THEN BEGIN Fprint_record(cat); Ffound:=TRUE; DEND; (IF ((cat.file_name[1] > tar1 ) OR (cat.file_name[2] > tar2 )) .THEN stop := TRUE; (GET(ncatfile); &UNTIL (stop OR EOF(ncatfile)); &IF NOT found THEN WRITELN('F1THEN start:=dexray['Z'] 1ELSE start:=dexray[tar1]; &SEEK(ncatfile,start); &GET(ncatfile); &REPEAT (cat:=ncatfile^; (IF ((wildcard=0) AND (POS(target,cat.file_name) =1)) ATHEN BEGIN Gprint_record(cat); Gfound:=TRUE; FEND; (IF ((wildcard >1) ANDeate one? (y/n) @@@@AAZZAZ̍ʍȡAZAƋצ#5:cat.point.dataʋɥƋƋצ#5:cat.point.data written to diskJFڪ"áP ˡHצI/O result for צ is   צPress space bar to continue>تPZMemory available at procedure REE.SPACEתƃ Ƅ ʄƄ ʄ̄ Ƅ ʄƄ ƃƄ ʄ ʄ M ʄ M ʄ4ġdš1AZAZáAZáAZʃM ̄ ʄ šM̄ ʄ ƃʄ ʄ ƃ Ƅ ʄ Ƅ ʄ ̄ Ƅ ʄ Ƅ ƃƄ ʄ ʄ ʄ ʄ ʄ  ʄ ʄ ʄʄ  ̄ʃ̃M̄ʄƃʄ Fer for required directory --> ƃ ʃ0ʃM "ˡ(צUnit not on lineƃM ƃ ƄƃƄƃ̄ƄƃƄƃƄ̃M ̄ʃʄȡ records.ġXMM5MMMM. Done sorting$ ̄Getdir-Enter unit numb ̄ Ƅ Ƅ Ƅ M ̄ ʄ ȡ@M ̄ ʄ  MASTCAT.DATAׯʄ  BACKCAT.DATAתM Z(Ɓ-#5:cat.point.dataإ HSorting  ؄  d<צ#5:mastcat.data not present.+IE M  M  Ƅ Ƅ  ' The following files are not backed up:dצ#5:mastcat.data؄+  ȡS  ȡ d;צ#5:mastcat.data not presentThe master catalog contains   records.+ *+צconsole:צ#5:mastcat.data٢  d٢ ddȡ)dd.  dW +צconsole:צ#5:mastcat.data]d#5:mastcat.data  sצ    á؂     áx٦ ת٢צ ٢ ٢  ٢ + +   +X dd sdצ    á؂  d   +-$JanFebMarAprMayJunJulAugSepOctNovDec++-+  + .+צ?Bad blockCode fileText fileInfo fileData fileGraf fileFoto file  L` ب++ + צ'Enter name of volume to be removed --> ``ȡ:ץ`ˡ`צ:`צ ````|ب+ צ is ( Rj1M 1M צ Ƅ'Ƅ'P-̄'Ƅ'Ƅ'WƄ'jƁ-#5:cat.point.dataب H` תAZáAZRAAZ`MɡMߢ !"ߢ!!ߥ!ߥ!!ق!ō !عMAdd  MצDelete  answer to missing copy on operations with a bulletin board. Also it is possible to scan by subject if you don't always have hard- copy available when you sign on to telemail. J(erry).Stueve Command? C: US.US Subj: Easier way out of Telemail GOTCHA!! Winsor, the easiest way to scan for what has happened in a case as you mention is to use SCAN SINCE mo/day/yr where the year is only necessary if it is from a previous time.This is a much shorter{\\X6צ"Insert system disk and hit return pBuhn &*,.02468:<>@DHJLNPRTVXZ\^fd+b 0@97vn znb ~rv42  `צ  צMainצ:CATALOG --> S(earch D(isplay B(ackup U(pdate R(emove Q(uit..{\\X6צ"Insert system disk and hit return pBuhn &*,.02468:<>@DHJLNPRTVXZ\^f#5:cat.point.dataX   `צ  צMainצ:CATALOG --> S(earch D(isplay B(ackup U(pdate R(emove Q(uit..d? Ä ? Ą   ōd٥d ؓ:File ? not foundd+  dڥ+Wצ#5:mastcat.data?ȡ?P?š"צName too long!s  צ recordsd)( ?? ȡ-?ˡ  d+`P צ ?:ײ? ?̄̄ʄʄȡʄM ʄ̄צ#5:backcat.data #5:backcat.data d#5:mastcat.data+צBackcat contains   recordsMastcat contain  ۡ$ۓZɡ*ZȡAZAAZA .oq>F~z+צconsole:צ#5:backcat.data%#5:backcat.data5Τ 6 !.,.0 @ "$&(á 󓄡 ȡȡ쥅`-á EצDelete