home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib31a.dsk / JUNE.1987 / RECORD.KEEPER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  7KB  |  158 lines
  1. 10  REM  **********************
  2. 20  REM  *   RECORD.KEEPER    *
  3. 30  REM  * A SPARSE FILE DEMO *
  4. 40  REM  * BY  SANDY MOSSBERG *
  5. 50  REM  * COPYRIGHT (C) 1987 *
  6. 60  REM  * BY MICROSPARC, INC *
  7. 70  REM  * CONCORD, MA  01742 *
  8. 80  REM  **********************
  9. 90  REM 
  10. 100  REM  ======================
  11. 110  REM   INITIALIZE VARIABLES
  12. 120  REM  ======================
  13. 130  LOMEM:  PEEK(105) + PEEK(106) *256 +256: REM  Increase LOMEM by 256 bytes before variables are defined
  14. 140 BUF =  PEEK(105) + PEEK(106) *256 -256: REM  Use liberated space as buffer
  15. 150 D$ =  CHR$(4):B$ =  CHR$(7)
  16. 160 F$ = "RK.DATA":L$ = ",L256":L = 255
  17. 170 BIVERS = 49149:COL80 = 49183
  18. 180  IF   NOT  PEEK(BIVERS)  THEN  PRINT B$: PRINT "BASIC.SYSTEM VERSION 1.0 NOT ACCEPTABLE": END : REM  Abort if BI v1.0 installed
  19. 190  PRINT D$"PREFIX": INPUT PFX$: REM  Get prefix
  20. 200 PN$ = PFX$ +F$: REM  Set full pathname of data file
  21. 210  REM  ==================
  22. 220  REM   VERIFY DATA FILE
  23. 230  REM  ==================
  24. 240  ONERR  GOTO 1510: REM  Enable ONERR flag
  25. 250  PRINT D$"BLOAD"PN$",TTXT,A"BUF",L256": REM  Check status of RK.DATA file
  26. 260 FLAG = 1: REM  If above command not trapped, file may be accessed
  27. 270  POKE 216,0: REM  Disable ONERR flag
  28. 280  REM  ==========
  29. 290  REM   SET DATE
  30. 300  REM  ==========
  31. 310  HOME 
  32. 320  INPUT "Enter Date (DA-MON-YR): ";DA$
  33. 330  IF DA$ = ""  THEN DA$ = "NO DATE": GOTO 400
  34. 340 DL =  LEN(DA$)
  35. 350  IF DL <7  OR DL >9  THEN 310
  36. 360  IF  MID$ (DA$,DL -2,1) < >"-"  OR  MID$ (DA$,DL -6,1) < >"-"  THEN 310
  37. 370  REM  ======
  38. 380  REM   MENU
  39. 390  REM  ======
  40. 400  HOME 
  41. 410  PRINT "-------------"
  42. 420  PRINT "RECORD KEEPER"
  43. 430  PRINT "-------------"
  44. 440  PRINT "  1. Enter New Record"
  45. 450  PRINT "  2. View Record"
  46. 460  PRINT "  3. View Record Usage"
  47. 470  PRINT "  4. Delete Record"
  48. 480  PRINT "  5. Catalog Disk"
  49. 490  PRINT "  6. Quit"
  50. 500  PRINT : PRINT "Selection: ";
  51. 510  GET A$:A =  VAL(A$)
  52. 520  IF A <1  OR A >6  THEN 510
  53. 530  PRINT A
  54. 540  ON A GOTO 590,790,940,1110,1280
  55. 550  END 
  56. 560  REM  ==================
  57. 570  REM   ENTER NEW RECORD
  58. 580  REM  ==================
  59. 590  IF   NOT FLAG  THEN  GOSUB 1430: GOTO 610: REM  Filter out empty file
  60. 600  PRINT D$"BLOAD"PN$",TTXT,A"BUF",L256": REM  Load record map into buffer
  61. 610  GOSUB 1350: REM  Get record number
  62. 620  IF   NOT  PEEK(BUF +R)  THEN 650: REM  If record not filled, proceed
  63. 630  PRINT B$: PRINT "THIS RECORD ALREADY FILLED"
  64. 640  GOSUB 1410: GOTO 400
  65. 650  PRINT D$"OPEN"PN$;L$
  66. 660  PRINT D$"WRITE"PN$",R"R
  67. 670  PRINT "RECORD "R: REM  Save record number data
  68. 680  PRINT DA$: REM  Save date data
  69. 690  PRINT D$"CLOSE"
  70. 700 FLAG = 1: REM  Enable file access flag
  71. 710 RF =  PEEK(BUF) +1
  72. 720  POKE BUF,RF: REM  Increment count of filled records
  73. 730  POKE BUF +R,1: REM  Mark record filled in buffer image of record map
  74. 740  PRINT D$"BSAVE"PN$",TTXT,A"BUF",L256"",B0": REM  Save record map back to disk
  75. 750  GOSUB 1390: GOTO 400
  76. 760  REM  =============
  77. 770  REM   VIEW RECORD
  78. 780  REM  =============
  79. 790  IF   NOT FLAG  THEN  PRINT B$: PRINT "NO RECORDS ENTERED": GOSUB 1410: GOTO 400: REM  Check file access
  80. 800  PRINT D$"BLOAD"PN$",TTXT,A"BUF",L256": REM  Load record map into buffer
  81. 810  GOSUB 1350: REM  Get record number
  82. 820  IF  PEEK(BUF +R)  THEN 850: REM  If record filled, proceed
  83. 830  PRINT B$: PRINT "THIS RECORD EMPTY"
  84. 840  GOSUB 1410: GOTO 400
  85. 850  PRINT D$"OPEN"PN$;L$
  86. 860  PRINT D$"READ"PN$",R"R
  87. 870  INPUT A$: INPUT A1$
  88. 880  PRINT D$"CLOSE"
  89. 890  PRINT : PRINT " "A$: PRINT " "A1$
  90. 900  GOSUB 1410: GOTO 400
  91. 910  REM  ===================
  92. 920  REM   VIEW RECORD USAGE
  93. 930  REM  ===================
  94. 940  IF   NOT FLAG  THEN 790: REM  Check file access
  95. 950  PRINT D$"BLOAD"PN$",TTXT,A"BUF",L256": REM  Load record map into buffer
  96. 960  PRINT : PRINT "Records Containing Data:": PRINT 
  97. 970 CW = 78: IF  PEEK(COL80) <128  THEN CW = 38: REM  Set column width for display
  98. 980 J = 3: REM  Start at column 3
  99. 990  FOR I = 1 TO L: REM  Search entire record map
  100. 1000  IF   NOT  PEEK(I +BUF)  THEN 1050: REM  Skip empty record
  101. 1010 A$ =  STR$(I)
  102. 1020  HTAB (J - LEN(A$) +1): PRINT I;: REM  Format and print filled record number
  103. 1030 J = J +5: REM  Tab to next display column
  104. 1040  IF J >CW  THEN J = 3: PRINT : REM  If end of line, set next line
  105. 1050  NEXT I
  106. 1060 RF =  PEEK(BUF): REM  Get number of used records
  107. 1070  PRINT : GOSUB 1390: GOTO 400
  108. 1080  REM  ===============
  109. 1090  REM   DELETE RECORD
  110. 1100  REM  ===============
  111. 1110  IF   NOT FLAG  THEN 790: REM  Check file access
  112. 1120  PRINT D$"BLOAD"PN$",TTXT,A"BUF",L256": REM  Load record map into buffer
  113. 1130  GOSUB 1350: REM  Get record number
  114. 1140  IF  PEEK(BUF +R)  THEN 1170: REM  If record filled, proceed
  115. 1150  PRINT B$: PRINT "THIS RECORD EMPTY"
  116. 1160  GOSUB 1410: GOTO 400
  117. 1170  POKE BUF +R,0: REM  Mark record used in buffer image of record map
  118. 1180 RF =  PEEK(BUF) -1
  119. 1190  POKE BUF,RF: REM  Decrement count of filled records
  120. 1200  PRINT D$"BSAVE"PN$",TTXT,A"BUF",L256"",B0": REM  Save record map back to disk
  121. 1210  GOSUB 1430: REM  Convert buffer to empty record
  122. 1220 B = (L +1) *R: REM  Set absolute record offset
  123. 1230  PRINT D$"BSAVE"PN$",TTXT,A"BUF",L256"",B"B: REM  Save empty record back to disk
  124. 1240  GOSUB 1390: GOTO 400
  125. 1250  REM  ==============
  126. 1260  REM   CATALOG DISK
  127. 1270  REM  ==============
  128. 1280  HOME 
  129. 1290  IF  PEEK(COL80) <128  THEN  PRINT D$"CAT"PFX$: GOTO 1310
  130. 1300  PRINT D$"CATALOG"PFX$
  131. 1310  GOSUB 1410: GOTO 400
  132. 1320  REM  =============
  133. 1330  REM   SUBROUTINES
  134. 1340  REM  =============
  135. 1350  VTAB 14: CALL  -958: INPUT "ENTER RECORD NUMBER: ";R$:R =  VAL(R$): REM  Enter record number
  136. 1360  IF R$ = ""  THEN  POP : GOTO 400: REM  If RETURN pressed, go to menu
  137. 1370  IF R < > INT(R)  OR R <1  OR R >L  THEN 1350
  138. 1380  RETURN 
  139. 1390  PRINT : PRINT " RECORDS USED : "RF: REM  Print number of filled and empty records
  140. 1400  PRINT " RECORDS EMPTY: "L -RF
  141. 1410  PRINT : PRINT "Press Any Key ";: GET A$: REM  Pause
  142. 1420  RETURN 
  143. 1430  FOR I = BUF TO BUF +255: REM  Fill buffer with zeroes
  144. 1440  POKE I,0: NEXT I
  145. 1450  RETURN 
  146. 1460  PRINT B$: PRINT "NO RECORDS ENTERED": GOSUB 1300
  147. 1470  RETURN 
  148. 1480  REM  ===============
  149. 1490  REM   ERROR HANDLER
  150. 1500  REM  ===============
  151. 1510  POKE 216,0: REM  Disable ONERR flag
  152. 1520 ERR =  PEEK(222): REM  Get error code
  153. 1530  IF ERR <5  AND ERR >7  THEN  RESUME : REM  Report fatal error and abort program
  154. 1540  CALL  -3288: REM  Clean up stack
  155. 1550  IF ERR = 5  THEN 310: REM  END OF DATA error means empty file exists
  156. 1560  PRINT D$"OPEN"PN$;L$: REM  PATH NOT FOUND error means RK.DATA must be created
  157. 1570  PRINT D$"CLOSE"
  158. 1580  GOTO 310