home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib40a.dsk / JANUARY.1991 / PACK.UNPACK.bas < prev    next >
BASIC Source File  |  2023-02-26  |  4KB  |  54 lines
  1. 1  REM  PACK.UNPACK / (c) 1991 MindCraft Publ. Corp. / By Peter Stubbs
  2. 70  PRINT  CHR$(21): LOMEM: 4630:F = 4621:P = 4352:M = 4541:U = 768:C =  -958:D$ =  CHR$(4):S$ =  CHR$(32): DIM A$(5): FOR I = F TO F +8: READ B: POKE I,B: NEXT : FOR I = 1 TO 5: READ A$(I): NEXT 
  3. 80  PRINT D$"BLOADUNPACK": PRINT D$"BLOADPACK,A"P: PRINT D$"BLOADPIC.MOVE,A"M
  4. 90 Z = 0: TEXT : HOME : NORMAL : PRINT "PACK.UNPACK BY PETER STUBBS": PRINT : PRINT "COPYRIGHT 1991 - MINDCRAFT PUBL. CORP.": PRINT D$"PREFIX": INPUT B$: VTAB 5: PRINT "PREFIX: ";: INVERSE : PRINT B$: NORMAL 
  5. 100  VTAB 8: FOR I = 1 TO 5: PRINT I;S$;A$(I): PRINT : NEXT : PRINT D$"FRE": VTAB 19: PRINT "Enter choice": VTAB 23: PRINT "SPACE BAR FLIPS DISPLAY MODE - ESC EXITS";: POKE 35,22
  6. 110  CALL C: VTAB 20: HTAB 1: INVERSE : PRINT "->";: NORMAL : GET B$: ON B$ =  CHR$(27) GOTO 570: IF B$ = S$  THEN  CALL F: GOTO 110
  7. 120 B =  VAL(B$): ON B <1  OR B >5 GOTO 110: VTAB 6 +B *2: HTAB 3: INVERSE : PRINT A$(B): NORMAL : ON B GOTO 150,140,260,250,340
  8. 130  REM LOAD
  9. 140 Z = 1
  10. 150  GOSUB 500: ONERR  GOTO 170
  11. 160  PRINT D$"VERIFY"A$: POKE 216,0: GOTO 180
  12. 170  GOSUB 440: GOTO 150
  13. 180  CALL 942: IF Z  THEN B$ = "": ON  PEEK(956) = 6 GOTO 200:B$ = ",T$C1": ON  PEEK(956) = 193 GOTO 200: GOTO 230
  14. 190  IF   NOT Z  THEN B$ = ",T$C0": ON  PEEK(956) < >192 GOTO 230
  15. 200  PRINT D$"BLOAD"A$",A$1400,L$8000"B$: ON Z GOTO 220
  16. 210  POKE 254, PEEK(957): VTAB 18: CALL C: VTAB 20: HTAB 10: INVERSE : PRINT " UNPACKING PICTURE ": NORMAL : CALL U: GOTO 90
  17. 220  CALL M: GOTO 90
  18. 230  HTAB 1: INVERSE : PRINT "WRONG FILE TYPE";: GOSUB 470: GOTO 150
  19. 240  REM SAVE
  20. 250 Z = 1:N = 32768: CALL M +2: GOTO 280
  21. 260  VTAB 18: CALL C: PRINT : HTAB 10: INVERSE : PRINT " PACKING PIC ": NORMAL : CALL P: IF  PEEK(254) < >0  THEN  INVERSE : PRINT "PACK ERR";: GOSUB 470: GOTO 90
  22. 270 N =  PEEK(237) +256 * PEEK(238)
  23. 280  GOSUB 500: ONERR  GOTO 300
  24. 290  PRINT D$"VERIFY"A$: VTAB 19: INVERSE :N$ = "PIC EXISTS - ENTER A NEW NAME": GOSUB 510: GOTO 290
  25. 300  ONERR  GOTO 530
  26. 310  PRINT D$"BSAVE"A$",A$1400,L"N: POKE 216,0: ON Z GOTO 90
  27. 320  CALL 942: POKE 945,195: POKE 952,7: POKE 956,192: POKE 957,1: POKE 958,0: CALL 942: POKE 945,196: POKE 952,10: GOTO 90
  28. 330  REM PREFIX
  29. 340  VTAB 19: PRINT "Type new prefix"
  30. 350  GOSUB 390: ONERR  GOTO 370
  31. 360  PRINT D$"PREFIX"A$: POKE 216,0: GOTO 90
  32. 370  VTAB 19: HTAB 1: INVERSE : PRINT "PATH NOT FOUND - TRY AGAIN": NORMAL : GOTO 350
  33. 380  REM INPUT
  34. 390 A$ = "":L = 0
  35. 400  VTAB 20: HTAB 1: INVERSE : PRINT "->";: NORMAL : PRINT A$;: CALL C: GET B$:B =  ASC(B$): ON L = 0  AND B = 13 GOTO 400: IF B = 32  THEN  CALL F: GOTO 400
  36. 410  ON B = 13 GOTO 490: ON B = 27 GOTO 590: IF (B = 8  OR B = 127)  AND (L >0)  THEN L = L -1: ON L = 0 GOTO 390:A$ =  LEFT$(A$,L): GOTO 400
  37. 420  ON B = 44 GOTO 430: ON (B >122  OR B <46  OR (B >57  AND B <65)  OR (B >90  AND B <97)) GOTO 400: IF B >90  THEN B$ =  CHR$(B -32)
  38. 430 A$ = A$ +B$:L = L +1: GOTO 400
  39. 440  HTAB 1: INVERSE : PRINT "PIC NOT FOUND - HIT A KEY FOR CATALOG";: NORMAL : CALL C
  40. 450  GET B$: ON B$ =  CHR$(27) GOTO 590: IF B$ = S$  THEN  CALL F: GOTO 450
  41. 460  HOME : PRINT D$"CAT": RETURN 
  42. 470  PRINT " - HIT A KEY";: NORMAL : CALL C
  43. 480  WAIT  -16384,128: GET B$: ON B$ =  CHR$(27) GOTO 590: ON B$ < >S$ GOTO 490: CALL F: GOTO 480
  44. 490  RETURN 
  45. 500 N$ = "Type pic name (CAT=CATALOG)"
  46. 510  VTAB 19: HTAB 1: CALL C: PRINT N$;: NORMAL : GOSUB 390: IF A$ = "CAT"  THEN  HOME : PRINT D$A$: GOTO 510
  47. 520  RETURN 
  48. 530  INVERSE :E =  PEEK(222): HTAB 1: IF E = 6  THEN  PRINT "DISK NOT FOUND";: GOTO 560
  49. 540  IF E = 9  THEN  PRINT "DISK FULL";: GOTO 560
  50. 550  PRINT "ERR: "E
  51. 560  GOSUB 470: GOTO 90
  52. 570  TEXT : HOME : END : DATA 173,41,192,73,192,141,41,192,96
  53. 580  DATA "LOAD AND UNPACK A PIC","LOAD A NON PACKED PIC","PACK & SAVE A PIC","SAVE A NON PACKED PIC","CHANGE PREFIX"
  54. 590  POP : GOTO 90