10 '***************************************************************************
20 '*                                                                         *
30 '*                            DRAW-IT.BAS                                  *
40 '*                                                                         *
50 '*                     BY ROBERT RELF (70176,403)                          *
60 '*                                                                         *
70 '*                             (C) 1983                                    *
80 '*                                                                         *
90 '***************************************************************************
100 '
110 'THIS IS A PROGRAM FOR DRAWING SCREEN GRAPHICS WITH SIMPLE KEYSTROKES.
120 'REQUIRES BASICA 2.00, COLOR GRAPHICS ADAPTER, ONE DISK DRIVE, COLOR OR
130 'NON-IBM MONOCHROME MONITOR, AND NEC OR PROWRITER DOT MATRIX PRINTER TO
140 'USE BUILT-IN GRAPHICS HARDCOPY SUBROUTINE. (DOS "GRAPHICS" COMMAND MAY
150 'BE USABLE FOR IBM OR EQUIVALENT PRINTER.)
160 '
170 '*************** IMPORTANT! ******************
180 'REMOVE THE APOSTROPHE FROM LINE 210 FOR COLOR MONITOR OR FROM LINE
190 '220 FOR NON-IBM MONOCHROME MONITOR.
200 '
210 COL1=1:COL2=1:COL3=2:COL7=7:COL10=10:COL14=14:COL15=15:P=0
220 'COL1=0:COL2=3:COL3=3:COL7=7:COL10=15:COL14=15:COL15=15:P=1
230 '
235 GOSUB 50000  'SWITCH TO COLOR MONITOR  ** ADDED BY TOM D. HALL **
240 GOSUB 1160      'CAPS LOCK / NUM LOCK ON
250 X%=160:Y%=90:Z%=3:C%=160:D%=90:C=0:DIM K%(14600):L%=1:M%=1:N%=318:P%=180
260 ON ERROR GOTO 2750
270 KEY 15,CHR$(&H40)+CHR$(71)   'DEFINE KEY TRAPS      HOME
280 KEY 16,CHR$(&H40)+CHR$(73)   'PgUp
290 KEY 17,CHR$(&H40)+CHR$(79)   'END
300 KEY 18,CHR$(&H40)+CHR$(81)   'PgDn
310 KEY 19,CHR$(&H40)+CHR$(58)   'CAPS LOCK
320 KEY 20,CHR$(&H40)+CHR$(69)   'NUM LOCK
340 KEY OFF:SCREEN 0,1:COLOR 15,0,0:WIDTH 40:CLS:LOCATE 5,19:PRINT "IBM"
350 LOCATE 7,12,0:PRINT "Personal Computer"
360 COLOR COL10,0:LOCATE 10,5,0:PRINT CHR$(213)+STRING$(31,205)+CHR$(184)
370 LOCATE 11,5,0:PRINT CHR$(179)+"            DRAW-IT            "+CHR$(179)
380 LOCATE 12,5,0:PRINT CHR$(179)+"                               "+CHR$(179)
390 LOCATE 13,5,0:PRINT CHR$(179)+STRING$(31,32)+CHR$(179)
400 LOCATE 14,5,0:PRINT CHR$(179)+"         Version 2.40          "+CHR$(179)
410 LOCATE 15,5,0:PRINT CHR$(212)+STRING$(31,205)+CHR$(190)
420 COLOR 15,0:LOCATE 17,6,0:PRINT "(C) Copyright  Rob Relf  1983"
430 COLOR COL14,0:LOCATE 23,7,0:PRINT "Press space bar to continue"
440 DEF SEG=0: POKE 1050,PEEK(1052):DEF SEG   'CLEAR KEYBOARD BUFFER
450 IF INKEY$=" " THEN ELSE 450
460 SCREEN 0:WIDTH 80:COLOR COL7,COL1,COL1:CLS      'SET SCREEN ATTRIBUTES
470 LOCATE 2,30:PRINT "WELCOME TO DRAW-IT
480 PRINT
490 GOSUB 2240         'PRINT HELP SCREEN
500 PRINT "WHICH DRIVE CONTAINS THIS PROGRAM ? (A,B,C,D,E,F or G)";
510 G$=INKEY$
520 IF G$="A"THEN F$="A:":GOTO 560
530 IF G$="B"THEN F$="B:":GOTO 560
540 IF G$="C"THEN F$="C:":GOTO 560
541 IF G$="D"THEN F$="D:":GOTO 560     ' ** ADDED BY TOM D. HALL **
542 IF G$="E"THEN F$="E:":GOTO 560     '
543 IF G$="F"THEN F$="F:":GOTO 560     '
544 IF G$="G"THEN F$="G:":GOTO 560     '
550 GOTO 510
560 SCREEN 1:COLOR 0,P:CLS:VIEW SCREEN (1,1)-(318,180),,3     'GRAPHICS SCREEN
570 LOCATE 24,1:PRINT "TO SET BACKGROUND COLOR PUSH SPACEBAR";
580 LOCATE 25,1:PRINT "THEN PUSH  TO CONTINUE";
590 Q$=INKEY$
600 IF Q$=" "THEN READ Q:IF Q>15 THEN Q=0:RESTORE
610 COLOR Q
620 IF Q$=CHR$(13)THEN 650
630 GOTO 590
640 DATA 1,3,7,8,9,11,13,15,16
650 GOSUB 1100:GOSUB 1090:GOSUB 1190:GOSUB 2920:GOSUB 1790  'PRINT STATUS LINES
655 GOSUB 1520                   'ENABLE KEY TRAPS
660 C$=INKEY$                                      'LOOP AND WAIT FOR KEYSTROKE
670 PSET(X%,Y%),Z%
680 IF C$="L"THEN GOSUB 1180    'LINE
690 IF C$="S"THEN GOSUB 1250    'SAVE SCREEN
700 IF C$="R"THEN GOSUB 1350    'RETRIEVE FILE
710 IF C$="*"THEN GOSUB 1410    'PRINT SCREEN
720 IF C$="X"THEN GOSUB 1510    'ACTIVATE KEYS
730 IF C$="p"THEN GOSUB 1740    'PALETTE
740 IF C$="D"THEN GOSUB 1780    'DRAW
750 IF C$="0"THEN Z%=0:GOSUB 1830       'SET COLOR 0
760 IF C$="1"THEN Z%=1:GOSUB 1830       'SET COLOR 1
770 IF C$="2"THEN Z%=2:GOSUB 1830       'SET COLOR 2
780 IF C$="3"THEN Z%=3:GOSUB 1830       'SET COLOR 3
790 IF C$="P"THEN GOSUB 1920    'PAINT
800 IF C$="A"THEN GOSUB 1960    'ARC
810 IF C$="C"THEN GOSUB 2000    'CIRCLE
820 IF C$="W"THEN GOSUB 2210    'WIPE SCREEN CLEAN
830 IF C$="H"THEN GOSUB 2630    'HELP
840 IF C$="F"THEN GOSUB 2900    'FAST
850 IF C$="I"THEN GOSUB 2970    'INSERT TEXT
860 IF C$="Q"THEN SCREEN 0:WIDTH 80:COLOR COL7,COL0,COL0:CLS:END
870 GOTO 660
880 '** TEST FOR DOT POSITION WITHIN SCREEN **
890 IF Y%>M% THEN Y%=Y%-L%:GOSUB 1050
900 RETURN 660
910 IF X%>M% THEN X%=X%-L%:GOSUB 1050
920 RETURN 660
930 IF X%M% AND Y%>M% THEN X%=X%-L%:Y%=Y%-L%:GOSUB 1050
980 RETURN 660
990 IF X%M% THEN X%=X%+L%:Y%=Y%-L%:GOSUB 1050
1000 RETURN 660
1010 IF X%>M% AND Y%INE  RC  IR  ELP";
1120 GOSUB 1830
1130 LOCATE 25,1:PRINT "X=     Y=      RAW  AST  

