プログラムリスト
SYS/SBANM

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

'
' ANIMATION EDITOR
'
' (C)2014 SmileBoom
'
MAXSP=200:BGZ=300:SPZ=200:GRZ=100
XSCREEN 2,MAXSP,2
FOR I=0 TO 1
 DISPLAY 0:VISIBLE 1,1,1,1:CLS
 SPPAGE 4:BGPAGE 5
NEXT
VER=1:RP1=15:RP2=4
FOR I=0 TO 7:BREPEAT I,RP1,RP2:NEXT
LC=RGB(16,16,16):OFFC=8:SELC=9:GC=14:WC=15
COLOR WC,0:CLS
DISPLAY 0:VISIBLE 1,0,0,0
PRINT "SPDEF/SPANM data setting tool"
TXLINEB
'---
MAXBW=30:BWCNT=0:BWPAGE=1
_X=0:_Y=1:_W=2:_H=3:_D=4:_S=5:_MAX=6
DIM BWORK%[MAXBW,_MAX],BSUB$[MAXBW]
DIM NM%[5]:FOR I=0 TO 4:READ NM%[I]:NEXT
DATA 10000,1000,100,10,1
DIM SW$[2]:SW$[0]="OFF":SW$[1]=" ON"
DIM NK%[16]:FOR I=0 TO 15:READ NK%[I]:NEXT
DATA 7,8,9,-1, 4,5,6,-2
DATA 1,2,3,-3, 0,-4,-5,-3
DIM CNO[4],CTMP[4]
CNO[0]=1:CNO[1]=3:CNO[2]=5:CNO[3]=9
'---
LAYTP=0:MAXLAYTP=3:ZMIX=0
DIM LAY$[MAXLAYTP]
LAY$[0]="":LAY$[1]="":LAY$[2]=""
DIM LAYHX[MAXLAYTP],LAYHY[MAXLAYTP]
LAYHX[0]=200:LAYHX[1]=0:LAYHX[2]=200
LAYHY[0]=120:LAYHY[1]=0:LAYHY[2]=239
'---
NDIX=0:NDOFS=0:ENTMODE=0
GOSUB @RESETANM
GOSUB @RESETSPD
'---
ZM=1:HMX=LAYHX[LAYTP]:HMY=LAYHY[LAYTP]
STW1=0:STW2=0:SVX=0:SVY=0
TCW1=0:TCW2=0:TVX=0:TVY=0
MD$="":FC=0:MODE=1:EXITSW=FALSE
DISPLAY 0:VISIBLE 1,1,1,1
'---
@RESTART
ON MODE GOSUB @INITSPD,@INITANM
'---
@MLOOP
BRP=BUTTON(1)
SFT=BUTTON(0) AND &H300
STICK OUT STX,STY
GOSUB @STKSUB
TOUCH OUT TCS,TCX,TCY
GOSUB @TCHSUB
GOSUB @HITMAIN
IF MD$!="" THEN GOSUB MD$:MD$=""
'---
FC=FC+1
VSYNC 1
'--- :FILE
IF BRP==&H80 THEN
 GOSUB @FILE
 GOTO @RESTART
ENDIF
'--- :EXIT
IF BRP==&H40 THEN EXITSW=TRUE
IF EXITSW==FALSE THEN @MLOOP

'======
' EXIT
'======
DISPLAY 0:VISIBLE 1,0,0,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

'---
@PUTASTAT
LOCATE 0,29
PRINT "=ADJUST =MOVE ";
PRINT "=EXIT =FILE";
LOCATE 42,29:PRINT FORMAT$("ver%.2F",VER);
RETURN

'====================
' reset SPANM() work
'====================
@RESETANM
EDW=3:EDH=10:ESX=5:ESY=2:EDOFS=0
'---
_TPXY=0:_TPZ=1:_TPDEF=2
_TPSC=3:_TPROT=4:_TPCOL=5:_TPV7=6
MAXTP=7:TPIX=0
DIM TP$[MAXTP,EDW]
DIM TPST%[MAXTP,3]
'---
@GRP
DATA "XY","Z","I","S","R","C","V"
DIM GRP$[MAXTP]:COPY GRP$,"@GRP"
'---
@TPNAME
DATA "XY","X   ","Y   ",0,-512,512
DATA "Z" ,"Z   ","    ",0,-256,1024
DATA "DF","DEF ","    ",0,0,4095
DATA "SC","SCLX","SCLY",100,0,9999
DATA "RT","ROT ","    ",0,-360,360
DATA "CL","ARGB","    ",9999,0,9999
DATA "V7","V7H ","V7L ",0,0,255
RESTORE @TPNAME
FOR I=0 TO MAXTP-1
 READ TP$[I,0],TP$[I,1],TP$[I,2]
 READ TPST%[I,0],TPST%[I,1],TPST%[I,2]
NEXT
'---
MAXAC=64:ACIX=0:ACOFS=0:ACCY=0
MAXND=16:NDLVL=7
FRCNT=1:MAXFR=16:FRSIZE=MAXFR*EDW
ACSIZE=MAXND*MAXTP*FRSIZE
DIM EWORK%[MAXFR,EDW]
'---
_FRCNT=0:_LOOP=1:MAXSYS=2:MAXLOOP=999
_NDCNT=0
DIM ACT%[MAXAC,MAXND,MAXTP,FRSIZE]
DIM ASYS%[MAXAC,MAXND,MAXTP,MAXSYS]
DIM LINK%[MAXAC,MAXND]
DIM PARENT%[MAXAC,MAXND]
DIM NDC%[MAXAC]
DIM ACNM$[MAXAC]
'---
ACOPYSW=0:NCOPYSW=0
DIM _ACWK%[MAXND,MAXTP,FRSIZE]
DIM _ASYSWK%[MAXND,MAXTP,MAXSYS]
DIM _LKWK%[MAXND]
DIM _NDCNT%
'---
NCOPYSW=0
DIM _NDWK%[MAXTP,FRSIZE]
DIM _FRCNT%[MAXTP]
'---
PRINT "MEM:";MAXAC*MAXND*MAXTP*FRSIZE
TXLINEB
'---
PRINT "initialize SPANM()"
PRINT "action(";MAXAC;") ";
PRINT "node(";MAXND;") ";
PRINT "type(";MAXTP;") ";
PRINT "frame(";MAXFR;") ";
PRINT "edit(";MAXED;") "
FOR N=0 TO MAXND-1
 '
 LINK%[0,N]=1
 PARENT%[0,N]=0
 '
 FOR T=0 TO MAXTP-1
  ASYS%[0,N,T,_FRCNT]=1
  ASYS%[0,N,T,_LOOP]=0
  FOR F=0 TO MAXFR-1
   OFS=F*EDW
   ACT%[0,N,T,OFS+0]=1 'def frame counter
   ACT%[0,N,T,OFS+1]=TPST%[T,0] 'def val
   ACT%[0,N,T,OFS+2]=TPST%[T,0] '
  NEXT
 NEXT
 
 ' TEST
' ACT%[0,N,_TPDEF,1]=RND(4096)
 '
NEXT
'--- root
LINK%[0,0]=0

'--- action work reset
FOR AC=0 TO MAXAC-1
 '---
 ACNM$[AC]=FORMAT$("ACT%02D",AC)
 '---
 COPY ACT%,AC*ACSIZE,ACT%,0,ACSIZE
 S=MAXND
 COPY LINK%,AC*S,LINK%,0,S
 COPY PARENT%,AC*S,PARENT%,0,S
 S=MAXND*MAXTP*MAXSYS
 COPY ASYS%,AC*S,ASYS%,0,S
 '---
 NDC%[AC]=1
NEXT
NDCNT=NDC%[0]

'---
TXLINEB
RETURN

'===================
' init SPANM() tool
'===================
@INITANM
BWCNT=0:MODE=1:CPYFLG=0

'---
DISPLAY 0:VISIBLE 1,1,1,1
GOSUB @BACK:CLS:GOSUB @PUTASTAT
GRID 0,0,400,240,16,16,LC
'--- set node sprite
FOR N=0 TO MAXND-1
 SPSET N,N
 SPOFS N,0,0,SPZ
 SPUNLINK N
 SPHIDE N
NEXT

'---
DISPLAY 1:VISIBLE 1,1,1,1
GOSUB @BACK:CLS
GRID 0,0,320,240,16,16,LC
TBOX 31,27,9,3,0,""," SPDEF","@SPD"
TBOX 31,0,5,3,0,"",LAY$[LAYTP],"@LAY"
'TBOX 36,0,4,3,0,"","x ","@ZOOM"
'
TBOX 31,13,9,3,0,"","ANMTEST","@ANMPLAY"

'--- viewer
CPX=31:CPY=3:CPW=9:CPH=9
'TBOX CPX,CPY,CPW,CPH,0,"","",""
OLDSPNO=-1
'
EDX=14:EDY=1:EDCOLX=0
TBOX EDX-5,EDY,22,EDH*2+1,1,"","","@ED"
COLOR GC,0
LOCATE EDX-4,EDY-1
PRINT"NO      X    Y";
LOCATE EDX-1,EDY
PRINT"";
FOR I=0 TO EDH-2
 LOCATE EDX-1,EDY+I*2+1
 PRINT"    "*3;
 LOCATE EDX-5,EDY+I*2+2
 PRINT"";
NEXT
LOCATE EDX-1,EDY+(I*2)+1:PRINT"    "*3;
LOCATE EDX-1,EDY+(I*2)+2:PRINT"";
LOCATE EDX+14,EDY+2:PRINT"";
LOCATE EDX+14,EDY+(EDH*2-2):PRINT"";
'
TPX=EDX-4:TPY=EDY+EDH*2+1:TPW=3:TPH=1
TBOX TPX-1,TPY-1,22,3,0,"","","@TP"
COLOR GC,0
LOCATE TPX-1,TPY-1
PRINT"";
LOCATE TPX+2,TPY  :PRINT"  "*6;
LOCATE TPX+2,TPY+1:PRINT""*6;
OLDTPIX=-1
'
FPX=27:FPY=23
TBOX FPX-1,FPY+1,5,3,0,"","F","@FRINC"
'TBOX 23,24,3,3,0,"","C","@FRCOPY"
'TBOX 23,27,3,3,0,"","P","@FRPASTE"
LPX=27:LPY=28
TBOX LPX-1,LPY-1,5,3,0,""," ∞ ","@FRLOOP"
OLDLOOP=-1

