1000 !
1020 ! PROGRAM NAME: LTRINP.BAS
1022 !
1024 ON ERROR GOTO ERR'CODE
1026 STRSIZ 100
1028 !
1030 MAP COPYRIGHT,S,47,"COPYRIGHT 1979, DATA PROCESSING CONSULTING, INC"
1040 !
1060 ! FUNCTION: THIS PROGRAM IS USED TO CREATE "DATA" FILES FOR USE
1080 ! WITH THE LETTER PROGRAM. IT USES A FILE TO
1100 ! PROMPT FOR LETTER SUBSTITUTION DATA AND CREATES AN
1120 ! OUTPUT FILE FROM THE RESPONSES.
1140 !
1160 ! AUTHOR: TOM DAHLQUIST
1180 !
1200 ! DATE WRITTEN: 3/7/79
1220 ! DATE REVISED: 3/7/79
1240 !
1250 FILENUM=1
1260 GET'PROMPT: INPUT "PROMPT FILE NAME: ",A$
1280 C$=".TXT" : GOSUB DEFAULT : PFN$=A$
1300 OPEN #1,PFN$,INPUT
1310 FILENUM=2
1320 GET'OUT: INPUT "OUTPUT FILE NAME: ",A$
1340 C$=".DAT" : GOSUB DEFAULT : OFN$=A$
1360 OPEN #2,OFN$,OUTPUT
1380 ?"USE CTL-C TO END PROGRAM" : ?
1400 !
1420 ! LOOP THROUGH PROMPT FILE
1440 !
1460 LOOP: INPUT LINE #1,A$
1470 IF EOF(1)=1 THEN CLOSE #1 : OPEN #1,PFN$,INPUT : GOTO LOOP
1480 ?A$;": "; : INPUT LINE B$
1500 ?#2,B$
1520 GOTO LOOP
4642 !
4644 ! EXTENSION DEFAULT ROUTINE--A$ IS INPUT, C$ IS DEFAULT EXTENSION
4646 !
4648 DEFAULT: IF INSTR(1,A$,".")<>0 RETURN
4650 I=INSTR(1,A$,"[")
4652 IF I=0 THEN A$=A$+C$ : RETURN
4654 A$=LEFT(A$,I-1)+C$+RIGHT(A$,LEN(A$)-I+1)
4656 RETURN
4660 !
4680 ! ON ERROR ROUTINE
4700 !
4720 ERR'CODE: IF ERR(0)=1 THEN RESUME QUIT
4740 IF ERR(0)<>17 GOTO CHK'SPEC
4760 ?"*** FILE NOT FOUND ***"
4780 RESUME RETRY
4800 CHK'SPEC: IF ERR(0)<>16 GOTO CHK'DEVRDY
4820 ?"*** FILE SPECIFICATION ERROR ***"
4840 RESUME RETRY
4844 CHK'DEVRDY: IF ERR(0)<>18 GOTO CHK'DEVFLL
4845 ?"*** DEVICE NOT READY ***"
4846 RESUME RETRY
4847 CHK'DEVFLL: IF ERR(0)<>19 GOTO CHK'DEVERR
4848 ?"*** DEVICE FULL ***"
4849 RESUME RETRY
4850 CHK'DEVERR: IF ERR(0)<>20 GOTO CHK'CODE
4851 ?"*** DEVICE ERROR ***"
4852 RESUME RETRY
4853 CHK'CODE: IF ERR(0)<>22 GOTO CHK'PROT
4854 ?"*** ILLEGAL USER CODE ***"
4855 RESUME RETRY
4856 CHK'PROT: IF ERR(0)<>23 GOTO CHK'WRIT
4857 ?"*** PROTECTION VIOLATION ***"
4858 RESUME RETRY
4859 CHK'WRIT: IF ERR(0)<>24 GOTO CHK'TYPE
4860 DIE: ?"*** ERROR: CODE=";ERR(0);" LINE=";ERR(1);" LASTFILE=";ERR(2)
4861 RESUME RETRY
4862 CHK'TYPE: IF ERR(0)<>25 GOTO CHK'DEV
4863 ?"*** NOT A SEQUENTIAL FILE ***"
4864 RESUME RETRY
4865 CHK'DEV: IF ERR(0)<>26 GOTO CHK'BIT
4866 ?"*** DEVICE DOES NOT EXIST ***"
4867 RESUME RETRY
4868 CHK'BIT: IF ERR(0)<>27 GOTO CHK'MNT
4869 ?"*** BITMAP DESTROYED ***"
4870 RESUME QUIT
4871 CHK'MNT: IF ERR(0)<>28 GOTO DIE
4872 ?"*** DISK NOT MOUNTED ***"
4873 RESUME RETRY
4880 ?"*** UNABLE TO CONTINUE"
4910 QUIT: ON ERROR GOTO 0
4915 CLOSE #2
4920 ? : ?"PROGRAM END" : END
4940 RETRY: ON FILENUM GOTO GET'PROMPT,GET'OUT
