SmileBASIC

プログラムリスト

SYS/SBMAP

スクリーンショット

トップメニュー「SmileBASICでプログラムを作る」から、LOAD"SYS/SBMAP"↵でプログラムが読み込まれます。キーボードの「EDIT」キーを押すと、このプログラムが自由に編集できます。


'
' MAP EDITOR
'
' (C)2014-2016 SmileBoom Co.Ltd.
'
BGL=4:XSCREEN 2,0,BGL
RP1=10:RP2=1:RC1=10:RC2=1:VER=1.5
FOR I=0 TO 7:BREPEAT I,RP1,RP2:NEXT
LC=RGB(32,32,32):WC=RGB(255,255,255)
FOR I=0 TO 1
 DISPLAY I:VISIBLE 1,1,1,1
 GPAGE I,I:GPRIO 50:GCLS
 COLOR 15,0:CLS
NEXT

'--- ファィルめいをひづけからつくる
DTREAD OUT Y,M,D:Y=Y-2000
TMP$=FORMAT$("%02D%02D%02D",Y,M,D)

'--- color
_CGRAY =RGB(200,200,200)
_CBLUE =RGB( 80,120,240)
_CTEXT =RGB(0,0,0)
_CRED  =RGB(250,50,50)
_CUNDO =RGB(250,200,50)
_CWHITE=RGB(255,255,255)
_CBACK =RGB(32,32,64)

'
' initialize
'
DISPLAY 0
MAPMAX=16383:CPSW=0:SPZ=500
DIM TMPC%[MAPMAX]
DIM UNDO0%[MAPMAX],UNDO1%[MAPMAX]
DIM UNDO2%[MAPMAX],UNDO3%[MAPMAX]
'---
ID=(ASC("M")<<24)
ID=(ASC("A")<<16) OR ID
ID=(ASC("P")<<8)  OR ID
ID=(ASC(":"))     OR ID
H_ID=0:H_VR=1:H_R2=2:H_LY=3
H_DW=4:H_DH=5:H_MX=6:H_MY=7
HEADMAX=8
'---
ATRMAX=32*32
DIM ATR%[ATRMAX]
'---
PRINT FORMAT$( "SBMAP v%.2F",VER)
TXLINEB:MSG$=""
'---
DW=32:DH=32:MX=2:MY=2:BGL=4:DLW=14:DLH=12
R=CALCSIZE():GOSUB @ALLCLR
'GOSUB @TMPLOAD
'GOSUB @FRESIZE
'---
ZMH=1.0:ZML=1.0:ZMT=1.0
'---
DIM STRATR$[2]
STRATR$[0]=" ":STRATR$[1]=""
'---
THX=30*8:THY=24:TSX=5:TSY=12:TCW=32:TCH=32
EHX=0:EHY=24:BGX=0:BGY=0
TLX=0:TLY=0:TLU=1:TLV=0:TLW=1:TLH=1
'---
FC=0:TSEL=0:UNDOSW=0
DM=0:DOX=0:DOY=0:ATRTP=0
AR=0:AH=0:AV=0:BGATR=0
CX=0:CY=0:LY=2:LYB=3
'---
ZMAX=5:DIM ZCNT[ZMAX]
DATA 0.25  '0
DATA 0.5   '1
DATA 0.75  '2
DATA 1     '3 DEFAULT
DATA 1.25  '4
FOR I=0 TO ZMAX-1:READ ZCNT[I]:NEXT
'---
FMAX=100
DIM FNCTX$[FMAX],FNCJP$[FMAX]
DIM FNCX[FMAX],FNCY[FMAX]
DIM FNCST[FMAX]
'
DATA " 0  1  2  3 ",0,0,"@HIPAGE",&HF
DATA "",8*8-6,0,"@HIGRID",1
DATA "  ",10*8-6,0,"@HIZOOM",3
DATA " 0  1  2  3 ",19*8+4,0,"@LOBACK",3
DATA "" ,27*8-2,0,"@LOGRID",1
'
DATA "S",0,28*8,"@MDSET",0
DATA "F",2*8,28*8,"@MDFILL",0
DATA "C",4*8,28*8,"@MDCOPY",0
DATA "A   ",6*8,28*8,"@MDATR",0

DATA "LOAD",19*8,28*8,"@FLOAD",0
DATA "SAVE",24*8-6,28*8,"@FSAVE",0
DATA "SCSAVE",14*8-6,0,"@FSAVEBG",0

DATA " 0  1  2  3 ",9*8+1,28*8,"@LOPAGE",2
'
DATA "",30*8,28*8,"@UNDO",0
DATA "      ",32*8,28*8,"@ATR90",0
DATA "H",36*8,28*8,"@ATRH",0
DATA "V",38*8,28*8,"@ATRV",0
'
DATA "",38*8,0,"@TOOLEND",0
'
DATA ""
'---
I=0
WHILE 1
 READ R$
 IF R$=="" THEN BREAK
 FNCTX$[I]=R$
 READ FNCX[I],FNCY[I],FNCJP$[I],FNCST[I]
 I=I+1
WEND
FNCMAX=I
'---
MDSETIX =-1:MDFILLIX=-1
MDCOPYIX=-1:MDATRIX =-1
EXITSW=FALSE

'=========
' RESTART
'=========
@RESTART
FILESW=FALSE
DISPLAY 0:VISIBLE 1,1,1,1:CLS
OLDVGX=-1:OLDBGY=-1
GOSUB @INIT
CMD=MDFILLIX
GOSUB @MDPUT
'---
@OFFLOOP
TOUCH OUT TCS,TCX,TCY
VSYNC 1
IF TCS THEN @OFFLOOP

'===========
' MAIN LOOP
'===========
@MLOOP
BTN=BUTTON(0)
SFT=BTN AND &H300
BRP=BUTTON(1)
BUTVEC BRP OUT BVX,BVY
STICK OUT STX,STY
GOSUB @STKSUB
TOUCH OUT TCS,TCX,TCY
'---
GOSUB @TILESEL
GOSUB @SCRNSEL
GOSUB @EDSCRN
GOSUB @BUTCHK
GOSUB @PUT_HICSR
GOSUB @PUT_TILECSR
GOSUB @EDAREACSR
'---
DISPLAY 0:X=BGX*16:Y=BGY*16
FOR L=0 TO BGL-1
 BGOFS L,X,Y,400-(L*100)
