1000 '************************************************************************* 1010 '* ‚l‚‚‹‚…@‚l‚•‚“‚‰‚ƒ Version 6.01 1999. * 1020 '* Copyright (C) Takashi Utsunomiya 쬊JŽn 1996. * 1030 '************************************************************************* 1040 ' “à—e: ‰¹Šyì¬E•ÒWƒ\ƒtƒg 1050 '************************************************************************* 1060 : 1070 CLEAR (&H1000*6+512)/16 1080 SCREEN 3,0,0,1:WIDTH 80,25:CONSOLE 0,25,0,1:COLOR 7,0,0,7,2:DEFINT A-Z 1090 DEF FNI(A,B)=-((A AND 2^B)=0):MOUSE 0 1100 DEF FNA(A,B)=ASC(INPUT$(A,B)) 1110 DEF FNS$(A) =MID$(STR$(A),2) 1120 COLOR=(1,&HAAA):COLOR=(2,&H777) 1130 MAXX=200*4:TP=120:RT=4 1140 TN$[0]="@0":TN$[1]="@0":TN$[2]="@0":PATH$="\b\music\" '<-- 1150 DIM G0[0],G1[0],G2[0],G3[0],G4[0],G5[0]:GOSUB *DIM.:GOSUB *STOP. 1160 DIM MM$[1000,5],CH[32000] 1170 DIM L$[96],C1[17],C2[769],C3[257],MP[79,24] 1180 DIM F$[10],SEN[25,1],VL[5],OC[5] 1190 FOR A=0 TO 5:VL[A]=13:OC[A]=5:NEXT 1200 FOR A=0 TO 10:READ F$ [A]:NEXT 1210 DATA ŒÄo,•Û‘¶,‰‰‘t,•”•ª,’âŽ~,’²†,”Žq,‘t‡,ù—¥,•¡ŽÊ,Á‹Ž 1220 FOR A=0 TO 6:READ N$ [A]:NEXT:DATA ¿,Ì,Ð,Ú,Ä,¼,× 1230 FOR A=0 TO 2:READ N2$[A]:NEXT:DATA ,#,b 1240 FOR A=0 TO 8:READ N3$[A]:NEXT:DATA " ",1,2,3,4,5,6,7,8 1250 FOR A=0 TO 6:READ N4$[A]:NEXT:DATA g,f,e,d,c,b,a 1260 FOR A=0 TO 2:READ N5$[A]:NEXT:DATA ,+,- 1270 FOR A=0 TO 2:READ C [A]:NEXT:DATA 7,5,3 1280 FOR A=1 TO 96:READ L$ [A]:NEXT 1290 DATA ,48 ,32 ,24 , ,16 1300 DATA ,12 , , , ,8 1310 DATA , , ,6 , ,8. 1320 DATA , , , , ,4 1330 DATA , , , , ,4^16 1340 DATA , , , , ,4. 1350 DATA , , , , ,4.. 1360 DATA , , , , ,2 1370 DATA , , , , ,2^16 1380 DATA , , , , ,2^8 1390 DATA , , , , ,8.^2 1400 DATA , , , , ,2. 1410 DATA , , , , ,2.^16 1420 DATA , , , , ,2.. 1430 DATA , , , , ,2... 1440 DATA , , , , ,1 1450 'READ A$:B$="":FOR I=0 TO 9:B$=B$+CHR$(VAL("&H"+MID$(A$,I*2+1,2))):NEXT 1460 'MOUSE 2,2,2,B$:DATA 7000f800f800f8007000 'ƒ}ƒEƒXƒJ[ƒ\ƒ‹ 1470 *MK.CHR '============== ‹x•„‹y‚ÑŠy•ˆ‚ÌŠGì¬ 1480 CLS 2:READ A$ '‹x•„ 1490 FOR J=0 TO 7:FOR K=0 TO 3 1500 PSET(K,J),-7*((VAL("&H"+MID$(A$,J+1,1)) AND 2^(3-K))>0) 1510 NEXT K,J:GET@(0,0)-STEP(3,7),C1 1520 DATA 42484684 1530 CLS 2:FOR I=0 TO 31 'Šy•ˆ 1540 A$=MID$("2222ffff",-(INSTR("@KLMNOQRSTU",CHR$(I+&H40))>0)*4+1,4) 1550 LINE(0,I*4)-STEP(23,0),7,,VAL("&H"+A$) 1560 NEXT :GET@(0, 0)- (23,127),C2 1570 LINE(0,32)-STEP(15,0),7:GET@(0,32)-STEP(15, 63),C3 1580 *MK.MAP '============== ƒRƒ}ƒ“ƒhƒ{ƒ^ƒ“ˆÊ’u‹L‰¯ 1590 FOR I=0 TO 10:FOR J=0 TO 3:MP[1+I*5+J,1]=I+1:NEXT J,I 1600 FOR I=0 TO 1:FOR J=0 TO 5:MP[2+(J\3)*39,13+(J MOD 3)*4+I*2]=17:NEXT J,I 1610 FOR I=0 TO 5:READ A,X1,Y1,X2,Y2 1620 FOR Y=Y1 TO Y2-1:FOR X=X1 TO X2-1:MP[X,Y]=A 1630 NEXT X,Y,I 1640 DATA 12,56,1,76,2, 13,10,7,13,8 1650 DATA 14,6,11,79,12, 15,19,3,79,11, 16,4,12,40,24, 16,43,12,79,24 1660 *START '============== ’¼‘Oˆ— 1670 GOSUB *SCR 1680 'FOR X=0 TO 78:FOR Y=0 TO 24:LOCATE X,Y:PRINT CHR$(&H60+MP[X,Y]);:NEXT Y,X:WHILE 1:WEND 1690 *MAIN '============== Žå“®•” 1700 LOCATE 15,9:PRINT RIGHT$(" "+HEX$(STATUS PLAY(0)),3); 1710 GOSUB *IN4:V=MX\8:W=MY\16:MENU=MP[V,W]:ON -(MENU=15) GOSUB *KAKU2 1720 ON -(ML=MR) GOTO *MAIN 1730 A=MENU:ON -(A=0) GOTO *MAIN:ON -(015 THEN MENU=0:GOSUB *SCR 1810 GOTO *MAIN 1820 *SCR '============== ‰æ–Ê•`‰æ 1830 MOUSE 1,,,0:SC=1-SC:OUT &HA6,SC:LINE(0,0)-(639,399),1,BF 1840 RESTORE 1860 1850 FOR I1=1 TO 12:READ X1,Y1,X2,Y2:GOSUB *B2:NEXT 1860 DATA 1,3,18,4, 19,3,79,11, 4,12,40,24, 43,12,79,24, 10,7,13,8, 56,1,76,2 1870 DATA 15,5,18,6, 15,7,18,8, 15,9,18,10, 1,5,9,6, 1,7,8,8, 1,9,8,10 1880 FOR I1=0 TO 10 'ƒRƒ}ƒ“ƒh 1890 X1=I1*5+1:Y1=1:X2=X1+4:Y2=2:LOCATE X1,Y1:PRINT F$[I1]:GOSUB *B2 1900 NEXT 1910 FOR I1=0 TO 5:FOR I2=0 TO 1 'o v 1920 X1=2+(I1\3)*39:Y1=13+(I1 MOD 3)*4+I2*2:X2=X1+1:Y2=Y1+1:GOSUB *B2 1930 NEXT I2,I1 1940 FOR Y=0 TO 5:FOR X=0 TO 17:GOSUB *KAKU:NEXT X,Y 1950 FOR X=0 TO 19:GOSUB *KAKU1:NEXT 1960 ON -(MENU>0 AND MENU<12) GOSUB *KAKU3:GOSUB *KAKU4 1970 MOUSE 1,,,1:OUT &HA4,SC 1980 *SCR01 '-------------- 1990 COLOR 6:LOCATE 13, 0:PRINT"‚l";STRING$(4,28);"‚l";STRING$(5,28);"‚U"; 2000 COLOR 4:LOCATE 15, 0:PRINT"ake";STRING$(3,28);"usic"; 2010 LOCATE 35, 0:PRINT"Programed by Takashi Utsunomiya 1996-"; 2020 LOCATE 2, 2:PRINT"Ò¯¾°¼Þ ´ÃÞ¨¯Ä ³¨ÝÄÞ³"; 2030 LOCATE 2, 4:PRINT"·®¸Ò² ¼®³¾Â"; 2040 LOCATE 2, 6:PRINT"# ÃÝÎß µÄ"; 2050 LOCATE 2, 8:PRINT"b"; 2060 LOCATE 1,11:PRINT"‘t‡t"+LEFT$(JUN$+STRING$(36," "),36); 2070 COLOR 7:LOCATE 56,1:PRINT"asssstttta"; 2080 A$=NA$:IF A$="" THEN A$="V‹Kì¬" 2090 LOCATE 1, 5:PRINT USING"@ ###";LEFT$(A$+" ",8);JX\RT+1; 2100 LOCATE 1, 7:PRINT USING"@ ###" ;LEFT$(T1$+" ",7);TP; 2110 LOCATE 1, 9:PRINT ;LEFT$(T2$+" ",7); 2120 FOR I=0 TO 5:X=2+(I\3)*39:Y=12+(I MOD 3)*4 2130 COLOR 4:LOCATE X,Y :PRINT"o";:COLOR 7:LOCATE X,Y+1:PRINT HEX$(OC[I]) 2140 COLOR 4:LOCATE X,Y+2:PRINT"v";:COLOR 7:LOCATE X,Y+3:PRINT HEX$(VL[I]) 2150 NEXT 2160 COLOR 5 2170 FOR I=0 TO 5:FOR J=0 TO 3 2180 LOCATE 17+(I\3)*39,12+(I MOD 3)*4+J 2190 PRINT MID$(" †˜ †™",-(I=EC)*14+1,14); 2200 NEXT J,I:COLOR 7 2210 ON -(MENU=0) GOSUB *KG2 2220 RETURN 2230 *SCR2 '============== ƒtƒ@ƒCƒ‹‘I‘ð‰æ–Ê•`‰æ 2240 LINE(8*19-1,16*3-1)-(639,16*5),1,BF 2250 LINE(-1,16*5-1)-(640,16*24+1),0,BF,2:LINE(0,16*24+1)-STEP(639,0),7 2260 LOCATE 19,2:PRINT SPACE$(60); 2270 DEF SEG=&HA000:FOR I=640 TO 3838:POKE I,0:NEXT :RETURN 2280 *KAKU '============== Šy•ˆˆê——•\Ž¦i‚P^‚S¬ß–ˆj 2290 V=8*4+(Y\3)*8*39+X*16:W=16*12+(Y MOD 3)*16*4:Z=(JX+X-7) MOD RT 2300 IF JX+X-7<0 OR JX+X-7>=MAXX THEN LINE(V,W)-STEP(15,63),2,BF:RETURN 2310 DEF SEG=GS[Y]:PUT@(V,W),C3,PSET 2320 LINE(V,W)-STEP(0,63),7,,-(Z=0)*&HFFFF-(Z<>0)*&HAAAA 2330 FOR I=0 TO 3 2340 GF=PEEK((JX+X-7)*24+I*6):G1=GF AND &H3F:G2=(GF AND &HC0)\&H40 2350 ON -(GF>0)-(G2=3) GOSUB 2360,2380:GOTO 2390 2360 A=-(G1>=17 AND G1<=47)*(G1-17)-(G1>47)*30 2370 CIRCLE(V+I*4+2,W+ 2+A*2),2,C[G2],,,,F:RETURN 2380 PUT@ (V+I*4+1,W+29 ),C1,OR :RETURN 2390 NEXT :RETURN 2400 *KAKU1 '============== Šy•ˆŠg‘å•\Ž¦i‚P^‚P‚U¬ß–ˆj 2410 V=8*19+X*24:W=16*3:A=JX*4+X:Z=A MOD 4:Z1=A MOD 4*RT 2420 DEF SEG=GS[EC]:PUT@(V,W),C2,PSET 2430 LINE(V,W)-STEP(-(Z1=0),127),7,B,-(Z=0)*&HFFFF-(Z>0)*&HAAAA 2440 FOR I=0 TO 5 2450 GF=PEEK(JX*24+X*6+I):G1=GF AND &H3F:G2=(GF AND &HC0)\&H40 2460 ON -(GF>0)-(G2=3) GOSUB 2470,2480:GOTO 2490 2470 CIRCLE(V+I*4+2,W+G1*2),2,C[G2],,,,F:RETURN 2480 PUT (V+I*4+1,W+ 61),C1,OR :RETURN 2490 NEXT :RETURN 2500 *KAKU2 '============== ‰¹ŠK•\Ž¦(main—p) 2510 Y=(MY-16*3)\2:C=Y MOD 7:O=OC[EC]+4-(Y+2)\7:A$="":ON -(Y=0) GOTO 2530 2520 A$=MID$(" "+FNS$(O),1-(0G1 THEN F2=-(INSTR(T1$,N4$[C])>0)-2*(INSTR(T2$,N4$[C])>0) 2880 GF=Y*ML OR F2*&H40:ON -(F2=3 OR GF=0) GOTO 2960 2890 ' 2900 O=OC[EC]+4-(Y+2)\7 2910 A$=MID$(" "+FNS$(O),1-(02 AND STATUS PLAY(0)=0 THEN PLAY ,,,A$ 2960 POKE JX*24+X,GF 2970 MOUSE 1,,,0:Y=EC:X=X\6:GOSUB *KAKU1:X=7+X\4:GOSUB *KAKU 2980 MOUSE 1,,,1:GOSUB *WA3:RETURN 2990 *WA3 '============== ƒ}ƒEƒX‚̃{ƒ^ƒ“‰Ÿ‰ºŠÔƒEƒFƒCƒg 3000 A=0:FOR I=0 TO 9:GOSUB 3010:A=A OR B:NEXT:ON A GOTO *WA3 :RETURN 3010 B=MOUSE(2,1) OR MOUSE(2,2):RETURN 3020 *WA2:WHILE INKEY$<>"":WEND :RETURN 3030 *KG2:MES$="":GOSUB *MES :RETURN 3040 *MES:LOCATE 1,3:PRINT LEFT$(" "+MES$+SPACE$(16),17); :RETURN 3050 *SE '============== ”͈͎w’è 3060 CH=0 3070 MES$="Start":GOSUB *MES:GOSUB *WA3:GOSUB *SE2:V1=X:W1=Y:IF CH THEN RETURN 3080 MES$="End ":GOSUB *MES:GOSUB *WA3:GOSUB *SE2:V2=X:W2=Y:IF CH THEN RETURN 3090 IF V1>V2 OR W1>W2 THEN CH=1:BEEP 3100 RETURN 3110 *SE2 '============== ”͈͎w’è 3120 GOSUB *IN4:ON -(ML=MR) GOTO 3120 :IF MR THEN CH=1:RETURN 3130 V=MX\8:W=MY\16:MP=MP[V,W] 3140 IF MP= 12 THEN GOSUB *FB:GOSUB *SCR:GOTO *SE2 3150 IF MP<>16 THEN *SE2 3160 X=(JX-7)*4+(MX+(MX>320)*312-32-1)\4 :IF X<0 OR X>=MAXX*4 THEN CH=1:BEEP 3170 Y=(V\40)*3+(W-12)\4 :RETURN 3180 *CNV '============== ‚l‚l‚k•¶‚Ö•ÏŠ· 3190 MES$="Now Converting":GOSUB *MES 3200 FOR I=0 TO 5:FOR J=0 TO 1000:MM$[J,I]="":NEXT J,I 3210 ' 3220 IF (MENU=2 OR MENU=3) AND JUN$>"" THEN 3270 3230 FOR X=0 TO V2-V1 3240 CH[X]=V1+X 3250 NEXT:MAX=(V2-V1)*6:GOTO 3340 3260 ' 3270 A=-1 'Šy•ˆ‘g—§ 3280 FOR I=1 TO LEN(JUN$):J=ASC(MID$(JUN$,I,1))-97:IF J<0 OR 258 THEN A$=A$+"r":GOTO 3470 3440 IF ABS(OC-O)=1 THEN A$=A$+MID$("<>",1-(OCO THEN A$=A$+"o"+FNS$(O) :OC=O 3460 A$=A$+N4$[C]+N5$[G2] 3470 IF LG<>L THEN A$=A$+L$ 3480 ' IF LG<>L THEN IF INSTR(L$,"^") THEN A$=A$+L$ ELSE LG=L:A$="l"+L$+A$ 3490 MM$[X\24*RT+1,I]=MM$[X\24*RT+1,I]+A$:X=X+L 3500 WEND 3510 NEXT :RETURN 3520 ' 3530 L=1 3540 WHILE L<96 AND X+L-1:FOR J=0 TO 5:DEF SEG=GS[J]:A=FNA(1,1):B=A AND &HC0 3830 POKE I*6,B OR -(A-B>0)*(A-B+8) 3840 NEXT:I=I+1:WEND:CLOSE#1 :RETURN 3850 *MAX '============== Šy•ˆ’·Œv‘ª 3860 MAX=-1 3870 FOR I=0 TO 5:DEF SEG=GS[I] 3880 A=768:B=0 3890 WHILE A>0:A=A-1:B=B+1 3900 ON -(PEEK(MAX+B)=0) GOTO 3910:MAX=MAX+B:B=0:A=768 3910 WEND 3920 NEXT :RETURN 3930 *TP '============== ‰‰‘t‘¬“xÝ’è 3940 A=((TP-ML+MR*16)\16)*16:B=((TP-ML+MR*24)\24)*24 3950 TP=(A+B+(ML-MR)*ABS(A-B))/2 3960 IF TP<32 THEN TP=32 ELSE IF TP>240 THEN TP=240 3970 GOSUB *WA3:RETURN 3980 *FIL '============== ŒÄoŠy•ˆ‘I‘ð 3990 DEF SEG=&HA000:CH=0:LOCATE 0,5:FILES PATH$+"*.mus":GOSUB *WA3 4000 GOSUB *IN4:ON -(ML=MR) GOTO 4000 4010 A=MX\320+(MY\16-5)*2:A$="" 4020 FOR I=0 TO 11 4030 A1=PEEK(160*5+80*A+I*2):A2=PEEK(160*5+80*A+I*2+1) 4040 IF A2=0 THEN A$=A$+CHR$(A1):GOTO 4060 '‚PƒoƒCƒg•¶Žš 4050 I=I+1:A$=A$+KNJ$(HEX$(A2+(A1+&H20)*&H100)) '‚QƒoƒCƒg•¶Žš 4060 NEXT 4070 IF MR OR A<0 THEN CH=1:RETURN 4080 IF MID$(A$,1,8)=STRING$(8," ") THEN CH=2 4090 IF MID$(A$,9,4)<>" MUS" THEN CH=3 4100 ANS$=MID$(A$,1,8) :RETURN 4110 *PLAY. '============== ‰‰‘t 4120 IF MENU=3 THEN GOSUB *MAX:V1=0:V2=MAX\6:W1=0:W2=5 4130 IF MENU=4 THEN GOSUB *SE:IF CH THEN RETURN 4140 GOSUB *CNV:IF CH THEN RETURN 4150 MES$="Now Playing":GOSUB *MES 4160 FOR I=0 TO (V2-V1)\4*RT+1 4170 PLAY MM$[I,0],MM$[I,1],MM$[I,2],MM$[I,3],MM$[I,4],MM$[I,5] 4180 NEXT :RETURN 4190 *STOP. '============== ‰‰‘t’âŽ~ 4200 A=&H1000:PLAY ALLOC A,A,A,A,A,A :RETURN 4210 *CHOUGOU '============== ’²†“ü—Í 4220 QUE$="#":GOSUB *IN3:T1$=LEFT$(ANS$,7) 4230 QUE$="b":GOSUB *IN3:T2$=LEFT$(ANS$,7) :RETURN 4240 *SOUJUN '============== ‰‰‘t‡˜“ü—Í 4250 LOCATE 7,11:INPUT "",JUN$ :RETURN 4260 *SENRITSU '============== ù—¥“ü—Í 4270 MES$="a-zF":GOSUB *MES:LOCATE 7,3:GOSUB *WA2 4280 ANS$=INPUT$(1):IF ANS$<"a" OR "z"32000 THEN BEEP:RETURN 4370 MES$="Copy":GOSUB *MES:GOSUB *WA3:GOSUB *SE2:V3=X:W3=Y:IF CH THEN RETURN 4380 V1=V1*6:V2=V2*6+5:V3=V3*6 4390 FOR I=0 TO W2-W1:DEF SEG=GS[W1+I] 4400 FOR J=0 TO V2-V1 4410 CH[I*AA+J]=PEEK(V1+J) 4420 NEXT J,I 4430 FOR I=0 TO W2-W1:ON -(W3+I>5) GOTO 4470:DEF SEG=GS[W3+I] 4440 FOR J=0 TO V2-V1:ON -(V3+J>=MAXX*24) GOTO 4460 4450 POKE V3+J,CH[I*AA+J] 4460 NEXT 4470 NEXT :RETURN 4480 *SHOUKYO '============== Šy•ˆÁ‹Ž 4490 GOSUB *SE:IF CH THEN RETURN 4500 FOR I=W1 TO W2:DEF SEG=GS[I] 4510 FOR J=V1*6 TO V2*6+5 4520 POKE J,0 4530 NEXT J,I :RETURN 4540 *HOZON '============== Šy•ˆ•Û‘¶ 4550 SH=FNI(INP(&HE8),6):IF NA$>"" THEN 4580 4560 QUE$="Šy•ˆ–¼":GOSUB *IN3:IF ANS$="" OR LEN(ANS$)>8 THEN BEEP:RETURN 4570 NA$=ANS$ 4580 ON 1+SH GOSUB *SA,*MML.SAVE :RETURN 4590 *YOBIDASHI '============== Šy•ˆŒÄo 4600 GOSUB *SCR2:MES$="ŒÄoŠy•ˆ‘I‘ð":GOSUB *MES:GOSUB *FIL:IF CH THEN 4620 4610 JX=0:EC=0:NA$=ANS$:GOSUB *DIM.:GOSUB *LO 4620 CLS:RETURN 4630 *MML.SAVE '============== ‚l‚l‚k•¶•Û‘¶ 4640 GOSUB *MAX:V1=0:V2=MAX\6:W1=0:W2=5:GOSUB *CNV:IF CH THEN RETURN 4650 MES$="Now MML Saving":GOSUB *MES 4660 OPEN PATH$+NA$+".mml" FOR OUTPUT AS#1 4670 FOR I=0 TO V2\4*RT+1:FOR J=0 TO 5:PRINT#1,MM$[I,J]:NEXT J,I:CLOSE:RETURN 4680 *FB '============== Šy•ˆ³‹t‡‘—‚è 4690 ON 1-(V<58)-2*(V>73) GOSUB 4700,4720,4730 :RETURN 4700 JX=JX+VAL(MID$("-64-16 -4 -1 1 4 16 64",((V-58)\2)*3+1,3)) 4710 JX=-(JX>0)*JX:IF JX>MAXX-5 THEN JX=MAXX-5:RETURN ELSE RETURN 4720 JX=0:RETURN 4730 GOSUB *MAX:JX=-(MAX>=24*4)*(MAX\24-4):RETURN 4740 *SEARCH. '============== Žw’èù—¥ŠJŽnˆÊ’uŒŸõ 4750 DEF SEG=&HA000:A$=CHR$(PEEK(1760+V*2)) 4760 IF "a"<=A$ AND A$<="z" THEN JX=SEN[ASC(A$)-97,0]\4 :RETURN 4770 *OC '============== Šeƒ`ƒƒƒ“ƒlƒ‹‚ÌŠî–{‰¹’ö‹y‚щ¹—ÊÝ’è 4780 FOR I=0 TO 5:X=2+(I\3)*39:Y=13+(I MOD 3)*4 4790 IF V=X AND W=Y THEN OC[I]=OC[I]-MR*(OC[I]<8 )+ML*(OC[I]>1) 4800 IF V=X AND W=Y+2 THEN VL[I]=VL[I]-MR*(VL[I]<15)+ML*(VL[I]>0) 4810 NEXT :GOSUB *WA3:RETURN 4820 *EC '============== •ÒWƒ`ƒƒƒ“ƒlƒ‹Ý’è 4830 Y=(V\40)*3+(W-12)\4:V=V+(V<40):V=((V-3) MOD 40)\2 4840 X=JX-9+V:X=-(X>0)*X:IF X>MAXX-5 THEN X=MAXX-5 4850 JX=X:EC=Y :RETURN