'
' MAP EDITOR
'
' (C)SmileBoom
'

BGL=4:XSCREEN 2,0,BGL
RP1=10:RP2=1:RC1=10:RC2=1:VER=1.0
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
'
' 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 FNCM[FMAX]
DIM FNCST[FMAX]
'
DATA "0 1 2 3",0,0,0,"@HIPAGE",&HF
DATA "",9,0,0,"@HIGRID",1
DATA "",12,0,0,"@HIZOOM",3
DATA "0 1 2 3",17,0,1,"@LOBACK",3
DATA "" ,26,0,1,"@LOGRID",1
'
DATA "S",0,28,0,"@MDSET",0
DATA "F",3,28,0,"@MDFILL",0
DATA "C",6,28,0,"@MDCOPY",0
DATA "A ",9,28,0,"@MDATR",0
DATA "",13,28,0,"@UNDO",0
DATA "0 1 2 3",20,28,0,"@LOPAGE",2
'
DATA "0  ",29,28,0,"@ATR90",0
DATA "H",34,28,0,"@ATRH",0
DATA "V",37,28,0,"@ATRV",0
'
DATA ""
'---
I=0
WHILE 1
 READ R$
 IF R$=="" THEN BREAK
 FNCTX$[I]=R$
 READ FNCX[I],FNCY[I],FNCM[I]
 READ FNCJP$[I],FNCST[I]
 I=I+1
WEND
FNCMAX=I
'---
MDSETIX =-1:MDFILLIX=-1
MDCOPYIX=-1:MDATRIX =-1
EXITSW=FALSE

'=========
' RESTART
'=========
@RESTART
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:NEXT
OLDBGX=BGX:OLDBGY=BGY
'---
VSYNC 1
FC=FC+1
'--- :FILE
IF BRP==&H80 THEN
 GOSUB @FILE
 GOTO @RESTART
ENDIF
'--- :EXIT
IF BRP==&H40 THEN EXITSW=TRUE
IF EXITSW==FALSE THEN @MLOOP

'======
' EXIT
'======
VISIBLE 1,0,0,0:DISPLAY 0:CLS
PRINT "EXIT":TXLINEB
K$=GETKEY$("ARE YOU SURE?[Y/N]")
IF K$!="Y" THEN
 EXITSW=FALSE
 GOTO @RESTART
ENDIF
K$=GETKEY$("DATA SAVE[Y/N]")
IF K$=="Y" THEN GOSUB @FSAVE
K$=GETKEY$("TMPSAVE[Y/N]")
IF K$=="Y" THEN GOSUB @TMPSAVE
'---
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

LOCATE 0,0:PRINT TX,TY,EX,EY
'
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)
U=TLX*16:V=TLY*16
IX=SPTILE
SPCHR IX,U,V,TSX*16,TSY*16,A OR 1
'SPOFS IX,TLX*16,TLY*16
GOSUB @PUT_TILEGRID
RETURN

'---
@PUT_TILEINFO
DISPLAY 1
COLOR 15:LOCATE 34,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
 GOSUB @GETBUT
 IF HIT(X*8-6,Y*8-6,L*8+12,8+12) THEN
  OX=(TCX-X*8) DIV 8
  IF OX< 0 THEN OX=0
  IF OX>=L THEN OX=L-1
  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 2
FNCST[BIX]=FNCST[BIX] XOR (1 << OX)
'---
@HIPAGEPUT
COLOR 14,0:LOCATE X,Y:PRINT T$
COLOR 15,9
FOR I=0 TO 3
 IF FNCST[BIX] AND (1<<I) THEN
  LOCATE X+I*2,Y:PRINT MID$(T$,I*2,1);
  DISPLAY 0:BGSHOW I:DISPLAY 1
 ELSE
  DISPLAY 0:BGHIDE I:DISPLAY 1
 ENDIF
NEXT
COLOR 15,0
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==0 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
LYB=OX DIV 2:SW=1
'---
@LOBACKPUT
L=LYB:GOTO @PUTLAYNO

'====================
@LOPAGE
LY=OX DIV 2:SW=1
'---
@LOPAGEPUT
L=LY
'---
@PUTLAYNO
COLOR 14,0:LOCATE X,Y:PRINT T$
COLOR 15,9
FOR I=0 TO 3
 IF I==L THEN
  LOCATE X+I*2,Y:PRINT MID$(T$,I*2,1);
 ENDIF
NEXT
COLOR 15,0
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
GOSUB @GETBUT
RETURN
'---
@MDPUTSUB
IF BIX==-1 THEN RETURN
C=14:CB=0
IF BIX==CMD THEN C=15:CB=9
GOSUB @GETBUT
LOCATE X,Y:COLOR C,CB:PRINT T$;
IF BIX==MDATRIX THEN
 LOCATE X+1,Y:PRINT STRATR$[ATRTP];
ENDIF
RETURN

'====================
@ATR90
AR=(AR+1) AND 3:SW=1
GOSUB @MKATR
'---
@ATR90PUT
LOCATE X,Y:PRINT FORMAT$("%3D",AR*90)
COLOR 15,0
RETURN
'---
@ATRH
AH=AH XOR 1:SW=1
GOSUB @MKATR
RETURN
'---
@ATRV
AV=AV XOR 1:SW=1
'---
@MKATR
BGATR=AR*&H1000
BGATR=BGATR OR (AH*&H4000)
BGATR=BGATR OR (AV*&H8000)
RETURN