NEXT
OLDBGX=BGX:OLDBGY=BGY
'---
VSYNC 1
FC=FC+1
'--- :FILE
IF BRP==&H80 THEN GOSUB @FILE:FILESW=TRUE
IF FILESW THEN @RESTART
'--- :EXIT
IF BRP==&H40 THEN EXITSW=TRUE
IF EXITSW==FALSE THEN @MLOOP

'======
' EXIT
'======
@TOOLEND
DATA "ツールを終了しますか？",""
IF DLG("@TOOLEND",1,"Xボタンによる終了確認")==-1 THEN
 EXITSW=FALSE:GOTO @RESTART
ENDIF
'---
@DLGSAVE
DATA "終了前にデータを保存しますか？",""
IF DLG( "@DLGSAVE",1,"データ保存確認" )==1 THEN
 GOSUB @FSAVE
ENDIF
'---
EXEC "SYS/SBSMILE"
END

'=============
' EDIT SCREEN
'=============
@EDSCRN
W=DLW*16:H=DLH*16
H=HIT(EHX,EHY,W,H)
X=((TCX-EHX) DIV 16)+CX+BGX
Y=((TCY-EHY) DIV 16)+CY+BGY
IF DM==1 THEN @ED2ND
IF DM==2 THEN @ED3RD

'---
@ED1ST
IF TCS==0 THEN RETURN
IF H==FALSE THEN RETURN
IF SFT THEN @SPOIT
IF CMD==MDSETIX THEN @PSET
'---
DM=1:DOX=X:DOY=Y
RETURN

'---
@ED2ND
IF H==FALSE THEN @ED2NDOVER
'---
DISPLAY 1
X1=DOX:Y1=DOY:X2=X:Y2=Y
IF X1>X2 THEN SWAP X1,X2
IF Y1>Y2 THEN SWAP Y1,Y2
GOSUB @PUT_LOGRID
TX=EHX+(X1-(CX+BGX))*16
TY=EHY+(Y1-(CY+BGY))*16
EX=EHX+(X2-(CX+BGX))*16
EY=EHY+(Y2-(CY+BGY))*16
'GBOX TX,TY,EX+16,EY+16,WC
CSRGBOX TX,TY,EX+16,EY+16,WC
'---
IF TCS THEN RETURN
'---
@ED2NDOVER
IF CMD==MDATRIX  THEN @ATRSET
IF CMD==MDCOPYIX THEN @COPYSET
'---
GOSUB @UNDOSAVE
'---
@EDSET
DISPLAY 0:EX=CX+BGX:EY=CY+BGY
FOR Y=Y1 TO Y2
 VV=((Y-Y1) MOD TLH)
 VV=((TLV+VV)*TCW)
 FOR X=X1 TO X2
  IF X<0 || X>=BGW THEN CONTINUE
  IF Y<0 || Y>=BGH THEN CONTINUE
  UU=((X-X1) MOD TLW)
  A=BGATR OR (TLU+UU) OR VV
  BGPUT LY,X,Y,A
 NEXT
NEXT
GOSUB @EDAREAPUT
GOSUB @PUT_LOGRID
DM=0
RETURN

'---
@ED3RD
DISPLAY 1
'GBOX CPTX,CPTY,CPEX,CPEY,WC
CSRGBOX CPTX,CPTY,CPEX,CPEY,WC
PUTMSG MSG$
'---
IF BRP AND &H20 THEN
 CPSW=0:DM=0
 GOSUB @EDAREACLR
 GOSUB @TILEINIT
 GOSUB @TILEPUT
 GOSUB @EDAREAPUT
 CLRMSG
 RETURN
ENDIF
'---
IF BRP AND &H10 THEN
 X=CPX:Y=CPY
 GOTO @PASTE
ENDIF
IF H==FALSE THEN RETURN
IF TCS==0 THEN RETURN
'
@PASTE
DISPLAY 0
BGLOAD LY,X,Y,CPW,CPH,TMPC%
GOSUB @EDAREAPUT
RETURN

'
' LO-CURSOR GBOX
'
DEF CSRGBOX TX,TY,EX,EY,C

W=DLW*16:H=DLH*16
'
IF TX<EHX THEN TX=EHX
IF TX>EHX+W THEN TX=EHX+W
IF TY<EHY THEN TY=EHY
IF TY>EHY+H THEN TY=EHY+H
'
IF EX<EHX THEN EX=EHX
IF EX>EHX+W THEN EX=EHX+W
IF EY<EHY THEN EY=EHY
IF EY>EHY+H THEN EY=EHY+H

GBOX TX,TY,EX,EY,C

END

'=========
' COPYSET
'=========
@COPYSET
DISPLAY 0
DM=2:CPSW=1:CPX=X1:CPY=Y1
CPW=(X2-X1)+1:CPH=(Y2-Y1)+1
BGSAVE LY,CPX,CPY,CPW,CPH,TMPC%
'
CPTX=EHX+(X1-(CX+BGX))*16
CPTY=EHY+(Y1-(CY+BGY))*16
CPEX=EHX+(X2-(CX+BGX))*16+16
CPEY=EHY+(Y2-(CY+BGY))*16+16
'
GOSUB @EDAREACLR
GOSUB @EDAREAPUT
GOSUB @UNDOSAVE
GOSUB @CLR_TILECSR
PUTMSG ":COPYEND"
RETURN

'========
' ATRSET
'========
@ATRSET
DISPLAY 0
FOR Y=Y1 TO Y2
 FOR X=X1 TO X2
  A=BGGET(LY,X,Y)
  ATR%[ A AND &HFFF ]=ATRTP
 NEXT
NEXT
GOSUB @EDAREAPUT
DM=0
RETURN

'======
' PSET 
'======
@PSET
IF TCS==1 THEN GOSUB @UNDOSAVE
X1=X:Y1=Y:X2=X:Y2=Y
GOTO @EDSET

'=======
' SPOIT
'=======
@SPOIT
DISPLAY 0
I=BGGET(LY,X,Y)
GETATR I OUT I,AR,AH,AV,U,V
IF TLU!=U OR TLV!=V THEN
 GOSUB @CLR_TILECSR
 W=TCW-TSX:H=TCH-TSY
 IF U<TLX OR U>TLX+TSX THEN TLX=U
 IF TLX>=W THEN TLX=W
 IF V<TLY OR V>TLY+TSY THEN TLY=V
 IF TLY>=H THEN TLY=H
 TLU=U:TLV=V
 GOSUB @TILEPUT
