    1 REM四川省 V1.3 : 7000-4500用
   20 ON ERROR GOTO *ERR
   30 ON TOUCH GOSUB *TCH
   40 BREAK OFF:DEFSNG A-Z:RANDOMIZE
   50 DIM P$(&23),Q$(&23),C(&8F),G(&C7),LX(&3),LY(&3)
   60 DIM VM(&9),VS(&9),VR(&9)
   70 DIM HM(&13,&1),HS(&13,&1),HR(&13,&1)
   80 DIM VW(&13),HW(&9,&1)
   90 DIM K(&4),X(&3),Y(&3),SF(&23)
  100 DIM M$(&1,&3)
  110 O=&0,P=&1,B=&2,C=&3,N=-P,O$=CHR$(O)
  120 LC=O,T1=O,T2=O,U1=O,U2=O
  130 SX=O,EX=O,SY=O,EY=O,H0=O,H1=O,V0=O,UT=O,UB=O,XW=O,YW=O
  140 FA=O,FR=O,FL=O,FT=O,FB=O,OK=O,SE=O,OE=O,BF=O
  150 J$="順位  名前      記録    記録日時"
  160 K$="                                    "
  170 F$="SX:SHISEN13.BA",V$=CHR$(O)+CHR$(&67)
  180 Y$=CHR$(&A0)+CHR$(&BB)+CHR$(&BD)+CHR$(&BE)+CHR$(&BF)+CHR$(&C2)+CHR$(&C3)+CHR$(&C4)+CHR$(&C6)+CHR$(&C7)+CHR$(&C9)+CHR$(&CA)+CHR$(&D0)+CHR$(&D1)
  190 Z$=CHR$(&20)+CHR$(&3B)+CHR$(&3D)+CHR$(&3E)+CHR$(&3F)+CHR$(&41)+CHR$(&43)+CHR$(&44)+CHR$(&6B)+CHR$(&52)+CHR$(&53)+CHR$(&4E)+CHR$(&55)+CHR$(&6C)
  200 GOSUB *FINIT:GOSUB *PINIT:GOSUB *HINIT:GOSUB *MINIT:GOSUB *GINIT:GOSUB *CINIT
  210 ICON I,F$+"I"
  220 *RENEW
  230 TOUCH OFF:BC=&F:GOSUB *BCHG:GOSUB *MSGSHOW:GOSUB *SHUFFLE
  240 *RENEW2
  250 TOUCH OFF
  260 FOR I=O TO &23:SF(I)=4:NEXT
  270 SCH=O,MD=O,Z=&90,P1=N,HF=O,KF=O
  280 GOSUB *CGSET:GOSUB *ALLDRAW
  290 TOUCH ON
  300 GOSUB *TSTART
  310 *MAINLP
  320 A$=INPUT$(P)
  330 IF A$=O$ THEN B$=INPUT$(P) ELSE *MAIN4
  340 IF B$=CHR$(&7E) THEN KF=NOT KF:GOTO *MAINLP
  350 IF B$=CHR$(&51) THEN GOSUB *TSTOP:BC=O:GOSUB *BCHG:GOSUB *HELP:BC=&F:GOSUB *BCHG:GOSUB *TCONT:GOTO *MAINLP
  360 IF KF<>O THEN C$=O$+CHR$(&7E):KF=O ELSE C$=""
  370 IF B$<CHR$(&65) OR B$>CHR$(&67) THEN KEY 0,C$+A$+B$+V$:CALL@11:GOTO *MAINLP
  375 IF B$<>CHR$(&65) THEN *MAINLP
  380 KEY 0,A$+B$+CHR$(&D):LOCATE&8,O:INPUT " ",A$
  390 IF A$=" " THEN *RENEW2
  400 IF A$="  " THEN GOSUB *TSTOP:SV1=O,SV2=&1C,SV3=&EE,SV4=&A7:GOSUB *SVSCR:BC=O:GOSUB *BCHG:GOSUB *HSD:CALL@11:GOSUB *LDSCR:BC=&F:GOSUB *BCHG:GOSUB *TCONT
  410 IF A$="   " THEN MF=NOT MF:GOSUB *CFGW:GOSUB *MCHG
  420 GOTO *MAINLP
  430 *MAIN4
  440 IF TOUCH@Z=P THEN *MAINLP
  450 IF ICON A,P,T,B THEN *THEEND
  460 IF ICON A,C,T,B THEN *RENEW
  470 IF ICON A,B,T,B THEN HF=N:GOSUB *SEARCH:GOTO *MAINLP
  480 IF ICON A,&4,T,B THEN GOSUB *TEISHI:GOTO *MAINLP
  490 IF NOT TOUCH(&B,&1D,&E2,&9C) THEN *MAINLP
  500 T1=TOUCH X:U1=TOUCH Y
  510 T1=INT((T1+P)/&C),U1=INT((U1-&D)/&10)
  520 IF MD=O THEN *MAIN3
  530 X=S1X,Y=S1Y,V=S2X,W=S2Y
  540 IF T1=S1X AND U1=S1Y THEN GOSUB *TC3:MD=O:GOTO *MAIN2
  550 IF T1=S2X AND U1=S2Y THEN GOSUB *TC3:MD=O:GOTO *MAIN2
  560 GOSUB *HANTENX:GOSUB *HANTEN2:MD=O
  570 *MAIN3
  580 IF P1<O THEN X=T1,Y=U1:GOSUB *TC1 ELSE V=T1,W=U1:GOSUB *TC2
  590 *MAIN2
  600 IF Z THEN *MAINLP
  610 '
  620 *NOPAI
  630 GOSUB *TSTOP
  640 S=INT(R/&3C),E=R-S*&3C
  650 S$=RIGHT$(STR$(S+&64),B)+":"+RIGHT$(STR$(E+&64),B)
  660 '
  670 BC=O:GOSUB *BCHG
  680 GOSUB *GCLR:CALL@12,&174:A$=INKEY$
  690 IF HF=O THEN GOSUB *HSS
  700 CALL@41,(O,&12)-(&EE,&A8),C,O:GOSUB *HSD
  710 BC=&5:GOSUB *BCHG
  720 '
  730 *LLP:CALL @11:IF TOUCH@Z=P THEN *LLP
  740 IF ICON A,C,T,B THEN *RENEW
  750 IF NOT (ICON A,P,T,B) THEN *LLP
  760 '
  770 *THEEND:BC=O:GOSUB *BCHG:CLS:WIDTH,,N:CALL@20:CALL@18:KEY 0,"":END
  780 '
  790 *TCH:RETURN
  800 '
  810 *ERR
  820 IF ERN=&4D THEN SE=N:RESUME NEXT
  830 IF ERN=&48 THEN RESUME NEXT
  840 IF ERN=&5E THEN OE=N:RESUME NEXT
  850 *ERR2:CLS:WAIT O:PRINT ERN;ERL:CALL@11:END
  860 '
  870 *CFGW:OPEN F$+"0" FOR APPEND AS #3:SEEK 3,1800,T:PRINT #3,MF:CLOSE #3:RETURN
  880 '
  890 *FINIT
  900 OE=O:OPEN F$+"1" FOR INPUT AS #2:IF NOT OE THEN CLOSE #2:RETURN
  910 FOR I=&C TO &A STEP N:B$="SX:SHISEN"+MID$(STR$(I),&2,&2)+".BA1"
  920 OE=O:OPEN B$ FOR INPUT AS #2:IF NOT OE THEN CLOSE #2:SE=O:COPY B$ TO F$+"1",B:IF NOT SE THEN RETURN
  930 NEXT
  940 SE=O:OPEN F$+"1" FOR OUTPUT AS #2
  950 FOR I=P TO 7
  960 PRINT #2,"　　　　　　　　 　　　　　　　　　"+CHR$(&D)+CHR$(&A);
  970 IF SE THEN *ERR2
  980 NEXT:CLOSE #2:RETURN
  990 '
 1000 *PINIT
 1010 OE=O:OPEN F$+"0" FOR INPUT AS #2
 1020 IF OE THEN *ERR2
 1030 FOR I=O TO 35:P$(I)=INPUT$(24,#2):Q$(I)=INPUT$(24,#2):A$=INPUT$(2,#2):NEXT
 1040 INPUT#2,MF
 1050 CLOSE #2:RETURN
 1060 '
 1070 *GINIT
 1080 CLS:WIDTH,M,N:WAIT O:LOCATE O,O:PRINT "■四川省":CALL@40,(O,&E)-(&EE,&F),P,&4,O
 1090 RETURN
 1100 '
 1110 *CINIT
 1120 FOR J=O TO &11:C(J)=J,C(J+&12)=J,C(J+&24)=J,C(J+&36)=J:NEXT
 1130 FOR J=&12 TO &23:C(J+&36)=J,C(J+&48)=J,C(J+&5A)=J,C(J+&6C)=J:NEXT
 1140 RETURN
 1150 '
 1160 *SHUFFLE
 1170 FOR I=O TO &120:J=RND144-P,K=RND144-P,L=C(J),C(J)=C(K),C(K)=L:NEXT
 1180 'FOR I=O TO &8F:J=RND144-P,L=C(I),C(I)=C(J),C(J)=L:NEXT
 1190 RETURN
 1200 '
 1210 *ALLDRAW
 1220 WAIT O:CALL@41,(O,&12)-(&EE,&A8),C,O
 1230 FOR I=P TO 9:FOR J=P TO 8
 1240 IF G(J*20+I)>=O THEN XX=I*12-P,YY=20+J*16:GCURSOR(XX,YY):GPRINT P$(G(J*20+I));:GCURSOR(XX,YY+8):GPRINT Q$(G(J*20+I));
 1250 IF G((9-J)*20+(19-I))>=O THEN XX=(19-I)*12-P,YY=20+(9-J)*16:GCURSOR(XX,YY):GPRINT P$(G((9-J)*20+(19-I)));:GCURSOR(XX,YY+8):GPRINT Q$(G((9-J)*20+(19-I)));
 1260 NEXT:NEXT
 1270 IF MD THEN X=S1X,Y=S1Y,V=S2X,W=S2Y:GOSUB *HANTENX:GOSUB *HANTEN2
 1280 IF P1>=O THEN GOSUB *HANTENX
 1290 RETURN
 1300 '
 1310 *CGSET
 1320 K=O
 1330 FOR I=P TO &8:FOR J=P TO &12:G(I*20+J)=C(K),K=K+P:NEXT:NEXT
 1340 FOR I=P TO &8:G(I*20)=N,G(I*20+19)=N:NEXT
 1350 FOR I=O TO &13:G(I)=N,G(180+I)=N:NEXT
 1360 FOR I=P TO &8:HW(I,O)=&3FE,HW(I,P)=&1FF:NEXT
 1370 FOR I=P TO &12:VW(I)=&1FE:NEXT
 1380 HW(O,O)=O,HW(O,P)=O,HW(&9,O)=O,HW(&9,P)=O,VW(O)=O,VW(&13)=O
 1390 RETURN
 1400 '
 1410 *HINIT
 1420 FOR I=O TO &9
 1430 J=2^I
 1440 VS(I)=J,VR(I)=&7FFF-J,VM(I)=J+J-P
 1450 HS(I,O)=J,HS(I,P)=O,HR(I,O)=&7FFF-J,HR(I,P)=&7FFF,HM(I,O)=J+J-P,HM(I,P)=O
 1460 HS(I+&A,O)=O,HS(I+&A,P)=J,HR(I+&A,O)=&7FFF,HR(I+&A,P)=&7FFF-J,HM(I+&A,O)=&7FFF,HM(I+&A,P)=J+J-P
 1470 NEXT
 1480 RETURN
 1490 '
 1500 *MSGSHOW:SV1=&1E,SV2=&40,SV3=&D0,SV4=&67,WX=&D,WY=&5,MES$="並べ替え中です":GOSUB *MKDIAG:RETURN
 1510 *MSGSHOW2:SV1=&28,SV2=&40,SV3=&C6,SV4=&67,WX=&11,WY=&5,MES$="検索中":GOSUB *SVSCR:GOSUB *MKDIAG:RETURN
 1520 *MSGHIDE2:GOSUB *LDSCR:RETURN
 1530 '
 1540 *MINIT
 1550 M$(O,O)="0四川省"
 1560 M$(O,P)="1やり直し":M$(P,P)=" "+CHR$(&D)
 1570 M$(O,B)="1ハイスコア":M$(P,B)="  "+CHR$(&D)
 1580 *MCHG
 1590 IF MF THEN M$(O,C)="1確認ﾗｲﾝ ON" ELSE M$(O,C)="1確認ﾗｲﾝ OFF"
 1600 M$(P,C)="   "+CHR$(&D)
 1610 CALL@20,M$
 1620 RETURN
 1630 '
 1640 *MENUOFF
 1650 FOR I=P TO 3
 1660 IF ASC(M$(O,I))=&31 THEN M$(O,I)="2"+RIGHT$(M$(O,I),LEN(M$(O,I))-P)
 1670 CALL@20,M$:NEXT:RETURN
 1680 '
 1690 *MENUON
 1700 FOR I=P TO 3
 1710 IF ASC(M$(O,I))=&32 THEN M$(O,I)="1"+RIGHT$(M$(O,I),LEN(M$(O,I))-P)
 1720 CALL@20,M$:NEXT:RETURN
 1730 '
 1740 *TC1
 1750 IF G(Y*20+X)=N THEN RETURN
 1760 P1=G(Y*20+X)
 1770 GOSUB *HANTENX
 1780 RETURN
 1790 '
 1800 *TC2
 1810 IF G(W*20+V)<>P1 THEN RETURN
 1820 IF X=V AND Y=W THEN P1=N:GOSUB *HANTENX:RETURN
 1830 GOSUB *HANTEN2
 1840 GOSUB *HANTEI:IF OK=O THEN GOSUB *HANTEN2:RETURN
 1850 '
 1860 *TC3
 1870 IF MF OR LC=O THEN *T3
 1880 FOR I=O TO LC:LX(I)=LX(I)*12+5:LY(I)=LY(I)*16+21:NEXT
 1890 FOR I=O TO LC-P
 1900 CALL@41,(LX(I)-P,LY(I)-P)-(LX(I+P),LY(I+P)),P,&4
 1910 NEXT
 1920 CALL@11,20
 1930 FOR I=O TO LC-P
 1940 CALL@41,(LX(I)-P,LY(I)-P)-(LX(I+P),LY(I+P)),C,O
 1950 NEXT
 1960 '
 1970 *T3
 1980 XX=X*12-P,YY=Y*16+13
 1990 CALL@41,(XX,YY)-(XX+11,YY+15),3,O
 2000 XX=V*12-P,YY=W*16+13
 2010 CALL@41,(XX,YY)-(XX+11,YY+15),3,O
 2020 XX=Y*20+X,P1=G(XX),G(XX)=N,G(W*20+V)=N
 2030 VW(X)=VW(X) AND VR(Y)
 2040 HW(Y,O)=HW(Y,O) AND HR(X,O)
 2050 HW(Y,P)=HW(Y,P) AND HR(X,P)
 2060 VW(V)=VW(V) AND VR(W)
 2070 HW(W,O)=HW(W,O) AND HR(V,O)
 2080 HW(W,P)=HW(W,P) AND HR(V,P)
 2090 Z=Z-B,SF(P1)=SF(P1)-B,P1=N
 2100 RETURN
 2110 '
 2120 *HANTENX:CALL@41,(X*12-P,Y*16+13)-(X*12+9,Y*16+27),P,P:RETURN
 2130 *HANTEN2:CALL@41,(V*12-P,W*16+13)-(V*12+9,W*16+27),P,P:RETURN
 2140 '
 2150 *GCLR
 2160 'BEEP 1,8,10000,5000
 2170 CALL@41,(&1E,&40)-(&D0,&67),P,&4
 2180 CALL@40,(&1E,&40)-(&D0,&67),P,&4,O
 2190 CALL@40,(&21,&43)-(&CE,&65),P,&8,O
 2200 WAIT O:LOCATE&9,&5:PRINT "ゲームクリア ＼(^-^)／"
 2210 WIDTH,A:LOCATE&18,&9:PRINT S$;:WIDTH,M
 2220 RETURN
 2230 '
 2240 *HSS
 2250 OPEN F$+"1" FOR APPEND AS #2
 2260 CALL @36,B,&25,P,INT(LOF(B)/&25)
 2270 CALL @37,O,[&D,&5,>,S$]
 2280 CALL @38,A
 2290 IF A=O THEN *HPATH
 2300 '
 2310 GOSUB *NMINPUT
 2320 I=&7:GOTO *USK
 2330 *ULP:SEEK 2,(I-P)*&25,T:A$=INPUT$(&25,B):PRINT #2,A$;
 2340 *USK:I=I-P:IF A<=I THEN *ULP
 2350 SEEK 2,(A-P)*&25,T:PRINT #2,N$+S$+D$+E$
 2360 *HPATH:SEEK 2,P,E:CLOSE #2
 2370 RETURN
 2380 '
 2390 *SEARCH
 2400 IF P1<>N THEN GOSUB *HANTENX:P1=N
 2410 IF MD THEN X=S1X,Y=S1Y,V=S2X,W=S2Y:GOSUB *HANTENX:GOSUB *HANTEN2
 2420 GOSUB *MSGSHOW2
 2430 TJ=SCH,OK=O
 2440 *SCHLPNEW
 2450 IF SF(TJ)=O THEN *SCHSKIP
 2460 CALL@2,G(O),TJ,SF(TJ),K()
 2470 FOR TI=O TO SF(TJ)-P
 2480 Y(TI)=INT(K(TI)/20):X(TI)=K(TI)-Y(TI)*20
 2490 NEXT
 2500 IF SF(TJ)=B THEN *TCHK2ND
 2510 '
 2520 X=X(O),Y=Y(O),V=X(P),W=Y(P):GOSUB *HANTEI:IF OK THEN *TCHKEND
 2530 X=X(O),Y=Y(O),V=X(B),W=Y(B):GOSUB *HANTEI:IF OK THEN *TCHKEND
 2540 X=X(O),Y=Y(O),V=X(C),W=Y(C):GOSUB *HANTEI:IF OK THEN *TCHKEND
 2550 X=X(P),Y=Y(P),V=X(B),W=Y(B):GOSUB *HANTEI:IF OK THEN *TCHKEND
 2560 X=X(P),Y=Y(P),V=X(C),W=Y(C):GOSUB *HANTEI:IF OK THEN *TCHKEND
 2570 X=X(B),Y=Y(B),V=X(C),W=Y(C):GOSUB *HANTEI:IF OK THEN *TCHKEND
 2580 GOTO *TCHKEND
 2590 '
 2600 *TCHK2ND
 2610 X=X(O),Y=Y(O),V=X(P),W=Y(P):GOSUB *HANTEI:IF OK THEN *TCHKEND
 2620 *TCHKEND
 2630 IF OK THEN *SCHOK
 2640 *SCHSKIP
 2650 TJ=TJ+P:IF TJ>35 THEN TJ=O
 2660 IF TJ<>SCH THEN *SCHLPNEW
 2670 '
 2680 WAIT O:LOCATE&C,&5:PRINT "手詰りです(;_;)":CALL@11
 2690 GOSUB *MSGHIDE2
 2700 RETURN *MAINLP
 2710 '
 2720 *SCHOK
 2730 GOSUB *MSGHIDE2:GOSUB *HANTENX:GOSUB *HANTEN2
 2740 MD=N,S1X=X,S1Y=Y,S2X=V,S2Y=W
 2750 TJ=TJ+P:IF TJ>&23 THEN TJ=O
 2760 SCH=TJ
 2770 RETURN
 2780 '
 2790 *HANTEI
 2800 LC=O:FA=&F
 2810 IF X<V THEN T1=X,T2=V,U1=Y,U2=W ELSE T1=V,T2=X,U1=W,U2=Y
 2820 IF U1<U2 THEN UT=U1,UB=U2 ELSE UT=U2,UB=U1
 2830 EX=T1,SX=T2
 2840 *L1:IF EX<T2 THEN IF G(U1*20+EX+P)=N THEN EX=EX+P:GOTO *L1
 2850 IF Y=W AND EX=T2-P THEN *T12
 2860 *L2:IF SX>T1 THEN IF G(U2*20+SX-P)=N THEN SX=SX-P:GOTO *L2
 2870 IF EX<T2 THEN FR=N:FA=FA AND &D ELSE FR=O
 2880 IF SX>T1 THEN FL=N:FA=FA AND &E ELSE FL=O
 2890 H0=HM(T2,O)-HM(T1-P,O)
 2900 H1=HM(T2,P)-HM(T1-P,P)
 2910 V0=VM(UB)-VM(UT-P)
 2920 IF U1>U2 THEN *B1
 2930 '
 2940 EY=U1,SY=U2
 2950 *L3:IF EY<U2 THEN IF G((EY+P)*20+T1)=N THEN EY=EY+P:GOTO *L3
 2960 IF X=V AND EY=UB-P THEN *U12
 2970 *L4:IF SY>U1 THEN IF G((SY-P)*20+T2)=N THEN SY=SY-P:GOTO *L4
 2980 IF SX<=T1 AND U2<=EY THEN *T1T1T2
 2990 IF T2<=EX AND SY<=U1 THEN *T1T2T2
 3000 GOTO *A1
 3010 '
 3020 *B1
 3030 EY=U2,SY=U1
 3040 *L5:IF EY<U1 THEN IF G((EY+P)*20+T2)=N THEN EY=EY+P:GOTO *L5
 3050 IF X=V AND EY=UB-P THEN *U12
 3060 *L6:IF SY>U2 THEN IF G((SY-P)*20+T1)=N THEN SY=SY-P:GOTO *L6
 3070 IF SX<=T1 AND SY<=U2 THEN *T1T1T2
 3080 IF T2<=EX AND U1<=EY THEN *T1T2T2
 3090 *A1
 3100 IF EY<UB THEN FB=N:FA=FA AND &7 ELSE FB=O
 3110 IF SY>UT THEN FT=N:FA=FA AND &B ELSE FT=O
 3120 YW=SY:GOTO *PYSK1
 3130 *PYLP1:IF ((HW(YW,O) AND H0) OR (HW(YW,P) AND H1))=O THEN *T1122U1WW2 ELSE YW=YW+P
 3140 *PYSK1:IF YW<=EY THEN *PYLP1
 3150 XW=SX:GOTO *PXSK1
 3160 *PXLP1:IF (VW(XW) AND V0)=O THEN *T1WW2U1122 ELSE XW=XW+P
 3170 *PXSK1:IF XW<=EX THEN *PXLP1
 3180 '
 3190 D=P
 3200 *SKL:IF FL THEN *SKR
 3210 XW=T1-D:IF XW<O THEN FL=N:FA=FA AND &E:GOTO *SKR
 3220 IF (VW(XW) AND V0)=O THEN *T1WW2U1122
 3230 IF G(UT*20+XW)<>N OR G(UB*20+XW)<>N THEN FL=N:FA=FA AND &E
 3240 *SKR:IF FR THEN *SKT
 3250 XW=T2+D:IF XW>19 THEN FR=N:FA=FA AND &D:GOTO *SKT
 3260 IF (VW(XW) AND V0)=O THEN *T1WW2U1122
 3270 IF G(UT*20+XW)<>N OR G(UB*20+XW)<>N THEN FR=N:FA=FA AND &D
 3280 *SKT:IF FT THEN *SKB
 3290 YW=UT-D:IF YW<O THEN FT=N:FA=FA AND &B:GOTO *SKB
 3300 IF ((HW(YW,O) AND H0) OR (HW(YW,P) AND H1))=O THEN *T1122U1WW2
 3310 IF G(YW*20+T1)<>N OR G(YW*20+T2)<>N THEN FT=N:FA=FA AND &B
 3320 *SKB:IF FB THEN *SKE
 3330 YW=UB+D:IF YW>9 THEN FB=N:FA=FA AND &7:GOTO *SKE
 3340 IF ((HW(YW,O) AND H0) OR (HW(YW,P) AND H1))=O THEN *T1122U1WW2
 3350 IF G(YW*20+T1)<>N OR G(YW*20+T2)<>N THEN FB=N:FA=FA AND &7
 3360 *SKE:D=D+P:IF FA THEN *SKL
 3370 '
 3380 *NGGET:OK=O:RETURN
 3390 *OKGET:OK=N:RETURN
 3400 '
 3410 *T1T1T2:LX(O)=T1,LY(O)=U1,LX(P)=T1,LY(P)=U2,LX(B)=T2,LY(B)=U2,LC=B:GOTO *OKGET
 3420 *T1T2T2:LX(O)=T1,LY(O)=U1,LX(P)=T2,LY(P)=U1,LX(B)=T2,LY(B)=U2,LC=B:GOTO *OKGET
 3430 *T1122U1WW2:LX(O)=T1,LY(O)=U1,LX(P)=T1,LY(P)=YW,LX(B)=T2,LY(B)=YW,LX(C)=T2,LY(C)=U2,LC=C:GOTO *OKGET
 3440 *T1WW2U1122:LX(O)=T1,LY(O)=U1,LX(P)=XW,LY(P)=U1,LX(B)=XW,LY(B)=U2,LX(C)=T2,LY(C)=U2,LC=C:GOTO *OKGET
 3450 *U12:LX(O)=T1,LY(O)=U1,LX(P)=T1,LY(P)=U2,LC=P:GOTO *OKGET
 3460 *T12:LX(O)=T1,LY(O)=U1,LX(P)=T2,LY(P)=U1,LC=P:GOTO *OKGET
 3470 '
 3480 *HELP
 3490 WAIT O:SV1=&9,SV2=&1C,SV3=&E8,SV4=&9C:GOSUB *SVSCR
 3500 OE=O:OPEN F$+"H" FOR INPUT AS #2:IF OE THEN RETURN
 3510 GOSUB *MKDIAG2:LMAX=INT(LOF(B)/&26):LLIN=O
 3520 *CTDR:GOSUB *DR
 3530 *CTLP:A$=INPUT$(P):IF A$<>O$ THEN IF TOUCH@Z<>P THEN *CTOUT ELSE *CTLP
 3540 B$=INPUT$(P):IF B$=CHR$(&7E) THEN KF=NOT KF:GOTO *CTLP
 3550 IF KF<>O THEN C$=O$+CHR$(&7E):KF=O ELSE C$=""
 3560 IF B$<CHR$(&65) OR B$>CHR$(&67) THEN KEY 0,C$+A$+B$+V$:CALL@11
 3570 IF B$=CHR$(&66) THEN IF LLIN>=&8 THEN LLIN=LLIN-&8:GOTO *CTDR
 3580 IF B$=CHR$(&67) THEN IF LLIN+&8<LMAX THEN LLIN=LLIN+&8:GOTO *CTDR
 3590 GOTO *CTLP
 3600 *CTOUT:CLOSE #2:GOSUB *LDSCR:RETURN
 3610 *DR:SEEK B,LLIN*&26,T
 3620 FOR LP=O TO &7
 3630 LOCATE B,B+LP:IF LLIN+LP>=LMAX THEN PRINT K$ ELSE A$=INPUT$(&26,#2):PRINT A$
 3640 NEXT
 3650 RETURN
 3660 '
 3670 *SVSCR:SE=O:OPEN F$+"2" FOR OUTPUT AS #3
 3680 CALL@15,C,(SV1,SV2)-(SV3,SV4)
 3690 CLOSE #3:RETURN
 3700 '
 3710 *LDSCR:OE=O:OPEN F$+"2" FOR INPUT AS #3
 3720 IF SE OR OE THEN GOSUB *ALLDRAW ELSE CALL@16,C,(SV1,SV2)
 3730 CLOSE #3:RETURN
 3740 '
 3750 *MKDIAG
 3760 CALL@41,(SV1,SV2)-(SV3,SV4),P,&4
 3770 CALL@40,(SV1,SV2)-(SV3,SV4),P,&4,O
 3780 CALL@40,(SV1+C,SV2+C)-(SV3-B,SV4-B),P,&8,O
 3790 LOCATE WX,WY:PRINT MES$
 3800 RETURN
 3810 '
 3820 *MKDIAG2
 3830 CALL@41,(SV1+B,SV2+B)-(SV3,SV4),P,O
 3840 CALL@41,(SV1,SV2)-(SV3-B,SV4-B),P,&4
 3850 CALL@40,(SV1,SV2)-(SV3-B,SV4-B),P,&4,O
 3860 RETURN
 3870 '
 3880 *BCHG
 3890 WX=BC XOR BF
 3900 IF WX AND P THEN IF BC AND P THEN ICON D,P,(&D0,O) ELSE ICON C,P
 3910 IF WX AND B THEN IF BC AND B THEN ICON D,B,(&AE,O) ELSE ICON C,B
 3920 IF WX AND &4 THEN IF BC AND &4 THEN ICON D,C,(&91,O) ELSE ICON C,C
 3930 IF WX AND &8 THEN IF BC AND &8 THEN ICON D,&4,(&60,O) ELSE ICON C,&4
 3940 BF=BC
 3950 RETURN
 3960 '
 3970 *HSD
 3980 WAIT O:OE=O:OPEN F$+"1" FOR INPUT AS #2:IF OE THEN RETURN
 3990 CALL@41,(&B,&1E)-(&E7,&9C),P,O
 4000 CALL@41,(&9,&1C)-(&E5,&9A),P,&4
 4010 CALL@40,(&9,&1C)-(&E5,&9A),P,&4,O
 4020 LOCATE B,B:PRINT J$;
 4030 CALL@41,(&A,&1D)-(&E4,&2D),P,P
 4040 FOR LP=C TO &9
 4050 CALL@39,(&B,LP*&F)-(&E3,LP*&F),B,&4,O
 4060 LOCATE B,LP:PRINT CHR$(&2E+LP);" ";INPUT$(&C,#2);
 4070 LOCATE&11,LP:PRINT INPUT$(&5,#2);" ";
 4080 A$=INPUT$(&A,#2):B$=INPUT$(&8,#2)
 4090 PRINT RIGHT$(A$,&8);" ";LEFT$(B$,&5);:B$=INPUT$(B,#2)
 4100 NEXT
 4110 CLOSE #2:RETURN
 4120 '
 4130 *NMINPUT
 4140 GOSUB *MENUOFF:WIDTH,,P
 4150 CALL@41,(O,&12)-(&EE,&51),C,O
 4160 CALL@41,(O,&52)-(&EE,&53),P,&4
 4170 CALL@41,(&B,&1E)-(&E7,&40),P,O
 4180 CALL@41,(&9,&1C)-(&E5,&3E),P,&4
 4190 CALL@40,(&9,&1C)-(&E5,&3E),P,&4,O
 4200 LOCATE B,B:PRINT J$;
 4210 CALL@41,(&A,&1D)-(&E4,&2D),P,P
 4220 LOCATE B,C:PRINT CHR$(&30+A);
 4230 LOCATE&11,C:PRINT RIGHT$(S$,&5);" ";RIGHT$(D$,&8);" ";LEFT$(E$,&5);
 4240 WIDTH,A:LOCATE&8,&7:PRINT "Input Your Name. (^^)/";:WIDTH,M
 4250 B$="":FOR I=O TO &F:B$=B$+CHR$(&1C):NEXT:I=O:N$=""
 4260 *ILP:LOCATE&4,C:KEY 0,N$+CHR$(&B)+LEFT$(B$,I):INPUT !12,N$
 4270 IF TOUCH@Z=N THEN IF TOUCH(&18,&2D,&5F,&3E) THEN I=KLEN(LEFT$(N$,INT(((TOUCH X)-&18)/&6))):GOTO *ILP
 4280 N$=LEFT$(N$+K$,&C):WIDTH,,N:GOSUB *MENUON
 4290 RETURN
 4300 '
 4310 *TEISHI
 4320 GOSUB *TSTOP
 4330 BC=O:GOSUB *BCHG
 4340 WAIT O:SV1=&9,SV2=&1C,SV3=&E8,SV4=&9C:GOSUB *SVSCR
 4350 GOSUB *MKDIAG2
 4360 WAIT O:WIDTH,M:LOCATE&B,&5:PRINT "一時停止中 m(__)m";
 4370 WIDTH,A:LOCATE&8,&C:PRINT "Touch Screen To Continue";
 4380 WIDTH,M
 4390 I=&B4:'30分でOFF
 4400 *TWLP
 4410 A$="":CALL@12,&26C:A$=INKEY$
 4420 IF A$="" THEN *TUCK
 4430 Q=INSTR(P,Y$,A$):IF Q>O THEN KEY 0,O$+MID$(Z$,Q,P)+V$:CALL@11
 4440 GOTO *TWLP
 4450 *TUCK:I=I-P:IF (TOUCH@Z=P) AND (I>O) THEN *TWLP :'not touch
 4460 IF I<=O THEN *TWOUT
 4470 GOSUB *LDSCR:BC=&F:GOSUB *BCHG
 4480 GOSUB *TCONT
 4490 RETURN
 4500 *TWOUT
 4510 BC=O:GOSUB *BCHG:CLS:WIDTH,,N:CALL@20:CALL@18
 4520 KEY 0,O$+CHR$(&20)+CHR$(&D):LOCATE&8,O:INPUT " ",A$:END
 4530 '
 4540 *TSTART:R=O:S$=TIME$:RETURN
 4550 *TCONT:S$=TIME$:RETURN
 4560 '
 4570 *TSTOP
 4580 E$=TIME$,D$=DATE$
 4590 S=VAL(LEFT$(S$,B))*&E10+VAL(MID$(S$,&4,B))*&3C+VAL(RIGHT$(S$,B))
 4600 E=VAL(LEFT$(E$,B))*&E10+VAL(MID$(E$,&4,B))*&3C+VAL(RIGHT$(E$,B))
 4610 IF S>=E THEN E=E+&15180
 4620 E=E-S:IF E>&176F THEN E=&176F
 4630 R=R+E :'繰越し時間
 4640 RETURN