' node tree
OLDGC=GC:GC=4
NDX=1:NDY=13:NDW=NDLVL:NDH=16
NDREDRAW=TRUE
TBOX NDX-1,NDY-1,NDW+2,NDH+2,0,"","","@ND"
COLOR GC,0
TBOX 9,24,5,3,0,"","T","@NDLVL"
TBOX 9,27,5,3,0,"","N","@NDINC"
TBOX 14,24,5,3,0,"","CPY","@NDCP"
TBOX 14,27,5,3,0,"","PST","@NDPS"

' action selector
GC=6:ACX=1:ACY=1:ACH=7
TBOX ACX-1,ACY-1,9,ACH+2,1,"","","@AC"
TBOX 0,9,4,3,0,"","CP","@ACCP"
TBOX 4,9,5,3,0,"","PST","@ACPS"
GC=OLDGC

'--- 
X=31:Y=16:F$="@EDENTER"
GOSUB @NUMINIT
' clear sprite
FOR I=0 TO 99:SPHIDE I:NEXT
' view select node1
SPSET 0,0
SPOFS 0,CPX*8+8,CPY*8+8,SPZ
SPROT 0,0
SPHOME 0,0,0:SPHIDE 0

'---
GOSUB @EDLOAD
GOSUB @SETSP
GOSUB @HITINIT
GOSUB @MKPARENT
GOSUB @SETAWALL
RETURN

'
' to SPDEF
'
@SPDTOUCH
IF TCS!=1 THEN RETURN
MD$="@INITSPD"
RETURN

'
' SPANM() edit
'
@EDPUT
DISPLAY 1

'--- edit index
FOR I=0 TO EDH-1
 IX=I+EDOFS
 LOCATE EDX-4,EDY+I*2+1
 IF IX<FRCNT THEN
  IF EWORK%[IX,0]<0 THEN S$="" ELSE S$=" "
  C=0:IF IX==0 THEN C=3
  COLOR 15,C
  PRINT S$;RIGHT$("0"+STR$(IX),2)
 ELSE
  COLOR GC,0:PRINT "---"
 ENDIF
NEXT
COLOR 15,0

'--- loop/frame cnt
L=ASYS%[ACIX,NDIX,TPIX,_LOOP]
IF OLDLOOP!=L THEN
 OLDLOOP=L:COLOR WC,0
 LOCATE LPX,LPY:S$=" ∞ "
 IF L THEN S$=RIGHT$("00"+STR$(L),3)
 PRINT S$;
ENDIF

'--- cursor
WW=EDW:HH=EDH:SX=ESX:SY=ESY:PX=EDX:PY=EDY+1
GETDT$="@EDGET":GOSUB @CSRPUT

'--- color cursor
IF TPIX==_TPCOL && EDCX==1 THEN
 NX=EDCX:NY=EDCY:IX=NX+NY*EDW:GOSUB @EDGET
 LOCATE EDX+NX*ESX+EDCOL,EDY+NY*ESY+1
 COLOR CNO[EDCOL],15
 PRINT MID$(N$,EDCOL,1);
ENDIF

'--- viewer sprite
N=NDIX:T=_TPDEF:GOSUB @CLCFR
IF OLDSPNO!=V1 THEN
 OLDSPNO=V1
 SPCHR 0,V1
 SPDEF V1 OUT UU,VV,WW,HH
 IF WW==0 THEN WW=1
 IF HH==0 THEN HH=1
 SPOFS 0,CPX*8+4,CPY*8+4,SPZ
 IF WW<HH THEN WW=HH
 SPSCALE 0,64/WW,64/HH
 SPHOME 0,0,0:SPSHOW 0
 LOCATE CPX+1,CPY+9:COLOR WC,0
 PRINT FORMAT$("DF:%4D",V1)
ENDIF
RETURN

'---
@EDENTER
IF EDCX>0 THEN
 LO=TPST%[TPIX,1]:HI=TPST%[TPIX,2]
ELSE
 LO=-999:HI=999
ENDIF
IF N<LO THEN N=LO
IF N>HI THEN N=HI
EWORK%[EDCY+EDOFS,EDCX]=N
GOSUB @EDSAVE
GOSUB @SETSP
'--- cursor down
VX=0:VY=0
IF ENTMODE==1 THEN VX=1
IF ENTMODE==2 THEN VY=1
GOSUB @EDMOVE
RETURN

'---
@EDGET
N$=" "*4
IF NY+EDOFS<FRCNT && TP$[TPIX,NX]!=N$ THEN
 N=EWORK%[NY+EDOFS,NX]
 N$=FORMAT$("%4D",N)
ELSE
 C=GC
ENDIF
RETURN

'---
@EDSET
IF NX>0 THEN
 LO=TPST%[TPIX,1]:HI=TPST%[TPIX,2]
ELSE
 LO=-999:HI=999
ENDIF
IF N<LO THEN N=LO
IF N>HI THEN N=HI
EWORK%[NY+EDOFS,NX]=N
RETURN

'---
@EDBUT
VX=BVX:VY=BVY
@EDMOVE
IF VX==0 && VY==0 THEN RETURN
'---
MX=EDW-1:MY=EDH-1:OY=MAXFR-EDH
EDCX=EDCX+VX
IF EDCX<0 THEN
 EDCX=MX:VY=-1
 IF EDCY==0 THEN
  IF EDOFS==0 THEN EDCX=0:VY=0
 ELSE
  IF EDCY>0 THEN EDCX=MX
 ENDIF
ENDIF
IF EDCX>MX THEN
 EDCX=0:VY=1
 IF EDCY==MY THEN
  IF EDOFS==OY THEN EDCY=MY:EDCX=MX
 ELSE
  IF EDOFS<OY THEN EDCX=0
 ENDIF
ENDIF
'
EDCY=EDCY+VY:VY=0
IF EDCY<0 THEN EDCY=0:VY=-1
IF EDCY>MY THEN EDCY=MY:VY=1
'
EDOFS=EDOFS+VY
IF EDOFS<0 THEN EDOFS=0
IF EDOFS>OY THEN EDOFS=OY
'
N=EWORK%[EDCY+EDOFS,EDCX]
GOSUB @CSRCLC
GOSUB @SETSP
RETURN

'
' stick
'
@EDSTICK
IF SVX==0 && SVY==0 THEN RETURN
NX=1:NY=EDCY
GOSUB "@STK"+TP$[TPIX,0]
GOSUB @EDSAVE
GOSUB @SETSP
RETURN
'--- ofsset x,y
'--- scale x,y
'--- check value7
@STKV7
@STKSC
@STKXY
VV=SVX:N=EWORK%[NY+EDOFS,NX]
IF SFT==0 THEN VV=VV*8:N=(N DIV 8)*8
N=N+VV:GOSUB @EDSET
NX=2
VV=SVY:N=EWORK%[NY+EDOFS,NX]
IF SFT==0 THEN VV=VV*8:N=(N DIV 8)*8
N=N+VV:GOSUB @EDSET
RETURN
'--- ofsset z
'--- def
'--- rotate
@STKRT
@STKZ
@STKDF
VV=SVX:IF SVX==0 THEN VV=-SVY
N=EWORK%[NY+EDOFS,NX]
IF SFT==0 THEN VV=VV*8:N=(N DIV 8)*8
N=N+VV:GOSUB @EDSET
RETURN
'--- color
@STKCL
N=EWORK%[NY+EDOFS,NX]
CTMP[0]=N DIV 1000:N=N MOD 1000
CTMP[1]=N DIV 100 :N=N MOD 100
CTMP[2]=N DIV 10  :N=N MOD 10
CTMP[3]=N MOD 10
EDCOL=EDCOL+SVX
IF EDCOL<0 THEN EDCOL=0
IF EDCOL>3 THEN EDCOL=3
VV=-SVY:C=CTMP[EDCOL]+VV
IF C<0 THEN C=0
IF C>9 THEN C=9
CTMP[EDCOL]=C
N=CTMP[0]*1000+CTMP[1]*100+CTMP[2]*10+CTMP[3]
GOSUB @EDSET
RETURN

'
' touch
'
@EDTOUCH
OFS=EDOFS:MAX=MAXFR-EDH
GOSUB @SLIDER
IF TCHREP()==FALSE THEN VY=0
EDOFS=OFS+VY
IF EDOFS<0 THEN EDOFS=0
IF EDOFS>MAX THEN EDOFS=MAX

'--- smooth sw
IF TCS==1 THEN
 IF TTX>EDX-5 && TTX<EDX-1 THEN
  IF TTY>=EDY && TTY<EDY+EDH*ESY THEN
   IX=((TTY-EDY) DIV ESY)+EDOFS
   IF IX<FRCNT THEN
    EWORK%[IX,0]=-EWORK%[IX,0]
   ENDIF
  ENDIF
 ENDIF
ENDIF

'--- /value
XX=EDX:SX=ESX:MX=XX+EDW*SX
YY=EDY:SY=ESY:MY=YY+EDH*SY
GOSUB @CSRTOUCH
GOSUB @SETAWALL
RETURN

'---
@EDSAVE
FOR F=0 TO MAXFR-1
 FOR I=0 TO EDW-1
  OFS=F*EDW+I
  ACT%[ACIX,NDIX,TPIX,OFS]=EWORK%[F,I]
 NEXT
NEXT
RETURN
'---
@EDLOAD
FOR F=0 TO MAXFR-1
 FOR I=0 TO EDW-1
  OFS=F*EDW+I
  EWORK%[F,I]=ACT%[ACIX,NDIX,TPIX,OFS]
 NEXT
