2 REM ****************************************************************
3 REM ** **
4 REM ** THE PURPOSE OF THIS PROGRAM IS TO ALLOW THE CREATION **
5 REM ** OF GRAPHICS DRAWINGS BY MOVING A DOT CURSOR ON THE **
6 REM ** MEDIUM RESOLUTION GRAPHICS SCREEN AND USING THE **
7 REM ** DEFINED FUNCTION KEYS TO DRAW LINES, CIRCLES AND TO **
8 REM ** PAINT WITHIN DEFINED BOUNDARIES. THE OPTION TO STORE **
9 REM ** THE CREATED SCREENS IS PROVIDED WITH RETRIEVAL FOR **
10 REM ** FURTHER EDITING AND STORAGE AVAILABLE. **
11 REM ** **
12 REM ** AUTHOR: DOUGLAS E. OLUFSEN **
13 REM ** LAST REVISION: DECEMBER 3, 1981 **
14 REM ** **
15 REM ****************************************************************
40 CLS
47 REM ------------------------------------------------------------------------
48 REM *** DEACTIVATE ALL FUNCTION KEYS ***
49 KEY OFF
50 KEY 1,"":KEY 2,"":KEY 3,"":KEY 4,"":KEY 5,""
51 KEY 6,"":KEY 7,"":KEY 8,"":KEY 9,"":KEY 10,""
55 DIM POS1(2),POS2(2),POS3(2),POS4(2),POSD(2),BKGND%(93)
56 DIM DTASAVE%(8002)
58 REM ------------------------------------------------------------------------
59 REM *** CHECK IF PREVIOUSLY STORED SCREEN IS DESIRED ***
60 A$="TESTSCRN"
61 IF "N"=LEFT$(A$,1) OR "n"=LEFT$(A$,1) THEN GOTO 100
62 'PRINT "":INPUT;"ENTER FILE NAME (OR `NONE'): ",A$
63 'IF A$="NONE" OR A$="none" THEN 100
64 ON ERROR GOTO 85:OPEN "R",#1,"SCREENS",128
65 FIELD 1,12 AS NA$,4 AS BKC$,4 AS PAL$,108 AS B$
66 FOR I%=1 TO 9:GET #1,I%
67 IF NA$=LEFT$(A$+SPACE$(12),12) THEN GOTO 70 ELSE NEXT I%
68 PRINT " ":PRINT "FILE SELECTED NOT ON DATA DISK":CLOSE 1:GOTO 62
70 BKC=CVS(BKC$):PAL=CVS(PAL$)
71 CLOSE 1
78 ON ERROR GOTO 0
79 'GOSUB 9100
80 GOSUB 9500
81 SCREEN 1
82 COLOR BKC,PAL
83 DEF SEG =&HB800:BLOAD A$,0:DEF SEG
84 GOTO 200
85 IF ERR=53 AND ERL=66 THEN PRINT "INDEX FILE NOT FOUND - TRY AGAIN.":RESUME 6
86 IF ERR=5 AND ERL=2205 THEN RESUME 2210 ELSE GOTO 9900
98 REM ------------------------------------------------------------------------
99 REM *** INPUT OF THE BACKGROUND AND PALETTE COLORS FOR NEW SCREEN ***
100 PRINT "":INPUT;"BACKGROUND COLOR NUMBER (0-15;16 FOR LIST): ",BKC
110 IF BKC>=0 AND BKC<=15 THEN 130 ELSE IF BKC=16 THEN 120 ELSE PRINT " >>> INPUT ERROR <<<":GOTO 100
120 PRINT " "
121 PRINT "COLOR KEY:"
122 PRINT " 0 BLACK 8 GRAY"
123 PRINT " 1 BLUE 9 LIGHT BLUE"
124 PRINT " 2 GREEN 10 LIGHT GREEN"
125 PRINT " 3 CYAN 11 LIGHT CYAN"
126 PRINT " 4 RED 12 LIGHT RED"
127 PRINT " 5 MAGENTA 13 LIGHT MAGENTA"
128 PRINT " 6 BROWN 14 YELLOW"
129 PRINT " 7 WHITE 15 HIGH INTENSITY WHITE":PRINT " ":GOTO 100
130 PRINT " "
131 INPUT "PALETTE GROUP NUMBER (0 OR 1): ",PAL
132 IF PAL=0 OR PAL=1 THEN 154 ELSE PRINT " >>>INPUT ERROR<<<":GOTO 131
154 GOSUB 9100
155 GOSUB 9500
163 SCREEN 1
164 COLOR BKC,PAL
199 REM ----------------------------------------------------------------------
200 REM ***DEFINE SUBROUTINE LOCATIONS FOR FUNCTION AND CURSOR KEYS***
210 ON KEY (1) GOSUB 1100:ON KEY (2) GOSUB 1200:ON KEY (3) GOSUB 1300
220 ON KEY (4) GOSUB 1400:ON KEY (5) GOSUB 1500:ON KEY (6) GOSUB 1600
230 ON KEY (7) GOSUB 1700:ON KEY (8) GOSUB 1800:ON KEY (9) GOSUB 1900
240 ON KEY(10) GOSUB 2000:ON KEY(11) GOSUB 2100:ON KEY(12) GOSUB 2200
250 ON KEY(13) GOSUB 2300:ON KEY(14) GOSUB 2400:ON PEN GOSUB 2500
259 REM ----------------------------------------------------------------------
260 REM ***ACTIVATE FUNCTION AND CURSOR KEYS AS REQUIRED***
270 KEY (1) ON: KEY (2) OFF: KEY (3) ON: KEY (4) ON: KEY (5) ON
280 KEY (6) ON: KEY (7) OFF: KEY (8) OFF: KEY (9) OFF: KEY(10) OFF
290 KEY(11) ON: KEY(12) ON: KEY(13) ON: KEY(14) ON:PEN ON
299 REM ----------------------------------------------------------------------
300 REM ***INITIALIZE NECESSARY VARIABLES***
310 LASTC=0
320 OPT=0
321 OUT1=0
322 ON ERROR GOTO 86
399 REM ----------------------------------------------------------------------
400 REM ***PLACE CURSOR DOT ON SCREEN AND LOOP UNTIL INTERRUPTED***
410 PSET (POSD(1),POSD(2)),3
420 FOR IX=1 TO 40
421 AA=1+1
422 NEXT
430 PRESET (POSD(1),POSD(2))
440 FOR IX=1 TO 40
441 AA=1+1
442 NEXT
449 IF OUT1=1 THEN PSET(POSD(1),POSD(2)),LASTC:GOSUB 9900
450 GOTO 400
1099 REM ----------------------------------------------------------------------
1100 REM *** KEY F1 ACTIVATED *** START LINE/CIRCLE POINT (POS1) ***
1101 POS1(1)=POSD(1):POS1(2)=POSD(2)
1105 IF OPT=0 THEN OPT=1:GOTO 1110 ELSE IF OPT=2 THEN GOTO 1130 ELSE GOTO 1198
1110 KEY (1) OFF:KEY (3) OFF:KEY (5) OFF:KEY (6) OFF
1120 KEY (2) ON
1130 KEY (1) OFF:KEY (3) OFF:KEY (5) OFF:KEY (6) OFF
1135 KEY (7) ON:KEY (8) ON:KEY (9) ON:KEY (10) ON
1198 RETURN
1199 REM ----------------------------------------------------------------------
1200 REM *** KEY F2 ACTIVATED *** END LINE/CIRCLE POINT (POS2) ***
1205 POS2(1)=POSD(1):POS2(2)=POSD(2)
1210 KEY (2) OFF
1220 KEY (7) ON:KEY (8) ON:KEY (9) ON:KEY (10) ON
1240 RETURN
1299 REM ----------------------------------------------------------------------
1300 REM *** KEY F3 ACTIVATED *** CIRCLE INITIATED - CENTER POINT (POS3) ***
1301 POS3(1)=POSD(1):POS3(2)=POSD(2)
1305 IF OPT=0 THEN OPT=2
1306 IF OPT=3 THEN 1350
1310 KEY (3) OFF:KEY (5) OFF:KEY (6) OFF
1315 GOTO 1398
1350 KEY (3) OFF
1355 KEY (7) ON:KEY (8) ON:KEY (9) ON: KEY (10) ON
1398 RETURN
1399 REM ----------------------------------------------------------------------
1400 REM *** KEY F4 ACTIVATED *** ABORT CURRENT DRAWING ***
1401 REM ***REINITIALIZE FUNCTION AND CURSOR KEYS ACTIVATION***
1410 KEY (1) ON: KEY (2) OFF: KEY (3) ON: KEY (4) ON: KEY (5) ON
1420 KEY (6) ON: KEY (7) OFF: KEY (8) OFF: KEY (9) OFF: KEY(10) OFF
1430 KEY(11) ON: KEY(12) ON: KEY(13) ON: KEY(14) ON
1440 OPT=0
1450 POS1(1)=0:POS1(2)=0:POS2(1)=0:POS2(2)=0:POS3(1)=0:POS3(2)=0
1498 RETURN
1499 REM ----------------------------------------------------------------------
1500 REM *** KEY F5 ACTIVATED *** INITIATE PAINT FUNCTION ***
1505 KEY (1) OFF:KEY (3) OFF:KEY (6) OFF
1510 KEY (7) ON:KEY (8) ON:KEY (9) ON: KEY (10) ON
1511 IF OPT=3 THEN GET(0,0)-(103,6),BKGND%:GOTO 1512 ELSE GOTO 1530
1512 KEY (5) OFF:KEY (7) OFF:KEY (8) OFF:KEY (9) OFF:KEY (10) OFF
1513 LOCATE 1,1:INPUT;"BACKGROUND:",BKC
1514 PUT (0,0),BKGND%,PSET
1515 IF BKC>=0 AND BKC<=15 THEN GOTO 1516 ELSE GOTO 1513
1516 LOCATE 1,1:INPUT;"PALETTE:",PAL
1517 PUT (0,0),BKGND%,PSET
1518 IF PAL>=0 AND PAL<=1 THEN GOTO 1519 ELSE GOTO 1516
1519 IF COLR1>=0 AND COLR1<=15 THEN COLOR BKC,PAL ELSE GOTO 1598
1524 GOSUB 1400
1525 GOTO 1598
1530 OPT=3
1531 POS1(1)=POSD(1):POS1(2)=POSD(2)
1598 RETURN
1599 REM ----------------------------------------------------------------------
1600 REM *** KEY F6 ACTIVATED *** END DRAWING AND STORE SCREEN ***
1601 PSET (POSD(1),POSD(2)),LASTC
1605 GOTO 9900
1698 OUT1=1:RETURN 449
1699 REM ----------------------------------------------------------------------
1700 REM *** KEY F7 ACTIVATED *** SELECT COLOR 0 (BACKGROUND) ***
1705 IF OPT=4 THEN COLR2=0:GOSUB 3000 ELSE COLR1=0:GOSUB 3000
1798 RETURN
1799 REM ----------------------------------------------------------------------
1800 REM *** KEY F8 ACTIVATED *** SELECT COLOR 1 (PALETTE) ***
1805 IF OPT=4 THEN COLR2=1:GOSUB 3000 ELSE COLR1=1:GOSUB 3000
1898 RETURN
1899 REM ----------------------------------------------------------------------
1900 REM *** KEY F9 ACTIVATED *** SELECT COLOR 2 (PALETTE) ***
1905 IF OPT=4 THEN COLR2=2:GOSUB 3000 ELSE COLR1=2:GOSUB 3000
1998 RETURN
1999 REM ----------------------------------------------------------------------
2000 REM *** KEY F10 ACTIVATED *** SELECT COLOR 3 (PALETTE) ***
2005 IF OPT=4 THEN COLR2=3:GOSUB 3000 ELSE COLR1=3:GOSUB 3000
2098 RETURN
2099 REM ----------------------------------------------------------------------
2100 REM *** CURSOR MOVEMENT UP DETECTED ***
2105 PSET (POSD(1),POSD(2)),3
2110 IF POSD(2)=0 THEN BEEP:GOTO 2198
2115 PRESET (POSD(1),POSD(2)),LASTC
2120 POSD(2)=POSD(2)-1
2125 LASTC=POINT(POSD(1),POSD(2))
2198 RETURN
2199 REM ----------------------------------------------------------------------
2200 REM *** CURSOR MOVEMENT LEFT DETECTED ***
2205 PSET (POSD(1),POSD(2)),3
2210 IF POSD(1)=0 THEN BEEP:GOTO 2298
2215 PRESET (POSD(1),POSD(2)),LASTC
2220 POSD(1)=POSD(1)-1
2225 LASTC=POINT(POSD(1),POSD(2))
2298 RETURN
2299 REM ----------------------------------------------------------------------
2300 REM *** CURSOR MOVEMENT RIGHT DETECTED ***
2305 PSET (POSD(1),POSD(2)),3
2310 IF POSD(1)=319 THEN BEEP:GOTO 2398
2315 PRESET (POSD(1),POSD(2)),LASTC
2320 POSD(1)=POSD(1)+1
2325 LASTC=POINT(POSD(1),POSD(2))
2398 RETURN
2399 REM ----------------------------------------------------------------------
2400 REM *** CURSOR MOVEMENT DOWN DETECTED ***
2405 PSET (POSD(1),POSD(2)),3
2410 IF POSD(2)=199 THEN BEEP:GOTO 2498
2415 PRESET (POSD(1),POSD(2)),LASTC
2420 POSD(2)=POSD(2)+1
2425 LASTC=POINT(POSD(1),POSD(2))
2498 RETURN
2499 REM ----------------------------------------------------------------------
2500 REM *** CURSOR MOVEMENT FROM LIGHT PEN DETECTED ***
2505 PSET (POSD(1),POSD(2)),3
2510 IF PEN(1)<0 OR PEN(1)>319 THEN BEEP:GOTO 2598
2512 IF PEN(2)<0 OR PEN(2)>199 THEN BEEP:GOTO 2598
2515 PRESET (POSD(1),POSD(2)),LASTC
2520 POSD(1)=PEN(1):POSD(2)=PEN(2)
2525 LASTC=POINT(POSD(1),POSD(2))
2598 RETURN
2599 REM ----------------------------------------------------------------------
3000 REM *** DRAW DESIRED FEATURE ***
3005 IF OPT=1 THEN 3010 ELSE IF OPT=2 THEN 3020
3006 IF OPT=3 THEN 3030 ELSE IF OPT=4 THEN 3040 ELSE 3090
3010 LINE (POS1(1),POS1(2))-(POS2(1),POS2(2)),COLR1:GOTO 3090
3020 RAD=(((POS3(1)-POS1(1))^2)+((POS3(2)-POS1(2))^2))^.5
3021 STRRAD=0:ENDRAD=2*3.141593
3025 CIRCLE(POS3(1),POS3(2)),RAD,COLR1,STRRAD,ENDRAD
3026 LASTC=POINT(POSD(1),POSD(2)):GOTO 3090
3030 OPT=4:GOTO 3099
3040 PSET(POS1(1),POS1(2)),LASTC
3041 PAINT (POS1(1),POS1(2)),COLR1,COLR2:LASTC=COLR1:GOTO 3090
3090 GOSUB 1400
3099 RETURN
9099 REM ----------------------------------------------------------------------
9100 REM *** SUBROUTINE TO LIST ON SCREEN FUNCTION KEY DEFINITIONS ***
9110 CLS
9111 PRINT"FUNCTION KEY DEFINITIONS:
9112 PRINT" KEY 1: Start LINE Function/CIRCLE Radius Point Defined
9113 PRINT" KEY 2: End LINE Point Defined
9114 PRINT" KEY 3: Start CIRCLE Function - Center Point Defined
9115 PRINT" KEY 4: ABORT Function - RESET To Start New Function
9116 PRINT" KEY 5: Start PAINT Function
9117 PRINT" KEY 6: END SCREEN SESSION - Option To Store
9118 PRINT" KEY 7: COLOR 0 Selection (Background) - Complete Function
9119 PRINT" KEY 8: COLOR 1 Selection (Palette 1) - Complete Function
9120 PRINT" KEY 9: COLOR 2 Selection (Palette 2) - Complete Function
9121 PRINT" KEY 10: COLOR 3 Selection (Palette 3) - Complete Function
9122 PRINT" "
9123 PRINT"TYPICAL FUNCTIONS AND FUNCTION KEY ORDER OF EXECUTION
9124 PRINT" DRAW A LINE: K1, K2, K7 or K8 or K9 or K10
9125 PRINT" "
9126 PRINT" DRAW A CIRCLE: K3, K1, K7 or K8 or K9 or K10
9127 PRINT" "
9128 PRINT" PAINT WITHIN A BOUNDARY: K5, K7-K10 (COLOR), K7-K10 (BOUNDARY)
9129 PRINT" "
9130 PRINT" BACKGROUND/PALETTE SELECTION: K5, K5, VALUE (0-15), VALUE (0-1)
9131 PRINT" "
9132 PRINT" DOT CURSOR MOVEMENT WITH CURSOR KEYS ( "+CHR$(27)+" "+CHR$(24)+" "+CHR$(26)+" "+CHR$(25)+" )
9133 RETURN
9299 REM ----------------------------------------------------------------------
9300 REM *** SUBROUTINE TO STORE SCREEN DATA ON DISKETTE ***
9301 REM *** DATA VARIABLES FOR STORAGE: ***
9302 REM *** `BKC' = BACKGROUND COLOR ***
9303 REM *** `PAL' = PALETTE CHOSEN ***
9309 NA$="NONE"
9310 IF NA$="NONE" OR NA$="none" THEN GOTO 9900
9311 ON ERROR GOTO 0
9320 OPEN "R",#1,"SCREENS",128:IR%=0
9321 FIELD 1,12 AS A$,4 AS BKC$,4 AS PAL$,108 AS B$
9322 FOR I%=1 TO 9:GET #1,I%
9323 IF A$=LEFT$(NA$+SPACE$(12),12) THEN IR%=I%:GOTO 9330 ELSE IF A$=STRING$(12,CHR$(0)) AND IR%=0 THEN IR%=I%
9324 NEXT I%
9325 IF IR%=0 THEN PRINT "DISK IS FULL - REPLACE WITH ANOTHER DISK OR FILENAME":CLOSE 1:GOTO 9300
9326 LSET A$=LEFT$(NA$+SPACE$(12),12):LSET BKC$=MKS$(BKC):LSET PAL$=MKS$(PAL)
9327 PUT #1,IR%:CLOSE 1:GOTO 9340
9330 PRINT " ":INPUT;"FILE ALREADY EXISTS - OVERLAY (Y/N)";B$
9331 IF B$="Y" OR B$="y" THEN GOTO 9326 ELSE CLOSE 1:GOTO 9300
9340 GOSUB 9500:SCREEN 1:COLOR BKC,PAL:PUT (0,0),DTASAVE%
9350 DEF SEG=&HB800:BSAVE NA$,0,&H4000:DEF SEG
9355 GOSUB 9600
9360 PRINT " ":PRINT "FILE ("+NA$+") HAS BEEN STORED."
9370 RETURN
9499 REM ----------------------------------------------------------------------
9500 REM *** SWITCH TO COLOR/GRAPHICS ADAPTER ***
9501 DEF SEG=0
9502 POKE &H410,(PEEK(&H410) AND &HCF) OR &H20
9503 DEF SEG
9504 LOCATE ,,1,6,7
9505 SCREEN 0
9506 WIDTH 40
9507 KEY OFF
9508 RETURN
9599 REM ----------------------------------------------------------------------
9600 REM *** SWITCH TO MONOCHROME ADAPTER ***
9601 DEF SEG=0
9602 POKE &H410,(PEEK(&H410) OR &H30)
9603 DEF SEG
9604 LOCATE ,,1,12,13
9605 SCREEN 0
9606 WIDTH 80
9607 RETURN
9799 REM ----------------------------------------------------------------------
9800 REM *** SUBROUTINE TO RE-ESTABLISH ORIGINAL FUNCTIONAL KEY DEFINITIONS ***
9810 'KEY ON
9811 KEY 1,"LIST "
9812 KEY 2,"RUN"+CHR$(13)
9813 KEY 3,"LOAD"+CHR$(34)
9814 KEY 4,"SAVE"+CHR$(34)
9815 KEY 5,"CONT"+CHR$(13)
9816 KEY 6,","+CHR$(34)+"LPT1:"+CHR$(34)+CHR$(13)
9817 KEY 7,"TRON"+CHR$(13)
9818 KEY 8,"TROFF"+CHR$(13)
9819 KEY 9,"KEY "
9820 KEY 10,"SCREEN 0,0,0"+CHR$(13)
9821 RETURN
9899 REM ----------------------------------------------------------------------
9900 GOSUB 9800:CHAIN "A:HAPPYB"
9901 PRINT " USE FUNCTION `GRAPHICS' TO RETRIEVE AND EDIT AND SAVE SCREEN."
9903 KEY ON
9904 GOSUB 9800
9905 END