ENDIF
GOSUB @PUT_TILEINFO
RETURN

'=============
' HI BGSCREEN
'=============
@SCRNSEL
VX=SVX:VY=SVY
IF VX==0 AND VY==0 THEN
 VX=BVX:VY=BVY
ENDIF
IF VX==0 AND VY==0 THEN RETURN
'
DISPLAY 0:S=16*ZMH
W=(400 DIV S):IF W>BGW THEN W=BGW
H=(240 DIV S):IF H>BGH THEN H=BGH
W=W-DLW:H=H-DLH
X=CX:CX=CX+VX:VX=0
IF CX<0 THEN CX=0:VX=-1
IF CX>W THEN CX=W:VX=1
Y=CY:CY=CY+VY:VY=0
IF CY<0 THEN CY=0:VY=-1
IF CY>H THEN CY=H:VY=1
'---
OX=BGX:BGX=BGX+VX
IF BGX<0 THEN BGX=0
WW=(BGW-DLW)-CX:IF WW<0 THEN WW=0
IF BGX>WW THEN BGX=WW
OY=BGY:BGY=BGY+VY
IF BGY<0 THEN BGY=0
HH=(BGH-DLH)-CY:IF HH<0 THEN HH=0
IF BGY>HH THEN BGY=HH
'---
I=X-CX OR Y-CY OR OY-BGY OR OX-BGX
IF I==0 THEN RETURN
'---
GOSUB @CLR_HICSR
GOSUB @PUT_HIGRID
GOSUB @PUT_LOGRID
GOSUB @EDAREAPUT
RETURN

'=============
' TILE SELECT
'=============
@TILESEL
DISPLAY 0
'--- release
IF TCS==0 THEN
 IF TSEL THEN
  X=TLX1-TCX:Y=TLY1-TCY
  IF X>-2 && X<2 && Y>-2 && Y<2 THEN
   GOSUB @CLR_TILECSR
   TLU=TLX+((TCX-THX) DIV 16)
   TLV=TLY+((TCY-THY) DIV 16)
   GOSUB @PUT_TILEINFO
   GOSUB @PUT_TILECSR
  ENDIF
 ENDIF
 TSEL=0
 RETURN
ENDIF
'--- touch start?
IF HIT(THX,THY,TSX*16,TSY*16) THEN
 IF TSEL THEN
  '--- drag
  GOSUB @CLR_TILECSR
  X=TLX1-TCX:Y=TLY1-TCY
  VX=0:VY=0
  IF X<-2 THEN VX=-1
  IF X> 2 THEN VX= 1
  IF Y<-2 THEN VY=-1
  IF Y> 2 THEN VY= 1
  '--- scroll
  TLX=TLX+VX:W=TCW-TSX
  TLY=TLY+VY:H=TCH-TSY
  IF TLX<0 THEN TLX=0
  IF TLX>W THEN TLX=W
  IF TLY<0 THEN TLY=0
  IF TLY>H THEN TLY=H
  GOSUB @PUT_TILECSR
  GOSUB @TILEPUT
  TLX1=TCX:TLY1=TCY
  '
 ELSE
  '--- shift?(change size)
  IF SFT THEN
   IF TCS!=1 THEN RETURN
   '
   GOSUB @CLR_TILECSR
   U1=TLU:V1=TLV
   U2=TLX+((TCX-THX) DIV 16)
   V2=TLY+((TCY-THY) DIV 16)
   IF U1>U2 THEN SWAP U1,U2
   IF V1>V2 THEN SWAP V1,V2
   TLU=U1:TLV=V1
   TLW=(U2-U1)+1:TLH=(V2-V1)+1
   GOSUB @PUT_TILECSR
   GOSUB @TILEPUT
   
  ELSE
   '--- 1st touch
   TSEL=1:TLX1=TCX:TLY1=TCY
   GOSUB @CLR_TILECSR
   TLW=1:TLH=1
   GOSUB @PUT_TILECSR
   GOSUB @TILEPUT
   
  ENDIF
  '
 ENDIF
 
ENDIF
RETURN

'---
@TILEPUT
DISPLAY 1:OX=THX:OY=THY
A=(BGATR >> 11)
FOR Y=0 TO TSY-1
 FOR X=0 TO TSX-1
  U=(X+TLX)*16:V=(Y+TLY)*16
  IX=SPTILE+Y*TSX+X
  SPCHR IX,U,V,16,16,A OR 1
 NEXT
NEXT
GOSUB @PUT_TILEGRID
RETURN

'---
@PUT_TILEINFO
DISPLAY 1
COLOR 15:LOCATE 30,1
PRINT "&H";HEX$(TLU+TLV*TCW+BGATR,4);
RETURN

'==============
' BUTTON CHECK
'==============
@BUTCHK
IF TCS==1 THEN @BUTHIT
IF TCS<RP1 THEN RETURN
IF (TCS-RP1) MOD RP2 THEN RETURN
'---
@BUTHIT
DISPLAY 1:SW=0
FOR BIX=0 TO FNCMAX-1
 GETBUT BIX OUT X,Y,T$,W,H
 IF HIT(X,Y,W,H) THEN
  OX=TCX-X
  JP$=FNCJP$[BIX]
  IF CHKLABEL(JP$) THEN
   GOSUB JP$:DISPLAY 1
  ENDIF
 ENDIF
NEXT
'---
IF SW==0 THEN RETURN
'---
GOSUB @PUT_TILEINFO
GOSUB @TILEPUT
GOSUB @EDAREAPUT
RETURN

'====================
@HIPAGE
OX=OX DIV 12:IF OX>3 THEN OX=3
FNCST[BIX]=FNCST[BIX] XOR (1 << OX)
'---
@HIPAGEPUT
PUTBUT BIX,_CGRAY:DISPLAY 0
X=X+4:Y=Y+2
FOR I=0 TO 3
 IF FNCST[BIX] AND (1<<I) THEN
  DISPLAY 1
  GFILL X,Y+1,X+10,Y+9,_CBACK
  GFILL X+1,Y,X+9 ,Y+10,_CBACK
  GPUTSTR X+2,Y+2,STR$(I),_CWHITE
  DISPLAY 0
  BGSHOW I
 ELSE
  BGHIDE I
 ENDIF
 X=X+12
