home *** CD-ROM | disk | FTP | other *** search
/ Software Du Jour / SoftwareDuJour.iso / COMPUTER / GRAPHICS / GRAFPIX.ARC / GRAF-PIX.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-25  |  14.0 KB  |  474 lines
  1. 1  '*****************************************
  2. 2  '*                                       *
  3. 3  '*         G R A F  -  P I X             *
  4. 4  '*                                       *
  5. 5  '*  A Graphics Program     Version 1.0   *
  6. 6  '*        by  Read G. Gilgen             *
  7. 7  '*  U.W. Labs for Recorded Instruction   *
  8. 8  '*  Madison, WI 53706     608-262-1408   *
  9. 9  '*                                       *
  10. 10  '*     (c) 1982 by Board of Regents     *
  11. 11  '*    University of Wisconsin System    *
  12. 12  '*                                      *
  13. 13  '****************************************
  14. 14  '
  15. 15  '
  16. 16  '
  17. 20  '***************************************
  18. 22  '* NOTICE:  This program may be copied *
  19. 24  '*   freely, so long as the copyright  *
  20. 26  '*   information and this notice are   *
  21. 28  '*   included unchanged.               *
  22. 30  '***************************************
  23. 35  '
  24. 36  '
  25. 37  '
  26. 100  CLEAR ,,1024:CLS:KEY OFF
  27. 105  REM program to check for default monitor
  28. 110  DEF SEG=0
  29. 115  IF (PEEK(&H410) AND &H30)=&H30 THEN GOSUB 6000
  30. 120  DIM CLRA$(20)
  31. 125  SCREEN 1
  32. 130  COLOR 0,1
  33. 135  LOCATE 13,16:PRINT "GRAF-PIX"
  34. 137  LOCATE 15,9:PRINT "Created by Read Gilgen"
  35. 140  LOCATE 19,7:PRINT "(c) 1982  Board of Regents"
  36. 142  LOCATE 20,5:PRINT "University of Wisconsin System"
  37. 145  FOR PAUSE=1 TO 2000:NEXT PAUSE
  38. 150  CLS:DEF SEG=&H40: POKE &H17, (PEEK(&H17) AND &HFFBF) +64:DEF SEG=&HB000:          POKE 3998,24:  ' SETS UPPER CASE FROM KEYBOARD
  39. 155  COLOR 0,1
  40. 160  PRINT "REMOVE GRAF-PIX DISK AND INSERT"
  41. 165  PRINT "IBM-FORMATTED STORAGE DISK."
  42. 170  PRINT:PRINT "(PRESS ANY KEY TO CONTINUE)":ANS$=INPUT$(1)
  43. 175  CLS:PRINT "Do you wish to:"
  44. 180  PRINT "   1.  Edit an existing graphics file"
  45. 185  PRINT "   2.  Create a new graphics file"
  46. 190  PRINT "   3.  Delete a graphics file"
  47. 195  PRINT "   4.  Print Graf-Pix documentation"
  48. 200  PRINT "   5.  Exit from Graf-Pix"
  49. 205  ON ERROR GOTO 365
  50. 210  ANS$=INPUT$(1)
  51. 215  IF ANS$="1" THEN GOTO 270 ELSE IF ANS$="2" THEN GOTO 315 ELSE IF ANS$="3"         THEN GOTO 220 ELSE IF ANS$="4" THEN GOTO 5000 ELSE IF ANS$="5"                  THEN GOTO 400 ELSE GOTO 150
  52. 220  CLS:PRINT "Graphics files on this disk are:"
  53. 225  PRINT:FILES "*.GRF":PRINT
  54. 230  PRINT :PRINT "Type COMPLETE filename to delete:"
  55. 235  INPUT FILENAME$
  56. 240  ON ERROR GOTO 255
  57. 245  CLS:PRINT "Delete ";FILENAME$;"?  (Y/N)";
  58. 250  ANS$=INPUT$(1):IF ANS$="Y" OR ANS$="y" THEN GOTO 260 ELSE IF ANS$<>"N" AND        ANS$<>"n" THEN GOTO 245 ELSE GOTO 150
  59. 255  CLS:PRINT "Deletion NOT completed":FOR PAUSE=1 TO 2000: NEXT PAUSE:               RESUME 220
  60. 260  KILL FILENAME$
  61. 265  CLS: PRINT FILENAME$ " has been deleted.":FOR PAUSE = 1 TO 2000 :                 NEXT PAUSE : GOTO 150
  62. 270  CLS:PRINT "Graphics files on this disk are:"
  63. 275  PRINT: FILES "*.grf":PRINT
  64. 280  PRINT "Please type filename to edit: ":INPUT PICTURENAME$
  65. 285  ON ERROR GOTO 300
  66. 290  CLS:DEF SEG=&HB800: BLOAD PICTURENAME$,0
  67. 295  GOTO 500
  68. 300  CLS:PRINT "Error in loading file.  Try again? (Y/N)"
  69. 305  ANS$=INPUT$(1)
  70. 310  IF ANS$="N" OR ANS$="n" THEN RESUME 150 ELSE IF ANS$="Y" OR ANS$="y"              THEN RESUME 270 ELSE GOTO 300
  71. 315  CLS: PRINT "Existing graphics files are:":ON ERROR GOTO 340
  72. 320  PRINT:FILES "*.grf":PICTURENAME$=""
  73. 325  PRINT:PRINT "Please type the new filename:":PRINT
  74. 330  ANS$=INPUT$(1)
  75. 335  IF ANS$=CHR$(13) THEN GOTO 355 ELSE IF ANS$="." THEN GOTO 355                     ELSE IF ANS$=CHR$(8) THEN GOTO 370 ELSE IF ANS$=CHR$(27) THEN GOTO 150          ELSE GOTO 345
  76. 340  PRINT:PRINT "(No files yet created . . .)":RESUME 325
  77. 345  PICTURENAME$=PICTURENAME$+ANS$:PRINT ANS$;
  78. 350  GOTO 330
  79. 355  TAG$=".grf":PICTURENAME$=PICTURENAME$+TAG$
  80. 360  GOTO 380
  81. 365  CLS:PRINT "FILE NOT AVAILABLE":PRINT:RESUME 175
  82. 370  PICTURENAME$=LEFT$(PICTURENAME$,(LEN(PICTURENAME$)-1))
  83. 375  PRINT CHR$(29);CHR$(32);CHR$(29);:GOTO 330
  84. 380  CLS:PRINT "The new filename is ";PICTURENAME$
  85. 385  PRINT "OK?  (Y/N): ";
  86. 390  ANS$=INPUT$(1):IF ANS$="Y" OR ANS$="y" THEN GOTO 395 ELSE GOTO 315
  87. 395  CLS:GOTO 500
  88. 400  GOTO 4000
  89. 405  '
  90. 406  '
  91. 500  REM Turtle Grahpics Program
  92. 501  '
  93. 505  ON ERROR GOTO 3000
  94. 510  BND=3    'Boundary color (lines, etc.); default to WHITE
  95. 515  BKGRD=0  'Background default to BLACK
  96. 520  PLT=1    'Pallete; default to CYAN, MGTA, WHITE
  97. 525  CLRA$(1)="Blue":CLRB$(1)="Cyan ":CLRC$(1)="Mgnta":CLRD$(1)="White"
  98. 530  CLRA$(0)="Black":CLRB$(0)="Green":CLRC$(0)="Red  ":CLRD$(0)="Brown"
  99. 535  COLOR (BKGRD),(PLT)
  100. 540  OLDA=160:OLDB=100
  101. 545  NEWA=OLDA:NEWB=OLDB
  102. 550  AMT=6
  103. 555  HELP=0
  104. 560  KEY (1) ON:ON KEY (1) GOSUB 1300     'help menu
  105. 565  KEY (3) ON:ON KEY (3) GOSUB 1400     'circle
  106. 570  KEY (4) ON : ON KEY (4) GOSUB 1700   'fill area
  107. 575  KEY (6) ON: ON KEY (6) GOSUB 1800    'box
  108. 580  KEY (8) ON: ON KEY (8) GOSUB 1900    'end program
  109. 585  KEY(7) ON: ON KEY(7) GOSUB 750       'increase/decrease cursor movement
  110. 590  KEY (11) ON: ON KEY (11) GOSUB 760   'cursor movements
  111. 595  KEY (12) ON: ON KEY (12) GOSUB 765
  112. 600  KEY (13) ON: ON KEY (13) GOSUB 770
  113. 605  KEY (14) ON: ON KEY (14) GOSUB 775
  114. 610  KEY (5) ON: ON KEY (5) GOSUB 1000     'input text
  115. 615  KEY (2) ON: ON KEY (2) GOSUB 2000    'set new color parameters
  116. 620  KEY (9) ON:ON KEY (9) GOSUB 800
  117. 625  KEY (10) ON:ON KEY (10) GOSUB 900
  118. 630  IF DOIT=0 THEN GOTO 645
  119. 635  LINE (OLDA,OLDB)-(NEWA,NEWB),BND
  120. 640  DOIT=0
  121. 645  DIAG$=INKEY$
  122. 650  IF DIAG$<>"" THEN GOSUB 700
  123. 655  GOTO 630
  124. 660  '
  125. 661  '
  126. 700  REM Diagonal cursor movements
  127. 701  '
  128. 705  IF DIAG$=CHR$(0)+CHR$(71) THEN GOTO 710 ELSE GOTO 715
  129. 710  LINE (OLDA,OLDB)-(NEWA,NEWB),0:NEWA=NEWA-AMT:NEWB=NEWB-AMT:DOIT=1:RETURN
  130. 715  IF DIAG$=CHR$(0)+CHR$(79) THEN GOTO 720 ELSE GOTO 725
  131. 720  LINE (OLDA,OLDB)-(NEWA,NEWB),0:NEWA=NEWA-AMT:NEWB=NEWB+AMT:DOIT=1:RETURN
  132. 725  IF DIAG$=CHR$(0)+CHR$(73) THEN GOTO 730 ELSE GOTO 735
  133. 730  LINE (OLDA,OLDB)-(NEWA,NEWB),0:NEWA=NEWA+AMT:NEWB=NEWB-AMT:DOIT=1:RETURN
  134. 735  IF DIAG$=CHR$(0)+CHR$(81) THEN GOTO 740 ELSE GOTO 745
  135. 740  LINE (OLDA,OLDB)-(NEWA,NEWB),0:NEWA=NEWA+AMT:NEWB=NEWB+AMT:DOIT=1:RETURN
  136. 745  RETURN
  137. 750  IF AMT=6 THEN AMT=1 ELSE IF AMT=1 THEN AMT=6:RETURN
  138. 755  RETURN
  139. 760  LINE (OLDA,OLDB)-(NEWA,NEWB),0:NEWB=NEWB-AMT:DOIT=1:RETURN
  140. 765  LINE (OLDA,OLDB)-(NEWA,NEWB),0:NEWA=NEWA-AMT:DOIT=1:RETURN
  141. 770  LINE (OLDA,OLDB)-(NEWA,NEWB),0:NEWA=NEWA+AMT:DOIT=1:RETURN
  142. 775  LINE (OLDA,OLDB)-(NEWA,NEWB),0:NEWB=NEWB+AMT:DOIT=1:RETURN
  143. 780  '
  144. 781  '
  145. 800  REM Erase the line and have a new point
  146. 801  '
  147. 805  PASTA=OLDA:PASTB=OLDB
  148. 810  IF DONE=0 THEN GOTO 840
  149. 815  IF NEWA<> OLDA AND NEWB<>OLDB THEN GOTO 860
  150. 820  IF NEWA>OLDA THEN OLDA=OLDA+1
  151. 825  IF NEWB>OLDB THEN OLDB=OLDB+1
  152. 830  IF NEWA<OLDA THEN OLDA=OLDA-1
  153. 835  IF NEWB<OLDB THEN OLDB=OLDB-1
  154. 840  LINE (OLDA,OLDB)-(NEWA,NEWB),0
  155. 845  OLDA=NEWA:OLDB=NEWB
  156. 850  DONE=0
  157. 855  RETURN
  158. 860  LINE (OLDA,OLDB)-(NEWA,NEWB),0
  159. 865  LINE (OLDA,OLDB)-(OLDA,OLDB),BND
  160. 870  GOTO 820
  161. 875  '
  162. 876  '
  163. 900  REM Draw the line permanently and have a new point
  164. 901  '
  165. 905  PASTA=OLDA:PASTB=OLDB
  166. 910  OLDA=NEWA:OLDB=NEWB
  167. 915  DONE=1
  168. 920  RETURN
  169. 925  '
  170. 926  '
  171. 1000  REM ROUTINE TO ALLOW TEXT PRINTING
  172. 1001  '
  173. 1005  LOCATE 25,1
  174. 1010  PRINT "      Esc = Return to Graphics";SPC(9);
  175. 1015  LINE (OLDA,OLDB)-(NEWA,NEWB),0:                                                   LOCATE (INT(NEWB/8)),(INT((NEWA/8)+1)),1,6,7
  176. 1020  CHRS=1
  177. 1025  TEXT$=INPUT$(1)
  178. 1030  IF TEXT$=CHR$(27) OR TEXT$=CHR$(13) THEN GOTO 1080 ELSE GOTO 1035
  179. 1035  IF TEXT$=CHR$(8) THEN GOTO 1040 ELSE GOTO 1060
  180. 1040  CHRS=CHRS-1
  181. 1045  LOCATE (INT(NEWB/8)),(INT((NEWA/8)+CHRS)):PRINT " "
  182. 1050  LOCATE (INT(NEWB/8)),(INT((NEWA/8)+CHRS))
  183. 1055  GOTO 1025
  184. 1060  PRINT TEXT$
  185. 1065  CHRS=CHRS+1
  186. 1070  LOCATE (INT(NEWB/8)),(INT((NEWA/8)+CHRS))
  187. 1075  GOTO 1025
  188. 1080  HELP=0
  189. 1085  FOR BLANK=1 TO 39:LOCATE 25,BLANK:PRINT CHR$(32);:NEXT BLANK
  190. 1090  RETURN
  191. 1095  '
  192. 1096  '
  193. 1100  REM ROUTINE TO SAVE THE PICTURE
  194. 1101  '
  195. 1105  LOCATE 25,1:PRINT SPC(39);
  196. 1110  LOCATE 25,1:PRINT "Save/Print this as ";PICTURENAME$;"?  (Y/N)";
  197. 1115  ANS$=INPUT$(1)
  198. 1120  IF ANS$="Y" OR ANS$="y" THEN GOTO 1180 ELSE IF ANS$<>"N" AND ANS$<>"n"            THEN GOTO 1105 ELSE GOTO 1125
  199. 1125  LOCATE 25,1:PRINT SPC(39);
  200. 1130  LOCATE 25,1:PRINT "What name:  ";
  201. 1135  LOCATE 25,13:GOSUB 2200
  202. 1140  PICTURENAME$=""
  203. 1145  FOR SCAN=1 TO 8
  204. 1150    IF MID$(INPT$,SCAN,1)="." THEN GOTO 1165 ELSE GOTO 1155
  205. 1155    PICTURENAME$=PICTURENAME$+MID$(INPT$,SCAN,1)
  206. 1160  NEXT SCAN
  207. 1165  TAG$=".grf"
  208. 1170  PICTURENAME$=PICTURENAME$+TAG$
  209. 1175  GOTO 1105
  210. 1180  LOCATE 25,1
  211. 1185  PRINT SPC(39);
  212. 1190  DEF SEG= &HB800
  213. 1195  BSAVE PICTURENAME$,0,&H4000
  214. 1200  RETURN
  215. 1205  '
  216. 1206  '
  217. 1300  REM Help Menu on Line 25
  218. 1301  '
  219. 1305  KEY OFF
  220. 1310  LOCATE 25,1
  221. 1315  IF HELP=0 THEN GOTO 1320 ELSE GOTO 1325
  222. 1320  PRINT "1=Help 2=Clr 3=Circle 4=AreaFill 5=Text";
  223. 1325  IF HELP = 1 THEN GOTO 1330 ELSE GOTO 1335
  224. 1330  PRINT "6=Box 7=Cursor 8=EndPgm 9=Erase 10=Line";
  225. 1335  IF HELP = 2 THEN GOTO 1340 ELSE GOTO 1345
  226. 1340  PRINT SPC(39);
  227. 1345  IF HELP=0 THEN HELP =1 ELSE IF HELP=1 THEN HELP=2 ELSE IF HELP=2                  THEN HELP=0
  228. 1350  RETURN
  229. 1355  '
  230. 1356  '
  231. 1400  REM Create a circle
  232. 1401  '
  233. 1405  ASPECT=0.833
  234. 1410  START=0
  235. 1415  ENDS=0
  236. 1420  PI=3.14159
  237. 1425  LOCATE 25,1:PRINT "Radius =  ";SPC(29);
  238. 1430  LOCATE 25,13:GOSUB 2200
  239. 1435  RD=VAL(INPT$):IF RD=<0 THEN GOTO 1425
  240. 1440  LOCATE 25,1:PRINT "Full Circle?  (Y/N)";SPC(20);
  241. 1445  LOCATE 25,23:GOSUB 2200:FULL$=INPT$
  242. 1450  IF FULL$="Y" OR FULL$="y" THEN GOTO 1515 ELSE IF FULL$<>"N" AND FULL$<>"n"        THEN GOTO 1440
  243. 1455  ANGLE$="2=Rt 1.5=Btm 1=Lft .5=Top"
  244. 1460  LOCATE 25,1:PRINT "Start: ";ANGLE$;SPC(7);
  245. 1465  LOCATE 25,34:GOSUB 2200:START$=INPT$
  246. 1470  START=VAL(START$):IF START=<0 THEN GOTO 1460
  247. 1475  LOCATE 25,1:PRINT "End: ";ANGLE$;SPC(9);
  248. 1480  LOCATE 25,33:GOSUB 2200:ENDS$=INPT$
  249. 1485  ENDS=VAL(ENDS$):IF ENDS=<0 THEN GOTO 1475
  250. 1490  START=(START*PI):ENDS=(ENDS*PI)
  251. 1495  LOCATE 25,1:PRINT "Draw radius lines? (Y/N)";SPC(15);
  252. 1500  LOCATE 25,26:GOSUB 2200:RLINS$=INPT$
  253. 1505  IF RLINS$="Y" OR RLINS$="y" THEN GOTO 1510 ELSE IF RLINS$="N" OR RLINS$="n"       THEN GOTO 1515 ELSE GOTO 1495
  254. 1510  START=-(START):ENDS=-(ENDS)
  255. 1515  LOCATE 25,1:PRINT "Aspect:  N=Normal  T=Tall  F=Flat      ";
  256. 1520  LOCATE 25,36:GOSUB 2200:VIEW$=INPT$
  257. 1525  IF VIEW$="T" OR VIEW$="t" THEN GOTO 1550 ELSE IF VIEW$="F" OR VIEW$= "f"          THEN GOTO 1530 ELSE GOTO 1570
  258. 1530  LOCATE 25,1:PRINT "Flat Range:  .01 to .8";SPC(17);
  259. 1535  LOCATE 25,26:GOSUB 2200:ASPECT$=INPT$
  260. 1540  ASPECT=VAL(ASPECT$):IF ASPECT<0.01 OR ASPECT>0.83 THEN GOTO 1530
  261. 1545  GOTO 1570
  262. 1550  LOCATE 25,1:PRINT "Tall Range:  .9 to 50(?)";SPC(15);
  263. 1555  LOCATE 25,30:GOSUB 2200:ASPECT$=INPT$
  264. 1560  ASPECT=VAL(ASPECT$):IF ASPECT<0.84 OR ASPECT>100 THEN GOTO 1550
  265. 1565  GOTO 1570
  266. 1570  REM Print the circle
  267. 1575  IF START=0 AND ENDS=0 THEN GOTO 1590
  268. 1580  CIRCLE (NEWA,NEWB),RD,BND,START,ENDS,ASPECT
  269. 1585  GOTO 1595
  270. 1590  CIRCLE(NEWA,NEWB),RD,BND,,,ASPECT
  271. 1595  LOCATE 25,1:PRINT SPC(39);
  272. 1600  RETURN
  273. 1605  '
  274. 1606  '
  275. 1700  REM Fill in an area
  276. 1701  '
  277. 1705  LOCATE 25,1:PRINT "Is cursor within closed area. (Y/N)    ";
  278. 1710  LOCATE 25,37:GOSUB 2200:READY$=INPT$
  279. 1715  IF READY$="Y" OR READY$="y" THEN GOTO 1725 ELSE GOTO 1785
  280. 1720  LOCATE 25,1:PRINT SPC(39);
  281. 1725  LOCATE 25,1:PRINT "Color? 0=";CLRA$(BKGRD);" 1=";CLRB$(PLT);" 2=";                CLRC$(PLT);" 3=";CLRD$(PLT);
  282. 1730  LOCATE 25,38:GOSUB 2200:CLR$=INPT$
  283. 1735  FILLCOLOR=VAL(CLR$)
  284. 1740  IF FILLCOLOR <0 OR FILLCOLOR>3 THEN GOTO 1725
  285. 1745  GOSUB 800    'erase cursor
  286. 1750  LOCATE 25,1:PRINT SPC(39);
  287. 1755  LOCATE 25,1:PRINT "Boundary? 1=";CLRB$(PLT);" 2=";CLRC$(PLT);" 3=";               CLRD$(PLT);
  288. 1760  LOCATE 25,36:GOSUB 2200:BOUNDS$=INPT$
  289. 1765  BND=VAL(BOUNDS$)
  290. 1770  IF BND<1 OR BND>3 THEN GOTO 1750
  291. 1775  PAINT (NEWA,NEWB),FILLCOLOR,BND
  292. 1780  IF FILLCOLOR = 0 THEN BND=3 ELSE BND=FILLCOLOR
  293. 1785  LOCATE 25,1:PRINT SPC(39);
  294. 1790  DONE=1
  295. 1795  RETURN
  296. 1798  '
  297. 1799  '
  298. 1800  REM Draw box
  299. 1801  '
  300. 1805  LOCATE 25,1:PRINT "Do you want the box filled? (Y/N)";SPC(6);
  301. 1810  LOCATE 25,35:GOSUB 2200:FILLED$=INPT$
  302. 1815  IF FILLED$="N" OR FILLED$="n" THEN GOTO 1830                                      ELSE IF FILLED$<>"Y" AND FILLED$<>"y" THEN GOTO 1805
  303. 1820  GOSUB 800
  304. 1825  LINE (PASTA,PASTB)-(NEWA,NEWB),BND,BF
  305. 1830  GOSUB 800
  306. 1835  LINE (PASTA,PASTB)-(NEWA,NEWB),BND,B
  307. 1840  LOCATE 25,1:PRINT SPC(39);
  308. 1845  HELP=0
  309. 1850  DONE=1
  310. 1855  RETURN
  311. 1860  '
  312. 1861  '
  313. 1900  REM End the Program
  314. 1901  '
  315. 1905  LOCATE 25,1:PRINT "(ESC)ape (S)ave (P)rint (E)nd-not save ";
  316. 1910  LOCATE 25,37:ANS$=INPUT$(1)
  317. 1915  IF ANS$="E" OR ANS$="e" THEN GOTO 1925 ELSE IF ANS$="S" OR ANS$="s"               THEN GOSUB 1100 ELSE IF ANS$=CHR$(27) THEN GOTO 1930 ELSE IF ANS$="P"           OR ANS$="p" THEN GOTO 1940 ELSE GOTO 1905
  318. 1920  GOTO 1905
  319. 1925  CLS: GOTO 150
  320. 1930  LOCATE 25,1:PRINT SPC(39);
  321. 1935  RETURN
  322. 1940  GOSUB 1100
  323. 1945  GOTO 4000
  324. 1950  RETURN
  325. 1951  '
  326. 1955  '
  327. 2000  REM Change the Color Parameters
  328. 2001  '
  329. 2005  LOCATE 25,1:PRINT SPC(39);
  330. 2010  LOCATE 25,1:PRINT "Line Color= ";
  331. 2015  IF BND=1 THEN PRINT CLRB$(PLT); ELSE IF BND=2 THEN PRINT CLRC$(PLT);              ELSE IF BND=3 THEN PRINT CLRD$(PLT);
  332. 2020  LOCATE 25,20:PRINT "Change? (Y/N)";
  333. 2025  LOCATE 25,35:CHNG$=INPUT$(1)
  334. 2030  IF CHNG$="Y" OR CHNG$="y" THEN GOTO 2035 ELSE GOTO 2045
  335. 2035  IF BND=1 THEN BND=2 ELSE IF BND=2 THEN BND=3 ELSE IF BND=3 THEN BND=1
  336. 2040  GOTO 2005
  337. 2045  LOCATE 25,1:PRINT SPC(39);
  338. 2050  LOCATE 25,1:PRINT "Other changes?  (Y/N)";
  339. 2055  LOCATE 25,30:MORE$=INPUT$(1)
  340. 2060  IF MORE$="Y" OR MORE$="y" THEN GOTO 2070
  341. 2065  LOCATE 25,1:PRINT SPC(39);:RETURN
  342. 2070  LOCATE 25,1:PRINT SPC(39);
  343. 2075  LOCATE 25,1:PRINT "Clrs 0(Grn,Rd,Brn) 1(Cyan,Mgta,Wht)";
  344. 2080  LOCATE 25,37:PALETTE$=INPUT$(1)
  345. 2085  PLT=VAL(PALETTE$)
  346. 2090  IF PLT<0 OR PLT>1 THEN GOTO 2070
  347. 2095  LOCATE 25,1:PRINT SPC(39);
  348. 2100  LOCATE 25,1:PRINT "Bkgrnd 0(Blk) 1(Blue) 2-15(Others)";
  349. 2105  LOCATE 25,36:GOSUB 2200:BACKGROUND$=INPT$
  350. 2110  BKGRD=VAL(BACKGROUND$)
  351. 2115  IF BKGRD<0 OR BKGRD>15 THEN GOTO 2095
  352. 2120  COLOR (BKGRD),(PLT)
  353. 2125  LOCATE 25,1:PRINT SPC(39);
  354. 2130  RETURN
  355. 2135  '
  356. 2136  '
  357. 2200  REM routine to eliminate carriage return on input
  358. 2201  '
  359. 2205  INPT$=""
  360. 2210  X$=INPUT$(1)
  361. 2215  IF X$=CHR$(13) THEN RETURN ELSE GOTO 2220
  362. 2220  IF X$=CHR$(8) THEN GOTO 2225 ELSE GOTO 2240
  363. 2225  INPT$=LEFT$(INPT$,(LEN(INPT$)-1))
  364. 2230  PRINT CHR$(29);CHR$(32);CHR$(29);
  365. 2235  GOTO 2210
  366. 2240  INPT$=INPT$+X$
  367. 2245  PRINT X$;
  368. 2250  GOTO 2210
  369. 2255  '
  370. 2256  '
  371. 3000  REM Error handling section
  372. 3001  '
  373. 3005  LOCATE 25,1:PRINT SPC(39);
  374. 3010  LOCATE 25,1:PRINT "Error #";ERR;"in line";ERL;"  Any Key:";
  375. 3015  LOCATE 25,39
  376. 3020  ANS$=INPUT$(1)
  377. 3025  RESUME 1900
  378. 3030  RESUME 500
  379. 3035  '
  380. 3036  '
  381. 4000  REM GRAPHICS DUMP ROUTINE
  382. 4001  '
  383. 4010  LOCATE 25,1: PRINT "Insert Graf-Pix Disk.  (Press any key)";
  384. 4020  ANS$=INPUT$(1)
  385. 4030  SYSTEM
  386. 4035  '
  387. 4036  '
  388. 5000  REM   Print Documentation
  389. 5005  '
  390. 5010  CLS:SCREEN 0:WIDTH 80
  391. 5015  ON ERROR GOTO 5200
  392. 5016  PRINT "MAKE SURE THE GRAF-PIX PROGRAM DISK"
  393. 5017  PRINT "IS IN DRIVE A.  HIT ANY KEY WHEN READY
  394. 5018  ANS$=INPUT$(1)
  395. 5019  CLS
  396. 5020  CLOSE #2: OPEN "GP.DOC" FOR INPUT AS #2
  397. 5025  PRINT:PRINT"MAKE SURE THAT YOUR PRINTER IS ON AND LOADED WITH CONTINUOUS FORM PAPER.
  398. 5030  PRINT"ALIGN THE PRINT HEAD WITH THE TOP OF THE FORM AND
  399. 5035  PRINT" SET THE PRINTER TO PRINT 66 LINES PER PAGE.
  400. 5040  PRINT"THE PRINTING ROUTINE WILL TAKE ABOUT 3 MINUTES AT 80 CPS.
  401. 5045  PRINT"DO YOU WISH TO PROCESS WITH PRINTING NOW (Y/N)? ";
  402. 5050  Q$=INKEY$:IF Q$="" THEN 5050
  403. 5055  IF Q$<>"Y" AND Q$<>"y" THEN GOTO 5155
  404. 5060  ON ERROR GOTO 5230
  405. 5065  LPRINT " "; '*** tests for whether printer is on
  406. 5070  LOCATE 25,1:PRINT">>> Printing Documentation <<<  (Press CTRL+<Home> to terminate.)";SPACE$(13);:LOCATE 24,1
  407. 5075  '
  408. 5076  '    - printing routine -
  409. 5080  INDENT=8
  410. 5085  FOR J=1 TO 100
  411. 5090    LPRINT:LPRINT:LPRINT:LPRINT:LPRINT:LPRINT
  412. 5095    FOR I=1 TO 55
  413. 5098      IF EOF(2) THEN CLOSE #2:GOTO 5145
  414. 5100      LINE INPUT #2,P$
  415. 5105      PRINT P$
  416. 5110      IF LEFT$(P$,1)="\" THEN 5135
  417. 5115      LPRINT SPACE$(INDENT);:LPRINT P$
  418. 5120      Q$=INKEY$:IF  Q$<>"" THEN IF ASC(RIGHT$(Q$,1))=119 THEN 5150
  419. 5130    NEXT I
  420. 5135    LPRINT:LPRINT:LPRINT:LPRINT:LPRINT
  421. 5140  NEXT J
  422. 5145  FOR K=I TO 55:LPRINT:NEXT K
  423. 5150  '     - terminate printing -
  424. 5155  CLOSE #2:CLS:SCREEN 1:GOTO 150
  425. 5160  FOR SPACES=1 TO 12
  426. 5165  LPRINT
  427. 5170  NEXT SPACES
  428. 5175  RETURN
  429. 5180  '
  430. 5200  CLS:PRINT "Make sure the Graf-Pix disk"
  431. 5205  PRINT "  is in the logged drive.  Strike"
  432. 5210  PRINT "  any key when ready."
  433. 5215  ANS$=INPUT$(1)
  434. 5220  RESUME 5000
  435. 5225  '
  436. 5230  CLS:PRINT "Make sure the printer is ready . . ."
  437. 5235  PRINT "(Strike any key when ready.)"
  438. 5240  ANS$=INPUT$(1)
  439. 5245  RESUME 5060
  440. 5250  '
  441. 5251  '
  442. 6000  REM Program to transfer control to COLOR/GRAPHICS adapter
  443. 6001  '
  444. 6005  KEY OFF:CLS
  445. 6010  COLOR 31:PRINT"CAUTION!!!":COLOR 7
  446. 6015  PRINT:PRINT "IF YOU DO NOT HAVE A COLOR ADAPTER"
  447. 6020  PRINT "CARD INSTALLED, DO NOT USE THIS"
  448. 6025  PRINT "PROGRAM OR YOU'LL HAVE TO START ALL"
  449. 6030  PRINT "OVER AGAIN!!
  450. 6035  PRINT:PRINT "DO YOU WISH TO PROCEED?  (Y/N)"
  451. 6040  A$=INPUT$(1)
  452. 6045  GOSUB 6070
  453. 6050  CLS
  454. 6055  WIDTH 80: DEF SEG=0: A=PEEK(&H410): POKE &H410, (A AND &HCF) OR &H20
  455. 6060  WIDTH 40: SCREEN 1: SCREEN 0: LOCATE ,,1,6,7
  456. 6065  RETURN
  457. 6070  REM CHECK FOR ANSWER
  458. 6075  IF A$="Y" OR A$="y" THEN RETURN
  459. 6080  WIDTH 80:CLS:SYSTEM
  460. 6085  END
  461. 7001  '*****************************************
  462. 7002  '*                                       *
  463. 7003  '*         G R A F  -  P I X             *
  464. 7004  '*                                       *
  465. 7005  '*        A Graphics Program             *
  466. 7006  '*        by  Read G. Gilgen             *
  467. 7007  '*  U.W. Labs for Recorded Instruction   *
  468. 7008  '*  Madison, WI 53706     608-262-1408   *
  469. 7009  '*                                       *
  470. 7010  '*      (c) 1982 Board of Regents        *
  471. 7011  '*    University of Wisconsin System     *
  472. 7012  '*                                       *
  473. 7014  '*****************************************
  474.