AINT "; 1140 RETURN 1150 '** CAPS LOCK / NUM LOCK ON ** 1160 DEF SEG=0:POKE &H417,192:DEF SEG:RETURN 1170 '** TOGGLE "LINE" FUNCTION ** 1180 A=A+1 1190 IF A=1 THEN A%=X%:B%=Y%:LOCATE 24,12:POKE &H4E,2:PRINT "INE "; 1200 IF A=1 THEN POKE &H4E,COL2:RETURN 1210 IF A=2 THEN LINE(A%,B%)-(X%,Y%),Z%:A=0:LOCATE 24,12:PRINT "INE "; 1220 RETURN 1230 LOCATE 24,12:PRINT "INE ";:RETURN 1240 '** SAVE SCREEN TO DISK ** 1250 GET(1,1)-(318,180),K%:CLS 1260 LOCATE 5,2:PRINT " WHAT WILL YOU NAME YOUR DRAWING? "; 1270 LOCATE 6,2:PRINT "TYPE IN A NAME UP TO 8 LETTERS LONG" 1280 LOCATE 7,2:INPUT "AND PRESS ",A$ 1290 IF A$=""OR LEN(A$)>8 THEN LOCATE 7,2:PRINT STRING$(38," ");:BEEP:GOTO 1280 1300 GOSUB 2700 1310 B$=F$+A$+".PIC" 1320 DEF SEG=&HB800:BSAVE B$,0,&H4000:DEF SEG 1330 RETURN 1340 '** RETRIEVE SCREEN FROM DISK ** 1350 LOCATE 24,1:PRINT STRING$(39," ");:POKE &H4E,COL3 1360 CLS:LOCATE 5,1:FILES F$+"*.PIC" 1370 LOCATE 24,1:INPUT;"ENTER FILENAME TO RECALL";D$:E$=F$+D$+".PIC" 1380 DEF SEG=&HB800:BLOAD E$,0 :DEF SEG 1390 POKE &H4E,COL2:RETURN 650 1400 '** DUMP SCREEN TO NEC OR C.ITOH DOT MATRIX PRINTER ** 1410 OPEN "lpt1:" AS #1:WIDTH #1,255:DEF SEG=&HB800 1420 LPRINT CHR$(29)CHR$(30)CHR$(27)"A"STRING$(4,10)CHR$(15)CHR$(27)"E"CHR$(27)"T16"CHR$(27)">"; 1430 FOR Y%=79 TO 0 STEP -1 1440 LPRINT CHR$(27);"S";"0552"; 1450 FOR X%=Y% TO 7280+Y% STEP 80:PRINT#1,STRING$(3,PEEK(X%))STRING$(3,PEEK(X%+&H2000));:NEXT 1470 LPRINT :NEXT :CLOSE #1 :LPRINT 1480 LPRINT CHR$(27)"A" STRING$(8,10)CHR$(29)CHR$(30)CHR$(27)"<"; 1490 DEF SEG:RETURN 1500 '** ENABLE KEY TRAPPING ** 1510 DEF SEG=0:POKE 1050,PEEK(1052):DEF SEG 'CLEAR BUFFERS 1520 ON KEY(11)GOSUB 890 1530 KEY(11)ON 1540 ON KEY(12)GOSUB 910 1550 KEY(12)ON 1560 ON KEY(13)GOSUB 930 1570 KEY(13)ON 1580 ON KEY(14)GOSUB 950 1590 KEY(14)ON 1600 ON KEY(15)GOSUB 970 1610 KEY(15)ON 1620 ON KEY(16)GOSUB 990 1630 KEY(16)ON 1640 ON KEY(17)GOSUB 1010 1650 KEY(17)ON 1660 ON KEY(18)GOSUB 1030 1670 KEY(18)ON 1680 ON KEY(19)GOSUB 1160 1690 KEY(19)ON 1700 ON KEY(20)GOSUB 1160 1710 KEY(20)ON 1720 RETURN 1730 '** TOGGLE COLOR PALETTE ** 1740 IF P=0 THEN P=1 ELSE P=0 1750 COLOR ,P 1760 RETURN 1770 '** TOGGLE "DRAW" FUNCTION ** 1780 IF B=0 THEN B=1 ELSE B=0 1790 IF B=1 THEN LOCATE 25,16:POKE &H4E,2:PRINT "RAW";:POKE &H4E,COL2 1800 IF B<>1 THEN LOCATE 25,16:PRINT "RAW"; 1810 RETURN 1820 '** PRINT COLOR ON STATUS LINE ** 1830 Z$=STR$(Z%):LOCATE 24,1:PRINT "COLOR 0123"; 1840 POKE &H4E,2 1850 IF Z%=0 THEN LOCATE 24,7:PRINT RIGHT$(Z$,1); 1860 IF Z%=1 THEN LOCATE 24,8:PRINT RIGHT$(Z$,1); 1870 IF Z%=2 THEN LOCATE 24,9:PRINT RIGHT$(Z$,1); 1880 IF Z%=3 THEN LOCATE 24,10:PRINT RIGHT$(Z$,1); 1890 POKE &H4E,COL2 1900 RETURN 1910 '** FILL IN SHAPE WITH CURRENT COLOR ** 1920 IF Z%=0 THEN W%=1 ELSE W%=0 1930 PSET(X%,Y%),W%:PAINT(X%,Y%),Z%,Z%:C=Z% 1940 RETURN 1950 '** DRAW SPECIFIED ARC OR CIRCLE ** 1960 POKE &H4E,COL3:LOCATE 24,1:PRINT STRING$(39," "); 1970 LOCATE 24,1:INPUT;"ENTER STARTING POINT DEGREES ",S$:I$=S$:GOSUB 2820 1980 LOCATE 24,1:PRINT STRING$(39," "); 1990 LOCATE 24,1:INPUT;"ENTER ENDING POINT DEGREES ",T$:I$=T$:GOSUB 2820 2000 LOCATE 24,1:PRINT STRING$(39," "); 2010 POKE &H4E,COL3:LOCATE 24,1 2020 INPUT;"ENTER THE DESIRED RADIUS ",R$:I$=R$:GOSUB 2820 2030 S=VAL(S$):T=VAL(T$):R=VAL(R$) 2040 IF S=0 AND T=0 THEN 2160 2050 B#=2*3.141593 2060 A#=B#/360 2070 S#=(S+90)*A#:T#=(T+90)*A# 2080 IF S#>B# THEN S#=S#-B# 2090 IF T#>B# THEN T#=T#-B# 2100 LOCATE 24,1:PRINT STRING$(39," "); 2110 LOCATE 24,1:PRINT "CONNECT ENDS OF ARC TO CENTER? (Y or N)";:POKE &H4E,COL2 2120 I$=INKEY$ 2130 IF I$="Y"THEN S#=-S#:T#=-T#:GOTO 2170 2140 IF I$="N"THEN 2170 2150 GOTO 2120 2160 CIRCLE(X%,Y%),R,Z%:GOTO 2180 2170 CIRCLE(X%,Y%),R,Z%,S#,T#:S$="":T$="" 2180 GOSUB 1100:GOSUB 1090:GOSUB 1190:GOSUB 2920:GOSUB 1790 'RESET STATUS LINE 2190 RETURN 2200 '** CLEAR SCREEN ** 2210 SCREEN 0,0,0:CLS:X%=160:Y%=90:Z%=3:C%=160:D%=90:C=0:RETURN 560 2220 '** "HELP" SCREEN ** 2230 SCREEN 0:WIDTH 80:COLOR COL7,COL1,COL1:CLS 2240 PRINT " THIS IS A PROGRAM FOR DRAWING GRAPHICS ON THE SCREEN. "; 2250 PRINT "SELECT THE COLOR THAT 2260 PRINT "YOU WILL DRAW IN BY TYPING 0,1,2 OR 3. "; 2270 PRINT "YOU MAY ALTERNATE BETWEEN ONE OF TWO 2280 PRINT "COLOR PALETTES BY PRESSING SHIFT / P. "; 2290 PRINT "YOU CAN MOVE FREELY ABOUT THE SCREEN BY 2300 PRINT "PRESSING ANY OF THE KEYS ON THE NUMERIC KEYPAD EXCEPT 0 OR 5. "; 2310 PRINT "(IF ANY OF THE 2320 PRINT "KEYS CEASE TO FUNCTION, PRESS X TO RESET THE KEYS). "; 2330 PRINT "TO DRAW A LINE AS YOU MOVE, 2340 PRINT "TYPE D. TO STOP DRAWING, TYPE D AGAIN. "; 2350 PRINT "TO DRAW A LINE THAT CANNOT BE DRAWN WITH 2360 PRINT "THE NUMERIC KEYS, "; 2370 PRINT "MOVE TO YOUR STARTING POINT AND TYPE L, THEN MOVE TO YOUR 2380 PRINT "ENDING POINT AND TYPE L ONCE AGAIN. "; 2390 PRINT "TYPE F FOR THE FAST MODE TO MOVE OR DRAW 2400 PRINT "IN UNITS OF TEN INSTEAD OF ONE. "; 2410 PRINT "( NOTE THAT YOU MUST BE IN THE NORMAL SPEED MODE"; 2420 PRINT "TO MOVE OR DRAW TO THE BORDER LINE ). "; 2430 PRINT "TO DRAW A CIRCLE OR AN ARC, MOVE TO THE 2440 PRINT "DESIRED CENTER POINT,"; 2450 PRINT "TYPE C OR A, AND ANSWER THE PROMPTS WHICH APPEAR.PARAMETERS"; 2460 PRINT "FOR AN ARC ARE 0 TO 360 "; 2470 PRINT "DEGREES WITH 0 AT THE TOP AND GOING COUNTER-CLOCKWISE 2480 PRINT "ON THE SCREEN. "; 2490 PRINT "RESPOND TO PROMPTS WHICH APPEAR ON THE STATUS LINE AND PRESS 2500 PRINT ".YOU MAY PAINT ANY "; 2510 PRINT "AREA WITH COLOR BY TYPING P, PROVIDED THAT THE ENTIRE"; 2520 PRINT "AREA IS BORDERED BY THAT "; 2530 PRINT "SAME COLOR. YOU MAY RECALL ANY PREVIOUSLY DRAWN SCREEN"; 2540 PRINT "BY TYPING R AND ANSWERING "; 2550 PRINT "THE PROMPT. TYPE Q TO QUIT. TYPE PrtSc TO PRINT A COPY"; 2560 PRINT "OF YOUR DRAWING ON THE PRINTER. "; 2570 PRINT "TYPE S TO SAVE YOUR DRAWING TO A DISK FILE. 2580 PRINT "TYPE I TO INSERT TEXT "; 2590 PRINT "INTO THE GRAPHICS SCREEN AT THE CURRENT X/Y COORDINATE."; 2600 PRINT "TYPE W TO WIPE THE SCREEN "; 2610 PRINT "IMAGE AND BEGIN AGAIN. TYPE H FOR HELP (THIS SCREEN). 2620 RETURN 2630 '** SAVE SCREEN IN ARRAY ** 2640 GET(1,1)-(318,180),K% 2650 GOSUB 2230 2660 PRINT 2670 PRINT " PRESS ANY KEY TO RETURN TO DRAWING 2680 N$=INKEY$ 2690 IF N$=""THEN 2680 2700 '** REPLACE SCREEN AS BEFORE ** 2710 SCREEN 1:COLOR Q,P:CLS:VIEW SCREEN (1,1)-(318,180),,3 2720 PUT(1,1),K% 2730 GOSUB 1100:GOSUB 1090:GOSUB 1190:GOSUB 2920:GOSUB 1790 'PRINT STATUS LINES 2740 RETURN 2750 '** ERROR HANDLING ** 2760 BEEP :DEF SEG 2770 LOCATE 24,1:PRINT STRING$(39," "); 2780 POKE &H4E,COL3:LOCATE 24,1:PRINT"ERROR HAS OCCURRED - TRY AGAIN "; 2790 POKE &H4E,COL2 2800 FOR X=1 TO 2000:NEXT 2810 RESUME 650 2820 '** TEST FOR PROPER INPUT ** 2830 IF I$=""THEN ERROR 200 2840 FOR X=1 TO LEN(I$) 2850 X$=MID$(I$,X) 2860 IF ASC(X$)>44 AND ASC(X$)<58 THEN 2870 ELSE K=1 2870 NEXT 2880 IF K=1 THEN K=0:ERROR 200 2890 RETURN 2900 '** TOGGLE "FAST" FUNCTION ** 2910 F=F+1 2920 IF F=1 THEN L%=10:M%=11:N%=308:P%=170:LOCATE 25,24 2930 IF F=1 THEN POKE &H4E,2:PRINT "AST ";:POKE &H4E,COL2:RETURN 2940 IF F=2 THEN L%=1:M%=1:N%=318:P%=180:F=0 2950 LOCATE 25,24:PRINT "AST ";:RETURN 2960 '**** INSERT TEXT INTO GRAPHICS SCREEN **** 2970 POKE &H4E,Z% 2980 ROW=Y%/8 2990 COL=X%/8+1 3000 LOCATE ROW,COL 3010 INPUT;"",I$ 3020 POKE &H4E,COL2 3030 RETURN 49990 REM ---- Switch to Color Monitor ** ADDED BY TOM D. HALL ** 50000 KEY OFF 'turn off 25th line 50010 CLS 'clear screen 50020 LOCATE ,,0 'turn off cursor 50030 DEF SEG =0 'address bios 50040 POKE &H410,(PEEK(&H410) AND &HCF) OR &H10 'change equipment parameter 50050 DEF SEG 'address default memory 50060 SCREEN 1 'set medium resolution graphics 50070 SCREEN 0 'set text mode 50080 WIDTH 80 'set width to 80 characters 50090 WIDTH 40 'set width to 40 characters 50100 LOCATE ,,1,6,7 'turn on cursor 50110 SCREEN 1,0 'set medium resolution graphics and enable color 50120 COLOR 0,0 'set background to black and select palette 0 50130 RETURN