NEXT
DISPLAY 1
RETURN

'====================
@HIGRIDINIT
HIGRIDSW=FNCST[BIX]
RETURN
'---
@HIGRID
IF TCS!=1 THEN RETURN
'---
FNCST[BIX]=FNCST[BIX] XOR 1
HIGRIDSW=FNCST[BIX]
GOSUB @PUT_HIGRID
RETURN

'====================
@HIZOOMINIT
HIZOOM=FNCST[BIX]
ZMH=ZCNT[ FNCST[BIX] ]
RETURN
'---
@HIZOOM
GOSUB @CLR_HICSR
GOSUB @CLR_HIGRID
I=FNCST[BIX]
IF OX<9 THEN I=I-1 ELSE I=I+1
IF I<0 THEN I=0
IF I>ZMAX-1 THEN I=ZMAX-1
OLDZMH=ZMH:FNCST[BIX]=I
GOSUB @HIZOOMINIT
DISPLAY 0
FOR L=0 TO BGL-1
 BGSCALE L,ZMH,ZMH
NEXT
DISPLAY 1
'IF ZMH>OLDZMH THEN
CX=0:CY=0:BGX=0:BGY=0
'
GOSUB @PUT_HIGRID
RETURN

'====================
@LOBACK
SW=1:LYB=OX DIV 12:IF LYB>3 THEN LYB=3
'---
@LOBACKPUT
L=LYB:GOTO @PUTLAYNO
'====================
@LOPAGE
SW=1:LY=OX DIV 12:IF LY>3 THEN LY=3
'---
@LOPAGEPUT
L=LY
'---
@PUTLAYNO
PUTBUT BIX,_CBLUE
X=X+4:Y=Y+2
FOR I=0 TO 3
 IF I==L THEN
  GFILL X,Y+1,X+11,Y+9 ,_CBACK
  GFILL X+1,Y,X+10,Y+10,_CBACK
  GPUTSTR X+2,Y+2,STR$(I),_CWHITE
 ENDIF
 X=X+12
NEXT
RETURN

'====================
@LOGRIDINIT
LOGRIDSW=FNCST[BIX]
RETURN
'
@LOGRID
IF TCS!=1 THEN RETURN
'
FNCST[BIX]=FNCST[BIX] XOR 1
LOGRIDSW=FNCST[BIX]
GOSUB @PUT_LOGRID
RETURN

'====================
@LOZOOMINIT
ZML=ZCNT[ FNCST[BIX] ]
RETURN
'---
@LOZOOM
RETURN

'====================
@MDSETINIT
MDSETIX=BIX:RETURN
'---
@MDFILLINIT
MDFILLIX=BIX:RETURN
'---
@MDCOPYINIT
MDCOPYIX=BIX:RETURN
'---
@MDATRINIT
MDATRIX=BIX:RETURN
'---
@MDATR
ATRTP=ATRTP XOR 1
'---
@MDCOPY
@MDFILL
@MDSET
CMD=BIX
GOSUB @EDAREAPUT
'---
@MDPUT
@MDSETPUT
@MDFILLPUT
@MDCOPYPUT
@MDATRPUT
'
OLDBIX=BIX
BIX=MDSETIX :GOSUB @MDPUTSUB
BIX=MDFILLIX:GOSUB @MDPUTSUB
BIX=MDCOPYIX:GOSUB @MDPUTSUB
BIX=MDATRIX :GOSUB @MDPUTSUB
COLOR 15,0
BIX=OLDBIX
GETBUT BIX OUT X,Y,T$,W,H
RETURN
'---
@MDPUTSUB
IF BIX==-1 THEN RETURN
C=_CGRAY:IF BIX==CMD THEN C=_CBLUE
GETBUT BIX OUT X,Y,T$,W,H
PUTBUT BIX,C
RETURN

'====================
@ATR90
AR=(AR+1) AND 3:SW=1
GOSUB @MKATR
'---
@ATR90PUT
PUTBUT BIX,_CBLUE
GPUTSTR X+3,Y+4,STR$(AR*90),_CWHITE
RETURN
'---
@ATRH
AH=AH XOR 1:SW=1
C=_CGRAY:IF AH THEN C=_CBLUE
PUTBUT BIX,C
GOSUB @MKATR
RETURN
'---
@ATRV
AV=AV XOR 1:SW=1
C=_CGRAY:IF AV THEN C=_CBLUE
PUTBUT BIX,C
'---
@MKATR
BGATR=AR*&H1000
BGATR=BGATR OR (AH*&H4000)
BGATR=BGATR OR (AV*&H8000)
RETURN

'====================
@UNDOINIT
UNDOIX=BIX:RETURN
'---
@UNDOPUT
DISPLAY 1
C=_CGRAY:IF UNDOSW THEN C=_CUNDO
PUTBUT BIX,C
RETURN
'---
@UNDO
IF UNDOSW==0 THEN RETURN
'
DISPLAY 0
FOR I=0 TO 3
 BGLOAD I,VAR("UNDO"+STR$(I)+"%")
NEXT
UNDOSW=0
GOSUB @UNDOPUT
GOSUB @EDAREAPUT
RETURN

'==============
' GET BGSCREEN
'==============
@UNDOSAVE
DISPLAY 0
FOR I=0 TO 3
 BGSAVE I,VAR("UNDO"+STR$(I)+"%")
NEXT
UNDOSW=1
'
BIX=UNDOIX
GETBUT BIX OUT X,Y,T$,W,H
GOSUB @UNDOPUT
RETURN

'==========
' ALL GRID
'==========
@GRIDALL
GOSUB @PUT_HIGRID
GOSUB @PUT_LOGRID
GOSUB @PUT_TILEGRID
GOSUB @PUT_TILECSR
RETURN

'======
' GRID
'======
@GRIDSUB
AA=EX-TX:IF AA>W THEN AA=W
FOR Y=-(TY MOD SH) TO H STEP SH
 IF AY+Y<AY THEN CONTINUE
 IF AY+Y>EY THEN BREAK
 GLINE AX,AY+Y,AX+AA,AY+Y,C
NEXT
AA=EY-TY:IF AA>H THEN AA=H
FOR X=-(TX MOD SW) TO W STEP SW
 IF AX+X<AX THEN CONTINUE
 IF AX+X>EX THEN BREAK
 GLINE AX+X,AY,AX+X,AY+AA,C
NEXT
RETURN

