Nibble Magazine/nib32b.dsk/CLIP.ART.bas

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

10  REM  **************************
20  REM  **************************
30  REM  **                      **
40  REM  **  CLIP.ART            **
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  POKE 49168,0:D$ =  CHR$(4):B$ = ",S6,D1":RAM =  PEEK(967):C = 0: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 1000
230  GOSUB 900: IF C GOTO 280
240 SD$ = B$: IF RAM  THEN SD$ = R$
250  PRINT D$"BLOAD PICFILE.CREATE"SD$: PRINT D$"BLOAD UPK.OBJ"SD$
260  FOR L = 0 TO 199: IF  PEEK(49152) >127  THEN L = 199
270  NEXT : POKE 49168,0
280  GOSUB 950: ONERR  GOTO 860
290  IF C  THEN  CALL 7191: GOTO 310
300 C = 1: POKE 230,32: CALL  -3086: CALL 7168
310 V =  PEEK(6): GOSUB 830: ON V GOTO 340,380,510,590,680
320 :
330  REM  LOAD MINI-GRAPHIC
340  HTAB 12: PRINT "LOAD MINI-GRAPHIC": GOSUB 730: IF ESC GOTO 650
350  GOSUB 1150: PRINT D$"BLOAD"F$",A$9600"SD$: POKE 7,255: GOTO 650
360 :
370  REM  HI-RES SCREEN
380  HTAB 10: PRINT "HIGH-RESOLUTION SCREEN": VTAB 17: HTAB 8: PRINT "<L> LOAD NEW SCREEN": VTAB 19: HTAB 8: PRINT "<S> SAVE SCREEN IN MEMORY": VTAB 21: HTAB 8: PRINT "<E> ERASE SCREEN IN MEMORY": VTAB 23: HTAB 8
390  PRINT "<ESC> GO BACK"
400  GOSUB 1120: IF K = 155 GOTO 650
410  IF K = 197  OR K = 229  THEN  CALL  -3086: GOTO 650
420  IF K = 211  OR K = 243  THEN  GOSUB 830: HTAB 8: PRINT "SAVE HIGH-RESOLUTION SCREEN": GOSUB 730: GOTO 460
430  IF K < >204  AND K < >236 GOTO 400
440  GOSUB 830: HTAB 8: PRINT "LOAD HIGH-RESOLUTION SCREEN": GOSUB 730: IF ESC GOTO 480
450  GOSUB 1150: PRINT D$"BLOAD"F$",A$2000"SD$: GOTO 650
460  IF ESC GOTO 480
470  GOSUB 1150: PRINT D$"BSAVE"F$",A$2000,L$1FF8"SD$
480  GOSUB 830: GOTO 380
490 :
500  REM  SAVE MINI-GRAPHIC FILE
510  HTAB 10: PRINT "SAVE MINI-GRAPHIC FILE": GOSUB 730: IF ESC GOTO 650
520 D =  PEEK(215): POKE 38397,D:L = 576 *D:A = 38400 -L:Y =  INT(A/256): POKE 38399,Y:Y = A -256 *Y: POKE 38398,Y: GOSUB 1150: ONERR  GOTO 540
530  PRINT D$"DELETE"F$SD$: GOTO 550
540  CALL  -3288
550  ONERR  GOTO 860
560  PRINT D$"BSAVE"F$",A"A",L"L;SD$: GOSUB 830: GOSUB 950: CALL 7172: GOTO 310
570 :
580  REM  QUIT
590  HTAB 8: PRINT "DO YOU REALLY WANT TO QUIT?": VTAB 17: HTAB 8: PRINT "<Y> YES, GO TO MAIN MENU": VTAB 19: HTAB 8: PRINT "<N> NO, GO BACK"
600  GOSUB 1120: IF K = 155  OR K = 206  OR K = 238 GOTO 650
610  IF K = 217  OR K = 249 GOTO 1030
620  GOTO 600
630 :
640  REM  RETURN TO PICTURE
650  GOSUB 830: GOSUB 950: CALL 7191: GOTO 310
660 :
670  REM  CATALOG DISK
680  HTAB 12: PRINT "CATALOG DISK VOLUME":F$ = "": GOSUB 730: IF ESC GOTO 650
690  IF P  THEN  VTAB 21 +2 *RAM: PRINT  SPC( 79): VTAB 20 +2 *RAM: PRINT : INPUT "DIRECTORY PREFIX: ";F$
700  HOME : PRINT D$C$F$SD$: HTAB 12: PRINT "PRESS <RETURN>";: GOSUB 1120: GOTO 230
710 :
720  REM  PARTIAL MENU
730 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"
740  IF   NOT DOS  THEN  VTAB 18: HTAB 28: PRINT "<P> PATHNAME"
750  VTAB 21 +2 *RAM: HTAB 14: PRINT "<ESC> GO BACK":ESC = 0
760  GOSUB 1120: 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): RETURN
770  IF RAM  THEN  IF K = 210  OR K = 242  THEN SD$ = R$: VTAB 21: HTAB 16: INVERSE : PRINT "<R>": NORMAL : RETURN
780  IF   NOT DOS  THEN  IF K = 208  OR K = 240  THEN  VTAB 18: HTAB 28: INVERSE : PRINT "<P>": NORMAL :SD$ = "":P = 1: RETURN
790  IF K = 155  THEN ESC = 1: RETURN
800  GOTO 760
810 :
820  REM  CLEAR COMMUNICATION WINDOW
830  VTAB 15: PRINT  SPC( 200); SPC( 199): POKE 2039,160: GOTO 920
840 :
850  REM  DISK ERROR
860  CALL 64477: CALL  -3288: IF V = 5  THEN  GOSUB 900
870  GOTO 310
880 :
890  REM  PRINT TITLE
900  TEXT : HOME : PRINT  CHR$(17); CHR$(21); CHR$(24): VTAB 1: FOR L = 0 TO 39: PRINT  CHR$(95);: NEXT : VTAB 3: HTAB 10: PRINT "NIBBLE "O$" CLIP ART": VTAB 5: HTAB 12: PRINT "BY ROBERT C. MOORE"
910  VTAB 6: FOR L = 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"
920  VTAB 14: PRINT : RETURN
930 :
940  REM  PRINT MENU
950  VTAB 22: INVERSE : PRINT "N";: NORMAL : PRINT "EGATIVE  ";: INVERSE : PRINT "L";: NORMAL : PRINT "OAD PIC  ";: INVERSE : PRINT "?";: NORMAL : PRINT "-CATALOG  ";: INVERSE : PRINT "D";: NORMAL : PRINT "RAW PIC"
960  HTAB 2: INVERSE : PRINT "M";: NORMAL : PRINT "IRROR  ";: INVERSE : PRINT "H";: NORMAL : PRINT "I-RES PIC  ";: INVERSE : PRINT "C";: NORMAL : PRINT "APTURE  ";: INVERSE : PRINT "X";: NORMAL : PRINT "-FACTOR="
970  HTAB 3: INVERSE : PRINT "F";: NORMAL : PRINT "LIP  ";: INVERSE : PRINT "S";: NORMAL : PRINT "AVE PICFILE  ";: INVERSE : PRINT "V";: NORMAL : PRINT "IEW   # PICS =";: GOTO 920
980 :
990  REM  FILE MISSING
1000  CALL 64477: CALL  -3288: HOME : VTAB 10: PRINT "DISK ERROR": FOR L = 0 TO 999: NEXT
1010 :
1020  REM  EXIT
1030  HOME : PRINT : ONERR  GOTO 1060
1040 SD$ = B$: IF RAM  THEN SD$ = R$
1050  PRINT D$"RUN START.CLIPART"SD$
1060  CALL 64477: CALL  -3288: VTAB 12: PRINT "PLEASE PLACE THE MINI-GRAPHICS DISK": PRINT : PRINT "IN THE BOOT DRIVE AND PRESS <RETURN>."
1070  GOSUB 1120: IF K < >141  AND K < >155 GOTO 1070
1080  IF K = 141  THEN SD$ = B$: GOTO 1050
1090  GOTO 220
1100 :
1110  REM  GET KEYPRESS CODE
1120  WAIT 49152,128:K =  PEEK(49152): POKE 49168,0: RETURN
1130 :
1140  REM  GET FILE/PATH NAME
1150  VTAB 21 +2 *RAM: PRINT  SPC( 79): VTAB 20 +2 *RAM: PRINT : PRINT P$"NAME: ";: INPUT "";F$: IF  LEFT$(F$,1) = "/"  THEN SD$ = ""
1160  RETURN