home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol163 / dir.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  9.8 KB  |  253 lines
  1.         REM    DIR.BAS    * PROGRAM TO LOOK AT DIRECTORY FOR AMBIGUOUS
  2.         REM               * FILENAMES OR UNAMBIGUOUS
  3.         REM 01 25 83      * J.BUTLER
  4.         REM SYSTEM CONTROL PROGRAM NUMBER    :
  5.         REM FILES UNDER 'DBFM' CONTROL <Y/N> :N
  6.  
  7.         REM COMMONS GO HERE
  8.         COMMON CLEAR$,NAME$,LINE$,DEMO$,CRSR$,FOCUS$,HIGH$,LOW$,PASSWORD$, \
  9.                DATE$,EOL$,CLRFORE$,ROWOFF,COLOFF,SCRPARA,CONT
  10.  
  11.         REM ADD HARD SCREEN FUNCTIONS HERE IF NECESSARY
  12.  
  13.   REM SOROC.ADD * SOROC ATTRIBUTES
  14.   CLEAR$=CHR$(27)+CHR$(42):CRSR$=CHR$(27)+CHR$(61):EOS$=CHR$(27)+CHR$(89)
  15.   EOL$=CHR$(27)+CHR$(84):CLRFORE$=CHR$(27)+CHR$(59):CLRBACK$=CHR$(27)+CHR$(43)
  16.   HIGH$=CHR$(27)+CHR$(40):LOW$=CHR$(27)+CHR$(41):HOME$=CHR$(30)
  17.   ROWOFF=32:COLOFF=32:SCRPARA=1
  18.  
  19.         REM DIMENSIONS GO HERE
  20.         DIM MONTHS$(12),MASK$(10),C$(65)
  21.         NUM=64:REM DATAFIL$=""  
  22.  
  23.         MONTHS$(1)="JANUARY":MONTHS$(2)="FEBRUARY":MONTHS$(3)="MARCH"
  24.         MONTHS$(4)="APRIL":MONTHS$(5)="MAY":MONTHS$(6)="JUNE"
  25.         MONTHS$(7)="JULY":MONTHS$(8)="AUGUST":MONTHS$(9)="SEPTEMBER"
  26.         MONTHS$(10)="OCTOBER":MONTHS$(11)="NOVEMBER":MONTHS$(12)="DECEMBER"
  27.  
  28.         C$="0123456789ABCDEF":TRUE%=-1:BLANK1$="          ":QUEST$="????????"
  29.         BLANK$="..........":SCNO$="":ERR=5
  30.  
  31. 7       GOTO 11
  32.  
  33. 8       REM VERTICAL CURSOR POSITIONING ROUTINE
  34.         FOR ZZ=1 TO VV:PRINT:NEXT ZZ:RETURN
  35.  
  36. 9       REM DATE FORMATTING ROUTINE
  37.         DATE$=MID$(P$,1,2)+"-"+MID$(P$,3,2)+"-"+MID$(P$,5,2)
  38.         RETURN
  39.  
  40. 10      REM CURSOR ADDRESS
  41.         IF SCRPARA=1 THEN \
  42.            PRINT CRSR$;CHR$(ROW+ROWOFF);CHR$(COLUMN+COLOFF);:RETURN
  43.         PRINT CRSR$;CHR$(COLUMN+COLOFF);CHR$(ROW+ROWOFF);:RETURN
  44.  
  45. 11      REM ASM FUNCTION HERE
  46.         A$="":PRINT CLEAR$
  47.         GET.DIR$ = \
  48.         CHR$(11H)+CHR$(0)+CHR$(28H)      +\ SETDMA:     LXI D,2800
  49.         CHR$(0EH)+CHR$(01AH)             +\             MVI C,1A
  50.         CHR$(0CDH)+CHR$(05H)+CHR$(0)     +\             CALL 5
  51.         CHR$(11H)+CHR$(05CH)+CHR$(0)     +\ STRG:       LXI D,005C
  52.         CHR$(21H)+".."                   +\             LXI H,STRG ADDRESS
  53.         CHR$(01H)+CHR$(21H)+CHR$(0)      +\             LXI B,0021
  54.         CHR$(0EDH)+CHR$(0B0H)            +\             LDIR
  55.         CHR$(01EH)+"."                   +\ LDDRIVE:    LD E,DRIVE
  56.         CHR$(0EH)+CHR$(0EH)              +\             MVI C,E
  57.         CHR$(0CDH)+CHR$(05H)+CHR$(0)     +\             CALL 5
  58.         CHR$(0E5H)                       +\ GETDIR:     PUSH H
  59.         CHR$(0D5H)                       +\             PUSH D
  60.         CHR$(0C5H)                       +\             PUSH B
  61.         CHR$(011H)+CHR$(05CH)+CHR$(0)    +\             LXI D,005C
  62.         CHR$(0EH)+CHR$(011H)             +\             MVI C,FIND DIR/SH NEXT
  63.         CHR$(0CDH)+CHR$(05H)+CHR$(0)     +\             CALL 5
  64.         CHR$(032H)+".."                  +\             STA MEMLOC%
  65.         CHR$(0C1H)                       +\             POP B
  66.         CHR$(0D1H)                       +\             POP D
  67.         CHR$(0E1H)                       +\             POP H
  68.         CHR$(0C9H)+"."                    \             RET;MEMLOC%
  69.  
  70.         GET.DIR% = SADD(GET.DIR$) + 1  REM      POINT TO FIRST DATA BYTE
  71.         REM  RELOCATE ADDRESSES WITHIN STRING
  72.         STRG.ADDR%=SADD(GET.DIR$)+13:DRIVE%=SADD(GET.DIR$)+21
  73.         GTONE%=SADD(GET.DIR$)+34:CHKGOOD%=SADD(GET.DIR$)+45
  74.         POKE SADD(GET.DIR$)+39,CHKGOOD%
  75.         POKE SADD(GET.DIR$)+40,((CHKGOOD%) AND 0FF00H) / 100H
  76.  
  77.         REM INITIALIZE THE ASM SUBROUTINE
  78.         REM HEX VALUE HERE
  79.         B9$=STR$(GET.DIR%):B9=GET.DIR%:B8$=""
  80.         FOR X%=LEN(B9$)-1 TO 1 STEP -1
  81.         Z=16^X%-(16^(X%-1)):R=16^(X%-1):Y=(B9 AND Z)/R
  82.         B8$=B8$+MID$(C$,INT(Y)+1,1)
  83.         NEXT X%
  84.         PRINT CLEAR$:PRINT "GET.DIR%=";GET.DIR%,B8$
  85.  
  86. 15      REM SCREEN GENERATION HERE
  87.         PRINT CLEAR$:SCRN=4:GOSUB 3000:PRINT " SIZE of DISK (k):";TAB(29);
  88.         PRINT "DIRECTORY ATTRIBUTES  SPACE LEFT (Sectors):"
  89.         PRINT " 1.";TAB(20);"17.";TAB(39);"33.";TAB(58);"49."
  90.         PRINT " 2.";TAB(20);"18.";TAB(39);"34.";TAB(58);"50."
  91.         PRINT " 3.";TAB(20);"19.";TAB(39);"35.";TAB(58);"51."
  92.         PRINT " 4.";TAB(20);"20.";TAB(39);"36.";TAB(58);"52."
  93.         PRINT " 5.";TAB(20);"21.";TAB(39);"37.";TAB(58);"53."
  94.         PRINT " 6.";TAB(20);"22.";TAB(39);"38.";TAB(58);"54."
  95.         PRINT " 7.";TAB(20);"23.";TAB(39);"39.";TAB(58);"55."
  96.         PRINT " 8.";TAB(20);"24.";TAB(39);"40.";TAB(58);"56."
  97.         PRINT " 9.";TAB(20);"25.";TAB(39);"41.";TAB(58);"57."
  98.         PRINT "10.";TAB(20);"26.";TAB(39);"42.";TAB(58);"58."
  99.         PRINT "11.";TAB(20);"27.";TAB(39);"43.";TAB(58);"59."
  100.         PRINT "12.";TAB(20);"28.";TAB(39);"44.";TAB(58);"60."
  101.         PRINT "13.";TAB(20);"29.";TAB(39);"45.";TAB(58);"61."
  102.         PRINT "14.";TAB(20);"30.";TAB(39);"46.";TAB(58);"62."
  103.         PRINT "15.";TAB(20);"31.";TAB(39);"47.";TAB(58);"63."
  104.         PRINT "16.";TAB(20);"32.";TAB(39);"48.";TAB(58);"64."
  105.         IF SECOND=1 THEN SECOND=0:RETURN
  106.  
  107. 20      PRINT HIGH$;CLRFORE$;
  108.         COLUMN=10:ROW=22:GOSUB 10:PRINT EOL$;
  109.         PRINT "FILENAME TO FIND ON DIRECTORY   :";:INPUT "";LINE C8$
  110.         IF C8$="" OR C8$="STOP" OR C8$="END" THEN 9990
  111.         IF LEN(C8$)>12 THEN 20
  112.         R=MATCH(".",C8$,1):R1=MATCH("*",C8$,1)
  113.         IF R=0 THEN 20
  114.         D8$=LEFT$(C8$,R-1):D9$=RIGHT$(C8$,LEN(C8$)-R)
  115.         IF R1=0 THEN 22
  116.         IF R1<R THEN D8$=LEFT$(D8$,R1-1)+LEFT$(QUEST$,8-R1+1)
  117.         IF R1>R THEN D9$=LEFT$(QUEST$,3):GOTO 22
  118.         R2=MATCH("*",C8$,R1+1)
  119.         IF R2=0 THEN 22
  120.         D9$=LEFT$(QUEST$,3)
  121.  
  122. 22      C8$=D8$+D9$
  123.  
  124. 23      COLUMN=10:ROW=22:GOSUB 10:PRINT EOL$;
  125.         PRINT "DRIVE WHERE PROGRAM RESIDES     :";:INPUT "";LINE DR$
  126.         DR=ASC(DR$)
  127.         IF DR<65 OR DR>72 THEN 23
  128.         DR=DR-65:DR$=CHR$(0)
  129.  
  130. 24      REM MORE THAN ONE OCCURANCE
  131.         D$="":IT$="Y":IT=(LEFT$(IT$,1)="Y")*TRUE%
  132.         FOR Y=1 TO 21:D$=D$+CHR$(0):NEXT Y
  133.         C7$=DR$+C8$+D$:C7%=SADD(C7$)+1:Y=1:POKE DRIVE%,DR
  134.         POKE STRG.ADDR%,C7%:POKE STRG.ADDR%+1,(C7% AND 0FF00H)/0100H
  135.  
  136. 25      IF Y>1 AND IT=1 THEN POKE GTONE%,18
  137.         IF Y>1 AND IT=0 THEN 9991
  138.         C9$="":CALL GET.DIR%:CHK=PEEK(CHKGOOD%)
  139.         IF CHK=255 THEN 30
  140.         Z9=(CHK AND 3)*32+10240
  141.         FOR X=Z9 TO Z9+11:C9$=C9$+CHR$(PEEK(X)):NEXT X
  142.         D8$=LEFT$(C9$,LEN(C9$)-3):D9$=RIGHT$(C9$,3):C9$=D8$+"."+D9$
  143.         COLUMN=INT((Y-1)/16)*19+5:ROW=Y-(INT((Y-1)/16)*16)+5:GOSUB 10
  144.         C$(Y)=C9$:PRINT C$(Y):Y=Y+1
  145.         IF Y>64 THEN 3002
  146.         GOTO 25
  147.  
  148. 30      PRINT LOW$;:COLUMN=10:ROW=22:GOSUB 10:PRINT EOL$;
  149.         PRINT "IS THIS DATA CORRECT <Y/N> :";:INPUT "";LINE DATA$
  150.         GOSUB 10:PRINT EOL$;
  151.         IF DATA$="" OR LEFT$(DATA$,1)="Y" THEN 15
  152.         IF DATA$="STOP" OR DATA$="END" THEN 9990
  153.         GOTO 9990
  154.         
  155. 40      REM ERROR CHECKING STATEMENT HERE
  156.         RECUR$="":COLUMN=11:ROW=22:GOSUB 10
  157.         PRINT EOL$;"'S'TOP, 'D'ELETE, 'R'ECUR @, FIELD #  :";
  158.         INPUT "";LINE CHANGE$
  159.         IF LEFT$(CHANGE$,1)="S" THEN GOSUB 2001:GOTO 9990
  160.         IF CHANGE$="" THEN GOSUB 2001:SECOND=1:GOSUB 15:GOTO 20
  161.         IF CHANGE$="D" THEN 8900
  162.         IF MID$(CHANGE$,1,1)="R" THEN RECUR$="R" \
  163.            :CHANGE$=MID$(CHANGE$,2,LEN(CHANGE$)-1)
  164.         IF VAL(CHANGE$)=0 THEN 15
  165.  
  166. 50      IF VAL(CHANGE$)<1 OR VAL(CHANGE$)>NUM THEN 40
  167.         GOSUB 7010
  168.         IF RECUR$="R" AND VAL(CHANGE$)<=NUM THEN \
  169.            CHANGE$=STR$(VAL(CHANGE$)+1):GOTO 50
  170.         REM GOSUB 2001
  171.         SECOND=1:GOSUB 15:GOTO 20
  172.  
  173. 60      REM SCREEN PRINT HERE
  174.         FOR X=1 TO NUM
  175.         COLUMN=INT((X-1)/16)*19+7:ROW=X-(INT((X-1)/16)*16)+4:GOSUB 10
  176.         IF C$(X)="" THEN PRINT BLANK$ ELSE PRINT C$(X)
  177.         NEXT X:RETURN
  178.  
  179. 1000    IF END #1 THEN 6000
  180.  
  181. 1001    READ #1,REC1+1;A1$,B1$,C1$,D1$
  182.         RETURN
  183.  
  184. 2001    REM PRINT #1,REC1+1;A1$,B1$,C1$,D1$
  185.         RETURN
  186.  
  187. 3000    PRINT TAB(40-(LEN(COMPANY$)/2));COMPANY$
  188.         PRINT TAB(5);"SCREEN:";SCRN;TAB(64);"DATE:";DATE$
  189.         PRINT TAB(27);"Direct I/O Data Transfer":PRINT:RETURN
  190.  
  191. 3002    COLUMN=10:ROW=22:GOSUB 10:PRINT EOL$;
  192.         PRINT "Directory Too LARGE! .. Will wrap around now"
  193.         PRINT " if other than 'RETURN' depressed ...  ... :";:INPUT "";LINE CH$
  194.         COLUMN=10:ROW=22:GOSUB 10:PRINT EOS$;
  195.         IF CH$="" OR CH$=CHR$(13) THEN SECOND=1:GOSUB 15:GOTO 30
  196.         Y=1:GOTO 24
  197.  
  198. 6000    COLUMN=2:ROW=22:GOSUB 10
  199.         PRINT EOL$;"RECORD #";REC1; \
  200.         " HAS NOT BEEN ESTABLISHED FOR ";DATAFIL$;" ";CHR$(7);
  201.         PRINT ": PRESS 'RETURN' :";:Y%=CONCHAR%
  202.         COLUMN=1:GOSUB 10:PRINT EOL$;
  203.  
  204. 6100    COLUMN=2:ROW=22:GOSUB 10
  205.         PRINT EOL$;"DO YOU WANT TO CREATE THIS RECORD <Y/N> : ";
  206.         INPUT "";LINE Y$
  207.         IF LEFT$(Y$,1)<>"Y" THEN 6102
  208.         SECOND=1:GOSUB 8900:GOSUB 10:PRINT EOL$;:GOTO 25
  209.  
  210. 6102    GOSUB 10:PRINT EOL$;:REC1=0:GOTO 15
  211.  
  212. 7010    REM SCREEN INPUT FUNCTIONS HERE
  213.         DUM$="":HOLDIT$=C$(VAL(CHANGE$)):Y1=0
  214.         COLUMN=INT((VAL(CHANGE$)-1)/16)*19+7
  215.         ROW=VAL(CHANGE$)-(INT((VAL(CHANGE$)-1)/16)*16)+4
  216.         GOSUB 10:PRINT BLANK$
  217.         REM COLUMN=COLUMN-1
  218.         GOSUB 10
  219.  
  220. 7015    Y%=CONCHAR%
  221.         IF Y%=24 THEN 7010
  222.         IF Y%=27 THEN Y1=0:RECUR$="":GOTO 7020
  223.         IF Y%=8 OR Y%=127 AND Y1>0 THEN Y1=Y1-1:PRINT CHR$(8);".";CHR$(8);: \
  224.            DUM$=LEFT$(DUM$,Y1):GOTO 7015
  225.         IF Y%=13 THEN 7020
  226.         IF Y%<32 OR Y%>123 THEN 7015
  227.         Y1=Y1+1
  228.         IF Y1>10 THEN PRINT CHR$(8);" ";CHR$(7);:GOTO 7010
  229.         DUM$=DUM$+CHR$(Y%):GOTO 7015
  230.  
  231. 7020    IF Y1<1 THEN C$(VAL(CHANGE$))=HOLDIT$:GOSUB 10:PRINT HOLDIT$:RETURN
  232.         IF DUM$=" " THEN C$(VAL(CHANGE$))="" \
  233.            ELSE C$(VAL(CHANGE$))=DUM$
  234.         RETURN
  235.  
  236. 8900    REM DELETE RECORD FUNCTION HERE
  237.         PRINT #1,REC1+1;"","","",""
  238.         IF SECOND=1 THEN SECOND=0:RETURN
  239.         GOTO 15
  240.  
  241. 9990    REM STOP HERE
  242.  
  243. 9991    STOP
  244.  
  245. 9992    FOR X=1 TO 24:PRINT:NEXT X
  246.         PRINT TAB(20);"ACCESS NOT PERMITTED! SEE YOUR SYSTEM SUPERVISOR..";ERR
  247.         Y%=CONCHAR%
  248.         IF Y%=5EH THEN 9999
  249.         GOTO 9992
  250.  
  251. 9999   STOP
  252.  
  253.