home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 2 / FreeSoftwareCollection2pd199x-jp.img / fbasic / paled / basfile / paled.bas < prev   
Encoding:
BASIC Source File  |  1990-06-14  |  24.1 KB  |  728 lines
  1. 10000 '***PALED･V1.02   By Dante  '90.4/19***     
  2. 10010 '設定
  3. 10020 DEFINT A-Z
  4. 10030 CLEAR ,,10000,400000,20000
  5. 10040 LOADM "..\REXFILE\IO.REX",0
  6. 10050 FLGLF=0                         '1:TIFF､2:P25､3:GRP
  7. 10060 FLGSQG=0                        '1:最初にグラデボードを描く
  8. 10070 LTF$="..\TIFFILE\TESTL.TIF"     '最初にロードするTIFファイル
  9. 10080 LPF$="..\PICFILE\TESTL.P25"     '最初にロードするP25ファイル
  10. 10090 LGR$="Q:\DEMO\ROOT\6_05.GRP"    '最初にロードするGRPファイル
  11. 10100 STF$="..\TIFFILE\TESTS.TIF"     'TIFFのセーブネーム
  12. 10110 TLP$="..\TELOP\TESTS.TLP"       'パレット情報のテロップファイル
  13. 10120 PLDIR$="..\PALFILE\"            'パレットファイルのディレクトリ 
  14. 10130 IPFN=0                          'イニシャライズ用PALファイル番号
  15. 10140 BPFN=100                        'セーブ時のオフセット
  16. 10150 CT=0:CB=255                     '文字､背景色
  17. 10160 ICSA=30:ICSB=225                'Ａ色､Ｂ色
  18. 10170 ICS1=2:ICS2=5:ICS3=30:ICS4=225  'グラデボードの4色
  19. 10180 MMH=16                          'クリックorドラッグの判断
  20. 10190 MOUSE 0
  21. 10200 MOUSE 3,0,4:MOUSE 3,1,4         'マウスカウント
  22. 10210 '起動
  23. 10220 DIM R%(255)
  24. 10230 DIM G%(255)
  25. 10240 DIM B%(255)
  26. 10250 DIM PA%(779)
  27. 10260 DIM ST%(255)
  28. 10270 DIM SR%(255)
  29. 10280 DIM SP%(0)
  30. 10290 DIM SRT&(255)
  31. 10300 IOA&=&H440:IOB&=&H442
  32. 10310 LG2#=LOG(2)
  33. 10320 SCREEN@ 2
  34. 10330 VIEW(0,0)-(1023,511)
  35. 10340 WINDOW(0,0)-(1023,511)
  36. 10350 PALETTE
  37. 10360 COLOR 0,%CB:CLS
  38. 10370 GOSUB *GRGO
  39. 10380 PF$=LPF$
  40. 10390 ON FLGLF GOSUB *LDLTF,*LDLPC,*LDLGR
  41. 10400 IF FLGLF<2 THEN PFN=IPFN:GOSUB *SETPF:GOSUB *PFLOAD 
  42. 10410 GOSUB *SETPAL
  43. 10420 GOSUB *EDGO
  44. 10430 ON MOUSE(3) GOSUB *MOUSE
  45. 10440 ON MOUSE(4) GOSUB *GRGO
  46. 10450 ON MOUSE(5) GOSUB *EDGO
  47. 10460 MOUSE(3) ON
  48. 10470 MOUSE(4) ON
  49. 10480 MOUSE(5) ON
  50. 10490 ON KEY(1) GOSUB *SETINIT
  51. 10500 KEY(1) ON
  52. 10510 ON ERROR GOTO 0
  53. 10520 '準備
  54. 10530 LINE(  2,  2)-(381,477),PSET,%CT,B
  55. 10540 LINE(  3,  3)-(380,476),PSET,%CT,B
  56. 10550 LINE(191,  2)-(192,477),PSET,%CT,B
  57. 10560 LINE(  2,191)-(381,191),PSET,%CT
  58. 10570 LINE(  2,379)-(381,380),PSET,%CT,B
  59. 10580 GOSUB *INITVAR
  60. 10590 GOSUB *BLOCK1
  61. 10600 GOSUB *BLOCK2
  62. 10610 GOSUB *BLOCK3
  63. 10620 GOSUB *BLOCK5
  64. 10630 GOSUB *BLOCK6
  65. 10640 GOSUB *BLOCK4
  66. 10650 MOUSE 1,100,100,1
  67. 10660 WHILE 0=0
  68. 10670 WEND
  69. 10680 'マウスルーチン
  70. 10690 *GRGO
  71. 10700  CALLM &H0000,IOA&,17
  72. 10710  CALLM &H0000,IOB&,48
  73. 10720  CALLM &H0000,IOA&,21
  74. 10730  CALLM &H0000,IOB&,48
  75. 10740 RETURN
  76. 10750 *EDGO
  77. 10760  CALLM &H0000,IOA&,17
  78. 10770  CALLM &H0000,IOB&,0
  79. 10780  CALLM &H0000,IOA&,21
  80. 10790  CALLM &H0000,IOB&,0
  81. 10800 RETURN
  82. 10810 *MOUSE
  83. 10820  MX0=MOUSE(4,0):MY0=MOUSE(5,0)
  84. 10830  MX=MOUSE(7,0):MY=MOUSE(8,0)
  85. 10840  MH&=(MX-MX0)^2+(MY-MY0)^2
  86. 10850  IF MH&<MMH THEN GOSUB *CLICK ELSE GOSUB *DRAG
  87. 10860 RETURN
  88. 10870 *CLICK
  89. 10880  IF (  8<MX)AND(MX<185)AND(  8<MY)AND(MY<185) THEN GOTO *MCL1
  90. 10890  IF (198<MX)AND(MX<375)AND(  8<MY)AND(MY<185) THEN GOTO *MCL2
  91. 10900  IF ( 61<MX)AND(MX<182)AND(196<MY)AND(MY<373) THEN GOTO *MCL3
  92. 10910  IF (200<MX)AND(MX<372)AND(199<MY)AND(MY<371) THEN GOTO *MCL4
  93. 10920  IF (  2<MX)AND(MX<191)AND(443<MY)AND(MY<476) THEN GOTO *MCL5
  94. 10930  IF ( 61<MX)AND(MX<182)AND(387<MY)AND(MY<436) THEN GOTO *MCLFN
  95. 10940  IF (191<MX)AND(MX<380)AND(379<MY)AND(MY<476) THEN GOTO *MCL6
  96. 10950  RETURN
  97. 10960  *MCL1
  98. 10970   I0=(MX-9)\11+((MY-9)\11)*16
  99. 10980   CSA0=SR%(I0)
  100. 10990   GOSUB *SETCSA
  101. 11000   GOSUB *SETCSB
  102. 11010  RETURN
  103. 11020  *MCL2
  104. 11030   I0=(MX-199)\11+((MY-9)\11)*16
  105. 11040   CSA0=I0
  106. 11050   GOSUB *SETCSA
  107. 11060   GOSUB *SETCSB
  108. 11070  RETURN
  109. 11080  *MCL3
  110. 11090   IF ((MY-197) MOD 32)>15 THEN RETURN
  111. 11100   I0=(MY-197)\32:I1=(MX-62)\40
  112. 11110   IF (I0 MOD 2)=0 THEN I2=1 ELSE I2=-1
  113. 11120   IF (MX-62) MOD 40<10 THEN I3=16 ELSE I3=1
  114. 11130   ON I0\2+1 GOSUB *MCSA,*MCSB,*MSFT
  115. 11140  RETURN
  116. 11150   *MCSA
  117. 11160    I4=ST%(CSA)
  118. 11170    ON I1+1 GOSUB *SETR,*SETG,*SETB
  119. 11180    GOSUB *SETCSA
  120. 11190    GOSUB *SETCSB
  121. 11200    PALETTE I4,[G%(I4),R%(I4),B%(I4)],1
  122. 11210   RETURN
  123. 11220   *MCSB
  124. 11230    I4=ST%(CSB)
  125. 11240    ON I1+1 GOSUB *SETR,*SETG,*SETB
  126. 11250    GOSUB *SETCSA
  127. 11260    GOSUB *SETCSB
  128. 11270    PALETTE I4,[G%(I4),R%(I4),B%(I4)],1
  129. 11280   RETURN
  130. 11290    *SETR
  131. 11300     IF 255-I2*(R%(I4)*2-255)<I3*2 THEN R%(I4)=(255+I2*255)\2 ELSE R%(I4)=R%(I4)+I2*I3
  132. 11310    RETURN
  133. 11320    *SETG
  134. 11330     IF 255-I2*(G%(I4)*2-255)<I3*2 THEN G%(I4)=(255+I2*255)\2 ELSE G%(I4)=G%(I4)+I2*I3
  135. 11340    RETURN
  136. 11350    *SETB
  137. 11360     IF 255-I2*(B%(I4)*2-255)<I3*2 THEN B%(I4)=(255+I2*255)\2 ELSE B%(I4)=B%(I4)+I2*I3
  138. 11370    RETURN
  139. 11380   *MSFT
  140. 11390    ON I1+1 GOSUB *SFTR,*SFTG,*SFTB
  141. 11400    GOSUB *SETSFT
  142. 11410   RETURN
  143. 11420    *SFTR
  144. 11430     IF 255-I2*SFR<I3 THEN SFR=I2*255 ELSE SFR=SFR+I2*I3
  145. 11440    RETURN
  146. 11450    *SFTG
  147. 11460     IF 255-I2*SFG<I3 THEN SFG=I2*255 ELSE SFG=SFG+I2*I3
  148. 11470    RETURN
  149. 11480    *SFTB
  150. 11490     IF 255-I2*SFB<I3 THEN SFB=I2*255 ELSE SFB=SFB+I2*I3
  151. 11500    RETURN
  152. 11510  *MCL4
  153. 11520   X=MX-222:Y=MY-221
  154. 11530   IF ( -1<X)AND(X<129)AND( -1<Y)AND(Y<129) THEN GOTO *GRADCSA
  155. 11540   IF ( -1<X)AND(X<129)AND(-22<Y)AND(Y<  0) THEN GOTO *GDCSA1
  156. 11550   IF (128<X)AND(X<140)AND( -1<Y)AND(Y<129) THEN GOTO *GDCSA2
  157. 11560   IF ( -1<X)AND(X<129)AND(128<Y)AND(Y<150) THEN GOTO *GDCSA3
  158. 11570   IF (-22<X)AND(X<  0)AND( -1<Y)AND(Y<129) THEN GOTO *GDCSA4
  159. 11580   IF (-22<X)AND(X<  0)AND(-22<Y)AND(Y<  0) THEN GOTO *GD1
  160. 11590   IF (128<X)AND(X<150)AND(-22<Y)AND(Y<  0) THEN GOTO *GD2
  161. 11600   IF (-22<X)AND(X<  0)AND(128<Y)AND(Y<150) THEN GOTO *GD3
  162. 11610   IF (128<X)AND(X<150)AND(128<Y)AND(Y<150) THEN GOTO *GD4
  163. 11620   RETURN
  164. 11630   *GRADCSA
  165. 11640    R%(ST%(CSA))=(R%(ST%(CS1))*(128-X)*(128-Y)+R%(ST%(CS2))*X*(128-Y)+R%(ST%(CS3))*(128-X)*Y+R%(ST%(CS4))*X*Y+8191)\16384
  166. 11650    G%(ST%(CSA))=(G%(ST%(CS1))*(128-X)*(128-Y)+G%(ST%(CS2))*X*(128-Y)+G%(ST%(CS3))*(128-X)*Y+G%(ST%(CS4))*X*Y+8191)\16384
  167. 11660    B%(ST%(CSA))=(B%(ST%(CS1))*(128-X)*(128-Y)+B%(ST%(CS2))*X*(128-Y)+B%(ST%(CS3))*(128-X)*Y+B%(ST%(CS4))*X*Y+8191)\16384
  168. 11670   GOTO *MCL4R
  169. 11680   *GDCSA1
  170. 11690    R%(ST%(CSA))=(R%(ST%(CS1))*(128-X)+R%(ST%(CS2))*X+63)\128
  171. 11700    G%(ST%(CSA))=(G%(ST%(CS1))*(128-X)+G%(ST%(CS2))*X+63)\128
  172. 11710    B%(ST%(CSA))=(B%(ST%(CS1))*(128-X)+B%(ST%(CS2))*X+63)\128
  173. 11720   GOTO *MCL4R
  174. 11730   *GDCSA2
  175. 11740    R%(ST%(CSA))=(R%(ST%(CS2))*(128-Y)+R%(ST%(CS4))*Y+63)\128
  176. 11750    G%(ST%(CSA))=(G%(ST%(CS2))*(128-Y)+G%(ST%(CS4))*Y+63)\128
  177. 11760    B%(ST%(CSA))=(B%(ST%(CS2))*(128-Y)+B%(ST%(CS4))*Y+63)\128
  178. 11770   GOTO *MCL4R
  179. 11780   *GDCSA3
  180. 11790    R%(ST%(CSA))=(R%(ST%(CS3))*(128-X)+R%(ST%(CS4))*X+63)\128
  181. 11800    G%(ST%(CSA))=(G%(ST%(CS3))*(128-X)+G%(ST%(CS4))*X+63)\128
  182. 11810    B%(ST%(CSA))=(B%(ST%(CS3))*(128-X)+B%(ST%(CS4))*X+63)\128
  183. 11820   GOTO *MCL4R
  184. 11830   *GDCSA4
  185. 11840    R%(ST%(CSA))=(R%(ST%(CS1))*(128-Y)+R%(ST%(CS3))*Y+63)\128
  186. 11850    G%(ST%(CSA))=(G%(ST%(CS1))*(128-Y)+G%(ST%(CS3))*Y+63)\128
  187. 11860    B%(ST%(CSA))=(B%(ST%(CS1))*(128-Y)+B%(ST%(CS3))*Y+63)\128
  188. 11870   GOTO *MCL4R
  189. 11880   *GD1
  190. 11890    R%(ST%(CSA))=R%(ST%(CS1))
  191. 11900    G%(ST%(CSA))=G%(ST%(CS1))
  192. 11910    B%(ST%(CSA))=B%(ST%(CS1))
  193. 11920   GOTO *MCL4R
  194. 11930   *GD2
  195. 11940    R%(ST%(CSA))=R%(ST%(CS2))
  196. 11950    G%(ST%(CSA))=G%(ST%(CS2))
  197. 11960    B%(ST%(CSA))=B%(ST%(CS2))
  198. 11970   GOTO *MCL4R
  199. 11980   *GD3
  200. 11990    R%(ST%(CSA))=R%(ST%(CS3))
  201. 12000    G%(ST%(CSA))=G%(ST%(CS3))
  202. 12010    B%(ST%(CSA))=B%(ST%(CS3))
  203. 12020   GOTO *MCL4R
  204. 12030   *GD4
  205. 12040    R%(ST%(CSA))=R%(ST%(CS4))
  206. 12050    G%(ST%(CSA))=G%(ST%(CS4))
  207. 12060    B%(ST%(CSA))=B%(ST%(CS4))
  208. 12070   GOTO *MCL4R
  209. 12080  *MCL4R
  210. 12090   GOSUB *SETCSA
  211. 12100   GOSUB *SETCSB
  212. 12110   PALETTE ST%(CSA),[G%(ST%(CSA)),R%(ST%(CSA)),B%(ST%(CSA))],1
  213. 12120  RETURN
  214. 12130  *MCL5
  215. 12140   I0=(MX-2)\47
  216. 12150   ON I0+1 GOSUB *SETPFLD,*SETPFSV,*SETPFKL,*SETSRSV
  217. 12160  RETURN
  218. 12170  *MCLFN
  219. 12180   IF ((MY-388) MOD 32)>15  THEN RETURN
  220. 12190   I0=(MX-62)\40+((MY-388)\32)*3
  221. 12200   ON I0+1 GOSUB *P1,*P2,*P3,*P4,*P5,*P6
  222. 12210   GOSUB *SETFN
  223. 12220  RETURN
  224. 12230  *MCL6
  225. 12240   I0=(MX-192)\47+((MY-380)\32)*4
  226. 12250   IF I0>7 THEN RETURN
  227. 12260   ON I0+1 GOSUB *SETINIT,*SETSORT,*SETSQGR,*SETGRAD,*SETSFT1,*SETSFT2,*SETTFSV,*SETTLSV
  228. 12270  RETURN
  229. 12280 *DRAG
  230. 12290  MX=MOUSE(7,0):MY=MOUSE(8,0)
  231. 12300  IF (198<MX0)AND(MX0<375)AND(  8<MY0)AND(MY0<185)AND(198<MX)AND(MX<375)AND(  8<MY)AND(MY<185) THEN GOTO *MDR0
  232. 12310  IF (200<MX)AND(MX<222)AND(199<MY)AND(MY<221) THEN GOTO *MDR1
  233. 12320  IF (350<MX)AND(MX<372)AND(199<MY)AND(MY<221) THEN GOTO *MDR2
  234. 12330  IF (200<MX)AND(MX<222)AND(349<MY)AND(MY<371) THEN GOTO *MDR3
  235. 12340  IF (350<MX)AND(MX<372)AND(349<MY)AND(MY<371) THEN GOTO *MDR4
  236. 12350  RETURN
  237. 12360  *MDR0
  238. 12370   I0=(MX0-199)\11+((MY0-9)\11)*16
  239. 12380   CSA0=I0
  240. 12390   GOSUB *SETCSA
  241. 12400   I0=(MX-199)\11+((MY-9)\11)*16
  242. 12410   CSB0=I0
  243. 12420   GOSUB *SETCSB
  244. 12430  RETURN
  245. 12440  *MDR1
  246. 12450   GOSUB *SETSPOIT
  247. 12460   CS1=CSP
  248. 12470   LINE(202,201)-(220,219),PSET,%ST%(CS1),BF
  249. 12480  RETURN
  250. 12490  *MDR2
  251. 12500   GOSUB *SETSPOIT
  252. 12510   CS2=CSP
  253. 12520   LINE(352,201)-(370,219),PSET,%ST%(CS2),BF
  254. 12530  RETURN
  255. 12540  *MDR3
  256. 12550   GOSUB *SETSPOIT
  257. 12560   CS3=CSP
  258. 12570   LINE(202,351)-(220,369),PSET,%ST%(CS3),BF
  259. 12580  RETURN
  260. 12590  *MDR4
  261. 12600   GOSUB *SETSPOIT
  262. 12610   CS4=CSP
  263. 12620   LINE(352,351)-(370,369),PSET,%ST%(CS4),BF
  264. 12630  RETURN
  265. 12640 '汎用サブルーチン
  266. 12650 *LDLTF
  267. 12660  LOAD@ LTF$,(384,0)
  268. 12670 RETURN
  269. 12680 *LDLPC
  270. 12690  I0=INSTR (LPF$,":") 
  271. 12700  OPEN "R",#1,LEFT$(LPF$,I0)+"(1)"+RIGHT$(LPF$,LEN(LPF$)-I0)
  272. 12710  FSI&=LOF(1)
  273. 12720  CLOSE #1
  274. 12730  DIM PC%(FSI&\2-1)
  275. 12740  LOAD@ LPF$,PC%
  276. 12750  I0=PC%(8)
  277. 12760  PUT@A (384,0)-(1023,479),PC%,,,,,787
  278. 12770  IF I0=1 THEN RETURN
  279. 12780  I1&=154387
  280. 12790  FOR I=2 TO I0
  281. 12800   POX1&=(PC%(I1&+5)+65536) MOD 65536
  282. 12810   POY1&=(PC%(I1&+6)+65536) MOD 65536
  283. 12820   POX2&=(PC%(I1&+7)+65536) MOD 65536
  284. 12830   POY2&=(PC%(I1&+8)+65536) MOD 65536
  285. 12840   POI1&=(PC%(I1&+1)+65536) MOD 65536
  286. 12850   POI2&=(PC%(I1&+2)+65536) MOD 65536
  287. 12860   POM1&=(PC%(I1&+3)+65536) MOD 65536
  288. 12870   POM2&=(PC%(I1&+4)+65536) MOD 65536
  289. 12880   PUT@A (384+POX1&,POY1&)-(384+POX2&,POY2&),PC%,MATTE,,,%255,I1&+9
  290. 12890   I1&=I1&+(POI1&+POI2&*65536)\2+(POM1&+POM2&*65536)\2+9
  291. 12900  NEXT 
  292. 12910  GOSUB *PFLOAD
  293. 12920 RETURN
  294. 12930 *LDLGR
  295. 12940  DIM PC%(153999)
  296. 12950  LOAD@ LGR$,PC%
  297. 12960  PUT@A (384,0)-(1023,479),PC%,,,,,400
  298. 12970  LOAD@ PF$,PA%
  299. 12980  FOR I=0 TO 127
  300. 12990   B%(I*2  )=ASC(RIGHT$(MKI$(PC%(I*3+16)),1))
  301. 13000   R%(I*2  )=ASC( LEFT$(MKI$(PC%(I*3+16)),1))
  302. 13010   G%(I*2  )=ASC(RIGHT$(MKI$(PC%(I*3+17)),1))
  303. 13020   B%(I*2+1)=ASC( LEFT$(MKI$(PC%(I*3+17)),1))
  304. 13030   R%(I*2+1)=ASC(RIGHT$(MKI$(PC%(I*3+18)),1))
  305. 13040   G%(I*2+1)=ASC( LEFT$(MKI$(PC%(I*3+18)),1))
  306. 13050  NEXT
  307. 13060 RETURN
  308. 13070 *SETPAL
  309. 13080  FOR I=0 TO 255
  310. 13090   PALETTE I,[G%(I),R%(I),B%(I)],0
  311. 13100  NEXT
  312. 13110 RETURN
  313. 13120 *INITVAR
  314. 13130  CSA0=ICSA:CSB0=ICSB
  315. 13140  CS1=ICS1:CS2=ICS2:CS3=ICS3:CS4=ICS4
  316. 13150  SFR=0:SFG=0:SFB=0
  317. 13160  PFN=IPFN
  318. 13170 RETURN
  319. 13180 *SETSPOIT
  320. 13190  GET@A(MX0,MY0)-(MX0,MY0),SP%
  321. 13200  CSP=SR%(SP%(0))
  322. 13210 RETURN
  323. 13220 *SC
  324. 13230  H0&=196608
  325. 13240  FOR I=3 TO 255
  326. 13250   H&=(R%(I)-R)^2+(G%(I)-G)^2+(B%(I)-B)^2
  327. 13260   IF H&<H0& THEN I0=I:H0&=H&
  328. 13270  NEXT
  329. 13280  FOR I=0 TO 2
  330. 13290   H&=(R%(I)-R)^2+(G%(I)-G)^2+(B%(I)-B)^2
  331. 13300   IF H&<H0& THEN I0=I:H0&=H&
  332. 13310  NEXT
  333. 13320 RETURN
  334. 13330 'ブロック1
  335. 13340 *BLOCK1
  336. 13350  FOR I=0 TO 255
  337. 13360   LINE(10+(I MOD 16)*11,10+(I\16)*11)-(18+(I MOD 16)*11,18+(I\16)*11),PSET,%I,BF
  338. 13370  NEXT
  339. 13380 RETURN
  340. 13390 'ブロック2
  341. 13400 *BLOCK2
  342. 13410  ST%(0)=0:SR%(0)=0:ST%(1)=182:SR%(182)=1:ST%(2)=255:SR%(255)=2
  343. 13420  FOR I=3 TO 183
  344. 13430   ST%(I)=I-2:SR%(I-2)=I
  345. 13440  NEXT
  346. 13450  FOR I=184 TO 255
  347. 13460   ST%(I)=I-1:SR%(I-1)=I
  348. 13470  NEXT
  349. 13480  LINE(199,  9)-(374,184),PSET,%CB,BF
  350. 13490  FOR I=0 TO 255
  351. 13500   LINE(200+(I MOD 16)*11,10+(I\16)*11)-(208+(I MOD 16)*11,18+(I\16)*11),PSET,%ST%(I),BF
  352. 13510  NEXT
  353. 13520 RETURN
  354. 13530 'ブロック3
  355. 13540 *BLOCK3
  356. 13550  FOR I=0 TO 11
  357. 13560   LINE( 62,197+I*16)-(182,197+I*16),PSET,%CT
  358. 13570   LINE( 62+(I MOD 4)*40,197+(I\4)*64)-(62+(I MOD 4)*40,245+(I\4)*64),PSET,%CT
  359. 13580  NEXT
  360. 13590  FOR I=0 TO 17
  361. 13600   LINE( 72+(I MOD 3)*40,197+(I\3)*32)-(72+(I MOD 3)*40,213+(I\3)*32),PSET,%CT
  362. 13610  NEXT
  363. 13620  FOR I=0 TO 8
  364. 13630   SYMBOL( 80+(I MOD 3)*40,200+(I\3)*64),"▲",1,.8!,%CT
  365. 13640   SYMBOL( 80+(I MOD 3)*40,231+(I\3)*64),"▼",1,.8!,%CT
  366. 13650  NEXT
  367. 13660  LINE( 22,213)-( 62,229),PSET,%CT,B
  368. 13670  LINE( 22,277)-( 62,293),PSET,%CT,B
  369. 13680  SYMBOL( 11,216),"A",1,.8!,%CT
  370. 13690  SYMBOL( 11,280),"B",1,.8!,%CT
  371. 13700  SYMBOL( 17,344),"SHIFT",1,.8!,%CT
  372. 13710  SYMBOL( 76,248),"ＲＧＢ",1,.8!,%CT,,,,24
  373. 13720  SYMBOL( 76,312),"ＲＧＢ",1,.8!,%CT,,,,24
  374. 13730  GOSUB *SETCSA
  375. 13740  GOSUB *SETCSB
  376. 13750  GOSUB *SETSFT
  377. 13760 RETURN
  378. 13770 *SETCSA
  379. 13780  LINE(199+(CSA MOD 16)*11,  9+(CSA\16)*11)-(209+(CSA MOD 16)*11, 19+(CSA\16)*11),PSET,%CB,B,&HCE73
  380. 13790  LINE(199+(CSA0 MOD 16)*11,  9+(CSA0\16)*11)-(209+(CSA0 MOD 16)*11, 19+(CSA0\16)*11),PSET,%CT,B,&HCE73
  381. 13800  CSA=CSA0
  382. 13810  LINE( 23,214)-( 61,228),PSET,%ST%(CSA),BF
  383. 13820  LINE( 32,200)-( 47,212),PSET,%CB,BF
  384. 13830  SYMBOL( 32,200),RIGHT$("0"+HEX$(CSA),2),1,.8!,%CT
  385. 13840  LINE( 32,232)-( 47,244),PSET,%CB,BF
  386. 13850  SYMBOL( 32,232),RIGHT$("0"+HEX$(ST%(CSA)),2),1,.8!,%CT
  387. 13860  LINE( 79,216)-( 94,228),PSET,%CB,BF
  388. 13870  SYMBOL( 79,216),RIGHT$("0"+HEX$(R%(ST%(CSA))),2),1,.8!,%CT
  389. 13880  LINE(119,216)-(134,228),PSET,%CB,BF
  390. 13890  SYMBOL(119,216),RIGHT$("0"+HEX$(G%(ST%(CSA))),2),1,.8!,%CT
  391. 13900  LINE(159,216)-(174,228),PSET,%CB,BF
  392. 13910  SYMBOL(159,216),RIGHT$("0"+HEX$(B%(ST%(CSA))),2),1,.8!,%CT
  393. 13920 RETURN
  394. 13930 *SETCSB
  395. 13940  LINE(199+(CSB MOD 16)*11,  9+(CSB\16)*11)-(209+(CSB MOD 16)*11, 19+(CSB\16)*11),PSET,%CB,B,&H318C
  396. 13950  LINE(199+(CSB0 MOD 16)*11,  9+(CSB0\16)*11)-(209+(CSB0 MOD 16)*11, 19+(CSB0\16)*11),PSET,%CT,B,&H318C
  397. 13960  CSB=CSB0
  398. 13970  LINE( 23,278)-( 61,292),PSET,%ST%(CSB),BF
  399. 13980  LINE( 32,264)-( 47,276),PSET,%CB,BF
  400. 13990  LINE( 32,296)-( 47,308),PSET,%CB,BF
  401. 14000  SYMBOL( 32,296),RIGHT$("0"+HEX$(ST%(CSB)),2),1,.8!,%CT
  402. 14010  LINE( 79,280)-( 94,292),PSET,%CB,BF
  403. 14020  SYMBOL( 79,280),RIGHT$("0"+HEX$(R%(ST%(CSB))),2),1,.8!,%CT
  404. 14030  LINE(119,280)-(134,292),PSET,%CB,BF
  405. 14040  SYMBOL(119,280),RIGHT$("0"+HEX$(G%(ST%(CSB))),2),1,.8!,%CT
  406. 14050  LINE(159,280)-(174,292),PSET,%CB,BF
  407. 14060  SYMBOL(159,280),RIGHT$("0"+HEX$(B%(ST%(CSB))),2),1,.8!,%CT
  408. 14070 RETURN
  409. 14080 *SETSFT
  410. 14090  SFRX$=RIGHT$("0"+HEX$(ABS(SFR)),2)
  411. 14100  IF SFR<0 THEN SFRX$="-"+SFRX$ ELSE SFRX$=" "+SFRX$
  412. 14110  SFGX$=RIGHT$("0"+HEX$(ABS(SFG)),2)
  413. 14120  IF SFG<0 THEN SFGX$="-"+SFGX$ ELSE SFGX$=" "+SFGX$
  414. 14130  SFBX$=RIGHT$("0"+HEX$(ABS(SFB)),2)
  415. 14140  IF SFB<0 THEN SFBX$="-"+SFBX$ ELSE SFBX$=" "+SFBX$
  416. 14150  LINE( 71,344)-( 94,356),PSET,%CB,BF
  417. 14160  SYMBOL( 71,344),SFRX$,1,.8!,%CT
  418. 14170  LINE(111,344)-(134,356),PSET,%CB,BF
  419. 14180  SYMBOL(111,344),SFGX$,1,.8!,%CT
  420. 14190  LINE(151,344)-(174,356),PSET,%CB,BF
  421. 14200  SYMBOL(151,344),SFBX$,1,.8!,%CT
  422. 14210 RETURN
  423. 14220 'ブロック4
  424. 14230 *BLOCK4
  425. 14240  IF FLGSQG<>0 THEN GOSUB *SQGRAD
  426. 14250  GOSUB *SETGRADB
  427. 14260 RETURN
  428. 14270 *SETSQGR
  429. 14280  LINE(286,380)-(333,412),XOR,%CB,BF
  430. 14290  GOSUB *SQGRAD
  431. 14300  GOSUB *SETGRADB 
  432. 14310  LINE(286,380)-(333,412),XOR,%CB,BF
  433. 14320 RETURN
  434. 14330 *SQGRAD
  435. 14340  R1=R%(ST%(CS1)):R2=R%(ST%(CS2)):R3=R%(ST%(CS3)):R4=R%(ST%(CS4))
  436. 14350  G1=G%(ST%(CS1)):G2=G%(ST%(CS2)):G3=G%(ST%(CS3)):G4=G%(ST%(CS4))
  437. 14360  B1=B%(ST%(CS1)):B2=B%(ST%(CS2)):B3=B%(ST%(CS3)):B4=B%(ST%(CS4))
  438. 14370  RR=36*R1+17:RX=6*(R2-R1):RY=6*(R3-R1):RH=R1+R4-R2-R3
  439. 14380  GG=36*G1+17:GX=6*(G2-G1):GY=6*(G3-G1):GH=G1+G4-G2-G3
  440. 14390  BB=36*B1+17:BX=6*(B2-B1):BY=6*(B3-B1):BH=B1+B4-B2-B3
  441. 14400  FOR Y=0 TO 6
  442. 14410   FOR X=0 TO 6
  443. 14420    R=(RR+RX*X+RY*Y+RH*X*Y)\36
  444. 14430    G=(GG+GX*X+GY*Y+GH*X*Y)\36
  445. 14440    B=(BB+BX*X+BY*Y+BH*X*Y)\36
  446. 14450    GOSUB *SC
  447. 14460    LINE(220+19*X,219+19*Y)-(238+19*X,237+19*Y),PSET,%I0,BF
  448. 14470   NEXT
  449. 14480  NEXT
  450. 14490 RETURN
  451. 14500 *SETGRADB
  452. 14510  LINE(221,220)-(351,350),PSET,%CT,B
  453. 14520  LINE(220,219)-(352,351),PSET,%CB,B
  454. 14530  LINE(201,200)-(371,370),PSET,%CT,B
  455. 14540  LINE(201,200)-(221,220),PSET,%CT,B
  456. 14550  LINE(351,200)-(371,220),PSET,%CT,B
  457. 14560  LINE(201,350)-(221,370),PSET,%CT,B
  458. 14570  LINE(351,350)-(371,370),PSET,%CT,B
  459. 14580  LINE(202,201)-(220,219),PSET,%ST%(CS1),BF
  460. 14590  LINE(352,201)-(370,219),PSET,%ST%(CS2),BF
  461. 14600  LINE(202,351)-(220,369),PSET,%ST%(CS3),BF
  462. 14610  LINE(352,351)-(370,369),PSET,%ST%(CS4),BF
  463. 14620 RETURN
  464. 14630 'ブロック5
  465. 14640 *BLOCK5
  466. 14650  FOR I=0 TO 3
  467. 14660   LINE( 62,388+I*16)-(182,388+I*16),PSET,%CT
  468. 14670   LINE( 62+(I MOD 4)*40,388+(I\4)*64)-(62+(I MOD 4)*40,436+(I\4)*64),PSET,%CT
  469. 14680  NEXT
  470. 14690  LINE(  2,444)-(191,444),PSET,%CT,B
  471. 14700  SYMBOL( 17,407),"PFILE",1,.8!,%CT
  472. 14710  FOR I=0 TO 2
  473. 14720   SYMBOL( 74+I*40,391),"▲",1,.8!,%CT
  474. 14730   SYMBOL( 74+I*40,423),"▼",1,.8!,%CT
  475. 14740  NEXT
  476. 14750  GOSUB *SETFN
  477. 14760  FOR I=0 TO 2
  478. 14770   LINE( 50+I*47,444)-( 50+I*47,477),PSET,%CT
  479. 14780  NEXT
  480. 14790  SYMBOL( 10,453),"PFLD",1,1,%CT
  481. 14800  SYMBOL( 57,453),"PFSV",1,1,%CT
  482. 14810  SYMBOL(104,453),"PFKL",1,1,%CT
  483. 14820  SYMBOL(151,453),"SRSV",1,1,%CT
  484. 14830 RETURN
  485. 14840 *SETFN
  486. 14850  GOSUB *SETPF
  487. 14860  LINE( 78,407)-( 85,419),PSET,%CB,BF:SYMBOL( 78,407),PFN2$,1,.8!,%CT
  488. 14870  LINE(118,407)-(125,419),PSET,%CB,BF:SYMBOL(118,407),PFN1$,1,.8!,%CT
  489. 14880  LINE(158,407)-(165,419),PSET,%CB,BF:SYMBOL(158,407),PFN0$,1,.8!,%CT
  490. 14890 RETURN
  491. 14900 *SETPFLD
  492. 14910  LINE(3,444)-(50,476),XOR,%CB,BF
  493. 14920  ON ERROR GOTO *ETPLD
  494. 14930  I0=0
  495. 14940  GOSUB *PFLOAD
  496. 14950  IF I0<>0 THEN GOTO *PLDR
  497. 14960  GOSUB *SETPAL
  498. 14970  GOSUB *BLOCK2
  499. 14980  GOSUB *SETCSA
  500. 14990  GOSUB *SETCSB
  501. 15000  GOTO *PLDR
  502. 15010  *ETPLD
  503. 15020   I0=1
  504. 15030  RESUME NEXT
  505. 15040 *PLDR
  506. 15050  ON ERROR GOTO 0
  507. 15060  LINE(  3,444)-( 50,476),XOR,%CB,BF
  508. 15070 RETURN
  509. 15080 *SETPFSV
  510. 15090  LINE( 50,444)-( 97,476),XOR,%CB,BF
  511. 15100  ON ERROR GOTO *ETPSV
  512. 15110  PFN=BPFN
  513. 15120  *PSV1
  514. 15130   GOSUB *SETPF
  515. 15140   GOSUB *PFSAVE
  516. 15150   GOTO *PSVR
  517. 15160   *ETPSV
  518. 15170    PFN=PFN+1
  519. 15180    IF PFN>999 THEN RESUME NEXT
  520. 15190   RESUME *PSV1
  521. 15200 *PSVR
  522. 15210  GOSUB *SETFN
  523. 15220  ON ERROR GOTO 0
  524. 15230  LINE( 50,444)-( 97,476),PSET,%CT,BF
  525. 15240  LINE( 51,445)-( 96,475),PSET,%CB,BF
  526. 15250  SYMBOL( 57,453),"PFSV",1,1,%CT
  527. 15260 RETURN
  528. 15270 *SETPFKL
  529. 15280  LINE( 97,444)-(144,476),XOR,%CB,BF
  530. 15290  ON ERROR GOTO *ETPKL
  531. 15300  KILL PF$
  532. 15310  GOTO *PKLR
  533. 15320  *ETPKL
  534. 15330   RESUME NEXT
  535. 15340 *PKLR
  536. 15350  ON ERROR GOTO 0
  537. 15360  LINE( 97,444)-(144,476),XOR,%CB,BF
  538. 15370 RETURN
  539. 15380 *SETSRSV
  540. 15390  LINE(144,444)-(191,476),XOR,%CB,BF
  541. 15400  PFN=BPFN
  542. 15410  ON ERROR GOTO *ETSSV
  543. 15420  *SSV1
  544. 15430   GOSUB *SETPF
  545. 15440   GOSUB *SRSAVE
  546. 15450   GOTO *SSVR
  547. 15460   *ETSSV
  548. 15470    PFN=PFN+1
  549. 15480    IF PFN>999 THEN RESUME NEXT
  550. 15490   RESUME *SSV1
  551. 15500 *SSVR
  552. 15510  GOSUB *SETFN
  553. 15520  ON ERROR GOTO 0
  554. 15530  LINE(144,444)-(191,476),PSET,%CT,BF
  555. 15540  LINE(145,445)-(190,475),PSET,%CB,BF
  556. 15550  SYMBOL(151,453),"SRSV",1,1,%CT
  557. 15560 RETURN
  558. 15570 *PFLOAD
  559. 15580  LOAD@ PF$,PA%
  560. 15590  FOR I=0 TO 255
  561. 15600   R%(I)=ASC(MKI$(PA%(I*3+12)))
  562. 15610   G%(I)=ASC(MKI$(PA%(I*3+13)))
  563. 15620   B%(I)=ASC(MKI$(PA%(I*3+14)))
  564. 15630  NEXT
  565. 15640 RETURN
  566. 15650 *PFSAVE
  567. 15660  FOR I=0 TO 255
  568. 15670   PA%(I*3+12)=CVI(RIGHT$(MKI$(R%(I)),1)+CHR$(0))
  569. 15680   PA%(I*3+13)=CVI(RIGHT$(MKI$(G%(I)),1)+CHR$(0))
  570. 15690   PA%(I*3+14)=CVI(RIGHT$(MKI$(B%(I)),1)+CHR$(0))
  571. 15700  NEXT 
  572. 15710  SAVE@ PF$,PA%
  573. 15720 RETURN
  574. 15730 *SRSAVE
  575. 15740  I=0:I0=ST%(0):GOSUB *SRSV1
  576. 15750  I=182:I0=ST%(1):GOSUB *SRSV1
  577. 15760  I=255:I0=ST%(2):GOSUB *SRSV1
  578. 15770  FOR I=1 TO 181 
  579. 15780   I0=ST%(I+2):GOSUB *SRSV1
  580. 15790  NEXT
  581. 15800  FOR I=183 TO 254 
  582. 15810   I0=ST%(I+1):GOSUB *SRSV1
  583. 15820  NEXT
  584. 15830  GOTO *SRSVR
  585. 15840  *SRSV1
  586. 15850   PA%(I*3+12)=CVI(RIGHT$(MKI$(R%(I0)),1)+CHR$(0))
  587. 15860   PA%(I*3+13)=CVI(RIGHT$(MKI$(G%(I0)),1)+CHR$(0))
  588. 15870   PA%(I*3+14)=CVI(RIGHT$(MKI$(B%(I0)),1)+CHR$(0))
  589. 15880  RETURN
  590. 15890  *SRSVR
  591. 15900  SAVE@ PF$,PA%
  592. 15910 RETURN
  593. 15920 *SETPF
  594. 15930  PFN0=PFN MOD 10:PFN0$=RIGHT$(STR$(PFN0),1)
  595. 15940  PFN1=PFN\10 MOD 10:PFN1$=RIGHT$(STR$(PFN1),1)
  596. 15950  PFN2=PFN\100 MOD 10:PFN2$=RIGHT$(STR$(PFN2),1)
  597. 15960  PF$=PLDIR$+"PAL"+PFN2$+PFN1$+PFN0$+".P25"
  598. 15970 RETURN
  599. 15980 *P1
  600. 15990  IF PFN>899 THEN PFN=999 ELSE PFN=PFN+100
  601. 16000  GOSUB *SETFN 
  602. 16010 RETURN
  603. 16020 *P2
  604. 16030  IF PFN>989 THEN PFN=999 ELSE PFN=PFN+10
  605. 16040  GOSUB *SETFN
  606. 16050 RETURN
  607. 16060 *P3
  608. 16070  IF PFN>998 THEN PFN=999 ELSE PFN=PFN+1
  609. 16080  GOSUB *SETFN
  610. 16090 RETURN
  611. 16100 *P4
  612. 16110  IF PFN<100 THEN PFN=0 ELSE PFN=PFN-100
  613. 16120  GOSUB *SETFN
  614. 16130 RETURN
  615. 16140 *P5
  616. 16150  IF PFN<10 THEN PFN=0 ELSE PFN=PFN-10
  617. 16160  GOSUB *SETFN
  618. 16170 RETURN
  619. 16180 *P6
  620. 16190  IF PFN<1 THEN PFN=0 ELSE PFN=PFN-1
  621. 16200  GOSUB *SETFN
  622. 16210 RETURN
  623. 16220 'ブロック6
  624. 16230 *BLOCK6
  625. 16240  LINE(192,412)-(381,412),PSET,%CT,B
  626. 16250  LINE(192,444)-(381,412),PSET,%CT,B
  627. 16260  FOR I=0 TO 2
  628. 16270   LINE(239+I*47,380)-(239+I*47,477),PSET,%CT
  629. 16280  NEXT
  630. 16290  SYMBOL(199,389),"INIT",1,1,%CT
  631. 16300  SYMBOL(246,389),"SORT",1,1,%CT
  632. 16310  SYMBOL(293,389),"SQGR",1,1,%CT
  633. 16320  SYMBOL(340,389),"GRAD",1,1,%CT
  634. 16330  SYMBOL(199,421),"SFT1",1,1,%CT
  635. 16340  SYMBOL(246,421),"SFT2",1,1,%CT
  636. 16350  SYMBOL(293,421),"TFSV",1,1,%CT
  637. 16360  SYMBOL(340,421),"TLSV",1,1,%CT
  638. 16370 RETURN 
  639. 16380 *SETINIT
  640. 16390  LINE(192,380)-(239,412),XOR,%CB,BF
  641. 16400  GOSUB *INITVAR
  642. 16410  GOSUB *SETFN
  643. 16420  GOSUB *SETPFLD
  644. 16430  GOSUB *SETGRADB
  645. 16440  LINE(192,380)-(239,412),XOR,%CB,BF
  646. 16450 RETURN
  647. 16460 *SETSORT
  648. 16470  LINE(239,380)-(286,412),XOR,%CB,BF
  649. 16480  FOR I=3 TO 255
  650. 16490   SRT&(I)=G%(ST%(I))*65536+R%(ST%(I))*256+B%(ST%(I))
  651. 16500  NEXT
  652. 16510  FOR I=255 TO 0 STEP -1
  653. 16520   FOR J=3 TO I-1
  654. 16530    IF SRT&(J)>SRT&(J+1) THEN SWAP SRT&(J),SRT&(J+1):SWAP ST%(J),ST%(J+1)
  655. 16540   NEXT
  656. 16550   LINE(200+(I MOD 16)*11,10+(I\16)*11)-(208+(I MOD 16)*11,18+(I\16)*11),PSET,%ST%(I),BF
  657. 16560  NEXT
  658. 16570  FOR I=0 TO 255
  659. 16580   SR%(ST%(I))=I
  660. 16590  NEXT
  661. 16600  GOSUB *SETGRADB
  662. 16610  LINE(239,380)-(286,412),XOR,%CB,BF
  663. 16620 RETURN
  664. 16630 *SETGRAD
  665. 16640  IF CSA=CSB THEN RETURN
  666. 16650  LINE(333,380)-(380,412),XOR,%CB,BF
  667. 16660  I0=ABS(CSB-CSA)
  668. 16670  FOR I=CSA TO CSB STEP SGN(CSB-CSA)
  669. 16680   R%(ST%(I))=(R%(ST%(CSA))*ABS(CSB-I)+R%(ST%(CSB))*ABS(CSA-I)+I0\2)\I0
  670. 16690   G%(ST%(I))=(G%(ST%(CSA))*ABS(CSB-I)+G%(ST%(CSB))*ABS(CSA-I)+I0\2)\I0
  671. 16700   B%(ST%(I))=(B%(ST%(CSA))*ABS(CSB-I)+B%(ST%(CSB))*ABS(CSA-I)+I0\2)\I0
  672. 16710   PALETTE ST%(I),[G%(ST%(I)),R%(ST%(I)),B%(ST%(I))],1
  673. 16720 NEXT
  674. 16730  LINE(333,380)-(380,412),XOR,%CB,BF
  675. 16740 RETURN
  676. 16750 *SETSFT1
  677. 16760  IF (SFR=0)AND(SFG=0)AND(SFB=0) THEN RETURN
  678. 16770  LINE(192,412)-(239,444),XOR,%CB,BF
  679. 16780  FOR I=CSA TO CSB STEP SGN(CSB-CSA)
  680. 16790   R%(ST%(I))=R%(ST%(I))+SFR
  681. 16800   IF R%(ST%(I))<  0 THEN R%(ST%(I))=0
  682. 16810   IF R%(ST%(I))>255 THEN R%(ST%(I))=255
  683. 16820   G%(ST%(I))=G%(ST%(I))+SFG
  684. 16830   IF G%(ST%(I))<  0 THEN G%(ST%(I))=0
  685. 16840   IF G%(ST%(I))>255 THEN G%(ST%(I))=255
  686. 16850   B%(ST%(I))=B%(ST%(I))+SFB
  687. 16860   IF B%(ST%(I))<  0 THEN B%(ST%(I))=0
  688. 16870   IF B%(ST%(I))>255 THEN B%(ST%(I))=255
  689. 16880   PALETTE ST%(I),[G%(ST%(I)),R%(ST%(I)),B%(ST%(I))],1
  690. 16890  NEXT
  691. 16900  GOSUB *SETCSA
  692. 16910  GOSUB *SETCSB
  693. 16920  SFR=0:SFG=0:SFB=0:GOSUB *SETSFT
  694. 16930  LINE(192,412)-(239,444),XOR,%CB,BF
  695. 16940 RETURN
  696. 16950 *SETSFT2
  697. 16960  IF (SFR=0)AND(SFG=0)AND(SFB=0) THEN RETURN
  698. 16970  LINE(239,412)-(286,444),XOR,%CB,BF
  699. 16980  FOR I=CSA TO CSB STEP SGN(CSB-CSA)
  700. 16990   I0&=INT(R%(ST%(I))*EXP(SFR*LG2#/64)+.5!)
  701. 17000   IF I0&>255 THEN R%(ST%(I))=255 ELSE R%(ST%(I))=I0&
  702. 17010   I0&=INT(G%(ST%(I))*EXP(SFG*LG2#/64)+.5!)
  703. 17020   IF I0&>255 THEN G%(ST%(I))=255 ELSE G%(ST%(I))=I0&
  704. 17030   I0&=INT(B%(ST%(I))*EXP(SFB*LG2#/64)+.5!)
  705. 17040   IF I0&>255 THEN B%(ST%(I))=255 ELSE B%(ST%(I))=I0&
  706. 17050   IF B%(ST%(I))>255 THEN B%(ST%(I))=255
  707. 17060   PALETTE ST%(I),[G%(ST%(I)),R%(ST%(I)),B%(ST%(I))],1
  708. 17070  NEXT
  709. 17080  GOSUB *SETCSA
  710. 17090  GOSUB *SETCSB
  711. 17100  SFR=0:SFG=0:SFB=0:GOSUB *SETSFT
  712. 17110  LINE(239,412)-(286,444),XOR,%CB,BF
  713. 17120 RETURN
  714. 17130 *SETTFSV
  715. 17140  LINE(286,412)-(333,444),XOR,%CB,BF
  716. 17150  SAVE@ STF$,(384,0)-(1023,479)
  717. 17160  LINE(286,412)-(333,444),XOR,%CB,BF
  718. 17170 RETURN
  719. 17180 *SETTLSV
  720. 17190  LINE(333,412)-(380,444),XOR,%CB,BF
  721. 17200  OPEN "O",#1,TLP$
  722. 17210  FOR I=0 TO 255
  723. 17220   PRINT#1,USING "### ' ### ### ###";I,R%(I),G%(I),B%(I)
  724. 17230  NEXT
  725. 17240  CLOSE #1
  726. 17250  LINE(333,412)-(380,444),XOR,%CB,BF
  727. 17260 RETURN
  728.