PETITCOM フォントエディタ V0.2

FONTED

'+------------------+
'| FONT EDITOR V0.2 |
'+------------------+
'PRG:FONTED

'------------
'--- ｼｮｷｶ ---
'------------
CLEAR
PNLTYPE "OFF"
VISIBLE 1,1,1,1,1,1
CLS
GPAGE 1:GCLS 0
SPPAGE 0:SPCLR

'★ﾍﾝｽｳ ｼｮｷｶ
BG$(0)="BGU0" 'EDITﾖｳBGﾉ ﾅﾏｴ
BG$(1)="BGF0" 'BANKﾖｳBGﾉ ﾅﾏｴ
BG$(2)="BGU1" 'CLIPBOARDﾖｳBGﾉ ﾅﾏｴ
COL=15  'ｾﾝﾀｸﾁｭｳ ﾉ ｲﾛ
CH(0)=65  'EDIT ﾉ ｷｬﾗﾊﾞﾝｺﾞｳ
CH(1)=65  'BANK ﾉ ｷｬﾗﾊﾞﾝｺﾞｳ
TBX=16  'ｷｬﾗﾋｮｳ ﾋﾀﾞﾘｳｴX
TBY=2   'ｷｬﾗﾋｮｳ ﾋﾀﾞﾘｳｴY
FTX0=5  'ﾍﾝｼｭｳﾎﾞｯｸｽ ﾋﾀﾞﾘｳｴ X
FTY0=5  'ﾍﾝｼｭｳﾎﾞｯｸｽ ﾋﾀﾞﾘｳｴ Y
FTX1=20 'ﾍﾝｼｭｳﾎﾞｯｸｽ ﾋﾀﾞﾘｳｴ X
FTY1=5  'ﾍﾝｼｭｳﾎﾞｯｸｽ ﾋﾀﾞﾘｳｴ Y
PALX=5  'ｶﾗ-ﾊﾟﾚｯﾄ ﾋﾀﾞﾘｳｴ X
PALY=21 'ｶﾗ-ﾊﾟﾚｯﾄ ﾋﾀﾞﾘｳｴ Y
ARX=15  'ﾐｷﾞﾑｷﾔｼﾞﾙｼ X
ARY=7   'ﾐｷﾞﾑｷﾔｼﾞﾙｼ Y
ALX=15  'ﾋﾀﾞﾘﾑｷﾔｼﾞﾙｼ X
ALY=10  'ﾋﾀﾞﾘﾑｷﾔｼﾞﾙｼ Y
DGY=16  'ﾀﾞｲｱﾛｸﾞ ｶｲｼY
CLX=25  'ｸﾘｯﾌﾟﾎﾞ-ﾄﾞ ﾋﾀﾞﾘｳｴ X
CLY=21  'ｸﾘｯﾌﾟﾎﾞ-ﾄﾞ ﾋﾀﾞﾘｳｴ Y
CLP$="" 'ｸﾘｯﾌﾟﾎﾞ-ﾄﾞ ﾉ ﾅｶﾐ
CMY=21  'ｺﾏﾝﾄﾞﾎﾞﾀﾝ Y
RP1=500 'ｷ-ｵ-ﾄﾘﾋﾟ-ﾄ ｼｮｶｲ
RP2=30  'ｷ-ｵ-ﾄﾘﾋﾟ-ﾄ 2ｶｲﾒ ｲｺｳ

GOSUB @SPDEF
GOSUB @BGSREAD
GOSUB @DRAWALL
GOSUB @CHRUPD

'-------------
'---ﾒｲﾝﾙ-ﾁﾝ---
'-------------

@EDTLOOP
GOSUB @CHKTCH
ON TA-1 GOTO @EDTFNT,@EDTLOOP,@CHGPAL,@PT,@CP
ON TA-6 GOTO @CLR,@EDLOAD,@BKLOAD,@BKSAVE,@FIN
ON TA-11 GOTO @CLP2ED,@ED2CLP,@COM
GOSUB @CHKBTN
GOTO @EDTLOOP
END

'★ﾄﾞｯﾄ ｳﾂ
@EDTFNT
CHRREAD(BG$(0),CH(0)),FN$
FN$=MID$(FN$,0,TX+TY*8)+HEX$(COL)+MID$(FN$,TX+TY*8+1,64)
CHRSET BG$(0),CH(0),FN$
FTX_=FTX0:FTY_=FTY0:BG_=0
GOSUB @FONTDISP
GOTO @EDTLOOP