'=========
' HI GRID
'=========
@CLR_HIGRID
DISPLAY 0:GCLS
RETURN
'---
@PUT_HIGRID
DISPLAY 0:Z=16*ZMH
'--- GRAY
AX=0:AY=0:W=400:H=240
SW=Z:SH=Z:C=LC
TX=BGX*Z:TY=BGY*Z:EX=BGW*Z:EY=BGH*Z
IF HIGRIDSW THEN
 GOSUB @GRIDSUB
ELSE
 GOSUB @CLR_HIGRID
ENDIF
'--- RED
AX=0:AY=0:W=400:H=240
SW=DW*Z:SH=DH*Z:C=RGB(255,0,0)
TX=BGX*Z:TY=BGY*Z:EX=BGW*Z:EY=BGH*Z
GOSUB @GRIDSUB

'===========
' HI CURSOR
'===========
@PUT_HICSR
DISPLAY 0:Z=16*ZMH
X=CX*Z:Y=CY*Z:W=DLW*Z:H=DLH*Z
C=(FC AND 7)*16+128
GBOX X,Y,X+W,Y+H,RGB(C,C,C)
'---
IF HIGRIDSW==0 THEN
 LOCATE 0,29:PRINT " "*50;
 RETURN
ENDIF
'
COLOR 15,8
X=BGX+CX:Y=BGY+CY
S$=FORMAT$("%3D,%3D",X,Y)
X=X DIV DW:Y=Y DIV DH
S$=S$+FORMAT$("(%2D,%2D)",X,Y)
S$=S$+FORMAT$("[%2D×%2D]",DW,DH)
S$=S$+FORMAT$("%D",HIZOOM)
H$=":FILE :EXIT"
L=50-LEN(S$+H$)
S$=S$+(" "*L)+H$
PUTSTR 0,15,S$
COLOR 15,0
RETURN
'
@CLR_HICSR
DISPLAY 0:Z=16*ZMH
X=X*Z:Y=Y*Z:W=DLW*Z:H=DLH*Z
GBOX X,Y,X+W,Y+H,0
RETURN

'=========
' LO GRID
'=========
@PUT_LOGRID
DISPLAY 1:Z=16*ZML
AX=EHX:AY=EHY:W=DLW*Z:H=DLH*Z
SW=Z:SH=Z:C=LC
TX=BGX*Z:TY=BGY*Z:EX=BGW*Z:EY=BGH*Z
IF LOGRIDSW THEN
 GOSUB @GRIDSUB
ELSE
 GFILL AX,AY,AX+W-1,AY+H-1,0
ENDIF
'--- RED
AX=EHX:AY=EHY:W=DLW*Z:H=DLH*Z
SW=DW*Z:SH=DH*Z:C=RGB(255,0,0)
TX=BGX*Z:TY=BGY*Z:EX=BGW*Z:EY=BGH*Z
GOSUB @GRIDSUB
RETURN

'===========
' TILE GRID
'===========
@PUT_TILEGRID
DISPLAY 1:Z=16
AX=THX:AY=THY:W=TSX*Z:H=TSY*Z
SW=Z:SH=Z:C=LC
TX=TLX*Z:TY=TLY*Z
EX=TX+TCW*Z:EY=TY+TCH*Z
GOSUB @GRIDSUB
GOSUB @PUT_TILECSR
RETURN

'=============
' TILE CURSOR
'=============
@CLR_TILECSR
C=LC:GOTO @TCSRSUB
'---
@PUT_TILECSR
IF CPSW THEN RETURN
'---
C=(FC AND 7)*16+128
'---
@TCSRSUB
X=TLU-TLX:Y=TLV-TLY:W=TLW:H=TLH
IF X<0 THEN RETURN
IF X>TSX-1 THEN RETURN
IF Y<0 THEN RETURN
IF Y>TSY-1 THEN RETURN
'
DISPLAY 1:ZM=16
OX=THX:OY=THY:SX=TLW*ZM:SY=TLH*ZM
X=OX+X*ZM:Y=OY+Y*ZM
GBOX X,Y,X+SX,Y+SY,RGB(C,C,C)
RETURN

'============
' INITIALIZE
'============
@INIT
GOSUB @INITHI
GOSUB @INITLO
GOSUB @EDAREAPUT
GOSUB @TILEPUT
GOSUB @GRIDALL
GOSUB @PUT_TILEINFO
RETURN

'---
@INITHI
DISPLAY 0:BGPAGE 5:GPRIO 50
FOR L=0 TO BGL-1
 BGOFS L,BGX,BGY
 BGSCALE L,ZMH,ZMH
 BGSHOW L
NEXT
RETURN

'---
@INITLO
DISPLAY 1:SPPAGE 5:GPRIO 50
NX=DLW*DLH:S=16*ZML
FOR Y=0 TO DLH-1
 FOR X=0 TO DLW-1
  '
  IX=Y*DLW+X
  SPSET IX,0,0,16,16
  SPOFS IX,EHX+X*S,EHY+Y*S,SPZ
  SPSCALE IX,ZML,ZML
  SPCOLOR IX,RGB(255,255,255,255)
  SPSHOW IX
  '--- back
  IX=IX+NX
  SPSET IX,0,0,16,16
  SPOFS IX,EHX+X*S,EHY+Y*S,SPZ+100
  SPCOLOR IX,RGB(128,255,255,255)
  SPSHOW IX
  SPSCALE IX,ZML,ZML
  '--- copy
  IX=IX+NX
  SPSET IX,0,0,16,16
  SPHIDE IX
  SPSCALE IX,ZML,ZML
  '
 NEXT
NEXT
'---
SPTILE=NX*2
GOSUB @TILEINIT
'--- button
COLOR 14
GFILL 0,0,319,17,_CBACK
GFILL 0,18,319,19,_CGRAY
GFILL 0,27*8+2,319,27*8+3,_CGRAY
GFILL 0,27*8+4,319,239,_CBACK
'---
FOR BIX=0 TO FNCMAX-1
 PUTBUT BIX,_CGRAY
 JP$=FNCJP$[BIX]+"INIT"
 IF CHKLABEL(JP$) THEN
  GETBUT BIX OUT X,Y,T$,W,H:GOSUB JP$
 ENDIF
 JP$=FNCJP$[BIX]+"PUT"
 IF CHKLABEL(JP$) THEN
  GETBUT BIX OUT X,Y,T$,W,H:GOSUB JP$
 ENDIF
