1 'CREATOR; WRITTEN ON 1/16/80 BY BRUCE W. TONKIN
2 'ADAPTED FOR CP/M AND MICROSOFT BASIC 5.01 ON 5/11/80
3 'FOR 4.51 ON 3/18/81, AND FOR MODEL III ON 2/20/83, FOR CP/M AND MBASIC 4.51/5.2+ AGAIN ON 3/23/83; FOR 48K CP/M WITH OVERLAYS ON 7/2/83; THIS IS MAIN
4 'THIS IS PUBLIC DOMAIN SOFTWARE AND MAY NOT BE SOLD OR INCORPORATED IN ANY COMMERCIAL SOFTWARE WITHOUT THE EXPRESS PERMISSION OF THE AUTHOR
5 '
6 'THIS PROGRAM WILL WORK ON ANY MACHINE RUNNING MBASIC 4.51 OR HIGHER, UNDER CP/M 1.4 OR HIGHER, WITH A 16 X 64 VIDEO SCREEN OR BIGGER.
7 'IF MBASIC 4.51 IS USED, RECORD LENGTH MUST ALWAYS BE 128; YOUR PROGRAM SHOULD BE CHANGED. YOU WILL ALSO NEED TO ADD A 'CLEAR' COMMAND
8 '	TO YOUR GENERATED REPORT PROGRAM. CLEAR 5000 SHOULD BE PLENTY.
9 '
10 'MODIFY OR DELETE THIS NEXT LINE FOR YOUR TERMINAL CLEAR SCREEN CODE
11 CLS$=CHR$(27)+"+":'TELEVIDEO CLEAR SCREEN CODE STRING
12 'TRS-80 P&T CP/M USES A SINGLE CHR$(12); ADM 3 SERIES USE A SINGLE CHR$(26)
13 'THIS PROGRAM AND YOUR GENERATED PROGRAM WILL USE THE CLEAR SCREEN CODE!
14 'IF YOUR TERMINAL DOES NOT SUPPORT A CLEAR CODE, SET CLS$=STRING$(20,10)
15 'IN LINE 11; THAT WILL SCROLL MOST OF THE OLD STUFF OFF THE SCREEN, ANYWAY.
16 'STRING$(24,10) IS TOO LONG TO USE IN THE PROGRAM. SORRY!
19 GOTO 60
20 FX=0:IF LEN(CV$)<1 THEN RETURN
30 FOR II=1 TO LEN(CV$):CV%=ASC(MID$(CV$,II,1)):IF CV%=34 AND FX=0 THEN FX=1:ELSE IF CV%=34 AND FX=1 THEN FX=0
40 IF CV%>90 AND FX=0 THEN CV%=CV% AND 95
50 MID$(CV$,II,1)=CHR$(CV%):NEXT II:RETURN
60 PRINT CLS$;"CREATOR.BAS: COPYRIGHT (C) 1983, BY BRUCE W. TONKIN":PRINT"34069 HAINESVILLE ROAD, ROUND LAKE, IL 60073":PRINT"THIS WORK MAY NOT BE SOLD"
70 PRINT"WITHOUT THE EXPRESS WRITTEN PERMISSION OF BRUCE W. TONKIN.":PRINT"BUT MAY BE FREELY REPRODUCED.":PRINT"GIVE A COPY TO A FRIEND!":PRINT"YOU MUST LEAVE THIS NOTICE IN PLACE AND UNCHANGED!"
75 PRINT"PROGRAM MANUALS ARE AVAILABLE, FOR $10+$1 POSTAGE, FROM THE":PRINT"PROGRAM'S AUTHOR. ADD $5.00 EXTRA IF OVERSEAS."
80 FOR I=1 TO 6000:NEXT I
90 PRINT CLS$;
100 PRINT"You may now change diskettes, if you wish. However, please be":PRINT"sure you have the file called C451.LIB on your default drive.":PRINT"DEPRESS ANY KEY WHEN READY TO CONTINUE.";
110 AN$=INKEY$:IF AN$="" THEN 110
120 RESET:PRINT CLS$;"THIS IS THE CREATOR, VERSION 2.1. It will allow you to generate":PRINT"a program that will create, update, and access a hashed data":PRINT"file. First, you must tell me the name you want to give your":PRINT"program. ";
130 PRINT"YOU ARE LIMITED TO 8 ALPHABETIC CHARACTERS.":PRINT"PROGRAM NAME= ";:LINE INPUT PN$:CV$=PN$:GOSUB 20:PN$=CV$:IF LEN(PN$)>8 THEN PRINT"TOO LONG.":GOTO 130
140 FOR I=1 TO LEN(PN$):IF MID$(PN$,I,1)<"A" OR MID$(PN$,I,1)>"Z" THEN PRINT"INVALID CHARACTER USED.":EX=1:I=LEN(PN$)
150 NEXT I:IF EX=1 THEN EX=0:GOTO 130
160 PRINT"The disk drives are lettered, A - P. Which drive do you want":PRINT"the data file on, WHEN YOUR PROGRAM IS RUN: ";
170 AN$=INKEY$:IF AN$="" THEN 170:ELSE IF AN$<"A" OR AN$>"P" THEN PRINT:GOTO 160
180 PRINT AN$
190 PRINT"What drive do you want your program written on: ";
200 BN$=INKEY$:IF BN$="" THEN 200:ELSE IF BN$<"A" OR BN$>"P" THEN PRINT:GOTO 190
210 PRINT BN$
220 PRINT"What drive do you want your program to be on, when you are":PRINT"running it: ";
230 CN$=INKEY$:IF CN$="" THEN 230:ELSE IF CN$<"A" OR CN$>"P" THEN PRINT:GOTO 220
240 PRINT CN$
250 ON ERROR GOTO 1930
260 OPEN"I",1,BN$+":"+PN$+".BAS":ERROR 126
270 KF$=AN$+":"+PN$+".KEY":DF$=AN$+":"+PN$+".DAT":PN$=PN$+".BAS":OPEN"O",1,BN$+":"+PN$:PRINT #1,"1 REM*PROGRAM NAME: ";PN$;"*":PRINT #1,"2 REM*DATA FILE NAME IS ";DF$;"*":PRINT #1,"3 REM*DATA FILE IS ON DRIVE ";AN$;"*"
280 PRINT CLS$;"What is the maximum number of records (per data disk) you want":PRINT"to allow in your data file: ";:LINE INPUT MS$:MS=VAL(MS$):IF MS<1 OR MS>32767 THEN 280
290 PRINT"What is the record length (1 to 256 is permitted): ";:LINE INPUT RS$:RS=VAL(RS$):IF RS>256 OR RS<1 THEN 290
300 PRINT #1,"4 REM*NUMBER OF RECORDS=";MS;"*":PRINT #1,"5 REM*RECORD LENGTH=";RS;"*":Q$=CHR$(34):PRINT"Please input the title you want displayed for your program:":LINE INPUT TI$
305 PRINT #1,"6 RESET:CLS$=";:FOR I=1 TO LEN(CLS$)-1:PRINT #1,"CHR$(";ASC(MID$(CLS$,I,1));")+";:NEXT I:PRINT #1,"CHR$(";ASC(RIGHT$(CLS$,1));")"
310 LN=LN+10:PRINT #1,LN;"'begin":LN=LN+10:PRINT #1,LN;"PRINT CLS$;":LN=LN+10:PRINT #1,LN;"OPEN";Q$;"R";Q$;",1,";Q$;DF$;Q$;",";RS;":OPEN";Q$;"R";Q$;",2,";Q$;KF$;Q$;",2:FIELD #2,2 AS KP$"
330 LN=LN+10:PRINT #1,LN;"ON ERROR GOTO 25000":LN=LN+10:PRINT #1,LN;"DIM F$(50),G$(50)"
340 PRINT #1,"32040 LSET KP$=MKI$(-1)"
350 IF RS<256 THEN PRINT #1,"32045 FIELD #1,";RS;" AS DL$:LSET DL$=STRING$(";RS;",250):PUT 1,1":ELSE PRINT #1,"32045 FIELD #1,255 AS DL$,1 AS DX$:LSET DL$=STRING$(255,250):LSET DX$=CHR$(250):PUT 1,1"
360 PRINT #1,"32050 FOR I=1 TO";MS:DIM F$(50)
370 PRINT CLS$;"You may now choose, if you wish, an exit code or message. This":PRINT"is an entry the operator may use in place of a normal entry":PRINT"in any field."
380 PRINT"If the operator makes this entry, the program will leave entry":PRINT"or update, and will return to the menu without adding to the":PRINT"file or altering any more information on the disk. Previous":PRINT"changes remain, though."
390 PRINT"Do you wish an exit code to be used (Y/N)? ";
400 OO$=INKEY$:IF OO$="" THEN 400:ELSE CV$=OO$:GOSUB 20:OO$=CV$:PRINT OO$:IF OO$<>"Y" AND OO$<>"N" THEN 390
410 IF OO$="Y" THEN PRINT"What is your message or code?";:LINE INPUT  OT$
420 PRINT CLS$;"Now we must describe the positions of the fields in the data":PRINT"file. The fields may be smaller than you think necessary."
425 PRINT"Numbers can be PACKED --squeezed-- into less space in the file":PRINT"than they take to print on the screen.";
430 PRINT" Whole numbers in the":PRINT"range -32767 to 32767 can be stored as packed integers, taking":PRINT"up only two spaces. Numbers needing up to six digits of":PRINT"accuracy can be stored in four spaces, and those needing up to"
440 PRINT"16 digits of accuracy can be stored in 8 spaces (double":PRINT"precision). Whole numbers in the range -127 to 127 can be":PRINT"stored as packed half-precision numbers, and take only one"
450 PRINT"space. Please take care to allocate the correct number of":PRINT"spaces for each field. You must proceed from left to right in"
455 PRINT"your record as you allocate space. You have ":PRINT RS;"spaces in each record, and up to";(47+RS+ABS(RS-47))/2;
460 PRINT"fields."
470 PRINT"TYPE IN 999 FOR THE NUMBER OF SPACES TO ALLOCATE WHEN DONE."
480 A=1
490 PRINT"FIELD #";A;"USES: ";:LINE INPUT F$(A):EX=EX+VAL(F$(A)):IF EX>RS AND F$(A)<>"999" THEN PRINT"EXCEEDS RECORD LENGTH. TRY AGAIN.":EX=EX-VAL(F$(A)):GOTO 490
500 IF F$(A)="999" THEN 560:ELSE IF VAL(F$(A))=0 THEN PRINT"INVALID.":GOTO 490
510 PRINT"Is this field size ok (Y/N)?";
520 EX$=INKEY$:IF EX$="" THEN 520:ELSE CV$=EX$:GOSUB 20:EX$=CV$:PRINT EX$:IF EX$="N" THEN EX=EX-VAL(F$(A)):GOTO 490
530 IF EX$<>"Y" THEN 510
540 IF RS-EX<1 THEN A=A+1:GOTO 560
550 PRINT"All right. You have";RS-EX;"spaces left in your record.":A=A+1:GOTO 490
560 LN=LN+10:PRINT #1,LN;"REM*SET UP FIELDS IN THE DATA RECORD*":A=A-1:SL=LN:OF$="GOSUB 36000":FOR I=1 TO A:PRINT #1,36000!+I;"F%(";MID$(STR$(I),2);")=";F$(I):NEXT
570 PRINT #1,"36800 CD%=0":PRINT #1,"55 DIM F%(";A;")":PRINT #1,"36810 FOR ZZ=1 TO";A
580 LN=LN+10:PRINT #1,LN;"FOR I=1 TO ";A;":G$(I)=";Q$;Q$;":NEXT I:FC=0:PRINT CLS$:UF=0:G$=";Q$;Q$;":";OF$:LN=LN+10:PRINT #1,LN;"PRINT TAB(21);";Q$;"PRODUCED BY THE CREATOR";Q$
590 LN=LN+10:PRINT #1,LN;"PRINT TAB(";(64-LEN(TI$))/2;")";Q$;TI$;Q$
630 LN=190:IF OO$<>"Y" THEN 650
640 PRINT #1,LN;"PRINT";Q$;"To return to the menu from entry or update without entering or";Q$:LN=LN+10:PRINT #1,LN;"PRINT";Q$;"updating your record, type in ";OT$;" for a field entry.";Q$
650 LN=LN+10:PRINT #1,LN;"AN$=INKEY$:IF AN$=";Q$;Q$;" THEN";LN;":ELSE ON(INSTR(";Q$;"EeLlSsUuDdIiXx";Q$;",AN$)-1.5)\2+1 GOTO 1000,10000,35000,11000,12000,32000,38000,";LN+20
655 LN=LN+10:PRINT #1,LN;"GOTO";SL:LN=LN+10:PRINT #1,LN;"CLOSE:NEW":DIM D%(50):CHAIN"CREATOR.OVR",1,ALL
1930 IF ERL=260 AND ERR=53 THEN CLOSE 1:RESUME 270
1940 IF ERR=52 THEN PRINT"You entered BASIC without specifying any files for disk access!":PRINT"Go back to DOS and re-enter BASIC correctly!":NEW
1950 IF (ERR=126 OR ERR=38) AND ERL=260 THEN PRINT"FILE ALREADY EXISTS. DEPRESS C TO WRITE OVER IT.":PRINT"DEPRESS ANY OTHER KEY TO RE-START."
1960 IF (ERR<>126 AND ERR<>38) OR ERL<>260 THEN 1990
1970 XN$=INKEY$:IF XN$="" THEN 1970:ELSE IF XN$="C" THEN CLOSE 1:RESUME 270
1980 END
1990 PRINT"ERROR NUMBER";ERR;"AT LINE";ERL:ON ERROR GOTO 0