NEXT
'---
@SETSP
D=DISPLAY():DISPLAY 0
FOR N=0 TO MAXND-1
 T=TPIX:GOSUB "@SET"+TP$[T,0]
 SW=(N<NDCNT):IF EDCY+EDOFS>=FRCNT THEN SW=0
 IF SW THEN SPSHOW N ELSE SPHIDE N
NEXT
'---
GOSUB @HICLR
'---
DISPLAY D
N=NDIX:T=TPIX:IX=EDIX+EDOFS
RETURN

'---
@CLCFR
F=EDCY+EDOFS:M=ASYS%[ACIX,N,T,_FRCNT]
IF F>M-1 THEN F=M-1
F=F*EDW
V1=ACT%[ACIX,N,T,F+1]
RETURN

'---
@SETAWALL
DISPLAY 0
FOR N=0 TO NDCNT-1
 GOSUB @SETXY
 GOSUB @SETZ
 GOSUB @SETDF
 GOSUB @SETSC
 GOSUB @SETRT
 GOSUB @SETCL
NEXT
RETURN

'--- ofsset x,y
@SETXY
T=_TPXY:GOSUB @CLCFR
V2=ACT%[ACIX,N,T,F+2]
IF N==0 THEN
 V1=V1*ZM+HMX:V2=V2*ZM+HMY
ENDIF
SPOFS N,V1,V2
RETURN
'--- ofsset z
@SETZ
T=_TPZ:GOSUB @CLCFR
SPOFS N,,,V1
RETURN
'--- def
@SETDF
T=_TPDEF:GOSUB @CLCFR
SPCHR N,V1
RETURN
'--- scale x,y
@SETSC
T=_TPSC:GOSUB @CLCFR
V2=ACT%[ACIX,N,T,F+2]
SPSCALE N,V1/100*ZM,V2/100*ZM
RETURN
'--- rotate
@SETRT
T=_TPROT:GOSUB @CLCFR
SPROT N,V1
RETURN
'--- color
@SETCL
T=_TPCOL:GOSUB @CLCFR
MKCOL V1 OUT WA,WR,WG,WB
SPCOLOR N,RGB(WA,WR,WG,WB)
RETURN
'---
DEF MKCOL C OUT WA,WR,WG,WB
S=255/9
WA=FLOOR(S*(C DIV 1000)):C=C MOD 1000
WR=FLOOR(S*(C DIV 100)) :C=C MOD 100
WG=FLOOR(S*(C DIV 10))  :C=C MOD 10
WB=FLOOR(S*(C MOD 10))
END
'--- value7
@SETV7
T=_TPV7:GOSUB @CLCFR
V2=ACT%[ACIX,N,T,F+2]
SPVAR N,7,V1*256+V2
RETURN

'
' loop control
'
@FRLOOPTOUCH
IF TCHREP()==FALSE THEN RETURN
GOSUB @EDSAVE
L=ASYS%[ACIX,NDIX,TPIX,_LOOP]
IF (TCX-X*8)<(W*8/2) THEN
 IF L>0 THEN L=L-1
ELSE
 IF L<MAXLOOP THEN L=L+1
ENDIF
ASYS%[ACIX,NDIX,TPIX,_LOOP]=L
GOSUB @EDLOAD
RETURN

'
' frame control
'
@FRINCTOUCH
IF TCHREP()==FALSE THEN RETURN
GOSUB @EDSAVE
IF (TCX-X*8)<(W*8/2) THEN
 IF FRCNT>1 THEN FRCNT=FRCNT-1
ELSE
 IF FRCNT<MAXFR THEN FRCNT=FRCNT+1
ENDIF
ASYS%[ACIX,NDIX,TPIX,_FRCNT]=FRCNT
GOSUB @EDLOAD
GOSUB @SETAWALL
RETURN

'
' COPY-NODE
'
@NDCPTOUCH
IF TCS!=1 THEN RETURN
FOR T=0 TO MAXTP-1
 FOR F=0 TO FRSIZE-1
  _NDWK%[T,F]=ACT%[ACIX,NDIX,T,F]
 NEXT
 _FRCNT%[T]=ASYS%[ACIX,NDIX,T,_FRCNT]
NEXT
FCOPYSW=1
RETURN
'---
@NDPSTOUCH
IF TCS!=1 THEN RETURN
IF FCOPYSW==0 THEN RETURN
FOR T=0 TO MAXTP-1
 FOR F=0 TO FRSIZE-1
  ACT%[ACIX,NDIX,T,F]=_NDWK%[T,F]
 NEXT
 ASYS%[ACIX,NDIX,T,_FRCNT]=_FRCNT%[T]
NEXT
GOSUB @REVIEW
RETURN

'
' COPY-ACTION
'
@ACCPTOUCH
IF TCS!=1 THEN RETURN
FOR N=0 TO MAXND-1
 FOR T=0 TO MAXTP-1
  FOR I=0 TO FRSIZE-1
   _ACWK%[N,T,I]=ACT%[ACIX,N,T,I]
  NEXT
  FOR I=0 TO MAXSYS-1
   _ASYSWK%[N,T,I]=ASYS%[ACIX,N,T,I]
  NEXT
 NEXT
 _LKWK%[N]=LINK%[ACIX,N]
NEXT
_NDCNT%=NDC%[ACIX]
ACOPYSW=1
RETURN
'---
@ACPSTOUCH
IF TCS!=1 THEN RETURN
IF ACOPYSW==0 THEN RETURN
'---
FOR N=0 TO MAXND-1
 FOR T=0 TO MAXTP-1
  FOR I=0 TO FRSIZE-1
   ACT%[ACIX,N,T,I]=_ACWK%[N,T,I]
  NEXT
  FOR I=0 TO MAXSYS-1
   ASYS%[ACIX,N,T,I]=_ASYSWK%[N,T,I]
  NEXT
 NEXT
 LINK%[ACIX,N]=_LKWK%[N]
NEXT
NDC%[ACIX]=_NDCNT%
NDCNT=_NDCNT%:NDIX=0
'---
@REVIEW
FRCNT=ASYS%[ACIX,NDIX,TPIX,_FRCNT]
GOSUB @EDLOAD
GOSUB @MKPARENT
GOSUB @SETAWALL
RETURN

'
' type control
'
@TPTOUCH
'IF TCS!=1 THEN RETURN
IF TTX>=(TPX+MAXTP*TPW) THEN RETURN
IF TTY<TPY THEN RETURN
GOSUB @EDSAVE
TPIX=(TTX-TPX) DIV TPW
FRCNT=ASYS%[ACIX,NDIX,TPIX,_FRCNT]
GOSUB @EDLOAD
'
@TPPUT
FOR I=0 TO MAXTP-1
 C=GC:CB=0:IF TPIX==I THEN C=WC:CB=SELC
 LOCATE TPX+I*TPW,TPY
 COLOR C,CB:PRINT TP$[I,0];
NEXT
'
COLOR GC,0
FOR I=1 TO EDW-1
 LOCATE EDX+I*5,EDY-1:PRINT TP$[TPIX,I];
NEXT
COLOR WC,0
RETURN

'---
@HICLR
DISPLAY 0
GOSUB @BACK
GRID 0,0,400,240,16,16,LC
DISPLAY 1
RETURN

'
' node level control
'
@NDLVLTOUCH
IF TCHREP()==FALSE THEN RETURN
IF NDIX==0 THEN RETURN
'
GOSUB @HICLR
'
L=LINK%[ACIX,NDIX]
IF (TCX-X*8)<(W*8/2) THEN
 IF L>1 THEN
  DEC L
  FOR I=NDIX+1 TO NDCNT-1
   IF LINK%[ACIX,I]>L THEN
    DEC LINK%[ACIX,I]
   ELSE
    BREAK
   ENDIF
  NEXT
 ENDIF
ELSE
 IF L<LINK%[ACIX,NDIX-1]+1 THEN
  IF L<NDLVL THEN INC L
 ENDIF
ENDIF
LINK%[ACIX,NDIX]=L
GOSUB @REVIEW
RETURN

'
' node control
'
@NDINCTOUCH
IF TCHREP()==FALSE THEN RETURN
IF (TCX-X*8)<(W*8/2) THEN
 IF NDCNT>1 THEN DEC NDCNT
ELSE
 IF NDCNT<MAXND THEN INC NDCNT
ENDIF
NDC%[ACIX]=NDCNT
NDIX=NDCNT-1
LINK%[ACIX,NDIX]=1
GOSUB @REVIEW
RETURN

'---
@MKPARENT
FOR NY=1 TO NDCNT-1
 L=LINK%[ACIX,NY]
 FOR I=NY-1 TO 0 STEP -1
  L2=LINK%[ACIX,I]
  IF L2==L-1 THEN
   PARENT%[ACIX,NY]=I
   BREAK
  ENDIF
 NEXT
NEXT

'---
@MKTREE
TREE$=" "*NDW*NDH
TREE$=SUBST$(TREE$,0,NDW,"ROOT  ")
FOR NY=1 TO NDCNT-1
 L=LINK%[ACIX,NY]:YY=NY
 FOR I=NY+1 TO NDCNT-1
  IF L==LINK%[ACIX,I] THEN YY=I
  IF L>LINK%[ACIX,I] THEN BREAK
 NEXT
 L$="":IF YY!=NY THEN L$=""
 S$=L$+CHR$(&H41+NY)'+STR$(L)
' S$=L$+STR$(L)+HEX$(PARENT%[ACIX,NY])
 TREE$=SUBST$(TREE$,NY*NDW+L-1,2,S$)
 IF YY!=NY THEN
  FOR I=NY+1 TO YY
   TREE$=SUBST$(TREE$,I*NDW+L-1,1,"")
  NEXT
 ENDIF
 YY=(NY-1)*NDW
 FOR I=0 TO L-1
  S$=MID$(ND$,YY+I,1)
  IF S$=="" || S$=="" THEN
   TREE$=SUBST$(TREE$,YY+NDW+I,1,"")
  ENDIF
 NEXT
NEXT
RETURN