'★ｲﾛﾍﾝｺｳ
@CHGPAL
COL=TX
GOSUB @PALDISP
GOTO @EDTLOOP

'★ｺﾋﾟｰ EDIT->BANK
@PT
DIAGST$="EDIT->BANK  OK?"
GOSUB @YNDIAG
IF RES<1 THEN GOTO @EDTLOOP
BG_=0:GOSUB @FONTCP
GOSUB @DRAWALL
GOTO @EDTLOOP

'★ｺﾋﾟｰ BANK->EDIT
@CP
DIAGST$="BANK->EDIT  OK?"
GOSUB @YNDIAG
IF RES<1 THEN GOTO @EDTLOOP
BG_=1:GOSUB @FONTCP
GOSUB @DRAWALL
GOTO @EDTLOOP

'★ｸﾘｱ EDIT
@CLR
DIAGST$="ｸﾘｱ EDIT  OK?"
GOSUB @YNDIAG
IF RES<1 THEN GOTO @EDTLOOP
FN$=""
FOR I=0 TO 7
FN$=FN$+"00000000"
NEXT
CHRSET BG$(0),CH(0),FN$
GOSUB @DRAWALL
GOTO @EDTLOOP

'★EDIT LOAD
@EDLOAD
LOCATE 0,20
INPUT "EDIT LOAD BGﾌｧｲﾙﾒｲ";BFL$
BFL=(BFL$=="." OR BFL$=="/" OR BFL$=="%")
IF BFL THEN @_BKEXT
LOAD BG$(0)+":"+BFL$,0
GOTO @_BKEXT
RETURN

'★BANK LOAD
@BKLOAD
LOCATE 0,20
INPUT "BANK LOAD BGﾌｧｲﾙﾒｲ";BFL$
BFL=(BFL$=="." OR BFL$=="/" OR BFL$=="%")
IF BFL THEN @_BKEXT
LOAD BG$(1)+":"+BFL$,0
GOTO @_BKEXT

'★BANK SAVE
@BKSAVE
LOCATE 0,20
INPUT "BANK SAVE BGﾌｧｲﾙﾒｲ";BFL$
BFL=(BFL$=="." OR BFL$=="/" OR BFL$=="%")
IF BFL THEN @_BKEXT
SAVE BG$(1)+":"+BFL$
GOTO @_BKEXT

@_BKEXT
GOSUB @DRAWALL
GOTO @EDTLOOP

'★ｼｭｳﾘｮｳ
@FIN
DIAGST$="
GOSUB @YNDIAG
IF RES<1 THEN GOTO @EDTLOOP
END

'★ｺﾋﾟｰ CLIPBOARD->EDIT
@CLP2ED
IF LEN(CLP$)!=64 THEN @EDTLOOP
CHRSET BG$(0),CH(0),CLP$
GOSUB @DRAWALL
GOTO @EDTLOOP

'★ｺﾋﾟｰ EDIT->CLIPBOARD
@ED2CLP
CHRREAD(BG$(0),CH(0)),CLP$
GOSUB @DRAWALL
GOTO @EDTLOOP

'★ｺﾏﾝﾄﾞ
@COM
?:INPUT "COMMAND";COM$
COM=(COM$=="." OR COM$=="/" OR COM$=="%")
IF COM THEN @_COMEXT
GOSUB @COMPRS
IF COM$(0)=="C>" THEN @_COM1
IF COM$(0)=="C<" THEN @_COM2
GOTO @_COMEXT
@_COM1
BC_=0
BP_=1
CB_=VAL(COM$(1))
CE_=VAL(COM$(2))
PB_=VAL(COM$(3))
PE_=VAL(COM$(4))
GOSUB @BLCOPY
GOTO @_COMEXT
@_COM2
BC_=1
BP_=0
CB_=VAL(COM$(1))
CE_=VAL(COM$(2))
PB_=VAL(COM$(3))
PE_=VAL(COM$(4))
GOSUB @BLCOPY
GOTO @_COMEXT
@_COMEXT
GOSUB @DRAWALL
GOTO @EDTLOOP

