home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 36.dms / 36.adf / screentool.bas < prev    next >
BASIC Source File  |  1988-05-22  |  11KB  |  276 lines
  1. 10    'screentool - v. 1.0 - Robert Sawdey - 11/26/85
  2. 20    for i%=0 to 15:rgb i%,0,0,0:next
  3. 30    screen 0,4,0:font 1:pena%=1:mode%=1
  4. 40    erase screen%:dim screen%(8002)
  5. 50    'Set Palette
  6. 60    erase rgb%:dim rgb%(16,3):restore
  7. 70    for i%=0 to 15:for j%=0 to 2:read rgb%(i%,j%):next j%,i%
  8. 80    data 00,00,00, 08,05,04, 11,09,07, 10,00,00
  9. 90    data 15,07,07, 12,05,00, 15,10,03, 13,13,01
  10. 100   data 15,15,06, 00,07,00, 03,15,07, 00,00,10
  11. 110   data 06,07,15, 08,00,08, 15,08,15, 15,15,15
  12. 120   'Set Lines
  13. 130   erase lines%:dim lines%(16)
  14. 140   for i%=0 to 7:read lines%(i%):next i%
  15. 150   data &B1111111111111111
  16. 160   data &B0000111111110000
  17. 170   data &B0011110000111100
  18. 180   data &B0110011001100110
  19. 190   data &B1010101010101010
  20. 200   data &B0100111001001110
  21. 210   data &B0011000011111100
  22. 220   data &B0010001000100010
  23. 230   'Set Patterns
  24. 240   erase pattern%:dim pattern%(4)
  25. 250   erase pattern0%,pattern1%,pattern2%,pattern3%
  26. 260   erase pattern4%,pattern5%,pattern6%,pattern7%
  27. 270   dim pattern0%(4),pattern1%(4),pattern2%(4)
  28. 280   dim pattern3%(4),pattern4%(4),pattern5%(4)
  29. 290   dim pattern6%(4),pattern7%(4)
  30. 300   for j%=0 to 3:read pattern0%(j%):next j%
  31. 310   'solid
  32. 320   data &B1111111111111111
  33. 330   data &B1111111111111111
  34. 340   data &B1111111111111111
  35. 350   data &B1111111111111111
  36. 360   for j%=0 to 3:read pattern1%(j%):next j%
  37. 370   'hor. stripe 1
  38. 380   data &B1111111111111111
  39. 390   data &B0000000000000000
  40. 400   data &B1111111111111111
  41. 410   data &B0000000000000000
  42. 420   for j%=0 to 3:read pattern2%(j%):next j%
  43. 430   'hor. stripe 2
  44. 440   data &B0000000000000000
  45. 450   data &B1111111111111111
  46. 460   data &B1111111111111111
  47. 470   data &B0000000000000000
  48. 480   for j%=0 to 3:read pattern3%(j%):next j%
  49. 490   'vert. stripe 1
  50. 500   data &B1010101010101010
  51. 510   data &B1010101010101010
  52. 520   data &B1010101010101010
  53. 530   data &B1010101010101010
  54. 540   for j%=0 to 3:read pattern4%(j%):next j%
  55. 550   'vert. stripe 2
  56. 560   data &B1100110011001100
  57. 570   data &B1100110011001100
  58. 580   data &B1100110011001100
  59. 590   data &B1100110011001100
  60. 600   for j%=0 to 3:read pattern5%(j%):next j%
  61. 610   'diag 1
  62. 620   data &B0101010101010101
  63. 630   data &B1010101010101010
  64. 640   data &B0101010101010101
  65. 650   data &B1010101010101010
  66. 660   for j%=0 to 3:read pattern6%(j%):next j%
  67. 670   'right diag 2
  68. 680   data &B0011001100110011
  69. 690   data &B0110011001100110
  70. 700   data &B1100110011001100
  71. 710   data &B1001100110011001
  72. 720   for j%=0 to 3:read pattern7%(j%):next j%
  73. 730   'left diag 2
  74. 740   data &B1100110011001100
  75. 750   data &B0110011001100110
  76. 760   data &B0011001100110011
  77. 770   data &B1001100110011001
  78. 780   'diag 2
  79. 790   data &B1100110011001100
  80. 800   data &B0011001100110011
  81. 810   data &B1100110011001100
  82. 820   data &B0011001100110011
  83. 830   data &B1100110011001100
  84. 840   'init
  85. 850   for i%=0 to 3:pattern%(i%)=pattern0%(i%):next i%
  86. 860   pena pena%:penb pena%:peno 2:linepat 65535
  87. 870   scnclr:print " ";inverse(1);"End  Screen  Color  Modes   Styles   ";at(1,1);
  88. 880   'menu 1
  89. 890   erase menu1%,save1%:dim menu1%(422),save1%(422)
  90. 900   print at(7,2);"clear";at(7,3);"load";at(7,4);"save   "
  91. 910   print at(7,5);"memory";at(7,6);"recall"
  92. 920   box(40,7;104,48),0:sshape(40,8;105,49),menu1%
  93. 930   'menu 2
  94. 940   erase menu2%,save2%:dim menu2%(210),save2%(210)
  95. 950   print at(15,2);"brush";at(15,3);"cycle"
  96. 960   box(104,7;160,25),0:sshape(104,8;161,26),menu2%
  97. 970   'menu 3
  98. 980   erase menu3%,save3%:dim menu3%(422),save3%(422)
  99. 990   print at(22,2);"draw";at(22,3);"line";at(22,4);"box";at(22,5);"circle";at(22,6);"fill"
  100. 1000  box(160,7;224,48),0:sshape(160,8;225,49),menu3%
  101. 1010  'menu 4
  102. 1020  erase menu4%,save4%:dim menu4%(262),save4%(262)
  103. 1030  print at(30,2);"brush";at(30,3);"line";at(30,4);"fill"
  104. 1040  box(224,7;287,33),0:sshape(224,8;288,34),menu4%
  105. 1050  peno pena%:scnclr:print " ";
  106. 1060  print at(1,1);" ";inverse(1);"End  Screen  Color  Modes   Styles  ";at(1,1);
  107. 1070  'fade in
  108. 1080  for i%=1 to 3:for j%=0 to 15:ask rgb i%,r%,g%,b%
  109. 1090  if r%< rgb%(i%,0) then r%=r%+1
  110. 1100  if g%< rgb%(i%,1) then g%=g%+1
  111. 1110  if b%< rgb%(i%,2) then b%=b%+1
  112. 1120  rgb i%,r%,g%,b%
  113. 1130  next j%,i%
  114. 1140  for i%=4 to 15:rgb i%,rgb%(i%,0),rgb%(i%,1),rgb%(i%,2):next i%
  115. 1150  goto 1270
  116. 1160  'menu loop
  117. 1170  ask mouse x%,y%,b%:if b%<>0 then goto 1170
  118. 1180  ask mouse x%,y%,b%:if b%=0 then goto 1180
  119. 1190  if y%>9 then goto 1270
  120. 1200  if (x%<296 and x%>224) then menu%=4:sshape(224,8;289,34),save4%:gshape(224,8),menu4%
  121. 1210  if (x%<224 and x%>160) then menu%=3:sshape(160,8;226,50),save3%:gshape(160,8),menu3%
  122. 1220  if (x%<160 and x%>104) then menu%=2:sshape(104,8;162,34),save2%:gshape(104,8),menu2%
  123. 1230  if (x%<104 and x%>040) then menu%=1:sshape(040,8;106,50),save1%:gshape(40,8),menu1%
  124. 1240  if x%<40 then screen 1,2,0:end
  125. 1250  on menu% gosub 1350,1520,1480,2190
  126. 1260  print " ";inverse(1);"End  Screen  Color  Modes   Styles  "; at (1,1);
  127. 1270  on mode% gosub 1720,1820,1930,2040,2140
  128. 1280  goto 1190
  129. 1290  'get menu selection 
  130. 1300  ask mouse x%,y%,b%:if b%<>0 then goto 1300
  131. 1310  ask mouse x%,y%,b%:if b%=0 then goto 1310
  132. 1320  if x%<xl% or x%>xr% or y%>yl% then goto 1300
  133. 1330  sel%=int(y%/8)
  134. 1340  return
  135. 1350  'get screen
  136. 1360  xl%=40:xr%=104:yl%=48:gosub 1290:screen%=sel%
  137. 1370  gshape(40,8),save1%:if screen%=0 then return
  138. 1380  on screen% gosub 1400,1440,1450,1460,1470
  139. 1390  return
  140. 1400  scnclr:return:' clear
  141. 1410  print at (1,1);space$(39);at (1,1);
  142. 1420  input "Filename: ",filename$:filename$=filename$+".scn"
  143. 1430  print at (1,1);:return
  144. 1440  gosub 1410:bload filename$,varptr(screen%(0)):gshape(0,0),screen%:return:' load
  145. 1450  sshape(0,0;319,199),screen%:gosub 1410:bsave filename$,varptr(screen%(0)),32008:return:' save
  146. 1460  sshape(0,0;319,199),screen%:return:' memory
  147. 1470  gshape(0,0),screen%:return:'recall
  148. 1480  'get mode
  149. 1490  xl%=160:xr%=224:yl%=48:gosub 1290
  150. 1500  gshape(160,8),save3%:if sel%=0 then return
  151. 1510  mode%=sel%:return
  152. 1520  'get pen, then color into pen
  153. 1530  xl%=104:xr%=160:yl%=32:gosub 1290:pen%=sel%
  154. 1540  gshape(104,8),save2%:if pen%=0 then return
  155. 1550  gosub 1610
  156. 1560  if pen%=1 then pena%=c%
  157. 1570  if pen%=2 then penb%=c%
  158. 1580  rem if pen%=3 then peno%=c%
  159. 1590  pena pena%:penb penb%:peno pena%
  160. 1600  return
  161. 1610  drawmode 0:pattern 4,pattern0%:'   COLOR
  162. 1620  for i%=0 to 15
  163. 1630  peno 1:pena i%:box(i%*18+7,0;i%*18+25,7),1
  164. 1640  next
  165. 1650  ask mouse x%,y%,b%:if b%<>0 then goto 1650
  166. 1660  ask mouse x%,y%,b%:if b%=0 then goto 1660
  167. 1670  if y%>9 then goto 1650
  168. 1680  c%=fix((x%-8)/18):if c%=16 then c%=0
  169. 1690  pattern 4,pattern%
  170. 1700  return
  171. 1710  'draw
  172. 1720  drawmode 0:linepat 65535
  173. 1730  ask mouse x%,y%,b%:if b%<>0 then goto 1730
  174. 1740  ask mouse x%,y%,b%
  175. 1750  if y%<9 then goto 1790
  176. 1760  if b%=0 then drawmode 2:box(x%,y%;x%-bw%,y%-bh%):box(x%,y%;x%-bw%,y%-bh%)
  177. 1770  if b%=4 then drawmode 0:box(x%,y%;x%-bw%,y%-bh%)
  178. 1780  goto 1740
  179. 1790  ask mouse x%,y%,b%:if b%=0 then goto 1790
  180. 1800  return
  181. 1810  'line
  182. 1820  drawmode 2:linepat lines%(pat%)
  183. 1830  ask mouse x2%,y2%,b%:if b%<>0 then goto 1830
  184. 1840  ask mouse x1%,y1%,b%:if b%=0 then goto 1840
  185. 1850  ask mouse x1%,y1%,b%:if b%<>0 then goto 1850
  186. 1860  if y1%<9 then x%=x1%:y%=y1%:return
  187. 1870  draw(x1%,y1%;x2%,y2%):draw(x1%,y1%;x2%,y2%)
  188. 1880  ask mouse x2%,y2%,b%
  189. 1890  if y2%<9 then goto 1820
  190. 1900  if b%=0 then goto 1870
  191. 1910  drawmode 0:draw(x1%,y1%;x2%,y2%):goto 1820
  192. 1920  'box
  193. 1930  drawmode 2:linepat lines%(pat%)
  194. 1940  ask mouse x2%,y2%,b%:if b%<>0 then goto 1940
  195. 1950  ask mouse x1%,y1%,b%:if b%=0 then goto 1950
  196. 1960  ask mouse x1%,y1%,b%:if b%<>0 then goto 1960
  197. 1970  if y1%<9 then x%=x1%:y%=y1%:return
  198. 1980  box(x1%,y1%;x2%,y2%):box(x1%,y1%;x2%,y2%)
  199. 1990  ask mouse x2%,y2%,b%
  200. 2000  if y2%<9 then goto 1930
  201. 2010  if b%=0 then goto 1980
  202. 2020  drawmode 0:box(x1%,y1%;x2%,y2%):goto 1930
  203. 2030  'circle
  204. 2040  drawmode 2
  205. 2050  ask mouse x2%,y2%,b%:if b%<>0 then goto 2050
  206. 2060  ask mouse x1%,y1%,b%:if b%=0 then goto 2060
  207. 2070  if y1%<9 then x%=x1%:y%=y1%:return
  208. 2080  circle(x1%,y1%),sqr((((x1%-x2%)^2)+((y1%-y2%)^2))),.9:circle(x1%,y1%),sqr((((x1%-x2%)^2)+((y1%-y2%)^2))),.9
  209. 2090  ask mouse x2%,y2%,b%
  210. 2100  if y2%<9 then goto 2050
  211. 2110  if b%=0 then goto 2080
  212. 2120  drawmode 0:circle(x1%,y1%),sqr((((x1%-x2%)^2)+((y1%-y2%)^2))),.9:goto 2040
  213. 2130  'fill
  214. 2140  drawmode 0:pattern 4,pattern%
  215. 2150  ask mouse x%,y%,b%:if b%<>0 then goto 2150
  216. 2160  ask mouse x%,y%,b%:if b%=0 then goto 2160
  217. 2170  if y%<9 then return
  218. 2180  paint(x%,y%),1:goto 2150
  219. 2190  ' Get Styles
  220. 2200  drawmode 0:xl%=224:xr%=296:yl%=32:gosub 1290:styles%=sel%
  221. 2210  gshape(224,8),save4%:if styles%=0 then return
  222. 2220  pattern 4,pattern0%:linepat 65535:pena 0:peno 1
  223. 2230  for i%=0 to 7:box(i%*36+7,0;i%*36+43,7),1:next 
  224. 2240  peno 2:pena 2:on styles% gosub 2270,2430,2520
  225. 2250  pena pena%:penb pena%:peno pena%
  226. 2260  return
  227. 2270  ' brush
  228. 2280  box(25,4;25,4):box(61,3;62,4):box(97,4;99,4):box(134,3;134,5)
  229. 2290  box(168,3;170,5):box(204,3;206,4):box(240,3;241,5):box(275,2;278,5)
  230. 2300  ask mouse x%,y%,b%:if b%<>0 then goto 2300
  231. 2310  ask mouse x%,y%,b%:if b%=0 then goto 2310
  232. 2320  if y%>9 then goto 2300
  233. 2330  brush%=fix((x%-8)/36):if brush%>7 then brush%=0
  234. 2340  if brush%=0 then bw%=0:bh%=0
  235. 2350  if brush%=1 then bw%=1:bh%=1
  236. 2360  if brush%=2 then bw%=2:bh%=0
  237. 2370  if brush%=3 then bw%=0:bh%=2
  238. 2380  if brush%=4 then bw%=2:bh%=2
  239. 2390  if brush%=5 then bw%=2:bh%=1
  240. 2400  if brush%=6 then bw%=1:bh%=2
  241. 2410  if brush%=7 then bw%=3:bh%=3
  242. 2420  return
  243. 2430  ' line
  244. 2440  for i%=0 to 7:linepat lines%(i%)
  245. 2450  locate ((i%*36+9),4):draw(to (i%*36+40),4):next i%
  246. 2460  ask mouse x%,y%,b%:if b%<>0 then goto 2460
  247. 2470  ask mouse x%,y%,b%:if b%=0 then goto 2470
  248. 2480  if y%>9 then goto 2460
  249. 2490  pat%=fix((x%-8)/36):if pat%>7 then pat%=0
  250. 2500  linepat lines%(pat%)
  251. 2510  return
  252. 2520  ' fill
  253. 2530  pattern 4,pattern0%:paint(12,2),1
  254. 2540  pattern 4,pattern1%:paint(48,2),1
  255. 2550  pattern 4,pattern2%:paint(84,2),1
  256. 2560  pattern 4,pattern3%:paint(120,2),1
  257. 2570  pattern 4,pattern4%:paint(156,4),1
  258. 2580  pattern 4,pattern5%:paint(192,4),1
  259. 2590  pattern 4,pattern6%:paint(228,4),1
  260. 2600  pattern 4,pattern7%:paint(264,4),1
  261. 2610  ask mouse x%,y%,b%:if b%<>0 then goto 2610
  262. 2620  ask mouse x%,y%,b%:if b%=0 then goto 2620
  263. 2630  fpat%=fix((x%-8)/36)+1:if fpat%>8 then fpat%=1
  264. 2640  on fpat% goto 2650,2660,2670,2680,2690,2700,2710,2720
  265. 2650  for i%=0 to 3:pattern%(i%)=pattern0%(i%):next i%:goto 2730
  266. 2660  for i%=0 to 3:pattern%(i%)=pattern1%(i%):next i%:goto 2730
  267. 2670  for i%=0 to 3:pattern%(i%)=pattern2%(i%):next i%:goto 2730
  268. 2680  for i%=0 to 3:pattern%(i%)=pattern3%(i%):next i%:goto 2730
  269. 2690  for i%=0 to 3:pattern%(i%)=pattern4%(i%):next i%:goto 2730
  270. 2700  for i%=0 to 3:pattern%(i%)=pattern5%(i%):next i%:goto 2730
  271. 2710  for i%=0 to 3:pattern%(i%)=pattern6%(i%):next i%:goto 2730
  272. 2720  for i%=0 to 3:pattern%(i%)=pattern7%(i%):next i%
  273. 2730  pattern 4,pattern%
  274. 2740  return
  275. 2750  end
  276.