'---
@NDPUT
EDCNT=EDCY+EDOFS:CC=RGB(128,128,128)
FOR NY=0 TO NDH-1
 '---
 LOCATE NDX,NDY+NY
 C=WC:IF NY>=NDCNT THEN C=GC
 CB=0:IF NY==NDIX THEN CB=SELC
 COLOR WC,CB
 PRINT MID$(TREE$,NY*NDW,NDW)
 '---
 IF EDCNT<FRCNT THEN
  DISPLAY 0
  IF NY<NDCNT THEN
   SPSHOW NY:P=PARENT%[ACIX,NY]
   IF NY!=P THEN
    '---
    SPLINK NY,P
    SPPARENT P OUT X1,Y1
    IF P THEN X1=X1*ZM:Y1=Y1*ZM
    '---
    SPOFS NY OUT X2,Y2
    SPDEF NY OUT WU,WV,WW,WH,HX,HY
    X2=X1+X2+HX:Y2=Y1+Y2+HY
    GLINE X1,Y1,X2,Y2,CC
    GFILL X2-1,Y2-1,X2+1,Y2+1,CC
    '---
   ENDIF
  ELSE
   SPHIDE NY
   SPUNLINK NY
  ENDIF
  DISPLAY 1
 ENDIF
NEXT
RETURN

'--- 
DEF SPPARENT I OUT X,Y
 P=PARENT%[ACIX,I]
 SPOFS I OUT X,Y
 SPDEF I OUT WU,WV,WW,WH,HX,HY
 X=X+HX:Y=Y+HY
 IF I>0 THEN
  SPPARENT P OUT XX,YY
  X=X+XX:Y=Y+YY
 ENDIF
END

'
@NDTOUCH
GOSUB @EDSAVE
NDIX=TTY-NDY
IF NDIX<0 THEN NDIX=0
IF NDIX>=NDCNT THEN NDIX=NDCNT-1
FRCNT=ASYS%[ACIX,NDIX,TPIX,_FRCNT]
GOSUB @EDLOAD
RETURN

'
' action control
'
@ACPUT
FOR AY=0 TO ACH-1
 IX=ACOFS+AY
 CB=0:IF ACCY==AY THEN CB=SELC
 LOCATE ACX,ACY+AY
 COLOR WC,CB:PRINT ACNM$[IX];
NEXT
RETURN

'---
@ACTOUCH
OFS=ACOFS:MAX=MAXAC:HX=200:HY=120
GOSUB @SLIDER
'
IX=ACCY+VY:MY=ACH-1:VY=0
IF IX<0  THEN VY=-1:IX=0
IF IX>MY THEN VY= 1:IX=MY
OFS=OFS+VY:MY=MAX-ACH
IF OFS<0  THEN OFS=0
IF OFS>MY THEN OFS=MY
'
IF D==1 && TCS>0 THEN
 XX=X+1:YY=Y+1:WW=W-3:HH=H-2
 IF TTY<YY || TTY>=YY+HH THEN YY=-1
 IF TTX<XX || TTX>=XX+WW THEN YY=-1
 IF YY!=-1 THEN IX=TTY-YY
ENDIF
'---
ACCY=IX:ACOFS=OFS:NDC%[ACIX]=NDCNT
GOSUB @EDSAVE
ACIX=ACOFS+ACCY
NDCNT=NDC%[ACIX]:NDIX=0
FRCNT=ASYS%[ACIX,NDIX,TPIX,_FRCNT]
GOSUB @REVIEW
DISPLAY 1
RETURN

'
' utility button
'
@ZOOMPUT
LOCATE X,Y-2
PRINT "x"+STR$(ZM)
RETURN
'
@ZOOMTOUCH
IF TCHREP()==FALSE THEN RETURN
VX=1:IF SFT THEN VX=-VX
ZM=ZM+VX:IF ZM>4 THEN ZM=1
IF ZM<1 THEN ZM=4
'
GOSUB @HICLR
GOSUB @MKPARENT
GOSUB @SETAWALL
RETURN

'---
@LAYPUT
DISPLAY 1
LOCATE X,Y-2
PRINT LAY$[LAYTP]
RETURN
'
@LAYTOUCH
IF TCS!=1 THEN RETURN
LAYTP=LAYTP+1
IF LAYTP>MAXLAYTP-1 THEN LAYTP=0
'
@SETLAYTP
HMX=LAYHX[LAYTP]
HMY=LAYHY[LAYTP]
GOSUB @HICLR
GOSUB @MKPARENT
GOSUB @SETAWALL
RETURN


'================
' ANIMATION PLAY
'================
@ANMSTOPTOUCH
DISPLAY 0
FOR I=0 TO MAXND-1
 SPOFS I,0,0,0
 SPDEF I OUT DF
 SPDEF I,DF
 SPROT I,0
 SPSCALE I,1,1
 SPCOLOR I,RGB(255,255,255,255)
 SPVAL I,0
NEXT
DISPLAY 1
RETURN

'---
@ANMPLAYTOUCH
C$="アニメーションかきだし"
M$="SLOT1にアニメーションをかきだします。 よろしいですか?"
R=DIALOG( M$,1,C$ )
IF R==-1 THEN RETURN
'
DISPLAY 0:VISIBLE 1,0,0,0:CLS
PRGEDIT 1
IF PRGSIZE(1)>0 THEN
'@ANMKLOOP
' PRINT "PRG1:TEXT FOUND!":TXLINEB
' K$=GETKEY$("overwrite PRG1:[Y/N]")
' IF K$!="Y" && K$!="N" THEN @ANMKLOOP
' IF K$!="Y" THEN @ANMTEND
 PRGDEL -1
ENDIF
'---
GOSUB @BACK:CLS
S$="SLOT1:CREATE PROGRAM"
LOCATE 0,12:TXLINEB
PRINT " "*((50-LEN(S$)) DIV 2)+S$
TXLINEB
GOSUB @MAKESLOT1
GCLS RGB(96,96,120):CLS
GRID 0,0,400,240,16,16,LC
'---
DISPLAY 1:VISIBLE 1,1,0,0:CLS
GCLS RGB(96,96,120):C=RGB(128,128,128)
ATW=320/8:ATH=192/8
FOR Y=0 TO 7
 FOR X=0 TO 7
  XX=X*ATW:YY=Y*ATH
  GFILL XX+1,YY+1,XX+ATW-2,YY+ATH-2,C
  LOCATE (XX DIV 8)+1,(YY DIV 8)+1
  PRINT FORMAT$("%S%2D","・",X+Y*8)
 NEXT
NEXT
'---
BWCNT=0
TBOX 0,24,40,6,0,"","EXIT","@ATEND"
'TBOX 22,24,3,6,0,"","I","@ATBUT"
'TBOX 25,24,3,3,0,"","","@ATBUT"
'TBOX 28,24,3,3,0,"","","@ATBUT"
'TBOX 31,24,3,3,0,"","","@ATBUT"
'TBOX 34,24,3,3,0,"","","@ATBUT"
'TBOX 37,24,3,3,0,"","","@ATBUT"
'TBOX 25,27,3,3,0,"","","@ATBUT"
'TBOX 28,27,3,3,0,"","","@ATBUT"
'TBOX 31,27,3,3,0,"","","@ATBUT"
'TBOX 34,27,3,3,0,"","","@ATBUT"
'TBOX 37,27,3,3,0,"","","@ATBUT"

'================
' ANIMATION TEST
'================
DISPLAY 0:VISIBLE 1,1,1,1:CLS
USE 1:GOSUB "1:@ANMINIT"
ATSP=0:ATAC=0:ATHX=200:ATHY=120
ANMPLAY ATSP,ATAC,ATHX,ATHY
GOSUB @ATCSRON
'---
ATSW=TRUE
GOSUB @HITINIT
'---
@ATEST_LOOP
BRP=BUTTON(1)
SFT=BUTTON(0) AND &H300
STICK OUT STX,STY
GOSUB @STKSUB
TOUCH OUT TCS,TCX,TCY
GOSUB @TCHSUB
GOSUB @HITSUB
GOSUB @ATEST
VSYNC 1
IF ATSW THEN @ATEST_LOOP
'---
@ANMTEND
GOSUB @INITANM
RETURN

'---
@ATEST
IF TCY<192 && TCS!=0 THEN
 GOSUB @ATCSROFF
 ATAC=(TCX DIV ATW)+(TCY DIV ATH)*8
 GOSUB @ATCSRON
 '---
 DISPLAY 0
 ATSP=0 ':ATHX=200:ATHY=120
 ANMPLAY ATSP,ATAC,ATHX,ATHY
ENDIF
'---
DISPLAY 0
ATHX=ATHX+STX*8
ATHY=ATHY-STY*8
IF ATHX<0 THEN ATHX=0
IF ATHX>399 THEN ATHX=399
IF ATHY<0 THEN ATHY=0
IF ATHY>239 THEN ATHY=239
SPOFS ATSP,ATHX,ATHY
'---
S$=FORMAT$("ACTION:%02D",ATAC)
LOCATE 0,29:PRINT S$;
RETURN
'---
@ATCSRON
DISPLAY 1
X=(ATAC MOD 8)*ATW+4
Y=(ATAC DIV 8)*ATH+4
GPAINT X,Y,RGB(0,64,224)
RETURN
'
@ATCSROFF
DISPLAY 1
X=(ATAC MOD 8)*ATW+4
Y=(ATAC DIV 8)*ATH+4
GPAINT X,Y,RGB(128,128,128)
RETURN

'---
@ATENDTOUCH
ATSW=FALSE
RETURN

'============
' MAKE SLOT1
'============
@MAKESLOT1
W$=CHR$(&H22)