'-------------
'---ｻﾌﾞﾙｰﾁﾝ---
'-------------

'★ｼﾞｮｳｹﾞｶﾞﾒﾝ ﾋﾞｮｳｶﾞ
@DRAWALL
GOSUB @DRAWSC0
GOSUB @DRAWSC1
RETURN

'★ｳｴｶﾞﾒﾝ ﾋﾞｮｳｶﾞ
@DRAWSC0
GPAGE 0:GCLS
CLS
?" EDIT ",,," BANK"
BGPAGE 0:BGCLIP 0,0,31,23
BGOFS 0,0,0,0
GOSUB @CHRTBL0
GOSUB @CHRTBL1
GLINE 127,0,127,191,2
RETURN

'★ｼﾀｶﾞﾒﾝ ﾋﾞｮｳｶﾞ
@DRAWSC1
GPAGE 1:GCLS
'==EDIT ﾋｮｳｼﾞ==
FTX_=FTX0:FTY_=FTY0:BG_=0
GOSUB @FRMDISP
GOSUB @FONTDISP
PNLSTR FTX0+2,FTY0+9,"EDIT"
PNLSTR FTX0,FTY1-2,"CHR:"+STR$(CH(0))+"  "
'==BANK ﾋｮｳｼﾞ==
FTX_=FTX1:FTY_=FTY1:BG_=1
GOSUB @FRMDISP
GOSUB @FONTDISP
PNLSTR FTX1+2,FTY1+9,"BANK"
PNLSTR FTX1,FTY1-2,"CHR:"+STR$(CH(1))+"  "
'==ｿﾉﾀ ﾉ ﾋｮｳｼﾞ==
GOSUB @PALDISP
GOSUB @ARRDISP
PNLSTR 0,0,"<CLR ><EDLD><LOAD><SAVE><EXIT>",0
FOR _I=0 TO 4
 GFILL _I*48+8,0,_I*48+39,7,4
NEXT
PNLSTR 0,CMY,"COM"
GFILL 0,CMY*8,23,CMY*8+7,4
GOSUB @CLPDISP
RETURN

'★ｾﾝﾀｸﾁｭｳ ｷｬﾗ ﾍﾝｺｳ
@CHRUPD
GOSUB @DRAWSC1
SPOFS 0,(CH(0)%16)*8-4,(FLOOR(CH(0)/16)+TBY)*8-4
SPOFS 1,(CH(1)%16+TBX)*8-4,(FLOOR(CH(1)/16)+TBY)*8-4
RETURN

'★ﾎﾞﾀﾝ ﾁｪｯｸ
@CHKBTN
UF=0
BA=B
B=BUTTON()
IF B!=BA THEN RT=RP1
RT=RT-(RT<=0)
IF 0<RT AND RT<RP1-1 OR B==0 THEN RETURN
IF RT==0 THEN RT=RP2
FOR _I=0 TO ((B AND 64)==0)
 PCHN=CH(_I)
 IF (B AND 1)>0 AND 15<CH(_I) THEN CH(_I)=CH(_I)-16
 IF (B AND 2)>0 AND CH(_I)<240 THEN CH(_I)=CH(_I)+16
 IF (B AND 4)>0 AND 0<CH(_I)%16 THEN CH(_I)=CH(_I)-1
 IF (B AND 8)>0 AND CH(_I)%16<15 THEN CH(_I)=CH(_I)+
 IF PCHN!=CH(_I) THEN UF=1
NEXT
IF UF THEN GOSUB @CHRUPD
IF B AND 256 THEN TX=(COL!=15)*15:COL=TX:GOSUB @PALDISP
IF (B AND 528)==528 THEN BG_=0:GOSUB @FONTCP
RETURN

