home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 1 / FREEWARE.BIN / basic / spedit / sped15.bas next >
BASIC Source File  |  1989-10-17  |  24KB  |  749 lines
  1. 10 ' ****************************************************************
  2. 20 ' ***                                                          ***
  3. 30 ' ***　  　　ＳＰＲＩＴＥ　ＥＤＩＴＯＲ　Ｖｅｒ１．５          ***
  4. 40 ' ***                                                          ***
  5. 50 ' ***        　　　  『鶴田ピンチ』の作品！　　　　　　　　　　***
  6. 60 ' ***                                                          ***
  7. 70 ' ***                                                          ***
  8. 80 ' *** 　　　    ・回転機能、コピー機能　追加版                 ***
  9. 90 ' ***                                                          ***
  10. 100 ' ****************************************************************
  11. 1000 '
  12. 1010 '-----初期設定
  13. 1020 '
  14. 1030 ON ERROR GOTO 5200
  15. 1040 SCREEN@ 1
  16. 1050 CLS
  17. 1060 MOUSE 0
  18. 1070 MOUSE 1,0,0,1:MOUSE 3,0,12:MOUSE 3,1,12
  19. 1080 DIM CG(10),CR(10),CB(10):'-----パレット用
  20. 1090 DIM SPP1%(256),SPP2%(256):'-----パターンデータ用
  21. 1100 DIM SPP3%(256),SPP4%(256):'-----パターンデータ用
  22. 1102 DIM CSP%(256):'-----回転用ワーク
  23. 1105 DIM COSP%(6400):'-----コピー用ワーク
  24. 1110 SG=0:SR=0:SB=0:'-----左クリック用
  25. 1120 RG=0:RR=0:RB=0:'-----右クリック用
  26. 1130 PG=0:PR=0:PB=0:'-----パレットエディット領域用
  27. 1140 'INPUT SG,SR,SB:CLS
  28. 1150 '
  29. 1160 '-----スプライトパターン領域
  30. 1170 '
  31. 1180 LINE(200,0)-(234,34),PSET,7,B
  32. 1190 LINE(217,0)-(217,34),PSET,7
  33. 1200 LINE(200,17)-(234,17),PSET,7
  34. 1210 '
  35. 1220 '-----エディット領域
  36. 1230 '
  37. 1240 LINE(0,0)-(162,162),PSET,7,B
  38. 1250 LINE(81,0)-(81,162),PSET,7
  39. 1260 LINE(0,81)-(162,81),PSET,7
  40. 1270 '
  41. 1280 '-----パレット領域
  42. 1290 '
  43. 1300 FOR X=0 TO 100 STEP 10
  44. 1310 LINE(X,169)-(X,179),PSET,7
  45. 1320 NEXT
  46. 1330 LINE(0,169)-(100,179),PSET,7,B
  47. 1340 '
  48. 1350 '-----クリックカラー領域
  49. 1360 '
  50. 1370 FOR X=140 TO 160 STEP 10
  51. 1380 LINE(X,169)-(X,179),PSET,7
  52. 1390 NEXT
  53. 1400 LINE(140,169)-(160,179),PSET,7,B
  54. 1410 '
  55. 1420 '-----パレットエディット領域
  56. 1430 '
  57. 1440 LINE(45,185)-(55,195),PSET,7,B:'色表示位置
  58. 1450 LINE(33,200)-(66,208),PSET,7,B:'Ｇ
  59. 1460 LINE(25,200)-(33,208),PSET,7,B:'-
  60. 1470 LINE(66,200)-(74,208),PSET,7,B:'+
  61. 1480 LINE(33,210)-(66,218),PSET,7,B:'Ｒ
  62. 1490 LINE(25,210)-(33,218),PSET,7,B:'-
  63. 1500 LINE(66,210)-(74,218),PSET,7,B:'+
  64. 1510 LINE(33,220)-(66,228),PSET,7,B:'Ｂ
  65. 1520 LINE(25,220)-(33,228),PSET,7,B:'-
  66. 1530 LINE(66,220)-(74,228),PSET,7,B:'+
  67. 1540 '-----　＋
  68. 1550 LINE(68,204)-(72,204),PSET,7:'Ｇ
  69. 1560 LINE(70,202)-(70,206),PSET,7
  70. 1570 LINE(68,214)-(72,214),PSET,7:'Ｒ
  71. 1580 LINE(70,212)-(70,216),PSET,7
  72. 1590 LINE(68,224)-(72,224),PSET,7:'Ｂ
  73. 1600 LINE(70,222)-(70,226),PSET,7
  74. 1610 '-----　－
  75. 1620 LINE(27,204)-(31,204),PSET,7:'Ｇ
  76. 1630 LINE(27,214)-(31,214),PSET,7:'Ｒ
  77. 1640 LINE(27,224)-(31,224),PSET,7:'Ｂ
  78. 1650 '-----ＣＬＳ
  79. 1660 LINE(310,0)-(319,9),PSET,7,B
  80. 1670 '-----スポイト指定位置(クリック→パレット)
  81. 1680 CONNECT(120,169)-(110,174)-(120,179)-(120,169),7,PSET
  82. 1690 '-----パターンセーブ
  83. 1700 LINE(310,30)-(319,39),PSET,2,BF
  84. 1710 '-----パターンロード
  85. 1720 LINE(310,45)-(319,54),PSET,5,BF
  86. 1722 '-----回転
  87. 1724 LINE(310,60)-(319,69),PSET,1,BF
  88. 1726 '-----コピー
  89. 1728 LINE(310,75)-(319,84),PSET,4,BF
  90. 1730 '
  91. 1740 '-----マウス設定
  92. 1750 '
  93. 1755 ON MOUSE (1) GOSUB 1850
  94. 1760 FOR I=1 TO 5
  95. 1770 MOUSE (I) ON
  96. 1780 NEXT
  97. 1800 IF MOUSE (2,0)=-1 THEN MOUSE (2) OFF:GOSUB 2350
  98. 1810 IF MOUSE (2,1)=-1 THEN GOSUB 2640
  99. 1820 IF (MOUSE (2,0)=-1) AND (MOUSE (2,1)=-1) THEN FOR I=1 TO 5:MOUSE (I) OFF:NEXT:LOCATE 23,22:INPUT"終了してもよろしいですか？(Y/N)";A$:IF A$="Y" OR A$="y" THEN MOUSE 5:END ELSE LOCATE 23,22:PRINT"                                  ":GOTO 1740
  100. 1822 MOUSE (2) ON
  101. 1830 GOTO 1800
  102. 1840 '
  103. 1850 '-----カーソル座標位置
  104. 1860 '
  105. 1870 PX=MOUSE (0)
  106. 1880 PY=MOUSE (1)
  107. 1890 RETURN
  108. 1900 '
  109. 1910 '-----ポイントセット サブルーチン
  110. 1920 '
  111. 1922 IF KAFLG=1 THEN KAFLG=0:GOTO 30000
  112. 1924 IF (COFLG=1) AND (SCOPY=0) THEN GOTO 31000
  113. 1926 IF (COFLG=1) AND (SCOPY>0) THEN GOTO 32000
  114. 1930 WPX=PX\5
  115. 1940 WPY=PY\5
  116. 1950 IF (PX MOD 5)=0 THEN WPX=WPX-1
  117. 1960 IF (PY MOD 5)=0 THEN WPY=WPY-1
  118. 1970 PPX=WPX*5+1:IF PPX=>81 THEN PPX=PPX+1
  119. 1980 PPY=WPY*5+1:IF PPY=>81 THEN PPY=PPY+1
  120. 1990 IF PPX>157 THEN PPX=157
  121. 2000 IF PPY>157 THEN PPY=157
  122. 2010 IF PPX<1 THEN PPX=1
  123. 2020 IF PPY<1 THEN PPY=1
  124. 2030 SX=201+WPX:IF SX=>217 THEN SX=SX+1
  125. 2040 IF SX<201 THEN SX=201
  126. 2050 IF SX>233 THEN SX=233
  127. 2060 SY=1+WPY:IF SY=>17 THEN SY=SY+1
  128. 2070 IF SY<1 THEN SY=1
  129. 2080 IF SY>33 THEN SY=33
  130. 2090 LINE (PPX,PPY)-(PPX+4,PPY+4),PSET,[SG*8,SR*8,SB*8],BF
  131. 2100 PSET(SX,SY),[SG*8,SR*8,SB*8]
  132. 2110 RETURN
  133. 2120 '
  134. 2130 '-----ポイントリセット サブルーチン
  135. 2140 '
  136. 2150 WPX=PX\5
  137. 2160 WPY=PY\5
  138. 2170 IF (PX MOD 5)=0 THEN WPX=WPX-1
  139. 2180 IF (PY MOD 5)=0 THEN WPY=WPY-1
  140. 2190 PPX=WPX*5+1:IF PPX=>81 THEN PPX=PPX+1
  141. 2200 PPY=WPY*5+1:IF PPY=>81 THEN PPY=PPY+1
  142. 2210 IF PPX>157 THEN PPX=157
  143. 2220 IF PPY>157 THEN PPY=157
  144. 2230 IF PPX<1 THEN PPX=1
  145. 2240 IF PPY<1 THEN PPY=1
  146. 2250 SX=201+WPX:IF SX=>217 THEN SX=SX+1
  147. 2260 IF SX<201 THEN SX=201
  148. 2270 IF SX>233 THEN SX=233
  149. 2280 SY=1+WPY:IF SY=>17 THEN SY=SY+1
  150. 2290 IF SY<1 THEN SY=1
  151. 2300 IF SY>33 THEN SY=33
  152. 2310 LINE (PPX,PPY)-(PPX+4,PPY+4),PSET,[RG*8,RR*8,RB*8],BF
  153. 2320 PSET(SX,SY),[RG*8,RR*8,RB*8]
  154. 2330 RETURN
  155. 2340 '
  156. 2350 '-----左クリック場所判定ルーチン
  157. 2360 '
  158. 2370 IF (PX=81 AND PY>161) THEN RETURN
  159. 2380 IF (PX>161 AND PY=81) THEN RETURN
  160. 2390 IF (PX<162 AND PY<162) AND (PX>0 AND PY>0) THEN GOSUB 1910:GOTO 2610
  161. 2400 IF (PX>310 AND PY>0) AND (PX<319 AND PY<9) THEN GOSUB 2840:GOTO 2610
  162. 2410 IF (PX>26 AND PY>201) AND (PX<32 AND PY<207) THEN PG=PG-1:GOSUB 3180:GOTO 2580
  163. 2420 IF (PX>67 AND PY>201) AND (PX<73 AND PY<207) THEN PG=PG+1:GOSUB 3180:GOTO 2580
  164. 2430 IF (PX>26 AND PY>211) AND (PX<32 AND PY<217) THEN PR=PR-1:GOSUB 3280:GOTO 2580
  165. 2440 IF (PX>67 AND PY>211) AND (PX<73 AND PY<217) THEN PR=PR+1:GOSUB 3280:GOTO 2580
  166. 2450 IF (PX>26 AND PY>221) AND (PX<32 AND PY<227) THEN PB=PB-1:GOSUB 3380:GOTO 2580
  167. 2460 IF (PX>67 AND PY>221) AND (PX<73 AND PY<227) THEN PB=PB+1:GOSUB 3380:GOTO 2580
  168. 2470 IF (PX>45 AND PY>185) AND (PX<55 AND PY<195) THEN GOSUB 2960:GOTO 2580
  169. 2480 IF (PX>0 AND PY>170) AND (PX<9 AND PY<178) THEN PF=0:GOSUB 3650:GOTO 2580
  170. 2490 IF (PX>10 AND PY>170) AND (PX<19 AND PY<178) THEN PF=1:GOSUB 3650:GOTO 2580
  171. 2500 IF (PX>20 AND PY>170) AND (PX<29 AND PY<178) THEN PF=2:GOSUB 3650:GOTO 2580
  172. 2510 IF (PX>30 AND PY>170) AND (PX<39 AND PY<178) THEN PF=3:GOSUB 3650:GOTO 2580
  173. 2520 IF (PX>40 AND PY>170) AND (PX<49 AND PY<178) THEN PF=4:GOSUB 3650:GOTO 2580
  174. 2530 IF (PX>50 AND PY>170) AND (PX<59 AND PY<178) THEN PF=5:GOSUB 3650:GOTO 2580
  175. 2540 IF (PX>60 AND PY>170) AND (PX<69 AND PY<178) THEN PF=6:GOSUB 3650:GOTO 2580
  176. 2550 IF (PX>70 AND PY>170) AND (PX<79 AND PY<178) THEN PF=7:GOSUB 3650:GOTO 2580
  177. 2560 IF (PX>80 AND PY>170) AND (PX<89 AND PY<178) THEN PF=8:GOSUB 3650:GOTO 2580
  178. 2570 IF (PX>90 AND PY>170) AND (PX<99 AND PY<178) THEN PF=9:GOSUB 3650:GOTO 2580
  179. 2580 IF (PX>110 AND PY>169) AND (PX<120 AND PY<179) THEN SPO2=1 ELSE SPO2=0
  180. 2590 IF (PX>310 AND PY>30) AND (PX<319 AND PY<39) THEN GOSUB 3870:GOTO 2610
  181. 2600 IF (PX>310 AND PY>45) AND (PX<319 AND PY<54) THEN GOSUB 4080:GOTO 2610
  182. 2602 IF (PX>310 AND PY>60) AND (PX<319 AND PY<69) THEN KAFLG=1 ELSE KAFLG=0:'GOTO 2610
  183. 2604 IF (PX>310 AND PY>75) AND (PX<319 AND PY<84) THEN COFLG=1 ELSE COFLG=0:'GOTO 2610
  184. 2610 IF SPO2=1 THEN PAINT(119,170),2,7 ELSE PAINT(119,170),0,7
  185. 2612 IF KAFLG=1 THEN LINE(310,60)-(319,69),PSET,6,BF ELSE LINE(310,60)-(319,69),PSET,1,BF
  186. 2614 IF (COFLG=1) AND (SCOPY=0) THEN LINE(310,75)-(319,84),PSET,6,BF ELSE IF (COFLG=1) AND (SCOPY>0) THEN LINE(310,75)-(319,84),PSET,7,BF ELSE LINE(310,75)-(319,84),PSET,4,BF
  187. 2620 RETURN
  188. 2630 '
  189. 2640 '-----右クリック場所判定ルーチン
  190. 2650 '
  191. 2660 IF (PX=81 AND PY>161) THEN RETURN
  192. 2670 IF (PX>161 AND PY=81) THEN RETURN
  193. 2680 IF (PX<161 AND PY<161) AND (PX>0 AND PY>0) THEN GOSUB 2130:GOTO 2810
  194. 2690 IF (PX>45 AND PY>185) AND (PX<55 AND PY<195) THEN GOSUB 3020:GOTO 2810
  195. 2700 IF (PX>0 AND PY>170) AND (PX<9 AND PY<178) THEN PF=0:GOSUB 3720:GOTO 2810
  196. 2710 IF (PX>10 AND PY>170) AND (PX<19 AND PY<178) THEN PF=1:GOSUB 3720:GOTO 2810
  197. 2720 IF (PX>20 AND PY>170) AND (PX<29 AND PY<178) THEN PF=2:GOSUB 3720:GOTO 2810
  198. 2730 IF (PX>30 AND PY>170) AND (PX<39 AND PY<178) THEN PF=3:GOSUB 3720:GOTO 2810
  199. 2740 IF (PX>40 AND PY>170) AND (PX<49 AND PY<178) THEN PF=4:GOSUB 3720:GOTO 2810
  200. 2750 IF (PX>50 AND PY>170) AND (PX<59 AND PY<178) THEN PF=5:GOSUB 3720:GOTO 2810
  201. 2760 IF (PX>60 AND PY>170) AND (PX<69 AND PY<178) THEN PF=6:GOSUB 3720:GOTO 2810
  202. 2770 IF (PX>70 AND PY>170) AND (PX<79 AND PY<178) THEN PF=7:GOSUB 3720:GOTO 2810
  203. 2780 IF (PX>80 AND PY>170) AND (PX<89 AND PY<178) THEN PF=8:GOSUB 3720:GOTO 2810
  204. 2790 IF (PX>90 AND PY>170) AND (PX<99 AND PY<178) THEN PF=9:GOSUB 3720:GOTO 2810
  205. 2800 IF (PX>310 AND PY>30) AND (PX<319 AND PY<39) THEN GOSUB 4330:GOTO 2810
  206. 2810 PAINT(119,170),0,7:SPO2=0
  207. 2812 IF KAFLG=1 THEN LINE(310,60)-(319,69),PSET,6,BF ELSE LINE(310,60)-(319,69),PSET,1,BF
  208. 2820 RETURN
  209. 2830 '
  210. 2840 '-----エディット画面ＣＬＳ
  211. 2850 '
  212. 2860 LINE(1,1)-(80,80),PSET,0,BF
  213. 2870 LINE(82,1)-(161,80),PSET,0,BF
  214. 2880 LINE(1,82)-(80,161),PSET,0,BF
  215. 2890 LINE(82,82)-(161,161),PSET,0,BF
  216. 2900 LINE(201,1)-(216,16),PSET,0,BF
  217. 2910 LINE(218,1)-(233,16),PSET,0,BF
  218. 2920 LINE(201,18)-(216,33),PSET,0,BF
  219. 2930 LINE(218,18)-(233,33),PSET,0,BF
  220. 2940 RETURN
  221. 2950 '
  222. 2960 '-----パレット用→左クリック用
  223. 2970 '
  224. 2980 SG=PG:SR=PR:SB=PB
  225. 2990 GOSUB 3080
  226. 3000 RETURN
  227. 3010 '
  228. 3020 '-----パレット用→右クリック用
  229. 3030 '
  230. 3040 RG=PG:RR=PR:RB=PB
  231. 3050 GOSUB 3130
  232. 3060 RETURN
  233. 3070 '
  234. 3080 '-----左クリック用ペイント
  235. 3090 '
  236. 3100 LINE(141,170)-(149,178),PSET,[SG*8,SR*8,SB*8],BF
  237. 3110 RETURN
  238. 3120 '
  239. 3130 '-----右クリック用ペイント
  240. 3140 '
  241. 3150 LINE(151,170)-(159,178),PSET,[RG*8,RR*8,RB*8],BF
  242. 3160 RETURN
  243. 3170 '
  244. 3180 '-----Ｇ判定
  245. 3190 '
  246. 3200 LINE(34+CPG,201)-(34+CPG,207),PSET,0
  247. 3210 IF PG<0 THEN PG=0:RETURN
  248. 3220 IF PG>31 THEN PG=31:RETURN
  249. 3230 LINE(34+PG,200)-(34+PG,208),PSET,7
  250. 3240 CPG=PG
  251. 3250 GOSUB 3480
  252. 3260 RETURN
  253. 3270 '
  254. 3280 '-----Ｒ判定
  255. 3290 '
  256. 3300 LINE(34+CPR,211)-(34+CPR,217),PSET,0
  257. 3310 IF PR<0 THEN PR=0:RETURN
  258. 3320 IF PR>31 THEN PR=31:RETURN
  259. 3330 LINE(34+PR,210)-(34+PR,218),PSET,7
  260. 3340 CPR=PR
  261. 3350 GOSUB 3480
  262. 3360 RETURN
  263. 3370 '
  264. 3380 '-----Ｂ判定
  265. 3390 '
  266. 3400 LINE(34+CPB,221)-(34+CPB,227),PSET,0
  267. 3410 IF PB<0 THEN PB=0:RETURN
  268. 3420 IF PB>31 THEN PB=31:RETURN
  269. 3430 LINE(34+PB,220)-(34+PB,228),PSET,7
  270. 3440 CPB=PB
  271. 3450 GOSUB 3480
  272. 3460 RETURN
  273. 3470 '
  274. 3480 '-----パレット用色表示位置ペイント
  275. 3490 '
  276. 3500 LINE(46,186)-(54,194),PSET,[PG*8,PR*8,PB*8],BF
  277. 3510 RETURN
  278. 3520 '
  279. 3530 '-----左クリック用→パレット
  280. 3540 '
  281. 3550 CG(PF)=SG:CR(PF)=SR:CB(PF)=SB
  282. 3560 LINE(PF*10+1,170)-(PF*10+1+8,178),PSET,[SG*8,SR*8,SB*8],BF
  283. 3570 RETURN
  284. 3580 '
  285. 3590 '-----右クリック用→パレット
  286. 3600 '
  287. 3610 CG(PF)=RG:CR(PF)=RR:CB(PF)=RB
  288. 3620 LINE(PF*10+1,170)-(PF*10+1+8,178),PSET,[RG*8,RR*8,RB*8],BF
  289. 3630 RETURN
  290. 3640 '
  291. 3650 '-----パレット→左クリック用
  292. 3660 '
  293. 3670 IF SPO2=1 THEN 3530
  294. 3680 SG=CG(PF):SR=CR(PF):SB=CB(PF)
  295. 3690 LINE(141,170)-(149,178),PSET,[SG*8,SR*8,SB*8],BF
  296. 3700 RETURN
  297. 3710 '
  298. 3720 '-----パレット→右クリック用
  299. 3730 '
  300. 3740 IF SPO2=1 THEN 3590
  301. 3750 RG=CG(PF):RR=CR(PF):RB=CB(PF)
  302. 3760 LINE(151,170)-(159,178),PSET,[RG*8,RR*8,RB*8],BF
  303. 3770 RETURN
  304. 3780 '
  305. 3790 '-----ＧＥＴ＠Ａ
  306. 3800 '
  307. 3810 GET@A (201,1)-(216,16),SPP1%
  308. 3820 GET@A (218,1)-(233,16),SPP2%
  309. 3830 GET@A (201,18)-(216,33),SPP3%
  310. 3840 GET@A (218,18)-(233,33),SPP4%
  311. 3850 RETURN
  312. 3860 '
  313. 3870 '-----パターンセーブ
  314. 3880 '
  315. 3890 GOSUB 3790
  316. 3900 LOCATE 23,23:INPUT"セーブファイルネーム";FL$
  317. 3910 LOCATE 23,21:PRINT"                                                                           "
  318. 3920 IF FL$="\" THEN LOCATE 23,23:PRINT"                                                ":RETURN
  319. 3930 OPEN "O",#1,FL$
  320. 3940 FOR D=0 TO 255
  321. 3950     IF SPP1%(D)=0 THEN SPP1%(D)=-32768
  322. 3960     IF SPP2%(D)=0 THEN SPP2%(D)=-32768
  323. 3970     IF SPP3%(D)=0 THEN SPP3%(D)=-32768
  324. 3980     IF SPP4%(D)=0 THEN SPP4%(D)=-32768
  325. 3990     PRINT #1,SPP1%(D);SPP2%(D);SPP3%(D);SPP4%(D);
  326. 4000 NEXT
  327. 4010 FOR D=0 TO 10
  328. 4020     PRINT #1,CG(D);CR(D);CB(D);
  329. 4030 NEXT
  330. 4040 CLOSE
  331. 4050 LOCATE 23,23:PRINT"セーブ終了                         " 
  332. 4060 RETURN
  333. 4070 '
  334. 4080 '-----パターンロード
  335. 4090 '
  336. 4100 COU=0:X1=1:Y1=1:X2=82:Y2=82
  337. 4110 LOCATE 23,23:INPUT"ロードファイルネーム";FL$
  338. 4120 LOCATE 23,21:PRINT"                                                                           "
  339. 4130 IF FL$="\" THEN LOCATE 23,23:PRINT"                                                ":RETURN
  340. 4140 OPEN "I",#1,FL$
  341. 4150 FOR D=0 TO 255
  342. 4160     INPUT#1,SPP1%(D),SPP2%(D),SPP3%(D),SPP4%(D)
  343. 4170 GOSUB 4940
  344. 4180 NEXT
  345. 4190 FOR D=0 TO 9
  346. 4200     INPUT#1,CG(D),CR(D),CB(D)
  347. 4210 NEXT
  348. 4220 CLOSE
  349. 4230 LOCATE 23,23:PRINT"ロード終了                         "
  350. 4240 GOSUB 20000
  351. 4250 GOSUB 20050
  352. 4260 GOSUB 20100
  353. 4270 GOSUB 20150
  354. 4280 FOR D=1 TO 10
  355. 4290 LINE(D*10+1,170)-(D*10+1+8,178),PSET,[CG(D)*8,CR(D)*8,CB(D)*8],BF
  356. 4300 NEXT
  357. 4310 RETURN
  358. 4320 '
  359. 4330 '-----ＢＡＳＩＣ変換ルーチン
  360. 4340 '
  361. 4350 GOSUB 3790
  362. 4360 D=0
  363. 4370 LOCATE 23,23:INPUT"変換後のファイル名";FL$
  364. 4380 'LOCATE 23,23:INPUT"黒を透明色にしますか(Y/N)";TOU$
  365. 4390 LOCATE 23,21:PRINT"                                                                           "
  366. 4400 IF FL$="\" THEN LOCATE 23,23:PRINT"                                                ":RETURN
  367. 4410 OPEN "O",#1,FL$
  368. 4420 PRINT #1,"60000 '--------------------左上パターンデータ"
  369. 4430 FOR GYO=60010 TO 60160 STEP 10
  370. 4440     PRINT #1,GYO;"DATA ";
  371. 4450         FOR COU=1 TO 16
  372. 4460             IF COU=16 THEN SS$="" ELSE SS$=","
  373. 4470             IF SPP1%(D)=0 THEN SPP1%(D)=-32768
  374. 4480             PRINT #1,SPP1%(D);SS$;
  375. 4490             D=D+1
  376. 4500         NEXT
  377. 4510     PRINT #1,CHR$(13)
  378. 4520 NEXT
  379. 4530 D=0
  380. 4540 PRINT #1,"61000 '--------------------右上パターンデータ"
  381. 4550 FOR GYO=61010 TO 61160 STEP 10
  382. 4560     PRINT #1,GYO;"DATA ";
  383. 4570         FOR COU=1 TO 16
  384. 4580             TT%=SPP2%(D)
  385. 4590             IF SPP2%(D)=0 THEN SPP2%(D)=-32768
  386. 4600             IF COU=16 THEN SS$="" ELSE SS$=","
  387. 4610             PRINT #1,SPP2%(D);SS$;
  388. 4620             D=D+1
  389. 4630         NEXT
  390. 4640     PRINT #1,CHR$(13)
  391. 4650 NEXT
  392. 4660 D=0
  393. 4670 PRINT #1,"62000 '--------------------左下パターンデータ"
  394. 4680 FOR GYO=62010 TO 62160 STEP 10
  395. 4690     PRINT #1,GYO;"DATA ";
  396. 4700         FOR COU=1 TO 16
  397. 4710             IF SPP3%(D)=0 THEN SPP3%(D)=-32768
  398. 4720             IF COU=16 THEN SS$="" ELSE SS$=","
  399. 4730             PRINT #1,SPP3%(D);SS$;
  400. 4740             D=D+1
  401. 4750         NEXT
  402. 4760     PRINT #1,CHR$(13)
  403. 4770 NEXT
  404. 4780 D=0
  405. 4790 PRINT #1,"63000 '--------------------右下パターンデータ"
  406. 4800 FOR GYO=63010 TO 63160 STEP 10
  407. 4810     PRINT #1,GYO;"DATA ";
  408. 4820         FOR COU=1 TO 16
  409. 4830             IF SPP4%(D)=0 THEN SPP4%(D)=-32768
  410. 4840             IF COU=16 THEN SS$="" ELSE SS$=","
  411. 4850             PRINT #1,SPP4%(D);SS$;
  412. 4860             D=D+1
  413. 4870         NEXT
  414. 4880     PRINT #1,CHR$(13)
  415. 4890 NEXT
  416. 4900 CLOSE
  417. 4910 LOCATE 23,23:PRINT"終了                            "
  418. 4920 RETURN
  419. 4930 '
  420. 4940 '-----エディット用変換ルーチン
  421. 4950 '
  422. 4960 W1=SPP1%(D):IF W1=-32768 THEN W1=0
  423. 4970 W2=SPP2%(D):IF W2=-32768 THEN W2=0
  424. 4980 W3=SPP3%(D):IF W3=-32768 THEN W3=0
  425. 4990 W4=SPP4%(D):IF W4=-32768 THEN W4=0
  426. 5000 G1=W1 \ 1024
  427. 5010 G2=W2 \ 1024
  428. 5020 G3=W3 \ 1024
  429. 5030 G4=W4 \ 1024
  430. 5040 R1=(W1-G1*1024) \ 32
  431. 5050 R2=(W2-G2*1024) \ 32
  432. 5060 R3=(W3-G3*1024) \ 32
  433. 5070 R4=(W4-G4*1024) \ 32
  434. 5080 B1=W1-G1*1024-R1*32
  435. 5090 B2=W2-G2*1024-R2*32
  436. 5100 B3=W3-G3*1024-R3*32
  437. 5110 B4=W4-G4*1024-R4*32
  438. 5120 LINE(X1,Y1)-(X1+4,Y1+4),PSET,[G1*8,R1*8,B1*8],BF
  439. 5130 LINE(X2,Y1)-(X2+4,Y1+4),PSET,[G2*8,R2*8,B2*8],BF
  440. 5140 LINE(X1,Y2)-(X1+4,Y2+4),PSET,[G3*8,R3*8,B3*8],BF
  441. 5150 LINE(X2,Y2)-(X2+4,Y2+4),PSET,[G4*8,R4*8,B4*8],BF
  442. 5160 X1=X1+5:X2=X2+5
  443. 5170 COU=COU+1
  444. 5180 IF COU>15 THEN X1=1:X2=82:Y1=Y1+5:Y2=Y2+5:COU=0
  445. 5190  RETURN
  446. 5200 '
  447. 5210 '------ファイルエラールーチン
  448. 5220 '
  449. 5230 IF ERR=63 THEN COLOR 2:LOCATE 23,22:PRINT"指定のファイルがありません｡もう一度指定してください。":COLOR 7:RESUME 4110
  450. 5240 IF ERR=64 THEN COLOR 2:LOCATE 23,22:INPUT"ファイル名が重複します。書換えますか(Y/N)",P$:COLOR 7:IF P$="Y" OR P$="y" THEN RESUME 5270 ELSE CLOSE:IF ERL=3930 THEN RESUME 3900 ELSE IF ERL=4410 THEN RESUME 4370
  451. 5250 PRINT "エラーです。行番号";ERL;"エラー番号";ERR:END
  452. 5260 '
  453. 5270 '-----ＫＩＬＬルーチン
  454. 5280 '
  455. 5290 CLOSE
  456. 5300 KILL FL$
  457. 5310 IF ERL=3930 THEN 3910
  458. 5320 IF ERL=4410 THEN 4390
  459. 10000 '******************** 左上回転
  460. 10005 WX=0
  461. 10010 FOR KC2=0 TO 15
  462. 10020   FOR KC1=15 TO 0 STEP -1
  463. 10030     NX=16*KC1+KC2
  464. 10040     CSP%(NX)=SPP1%(WX)
  465. 10050     WX=WX+1
  466. 10060   NEXT
  467. 10070 NEXT
  468. 10080 FOR KC=0 TO 255
  469. 10090   SPP1%(KC)=CSP%(KC)
  470. 10100 NEXT
  471. 10110 GOSUB 20000
  472. 10112 GOSUB 35000
  473. 10120 RETURN
  474. 10200 '******************** 右上回転
  475. 10205 WX=0
  476. 10210 FOR KC2=0 TO 15
  477. 10220   FOR KC1=15 TO 0 STEP -1
  478. 10230     NX=16*KC1+KC2
  479. 10240     CSP%(NX)=SPP2%(WX)
  480. 10250     WX=WX+1
  481. 10260   NEXT
  482. 10270 NEXT
  483. 10280 FOR KC=0 TO 255
  484. 10290   SPP2%(KC)=CSP%(KC)
  485. 10300 NEXT
  486. 10310 GOSUB 20050
  487. 10312 GOSUB 35200
  488. 10320 RETURN
  489. 10400 '******************** 左下回転
  490. 10405 WX=0
  491. 10410 FOR KC2=0 TO 15
  492. 10420   FOR KC1=15 TO 0 STEP -1
  493. 10430     NX=16*KC1+KC2
  494. 10440     CSP%(NX)=SPP3%(WX)
  495. 10450     WX=WX+1
  496. 10460   NEXT
  497. 10470 NEXT
  498. 10480 FOR KC=0 TO 255
  499. 10490   SPP3%(KC)=CSP%(KC)
  500. 10500 NEXT
  501. 10510 GOSUB 20100
  502. 10512 GOSUB 35400
  503. 10520 RETURN
  504. 10600 '******************** 右下回転
  505. 10605 WX=0
  506. 10610 FOR KC2=0 TO 15
  507. 10620   FOR KC1=15 TO 0 STEP -1
  508. 10630     NX=16*KC1+KC2
  509. 10640     CSP%(NX)=SPP4%(WX)
  510. 10650     WX=WX+1
  511. 10660   NEXT
  512. 10670 NEXT
  513. 10680 FOR KC=0 TO 255
  514. 10690   SPP4%(KC)=CSP%(KC)
  515. 10700 NEXT
  516. 10710 GOSUB 20150
  517. 10712 GOSUB 35600
  518. 10720 RETURN
  519. 20000 '********** 左上ＰＵＴ
  520. 20010 PUT@A (201,1)-(216,16),SPP1%
  521. 20020 RETURN
  522. 20050 '********** 右上ＰＵＴ
  523. 20060 PUT@A (218,1)-(233,16),SPP2%
  524. 20070 RETURN
  525. 20100 '********** 左下ＰＵＴ
  526. 20110 PUT@A (201,18)-(216,33),SPP3%
  527. 20120 RETURN
  528. 20150 '********** 右下ＰＵＴ
  529. 20160 PUT@A (218,18)-(233,33),SPP4%
  530. 20170 RETURN
  531. 30000 '********** 回転位置
  532. 30005 GOSUB 3790
  533. 30010 KAPX=PX \ 80
  534. 30020 KAPY=PY \ 80
  535. 30030 IF (KAPX=0 AND KAPY=0) THEN GOSUB 10000
  536. 30040 IF (KAPX=1 AND KAPY=0) THEN GOSUB 10200
  537. 30050 IF (KAPX=0 AND KAPY=1) THEN GOSUB 10400
  538. 30060 IF (KAPX=1 AND KAPY=1) THEN GOSUB 10600
  539. 30070 RETURN
  540. 31000 '********** コピー元
  541. 31005 GOSUB 3790
  542. 31010 COPSX=PX \ 80
  543. 31020 COPSY=PY \ 80
  544. 31030 IF (COPSX=0 AND COPSY=0) THEN SCOPY=1:GOTO 31080
  545. 31040 IF (COPSX=1 AND COPSY=0) THEN SCOPY=2:GOTO 31080
  546. 31050 IF (COPSX=0 AND COPSY=1) THEN SCOPY=3:GOTO 31080
  547. 31060 IF (COPSX=1 AND COPSY=1) THEN SCOPY=4:GOTO 31080
  548. 31070 SCOPY=0
  549. 31080 LINE(310,75)-(319,84),PSET,7,BF
  550. 31090 FOR T=1 TO 3000:NEXT
  551. 31100 RETURN
  552. 32000 '********** コピー先
  553. 32005 GOSUB 3790
  554. 32010 COPDX=PX \ 80
  555. 32020 COPDY=PY \ 80
  556. 32030 IF (COPDX=0 AND COPDY=0) THEN DCOPY=1:GOTO 32070
  557. 32040 IF (COPDX=1 AND COPDY=0) THEN DCOPY=2:GOTO 32070
  558. 32050 IF (COPDX=0 AND COPDY=1) THEN DCOPY=3:GOTO 32070
  559. 32060 IF (COPDX=1 AND COPDY=1) THEN DCOPY=4:GOTO 32070
  560. 32062 LINE(310,75)-(319,84),PSET,4,BF
  561. 32064 DCOPY=0:SCOPY=0:COFLG=0:RETURN
  562. 32070 '***** コピー
  563. 32080 IF SCOPY=DCOPY THEN 32210
  564. 32090 IF (SCOPY=1) AND (DCOPY=2) THEN GOSUB 32300
  565. 32100 IF (SCOPY=1) AND (DCOPY=3) THEN GOSUB 32400
  566. 32110 IF (SCOPY=1) AND (DCOPY=4) THEN GOSUB 32500
  567. 32120 IF (SCOPY=2) AND (DCOPY=1) THEN GOSUB 32600
  568. 32130 IF (SCOPY=2) AND (DCOPY=3) THEN GOSUB 32700
  569. 32140 IF (SCOPY=2) AND (DCOPY=4) THEN GOSUB 32800
  570. 32150 IF (SCOPY=3) AND (DCOPY=1) THEN GOSUB 32900
  571. 32160 IF (SCOPY=3) AND (DCOPY=2) THEN GOSUB 33000
  572. 32170 IF (SCOPY=3) AND (DCOPY=4) THEN GOSUB 33100
  573. 32180 IF (SCOPY=4) AND (DCOPY=1) THEN GOSUB 33200
  574. 32190 IF (SCOPY=4) AND (DCOPY=2) THEN GOSUB 33300
  575. 32200 IF (SCOPY=4) AND (DCOPY=3) THEN GOSUB 33400
  576. 32210 GOTO 32064
  577. 32300 '***** 左上→右上
  578. 32310 FOR D=0 TO 255
  579. 32320    SPP2%(D)=SPP1%(D)
  580. 32330 NEXT
  581. 32340 GOSUB 20050
  582. 32350 GOSUB 34000
  583. 32360 GOSUB 34550
  584. 32390 RETURN
  585. 32400 '***** 左上→左下
  586. 32410 FOR D=0 TO 255
  587. 32420    SPP3%(D)=SPP1%(D)
  588. 32430 NEXT
  589. 32440 GOSUB 20100
  590. 32450 GOSUB 34000
  591. 32460 GOSUB 34600
  592. 32490 RETURN
  593. 32500 '***** 左上→右下
  594. 32510 FOR D=0 TO 255
  595. 32520    SPP4%(D)=SPP1%(D)
  596. 32530 NEXT
  597. 32540 GOSUB 20150
  598. 32550 GOSUB 34000
  599. 32560 GOSUB 34650
  600. 32590 RETURN
  601. 32600 '***** 右上→左上
  602. 32610 FOR D=0 TO 255
  603. 32620    SPP1%(D)=SPP2%(D)
  604. 32630 NEXT
  605. 32640 GOSUB 20000
  606. 32650 GOSUB 34050
  607. 32660 GOSUB 34500
  608. 32690 RETURN
  609. 32700 '***** 右上→左下
  610. 32710 FOR D=0 TO 255
  611. 32720    SPP3%(D)=SPP2%(D)
  612. 32730 NEXT
  613. 32740 GOSUB 20100
  614. 32750 GOSUB 34050
  615. 32760 GOSUB 34600
  616. 32790 RETURN
  617. 32800 '***** 右上→右下
  618. 32810 FOR D=0 TO 255
  619. 32820    SPP4%(D)=SPP2%(D)
  620. 32830 NEXT
  621. 32840 GOSUB 20150
  622. 32850 GOSUB 34050
  623. 32860 GOSUB 34650
  624. 32890 RETURN
  625. 32900 '***** 左下→左上
  626. 32910 FOR D=0 TO 255
  627. 32920    SPP1%(D)=SPP3%(D)
  628. 32930 NEXT
  629. 32940 GOSUB 20000
  630. 32950 GOSUB 34100
  631. 32960 GOSUB 34500
  632. 32990 RETURN
  633. 33000 '***** 左下→右上
  634. 33010 FOR D=0 TO 255
  635. 33020    SPP2%(D)=SPP3%(D)
  636. 33030 NEXT
  637. 33040 GOSUB 20050
  638. 33050 GOSUB 34100
  639. 33060 GOSUB 34550
  640. 33090 RETURN
  641. 33100 '***** 左下→右下
  642. 33110 FOR D=0 TO 255
  643. 33120    SPP4%(D)=SPP3%(D)
  644. 33130 NEXT
  645. 33140 GOSUB 20150
  646. 33150 GOSUB 34100
  647. 33160 GOSUB 34650
  648. 33190 RETURN
  649. 33200 '***** 右下→左上
  650. 33210 FOR D=0 TO 255
  651. 33220    SPP1%(D)=SPP4%(D)
  652. 33230 NEXT
  653. 33240 GOSUB 20000
  654. 33250 GOSUB 34150
  655. 33260 GOSUB 34500
  656. 33290 RETURN
  657. 33300 '***** 右下→右上
  658. 33310 FOR D=0 TO 255
  659. 33320    SPP2%(D)=SPP4%(D)
  660. 33330 NEXT
  661. 33340 GOSUB 20050
  662. 33350 GOSUB 34150
  663. 33360 GOSUB 34550
  664. 33390 RETURN
  665. 33400 '***** 右下→左下
  666. 33410 FOR D=0 TO 255
  667. 33420    SPP3%(D)=SPP4%(D)
  668. 33430 NEXT
  669. 33440 GOSUB 20100
  670. 33450 GOSUB 34150
  671. 33460 GOSUB 34600
  672. 33490 RETURN
  673. 34000 '***** 左上ＧＥＴ
  674. 34010 GET@A (1,1)-(80,80),COSP%
  675. 34020 RETURN
  676. 34050 '***** 右上ＧＥＴ
  677. 34060 GET@A (82,1)-(161,80),COSP%
  678. 34070 RETURN
  679. 34100 '***** 左下ＧＥＴ
  680. 34110 GET@A (1,82)-(80,161),COSP%
  681. 34120 RETURN
  682. 34150 '***** 右下ＧＥＴ
  683. 34160 GET@A (82,82)-(161,161),COSP%
  684. 34170 RETURN
  685. 34500 '***** 左上ＰＵＴ
  686. 34510 PUT@A (1,1)-(80,80),COSP%
  687. 34520 RETURN
  688. 34550 '***** 右上ＰＵＴ
  689. 34560 PUT@A (82,1)-(161,80),COSP%
  690. 34570 RETURN
  691. 34600 '***** 左下ＰＵＴ
  692. 34610 PUT@A (1,82)-(80,161),COSP%
  693. 34620 RETURN
  694. 34650 '***** 右下ＰＵＴ
  695. 34660 PUT@A (82,82)-(161,161),COSP%
  696. 34670 RETURN
  697. 35000 '********** 左上エディット回転
  698. 35002 D=0
  699. 35010 FOR Y1=1 TO 76 STEP 5
  700. 35012   FOR X1=1 TO 76 STEP 5
  701. 35020     W1=SPP1%(D):IF W1=-32768 THEN W1=0
  702. 35030     G1=W1 \ 1024
  703. 35040     R1=(W1-G1*1024) \ 32
  704. 35050     B1=W1-G1*1024-R1*32
  705. 35100     LINE(X1,Y1)-(X1+4,Y1+4),PSET,[G1*8,R1*8,B1*8],BF
  706. 35110     D=D+1
  707. 35120   NEXT
  708. 35130 NEXT
  709. 35140 RETURN
  710. 35200 '********** 右上エディット回転
  711. 35202 D=0
  712. 35210 FOR Y1=1 TO 76 STEP 5
  713. 35212   FOR X1=82 TO 157 STEP 5
  714. 35220     W1=SPP2%(D):IF W1=-32768 THEN W1=0
  715. 35230     G1=W1 \ 1024
  716. 35240     R1=(W1-G1*1024) \ 32
  717. 35250     B1=W1-G1*1024-R1*32
  718. 35300     LINE(X1,Y1)-(X1+4,Y1+4),PSET,[G1*8,R1*8,B1*8],BF
  719. 35310     D=D+1
  720. 35320   NEXT
  721. 35330 NEXT
  722. 35340 RETURN
  723. 35400 '********** 左下エディット回転
  724. 35402 D=0
  725. 35410 FOR Y1=82 TO 157 STEP 5
  726. 35412   FOR X1=1 TO 76 STEP 5
  727. 35420     W1=SPP3%(D):IF W1=-32768 THEN W1=0
  728. 35430     G1=W1 \ 1024
  729. 35440     R1=(W1-G1*1024) \ 32
  730. 35450     B1=W1-G1*1024-R1*32
  731. 35500     LINE(X1,Y1)-(X1+4,Y1+4),PSET,[G1*8,R1*8,B1*8],BF
  732. 35510     D=D+1
  733. 35520   NEXT
  734. 35530 NEXT
  735. 35540 RETURN
  736. 35600 '********** 右下エディット回転
  737. 35602 D=0
  738. 35610 FOR Y1=82 TO 157 STEP 5
  739. 35612   FOR X1=82 TO 157 STEP 5
  740. 35620     W1=SPP4%(D):IF W1=-32768 THEN W1=0
  741. 35630     G1=W1 \ 1024
  742. 35640     R1=(W1-G1*1024) \ 32
  743. 35650     B1=W1-G1*1024-R1*32
  744. 35700     LINE(X1,Y1)-(X1+4,Y1+4),PSET,[G1*8,R1*8,B1*8],BF
  745. 35710     D=D+1
  746. 35720   NEXT
  747. 35730 NEXT
  748. 35740 RETURN
  749.