'--- comment & label
PRGSET "'============"
PRGSET "' from SBANM"
PRGSET "'============"
PRGSET "@ANMTEST"
PRGSET "DISPLAY 0"
PRGSET "GOSUB @ANMINIT"
PRGSET "SPTOP=0"
PRGSET "ACTOP=0"
PRGSET "HX=200:HY=120"
PRGSET "ANMPLAY SPTOP,ACTOP,HX,HY"
PRGSET "END"
PRGSET ""
'---
PRGSET "'=================="
PRGSET "' SBANM INITIALIZE "
PRGSET "'=================="
PRGSET "@ANMINIT"
G$="MAXAC="+STR$(MAXAC)
G$=G$+":MAXND="+STR$(MAXND)
G$=G$+":MAXTP="+STR$(MAXTP)
G$=G$+":MAXFR="+STR$(MAXFR)
PRGSET G$
G$="DIM GRP$[MAXTP]:COPY GRP$,"+W$+"@GRP"+W$
PRGSET G$
PRGSET "@GRP"
G$=W$+"XY"+W$+","+W$+"Z"+W$+","
G$=G$+W$+"I"+W$+","+W$+"S"+W$+","
G$=G$+W$+"R"+W$+","+W$+"C"+W$+","
G$=G$+W$+"V"+W$
PRGSET "DATA "+G$
PRGSET "DIM LP%[MAXTP],PARENT%[MAXND]"
PRGSET "RETURN"
PRGSET ""
'---
PRGSET "'=============="
PRGSET "' SBANM PLAYER "
PRGSET "'=============="
PRGSET "COMMON DEF ANMPLAY SP,AC,HX,HY"
'--- action initialize
PRGSET "'--- action"
PRGSET "AC$="+W$+"@A"+W$+"+STR$(AC)"
PRGSET "RESTORE AC$"
PRGSET "READ NDCNT"
PRGSET "COPY PARENT%,AC$+"+W$+"P"+W$+",NDCNT"
PRGSET "FOR N=0 TO NDCNT-1"
PRGSET " IX=SP+N"
PRGSET " SPSET IX,N"
PRGSET " SPSHOW IX"
PRGSET "NEXT"
PRGSET ""

'--- program
PRGSET "'--- program"
PRGSET "FOR N=0 TO NDCNT-1"
 
 '--- sprite index
 PRGSET " '"
 PRGSET " IX=SP+N"
 PRGSET " '"
 
 '--- default setting
 PRGSET " ND$=AC$+"+W$+"N"+W$+"+STR$(N)"
 PRGSET " COPY LP%,ND$+"+W$+"L"+W$+",MAXTP"
 PRGSET " RESTORE ND$"
 PRGSET " READ _X,_Y,_Z,_DEF"
 PRGSET " READ _SCX,_SCY,_ROT"
 PRGSET " READ _COL,_V7"
 '
' PRGSET " SPOFS IX,_X+HX,_Y+HY,_Z:HX=0:HY=0"
 PRGSET " IF N THEN SPLINK IX,PARENT%[N]"
 PRGSET " SPOFS IX,_X,_Y,_Z"
 PRGSET " SPCHR IX,_DEF"
 PRGSET " SPSCALE IX,_SCX,_SCY"
 PRGSET " 'SPROT IX,_ROT"
 PRGSET " SPCOLOR IX,_COL"
 PRGSET " SPVAR IX,7,_V7"
 PRGSET " '"
 
 '--- animation
 PRGSET " FOR T=0 TO MAXTP-1"
  L$="ND$+"+W$+"_"+W$+"+GRP$[T]"
  PRGSET "  L$="+L$
  PRGSET "  IF CHKLABEL(L$) THEN
  PRGSET "   G$=W$+GRP$[T]+W$:R$="+W$+"+"+W$
  PRGSET "   IF T==0 THEN G$=G$+R$"
  PRGSET "   SPANIM IX,G$,L$,LP%[T]"
  PRGSET "  ENDIF"
 PRGSET " NEXT"
 PRGSET " '"
 
PRGSET "NEXT"

'--- frame data
X=0:Y=0
FOR A=0 TO MAXAC-1
 '---
 LOCATE X+20,Y+16:PRINT ""
 X=X+1:IF X>7 THEN X=0:Y=Y+1
 '---
 PRGSET "'--- action"+STR$(A)
 PRGSET FORMAT$("@A%D",A)
 NMAX=NDC%[A]
 PRGSET "DATA "+STR$(NMAX)+" 'node counter"
 '---
 PRGSET FORMAT$("@A%DP",A)
 P$="DATA "
 FOR N=0 TO NMAX-1
  P$=P$+STR$(PARENT%[A,N])
  IF N<NMAX-1 THEN P$=P$+","
 NEXT
 PRGSET P$+" 'parent"
 '---
 FOR N=0 TO NMAX-1
  '---
  ND$=FORMAT$("@A%DN%D",A,N)
  PRGSET ND$+"L"
  '--- loop
  S$="DATA "
  FOR T=0 TO MAXTP-1
   S$=S$+STR$(ASYS%[A,N,T,_LOOP])
   IF T<MAXTP-1 THEN S$=S$+","
  NEXT
  PRGSET S$+" 'loop"
  '--- default
  PRGSET ND$
  FOR T=0 TO MAXTP-1
   F=0:GOSUB @GETACT
   IF T==0 THEN
    BX=V1:BY=V2:'D$="0,0"
   ENDIF
   PRGSET FORMAT$("DATA %S '%S",D$,GRP$[T])
  NEXT
  PRGSET "'"
  '--- frame
  FC=0
  FOR T=0 TO MAXTP-1
   FMAX=ASYS%[A,N,T,_FRCNT]
   IF FMAX>1 THEN
    PRGSET FORMAT$("%S_%S",ND$,GRP$[T])
    PRGSET FORMAT$("DATA %D 'counter",FMAX)
    FOR F=0 TO FMAX-1
     GOSUB @GETACT
     IF T==0 THEN
      D$=FORMAT$("%D,%D",V1-BX,V2-BY)
     ENDIF
     S$=FORMAT$("DATA %D,%S '%D",FC,D$,F)
     PRGSET S$
    NEXT
    FC=FC+1
   ENDIF
  NEXT
  IF FC THEN PRGSET "'"
  '
 NEXT
 '
NEXT
PRGSET "'--- COMMON DEF"
PRGSET "SPOFS SPTOP,HX,HY"
PRGSET "END"
RETURN

'===========
' GET VALUE
'===========
@GETACT
FC=ACT%[A,N,T,F*EDW+0]
V1=ACT%[A,N,T,F*EDW+1]
V2=ACT%[A,N,T,F*EDW+2]
GOSUB "@GETAW_"+GRP$[T]
RETURN
'
@GETAW_XY
D$=FORMAT$("%D,%D",V1,V2)
RETURN
'
@GETAW_I
@GETAW_Z
@GETAW_R
D$=FORMAT$("%D",V1)
RETURN
'
@GETAW_S
V1=V1/100:V2=V2/100
D$=FORMAT$("%F,%F",V1,V2)
RETURN
'
@GETAW_C
MKCOL V1 OUT WA,WR,WG,WB
D$=FORMAT$("&H%08X",RGB(WA,WR,WG,WB))
RETURN
'
@GETAW_V
V1=V1 OR (V2<<8)
D$=FORMAT$("&H%04X",V1)
RETURN

'====================
' reset SPDEF() work
'====================
@RESETSPD
_PU=0:_PV=1:_PW=2:_PH=3:_PHX=4:_PHY=5
_PRH=6:_PRV=7:_PRO=8:_P09=9
PRX=30:PRY=3:PRW=2:PRH=5:PSX=5:PSY=2
MAXPR=PRW*PRH
DIM PWORK%[MAXPR],CPWORK%[MAXPR]
DIM PN$[PRH]
DIM PF$[PRW,PRH]
DIM PS%[PRW,PRH,3]
'---
DATA "U,V"
DATA " %3D",0,0,511 'u
DATA " %3D",0,0,511 'v
DATA "W,H"
DATA " %3D",16,1,512 'w
DATA " %3D",16,1,512 'h
DATA "HX,Y"
DATA "%+4D",0,-999,999 'home x
DATA "%+4D",0,-999,999 'home y
DATA "R-HV"
DATA " %S" ,0,0,1 '
DATA " %S" ,0,0,1 '
DATA "R-90"
DATA " %3D",0,0,3 '0/90/180/270
DATA "    ",0,0,0 'empty
FOR Y=0 TO PRH-1
 READ PN$[Y]
 FOR X=0 TO PRW-1
  READ PF$[X,Y]
  READ PS%[X,Y,0],PS%[X,Y,1],PS%[X,Y,2]
 NEXT
NEXT
'---
TBOFS=0:TBOX=0:TBOY=0:TBW=2:TBH=2
TBIX=0:TBSX=10:TBSY=10
MAXDEF=4096
DIM DWORK%[MAXDEF,MAXPR]
DIM NAME$[MAXDEF]
PRINT "initialize SPDEF()"
PRINT "total:";MAXAC
PRINT "value:";MAXPR
FOR N=0 TO MAXDEF-1
 '
 IF (N MOD 128)==0 THEN PRINT ".";
 FOR I=0 TO MAXPR-1
  X=I MOD PRW:Y=I DIV PRW
  DWORK%[N,I]=PS%[X,Y,0]
 NEXT
 '
 SPDEF N OUT WU,WV,WW,WH,HX,HY,WA
 DWORK%[N,_PU]=WU:DWORK%[N,_PV]=WV
 DWORK%[N,_PW]=WW:DWORK%[N,_PH]=WH
 DWORK%[N,_PHX]=HX:DWORK%[N,_PHY]=HY
 RV=(WA>>4) AND 1
 RH=(WA>>3) AND 1
 RR=(WA>>1) AND 3
 DWORK%[N,_PRH]=RH
 DWORK%[N,_PRV]=RV
 DWORK%[N,_PRO]=RR
 '
NEXT
PRINT
'---
TXLINEB
RETURN

