Nibble Magazine/nib32b.dsk/GALLERY.bas

BASIC Source File | 2023-02-26 | 6KB | 103 lines

10  REM  **************************
20  REM  **************************
30  REM  **                      **
40  REM  **  GALLERY             **
50  REM  **                      **
60  REM  **  Copyright (C) 1987  **
70  REM  **  by MicroSPARC, Inc. **
80  REM  **  52 Domino Drive     **
90  REM  **  Concord, MA  01742  **
100  REM **                      **
110  REM **************************
120  REM **************************
130 :
140 :
150  REM  by Robert C. Moore
160 :
170  REM  Part of Nibble Clip Art
180 :
190 :
200  HIMEM: 6144
210 D$ =  CHR$(4):B$ = ",S6,D1": POKE 216,0:V = 0:RAM =  PEEK(967):O$ = "PRODOS":C$ = "CAT":P$ = "PATH":R$ = ",S3,D2":DOS =  PEEK(966): IF DOS  THEN O$ = "DOS3.3":C$ = "CATALOG":P$ = "FILE":R$ = ",S3,D1"
220  ONERR  GOTO 940
230  GOSUB 890:PR$ = "PRESS <RETURN>":SD$ = B$: IF RAM  THEN SD$ = R$
240  PRINT D$"BLOAD BACKGROUND"SD$: PRINT D$"BLOAD UNPACK.FAST"SD$
250  ONERR  GOTO 580
260  POKE 49168,0: HTAB 10: PRINT "<L> LOAD PICTURE FILE": VTAB 17: HTAB 10: PRINT "<C> CATALOG DISK VOLUME": IF V  THEN  VTAB 19: HTAB 10: PRINT "<V> VIEW FILE IN MEMORY"
270  VTAB 19 +V +V: HTAB 8: PRINT "<ESC> RETURN TO MAIN MENU"
280  GOSUB 860: IF K = 195  OR K = 227 GOTO 800
290  IF V  THEN  IF K = 214  OR K = 246 GOTO 360
300  IF K = 155  OR K = 209  OR K = 241 GOTO 970
310  IF K < >204  AND K < >236 GOTO 280
320  GOSUB 550: HTAB 12: PRINT "LOAD PICTURE FILE": GOSUB 660:D = 0: GOSUB 710: IF ESC  THEN  GOSUB 550: GOTO 260
330  VTAB 21 +2 *RAM: PRINT  SPC( 28): HTAB 1: PRINT P$"NAME":";:INPUT "";F$:E=1:POKE 38397,255:POKE 38398,0:POKE 38399,0:?D$"B LOAD "F$SD$
340 V = 0:NP =  PEEK(38397):A = 38400 - PEEK(38398) -256 * PEEK(38399):S =  INT(A/576): IF 576 *S < >A GOTO 630
350  IF S < >NP GOTO 630
360 V = 1: GOSUB 550: HTAB 7: PRINT "WRITE GALLERY.PIC SCREENS TO:": GOSUB 660: VTAB 21 +2 *RAM: HTAB 14: PRINT "  <D> DISPLAY ONLY":D = 1: GOSUB 710: IF D GOTO 430
370 N = 5: ONERR  GOTO 400
380 F$ = "": IF P  THEN  VTAB 21 +2 *RAM: PRINT  SPC( 79): VTAB 20 +2 *RAM: PRINT : PRINT "PREFIX: ";: INPUT "";F$: IF  RIGHT$(F$,1) < >"/"  THEN F$ = F$ +"/"
390  PRINT D$"DELETE"F$"GALLERY.PIC."N;SD$: GOTO 410
400  CALL  -3288
410 N = N -1: IF N GOTO 390
420  ONERR  GOTO 580
430  GOSUB 550: PRINT "DO YOU WANT THE MINI-GRAPHICS XDRAWN TO ": PRINT " WHITE OR BLACK BACKGROUNDS? (W/B) ";
440  GET A$: IF A$ < >"W"  AND A$ < > CHR$(119)  AND A$ < >"B"  AND A$ < > CHR$(98) GOTO 440
450  PRINT A$: POKE 7213,9: POKE 7214,15: POKE 7221,127: IF A$ = "B"  OR A$ =  CHR$(98)  THEN  POKE 7213,41: POKE 7214,240: POKE 7221,0
460 E = 2:N = 1:PN = 0
470  CALL 7168: VTAB 22: HTAB 14: PRINT "GALLERY.PIC."N: FOR Y = 0 TO 108  STEP 54: FOR X = 0 TO 182  STEP 91:PN = PN +1: IF PN >NP  THEN X = 182:Y = 108: GOTO 490
480  POKE 215,PN: POKE 224,X: POKE 226,Y: CALL 774
490  NEXT X,Y: IF D GOTO 510
500  PRINT D$"BSAVE"F$"GALLERY.PIC."N",A$2000,L$1FF8"SD$
510  VTAB 24: HTAB 14: PRINT PR$;: VTAB 21: PRINT : GOSUB 860: GOSUB 550:N = N +1: IF PN <NP GOTO 470
520  GOTO 830
530 :
540  REM  CLEAR COMMUNICATIONS WINDOW
550  VTAB 15: PRINT  SPC( 200); SPC( 199): GOTO 910
560 :
570  REM  ERROR HANDLER
580  CALL 64477: CALL  -3288: GOSUB 550: ON E GOTO 260,510,600
590  GOTO 260
600  GOSUB 890: GOTO 800
610 :
620  REM  PICFILE CHECK ERROR
630  GOSUB 550: HTAB 12: PRINT "BAD PICTURE FILE": CALL 64477: FOR I = 0 TO 1999: NEXT : GOSUB 550: GOTO 260
640 :
650  REM  PARTIAL MENU
660 P = 0: VTAB 17: HTAB 16: PRINT "<1> DRIVE 1": VTAB 19: HTAB 16: PRINT "<2> DRIVE 2": IF RAM  THEN  VTAB 21: HTAB 16: PRINT "<R> RAMDISK"
670  IF   NOT DOS  THEN  VTAB 18: HTAB 28: PRINT "<P> PATHNAME"
680  VTAB 21 +2 *RAM: HTAB 14: PRINT "<ESC> GO BACK": RETURN
690 :
700  REM  GET MENU SELECTION
710 ESC = 0: GOSUB 860: IF K = 177  OR K = 178  THEN  VTAB K +K -337: HTAB 16: INVERSE : PRINT "<"K -176">": NORMAL :SD$ =  LEFT$(B$,5) + CHR$(K -128): GOTO 770
720  IF RAM  THEN  IF K = 210  OR K = 242  THEN SD$ = R$: VTAB 21: HTAB 16: INVERSE : PRINT "<R>": NORMAL : GOTO 770
730  IF D  THEN  IF K = 196  OR K = 228  THEN  RETURN
740  IF   NOT DOS  THEN  IF K = 208  OR K = 240  THEN  VTAB 18: HTAB 28: INVERSE : PRINT "<P>": NORMAL :SD$ = "":P = 1: GOTO 770
750  IF K = 155  THEN ESC = 1: RETURN
760  GOTO 710
770 D = 0: RETURN
780 :
790  REM  CATALOG DISK
800  GOSUB 550: HTAB 12: PRINT "CATALOG DISK VOLUME": GOSUB 660:D = 0: GOSUB 710: IF ESC  THEN  GOSUB 550: GOTO 260
810 F$ = "": IF P  THEN  VTAB 21 +2 *RAM: PRINT  SPC( 79): VTAB 20 +2 *RAM: PRINT : INPUT "DIRECTORY PREFIX: ";F$
820  HOME :E = 3: PRINT D$C$F$SD$: HTAB 12: PRINT PR$;: GOSUB 860
830  GOSUB 890: GOTO 260
840 :
850  REM  GET KEYPRESS CODE
860  WAIT 49152,128:K =  PEEK(49152): POKE 49168,0: RETURN
870 :
880  REM  PRINT TITLE DISPLAY
890  TEXT : HOME : PRINT  CHR$(17); CHR$(21); CHR$(24): VTAB 1: FOR I = 0 TO 39: PRINT  CHR$(95);: NEXT : VTAB 3: HTAB 10: PRINT "NIBBLE "O$" GALLERY": VTAB 5: HTAB 12: PRINT "BY ROBERT C. MOORE": VTAB 6
900  FOR I = 0 TO 39: PRINT  CHR$(95);: NEXT : VTAB 9: HTAB 12: PRINT "COPYRIGHT (C) 1987": HTAB 12: PRINT "BY MICROSPARC, INC.": HTAB 12: PRINT "52 DOMINO DRIVE": HTAB 12: PRINT "CONCORD, MA  01742"
910  VTAB 14: PRINT : RETURN
920 :
930  REM  FILE MISSING
940  CALL 64477: CALL  -3288: HOME : VTAB 10: PRINT "DISK ERROR": FOR I = 0 TO 999: NEXT
950 :
960  REM  EXIT TO START.CLIPART
970  HOME : PRINT : ONERR  GOTO 1000
980 SD$ = B$: IF RAM  THEN SD$ = R$
990  PRINT D$"RUN START.CLIPART"SD$
1000  CALL 64477: CALL  -3288: VTAB 12: PRINT "PLEASE PLACE THE MINI-GRAPHICS DISK": PRINT : PRINT "IN DRIVE 1 AND PRESS <RETURN>."
1010  GOSUB 860: IF K < >141  AND K < >155 GOTO 1010
1020  IF K = 141  THEN SD$ = B$: GOTO 990
1030  GOTO 220