        REM CREATE.BAS    * PROGRAM TO CREATE DATA FILES (STRINGS)
        REM               * 2330
        REM 06 29 83      * J.BUTLER
        REM SYSTEM CONTROL PROGRAM NUMBER    :
 
        REM COMMONS GO HERE
        COMMON CLEAR$,NAME$,LINE$,DEMO$,CRSR$,EOL$,DATE$,ID$,SCRPARA,EOS$
        COMMON ROWOFF,COLOFF,DIO
 
        REM DIMENSIONS GO HERE
        DIM MONTHS$(12),CA$(10),CA(10),S(35)
        DIO=0DB00H
        FOR X=1 TO 33:READ S(X):POKE DIO-1+X,S(X):NEXT X
        REV$="052983"
        BLANK$="........................................................":ERR=1
 
        IF END #1 THEN 9992
        OPEN "SCREEN.FIL" RECL 18 AS 1

1       REM OPEN ANY MORE FILES HERE
 
        REM  ** GET SCREEN PARAMETERS FROM SCREEN.FIL **
        READ #1,1;A$,B$,C$
        CLEAR$=CHR$(VAL(A$))+CHR$(VAL(B$))
        READ #1,2;A$,B$,C$
        CRSR$=CHR$(VAL(A$))+CHR$(VAL(B$))
        READ #1,3;A$,B$,C$
        EOS$=CHR$(VAL(A$))+CHR$(VAL(B$))
        READ #1,4;A$,B$,C$
        EOL$=CHR$(VAL(A$))+CHR$(VAL(B$))
        READ #1,5;A$,B$,C$
        CLRFORE$=CHR$(VAL(A$))+CHR$(VAL(B$))
        READ #1,6;A$,B$,C$
        CLRBACK$=CHR$(VAL(A$))+CHR$(VAL(B$))
        READ #1,7;A$,B$,C$
        HIGH$=CHR$(VAL(A$))+CHR$(VAL(B$))
        READ #1,8;A$,B$,C$
        LOW$=CHR$(VAL(A$))+CHR$(VAL(B$))
        READ #1,9;A$,B$,C$
        HOME$=CHR$(VAL(A$))+CHR$(VAL(B$))
        READ #1,13;A$,B$,C$
        ROWOFF=VAL(A$):COLOFF=VAL(B$):SCRPARA=VAL(C$)
        CLOSE 1

        REM MASK INITIALIZATION GOES HERE
 
6       REM PASSWORD ROUTINE GOES HERE

7       NAME$="Creative Data":LINE$="*************":GOTO 11
 
8       REM VERTICAL CURSOR POSITIONING ROUTINE
        FOR ZZ=1 TO VV:PRINT:NEXT ZZ:RETURN

9       REM DATE FORMATTING ROUTINE
        DATE$=MID$(P$,1,2)+"-"+MID$(P$,3,2)+"-"+MID$(P$,5,2)
        RETURN
 
10      REM  CURSOR ADDRESS
        IF SCRPARA=1 THEN \
        PRINT CRSR$;CHR$(ROW+ROWOFF);CHR$(COLUMN+COLOFF);:RETURN
        PRINT CRSR$;CHR$(COLUMN+COLOFF);CHR$(ROW+ROWOFF);:RETURN

11      REM LENGTHS OF EACH FIELD
        CA(1)=12:CA(2)=1:CA(3)=4:CA(4)=2:CA(5)=4:CA(6)=1:CA(7)=1
 
15      REM COMPANY INFO HERE
        NUM=7:GOSUB 2000:PRINT TAB(22);"PROGRAM TO CREATE CBASIC DATA FILES"
        ROW=7:COLUMN=1:GOSUB 10:PRINT:REM 46+
        PRINT TAB(13);" 1. NAME OF FILE TO CREATE      : "
        PRINT TAB(13);" 2. DISK WHERE IT RESIDES       : "
        PRINT TAB(13);" 3. LENGTH OF EACH RECORD       : "
        PRINT TAB(13);" 4. NUMBER OF FIELDS            : "
        PRINT TAB(13);" 5. NUMBER OF RECORDS           : "
        PRINT TAB(13);" 6. 'S'TRING OR 'V'ARIABLE      : "
        PRINT TAB(13);" 7. 'C'OMMA OR 'S'PACE DELIMITER: ":PRINT
        PRINT TAB(9);"For Record Length : Use the formula X * 16."
        PRINT TAB(9);"e.g.: 016 032 048 064 080 096 112 128 144 160"
        PRINT TAB(9);"      176 192 208 224 240 256 272 288 304 320"
        PRINT TAB(9);"      336 352 368 384 400 416 432 448 464 480"
        IF SECOND=1 THEN SECOND=0:RETURN