'===================
' init SPDEF() tool
'===================
@INITSPD
BWCNT=0:MODE=0:CPYFLG=0:OLDTBIX=-1
'---
DISPLAY 0:VISIBLE 1,1,1,1
GOSUB @BACK:CLS
LOCATE 0,29
PRINT "=SELECT =MOVE ";
PRINT "=+8 =-8 =EXIT =FILE";
LOCATE 42,29:PRINT VER$;
OLL=LAYTP:LAYTP=0
GRID 0,0,400,240,16,16,LC
LAYTP=OLL
' clear sprite
FOR I=0 TO 99:SPHIDE I:NEXT
' show def1
SPSET 0,0:SPOFS 0,200,120,SPZ
SPHOME 0,0,0:SPSHOW 0
'---
DISPLAY 1:VISIBLE 1,1,1,1
GOSUB @BACK:CLS
GRID 0,0,320,240,16,16,LC
TBOX 0,0,24,24,1,"","","@TMB"
TBOX 24,0,16,PRH+8,0,"#0000","","@PR"
TBOX 31,27,9,3,0,""," SPANM","@ANM"
TBOX 0,24,4,3,0,"","-4","@TBMOV"
TBOX 0,27,4,3,0,"","+4","@TBMOV"
TBOX 4,24,5,3,0,"","-64","@TBMOV"
TBOX 4,27,5,3,0,"","+64","@TBMOV"
TBOX 9,24,6,3,0,"","-256","@TBMOV"
TBOX 9,27,6,3,0,"","+256","@TBMOV"
TBOX 31,13,4,3,0,"","CP","@CPY"
TBOX 35,13,5,3,0,"","PST","@PST"
CPX=24:CPY=13:CPW=7:CPH=7
TBOX CPX,CPY,CPW,CPH,0,"","",""
'
LOCATE PRX-1,PRY-1:COLOR GC,0
PRINT"";
FOR I=0 TO PRH-2
 LOCATE PRX-6,PRY+1+I*2
 PRINT"";
NEXT
LOCATE PRX-1,PRY+1+I*2
PRINT"";
FOR I=0 TO PRH-1
 Y=PRY+I*2
 LOCATE PRX-1,Y
 PRINT"    ";
 LOCATE PRX-5,Y:PRINT PN$[I];
NEXT
'
X=31:Y=16:F$="@PRENTER"
GOSUB @NUMINIT
' clear sprite
FOR I=0 TO 99:SPHIDE I:NEXT
' set copy sprite
SPSET 0,0:SPHOME 0,0,0:SPHIDE 0
' show select def1
FOR H=0 TO TBH-1
 FOR W=0 TO TBW-1
  I=H*TBW+W
  SPSET I+1,0
  SPHOME I+1,0,0
  SPHIDE I+1
 NEXT
NEXT
'---
GOSUB @PRLOAD
GOSUB @HITINIT
RETURN

'
' to SPANM
'
@ANMTOUCH
IF TCS!=1 THEN RETURN
MD$="@INITANM"
RETURN

'
' DEF COPY(PWORK)
'
@CPYTOUCH
IF TCS!=1 THEN RETURN
CPYFLG=1
COPY CPWORK%,PWORK%
'
GOSUB @WRITEPR
SPCHR 0,WU,WV,WW,WH,WA
IF WW<WH THEN WW=WH
SPSCALE 0,((CPW-2)*8)/WW,((CPH-2)*8)/WW
SPOFS 0,CPX*8+8,CPY*8+8,SPZ
LOCATE CPX,CPY+CPH
PRINT FORMAT$("%04D",TBIX)
SPSHOW 0
RETURN

'
' DEF PASTE(PWORK)
'
@PSTTOUCH
IF TCS!=1 THEN RETURN
IF CPYFLG==0 THEN RETURN
COPY PWORK%,CPWORK%
RETURN

'
' thumbnail
'
@TMBPUT
DISPLAY 0
SPCHR 0,TBIX
'---
IF TBIX!=OLDTBIX THEN
 LOCATE 0,0:PRINT" "*50
 LOCATE 0,0:PRINT NAME$[TBIX]
ENDIF
OLDTBIX=TBIX

'---
DISPLAY 1
LOCATE PRX-5,PRY-2
PRINT FORMAT$("SPDEF(%04D)",TBIX)
'---
FOR H=0 TO TBH-1
 FOR W=0 TO TBW-1
  '
  C=14
  IF TBOX==W && TBOY==H THEN
   IF (FC AND 31)<16 THEN C=SELC
  ENDIF
  COLOR C,0
  '
  X=W*10+2:Y=H*11+2
  LOCATE X-1,Y-1:PRINT"";""*8+""
  FOR I=0 TO 7
   LOCATE X-1,Y+I:PRINT"";" "*8+""
  NEXT
  LOCATE X-1,Y+8:PRINT"";""*8+""
  '
  I=W+H*TBW:N=I+TBOFS
  LOCATE X,Y+9:PRINT FORMAT$("%04D",N)
  '  
  WW=DWORK%[N,_PW]:WH=DWORK%[N,_PH]
  IF WW==0 THEN WW=1
  IF HH==0 THEN HH=1
  IF WW<WH THEN WW=WH
  SPCHR I+1,N
  SPOFS I+1,X*8,Y*8,SPZ
  SPHOME I+1,0,0
  SPSCALE I+1,64/WW,64/WW
  SPSHOW I+1
  '
 NEXT
NEXT
RETURN

'
' stick
'
@TMBSTICK
VVX=SVX:VVY=SVY
'---
@TMBMOVE
TBOX=TBOX+VVX:VY=0
IF TBOX<0 THEN TBOX=TBW-1:VY=-1
IF TBOX>TBW-1 THEN TBOX=0:VY=1
TBOY=TBOY+VVY+VY:VY=0
IF TBOY<0 THEN TBOY=0:VY=-2
IF TBOY>TBH-1 THEN TBOY=TBH-1:VY=2
'---
@TMBOFSCLC
MAX=MAXDEF:PG=TBW*TBH
TBOFS=TBOFS+VY
IF TBOFS<0 THEN TBOFS=0
IF TBOFS>MAX-PG THEN TBOFS=MAX-PG
'---
@TMBNOCLC
GOSUB @PRSAVE
TBIX=TBOFS+TBOX+(TBOY*TBW)
GOSUB @PRLOAD
RETURN

'
' touch
'
@TMBTOUCH
GOSUB @TMBTSUB
GOSUB @TMBNOCLC
RETURN

'---
@TMBTSUB
IF D==0 || TCS==0 THEN RETURN
IF TTY<Y || TTY>=Y+H THEN RETURN
IF TTX<X || TTX>=X+W THEN RETURN
SLX=X+W-2
'IF TTX<SLX THEN RETURN

'--- image area
IF TTX<SLX THEN
 TBOX=(TTX DIV 12)
 TBOY=((TTY-2) DIV 12)
 RETURN
ENDIF

'--- slider top/end
VVX=0:VVY=0:SLY=Y+2:SLH=H-4
IF TTY<SLY      THEN VVY=-1
IF TTY>=SLY+SLH THEN VVY=1
'---
MAX=MAXDEF-(TBW*TBH)
SLY=Y+3:SLH=H-6
IF VVY!=0 THEN
 IF TCHREP()==FALSE THEN RETURN
 YY=((TBOFS*SLH) DIV MAX)
 IF YY>SLH-1 THEN YY=SLH-1
 YY=YY+SLY
 GOSUB @PUTTBTHUMB
 GOSUB @TMBMOVE
 RETURN
ENDIF
'--- slider area
IF TTY<SLY      THEN RETURN
IF TTY>=SLY+SLH THEN RETURN
'
TBOFS=TCY-(SLY*8)
TBOFS=FLOOR(TBOFS*(MAX/(SLH*8-1)))
IF TBOFS<0   THEN TBOFS=0
IF TBOFS>MAX THEN TBOFS=MAX
YY=TTY
'---
@PUTTBTHUMB
FOR I=0 TO SLH-1
 LOCATE SLX,SLY+I:PRINT " ";
NEXT
LOCATE SLX,YY:PRINT"";
RETURN

'
' thumb csr move
'
@TBMOVTOUCH
IF TCHREP()==FALSE THEN RETURN
'
VY=0
IF IH==3 THEN VY=-4
IF IH==4 THEN VY=4
IF IH==5 THEN VY=-64
IF IH==6 THEN VY=64
IF IH==7 THEN VY=-256
IF IH==8 THEN VY=256
IF VY==0 THEN RETURN
GOSUB @TMBOFSCLC
RETURN

'
' SPDEF() property edit
'
@PRPUT
WW=PRW:HH=PRH:SX=PSX:SY=PSY:PX=PRX:PY=PRY
GETDT$="@PRGET":GOSUB @CSRPUT
RETURN
'---
@PRENTER
X=EDCX:Y=EDCY:IX=X+Y*PRW
LO=PS%[X,Y,1]:HI=PS%[X,Y,2]
IF N<LO THEN N=LO
IF N>HI THEN N=HI
'
O=0
IF IX<2 THEN O=2 ELSE IF IX<4 THEN O=-2
IF O!=0 THEN
 O=PWORK%[IX+O]
 IF N+O>511 THEN N=512-O
ENDIF
PWORK%[IX]=N
'---
VX=0:VY=0
IF ENTMODE==1 THEN VX=1
IF ENTMODE==2 THEN VY=1
MX=PRW-1:MY=PRH-1
GOSUB @CSRMOVE
RETURN

'---
@PRGET
F$=PF$[NX,NY]:N=PWORK%[IX]
IF IX==_PRH OR IX==_PRV THEN
' N$=FORMAT$(F$,SW$[N]):F$="   %1D"
 F$="   %1D":N$=FORMAT$(F$,N)
 RETURN
ELSE
 IF IX==_PRO THEN
  N$=FORMAT$(F$,N):F$="   %1D"
 ELSE
  N$=FORMAT$(F$,N)
 ENDIF
ENDIF
RETURN
'---
@PRSET
IF N<PS%[NX,NY,1] THEN N=PS%[NX,NY,1]
IF N>PS%[NX,NY,2] THEN N=PS%[NX,NY,2]
PWORK%[IX]=N
RETURN
'
@PRLOAD
FOR I=0 TO MAXPR-1
 PWORK%[I]=DWORK%[TBIX,I]
NEXT
GOTO @WRITEPR
'
@PRSAVE
FOR I=0 TO MAXPR-1
 DWORK%[TBIX,I]=PWORK%[I]