NEXT

'--- guide
X=((THX DIV 8)-2)*8+2:Y=2*8+2
W=10:H=25*8+1
GFILL X,Y,X+1,Y+H,_CGRAY:X=X+2
GFILL X,Y,X+W,Y+H,_CBACK:X=X+W
GFILL X,Y,X+1,Y+H,_CGRAY

'===============
' PUT EDIT AREA 
'===============
@EDAREAPUT
EX=CX+BGX:EY=CY+BGY:NX=DLW*DLH
S=16*ZML:S$=" "
FOR Y=0 TO DLH-1
 FOR X=0 TO DLW-1
  '---
  IF EX+X<0 || EX+X>=BGW THEN CONTINUE
  IF EY+Y<0 || EY+Y>=BGH THEN CONTINUE
  '---
  DISPLAY 0
  I=BGGET(LYB,EX+X,EY+Y) 'back
  GETATR I OUT C,RT,RH,RV,U2,V2
  A2=(RT*2) OR (RH*8) OR (RV*16) OR 1
  '
  I=BGGET(LY,EX+X,EY+Y) 'front(edit)
  GETATR I OUT C,RT,RH,RV,U,V
  A=(RT*2) OR (RH*8) OR (RV*16) OR 1
  '---
  DISPLAY 1:IX=Y*DLW+X
  SPCHR IX,U*16,V*16,16,16,A
  SPCHR NX+IX,U2*16,V2*16,16,16,A2
  '--- atr
  LOCATE X*2,3+Y*2:C=15:CB=0
  IF CMD==MDATRIX THEN
   S$=STRATR$[ ATR%[ I AND &HFFF ] ]
   C=15:CB=9
  ENDIF
  COLOR C,CB:PRINT S$;
  '
 NEXT
NEXT
'---
COLOR 7,0
LOCATE 30,0
PRINT FORMAT$("v%.2F",VER);
COLOR 15,0
RETURN

'---
@EDAREACSR
IF CPSW==0 THEN RETURN
'---
DISPLAY 1
CC=((FC AND 7) << 4) + &H80
WW=CPW:IF CPW>DLW THEN WW=DLW
HH=CPH:IF CPH>DLH THEN HH=DLH
FOR Y=0 TO HH-1
 FOR X=0 TO WW-1
  IX=SPTILE+Y*WW+X
  SPSHOW IX
  I=TMPC%[X+Y*CPW]
  GETATR I OUT C,RT,RH,RV,U,V
  SPCHR IX,U*16,V*16,16,16,A
  XX=EHX+(CPX+X)*16
  YY=EHY+(CPY+Y)*16
  SPOFS IX,XX,YY,SPZ-100
  SPCOLOR IX,RGB(128,CC,CC,CC)
 NEXT
NEXT
RETURN

'---
@EDAREACLR
DISPLAY 1
S=16*ZML
FOR Y=0 TO DLH-1
 FOR X=0 TO DLW-1
  IX=SPTILE+Y*DLW+X
  SPHIDE IX
 NEXT
NEXT
'---
COLOR 14
X=THX/8:Y=THY/8
FOR I=0 TO 12*2-1
 LOCATE X,Y+I
 PRINT ""*(40-X);
NEXT
COLOR 15
RETURN

'---
@TILEINIT
DISPLAY 1
FOR Y=0 TO TSY-1
 FOR X=0 TO TSX-1
  IX=SPTILE+Y*TSX+X
  SPSET IX,0,0,16,16,1
  SPOFS IX,THX+X*16,THY+Y*16,SPZ
  SPSCALE IX,ZMT,ZMT
  SPCOLOR IX,RGB(255,255,255,255)
  SPSHOW IX
 NEXT
NEXT
'---
X=THX/8:Y=THY/8
FOR I=0 TO 12*2-1
 LOCATE X,Y+I
 PRINT " "*(40-X);
NEXT
RETURN

'====================
' stick repeat check
'====================
@STKSUB
SVX=0:SVY=0
IF STX<-0.2 THEN SVX=-1
IF STX> 0.2 THEN SVX=1
IF STY<-0.2 THEN SVY=1
IF STY> 0.2 THEN SVY=-1
IF SVX==0 && SVY==0 THEN STC=0:RETURN
'
STC=STC+1
IF STC==1 THEN RETURN
'
I=STC-RP1
IF I>=0 && (I MOD RP2)==0 THEN RETURN
'
SVX=0:SVY=0
RETURN

'===============
' USER FUNCTION
'===============

'---
DEF CLRMSG
DISPLAY 1
COLOR 15,0
LOCATE 0,26
PRINT " "*28;
MSG$=""
END
'---
DEF PUTMSG T$
IF T$=="" THEN RETURN
MSG$=T$
DISPLAY 1
LOCATE 0,26
COLOR 15,((FC>>4) AND 1)*8
PRINT MSG$+(" "*(28-LEN(MSG$)));
COLOR 15,0
END

'---
DEF PUTSTR X,C,T$
DISPLAY 0
LOCATE X,29
COLOR C,8
PRINT T$;
COLOR 15,0
END

'---
DEF CALCSIZE()
BGW=DW*MX:BGH=DH*MY:MAX=BGW*BGH
IF MAX>16383 THEN RETURN FALSE
IF BGL<1 OR BGL>4 THEN RETURN FALSE
'---
DISPLAY 0
FOR L=0 TO BGL-1
 BGCLR L
 BGSCREEN L,BGW,BGH
 BGOFS L,BGX,BGY
 BGSCALE L,ZMH,ZMH
 BGSHOW L
NEXT
'---
RETURN TRUE
END

'---
DEF HIT( X,Y,W,H )
IF TCX<X THEN RETURN FALSE
IF TCX>X+W-1 THEN RETURN FALSE
IF TCY<Y THEN RETURN FALSE
IF TCY>Y+H-1 THEN RETURN FALSE
RETURN TRUE
END

'---
DEF GETATR I OUT N,RT,RH,RV,U,V
RV=0:IF I AND &H8000 THEN RV=1
RH=0:IF I AND &H4000 THEN RH=1
RT=(I/&H1000) AND &H3
N=I AND &HFFF
U=FLOOR(N MOD TCW)
V=FLOOR(N/TCW)
END

