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