NEXT
'--- 
@WRITEPR
WU=PWORK%[_PU]:WV=PWORK%[_PV]
WW=PWORK%[_PW]:WH=PWORK%[_PH]
WA= 1 OR (PWORK%[_PRH]<<3)
WA=WA OR (PWORK%[_PRV]<<4)
WA=WA OR (PWORK%[_PRO]<<1)
HX=PWORK%[_PHX]:HY=PWORK%[_PHY]
SPDEF TBIX,WU,WV,WW,WH,HX,HY,WA
RETURN
'
@PRBUT
MX=PRW-1:MY=PRH-1:GOSUB @CSRBUT
N=PWORK%[EDCX+EDCY*PRW]
GOSUB @CSRCLC
RETURN
'
@PRSTICK
'MX=PRW-1:MY=PRH-1:GOSUB @CSRSTICK
RETURN
'
@PRTOUCH
XX=PRX:SX=PSX:MX=XX+PRW*SX
YY=PRY:SY=PSY:MY=YY+PRH*SY
GOSUB @CSRTOUCH
RETURN

'====================
' back clear
'====================
@BACK
GCLS RGB(32,32,48)
RETURN

'====================
' cursor control sub
'====================
@CSRPUT
FOR NY=0 TO HH-1
 FOR NX=0 TO WW-1
  IX=NX+NY*WW:XX=PX+NX*SX:YY=PY+NY*SY
  C=WC:C2=0
  IF NX==EDCX && NY==EDCY THEN
   B=BVX OR BVY
   IF B || ((FC AND 15)<8) THEN C2=SELC
  ENDIF
  GOSUB GETDT$
  LOCATE XX,YY:COLOR C,C2:PRINT N$;
 NEXT
NEXT
COLOR WC,0
RETURN

'---
@CSRBUT
VX=BVX:VY=BVY
'---
@CSRMOVE
EDCX=EDCX+VX
IF EDCX<0 THEN EDCX=MX:VY=-1
IF EDCX>MX THEN EDCX=0:VY=1
EDCY=EDCY+VY
IF EDCY<0 THEN EDCY=MY
IF EDCY>MY THEN EDCY=0
RETURN
'---
@CSRCLC
VY=0
IF BRP AND &H10 THEN VY=VY+1
IF BRP AND &H20 THEN VY=VY-1
IF VY==0 THEN RETURN
'
ST=8
IF SFT==&H100 THEN ST=16
IF SFT==&H200 THEN ST=32
IF SFT==&H300 THEN ST=1
N=((N DIV ST)*ST)+(VY*ST)
GOSUB NMENTER$
RETURN

'---
@CSRSTICK
VX=STX:VY=STY
GOSUB @CSRMOVE
RETURN

'---
@CSRTOUCH
IF TCS==0 THEN RETURN
IF TTX<XX OR TTX>=MX THEN RETURN
IF TTY<YY OR TTY>=MY THEN RETURN
EDCX=((TTX-XX) DIV SX):EDCY=((TTY-YY) DIV SY)
EDNX=((TTX-XX) MOD SX):MN=SX-2
IF EDNX>MN THEN EDNX=MN
RETURN

'================
' slider control
'================
@SLIDER
VY=0
IF D==0 || TCS==0 THEN RETURN
IF TTY<Y || TTY>=Y+H THEN RETURN
IF TTX<X || TTX>=X+W THEN RETURN
SLX=X+W-2
IF TTX<SLX THEN RETURN
'---
SLY=Y+2:SLH=H-4
IF TTY<SLY      THEN VY=-1
IF TTY>=SLY+SLH THEN VY=1
'---
SLY=Y+3:SLH=H-6
IF VY!=0 THEN
 IF TCHREP()==FALSE THEN VY=0
 YY=((OFS*SLH) DIV MAX)
 IF YY>SLH-1 THEN YY=SLH-1
 YY=YY+SLY
 GOSUB @PUTTHUMB
 RETURN
ENDIF
'---
IF TTY<SLY      THEN RETURN
IF TTY>=SLY+SLH THEN RETURN
'---
OFS=TCY-(SLY*8)
OFS=FLOOR(OFS*(MAX/(SLH*8-1)))
YY=TTY
'---
@PUTTHUMB
FOR I=0 TO SLH-1
 LOCATE SLX,SLY+I:PRINT " ";
NEXT
LOCATE SLX,YY:PRINT"";
RETURN

'==========
' hit main
'==========
@HITMAIN
GOSUB @HITSUB
GOSUB @NUMCTRL
GOSUB @NUMPUT
RETURN
'---
@HITSUB
BVX=0:BVY=0
IF BRP AND 1 THEN BVY=BVY-1
IF BRP AND 2 THEN BVY=BVY+1
IF BRP AND 4 THEN BVX=BVX-1
IF BRP AND 8 THEN BVX=BVX+1
'
FOR IH=0 TO BWCNT-1
 
 DISPLAY 1
 GETWORK IH OUT X,Y,W,H,D,S$
 '
 J$=S$+"BUT":GOSUB @PROC
 J$=S$+"STICK":GOSUB @PROC
 '
 IF D!=0 && TCS>0 THEN
  IF TTX>=X AND TTX<X+W THEN
   IF TTY>=Y AND TTY<Y+H THEN
    J$=S$+"TOUCH":GOSUB @PROC
   ENDIF
  ENDIF
 ENDIF
 '
 X=X+1:Y=Y+3:H=H-4
 J$=S$+"PUT":GOSUB @PROC
 '
NEXT
RETURN
'
@HITINIT
EDCX=0:EDCY=0:EDNX=0
FOR IH=0 TO BWCNT-1
 
 DISPLAY 1
 GETWORK IH OUT X,Y,W,H,D,S$
 '
 IF D==0 THEN CONTINUE
 IF S$=="" THEN CONTINUE
 '
 X=X+1:Y=Y+3:H=H-4
 J$=S$+"PUT":GOSUB @PROC
 '
NEXT
RETURN

'====================
' input number panel
'====================
@NUMCTRL
IF TCHREP()==FALSE THEN RETURN
IF TTX<NMX THEN RETURN
X=((TCX-(NMX*8+4)) DIV 16)
Y=((TCY-(NMY*8+4)) DIV 16)-1
IF X<0 || X>3 THEN RETURN
IF Y<0 || Y>3 THEN RETURN
I=NK%[X+Y*4]
IF I<0 THEN
 IF I==-1 THEN GOSUB @NUM0
 IF I==-2 THEN
  NMVAL=NMVAL DIV 10
  IF NMST>1 THEN NMST=NMST-1
 ENDIF
 IF I==-3 THEN
  N=NMVAL:GOSUB NMENTER$:ENTSW=TRUE
 ENDIF
 IF I==-4 THEN
  ENTMODE=(ENTMODE+1) MOD 3
 ENDIF
 IF I==-5 THEN NMSG=NMSG*-1:NMVAL=NMVAL*-1
 RETURN
ENDIF
'
IF ENTSW THEN
 ENTSW=0:GOSUB @NUM0
ENDIF
'
NMVAL=(NMVAL*10)+(I*NMSG)
IF NMVAL==0 && I==0 THEN RETURN
NMST=NMST+1:IF NMST<6 THEN RETURN
'
@NUM0
NMST=0:NMVAL=0:NMSG=1
RETURN
'
@NUMINIT
DATA ""
DATA "       "
DATA ""
DATA "789C"
DATA ""
DATA "456"
DATA ""
DATA "123E"
DATA "N"
DATA "0-T"
DATA ""
NMENTER$=F$:NMX=X:NMY=Y:GOSUB @NUM0
DISPLAY 1:COLOR 12,0
RESTORE @NUMINIT
FOR I=0 TO 10
 READ T$:LOCATE X,Y+I:PRINT T$;
NEXT
ENTSW=FALSE
'
@NUMPUT
DISPLAY 1
LOCATE NMX+3,NMY+9:COLOR 15,0:S$=""
IF ENTMODE==1 THEN S$=""
IF ENTMODE==2 THEN S$=""
PRINT S$
LOCATE NMX+2,NMY+1:COLOR WC,0
PRINT RIGHT$(FORMAT$("      %D",NMVAL),6)
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

'===============
' touch convert
'===============
@TCHSUB
TTX=TCX DIV 8:TTY=TCY DIV 8
RETURN

'==============
' check & call
'==============
@PROC
IF CHKLABEL(J$)==TRUE THEN GOSUB J$
RETURN

'=================
' cmd:text button
'=================
DEF TBOX X,Y,W,H,S,C$,T$,S$
 '
 BWORK%[BWCNT,0]=X
 BWORK%[BWCNT,1]=Y
 BWORK%[BWCNT,2]=W
 BWORK%[BWCNT,3]=H
 BWORK%[BWCNT,4]=DISPLAY()
 BWORK%[BWCNT,5]=(C$=="")
 BSUB$[BWCNT]=S$
 BWCNT=BWCNT+1
 '
 W=W-2:IF W<0 THEN W=0
 H=H-2:IF H<0 THEN H=0
 OX=X:OY=Y
 
 '--- window & caption
 COLOR GC,0
 LOCATE X,Y:PRINT ""+""*W+"";:Y=Y+1
 IF C$!="" THEN
  LOCATE X,Y:PRINT ""+" "*W+"";:Y=Y+1
  LOCATE X,Y:PRINT ""+""*W+"";:Y=Y+1
  COLOR WC,0
  LOCATE X+1,Y-2:PRINT C$;
  COLOR GC,0
  H=H-2:IF H<0 THEN H=0
 ENDIF
 FOR I=0 TO H-1
  LOCATE X,Y:PRINT ""+" "*W+"";:Y=Y+1
 NEXT
 LOCATE X,Y:PRINT ""+""*W+"";
 
 '--- slider
 IF S!=0 THEN
  X=X+W-1:Y=OY+2:IF C$=="" THEN Y=OY
  LOCATE X,Y:PRINT "";:Y=Y+1
  LOCATE X,Y:PRINT "";:Y=Y+1
  LOCATE X,Y:PRINT "";:Y=Y+1
  FOR I=0 TO H-5
   LOCATE X,Y:PRINT " ";:Y=Y+1
  NEXT
  LOCATE X,Y:PRINT "";:Y=Y+1
  LOCATE X,Y:PRINT "";:Y=Y+1
  LOCATE X,Y:PRINT "";
  '
  COLOR WC,0
  LOCATE X+1,OY+3:PRINT "";
  
 ENDIF
 
 '--- text
 COLOR WC,0
 IF T$!="" THEN
  X=OX+1:Y=OY+3:IF C$=="" THEN Y=OY+1
  LOCATE X,Y:PRINT T$;
 ENDIF
 '
