home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib36b.dsk / PRICE.FILE.COMP.bas < prev    next >
BASIC Source File  |  2023-02-26  |  4KB  |  82 lines

  1. 10  REM  **********************
  2. 20  REM  * PRICE.FILE.COMP    *
  3. 30  REM  * BY GERHALD HANSEL  *
  4. 40  REM  * COPYRIGHT(C) 1989  *
  5. 50  REM  * MICROSPARC, INC    *
  6. 60  REM  * CONCORD, MA 01742  *
  7. 70  REM  **********************
  8. 80  REM 
  9. 90  POKE 33,40: ONERR  GOTO 700
  10. 100  HOME : GOTO 120
  11. 110  HTAB 20 - INT( LEN(A$)/2): PRINT A$: RETURN 
  12. 120 A$ = "PRICE FILE COMPRESSOR": GOSUB 110:A$ = "BY GERHALD HANSEL": GOSUB 110
  13. 130 A$ = "COPYRIGHT(C) 1989": GOSUB 110
  14. 140 A$ = "MICROSPARC, INC": GOSUB 110: PRINT 
  15. 150  PRINT : PRINT : PRINT 
  16. 160  PRINT "THIS PROGRAM ALLOWS YOU TO SHORTEN": PRINT 
  17. 170  PRINT "THE PRICE FILES CREATED BY": PRINT : PRINT "THE NIBBLE INVESTOR"
  18. 180  PRINT : PRINT 
  19. 190  PRINT "THE INVESTOR WAS PUBLISHED IN NIBBLE": PRINT 
  20. 200  PRINT "VOLUME #4, ISSUE #2 AND": PRINT 
  21. 210  PRINT "NIBBLE EXPRESS VOLUME IV.": PRINT 
  22. 220  GOSUB 290
  23. 230  HOME : CLEAR :D$ =  CHR$(4): REM       CTRL-D  
  24. 240  PRINT "CHOOSE ONE OF THE FOLLOWING:": PRINT : PRINT "1..SHORTEN PRICE FILE"
  25. 250  PRINT : PRINT "2..QUIT PROGRAM": PRINT : PRINT "ENTER CHOICE ";:
  26. 260  GET A$: PRINT :A =  VAL(A$): IF A <1  OR A >2  THEN 230
  27. 270  HOME :X =  FRE(0)
  28. 280  ON A GOTO 310,690
  29. 290  INPUT "PRESS <RETURN> TO CONTINUE.";A$: RETURN 
  30. 300  REM  FILE NAME INPUT
  31. 310  HOME : PRINT "IF YOU NEED THE CATALOG, TYPE ? <RETURN>"
  32. 320  INPUT "FILE NAME ";NA$: IF NA$ = ""  THEN 310
  33. 330  IF NA$ = "?"  THEN  PRINT D$;"CATALOG": GOSUB 290: GOTO 310
  34. 340 NL =  ASC(NA$): IF NL > = 65  AND NL < = 90  OR NL > = 193  AND NL < = 218  THEN 360
  35. 350  PRINT "FILE NAME MUST BEGAN WITH A LETTER": PRINT : GOSUB 290: GOTO 310
  36. 360  PRINT D$;"VERIFY";NA$
  37. 370  REM  INPUT RECORD 0
  38. 380  PRINT D$;"OPEN";NA$;",L50  
  39. 390  PRINT D$;"READ ";NA$;",R0"
  40. 400  INPUT U$:R =  VAL(U$): PRINT D$;"CLOSE";NA$
  41. 410  PRINT : PRINT "THERE ARE "R" RECORDS IN FILE ": PRINT : PRINT NA$".": PRINT 
  42. 420  IF R < = 52  THEN  PRINT "THERE IS NO NEED TO SHORTEN THE FILE ": PRINT : PRINT NA$".": PRINT : GOSUB 290: GOTO 230
  43. 430  DIM U$(R +1,7),V$(53,7)
  44. 440  PRINT "DO YOU WANT TO SHORTEN ": PRINT : PRINT NA$: PRINT : PRINT "TO 52 RECORDS Y/N ?": GET A$: PRINT 
  45. 450  IF (A$ = "N"  OR A$ = "n")  THEN 230
  46. 460  IF (A$ = "Y"  OR A$ = "y")  THEN 490
  47. 470  HOME : GOTO 440
  48. 480  REM    READ PRICE FILE DATA 
  49. 490 NN$ = NA$ +"B": PRINT D$;"RENAME";NA$;","NN$: PRINT NA$" HAS BEEN RENAMED "NN$: PRINT 
  50. 500  PRINT D$;"OPEN";NN$;",L50 
  51. 510  FOR W = R -51 TO R
  52. 520 N = N +1
  53. 530  PRINT D$;"READ";NN$",R";W
  54. 540  FOR F = 1 TO 7: INPUT U$(W,F)
  55. 550 V$(N,F) = U$(W,F)
  56. 560  NEXT : NEXT W
  57. 570  PRINT D$;"CLOSE": PRINT 
  58. 580  REM  STORES RECORDS
  59. 590  PRINT D$;"OPEN";NA$;",L50"
  60. 600  PRINT D$;"WRITE";NA$;",R0
  61. 610 R$ = "52": PRINT R$
  62. 620  FOR W = 1 TO 52
  63. 630  PRINT D$;"WRITE";NA$;",R";W
  64. 640  FOR F = 1 TO 7
  65. 650  PRINT V$(W,F)
  66. 660  NEXT F: NEXT W
  67. 670  PRINT D$;"CLOSE";NA$
  68. 680  PRINT "THE ORIGINAL FILE IS "NA$ +"B": PRINT : PRINT "THE SHORTENED FILE IS "NA$: PRINT : GOSUB 290: GOTO 230
  69. 690  HOME : END 
  70. 700  PRINT D$;"CLOSE";NA$
  71. 710  IF  PEEK(222) = 4  THEN  VTAB 21: PRINT "DISK WRITE PROTECTED:GOTO10020   
  72. 720  IF  PEEK(222) = 5  THEN  VTAB 21: PRINT "END OF DATA FOR FILE:GOTO10020
  73. 730  IF  PEEK(222) = 6  THEN  VTAB 21: PRINT "NO FILE BY THAT NAME": GOTO 810
  74. 740  IF  PEEK(222) = 8  THEN  VTAB 21: PRINT "DISK I/O ERROR": GOTO 810
  75. 750  IF  PEEK(222) = 9  THEN  VTAB 21: PRINT "DISK FULL.. SET UP A NEW DISK": GOTO 810
  76. 760  IF  PEEK(222) = 10  THEN  VTAB 21: PRINT "FILE LOCKED": GOTO 810
  77. 770  IF  PEEK(222) = 13  THEN  VTAB 21: PRINT "FILE TYPE MISMATCH": GOTO 810
  78. 780  IF  PEEK(222) = 107  THEN  VTAB 21: PRINT "BAD SUBSCRIPT": GOTO 810
  79. 790  IF  PEEK(222) = 120  THEN  VTAB 21: PRINT "REDIMENSIONED ARRAY": GOTO 810
  80. 800  VTAB 21: PRINT "ERROR#"; PEEK(222);" HAS OCCURRED IN LINE "; PEEK(218) + PEEK(219) *256".": PRINT "CHECK APPLE MANUAL ERROR CODES (DOS & APPLESOFT)": GOTO 810
  81. 810  CALL  -868: INPUT "PRESS <RETURN> FOR MENU";A$
  82. 820  GOTO 230