home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #3.1 / RBBSIABOX31.cdr / dull / draw_it.bas < prev    next >
BASIC Source File  |  1990-09-29  |  13KB  |  304 lines
  1. 10 '***************************************************************************
  2. 20 '*                                                                         *
  3. 30 '*                            DRAW-IT.BAS                                  *
  4. 40 '*                                                                         *
  5. 50 '*                     BY ROBERT RELF (70176,403)                          *
  6. 60 '*                                                                         *
  7. 70 '*                             (C) 1983                                    *
  8. 80 '*                                                                         *
  9. 90 '***************************************************************************
  10. 100 '
  11. 110 'THIS IS A PROGRAM FOR DRAWING SCREEN GRAPHICS WITH SIMPLE KEYSTROKES.
  12. 120 'REQUIRES BASICA 2.00, COLOR GRAPHICS ADAPTER, ONE DISK DRIVE, COLOR OR
  13. 130 'NON-IBM MONOCHROME MONITOR, AND NEC OR PROWRITER DOT MATRIX PRINTER TO
  14. 140 'USE BUILT-IN GRAPHICS HARDCOPY SUBROUTINE. (DOS "GRAPHICS" COMMAND MAY
  15. 150 'BE USABLE FOR IBM OR EQUIVALENT PRINTER.)
  16. 160 '
  17. 170 '*************** IMPORTANT! ******************
  18. 180 'REMOVE THE APOSTROPHE FROM LINE 210 FOR COLOR MONITOR OR FROM LINE
  19. 190 '220 FOR NON-IBM MONOCHROME MONITOR.
  20. 200 '
  21. 210 COL1=1:COL2=1:COL3=2:COL7=7:COL10=10:COL14=14:COL15=15:P=0
  22. 220 'COL1=0:COL2=3:COL3=3:COL7=7:COL10=15:COL14=15:COL15=15:P=1
  23. 230 '
  24. 240 GOSUB 1160      'CAPS LOCK / NUM LOCK ON
  25. 250 X%=160:Y%=90:Z%=3:C%=160:D%=90:C=0:DIM K%(14600):L%=1:M%=1:N%=318:P%=180
  26. 260 ON ERROR GOTO 2750
  27. 270 KEY 15,CHR$(&H40)+CHR$(71)   'DEFINE KEY TRAPS
  28. 280 KEY 16,CHR$(&H40)+CHR$(73)
  29. 290 KEY 17,CHR$(&H40)+CHR$(79)
  30. 300 KEY 18,CHR$(&H40)+CHR$(81)
  31. 310 KEY 19,CHR$(&H40)+CHR$(58)
  32. 320 KEY 20,CHR$(&H40)+CHR$(69)
  33. 330 GOSUB 1520                   'ENABLE KEY TRAPS
  34. 340 KEY OFF:SCREEN 0,1:COLOR 15,0,0:WIDTH 40:CLS:LOCATE 5,19:PRINT "IBM"
  35. 350 LOCATE 7,12,0:PRINT "Personal Computer"
  36. 360 COLOR COL10,0:LOCATE 10,5,0:PRINT CHR$(213)+STRING$(31,205)+CHR$(184)
  37. 370 LOCATE 11,5,0:PRINT CHR$(179)+"            DRAW-IT            "+CHR$(179)
  38. 380 LOCATE 12,5,0:PRINT CHR$(179)+"                               "+CHR$(179)
  39. 390 LOCATE 13,5,0:PRINT CHR$(179)+STRING$(31,32)+CHR$(179)
  40. 400 LOCATE 14,5,0:PRINT CHR$(179)+"         Version 2.40          "+CHR$(179)
  41. 410 LOCATE 15,5,0:PRINT CHR$(212)+STRING$(31,205)+CHR$(190)
  42. 420 COLOR 15,0:LOCATE 17,6,0:PRINT "(C) Copyright  Rob Relf  1983"
  43. 430 COLOR COL14,0:LOCATE 23,7,0:PRINT "Press space bar to continue"
  44. 440 DEF SEG : POKE 106,0          'CLEAR KEYBOARD BUFFER
  45. 450 IK$=INKEY$ : IF IK$ = "" THEN GOTO 450
  46. 460 SCREEN 0:WIDTH 80:COLOR COL7,COL1,COL1:CLS      'SET SCREEN ATTRIBUTES
  47. 470 LOCATE 2,30:PRINT "WELCOME TO DRAW-IT
  48. 480 PRINT
  49. 490 GOSUB 2240         'PRINT HELP SCREEN
  50. 500 PRINT "WHICH DRIVE CONTAINS THIS PROGRAM ? (A,B or C)";
  51. 510 G$=INKEY$
  52. 520 IF G$="A"THEN F$="A:":GOTO 560
  53. 530 IF G$="B"THEN F$="B:":GOTO 560
  54. 540 IF G$="C"THEN F$="C:":GOTO 560
  55. 550 GOTO 510
  56. 560 SCREEN 1:COLOR 0,P:CLS:VIEW SCREEN (1,1)-(318,180),,3     'GRAPHICS SCREEN
  57. 570 LOCATE 24,1:PRINT "TO SET BACKGROUND COLOR PUSH SPACEBAR";
  58. 580 LOCATE 25,1:PRINT "THEN PUSH <ENTER> TO CONTINUE";
  59. 590 Q$=INKEY$
  60. 600 IF Q$=" "THEN READ Q:IF Q>15 THEN Q=0:RESTORE
  61. 610 COLOR Q
  62. 620 IF Q$=CHR$(13)THEN 650
  63. 630 GOTO 590
  64. 640 DATA 1,3,7,8,9,11,13,15,16
  65. 650 GOSUB 1100:GOSUB 1090:GOSUB 1190:GOSUB 2920:GOSUB 1790  'PRINT STATUS LINES
  66. 660 C$=INKEY$                                      'LOOP AND WAIT FOR KEYSTROKE
  67. 670 PSET(X%,Y%),Z%
  68. 680 IF C$="L"THEN GOSUB 1180
  69. 690 IF C$="S"THEN GOSUB 1250
  70. 700 IF C$="R"THEN GOSUB 1350
  71. 710 IF C$="*"THEN GOSUB 1410
  72. 720 IF C$="X"THEN GOSUB 1510
  73. 730 IF C$="p"THEN GOSUB 1740
  74. 740 IF C$="D"THEN GOSUB 1780
  75. 750 IF C$="0"THEN Z%=0:GOSUB 1830
  76. 760 IF C$="1"THEN Z%=1:GOSUB 1830
  77. 770 IF C$="2"THEN Z%=2:GOSUB 1830
  78. 780 IF C$="3"THEN Z%=3:GOSUB 1830
  79. 790 IF C$="P"THEN GOSUB 1920
  80. 800 IF C$="A"THEN GOSUB 1960
  81. 810 IF C$="C"THEN GOSUB 2000
  82. 820 IF C$="W"THEN GOSUB 2210
  83. 830 IF C$="H"THEN GOSUB 2630
  84. 840 IF C$="F"THEN GOSUB 2900
  85. 850 IF C$="I"THEN GOSUB 2960
  86. 860 IF C$="Q"THEN SCREEN 0:WIDTH 80:COLOR COL7,COL1,COL1:KEY ON:CLS:END
  87. 870 GOTO 660
  88. 880 '** TEST FOR DOT POSITION WITHIN SCREEN **
  89. 890 IF Y%>M% THEN Y%=Y%-L%:GOSUB 1050
  90. 900 RETURN 660
  91. 910 IF X%>M% THEN X%=X%-L%:GOSUB 1050
  92. 920 RETURN 660
  93. 930 IF X%<N% THEN X%=X%+L%:GOSUB 1050
  94. 940 RETURN 660
  95. 950 IF Y%<P% THEN Y%=Y%+L%:GOSUB 1050
  96. 960 RETURN 660
  97. 970 IF X%>M% AND Y%>M% THEN X%=X%-L%:Y%=Y%-L%:GOSUB 1050
  98. 980 RETURN 660
  99. 990 IF X%<N% AND Y%>M% THEN X%=X%+L%:Y%=Y%-L%:GOSUB 1050
  100. 1000 RETURN 660
  101. 1010 IF X%>M% AND Y%<P% THEN X%=X%-L%:Y%=Y%+L%:GOSUB 1050
  102. 1020 RETURN 660
  103. 1030 IF X%<N% AND Y%<P% THEN X%=X%+L%:Y%=Y%+L%:GOSUB 1050
  104. 1040 RETURN 660
  105. 1050 IF B=1 THEN 1060 ELSE 1070
  106. 1060 PSET(C%,D%),Z%:LINE-(X%,Y%),Z%:GOTO 1080
  107. 1070 PSET(C%,D%),C:B=0
  108. 1080 C=POINT(X%,Y%):C%=X%:D%=Y%
  109. 1090 LOCATE 25,3:PRINT X%;:LOCATE 25,10:PRINT Y%;:RETURN
  110. 1100 DEF SEG:POKE &H4E,COL2     'PRINT GREEN TEXT IN COLOR MODE
  111. 1110 LOCATE 24,1:PRINT "           <L>INE  <A>RC  <C>IR  <H>ELP";
  112. 1120 GOSUB 1830
  113. 1130 LOCATE 25,1:PRINT "X=     Y=      <D>RAW  <F>AST  <P>AINT ";
  114. 1140 RETURN
  115. 1150 '** CAPS LOCK / NUM LOCK ON **
  116. 1160 DEF SEG=0:POKE &H417,192:RETURN
  117. 1170 '** TOGGLE "LINE" FUNCTION **
  118. 1180 A=A+1
  119. 1190 IF A=1 THEN A%=X%:B%=Y%:LOCATE 24,12:DEF SEG:POKE &H4E,2:PRINT "<L>INE  ";
  120. 1200 IF A=1 THEN POKE &H4E,COL2:RETURN
  121. 1210 IF A=2 THEN LINE(A%,B%)-(X%,Y%),Z%:A=0:LOCATE 24,12:PRINT "<L>INE  ";
  122. 1220 RETURN
  123. 1230 LOCATE 24,12:PRINT "<L>INE  ";:RETURN
  124. 1240 '** SAVE SCREEN TO DISK **
  125. 1250 GET(1,1)-(318,180),K%:CLS
  126. 1260 LOCATE 5,2:PRINT "  WHAT WILL YOU NAME YOUR DRAWING? ";
  127. 1270 LOCATE 6,2:PRINT "TYPE IN A NAME UP TO 8 LETTERS LONG"
  128. 1280 LOCATE 7,2:INPUT "AND PRESS <ENTER>",A$
  129. 1290 IF A$=""OR  LEN(A$)>8 THEN LOCATE 7,2:PRINT STRING$(38," ");:BEEP:GOTO 1280
  130. 1300 GOSUB 2700
  131. 1310 B$=F$+A$+".PIC"
  132. 1320 DEF SEG=&HB800:BSAVE B$,0,&H4000
  133. 1330 RETURN
  134. 1340 '** RETRIEVE SCREEN FROM DISK **
  135. 1350 LOCATE 24,1:PRINT STRING$(39," ");:DEF SEG:POKE &H4E,COL3
  136. 1360 CLS:LOCATE 5,1:FILES F$+"*.PIC"
  137. 1370 LOCATE 24,1:INPUT;"ENTER FILENAME TO RECALL";D$:E$=F$+D$+".PIC"
  138. 1380 DEF SEG=&HB800:BLOAD E$,0
  139. 1390 POKE &H4E,COL2:RETURN 650
  140. 1400 '** DUMP SCREEN TO NEC OR C.ITOH DOT MATRIX PRINTER **
  141. 1410 WIDTH "LPT1:",255:DEF SEG=&HB800
  142. 1420 LPRINT CHR$(14)CHR$(27)CHR$(84)"16";
  143. 1430 FOR Y%=79 TO 0 STEP -1
  144. 1440 LPRINT CHR$(27)+CHR$(83);"0200";
  145. 1450 FOR X%=Y% TO 7920+Y% STEP 80:LPRINT CHR$(PEEK(X%))CHR$(PEEK(X%+&H2000));
  146. 1460 NEXT
  147. 1470 LPRINT CHR$(13);:NEXT
  148. 1480 WIDTH "LPT1:",80:LPRINT CHR$(15)CHR$(13)CHR$(27)CHR$(65)CHR$(12)
  149. 1490 RETURN
  150. 1500 '** ENABLE KEY TRAPPING **
  151. 1510 DEF SEG=0:POKE 1050,PEEK(1052):DEF SEG:POKE 106,0    'CLEAR BUFFERS
  152. 1520 ON KEY(11)GOSUB 890
  153. 1530 KEY(11)ON
  154. 1540 ON KEY(12)GOSUB 910
  155. 1550 KEY(12)ON
  156. 1560 ON KEY(13)GOSUB 930
  157. 1570 KEY(13)ON
  158. 1580 ON KEY(14)GOSUB 950
  159. 1590 KEY(14)ON
  160. 1600 ON KEY(15)GOSUB 970
  161. 1610 KEY(15)ON
  162. 1620 ON KEY(16)GOSUB 990
  163. 1630 KEY(16)ON
  164. 1640 ON KEY(17)GOSUB 1010
  165. 1650 KEY(17)ON
  166. 1660 ON KEY(18)GOSUB 1030
  167. 1670 KEY(18)ON
  168. 1680 ON KEY(19)GOSUB 1160
  169. 1690 KEY(19)ON
  170. 1700 ON KEY(20)GOSUB 1160
  171. 1710 KEY(20)ON
  172. 1720 RETURN
  173. 1730 '** TOGGLE COLOR PALETTE **
  174. 1740 IF P=0 THEN P=1 ELSE P=0
  175. 1750 COLOR ,P
  176. 1760 RETURN
  177. 1770 '** TOGGLE "DRAW" FUNCTION **
  178. 1780 IF B=0 THEN B=1 ELSE B=0
  179. 1790 IF B=1 THEN LOCATE 25,16:DEF SEG:POKE &H4E,2:PRINT "<D>RAW";:POKE &H4E,COL2
  180. 1800 IF B<>1 THEN LOCATE 25,16:PRINT "<D>RAW";
  181. 1810 RETURN
  182. 1820 '** PRINT COLOR ON STATUS LINE **
  183. 1830 Z$=STR$(Z%):LOCATE 24,1:PRINT "COLOR 0123";
  184. 1840 DEF SEG:POKE &H4E,2
  185. 1850 IF Z%=0 THEN LOCATE 24,7:PRINT RIGHT$(Z$,1);
  186. 1860 IF Z%=1 THEN LOCATE 24,8:PRINT RIGHT$(Z$,1);
  187. 1870 IF Z%=2 THEN LOCATE 24,9:PRINT RIGHT$(Z$,1);
  188. 1880 IF Z%=3 THEN LOCATE 24,10:PRINT RIGHT$(Z$,1);
  189. 1890 POKE &H4E,COL2
  190. 1900 RETURN
  191. 1910 '** FILL IN SHAPE WITH CURRENT COLOR **
  192. 1920 IF Z%=0 THEN W%=1 ELSE W%=0
  193. 1930 PSET(X%,Y%),W%:PAINT(X%,Y%),Z%,Z%:C=Z%
  194. 1940 RETURN
  195. 1950 '** DRAW SPECIFIED ARC OR CIRCLE **
  196. 1960 POKE &H4E,COL3:LOCATE 24,1:PRINT STRING$(39," ");
  197. 1970 LOCATE 24,1:INPUT;"ENTER STARTING POINT DEGREES    ",S$:I$=S$:GOSUB 2820
  198. 1980 LOCATE 24,1:PRINT STRING$(39," ");
  199. 1990 LOCATE 24,1:INPUT;"ENTER ENDING POINT DEGREES      ",T$:I$=T$:GOSUB 2820
  200. 2000 LOCATE 24,1:PRINT STRING$(39," ");
  201. 2010 DEF SEG:POKE &H4E,COL3:LOCATE 24,1
  202. 2020 INPUT;"ENTER THE DESIRED RADIUS     ",R$:I$=R$:GOSUB 2820
  203. 2030 S=VAL(S$):T=VAL(T$):R=VAL(R$)
  204. 2040 IF S=0 AND T=0 THEN 2160
  205. 2050 B#=2*3.141593
  206. 2060 A#=B#/360
  207. 2070 S#=(S+90)*A#:T#=(T+90)*A#
  208. 2080 IF S#>B# THEN S#=S#-B#
  209. 2090 IF T#>B# THEN T#=T#-B#
  210. 2100 LOCATE 24,1:PRINT STRING$(39," ");
  211. 2110 LOCATE 24,1:PRINT "CONNECT ENDS OF ARC TO CENTER? (Y or N)";:POKE &H4E,COL2
  212. 2120 I$=INKEY$
  213. 2130 IF I$="Y"THEN S#=-S#:T#=-T#:GOTO 2170
  214. 2140 IF I$="N"THEN 2170
  215. 2150 GOTO 2120
  216. 2160 CIRCLE(X%,Y%),R,Z%:GOTO 2180
  217. 2170 CIRCLE(X%,Y%),R,Z%,S#,T#:S$="":T$=""
  218. 2180 GOSUB 1100:GOSUB 1090:GOSUB 1190:GOSUB 2920:GOSUB 1790  'RESET STATUS LINE
  219. 2190 RETURN
  220. 2200 '** CLEAR SCREEN **
  221. 2210 SCREEN 0,0,0:CLS:X%=160:Y%=90:Z%=3:C%=160:D%=90:C=0:RETURN 560
  222. 2220 '** "HELP" SCREEN **
  223. 2230 SCREEN 0:WIDTH 80:COLOR COL7,COL1,COL1:CLS
  224. 2240 PRINT "  THIS IS A PROGRAM FOR DRAWING GRAPHICS ON THE SCREEN. ";
  225. 2250 PRINT "SELECT THE COLOR THAT
  226. 2260 PRINT "YOU WILL DRAW IN BY TYPING 0,1,2 OR 3. ";
  227. 2270 PRINT "YOU MAY ALTERNATE BETWEEN ONE OF TWO
  228. 2280 PRINT "COLOR PALETTES BY PRESSING SHIFT / P. ";
  229. 2290 PRINT "YOU CAN MOVE FREELY ABOUT THE SCREEN BY
  230. 2300 PRINT "PRESSING ANY OF THE KEYS ON THE NUMERIC KEYPAD EXCEPT 0 OR 5. ";
  231. 2310 PRINT "(IF ANY OF THE
  232. 2320 PRINT "KEYS CEASE TO FUNCTION, PRESS X TO RESET THE KEYS). ";
  233. 2330 PRINT "TO DRAW A LINE AS YOU MOVE,
  234. 2340 PRINT "TYPE D. TO STOP DRAWING, TYPE D AGAIN. ";
  235. 2350 PRINT "TO DRAW A LINE THAT CANNOT BE DRAWN WITH
  236. 2360 PRINT "THE NUMERIC KEYS, ";
  237. 2370 PRINT "MOVE TO YOUR STARTING POINT AND TYPE L, THEN MOVE TO YOUR
  238. 2380 PRINT "ENDING POINT AND TYPE L ONCE AGAIN. ";
  239. 2390 PRINT "TYPE F FOR THE FAST MODE TO MOVE OR DRAW
  240. 2400 PRINT "IN UNITS OF TEN INSTEAD OF ONE. ";
  241. 2410 PRINT "( NOTE THAT YOU MUST BE IN THE NORMAL SPEED MODE";
  242. 2420 PRINT "TO MOVE OR DRAW TO THE BORDER LINE ). ";
  243. 2430 PRINT "TO DRAW A CIRCLE OR AN ARC, MOVE TO THE
  244. 2440 PRINT "DESIRED CENTER POINT,";
  245. 2450 PRINT "TYPE C OR A, AND ANSWER THE PROMPTS WHICH APPEAR.PARAMETERS";
  246. 2460 PRINT "FOR AN ARC ARE 0 TO 360 ";
  247. 2470 PRINT "DEGREES WITH 0 AT THE TOP AND GOING COUNTER-CLOCKWISE
  248. 2480 PRINT "ON THE SCREEN. ";
  249. 2490 PRINT "RESPOND TO PROMPTS WHICH APPEAR ON THE STATUS LINE AND PRESS
  250. 2500 PRINT "<ENTER>.YOU MAY PAINT ANY ";
  251. 2510 PRINT "AREA WITH COLOR BY TYPING P, PROVIDED THAT THE ENTIRE";
  252. 2520 PRINT "AREA IS BORDERED BY THAT ";
  253. 2530 PRINT "SAME COLOR. YOU MAY RECALL ANY PREVIOUSLY DRAWN SCREEN";
  254. 2540 PRINT "BY TYPING R AND ANSWERING ";
  255. 2550 PRINT "THE PROMPT. TYPE Q TO QUIT. TYPE PrtSc TO PRINT A COPY";
  256. 2560 PRINT "OF YOUR DRAWING ON THE PRINTER. ";
  257. 2570 PRINT "TYPE S TO SAVE YOUR DRAWING TO A DISK FILE.
  258. 2580 PRINT "TYPE I TO INSERT TEXT ";
  259. 2590 PRINT "INTO THE GRAPHICS SCREEN AT THE CURRENT X/Y COORDINATE.";
  260. 2600 PRINT "TYPE W TO WIPE THE SCREEN ";
  261. 2610 PRINT "IMAGE AND BEGIN AGAIN. TYPE H FOR HELP (THIS SCREEN).
  262. 2620 RETURN
  263. 2630 '** SAVE SCREEN IN ARRAY **
  264. 2640 GET(1,1)-(318,180),K%
  265. 2650 GOSUB 2230
  266. 2660 PRINT
  267. 2670 PRINT "                PRESS ANY KEY TO RETURN TO DRAWING
  268. 2680 N$=INKEY$
  269. 2690 IF N$=""THEN 2680
  270. 2700 '** REPLACE SCREEN AS BEFORE **
  271. 2710 SCREEN 1:COLOR Q,P:CLS:VIEW SCREEN (1,1)-(318,180),,3
  272. 2720 PUT(1,1),K%
  273. 2730 GOSUB 1100:GOSUB 1090:GOSUB 1190:GOSUB 2920:GOSUB 1790 'PRINT STATUS LINES
  274. 2740 RETURN
  275. 2750 '** ERROR HANDLING **
  276. 2760 BEEP
  277. 2770 LOCATE 24,1:PRINT STRING$(39," ");
  278. 2780 DEF SEG:POKE &H4E,COL3:LOCATE 24,1:PRINT"ERROR HAS OCCURRED - TRY AGAIN  ";
  279. 2790 POKE &H4E,COL2
  280. 2800 FOR X=1 TO 2000:NEXT
  281. 2810 RESUME 650
  282. 2820 '** TEST FOR PROPER INPUT **
  283. 2830 IF I$=""THEN ERROR 200
  284. 2840 FOR X=1 TO LEN(I$)
  285. 2850 X$=MID$(I$,X)
  286. 2860 IF ASC(X$)>44 AND ASC(X$)<58 THEN 2870 ELSE K=1
  287. 2870 NEXT
  288. 2880 IF K=1 THEN K=0:ERROR 200
  289. 2890 RETURN
  290. 2900 '** TOGGLE "FAST" FUNCTION **
  291. 2910 F=F+1
  292. 2920 IF F=1 THEN L%=10:M%=11:N%=308:P%=170:LOCATE 25,24
  293. 2930 IF F=1 THEN DEF SEG:POKE &H4E,2:PRINT "<F>AST  ";:POKE &H4E,COL2:RETURN
  294. 2940 IF F=2 THEN L%=1:M%=1:N%=318:P%=180:F=0
  295. 2950 LOCATE 25,24:PRINT "<F>AST  ";:RETURN
  296. 2960 '**** INSERT TEXT INTO GRAPHICS SCREEN ****
  297. 2970 POKE &H4E,Z%
  298. 2980 ROW=Y%/8
  299. 2990 COL=X%/8+1
  300. 3000 LOCATE ROW,COL
  301. 3010 INPUT;"",I$
  302. 3020 POKE &H4E,COL2
  303. 3030 RETURN
  304.