'--- 
DEF BUTVEC B OUT VX,VY
VX=0:VY=0
IF B AND 1 THEN VY=VY-1
IF B AND 2 THEN VY=VY+1
IF B AND 4 THEN VX=VX-1
IF B AND 8 THEN VX=VX+1
RETURN
END


'==================
' GET BUTTON VALUE
'==================
DEF GETBUT I OUT X,Y,T$,W,H
X=FNCX[I]:Y=FNCY[I]
T$=FNCTX$[I]
W=STRW(T$):H=15
END

'=============
'
'============
DEF STRW(T$)
VAR I,W=LEN(T$)*6+8
FOR I=0 TO LEN(T$)-1
 IF MID$(T$,I,1)==" " THEN DEC W,3
NEXT
RETURN W
END

'
'PUT BUTTON
'
DEF PUTBUT I,C
'---
VAR O=DISPLAY():DISPLAY 1
VAR X,Y,W,H
GETBUT I OUT X,Y,T$,W,H
'---
GFILL X,Y+1,X+W-1,Y+H-2,C
GFILL X+1,Y,X+W-2,Y+H-1,C
GPUTSTR X+3,Y+4,FNCTX$[I],_CTEXT
'--- atr
IF I==MDATRIX THEN
 GPUTSTR X+12,Y+4,STRATR$[ATRTP],_CTEXT
ENDIF
'---
DISPLAY O
END

'==============
' FILE UTILITY
'==============
@FILE
DATA "機能を選んでボタンを押して下さい"
DATA " "
DATA "Aボタン:LOAD（データ読み込み）"
DATA "Xボタン:SAVE（データ保存）"
DATA "Yボタン:マップデータ初期化"
DATA " "
DATA "Bボタン:ツールに戻る"
DATA ""
R=DLG( "@FILE",-1,"ファイル管理メニュー" )
J$=""
IF R==128 THEN J$="@FLOAD0"
IF R==130 THEN J$="@FSAVE0"
IF R==131 THEN J$="@FALLCLR"
IF J$!="" && CHKLABEL(J$) THEN GOSUB J$
RETURN

'===========
' ALL CLEAR
'===========
@FALLCLR
R=DIALOG( "マップを初期化しますか？",1,"マップ初期化の確認" )
IF R==-1 THEN RETURN
@ALLCLR
FOR I=0 TO ATRMAX-1:ATR%[I]=0:NEXT
BGCLR
RETURN

'===============
' RESIZE SCREEN
'===============
@FRESIZE
PRINT "RESIZE(HI=25×15/LO=20×15)"
TXLINEB
OLDW=DW:OLDH=DH:OLDMX=MX:OLDMY=MY:OLDL=BGL
'---
@RESZLOOP
DW=GETNUM("BASEX",DW,8,32)
DH=GETNUM("BASEY",DH,8,32)
'---
MAX=MAPMAX DIV (DW*DH)
MX=GETNUM("MAPX",MX,1,MAX)
MAX=MAX DIV MX
MY=GETNUM("MAPY",MY,1,MAX)
'---
BGL=GETNUM("LAYER",BGL,1,4)
TXLINEB
'---
X=DW*MX:Y=DH*MY
PRINT"SCREEN(";X;",";Y;") ";
PRINT"DOT(";X*16;",";Y*16;")"
PRINT"TOTAL MEMORY(";X*Y;"/";MAPMAX;") ";
PRINT"REST(";MAPMAX-(X*Y);")"
R=CALCSIZE():TXLINE
K$=GETKEY$("ARE YOU SURE?[Y/N]")
IF K$!="Y" THEN @RESZLOOP
RETURN

'======
' SAVE
'======
@FSAVE0
DATA "保存対象を選んで下さい"
DATA " "
DATA "Aボタン：マップデータ"
DATA "Xボタン：BGSCREENデータ"
'DATA "Yボタン："
DATA " "
DATA "Bボタン：ツールに戻る"
DATA ""
R=DLG( "@FSAVE0",-1,"保存対象の選択" )
IF R==128 THEN @FSAVE
IF R==130 THEN @FSAVEBG
RETURN

'---
@FSAVE
FILESW=TRUE:C$="SAVEするMAPの名前"
N$=GETNAME$("DAT",TMP$,"MAP",10,C$)
IF N$!="" THEN SAVESUB N$
RETURN

'---
@FSAVEBG
FILESW=TRUE:C$="SAVEするBGSCREENの名前"
N$=GETNAME$("DAT",TMP$,"SC",8,C$)
IF N$!="" THEN SCSAVESUB N$
RETURN

'===============
' BGSCREEN SAVE
'===============
DEF SCSAVESUB N$
DISPLAY 0
'---
DIALOG "BGSCREENを4まいSAVEします",0,"かくにん"
'---
DIM TMP%[MAPMAX]
FOR I=0 TO BGL-1
 BGSAVE I,TMP%
 SAVE N$+"_L"+STR$(I),TMP%
NEXT
END

'===========================
DEF SAVESUB N$
'---
ATRSIZE=ATRMAX DIV 4
BGSIZE=(BGW*BGH) DIV 2
WMAX=HEADMAX+ATRSIZE+(BGSIZE*4)
DIM W%[WMAX]
'--- HEADER
W%[H_ID]=ID:W%[H_VR]=VER
W%[H_R2]=0 :W%[H_LY]=BGL
W%[H_DW]=DW:W%[H_DH]=DH
W%[H_MX]=MX:W%[H_MY]=MY
'--- ATR[]
TOP=HEADMAX
FOR I=0 TO ATRMAX-1 STEP 4
 V%=ATR%[I+0] AND &HFF
 V%=V% OR ((ATR%[I+1] AND &HFF)<<8)
 V%=V% OR ((ATR%[I+2] AND &HFF)<<16)
 V%=V% OR ((ATR%[I+3] AND &HFF)<<24)
 W%[TOP]=V%
 TOP=TOP+1
NEXT
'--- TMP0[]-TMP3[]
DISPLAY 0
DIM TMP%[MAPMAX]
FOR I=0 TO BGL-1
 BGSAVE I,TMP%
 FOR Y=0 TO BGH-1
  FOR X=0 TO BGW-1 STEP 2
   O=X+Y*BGW
   V%=(TMP%[O+0] AND &HFFFF)
   V%=V% OR ((TMP%[O+1] AND &HFFFF)<<16)
   W%[TOP]=V%
   TOP=TOP+1
  NEXT
 NEXT
