home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 5
/
FREESOFT.BIN
/
fb386
/
pmbed
/
pmbed.bas
< prev
next >
Wrap
BASIC Source File
|
1992-08-19
|
67KB
|
1,976 lines
10000 DATA " ___________________________________________________________ "
10010 DATA " PMBED Ver1.02 1992/01/26 Copyright(c) TETSU 1992- "
10020 DATA " FileName=「PMBED.BAS」 "
10030 DATA " FM-TOWNS用 要2MbyteRAM "
10040 DATA " F-BASIC386 V1.1L20 以降用 "
10050 DATA " カレントディレクトリに「mtrnsm.rex」が必要 "
10060 DATA " ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ "
10070 *INIT
10080 SCREEN@ 0: COLOR 7,0,7,0: CLS: WIDTH 80,25: CONSOLE 0,24,0
10090 PAL=0: FOR I=0 TO 15: PALETTE I,[PAL,PAL,PAL]: NEXT I
10100 COLOR 7,0,7,1: RESTORE
10110 FOR I=0 TO 6: READ I$: LOCATE 9,7+I: PRINT I$;: NEXT I
10120 COLOR 7,0,7,0
10130 CLEAR ,,512,,1000
10140 CLEAR ,,,FRE(4)-50000
10150 DEFLNG A-Z
10160 SMRTL=((FRE(3)-300000)\4)*2: PAL=0
10170 IF SMRTL<=0 THEN BEEP: PRINT "実行不能 もっとメモリーを!": END
10180 WINDOW(0,0)-(1023,511)
10190 VIEW (0,0)-(1023,511)
10200 LINE (0,0)-(1023,511),PSET,%7,BF
10210 MTRNSM=5: LOADM "mtrnsm.rex",MTRNSM
10220 DEF FNVRAM (X,Y)=INT((INT((X+8)/8)*(Y+1)*4+2-1)/2)
10230 DIM FSNAME$(99),FSSIZE(99),SID(99),FSP(99),FSF%(99)'*FSCHK 用
10240 PI!=3.14159!/2/127
10250 LOADWX=140: LOADWY=140: LFL$=""
10260 SAVEWX=160: SAVEWY=180: SFL$=""
10270 ERRWX =220: ERRWY =180
10280 EXITWX=220: EXITWY=180
10290 OPTIWX=160: OPTIWY=180
10300 KX = 11: KY =427
10310 MX =320: MY =240
10320 RESTORE *INIT
10330 DIM N$(11): FOR I=0 TO 11: READ N$(I): NEXT I
10340 DATA C,C+,D,D+,E,F,F+,G,G+,A,A+,B
10350 '
10360 'INTERVAL 1: ON INTERVAL GOSUB *INTE: INTERVAL ON
10370 '
10380 GOSUB *BOX
10390 GOSUB *SYMBOL
10400 GOSUB *ENV_INIT
10410 GOSUB *KB_INIT
10420 GOSUB *V_INIT
10430 GOSUB *S_INIT
10440 GOSUB *BTN_INIT
10450 GOSUB *FSLCT_INIT
10460 GOSUB *PAL_INIT
10470 CLS 4
10480 ON ERROR GOTO *ERR
10490 MOUSE 0: MOUSE 1,320,240,1
10500 '
10510 *MAIN
10520 MOUSE 4,0,0,639,479
10530 GOSUB *MPLOOP1
10540 J=0
10550 FOR I=1 TO 17
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
10570 NEXT I
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
10590 GOTO *MAIN
10600 '
10610 *BTN_INIT
10620 DIM BTNX1%(17),BTNY1%(17),BTNX2%(17),BTNY2%(17),BTNM%(17)
10630 RESTORE *BTN_INIT
10640 FOR I=1 TO 17
10650 READ BTNX1%(I),BTNY1%(I),BTNX2%(I),BTNY2%(I),BTNM%(I)
10660 NEXT I
10670 RETURN
10680 DATA 011,427,627,477,1'*KB
10690 DATA 000,158,638,400,3'*ENV_OP
10700 DATA 410, 46,557,150,3'*S_DATA_OP
10710 DATA 205,070,270,085,3'*S_PLAY
10720 DATA 564,108,638,156,3'*PLAYOFF
10730 DATA 564,020,638,040,1'*LOAD
10740 DATA 564,042,638,062,1'*SAVE
10750 DATA 564,064,638,084,1'*EXIT
10760 DATA 564,086,638,106,1'*OPTI
10770 DATA 100,022,163,037,1'*BNK
10780 DATA 005,050,068,065,1'*V_READ
10790 DATA 005,070,068,085,1'*V_SAVE
10800 DATA 005,130,068,145,1'*V_NAME
10810 DATA 005,090,068,105,1'*V_CLR
10820 DATA 075,046,190,150,1'*V_SCRN
10830 DATA 272,046,400,150,1'*S_DATA
10840 DATA 205,050,270,065,1'*S_KILL
10850 '
10860 *PAL_INIT
10870 RESTORE *PAL_INIT
10880 DIM G(15),R(15),B(15)
10890 FOR I=0 TO 15
10900 READ G(I),R(I),B(I)
10910 NEXT I
10920 FOR I!=0 TO 1 STEP .2!
10930 FOR J=0 TO 15
10940 PALETTE J,[PAL+(G(J)-PAL)*I!,PAL+(R(J)-PAL)*I!,PAL+(B(J)-PAL)*I!]
10950 NEXT J
10960 NEXT I!
10970 FOR J=0 TO 15
10980 PALETTE J,[G(J),R(J),B(J)]
10990 NEXT J
11000 ERASE G,R,B
11010 RETURN
11020 DATA 000,000,000 , 000,000,128 , 000,128,000 , 000,128,128
11030 DATA 128,000,000 , 128,000,128 , 128,128,000 , 128,128,128
11040 DATA 040,040,040 , 000,000,255 , 000,255,000 , 000,255,255
11050 DATA 255,000,000 , 255,000,255 , 255,255,000 , 255,255,255
11060 '
11070 '
11080 '
11090 *BOX_PR
11100 LINE(X1,Y1)-(X2,Y2),PSET,7,BF,%7
11110 CONNECT(X1,Y2)-(X2,Y2)-(X2,Y1),0
11120 RETURN
11130 '
11140 *BOX
11150 RESTORE *BOX
11160 READ X1,Y1,X2,Y2
11170 WHILE X1<>-1
11180 GOSUB *BOX_PR
11190 READ X1,Y1,X2,Y2
11200 WEND
11210 RETURN
11220 DATA 001,001,638,018'title
11230 DATA 0, 20,198, 39'バンクネ-ム
11240 DATA 0, 40,198,156'音色達
11250 DATA 170,150, 75, 46'VOICE_NAMES
11260 DATA 191,150,172, 46'VOICE_BAR
11270 DATA 173, 47,190, 65'V_▲
11280 DATA 173,131,190,149'V_▼
11290 DATA 72,150, 3,125'V_NAME
11300 DATA 200, 20,562, 39'登録サウンド
11310 DATA 200, 40,562,156'サウンドFILES
11320 DATA 380,150,272, 46'サウンドFILENAMES
11330 DATA 557,150,410, 46'サウンドDATA
11340 DATA 401,150,382, 46'サウンドBAR
11350 DATA 383, 47,400, 65'S_▲
11360 DATA 383,131,400,149'S_▼
11370 DATA 564, 20,638, 40'LOAD
11380 DATA 564, 42,638, 62'SAVE
11390 DATA 564, 64,638, 84'EXIT
11400 DATA 564, 86,638,106'OPTI
11410 DATA 564,108,638,156'PLAYOFF
11420 DATA 0,158, 79,400'ENV
11430 DATA 77,237, 1,178'ENV
11440 DATA 0,401,639,478'KB
11450 DATA -1, -1, -1, -1
11460 '
11470 *SYMBOL
11480 RESTORE *SYMBOL
11490 READ X,Y,A$
11500 WHILE X<>-1
11510 SYMBOL(X,Y),A$,1,1,0
11520 READ X,Y,A$
11530 WEND
11540 RETURN
11550 DATA 30, 3,PMBED Ver1.02
11560 DATA 500, 3,(c) TETSU 1992-
11570 DATA 5, 22,instDATA
11580 DATA 5, 50,読み込み
11590 DATA 5, 70,保存
11600 DATA 5, 90,初期化
11610 DATA 174, 49,▲
11620 DATA 174,133,▼
11630 DATA 205, 22,sndDATA
11640 DATA 415, 22,メモリー
11650 DATA 205, 50,削除
11660 DATA 205, 70,PLAY
11670 DATA 384, 49,▲
11680 DATA 384,133,▼
11690 DATA 415, 50,Name
11700 DATA 415, 70,Rate
11710 DATA 415, 90,補正
11720 DATA 415,110,音階
11730 DATA 415,130,Size
11740 DATA 570, 23,LOAD
11750 DATA 570, 45,SAVE
11760 DATA 570, 67,EXIT
11770 DATA 570, 89,OPTI
11780 DATA 570,115,PLAY
11790 DATA 577,135,OFF
11800 DATA 459, 90,< >
11810 DATA 459,110,< >
11820 DATA -1, -1,END
11830 '
11840 *MPLOOP1
11850 PUSH=0
11860 WHILE PUSH=0
11870 IF MOUSE(2,0)=-1 THEN PUSH=1
11880 IF MOUSE(2,1)=-1 THEN PUSH=2
11890 WEND
11900 MX=MOUSE(0):MY=MOUSE(1)
11910 RETURN
11920 '
11930 *MPLOOP2
11940 WHILE MOUSE(2,0)=-1 OR MOUSE(2,1)=-1: WEND
11950 RETURN
11960 '
11970 *INP_INIT
11980 IF IPC=1 GOSUB *INP_END
11990 IA2$=IA$: IPC=1: IC=0: IP=0: IP2=IP: IXS=8*IM-1
12000 DIM IA%(FNVRAM(IXS+8,15))
12010 GET@A(IX,IY)-(IX+IXS+8,IY+15),IA%
12020 GOSUB *INP_PR_2
12030 WHILE INKEY$<>"": WEND
12040 RETURN
12050 '
12060 *INP
12070 IC=0
12080 IF MOUSE(2,0)=-1 GOSUB *INP_MOUSE
12090 I$=INKEY$
12100 IF I$="" RETURN
12110 J$=INKEY$
12120 WHILE J$<>"": I$=J$: J$=INKEY$: WEND
12130 IC=ASC(I$)
12140 IF IC=&H1D THEN IP2=IP-1: GOSUB *INP_PR: RETURN '←
12150 IF IC=&H1C THEN IP2=IP+1: GOSUB *INP_PR: RETURN '→
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
12170 IF IC=&H7F THEN IA2$=LEFT$(IA$,IP)+MID$(IA$,IP+2): IP2=IP: GOSUB *INP_PR: RETURN 'DEL
12180 IF IC=&H05 THEN IA2$=LEFT$(IA$,IP): GOSUB *INP_PR: IP2=IP: RETURN 's^DEL
12190 IF IC=&H1B THEN GOSUB *INP_ESC: RETURN 'ESC
12200 IF IC<=&H1F OR IMM<=LEN(IA$) RETURN
12210 IA2$=LEFT$(IA$,IP)+I$+MID$(IA$,IP+1): IP2=IP+LEN(I$)
12220 GOSUB *INP_PR
12230 RETURN
12240 '
12250 *INP_MOUSE
12260 MX=MOUSE(0)-IX: MY=MOUSE(1)-IY
12270 IF MX<0 OR IXS<MX OR MY<0 OR 15<MY RETURN
12280 MOUSE 4,IX,IY,IX+IXS,IY+15
12290 IP2=(IP\IM)*IM+MX\8
12300 IF MX<=0 AND 0<IP2 THEN IP2=(IP\IM-1)*IM: MOUSE 1,IX+IXS-1,,1
12310 IF IXS<=MX AND IP2<IMM-1 AND IP2<LEN(IA2$) THEN IP2=(IP\IM+1)*IM: MOUSE 1,IX+1,,1
12320 GOSUB *INP_PR
12330 RETURN
12340 '
12350 *INP_PR
12360 IF IP2<0 THEN IP2=0
12370 IF LEN(IA2$)<IP2 THEN IP2=LEN(IA2$)
12380 IF IMM<=IP2 THEN IP2=IMM-1
12390 IF IP2=IP AND IA2$=IA$ THEN RETURN
12400 IP=IP2: IA$=IA2$
12410 *INP_PR_2
12420 I=(IP\IM)*IM: J=IP MOD IM
12430 PUT@A(IX,IY)-(IX+IXS+8,IY+15),IA%
12440 SYMBOL(IX,IY),MID$(IA$,I+1,IM),1,1,%ICL
12450 LINE(IX+8*J,IY)-STEP(1,15),PSET,2,B
12460 RETURN
12470 '
12480 *INP_END
12490 IF IPC=0 THEN RETURN
12500 IPC=0
12510 PUT@A(IX,IY)-(IX+IXS+8,IY+15),IA%
12520 SYMBOL(IX,IY),MID$(IA$,1,IM),1,1,%ICL
12530 ERASE IA%
12540 RETURN
12550 '
12560 *INP_ESC
12570 DIM IB%(FNVRAM(639,104))
12580 GET@A(0,375)-(639,479),IB%
12590 LINE(-1,375)-(640,480),PSET,0,BF,7
12600 CONSOLE 20,4,1: COLOR 1,,,4: LOCATE 0,20
12610 LINE INPUT I$
12620 IF I$<>"" THEN IA2$=LEFT$(I$,IMM): IP2=0
12630 CONSOLE 0,23,0: CLS 4
12640 PUT@A(0,375)-(639,479),IB%
12650 ERASE IB%
12660 GOSUB *INP_PR
12670 RETURN
12680 '
12690 *WIN_ON
12700 VIEW (WX+5,WY+5)-(WX+WXS-10,WY+WYS-10)
12710 WINDOW(WX+5,WY+5)-(WX+WXS-10,WY+WYS-10)
12720 RETURN
12730 '
12740 *WIN_OFF
12750 VIEW (0,0)-(1023,511)
12760 WINDOW(0,0)-(1023,511)
12770 RETURN
12780 '
12790 *WIN_INIT
12800 IF WPC=1 GOSUB *WIN_END
12810 IF FRE(3)<(WXS+32)*WYS/2*2+WON*8 THEN ERRF=1: RETURN
12820 WPC=1: WC=-2: WCL=10: I=1
12830 DIM WA%(FNVRAM(WXS,WYS)),WB%(FNVRAM(WXS,WYS)),WOZ(WON,3)
12840 IF 639<WX+WXS THEN WX=639-WXS
12850 IF 479<WY+WYS THEN WY=479-WYS
12860 GET@A(WX,WY)-(WX+WXS,WY+WYS),WA%
12870 LINE(WX,WY)-(WX+WXS,WY+WYS),PSET,%7,BF
12880 LINE(WX+3,WY+3)-(WX+WXS,WY+WYS),PSET,%8,BF
12890 LINE(WX,WY)-(WX+WXS-3,WY+WYS-3),PSET,0,BF,7
12900 WHILE I<=WON AND (WF AND 2)=0
12910 FOR J=0 TO 3: READ WOZ(I,J): NEXT J
12920 LINE(WX+WOZ(I,0),WY+WOZ(I,1))-(WX+WOZ(I,2),WY+WOZ(I,3)),PSET,0,B
12930 I=I+1
12940 WEND
12950 RETURN
12960 '
12970 *WIN
12980 IF MOUSE(2,0)=0 THEN WC=-2: RETURN
12990 MX=MOUSE(0)-WX: MY=MOUSE(1)-WY
13000 IF MX<0 OR MY<0 OR WXS<MX OR WYS<MY THEN WC=0: RETURN
13010 WC=-3: I=1
13020 WHILE I<=WON
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
13040 I=I+1
13050 WEND
13060 IF 1<=WC OR (WF AND 1) THEN RETURN
13070 WC=-1
13080 X=MX: Y=MY: MX=WX: MY=WY
13090 MOUSE 4,X,Y,639-WXS+X,479-WYS+Y
13100 LINE(MX,MY)-STEP(WXS,WYS),XOR,%WCL,B
13110 WHILE MOUSE(2,0)=-1
13120 WHILE MOUSE(9)=0 AND MOUSE(10)=0 AND MOUSE(2,0)=-1: WEND
13130 LINE(MX,MY)-STEP(WXS,WYS),XOR,%WCL,B
13140 MX=MOUSE(0)-X: MY=MOUSE(1)-Y
13150 LINE(MX,MY)-STEP(WXS,WYS),XOR,%WCL,B
13160 WEND
13170 LINE(MX,MY)-STEP(WXS,WYS),XOR,%WCL,B
13180 GET@A(WX,WY)-(WX+WXS,WY+WYS),WB%
13190 PUT@A(WX,WY)-(WX+WXS,WY+WYS),WA%
13200 GET@A(MX,MY)-(MX+WXS,MY+WYS),WA%
13210 PUT@A(MX,MY)-(MX+WXS,MY+WYS),WB%
13220 WX=MX: WY=MY
13230 RETURN
13240 '
13250 *WIN_END
13260 IF WPC=0 THEN RETURN
13270 WPC=0
13280 PUT@A(WX,WY)-(WX+WXS,WY+WYS),WA%
13290 ERASE WA%,WB%,WOZ
13300 RETURN
13310 '
13320 *KB_INIT
13330 PART 6,6
13340 DIM KZ(11,4)
13350 RESTORE *KB_INIT
13360 FOR I=0 TO 11
13370 FOR J=0 TO 4
13380 READ KZ(I,J)
13390 NEXT J
13400 NEXT I
13410 DATA 0, 0,11,50, 0 '0 C
13420 DATA 11, 0,22,50, 2 '1 D
13430 DATA 22, 0,33,50, 4 '2 E
13440 DATA 33, 0,44,50, 5 '3 F
13450 DATA 44, 0,55,50, 7 '4 G
13460 DATA 55, 0,66,50, 9 '5 A
13470 DATA 66, 0,77,50,11 '6 B
13480 DATA 08, 0,14,30, 1 '7 C+
13490 DATA 19, 0,25,30, 3 '8 D+
13500 DATA 41, 0,47,30, 6 '9 F+
13510 DATA 52, 0,58,30, 8 '10 G+
13520 DATA 63, 0,69,30,10 '11 A+
13530 FOR I=0 TO 6
13540 LINE(KX+KZ(I,0),KY)-(KX+KZ(I,2),KY+KZ(I,3)),PSET,%8,BF,%15
13550 NEXT I
13560 FOR I=7 TO 11
13570 LINE(KX+KZ(I,0),KY)-(KX+KZ(I,2),KY+KZ(I,3)),PSET,%8,BF,%8
13580 NEXT I
13590 CIRCLE(KX+5,KY+45),2,%10,,,,F
13600 DIM A%(FNVRAM(77,50))
13610 GET@A(KX,KY)-(KX+77,KY+50),A%
13620 FOR X=KX+77 TO KX+539 STEP 77
13630 PUT@A(X,KY)-(X+77,KY+50),A%
13640 NEXT X
13650 ERASE A%
13660 RETURN
13670 '
13680 *KB
13690 MOUSE 4,KX,KY,KX+615,KY+50
13700 KN=-1
13710 WHILE MOUSE(2,0)=-1
13720 X=MOUSE(0)-KX: Y=MOUSE(1)-KY
13730 O=X\77: X=X MOD 77
13740 FOR I=0 TO 11
13750 IF KZ(I,0)<=X AND X<=KZ(I,2) AND Y<=KZ(I,3) THEN J=KZ(I,4)
13760 NEXT I
13770 A$=N$(J)+"&": J=12*O+J
13780 WHILE KN<>J
13790 KN=J: SC=0
13800 FOR I=0 TO 7
13810 IF KN<=UL%(I+1) THEN SC=ID(I): I=7
13820 NEXT I
13830 DIM A%(SSIZE(SC)\2)
13840 CALLM MTRNSM,VARPTR(SDM%(0))+SDMP(SC),VARPTR(A%(0)),SSIZE(SC)
13850 VOICE SET A%
13860 VOICE 1,V%,1
13870 PLAY OFF
13880 PLAY ,,,,,,"T30 @1 %C Q8 V15 L1 O"+STR$(O+1)+A$+A$+A$+A$+A$+A$
13890 ERASE A%
13900 WEND
13910 WEND
13920 PLAY OFF
13930 RETURN
13940 '
13950 *LOAD
13960 GOSUB *SMR_PR
13970 SYMBOL(570, 23),"LOAD",1,1,2
13980 WX=LOADWX: WY=LOADWY: WXS=360: WYS=190: WON=8: WF=0: MODE=0
13990 RESTORE *LOAD
14000 GOSUB*WIN_INIT
14010 DATA 28, 78,177, 97'1
14020 DATA 28,103,177,122'2
14030 DATA 183, 78,330, 97'3
14040 DATA 183,103,330,122'4
14050 DATA 150, 45,330, 65'文字入力
14060 DATA 220,140,270,160'実行
14070 DATA 280,140,330,160'取消
14080 DATA 280, 18,330, 38'FILES
14090 SYMBOL(WX+20,WY+20),"LOAD",1,1,0
14100 SYMBOL(WX+287,WY+21),"FILES",1,1,0
14110 SYMBOL(WX+55,WY+47),"ファイル名",1,1,0
14120 SYMBOL(WX+229,WY+142),"実行",1,1,0
14130 SYMBOL(WX+289,WY+142),"取消",1,1,0
14140 GOSUB *LOAD_MODE_PR
14150 *LOAD_2
14160 IX=WX+155: IY=WY+48: IM=21: IMM=84: IA$=LFL$: ICL=0
14170 LINE(IX,IY)-STEP(IM*8,15),PSET,7,BF
14180 GOSUB *INP_INIT
14190 GOSUB *MPLOOP2
14200 *LOAD_LOOP
14210 GOSUB *WIN
14220 LOADWX=WX: LOADWY=WY: IX=WX+155: IY=WY+48
14230 IF WC=1 OR IC=&H16 THEN MODE=1: GOSUB *LOAD_MODE_PR
14240 IF WC=2 OR IC=&H17 THEN MODE=2: GOSUB *LOAD_MODE_PR
14250 IF WC=3 OR IC=&H0B THEN MODE=3: GOSUB *LOAD_MODE_PR
14260 IF WC=4 OR IC=&H12 THEN MODE=4: GOSUB *LOAD_MODE_PR
14270 IF WC=5 THEN MOUSE 4,IX,IY,IX+IM*8,IY+15 ELSE MOUSE 4,0,0,639,479
14280 IF WC=6 OR IC=&H0D THEN GOTO *LOAD_CHK
14290 IF WC=7 OR MOUSE(2,1)=-1 OR IC=&H18 THEN GOSUB *INP_END: GOSUB *WIN_END: GOTO *LOAD_RET
14300 IF WC=8 THEN GOSUB *LOAD_FILES
14310 GOSUB *INP
14320 LFL$=IA$
14330 GOTO *LOAD_LOOP
14340 *LOAD_RET
14350 CLOSE
14360 FOR I=1 TO 4: KEY(I) OFF: NEXT I
14370 SYMBOL(570, 23),"LOAD",1,1,0
14380 GOSUB *MPLOOP2
14390 RETURN
14400 '
14410 *LOAD_FILES
14420 GOSUB *INP_END
14430 GOSUB *FSLCT
14440 LINE(WX+151,WY+46)-(WX+329,WY+64),PSET,7,BF
14450 IF FSLCT$<>"" THEN IA$=FSLCT$
14460 IX=WX+155: IY=WY+48: IM=21: IMM=84: ICL=0
14470 GOSUB *INP_INIT
14480 RETURN
14490 '
14500 *LOAD_CHK
14510 GOSUB *INP_END
14520 LINE(WX+40,WY+142)-STEP(160,15),PSET,7,BF
14530 IF MODE=0 THEN A$="Select a Mode": GOTO *LOAD_ERR_RET
14540 FL$=LFL$
14550 GOSUB *FLCNV
14560 '
14570 ON ERROR GOTO *LOAD_ERR
14580 OPEN "I",1,FL$: CLOSE
14590 ON ERROR GOTO *ERR
14600 '
14610 ERRF=0
14620 GOSUB *FLOAD_INIT
14630 IF ERRF THEN A$="Large File"+STR$(FLTL): GOTO *LOAD_ERR_RET
14640 IF MODE=4 THEN GOSUB *LOAD_CHK_SND ELSE GOSUB *LOAD_CHK_PMB
14650 IF ERRF THEN GOSUB *FLOAD_END: GOTO *LOAD_ERR_RET
14660 ON MODE GOSUB *LOAD_ALL,*LOAD_1V,*LOAD_SPMB,*LOAD_SSND
14670 GOSUB *FLOAD_END
14680 GOTO *LOAD_RET
14690 '
14700 *LOAD_CHK_SND
14710 IF 99<=SNMAX THEN A$="too Many Sounds 99": ERRF=1: RETURN
14720 IF FLTL<=32 THEN A$="Bad File Size": ERRF=1: RETURN
14730 FP=12: MP=VARPTR(TL): L=4: FLOADF=0
14740 GOSUB *FLOAD
14750 IF TL<=0 THEN A$="Bad File": ERRF=1: RETURN
14760 IF SMR<TL+32 THEN A$="Large File"+STR$(TL+32): ERRF=1: RETURN
14770 RETURN
14780 '
14790 *LOAD_CHK_PMB
14800 IF FLTL<4104 THEN A$="Bad File Size": ERRF=1: RETURN
14810 GOSUB *FSCHK
14820 IF MODE=3 AND FSNMAX=0 THEN A$="No Sound Data ": ERRF=1: RETURN
14830 IF MODE=3 AND 60<FSNMAX THEN A$="too Many Sounds"+STR$(FSNMAX): ERRF=1: RETURN
14840 RETURN
14850 '
14860 *LOAD_ALL
14870 SFL$=LFL$
14880 GOSUB *WIN_ON
14890 MOUSE 1,,,0
14900 FSIX=WX+329: FSIY=WY+135
14910 LINE(WX+1,FSIY-1)-(FSIX+1,FSIY+35),PSET,7,BF
14920 LINE(FSIX-(FSTL+4104)/384-1,FSIY-1)-(FSIX+1,FSIY+9),PSET,0,B
14930 LINE(FSIX-4104/384,FSIY)-(FSIX,FSIY+8),PSET,6,BF
14940 FSN=1
14950 WHILE FSN<=FSNMAX
14960 LINE(FSIX-FSP(FSN)/384,FSIY)-STEP(0,8),PSET,%7
14970 FSN=FSN+1
14980 WEND
14990 GOSUB *WIN_OFF
15000 BNK$=FBNK$
15010 FP=8: L=4096: MP=VARPTR(ALLV%(0,0)): MSP=0: FLOADF=1
15020 GOSUB *FLOAD
15030 '
15040 FOR I=1 TO FSNMAX: FSF%(I)=1: NEXT I: SNMAX=0: SN=0: MSP=4104
15050 GOSUB *FSLOAD
15060 '
15070 MOUSE 1,,,1
15080 '
15090 P=VARPTR(ALLV%(0,0))
15100 FOR I=0 TO 31
15110 VNAME$(I)=""
15120 FOR J=0 TO 7
15130 K=PEEK(P+128*I+J)
15140 IF K=0 THEN J=7 ELSE VNAME$(I)=VNAME$(I)+CHR$(K)
15150 NEXT J
15160 NEXT I
15170 '
15180 FOR I=0 TO 31
15190 FOR J=0 TO 7
15200 P1=P+128*I+32+4*J
15210 K=SEARCH(SID,PEEK(P1,4),1) '{K:K=-1 OR 1<=K}
15220 IF K<1 OR SNMAX<K THEN K=0 '{K:0<=K<=SNMAX}
15230 SF%(K)=SF%(K)+1
15240 POKE P1,K,4
15250 NEXT J
15260 NEXT I
15270 FOR I=0 TO 7
15280 ID(I)=0
15290 NEXT I
15300 GOSUB *WIN_END
15310 GOSUB *V_INIT_1
15320 GOSUB *S_PR
15330 GOSUB *SMR_PR
15340 GOSUB *S_DATA_PR
15350 GOSUB *ENV_SNAME_PR
15360 RETURN
15370 '
15380 *LOAD_MODE_PR
15390 FOR J=0 TO 1
15400 SYMBOL(WX+ 30+J,WY+ 80),"全音色 データ .PMB",1,1,%(7-(MODE=1)*3)
15410 SYMBOL(WX+ 30+J,WY+105),"単一音色データ.PMB",1,1,%(7-(MODE=2)*3)
15420 SYMBOL(WX+185+J,WY+ 80),"サウンドデータ.PMB",1,1,%(7-(MODE=3)*3)
15430 SYMBOL(WX+185+J,WY+105),"サウンドデータ.SND",1,1,%(7-(MODE=4)*3)
15440 NEXT J
15450 RETURN
15460 '
15470 *LOAD_1V
15480 GOSUB *WIN_END
15490 RESTORE *LOAD_1V
15500 WX=LOADWX: WY=LOADWY: WXS=305: WYS=145: WON=5: WF=0
15510 GOSUB*WIN_INIT
15520 DIM FVNAME$(32),FALLV%(63,31),FVSIZE(32),FVSF%(31,99)
15530 FVN=0
15540 DATA 258, 38,280, 59'▲
15550 DATA 258, 61,280, 82'▼
15560 DATA 170,105,220,125'LOAD
15570 DATA 230,105,280,125'取消
15580 DATA 135, 38,256, 82'音色表示
15590 SYMBOL(WX+15,WY+15),"単一音色のLOAD",1,1,0
15600 SYMBOL(WX+25,WY+42),LEFT$(FL3$+" ",8)+FL4$,1,1,0
15610 SYMBOL(WX+262,WY+41),"▲",1,1,%8
15620 SYMBOL(WX+262,WY+64),"▼",1,1,%8
15630 SYMBOL(WX+179,WY+108),"LOAD",1,1,0
15640 SYMBOL(WX+239,WY+107),"取消",1,1,0
15650 SYMBOL(WX+25,WY+62),FBNK$,1,1,0
15660 '
15670 FP=8: L=4096: MP=VARPTR(FALLV%(0,0)): MSP=0: FLOADF=0
15680 GOSUB *FLOAD
15690 P=VARPTR(FALLV%(0,0))
15700 FOR I=0 TO 31
15710 FOR J=0 TO 7
15720 K=PEEK(P+128*I+J)
15730 IF K=0 THEN J=7 ELSE FVNAME$(I)=FVNAME$(I)+CHR$(K)
15740 NEXT J
15750 FOR J=0 TO 7
15760 K=SEARCH(SID,PEEK(P+128*I+32+4*J,4),1)
15770 IF 1<=K AND K<=FSNMAX THEN FVSF%(I,K)=1
15780 NEXT J
15790 FOR J=1 TO FSNMAX
15800 IF FVSF%(I,J)=1 THEN FVSIZE(I)=FVSIZE(I)+FSSIZE(J)
15810 NEXT J
15820 NEXT I
15830 GOSUB *LOAD_1V_PR
15840 GOSUB *MPLOOP2
15850 *LOAD_1V_LOOP
15860 GOSUB *WIN
15870 LOADWX=WX: LOADWY=WY: MOUSE 4,0,0,639,479
15880 IF WC=1 THEN MOUSE 4,WX+258,WY+38,WX+280,WY+59: V=-1: GOSUB *LOAD_1V_MOVE
15890 IF WC=2 THEN MOUSE 4,WX+258,WY+61,WX+280,WY+82: V= 1: GOSUB *LOAD_1V_MOVE
15900 IF WC=3 THEN IF FVSIZE(FVN)<=SMR THEN GOSUB *LOAD_1V_EXE: GOTO *LOAD_1V_RET ELSE BEEP: GOSUB *MPLOOP2
15910 IF WC=4 OR MOUSE(2,1)=-1 GOSUB *WIN_END: GOTO *LOAD_1V_RET
15920 IF WC=5 GOSUB *LOAD_1V_DATA
15930 GOTO *LOAD_1V_LOOP
15940 *LOAD_1V_RET
15950 ERASE FVNAME$,FALLV%,FVSIZE,FVSF%
15960 RETURN
15970 '
15980 *LOAD_1V_MOVE
15990 T=-1
16000 WHILE MOUSE(2,0)=-1
16010 I=FVN+V: T=T+1
16020 IF I<0 THEN I=0
16030 IF 31<I THEN I=31
16040 IF FVN<>I AND (T=0 OR 150<T) THEN FVN=I: GOSUB *LOAD_1V_PR
16050 WEND
16060 RETURN
16070 '
16080 *LOAD_1V_PR
16090 IF FVSIZE(FVN)<=SMR THEN CL=0 ELSE CL=2
16100 LINE(WX+135,WY+38)-(WX+256,WY+82),PSET,%8,BF,7
16110 SYMBOL(WX+137,WY+42),STR$(FVN+1),1,1,0
16120 SYMBOL(WX+167,WY+42),FVNAME$(FVN),1,1,0
16130 SYMBOL(WX+159,WY+62),STR$(FVSIZE(FVN)),1,1,CL
16140 RETURN
16150 '
16160 *LOAD_1V_DATA
16170 MX=MOUSE(0): MY=MOUSE(1): MOUSE 1,,,0
16180 X1=MX: Y1=MY: X2=165
16190 IF FSNMAX=0 OR 20<FSNMAX THEN Y2=30 ELSE Y2=20*FSNMAX+10
16200 IF 639<X1+X2 THEN X1=639-X2
16210 IF 479<Y1+Y2 THEN Y1=479-Y2
16220 DIM A%(FNVRAM(X2,Y2))
16230 GET@A(X1,Y1)-(X1+X2,Y1+Y2),A%
16240 LINE(X1+5,Y1+5)-STEP(X2-5,Y2-5),PSET,%8,BF
16250 LINE(X1,Y1)-STEP(X2-5,Y2-5),PSET,0,BF,7
16260 IF FSNMAX=0 THEN SYMBOL(X1+20,Y1+5),"No Sound Data",1,1,0: GOTO *LOAD_1V_DATA_1
16270 IF 20<FSNMAX THEN SYMBOL(X1+20,Y1+5),"Many Sounds"+STR$(FSNMAX),1,1,0: GOTO *LOAD_1V_DATA_1
16280 FOR I=1 TO FSNMAX
16290 SYMBOL(X1 ,Y1+20*I-15),STR$(I),1,1,0
16300 SYMBOL(X1+30,Y1+20*I-15),FSNAME$(I),1,1,0
16310 SYMBOL(X1+95,Y1+20*I-15),STR$(FSSIZE(I)),1,1,0
16320 IF FVSF%(FVN,I)=1 THEN CIRCLE(X1+150,Y1+20*(I-1)+12),2,2,,,,F
16330 NEXT I
16340 *LOAD_1V_DATA_1
16350 GOSUB *MPLOOP2
16360 PUT@A(X1,Y1)-(X1+X2,Y1+Y2),A%
16370 ERASE A%
16380 MOUSE 1,,,1
16390 RETURN
16400 '
16410 *LOAD_1V_EXE
16420 FSIX=WX+279: FSIY=WY+93: MSP=0
16430 GOSUB *WIN_ON
16440 LINE(WX+1,FSIY-1)-(WX+WXS-6,WY+WYS-5),PSET,7,BF
16450 FOR FSN=1 TO FSNMAX
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
16470 NEXT FSN
16480 LINE(FSIX-MSP/384,FSIY-1)-(FSIX+1,FSIY+9),PSET,%8,B'INDI
16490 GOSUB *WIN_OFF
16500 MOUSE 1,,,0
16510 MSP=0
16520 GOSUB *FSLOAD
16530 MOUSE 1,,,1
16540 '
16550 VNAME$=FVNAME$(FVN)
16560 P=VARPTR(FALLV%(0,0))+128*FVN
16570 FOR S=0 TO 7
16580 FOR I=0 TO 7
16590 ENV%(S,I)=PEEK(P+64+8*S+I)
16600 NEXT I
16610 IF &H80 AND ENV%(S,6) THEN ENV%(S,6)=ENV%(S,6)-256
16620 I=PEEK(P+16+2*S,2)-24
16630 IF I<0 THEN I=0
16640 IF 95<I THEN I=95
16650 UL%(S+1)=I
16660 J=SEARCH(SID,PEEK(P+32+4*S,4),SNMIN+1)
16670 IF SNMIN+1<=J AND J<=SNMAX THEN ID(S)=J ELSE ID(S)=0
16680 NEXT S
16690 GOSUB *WIN_END
16700 GOSUB *V_NAME_PR
16710 GOSUB *S_PR
16720 GOSUB *SMR_PR
16730 GOSUB *S_DATA_PR
16740 GOSUB *ENV_ALL_PR
16750 GOSUB *ENV_SET
16760 RETURN
16770 '
16780 *LOAD_ERR
16790 ON ERROR GOTO *ERR
16800 IF ERR=63 THEN A$="File not Found" ELSE A$="File Access Error"
16810 RESUME *LOAD_ERR_RET
16820 '
16830 *LOAD_ERR_RET
16840 LINE(WX+40,WY+142)-STEP(160,15),PSET,7,BF
16850 BEEP: SYMBOL(WX+40,WY+142),A$,1,1,2
16860 GOTO *LOAD_2
16870 '
16880 *SAVE
16890 SYMBOL(570, 45),"SAVE",1,1,2
16900 WX=SAVEWX: WY=SAVEWY: WXS=330: WYS=120: WF=0: WON=4
16910 RESTORE *SAVE
16920 GOSUB*WIN_INIT
16930 DATA 120, 40,300, 60'文字入力
16940 DATA 190, 85,240,105'実行
16950 DATA 250, 85,300,105'取消
16960 DATA 250, 13,300, 33'FILES
16970 SYMBOL(WX+257,WY+16),"FILES",1,1,0
16980 SYMBOL(WX+15,WY+15),"音色ファイルのSAVE",1,1,0
16990 SYMBOL(WX+25,WY+42),"ファイル名",1,1,0
17000 SYMBOL(WX+199,WY+87),"実行",1,1,0
17010 SYMBOL(WX+259,WY+87),"取消",1,1,0
17020 LINE(WX+300,WY+80)-(WX+299-(65536+4104)/384,WY+81),PSET,2,BF
17030 LINE(WX+299,WY+68)-(WX+299-4104/384,WY+78),PSET,6,BF,6
17040 GOSUB *WIN_ON
17050 SC=1: FLTL=4104: FSTL=0: MODE=1
17060 WHILE SC<=SNMAX
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
17080 SC=SC+1
17090 WEND
17100 LINE(WX+300,WY+68)-(WX+299-FLTL/384,WY+78),PSET,0,B
17110 GOSUB *WIN_OFF
17120 DIM IND%(FNVRAM(300,10))
17130 GET@A(WX,WY+68)-(WX+300,WY+78),IND%
17140 IF 65536<FSTL THEN CL=10 ELSE CL=8
17150 SYMBOL(WX+110,WY+87),STR$(FSTL),1,1,%CL
17160 IX=WX+125: IY=WY+43: IM=21: IMM=84: IA$=SFL$: ICL=0
17170 LINE(IX,IY)-STEP(IM*8,15),PSET,7,BF
17180 GOSUB *INP_INIT
17190 GOSUB *MPLOOP2
17200 *SAVE_LOOP
17210 GOSUB *WIN
17220 SAVEWX=WX: SAVEWY=WY: IX=WX+125: IY=WY+43
17230 IF WC=1 THEN MOUSE 4,IX,IY,IX+IM*8,IY+15 ELSE MOUSE 4,0,0,639,479
17240 IF WC=2 OR IC=&H0D THEN GOTO *SAVE_CHK
17250 IF WC=3 OR MOUSE(2,1)=-1 OR IC=&H18 THEN GOSUB *INP_END: GOTO *SAVE_RET
17260 IF WC=4 THEN GOSUB *SAVE_FILES
17270 GOSUB *INP
17280 SFL$=IA$
17290 GOTO *SAVE_LOOP
17300 *SAVE_RET
17310 ERASE IND%
17320 GOSUB *WIN_END
17330 SYMBOL(570, 45),"SAVE",1,1,0
17340 GOSUB *MPLOOP2
17350 RETURN
17360 '
17370 *SAVE_FILES
17380 GOSUB *INP_END
17390 GOSUB *FSLCT
17400 LINE(WX+121,WY+41)-(WX+299,WY+59),PSET,7,BF
17410 IF FSLCT$<>"" THEN IA$=FSLCT$
17420 IX=WX+125: IY=WY+43: IM=21: IMM=84: ICL=0
17430 GOSUB *INP_INIT
17440 RETURN
17450 '
17460 *SAVE_CHK
17470 GOSUB *INP_END
17480 LINE(WX+40,WY+87)-STEP(149,15),PSET,7,BF
17490 PUT@A(WX,WY+68)-(WX+300,WY+78),IND%
17500 FL$=SFL$
17510 GOSUB *FLCNV
17520 '
17530 ON ERROR GOTO *SAVE_ERR
17540 OPEN "O",1,FL$: CLOSE
17550 ON ERROR GOTO *ERR
17560 '
17570 *SAVE_EXE
17580 LINE(WX+40,WY+87)-STEP(149,15),PSET,7,BF
17590 DIM FLBF%(FLTL\2)
17600 P=VARPTR(FLBF%(0))
17610 FOR I=0 TO 7
17620 I$=MID$(BNK$,I+1,1)
17630 IF I$="" POKE P+I,0 ELSE POKE P+I,ASC(I$)
17640 NEXT I
17650 CALLM MTRNSM,VARPTR(ALLV%(0,0)),P+8,4096
17660 SC=1: P=VARPTR(FLBF%(0))+4104
17670 WHILE SC<=SNMAX
17680 IF SF%(SC) THEN CALLM MTRNSM,VARPTR(SDM%(0))+SDMP(SC),P,SSIZE(SC): P=P+SSIZE(SC)
17690 SC=SC+1
17700 WEND
17710 '
17720 MOUSE 1,,,0
17730 GOSUB *WIN_ON
17740 ERRC=0
17750 ON ERROR GOTO *ERRKP
17760 '
17770 OPEN "R",1,FL1$+"(128)"+FL2$+FL3$+FL4$
17780 FIELD 1,128 AS FB1$
17790 P1=PEEK(VARPTR(FB1$),4): P2=VARPTR(FLBF%(0)): FLN=(FLTL-1)\128: I=0
17800 WHILE I<=FLN-1 AND ERRC=0
17810 CALLM MTRNSM,P2+128*I,P1,128
17820 PUT 1,I+1
17830 LINE(WX+299-I/3,WY+69)-STEP(0,8),PSET,1
17840 I=I+1
17850 WEND
17860 CLOSE
17870 '
17880 OPEN "R",2,FL1$+"(1)" +FL2$+FL3$+FL4$
17890 FIELD 2, 1 AS FB2$
17900 P=VARPTR(FLBF%(0)): I=128*FLN
17910 WHILE I<=FLTL-1 AND ERRC=0
17920 LSET FB2$=CHR$(PEEK(P+I))
17930 PUT 2,I+1
17940 I=I+1
17950 WEND
17960 CLOSE
17970 ON ERROR GOTO *ERR
17980 ERASE FLBF%
17990 GOSUB *WIN_OFF
18000 MOUSE 1,,,1
18010 IF ERRC=67 THEN KILL FL$: A$="Scanty Free Area": BEEP: GOTO *SAVE_ERR_RET
18020 GOTO *SAVE_RET
18030 '
18040 *SAVE_ERR
18050 IF ERR=64 THEN RESUME *SAVE_ERR_3
18060 *SAVE_ERR_2
18070 BEEP: ON ERROR GOTO *ERR
18080 A$="File Access Error"
18090 RESUME *SAVE_ERR_RET
18100 '
18110 *SAVE_ERR_3
18120 BEEP: ON ERROR GOTO *ERR
18130 SYMBOL(WX+40,WY+87),"Over Write ?",1,1,2
18140 GOSUB *MPLOOP2
18150 *SAVE_ERR_3_LOOP
18160 GOSUB *WIN
18170 SAVEWX=WX: SAVEWY=WY: MOUSE 4,0,0,639,479
18180 IF WC=1 THEN A$="": GOTO *SAVE_ERR_RET
18190 IF WC=2 OR INKEY$=CHR$(&H0D) THEN ON ERROR GOTO *SAVE_ERR_2: KILL FL$: ON ERROR GOTO *ERR: GOTO *SAVE_EXE
18200 IF WC=3 OR MOUSE(2,1)=-1 GOTO *SAVE_RET
18210 IF WC=4 THEN A$="": GOTO *SAVE_ERR_RET
18220 GOTO *SAVE_ERR_3_LOOP
18230 '
18240 *SAVE_ERR_RET
18250 LINE(WX+40,WY+87)-STEP(149,15),PSET,7,BF
18260 SYMBOL(WX+40,WY+87),A$,1,1,2
18270 IX=WX+125: IY=WY+43: IM=21: IMM=84: IA$=SFL$: ICL=0
18280 LINE(IX,IY)-STEP(IM*8,15),PSET,7,BF
18290 GOSUB *INP_INIT
18300 GOTO *SAVE_LOOP
18310 '
18320 *EXIT
18330 SYMBOL(570,67),"EXIT",1,1,2
18340 WX=EXITWX: WY=EXITWY: WXS=190: WYS=95: WF=0: WON=2
18350 RESTORE *EXIT
18360 GOSUB *WIN_INIT
18370 DATA 78, 68,128, 88'実行
18380 DATA 133, 68,183, 88'取消
18390 SYMBOL(WX+50,WY+30),"終了します",1,1,0
18400 SYMBOL(WX+87,WY+70),"実行",1,1,0
18410 SYMBOL(WX+142,WY+70),"取消",1,1,0
18420 GOSUB *MPLOOP2
18430 *EXIT_LOOP
18440 GOSUB *WIN
18450 EXITWX=WX: EXITWY=WY: MOUSE 4,0,0,639,479
18460 IF WC=1 THEN GOSUB *WIN_END: PLAY OFF: COLOR 7,0,7,4: END
18470 IF WC=2 OR MOUSE(2,1)=-1 THEN GOTO *EXIT_RET
18480 GOTO *EXIT_LOOP
18490 *EXIT_RET
18500 GOSUB *WIN_END
18510 SYMBOL(570,67),"EXIT",1,1,0
18520 GOSUB *MPLOOP2
18530 RETURN
18540 '
18550 *INTE
18560 PRINT FRE(1),FRE(3),FRE(4)
18570 RETURN
18580 '
18590 *OPTI
18600 SYMBOL(570,89),"OPTI",1,1,2
18610 WX=OPTIWX: WY=OPTIWY: WXS=320: WYS=85: WF=0: WON=1
18620 RESTORE *OPTI
18630 GOSUB *WIN_INIT
18640 DATA 135, 57,185, 77'確認
18650 SYMBOL(WX+20,WY+20),"OPTIには機能が設定されていません",1,1,0
18660 SYMBOL(WX+144,WY+59),"確認",1,1,0
18670 GOSUB *MPLOOP2
18680 WHILE WC<>1 AND MOUSE(2,1)=0
18690 GOSUB *WIN
18700 OPTIWX=WX: OPTIWY=WY: MOUSE 4,0,0,639,479
18710 WEND
18720 GOSUB *WIN_END
18730 SYMBOL(570,89),"OPTI",1,1,0
18740 GOSUB *MPLOOP2
18750 RETURN
18760 '
18770 *PLAYOFF
18780 SYMBOL(570,115),"PLAY",1,1,2
18790 SYMBOL(577,135),"OFF",1,1,2
18800 MOUSE 4,564,108,638,156
18810 DIM A%(SSIZE(0)\2)
18820 CALLM MTRNSM,VARPTR(SDM%(0)),VARPTR(A%(0)),SSIZE(0)
18830 VOICE SET A%: PLAY OFF
18840 ERASE A%
18850 GOSUB *MPLOOP2
18860 SYMBOL(570,115),"PLAY",1,1,0
18870 SYMBOL(577,135),"OFF",1,1,0
18880 RETURN
18890 '
18900 *BNK
18910 IX=100: IY=22: IM=8: IMM=8: IA$=BNK$: ICL=15
18920 LINE(100,22)-(163,37),PSET,%7,BF
18930 GOSUB *INP_INIT
18940 *BNK_LOOP
18950 IF MOUSE(2,0)=0 THEN MOUSE 4,0,0,639,479: GOTO *BNK_LOOP_2
18960 MX=MOUSE(0):MY=MOUSE(1)
18970 IF 100<=MX AND 22<=MY AND MX<=163 AND MY<=37 THEN MOUSE 4,100,22,163,37 ELSE GOTO *BNK_RET
18980 *BNK_LOOP_2
18990 GOSUB *INP
19000 IF IC<>&H0D AND MOUSE(2,1)=0 GOTO *BNK_LOOP
19010 *BNK_RET
19020 BNK$=IA$
19030 GOSUB*INP_END
19040 RETURN
19050 '
19060 *V_SCRN
19070 VC=-1
19080 IF 173<=MX AND 66<=MY AND MX<=190 AND MY<=130 GOSUB *V_BTN
19090 IF 173<=MX AND 47<=MY AND MX<=190 AND MY<=65 GOSUB *V_UP
19100 IF 173<=MX AND 131<=MY AND MX<=190 AND MY<=149 GOSUB *V_DOWN
19110 IF 75<=MX AND 46<=MY AND MX<=170 AND MY<=150 GOSUB *V_SLCT
19120 MOUSE 4,0,0,639,479
19130 RETURN
19140 '
19150 *V_READ
19160 SYMBOL(5,50),"読み込み",1,1,2
19170 GOSUB *MPLOOP2
19180 *V_READ_LOOP
19190 GOSUB *MPLOOP1
19200 IF PUSH=2 OR MX<75 OR MY<46 OR 190<MX OR 150<MY GOTO *V_READ_RET
19210 GOSUB *V_SCRN
19220 IF VC=-1 GOTO *V_READ_LOOP
19230 VN=VC: VNAME$=VNAME$(VN)
19240 GOSUB *V_PR
19250 GOSUB *V_NAME_PR
19260 P=VARPTR(ALLV%(0,0))+128*VN
19270 FOR S=0 TO 7
19280 FOR I=0 TO 7
19290 ENV%(S,I)=PEEK(P+64+8*S+I)
19300 NEXT I
19310 IF &H80 AND ENV%(S,6) THEN ENV%(S,6)=ENV%(S,6)-256
19320 I=PEEK(P+16+2*S,2)-24
19330 IF I<0 THEN I=0
19340 IF 95<I THEN I=95
19350 UL%(S+1)=I
19360 ID(S)=PEEK(P+32+4*S,4)
19370 NEXT S
19380 GOSUB *ENV_ALL_PR
19390 GOSUB *ENV_SET
19400 *V_READ_RET
19410 SYMBOL(5,50),"読み込み",1,1,0
19420 RETURN
19430 '
19440 *V_SAVE
19450 SYMBOL(5,70),"保存",1,1,2
19460 GOSUB *MPLOOP2
19470 *V_SAVE_LOOP
19480 GOSUB *MPLOOP1
19490 IF PUSH=2 OR MX<75 OR MY<46 OR 190<MX OR 150<MY GOTO *V_SAVE_RET
19500 GOSUB *V_SCRN
19510 IF VC=-1 GOTO *V_SAVE_LOOP
19520 VN=VC: VNAME$(VN)=VNAME$
19530 GOSUB *V_PR
19540 P=VARPTR(ALLV%(0,0))+128*VN
19550 FOR I=0 TO 7
19560 J=PEEK(P+32+4*I,4)
19570 SF%(J)=SF%(J)-1
19580 SF%(ID(I))=SF%(ID(I))+1
19590 NEXT I
19600 GOSUB *S_PR
19610 FOR I=0 TO 7
19620 I$=MID$(VNAME$,I+1,1)
19630 IF I$="" THEN POKE P+I,0 ELSE POKE P+I,ASC(I$)
19640 NEXT I
19650 FOR S=0 TO 7
19660 POKE P+16+2*S,UL%(S+1)+24,2' UL
19670 POKE P+32+4*S,ID(S),4' ID
19680 FOR I=0 TO 7
19690 POKE P+64+8*S+I,ENV%(S,I)
19700 NEXT I
19710 NEXT S
19720 *V_SAVE_RET
19730 SYMBOL(5,70),"保存",1,1,0
19740 RETURN
19750 '
19760 *V_NAME
19770 IX=5: IY=130: IM=8: IMM=8: IA$=VNAME$: ICL=15
19780 LINE(5,130)-(68,145),PSET,%7,BF
19790 GOSUB *INP_INIT
19800 *V_NAME_LOOP
19810 IF MOUSE(2,0)=0 THEN MOUSE 4,0,0,639,479: GOTO *V_NAME_LOOP_2
19820 MX=MOUSE(0):MY=MOUSE(1)
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
19840 *V_NAME_LOOP_2
19850 GOSUB *INP
19860 IF IC<>&H0D AND MOUSE(2,1)=0 GOTO *V_NAME_LOOP
19870 *V_NAME_RET
19880 VNAME$=IA$
19890 GOSUB*INP_END
19900 GOSUB *V_NAME_PR
19910 RETURN
19920 '
19930 *V_NAME_PR
19940 LINE(5,130)-(68,145),PSET,%7,BF
19950 SYMBOL(5,130),VNAME$,1,1,7
19960 RETURN
19970 '
19980 *V_CLR
19990 SYMBOL(5,90),"初期化",1,1,2
20000 GOSUB *MPLOOP2
20010 *V_CLR_LOOP
20020 GOSUB *MPLOOP1
20030 IF PUSH=2 OR MX<75 OR MY<46 OR 190<MX OR 150<MY GOTO *V_CLR_RET
20040 GOSUB *V_SCRN
20050 IF VC=-1 GOTO *V_CLR_LOOP
20060 P=VARPTR(ALLV%(0,0))+128*VC
20070 FOR I=0 TO 7
20080 J=PEEK(P+32+4*I,4)
20090 SF%(J)=SF%(J)-1
20100 NEXT I
20110 FOR I=0 TO 127
20120 POKE P+I,0
20130 NEXT I
20140 VNAME$(VC)=""
20150 FOR I=0 TO 7
20160 POKE P+16+2*I,119,2
20170 NEXT I
20180 GOSUB *V_PR
20190 GOSUB *S_PR
20200 *V_CLR_RET
20210 SYMBOL(5,90),"初期化",1,1,0
20220 RETURN
20230 '
20240 *V_INIT
20250 DIM ALLV%(63,31),VNAME$(31),V%(63)
20260 P=VARPTR(ALLV%(0,0))
20270 FOR I=0 TO 31
20280 FOR J=0 TO 7: POKE P+128*I+16+2*J,119,2: NEXT J
20290 NEXT I
20300 BNK$=""
20310 *V_INIT_1
20320 LINE(100,22)-(163,37),PSET,%7,BF
20330 SYMBOL(100,22),BNK$,1,1,7
20340 VNS=0: VN=-1: VC=-1
20350 GOSUB *V_PR
20360 RETURN
20370 '
20380 *V_PR
20390 GOSUB *V_BTN_PR
20400 FOR I=0 TO 4
20410 IF VNS+I=VN THEN CL=2 ELSE CL=7
20420 LINE(76,50+I*20)-(169,65+I*20),PSET,%7,BF
20430 SYMBOL(70,50+I*20),STR$(VNS+I+1),1,1,CL
20440 SYMBOL(100,50+I*20),VNAME$(VNS+I),1,1,CL
20450 NEXT I
20460 RETURN
20470 '
20480 *V_BTN_PR
20490 X1=173: Y1=VNS*47/27+66: X2=190: Y2=Y1+17
20500 LINE(173,66)-(190,130),PSET,%7,BF
20510 GOSUB *BOX_PR
20520 RETURN
20530 '
20540 *V_BTN
20550 MOUSE 4,173,75,190,122: MOUSE 1,,,0
20560 WHILE MOUSE(2,0)=-1
20570 I=(MOUSE(1)-9-66)*27/47
20580 IF I<>VNS THEN VNS=I: GOSUB *V_PR
20590 WEND
20600 MOUSE 1,MOUSE(0),MOUSE(1),1
20610 RETURN
20620 '
20630 *V_UP
20640 MOUSE 4,173,47,190,65: MOUSE 1,,,0
20650 DIM A%(FNVRAM(93,75))
20660 WHILE MOUSE(2,0)=-1
20670 IF VNS<=0 GOTO *V_UP_1
20680 VNS=VNS-1
20690 GET@A(76,50)-(169,125),A%
20700 PUT@A(76,70)-(169,145),A%
20710 IF VNS=VN THEN CL=2 ELSE CL=7
20720 LINE(76,50)-(169,65),PSET,%7,BF
20730 SYMBOL(70,50),STR$(VNS+1),1,1,CL
20740 SYMBOL(100,50),VNAME$(VNS),1,1,CL
20750 GOSUB *V_BTN_PR
20760 *V_UP_1
20770 WEND
20780 MOUSE 1,MOUSE(0),MOUSE(1),1
20790 ERASE A%
20800 RETURN
20810 '
20820 *V_DOWN
20830 MOUSE 4,173,131,190,149: MOUSE 1,,,0
20840 DIM A%(FNVRAM(93,75))
20850 WHILE MOUSE(2,0)=-1
20860 IF 27<=VNS GOTO *V_DOWN_1
20870 VNS=VNS+1
20880 GET@A(76,70)-(169,145),A%
20890 PUT@A(76,50)-(169,125),A%
20900 IF VNS+4=VN THEN CL=2 ELSE CL=7
20910 LINE(76,130)-(169,145),PSET,%7,BF
20920 SYMBOL(70,130),STR$(VNS+5),1,1,CL
20930 SYMBOL(100,130),VNAME$(VNS+4),1,1,CL
20940 GOSUB *V_BTN_PR
20950 *V_DOWN_1
20960 WEND
20970 MOUSE 1,MOUSE(0),MOUSE(1),1
20980 ERASE A%
20990 RETURN
21000 '
21010 *V_SLCT
21020 IF MOUSE(2,0)=0 RETURN
21030 MOUSE 4,77,48,168,147
21040 MY=MOUSE(1)
21050 Y1=INT((MY-48)/20): Y2=Y1
21060 GOSUB *V_SLCT_PR
21070 *V_SLCT_LOOP
21080 MY=MOUSE(1)
21090 Y1=INT((MY-48)/20)
21100 IF Y1<>Y2 THEN GOSUB *V_SLCT_PR: Y2=Y1: GOSUB *V_SLCT_PR
21110 IF MOUSE(2,1)=-1 THEN GOSUB *V_SLCT_PR: GOSUB *MPLOOP2: RETURN
21120 IF MOUSE(2,0)=-1 GOTO *V_SLCT_LOOP
21130 GOSUB *V_SLCT_PR
21140 VC=Y2+VNS
21150 RETURN
21160 '
21170 *V_SLCT_PR
21180 LINE(77,Y2*20+48)-(168,Y2*20+67),XOR,%9,BF,%1
21190 RETURN
21200 '
21210 *ENV_INIT
21220 DATA TL,0,AR,0,DR,0,SL,0,SR,0,RR,0,RK,4C,?!,0,UL,8B
21230 DATA 8,14,19,25,33,41,47,52,58,63,69,77
21240 DIM ENV%(7,7),ID(7),UL%(9),KX%(95),A%(FNVRAM(79,242))
21250 UL%(0)=0
21260 FOR I=1 TO 9: UL%(I)=95: NEXT I
21270 RESTORE *ENV_INIT
21280 FOR Y=80 TO 224 STEP 18
21290 READ A$,B$
21300 SYMBOL(1,160+Y),A$,1,1,0
21310 SYMBOL(20,160+Y),"<",1,1,0
21320 SYMBOL(62,160+Y),">",1,1,0
21330 SYMBOL(36,160+Y),B$,1,1,7
21340 NEXT Y
21350 S=0
21360 GOSUB *ENV_PR
21370 GET@A(0,158)-(79,400),A%
21380 FOR S=0 TO 7
21390 PUT@A(S*80,158)-(79+S*80,400),A%
21400 SYMBOL(-6+S*80,160),STR$(S+1),1,1,2
21410 LINE(78+S*80,401)-STEP(0,1),PSET,0
21420 NEXT S
21430 ERASE A%
21440 FOR N=0 TO 11
21450 READ I
21460 FOR O=0 TO 7
21470 KX%(O*12+N)=O*77+I
21480 NEXT O
21490 NEXT N
21500 GOSUB *UL_PR
21510 RETURN
21520 '
21530 *ENV_PR
21540 WINDOW(0,127)-(400,0)
21550 VIEW(2+S*80,179)-(76+S*80,236)
21560 TL=ENV%(S,0): AR=ENV%(S,1): DR=ENV%(S,2)
21570 SL=ENV%(S,3): SR=127-ENV%(S,4): RR=127-ENV%(S,5)
21580 X1=0: Y1=0: X2=0: Y2=0: X3=0: Y3=0
21590 X4=300: Y4=0: X5=400: Y5=0: X6=500: Y6=0
21600 IF AR=127 OR TL=0 GOTO *ENV_PR_3
21610 X2=AR*150/127: Y2=TL
21620 IF SL=127 OR DR=127 THEN X3=X2: Y3=Y2: SR=0: GOTO *ENV_PR_1
21630 X3=X2+DR*150/127: Y3=SL*TL/127
21640 *ENV_PR_1
21650 IF SR=127 THEN X4=X3: Y4=0: GOTO *ENV_PR_2
21660 IF SR=0 THEN X4=300: Y4=Y3: GOTO *ENV_PR_2
21670 X4=300: Y4=Y3-(X4-X3)*TAN(PI!*SR)
21680 IF Y4<=0 THEN X4=X3+(X4-X3)*Y3/(Y3-Y4): Y4=0: GOTO *ENV_PR_3
21690 *ENV_PR_2
21700 IF RR=127 THEN X5=X4: Y5=0: GOTO *ENV_PR_3
21710 IF RR=0 THEN X5=400: Y5=Y4: GOTO *ENV_PR_3
21720 X5=400: Y5=Y4-(X5-X4)*TAN(PI!*RR)
21730 IF Y5<=0 THEN X5=X4+(X5-X4)*Y4/(Y4-Y5): Y5=0
21740 *ENV_PR_3
21750 LINE(0,0)-(400,127),PSET,%7,BF
21760 LINE(X2,0)-(X2,127),PSET,%1,,&H6666
21770 LINE(X3,0)-(X3,127),PSET,%1,,&H6666
21780 LINE(300,0)-(300,127),PSET,%1,,&H6666
21790 CONNECT(X1,Y1)-(X2,Y2)-(X3,Y3)-(X4,Y4)-(X5,Y5)-(X6,Y6),1
21800 GOSUB *WIN_OFF
21810 RETURN
21820 '
21830 *ENV_OP
21840 S=INT(MX/80): MX=MX MOD 80: P=-1: V=0: T=-1
21850 IF 2<=MX AND 160<=MY AND MX<=76 AND MY<=175 GOTO *ENV_SNAME
21860 FOR I=0 TO 8
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
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
21890 NEXT I
21900 IF P=6 GOTO *RK_OP
21910 IF P=8 GOTO *UL_OP
21920 IF P=-1 OR V=0 RETURN
21930 MOUSE 1,,,0
21940 *ENV_OP_LOOP
21950 PUSH=0: T=T+1
21960 IF MOUSE(2,0)=-1 THEN PUSH=1
21970 IF MOUSE(2,1)=-1 THEN PUSH=10: IF P=7 THEN PUSH=8
21980 IF PUSH=0 THEN MOUSE 4,0,0,639,479: MOUSE 1,,,1: GOSUB *ENV_SET: RETURN
21990 IF T<>0 AND T<=100 GOTO *ENV_OP_LOOP
22000 I=ENV%(S,P)+V*PUSH
22010 IF I<0 THEN I=0
22020 IF P<>7 AND 127<I THEN I=127
22030 IF P=7 AND 255<I THEN I=255
22040 IF I=ENV%(S,P) GOTO *ENV_OP_LOOP ELSE ENV%(S,P)=I
22050 GOSUB *ENV_PR
22060 LINE(36+S*80,240+P*18)-STEP(23,15),PSET,%7,BF
22070 SYMBOL(28+S*80,240+P*18),STR$(I),1,1,7
22080 GOTO *ENV_OP_LOOP
22090 '
22100 *RK_OP
22110 MOUSE 1,,,0
22120 T=0
22130 WHILE MOUSE(2,0)=-1 OR MOUSE (2,1)=-1
22140 IF 0<T AND T<130 GOTO *RK_OP_2
22150 PUSH=0
22160 IF MOUSE(2,0)=-1 THEN PUSH=1
22170 IF MOUSE(2,1)=-1 THEN PUSH=12
22180 IF MOUSE(2,0)=-1 AND MOUSE(2,1)=-1 THEN PUSH=255
22190 I=ENV%(S,6)-V*PUSH
22200 IF SN%(ID(S))-I<0 THEN I=SN%(ID(S))
22210 IF 95<SN%(ID(S))-I THEN I=SN%(ID(S))-95
22220 ENV%(S,6)=I: O=(SN%(ID(S))-I)\12: N=(SN%(ID(S))-I+65532) MOD 12
22230 LINE(36+S*80,348)-(59+S*80,363),PSET,%7,BF
22240 SYMBOL(28+S*80,348),STR$(O+1)+N$(N),1,1,7
22250 *RK_OP_2
22260 T=T+1
22270 WEND
22280 MOUSE 4,0,0,639,479: MOUSE 1,,,1
22290 GOSUB *ENV_SET
22300 RETURN
22310 '
22320 *UL_OP
22330 MOUSE 1,,,0
22340 K=S: T=0
22350 WHILE MOUSE(2,0)=-1 OR MOUSE (2,1)=-1
22360 IF T<>0 AND T<130 GOTO *UL_OP_2
22370 PUSH=0
22380 IF MOUSE(2,0)=-1 THEN PUSH=1
22390 IF MOUSE(2,1)=-1 THEN PUSH=12
22400 IF MOUSE(2,0)=-1 AND MOUSE(2,1)=-1 THEN PUSH=255
22410 I=UL%(K+1)+V*PUSH
22420 IF I<=UL%(K) THEN I=UL%(K)
22430 IF UL%(K+2)<=I THEN I=UL%(K+2)
22440 IF UL%(K+1)=I GOTO *UL_OP_2
22450 UL%(K+1)=I: O=INT(I/12): N=I MOD 12
22460 LINE(36+K*80,384)-(59+K*80,399),PSET,%7,BF
22470 SYMBOL(28+K*80,384),STR$(O+1)+N$(N),1,1,7
22480 GOSUB *UL_PR
22490 *UL_OP_2
22500 T=T+1
22510 WEND
22520 MOUSE 4,0,0,639,479: MOUSE 1,,,1
22530 GOSUB *ENV_SET
22540 RETURN
22550 '
22560 *ENV_SNAME
22570 IF PUSH=2 OR SNMAX=0 RETURN
22580 LINE(2+80*S,159)-(76+80*S,176),XOR,%11,BF,%3
22590 GOSUB *MPLOOP2
22600 *ENV_SNAME_LOOP
22610 GOSUB *MPLOOP1
22620 IF PUSH=2 OR MX<272 OR MY<46 OR 400<MX OR 150<MY GOTO *ENV_SNAME_RET
22630 GOSUB *S_SCRN
22640 IF SC=-1 GOTO *ENV_SNAME_LOOP
22650 ID(S)=SC: I=SN%(ID(S))-ENV%(S,6): CL=7
22660 IF I<0 THEN CL=2: I=0
22670 IF 95<I THEN CL=2: I=95
22680 O=INT(I/12): N=(I+65532) MOD 12
22690 LINE(36+S*80,348)-(59+S*80,363),PSET,%7,BF
22700 SYMBOL(28+S*80,348),STR$(O+1)+N$(N),1,1,CL
22710 GOSUB *ENV_SET
22720 *ENV_SNAME_RET
22730 LINE(2+80*S,159)-(77+80*S,176),PSET,%7,BF
22740 SYMBOL(-6+80*S,160),STR$(S+1),1,1,2
22750 SYMBOL(12+80*S,160),SNAME$(ID(S)),1,1,7
22760 RETURN
22770 '
22780 *ENV_SET
22790 P=VARPTR(V%(0))
22800 FOR I=0 TO 7
22810 POKE P+16+2*I,UL%(I+1)+24,2
22820 POKE P+32+4*I,ID(I),4
22830 FOR J=0 TO 7
22840 POKE P+64+8*I+J,ENV%(I,J)
22850 NEXT J
22860 NEXT I
22870 RETURN
22880 '
22890 *ENV_ALL_PR
22900 GOSUB *ENV_SNAME_PR
22910 FOR S=0 TO 7
22920 GOSUB *ENV_PR
22930 LINE(36+S*80,240)-(59+S*80,399),PSET,%7,BF
22940 FOR I=0 TO 5
22950 SYMBOL(28+S*80,240+I*18),STR$(ENV%(S,I)),1,1,7
22960 NEXT I
22970 I=SN%(ID(S))-ENV%(S,6): CL=7
22980 IF I<0 THEN CL=2: I=0
22990 IF 95<I THEN CL=2: I=95
23000 O=INT(I/12): N=(I+65532) MOD 12
23010 SYMBOL(28+S*80,348),STR$(O+1)+N$(N),1,1,CL
23020 SYMBOL(28+S*80,366),STR$(ENV%(S,7)),1,1,7
23030 O=UL%(S+1)\12: N=UL%(S+1) MOD 12
23040 SYMBOL(28+S*80,384),STR$(O+1)+N$(N),1,1,7
23050 NEXT S
23060 GOSUB *UL_PR
23070 RETURN
23080 '
23090 *ENV_SNAME_PR
23100 FOR S=0 TO 7
23110 LINE(12+S*80,160)-(12+S*80+64,175),PSET,%7,BF
23120 SYMBOL(12+S*80,160),SNAME$(ID(S)),1,1,7
23130 NEXT S
23140 RETURN
23150 '
23160 *UL_PR
23170 LINE(1,480)-(638,503),PSET,%7,BF
23180 FOR I=0 TO 7
23190 CONNECT(78+I*80,480)-(KX+KX%(UL%(I+1)),497)-STEP(0,6),%8
23200 NEXT I
23210 DIM A%(FNVRAM(637,23))
23220 GET@A(1,480)-(638,503),A%
23230 PUT@A(1,403)-(638,426),A%
23240 ERASE A%
23250 RETURN
23260 '
23270 *S_INIT
23280 SN=0: SC=-1: SNMAX=0: SNS=1: SNSMAX=1
23290 DIM SNAME$(100),SSIZE(100),SF%(100),SN%(100),SPA%(0)
23300 DIM SDM%(SMRTL\2),SDMP(100)
23310 SNAME$(0)="": SDMP(0)=0: SSIZE(0)=33
23320 SDMP(1)=SDMP(0)+SSIZE(0): SN%(0)=36
23330 GOSUB *S_PR
23340 GOSUB *SMR_PR
23350 RESTORE *S_INIT
23360 P=VARPTR(SDM%(0))
23370 FOR I=0 TO 31
23380 READ I$: POKE P+I,VAL("&h"+I$)
23390 NEXT I
23400 GOSUB *S_DATA_PR
23410 RETURN
23420 DATA 49,73,61,61,63,00,00,00,00,00,00,00,01,00,00,00
23430 DATA 00,00,00,00,00,00,00,00,00,00,00,00,3C,00,00,00
23440 '
23450 *S_SLCT
23460 IF MOUSE(2,0)=0 OR SNMAX=0 RETURN
23470 Y=SNMAX-SNSMAX'0<=Y<=4
23480 IF 4<=Y THEN Y=4
23490 MOUSE 4,274,48,378,67+20*Y
23500 MY=MOUSE(1): Y2=INT((MY-48)/20)
23510 GOSUB *S_SLCT_PR
23520 *S_SLCT_LOOP
23530 MY=MOUSE(1): Y1=INT((MY-48)/20)
23540 IF Y1<>Y2 THEN GOSUB *S_SLCT_PR: Y2=Y1: GOSUB *S_SLCT_PR
23550 IF MOUSE(2,1)=-1 THEN GOSUB *S_SLCT_PR: GOSUB *MPLOOP2: RETURN
23560 IF MOUSE(2,0)=-1 GOTO *S_SLCT_LOOP
23570 GOSUB *S_SLCT_PR
23580 SC=Y2+SNS
23590 RETURN
23600 '
23610 *S_SLCT_PR
23620 LINE(274,Y2*20+48)-(378,Y2*20+67),XOR,%11,BF,%3
23630 RETURN
23640 '
23650 *S_SCRN
23660 SC=-1
23670 IF 272<=MX AND 46<=MY AND MX<=380 AND MY<=150 GOSUB *S_SLCT
23680 IF 383<=MX AND 66<=MY AND MX<=400 AND MY<=130 GOSUB *S_BTN
23690 IF 383<=MX AND 47<=MY AND MX<=400 AND MY<= 65 GOSUB *S_UP
23700 IF 383<=MX AND 131<=MY AND MX<=400 AND MY<=149 GOSUB *S_DOWN
23710 MOUSE 4,0,0,639,479
23720 RETURN
23730 '
23740 *S_BTN
23750 IF SNSMAX=1 RETURN
23760 MOUSE 4,383,66+9,400,130-8: MOUSE 1,,,0
23770 WHILE MOUSE(2,0)=-1
23780 I=(MOUSE(1)-9-66)*(SNSMAX-1)/47+1
23790 IF I<>SNS THEN SNS=I: GOSUB *S_PR
23800 WEND
23810 MOUSE 1,MOUSE(0),MOUSE(1),1
23820 RETURN
23830 '
23840 *S_BTN_PR
23850 IF SNSMAX=1 THEN Y1=66 ELSE Y1=66+((SNS-1)/(SNSMAX-1)*47)
23860 X1=383: X2=400: Y2=Y1+17
23870 LINE(383,66)-(400,130),PSET,%7,BF
23880 GOSUB *BOX_PR
23890 RETURN
23900 '
23910 *S_PR
23920 GOSUB *S_BTN_PR
23930 IF SNMAX=0 THEN J=-1
23940 IF SNMAX<=SNS+4 THEN J=SNMAX-SNS ELSE J=4
23950 FOR I=0 TO 4
23960 IF SNS+I=SN THEN CL=2 ELSE CL=7
23970 LINE(273,50+I*20)-(379,65+I*20),PSET,%7,BF
23980 IF J<I GOTO *S_PR_1
23990 SYMBOL(267,50+I*20),STR$(SNS+I),1,1,CL
24000 SYMBOL(297,50+I*20),SNAME$(SNS+I),1,1,CL
24010 IF SF%(SNS+I) THEN CIRCLE(370,50+I*20+7),2,2,,,,F
24020 *S_PR_1
24030 NEXT I
24040 RETURN
24050 '
24060 *S_UP
24070 IF SNSMAX=1 RETURN
24080 MOUSE 4,383,47,400,65: MOUSE 1,,,0
24090 DIM A%(FNVRAM(106,75))
24100 WHILE MOUSE(2,0)=-1
24110 IF SNS<=1 GOTO *S_UP_1
24120 SNS=SNS-1
24130 GET@A(273,50)-(379,125),A%
24140 PUT@A(273,70)-(379,145),A%
24150 LINE(273,50)-(379,65),PSET,%7,BF
24160 IF SNS=SN THEN CL=2 ELSE CL=7
24170 SYMBOL(267,50),STR$(SNS),1,1,CL
24180 SYMBOL(297,50),SNAME$(SNS),1,1,CL
24190 IF SF%(SNS) THEN CIRCLE(370,50+7),2,2,,,,F
24200 GOSUB *S_BTN_PR
24210 *S_UP_1
24220 WEND
24230 MOUSE 1,MOUSE(0),MOUSE(1),1
24240 ERASE A%
24250 RETURN
24260 '
24270 *S_DOWN
24280 IF SNSMAX=1 RETURN
24290 MOUSE 4,383,131,400,149: MOUSE 1,,,0
24300 DIM A%(FNVRAM(106,75))
24310 WHILE MOUSE(2,0)=-1
24320 IF SNSMAX<=SNS GOTO *S_DOWN_1
24330 SNS=SNS+1
24340 GET@A(273,70)-(379,145),A%
24350 PUT@A(273,50)-(379,125),A%
24360 LINE(273,130)-(379,145),PSET,%7,BF
24370 IF SNS+4=SN THEN CL=2 ELSE CL=7
24380 SYMBOL(267,130),STR$(SNS+4),1,1,CL
24390 SYMBOL(297,130),SNAME$(SNS+4),1,1,CL
24400 IF SF%(SNS+4) THEN CIRCLE(370,130+7),2,2,,,,F
24410 GOSUB *S_BTN_PR
24420 *S_DOWN_1
24430 WEND
24440 MOUSE 1,MOUSE(0),MOUSE(1),1
24450 ERASE A%
24460 RETURN
24470 '
24480 *LOAD_SSND
24490 SNMAX=SNMAX+1: SN=SNMAX
24500 IF 5<=SNMAX THEN SNSMAX=SNMAX-4: SNS=SNSMAX ELSE SNSMAX=1: SNS=1
24510 SSIZE(SN)=32+TL
24520 SDMP(SN+1)=SDMP(SN)+SSIZE(SN)
24530 MOUSE 1,,,0
24540 GOSUB *WIN_ON
24550 FSIX=WX+329: FSIY=WY+135
24560 LINE(WX+1,FSIY-1)-(FSIX+1,FSIY+35),PSET,7,BF
24570 LINE(FSIX-(32+TL)/384-1,FSIY-1)-(FSIX+1,FSIY+9),PSET,0,B
24580 LINE(FSIX-(32+TL)/384-1,FSIY-1)-(FSIX+1,FSIY+9),PSET,0,B
24590 DIM A%(4)
24600 FP=0: MP=VARPTR(A%(0)): L=8: FLOADF=0
24610 GOSUB *FLOAD
24620 P=VARPTR(A%(0)): SNAME$(SN)=""
24630 FOR I=0 TO 7
24640 J=PEEK(P+I): IF J=0 THEN I=7 ELSE SNAME$(SN)=SNAME$(SN)+CHR$(J)
24650 NEXT I
24660 ERASE A%
24670 SYMBOL(FSIX-112,FSIY+17),SNAME$(SN),1,1,0
24680 SYMBOL(FSIX-50,FSIY+17),STR$(SSIZE(SN)),1,1,0
24690 FP=0: L=32+TL: MP=VARPTR(SDM%(0))+SDMP(SN): MSP=0: FLOADF=1
24700 GOSUB *FLOAD
24710 GOSUB *WIN_OFF
24720 MOUSE 1,,,1
24730 P=VARPTR(SDM%(0))+SDMP(SN)
24740 POKE P+8,SN,4: SN%(SN)=PEEK(P+28)-24: SF%(SN)=0
24750 GOSUB *WIN_END
24760 GOSUB *SMR_PR
24770 GOSUB *S_PR
24780 GOSUB *S_DATA_PR
24790 RETURN
24800 '
24810 *LOAD_SPMB
24820 GOSUB *WIN_END
24830 XMAX=2: FSTL=0
24840 IF 20<FSNMAX THEN XMAX=3
24850 IF 40<FSNMAX THEN XMAX=4
24860 YMAX=(FSNMAX-1)\XMAX+1
24870 WON=3+FSNMAX: WF=2: WXS=140*XMAX+50: WYS=20*YMAX+155
24880 GOSUB *WIN_INIT
24890 IF ERRF THEN GOSUB *FLOAD_END: ERROR 90
24900 FOR I=0 TO 99: FSF%(I)=0: NEXT I
24910 '
24920 SYMBOL(WX+15,WY+15),"サウンドデータのLOAD",1,1,0
24930 SYMBOL(WX+28,WY+45),LEFT$(FL3$+" ",8)+FL4$,1,1,0
24940 SYMBOL(WX+28,WY+65),FBNK$,1,1,0
24950 GOSUB *LOAD_SPMB_FSTL
24960 SYMBOL(WX+170,WY+65),"ALL",1,1,0
24970 SYMBOL(WX+210,WY+65),"LOAD",1,1,0
24980 SYMBOL(WX+263,WY+65),"取消",1,1,0
24990 LINE(WX+24,WY+131)-(WX+26+140*XMAX,WY+133+20*YMAX),PSET,%8,B'DATAS
25000 RESTORE *LOAD_SPMB
25010 FOR I=1 TO 3
25020 FOR J=0 TO 3: READ WOZ(I,J): NEXT J
25030 LINE(WX+WOZ(I,0),WY+WOZ(I,1))-(WX+WOZ(I,2),WY+WOZ(I,3)),PSET,%8,B
25040 NEXT I
25050 DATA 167, 63,197, 82'ALL
25060 DATA 202, 63,250, 82'LOAD
25070 DATA 255, 63,303, 82'取消
25080 '
25090 FOR I=0 TO FSNMAX-1: FSN=I+1
25100 WOZ(I+4,0)=140*(I\YMAX)+26: WOZ(I+4,1)=20*(I MOD YMAX)+133
25110 WOZ(I+4,2)=WOZ(I+4,0)+139: WOZ(I+4,3)=WOZ(I+4,1)+19
25120 LINE(WX+WOZ(I+4,0),WY+WOZ(I+4,1))-STEP(138,18),PSET,%7,B,&H5555
25130 GOSUB *LOAD_SPMB_PR
25140 NEXT I
25150 GOSUB *MPLOOP2
25160 *LOAD_SPMB_LOOP
25170 GOSUB *WIN
25180 LOADWX=WX: LOADWY=WY
25190 MOUSE 4,0,0,639,479
25200 IF WC=1 GOSUB *LOAD_SPMB_ALL
25210 IF WC=2 IF FSTL<=SMR THEN GOSUB *LOAD_SPMB_EXE: GOTO *LOAD_SPMB_RET ELSE BEEP: GOSUB *MPLOOP2
25220 IF WC=3 OR MOUSE(2,1)=-1 GOSUB *WIN_END: GOTO *LOAD_SPMB_RET
25230 IF 4<=WC AND WC<=FSNMAX+3 THEN FSN=WC-3: GOSUB *LOAD_SPMB_SET
25240 GOTO *LOAD_SPMB_LOOP
25250 *LOAD_SPMB_RET
25260 RETURN
25270 '
25280 *LOAD_SPMB_PR
25290 IF FSF%(FSN)=1 THEN CL=2 ELSE CL=0
25300 X=WX+140*((FSN-1)\YMAX)+26: Y=WY+20*((FSN-1) MOD YMAX)+135
25310 SYMBOL(X-6,Y),STR$(FSN),1,1,CL
25320 SYMBOL(X+24,Y),FSNAME$(FSN),1,1,CL
25330 SYMBOL(X+86,Y),STR$(FSSIZE(FSN)),1,1,CL
25340 RETURN
25350 '
25360 *LOAD_SPMB_ALL
25370 J=0
25380 FOR I=1 TO FSNMAX
25390 IF FSF%(I)=1 THEN J=1: I=FSNMAX
25400 NEXT I
25410 FOR FSN=1 TO FSNMAX
25420 IF J=0 AND FSF%(FSN)=0 THEN FSF%(FSN)=1: FSTL=FSTL+FSSIZE(FSN): GOSUB *LOAD_SPMB_PR: GOSUB *LOAD_SPMB_FSTL
25430 IF J=1 AND FSF%(FSN)=1 THEN FSF%(FSN)=0: FSTL=FSTL-FSSIZE(FSN): GOSUB *LOAD_SPMB_PR: GOSUB *LOAD_SPMB_FSTL
25440 NEXT FSN
25450 GOSUB *MPLOOP2
25460 RETURN
25470 '
25480 *LOAD_SPMB_SET
25490 IF FSF%(FSN)=0 THEN FSF%(FSN)=1: FSTL=FSTL+FSSIZE(FSN) ELSE FSF%(FSN)=0: FSTL=FSTL-FSSIZE(FSN)
25500 GOSUB *LOAD_SPMB_PR
25510 GOSUB *LOAD_SPMB_FSTL
25520 GOSUB *MPLOOP2
25530 RETURN
25540 '
25550 *LOAD_SPMB_FSTL
25560 IF SMR<FSTL OR SMR=0 THEN CL=2 ELSE CL=0
25570 LINE(WX+160,WY+45)-STEP(150,15),PSET,7,BF
25580 SYMBOL(WX+231,WY+45),"|",1,1,0
25590 SYMBOL(WX+162,WY+45),STR$(SMR-FSTL),1,1,CL
25600 SYMBOL(WX+239,WY+45),STR$(FSTL),1,1,0
25610 RETURN
25620 '
25630 *LOAD_SPMB_EXE
25640 MOUSE 1,,,0
25650 GOSUB*WIN_ON
25660 FSIX=WX+302: FSIY=WY+90: FSSX=WX+190: FSSY=WY+107: MSP=0
25670 FOR FSN=1 TO FSNMAX
25680 IF FSF%(FSN)=1 THEN MSP=MSP+FSSIZE(FSN): LINE(FSIX-MSP/384,FSIY)-STEP(0,8),PSET,%7
25690 NEXT FSN
25700 LINE(FSIX-MSP/384,FSIY-1)-(FSIX+1,FSIY+9),PSET,%8,B
25710 GOSUB *WIN_OFF
25720 MSP=0
25730 GOSUB *FSLOAD
25740 MOUSE 1,,,1
25750 GOSUB *WIN_END
25760 GOSUB *S_PR
25770 GOSUB *SMR_PR
25780 GOSUB *S_DATA_PR
25790 RETURN
25800 '
25810 *SMR_PR
25820 SMR=SMRTL-SDMP(SNMAX+1)
25830 LINE(475,22)-STEP(8*7,15),PSET,%7,BF
25840 SYMBOL(475-8,22),STR$(SMR),1,1,0
25850 RETURN
25860 '
25870 *S_DATA
25880 IF SNMAX=0 GOTO *S_DATA_RET
25890 *S_DATA_LOOP
25900 IF MOUSE(2,0)=0 GOTO *S_DATA_RET
25910 MX=MOUSE(0): MY=MOUSE(1)
25920 IF MX<272 OR MY<46 OR 400<MX OR 150<MY GOTO *S_DATA_RET
25930 GOSUB *S_SCRN
25940 IF SC=-1 GOTO *S_DATA_LOOP
25950 SN=SC
25960 GOSUB *S_PR
25970 GOSUB *S_DATA_PR
25980 *S_DATA_RET
25990 RETURN
26000 '
26010 *S_DATA_PR
26020 P=VARPTR(SDM%(0))+SDMP(SN)
26030 SNAME$=SNAME$(SN)
26040 RATE=PEEK(P+24,2)*1000/98
26050 I=PEEK(P+26,2)
26060 IF I>=32768 THEN HOSEI%=I-65536 ELSE HOSEI%=I
26070 GENO=INT(SN%(SN)/12): GENN=(SN%(SN)+65532) MOD 12
26080 IF SN%(SN)<0 OR 95<SN%(SN) THEN CL=2 ELSE CL=7
26090 SSIZE=SSIZE(SN)
26100 LINE(475,50)-STEP(63,95),PSET,%7,BF
26110 SYMBOL(475,50),SNAME$,1,1,7
26120 SYMBOL(475,70),STR$(RATE),1,1,7
26130 SYMBOL(475,90),STR$(HOSEI%),1,1,7
26140 SYMBOL(475,110)," O"+RIGHT$(STR$(GENO+1),1)+" "+N$(GENN),1,1,CL
26150 SYMBOL(475,130),STR$(SSIZE),1,1,7
26160 RETURN
26170 '
26180 *S_DATA_OP
26190 IF 459<=MX AND 90<=MY AND MX<=474 AND MY<=105 THEN MOUSE 4,459, 90,474,105: V=-1: GOSUB *HOSEI
26200 IF 539<=MX AND 90<=MY AND MX<=554 AND MY<=105 THEN MOUSE 4,539, 90,554,105: V= 1: GOSUB *HOSEI
26210 IF 459<=MX AND 110<=MY AND MX<=474 AND MY<=125 THEN MOUSE 4,459,110,474,125: V=-1: GOSUB *GEN
26220 IF 539<=MX AND 110<=MY AND MX<=554 AND MY<=125 THEN MOUSE 4,539,110,554,125: V= 1: GOSUB *GEN
26230 IF 475<=MX AND 50<=MY AND MX<=538 AND MY<= 65 GOSUB *SNAME
26240 MOUSE 4,0,0,639,479
26250 P=VARPTR(SDM%(0))+SDMP(SN)
26260 SNAME$(SN)=SNAME$
26270 FOR I=0 TO 7
26280 J$=MID$(SNAME$,I+1,1)
26290 IF J$="" THEN POKE P+I,0 ELSE POKE P+I,ASC(J$)
26300 NEXT I
26310 POKE P+26,HOSEI%,2
26320 POKE P+28,SN%(SN)+24
26330 RETURN
26340 '
26350 *HOSEI
26360 T=-1
26370 WHILE MOUSE(2,0)=-1 OR MOUSE(2,1)=-1
26380 PUSH=0: T=T+1
26390 IF MOUSE(2,0)=-1 THEN PUSH=1
26400 IF MOUSE(2,1)=-1 THEN PUSH=10
26410 IF MOUSE(2,0)=-1 AND MOUSE(2,1)=-1 THEN PUSH=100
26420 IF T=0 OR 100<T THEN I=HOSEI%+V*PUSH ELSE GOTO *HOSEI_2
26430 IF I<-32768 THEN I=-32768
26440 IF 32767<I THEN I=32767
26450 IF I=HOSEI% GOTO *HOSEI_2
26460 HOSEI%=I
26470 LINE(475,90)-STEP(63,15),PSET,%7,BF
26480 SYMBOL(475,90),STR$(HOSEI%),1,1,7
26490 *HOSEI_2
26500 WEND
26510 RETURN
26520 '
26530 *GEN
26540 MOUSE 1,,,0
26550 T=-1
26560 WHILE MOUSE(2,0)=-1 OR MOUSE(2,1)=-1
26570 PUSH=0: T=T+1
26580 IF MOUSE(2,0)=-1 THEN PUSH=1
26590 IF MOUSE(2,1)=-1 THEN PUSH=12
26600 IF T=0 OR 100<T THEN J=SN%(SN)+V*PUSH ELSE GOTO *GEN_3
26610 IF J<0 THEN J=0
26620 IF 95<J THEN J=95
26630 IF J=SN%(SN) GOTO *GEN_3
26640 SN%(SN)=J: O=INT(SN%(SN)/12): N=SN%(SN) MOD 12
26650 LINE(475,110)-STEP(63,15),PSET,%7,BF
26660 SYMBOL(475,110)," O"+RIGHT$(STR$(O+1),1)+" "+N$(N),1,1,7
26670 FOR S=0 TO 7
26680 IF ID(S)<>SN GOTO *GEN_2
26690 I=SN%(SN)-ENV%(S,6): CL=7
26700 IF I<0 THEN CL=2: I=0
26710 IF 95<I THEN CL=2: I=95
26720 O=INT(I/12): N=(I+65532) MOD 12
26730 LINE(36+S*80,348)-(59+S*80,363),PSET,%7,BF
26740 SYMBOL(28+S*80,348),STR$(O+1)+N$(N),1,1,CL
26750 *GEN_2
26760 NEXT S
26770 *GEN_3
26780 WEND
26790 MOUSE 1,MOUSE(0),MOUSE(1),1
26800 RETURN
26810 '
26820 *SNAME
26830 IX=475: IY=50: IM=8: IMM=8: IA$=SNAME$: ICL=15
26840 LINE(475,50)-STEP(63,15),PSET,%7,BF
26850 GOSUB *INP_INIT
26860 *SNAME_LOOP
26870 IF MOUSE(2,0)=0 THEN MOUSE 4,0,0,639,479: GOTO *SNAME_LOOP_2
26880 MX=MOUSE(0): MY=MOUSE(1)
26890 IF 475<=MX AND 50<=MY AND MX<=538 AND MY<=65 THEN MOUSE 4,475,50,538,65 ELSE GOTO *SNAME_RET
26900 *SNAME_LOOP_2
26910 GOSUB *INP
26920 IF IC<>&H0D AND MOUSE(2,1)=0 GOTO *SNAME_LOOP
26930 *SNAME_RET
26940 SNAME$=IA$: SNAME$(SN)=SNAME$
26950 GOSUB *INP_END
26960 GOSUB *S_PR
26970 GOSUB *ENV_SNAME_PR
26980 RETURN
26990 '
27000 *S_PLAY
27010 SYMBOL(205,70),"PLAY",1,1,2
27020 ERASE SPA%
27030 DIM SPA%(SSIZE(SN)\2)
27040 CALLM MTRNSM,VARPTR(SDM%(0))+SDMP(SN),VARPTR(SPA%(0)),SSIZE(SN)
27050 PCMPLAY SPA%
27060 GOSUB *MPLOOP2
27070 SYMBOL(205,70),"PLAY",1,1,0
27080 RETURN
27090 '
27100 *S_KILL
27110 IF SNMAX=0 RETURN
27120 SYMBOL(205,50),"削除",1,1,2
27130 GOSUB *MPLOOP2
27140 *S_KILL_LOOP
27150 GOSUB *MPLOOP1
27160 IF PUSH=2 OR MX<272 OR MY<46 OR 400<MX OR 150<MY GOTO *S_KILL_RET
27170 GOSUB *S_SCRN
27180 IF SC=-1 GOTO *S_KILL_LOOP
27190 FOR I=0 TO SNMAX: SID(I)=I: NEXT I
27200 I=SC: SID(SC)=0
27210 '
27220 WHILE I<=SNMAX-1
27230 SNAME$(I)=SNAME$(I+1): SN%(I)=SN%(I+1): SID(I+1)=I
27240 P=VARPTR(SDM%(0))
27250 CALLM MTRNSM,P+SDMP(I+1),P+SDMP(I),SSIZE(I+1)
27260 POKE P+SDMP(I)+8,I,4
27270 SSIZE(I)=SSIZE(I+1): SDMP(I+1)=SDMP(I)+SSIZE(I): SF%(I)=SF%(I+1)
27280 I=I+1
27290 WEND
27300 '
27310 P=VARPTR(ALLV%(0,0))
27320 FOR I=0 TO 3968 STEP 128
27330 FOR J=0 TO 28 STEP 4
27340 POKE P+I+32+J,SID(PEEK(P+I+32+J,4)),4
27350 NEXT J
27360 NEXT I
27370 FOR S=0 TO 7
27380 ID(S)=SID(ID(S))
27390 NEXT S
27400 GOSUB *ENV_SET
27410 GOSUB *ENV_SNAME_PR
27420 '
27430 SNMAX=SNMAX-1
27440 IF SNMAX<=5 THEN SNSMAX=1 ELSE SNSMAX=SNMAX-4
27450 IF SNSMAX<=SNS THEN SNS=SNSMAX
27460 IF SN=SC THEN SN=0
27470 IF SC<SN THEN SN=SN-1
27480 SF%(SNMAX+1)=0: SNAME$(SNMAX+1)=""
27490 GOSUB *S_PR
27500 GOSUB *SMR_PR
27510 GOSUB *S_DATA_PR
27520 *S_KILL_RET
27530 SYMBOL(205,50),"削除",1,1,0
27540 RETURN
27550 '
27560 *ERR
27570 BEEP: CLOSE: MOUSE 0: MOUSE 1,,,1
27580 GOSUB *WIN_OFF
27590 GOSUB *INP_END
27600 GOSUB *WIN_END
27610 WX=ERRWX: WY=ERRWY: WXS=190: WYS=95: WON=2: WF=0
27620 RESTORE *ERR
27630 GOSUB *WIN_INIT
27640 DATA 78, 68,128, 88'中断
27650 DATA 133, 68,183, 88'無視
27660 IF ERR=90 THEN SYMBOL(WX+10,WY+15),"ウィンドーが開けません",1,1,0 ELSE SYMBOL(WX+18,WY+15),"エラーが発生しました",1,1,0
27670 SYMBOL(WX+30,WY+40),"ERROR"+STR$(ERR)+"/"+STR$(ERL)+"行",1,1,0
27680 SYMBOL(WX+87,WY+70),"中断",1,1,0
27690 SYMBOL(WX+142,WY+70),"無視",1,1,0
27700 GOSUB *MPLOOP2
27710 *ERR_LOOP
27720 GOSUB *WIN
27730 ERRWX=WX: ERRWY=WY: MOUSE 4,0,0,639,479
27740 IF WC=1 THEN PLAY OFF: END
27750 IF WC=2 OR MOUSE(2,1)=-1 THEN GOSUB *WIN_END: GOSUB *MPLOOP2: RESUME *MAIN
27760 GOTO *ERR_LOOP
27770 '
27780 *ERRKP
27790 ERRC=ERR
27800 RESUME NEXT
27810 '
27820 *FSCHK
27830 DIM A%(16)
27840 FP=0: MP=VARPTR(A%(0)): L=8: FLOADF=0
27850 GOSUB *FLOAD
27860 P=VARPTR(A%(0)): FBNK$=""
27870 FOR I=0 TO 7
27880 J=PEEK(P+I): IF J THEN FBNK$=FBNK$+CHR$(J)
27890 NEXT I
27900 FSNMAX=0: FSP=4104: FSTL=0
27910 *FSCHK_LOOP
27920 IF FLTL<FSP+32 GOTO *FSCHK_RET
27930 FP=FSP: MP=VARPTR(A%(0)): L=32
27940 GOSUB *FLOAD
27950 P=VARPTR(A%(0))
27960 TL=PEEK(P+12,4)
27970 IF FLTL<FSP+32+TL OR TL<0 GOTO *FSCHK_RET
27980 FSNMAX=FSNMAX+1: FSN=FSNMAX
27990 SID(FSN)=PEEK(P+8,4): FSSIZE(FSN)=32+TL: FSTL=FSTL+32+TL
28000 FSNAME$(FSN)=""
28010 FOR I=0 TO 7
28020 J=PEEK(P+I): IF J THEN FSNAME$(FSN)=FSNAME$(FSN)+CHR$(J)
28030 NEXT I
28040 FSP(FSN)=FSP: FSP=FSP+32+TL
28050 GOTO *FSCHK_LOOP
28060 *FSCHK_RET
28070 ERASE A%
28080 RETURN
28090 '
28100 *FLOAD_INIT
28110 OPEN "R",1,FL1$+"(128)"+FL2$+FL3$+FL4$: FIELD 1,128 AS FB1$
28120 OPEN "R",2,FL1$+"(1)" +FL2$+FL3$+FL4$: FIELD 2, 1 AS FB2$
28130 FLTL=LOF(2): FLN=(FLTL-1)\128
28140 IF FLTL<=0 OR SMRTL<FLTL THEN CLOSE: ERRF=1: RETURN
28150 DIM FLBF%(FLTL\2+1),FLBFF%(FLN)
28160 RETURN
28170 '
28180 *FLOAD_END
28190 ERASE FLBF%,FLBFF%
28200 CLOSE
28210 RETURN
28220 '
28230 *FLOAD 'FP L > MP ,FLOADF
28240 IF L<=0 OR FLTL-1<FP THEN RETURN
28250 N1=FP\128: N2=(FP+L-1)\128
28260 '
28270 I=N1: P=VARPTR(FLBF%(0))
28280 WHILE I<=N2 AND I<=FLN
28290 IF FLBFF%(I) THEN GOTO *FLOAD_1 ELSE FLBFF%(I)=1
28300 IF I=FLN GOSUB *FLOAD_SUB: GOTO *FLOAD_1
28310 GET 1,I+1
28320 CALLM MTRNSM,PEEK(VARPTR(FB1$),4),P+128*I,128
28330 *FLOAD_1
28340 IF FLOADF LINE(FSIX-(MSP+(I-N1)*128)/384,FSIY)-STEP(0,8),PSET,1
28350 I=I+1
28360 WEND
28370 CALLM MTRNSM,VARPTR(FLBF%(0))+FP,MP,L
28380 RETURN
28390 '
28400 *FLOAD_SUB
28410 J=128*FLN
28420 WHILE J<=FLTL-1
28430 GET 2,J+1
28440 POKE P+J,ASC(FB2$)
28450 J=J+1
28460 WEND
28470 RETURN
28480 '
28490 *FSLOAD
28500 SNMIN=SNMAX: FSN=1: FLOADF=1
28510 GOSUB *WIN_ON
28520 WHILE FSN<=FSNMAX
28530 IF FSF%(FSN)=0 OR SNMAX>=99 GOTO *FSLOAD_2
28540 SNMAX=SNMAX+1
28550 LINE(FSIX-142,FSIY+17)-STEP(140,15),PSET,7,BF
28560 SYMBOL(FSIX-142,FSIY+17),STR$(FSN),1,1,0
28570 SYMBOL(FSIX-112,FSIY+17),FSNAME$(FSN),1,1,0
28580 SYMBOL(FSIX-50,FSIY+17),STR$(FSSIZE(FSN)),1,1,0
28590 FP=FSP(FSN): L=FSSIZE(FSN): MP=VARPTR(SDM%(0))+SDMP(SNMAX)
28600 GOSUB *FLOAD
28610 MSP=MSP+FSSIZE(FSN)
28620 P=VARPTR(SDM%(0))+SDMP(SNMAX)
28630 SID(SNMAX)=PEEK(P+8,4): POKE P+8,SNMAX,4
28640 SN%(SNMAX)=PEEK(P+28)-24: SNAME$(SNMAX)=FSNAME$(FSN)
28650 SSIZE(SNMAX)=FSSIZE(FSN): SDMP(SNMAX+1)=SDMP(SNMAX)+SSIZE(SNMAX)
28660 SF%(SNMAX)=0
28670 *FSLOAD_2
28680 FSN=FSN+1
28690 WEND
28700 IF SNMIN<SNMAX: SN=SNMIN+1
28710 IF 5<=SNMAX THEN SNSMAX=SNMAX-4: SNS=SN ELSE SNSMAX=1: SNS=1
28720 IF SNSMAX<SNS THEN SNS=SNSMAX
28730 GOSUB *WIN_OFF
28740 RETURN
28750 '
28760 *FSLCT
28770 WIDTH 80,25: CONSOLE 2,23,0: COLOR 0,0,7,4: CLS 4
28780 DIM FSLCT%(46080)
28790 GET@A(0,0)-(380,479),FSLCT%
28800 LINE(0,0)-(380,479),PSET,,BF
28810 LINE(380,0)-(380,479),PSET,0
28820 *FSLCT_1
28830 CL=5
28840 GOSUB *FSLCT_PR
28850 CL=4
28860 ON ERROR GOTO *FSLCT_ERR
28870 CLS 1: LOCATE 0,2:FILES DSK$+PATH$(DSK)+"*.*"
28880 ON ERROR GOTO *ERR
28890 YMAX=CSRLIN
28900 GOSUB *FSLCT_PR
28910 IF CL=4 THEN LOCATE 10,0:PRINT DSK$+PATH$(DSK)+"*.*";
28920 GOSUB *MPLOOP2
28930 *FSLCT_LOOP
28940 GOSUB *MPLOOP1
28950 Y=INT(MY/19)
28960 IF PUSH=2 THEN FSLCT$="": GOTO *FSLCT_RET
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
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
28990 IF 24<=MX AND 0<=MY AND MX<=40 AND MY<=16 GOTO *FSLCT_1
29000 IF CL=5 GOTO *FSLCT_LOOP
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
29020 IF MX<0 OR 380<MX OR Y<=1 OR YMAX-2<=Y GOTO *FSLCT_LOOP
29030 FL1$="": FL2$="": FL3$=""
29040 I=0
29050 WHILE I<=7 AND SCREEN(I,Y)<>&H20
29060 FL1$=FL1$+CHR$(SCREEN(I,Y)): I=I+1
29070 WEND
29080 I=0
29090 WHILE I<=2 AND SCREEN(9+I,Y)<>0
29100 FL2$=FL2$+CHR$(SCREEN(9+I,Y)): I=I+1
29110 WEND
29120 FOR I=0 TO 8
29130 FL3$=FL3$+CHR$(SCREEN(16+I,Y))
29140 NEXT I
29150 IF INSTR(FL1$,".")<>0 OR INSTR(FL2$,".")<>0 THEN GOSUB *FSLCT_PATH1: GOTO *FSLCT_1
29160 IF INSTR(FL3$,"DIR")<>0 THEN PATH$(DSK)=PATH$(DSK)+FL1$+"\": GOTO *FSLCT_1
29170 FSLCT$=DSK$+PATH$(DSK)+FL1$+"."+FL2$
29180 GOTO *FSLCT_RET
29190 '
29200 *FSLCT_PATH1
29210 I=LEN(PATH$(DSK))-1: PATH$(DSK)=LEFT$(PATH$(DSK),I)
29220 WHILE MID$(PATH$(DSK),I,1)<>"\"
29230 I=I-1: PATH$(DSK)=LEFT$(PATH$(DSK),I)
29240 WEND
29250 RETURN
29260 '
29270 *FSLCT_PATH2
29280 X=INT((MX-96)/8)+1
29290 IF X<=1 THEN PATH$(DSK)="\": RETURN
29300 FOR I=X TO LEN(PATH$(DSK))
29310 IF MID$(PATH$(DSK),I,1)="\" THEN J=I: I=255
29320 NEXT I
29330 PATH$(DSK)=LEFT$(PATH$(DSK),J)
29340 RETURN
29350 '
29360 *FSLCT_RET
29370 CLS 4
29380 PUT@A(0,0)-(380,479),FSLCT%
29390 ERASE FSLCT%
29400 GOSUB *MPLOOP2
29410 RETURN
29420 '
29430 *FSLCT_INIT
29440 DIM PATH$(16)
29450 DSK=0: DSK$=CHR$(&H41+DSK)
29460 FOR I=0 TO 16: PATH$(I)="\": NEXT I
29470 RETURN
29480 '
29490 *FSLCT_PR
29500 DSK=(DSK+17) MOD 17
29510 DSK$=CHR$(&H41+DSK)+":"
29520 CLS 2
29530 LOCATE 0,0: PRINT "< >";
29540 COLOR,,,CL: LOCATE 3,0: PRINT DSK$;: COLOR ,,,4
29550 RETURN
29560 '
29570 *FSLCT_ERR
29580 CL=5: PATH$(DSK)="\"
29590 IF ERR=63 THEN RESUME *FSLCT_1
29600 BEEP
29610 LOCATE 0,2: PRINT "File Access Error";
29620 RESUME NEXT
29630 '
29640 *FLCNV 'FL$>FL1$,FL2$,FL3$,FL4$
29650 J=INSTR(FL$,":"): K=1: L=INSTR(FL$,".")
29660 FOR I=1 TO LEN(FL$)
29670 IF MID$(FL$,I,1)=":" OR MID$(FL$,I,1)="\" THEN K=I+1
29680 NEXT I
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"
29700 FL1$=LEFT$(FL$,J)
29710 FL2$=MID$(FL$,J+1,K-(J+1))
29720 FL$=FL1$+FL2$+FL3$+FL4$
29730 RETURN
29740 '