1000 '************************************************************************* 1010 '* Ｍａｋｅ　ＣＨＲ Version 2.03 2000.09.24. * 1020 '* Copyright (C) Takashi Utsunomiya 作成開始 1996. * 1030 '************************************************************************* 1040 ' 内容: キャラクタ作成・編集ソフト 1050 '************************************************************************* 1060 : 1070 SCREEN 3,0,0,1:WIDTH 80,25:CONSOLE 0,25,0,1,0:COLOR 7,0,0,7,2:MOUSE 0 1080 DEFINT A-Z:CLS 3 1090 : 1100 DIM G[15361] '画像処理用（320*192ﾄﾞｯﾄ） 1110 DIM FLNO,FLMAX '編集中のﾌｧｲﾙ番号,開いているﾌｧｲﾙ数 1120 DIM FL$[99]:FL$[0]="NEWFILE .BMP" 'ﾌｧｲﾙ名（fl$[0]は必ず大文字で１２文字） 1130 DIM MP,MP[79,24] '画面上のﾎﾞﾀﾝ関係 1140 DIM SZX,SZY:SZX=32:SZY=32 'ｷｬﾗのｻｲｽﾞ 1150 DIM LNX,LNY,DT,MAS 'ｷｬﾗのｻｲｽﾞ関係 1160 DIM CX1,CY1,CX1B,CY1B,CSX,CSY 'ｶｰｿﾙ位置関係 1170 DIM MX,MY,ML,MR 'ﾏｳｽ関係 1180 DIM MC[1]:MC[0]=7 'ﾍﾟﾝの色 1190 DIM TMPDRV$:TMPDRV$="" '作業用ﾄﾞﾗｲﾌﾞ（ＨＤを指定） 1200 DIM TF$:TF$=TMPDRV$+"tf.tmp" '作業用ﾌｧｲﾙ 1210 DIM TF1$:TF1$=TMPDRV$+"tf1.tmp" '作業用ﾌｧｲﾙ 1220 DIM ASKF$:ASKF$="mkbmp.bas" '自己解凍機能付圧縮ﾌｧｲﾙ名 1230 DIM ASK$,C[15],ASK,A[15] '圧縮用（文字ﾃｰﾌﾞﾙ,ﾊﾟﾚｯﾄ,圧縮の種類） 1240 DIM DQ$:DQ$=CHR$(&H22) 'ﾀﾞﾌﾞﾙｸｫｰﾃｰｼｮﾝ 1250 : 1260 FOR I=0 TO 3:READ A$,B$ '文字ﾃｰﾌﾞﾙ ｾｯﾄ 1270 FOR J=VAL("&H"+A$) TO VAL("&H"+B$) 1280 ASK$=ASK$+CHR$(J) 1290 NEXT J,I :DATA 2d,7e,23,2b,b1,df,a1,af 1300 *START '-------------- 直前処理 1310 GOSUB *SCR 1320 GOSUB *SIZE1 1330 GOSUB *SAVE.TEMP 1340 ON STOP GOSUB *STOP.:STOP ON 1350 MOUSE 1,,,1 1360 *MAIN '============== 主動部 1370 GOSUB *WA:WHILE ML=MR:GOSUB *IN:WEND 1380 MP=MP[MX\8,MY\16]-2:ON -(MP<0) GOTO *MAIN 1390 A=MP\5:B=MP-A*5+1:MOUSE 1,,,0 1400 ON A+1 GOSUB 1420,1430,1440,1450,1460:GOTO 1480 1410 : 1420 ON B GOSUB *WIN0 ,*WIN1 :RETURN 1430 ON B GOSUB *YOBIDASI,*HOZON ,*SIZE ,*SEND0 ,*SEND1 :RETURN 1440 ON B GOSUB *SEND2 ,*FL.REW,*FL.FF,*COL ,*CL :RETURN 1450 ON B GOSUB *KAITEN ,*HANTEN,*SH.LR,*SH.LR ,*SH.UD :RETURN 1460 ON B GOSUB *SH.UD :RETURN 1470 : 1480 MOUSE 1,,,1:GOTO *MAIN 1490 *SCR '============== 基本画面描画 1500 LINE(0,0)-(639,399),15,BF:RESTORE *SCR.DATA:A$="" 1510 WHILE A$<>"*" 1520 READ A$:IF A$="*" THEN 1560 1530 X1=VAL(A$):READ Y1,X2,Y2,NO 1540 FOR Y=Y1 TO Y2-1:FOR X=X1 TO X2-1:MP[X,Y]=NO:NEXT X,Y 1550 GOSUB *BOX 1560 WEND 1570 FOR I=0 TO 15:LINE(80+(I MOD 8)*16,32-(I\8)*16)-STEP(15,15),I,BF:NEXT 1580 LINE(304,64)-STEP(319,191),0,BF 1590 LINE(224,64)-STEP( 63, 63),0,BF 1600 GOSUB *SEND1 1610 *SCR1 '-------------- 基本画面描画１ 1620 LOCATE 29, 0:COLOR 4:PRINT"Ｍake ＣHR by T.U";:COLOR 7 1630 LOCATE 68, 1:PRINT"画像 画像"; 1640 LOCATE 68, 2:PRINT"読込 保存"; 1650 LOCATE 28, 9:PRINT"←→↑↓"; 1660 LOCATE 28,11:PRINT" → →"; 1670 LOCATE 28,13:PRINT"← ← "; 1680 LOCATE 28,15:PRINT"←重合せ"; 1690 LOCATE 2,17:PRINT"＊ Φ ← → ↑ ↓"; 1700 LOCATE 3,19:PRINT" - 描画時 -"; 1710 LOCATE 3,20:PRINT"[SHIFT]+ 太筆"; 1720 LOCATE 3,21:PRINT"[CTRL]+ 塗る"; 1730 LOCATE 3,22:PRINT"[GRPH]+ 色取得"; 1740 LOCATE 30,19:PRINT" - その他 -"; 1750 LOCATE 30,20:PRINT"[SHIFT]+「画像保存」 自己解凍機能付圧縮保存"; 1760 GOSUB *KAKU 1770 RETURN 1780 *KAKU '-------------- 1790 FOR I=0 TO 1:LINE(16+I*32,16)-STEP(15,31),MC[I],BF:NEXT 1800 GOSUB *CSR.DRW 1810 LOCATE 32, 2:PRINT FL$[FLNO]; 1820 LOCATE 28, 2:PRINT MID$(" ←",1-2*(FLNO>0),2); 1830 LOCATE 46, 2:PRINT MID$(" →",1-2*(FLNO=SZX OR MY>=SZY) GOTO 2030 1920 : 1930 IF GR THEN MC[MR]=POINT(224+MX,64+MY):GOSUB *KAKU:RETURN 1940 IF CT THEN GOSUB *PAINT.:RETURN 1950 : 1960 FOR Y=0 TO SH:FOR X=0 TO SH 1970 V=MX-X:W=MY-Y 1980 ON -(V<0 OR V>=SZX OR W<0 OR W=>SZY) GOTO 2010 1990 PSET(224+V,64+W),CL 2000 LINE(16+V*DT,64+W*DT)-STEP(DT-1+MAS,DT-1+MAS),MAS*15-(MAS=0)*CL,BF,CL 2010 NEXT X,Y 2020 : 2030 MOUSE 1,,,1:GOSUB *IN:IF ML=0 AND MR=0 THEN RETURN 2040 GOTO *WIN0 2050 *PAINT. '-------------- 塗る 2060 A$=CHR$(MX)+CHR$(MY):B$="":C1=POINT(224+MX,64+MY) 2070 IF CL=C1 THEN RETURN 2080 PSET(224+MX,64+MY),CL 2090 GOSUB 2110:GOSUB *TARGET :RETURN 2100 : 2110 WHILE A$>"" 2120 X=ASC(A$):A$=MID$(A$,2) 2130 Y=ASC(A$):A$=MID$(A$,2) 2140 FOR I=0 TO 3 2150 V=X+VAL(MID$("1021",I+1,1))-1 2160 W=Y+VAL(MID$("0112",I+1,1))-1 2170 ON -(V<0 OR V>=SZX OR W<0 OR W>=SZY) GOTO 2210 2180 ON -(POINT(224+V,64+W)<>C1) GOTO 2210 2190 PSET(224+V,64+W),CL 2200 B$=B$+CHR$(V)+CHR$(W) 2210 NEXT 2220 WEND:A$=B$:B$="":ON -(A$>"") GOTO 2110 2230 RETURN 2240 *COL '-------------- 色変更 2250 MC[MR]=8+(MX-80)\16 MOD 8-((MY-16)\16)*8:GOSUB *KAKU :RETURN 2260 *CL '-------------- 消去 2270 LINE(224,64)-STEP(63,63),0,BF:GOSUB *TARGET :RETURN 2280 *KAITEN '-------------- ９０°回転 2290 FOR Y=0 TO SZY-1:FOR X=0 TO SZX-1 2300 OUT &HA6,0:A=POINT(224+X,64+Y) 2310 OUT &HA6,1:PSET(Y,SZX-1-X),A 2320 NEXT X,Y 2330 SWAP SZX,SZY 2340 OUT &HA6,0:LINE(16,64)-STEP(191,191),8,BF:LINE(224,64)-STEP(63,63),0,BF 2350 OUT &HA6,1:GET@(0,0)-STEP(SZX-1,SZY-1),G 2360 OUT &HA6,0:PUT@(224,64),G,PSET 2370 GOSUB *TARGET:GOSUB *KAKU :RETURN 2380 *HANTEN '-------------- 左右反転 2390 FOR X=0 TO SZX-1 2400 GET@(224+X,64)-STEP(0,SZY-1),G[X*200] 2410 NEXT 2420 FOR X=0 TO SZX-1:PUT@(224+SZX-1-X,64),G[X*200],PSET:NEXT 2430 GOSUB *TARGET :RETURN 2440 *SH.LR '-------------- スライド（左右） 2450 LR=(MP=17)-(MP=18) 2460 FOR X=0 TO SZX-1:GET@(224+X,64)-STEP(0,SZY-1),G[X*200]:NEXT 2470 FOR X=0 TO SZX-1:PUT@(224+(X+SZX+LR)MOD SZX,64),G[X*200],PSET:NEXT 2480 GOSUB *TARGET :RETURN 2490 *SH.UD '-------------- スライド（上下） 2500 UD=(MP=19)-(MP=20) 2510 FOR Y=0 TO SZY-1:GET@(224,64+Y)-STEP(SZX-1,0),G[Y*200]:NEXT 2520 FOR Y=0 TO SZY-1:PUT@(224,64+(Y+SZY+UD)MOD SZY),G[Y*200],PSET:NEXT 2530 GOSUB *TARGET :RETURN 2540 *WIN1 '============== 窓１が押された！ 2550 X=(MX-304)\SZX:Y=(MY-64)\SZY:IF X>=LNX OR Y>=LNY THEN RETURN 2560 CX1=X:CY1=Y:GOSUB *KAKU :RETURN 2570 *CSR.DRW '-------------- カーソル描画 2580 FOR I=0 TO 1 2590 IF I=0 THEN X=CX1B:Y=CY1B:V=CSX:W=CSY ELSE X=CX1:Y=CY1:V=SZX:W=SZY 2600 X1=36+ X *(V\16)*2:Y1=3+ Y *(W\16) 2610 X2=38+(X+1)*(V\16)*2:Y2=4+(Y+1)*(W\16) 2620 LOCATE X1,Y1:PRINT MID$(" ｱ",I*2+1,2); 2630 LOCATE X2,Y1:PRINT MID$(" ｵ",I*2+1,2); 2640 LOCATE X1,Y2:PRINT MID$(" ｹ",I*2+1,2); 2650 LOCATE X2,Y2:PRINT MID$(" ｽ",I*2+1,2); 2660 NEXT 2670 CX1B=CX1:CY1B=CY1:CSX=SZX:CSY=SZY '古い位置、ｻｲｽﾞを保存 2680 RETURN 2690 *SEND0 '============== 窓０から窓１へ 2700 GET@(224,64)-STEP(SZX-1,SZY-1),G 2710 PUT@(304+CX1*SZX,64+CY1*SZY),G,PSET :RETURN 2720 *SEND1 '-------------- 窓１から窓０へ 2730 GET@(304+CX1*SZX,64+CY1*SZY)-STEP(SZX-1,SZY-1),G 2740 PUT@(224,64),G,PSET 2750 GOSUB *TARGET :RETURN 2760 *SEND2 '-------------- 窓１から窓０へ（重ね合せ） 2770 V=304+CX1*SZX:W=64+CY1*SZY 2780 FOR Y=0 TO SZY-1:FOR X=0 TO SZX-1 2790 A=POINT(V+X,W+Y):ON -(A=0) GOTO 2810 2800 PSET(224+X,64+Y),A 2810 NEXT X,Y 2820 GOSUB *TARGET :RETURN 2830 *TARGET '============== 拡大表示 2840 FOR Y=0 TO SZY-1:FOR X=0 TO SZX-1 2850 A=POINT(224+X,64+Y) 2860 LINE(16+X*DT,64+Y*DT)-STEP(DT-1+MAS,DT-1+MAS),MAS*15-(MAS=0)*A,BF,A 2870 NEXT X,Y :RETURN 2880 *SIZE '============== サイズ変更 2890 FOR I=0 TO 4:A[I]=VAL(MID$("1624324864",I*2+1,2)):NEXT 2900 ON 1+(MX-224)\16 GOSUB 2930,2940,2950,2960 2910 GOSUB *SIZE1:CX1=0:CY1=0:GOSUB *KAKU :RETURN 2920 : 2930 A=4:WHILE A>0 AND SZX<=A[A]:A=A-1:WEND:SZX=A[A]:RETURN 2940 A=0:WHILE A<4 AND SZX>=A[A]:A=A+1:WEND:SZX=A[A]:RETURN 2950 A=4:WHILE A>0 AND SZY<=A[A]:A=A-1:WEND:SZY=A[A]:RETURN 2960 A=0:WHILE A<4 AND SZY>=A[A]:A=A+1:WEND:SZY=A[A]:RETURN 2970 *SIZE1 '-------------- マス目幅決定 ＆ 描画 2980 LNX=320\SZX:LNY=192\SZY 2990 DT=192\SZX:IF SZX=6) 3010 : 3020 LINE(16,64)-STEP(191,191),8,BF 3030 GET@(224,64)-STEP(SZX-1,SZY-1),G 3040 LINE(224,64)-STEP(63,63),0,BF 3050 PUT@(224,64),G,PSET 3060 GOSUB *TARGET :RETURN 3070 *IN '============== マウスの情報取得 3080 MX=MOUSE(0):MY=MOUSE(1):ML=MOUSE(2,1):MR=MOUSE(2,2) :RETURN 3090 *WA '-------------- マウスのボタン押下間ウェイト 3100 ML=1:WHILE ML+MR:GOSUB *IN:WEND :RETURN 3110 *TOKUSHU '============== 特殊キーの押下情報取得 3120 A=INP(&HE8) 3130 SH=-((A AND 64)=0) '[SHIFT] 3140 CT=-((A AND 128)=0) '[CTRL] 3150 GR=-((A AND 16)=0) '[GRPH] 3160 RETURN 3170 *HOZON '============== 画像保存 3180 GOSUB *TOKUSHU 3190 ON 1+SH GOSUB *SAVE.BMP,*SAVE.ASK :RETURN 3200 *LNG '-------------- 画像ｻｲｽﾞ計測 3210 A=0:X=320 3220 WHILE A=0 AND X>0:X=X-1 3230 FOR I=0 TO 191:A=A OR POINT(304+X,64+I):NEXT 3240 WEND:X=X+1 3250 A=0:Y=192 3260 WHILE A=0 AND Y>0:Y=Y-1 3270 FOR I=0 TO X-1:A=A OR POINT(304+I,64+Y):NEXT 3280 WEND:Y=Y+1 :RETURN 3290 *SAVE.BMP '============== 通常保存 3300 GOSUB *LNG 3310 GET@(304,64)-STEP(X-1,Y-1),G 3320 A=((((X+7)\8)*Y*4+4)+1)\2 3330 MID$(FL$[FLNO],10,3)="BMP" 3340 DEF SEG=VARPTR(G%[0],1):BSAVE FL$[FLNO],0,A*2 :RETURN 3350 *SAVE.ASK '============== 圧縮保存 3360 SAVE TF$,A '解凍ﾙｰﾁﾝのｺﾋﾟｰ 3370 OPEN TF$ FOR INPUT AS#1 3380 OPEN ASKF$ FOR OUTPUT AS#2 3390 WHILE INSTR(A$,"*MKBMP")=0 OR MID$(A$,6,1)<>"*":LINE INPUT#1,A$:WEND 3400 PRINT#2,A$:WHILE INSTR(A$,"DEF SEG")=0:LINE INPUT#1,A$:PRINT#2,A$:WEND 3410 CLOSE 3420 : 3430 GOSUB *LNG 3440 FOR I=0 TO 15:A[I]=I:C[I]=0:NEXT:C=1 'ﾊﾟﾚｯﾄ並べ替え 3450 FOR I=0 TO Y-1:FOR J=0 TO X-1 3460 A=POINT(304+J,64+I):C[A]=C[A]+1:C=C-(C[A]=1) 3470 NEXT J,I 3480 ASK=-(C>12) '13色以上か 3490 FOR I=0 TO 14:FOR J=I+1 TO 15 3500 IF C[I]-1 3640 A1$=INPUT$(1,#1) 3650 IF EOF(#1)<>-1 THEN A2$=INPUT$(1,#1) ELSE A2$=CHR$(&H2D) 3660 PRINT#2,MID$(ASK$,ASC(A1$)-&H2D+(ASC(A2$)-&H2D)*12+1,1); 3670 WEND:CLOSE:KILL TF$:NAME TF1$ AS TF$ 3680 : 3690 OPEN TF$ FOR INPUT AS#1 'ﾗﾝﾚﾝｸﾞｽ圧縮 3700 OPEN ASKF$ FOR APPEND AS#2 3710 PRINT#2,"7000 *bmp.data '==============" 3720 PRINT#2,"7010 data"+STR$(ASK)+","+STR$(X)+","+STR$(Y); 3730 LN=7020:LC=0:BOUT$="":BIN$="" :IF ASK THEN PRINT#2,"":GOTO 3760 3740 PRINT#2,",";:FOR I=0 TO 15:PRINT#2,HEX$(C[I]);:NEXT:PRINT#2,"" 3750 : 3760 GOSUB *BIN:A1$=MID$(BIN$,1,1) '最初の１回 3770 GOSUB *BIN:A2$=MID$(BIN$,2,1) 3780 GOSUB *BIN:A3$=MID$(BIN$,3,1) 3790 ON 1-(A1$<>A3$ OR A1$<>A3$) GOSUB *ONAJI,*TIGAU 3800 : 3810 WHILE EOF(#1)<>-1 OR A1$<>"" '２回目以降 3820 ON 1-(A1$<>A2$ OR A1$<>A3$) GOSUB *ONAJI,*TIGAU 3830 WEND 3840 BOUT$=CHR$(0):GOSUB *BOUT '書き込み終了 3850 CLOSE:KILL TF$ :RETURN 3860 *ONAJI '-------------- 3870 LNG=2 3880 WHILE A1$=A3$ AND LNG<100+2 3890 LNG=LNG+1 3900 GOSUB *BIN:A3$=MID$(BIN$,LNG+1,1) 3910 WEND 3920 BOUT$=MID$(ASK$,53+LNG-2,1)+A1$:GOSUB *BOUT 3930 BIN$=MID$(BIN$,LNG+1):A1$=MID$(BIN$,1,1) 3940 GOSUB *BIN:A2$=MID$(BIN$,2,1) 3950 GOSUB *BIN:A3$=MID$(BIN$,3,1) :RETURN 3960 *TIGAU '-------------- 3970 LNG=0 3980 WHILE (A1$<>A2$ OR A1$<>A3$) AND LNG<53 3990 LNG=LNG+1 4000 A1$=A2$:A2$=A3$:GOSUB *BIN:A3$=MID$(BIN$,LNG+3,1) 4010 WEND 4020 BOUT$=MID$(ASK$,LNG,1)+MID$(BIN$,1,LNG):GOSUB *BOUT 4030 BIN$=MID$(BIN$,LNG+1) :RETURN 4040 *BIN '-------------- 4050 IF EOF(#1)<>-1 THEN BIN$=BIN$+INPUT$(1,#1) 4060 RETURN 4070 *BOUT '-------------- 4080 WHILE BOUT$>"" 4090 A$=MID$(BOUT$,1,1):BOUT$=MID$(BOUT$,2) 4100 IF LC=0 THEN PRINT#2,MID$(STR$(LN),2)+" data"+DQ$;:SUM=0:LN=LN+10:LC=10 4110 B$="":IF A$=CHR$(0) THEN B$=",":GOTO 4130 'ｴﾝﾄﾞ 4120 PRINT#2,A$;:SUM=((SUM+LC-10)XOR ASC(A$))AND &H3F:LC=LC+1 4130 IF LC=76 OR A$=CHR$(0) THEN PRINT#2,CHR$(&H2D+SUM)+DQ$+B$:LC=0 4140 WEND :RETURN 4150 *MKBMP '============== 画像作成 4160 SCREEN 3,0,0,1:WIDTH 80,25:CONSOLE 0,25,0,1,0:COLOR 7,0,0,7,2:CLS 3 4170 DEFINT A-Z:DIM C[15]:TF$="tf.tmp":TF1$="tf1.tmp":FL$="a.bmp":LN=7000 '<-- 4180 FOR I=0 TO 3:READ A1$,A2$:FOR J=VAL("&H"+A1$) TO VAL("&H"+A2$) 4190 ASK$=ASK$+CHR$(J):NEXT J,I :DATA 2d,7e,23,2b,b1,df,a1,af 4200 : 4210 READ ASK,X,Y:IF ASK THEN 4230 4220 READ A$:FOR I=15 TO 0 STEP -1:C[VAL("&H"+MID$(A$,I+1,1))]=I:NEXT 4230 OPEN TF$ FOR OUTPUT AS#1:A$="*" 'ﾃﾞｰﾀﾁｪｯｸ & ﾌｧｲﾙへ書き出し 4240 WHILE A$<>"":READ A$:IF A$="" THEN 4280 4250 S=0:SUM=ASC(RIGHT$(A$,1))-&H2D:A$=MID$(A$,1,LEN(A$)-1) 4260 FOR I=0 TO LEN(A$)-1:S=((S+I)XOR ASC(MID$(A$,I+1,1)))AND &H3F:NEXT 4270 PRINT#1,A$;:LN=LN+10:IF S<>SUM THEN PRINT"ERROR IN"+STR$(LN+10):END 4280 WEND:CLOSE#1 4290 : 4300 OPEN TF$ FOR INPUT AS#1:OPEN TF1$ FOR OUTPUT AS#2 '展開１ 4310 WHILE EOF(#1)<>-1:A=INSTR(ASK$,INPUT$(1,#1)):B=-(A>53):A=A-53*B 4320 IF B THEN PRINT#2,STRING$(A+2,INPUT$(1,#1)); ELSE PRINT#2,INPUT$(A,#1); 4330 WEND:CLOSE :IF ASK THEN 4400 ELSE KILL TF$:NAME TF1$ AS TF$ 4340 : 4350 OPEN TF$ FOR INPUT AS#1:OPEN TF1$ FOR OUTPUT AS#2 '展開２ 4360 WHILE EOF(#1)<>-1:A=INSTR(ASK$,INPUT$(1,#1))-1 4370 PRINT#2,CHR$(A MOD 12+&H2D);:PRINT#2,CHR$(A\12+&H2D); 4380 WEND:CLOSE 4390 : 4400 OPEN TF1$ FOR INPUT AS#1 '画像ﾌｧｲﾙ復元 4410 FOR I=0 TO Y-1:FOR J=0 TO X-1:PSET(J,I),C[ASC(INPUT$(1,#1))-&H2D] 4420 NEXT J,I:CLOSE:A=((((X+7)\8)*Y*4+4)+1)\2:DIM G[A-1]:GET@(0,0)-(X-1,Y-1),G 4430 DEF SEG=VARPTR(G%[0],1):BSAVE FL$,0,A*2:KILL TF$:KILL TF1$ :END 4440 *YOBIDASI '============== 画像呼出 4450 IF FLMAX+1>99 THEN RETURN 4460 GOSUB *SAVE.TEMP '現在編集中のﾌｧｲﾙを保存 4470 DEF SEG=&HA000:OUT &HA6,1:CLS 3:OUT &HA4,1 4480 : 4490 CLS:FILES"*.bmp":FILES"*.b" 4500 GOSUB *WA:MOUSE 1,,,1:WHILE ML=MR:GOSUB *IN:WEND:MOUSE 1,,,0 4510 A=MX\320+(MY\16)*2 :IF MR THEN 4620 4520 F$="":FOR I=0 TO 11:F$=F$+CHR$(PEEK(A*80+I*2)):NEXT 4530 MID$(F$,9)=".":IF INSTR(".B .BMP",MID$(F$,9,3))=0 THEN 4490 4540 : 4550 CH=0 4560 FOR I=0 TO FLMAX '既にﾘｽﾄにないかﾁｪｯｸ あればそれをﾛｰﾄﾞ 4570 IF MID$(F$,1,8)=MID$(FL$[I],1,8) THEN CH=1:FLNO=I:FL$[FLNO]=F$ 4580 NEXT 4590 IF CH=0 THEN FLMAX=FLMAX+1:FLNO=FLMAX:FL$[FLNO]=F$ 4600 : 4610 CLS:OUT &HA6,0:OUT &HA4,0:GOSUB *ADD.LIST:GOSUB *SAVE.TEMP :RETURN 4620 CLS:OUT &HA6,0:OUT &HA4,0:GOSUB *SCR1 :RETURN 4630 *FL.FF '============== 次のファイル 4640 IF FLNO+1>FLMAX THEN RETURN 4650 GOSUB *SAVE.TEMP:FLNO=FLNO+1:GOSUB *LOAD.TEMP:GOSUB *SET. :RETURN 4660 *FL.REW '-------------- 前のファイル 4670 IF FLNO-1<0 THEN RETURN 4680 GOSUB *SAVE.TEMP:FLNO=FLNO-1:GOSUB *LOAD.TEMP:GOSUB *SET. :RETURN 4690 *SAVE.TEMP '============== 作業用保存 4700 GET@(304,64)-STEP(319,191),G 4710 DEF SEG=VARPTR(G%[0],1) 4720 BSAVE TMPDRV$+MID$(STR$(FLNO),2)+".tmp",0,30564 :RETURN 4730 *LOAD.TEMP '-------------- 作業用呼出 4740 DEF SEG=VARPTR(G%[0],1) 4750 BLOAD TMPDRV$+MID$(STR$(FLNO),2)+".tmp",0 :RETURN 4760 *ADD.LIST '============== 編集ﾘｽﾄに追加 4770 OUT &HA6,1:CLS 3 4780 A=(INSTR(".BMP.B ",MID$(FL$[FLNO],9,4))-1)\4+1 4790 ON A GOSUB *LOAD.BMP,*LOAD.BRGE 4800 GET@(0,0)-(319,191),G:OUT &HA6,0 4810 *SET. '-------------- 編集ｳｨﾝﾄﾞｳにｾｯﾄ 4820 PUT@(304,64),G,PSET 4830 GOSUB *SCR1 :RETURN 4840 *LOAD.BMP '============== 呼出(.bmp) 4850 DEF SEG=VARPTR(G%[0],1):BLOAD FL$[FLNO]:PUT@(0,0),G,PSET :RETURN 4860 *LOAD.BRGE '-------------- 呼出(.b/r/g/e) 4870 FOR I=0 TO 3 4880 DEF SEG=VAL("&H"+MID$("a8b0b8e0",I*2+1,2)+"00") 4890 BLOAD MID$(FL$[FLNO],1,9)+MID$("brge",I+1,1) 4900 NEXT :RETURN 4910 *STOP. '============== 終了処理 4920 CLOSE 4930 OPEN TF$ AS#1:CLOSE#1:KILL TF$ 4940 OPEN TF1$ AS#1:CLOSE#1:KILL TF1$ 4950 FOR I=0 TO FLMAX 4960 KILL TMPDRV$+MID$(STR$(I),2)+".tmp" 4970 NEXT :CLS 3:END 4980 *BOX '============== ボックス描画 4990 X1=X1*8-1:Y1=Y1*16-1:X2=X2*8:Y2=Y2*16 5000 LINE(X1,Y2)-(X2,Y1),7,BF,8:LINE-(X1,Y1),0:LINE-(X1,Y2),0 :RETURN 5010 *SCR.DATA '============== 画面データ 5020 DATA 74, 1,78, 3, 8 ,68, 1,72, 3, 7 , 2, 4,26,16, 2 ,28, 4,36, 8, 1 5030 DATA 38, 4,78,16, 3 , 2,19,78,24, 1 , 2, 1, 4, 3, 1 , 6, 1, 8, 3, 1 5040 DATA 22,17,24,18,21 ,28, 9,36,10, 9 ,28,11,36,12,10 ,28,13,36,14,11 5050 DATA 28,15,36,16,12 , 2,17, 4,18,16 , 6,17, 8,18,17 ,10,17,12,18,18 5060 DATA 14,17,16,18,19 ,18,17,20,18,20 ,10, 1,26, 3,15 ,28, 2,30, 3,13 5070 DATA 46, 2,48, 3,14 ,32, 2,44, 3, 1 ,26,17,28,18,22 ,*