home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FreeWare Collection 3
/
FreeSoftwareCollection3pd199x-jp.img
/
oh_fm
/
townsfos
/
twfc.bas
< prev
next >
Wrap
BASIC Source File
|
1980-01-02
|
12KB
|
352 lines
10000 '
10010 ' TW-FC : Towns File Creater : By TaroPYON
10020 '
10030 ' TownsFOS 対応 アプリケーション
10040 '
10050 ' Filename "TWFC.BAS"
10060 '
10070 ' Last Update 1989. 5.17 Ver.1.01
10080 '
10090 '
10100 DEFINT A-Z
10110 DIM B(256)
10120 DIM SMX(15),SMY(15)
10130 DIM KASN$(15)
10140 RESTORE *KEY_ASN_TBL : FOR I=0 TO 15 : READ KASN$(I) : NEXT
10150 *KEY_ASN_TBL
10160 DATA "0 ", "1,", "2.", "3/","4kK","5lL", "6;","7iI"
10170 DATA "8oO","9pP","aA-","bB^","cC@","dD[","eE:","fF]"
10180 DEF FNH$(HH,LL)=RIGHT$(STRING$(LL,"0")+HEX$(HH),LL)
10190 '
10200 CP&=0 : MP&=0
10210 CUP$=CHR$(&H1E)+CHR$(&H17):CDW$=CHR$(&H1F)+CHR$(&H18)
10220 CLT$=CHR$(&H1D)+CHR$(&H01):CRT$=CHR$(&H1C)+CHR$(&H04)
10230 CX=0:CY=0
10240 S_GRA%=-1
10250 '
10260 ' 画面初期化
10270 '
10280 COLOR 7,0 : WIDTH 80,25 : CONSOLE 23,2
10290 LOCATE 0,0:PRINT "||||| TW-FC : Towns File Creater : Ver.1.01 |||||";
10300 LOCATE 0,1:PRINT STRING$(80,"-");
10310 LOCATE 0,3:PRINT " OffSet +0 +1 +2 +3 +4 +5 +6 +7 +8 +9 +A +B +C +D +E +F :SM: | A S C I I |";
10320 FOR Y=3 TO 21
10330 LOCATE 31,Y:PRINT "|";:LOCATE 56,Y:PRINT ":";
10340 LOCATE 59,Y:PRINT ":";
10350 NEXT
10360 LOCATE 0,20:PRINT " ";STRING$(79,"-");
10370 LOCATE 4,21:PRINT "SUM";
10380 GOTO *MAIN : 'GOSUB *PUT_1SEC
10390 '
10400 ' INKEY$
10410 '
10420 *KIN : K$="":WHILE K$="":K$=INKEY$:WEND
10430 RETURN
10440 '
10450 ' Clear Key Buffer
10460 '
10470 *KCLR : WHILE INKEY$<>"":WEND
10480 RETURN
10490 '
10500 ' 256バイト表示 : [OF&:オフセット
10510 '
10520 *PUT_1SEC
10530 SUM=0
10540 FOR P1_Y=0 TO 15
10550 P1_L$=RIGHT$("00000"+HEX$(OF&+P1_Y*16),6) : P1_M$=": " : P1_XS=0
10560 FOR P1_X=0 TO 15
10570 P1_A=B(P1_Y*16+P1_X)
10580 P1_L$=P1_L$+" "+RIGHT$("0"+HEX$(P1_A),2)
10590 I=P1_A:GOSUB *CHK_KANA
10600 IF (P1_A>=&H20 AND P1_A<=&H7E) OR R THEN P1_A$=CHR$(P1_A) ELSE P1_A$="・"
10610 P1_M$=P1_M$+P1_A$
10620 P1_XS=(P1_XS+P1_A) AND &HFF
10630 SUM=(SUM+P1_A) AND &HFF
10640 NEXT
10650 MID$(P1_L$,31,1)="|" : SMY(P1_Y)=P1_XS
10660 LOCATE 1,P1_Y+4:PRINT P1_L$+" :"+RIGHT$("0"+HEX$(P1_XS),2)+P1_M$;
10670 NEXT
10680 '
10690 P1_L$=""
10700 FOR P1_X=0 TO 15
10710 P1_YS=0
10720 FOR P1_Y=0 TO 15 : P1_YS=(P1_YS+B(P1_Y*16+P1_X)) AND &HFF : NEXT
10730 P1_L$=P1_L$+" "+RIGHT$("0"+HEX$(P1_YS),2):SMX(P1_X)=P1_YS
10740 NEXT
10750 MID$(P1_L$,25,1)="|"
10760 LOCATE 7,21:PRINT P1_L$+" :"+RIGHT$("0"+HEX$(SUM),2)+":"
10770 RETURN
10780 '
10790 ' CURSOR
10800 '
10810 *CUR_SUB : CU_A=B(CY*16+CX):CU_X=CX*3
10820 LOCATE 1,CY+4:PRINT RIGHT$("00000"+HEX$(CP&+CY*16),6);
10830 LOCATE 8+CU_X,3:PRINT "+"+HEX$(CX);
10840 LOCATE 8+CU_X,4+CY:IF EM THEN PRINT RIGHT$("0"+HEX$(CU_A),2); ELSE IF IL=0 THEN PRINT HEX$(CU_A \ 16); ELSE LOCATE 9+CU_X,4+CY:PRINT HEX$(CU_A AND 15);
10850 LOCATE 8+CU_X,21:PRINT RIGHT$("0"+HEX$(SMX(CX)),2);
10860 LOCATE 57,CY+4:PRINT RIGHT$("0"+HEX$(SMY(CY)),2);
10870 I=CU_A:GOSUB *CHK_KANA
10880 IF (CU_A>=&H20 AND CU_A<=&H7E) OR R THEN CU_A$=CHR$(CU_A) ELSE CU_A$="・"
10890 LOCATE 61+CX,CY+4:PRINT CU_A$;:COLOR 7
10900 LOCATE 57,21:PRINT RIGHT$("0"+HEX$(SUM),2);:RETURN
10910 '
10920 *CUR_ON : COLOR 15 : GOTO *CUR_SUB
10930 *CUR_OFF: COLOR 7 : GOTO *CUR_SUB
10940 '
10950 ' 片仮名コードのチェック : I -> R<>0:KANA
10960 '
10970 *CHK_KANA
10980 IF I>=&HA1 AND I<=&HDF THEN R=-1 ELSE R=0
10990 RETURN
11000 '
11010 ' MAIN ROUTINE
11020 '
11030 *MAIN
11040 IF ARGC%>1 THEN FL$=ARGV$(1):GOTO *MA_1
11050 LOCATE 0,24 : LINE INPUT "Filename ? ",FL$:IF FL$="" THEN *END_EXIT
11060 *MA_1
11070 P=INSTR(FL$,":"):IF P>0 THEN FLR$=LEFT$(FL$,P)+"(1)"+MID$(FL$,P+1) ELSE FLR$="(1)"+FL$
11080 A$="":FOR I=1 TO LEN(FL$):B$=MID$(FL$,I,1):IF B$>="a" AND B$<="z" THEN A$=A$+CHR$(ASC(B$)-&H20) ELSE A$=A$+B$
11090 NEXT:FL$=A$
11100 LOCATE 50,0:PRINT SPC(30);
11110 LOCATE 50,0:PRINT LEFT$("Filename = "+FL$+" =",80-50);
11120 ON ERROR GOTO *ERR_OPEN
11130 OPEN "R",#1,FLR$ : FIELD #1,1 AS W_A$ : ON ERROR GOTO 0
11140 MP&=LOF(1) : CP&=(MP& AND &HFFFF00)
11150 '
11160 *PUT_AND_EDIT
11170 CLS 1:PRINT "Reading ...";
11180 LOCATE 61,21:PRINT "FileSize $";RIGHT$("00000"+HEX$(MP&),6);
11190 OF&=CP&
11200 FOR I=0 TO 255
11210 IF MP&>(CP&+I) THEN GET #1,CP&+I+1:A$=W_A$:B(I)=ASC(A$) ELSE B(I)=0
11220 NEXT
11230 GOSUB *PUT_1SEC
11240 GOTO *EDIT_PART
11250 '
11260 ' ERROR
11270 '
11280 *ERR_OPEN
11290 CLS 1 : PRINT "@@ Open Error : ";
11300 IF ARGC% THEN S_ERR%=ERR : RETURN *S_T_RETURN
11310 PRINT " Error #";ERR; : RESUME *MAIN
11320 '
11330 ' EDIT
11340 '
11350 *EDIT_PART
11360 CLS 1
11370 PRINT " Command [+,N:+256bytes [-,B:-256byte [S:Select [E:Exit"
11380 PRINT " [ESC,H:Edit(hex) [A:Edit(Ascii) [C:Clear";
11390 *EDP_1 : GOSUB *KCLR : GOSUB *KIN
11400 IF INSTR(";+nN"+CDW$,K$) THEN *MV_NEXT
11410 IF INSTR("-=bB"+CUP$,K$) THEN *MV_BEFR
11420 IF INSTR("sS",K$) THEN *MV_SELECT
11430 IF INSTR("uU",K$) THEN *UNDO
11440 IF INSTR("eE",K$) THEN *EXIT
11450 IF INSTR("hH"+CHR$(27),K$) THEN EM=0:GOTO *F_EDIT
11460 IF INSTR("aA",K$) THEN EM=1:GOTO *F_EDIT
11470 IF INSTR("cC",K$) THEN *E_CLEAR
11480 I=ASC(K$):GOSUB *CHK_KANA:IF R THEN GOSUB *KANA_CUT:GOTO *EDIT_PART
11490 GOTO *EDP_1
11500 '
11510 ' EXIT
11520 '
11530 *EXIT
11540 CLS 1:PRINT "作業を終了しますか? (Y/N) ";:GOSUB *KCLR
11550 *EX_1:GOSUB *KIN : IF INSTR("YyNn",K$)=0 THEN *EX_1
11560 IF K$="n" OR K$="N" THEN *EDIT_PART
11570 CLOSE
11580 *END_EXIT
11590 IF ARGC% THEN RETURN
11600 WIDTH : LOCATE 25,3 : PRINT "*** TW-FC : Good Bye.... ****"
11610 END
11620 '
11630 ' Pointer Move Next Block
11640 '
11650 *MV_NEXT
11660 MP&=LOF(1):CP&=CP& AND &HFFFF00
11670 IF MP&<=(CP&+256) THEN *MVN_1
11680 CP&=CP&+256:
11690 GOTO *PUT_AND_EDIT
11700 *MVN_1
11710 CLS 1:PRINT "Working..."
11720 FOR I=0 TO 255:B(I)=0:NEXT
11730 CP&=CP&+256:OF&=CP&
11740 GOSUB *PUT_1SEC
11750 GOTO *EDIT_PART
11760 '
11770 ' Pointer Move Before Block
11780 '
11790 *MV_BEFR
11800 MP&=LOF(1):CP&=CP& AND &HFFFF00
11810 IF CP&<256 THEN *EDIT_PART
11820 CP&=CP&-256
11830 GOTO *PUT_AND_EDIT
11840 '
11850 ' Pointer Move
11860 '
11870 *MV_SELECT
11880 CLS 1
11890 LOCATE 0,24:INPUT "Move Pointer ? $",A$
11900 P&=VAL("&H"+A$):IF INSTR(A$,"0")=0 AND P&=0 THEN *EDIT_PART
11910 Q=P& AND &HFF:P&=P& AND &HFFFF00
11920 IF MP&<=P& THEN *MVS_1
11930 CX=Q AND 15 : CY=Q \ 16 : IF CP&<>P& THEN CP&=P& ELSE *EDIT_PART
11940 GOTO *PUT_AND_EDIT
11950 *MVS_1
11960 CLS 1:PRINT "指定位置は($";FNH$(P&,6);
11970 PRINT ")はファイルサイズを($";FNH$(MP&,6);")を越えています。"
11980 PRINT "この位置に移動してよいですか? (Y/N)";
11990 *MVS_2 : GOSUB *KIN
12000 IF INSTR("yYnN",K$)=0 THEN *MVS_2
12010 IF K$="n" OR K$="N" THEN *EDIT_PART
12020 CP&=P& : CX=Q AND 15 : CY=Q \ 16
12030 GOTO *PUT_AND_EDIT
12040 '
12050 ' Clear
12060 '
12070 *E_CLEAR
12080 CLS 1:PRINT "* 消去する範囲は"
12090 PRINT " [1:表示中の256バイト [2:指定の範囲 [Q:中止 ?";
12100 *ECL_1 : GOSUB *KCLR : GOSUB *KIN
12110 IF INSTR("12qQ",K$)=0 THEN *ECL_1
12120 IF K$="q" OR K$="Q" THEN *EDIT_PART
12130 IF K$="2" THEN *ECL_2
12140 IF CP&>=MP& THEN *EDIT_PART
12150 CLS 1 : PRINT "Working...";
12160 IF (CP& \ 256)=(MP& \ 256) THEN M=(MP&-1) AND &HFF ELSE M=255
12170 FOR I=0 TO M : LSET W_A$=CHR$(0) : PUT #1,CP&+I+1 : NEXT""
12180 GOTO *PUT_AND_EDIT
12190 *ECL_2
12200 CLS 1:LOCATE 0,24 : INPUT "消去範囲の開始位置は? $",A$: IF A$="" THEN *EDIT_PART
12210 S&=VAL("&H"+A$):IF INSTR("0",A$)=0 AND S&=0 THEN *EDIT_PART
12220 CLS 1:LOCATE 0,24 : INPUT "消去範囲の終了位置は? $",A$: IF A$="" THEN *EDIT_PART
12230 E&=VAL("&H"+A$):IF (INSTR("0",A$)=0 AND E&=0) OR S&>=E& THEN *EDIT_PART
12240 CLS 1:PRINT "消去範囲 $";FNH$(S&,6);" から $";FNH$(E&,6);"まで"
12250 PRINT "消去してもよろしいですか? (Y/N) ";
12260 *ECL_3:GOSUB *KCLR : GOSUB *KIN
12270 IF INSTR("yYnN",K$)=0 THEN *ECL_3
12280 IF K$="n" OR K$="N" THEN *EDIT_PART
12290 CLS 1:PRINT "Working...";
12300 FOR I&=S& TO E& : LSET W_A$=CHR$(0) : PUT #1,I&+1 : NEXT
12310 GOTO *PUT_AND_EDIT
12320 '
12330 ' INPUT PART
12340 '
12350 *F_EDIT:IL=0:IN_MAX&=CP&-1 '書換えのあった最大のポインタ
12360 *ED_TOP
12370 IF EM THEN A$="(ASC)" ELSE A$="(HEX)"
12380 CLS 1:PRINT A$+"Edit: [TAB:Change Input Mode [ESC:Command"
12390 PRINT " [BS: [HOME: [RET:";
12400 *ED_1:K$=""
12410 GOSUB *CUR_ON : GOSUB *KIN : GOSUB *CUR_OFF
12420 IF EM THEN *ED_3 ELSE A=-1
12430 FOR I=0 TO 15
12440 IF INSTR(KASN$(I),K$) THEN A=I
12450 NEXT : IF A<>-1 THEN I=A:GOTO *SET_HEX
12460 *ED_3
12470 IF INSTR(CUP$,K$) THEN IL=0:CY=CY-1:GOTO *ED_2
12480 IF INSTR(CDW$,K$) THEN IL=0:CY=CY+1:GOTO *ED_2
12490 IF INSTR(CLT$,K$) THEN IL=0:CX=CX-1:GOTO *ED_2
12500 IF INSTR(CRT$,K$) THEN IL=0:CX=CX+1:GOTO *ED_2
12510 IF K$=CHR$(8) THEN *E_BS
12520 IF K$=CHR$(13) THEN IL=0:CY=CY+1:CX=0:GOTO *ED_2
12530 IF K$=CHR$(9) THEN IL=0:EM=(EM+1) AND 1:GOTO *F_EDIT 'TAB
12540 IF K$=CHR$(11) THEN CX=0 : CY=0: GOTO *ED_1 : 'HOME
12550 IF K$=CHR$(27) THEN *E_ESC
12560 IF EM THEN I=ASC(K$):GOTO *SET_ANK
12570 I=ASC(K$):GOSUB *CHK_KANA:IF EM=0 AND R THEN GOSUB *KANA_CUT:GOTO *ED_TOP
12580 GOTO *ED_1
12590 '
12600 *ED_2
12610 IF CX<0 THEN IF CY=0 THEN CX=0 ELSE CY=CY-1:CX=15
12620 IF CX>15 THEN IF CY=15 THEN CX=15 ELSE CY=CY+1:CX=0
12630 IF CY<0 THEN CY=0
12640 IF CY>15 THEN CY=15
12650 WHILE INKEY$<>"":WEND
12660 GOTO *ED_1
12670 '
12680 *KANA_CUT
12690 CLS 1:PRINT "入力がカタカナになっています。英数モードにしてください。"
12700 PRINT SPC(16);"*** 何かキーを押してください。 ***";
12710 GOSUB *KCLR : GOSUB *KIN
12720 RETURN
12730 '
12740 ' Return Command mode
12750 '
12760 *E_ESC : MP&=LOF(1)
12770 IF IN_MAX&<CP& THEN *EDIT_PART
12780 CLS 1:PRINT "Writing...";
12790 IF (MP& \ 256)<>(CP& \ 256) AND IN_MAX&<MP& THEN M=255 ELSE GOSUB *E_ESC_M
12800 FOR I=0 TO M
12810 LSET W_A$=CHR$(B(I)) : PUT #1,CP&+I+1
12820 NEXT
12830 MP&=LOF(1):LOCATE 71,21:PRINT FNH$(MP&,6);
12840 GOTO *EDIT_PART
12850 '
12860 *E_ESC_M
12870 IF MP&=0 THEN S&=0 ELSE S&=MP&-1
12880 FOR P&=S& TO IN_MAX& : LSET W_A$=CHR$(0):PUT #1,P&+1 : NEXT
12890 M=IN_MAX& AND &HFF
12900 RETURN
12910 '
12920 ' SET HEX MODE
12930 '
12940 *SET_HEX
12950 P=CY*16+CX : A=B(P) : SUM=SUM+256 : SX=SMX(CX)+256 : SY=SMY(CY)+256
12960 IF IL THEN *SET_H_1
12970 I=I*16 : H=I-(A AND &HF0) : SUM=SUM+H : SX=SX+H : SY=SY+H
12980 A=(A AND &H0F)+I
12990 GOTO *SET_H_2
13000 *SET_H_1
13010 L=I-(A AND &H0F) : SUM=SUM+L : SX=SX+L : SY=SY+L
13020 A=(A AND &HF0)+I
13030 *SET_H_2
13040 IF (CP&+P)>IN_MAX& THEN IN_MAX&=CP&+P
13050 B(P)=A : SUM=SUM AND &HFF: SMX(CX)=SX AND &HFF: SMY(CY)=SY AND &HFF
13060 EM=1:GOSUB *CUR_OFF:EM=0
13070 IF IL=0 THEN IL=1:GOTO *ED_1
13080 *SET_RET
13090 CX=CX+1
13100 IF CX>15 THEN CY=CY+1:IF CY>15 THEN CY=15:CX=15 ELSE CX=0
13110 IL=0
13120 GOTO *ED_1
13130 '
13140 ' SET ANK MODE
13150 '
13160 *SET_ANK
13170 P=CY*16+CX : A=B(P): B(P)=I
13180 IF (CP&+P)>IN_MAX& THEN IN_MAX&=CP&+P
13190 F=256-A+I:SUM=(SUM+F) AND &HFF
13200 SMX(CX)=(SMX(CX)+F) AND &HFF : SMY(CY)=(SMY(CY)+F) AND &HFF
13210 GOSUB *CUR_OFF
13220 GOTO *SET_RET
13230 '
13240 ' BS
13250 '
13260 *E_BS
13270 SUM=SUM+256
13280 IF EM THEN *E_BS_ANK
13290 IF IL THEN *E_BS_L
13300 IF CX=0 AND CY=0 THEN *ED_1
13310 CX=CX-1:IF CX<0 THEN CX=15:CY=CY-1
13320 P=CY*16+CX : A=B(P) :SX=SMX(CX)+256 : SY=SMY(CY)+256
13330 L=A AND &H0F:SUM=SUM-L:SX=SX-L:SY=SY-L
13340 A=A AND &HF0:IL=1
13350 GOTO *E_BS_RET
13360 *E_BS_L
13370 P=CY*16+CX : A=B(P) : SX=SMX(CX)+256 : SY=SMY(CY)+256
13380 H=A AND &HF0:SUM=SUM-H:SX=SX-H:SY=SY-H
13390 A=A AND &H0F:IL=0
13400 GOTO *E_BS_RET
13410 *E_BS_ANK
13420 IF CX=0 AND CY=0 THEN *ED_1
13430 CX=CX-1:IF CX<0 THEN CX=15:CY=CY-1
13440 P=CY*16+CX : A=B(P) : SX=SMX(CX)+256 : SY=SMY(CY)+256
13450 SUM=SUM-A : SX=SX-A : SY=SY-A
13460 A=0
13470 *E_BS_RET
13480 B(P)=A : SUM=SUM AND &HFF : SMX(CX)=SX AND &HFF : SMY(CY)=SY AND &HFF
13490 A=EM : GOSUB *CUR_OFF : EM=A
13500 GOTO *ED_1