'★ﾀｯﾁｲﾁ ﾁｪｯｸ
@CHKTCH
TA=0:TX=0:TY=0
IF TCHST==0 THEN RETURN
X=FLOOR(TCHX/8)
Y=FLOOR(TCHY/8)
TX=X-FTX0
TY=Y-FTY0
IF 0<=TX AND TX<8 AND 0<=TY AND TY<8 THEN TA=1:RETURN
TX=X-FTX1
TY=Y-FTY1
IF 0<=TX AND TX<8 AND 0<=TY AND TY<8 THEN TA=2:RETURN
TX=X-PALX
TY=Y-PALY
IF 0<=TX AND TX<16 AND 0<=TY AND TY<2 THEN TA=3:RETURN
IF Y==ARY AND (ARX<=X AND X<ARX+3) THEN TA=4:RETURN
IF Y==ALY AND (ALX<=X AND X<ALX+3) THEN TA=5:RETURN
IF Y==0 THEN TA=6+FLOOR(X/6):RETURN
IF Y==CLY-1 AND (CLX+2<=X AND X<=31) THEN TA=11:RETURN
IF Y==CLY+1 AND (CLX+2<=X AND X<=31) THEN TA=12:RETURN
IF Y==CMY AND (0<=X AND X<3) THEN TA=13:RETURN
RETURN

'★EDIT<->BANK ｶﾝ ﾉ ｺﾋﾟ-
@FONTCP
_BGX=BG_ XOR 1
CHRREAD(BG$(BG_),CH(BG_)),FN$
CHRSET BG$(_BGX),CH(_BGX),FN$
RETURN

'★BGU0ﾆ ﾋｮｳｼﾞｭﾝﾌｫﾝﾄ ﾖﾐｺﾐ
@BGSREAD
FOR _I=0 TO 255
CHRREAD(BG$(1),_I),FN$
CHRSET BG$(0),_I,FN$
NEXT
RETURN

'★ﾌｫﾝﾄｶｸﾀﾞｲ ﾋｮｳｼﾞ
@FONTDISP
GFILL FTX_*8,FTY_*8,FTX_*8+63,FTY_*8+63,0
GPUTCHR FTX_*8,FTY_*8,BG$(BG_),CH(BG_),0,8
RETURN

'★ﾜｸ ﾋｮｳｼﾞ   ┌ ﾊ ｷｬﾗｺｰﾄﾞ21
@FRMDISP
PNLSTR FTX_-1,FTY_-1, "┏━━━━━━━━┓",0
FOR _I=0 TO 7
PNLSTR FTX_-1,FTY_+_I,"┃┌┌┌┌┌┌┌┌┃",0
NEXT
PNLSTR FTX_-1,FTY_+8, "┗━━━━━━━━┛",0
RETURN

'★ｶﾗ-ﾊﾟﾚｯﾄ ﾋｮｳｼﾞ
@PALDISP
GFILL PALX*8,PALY*8,(PALX+16)*8,PALY*8+7,0
GBOX PALX*8-1,PALY*8-1,(PALX+16)*8+1,PALY*8+8,15
FOR _I=0 TO 15
GFILL (PALX+_I)*8+1,PALY*8+1,(PALX+_I)*8+6,PALY*8+6,_I
PNLSTR _I+PALX,PALY+1,"　",0
NEXT
PNLSTR PALX+COL,PALY+1,"↑",0
RETURN

'★ﾔｼﾞﾙｼ ﾋｮｳｼﾞ
@ARRDISP
PNLSTR ARX,ARY,">>>",0
PNLSTR ALX,ALY,"<<<",0
RETURN

'★ｸﾘｯﾌﾟﾎﾞｰﾄﾞ ﾋｮｳｼﾞ
@CLPDISP
PNLSTR CLX-1,CLY-1,"┏━┓PASTE",0
PNLSTR CLX-1,CLY  ,"┃　┃     ",0
PNLSTR CLX-1,CLY+1,"┗━┛ COPY",0
GFILL CLX*8+16,CLY*8-8,CLX*8+55,CLY*8-1,4
GFILL CLX*8+16,CLY*8+8,CLX*8+55,CLY*8+15,4
IF LEN(CLP$)!=64 THEN RETURN
CHRSET BG$(2),0,CLP$
GPUTCHR CLX*8,CLY*8,BG$(2),0,0,1
RETURN

