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