#B
   .J
   NEW
   10 REM CRDFIL.BAS   Card File Program for Cambridge Z88
   14 :
   15 REM Slight mod to make file rename efficient, with OSCLI command
   16 REM based on BBC BASIC Ref Manual approach [3/21/89]
   17 :
   20 REM Converted from the Model 100/200 program CRDFIL.BAS
   30 REM Copyright 1987 Tony B. Anderson
   40 REM Converted to Z88 and distributed with author's permission
   45 REM Edit routines based on Model 100 code by Charles Lewis
   50 REM Z88 version Copyright Phil Wheeler 1989
   60 REM Z88 Version 1.3 [3/15/89] enhances the output capability,
   62 REM allowing selection of card entries to be outputed and
   64 REM their order in the output file.  The file can be edited
   66 REM in PipeDream for the desired format (e.g., mailing lists)
   68 REM and printed from PipeDream.
   78 :
   80 *NAME CRDFIL
   90 M=0
  100 CLEAR:M=0:BL$=CHR$(1)+"B"
  105 ON ERROR GOTO 2340
  110 CLS:PRINT TAB(0,0)BL$"Z88 CARD FILE PROGRAM -- Version 1.3"BL$
  120 PRINT TAB(0,2)BL$;"C";BL$;")reate a new card file";
  130 PRINT TAB(0,3)BL$;"A";BL$;")dd to existing card file";
  140 PRINT TAB(0,4)BL$;"D";BL$;")isplay a card file";
  145 PRINT TAB(0,5)BL$;"E";BL$;")dit a card file";
  150 PRINT TAB(0,6)BL$;"O";BL$;")utput a card file";
  155 PRINT TAB(0,7)BL$;"Q";BL$;")uit CRDFIL";
  160 ON((INSTR("aAcCdDeEoOqQ",GET$)+3) DIV 2) GOTO 90,670,180,520,2000,2500,170 
  170 CLOSE#0:CLS:END
  180 CLS
  190 PRINT:INPUT" Filename to Create";F$
  200 INPUT" Number of entries per card";N
  210 GOSUB 810
  220 FOR A=1 TO N:CLS:PRINT
  230   GOSUB 830
  240 NEXT
  250 CLS:PRINT TAB(0,1);"Now review your prompt screen.  Press any key to continue.";
  260 Q$=GET$:CLS
  270 FOR A= 1 TO N
  280   PROC_RC:PRINT TAB(COL,ROW);BL$;A$(A);BL$;
  290 NEXT:PRINT TAB(93,7);"";:Q$=GET$
  300 CLS:PRINT TAB(0,1);"Do you want to make any changes? (Y/N) ";:Q$=GET$:PRINTQ$:IFQ$=""THEN440
  310 IF INSTR("Nn",Q$) THEN 390
  320 FOR A=1 TO N:CLS:PRINT
  330   PRINT "Prompt #"A": ";BL$;A$(A);BL$:PRINT
  340   PROC_RC:PRINT"Line # ";ROW;"   Column # ";COL:PRINT
  350   PRINT" Is this one correct? (Y/N)";:Q$=GET$:PRINTQ$
  360   IFINSTR("Yy",Q$) THEN 380
  370   GOSUB 830
  380 NEXT:GOTO 250
  390 CLS:PRINT:PRINT" File now being created..."
  400 CLOSE#0:F%=OPENOUT(F$)
  410 PRINT#F%,N
  420 FOR A=1 TO N:PRINT#F%,A$(A):PRINT#F%,P(A):NEXT
  430 GOSUB 1060:GOSUB 1100
  440 CLS:FOR A=1 TO N
  450   PROC_RC:PRINT TAB(COL,ROW);BL$;A$(A);BL$;
  460   INPUT LINE B$(A):IF B$(A)="" THEN B$(A)=" "
  470   IFINSTR("ENDEndend",B$(A)) THEN RUN
  480 NEXT
  490 CLS:PRINTTAB(0,1);"Was all the data correct? (Y/N) ";:Q$=GET$:PRINTQ$
  500 IF INSTR("Nn",Q$) THEN GOSUB 1100:GOTO 440
  510 IF INSTR("Yy",Q$) THEN FOR A=1 TO N:PRINT#F%,B$(A):NEXT:GOTO 440 ELSE PROC_BEEP:GOTO 490
  520 CLS:PRINT TAB(0,2)BL$;"A";BL$;")ll card display";
  530 PRINT TAB(0,3)BL$;"S";BL$;")earch for word match";
  540 ON((INSTR("aAsS",GET$)+3) DIV 2) GOTO 520,550,590
  550 GOSUB 890:GOSUB 960
  560 IF EOF#F% THEN 580
  570 GOSUB 1030:GOSUB 1050:GOSUB 950:GOTO 560
  580 CLS:PRINT TAB(0,1);"Last card in file has been displayed.":GOTO 660
  590 GOSUB 890:GOSUB 960
  600 CLS:PRINT TAB(0,1);"What word/phrase would you like to search for";:INPUT LINE S$
  605 FOR A=1 TO LEN(S$): IF ASC(MID$(S$,A,1))>64 THEN Z$=S$:PROC_MID:S$=Z$:NEXT ELSE NEXT
  610 PRINT:PRINT" OK, now looking through the file...":M=INT(M)
  620 IF EOF#F% THEN 650
  630 GOSUB 1030:FOR B=1 TO N:C$=B$(B):FOR A=1 TO LEN(C$):IF ASC(MID$(C$,A,1))>64 THEN Z$=C$:PROC_MID:C$=Z$
  635   NEXT:IF INSTR(C$,S$) THEN 640 ELSE NEXT:GOTO 620
  640 GOSUB 1050:M=1:GOSUB 950:GOTO 610
  650 CLS:IFM=0THENPRINT TAB(0,1);"No Matching Entries."ELSE PRINT TAB(0,1);"End of file."
  660 PRINT:PRINT" Press ENTER to return to option menu.   ";:Q$=GET$:RUN
  670 GOSUB 890:GOSUB 960
  680 CLOSE#0:GOSUB 1060
  690 CLS:FOR A=1 TO N
  700   PROC_RC:PRINT TAB(COL,ROW);BL$;A$(A);BL$;
  710   INPUT LINE B$(A):IF B$(A)="" THEN B$(A)=" "
  720   IF INSTR("ENDEndend",B$(A))THEN RUN ELSE NEXT
  730 CLS:PRINT TAB(0,1);"Was the data correct? (Y/N) ";:Q$=GET$:PRINT Q$
  740 IF INSTR("Nn",Q$) THEN GOSUB 1100:GOTO 690
  750 IF INSTR("Yy",Q$) THEN 760 ELSE PROC_BEEP:GOTO 730
  760 PRINT:PRINT" Now writing data to the file..."
  770 CLOSE#0
  780 G%=OPENUP(F$):PTR#G%=EXT#G%
  790 FOR A=1 TO N:PRINT#G%,B$(A):NEXT
  800 CLOSE#0:GOTO 690
  810 DIM A$(N),B$(N),P(N)
  820 RETURN
  830 PRINT" Prompt for #"STR$(A)": ";:INPUT LINE I$
  840 A$(A)=I$+" ":I$=""
  850 INPUT" Screen position:  Line # (0 TO 7)  ";X
  860 INPUT"                 Column # (0 TO 79) ";Y
  870 P(A)=(X*80+Y):X=0:Y=0
  880 RETURN
  890 CLS:PRINT TAB(0,1);"Name of card file to be used";:INPUT F$:PRINT
  900 ON ERROR GOTO 940
  910 F%=OPENIN(F$):CLOSE#0
  930 RETURN
  940 PROC_BEEP:PRINT" File does not exist. Press ENTER to continue. ";:Q$=GET$:RUN
  950 PRINT TAB(93,7);"";:Q$=GET$:CLS:RETURN
  960 CLOSE#0:F%=OPENIN(F$)
  970 IF EOF#F% THEN PROC_BEEP:PRINT" Data file is empty":PRINT:CLOSE#0:PROC_STP
  980 INPUT#F%,N:GOSUB 810
  990 FOR A=1 TO N:IF EOF#F% THEN 1020
 1000   INPUT#F%,A$(A):INPUT#F%,P(A):NEXT
 1010 RETURN
 1020 PROC_BEEP:PRINT" Data file error":PRINT:CLOSE#0:PROC_STP
 1030 FOR A=1 TO N:IF EOF#F% THEN 1020
 1040   INPUT#F%,B$(A):NEXT:RETURN
 1050 CLS:FOR A=1 TO N:PROC_RC:PRINT TAB(COL,ROW);BL$;A$(A);BL$;B$(A);:NEXT:RETURN
 1060 CLS:PRINT TAB(0,1);"Now ready for input phase.  Press the ENTER key to start. Type `END' at any"
 1070 PRINT" prompt to terminate the input mode and return to the opening menu. ";:INPUT LINE Q$
 1080 IF Q$="" THEN 1090 ELSE IF INSTR("ENDEndend",Q$) THEN CLS:END
 1090 RETURN
 1100 FOR A=1 TO N:B$(A)=" ":NEXT:RETURN
 2000 CLS:SE=0:PRINT
 2010 INPUT LINE" Name of card file: ";F$
 2030 F%=OPENIN(F$)
 2040 T%=OPENOUT("CRDTMP")
 2050 INPUT#F%,N:PRINT#T%,N
 2052 DIM A$(N),B$(N),T$(N),P(N)
 2060 PRINT" Edit: "BL$"A"BL$")ll or "BL$"S"BL$")elected? ";:PROC_INP
 2070 IF W$="S" THEN INPUT LINE" Search string: ";S$ ELSE 2100
 2080 FOR A=1 TO LEN(S$):IF ASC(MID$(S$,A,1))>64 THEN Z$=S$:PROC_MID:S$=Z$
 2090 NEXT:PRINT"In which entry will the Search String be found";:INPUT SE
 2100 CLS:PRINT:PRINT "For each entry, as it is displayed:"
 2102 PRINT "     o Press ";BL$;"ENTER";BL$;" if correct"
 2104 PRINT "     o Press ";BL$;"E";BL$;")dit to change"
 2106 PRINT "     o Press ";BL$;"D";BL$;")elete to delete"
 2108 PRINT "In Editing, type over incorrect entries to replace them"
 2110 PRINT:PRINT BL$;"Press any key to continue ";BL$;:Q$=GET$:CLS:GOSUB 2330
 2120 REM retrieve field names - transfer
 2130 FOR A=1 TO N:IF EOF#F% THEN PROC_BEEP:PRINT:PRINT"Data file error":CLOSE#0:PROC_STP
 2140   INPUT#F%,A$(A):INPUT#F%,P(A):PRINT#T%,A$(A):PRINT#T%,P(A):NEXT
 2150 REM if finished, rename
 2160 IF NOT EOF#F% THEN 2170 ELSE CLS:PRINT:PRINT"Last card done":CLOSE#0
 2162 PROC_END
 2166 GOTO 100
 2170 REM get card data
 2180 FOR A= 1 TO N:IF EOF#F% THEN PROC_BEEP:PRINT"Data file error":CLOSE#0:PROC_STP
 2190   INPUT#F%,B$(A):NEXT:IF SE=0 THEN 2230
 2200 C$=B$(SE): FOR A=1 TO LEN(C$):IF ASC(MID$(C$,A,1))>64 THEN Z$=C$:PROC_MID:C$=Z$
 2210 NEXT:IFINSTR(C$,S$) THEN 2230 ELSE 2250
 2220 REM display card
 2230 CLS:FOR A=1 TO N:PROC_RC:PRINT TAB(COL,ROW);BL$;A$(A);BL$;B$(A);:NEXT
 2240 PRINT TAB(93,7)"";:C$=GET$:IF INSTR("EeNnDd",C$) THEN 2290
 2250 CLS:IF SE THEN GOSUB 2330
 2260 FOR A=1 TO N:PRINT#T%,B$(A):NEXT
 2270 GOTO 2160
 2280 REM Edit routine
 2290 IF INSTR("Dd",C$) THEN 2400 ELSE FOR A=1 TO N:T$(A)=B$(A):NEXT
 2300 CLS:FOR A=1 TO N:PROC_RC:PRINT TAB(COL,ROW);BL$;A$(A);BL$;"  ";B$(A);:PRINT TAB(COL,ROW);BL$;A$(A);BL$;:INPUT LINE B$(A)
 2310   IF B$(A)="" THEN B$(A)=T$(A)
 2320 NEXT:GOTO 2230
 2330 PRINT" Now reading datafile...":RETURN
 2340 PRINT:PROC_BEEP:REPORT:PRINT";  Error ";ERR;" in Line ";ERL;:CLOSE#0:PROC_STP
 2400 CLS:IF SE THEN GOSUB 2330:GOTO 2160 ELSE GOTO 2160
 2500 REM output routines
 2510 CLS:PRINT:INPUT LINE "Name of Card File: ";F$
 2520 F%=OPENIN(F$):INPUT#F%,N
 2530 DIM A$(N),B$(N),P(N),K(N),C$(N)
 2540 PROC_SEL
 2570 INPUT LINE "Name of Output File ";H$
 2580 H%=OPENOUT(H$)
 2620 CLS:PRINT TAB(20,3);"Now Outputing to File ";H$;" .....";
 2650 IF EOF#F% THEN CLOSE#0:GOTO 100
 2660 FOR A=1 TO N:INPUT#F%,B$(A):NEXT
 2670 FOR A=1 TO N: IF K(A)<>0 THEN C$(K(A))=B$(A) ELSE C$(K(A))="***** "
 2680 NEXT
 2710 FOR A=1 TO KM:IF LEFT$(C$(A),5)<>"*****" THEN PRINT#H%,C$(A):NEXT ELSE NEXT
 2720 PRINT#H%,"":GOTO 2650
 4500 :
 4510 REM Procedures
 4520 :
 4530 DEF PROC_INP
 4540 W$=GET$:W$=CHR$(ASC(W$) AND 223):PRINT W$
 4550 ENDPROC 
 4610 :
 4620 DEF PROC_PRESS
 4630 PRINT TAB(10,7);"Press Any Key to Continue";:W$=GET$
 4640 ENDPROC
 4650 :
 4660 DEF PROC_SEL
 4662 CLS:PRINT TAB(0,1);"Prompts will be displayed. Specify order of output by"
 4664 PRINT "a specifying number from 1 to ";N;" (total number of entries"
 4666 PRINT "per card). Specify '0' if entry is not to be outputed."
 4668 PRINT "Do not skip any numbers (such as using 1 and 3 but not 2)"
 4669 PRINT "or unexpected output formats may result"
 4670 PROC_PRESS:CLS:PRINT:KM=0
 4672 FOR A=1 TO N:INPUT#F%,A$(A):INPUT#F%,P(A):PRINT "Prompt: ";BL$;A$(A);BL$;". ";
 4674   PRINT " Output order for this entry ";:INPUT J$:J=VAL(J$)
 4676   K(A)=J:IF J>KM THEN KM=J
 4678 NEXT
 4680 ENDPROC
 4690 :
 4820 DEF PROC_RC
 4830 ROW=INT(P(A)/80)
 4840 COL=P(A) MOD 80
 4850 ENDPROC
 4860 :
 4870 DEF PROC_BEEP
 4880 PRINT CHR$(7);
 4890 ENDPROC
 4900 :
 4910 DEF PROC_STP
 4920 PROC_PRESS:GOTO 100
 4930 ENDPROC
 4940 :
 5000 DEF PROC_MID
 5010 RP$=CHR$(ASC(MID$(Z$,A,1)) AND 223)
 5020 Z$=LEFT$(Z$,A-1)+RP$+RIGHT$(Z$,LEN(Z$)-A)
 5030 ENDPROC
 5040 :
 5090 REM Procedure to ERase F$ and REname CRDTMP to F$ with CLI
 5100 DEF PROC_END
 5110 OSCLI("DELETE "+F$)
 5120 OSCLI("RENAME CRDTMP"+" "+F$)
 5130 ENDPROC