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