home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 5 / FREESOFT.BIN / fb386 / pmbed / pmbed.bas < prev    next >
BASIC Source File  |  1992-08-19  |  67KB  |  1,976 lines

  1. 10000 DATA " ___________________________________________________________ "
  2. 10010 DATA "   PMBED Ver1.02     1992/01/26   Copyright(c) TETSU 1992-   "
  3. 10020 DATA "                    FileName=「PMBED.BAS」                     "
  4. 10030 DATA "                  FM-TOWNS用   要2MbyteRAM                   "
  5. 10040 DATA "                  F-BASIC386 V1.1L20 以降用                  "
  6. 10050 DATA "           カレントディレクトリに「mtrnsm.rex」が必要          "
  7. 10060 DATA " ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ "
  8. 10070 *INIT
  9. 10080   SCREEN@ 0: COLOR 7,0,7,0: CLS: WIDTH 80,25: CONSOLE 0,24,0
  10. 10090   PAL=0: FOR I=0 TO 15: PALETTE I,[PAL,PAL,PAL]: NEXT I
  11. 10100   COLOR 7,0,7,1: RESTORE
  12. 10110   FOR I=0 TO 6: READ I$: LOCATE 9,7+I: PRINT I$;: NEXT I
  13. 10120   COLOR 7,0,7,0
  14. 10130   CLEAR ,,512,,1000
  15. 10140   CLEAR ,,,FRE(4)-50000
  16. 10150   DEFLNG A-Z
  17. 10160   SMRTL=((FRE(3)-300000)\4)*2: PAL=0
  18. 10170   IF SMRTL<=0 THEN BEEP: PRINT "実行不能 もっとメモリーを!": END
  19. 10180   WINDOW(0,0)-(1023,511)
  20. 10190   VIEW  (0,0)-(1023,511)
  21. 10200   LINE  (0,0)-(1023,511),PSET,%7,BF
  22. 10210   MTRNSM=5: LOADM "mtrnsm.rex",MTRNSM
  23. 10220   DEF FNVRAM (X,Y)=INT((INT((X+8)/8)*(Y+1)*4+2-1)/2)
  24. 10230   DIM FSNAME$(99),FSSIZE(99),SID(99),FSP(99),FSF%(99)'*FSCHK 用
  25. 10240   PI!=3.14159!/2/127
  26. 10250   LOADWX=140: LOADWY=140: LFL$=""
  27. 10260   SAVEWX=160: SAVEWY=180: SFL$="" 
  28. 10270   ERRWX =220: ERRWY =180
  29. 10280   EXITWX=220: EXITWY=180
  30. 10290   OPTIWX=160: OPTIWY=180
  31. 10300   KX    = 11: KY    =427
  32. 10310   MX    =320: MY    =240
  33. 10320   RESTORE *INIT
  34. 10330   DIM N$(11): FOR I=0 TO 11: READ N$(I): NEXT I
  35. 10340   DATA C,C+,D,D+,E,F,F+,G,G+,A,A+,B
  36. 10350 '
  37. 10360 'INTERVAL 1: ON INTERVAL GOSUB *INTE: INTERVAL ON
  38. 10370 '
  39. 10380   GOSUB *BOX
  40. 10390   GOSUB *SYMBOL
  41. 10400   GOSUB *ENV_INIT
  42. 10410   GOSUB *KB_INIT
  43. 10420   GOSUB *V_INIT
  44. 10430   GOSUB *S_INIT
  45. 10440   GOSUB *BTN_INIT
  46. 10450   GOSUB *FSLCT_INIT
  47. 10460   GOSUB *PAL_INIT
  48. 10470   CLS 4
  49. 10480   ON ERROR GOTO *ERR
  50. 10490   MOUSE 0: MOUSE 1,320,240,1
  51. 10500 '
  52. 10510 *MAIN
  53. 10520   MOUSE 4,0,0,639,479
  54. 10530   GOSUB *MPLOOP1
  55. 10540   J=0
  56. 10550   FOR I=1 TO 17
  57. 10560     IF BTNX1%(I)<=MX AND BTNY1%(I)<=MY AND                                         MX<=BTNX2%(I) AND MY<=BTNY2%(I) AND                                         (BTNM%(I)=3 OR PUSH=BTNM%(I))       THEN J=I: I=17
  58. 10570   NEXT I
  59. 10580   ON J GOSUB  *KB     ,*ENV_OP ,*S_DATA_OP,*S_PLAY ,*PLAYOFF,*LOAD                       ,*SAVE   ,*EXIT   ,*OPTI     ,*BNK    ,*V_READ ,*V_SAVE                     ,*V_NAME ,*V_CLR  ,*V_SCRN   ,*S_DATA ,*S_KILL
  60. 10590 GOTO *MAIN
  61. 10600 '
  62. 10610 *BTN_INIT
  63. 10620   DIM BTNX1%(17),BTNY1%(17),BTNX2%(17),BTNY2%(17),BTNM%(17)
  64. 10630   RESTORE *BTN_INIT
  65. 10640   FOR I=1 TO 17
  66. 10650     READ BTNX1%(I),BTNY1%(I),BTNX2%(I),BTNY2%(I),BTNM%(I)
  67. 10660   NEXT I
  68. 10670 RETURN
  69. 10680 DATA 011,427,627,477,1'*KB
  70. 10690 DATA 000,158,638,400,3'*ENV_OP
  71. 10700 DATA 410, 46,557,150,3'*S_DATA_OP
  72. 10710 DATA 205,070,270,085,3'*S_PLAY
  73. 10720 DATA 564,108,638,156,3'*PLAYOFF
  74. 10730 DATA 564,020,638,040,1'*LOAD
  75. 10740 DATA 564,042,638,062,1'*SAVE
  76. 10750 DATA 564,064,638,084,1'*EXIT
  77. 10760 DATA 564,086,638,106,1'*OPTI
  78. 10770 DATA 100,022,163,037,1'*BNK
  79. 10780 DATA 005,050,068,065,1'*V_READ
  80. 10790 DATA 005,070,068,085,1'*V_SAVE
  81. 10800 DATA 005,130,068,145,1'*V_NAME
  82. 10810 DATA 005,090,068,105,1'*V_CLR
  83. 10820 DATA 075,046,190,150,1'*V_SCRN
  84. 10830 DATA 272,046,400,150,1'*S_DATA
  85. 10840 DATA 205,050,270,065,1'*S_KILL
  86. 10850 '
  87. 10860 *PAL_INIT
  88. 10870   RESTORE *PAL_INIT
  89. 10880   DIM G(15),R(15),B(15)
  90. 10890   FOR I=0 TO 15
  91. 10900     READ G(I),R(I),B(I)
  92. 10910   NEXT I
  93. 10920   FOR I!=0 TO 1 STEP .2!
  94. 10930     FOR J=0 TO 15
  95. 10940     PALETTE J,[PAL+(G(J)-PAL)*I!,PAL+(R(J)-PAL)*I!,PAL+(B(J)-PAL)*I!]
  96. 10950     NEXT J
  97. 10960   NEXT I!
  98. 10970   FOR J=0 TO 15
  99. 10980     PALETTE J,[G(J),R(J),B(J)]
  100. 10990   NEXT J
  101. 11000   ERASE G,R,B
  102. 11010 RETURN
  103. 11020 DATA 000,000,000 , 000,000,128 , 000,128,000 , 000,128,128
  104. 11030 DATA 128,000,000 , 128,000,128 , 128,128,000 , 128,128,128
  105. 11040 DATA 040,040,040 , 000,000,255 , 000,255,000 , 000,255,255
  106. 11050 DATA 255,000,000 , 255,000,255 , 255,255,000 , 255,255,255
  107. 11060 '
  108. 11070 '
  109. 11080 '
  110. 11090 *BOX_PR
  111. 11100   LINE(X1,Y1)-(X2,Y2),PSET,7,BF,%7
  112. 11110   CONNECT(X1,Y2)-(X2,Y2)-(X2,Y1),0
  113. 11120 RETURN
  114. 11130 '
  115. 11140 *BOX
  116. 11150   RESTORE *BOX
  117. 11160   READ X1,Y1,X2,Y2
  118. 11170   WHILE X1<>-1
  119. 11180     GOSUB *BOX_PR
  120. 11190     READ X1,Y1,X2,Y2
  121. 11200   WEND
  122. 11210 RETURN
  123. 11220 DATA 001,001,638,018'title
  124. 11230 DATA   0, 20,198, 39'バンクネ-ム
  125. 11240 DATA   0, 40,198,156'音色達
  126. 11250 DATA 170,150, 75, 46'VOICE_NAMES
  127. 11260 DATA 191,150,172, 46'VOICE_BAR
  128. 11270 DATA 173, 47,190, 65'V_▲
  129. 11280 DATA 173,131,190,149'V_▼
  130. 11290 DATA  72,150,  3,125'V_NAME
  131. 11300 DATA 200, 20,562, 39'登録サウンド
  132. 11310 DATA 200, 40,562,156'サウンドFILES
  133. 11320 DATA 380,150,272, 46'サウンドFILENAMES
  134. 11330 DATA 557,150,410, 46'サウンドDATA
  135. 11340 DATA 401,150,382, 46'サウンドBAR
  136. 11350 DATA 383, 47,400, 65'S_▲
  137. 11360 DATA 383,131,400,149'S_▼
  138. 11370 DATA 564, 20,638, 40'LOAD
  139. 11380 DATA 564, 42,638, 62'SAVE
  140. 11390 DATA 564, 64,638, 84'EXIT
  141. 11400 DATA 564, 86,638,106'OPTI
  142. 11410 DATA 564,108,638,156'PLAYOFF
  143. 11420 DATA   0,158, 79,400'ENV
  144. 11430 DATA  77,237,  1,178'ENV
  145. 11440 DATA   0,401,639,478'KB
  146. 11450 DATA  -1, -1, -1, -1
  147. 11460 '
  148. 11470 *SYMBOL
  149. 11480   RESTORE *SYMBOL
  150. 11490   READ X,Y,A$
  151. 11500   WHILE X<>-1
  152. 11510     SYMBOL(X,Y),A$,1,1,0
  153. 11520     READ X,Y,A$
  154. 11530   WEND
  155. 11540 RETURN
  156. 11550 DATA  30,  3,PMBED  Ver1.02
  157. 11560 DATA 500,  3,(c) TETSU 1992-
  158. 11570 DATA   5, 22,instDATA
  159. 11580 DATA   5, 50,読み込み
  160. 11590 DATA   5, 70,保存
  161. 11600 DATA   5, 90,初期化
  162. 11610 DATA 174, 49,▲
  163. 11620 DATA 174,133,▼
  164. 11630 DATA 205, 22,sndDATA
  165. 11640 DATA 415, 22,メモリー
  166. 11650 DATA 205, 50,削除
  167. 11660 DATA 205, 70,PLAY
  168. 11670 DATA 384, 49,▲
  169. 11680 DATA 384,133,▼
  170. 11690 DATA 415, 50,Name
  171. 11700 DATA 415, 70,Rate
  172. 11710 DATA 415, 90,補正
  173. 11720 DATA 415,110,音階
  174. 11730 DATA 415,130,Size
  175. 11740 DATA 570, 23,LOAD
  176. 11750 DATA 570, 45,SAVE
  177. 11760 DATA 570, 67,EXIT
  178. 11770 DATA 570, 89,OPTI
  179. 11780 DATA 570,115,PLAY
  180. 11790 DATA 577,135,OFF
  181. 11800 DATA 459, 90,<        >
  182. 11810 DATA 459,110,<        > 
  183. 11820 DATA  -1, -1,END
  184. 11830 '
  185. 11840 *MPLOOP1
  186. 11850   PUSH=0
  187. 11860   WHILE PUSH=0
  188. 11870     IF MOUSE(2,0)=-1 THEN PUSH=1
  189. 11880     IF MOUSE(2,1)=-1 THEN PUSH=2
  190. 11890   WEND
  191. 11900   MX=MOUSE(0):MY=MOUSE(1)
  192. 11910 RETURN
  193. 11920 '
  194. 11930 *MPLOOP2
  195. 11940   WHILE MOUSE(2,0)=-1 OR MOUSE(2,1)=-1: WEND
  196. 11950 RETURN
  197. 11960 '
  198. 11970 *INP_INIT
  199. 11980   IF IPC=1 GOSUB *INP_END
  200. 11990   IA2$=IA$: IPC=1: IC=0: IP=0: IP2=IP: IXS=8*IM-1
  201. 12000   DIM IA%(FNVRAM(IXS+8,15))
  202. 12010   GET@A(IX,IY)-(IX+IXS+8,IY+15),IA%
  203. 12020   GOSUB *INP_PR_2
  204. 12030   WHILE INKEY$<>"": WEND
  205. 12040 RETURN
  206. 12050 '
  207. 12060 *INP
  208. 12070   IC=0
  209. 12080   IF MOUSE(2,0)=-1 GOSUB *INP_MOUSE
  210. 12090   I$=INKEY$
  211. 12100   IF I$="" RETURN
  212. 12110   J$=INKEY$
  213. 12120   WHILE J$<>"": I$=J$: J$=INKEY$: WEND
  214. 12130   IC=ASC(I$)
  215. 12140   IF IC=&H1D THEN IP2=IP-1: GOSUB *INP_PR: RETURN              '←
  216. 12150   IF IC=&H1C THEN IP2=IP+1: GOSUB *INP_PR: RETURN              '→
  217. 12160   IF IC=&H08 AND 0<IP THEN IA2$=LEFT$(IA$,IP-1)+MID$(IA$,IP+1):                                        IP2=IP-1: GOSUB *INP_PR: RETURN     'BS
  218. 12170   IF IC=&H7F THEN IA2$=LEFT$(IA$,IP)+MID$(IA$,IP+2):                                          IP2=IP: GOSUB *INP_PR: RETURN                'DEL
  219. 12180   IF IC=&H05 THEN IA2$=LEFT$(IA$,IP): GOSUB *INP_PR:                                          IP2=IP: RETURN                               's^DEL
  220. 12190   IF IC=&H1B THEN GOSUB *INP_ESC: RETURN                       'ESC
  221. 12200   IF IC<=&H1F OR IMM<=LEN(IA$) RETURN
  222. 12210   IA2$=LEFT$(IA$,IP)+I$+MID$(IA$,IP+1): IP2=IP+LEN(I$)
  223. 12220   GOSUB *INP_PR
  224. 12230 RETURN
  225. 12240 '
  226. 12250 *INP_MOUSE
  227. 12260   MX=MOUSE(0)-IX: MY=MOUSE(1)-IY
  228. 12270   IF MX<0 OR IXS<MX OR MY<0 OR 15<MY RETURN
  229. 12280   MOUSE 4,IX,IY,IX+IXS,IY+15
  230. 12290   IP2=(IP\IM)*IM+MX\8
  231. 12300   IF MX<=0   AND 0<IP2     THEN IP2=(IP\IM-1)*IM: MOUSE 1,IX+IXS-1,,1
  232. 12310   IF IXS<=MX AND IP2<IMM-1 AND IP2<LEN(IA2$)                                                           THEN IP2=(IP\IM+1)*IM: MOUSE 1,IX+1,,1
  233. 12320   GOSUB *INP_PR
  234. 12330 RETURN
  235. 12340 '
  236. 12350 *INP_PR
  237. 12360   IF IP2<0 THEN IP2=0
  238. 12370   IF LEN(IA2$)<IP2 THEN IP2=LEN(IA2$)
  239. 12380   IF IMM<=IP2 THEN IP2=IMM-1
  240. 12390   IF IP2=IP AND IA2$=IA$ THEN RETURN
  241. 12400   IP=IP2: IA$=IA2$
  242. 12410 *INP_PR_2
  243. 12420   I=(IP\IM)*IM: J=IP MOD IM
  244. 12430   PUT@A(IX,IY)-(IX+IXS+8,IY+15),IA%
  245. 12440   SYMBOL(IX,IY),MID$(IA$,I+1,IM),1,1,%ICL
  246. 12450   LINE(IX+8*J,IY)-STEP(1,15),PSET,2,B
  247. 12460 RETURN
  248. 12470 '
  249. 12480 *INP_END
  250. 12490   IF IPC=0 THEN RETURN
  251. 12500   IPC=0
  252. 12510   PUT@A(IX,IY)-(IX+IXS+8,IY+15),IA%
  253. 12520   SYMBOL(IX,IY),MID$(IA$,1,IM),1,1,%ICL
  254. 12530   ERASE IA%
  255. 12540 RETURN
  256. 12550 '
  257. 12560 *INP_ESC
  258. 12570   DIM IB%(FNVRAM(639,104))
  259. 12580   GET@A(0,375)-(639,479),IB%
  260. 12590   LINE(-1,375)-(640,480),PSET,0,BF,7
  261. 12600   CONSOLE 20,4,1: COLOR 1,,,4: LOCATE 0,20
  262. 12610   LINE INPUT I$
  263. 12620   IF I$<>"" THEN IA2$=LEFT$(I$,IMM): IP2=0
  264. 12630   CONSOLE 0,23,0: CLS 4
  265. 12640   PUT@A(0,375)-(639,479),IB%
  266. 12650   ERASE IB%
  267. 12660   GOSUB *INP_PR
  268. 12670 RETURN
  269. 12680 '
  270. 12690 *WIN_ON
  271. 12700   VIEW  (WX+5,WY+5)-(WX+WXS-10,WY+WYS-10)
  272. 12710   WINDOW(WX+5,WY+5)-(WX+WXS-10,WY+WYS-10)
  273. 12720 RETURN
  274. 12730 '
  275. 12740 *WIN_OFF
  276. 12750   VIEW  (0,0)-(1023,511)
  277. 12760   WINDOW(0,0)-(1023,511)
  278. 12770 RETURN
  279. 12780 '
  280. 12790 *WIN_INIT
  281. 12800   IF WPC=1 GOSUB *WIN_END
  282. 12810   IF FRE(3)<(WXS+32)*WYS/2*2+WON*8 THEN ERRF=1: RETURN
  283. 12820   WPC=1: WC=-2: WCL=10: I=1
  284. 12830   DIM WA%(FNVRAM(WXS,WYS)),WB%(FNVRAM(WXS,WYS)),WOZ(WON,3)
  285. 12840   IF 639<WX+WXS THEN WX=639-WXS
  286. 12850   IF 479<WY+WYS THEN WY=479-WYS
  287. 12860   GET@A(WX,WY)-(WX+WXS,WY+WYS),WA%
  288. 12870   LINE(WX,WY)-(WX+WXS,WY+WYS),PSET,%7,BF
  289. 12880   LINE(WX+3,WY+3)-(WX+WXS,WY+WYS),PSET,%8,BF
  290. 12890   LINE(WX,WY)-(WX+WXS-3,WY+WYS-3),PSET,0,BF,7
  291. 12900   WHILE I<=WON AND (WF AND 2)=0
  292. 12910     FOR J=0 TO 3: READ WOZ(I,J): NEXT J
  293. 12920     LINE(WX+WOZ(I,0),WY+WOZ(I,1))-(WX+WOZ(I,2),WY+WOZ(I,3)),PSET,0,B
  294. 12930     I=I+1
  295. 12940   WEND
  296. 12950 RETURN
  297. 12960 '
  298. 12970 *WIN
  299. 12980   IF MOUSE(2,0)=0 THEN WC=-2: RETURN
  300. 12990   MX=MOUSE(0)-WX: MY=MOUSE(1)-WY
  301. 13000   IF MX<0 OR MY<0 OR WXS<MX OR WYS<MY THEN WC=0: RETURN
  302. 13010   WC=-3: I=1
  303. 13020   WHILE I<=WON
  304. 13030     IF WOZ(I,0)<=MX AND WOZ(I,1)<=MY AND                                           MX<=WOZ(I,2) AND MY<=WOZ(I,3) THEN WC=I: I=WON
  305. 13040     I=I+1
  306. 13050   WEND
  307. 13060   IF 1<=WC OR (WF AND 1) THEN RETURN
  308. 13070   WC=-1
  309. 13080   X=MX: Y=MY: MX=WX: MY=WY
  310. 13090   MOUSE 4,X,Y,639-WXS+X,479-WYS+Y
  311. 13100   LINE(MX,MY)-STEP(WXS,WYS),XOR,%WCL,B
  312. 13110   WHILE MOUSE(2,0)=-1
  313. 13120     WHILE MOUSE(9)=0 AND MOUSE(10)=0 AND MOUSE(2,0)=-1: WEND
  314. 13130     LINE(MX,MY)-STEP(WXS,WYS),XOR,%WCL,B
  315. 13140     MX=MOUSE(0)-X: MY=MOUSE(1)-Y
  316. 13150     LINE(MX,MY)-STEP(WXS,WYS),XOR,%WCL,B
  317. 13160   WEND
  318. 13170   LINE(MX,MY)-STEP(WXS,WYS),XOR,%WCL,B
  319. 13180   GET@A(WX,WY)-(WX+WXS,WY+WYS),WB%
  320. 13190   PUT@A(WX,WY)-(WX+WXS,WY+WYS),WA%
  321. 13200   GET@A(MX,MY)-(MX+WXS,MY+WYS),WA%
  322. 13210   PUT@A(MX,MY)-(MX+WXS,MY+WYS),WB%
  323. 13220   WX=MX: WY=MY
  324. 13230 RETURN
  325. 13240 '
  326. 13250 *WIN_END
  327. 13260   IF WPC=0 THEN RETURN
  328. 13270   WPC=0
  329. 13280   PUT@A(WX,WY)-(WX+WXS,WY+WYS),WA%
  330. 13290   ERASE WA%,WB%,WOZ
  331. 13300 RETURN
  332. 13310 '
  333. 13320 *KB_INIT
  334. 13330   PART 6,6
  335. 13340   DIM KZ(11,4)
  336. 13350   RESTORE *KB_INIT
  337. 13360   FOR I=0 TO 11
  338. 13370     FOR J=0 TO 4
  339. 13380       READ KZ(I,J)
  340. 13390     NEXT J
  341. 13400   NEXT I
  342. 13410   DATA  0, 0,11,50, 0  '0  C
  343. 13420   DATA 11, 0,22,50, 2  '1  D
  344. 13430   DATA 22, 0,33,50, 4  '2  E
  345. 13440   DATA 33, 0,44,50, 5  '3  F
  346. 13450   DATA 44, 0,55,50, 7  '4  G
  347. 13460   DATA 55, 0,66,50, 9  '5  A
  348. 13470   DATA 66, 0,77,50,11  '6  B
  349. 13480   DATA 08, 0,14,30, 1  '7  C+
  350. 13490   DATA 19, 0,25,30, 3  '8  D+
  351. 13500   DATA 41, 0,47,30, 6  '9  F+
  352. 13510   DATA 52, 0,58,30, 8  '10 G+
  353. 13520   DATA 63, 0,69,30,10  '11 A+
  354. 13530   FOR I=0 TO 6 
  355. 13540     LINE(KX+KZ(I,0),KY)-(KX+KZ(I,2),KY+KZ(I,3)),PSET,%8,BF,%15
  356. 13550   NEXT I
  357. 13560   FOR I=7 TO 11
  358. 13570     LINE(KX+KZ(I,0),KY)-(KX+KZ(I,2),KY+KZ(I,3)),PSET,%8,BF,%8
  359. 13580   NEXT I
  360. 13590   CIRCLE(KX+5,KY+45),2,%10,,,,F
  361. 13600   DIM A%(FNVRAM(77,50))
  362. 13610   GET@A(KX,KY)-(KX+77,KY+50),A%
  363. 13620   FOR X=KX+77 TO KX+539 STEP 77
  364. 13630     PUT@A(X,KY)-(X+77,KY+50),A%
  365. 13640   NEXT X
  366. 13650   ERASE A%
  367. 13660 RETURN
  368. 13670 '
  369. 13680 *KB
  370. 13690   MOUSE 4,KX,KY,KX+615,KY+50
  371. 13700   KN=-1
  372. 13710   WHILE MOUSE(2,0)=-1
  373. 13720     X=MOUSE(0)-KX: Y=MOUSE(1)-KY
  374. 13730     O=X\77: X=X MOD 77
  375. 13740     FOR I=0 TO 11
  376. 13750       IF KZ(I,0)<=X AND X<=KZ(I,2) AND Y<=KZ(I,3) THEN J=KZ(I,4)
  377. 13760     NEXT I
  378. 13770     A$=N$(J)+"&": J=12*O+J
  379. 13780     WHILE KN<>J
  380. 13790       KN=J: SC=0
  381. 13800       FOR I=0 TO 7
  382. 13810         IF KN<=UL%(I+1) THEN SC=ID(I): I=7
  383. 13820       NEXT I
  384. 13830       DIM A%(SSIZE(SC)\2)
  385. 13840       CALLM MTRNSM,VARPTR(SDM%(0))+SDMP(SC),VARPTR(A%(0)),SSIZE(SC)
  386. 13850       VOICE SET A%
  387. 13860       VOICE 1,V%,1
  388. 13870       PLAY OFF
  389. 13880       PLAY ,,,,,,"T30 @1 %C Q8 V15 L1 O"+STR$(O+1)+A$+A$+A$+A$+A$+A$
  390. 13890       ERASE A%
  391. 13900     WEND
  392. 13910   WEND
  393. 13920   PLAY OFF
  394. 13930 RETURN
  395. 13940 '
  396. 13950 *LOAD
  397. 13960   GOSUB *SMR_PR
  398. 13970   SYMBOL(570, 23),"LOAD",1,1,2
  399. 13980   WX=LOADWX: WY=LOADWY: WXS=360: WYS=190: WON=8: WF=0: MODE=0
  400. 13990   RESTORE *LOAD
  401. 14000   GOSUB*WIN_INIT
  402. 14010   DATA  28, 78,177, 97'1
  403. 14020   DATA  28,103,177,122'2
  404. 14030   DATA 183, 78,330, 97'3
  405. 14040   DATA 183,103,330,122'4
  406. 14050   DATA 150, 45,330, 65'文字入力
  407. 14060   DATA 220,140,270,160'実行
  408. 14070   DATA 280,140,330,160'取消
  409. 14080   DATA 280, 18,330, 38'FILES
  410. 14090   SYMBOL(WX+20,WY+20),"LOAD",1,1,0
  411. 14100   SYMBOL(WX+287,WY+21),"FILES",1,1,0
  412. 14110   SYMBOL(WX+55,WY+47),"ファイル名",1,1,0
  413. 14120   SYMBOL(WX+229,WY+142),"実行",1,1,0
  414. 14130   SYMBOL(WX+289,WY+142),"取消",1,1,0
  415. 14140   GOSUB *LOAD_MODE_PR
  416. 14150 *LOAD_2
  417. 14160   IX=WX+155: IY=WY+48: IM=21: IMM=84: IA$=LFL$: ICL=0
  418. 14170   LINE(IX,IY)-STEP(IM*8,15),PSET,7,BF
  419. 14180   GOSUB *INP_INIT
  420. 14190   GOSUB *MPLOOP2
  421. 14200 *LOAD_LOOP
  422. 14210   GOSUB *WIN
  423. 14220   LOADWX=WX: LOADWY=WY: IX=WX+155: IY=WY+48
  424. 14230   IF WC=1 OR IC=&H16 THEN MODE=1: GOSUB *LOAD_MODE_PR
  425. 14240   IF WC=2 OR IC=&H17 THEN MODE=2: GOSUB *LOAD_MODE_PR
  426. 14250   IF WC=3 OR IC=&H0B THEN MODE=3: GOSUB *LOAD_MODE_PR
  427. 14260   IF WC=4 OR IC=&H12 THEN MODE=4: GOSUB *LOAD_MODE_PR
  428. 14270   IF WC=5 THEN MOUSE 4,IX,IY,IX+IM*8,IY+15 ELSE MOUSE 4,0,0,639,479
  429. 14280   IF WC=6 OR IC=&H0D THEN GOTO *LOAD_CHK
  430. 14290   IF WC=7 OR MOUSE(2,1)=-1 OR IC=&H18                                            THEN GOSUB *INP_END: GOSUB *WIN_END: GOTO *LOAD_RET
  431. 14300   IF WC=8 THEN GOSUB *LOAD_FILES
  432. 14310   GOSUB *INP
  433. 14320   LFL$=IA$
  434. 14330 GOTO *LOAD_LOOP
  435. 14340 *LOAD_RET
  436. 14350   CLOSE
  437. 14360   FOR I=1 TO 4: KEY(I) OFF: NEXT I
  438. 14370   SYMBOL(570, 23),"LOAD",1,1,0
  439. 14380   GOSUB *MPLOOP2
  440. 14390 RETURN
  441. 14400 '
  442. 14410 *LOAD_FILES
  443. 14420   GOSUB *INP_END
  444. 14430   GOSUB *FSLCT
  445. 14440   LINE(WX+151,WY+46)-(WX+329,WY+64),PSET,7,BF
  446. 14450   IF FSLCT$<>"" THEN IA$=FSLCT$
  447. 14460   IX=WX+155: IY=WY+48: IM=21: IMM=84: ICL=0
  448. 14470   GOSUB *INP_INIT
  449. 14480 RETURN
  450. 14490 '
  451. 14500 *LOAD_CHK
  452. 14510   GOSUB *INP_END
  453. 14520   LINE(WX+40,WY+142)-STEP(160,15),PSET,7,BF
  454. 14530   IF MODE=0 THEN A$="Select a Mode": GOTO *LOAD_ERR_RET
  455. 14540   FL$=LFL$
  456. 14550   GOSUB *FLCNV
  457. 14560 '
  458. 14570   ON ERROR GOTO *LOAD_ERR
  459. 14580   OPEN "I",1,FL$: CLOSE
  460. 14590   ON ERROR GOTO *ERR
  461. 14600 '
  462. 14610   ERRF=0
  463. 14620   GOSUB *FLOAD_INIT
  464. 14630   IF ERRF THEN A$="Large File"+STR$(FLTL): GOTO *LOAD_ERR_RET
  465. 14640   IF MODE=4 THEN GOSUB *LOAD_CHK_SND ELSE GOSUB *LOAD_CHK_PMB
  466. 14650   IF ERRF THEN GOSUB *FLOAD_END: GOTO *LOAD_ERR_RET
  467. 14660   ON MODE GOSUB *LOAD_ALL,*LOAD_1V,*LOAD_SPMB,*LOAD_SSND
  468. 14670   GOSUB *FLOAD_END
  469. 14680 GOTO *LOAD_RET
  470. 14690 '
  471. 14700 *LOAD_CHK_SND
  472. 14710   IF 99<=SNMAX THEN A$="too Many Sounds 99": ERRF=1: RETURN
  473. 14720   IF FLTL<=32 THEN A$="Bad File Size": ERRF=1: RETURN
  474. 14730   FP=12: MP=VARPTR(TL): L=4: FLOADF=0
  475. 14740   GOSUB *FLOAD
  476. 14750   IF TL<=0     THEN A$="Bad File": ERRF=1: RETURN
  477. 14760   IF SMR<TL+32 THEN A$="Large File"+STR$(TL+32): ERRF=1: RETURN
  478. 14770 RETURN
  479. 14780 '
  480. 14790 *LOAD_CHK_PMB
  481. 14800   IF FLTL<4104 THEN A$="Bad File Size": ERRF=1: RETURN
  482. 14810   GOSUB *FSCHK
  483. 14820   IF MODE=3 AND FSNMAX=0  THEN A$="No Sound Data ": ERRF=1: RETURN
  484. 14830   IF MODE=3 AND 60<FSNMAX THEN A$="too Many Sounds"+STR$(FSNMAX):                                          ERRF=1: RETURN
  485. 14840 RETURN
  486. 14850 '
  487. 14860 *LOAD_ALL
  488. 14870   SFL$=LFL$
  489. 14880   GOSUB *WIN_ON
  490. 14890   MOUSE 1,,,0
  491. 14900   FSIX=WX+329: FSIY=WY+135
  492. 14910   LINE(WX+1,FSIY-1)-(FSIX+1,FSIY+35),PSET,7,BF
  493. 14920   LINE(FSIX-(FSTL+4104)/384-1,FSIY-1)-(FSIX+1,FSIY+9),PSET,0,B
  494. 14930   LINE(FSIX-4104/384,FSIY)-(FSIX,FSIY+8),PSET,6,BF
  495. 14940   FSN=1
  496. 14950   WHILE FSN<=FSNMAX
  497. 14960     LINE(FSIX-FSP(FSN)/384,FSIY)-STEP(0,8),PSET,%7
  498. 14970     FSN=FSN+1
  499. 14980   WEND
  500. 14990   GOSUB *WIN_OFF
  501. 15000   BNK$=FBNK$
  502. 15010   FP=8: L=4096: MP=VARPTR(ALLV%(0,0)): MSP=0: FLOADF=1
  503. 15020   GOSUB *FLOAD
  504. 15030 '
  505. 15040   FOR I=1 TO FSNMAX: FSF%(I)=1: NEXT I: SNMAX=0: SN=0: MSP=4104
  506. 15050   GOSUB *FSLOAD
  507. 15060 '
  508. 15070   MOUSE 1,,,1
  509. 15080 '
  510. 15090   P=VARPTR(ALLV%(0,0))
  511. 15100   FOR I=0 TO 31
  512. 15110     VNAME$(I)=""
  513. 15120     FOR J=0 TO 7
  514. 15130       K=PEEK(P+128*I+J)
  515. 15140       IF K=0 THEN J=7 ELSE VNAME$(I)=VNAME$(I)+CHR$(K)
  516. 15150     NEXT J
  517. 15160   NEXT I
  518. 15170 '
  519. 15180   FOR I=0 TO 31 
  520. 15190     FOR J=0 TO 7
  521. 15200       P1=P+128*I+32+4*J
  522. 15210       K=SEARCH(SID,PEEK(P1,4),1)   '{K:K=-1 OR 1<=K}
  523. 15220       IF K<1 OR SNMAX<K THEN K=0   '{K:0<=K<=SNMAX}
  524. 15230       SF%(K)=SF%(K)+1
  525. 15240       POKE P1,K,4
  526. 15250     NEXT J
  527. 15260   NEXT I
  528. 15270   FOR I=0 TO 7
  529. 15280     ID(I)=0
  530. 15290   NEXT I
  531. 15300   GOSUB *WIN_END
  532. 15310   GOSUB *V_INIT_1
  533. 15320   GOSUB *S_PR
  534. 15330   GOSUB *SMR_PR
  535. 15340   GOSUB *S_DATA_PR
  536. 15350   GOSUB *ENV_SNAME_PR
  537. 15360 RETURN
  538. 15370 '
  539. 15380 *LOAD_MODE_PR
  540. 15390   FOR J=0 TO 1
  541. 15400     SYMBOL(WX+ 30+J,WY+ 80),"全音色 データ .PMB",1,1,%(7-(MODE=1)*3)
  542. 15410     SYMBOL(WX+ 30+J,WY+105),"単一音色データ.PMB",1,1,%(7-(MODE=2)*3)
  543. 15420     SYMBOL(WX+185+J,WY+ 80),"サウンドデータ.PMB",1,1,%(7-(MODE=3)*3)
  544. 15430     SYMBOL(WX+185+J,WY+105),"サウンドデータ.SND",1,1,%(7-(MODE=4)*3)
  545. 15440   NEXT J
  546. 15450 RETURN
  547. 15460 '
  548. 15470 *LOAD_1V
  549. 15480   GOSUB *WIN_END
  550. 15490   RESTORE *LOAD_1V
  551. 15500   WX=LOADWX: WY=LOADWY: WXS=305: WYS=145: WON=5: WF=0
  552. 15510   GOSUB*WIN_INIT
  553. 15520   DIM FVNAME$(32),FALLV%(63,31),FVSIZE(32),FVSF%(31,99)
  554. 15530   FVN=0
  555. 15540   DATA 258, 38,280, 59'▲
  556. 15550   DATA 258, 61,280, 82'▼
  557. 15560   DATA 170,105,220,125'LOAD
  558. 15570   DATA 230,105,280,125'取消
  559. 15580   DATA 135, 38,256, 82'音色表示
  560. 15590   SYMBOL(WX+15,WY+15),"単一音色のLOAD",1,1,0
  561. 15600   SYMBOL(WX+25,WY+42),LEFT$(FL3$+"        ",8)+FL4$,1,1,0
  562. 15610   SYMBOL(WX+262,WY+41),"▲",1,1,%8
  563. 15620   SYMBOL(WX+262,WY+64),"▼",1,1,%8
  564. 15630   SYMBOL(WX+179,WY+108),"LOAD",1,1,0
  565. 15640   SYMBOL(WX+239,WY+107),"取消",1,1,0
  566. 15650   SYMBOL(WX+25,WY+62),FBNK$,1,1,0
  567. 15660 '
  568. 15670   FP=8: L=4096: MP=VARPTR(FALLV%(0,0)): MSP=0: FLOADF=0
  569. 15680   GOSUB *FLOAD
  570. 15690   P=VARPTR(FALLV%(0,0))
  571. 15700   FOR I=0 TO 31
  572. 15710     FOR J=0 TO 7
  573. 15720       K=PEEK(P+128*I+J)
  574. 15730       IF K=0 THEN J=7 ELSE FVNAME$(I)=FVNAME$(I)+CHR$(K)
  575. 15740     NEXT J
  576. 15750     FOR J=0 TO 7
  577. 15760       K=SEARCH(SID,PEEK(P+128*I+32+4*J,4),1)
  578. 15770       IF 1<=K AND K<=FSNMAX THEN FVSF%(I,K)=1
  579. 15780     NEXT J
  580. 15790     FOR J=1 TO FSNMAX
  581. 15800       IF FVSF%(I,J)=1 THEN FVSIZE(I)=FVSIZE(I)+FSSIZE(J)
  582. 15810     NEXT J
  583. 15820   NEXT I
  584. 15830   GOSUB *LOAD_1V_PR
  585. 15840   GOSUB *MPLOOP2
  586. 15850 *LOAD_1V_LOOP
  587. 15860   GOSUB *WIN
  588. 15870   LOADWX=WX: LOADWY=WY: MOUSE 4,0,0,639,479
  589. 15880   IF WC=1 THEN MOUSE 4,WX+258,WY+38,WX+280,WY+59: V=-1:                                    GOSUB *LOAD_1V_MOVE
  590. 15890   IF WC=2 THEN MOUSE 4,WX+258,WY+61,WX+280,WY+82: V= 1:                                    GOSUB *LOAD_1V_MOVE
  591. 15900   IF WC=3 THEN IF FVSIZE(FVN)<=SMR                                                             THEN GOSUB *LOAD_1V_EXE: GOTO *LOAD_1V_RET                                  ELSE BEEP: GOSUB *MPLOOP2
  592. 15910   IF WC=4 OR MOUSE(2,1)=-1 GOSUB *WIN_END: GOTO *LOAD_1V_RET
  593. 15920   IF WC=5 GOSUB *LOAD_1V_DATA
  594. 15930 GOTO *LOAD_1V_LOOP
  595. 15940 *LOAD_1V_RET
  596. 15950   ERASE FVNAME$,FALLV%,FVSIZE,FVSF%
  597. 15960 RETURN
  598. 15970 '
  599. 15980 *LOAD_1V_MOVE
  600. 15990   T=-1
  601. 16000   WHILE MOUSE(2,0)=-1
  602. 16010     I=FVN+V: T=T+1
  603. 16020     IF I<0 THEN I=0
  604. 16030     IF 31<I THEN I=31
  605. 16040     IF FVN<>I AND (T=0 OR 150<T) THEN FVN=I: GOSUB *LOAD_1V_PR
  606. 16050   WEND
  607. 16060 RETURN
  608. 16070 '
  609. 16080 *LOAD_1V_PR
  610. 16090   IF FVSIZE(FVN)<=SMR THEN CL=0 ELSE CL=2
  611. 16100   LINE(WX+135,WY+38)-(WX+256,WY+82),PSET,%8,BF,7
  612. 16110   SYMBOL(WX+137,WY+42),STR$(FVN+1),1,1,0
  613. 16120   SYMBOL(WX+167,WY+42),FVNAME$(FVN),1,1,0
  614. 16130   SYMBOL(WX+159,WY+62),STR$(FVSIZE(FVN)),1,1,CL
  615. 16140 RETURN
  616. 16150 '
  617. 16160 *LOAD_1V_DATA
  618. 16170   MX=MOUSE(0): MY=MOUSE(1): MOUSE 1,,,0
  619. 16180   X1=MX: Y1=MY: X2=165
  620. 16190   IF FSNMAX=0 OR 20<FSNMAX THEN Y2=30 ELSE Y2=20*FSNMAX+10
  621. 16200   IF 639<X1+X2 THEN X1=639-X2
  622. 16210   IF 479<Y1+Y2 THEN Y1=479-Y2
  623. 16220   DIM A%(FNVRAM(X2,Y2))
  624. 16230   GET@A(X1,Y1)-(X1+X2,Y1+Y2),A%
  625. 16240   LINE(X1+5,Y1+5)-STEP(X2-5,Y2-5),PSET,%8,BF
  626. 16250   LINE(X1,Y1)-STEP(X2-5,Y2-5),PSET,0,BF,7
  627. 16260   IF FSNMAX=0 THEN SYMBOL(X1+20,Y1+5),"No Sound Data",1,1,0:                                    GOTO *LOAD_1V_DATA_1
  628. 16270   IF 20<FSNMAX                                                                   THEN SYMBOL(X1+20,Y1+5),"Many Sounds"+STR$(FSNMAX),1,1,0:                        GOTO *LOAD_1V_DATA_1
  629. 16280   FOR I=1 TO FSNMAX
  630. 16290     SYMBOL(X1 ,Y1+20*I-15),STR$(I),1,1,0
  631. 16300     SYMBOL(X1+30,Y1+20*I-15),FSNAME$(I),1,1,0
  632. 16310     SYMBOL(X1+95,Y1+20*I-15),STR$(FSSIZE(I)),1,1,0
  633. 16320     IF FVSF%(FVN,I)=1 THEN CIRCLE(X1+150,Y1+20*(I-1)+12),2,2,,,,F
  634. 16330   NEXT I
  635. 16340 *LOAD_1V_DATA_1
  636. 16350   GOSUB *MPLOOP2
  637. 16360   PUT@A(X1,Y1)-(X1+X2,Y1+Y2),A%
  638. 16370   ERASE A%
  639. 16380   MOUSE 1,,,1
  640. 16390 RETURN
  641. 16400 '
  642. 16410 *LOAD_1V_EXE
  643. 16420   FSIX=WX+279: FSIY=WY+93: MSP=0
  644. 16430   GOSUB *WIN_ON
  645. 16440   LINE(WX+1,FSIY-1)-(WX+WXS-6,WY+WYS-5),PSET,7,BF
  646. 16450   FOR FSN=1 TO FSNMAX
  647. 16460     IF FVSF%(FVN,FSN)=1 THEN MSP=MSP+FSSIZE(FSN): FSF%(FSN)=1:                                         LINE(FSIX-MSP/384,FSIY)-STEP(0,8),PSET,%7                                ELSE FSF%(FSN)=0
  648. 16470   NEXT FSN
  649. 16480   LINE(FSIX-MSP/384,FSIY-1)-(FSIX+1,FSIY+9),PSET,%8,B'INDI
  650. 16490   GOSUB *WIN_OFF
  651. 16500   MOUSE 1,,,0
  652. 16510   MSP=0
  653. 16520   GOSUB *FSLOAD
  654. 16530   MOUSE 1,,,1
  655. 16540 '
  656. 16550   VNAME$=FVNAME$(FVN)
  657. 16560   P=VARPTR(FALLV%(0,0))+128*FVN
  658. 16570   FOR S=0 TO 7
  659. 16580     FOR I=0 TO 7
  660. 16590       ENV%(S,I)=PEEK(P+64+8*S+I)
  661. 16600     NEXT I
  662. 16610     IF &H80 AND ENV%(S,6) THEN ENV%(S,6)=ENV%(S,6)-256
  663. 16620     I=PEEK(P+16+2*S,2)-24
  664. 16630     IF I<0 THEN I=0
  665. 16640     IF 95<I THEN I=95
  666. 16650     UL%(S+1)=I
  667. 16660     J=SEARCH(SID,PEEK(P+32+4*S,4),SNMIN+1)
  668. 16670     IF SNMIN+1<=J AND J<=SNMAX THEN ID(S)=J ELSE ID(S)=0
  669. 16680   NEXT S
  670. 16690   GOSUB *WIN_END
  671. 16700   GOSUB *V_NAME_PR
  672. 16710   GOSUB *S_PR
  673. 16720   GOSUB *SMR_PR
  674. 16730   GOSUB *S_DATA_PR
  675. 16740   GOSUB *ENV_ALL_PR
  676. 16750   GOSUB *ENV_SET
  677. 16760 RETURN
  678. 16770 '
  679. 16780 *LOAD_ERR
  680. 16790   ON ERROR GOTO *ERR
  681. 16800   IF ERR=63 THEN A$="File not Found" ELSE A$="File Access Error"
  682. 16810 RESUME *LOAD_ERR_RET
  683. 16820 '
  684. 16830 *LOAD_ERR_RET
  685. 16840   LINE(WX+40,WY+142)-STEP(160,15),PSET,7,BF
  686. 16850   BEEP: SYMBOL(WX+40,WY+142),A$,1,1,2
  687. 16860 GOTO *LOAD_2
  688. 16870 '
  689. 16880 *SAVE
  690. 16890   SYMBOL(570, 45),"SAVE",1,1,2
  691. 16900   WX=SAVEWX: WY=SAVEWY: WXS=330: WYS=120: WF=0: WON=4
  692. 16910   RESTORE *SAVE
  693. 16920   GOSUB*WIN_INIT
  694. 16930   DATA 120, 40,300, 60'文字入力
  695. 16940   DATA 190, 85,240,105'実行
  696. 16950   DATA 250, 85,300,105'取消
  697. 16960   DATA 250, 13,300, 33'FILES
  698. 16970   SYMBOL(WX+257,WY+16),"FILES",1,1,0
  699. 16980   SYMBOL(WX+15,WY+15),"音色ファイルのSAVE",1,1,0
  700. 16990   SYMBOL(WX+25,WY+42),"ファイル名",1,1,0
  701. 17000   SYMBOL(WX+199,WY+87),"実行",1,1,0
  702. 17010   SYMBOL(WX+259,WY+87),"取消",1,1,0
  703. 17020   LINE(WX+300,WY+80)-(WX+299-(65536+4104)/384,WY+81),PSET,2,BF
  704. 17030   LINE(WX+299,WY+68)-(WX+299-4104/384,WY+78),PSET,6,BF,6
  705. 17040   GOSUB *WIN_ON
  706. 17050   SC=1: FLTL=4104: FSTL=0: MODE=1
  707. 17060   WHILE SC<=SNMAX
  708. 17070     IF SF%(SC) THEN LINE(WX+299-FLTL/384,WY+68)-STEP(0,10),PSET,%7:                             FLTL=FLTL+SSIZE(SC):                                                        FSTL=FSTL+((SSIZE(SC)+255)\256)*256
  709. 17080     SC=SC+1
  710. 17090   WEND
  711. 17100   LINE(WX+300,WY+68)-(WX+299-FLTL/384,WY+78),PSET,0,B
  712. 17110   GOSUB *WIN_OFF
  713. 17120   DIM IND%(FNVRAM(300,10))
  714. 17130   GET@A(WX,WY+68)-(WX+300,WY+78),IND%
  715. 17140   IF 65536<FSTL THEN CL=10 ELSE CL=8
  716. 17150   SYMBOL(WX+110,WY+87),STR$(FSTL),1,1,%CL
  717. 17160   IX=WX+125: IY=WY+43: IM=21: IMM=84: IA$=SFL$: ICL=0
  718. 17170   LINE(IX,IY)-STEP(IM*8,15),PSET,7,BF
  719. 17180   GOSUB *INP_INIT
  720. 17190   GOSUB *MPLOOP2
  721. 17200 *SAVE_LOOP
  722. 17210   GOSUB *WIN
  723. 17220   SAVEWX=WX: SAVEWY=WY: IX=WX+125: IY=WY+43
  724. 17230   IF WC=1  THEN MOUSE 4,IX,IY,IX+IM*8,IY+15 ELSE MOUSE 4,0,0,639,479
  725. 17240   IF WC=2 OR IC=&H0D THEN GOTO *SAVE_CHK
  726. 17250   IF WC=3 OR MOUSE(2,1)=-1 OR IC=&H18                                            THEN GOSUB *INP_END: GOTO *SAVE_RET
  727. 17260   IF WC=4 THEN GOSUB *SAVE_FILES
  728. 17270   GOSUB *INP
  729. 17280   SFL$=IA$
  730. 17290 GOTO *SAVE_LOOP
  731. 17300 *SAVE_RET
  732. 17310   ERASE IND%
  733. 17320   GOSUB *WIN_END
  734. 17330   SYMBOL(570, 45),"SAVE",1,1,0
  735. 17340   GOSUB *MPLOOP2
  736. 17350 RETURN
  737. 17360 '
  738. 17370 *SAVE_FILES
  739. 17380   GOSUB *INP_END
  740. 17390   GOSUB *FSLCT
  741. 17400   LINE(WX+121,WY+41)-(WX+299,WY+59),PSET,7,BF
  742. 17410   IF FSLCT$<>"" THEN IA$=FSLCT$
  743. 17420   IX=WX+125: IY=WY+43: IM=21: IMM=84: ICL=0
  744. 17430   GOSUB *INP_INIT
  745. 17440 RETURN
  746. 17450 '
  747. 17460 *SAVE_CHK
  748. 17470   GOSUB *INP_END
  749. 17480   LINE(WX+40,WY+87)-STEP(149,15),PSET,7,BF
  750. 17490   PUT@A(WX,WY+68)-(WX+300,WY+78),IND%
  751. 17500   FL$=SFL$
  752. 17510   GOSUB *FLCNV
  753. 17520 '
  754. 17530   ON ERROR GOTO *SAVE_ERR
  755. 17540   OPEN "O",1,FL$: CLOSE
  756. 17550   ON ERROR GOTO *ERR
  757. 17560 '
  758. 17570 *SAVE_EXE
  759. 17580   LINE(WX+40,WY+87)-STEP(149,15),PSET,7,BF
  760. 17590   DIM FLBF%(FLTL\2)
  761. 17600   P=VARPTR(FLBF%(0))
  762. 17610   FOR I=0 TO 7
  763. 17620     I$=MID$(BNK$,I+1,1)
  764. 17630     IF I$="" POKE P+I,0 ELSE POKE P+I,ASC(I$)
  765. 17640   NEXT I
  766. 17650   CALLM MTRNSM,VARPTR(ALLV%(0,0)),P+8,4096
  767. 17660   SC=1: P=VARPTR(FLBF%(0))+4104
  768. 17670   WHILE SC<=SNMAX
  769. 17680     IF SF%(SC) THEN CALLM MTRNSM,VARPTR(SDM%(0))+SDMP(SC),P,SSIZE(SC):                          P=P+SSIZE(SC)
  770. 17690     SC=SC+1
  771. 17700   WEND
  772. 17710 '
  773. 17720   MOUSE 1,,,0
  774. 17730   GOSUB *WIN_ON
  775. 17740   ERRC=0
  776. 17750   ON ERROR GOTO *ERRKP
  777. 17760 '
  778. 17770   OPEN "R",1,FL1$+"(128)"+FL2$+FL3$+FL4$
  779. 17780   FIELD 1,128 AS FB1$
  780. 17790   P1=PEEK(VARPTR(FB1$),4): P2=VARPTR(FLBF%(0)): FLN=(FLTL-1)\128: I=0
  781. 17800   WHILE I<=FLN-1 AND ERRC=0
  782. 17810     CALLM MTRNSM,P2+128*I,P1,128
  783. 17820     PUT 1,I+1
  784. 17830     LINE(WX+299-I/3,WY+69)-STEP(0,8),PSET,1
  785. 17840     I=I+1
  786. 17850   WEND
  787. 17860   CLOSE
  788. 17870 '
  789. 17880   OPEN "R",2,FL1$+"(1)"  +FL2$+FL3$+FL4$
  790. 17890   FIELD 2,  1 AS FB2$
  791. 17900   P=VARPTR(FLBF%(0)): I=128*FLN
  792. 17910   WHILE I<=FLTL-1 AND ERRC=0
  793. 17920     LSET FB2$=CHR$(PEEK(P+I))
  794. 17930     PUT 2,I+1
  795. 17940     I=I+1
  796. 17950   WEND
  797. 17960   CLOSE
  798. 17970   ON ERROR GOTO *ERR
  799. 17980   ERASE FLBF%
  800. 17990   GOSUB *WIN_OFF
  801. 18000   MOUSE 1,,,1
  802. 18010   IF ERRC=67 THEN KILL FL$: A$="Scanty Free Area": BEEP:                                      GOTO *SAVE_ERR_RET
  803. 18020 GOTO *SAVE_RET
  804. 18030 '
  805. 18040 *SAVE_ERR
  806. 18050   IF ERR=64 THEN RESUME *SAVE_ERR_3
  807. 18060 *SAVE_ERR_2
  808. 18070   BEEP: ON ERROR GOTO *ERR
  809. 18080   A$="File Access Error"
  810. 18090 RESUME *SAVE_ERR_RET
  811. 18100 '
  812. 18110 *SAVE_ERR_3
  813. 18120   BEEP: ON ERROR GOTO *ERR
  814. 18130   SYMBOL(WX+40,WY+87),"Over Write ?",1,1,2
  815. 18140   GOSUB *MPLOOP2
  816. 18150 *SAVE_ERR_3_LOOP
  817. 18160   GOSUB *WIN
  818. 18170   SAVEWX=WX: SAVEWY=WY: MOUSE 4,0,0,639,479
  819. 18180   IF WC=1 THEN A$="": GOTO *SAVE_ERR_RET
  820. 18190   IF WC=2 OR INKEY$=CHR$(&H0D)                                                   THEN ON ERROR GOTO *SAVE_ERR_2: KILL FL$:                                        ON ERROR GOTO *ERR: GOTO *SAVE_EXE
  821. 18200   IF WC=3 OR MOUSE(2,1)=-1 GOTO *SAVE_RET
  822. 18210   IF WC=4 THEN A$="": GOTO *SAVE_ERR_RET
  823. 18220 GOTO *SAVE_ERR_3_LOOP
  824. 18230 '
  825. 18240 *SAVE_ERR_RET
  826. 18250   LINE(WX+40,WY+87)-STEP(149,15),PSET,7,BF
  827. 18260   SYMBOL(WX+40,WY+87),A$,1,1,2
  828. 18270   IX=WX+125: IY=WY+43: IM=21: IMM=84: IA$=SFL$: ICL=0
  829. 18280   LINE(IX,IY)-STEP(IM*8,15),PSET,7,BF
  830. 18290   GOSUB *INP_INIT
  831. 18300 GOTO *SAVE_LOOP
  832. 18310 '
  833. 18320 *EXIT
  834. 18330   SYMBOL(570,67),"EXIT",1,1,2
  835. 18340   WX=EXITWX: WY=EXITWY: WXS=190: WYS=95: WF=0: WON=2
  836. 18350   RESTORE *EXIT
  837. 18360   GOSUB *WIN_INIT
  838. 18370   DATA  78, 68,128, 88'実行
  839. 18380   DATA 133, 68,183, 88'取消
  840. 18390   SYMBOL(WX+50,WY+30),"終了します",1,1,0
  841. 18400   SYMBOL(WX+87,WY+70),"実行",1,1,0
  842. 18410   SYMBOL(WX+142,WY+70),"取消",1,1,0
  843. 18420   GOSUB *MPLOOP2
  844. 18430 *EXIT_LOOP
  845. 18440   GOSUB *WIN
  846. 18450   EXITWX=WX: EXITWY=WY: MOUSE 4,0,0,639,479
  847. 18460   IF WC=1 THEN GOSUB *WIN_END: PLAY OFF: COLOR 7,0,7,4: END
  848. 18470   IF WC=2 OR MOUSE(2,1)=-1 THEN GOTO *EXIT_RET
  849. 18480 GOTO *EXIT_LOOP
  850. 18490 *EXIT_RET
  851. 18500   GOSUB *WIN_END
  852. 18510   SYMBOL(570,67),"EXIT",1,1,0
  853. 18520   GOSUB *MPLOOP2
  854. 18530 RETURN
  855. 18540 '
  856. 18550 *INTE
  857. 18560   PRINT FRE(1),FRE(3),FRE(4)
  858. 18570 RETURN
  859. 18580 '
  860. 18590 *OPTI
  861. 18600   SYMBOL(570,89),"OPTI",1,1,2
  862. 18610   WX=OPTIWX: WY=OPTIWY: WXS=320: WYS=85: WF=0: WON=1
  863. 18620   RESTORE *OPTI
  864. 18630   GOSUB *WIN_INIT
  865. 18640   DATA 135, 57,185, 77'確認
  866. 18650   SYMBOL(WX+20,WY+20),"OPTIには機能が設定されていません",1,1,0
  867. 18660   SYMBOL(WX+144,WY+59),"確認",1,1,0
  868. 18670   GOSUB *MPLOOP2
  869. 18680   WHILE WC<>1 AND MOUSE(2,1)=0
  870. 18690     GOSUB *WIN
  871. 18700     OPTIWX=WX: OPTIWY=WY: MOUSE 4,0,0,639,479
  872. 18710   WEND
  873. 18720   GOSUB *WIN_END
  874. 18730   SYMBOL(570,89),"OPTI",1,1,0
  875. 18740   GOSUB *MPLOOP2
  876. 18750 RETURN
  877. 18760 '
  878. 18770 *PLAYOFF
  879. 18780   SYMBOL(570,115),"PLAY",1,1,2
  880. 18790   SYMBOL(577,135),"OFF",1,1,2
  881. 18800   MOUSE 4,564,108,638,156
  882. 18810   DIM A%(SSIZE(0)\2)
  883. 18820   CALLM MTRNSM,VARPTR(SDM%(0)),VARPTR(A%(0)),SSIZE(0)
  884. 18830   VOICE SET A%: PLAY OFF
  885. 18840   ERASE A%
  886. 18850   GOSUB *MPLOOP2
  887. 18860   SYMBOL(570,115),"PLAY",1,1,0
  888. 18870   SYMBOL(577,135),"OFF",1,1,0
  889. 18880 RETURN
  890. 18890 '
  891. 18900 *BNK
  892. 18910   IX=100: IY=22: IM=8: IMM=8: IA$=BNK$: ICL=15
  893. 18920   LINE(100,22)-(163,37),PSET,%7,BF
  894. 18930   GOSUB *INP_INIT
  895. 18940 *BNK_LOOP
  896. 18950   IF MOUSE(2,0)=0 THEN MOUSE 4,0,0,639,479: GOTO *BNK_LOOP_2
  897. 18960   MX=MOUSE(0):MY=MOUSE(1)
  898. 18970   IF 100<=MX AND 22<=MY AND MX<=163 AND MY<=37                                   THEN MOUSE 4,100,22,163,37                                                  ELSE GOTO *BNK_RET
  899. 18980 *BNK_LOOP_2
  900. 18990   GOSUB *INP
  901. 19000 IF IC<>&H0D AND MOUSE(2,1)=0 GOTO *BNK_LOOP
  902. 19010 *BNK_RET
  903. 19020   BNK$=IA$
  904. 19030   GOSUB*INP_END
  905. 19040 RETURN
  906. 19050 '
  907. 19060 *V_SCRN
  908. 19070   VC=-1
  909. 19080   IF 173<=MX AND  66<=MY AND MX<=190 AND MY<=130 GOSUB *V_BTN
  910. 19090   IF 173<=MX AND  47<=MY AND MX<=190 AND MY<=65  GOSUB *V_UP
  911. 19100   IF 173<=MX AND 131<=MY AND MX<=190 AND MY<=149 GOSUB *V_DOWN
  912. 19110   IF  75<=MX AND  46<=MY AND MX<=170 AND MY<=150 GOSUB *V_SLCT
  913. 19120   MOUSE 4,0,0,639,479
  914. 19130 RETURN
  915. 19140 '
  916. 19150 *V_READ
  917. 19160   SYMBOL(5,50),"読み込み",1,1,2
  918. 19170   GOSUB *MPLOOP2
  919. 19180 *V_READ_LOOP
  920. 19190   GOSUB *MPLOOP1
  921. 19200 IF PUSH=2 OR MX<75 OR MY<46 OR 190<MX OR 150<MY GOTO *V_READ_RET
  922. 19210   GOSUB *V_SCRN
  923. 19220 IF VC=-1 GOTO *V_READ_LOOP
  924. 19230   VN=VC: VNAME$=VNAME$(VN)
  925. 19240   GOSUB *V_PR
  926. 19250   GOSUB *V_NAME_PR
  927. 19260   P=VARPTR(ALLV%(0,0))+128*VN
  928. 19270   FOR S=0 TO 7
  929. 19280     FOR I=0 TO 7
  930. 19290       ENV%(S,I)=PEEK(P+64+8*S+I)
  931. 19300     NEXT I
  932. 19310     IF &H80 AND ENV%(S,6) THEN ENV%(S,6)=ENV%(S,6)-256
  933. 19320     I=PEEK(P+16+2*S,2)-24
  934. 19330     IF I<0 THEN I=0
  935. 19340     IF 95<I THEN I=95
  936. 19350     UL%(S+1)=I
  937. 19360     ID(S)=PEEK(P+32+4*S,4)
  938. 19370   NEXT S
  939. 19380   GOSUB *ENV_ALL_PR
  940. 19390   GOSUB *ENV_SET
  941. 19400 *V_READ_RET
  942. 19410   SYMBOL(5,50),"読み込み",1,1,0
  943. 19420 RETURN
  944. 19430 '
  945. 19440 *V_SAVE
  946. 19450   SYMBOL(5,70),"保存",1,1,2
  947. 19460   GOSUB *MPLOOP2
  948. 19470 *V_SAVE_LOOP
  949. 19480   GOSUB *MPLOOP1
  950. 19490 IF PUSH=2 OR MX<75 OR MY<46 OR 190<MX OR 150<MY GOTO *V_SAVE_RET
  951. 19500   GOSUB *V_SCRN
  952. 19510 IF VC=-1 GOTO *V_SAVE_LOOP
  953. 19520   VN=VC: VNAME$(VN)=VNAME$
  954. 19530   GOSUB *V_PR
  955. 19540   P=VARPTR(ALLV%(0,0))+128*VN
  956. 19550   FOR I=0 TO 7
  957. 19560     J=PEEK(P+32+4*I,4)
  958. 19570     SF%(J)=SF%(J)-1
  959. 19580     SF%(ID(I))=SF%(ID(I))+1
  960. 19590   NEXT I
  961. 19600   GOSUB *S_PR
  962. 19610   FOR I=0 TO 7
  963. 19620     I$=MID$(VNAME$,I+1,1)
  964. 19630     IF I$="" THEN POKE P+I,0 ELSE POKE P+I,ASC(I$)
  965. 19640   NEXT I
  966. 19650   FOR S=0 TO 7
  967. 19660     POKE P+16+2*S,UL%(S+1)+24,2'  UL
  968. 19670     POKE P+32+4*S,ID(S),4'        ID
  969. 19680     FOR I=0 TO 7
  970. 19690       POKE P+64+8*S+I,ENV%(S,I)
  971. 19700     NEXT I
  972. 19710   NEXT S
  973. 19720 *V_SAVE_RET
  974. 19730   SYMBOL(5,70),"保存",1,1,0
  975. 19740 RETURN
  976. 19750 '
  977. 19760 *V_NAME
  978. 19770   IX=5: IY=130: IM=8: IMM=8: IA$=VNAME$: ICL=15
  979. 19780   LINE(5,130)-(68,145),PSET,%7,BF
  980. 19790   GOSUB *INP_INIT
  981. 19800 *V_NAME_LOOP
  982. 19810 IF MOUSE(2,0)=0 THEN MOUSE 4,0,0,639,479: GOTO *V_NAME_LOOP_2
  983. 19820   MX=MOUSE(0):MY=MOUSE(1)
  984. 19830   IF 5<=MX AND 130<=MY AND MX<=68 AND MY<=145                                    THEN MOUSE 4,5,130,68,145                                                   ELSE GOTO *V_NAME_RET
  985. 19840 *V_NAME_LOOP_2
  986. 19850   GOSUB *INP
  987. 19860 IF IC<>&H0D AND MOUSE(2,1)=0 GOTO *V_NAME_LOOP
  988. 19870 *V_NAME_RET
  989. 19880   VNAME$=IA$
  990. 19890   GOSUB*INP_END
  991. 19900   GOSUB *V_NAME_PR
  992. 19910 RETURN
  993. 19920 '
  994. 19930 *V_NAME_PR
  995. 19940   LINE(5,130)-(68,145),PSET,%7,BF
  996. 19950   SYMBOL(5,130),VNAME$,1,1,7
  997. 19960 RETURN
  998. 19970 '
  999. 19980 *V_CLR
  1000. 19990   SYMBOL(5,90),"初期化",1,1,2
  1001. 20000   GOSUB *MPLOOP2
  1002. 20010 *V_CLR_LOOP
  1003. 20020   GOSUB *MPLOOP1
  1004. 20030 IF PUSH=2 OR MX<75 OR MY<46 OR 190<MX OR 150<MY GOTO *V_CLR_RET
  1005. 20040   GOSUB *V_SCRN
  1006. 20050 IF VC=-1 GOTO *V_CLR_LOOP
  1007. 20060   P=VARPTR(ALLV%(0,0))+128*VC
  1008. 20070   FOR I=0 TO 7
  1009. 20080     J=PEEK(P+32+4*I,4)
  1010. 20090     SF%(J)=SF%(J)-1
  1011. 20100   NEXT I
  1012. 20110   FOR I=0 TO 127
  1013. 20120     POKE P+I,0
  1014. 20130   NEXT I
  1015. 20140   VNAME$(VC)=""
  1016. 20150   FOR I=0 TO 7
  1017. 20160     POKE P+16+2*I,119,2
  1018. 20170   NEXT I
  1019. 20180   GOSUB *V_PR
  1020. 20190   GOSUB *S_PR
  1021. 20200 *V_CLR_RET
  1022. 20210   SYMBOL(5,90),"初期化",1,1,0
  1023. 20220 RETURN
  1024. 20230 '
  1025. 20240 *V_INIT
  1026. 20250   DIM ALLV%(63,31),VNAME$(31),V%(63)
  1027. 20260   P=VARPTR(ALLV%(0,0))
  1028. 20270   FOR I=0 TO 31
  1029. 20280     FOR J=0 TO 7: POKE P+128*I+16+2*J,119,2: NEXT J
  1030. 20290   NEXT I
  1031. 20300   BNK$=""
  1032. 20310 *V_INIT_1
  1033. 20320   LINE(100,22)-(163,37),PSET,%7,BF
  1034. 20330   SYMBOL(100,22),BNK$,1,1,7
  1035. 20340   VNS=0: VN=-1: VC=-1
  1036. 20350   GOSUB *V_PR
  1037. 20360 RETURN
  1038. 20370 '
  1039. 20380 *V_PR
  1040. 20390   GOSUB *V_BTN_PR
  1041. 20400   FOR I=0 TO 4
  1042. 20410     IF VNS+I=VN  THEN CL=2 ELSE CL=7
  1043. 20420     LINE(76,50+I*20)-(169,65+I*20),PSET,%7,BF
  1044. 20430     SYMBOL(70,50+I*20),STR$(VNS+I+1),1,1,CL
  1045. 20440     SYMBOL(100,50+I*20),VNAME$(VNS+I),1,1,CL
  1046. 20450   NEXT I
  1047. 20460 RETURN
  1048. 20470 '
  1049. 20480 *V_BTN_PR
  1050. 20490   X1=173: Y1=VNS*47/27+66: X2=190: Y2=Y1+17
  1051. 20500   LINE(173,66)-(190,130),PSET,%7,BF
  1052. 20510   GOSUB *BOX_PR
  1053. 20520 RETURN
  1054. 20530 '
  1055. 20540 *V_BTN
  1056. 20550   MOUSE 4,173,75,190,122: MOUSE 1,,,0
  1057. 20560   WHILE MOUSE(2,0)=-1
  1058. 20570     I=(MOUSE(1)-9-66)*27/47
  1059. 20580     IF I<>VNS THEN VNS=I: GOSUB *V_PR
  1060. 20590   WEND
  1061. 20600   MOUSE 1,MOUSE(0),MOUSE(1),1
  1062. 20610 RETURN
  1063. 20620 '
  1064. 20630 *V_UP
  1065. 20640   MOUSE 4,173,47,190,65: MOUSE 1,,,0
  1066. 20650   DIM A%(FNVRAM(93,75))
  1067. 20660   WHILE MOUSE(2,0)=-1
  1068. 20670     IF VNS<=0 GOTO *V_UP_1
  1069. 20680     VNS=VNS-1
  1070. 20690     GET@A(76,50)-(169,125),A%
  1071. 20700     PUT@A(76,70)-(169,145),A%
  1072. 20710     IF VNS=VN  THEN CL=2 ELSE CL=7
  1073. 20720     LINE(76,50)-(169,65),PSET,%7,BF
  1074. 20730     SYMBOL(70,50),STR$(VNS+1),1,1,CL
  1075. 20740     SYMBOL(100,50),VNAME$(VNS),1,1,CL
  1076. 20750     GOSUB *V_BTN_PR
  1077. 20760 *V_UP_1
  1078. 20770   WEND
  1079. 20780   MOUSE 1,MOUSE(0),MOUSE(1),1
  1080. 20790   ERASE A%
  1081. 20800 RETURN
  1082. 20810 '
  1083. 20820 *V_DOWN
  1084. 20830   MOUSE 4,173,131,190,149: MOUSE 1,,,0
  1085. 20840   DIM A%(FNVRAM(93,75))
  1086. 20850   WHILE MOUSE(2,0)=-1
  1087. 20860     IF 27<=VNS GOTO *V_DOWN_1
  1088. 20870     VNS=VNS+1
  1089. 20880     GET@A(76,70)-(169,145),A%
  1090. 20890     PUT@A(76,50)-(169,125),A%
  1091. 20900     IF VNS+4=VN  THEN CL=2 ELSE CL=7
  1092. 20910     LINE(76,130)-(169,145),PSET,%7,BF
  1093. 20920     SYMBOL(70,130),STR$(VNS+5),1,1,CL
  1094. 20930     SYMBOL(100,130),VNAME$(VNS+4),1,1,CL
  1095. 20940     GOSUB *V_BTN_PR
  1096. 20950 *V_DOWN_1
  1097. 20960   WEND
  1098. 20970   MOUSE 1,MOUSE(0),MOUSE(1),1
  1099. 20980   ERASE A%
  1100. 20990 RETURN
  1101. 21000 '
  1102. 21010 *V_SLCT
  1103. 21020   IF MOUSE(2,0)=0 RETURN
  1104. 21030   MOUSE 4,77,48,168,147
  1105. 21040   MY=MOUSE(1)
  1106. 21050   Y1=INT((MY-48)/20): Y2=Y1
  1107. 21060   GOSUB *V_SLCT_PR
  1108. 21070 *V_SLCT_LOOP 
  1109. 21080   MY=MOUSE(1)
  1110. 21090   Y1=INT((MY-48)/20)
  1111. 21100   IF Y1<>Y2 THEN GOSUB *V_SLCT_PR: Y2=Y1: GOSUB *V_SLCT_PR
  1112. 21110   IF MOUSE(2,1)=-1 THEN GOSUB *V_SLCT_PR: GOSUB *MPLOOP2: RETURN
  1113. 21120 IF MOUSE(2,0)=-1 GOTO *V_SLCT_LOOP
  1114. 21130   GOSUB *V_SLCT_PR
  1115. 21140   VC=Y2+VNS
  1116. 21150 RETURN
  1117. 21160 '
  1118. 21170 *V_SLCT_PR
  1119. 21180   LINE(77,Y2*20+48)-(168,Y2*20+67),XOR,%9,BF,%1
  1120. 21190 RETURN
  1121. 21200 '
  1122. 21210 *ENV_INIT
  1123. 21220   DATA TL,0,AR,0,DR,0,SL,0,SR,0,RR,0,RK,4C,?!,0,UL,8B
  1124. 21230   DATA  8,14,19,25,33,41,47,52,58,63,69,77
  1125. 21240   DIM ENV%(7,7),ID(7),UL%(9),KX%(95),A%(FNVRAM(79,242))
  1126. 21250   UL%(0)=0
  1127. 21260   FOR I=1 TO 9: UL%(I)=95: NEXT I
  1128. 21270   RESTORE *ENV_INIT
  1129. 21280   FOR Y=80 TO 224 STEP 18
  1130. 21290     READ A$,B$
  1131. 21300     SYMBOL(1,160+Y),A$,1,1,0
  1132. 21310     SYMBOL(20,160+Y),"<",1,1,0
  1133. 21320     SYMBOL(62,160+Y),">",1,1,0
  1134. 21330     SYMBOL(36,160+Y),B$,1,1,7
  1135. 21340   NEXT Y
  1136. 21350   S=0
  1137. 21360   GOSUB *ENV_PR
  1138. 21370   GET@A(0,158)-(79,400),A%
  1139. 21380   FOR S=0 TO 7
  1140. 21390     PUT@A(S*80,158)-(79+S*80,400),A%
  1141. 21400     SYMBOL(-6+S*80,160),STR$(S+1),1,1,2
  1142. 21410     LINE(78+S*80,401)-STEP(0,1),PSET,0
  1143. 21420   NEXT S
  1144. 21430   ERASE A%
  1145. 21440   FOR N=0 TO 11
  1146. 21450     READ I
  1147. 21460     FOR O=0 TO 7
  1148. 21470       KX%(O*12+N)=O*77+I
  1149. 21480     NEXT O
  1150. 21490   NEXT N
  1151. 21500   GOSUB *UL_PR
  1152. 21510 RETURN
  1153. 21520 '
  1154. 21530 *ENV_PR
  1155. 21540   WINDOW(0,127)-(400,0)
  1156. 21550   VIEW(2+S*80,179)-(76+S*80,236)
  1157. 21560   TL=ENV%(S,0): AR=ENV%(S,1): DR=ENV%(S,2)
  1158. 21570   SL=ENV%(S,3): SR=127-ENV%(S,4): RR=127-ENV%(S,5)
  1159. 21580   X1=0:   Y1=0: X2=0:   Y2=0: X3=0:   Y3=0
  1160. 21590   X4=300: Y4=0: X5=400: Y5=0: X6=500: Y6=0
  1161. 21600   IF AR=127 OR TL=0 GOTO *ENV_PR_3
  1162. 21610   X2=AR*150/127: Y2=TL
  1163. 21620   IF SL=127 OR DR=127 THEN X3=X2: Y3=Y2: SR=0: GOTO *ENV_PR_1
  1164. 21630   X3=X2+DR*150/127: Y3=SL*TL/127
  1165. 21640 *ENV_PR_1
  1166. 21650   IF SR=127 THEN X4=X3:  Y4=0:  GOTO *ENV_PR_2
  1167. 21660   IF SR=0   THEN X4=300: Y4=Y3: GOTO *ENV_PR_2
  1168. 21670   X4=300: Y4=Y3-(X4-X3)*TAN(PI!*SR)
  1169. 21680   IF Y4<=0 THEN X4=X3+(X4-X3)*Y3/(Y3-Y4): Y4=0: GOTO *ENV_PR_3
  1170. 21690 *ENV_PR_2
  1171. 21700   IF RR=127 THEN X5=X4:  Y5=0:  GOTO *ENV_PR_3
  1172. 21710   IF RR=0   THEN X5=400: Y5=Y4: GOTO *ENV_PR_3
  1173. 21720   X5=400: Y5=Y4-(X5-X4)*TAN(PI!*RR)
  1174. 21730   IF Y5<=0 THEN X5=X4+(X5-X4)*Y4/(Y4-Y5): Y5=0
  1175. 21740 *ENV_PR_3
  1176. 21750   LINE(0,0)-(400,127),PSET,%7,BF
  1177. 21760   LINE(X2,0)-(X2,127),PSET,%1,,&H6666
  1178. 21770   LINE(X3,0)-(X3,127),PSET,%1,,&H6666
  1179. 21780   LINE(300,0)-(300,127),PSET,%1,,&H6666
  1180. 21790   CONNECT(X1,Y1)-(X2,Y2)-(X3,Y3)-(X4,Y4)-(X5,Y5)-(X6,Y6),1
  1181. 21800   GOSUB *WIN_OFF
  1182. 21810 RETURN
  1183. 21820 '
  1184. 21830 *ENV_OP
  1185. 21840   S=INT(MX/80): MX=MX MOD 80: P=-1: V=0: T=-1
  1186. 21850   IF 2<=MX AND 160<=MY AND MX<=76 AND MY<=175 GOTO *ENV_SNAME
  1187. 21860   FOR I=0 TO 8
  1188. 21870     IF 20<=MX AND 240+I*18<=MY AND MX<=35 AND MY<=255+I*18                         THEN P=I: I=8: V=-1: MOUSE 4,20+S*80,240+P*18,35+S*80,255+P*18
  1189. 21880     IF 62<=MX AND 240+I*18<=MY AND MX<=77 AND MY<=255+I*18                         THEN P=I: I=8: V= 1: MOUSE 4,62+S*80,240+P*18,77+S*80,255+P*18
  1190. 21890   NEXT I
  1191. 21900   IF P=6 GOTO *RK_OP
  1192. 21910   IF P=8 GOTO *UL_OP
  1193. 21920   IF P=-1 OR V=0 RETURN
  1194. 21930   MOUSE 1,,,0
  1195. 21940 *ENV_OP_LOOP
  1196. 21950   PUSH=0: T=T+1
  1197. 21960   IF MOUSE(2,0)=-1 THEN PUSH=1
  1198. 21970   IF MOUSE(2,1)=-1 THEN PUSH=10: IF P=7 THEN PUSH=8
  1199. 21980   IF PUSH=0 THEN MOUSE 4,0,0,639,479: MOUSE 1,,,1: GOSUB *ENV_SET:                           RETURN
  1200. 21990 IF T<>0 AND T<=100 GOTO *ENV_OP_LOOP
  1201. 22000   I=ENV%(S,P)+V*PUSH
  1202. 22010   IF I<0 THEN I=0
  1203. 22020   IF P<>7 AND 127<I THEN I=127
  1204. 22030   IF P=7  AND 255<I THEN I=255
  1205. 22040 IF I=ENV%(S,P) GOTO *ENV_OP_LOOP ELSE ENV%(S,P)=I
  1206. 22050   GOSUB *ENV_PR
  1207. 22060   LINE(36+S*80,240+P*18)-STEP(23,15),PSET,%7,BF
  1208. 22070   SYMBOL(28+S*80,240+P*18),STR$(I),1,1,7
  1209. 22080 GOTO *ENV_OP_LOOP
  1210. 22090 '
  1211. 22100 *RK_OP
  1212. 22110   MOUSE 1,,,0
  1213. 22120   T=0
  1214. 22130   WHILE MOUSE(2,0)=-1 OR MOUSE (2,1)=-1
  1215. 22140     IF 0<T AND T<130 GOTO *RK_OP_2
  1216. 22150     PUSH=0
  1217. 22160     IF MOUSE(2,0)=-1 THEN PUSH=1
  1218. 22170     IF MOUSE(2,1)=-1 THEN PUSH=12
  1219. 22180     IF MOUSE(2,0)=-1 AND MOUSE(2,1)=-1 THEN PUSH=255
  1220. 22190     I=ENV%(S,6)-V*PUSH
  1221. 22200     IF SN%(ID(S))-I<0  THEN I=SN%(ID(S))
  1222. 22210     IF 95<SN%(ID(S))-I THEN I=SN%(ID(S))-95
  1223. 22220     ENV%(S,6)=I: O=(SN%(ID(S))-I)\12: N=(SN%(ID(S))-I+65532) MOD 12
  1224. 22230     LINE(36+S*80,348)-(59+S*80,363),PSET,%7,BF
  1225. 22240     SYMBOL(28+S*80,348),STR$(O+1)+N$(N),1,1,7
  1226. 22250 *RK_OP_2
  1227. 22260     T=T+1
  1228. 22270   WEND
  1229. 22280   MOUSE 4,0,0,639,479: MOUSE 1,,,1
  1230. 22290   GOSUB *ENV_SET
  1231. 22300 RETURN
  1232. 22310 '
  1233. 22320 *UL_OP
  1234. 22330   MOUSE 1,,,0
  1235. 22340   K=S: T=0
  1236. 22350   WHILE MOUSE(2,0)=-1 OR MOUSE (2,1)=-1
  1237. 22360 IF T<>0 AND T<130 GOTO *UL_OP_2
  1238. 22370     PUSH=0
  1239. 22380     IF MOUSE(2,0)=-1 THEN PUSH=1
  1240. 22390     IF MOUSE(2,1)=-1 THEN PUSH=12
  1241. 22400     IF MOUSE(2,0)=-1 AND MOUSE(2,1)=-1 THEN PUSH=255
  1242. 22410     I=UL%(K+1)+V*PUSH
  1243. 22420     IF I<=UL%(K) THEN I=UL%(K)
  1244. 22430     IF UL%(K+2)<=I THEN I=UL%(K+2)
  1245. 22440 IF UL%(K+1)=I GOTO *UL_OP_2
  1246. 22450     UL%(K+1)=I: O=INT(I/12): N=I MOD 12
  1247. 22460     LINE(36+K*80,384)-(59+K*80,399),PSET,%7,BF
  1248. 22470     SYMBOL(28+K*80,384),STR$(O+1)+N$(N),1,1,7
  1249. 22480     GOSUB *UL_PR
  1250. 22490 *UL_OP_2
  1251. 22500     T=T+1
  1252. 22510   WEND
  1253. 22520   MOUSE 4,0,0,639,479: MOUSE 1,,,1
  1254. 22530   GOSUB *ENV_SET
  1255. 22540 RETURN
  1256. 22550 '
  1257. 22560 *ENV_SNAME
  1258. 22570 IF PUSH=2 OR SNMAX=0 RETURN
  1259. 22580   LINE(2+80*S,159)-(76+80*S,176),XOR,%11,BF,%3
  1260. 22590   GOSUB *MPLOOP2
  1261. 22600 *ENV_SNAME_LOOP
  1262. 22610   GOSUB *MPLOOP1
  1263. 22620   IF PUSH=2 OR MX<272 OR MY<46 OR 400<MX OR 150<MY GOTO *ENV_SNAME_RET
  1264. 22630   GOSUB *S_SCRN
  1265. 22640   IF SC=-1 GOTO *ENV_SNAME_LOOP
  1266. 22650   ID(S)=SC: I=SN%(ID(S))-ENV%(S,6): CL=7
  1267. 22660   IF I<0  THEN CL=2: I=0
  1268. 22670   IF 95<I THEN CL=2: I=95
  1269. 22680   O=INT(I/12): N=(I+65532) MOD 12
  1270. 22690   LINE(36+S*80,348)-(59+S*80,363),PSET,%7,BF
  1271. 22700   SYMBOL(28+S*80,348),STR$(O+1)+N$(N),1,1,CL
  1272. 22710   GOSUB *ENV_SET
  1273. 22720 *ENV_SNAME_RET
  1274. 22730   LINE(2+80*S,159)-(77+80*S,176),PSET,%7,BF
  1275. 22740   SYMBOL(-6+80*S,160),STR$(S+1),1,1,2
  1276. 22750   SYMBOL(12+80*S,160),SNAME$(ID(S)),1,1,7
  1277. 22760 RETURN
  1278. 22770 '
  1279. 22780 *ENV_SET
  1280. 22790   P=VARPTR(V%(0))
  1281. 22800   FOR I=0 TO 7
  1282. 22810     POKE P+16+2*I,UL%(I+1)+24,2
  1283. 22820     POKE P+32+4*I,ID(I),4
  1284. 22830     FOR J=0 TO 7
  1285. 22840       POKE P+64+8*I+J,ENV%(I,J)
  1286. 22850     NEXT J
  1287. 22860   NEXT I
  1288. 22870 RETURN
  1289. 22880 '
  1290. 22890 *ENV_ALL_PR
  1291. 22900   GOSUB *ENV_SNAME_PR
  1292. 22910   FOR S=0 TO 7
  1293. 22920     GOSUB *ENV_PR
  1294. 22930       LINE(36+S*80,240)-(59+S*80,399),PSET,%7,BF
  1295. 22940     FOR I=0 TO 5
  1296. 22950       SYMBOL(28+S*80,240+I*18),STR$(ENV%(S,I)),1,1,7
  1297. 22960     NEXT I
  1298. 22970     I=SN%(ID(S))-ENV%(S,6): CL=7
  1299. 22980     IF I<0  THEN CL=2: I=0
  1300. 22990     IF 95<I THEN CL=2: I=95
  1301. 23000     O=INT(I/12): N=(I+65532) MOD 12
  1302. 23010     SYMBOL(28+S*80,348),STR$(O+1)+N$(N),1,1,CL
  1303. 23020     SYMBOL(28+S*80,366),STR$(ENV%(S,7)),1,1,7
  1304. 23030     O=UL%(S+1)\12: N=UL%(S+1) MOD 12
  1305. 23040     SYMBOL(28+S*80,384),STR$(O+1)+N$(N),1,1,7
  1306. 23050   NEXT S
  1307. 23060   GOSUB *UL_PR
  1308. 23070 RETURN
  1309. 23080 '
  1310. 23090 *ENV_SNAME_PR
  1311. 23100   FOR S=0 TO 7
  1312. 23110     LINE(12+S*80,160)-(12+S*80+64,175),PSET,%7,BF
  1313. 23120     SYMBOL(12+S*80,160),SNAME$(ID(S)),1,1,7
  1314. 23130   NEXT S
  1315. 23140 RETURN
  1316. 23150 '
  1317. 23160 *UL_PR
  1318. 23170   LINE(1,480)-(638,503),PSET,%7,BF
  1319. 23180   FOR I=0 TO 7
  1320. 23190     CONNECT(78+I*80,480)-(KX+KX%(UL%(I+1)),497)-STEP(0,6),%8
  1321. 23200   NEXT I
  1322. 23210   DIM A%(FNVRAM(637,23))
  1323. 23220   GET@A(1,480)-(638,503),A%
  1324. 23230   PUT@A(1,403)-(638,426),A%
  1325. 23240   ERASE A%
  1326. 23250 RETURN
  1327. 23260 '
  1328. 23270 *S_INIT
  1329. 23280   SN=0: SC=-1: SNMAX=0: SNS=1: SNSMAX=1
  1330. 23290   DIM SNAME$(100),SSIZE(100),SF%(100),SN%(100),SPA%(0)
  1331. 23300   DIM SDM%(SMRTL\2),SDMP(100)
  1332. 23310   SNAME$(0)="": SDMP(0)=0: SSIZE(0)=33
  1333. 23320   SDMP(1)=SDMP(0)+SSIZE(0): SN%(0)=36
  1334. 23330   GOSUB *S_PR
  1335. 23340   GOSUB *SMR_PR
  1336. 23350   RESTORE *S_INIT
  1337. 23360   P=VARPTR(SDM%(0))
  1338. 23370   FOR I=0 TO 31
  1339. 23380     READ I$: POKE P+I,VAL("&h"+I$)
  1340. 23390   NEXT I
  1341. 23400   GOSUB *S_DATA_PR
  1342. 23410 RETURN
  1343. 23420 DATA 49,73,61,61,63,00,00,00,00,00,00,00,01,00,00,00
  1344. 23430 DATA 00,00,00,00,00,00,00,00,00,00,00,00,3C,00,00,00
  1345. 23440 '
  1346. 23450 *S_SLCT
  1347. 23460 IF MOUSE(2,0)=0 OR SNMAX=0 RETURN
  1348. 23470   Y=SNMAX-SNSMAX'0<=Y<=4
  1349. 23480   IF 4<=Y THEN Y=4
  1350. 23490   MOUSE 4,274,48,378,67+20*Y
  1351. 23500   MY=MOUSE(1): Y2=INT((MY-48)/20)
  1352. 23510   GOSUB *S_SLCT_PR
  1353. 23520 *S_SLCT_LOOP
  1354. 23530   MY=MOUSE(1): Y1=INT((MY-48)/20)
  1355. 23540   IF Y1<>Y2 THEN GOSUB *S_SLCT_PR: Y2=Y1: GOSUB *S_SLCT_PR
  1356. 23550 IF MOUSE(2,1)=-1 THEN GOSUB *S_SLCT_PR: GOSUB *MPLOOP2: RETURN
  1357. 23560 IF MOUSE(2,0)=-1 GOTO *S_SLCT_LOOP
  1358. 23570   GOSUB *S_SLCT_PR
  1359. 23580   SC=Y2+SNS
  1360. 23590 RETURN
  1361. 23600 '
  1362. 23610 *S_SLCT_PR
  1363. 23620   LINE(274,Y2*20+48)-(378,Y2*20+67),XOR,%11,BF,%3
  1364. 23630 RETURN
  1365. 23640 '
  1366. 23650 *S_SCRN
  1367. 23660   SC=-1
  1368. 23670   IF 272<=MX AND  46<=MY AND MX<=380 AND MY<=150 GOSUB *S_SLCT
  1369. 23680   IF 383<=MX AND  66<=MY AND MX<=400 AND MY<=130 GOSUB *S_BTN
  1370. 23690   IF 383<=MX AND  47<=MY AND MX<=400 AND MY<= 65 GOSUB *S_UP
  1371. 23700   IF 383<=MX AND 131<=MY AND MX<=400 AND MY<=149 GOSUB *S_DOWN
  1372. 23710   MOUSE 4,0,0,639,479
  1373. 23720 RETURN
  1374. 23730 '
  1375. 23740 *S_BTN
  1376. 23750   IF SNSMAX=1 RETURN
  1377. 23760   MOUSE 4,383,66+9,400,130-8: MOUSE 1,,,0
  1378. 23770   WHILE MOUSE(2,0)=-1
  1379. 23780     I=(MOUSE(1)-9-66)*(SNSMAX-1)/47+1
  1380. 23790     IF I<>SNS THEN SNS=I: GOSUB *S_PR
  1381. 23800   WEND
  1382. 23810   MOUSE 1,MOUSE(0),MOUSE(1),1
  1383. 23820 RETURN
  1384. 23830 '
  1385. 23840 *S_BTN_PR
  1386. 23850   IF SNSMAX=1 THEN Y1=66 ELSE Y1=66+((SNS-1)/(SNSMAX-1)*47)
  1387. 23860   X1=383: X2=400: Y2=Y1+17
  1388. 23870   LINE(383,66)-(400,130),PSET,%7,BF
  1389. 23880   GOSUB *BOX_PR
  1390. 23890 RETURN
  1391. 23900 '
  1392. 23910 *S_PR
  1393. 23920   GOSUB *S_BTN_PR
  1394. 23930   IF SNMAX=0 THEN J=-1
  1395. 23940   IF SNMAX<=SNS+4 THEN J=SNMAX-SNS ELSE J=4
  1396. 23950   FOR I=0 TO 4
  1397. 23960     IF SNS+I=SN THEN CL=2 ELSE CL=7
  1398. 23970     LINE(273,50+I*20)-(379,65+I*20),PSET,%7,BF
  1399. 23980     IF J<I GOTO *S_PR_1
  1400. 23990       SYMBOL(267,50+I*20),STR$(SNS+I),1,1,CL
  1401. 24000       SYMBOL(297,50+I*20),SNAME$(SNS+I),1,1,CL
  1402. 24010       IF SF%(SNS+I) THEN CIRCLE(370,50+I*20+7),2,2,,,,F
  1403. 24020 *S_PR_1
  1404. 24030   NEXT I
  1405. 24040 RETURN
  1406. 24050 '
  1407. 24060 *S_UP
  1408. 24070 IF SNSMAX=1 RETURN
  1409. 24080   MOUSE 4,383,47,400,65: MOUSE 1,,,0
  1410. 24090   DIM A%(FNVRAM(106,75))
  1411. 24100   WHILE MOUSE(2,0)=-1
  1412. 24110 IF SNS<=1 GOTO *S_UP_1
  1413. 24120     SNS=SNS-1
  1414. 24130     GET@A(273,50)-(379,125),A%
  1415. 24140     PUT@A(273,70)-(379,145),A%
  1416. 24150     LINE(273,50)-(379,65),PSET,%7,BF
  1417. 24160     IF SNS=SN THEN CL=2 ELSE CL=7
  1418. 24170     SYMBOL(267,50),STR$(SNS),1,1,CL
  1419. 24180     SYMBOL(297,50),SNAME$(SNS),1,1,CL
  1420. 24190     IF SF%(SNS) THEN CIRCLE(370,50+7),2,2,,,,F
  1421. 24200     GOSUB *S_BTN_PR
  1422. 24210 *S_UP_1
  1423. 24220   WEND
  1424. 24230   MOUSE 1,MOUSE(0),MOUSE(1),1
  1425. 24240   ERASE A%
  1426. 24250 RETURN
  1427. 24260 '
  1428. 24270 *S_DOWN
  1429. 24280 IF SNSMAX=1 RETURN
  1430. 24290   MOUSE 4,383,131,400,149: MOUSE 1,,,0
  1431. 24300   DIM A%(FNVRAM(106,75))
  1432. 24310   WHILE MOUSE(2,0)=-1
  1433. 24320 IF SNSMAX<=SNS GOTO *S_DOWN_1
  1434. 24330     SNS=SNS+1
  1435. 24340     GET@A(273,70)-(379,145),A%
  1436. 24350     PUT@A(273,50)-(379,125),A%
  1437. 24360     LINE(273,130)-(379,145),PSET,%7,BF
  1438. 24370     IF SNS+4=SN THEN CL=2 ELSE CL=7
  1439. 24380     SYMBOL(267,130),STR$(SNS+4),1,1,CL
  1440. 24390     SYMBOL(297,130),SNAME$(SNS+4),1,1,CL
  1441. 24400     IF SF%(SNS+4) THEN CIRCLE(370,130+7),2,2,,,,F
  1442. 24410     GOSUB *S_BTN_PR
  1443. 24420 *S_DOWN_1
  1444. 24430   WEND
  1445. 24440   MOUSE 1,MOUSE(0),MOUSE(1),1
  1446. 24450   ERASE A%
  1447. 24460 RETURN
  1448. 24470 '
  1449. 24480 *LOAD_SSND
  1450. 24490   SNMAX=SNMAX+1: SN=SNMAX
  1451. 24500   IF 5<=SNMAX THEN SNSMAX=SNMAX-4: SNS=SNSMAX ELSE SNSMAX=1: SNS=1
  1452. 24510   SSIZE(SN)=32+TL
  1453. 24520   SDMP(SN+1)=SDMP(SN)+SSIZE(SN)
  1454. 24530   MOUSE 1,,,0
  1455. 24540   GOSUB *WIN_ON
  1456. 24550   FSIX=WX+329: FSIY=WY+135
  1457. 24560   LINE(WX+1,FSIY-1)-(FSIX+1,FSIY+35),PSET,7,BF
  1458. 24570   LINE(FSIX-(32+TL)/384-1,FSIY-1)-(FSIX+1,FSIY+9),PSET,0,B
  1459. 24580   LINE(FSIX-(32+TL)/384-1,FSIY-1)-(FSIX+1,FSIY+9),PSET,0,B
  1460. 24590   DIM A%(4)
  1461. 24600   FP=0: MP=VARPTR(A%(0)): L=8: FLOADF=0
  1462. 24610   GOSUB *FLOAD
  1463. 24620   P=VARPTR(A%(0)): SNAME$(SN)=""
  1464. 24630   FOR I=0 TO 7
  1465. 24640     J=PEEK(P+I): IF J=0 THEN I=7 ELSE SNAME$(SN)=SNAME$(SN)+CHR$(J)
  1466. 24650   NEXT I
  1467. 24660   ERASE A%
  1468. 24670   SYMBOL(FSIX-112,FSIY+17),SNAME$(SN),1,1,0
  1469. 24680   SYMBOL(FSIX-50,FSIY+17),STR$(SSIZE(SN)),1,1,0
  1470. 24690   FP=0: L=32+TL: MP=VARPTR(SDM%(0))+SDMP(SN): MSP=0: FLOADF=1
  1471. 24700   GOSUB *FLOAD
  1472. 24710   GOSUB *WIN_OFF
  1473. 24720   MOUSE 1,,,1
  1474. 24730   P=VARPTR(SDM%(0))+SDMP(SN)
  1475. 24740   POKE P+8,SN,4: SN%(SN)=PEEK(P+28)-24: SF%(SN)=0
  1476. 24750   GOSUB *WIN_END
  1477. 24760   GOSUB *SMR_PR
  1478. 24770   GOSUB *S_PR
  1479. 24780   GOSUB *S_DATA_PR
  1480. 24790 RETURN
  1481. 24800 '
  1482. 24810 *LOAD_SPMB
  1483. 24820   GOSUB *WIN_END
  1484. 24830   XMAX=2: FSTL=0 
  1485. 24840   IF 20<FSNMAX THEN XMAX=3
  1486. 24850   IF 40<FSNMAX THEN XMAX=4
  1487. 24860   YMAX=(FSNMAX-1)\XMAX+1
  1488. 24870   WON=3+FSNMAX: WF=2: WXS=140*XMAX+50: WYS=20*YMAX+155
  1489. 24880   GOSUB *WIN_INIT
  1490. 24890   IF ERRF THEN GOSUB *FLOAD_END: ERROR 90
  1491. 24900   FOR I=0 TO 99: FSF%(I)=0: NEXT I
  1492. 24910 '
  1493. 24920   SYMBOL(WX+15,WY+15),"サウンドデータのLOAD",1,1,0
  1494. 24930   SYMBOL(WX+28,WY+45),LEFT$(FL3$+"       ",8)+FL4$,1,1,0
  1495. 24940   SYMBOL(WX+28,WY+65),FBNK$,1,1,0
  1496. 24950   GOSUB *LOAD_SPMB_FSTL
  1497. 24960   SYMBOL(WX+170,WY+65),"ALL",1,1,0
  1498. 24970   SYMBOL(WX+210,WY+65),"LOAD",1,1,0
  1499. 24980   SYMBOL(WX+263,WY+65),"取消",1,1,0
  1500. 24990   LINE(WX+24,WY+131)-(WX+26+140*XMAX,WY+133+20*YMAX),PSET,%8,B'DATAS
  1501. 25000   RESTORE *LOAD_SPMB
  1502. 25010   FOR I=1 TO 3
  1503. 25020     FOR J=0 TO 3: READ WOZ(I,J): NEXT J
  1504. 25030     LINE(WX+WOZ(I,0),WY+WOZ(I,1))-(WX+WOZ(I,2),WY+WOZ(I,3)),PSET,%8,B
  1505. 25040   NEXT I
  1506. 25050   DATA 167, 63,197, 82'ALL
  1507. 25060   DATA 202, 63,250, 82'LOAD
  1508. 25070   DATA 255, 63,303, 82'取消
  1509. 25080 '
  1510. 25090   FOR I=0 TO FSNMAX-1: FSN=I+1
  1511. 25100     WOZ(I+4,0)=140*(I\YMAX)+26: WOZ(I+4,1)=20*(I MOD YMAX)+133
  1512. 25110     WOZ(I+4,2)=WOZ(I+4,0)+139: WOZ(I+4,3)=WOZ(I+4,1)+19
  1513. 25120     LINE(WX+WOZ(I+4,0),WY+WOZ(I+4,1))-STEP(138,18),PSET,%7,B,&H5555
  1514. 25130     GOSUB *LOAD_SPMB_PR
  1515. 25140   NEXT I
  1516. 25150   GOSUB *MPLOOP2
  1517. 25160 *LOAD_SPMB_LOOP
  1518. 25170   GOSUB *WIN
  1519. 25180   LOADWX=WX: LOADWY=WY
  1520. 25190   MOUSE 4,0,0,639,479
  1521. 25200   IF WC=1 GOSUB *LOAD_SPMB_ALL
  1522. 25210   IF WC=2 IF FSTL<=SMR THEN GOSUB *LOAD_SPMB_EXE: GOTO *LOAD_SPMB_RET                            ELSE BEEP: GOSUB *MPLOOP2
  1523. 25220   IF WC=3 OR MOUSE(2,1)=-1 GOSUB *WIN_END: GOTO *LOAD_SPMB_RET
  1524. 25230   IF 4<=WC AND WC<=FSNMAX+3 THEN FSN=WC-3: GOSUB *LOAD_SPMB_SET
  1525. 25240 GOTO *LOAD_SPMB_LOOP
  1526. 25250 *LOAD_SPMB_RET
  1527. 25260 RETURN
  1528. 25270 '
  1529. 25280 *LOAD_SPMB_PR
  1530. 25290   IF FSF%(FSN)=1 THEN CL=2 ELSE CL=0
  1531. 25300   X=WX+140*((FSN-1)\YMAX)+26: Y=WY+20*((FSN-1) MOD YMAX)+135
  1532. 25310   SYMBOL(X-6,Y),STR$(FSN),1,1,CL
  1533. 25320   SYMBOL(X+24,Y),FSNAME$(FSN),1,1,CL
  1534. 25330   SYMBOL(X+86,Y),STR$(FSSIZE(FSN)),1,1,CL
  1535. 25340 RETURN
  1536. 25350 '
  1537. 25360 *LOAD_SPMB_ALL
  1538. 25370   J=0
  1539. 25380   FOR I=1 TO FSNMAX
  1540. 25390     IF FSF%(I)=1 THEN J=1: I=FSNMAX
  1541. 25400   NEXT I
  1542. 25410   FOR FSN=1 TO FSNMAX
  1543. 25420     IF J=0 AND FSF%(FSN)=0 THEN FSF%(FSN)=1: FSTL=FSTL+FSSIZE(FSN):                                  GOSUB *LOAD_SPMB_PR: GOSUB *LOAD_SPMB_FSTL
  1544. 25430     IF J=1 AND FSF%(FSN)=1 THEN FSF%(FSN)=0: FSTL=FSTL-FSSIZE(FSN):                                  GOSUB *LOAD_SPMB_PR: GOSUB *LOAD_SPMB_FSTL
  1545. 25440   NEXT FSN
  1546. 25450   GOSUB *MPLOOP2
  1547. 25460 RETURN
  1548. 25470 '
  1549. 25480 *LOAD_SPMB_SET
  1550. 25490   IF FSF%(FSN)=0 THEN FSF%(FSN)=1: FSTL=FSTL+FSSIZE(FSN)                                   ELSE FSF%(FSN)=0: FSTL=FSTL-FSSIZE(FSN)
  1551. 25500   GOSUB *LOAD_SPMB_PR
  1552. 25510   GOSUB *LOAD_SPMB_FSTL
  1553. 25520   GOSUB *MPLOOP2
  1554. 25530 RETURN
  1555. 25540 '
  1556. 25550 *LOAD_SPMB_FSTL
  1557. 25560   IF SMR<FSTL OR SMR=0 THEN CL=2 ELSE CL=0
  1558. 25570   LINE(WX+160,WY+45)-STEP(150,15),PSET,7,BF
  1559. 25580   SYMBOL(WX+231,WY+45),"|",1,1,0
  1560. 25590   SYMBOL(WX+162,WY+45),STR$(SMR-FSTL),1,1,CL
  1561. 25600   SYMBOL(WX+239,WY+45),STR$(FSTL),1,1,0
  1562. 25610 RETURN
  1563. 25620 '
  1564. 25630 *LOAD_SPMB_EXE
  1565. 25640   MOUSE 1,,,0
  1566. 25650   GOSUB*WIN_ON
  1567. 25660   FSIX=WX+302: FSIY=WY+90: FSSX=WX+190: FSSY=WY+107: MSP=0
  1568. 25670   FOR FSN=1 TO FSNMAX
  1569. 25680     IF FSF%(FSN)=1 THEN MSP=MSP+FSSIZE(FSN):                                                        LINE(FSIX-MSP/384,FSIY)-STEP(0,8),PSET,%7
  1570. 25690   NEXT FSN
  1571. 25700   LINE(FSIX-MSP/384,FSIY-1)-(FSIX+1,FSIY+9),PSET,%8,B
  1572. 25710   GOSUB *WIN_OFF
  1573. 25720   MSP=0
  1574. 25730   GOSUB *FSLOAD
  1575. 25740   MOUSE 1,,,1
  1576. 25750   GOSUB *WIN_END
  1577. 25760   GOSUB *S_PR
  1578. 25770   GOSUB *SMR_PR
  1579. 25780   GOSUB *S_DATA_PR
  1580. 25790 RETURN
  1581. 25800 '
  1582. 25810 *SMR_PR
  1583. 25820   SMR=SMRTL-SDMP(SNMAX+1)
  1584. 25830   LINE(475,22)-STEP(8*7,15),PSET,%7,BF
  1585. 25840   SYMBOL(475-8,22),STR$(SMR),1,1,0
  1586. 25850 RETURN
  1587. 25860 '
  1588. 25870 *S_DATA
  1589. 25880   IF SNMAX=0 GOTO *S_DATA_RET
  1590. 25890 *S_DATA_LOOP
  1591. 25900   IF MOUSE(2,0)=0 GOTO *S_DATA_RET
  1592. 25910   MX=MOUSE(0): MY=MOUSE(1)
  1593. 25920   IF MX<272 OR MY<46 OR 400<MX OR 150<MY GOTO *S_DATA_RET
  1594. 25930   GOSUB *S_SCRN
  1595. 25940 IF SC=-1 GOTO *S_DATA_LOOP
  1596. 25950   SN=SC
  1597. 25960   GOSUB *S_PR
  1598. 25970   GOSUB *S_DATA_PR
  1599. 25980 *S_DATA_RET
  1600. 25990 RETURN
  1601. 26000 '
  1602. 26010 *S_DATA_PR
  1603. 26020   P=VARPTR(SDM%(0))+SDMP(SN)
  1604. 26030   SNAME$=SNAME$(SN)
  1605. 26040   RATE=PEEK(P+24,2)*1000/98
  1606. 26050   I=PEEK(P+26,2)
  1607. 26060   IF I>=32768 THEN HOSEI%=I-65536 ELSE HOSEI%=I
  1608. 26070   GENO=INT(SN%(SN)/12): GENN=(SN%(SN)+65532) MOD 12
  1609. 26080   IF SN%(SN)<0 OR 95<SN%(SN) THEN CL=2 ELSE CL=7
  1610. 26090   SSIZE=SSIZE(SN)
  1611. 26100   LINE(475,50)-STEP(63,95),PSET,%7,BF
  1612. 26110   SYMBOL(475,50),SNAME$,1,1,7
  1613. 26120   SYMBOL(475,70),STR$(RATE),1,1,7
  1614. 26130   SYMBOL(475,90),STR$(HOSEI%),1,1,7
  1615. 26140   SYMBOL(475,110)," O"+RIGHT$(STR$(GENO+1),1)+"  "+N$(GENN),1,1,CL
  1616. 26150   SYMBOL(475,130),STR$(SSIZE),1,1,7
  1617. 26160 RETURN
  1618. 26170 '
  1619. 26180 *S_DATA_OP
  1620. 26190 IF 459<=MX AND  90<=MY AND MX<=474 AND MY<=105                                 THEN MOUSE 4,459, 90,474,105: V=-1: GOSUB *HOSEI
  1621. 26200 IF 539<=MX AND  90<=MY AND MX<=554 AND MY<=105                                 THEN MOUSE 4,539, 90,554,105: V= 1: GOSUB *HOSEI
  1622. 26210 IF 459<=MX AND 110<=MY AND MX<=474 AND MY<=125                                 THEN MOUSE 4,459,110,474,125: V=-1: GOSUB *GEN
  1623. 26220 IF 539<=MX AND 110<=MY AND MX<=554 AND MY<=125                                 THEN MOUSE 4,539,110,554,125: V= 1: GOSUB *GEN
  1624. 26230 IF 475<=MX AND  50<=MY AND MX<=538 AND MY<= 65 GOSUB *SNAME
  1625. 26240   MOUSE 4,0,0,639,479
  1626. 26250   P=VARPTR(SDM%(0))+SDMP(SN)
  1627. 26260   SNAME$(SN)=SNAME$
  1628. 26270   FOR I=0 TO 7
  1629. 26280     J$=MID$(SNAME$,I+1,1)
  1630. 26290     IF J$="" THEN POKE P+I,0 ELSE POKE P+I,ASC(J$)
  1631. 26300   NEXT I
  1632. 26310   POKE P+26,HOSEI%,2 
  1633. 26320   POKE P+28,SN%(SN)+24
  1634. 26330 RETURN
  1635. 26340 '  
  1636. 26350 *HOSEI
  1637. 26360   T=-1
  1638. 26370   WHILE MOUSE(2,0)=-1 OR MOUSE(2,1)=-1
  1639. 26380     PUSH=0: T=T+1
  1640. 26390     IF MOUSE(2,0)=-1 THEN PUSH=1
  1641. 26400     IF MOUSE(2,1)=-1 THEN PUSH=10
  1642. 26410     IF MOUSE(2,0)=-1 AND MOUSE(2,1)=-1 THEN PUSH=100
  1643. 26420 IF T=0 OR 100<T THEN I=HOSEI%+V*PUSH ELSE GOTO *HOSEI_2
  1644. 26430     IF I<-32768 THEN I=-32768
  1645. 26440     IF  32767<I THEN I=32767
  1646. 26450 IF I=HOSEI% GOTO *HOSEI_2
  1647. 26460     HOSEI%=I
  1648. 26470     LINE(475,90)-STEP(63,15),PSET,%7,BF
  1649. 26480     SYMBOL(475,90),STR$(HOSEI%),1,1,7
  1650. 26490 *HOSEI_2
  1651. 26500   WEND
  1652. 26510 RETURN
  1653. 26520 '  
  1654. 26530 *GEN
  1655. 26540   MOUSE 1,,,0
  1656. 26550   T=-1
  1657. 26560   WHILE MOUSE(2,0)=-1 OR MOUSE(2,1)=-1
  1658. 26570     PUSH=0: T=T+1
  1659. 26580     IF MOUSE(2,0)=-1 THEN PUSH=1
  1660. 26590     IF MOUSE(2,1)=-1 THEN PUSH=12
  1661. 26600     IF T=0 OR 100<T THEN J=SN%(SN)+V*PUSH ELSE GOTO *GEN_3
  1662. 26610     IF J<0 THEN J=0
  1663. 26620     IF 95<J THEN J=95
  1664. 26630     IF J=SN%(SN) GOTO *GEN_3
  1665. 26640     SN%(SN)=J: O=INT(SN%(SN)/12): N=SN%(SN) MOD 12
  1666. 26650     LINE(475,110)-STEP(63,15),PSET,%7,BF
  1667. 26660     SYMBOL(475,110)," O"+RIGHT$(STR$(O+1),1)+"  "+N$(N),1,1,7
  1668. 26670     FOR S=0 TO 7
  1669. 26680       IF ID(S)<>SN GOTO *GEN_2
  1670. 26690       I=SN%(SN)-ENV%(S,6): CL=7
  1671. 26700       IF I<0  THEN CL=2: I=0
  1672. 26710       IF 95<I THEN CL=2: I=95
  1673. 26720       O=INT(I/12): N=(I+65532) MOD 12
  1674. 26730       LINE(36+S*80,348)-(59+S*80,363),PSET,%7,BF
  1675. 26740       SYMBOL(28+S*80,348),STR$(O+1)+N$(N),1,1,CL
  1676. 26750 *GEN_2
  1677. 26760     NEXT S
  1678. 26770 *GEN_3
  1679. 26780   WEND
  1680. 26790   MOUSE 1,MOUSE(0),MOUSE(1),1
  1681. 26800 RETURN
  1682. 26810 '  
  1683. 26820 *SNAME
  1684. 26830   IX=475: IY=50: IM=8: IMM=8: IA$=SNAME$: ICL=15
  1685. 26840   LINE(475,50)-STEP(63,15),PSET,%7,BF
  1686. 26850   GOSUB *INP_INIT
  1687. 26860 *SNAME_LOOP
  1688. 26870   IF MOUSE(2,0)=0 THEN MOUSE 4,0,0,639,479: GOTO *SNAME_LOOP_2
  1689. 26880   MX=MOUSE(0): MY=MOUSE(1)
  1690. 26890 IF 475<=MX AND 50<=MY AND MX<=538 AND MY<=65                                   THEN MOUSE 4,475,50,538,65                                                  ELSE GOTO *SNAME_RET
  1691. 26900 *SNAME_LOOP_2
  1692. 26910   GOSUB *INP
  1693. 26920 IF IC<>&H0D AND MOUSE(2,1)=0 GOTO *SNAME_LOOP
  1694. 26930 *SNAME_RET
  1695. 26940   SNAME$=IA$: SNAME$(SN)=SNAME$
  1696. 26950   GOSUB *INP_END
  1697. 26960   GOSUB *S_PR
  1698. 26970   GOSUB *ENV_SNAME_PR
  1699. 26980 RETURN
  1700. 26990 '
  1701. 27000 *S_PLAY
  1702. 27010   SYMBOL(205,70),"PLAY",1,1,2
  1703. 27020   ERASE SPA%
  1704. 27030   DIM SPA%(SSIZE(SN)\2)
  1705. 27040   CALLM MTRNSM,VARPTR(SDM%(0))+SDMP(SN),VARPTR(SPA%(0)),SSIZE(SN)
  1706. 27050   PCMPLAY SPA%
  1707. 27060   GOSUB *MPLOOP2
  1708. 27070   SYMBOL(205,70),"PLAY",1,1,0
  1709. 27080 RETURN
  1710. 27090 '
  1711. 27100 *S_KILL
  1712. 27110   IF SNMAX=0 RETURN
  1713. 27120   SYMBOL(205,50),"削除",1,1,2
  1714. 27130   GOSUB *MPLOOP2
  1715. 27140 *S_KILL_LOOP
  1716. 27150   GOSUB *MPLOOP1
  1717. 27160   IF PUSH=2 OR MX<272 OR MY<46 OR 400<MX OR 150<MY GOTO *S_KILL_RET
  1718. 27170   GOSUB *S_SCRN
  1719. 27180 IF SC=-1 GOTO *S_KILL_LOOP
  1720. 27190   FOR I=0 TO SNMAX: SID(I)=I: NEXT I
  1721. 27200   I=SC: SID(SC)=0
  1722. 27210 '
  1723. 27220   WHILE I<=SNMAX-1
  1724. 27230     SNAME$(I)=SNAME$(I+1): SN%(I)=SN%(I+1): SID(I+1)=I
  1725. 27240     P=VARPTR(SDM%(0))
  1726. 27250     CALLM MTRNSM,P+SDMP(I+1),P+SDMP(I),SSIZE(I+1)
  1727. 27260     POKE P+SDMP(I)+8,I,4
  1728. 27270     SSIZE(I)=SSIZE(I+1): SDMP(I+1)=SDMP(I)+SSIZE(I): SF%(I)=SF%(I+1)
  1729. 27280     I=I+1
  1730. 27290   WEND
  1731. 27300 '
  1732. 27310   P=VARPTR(ALLV%(0,0))
  1733. 27320   FOR I=0 TO 3968 STEP 128
  1734. 27330     FOR J=0 TO 28 STEP 4
  1735. 27340       POKE P+I+32+J,SID(PEEK(P+I+32+J,4)),4
  1736. 27350     NEXT J
  1737. 27360   NEXT I
  1738. 27370   FOR S=0 TO 7
  1739. 27380     ID(S)=SID(ID(S))
  1740. 27390   NEXT S
  1741. 27400   GOSUB *ENV_SET
  1742. 27410   GOSUB *ENV_SNAME_PR
  1743. 27420 '
  1744. 27430   SNMAX=SNMAX-1
  1745. 27440   IF SNMAX<=5 THEN SNSMAX=1 ELSE SNSMAX=SNMAX-4
  1746. 27450   IF SNSMAX<=SNS THEN SNS=SNSMAX
  1747. 27460   IF SN=SC THEN SN=0
  1748. 27470   IF SC<SN THEN SN=SN-1
  1749. 27480   SF%(SNMAX+1)=0: SNAME$(SNMAX+1)=""
  1750. 27490   GOSUB *S_PR
  1751. 27500   GOSUB *SMR_PR
  1752. 27510   GOSUB *S_DATA_PR
  1753. 27520 *S_KILL_RET
  1754. 27530   SYMBOL(205,50),"削除",1,1,0
  1755. 27540 RETURN
  1756. 27550 '
  1757. 27560 *ERR
  1758. 27570   BEEP: CLOSE: MOUSE 0: MOUSE 1,,,1
  1759. 27580   GOSUB *WIN_OFF
  1760. 27590   GOSUB *INP_END
  1761. 27600   GOSUB *WIN_END
  1762. 27610   WX=ERRWX: WY=ERRWY: WXS=190: WYS=95: WON=2: WF=0
  1763. 27620   RESTORE *ERR
  1764. 27630   GOSUB *WIN_INIT
  1765. 27640   DATA  78, 68,128, 88'中断
  1766. 27650   DATA 133, 68,183, 88'無視
  1767. 27660   IF ERR=90 THEN SYMBOL(WX+10,WY+15),"ウィンドーが開けません",1,1,0                     ELSE SYMBOL(WX+18,WY+15),"エラーが発生しました",1,1,0 
  1768. 27670   SYMBOL(WX+30,WY+40),"ERROR"+STR$(ERR)+"/"+STR$(ERL)+"行",1,1,0
  1769. 27680   SYMBOL(WX+87,WY+70),"中断",1,1,0
  1770. 27690   SYMBOL(WX+142,WY+70),"無視",1,1,0
  1771. 27700   GOSUB *MPLOOP2
  1772. 27710 *ERR_LOOP
  1773. 27720   GOSUB *WIN
  1774. 27730   ERRWX=WX: ERRWY=WY: MOUSE 4,0,0,639,479
  1775. 27740   IF WC=1 THEN PLAY OFF: END
  1776. 27750   IF WC=2 OR MOUSE(2,1)=-1 THEN GOSUB *WIN_END: GOSUB *MPLOOP2:                                             RESUME *MAIN
  1777. 27760 GOTO *ERR_LOOP
  1778. 27770 '
  1779. 27780 *ERRKP
  1780. 27790   ERRC=ERR
  1781. 27800 RESUME NEXT
  1782. 27810 '
  1783. 27820 *FSCHK
  1784. 27830   DIM A%(16)
  1785. 27840   FP=0: MP=VARPTR(A%(0)): L=8: FLOADF=0
  1786. 27850   GOSUB *FLOAD
  1787. 27860   P=VARPTR(A%(0)): FBNK$=""
  1788. 27870   FOR I=0 TO 7
  1789. 27880     J=PEEK(P+I): IF J THEN FBNK$=FBNK$+CHR$(J)
  1790. 27890   NEXT I
  1791. 27900   FSNMAX=0: FSP=4104: FSTL=0
  1792. 27910 *FSCHK_LOOP
  1793. 27920 IF FLTL<FSP+32 GOTO *FSCHK_RET
  1794. 27930   FP=FSP: MP=VARPTR(A%(0)): L=32
  1795. 27940   GOSUB *FLOAD
  1796. 27950   P=VARPTR(A%(0))
  1797. 27960   TL=PEEK(P+12,4)
  1798. 27970 IF FLTL<FSP+32+TL OR TL<0 GOTO *FSCHK_RET
  1799. 27980   FSNMAX=FSNMAX+1: FSN=FSNMAX
  1800. 27990   SID(FSN)=PEEK(P+8,4): FSSIZE(FSN)=32+TL: FSTL=FSTL+32+TL
  1801. 28000   FSNAME$(FSN)=""
  1802. 28010   FOR I=0 TO 7
  1803. 28020     J=PEEK(P+I): IF J THEN FSNAME$(FSN)=FSNAME$(FSN)+CHR$(J)
  1804. 28030   NEXT I
  1805. 28040   FSP(FSN)=FSP: FSP=FSP+32+TL
  1806. 28050 GOTO *FSCHK_LOOP
  1807. 28060 *FSCHK_RET
  1808. 28070   ERASE A%
  1809. 28080 RETURN
  1810. 28090 '
  1811. 28100 *FLOAD_INIT
  1812. 28110   OPEN "R",1,FL1$+"(128)"+FL2$+FL3$+FL4$: FIELD 1,128 AS FB1$
  1813. 28120   OPEN "R",2,FL1$+"(1)"  +FL2$+FL3$+FL4$: FIELD 2,  1 AS FB2$
  1814. 28130   FLTL=LOF(2): FLN=(FLTL-1)\128
  1815. 28140   IF FLTL<=0 OR SMRTL<FLTL THEN CLOSE: ERRF=1: RETURN
  1816. 28150   DIM FLBF%(FLTL\2+1),FLBFF%(FLN)
  1817. 28160 RETURN
  1818. 28170 '
  1819. 28180 *FLOAD_END
  1820. 28190   ERASE FLBF%,FLBFF%
  1821. 28200   CLOSE
  1822. 28210 RETURN
  1823. 28220 '
  1824. 28230 *FLOAD    'FP   L  >  MP   ,FLOADF
  1825. 28240 IF L<=0 OR FLTL-1<FP THEN RETURN
  1826. 28250   N1=FP\128: N2=(FP+L-1)\128
  1827. 28260 '
  1828. 28270   I=N1: P=VARPTR(FLBF%(0))
  1829. 28280   WHILE I<=N2 AND I<=FLN
  1830. 28290     IF FLBFF%(I) THEN GOTO *FLOAD_1 ELSE FLBFF%(I)=1
  1831. 28300     IF I=FLN GOSUB *FLOAD_SUB: GOTO *FLOAD_1
  1832. 28310     GET 1,I+1
  1833. 28320     CALLM MTRNSM,PEEK(VARPTR(FB1$),4),P+128*I,128
  1834. 28330 *FLOAD_1
  1835. 28340     IF FLOADF LINE(FSIX-(MSP+(I-N1)*128)/384,FSIY)-STEP(0,8),PSET,1
  1836. 28350     I=I+1
  1837. 28360   WEND
  1838. 28370   CALLM MTRNSM,VARPTR(FLBF%(0))+FP,MP,L
  1839. 28380 RETURN
  1840. 28390 '
  1841. 28400 *FLOAD_SUB
  1842. 28410   J=128*FLN
  1843. 28420   WHILE J<=FLTL-1
  1844. 28430     GET 2,J+1
  1845. 28440     POKE P+J,ASC(FB2$)
  1846. 28450     J=J+1
  1847. 28460   WEND
  1848. 28470 RETURN
  1849. 28480 '
  1850. 28490 *FSLOAD
  1851. 28500   SNMIN=SNMAX: FSN=1: FLOADF=1
  1852. 28510   GOSUB *WIN_ON
  1853. 28520   WHILE FSN<=FSNMAX
  1854. 28530     IF FSF%(FSN)=0 OR SNMAX>=99 GOTO *FSLOAD_2
  1855. 28540     SNMAX=SNMAX+1
  1856. 28550     LINE(FSIX-142,FSIY+17)-STEP(140,15),PSET,7,BF
  1857. 28560     SYMBOL(FSIX-142,FSIY+17),STR$(FSN),1,1,0
  1858. 28570     SYMBOL(FSIX-112,FSIY+17),FSNAME$(FSN),1,1,0
  1859. 28580     SYMBOL(FSIX-50,FSIY+17),STR$(FSSIZE(FSN)),1,1,0
  1860. 28590     FP=FSP(FSN): L=FSSIZE(FSN): MP=VARPTR(SDM%(0))+SDMP(SNMAX)
  1861. 28600     GOSUB *FLOAD
  1862. 28610     MSP=MSP+FSSIZE(FSN)
  1863. 28620     P=VARPTR(SDM%(0))+SDMP(SNMAX)
  1864. 28630     SID(SNMAX)=PEEK(P+8,4): POKE P+8,SNMAX,4
  1865. 28640     SN%(SNMAX)=PEEK(P+28)-24: SNAME$(SNMAX)=FSNAME$(FSN)
  1866. 28650     SSIZE(SNMAX)=FSSIZE(FSN): SDMP(SNMAX+1)=SDMP(SNMAX)+SSIZE(SNMAX)
  1867. 28660     SF%(SNMAX)=0
  1868. 28670 *FSLOAD_2
  1869. 28680     FSN=FSN+1
  1870. 28690   WEND
  1871. 28700   IF SNMIN<SNMAX: SN=SNMIN+1
  1872. 28710   IF 5<=SNMAX THEN SNSMAX=SNMAX-4: SNS=SN ELSE SNSMAX=1: SNS=1
  1873. 28720   IF SNSMAX<SNS THEN SNS=SNSMAX
  1874. 28730   GOSUB *WIN_OFF
  1875. 28740 RETURN
  1876. 28750 '
  1877. 28760 *FSLCT
  1878. 28770   WIDTH 80,25: CONSOLE 2,23,0: COLOR 0,0,7,4: CLS 4
  1879. 28780   DIM FSLCT%(46080)
  1880. 28790   GET@A(0,0)-(380,479),FSLCT%
  1881. 28800   LINE(0,0)-(380,479),PSET,,BF
  1882. 28810   LINE(380,0)-(380,479),PSET,0
  1883. 28820 *FSLCT_1
  1884. 28830   CL=5
  1885. 28840   GOSUB *FSLCT_PR
  1886. 28850   CL=4
  1887. 28860   ON ERROR GOTO *FSLCT_ERR
  1888. 28870   CLS 1: LOCATE 0,2:FILES DSK$+PATH$(DSK)+"*.*"
  1889. 28880   ON ERROR GOTO *ERR
  1890. 28890   YMAX=CSRLIN
  1891. 28900   GOSUB *FSLCT_PR
  1892. 28910   IF CL=4 THEN LOCATE 10,0:PRINT DSK$+PATH$(DSK)+"*.*";
  1893. 28920   GOSUB *MPLOOP2
  1894. 28930 *FSLCT_LOOP
  1895. 28940   GOSUB *MPLOOP1
  1896. 28950   Y=INT(MY/19)
  1897. 28960 IF PUSH=2 THEN FSLCT$="": GOTO *FSLCT_RET
  1898. 28970   IF  0<=MX AND 0<=MY AND MX<=16 AND MY<=16                                      THEN DSK=DSK-1: CLS 1: CL=5: GOSUB *FSLCT_PR: GOSUB *MPLOOP2
  1899. 28980   IF 48<=MX AND 0<=MY AND MX<=64 AND MY<=16                                      THEN DSK=DSK+1: CLS 1: CL=5: GOSUB *FSLCT_PR: GOSUB *MPLOOP2
  1900. 28990   IF 24<=MX AND 0<=MY AND MX<=40 AND MY<=16 GOTO *FSLCT_1
  1901. 29000 IF CL=5 GOTO *FSLCT_LOOP
  1902. 29010   IF 80<=MX AND 0<=MY AND MX<=80+8*LEN(PATH$(DSK))+15 AND MY<=16                 THEN GOSUB *FSLCT_PATH2: GOTO *FSLCT_1
  1903. 29020 IF MX<0 OR 380<MX OR Y<=1 OR YMAX-2<=Y GOTO *FSLCT_LOOP
  1904. 29030   FL1$="": FL2$="": FL3$=""
  1905. 29040   I=0
  1906. 29050   WHILE I<=7 AND SCREEN(I,Y)<>&H20
  1907. 29060     FL1$=FL1$+CHR$(SCREEN(I,Y)): I=I+1
  1908. 29070   WEND
  1909. 29080   I=0
  1910. 29090   WHILE I<=2 AND SCREEN(9+I,Y)<>0
  1911. 29100     FL2$=FL2$+CHR$(SCREEN(9+I,Y)): I=I+1
  1912. 29110   WEND
  1913. 29120   FOR I=0 TO 8
  1914. 29130     FL3$=FL3$+CHR$(SCREEN(16+I,Y))
  1915. 29140   NEXT I
  1916. 29150   IF INSTR(FL1$,".")<>0 OR INSTR(FL2$,".")<>0 THEN GOSUB *FSLCT_PATH1:                                                         GOTO *FSLCT_1
  1917. 29160   IF INSTR(FL3$,"DIR")<>0 THEN PATH$(DSK)=PATH$(DSK)+FL1$+"\":                   GOTO *FSLCT_1
  1918. 29170   FSLCT$=DSK$+PATH$(DSK)+FL1$+"."+FL2$
  1919. 29180 GOTO *FSLCT_RET
  1920. 29190 '
  1921. 29200 *FSLCT_PATH1
  1922. 29210   I=LEN(PATH$(DSK))-1: PATH$(DSK)=LEFT$(PATH$(DSK),I)
  1923. 29220   WHILE MID$(PATH$(DSK),I,1)<>"\"
  1924. 29230     I=I-1: PATH$(DSK)=LEFT$(PATH$(DSK),I)
  1925. 29240   WEND
  1926. 29250 RETURN
  1927. 29260 '
  1928. 29270 *FSLCT_PATH2
  1929. 29280   X=INT((MX-96)/8)+1
  1930. 29290 IF X<=1 THEN PATH$(DSK)="\": RETURN
  1931. 29300   FOR I=X TO LEN(PATH$(DSK))
  1932. 29310     IF MID$(PATH$(DSK),I,1)="\" THEN J=I: I=255
  1933. 29320   NEXT I
  1934. 29330   PATH$(DSK)=LEFT$(PATH$(DSK),J)
  1935. 29340 RETURN
  1936. 29350 '
  1937. 29360 *FSLCT_RET
  1938. 29370   CLS 4
  1939. 29380   PUT@A(0,0)-(380,479),FSLCT%
  1940. 29390   ERASE FSLCT%
  1941. 29400   GOSUB *MPLOOP2
  1942. 29410 RETURN
  1943. 29420 '
  1944. 29430 *FSLCT_INIT
  1945. 29440   DIM PATH$(16)
  1946. 29450   DSK=0: DSK$=CHR$(&H41+DSK)
  1947. 29460   FOR I=0 TO 16: PATH$(I)="\": NEXT I
  1948. 29470 RETURN
  1949. 29480 '
  1950. 29490 *FSLCT_PR
  1951. 29500   DSK=(DSK+17) MOD 17
  1952. 29510   DSK$=CHR$(&H41+DSK)+":"
  1953. 29520   CLS 2
  1954. 29530   LOCATE 0,0: PRINT "<    >";
  1955. 29540   COLOR,,,CL: LOCATE 3,0: PRINT DSK$;: COLOR ,,,4
  1956. 29550 RETURN
  1957. 29560 '
  1958. 29570 *FSLCT_ERR
  1959. 29580  CL=5: PATH$(DSK)="\"
  1960. 29590  IF ERR=63 THEN RESUME *FSLCT_1
  1961. 29600  BEEP
  1962. 29610  LOCATE 0,2: PRINT "File Access Error";
  1963. 29620 RESUME NEXT
  1964. 29630 '
  1965. 29640 *FLCNV 'FL$>FL1$,FL2$,FL3$,FL4$
  1966. 29650   J=INSTR(FL$,":"): K=1: L=INSTR(FL$,".")
  1967. 29660   FOR I=1 TO LEN(FL$)
  1968. 29670     IF MID$(FL$,I,1)=":" OR MID$(FL$,I,1)="\" THEN K=I+1
  1969. 29680   NEXT I
  1970. 29690   IF L<>0 THEN FL3$=MID$(FL$,K,L-K): FL4$=MID$(FL$,L)                                 ELSE FL3$=MID$(FL$,K): IF MODE=4 THEN FL4$=".SND"                                                            ELSE FL4$=".PMB"
  1971. 29700   FL1$=LEFT$(FL$,J)
  1972. 29710   FL2$=MID$(FL$,J+1,K-(J+1))
  1973. 29720   FL$=FL1$+FL2$+FL3$+FL4$
  1974. 29730 RETURN
  1975. 29740 '
  1976.