home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol163 / create.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  7.6 KB  |  235 lines
  1.         REM CREATE.BAS    * PROGRAM TO CREATE DATA FILES (STRINGS)
  2.         REM               * 2330
  3.         REM 06 29 83      * J.BUTLER
  4.         REM SYSTEM CONTROL PROGRAM NUMBER    :
  5.  
  6.         REM COMMONS GO HERE
  7.         COMMON CLEAR$,NAME$,LINE$,DEMO$,CRSR$,EOL$,DATE$,ID$,SCRPARA,EOS$
  8.         COMMON ROWOFF,COLOFF,DIO
  9.  
  10.         REM DIMENSIONS GO HERE
  11.         DIM MONTHS$(12),CA$(10),CA(10),S(35)
  12.         DIO=0DB00H
  13.         FOR X=1 TO 33:READ S(X):POKE DIO-1+X,S(X):NEXT X
  14.         REV$="052983"
  15.         BLANK$="........................................................":ERR=1
  16.  
  17.         IF END #1 THEN 9992
  18.         OPEN "SCREEN.FIL" RECL 18 AS 1
  19.  
  20. 1       REM OPEN ANY MORE FILES HERE
  21.  
  22.         REM  ** GET SCREEN PARAMETERS FROM SCREEN.FIL **
  23.         READ #1,1;A$,B$,C$
  24.         CLEAR$=CHR$(VAL(A$))+CHR$(VAL(B$))
  25.         READ #1,2;A$,B$,C$
  26.         CRSR$=CHR$(VAL(A$))+CHR$(VAL(B$))
  27.         READ #1,3;A$,B$,C$
  28.         EOS$=CHR$(VAL(A$))+CHR$(VAL(B$))
  29.         READ #1,4;A$,B$,C$
  30.         EOL$=CHR$(VAL(A$))+CHR$(VAL(B$))
  31.         READ #1,5;A$,B$,C$
  32.         CLRFORE$=CHR$(VAL(A$))+CHR$(VAL(B$))
  33.         READ #1,6;A$,B$,C$
  34.         CLRBACK$=CHR$(VAL(A$))+CHR$(VAL(B$))
  35.         READ #1,7;A$,B$,C$
  36.         HIGH$=CHR$(VAL(A$))+CHR$(VAL(B$))
  37.         READ #1,8;A$,B$,C$
  38.         LOW$=CHR$(VAL(A$))+CHR$(VAL(B$))
  39.         READ #1,9;A$,B$,C$
  40.         HOME$=CHR$(VAL(A$))+CHR$(VAL(B$))
  41.         READ #1,13;A$,B$,C$
  42.         ROWOFF=VAL(A$):COLOFF=VAL(B$):SCRPARA=VAL(C$)
  43.         CLOSE 1
  44.  
  45.         REM MASK INITIALIZATION GOES HERE
  46.  
  47. 6       REM PASSWORD ROUTINE GOES HERE
  48.  
  49. 7       NAME$="Creative Data":LINE$="*************":GOTO 11
  50.  
  51. 8       REM VERTICAL CURSOR POSITIONING ROUTINE
  52.         FOR ZZ=1 TO VV:PRINT:NEXT ZZ:RETURN
  53.  
  54. 9       REM DATE FORMATTING ROUTINE
  55.         DATE$=MID$(P$,1,2)+"-"+MID$(P$,3,2)+"-"+MID$(P$,5,2)
  56.         RETURN
  57.  
  58. 10      REM  CURSOR ADDRESS
  59.         IF SCRPARA=1 THEN \
  60.         PRINT CRSR$;CHR$(ROW+ROWOFF);CHR$(COLUMN+COLOFF);:RETURN
  61.         PRINT CRSR$;CHR$(COLUMN+COLOFF);CHR$(ROW+ROWOFF);:RETURN
  62.  
  63. 11      REM LENGTHS OF EACH FIELD
  64.         CA(1)=12:CA(2)=1:CA(3)=4:CA(4)=2:CA(5)=4:CA(6)=1:CA(7)=1
  65.  
  66. 15      REM COMPANY INFO HERE
  67.         NUM=7:GOSUB 2000:PRINT TAB(22);"PROGRAM TO CREATE CBASIC DATA FILES"
  68.         ROW=7:COLUMN=1:GOSUB 10:PRINT:REM 46+
  69.         PRINT TAB(13);" 1. NAME OF FILE TO CREATE      : "
  70.         PRINT TAB(13);" 2. DISK WHERE IT RESIDES       : "
  71.         PRINT TAB(13);" 3. LENGTH OF EACH RECORD       : "
  72.         PRINT TAB(13);" 4. NUMBER OF FIELDS            : "
  73.         PRINT TAB(13);" 5. NUMBER OF RECORDS           : "
  74.         PRINT TAB(13);" 6. 'S'TRING OR 'V'ARIABLE      : "
  75.         PRINT TAB(13);" 7. 'C'OMMA OR 'S'PACE DELIMITER: ":PRINT
  76.         PRINT TAB(9);"For Record Length : Use the formula X * 16."
  77.         PRINT TAB(9);"e.g.: 016 032 048 064 080 096 112 128 144 160"
  78.         PRINT TAB(9);"      176 192 208 224 240 256 272 288 304 320"
  79.         PRINT TAB(9);"      336 352 368 384 400 416 432 448 464 480"
  80.         IF SECOND=1 THEN SECOND=0:RETURN
  81.  
  82. 20      PRINT HIGH$
  83.  
  84. 25      PRINT CLRFORE$:GOSUB 60
  85.  
  86. 30      PRINT LOW$;:COLUMN=11:ROW=21:GOSUB 10
  87.         PRINT "IS THIS DATA CORRECT <Y/N> :";:Y%=CONCHAR%:GOSUB 10:PRINT EOL$;
  88.         IF Y%=13 OR Y%=89 THEN 2001
  89.         IF Y%=5EH THEN 9990
  90.  
  91. 40      REM ERROR CHECKING STATEMENT HERE
  92.         GOSUB 8802:RECUR$="":COLUMN=11:ROW=21:GOSUB 10
  93.         PRINT EOL$;"'S'TOP, 'D'ELETE, 'R'ECUR @, FIELD #  :";
  94.         INPUT "";LINE CHANGE$
  95.         IF LEFT$(CHANGE$,1)="S" THEN GOSUB 2001:GOTO 9990
  96.         IF CHANGE$="" THEN 15
  97.         IF CHANGE$="D" THEN 8900
  98.         IF MID$(CHANGE$,1,1)="R" THEN RECUR$="R": \
  99.            CHANGE$=MID$(CHANGE$,2,LEN(CHANGE$)-1)
  100.         IF VAL(CHANGE$)=0 THEN 15
  101.  
  102. 50      IF VAL(CHANGE$)<1 OR VAL(CHANGE$)>NUM THEN 40
  103.         GOSUB 7010
  104.         IF RECUR$="R" AND VAL(CHANGE$)<=NUM THEN \
  105.            CHANGE$=STR$(VAL(CHANGE$)+1):GOTO 50
  106.         SECOND=1:GOSUB 15:GOTO 25
  107.  
  108. 60      REM SCREEN PRINT HERE
  109.         COLUMN=46
  110.         FOR X=1 TO NUM
  111.         ROW=7+X:GOSUB 10
  112.         IF CA$(X)<>"" THEN PRINT CA$(X) ELSE PRINT LEFT$(BLANK$,CA(X))        
  113.         NEXT X
  114.         RETURN
  115.  
  116. 1000    IF END #1 THEN 6000
  117.  
  118. 1001    READ #1,REC1;CA$(1),CA$(2),CA$(3),CA$(4),CA$(5) 
  119.         RETURN
  120.  
  121. 2000    PRINT CLEAR$:PRINT TAB(40-LEN(NAME$)/2);NAME$
  122.         PRINT TAB(40-LEN(LINE$)/2);LINE$:PRINT:RETURN
  123.  
  124. 2001    A%=(241-SIZE(CA$(2)+":*.*"))*1024:B%=(VAL(CA$(3))+2)*VAL(CA$(5))
  125.         IF B%>A% THEN 6000
  126.         IF END #1 THEN 6100
  127.         CREATE CA$(2)+":"+CA$(1) RECL VAL(CA$(3)) AS 1
  128.         GOSUB 2000:VV=8:GOSUB 8
  129.         PRINT TAB(21);"NOW CREATING YOUR FILE ";CA$(2);":";CA$(1);" ";
  130.         
  131. 2002    B$=""
  132.         IF CA$(6)="S" THEN B2$=CHR$(34)+""+CHR$(34) ELSE B2$="0"
  133.         IF CA$(7)="C" THEN B3$="," ELSE B3$=" "
  134.         FOR X=1 TO VAL(CA$(4))
  135.         B$=B$+B2$+B3$
  136.         NEXT X
  137.         B$=LEFT$(B$,LEN(B$)-1)
  138.         IF LEN(B$)+2>VAL(CA$(3)) THEN 6200
  139.         FOR Y=1 TO VAL(CA$(5))
  140.         PRINT USING "&";#1,Y;B$
  141.         NEXT Y
  142.         FOR X=1 TO NUM:CA$(X)="":NEXT X
  143.         CLOSE 1:GOTO 15
  144.  
  145. 6000    COLUMN=2:ROW=21:GOSUB 10
  146.         PRINT EOL$;"NOT ENOUGH DISK SPACE FOR ";CA$(2);":";CA$(1);CHR$(7);
  147.         FOR X=1 TO 200:NEXT X
  148.         GOSUB 10:PRINT EOL$:GOTO 15
  149.  
  150. 6100    COLUMN=2:ROW=21:GOSUB 10
  151.         PRINT EOL$;"NOT ENOUGH DIRECTORY SPACE FOR ";CA$(2);":";CA$(1);CHR$(7);
  152.         FOR X=1 TO 200:NEXT X
  153.         GOSUB 10:PRINT EOL$:GOTO 15
  154.  
  155. 6200    COLUMN=2:ROW=21:GOSUB 10
  156.         PRINT EOL$;"RECORD LENGTH OF";CA$(3);" IS TOO SMALL FOR";CA$(4);
  157.         PRINT " FIELDS ";CHR$(7);
  158.         FOR X=1 TO 200:NEXT X
  159.         DELETE 1:GOSUB 10:PRINT EOL$:GOTO 15
  160.  
  161. 7010    REM SCREEN INPUT FUNCTIONS HERE
  162.         Y$="":HOLDIT$=CA$(VAL(CHANGE$)):Y=1
  163.         COLUMN=46:ROW=7+VAL(CHANGE$):GOSUB 10
  164.         PRINT LEFT$(BLANK$,CA(VAL(CHANGE$))):GOSUB 10
  165.  
  166. 7015    POKE DIO,0:CALL DIO+1
  167.         CHR%=PEEK(DIO) AND 127
  168.         IF CHR%=0 THEN 7015
  169.         IF CHR%=8 AND LEN(Y$)<1 THEN 7015
  170.         IF CHR%=27 THEN RECUR$="":RETURN
  171.         IF CHR%=24 THEN 7010
  172.         IF CHR%=13 THEN 7020
  173.         IF CHR%=8  THEN Y$=LEFT$(Y$,LEN(Y$)-1):Y=Y-1:PRINT CHR$(8);" ";CHR$(8);
  174.         IF CHR%<32 OR CHR%>122 THEN 7015
  175.         IF Y>CA(VAL(CHANGE$)) THEN PRINT CHR$(7);:GOTO 7015
  176.         PRINT CHR$(CHR%);:Y$=Y$+CHR$(CHR%):Y=Y+1:GOTO 7015
  177.  
  178. 7018    CA$(VAL(CHANGE$))=HOLDIT$:RETURN
  179.  
  180. 7020    ON VAL(CHANGE$) GOTO 7021,7022,7023,7024,7025,7026,7027
  181.  
  182. 7021    IF MATCH(".",Y$,1)=0 THEN PRINT CHR$(7);:GOTO 7010
  183.         GOTO 7120
  184.  
  185. 7022    Z=ASC(Y$)-64
  186.         IF Z<1 OR Z>2 THEN PRINT CHR$(7);:GOTO 7010
  187.         GOTO 7120
  188.  
  189. 7023    Z=VAL(Y$)
  190.         IF Z<1 OR Z>1024 THEN PRINT CHR$(7);:GOTO 7010
  191.         GOTO 7120
  192.  
  193. 7024    Z=VAL(Y$)
  194.         IF Z<1 OR Z>99 THEN PRINT CHR$(7);:GOTO 7010
  195.         GOTO 7120
  196.  
  197. 7025    Z=VAL(Y$)
  198.         IF Z<1 OR Z>5000 THEN PRINT CHR$(7);:GOTO 7010
  199.         GOTO 7120
  200.  
  201. 7026    Z=ASC(Y$)
  202.         IF Z<>86 AND Z<>83 THEN PRINT CHR$(7);:GOTO 7010
  203.         GOTO 7120
  204.  
  205. 7027    Z=ASC(Y$)
  206.         IF Z<>83 AND Z<>67 THEN PRINT CHR$(7);:GOTO 7010
  207.         GOTO 7120
  208.         
  209. 7120    IF Y$=" " THEN CA$(VAL(CHANGE$))="":RETURN
  210.         IF Y$<>"" THEN CA$(VAL(CHANGE$))=Y$ ELSE CA$(VAL(CHANGE$))=HOLDIT$
  211.         ROW=21:RETURN
  212.  
  213. 8802    ROW=ROW-1:GOSUB 10:PRINT EOS$:RETURN
  214.  
  215. 8900    REM DELETE RECORD FUNCTION HERE
  216.         FOR X=1 TO 5:CA$(X)="":NEXT X
  217.         GOTO 15
  218.  
  219. 9000    REM DIRECT CONSOLE I/O                               DB
  220.         DATA 0,229,213,197,245,30,255,14,6,205,5,0,183,202,5,219,50,0
  221.         DATA 219,241,193,209,225,201,0,14,2,30,8,205,5,0,201
  222.         REM   DB 
  223.  
  224. 9990    PRINT LOW$;CLEAR$:STOP
  225.  
  226. 9992    FOR X=1 TO 24:PRINT:NEXT X
  227.         PRINT TAB(20);"ACCESS NOT PERMITTED! SEE YOUR SYSTEM SUPERVISOR..";ERR;
  228.         Y%=CONCHAR%
  229.         IF Y%=5EH THEN 9999
  230.         GOTO 9992
  231.  
  232. 9999    PRINT LOW$;CLEAR$
  233.         STOP
  234.  
  235.