home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 006.lha / APAINT.MAIN < prev    next >
Encoding:
Text File  |  1986-02-01  |  35.0 KB  |  1,011 lines
  1. 100   PRINT "          ==== APAINT ====          "
  2. 110   PRINT
  3. 120   PRINT "  Copyright 1985,1986 Colin French  "
  4. 130   PRINT "  Requires: min. 512K, Amiga mouse  "
  5. 140   PRINT "  Latest Revision:   24/02/86  CJF  "
  6. 150   RETURN
  7. 160   PRINT "Although this program is copyrighted,"
  8. 170   PRINT "please feel free to pass on copies to"
  9. 180   PRINT "friends and user groups, so long as"
  10. 190   PRINT "it's not done for profit. All other"
  11. 200   PRINT "rights are reserved by the author."
  12. 210   RETURN
  13. 220   PRINT "APaint uses a number of other files"
  14. 230   PRINT "which must be copied along with this"
  15. 240   PRINT "main program. Put these files on a"
  16. 250   PRINT "bootable disk that contains all the"
  17. 260   PRINT "AmigaDOS system files. (For example,"
  18. 270   PRINT "a copy of the Workbench disk that has"
  19. 280   PRINT "been stripped-down, ie no demo files,"
  20. 290   PRINT "font files, etc.) Then boot up with"
  21. 300   PRINT "this disk instead of the Workbench."
  22. 310   PRINT
  23. 320   PRINT "The easiest way to copy APaint is to"
  24. 330   PRINT "use the Workbench & copy this entire"
  25. 340   PRINT "disk in the usual manner."
  26. 350   RETURN
  27. 360   PRINT "APaint must be on the disk you use to"
  28. 370   PRINT "boot up the computer and must be left"
  29. 380   PRINT "in the built-in drive at all times."
  30. 390   PRINT "If you only have one disk drive, you"
  31. 400   PRINT "will have to save your pictures on"
  32. 410   PRINT "this boot disk. If it's been stripped"
  33. 420   PRINT "down you'll have room for five images."
  34. 430   PRINT "With two drives, you can put pictures"
  35. 440   PRINT "on any disk in the external drive."
  36. 450   PRINT
  37. 460   PRINT "For information on APaint, and how to"
  38. 470   PRINT "use the pictures you create in your"
  39. 480   PRINT "own programs, run APAINT.HINTS."
  40. 490   RETURN
  41. 500   '
  42. 510   '  If you find any bugs, or make improvements to
  43. 520   '  APaint, I'd like to hear from you. Write:
  44. 530   '
  45. 540   '             Colin French
  46. 550   '             2144 Iris St.
  47. 560   '             Ottawa, Ontario
  48. 570   '             K2C 1B3
  49. 580   '
  50. 590   '
  51. 600   '   ---------NORMAL ENTRY POINT---------
  52. 610   '    This main program is chained into
  53. 620   '    place by the program 'APAINT' and
  54. 630   '    execution begins here.
  55. 640   '
  56. 650   '    GET DISK INFO & FILE LISTS
  57. 660   '
  58. 670   GOSUB 12600:DISK$=NAME$(0,NUMNAME%(0))
  59. 680   DSKBLK%=DSKBLK%(NUMNAME%(0))
  60. 690   GOSUB 12200
  61. 700   '
  62. 710   '    PROMPT TO CONTINUE
  63. 720   '
  64. 730   PENA 0:OUTLINE 0:BOX(35,162;261,172),1
  65. 740   PENA 30:PRINT AT(48,170);"Please double click here []"
  66. 750   ASK MOUSE X%,Y%,B%:IF B%=0 THEN 750
  67. 760   PENA 0:BOX(86,172;214,182),1:PENA 30
  68. 770   IF X%>248 AND X%<262 AND Y%>161 AND Y%<171 THEN PRINT AT(108,180);"Thank you!":GOTO 790
  69. 780   PRINT AT(98,180);"Close enough..."
  70. 790   SLEEP 10^6:SCNCLR:PENA FCLR:DRAWMODE DRWMD
  71. 800   '
  72. 810   '    +--------------------+
  73. 820   '    |    MAIN PROGRAM    |
  74. 830   '    +--------------------+
  75. 840   '
  76. 860   QUIT=0
  77. 870   WHILE NOT(QUIT)
  78. 880   ASK MOUSE X%,Y%,B%
  79. 890   IF Y%<0 THEN GOSUB 6000 'cursor on menu bar
  80. 900   IF B%=0 THEN 960 'button not pressed
  81. 910   SSHAPE(0,0;304,189),UNDOBUF%() 'save screen
  82. 920   IF TOOL<7 THEN ON TOOL GOSUB 1000,1830,1940,1000,2340,2300:GOTO 960
  83. 930   IF TOOL<13 THEN ON TOOL-6 GOSUB 2600,2600,2800,2800,3030,3030:GOTO 960
  84. 940   IF TOOL<19 THEN ON TOOL-12 GOSUB 4250,4250,4340,4340,4240,4240:GOTO 960
  85. 950   IF TOOL<25 THEN ON TOOL-18 GOSUB 4670,4740,4890,5060,4240,5500
  86. 960   GET Z$:IF Z$<>"" THEN GOSUB 11100 'keyboard check
  87. 970   WEND
  88. 980   '    CLEAN UP BEFORE QUITTING
  89. 990   GOSUB 11000
  90. 992   END
  91. 1000  '
  92. 1010  '    +---------------------+
  93. 1020  '    |    DRAWING TOOLS    |
  94. 1030  '    +---------------------+
  95. 1040  '
  96. 1050  '    FREEHAND BRUSH
  97. 1060  X1%=X%:Y1%=Y%
  98. 1070  ASK MOUSE X%,Y%,B%:IF B%=0 THEN RETURN
  99. 1080  GOSUB 1100:GOTO 1060
  100. 1090  '    BRANCH TO BRUSHES
  101. 1100  ON BRUSH+1 GOSUB 1130,1160,1190,1230,1290,1360,1450,1480,1510,1540,1600,1690
  102. 1110  RETURN
  103. 1120  '    BRUSH 0: SINGLE POINT
  104. 1130  AREA(X1%,Y1% TO X1%,Y1% TO X%,Y%)
  105. 1140  RETURN
  106. 1150  '    BRUSH 1: DOUBLE POINT
  107. 1160  AREA(X1%,Y1% TO X1%+1,Y1% TO X%+1,Y% TO X%,Y%)
  108. 1170  RETURN
  109. 1180  '    BRUSH 2: SMALL SQUARE
  110. 1190  AREA(X1%,Y1% TO X1%+1,Y1% TO X%+1,Y% TO X%,Y%)
  111. 1200  AREA(X1%,Y1%+1 TO X1%+1,Y1%+1 TO X%+1,Y%+1 TO X%,Y%+1)
  112. 1210  RETURN
  113. 1220  '    BRUSH 3: SMALL CIRCLE
  114. 1230  AREA(X1%-1,Y1% TO X1%+2,Y1% TO X%+2,Y% TO X%-1,Y%)
  115. 1240  AREA(X1%-1,Y1%+1 TO X1%+2,Y1%+1 TO X%+2,Y%+1 TO X%-1,Y%+1)
  116. 1250  AREA(X1%,Y1%-1 TO X1%+1,Y1%-1 TO X%+1,Y%-1 TO X%,Y%-1)
  117. 1260  AREA(X1%,Y1%+2 TO X1%+1,Y1%+2 TO X%+1,Y%+2 TO X%,Y%+2)
  118. 1270  RETURN
  119. 1280  '    BRUSH 4: LARGE SQUARE
  120. 1290  AREA(X1%-2,Y1%-2 TO X1%-2,Y1%+2 TO X%-2,Y%+2 TO X%-2,Y%-2)
  121. 1300  AREA(X1%-2,Y1%+2 TO X1%+2,Y1%+2 TO X%+2,Y%+2 TO X%-2,Y%+2)
  122. 1310  AREA(X1%+2,Y1%+2 TO X1%+2,Y1%-2 TO X%+2,Y%-2 TO X%+2,Y%+2)
  123. 1320  AREA(X1%+2,Y1%-2 TO X1%-2,Y1%-2 TO X%-2,Y%-2 TO X%+2,Y%-2)
  124. 1330  AREA(X1%-2,Y1%-2 TO X1%-2,Y1%+2 TO X1%+2,Y1%+2 TO X1%+2,Y1%-2)
  125. 1340  RETURN
  126. 1350  '    BRUSH 5: LARGE CIRCLE
  127. 1360  AREA(X1%-3,Y1%-1 TO X1%-3,Y1%+2 TO X%-3,Y%+2 TO X%-3,Y%-1)
  128. 1370  AREA(X1%-1,Y1%+4 TO X1%+2,Y1%+4 TO X%+2,Y%+4 TO X%-1,Y%+4)
  129. 1380  AREA(X1%+4,Y1%+2 TO X1%+4,Y1%-1 TO X%+4,Y%-1 TO X%+4,Y%+2)
  130. 1390  AREA(X1%+2,Y1%-3 TO X1%-1,Y1%-3 TO X%-1,Y%-3 TO X%+2,Y%-3)
  131. 1400  AREA(X1%-2,Y1%-2 TO X1%-2,Y1%+3 TO X%-2,Y%+3 TO X%-2,Y%-2)
  132. 1410  AREA(X1%+3,Y1%-2 TO X1%+3,Y1%+3 TO X%+3,Y%+3 TO X%+3,Y%-2)
  133. 1420  AREA(X1%-2,Y1%-2 TO X1%-2,Y1%+3 TO X1%+3,Y1%+3 TO X1%+3,Y1%-2)
  134. 1430  RETURN
  135. 1440  '    BRUSH 6: HORIZ LINE
  136. 1450  AREA(X1%-8,Y1% TO X1%+8,Y1% TO X%+8,Y% TO X%-8,Y%)
  137. 1460  RETURN
  138. 1470  '    BRUSH 7: DIAGONAL LINE
  139. 1480  AREA(X1%-3,Y1%+3 TO X1%+3,Y1%-3 TO X%+3,Y%-3 TO X%-3,Y%+3)
  140. 1490  RETURN
  141. 1500  '    BRUSH 8: VERTICAL LINE
  142. 1510  AREA(X1%,Y1%-7 TO X1%,Y1%+8 TO X%,Y%+8 TO X%,Y%-7)
  143. 1520  RETURN
  144. 1530  '    BRUSH 9: 3 SHORT BARS
  145. 1540  AREA(X1%-1,Y1%-7 TO X1%+1,Y1%-7 TO X%+1,Y%-7 TO X%-1,Y%-7)
  146. 1550  AREA(X1%-1,Y1% TO X1%+1,Y1% TO X%+1,Y% TO X%-1,Y%)
  147. 1560  AREA(X1%-1,Y1%+7 TO X1%+1,Y1%+7 TO X%+1,Y%+7 TO X%-1,Y%+7)
  148. 1570  RETURN
  149. 1580  '    BRUSH 10: SMALL RANDOM DOTS
  150. 1590  '  Note: Only draws at current position
  151. 1600  AREA(X%-2,Y%+1 TO X%-2,Y%+1 TO X%-2,Y%+1)
  152. 1610  AREA(X%-1,Y%-2 TO X%-1,Y%-2 TO X%-1,Y%-2)
  153. 1620  AREA(X%,Y% TO X%,Y% TO X%,Y%)
  154. 1630  AREA(X%,Y%+2 TO X%,Y%+2 TO X%,Y%+2)
  155. 1640  AREA(X%+2,Y%-1 TO X%+2,Y%-1 TO X%+2,Y%-1)
  156. 1650  AREA(X%+3,Y%+1 TO X%+3,Y%+1 TO X%+3,Y%+1)
  157. 1660  RETURN
  158. 1670  '    BRUSH 11: LARGE RANDOM DOTS
  159. 1680  '  Note: Only draws at current coords,
  160. 1690  AREA(X%-5,Y%-1 TO X%-5,Y%-1 TO X%-5,Y%-1)
  161. 1700  AREA(X%-4,Y%-3 TO X%-4,Y%-3 TO X%-4,Y%-3)
  162. 1710  AREA(X%-3,Y%+1 TO X%-3,Y%+1 TO X%-3,Y%+1)
  163. 1720  AREA(X%-2,Y%-2 TO X%-2,Y%-2 TO X%-2,Y%-2)
  164. 1730  AREA(X%-2,Y%+3 TO X%-2,Y%+3 TO X%-2,Y%+3)
  165. 1740  AREA(X%-1,Y%-4 TO X%-1,Y%-4 TO X%-1,Y%-4)
  166. 1750  AREA(X%-1,Y% TO X%-1,Y% TO X%-1,Y%)
  167. 1760  AREA(X%,Y%+4 TO X%,Y%+4 TO X%,Y%+4)
  168. 1770  AREA(X%+1,Y%-3 TO X%+1,Y%-3 TO X%+1,Y%-3)
  169. 1780  AREA(X%+1,Y%+2 TO X%+1,Y%+2 TO X%+1,Y%+2)
  170. 1790  AREA(X%+2,Y%-1 TO X%+2,Y%-1 TO X%+2,Y%-1)
  171. 1800  AREA(X%+4,Y%-2 TO X%+4,Y%-2 TO X%+4,Y%-2)
  172. 1810  AREA(X%+4,Y%+1 TO X%+4,Y%+1 TO X%+4,Y%+1)
  173. 1820  RETURN
  174. 1830  '
  175. 1840  '    SINGLE LINES
  176. 1850  '
  177. 1860  SSHAPE(0,0;304,189),TPIC%():DRAWMODE 2
  178. 1870  X1%=X%:Y1%=Y%
  179. 1880  X2%=X%:Y2%=Y%
  180. 1890  ASK MOUSE X%,Y%,B%:IF B%=0 THEN 1920
  181. 1900  IF X%=X2% AND Y%=Y2% THEN 1890
  182. 1910  GSHAPE(0,0),TPIC%():DRAW(X1%,Y1% TO X%,Y%):GOTO 1880
  183. 1920  GSHAPE(0,0),TPIC%():DRAWMODE DRWMD
  184. 1930  GOSUB 1090:RETURN
  185. 1940  '
  186. 1950  '    CONNECTED LINES
  187. 1960  '
  188. 1970  IF CONFLG=1 THEN X%=XSAVE:Y%=YSAVE
  189. 1980  GOSUB 1860:XSAVE=X%:YSAVE=Y%
  190. 1990  CONFLG=1:RETURN
  191. 2300  '
  192. 2310  '    FILL AREA
  193. 2320  '
  194. 2330  PAINT(X%,Y%),1:RETURN
  195. 2340  '
  196. 2350  '    TEXT ENTRY
  197. 2360  '
  198. 2370  ASK MOUSE X%,Y%,B%:IF B%>0 THEN 2370
  199. 2380  X1%=X%-6:Y1%=Y%-1:OUTLINE 0:DRAWMODE DRWMD
  200. 2390  SSHAPE(0,0;304,189),TPIC%():S$="":NUMCHAR=0
  201. 2400  PRINT AT(X1%+NUMCHAR*8,Y1%);"_";
  202. 2410  ASK MOUSE X%,Y%,B%
  203. 2420  IF B%>0 THEN GSHAPE(0,0),TPIC%():PRINT AT(X1%,Y1%);S$;:GOTO 2370
  204. 2430  IF Y%<0 THEN 2580
  205. 2440  GET Z$:IF Z$="" THEN 2410
  206. 2450  IF Z$<>CHR$(13) THEN 2460
  207. 2452  GSHAPE(0,0),TPIC%():PRINT AT(X1%,Y1%);S$;
  208. 2454  Y1%=Y1%+8:IF Y1%>186 THEN Y1%=Y1%-180
  209. 2456  GOTO 2390
  210. 2460  IF (Z$=CHR$(8) OR Z$=CHR$(127)) AND NUMCHAR>0 THEN 2550
  211. 2470  IF Z$<>CHR$(155) THEN 2500
  212. 2480  GET Z$:IF Z$="D" AND NUMCHAR>0 THEN 2550
  213. 2490  GOTO 2410
  214. 2500  IF ASC(Z$)<32 OR ASC(Z$)>127 THEN 2410
  215. 2510  IF X1%+NUMCHAR*8>295 THEN 2410
  216. 2520  S$=S$+Z$:NUMCHAR=NUMCHAR+1
  217. 2530  GSHAPE(0,0),TPIC%():PRINT AT(X1%,Y1%);S$;
  218. 2540  GOTO 2400
  219. 2550  NUMCHAR=NUMCHAR-1:S$=LEFT$(S$,NUMCHAR)
  220. 2560  GSHAPE(0,0),TPIC%():PRINT AT(X1%,Y1%);S$;
  221. 2570  GOTO 2400
  222. 2580  GSHAPE(0,0),TPIC%():PRINT AT(X1%,Y1%);S$;
  223. 2590  RETURN
  224. 2600  '
  225. 2610  '    BOX & FILLED BOX
  226. 2620  '
  227. 2630  SSHAPE(0,0;304,189),TPIC%()
  228. 2640  IF TOOL=7 THEN OUTLINE 1:DRAWMODE 2
  229. 2650  X1%=X%:Y1%=Y%
  230. 2660  X2%=X%:Y2%=Y%
  231. 2670  ASK MOUSE X%,Y%,B%:IF B%=0 THEN 2720
  232. 2680  IF X%=X2% AND Y%=Y2% THEN 2670
  233. 2690  GSHAPE(0,0),TPIC%()
  234. 2700  IF TOOL=7 THEN BOX(X1%,Y1%;X%,Y%):GOTO 2660
  235. 2710  BOX(X1%,Y1%;X%,Y%),1:GOTO 2660
  236. 2720  IF TOOL=8 THEN RETURN
  237. 2730  GSHAPE(0,0),TPIC%():OUTLINE 0:DRAWMODE DRWMD
  238. 2740  XS%=X1%:YS%=Y1%:XE%=X%:YE%=Y%
  239. 2750  X%=XS%:Y%=YE%:GOSUB 1100
  240. 2760  X%=XE%:Y1%=YE%:GOSUB 1100
  241. 2770  X1%=XE%:Y%=YS%:GOSUB 1100
  242. 2780  X1%=XS%:Y1%=YS%:GOSUB 1100
  243. 2790  RETURN
  244. 2800  '
  245. 2810  '    OVAL & FILLED OVAL
  246. 2820  '
  247. 2830  SSHAPE(0,0;304,189),TPIC%():DRAWMODE 2
  248. 2840  X1%=X%:Y1%=Y%
  249. 2850  X2%=X%:Y2%=Y%
  250. 2860  ASK MOUSE X%,Y%,B%:IF B%=0 THEN 2910
  251. 2870  IF X%=X2% AND Y%=Y2% THEN 2860
  252. 2880  GSHAPE(0,0),TPIC%()
  253. 2890  Y=ABS(Y1%-Y%):X=ABS(X1%-X%):IF X=0 THEN X=.0001
  254. 2900  CIRCLE(X1%,Y1%),X,Y/X:GOTO 2850
  255. 2910  HR=ABS(X%-X1%):VR=ABS(Y%-Y1%)
  256. 2920  GSHAPE(0,0),TPIC%():DRAWMODE DRWMD
  257. 2930  FOR N=0 TO 35
  258. 2940  CIR%(N*2)=XOFF(N)*HR+X1%
  259. 2950  CIR%(N*2+1)=YOFF(N)*VR+Y1%
  260. 2960  NEXT
  261. 2970  IF TOOL=10 THEN MAT AREA 36,CIR%():RETURN
  262. 2980  FOR N=0 TO 68 STEP 2
  263. 2990  X1%=CIR%(N):Y1%=CIR%(N+1):X%=CIR%(N+2):Y%=CIR%(N+3)
  264. 3000  GOSUB 1100:NEXT
  265. 3010  X1%=CIR%(70):Y1%=CIR%(71):X%=CIR%(0):Y%=CIR%(1)
  266. 3020  GOSUB 1100:RETURN
  267. 3030  '
  268. 3040  '    AUSTRALIA & FILLED AUSTRALIA
  269. 3050  '
  270. 3060  SSHAPE(0,0;304,189),TPIC%():BUTFLG=1:DRAWMODE 2
  271. 3070  PTS%(0)=X%:PTS%(1)=Y%:NUMPTS=0:TLR=2
  272. 3080  X2%=X%:Y2%=Y%
  273. 3090  ASK MOUSE X%,Y%,B%:IF B%=0 AND BUTFLG=1 THEN 3170
  274. 3100  IF B%=0 THEN 3090
  275. 3110  IF X%=X2% AND Y%=Y2% THEN 3090
  276. 3120  GSHAPE(0,0),TPIC%():BUTFLG=1:IF NUMPTS=0 THEN 3160
  277. 3130  FOR N=0 TO NUMPTS-1
  278. 3140  DRAW(PTS%(N*2),PTS%(N*2+1) TO PTS%(N*2+2),PTS%(N*2+3))
  279. 3150  NEXT
  280. 3160  DRAW(PTS%(NUMPTS*2),PTS%(NUMPTS*2+1) TO X%,Y%):GOTO 3080
  281. 3170  BUTFLG=0:NUMPTS=NUMPTS+1:IF NUMPTS>31 THEN NUMPTS=31:GOTO 3210
  282. 3180  PTS%(NUMPTS*2)=X%:PTS%(NUMPTS*2+1)=Y%
  283. 3190  IF ABS(X%-PTS%(0))>TLR THEN 3080
  284. 3200  IF ABS(Y%-PTS%(1))>TLR THEN 3080
  285. 3210  GSHAPE(0,0),TPIC%():DRAWMODE DRWMD
  286. 3220  IF NUMPTS<3 THEN RETURN
  287. 3230  IF TOOL=12 THEN MAT AREA NUMPTS,PTS%():RETURN
  288. 3240  FOR N=0 TO NUMPTS-1
  289. 3250  X1%=PTS%(N*2):Y1%=PTS%(N*2+1)
  290. 3260  X%=PTS%(N*2+2):Y%=PTS%(N*2+3)
  291. 3270  GOSUB 1100:NEXT
  292. 3280  X1%=PTS%(NUMPTS*2):Y1%=PTS%(NUMPTS*2+1)
  293. 3290  X%=PTS%(0):Y%=PTS%(1)
  294. 3300  GOSUB 1100:RETURN
  295. 4000  '
  296. 4010  '    +---------------------+
  297. 4020  '    |    EDITING TOOLS    |
  298. 4030  '    +---------------------+
  299. 4040  '
  300. 4050  '    DRAW AN EDIT FRAME
  301. 4060  '
  302. 4070  IF X%<0 THEN X%=0
  303. 4080  IF X%>302 THEN X%=302
  304. 4090  IF Y%<0 THEN Y%=0
  305. 4100  IF Y%>186 THEN Y%=186
  306. 4110  LINEPAT LINPAT%(1):EDSTX%=X%:EDSTY%=Y%
  307. 4120  DRAWMODE 2:OUTLINE 1
  308. 4130  X1%=X%:Y1%=Y%:BOX(EDSTX%,EDSTY%;X1%,Y1%)
  309. 4140  ASK MOUSE X%,Y%,B%:IF B%=0 THEN 4210
  310. 4150  IF X%<0 THEN X%=0
  311. 4160  IF X%>302 THEN X%=302
  312. 4170  IF Y%<0 THEN Y%=0
  313. 4180  IF Y%>186 THEN Y%=186
  314. 4190  IF X1%=X% AND Y1%=Y% THEN 4140
  315. 4200  BOX(EDSTX%,EDSTY%;X1%,Y1%):GOTO 4130
  316. 4210  BOX(EDSTX%,EDSTY%;X1%,Y1%):DRAWMODE DRWMD
  317. 4220  OUTLINE 0:LINEPAT LINPAT%(0)
  318. 4230  EDENDX%=X1%:EDENDY%=Y1%
  319. 4240  RETURN
  320. 4250  '
  321. 4260  '    COPY OR CUT AN AREA
  322. 4270  '
  323. 4280  GOSUB 4050 'specify area
  324. 4290  SSHAPE(EDSTX%,EDSTY%;EDENDX%+1,EDENDY%+1),EDITBUF%()
  325. 4300  IF TOOL<>14 THEN CLPFLG=1:RETURN
  326. 4310  OUTLINE 0:PENA 0
  327. 4320  BOX(EDSTX%,EDSTY%;EDENDX%,EDENDY%),1
  328. 4330  PENA FCLR:CLPFLG=1:RETURN
  329. 4340  '
  330. 4350  '    PASTE OR USE AS BRUSH
  331. 4360  '
  332. 4370  IF CLPFLG=0 THEN RETURN
  333. 4380  SSHAPE(0,0;304,189),TPIC%()
  334. 4390  X1%=X%:Y1%=Y%:GSHAPE(X%,Y%),EDITBUF%()
  335. 4400  ASK MOUSE X%,Y%,B%:IF B%=0 THEN RETURN
  336. 4410  IF X%=X1% AND Y%=Y1% THEN 4400
  337. 4420  IF TOOL=15 THEN GSHAPE(0,0),TPIC%()
  338. 4430  GOTO 4390
  339. 4670  '
  340. 4680  '    INVERT COLORS
  341. 4690  '
  342. 4700  GOSUB 4050 'specify area
  343. 4710  IF EDSTX%=EDENDX% AND EDSTY%=EDENDY% THEN RETURN
  344. 4720  DRAWMODE 2:BOX(EDSTX%,EDSTY%;EDENDX%,EDENDY%),1
  345. 4730  DRAWMODE DRWMD:RETURN
  346. 4740  '
  347. 4750  '    FLIP HORIZ
  348. 4760  '
  349. 4770  GOSUB 4050
  350. 4780  IF EDSTX%=EDENDX% AND EDSTY%=EDENDY% THEN RETURN
  351. 4790  IF EDSTX%>EDENDX% THEN SWAP EDSTX%,EDENDX%
  352. 4800  T1%=INT((EDENDX%-EDSTX%+1)/2)-1
  353. 4810  IF T1%<0 THEN RETURN
  354. 4820  FOR Y=EDSTY% TO EDENDY%
  355. 4830  FOR N=0 TO T1%
  356. 4840  T2%=PIXEL(EDSTX%+N,Y)
  357. 4850  T3%=PIXEL(EDENDX%-N,Y)
  358. 4860  PENA T2%:DRAW(EDENDX%-N,Y)
  359. 4870  PENA T3%:DRAW(EDSTX%+N,Y)
  360. 4880  NEXT N,Y:PENA FCLR:RETURN
  361. 4890  '
  362. 4900  '    FLIP VERT
  363. 4910  '
  364. 4920  GOSUB 4050
  365. 4930  IF EDSTX%=EDENDX% AND EDSTY%=EDENDY% THEN RETURN
  366. 4940  IF EDSTY%>EDENDY% THEN SWAP EDSTY%,EDENDY%
  367. 4950  T1%=INT((EDENDY%-EDSTY%+1)/2)-1
  368. 4960  IF T1%<0 THEN RETURN
  369. 4970  FOR X=EDSTX% TO EDENDX%
  370. 4980  FOR N=0 TO T1%
  371. 4990  T2%=PIXEL(X,EDSTY%+N)
  372. 5000  T3%=PIXEL(X,EDENDY%-N)
  373. 5010  PENA T2%:DRAW(X,EDENDY%-N)
  374. 5020  PENA T3%:DRAW(X,EDSTY%+N)
  375. 5030  NEXT N,X
  376. 5040  PENA FCLR:RETURN
  377. 5050  '
  378. 5060  '    STRETCH AREA
  379. 5070  '
  380. 5080  GOSUB 4050 'specify original area
  381. 5090  DRAWMODE 2:OUTLINE 1:LINEPAT LINPAT%(1)
  382. 5100  BOX(EDSTX%,EDSTY%;EDENDX%,EDENDY%)
  383. 5110  LINEPAT LINPAT%(0):ASK MOUSE X%,Y%,B%:IF B%=0 THEN 5110
  384. 5120  X1%=X%:Y1%=Y%:BOX(EDSTX%,EDSTY%;X1%,Y1%)
  385. 5130  ASK MOUSE X%,Y%,B%:IF B%=0 THEN 5160
  386. 5140  IF X1%=X% AND Y1%=Y% THEN 5130
  387. 5150  BOX(EDSTX%,EDSTY%;X1%,Y1%):GOTO 5120
  388. 5160  BOX(EDSTX%,EDSTY%;X1%,Y1%):LINEPAT LINPAT%(1)
  389. 5170  BOX(EDSTX%,EDSTY%;EDENDX%,EDENDY%)
  390. 5180  LINEPAT LINPAT%(0):DRAWMODE DRWMD:OUTLINE 0
  391. 5190  'now have both old and new boxes
  392. 5200  X%(0)=EDSTX%:X%(1)=EDENDX%
  393. 5210  X%(2)=EDSTX%:X%(3)=X1%
  394. 5220  Y%(0)=EDSTY%:Y%(1)=EDENDY%
  395. 5230  Y%(2)=EDSTY%:Y%(3)=Y1%
  396. 5240  X%(4)=X%(1)-X%(0):Y%(4)=Y%(1)-Y%(0)
  397. 5250  X%(5)=X%(3)-X%(2):Y%(5)=Y%(3)-Y%(2)
  398. 5260  IF ABS(X%(5))<=ABS(X%(4)) THEN 5290
  399. 5270  SWAP X%(0),X%(1):SWAP X%(2),X%(3)
  400. 5280  X%(4)=X%(4)*(-1):X%(5)=X%(5)*(-1)
  401. 5290  IF ABS(Y%(5))<=ABS(Y%(4)) THEN 5320
  402. 5300  SWAP Y%(0),Y%(1):SWAP Y%(2),Y%(3)
  403. 5310  Y%(4)=Y%(4)*(-1):Y%(5)=Y%(5)*(-1)
  404. 5320  XRATIO=X%(4)/X%(5):YRATIO=Y%(4)/Y%(5)
  405. 5330  'actual modification loop
  406. 5340  FOR N=0 TO X%(5) STEP SGN(X%(5))
  407. 5350  FOR N2=0 TO Y%(5) STEP SGN(Y%(5))
  408. 5360  PENA PIXEL(X%(0)+N*XRATIO,Y%(0)+N2*YRATIO)
  409. 5370  DRAW(X%(2)+N,Y%(2)+N2)
  410. 5380  NEXT N2,N
  411. 5390  RETURN
  412. 5500  '
  413. 5510  '    MAGNIFY AREA
  414. 5520  '
  415. 5530  DRAWMODE 2:LINEPAT LINPAT%(1)
  416. 5540  BOX(X%,Y%;X%+29,Y%+22):XS%=X%:YS%=Y%
  417. 5550  ASK MOUSE X%,Y%,B%:IF B%=0 THEN 5620
  418. 5560  IF X%>274 THEN X%=274
  419. 5570  IF X%<0 THEN X%=0
  420. 5580  IF Y%>165 THEN Y%=165
  421. 5590  IF Y%<0 THEN Y%=0
  422. 5600  IF X%=XS% AND Y%=YS% THEN 5550
  423. 5610  GSHAPE(0,0),TPIC%():GOTO 5540
  424. 5620  '    set up large view
  425. 5630  DRAWMODE 0:LINEPAT LINPAT%(0)
  426. 5640  GSHAPE(0,0),TPIC%():SSHAPE(XS%,YS%;XS%+30,YS%+23),SMLBUF%()
  427. 5650  SCNCLR:GSHAPE(259,22),SMLBUF%()
  428. 5660  PENO 29:OUTLINE 1:BOX(254,159;293,180)
  429. 5670  PENA 1:OUTLINE 0:PRINT AT(258,168);"Quit";AT(258,177);"Zoom"
  430. 5680  FOR Y=0 TO 7:FOR X=0 TO 3:PENA Y*4+X
  431. 5690  BOX(255+X*10,71+Y*10;262+X*10,78+Y*10),1:NEXT X,Y
  432. 5700  FOR Y=0 TO 22:FOR X=0 TO 29:PENA PIXEL(259+X,22+Y)
  433. 5710  BOX(X*8,Y*8;X*8+6,Y*8+6),1:NEXT X,Y
  434. 5720  PENA FCLR:Y=INT(FCLR/4):X=FCLR-Y*4
  435. 5730  OUTLINE 1:BOX(253+X*10,69+Y*10;264+X*10,80+Y*10):OUTLINE 0
  436. 5740  '    loop to modify points
  437. 5750  ASK MOUSE X%,Y%,B%:IF B%=0 THEN 5750
  438. 5760  IF X%>239 THEN 5820
  439. 5770  IF X%<0 THEN X%=0
  440. 5780  IF Y%<0 THEN Y%=0
  441. 5790  IF Y%>183 THEN Y%=183
  442. 5800  X=INT(X%/8):Y=INT(Y%/8):DRAW(259+X,22+Y)
  443. 5810  BOX(X*8,Y*8;X*8+6,Y*8+6),1:GOTO 5750
  444. 5820  '    changing color?
  445. 5830  IF X%<255 OR X%>292 OR Y%<71 OR Y%>148 THEN 5900
  446. 5840  Y=INT(FCLR/4):X=FCLR-Y*4:OUTLINE 1:PENO 0
  447. 5850  BOX(253+X*10,69+Y*10;264+X*10,80+Y*10):PENO 29
  448. 5860  FCLR=INT((X%-255)/10)+INT((Y%-71)/10)*4
  449. 5870  Y=INT(FCLR/4):X=FCLR-Y*4
  450. 5880  BOX(253+X*10,69+Y*10;264+X*10,80+Y*10)
  451. 5890  OUTLINE 0:PENA FCLR:GOTO 5750
  452. 5900  '    quitting?
  453. 5910  IF X%<255 OR X%>292 OR Y%<160 OR Y%>179 THEN 5750
  454. 5920  SSHAPE(259,22;289,45),SMLBUF%()
  455. 5930  GSHAPE(0,0),TPIC%():GSHAPE(XS%,YS%),SMLBUF%():SSHAPE(0,0;304,189),TPIC%()
  456. 5940  OUTLINE 1:GOTO 6450
  457. 6000  '
  458. 6010  '    +-----------------------------+
  459. 6020  '    |    MENU COMMAND ROUTINES    |
  460. 6030  '    +-----------------------------+
  461. 6040  '
  462. 6050  '    ENTRY PREPARATION
  463. 6060  '
  464. 6070  SSHAPE(0,0;304,189),TPIC%()
  465. 6080  FOR N=0 TO 2:RGB N,ACLR%(N,0),ACLR%(N,1),ACLR%(N,2):NEXT
  466. 6090  FOR N=29 TO 31:RGB N,ACLR%(N,0),ACLR%(N,1),ACLR%(N,2):NEXT
  467. 6100  PATTERN 2,PAT0%():DRAWMODE 0:OUTLINE 1
  468. 6110  MENU=(-1):ITEM=(-1)
  469. 6120  CLRFLG=0:RNGFLG=0:CONFLG=0
  470. 6130  PENB 1:PENO 29
  471. 6140  '
  472. 6150  '    CHECK IF ON A MENU TITLE
  473. 6160  '
  474. 6170  ASK MOUSE X%,Y%,B%
  475. 6180  FOR N=0 TO NUMMENU
  476. 6190  IF X%<MTITLFT%(N) OR X%>MTITRGT%(N) THEN 6210
  477. 6200  MENU=N:N=NUMMENU
  478. 6210  NEXT
  479. 6220  IF MENU<0 THEN 6450 'not on a title
  480. 6230  '
  481. 6240  '    DISPLAY MENU, HIGHLIGHT ITEMS
  482. 6250  '    POINTED AT UNTIL SELECTION MADE
  483. 6260  '    OR CURSOR LEAVES MENU BOUNDRIES
  484. 6270  '
  485. 6280  GOSUB 6500  'display menu
  486. 6290  ASK MOUSE X%,Y%,B%
  487. 6300  IF B%>0 AND ITEM>(-1) THEN 8000 'selection made
  488. 6310  IF Y%<0 AND (X%<MTITLFT%(MENU)-1 OR X%>MTITRGT%(MENU)+1) THEN GSHAPE(0,0),TPIC%():GOTO 6450
  489. 6320  IF X%<MENULFT%(MENU) OR X%>MENURGT%(MENU) OR Y%>MENUBOT%(MENU) THEN GSHAPE(0,0),TPIC%():GOTO 6450
  490. 6330  TEMPITEM=(-1):FOR N=0 TO NUMITEM%(MENU)
  491. 6340  IF X%<ITEMLFT%(MENU,N) OR X%>ITEMRGT%(MENU,N) THEN 6370
  492. 6350  IF Y%<ITEMTOP%(MENU,N) OR Y%>ITEMBOT%(MENU,N) THEN 6370
  493. 6360  TEMPITEM=N:N=NUMITEM%(MENU)
  494. 6370  NEXT:IF TEMPITEM=ITEM THEN 6290 'no change
  495. 6380  IF ITEM>(-1) THEN GOSUB 7120 'un-highlight old item
  496. 6390  ITEM=TEMPITEM
  497. 6400  IF ITEM>(-1) THEN GOSUB 7120 'highlight new item
  498. 6410  GOTO 6290
  499. 6420  '
  500. 6430  '    EXIT CLEANUP
  501. 6440  '
  502. 6450  IF Y%<0 THEN 6100 'still on menu bar
  503. 6460  GOSUB 7190 'restore selected pattern
  504. 6470  GSHAPE(0,0),TPIC%():PENA FCLR:IF BCLR>=0 THEN PENB BCLR
  505. 6480  ASK MOUSE X%,Y%,B%:IF B%<>0 THEN 6480
  506. 6490  DRAWMODE DRWMD:OUTLINE 0:RETURN
  507. 6500  '
  508. 6510  '---------MENU DISPLAY ROUTINES---------
  509. 6520  '
  510. 6530  PENA 0:BOX(MENULFT%(MENU),0;MENURGT%(MENU),MENUBOT%(MENU)),1
  511. 6540  ON MENU GOTO 6590,6730,7070,7100
  512. 6550  '
  513. 6560  '    MENU 0: PROJECT
  514. 6570  GSHAPE(MENULFT%(0),0),PROJMENU%():RETURN
  515. 6580  '
  516. 6590  '    MENU 1: TOOLS
  517. 6600  GSHAPE(MENULFT%(1),0),TOOLMENU%()
  518. 6610  GOSUB 6620:GOSUB 6700:RETURN
  519. 6620  'tool indicator
  520. 6630  IF TOOL<13 THEN BOX(15+(TOOL-1)*23,16;34+(TOOL-1)*23,35):GOTO 6660
  521. 6640  IF TOOL<19 THEN BOX(15+(TOOL-13)*46,92;57+(TOOL-13)*46,111):GOTO 6660
  522. 6650  BOX(15+(TOOL-19)*46,115;57+(TOOL-19)*46,134)
  523. 6660  IF CLPFLG<>0 THEN RETURN
  524. 6670  OUTLINE 0:PENA 1:PATTERN 4,PAT6%()
  525. 6680  BOX(108,93;148,110),1:BOX(154,93;194,110),1:BOX(200,93;240,110),1
  526. 6690  OUTLINE 1:PATTERN 2,PAT0%():RETURN
  527. 6700  'brush indicator
  528. 6710  BOX(15+BRUSH*23,54;34+BRUSH*23,73):RETURN
  529. 6720  '
  530. 6730  '    MENU 1: COLOR
  531. 6740  GSHAPE(MENULFT%(2),0),CLR1MENU%()
  532. 6750  GSHAPE(MENULFT%(2)+74,16),CLR2MENU%()
  533. 6760  GSHAPE(MENULFT%(2)+202,16),CLR2MENU%()
  534. 6770  GOSUB 6790:GOSUB 6820:GOSUB 6880:GOSUB 6920
  535. 6780  GOSUB 6990:GOSUB 7040:RETURN
  536. 6790  'foreground color indicator
  537. 6800  Y=INT(FCLR/8):X=FCLR-Y*8
  538. 6810  BOX(81+X*9,14+Y*8;91+X*9,23+Y*8):RETURN
  539. 6820  'foreground color RGB bars
  540. 6830  OUTLINE 0:PENA 0:BOX(99,52;160,74),1
  541. 6840  PENA 29:PATTERN 2,PAT11%()
  542. 6850  ASK RGB FCLR,R%,G%,B%:BOX(99,52;99+R%*4,57),1
  543. 6860  BOX(99,60;99+G%*4,65),1:BOX(99,68;99+B%*4,73),1
  544. 6870  OUTLINE 1:PATTERN 2,PAT0%():RETURN
  545. 6880  'background color indicator
  546. 6890  IF BCLR<0 THEN BOX(281,14;290,47):RETURN
  547. 6900  Y=INT(BCLR/8):X=BCLR-Y*8
  548. 6910  BOX(209+X*9,14+Y*8;219+X*9,23+Y*8):RETURN
  549. 6920  'background color RGB bars
  550. 6930  OUTLINE 0:PENA 0:BOX(227,52;289,74),1
  551. 6940  PENA 29:PATTERN 2,PAT11%()
  552. 6950  IF BCLR<0 THEN PRINT AT(226,65);"TRNSPRNT":GOTO 6980
  553. 6960  ASK RGB BCLR,R%,G%,B%:BOX(227,52;227+R%*4,57),1
  554. 6970  BOX(227,60;227+G%*4,65),1:BOX(227,68;227+B%*4,73),1
  555. 6980  OUTLINE 1:PATTERN 2,PAT0%():RETURN
  556. 6990  'combined colors and pattern
  557. 7000  PENA 0:OUTLINE 0:BOX(173,36;198,59),1
  558. 7010  DRAWMODE DRWMD:GOSUB 7190:PENA FCLR:IF BCLR>=0 THEN PENB BCLR
  559. 7020  BOX(173,36;198,59),1:DRAWMODE 0:PENB 1
  560. 7030  OUTLINE 1:PATTERN 2,PAT0%():RETURN
  561. 7040  'pattern indicator
  562. 7050  BOX(92+PAT*18,87;109+PAT*18,105):RETURN
  563. 7060  '
  564. 7070  '    MENU 3: EXTRAS
  565. 7080  GSHAPE(MENULFT%(3),0),EXTRMENU%():RETURN
  566. 7090  '
  567. 7100  '    MENU 4: UNDO
  568. 7110  GSHAPE(MENULFT%(4),0),UNDOMENU%():RETURN
  569. 7120  '
  570. 7130  '------HIGHLIGHT/UNHIGHLIGHT ITEM-------
  571. 7140  '
  572. 7150  IF ITEMHIGH%(MENU,ITEM)=0 THEN 7180
  573. 7160  DRAWMODE 2:OUTLINE 0
  574. 7170  BOX(ITEMLFT%(MENU,ITEM),ITEMTOP%(MENU,ITEM)-1;ITEMRGT%(MENU,ITEM),ITEMBOT%(MENU,ITEM)+1),1
  575. 7180  DRAWMODE 0:RETURN
  576. 7190  '
  577. 7200  '------SET TO USER'S FILL PATTERN-------
  578. 7210  '
  579. 7220  ON PAT GOTO 7240,7250,7260,7270,7280,7290,7300,7310,7320,7330
  580. 7230  PATTERN 2,PAT0%():GOTO 7350
  581. 7240  PATTERN 4,PAT1%():GOTO 7350
  582. 7250  PATTERN 2,PAT2%():GOTO 7350
  583. 7260  PATTERN 2,PAT3%():GOTO 7350
  584. 7270  PATTERN 2,PAT4%():GOTO 7350
  585. 7280  PATTERN 4,PAT5%():GOTO 7350
  586. 7290  PATTERN 4,PAT6%():GOTO 7350
  587. 7300  PATTERN 4,PAT7%():GOTO 7350
  588. 7310  PATTERN 16,PAT8%():GOTO 7350
  589. 7320  PATTERN 16,PAT9%():GOTO 7350
  590. 7330  PATTERN 16,PAT10%():GOTO 7350
  591. 7350  RETURN
  592. 8000  '
  593. 8010  '    +----------------------------+
  594. 8020  '    |   CARRY OUT MENU COMMAND   |
  595. 8030  '    +----------------------------+
  596. 8040  '
  597. 8050  ON MENU GOTO 8540,8780,9900,10070
  598. 8060  '
  599. 8070  '    MENU 0: PROJECT
  600. 8080  '
  601. 8090  ON ITEM GOTO 8120,8260,8290,8480,8520
  602. 8100  '    NEW
  603. 8110  PROJNAME$="":GOTO 8480
  604. 8120  '    OPEN
  605. 8130  FT=1:FILACT$="Load"
  606. 8140  GOSUB 12800:GOSUB 11350
  607. 8150  IF ERRFLG<>0 OR S$="" THEN 8250
  608. 8160  PROJNAME$=S$
  609. 8170  N$=DISK$+PROJNAME$+SUFF$(FT)
  610. 8180  'future error handling
  611. 8190  BLOAD N$,VARPTR(TPIC%(0))
  612. 8200  'future error handling
  613. 8210  V=TPIC%(8981):IF V=0 THEN 8250
  614. 8220  FOR N=0 TO 31
  615. 8230  RGB N,TPIC%(8982+N*3),TPIC%(8983+N*3),TPIC%(8984+N*3)
  616. 8240  NEXT
  617. 8250  GOTO 6450
  618. 8260  '    SAVE
  619. 8270  IF PROJNAME$="" THEN 8290
  620. 8280  GSHAPE(0,0),TPIC%():GOTO 8420
  621. 8290  '    SAVE AS...
  622. 8300  FT=1:FILACT$="Save"
  623. 8310  GOSUB 12800:GOSUB 11350
  624. 8320  IF ERRFLG<>0 OR S$="" THEN 8460
  625. 8330  IF DSKBLK%>73 THEN 8380
  626. 8340  PENA 29:DRAWMODE 1
  627. 8350  PRINT AT(64,99);"*NOT ENOUGH ROOM ON DISK!*"
  628. 8360  ASK MOUSE X%,Y%,B%:IF B%=0 THEN 8360
  629. 8370  DRAWMODE 0:GOTO 8460
  630. 8380  PROJNAME$=S$
  631. 8390  FOR N=0 TO 31
  632. 8400  ASK RGB N,TPIC%(8982+N*3),TPIC%(8983+N*3),TPIC%(8984+N*3)
  633. 8410  NEXT:TPIC%(8981)=1 'version number
  634. 8420  'future error handling
  635. 8430  N$=DISK$+PROJNAME$+SUFF$(FT)
  636. 8440  BSAVE N$,VARPTR(TPIC%(0)),36400
  637. 8450  'future error handling
  638. 8460  GOTO 6450
  639. 8480  '    CLEAR
  640. 8490  PENA 0:OUTLINE 0:BOX(0,0;304,189),1
  641. 8500  OUTLINE 1:SSHAPE(0,0;304,189),TPIC%()
  642. 8510  GOTO 6450
  643. 8520  '    QUIT
  644. 8530  QUIT=(-1):GOTO 6450
  645. 8540  '
  646. 8550  '    MENU 1: TOOLS
  647. 8560  '
  648. 8570  ON ITEM GOTO 8610,8640
  649. 8580  '    SELECT DRAWING TOOL
  650. 8590  PENO 1:GOSUB 6620:TOOL=INT((X%-14)/23)+1
  651. 8600  PENO 29:GOSUB 6620:GOTO 6310
  652. 8610  '    SELECT BRUSH
  653. 8620  PENO 1:GOSUB 6700:BRUSH=INT((X%-14)/23)
  654. 8630  PENO 29:GOSUB 6700:GOTO 6310
  655. 8640  '    SELECT EDITING TOOL
  656. 8642  PENO 1:GOSUB 6620:PENO 29
  657. 8644  T1%=INT((X%-14)/46)+INT((Y%-93)/23)*6+13
  658. 8646  IF CLPFLG=0 AND T1%>14 AND T1%<18 THEN GOSUB 6620:GOTO 6310
  659. 8648  IF T1%=23 THEN GOSUB 6620:GOTO 6310
  660. 8650  IF T1%=17 THEN 8660
  661. 8652  IF T1%=18 THEN 8700
  662. 8654  TOOL=T1%:GOSUB 6620:GOTO 6310
  663. 8660  '    save clipping to disk
  664. 8662  FT=3:FILACT$="Save"
  665. 8664  GOSUB 12800:GOSUB 11350
  666. 8666  IF ERRFLG<>0 OR S$="" THEN 8692
  667. 8668  N$=DISK$+S$+SUFF$(FT)
  668. 8670  ADD=VARPTR(EDITBUF%(0))
  669. 8672  T%(0)=PEEK_W(ADD+2):T%(1)=PEEK_W(ADD+4)
  670. 8674  T%(2)=(INT((T%(0)+15)/16)*T%(1)*5+4)*2
  671. 8676  IF DSKBLK%>INT(T%(2)/512)+3 THEN 8686
  672. 8678  PENA 29:PENB 1:DRAWMODE 1
  673. 8680  PRINT AT(64,99);"*NOT ENOUGH ROOM ON DISK!*"
  674. 8682  ASK MOUSE X%,Y%,B%:IF B%=0 THEN 8682
  675. 8684  DRAWMODE 0:GOTO 8692
  676. 8686  'future error handling
  677. 8688  BSAVE N$,ADD,T%(2)
  678. 8690  'future error handling
  679. 8692  GSHAPE(0,0),TPIC%():GOSUB 6500:GOTO 6310
  680. 8700  'loading clipping from disk, then use paste tool.
  681. 8710  FT=3:FILACT$="Load"
  682. 8720  GOSUB 12800:GOSUB 11350
  683. 8730  IF ERRFLG<>0 OR S$="" THEN 8770
  684. 8740  N$=DISK$+S$+SUFF$(FT)
  685. 8742  'future error handling
  686. 8750  BLOAD N$,VARPTR(EDITBUF%(0))
  687. 8752  'future error handling
  688. 8760  CLPFLG=1:TOOL=15
  689. 8770  GSHAPE(0,0),TPIC%():GOSUB 6500:GOTO 6310
  690. 8780  '
  691. 8790  '    MENU 2: COLOR
  692. 8800  '
  693. 8810  ON ITEM+1 GOTO 8870,9040,9260,9300,9340,9510,9620,9690,9770,9770,9770,9820,9820,9820,9880
  694. 8820  GOTO 6310
  695. 8830  '    SAVE CURRENT COLORS
  696. 8840  FOR N=0 TO 31
  697. 8850  ASK RGB N,TCLR%(N,0),TCLR%(N,1),TCLR%(N,2)
  698. 8860  NEXT:RETURN
  699. 8870  '    COPY COLOR ROUTINES
  700. 8880  GOSUB 7120:PENA 0:DRAWMODE 1
  701. 8890  PRINT AT(19,27);"from?":GOSUB 7120
  702. 8900  IF RNGFLG>0 THEN RNGFLG=0:DRAWMODE 1:PRINT AT(19,35);"Range"
  703. 8910  DRAWMODE 0:CLRFLG=1:GOTO 6310
  704. 8920  'remember 'from' color
  705. 8930  IF C<0 THEN 6310
  706. 8940  STCLR=C:PENA 0:DRAWMODE 1:PRINT AT(19,27);"to?  "
  707. 8950  DRAWMODE 0:CLRFLG=2:GOSUB 11170:GOTO 6310
  708. 8960  'carry out copy
  709. 8970  IF C<0 THEN 6310
  710. 8980  ENDCLR=C:PENA 0:DRAWMODE 1:PRINT AT(19,27);"Copy "
  711. 8990  DRAWMODE 0:CLRFLG=0:GOSUB 8830
  712. 9000  ASK RGB STCLR,R%,G%,B%:RGB ENDCLR,R%,G%,B%
  713. 9010  IF ENDCLR=FCLR THEN GOSUB 6820
  714. 9020  IF ENDCLR=BCLR THEN GOSUB 6920
  715. 9030  GOSUB 11170:GOTO 6310
  716. 9040  '    MAKE COLOR RANGE ROUTINES
  717. 9050  GOSUB 7120:PENA 0:DRAWMODE 1
  718. 9060  PRINT AT(19,35);"from?":GOSUB 7120
  719. 9070  IF CLRFLG>0 THEN CLRFLG=0:DRAWMODE 1:PRINT AT(19,27);"Copy "
  720. 9080  DRAWMODE 0:RNGFLG=1:GOTO 6310
  721. 9090  'remember 'from' color
  722. 9100  IF C<0 THEN 6310
  723. 9110  STCLR=C:PENA 0:DRAWMODE 1:PRINT AT(19,35);"to?  "
  724. 9120  DRAWMODE 0:RNGFLG=2:GOSUB 11170:GOTO 6310
  725. 9130  'create range
  726. 9140  IF C<0 THEN 6310
  727. 9150  ENDCLR=C:PENA 0:DRAWMODE 1:PRINT AT(19,35);"Range"
  728. 9160  DRAWMODE 0:RNGFLG=0:GOSUB 8830
  729. 9170  IF ENDCLR<STCLR THEN SWAP ENDCLR,STCLR
  730. 9180  STP=ENDCLR-STCLR:IF STP<2 THEN 6310
  731. 9190  ASK RGB STCLR,SR%,SG%,SB%
  732. 9200  ASK RGB ENDCLR,ER%,EG%,EB%
  733. 9210  RINC=(ER%-SR%)/STP:GINC=(EG%-SG%)/STP:BINC=(EB%-SB%)/STP
  734. 9220  FOR N=1 TO STP-1
  735. 9230  R%=SR%+RINC*N:G%=SG%+GINC*N:B%=SB%+BINC*N
  736. 9240  RGB STCLR+N,R%,G%,B%:NEXT
  737. 9250  GOSUB 6820:GOSUB 6920:GOSUB 11170:GOTO 6310
  738. 9260  '    UNDO COLOR CHANGE
  739. 9270  FOR N=0 TO 31
  740. 9280  RGB N,TCLR%(N,0),TCLR%(N,1),TCLR%(N,2)
  741. 9290  NEXT:GOSUB 6820:GOSUB 6920:GOTO 6310
  742. 9300  '    SET NORMAL COLORS
  743. 9310  FOR N=0 TO 31
  744. 9320  RGB N,ACLR%(N,0),ACLR%(N,1),ACLR%(N,2)
  745. 9330  NEXT:GOSUB 6820:GOSUB 6920:GOTO 6310
  746. 9340  '    SAVE PALETTE
  747. 9350  FT=2:FILACT$="Save"
  748. 9360  GOSUB 12800:GOSUB 11350
  749. 9370  IF ERRFLG<>0 OR S$="" THEN 9490
  750. 9380  IF DSKBLK%>3 THEN 9430
  751. 9390  PENA 29:DRAWMODE 1
  752. 9400  PRINT AT(64,99);"*NOT ENOUGH ROOM ON DISK!*"
  753. 9410  ASK MOUSE X%,Y%,B%:IF B%=0 THEN 9410
  754. 9420  DRAWMODE 0:GOTO 9490
  755. 9430  FOR N=0 TO 31
  756. 9440  ASK RGB N,CCLR%(N*3),CCLR%(N*3+1),CCLR%(N*3+2)
  757. 9450  NEXT:N$=DISK$+S$+SUFF$(FT)
  758. 9460  'future error handling
  759. 9470  BSAVE N$,VARPTR(CCLR%(0)),384
  760. 9480  'future error handling
  761. 9490  GOTO 6450
  762. 9510  '    LOAD PALETTE
  763. 9520  FT=2:FILACT$="Load"
  764. 9530  GOSUB 12800:GOSUB 11350
  765. 9540  IF ERRFLG<>0 OR S$="" THEN 9610
  766. 9550  N$=DISK$+S$+SUFF$(FT):GOSUB 8830
  767. 9560  'future error handling
  768. 9570  BLOAD N$,VARPTR(CCLR%(0))
  769. 9580  'future error handling
  770. 9590  FOR N=0 TO 31
  771. 9600  RGB N,CCLR%(N*3),CCLR%(N*3+1),CCLR%(N*3+2):NEXT
  772. 9610  GOTO 6450
  773. 9620  '    SET FOREGROUND COLOR
  774. 9630  C=INT((X%-81)/9)+INT((Y%-14)/8)*8
  775. 9640  ON CLRFLG GOTO 8920,8960
  776. 9650  ON RNGFLG GOTO 9090,9130
  777. 9660  PENO 0:GOSUB 6790:PENO 29
  778. 9670  FCLR=C:GOSUB 6790:GOSUB 6820:GOSUB 6990
  779. 9680  GOTO 6310
  780. 9690  '    SET BACKGROUND COLOR
  781. 9700  IF X%>280 THEN C=(-1):DRWMD=0:GOTO 9720
  782. 9710  C=INT((X%-209)/9)+INT((Y%-14)/8)*8:DRWMD=1
  783. 9720  ON CLRFLG GOTO 8920,8960
  784. 9730  ON RNGFLG GOTO 9090,9130
  785. 9740  PENO 0:GOSUB 6880:PENO 29
  786. 9750  BCLR=C:GOSUB 6880:GOSUB 6920:GOSUB 6990
  787. 9760  GOTO 6310
  788. 9770  '    MODIFY FOREGROUND RGB
  789. 9780  GOSUB 8830:ASK RGB FCLR,T%(0),T%(1),T%(2)
  790. 9790  T%(ITEM-8)=INT((X%-95)/4):RGB FCLR,T%(0),T%(1),T%(2)
  791. 9800  GOSUB 6820:IF BCLR=FCLR THEN GOSUB 6920
  792. 9810  GOTO 6310
  793. 9820  '    MODIFY BACKGROUND RGB
  794. 9830  IF BCLR<0 THEN 6310
  795. 9840  GOSUB 8830:ASK RGB BCLR,T%(0),T%(1),T%(2)
  796. 9850  T%(ITEM-11)=INT((X%-223)/4):RGB BCLR,T%(0),T%(1),T%(2)
  797. 9860  GOSUB 6920:IF FCLR=BCLR THEN GOSUB 6820
  798. 9870  GOTO 6310
  799. 9880  '    SELECT PATTERN
  800. 9890  PENO 0:GOSUB 7040:PAT=INT((X%-92)/18):PENO 29:GOSUB 7040:GOSUB 6990:GOTO 6310
  801. 9900  '
  802. 9910  '    MENU 3: EXTRAS
  803. 9920  '
  804. 9930  ON ITEM+1 GOTO 9950,10030
  805. 9940  GOTO 6310
  806. 9950  '    INFORMATION
  807. 9960  SCNCLR:GRAPHIC 0:DRAWMODE 1:PENA 1
  808. 9970  PRINT AT(1,1);"":GOSUB 100:PRINT:GOSUB 360:PRINT
  809. 9980  PRINT AT(1,23);"(Press a key or button to continue) ";
  810. 9990  GET Z$:IF Z$<>"" THEN 10010
  811. 10000 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 9990
  812. 10010 GRAPHIC 1:DRAWMODE 0
  813. 10020 GOTO 6450
  814. 10030 '    COPYING APAINT
  815. 10040 SCNCLR:GRAPHIC 0:DRAWMODE 1:PENA 1
  816. 10050 PRINT AT(1,1);"":GOSUB 160:PRINT:GOSUB 220:PRINT
  817. 10060 GOTO 9980
  818. 10070 '
  819. 10080 '    MENU 4: UNDO
  820. 10090 '
  821. 10100 GSHAPE(0,0),UNDOBUF%():SSHAPE(0,0;303,189),TPIC%()
  822. 10110 GOTO 6450
  823. 11000 '
  824. 11010 '    +------------------------------+
  825. 11020 '    |   CLEAN UP BEFORE QUITTING   |
  826. 11030 '    +------------------------------+
  827. 11040 '
  828. 11050 FOR N=0 TO 31
  829. 11060 RGB N,STDCLR%(N,0),STDCLR%(N,1),STDCLR%(N,2)
  830. 11070 NEXT
  831. 11080 CLOSE #1
  832. 11090 GRAPHIC 0
  833. 11100 '
  834. 11110 '    +----------------------+
  835. 11120 '    |    KEYBOARD CHECK    |
  836. 11130 '    +----------------------+
  837. 11140 '
  838. 11150 IF Z$=CHR$(27) THEN QUIT=(-1)
  839. 11160 RETURN
  840. 11170 '
  841. 11172 '    +-------------------------------+
  842. 11180 '    |    WAIT FOR BUTTON RELEASE    |
  843. 11182 '    +-------------------------------+
  844. 11184 '
  845. 11190 WHILE B%<>0:ASK MOUSE X%,Y%,B%:WEND:RETURN
  846. 11300 '
  847. 11310 '    +------------------------------+
  848. 11320 '    |    FILE HANDLING ROUTINES    |
  849. 11330 '    +------------------------------+
  850. 11340 '
  851. 11350 '    FILE I/O SELECTION
  852. 11360 '
  853. 11370 DRAWMODE 1:PENA 29:PENB 1:OUTLINE 0
  854. 11380 NUMCHAR=0:MAXCHAR=25:S$=""
  855. 11390 CURTIT=0:ERRFLG=0
  856. 11400 IF FILACT$="Load" THEN GOSUB 12400:GOTO 11420
  857. 11410 PRINT AT(64+NUMCHAR*8,99);"_";
  858. 11420 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 11790
  859. 11430 '    clicked on disk name?
  860. 11440 IF X%<16 OR X%>287 OR Y%<56 OR Y%>63 THEN 11600
  861. 11450 IF FT=0 THEN 11790
  862. 11460 T%(0)=FT:FT=0:N$=FILACT$:FILACT$="Load"
  863. 11470 PENA 1:BOX(64,56;287,63),1:BOX(64,77;264,117),1:PENA 0
  864. 11480 PRINT AT(16,99);"Disk:":PENA 29
  865. 11490 PRINT AT(64,99);"--Checking disks online--"
  866. 11500 GOSUB 12600:GOSUB 11350 'get info & select a disk
  867. 11510 IF ERRFLG<>0 THEN 11500 'must select something!
  868. 11520 DISK$=S$:DSKBLK%=DSKBLK%(CURTIT)
  869. 11530 FT=T%(0):FILACT$=N$:DRAWMODE 1
  870. 11540 PENA 0:PRINT AT(16,99);FILACT$;AT(64,62);DISK$
  871. 11550 PENA 1:BOX(64,77;264,117),1:PENA 29
  872. 11560 IF FILACT$<>"Load" THEN 11590
  873. 11570 PRINT AT(64,99);"----Reading Directory----"
  874. 11580 GOSUB 12200:PRINT AT(64,99);STRING$(25," ")
  875. 11590 GOTO 11350
  876. 11600 '    clicked on a scroll button?
  877. 11610 IF X%<277 OR X%>287 OR FILACT$<>"Load" THEN 11680
  878. 11620 IF Y%<84 OR Y%>94 THEN 11650
  879. 11630 CURTIT=CURTIT-1:IF CURTIT<0 THEN CURTIT=0
  880. 11640 SLEEP 10^6*.2:GOTO 11400
  881. 11650 IF Y%<100 OR Y%>110 THEN 11790
  882. 11660 CURTIT=CURTIT+1:IF CURTIT>NUMNAME%(FT) THEN CURTIT=NUMNAME%(FT)
  883. 11670 SLEEP 10^6*.2:GOTO 11400
  884. 11680 '    clicked on a file name?
  885. 11690 IF FILACT$<>"Load" THEN 11750
  886. 11700 IF X%<64 OR X%>263 OR Y%<77 OR Y%>116 THEN 11750
  887. 11710 T%(1)=CURTIT+INT((Y%-77)/8)-2
  888. 11720 IF T%(1)<0 THEN T%(1)=0
  889. 11730 IF T%(1)>NUMNAME%(FT) THEN T%(1)=NUMNAME%(FT)
  890. 11740 CURTIT=T%(1):GOTO 11400
  891. 11750 '    clicked on OK or CANCEL button?
  892. 11760 IF Y%<131 OR Y%>142 THEN 11790
  893. 11770 IF X%>59 AND X%<116 THEN ERRFLG=0:GOTO 11960
  894. 11780 IF X%>187 AND X%<244 THEN ERRFLG=1:GOTO 11960
  895. 11790 '    check for keyboard input
  896. 11800 GET Z$:IF Z$="" THEN 11420
  897. 11810 IF Z$=CHR$(13) THEN ERRFLG=0:GOTO 11960
  898. 11820 IF Z$=CHR$(27) THEN ERRFLG=1:GOTO 11960
  899. 11830 IF FILACT$="Load" THEN 11420
  900. 11840 IF (Z$=CHR$(8) OR Z$=CHR$(127)) AND NUMCHAR>0 THEN 11930
  901. 11850 IF Z$<>CHR$(155) THEN 11880
  902. 11860 GET Z$:IF Z$="D" AND NUMCHAR>0 THEN 11930
  903. 11870 GOTO 11420
  904. 11880 IF ASC(Z$)<32 OR ASC(Z$)>126 THEN 11420
  905. 11890 IF NUMCHAR>=MAXCHAR THEN 11420
  906. 11900 IF Z$=" " THEN Z$="."
  907. 11910 PRINT AT(64+NUMCHAR*8,99);Z$;
  908. 11920 S$=S$+Z$:NUMCHAR=NUMCHAR+1:GOTO 11410
  909. 11930 '    erase a character
  910. 11940 PRINT AT(64+NUMCHAR*8,99);" ";
  911. 11950 NUMCHAR=NUMCHAR-1:S$=LEFT$(S$,NUMCHAR):GOTO 11410
  912. 11960 '    clean up and exit
  913. 11970 DRAWMODE DRWMD:PENA FCLR:IF BCLR>(-1) THEN PENB BCLR
  914. 11980 IF FILACT$="Load" THEN S$=NAME$(FT,CURTIT)
  915. 11990 RETURN
  916. 12200 '
  917. 12210 '    READ FILE TITLES
  918. 12220 '
  919. 12230 OPEN "O",#15,DISK$+"TEMPFILE"
  920. 12240 Z$="LIST "+DISK$
  921. 12250 CMD #15:SHELL Z$:CLOSE #15
  922. 12260 FOR N=1 TO 3:NUMNAME%(N)=(-1):NEXT
  923. 12270 OPEN "I",#15,DISK$+"TEMPFILE"
  924. 12280 WHILE NOT(EOF(15)):LINE INPUT #15,Z$
  925. 12290 Z$=LEFT$(Z$,INSTR(Z$," ")-1)
  926. 12300 S$=RIGHT$(Z$,5)
  927. 12310 FOR N=1 TO 3:IF SUFF$(N)<>S$ THEN 12350
  928. 12320 NUMNAME%(N)=NUMNAME%(N)+1
  929. 12330 IF NUMNAME%(N)>30 THEN 12350
  930. 12340 NAME$(N,NUMNAME%(N))=LEFT$(Z$,LEN(Z$)-5)
  931. 12350 NEXT
  932. 12360 WEND
  933. 12370 CLOSE #15:CMD #1
  934. 12380 SCRATCH DISK$+"TEMPFILE"
  935. 12390 RETURN
  936. 12400 '
  937. 12410 '    DISPLAY FILE TITLES
  938. 12420 '
  939. 12430 PENA 1:OUTLINE 0
  940. 12440 BOX(64,77;264,117),1:PENA 29:PENB 1
  941. 12450 IF NUMNAME%(FT)>(-1) THEN 12480
  942. 12460 PRINT AT(64,99);"--No "+FILTYP$(FT)+" on disk--"
  943. 12470 GOTO 12540
  944. 12480 FOR N=(-2) TO 2
  945. 12490 IF N=0 THEN PENA 29 ELSE PENA 0
  946. 12500 IF CURTIT+N<0 THEN 12530
  947. 12510 IF CURTIT+N>NUMNAME%(FT) THEN 12530
  948. 12520 PRINT AT(64,99+N*8);NAME$(FT,CURTIT+N)
  949. 12530 NEXT:PENA 29
  950. 12540 RETURN
  951. 12600 '
  952. 12610 '    GET DISK INFO
  953. 12620 '
  954. 12630 OPEN "O",#15,"DF0:TEMPFILE"
  955. 12640 CMD #15:SHELL "INFO":CLOSE #15
  956. 12650 NUMNAME%(0)=(-1)
  957. 12660 FOR N=0 TO 9:NAME$(0,N)=":"
  958. 12670 DSKBLK%(N)=0:NEXT
  959. 12680 OPEN "I",#15,"DF0:TEMPFILE"
  960. 12690 LINE INPUT #15,Z$ 'throw away 1st blank line
  961. 12700 WHILE NOT(EOF(15))
  962. 12710 LINE INPUT #15,Z$:IF Z$="" THEN 12780
  963. 12720 IF LEFT$(Z$,2)<>"DF" THEN 12770
  964. 12730 NUMNAME%(0)=NUMNAME%(0)+1
  965. 12740 NAME$(0,NUMNAME%(0))=MID$(Z$,48,26)+":"
  966. 12750 DSKBLK%(NUMNAME%(0))=VAL(MID$(Z$,18,8))
  967. 12760 IF NAME$(0,NUMNAME%(0))=":" THEN NUMNAME%(0)=NUMNAME%(0)-1
  968. 12770 WEND
  969. 12780 CLOSE #15:CMD #1:SCRATCH "DF0:TEMPFILE"
  970. 12790 RETURN
  971. 12800 '
  972. 12810 '    DRAW FILE I/O BOX
  973. 12820 '
  974. 12830 PENA 1:PENO 29:OUTLINE 1:PATTERN 2,PAT0%()
  975. 12840 BOX(8,38;296,150),1:BOX(59,130;116,143)
  976. 12850 BOX(187,130;244,143):PENA 0:PENB 1:OUTLINE 0
  977. 12860 DRAW(60,144 TO 117,144 TO 117,131)
  978. 12870 DRAW(188,144 TO 245,144 TO 245,131)
  979. 12880 PRINT AT(80,139);"OK";AT(192,139);"CANCEL"
  980. 12890 DRAW(13,70 TO 290,70):DRAW(13,123 TO 290,123)
  981. 12900 PRINT AT(104,50);FILACT$;" ";FILTYP$(FT)
  982. 12910 PRINT AT(16,62);"Disk: "+DISK$
  983. 12920 PRINT AT(16,99);FILACT$;":"
  984. 12930 IF FILACT$<>"Load" THEN 12990
  985. 12940 OUTLINE 1:BOX(276,83;288,95):BOX(276,99;288,111):OUTLINE 0
  986. 12950 DRAW(277,96 TO 289,96 TO 289,84)
  987. 12960 DRAW(277,112 TO 289,112 TO 289,100)
  988. 12970 BOX(281,90;283,92),1:AREA(282,86 TO 279,89 TO 285,89)
  989. 12980 BOX(281,102;283,104),1:AREA(282,108 TO 279,105 TO 285,105)
  990. 12990 PENA 29:RETURN
  991. 13000 '
  992. 13010 '    DISK ERROR HANDLING
  993. 13020 '
  994. 13022 'Not used at present. Adding ON ERROR traps seems
  995. 13024 'to make ABasiC's/AmigaDOS' error handling even
  996. 13026 'worse than it already is. Therefore, APaint is
  997. 13028 'designed to avoid the more common file errors
  998. 13029 'without using error traps. (I hope!)
  999. 13030 PENA 30:BOX(8,10;295,66),1
  1000. 13040 PENA 0:PRINT AT(88,24);"---DISK ERROR---"
  1001. 13050 IF ERR=53 THEN PRINT AT(56,40);"Couldn't find that file.":GOTO 13100
  1002. 13060 IF ERR=64 THEN PRINT AT(64,40);"Not a proper filename.":GOTO 13100
  1003. 13070 IF STATUS=221 THEN PRINT AT(80,40);"That disk is full.":GOTO 13100
  1004. 13090 PRINT AT(48,40);"A disk error has occurred."
  1005. 13100 PRINT AT(16,56);"(Press a key or button to continue.)"
  1006. 13110 ERRFLG=1
  1007. 13120 GET Z$:IF Z$<>"" THEN 13140
  1008. 13130 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 13120
  1009. 13140 IF ERL>12200 AND ERL<12380 THEN RESUME 12370
  1010. 13150 RESUME NEXT
  1011.