NEXT
'---
SAVE N$,W%
END

'======
' LOAD
'======
@FLOAD0
DATA "LOAD対象を選んで下さい"
DATA " "
DATA "Aボタン：マップデータ"
DATA "Xボタン：BGSCREENデータ"
'DATA "Yボタン："
DATA " "
DATA "Bボタン：ツールに戻る"
DATA ""
R=DLG( "@FLOAD0",-1,"LOAD対象の選択" )
IF R==128 THEN @FLOAD
IF R==130 THEN @FLOADBG
RETURN

'--- 
@FLOAD
FILESW=TRUE:C$="LOADするMAPの名前"
N$=GETNAME$("DAT",TMP$,"MAP",10,C$)
IF N$!="" THEN LOADSUB N$
RETURN

'--- 
@FLOADBG
FILESW=TRUE:C$="LOADするBGSCREENの名前"
N$=GETNAME$("DAT",TMP$,"SC",8,C$)
IF N$!="" THEN SCLOADSUB N$
RETURN

'===============
' BGSCREEN LOAD
'===============
DEF SCLOADSUB N$
DISPLAY 0
'---
DIALOG "BGSCREENを4まいLOADします",0,"かくにん"
'---
DIM TMP%[MAPMAX]
FOR I=0 TO BGL-1
 LOAD N$+"_L"+STR$(I),TMP%,FALSE
 IF RESULT==TRUE THEN
  BGLOAD I,TMP%
 ENDIF
NEXT
END

'===========================
DEF LOADSUB N$
'--- 
ATRSIZE=ATRMAX DIV 4
WMAX=HEADMAX+ATRSIZE+(MAPMAX*4)
DIM W%[WMAX]
'---
LOAD N$,W%
IF RESULT==FALSE THEN RETURN
'--- HEADER
IF W%[H_ID]!=ID THEN
 ERROR "ERROR< BAD ID >"
 RETURN
ENDIF
BGL=W%[H_LY]
DW=W%[H_DW]:DH=W%[H_DH]
MX=W%[H_MX]:MY=W%[H_MY]
R=CALCSIZE()
'--- ATR[]
TOP=HEADMAX
FOR I=0 TO ATRMAX-1 STEP 4
 ATR%[I+0]=W%[TOP] AND &HFF
 ATR%[I+1]=(W%[TOP]>>8) AND &HFF
 ATR%[I+2]=(W%[TOP]>>16) AND &HFF
 ATR%[I+3]=(W%[TOP]>>24) AND &HFF
 TOP=TOP+1
NEXT
'--- TMP0[]-TMP3[]
DISPLAY 0
BGCLR
DIM TMP%[BGH*BGW]
FOR I=0 TO BGL-1
 FOR Y=0 TO BGH-1
  FOR X=0 TO BGW-1 STEP 2
   O=X+Y*BGW
   TMP%[O+0]=W%[TOP] AND &HFFFF
   TMP%[O+1]=(W%[TOP]>>16) AND &HFFFF
   TOP=TOP+1
  NEXT
 NEXT
 BGLOAD I,TMP%
NEXT
END

'==========
' GET NAME
'==========
DEF GETNAME$( G$,F$,T$,CNT,C$ )
'--- かたていぎ
IF G$!="" THEN G$=G$+":"
'--- キャプションさくせい
C$=C$+"("+G$
IF T$!="" THEN C$=C$+T$+"_"
C$=C$+"name"
IF E$!="" THEN C$=C$+"_"+E$
C$=C$+")["+STR$(CNT)+"]"
'--- ダイアログでもじにゅうりょく
TMP$=F$:F$=DIALOG( F$,C$,CNT )
'IF RESULT==-1 THEN RETURN ""
'IF RESULT==FALSE THEN RETURN ""
IF F$=="" THEN RETURN ""
'--- ながさいないにきょうせいてきにへんこう
IF LEN(F$)>CNT THEN F$=MID$(F$,0,CNT)
'--- きおくする
TMP$=F$
'--- そうしょくもじれつをたす
IF T$!="" THEN G$=G$+T$+"_"
F$=G$+F$
RETURN F$
END

'=======
' ERROR
'=======
DEF ERROR T$
BEEP:COLOR 3
K$=GETKEY$( T$ )
COLOR 15
END

'============
' GET NUMBER
'============
DEF GETNUM( T$,V,MIN,MAX )
'
IF V<MIN THEN V=MIN
IF V>MAX THEN V=MAX
'
PRINT T$;"(";MIN;"-";MAX;"/";V;"):";
X=CSRX:Y=CSRY
'
@GNLOOP
VSYNC 1:LOCATE X,Y:LINPUT K$
IF K$=="" THEN N=V ELSE N=VAL(K$)
LOCATE X,Y:PRINT " "*LEN(K$);
IF N<MIN || N>MAX THEN @GNLOOP
'
LOCATE X,Y:PRINT N
RETURN N
END

'=========
' GET KEY
'=========
DEF GETKEY$( T$ )
'
PRINT T$;"(";CHR$(&HE20D);"):";
X=CSRX:Y=CSRY
'
@GKLOOP
VSYNC 1:LOCATE X,Y:LINPUT K$
K$=MID$(K$,0,1)
IF K$=="" THEN @GKLOOP
'
IF K$>="a" && K$<="z" THEN
 K$=CHR$((ASC(K$)-ASC("a"))+ASC("A"))
ENDIF
'
LOCATE X,Y:PRINT K$:TXLINE
RETURN K$
END

'===========
' TEXT LINE
'===========
DEF TXLINE
COLOR 14:PRINT "-"*50:COLOR 15
END
DEF TXLINEB
COLOR 14:PRINT ""*50:COLOR 15
END

'========
' DIALOG
'========
DEF DLG( D$,TP,C$ )
T$="":RESTORE D$
WHILE 1
 READ R$:IF R$=="" THEN BREAK
 T$=T$+R$+CHR$(10)
WEND
RETURN DIALOG( T$,TP,C$ )
END

'===========
' GPUTSTR
'===========
DEF GPUTSTR X,Y,T$,C
VAR N,V
VAR C$
FOR N=0 TO LEN(T$)-1
 C$=MID$(T$,N,1)
 V=6:IF C$=="I" THEN DEC X:V=5
 IF C$==" " THEN V=3
 GPUTCHR X,Y,C$,C:INC X,V
NEXT
END
ページトップへ