20      PRINT HIGH$
 
25      PRINT CLRFORE$:GOSUB 60

30      PRINT LOW$;:COLUMN=11:ROW=21:GOSUB 10
        PRINT "IS THIS DATA CORRECT <Y/N> :";:Y%=CONCHAR%:GOSUB 10:PRINT EOL$;
        IF Y%=13 OR Y%=89 THEN 2001
        IF Y%=5EH THEN 9990

40      REM ERROR CHECKING STATEMENT HERE
        GOSUB 8802:RECUR$="":COLUMN=11:ROW=21:GOSUB 10
        PRINT EOL$;"'S'TOP, 'D'ELETE, 'R'ECUR @, FIELD #  :";
        INPUT "";LINE CHANGE$
        IF LEFT$(CHANGE$,1)="S" THEN GOSUB 2001:GOTO 9990
        IF CHANGE$="" THEN 15
        IF CHANGE$="D" THEN 8900
        IF MID$(CHANGE$,1,1)="R" THEN RECUR$="R": \
           CHANGE$=MID$(CHANGE$,2,LEN(CHANGE$)-1)
        IF VAL(CHANGE$)=0 THEN 15

50      IF VAL(CHANGE$)<1 OR VAL(CHANGE$)>NUM THEN 40
        GOSUB 7010
        IF RECUR$="R" AND VAL(CHANGE$)<=NUM THEN \
           CHANGE$=STR$(VAL(CHANGE$)+1):GOTO 50
        SECOND=1:GOSUB 15:GOTO 25

60      REM SCREEN PRINT HERE
        COLUMN=46
        FOR X=1 TO NUM
        ROW=7+X:GOSUB 10
        IF CA$(X)<>"" THEN PRINT CA$(X) ELSE PRINT LEFT$(BLANK$,CA(X))        
        NEXT X
        RETURN

1000    IF END #1 THEN 6000

1001    READ #1,REC1;CA$(1),CA$(2),CA$(3),CA$(4),CA$(5) 
        RETURN

2000    PRINT CLEAR$:PRINT TAB(40-LEN(NAME$)/2);NAME$
        PRINT TAB(40-LEN(LINE$)/2);LINE$:PRINT:RETURN

2001    A%=(241-SIZE(CA$(2)+":*.*"))*1024:B%=(VAL(CA$(3))+2)*VAL(CA$(5))
        IF B%>A% THEN 6000
        IF END #1 THEN 6100
        CREATE CA$(2)+":"+CA$(1) RECL VAL(CA$(3)) AS 1
        GOSUB 2000:VV=8:GOSUB 8
        PRINT TAB(21);"NOW CREATING YOUR FILE ";CA$(2);":";CA$(1);" ";
        
2002    B$=""
        IF CA$(6)="S" THEN B2$=CHR$(34)+""+CHR$(34) ELSE B2$="0"
        IF CA$(7)="C" THEN B3$="," ELSE B3$=" "
        FOR X=1 TO VAL(CA$(4))
        B$=B$+B2$+B3$
        NEXT X
        B$=LEFT$(B$,LEN(B$)-1)
        IF LEN(B$)+2>VAL(CA$(3)) THEN 6200
        FOR Y=1 TO VAL(CA$(5))
        PRINT USING "&";#1,Y;B$
        NEXT Y
        FOR X=1 TO NUM:CA$(X)="":NEXT X
        CLOSE 1:GOTO 15

6000    COLUMN=2:ROW=21:GOSUB 10
        PRINT EOL$;"NOT ENOUGH DISK SPACE FOR ";CA$(2);":";CA$(1);CHR$(7);
        FOR X=1 TO 200:NEXT X
        GOSUB 10:PRINT EOL$:GOTO 15