END

'====================
' cmd:get text value
'====================
DEF GETWORK I OUT X,Y,W,H,D,S$
 X=BWORK%[I,0]
 Y=BWORK%[I,1]
 W=BWORK%[I,2]
 H=BWORK%[I,3]
 D=BWORK%[I,4]
 '--- caption
 IF BWORK%[I,5]==FALSE THEN
  Y=Y+2:H=H-2
 ENDIF
 S$=BSUB$[I]:IF S$=="" THEN S$="@DEF"
END

'===================
' cmd:put grid line
'===================
DEF GRID GTX,GTY,GEX,GEY,GW,GH,GC
 GTX=GTX-8:GTY=GTY-8
 FOR YY=GTY TO GEY STEP GH
  GLINE GTX,YY,GEX,YY,GC
 NEXT
 FOR XX=GTX TO GEX STEP GW
  GLINE XX,GTY,XX,GEY,GC
 NEXT
 IF DISPLAY()==0 THEN
  XX=LAYHX[LAYTP]:YY=LAYHY[LAYTP]
  GLINE 0,YY,399,YY,RGB(200,30,0)
  GLINE XX,0,XX,239,RGB(200,30,0)
 ENDIF
END

'========================
' cmd:touch repeat check
'========================
DEF TCHREP()
 IF TCS==1  THEN RETURN TRUE
 IF TCS<RP1 THEN RETURN FALSE
 R=(TCS-RP1) MOD RP2
 IF R==0 THEN RETURN TRUE
 RETURN FALSE
END

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

'==========
' GRP4LOAD
'==========
@FGRP4LOAD
PRINT "GRP4LOAD":TXLINEB
K$=GETKEY$("load GRP4[Y/N]")
IF K$=="Y" THEN
 LINPUT "filename?:";K$
 IF K$!="" THEN
  LOAD "GRP4:"+K$:TXLINE
 ENDIF
ENDIF
RETURN

'======
' SAVE
'======
@FSAVE
PRINT "SAVE":TXLINEB
K$=GETKEY$("save SPDEF [Y/N]")
IF K$=="Y" THEN
 N$=GETNAME$("TMP","DEF")
 IF N$!="" THEN SAVEDEF N$:TXLINE
ENDIF
'---
K$=GETKEY$("save SPANM [Y/N]")
IF K$=="Y" THEN
 N$=GETNAME$("TMP","ANM")
 IF N$!="" THEN
  SAVEANM N$:TXLINE
 ENDIF
ENDIF
RETURN

'---
@TMPSAVE
SAVEANM "DAT:ANM_TMP"
SAVEDEF "DAT:DEF_TMP"
RETURN

'---
DEF SAVEANM N$
 
 '---
 ID=(ASC("A")<<24)
 ID=(ASC("N")<<16) OR ID
 ID=(ASC("M")<<8)  OR ID
 ID=(ASC(":"))     OR ID
 H_ID=0:H_VR=1:H_R2=2:H_R3=3
 HEADMAX=4
 
 '---
 ASZ=(MAXAC*ACSIZE)     'ACT%
 SSS=MAXAC*MAXND
 SSZ=(SSS*MAXTP*MAXSYS) 'ASYS%
 LSZ=SSS                'LINK%
 PSZ=SSS                'PARENT%
 NSZ=MAXAC              'NDC%
 WSIZE=ASZ+SSZ+LSZ+PSZ+NSZ+HEADMAX
 DIM W%[WSIZE]
 
 '--- HEADER
 W%[H_ID]=ID:W%[H_VR]=VER
 W%[H_R2]=0 :W%[H_R3]=0
 TOP=HEADMAX
 '--- ACT%[]
 COPY W%,TOP,ACT%,0,ASZ
 TOP=TOP+ASZ
 '--- ASYS%[]
 COPY W%,TOP,ASYS%,0,SSZ
 TOP=TOP+SSZ
 '--- LINK%[]
 COPY W%,TOP,LINK%,0,LSZ
 TOP=TOP+LSZ
 '--- PARENT%[]
 COPY W%,TOP,PARENT%,0,PSZ
 TOP=TOP+PSZ
 '--- NDC%[]
 COPY W%,TOP,NDC%,0,NSZ
 TOP=TOP+NSZ
 
 '---
 SAVE N$,W%
 
END

'---
DEF SAVEDEF N$
 
 '---
 ID=(ASC("D")<<24)
 ID=(ASC("E")<<16) OR ID
 ID=(ASC("F")<<8)  OR ID
 ID=(ASC(":"))     OR ID
 H_ID=0:H_VR=1:H_R2=2:H_R3=3
 HEADMAX=4
 
 '---
 DSZ=MAXDEF*MAXPR
 WSIZE=DSZ+HEADMAX
 DIM W%[WSIZE]
 
 '--- HEADER
 W%[H_ID]=ID:W%[H_VR]=VER
 W%[H_R2]=0 :W%[H_R3]=0
 TOP=HEADMAX
 
 '--- DWORK%[]
 COPY W%,TOP,DWORK%,0,DSZ
 TOP=TOP+DSZ
 
 '---
 SAVE N$,W%
 
END

'======
' LOAD
'======
@FLOAD
PRINT "LOAD":TXLINEB
K$=GETKEY$("load SPDEF [Y/N]")
IF K$=="Y" THEN
 N$=GETNAME$("TMP","DEF")
 IF N$!="" THEN GOSUB @LOADDEFSUB
ENDIF
'
K$=GETKEY$("load SPANM [Y/N]")
IF K$=="Y" THEN
 N$=GETNAME$("TMP","ANM")
 IF N$!="" THEN GOSUB @LOADANMSUB
ENDIF
RETURN

'---
@TMPLOAD
N$="DAT:DEF_TMP"
IF CHKFILE(N$)==TRUE THEN
 K$=GETKEY$("LOAD DEFTMP?[Y/N]")
 IF K$=="Y" THEN GOSUB @LOADANMSUB
ENDIF
'
N$="DAT:ANM_TMP"
IF CHKFILE(N$)==TRUE THEN
 K$=GETKEY$("LOAD ANMTMP?[Y/N]")
 IF K$=="Y" THEN GOSUB @LOADANMSUB
ENDIF
RETURN

'---
@LOADANMSUB
LOADANM N$
TXLINE
GOSUB @EDLOAD
NDCNT=NDC%[ACIX]
ACIX=0:NDIX=0
FRCNT=ASYS%[ACIX,NDIX,TPIX,_FRCNT]
GOSUB @MKPARENT
GOSUB @SETAWALL
RETURN

'---
DEF LOADANM N$
 
 '---
 ID=(ASC("A")<<24)
 ID=(ASC("N")<<16) OR ID
 ID=(ASC("M")<<8)  OR ID
 ID=(ASC(":"))     OR ID
 H_ID=0:H_VR=1:H_R2=2:H_R3=3
 HEADMAX=4
 
 '---
 ASZ=(MAXAC*ACSIZE)     'ACT%
 SSS=MAXAC*MAXND
 SSZ=(SSS*MAXTP*MAXSYS) 'ASYS%
 LSZ=SSS                'LINK%
 PSZ=SSS                'PARENT%
 NSZ=MAXAC              'NDC%
 WSIZE=ASZ+SSZ+LSZ+PSZ+NSZ+HEADMAX
 DIM W%[WSIZE]
 LOAD N$,W%
 
 '--- HEADER
 TOP=HEADMAX
 '--- ACT%[]
 COPY ACT%,0,W%,TOP,ASZ
 TOP=TOP+ASZ
 '--- ASYS%[]
 COPY ASYS%,0,W%,TOP,SSZ
 TOP=TOP+SSZ
 '--- LINK%[]
 COPY LINK%,0,W%,TOP,LSZ
 TOP=TOP+LSZ
 '--- PARENT%[]
 COPY PARENT%,0,W%,TOP,PSZ
 TOP=TOP+PSZ
 '--- NDC%[]
 COPY NDC%,0,W%,TOP,NSZ
 TOP=TOP+NSZ
 
END

'---
@LOADDEFSUB
LOADDEF N$
TXLINE
FOR N=0 TO MAXDEF-1
 U=DWORK%[N,_PU]:V=DWORK%[N,_PV]
 W=DWORK%[N,_PW]:H=DWORK%[N,_PH]
 X=DWORK%[N,_PHX]:Y=DWORK%[N,_PHY]
 A=1
 A=A OR (DWORK%[N,_PRV]<<4)
 A=A OR (DWORK%[N,_PRH]<<3)
 A=A OR (DWORK%[N,_PRO]<<1)
 SPDEF N,U,V,W,H,X,Y,A
NEXT
RETURN

'---
DEF LOADDEF N$
 
 '---
 ID=(ASC("D")<<24)
 ID=(ASC("E")<<16) OR ID
 ID=(ASC("F")<<8)  OR ID
 ID=(ASC(":"))     OR ID
 H_ID=0:H_VR=1:H_R2=2:H_R3=3
 HEADMAX=4
 
 '---
 DSZ=MAXDEF*MAXPR
 WSIZE=DSZ+HEADMAX
 DIM W%[WSIZE]
 LOAD N$,W%
 
 '--- HEADER
 TOP=HEADMAX
 '--- DWORK%[]
 COPY DWORK%,0,W%,TOP,DSZ
 TOP=TOP+DSZ
 '---
 
END


'==========
' GET NAME
'==========
DEF GETNAME$( F$, T$ )
 LINPUT "filename?:";F$
 IF F$!="" THEN F$="DAT:"+T$+"_"+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