home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib26a.dsk / NOVEMBER.1985 / PIC.COMPRESSOR.bas < prev    next >
BASIC Source File  |  2023-02-26  |  3KB  |  49 lines
  1. 10  REM ************************
  2. 20  REM * PIC.COMPRESSOR       *
  3. 30  REM * BY RICHARD KISS      *
  4. 40  REM * COPYRIGHT (C) 1985   *
  5. 50  REM * BY MICROSPARC, INC.  *
  6. 60  REM * CONCORD, MA.  01742  *
  7. 70  REM ************************
  8. 80  SPEED= 255: INVERSE : HIMEM: 8192 -1024 *( PEEK(48896) = 76):CA$ = "CAT": IF  PEEK(48896) < >76  THEN CA$ = "CATALOG"
  9. 90  TEXT : HOME : HTAB 12: PRINT  SPC( 18): PRINT : HTAB 12: PRINT "  HI-RES PICTURE  "
  10. 100  HTAB 12: PRINT "    COMPRESSOR    ": HTAB 12: PRINT  SPC( 18): NORMAL 
  11. 110  VTAB 8: HTAB 13: PRINT "BY RICHARD KISS": HTAB 13: PRINT "COPYRIGHT, 1985": HTAB 12: PRINT "BY MICROSPARC,INC.": VTAB 12
  12. 120  PRINT : PRINT " THIS PROGRAM TAKES HI-RES IMAGES STOREDON DISK AND CRUNCHES THEM INTO THE LEASTPOSSIBLE MEMORY."
  13. 130 EF = 1: ONERR  GOTO 480
  14. 140  PRINT  CHR$(4)"BLOAD CRUNCH"
  15. 150  VTAB 22: HTAB 9: PRINT "PRESS <RETURN> TO CONTINUE ";
  16. 160  GET A$: PRINT 
  17. 170  HOME :EF = 2: ONERR  GOTO 480
  18. 180  PRINT "ENTER PICTURE NAME OR 1 FOR PAGE 1,     2 FOR PAGE 2, ? FOR CATALOG"
  19. 190  PRINT : INPUT "FILE-->";A$: IF A$ = "?"  THEN  PRINT  CHR$(4)CA$: GOTO 190
  20. 200  IF A$ = "1"  OR A$ = "2"  THEN A =  VAL(A$): GOTO 220
  21. 210  PRINT "LOADING PICTURE...": PRINT  CHR$(4)"BLOAD "A$",A$2000":A = 1: ONERR  GOTO 480
  22. 220  HOME : PRINT "PRESS ANY KEY FOR PICTURE THEN PRESS A  KEY AGAIN TO RETURN TO TEXT MODE"
  23. 230  POKE  -16368,0: WAIT  -16384,128: POKE  -16368,0
  24. 240  POKE  -16297,0: POKE  -16302,0: POKE  -16301 +A,0: POKE  -16304,0
  25. 250  HOME : WAIT  -16384,128: POKE  -16368,0: POKE  -16300,0: POKE  -16303,0
  26. 260  PRINT "COMPRESSING..."
  27. 270  FOR I = 8192 *A +120 TO 8192 *(A +1)  STEP 128: FOR J = I TO I +7: POKE J,0: NEXT : NEXT 
  28. 280  POKE 4,A *32: POKE 8192 *(A +1) -1,1: CALL 24576
  29. 290  POKE 24634,32 *A: VTAB 6: PRINT "DONE! IT WOULD TAKE UP ";:B =  PEEK(2) + PEEK(3) *256:L = B -24633
  30. 300 M = 2 + INT((L +4)/256): IF  PEEK(48896) = 76  THEN  PRINT  INT(M/2 +.5)" BLOCKS.": GOTO 320
  31. 310  PRINT M" SECTORS."
  32. 320  PRINT : PRINT : IF M >33  THEN  PRINT "THIS IS NOT SPACE SAVING. SAVE ABORTED.": GOTO 460
  33. 330 EF = 3: ONERR  GOTO 480
  34. 340  PRINT "INPUT NAME TO SAVE, "3 -A" FOR PAGE "3 -A",       <CR> FOR SAME NAME OR . TO ABORT.": PRINT 
  35. 350 YF = 0: PRINT "PAGE "A":";: INPUT "FILE-->";C$
  36. 360  IF C$ = "."  THEN 460
  37. 370  IF C$ = "1"  OR C$ = "2"  THEN A =  VAL(C$): GOTO 290
  38. 380  IF C$ = ""  AND (A$ = "1"  OR A$ = "2")  THEN  PRINT : PRINT "YOU MUST SUPPLY A FILE NAME.": GOTO 340
  39. 390  IF C$ = ""  THEN  PRINT : INPUT "DELETE ORIGINAL FILE? ";YN$:YF =  LEFT$(YN$,1) = "Y": IF   NOT YF  THEN  PRINT : PRINT "SAVE ABORTED.": GOTO 460
  40. 400  IF  VAL(C$) < >0  THEN  PRINT : PRINT "INVALID FILE NAME": GOTO 340
  41. 410  IF YF  THEN C$ = A$: PRINT  CHR$(4)"DELETE"C$: ONERR  GOTO 480
  42. 420  PRINT "SAVING...":B =  PEEK(37) -1
  43. 430  PRINT  CHR$(4)"BSAVE"C$",A$6039,L"L: ONERR  GOTO 480
  44. 440  VTAB B +1
  45. 450  PRINT "SAVING COMPLETE."
  46. 460  INPUT "ANOTHER PICTURE?";A$:A$ =  LEFT$(A$,1): IF A$ = "Y"  THEN 170
  47. 470  TEXT : VTAB 23: POKE 115,0: POKE 116,150: END 
  48. 480 E =  PEEK(222):EL =  PEEK(218) +256 * PEEK(219): POKE 216,0: HOME : VTAB 12: PRINT "ERROR #"E" IN LINE "EL: VTAB 22: PRINT "PRESS <RETURN> TO CONTINUE";: GET Z$: PRINT 
  49. 490  ON EF GOTO 90,170,330