6100    COLUMN=2:ROW=21:GOSUB 10
        PRINT EOL$;"NOT ENOUGH DIRECTORY SPACE FOR ";CA$(2);":";CA$(1);CHR$(7);
        FOR X=1 TO 200:NEXT X
        GOSUB 10:PRINT EOL$:GOTO 15

6200    COLUMN=2:ROW=21:GOSUB 10
        PRINT EOL$;"RECORD LENGTH OF";CA$(3);" IS TOO SMALL FOR";CA$(4);
        PRINT " FIELDS ";CHR$(7);
        FOR X=1 TO 200:NEXT X
        DELETE 1:GOSUB 10:PRINT EOL$:GOTO 15

7010    REM SCREEN INPUT FUNCTIONS HERE
        Y$="":HOLDIT$=CA$(VAL(CHANGE$)):Y=1
        COLUMN=46:ROW=7+VAL(CHANGE$):GOSUB 10
        PRINT LEFT$(BLANK$,CA(VAL(CHANGE$))):GOSUB 10

7015    POKE DIO,0:CALL DIO+1
        CHR%=PEEK(DIO) AND 127
        IF CHR%=0 THEN 7015
        IF CHR%=8 AND LEN(Y$)<1 THEN 7015
        IF CHR%=27 THEN RECUR$="":RETURN
        IF CHR%=24 THEN 7010
        IF CHR%=13 THEN 7020
        IF CHR%=8  THEN Y$=LEFT$(Y$,LEN(Y$)-1):Y=Y-1:PRINT CHR$(8);" ";CHR$(8);
        IF CHR%<32 OR CHR%>122 THEN 7015
        IF Y>CA(VAL(CHANGE$)) THEN PRINT CHR$(7);:GOTO 7015
        PRINT CHR$(CHR%);:Y$=Y$+CHR$(CHR%):Y=Y+1:GOTO 7015

7018    CA$(VAL(CHANGE$))=HOLDIT$:RETURN

7020    ON VAL(CHANGE$) GOTO 7021,7022,7023,7024,7025,7026,7027

7021    IF MATCH(".",Y$,1)=0 THEN PRINT CHR$(7);:GOTO 7010
        GOTO 7120

7022    Z=ASC(Y$)-64
        IF Z<1 OR Z>2 THEN PRINT CHR$(7);:GOTO 7010
        GOTO 7120

7023    Z=VAL(Y$)
        IF Z<1 OR Z>1024 THEN PRINT CHR$(7);:GOTO 7010
        GOTO 7120

7024    Z=VAL(Y$)
        IF Z<1 OR Z>99 THEN PRINT CHR$(7);:GOTO 7010
        GOTO 7120
 
7025    Z=VAL(Y$)
        IF Z<1 OR Z>5000 THEN PRINT CHR$(7);:GOTO 7010
        GOTO 7120

7026    Z=ASC(Y$)
        IF Z<>86 AND Z<>83 THEN PRINT CHR$(7);:GOTO 7010
        GOTO 7120

7027    Z=ASC(Y$)
        IF Z<>83 AND Z<>67 THEN PRINT CHR$(7);:GOTO 7010
        GOTO 7120
        
7120    IF Y$=" " THEN CA$(VAL(CHANGE$))="":RETURN
        IF Y$<>"" THEN CA$(VAL(CHANGE$))=Y$ ELSE CA$(VAL(CHANGE$))=HOLDIT$
        ROW=21:RETURN

8802    ROW=ROW-1:GOSUB 10:PRINT EOS$:RETURN
 
8900    REM DELETE RECORD FUNCTION HERE
        FOR X=1 TO 5:CA$(X)="":NEXT X
        GOTO 15

9000    REM DIRECT CONSOLE I/O                               DB
        DATA 0,229,213,197,245,30,255,14,6,205,5,0,183,202,5,219,50,0
        DATA 219,241,193,209,225,201,0,14,2,30,8,205,5,0,201
        REM   DB 

9990    PRINT LOW$;CLEAR$:STOP
 
9992    FOR X=1 TO 24:PRINT:NEXT X
        PRINT TAB(20);"ACCESS NOT PERMITTED! SEE YOUR SYSTEM SUPERVISOR..";ERR;
        Y%=CONCHAR%
        IF Y%=5EH THEN 9999
        GOTO 9992
 
9999    PRINT LOW$;CLEAR$
        STOP