'====================
@UNDOINIT
UNDOIX=BIX:RETURN
'---
@UNDOPUT
DISPLAY 1
C=14:IF UNDOSW THEN C=7
COLOR C,0
LOCATE X,Y:PRINT T$
COLOR 15,0
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
GOSUB @GETBUT
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
LOCATE 0, 2:PRINT ""*40;
LOCATE 0,27:PRINT ""*40;
FOR BIX=0 TO FNCMAX-1
 PUTBUT BIX
 JP$=FNCJP$[BIX]+"INIT"
 IF CHKLABEL(JP$) THEN
  GOSUB @GETBUT:GOSUB JP$
 ENDIF
 JP$=FNCJP$[BIX]+"PUT"
 IF CHKLABEL(JP$) THEN
  GOSUB @GETBUT:GOSUB JP$
 ENDIF
NEXT

'--- guide
COLOR 14
X=(THX DIV 8)-2
LOCATE X,3:PRINT"";
FOR I=4 TO 25
 LOCATE X,I:PRINT"";
NEXT
LOCATE X,I:PRINT"";
'
'LOCATE 0,25:PRINT"";""*26;"";
'LOCATE 0,26:PRINT"";""*26;"";
'---
COLOR 0,14
LOCATE  4,1:PRINT"show";
LOCATE 21,0:PRINT"back";
LOCATE 24,29:PRINT"edit";
LOCATE 30,29:PRINT"rot";
COLOR 15,0

'===============
' 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 35,0
PRINT FORMAT$("v%.2F",VER);
COLOR 15,0
LOCATE 30,1
PRINT "BG#:"
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
IX=SPTILE
SPSET IX,0,0,TSX*16,TSY*16,1
SPOFS IX,THX,THY,SPZ
SPSCALE IX,ZMT,ZMT
SPCOLOR IX,RGB(255,255,255,255)
SPSHOW IX
'---
X=THX/8:Y=THY/8
FOR I=0 TO 12*2-1
 LOCATE X,Y+I
 PRINT " "*(40-X);
NEXT
RETURN

'==================
' GET BUTTON VALUE
'==================
@GETBUT
X=FNCX[BIX]+1
Y=FNCY[BIX]+FNCM[BIX]
T$=FNCTX$[BIX]
L=LEN(FNCTX$[BIX])
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

'---
DEF PUTBUT I
 
 O=DISPLAY():DISPLAY 1
 X=FNCX[I]:Y=FNCY[I]
 L=LEN(FNCTX$[I])
 COLOR 14,0
 '
 IF FNCM[I]==1 THEN
  LOCATE X,Y:PRINT "";""*L;"";
  Y=Y+1
 ELSE
  IF Y>0 THEN
   LOCATE X,Y-1:PRINT "";""*L;"";
  ENDIF
 ENDIF
 '
 LOCATE X,Y:PRINT "";FNCTX$[I];"";
 Y=Y+1
 '
 IF FNCM[I]==1 THEN
  LOCATE X,Y:PRINT "";""*L;"";
 ELSE
  LOCATE X,Y:PRINT "";""*L;"";
 ENDIF
 '
 COLOR 15,0
 DISPLAY O
 
END

'---
DEF GETBUT I OUT X,Y,T$,S,L
 X=FNCX[I]+1
 Y=FNCY[I]+FNCM[I]
 T$=FNCTX$[I]
 L=LEN(T$)
END

'==============
' FILE UTILITY
'==============
@FILE
DISPLAY 0:VISIBLE 1,0,0,0:CLS
PRINT "FILE UTILITY":TXLINEB
'
PRINT "'L'=LOAD"
PRINT "'S'=SAVE"
'PRINT "'R'=RESIZE SCREEN"
PRINT "'A'=CLEAR ALL SCREEN"
PRINT "'X'=EXIT"
TXLINE
'
@FUTLOOP
K$=GETKEY$("command?[L/S/A/X]")
J$=""
IF K$=="L" THEN J$="@FLOAD"
IF K$=="S" THEN J$="@FSAVE"
'IF K$=="R" THEN J$="@FRESIZE"
IF K$=="A" THEN J$="@FALLCLR"
IF K$=="X" THEN EXITSW=TRUE
'---
IF J$!="" && CHKLABEL(J$) THEN GOSUB J$
'---
@FEND
VISIBLE 1,1,1,1:DISPLAY 1:CLS
RETURN

'===========
' ALL CLEAR
'===========
@FALLCLR
PRINT "ALL CLEAR":TXLINEB
K$=GETKEY$("ARE YOU SURE?[Y/N]")
IF K$!="Y" 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
'======
@FSAVE
PRINT "SAVE":TXLINEB
N$=GETNAME$()
IF N$!="" THEN SAVESUB N$
TXLINE
RETURN
'---
@TMPSAVE
SAVESUB "DAT:SBMAP_TMP"
RETURN

'---
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
'======
@FLOAD
PRINT "LOAD":TXLINEB
N$=GETNAME$()
IF N$!="" THEN LOADSUB N$
RETURN
'---
@TMPLOAD
N$="DAT:SBMAP_TMP"
IF CHKFILE(N$)==FALSE THEN RETURN
K$=GETKEY$("LOAD TMPFILE?[Y/N]")
IF K$=="Y" THEN LOADSUB N$
RETURN

'---
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$()
 LINPUT "filename?:";F$
 IF F$!="" THEN F$="DAT:"+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