'★Y/Nﾀﾞｲｱﾛｸﾞ
@YNDIAG
PNLSTR 8,DGY,DIAGST$,7
PNLSTR 7,DGY+1,"┏━━━━━━━┓　┏━━━━━━━┓"
PNLSTR 7,DGY+2,"┃Ａ：　ＯＫ　　┃　┃Ｂ：キャンセル┃"
PNLSTR 7,DGY+3,"┗━━━━━━━┛　┗━━━━━━━┛"
RES=0
@_0YNDIAG
IF TCHST THEN @_0YNDIAG
IF BUTTON() THEN @_0YNDIAG
@_1YNDIAG
B=BUTTON()
IF B==16 THEN RES=1:GOTO @_2YNDIAG
IF B==32 THEN RES=0:GOTO @_2YNDIAG
GOSUB @CHKTCH
IF TA!=0 OR Y<DGY+1 OR DGY+3<Y THEN @_1YNDIAG
IF X<7 OR X==16 OR 25<X THEN @_1YNDIAG
RES=(X<16)
@_2YNDIAG
PNLSTR 7,DGY,  "　　　　　　　　　　　　　　　　　　　"
PNLSTR 7,DGY+1,"　　　　　　　　　　　　　　　　　　　"
PNLSTR 7,DGY+2,"　　　　　　　　　　　　　　　　　　　"
PNLSTR 7,DGY+3,"　　　　　　　　　　　　　　　　　　　"
RETURN

'★ｷｬﾗﾃｰﾌﾞﾙ0 ﾋｮｳｼﾞ
@CHRTBL0
COLOR 2
LOCATE 0,TBY-1
?"0123456789ABCDEF"
BGO=VAL(MID$(BG$(0),3,1))*256
BGPAGE 0
FOR _I=0 TO 15
FOR _J=0 TO 15
  BGPUT 0,_J,_I+TBY,_I*16+_J+BGO,0,0,0
NEXT
NEXT
RETURN

'★ｷｬﾗﾃｰﾌﾞﾙ1 ﾋｮｳｼﾞ
@CHRTBL1
COLOR 2
LOCATE TBX,TBY-1
?"0123456789ABCDEF"
FOR _I=0 TO 15
 COLOR 2
 LOCATE TBX-1,TBY+_I
 ?" ";
 COLOR 0
 FOR _J=0 TO 15
  ?CHR$(_I*16+_J);
 NEXT
NEXT
RETURN

'★ｶｰｿﾙﾖｳ ｽﾌﾟﾗｲﾄ ﾃｲｷﾞ
@SPDEF
GCLS
GBOX 2,2,13,13,2
GBOX 3,3,12,12,2
FOR H=0 TO 3
SP$=""
FOR I=0 TO 7
  FOR J=0 TO 7
   SP$=SP$+HEX$(GSPOIT(H%2*8+J,(H>1)*8+I))
  NEXT
NEXT
CHRSET "SPU0",H,SP$
NEXT
GCLS
SPSET 0,0,0,0,0,0
SPSET 1,0,0,0,0,0
RETURN

'★COMMAND ｶｲｾｷ
@COMPRS
FOR _K=0 TO 9:COM$(_K)="":NEXT
_K=0
_J=0
FOR _I=0 TO LEN(COM$)
IF _I==LEN(COM$) THEN @_0COMPRS
_C$=MID$(COM$,_I,1)
IF _C$!="/" AND _C$!=" " THEN @_1COMPRS
@_0COMPRS
COM$(_K)=MID$(COM$,_J,_I-_J)
_J=_I+1
_K=_K+1
@_1COMPRS
NEXT
RETURN

'★ﾌﾞﾛｯｸ ｺﾋﾟｰ
@BLCOPY
_PI=PB_
FOR _I=CB_ TO CE_
IF _I<0 OR 255<_I THEN @_0BLCOPY
CHRREAD(BG$(BC_),_I),FN$
CHRSET BG$(BP_),_PI,FN$
_PI=_PI+1
IF _PI>PE_ THEN _PI=PB_
@_0BLCOPY
NEXT
RETURN

1/17 ドット打ちを楽しみたい人向けのプチコン用フォントエディタです。
316行目の ┌ は キャラコード21番を入力してください。
なぜかいきなりV0.2ですが気にしないこと。

1/29 何も操作しないで放っておくと、リピート用の変数RTがオーバーフローするバグがありましたので、修正しました。
252行の RT=RT-1 を RT=RT-(RT>=0) としてください。

2/13 Lボタンを何回か使うと、Out of memoryになるバグがありましたので修正しました。
本来、GOSUBで呼んではいけないラベルをGOSUBで呼んでしまっていたためです。
264行目のTHEN以降を修正してください。