SmileBASIC

プログラムリスト

SYS/SBANM

スクリーンショット

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


'
' ANIMATION EDITOR
'
' (C)2014-2016 SmileBoom Co.Ltd.
'
MAXSP=200:BGZ=300:SPZ=200:GRZ=100
XSCREEN 2,MAXSP,2
FOR I=0 TO 1
 DISPLAY I:VISIBLE 1,1,1,1:CLS:SPCLR
 SPPAGE 4:BGPAGE 5:GCLS
NEXT
VER=1.5:VER$=FORMAT$("ver:%4.2F",VER)
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:SPCLR
PRINT "SPDEF/SPANM data setting tool"
TXLINEB
'--- ファィルめいをひづけからつくる
DTREAD OUT Y,M,D:Y=Y-2000
TMP$=FORMAT$("%02D%02D%02D",Y,M,D)
TMPANM$=TMP$
TMPDEF$=TMP$
TMPGRP$=TMP$
TMPPRG$=TMP$
'---
_WHITE=RGB(220,220,220)
_GRAY =RGB(40,40,40)
_TEXT =RGB(0,0,0)
_BACK =RGB(20,20,20)
_RED  =RGB(240,80,120)
_BLUE =RGB(20,50,90)
_TAB  =RGB(80,80,100)
_ANMBACK=RGB(32,32,48)
_YELLOW =RGB(220,190,60)
'---
MAXDEF=4096
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]=" CENTER"
LAY$[1]=" HI&LEFT"
LAY$[2]=" LO&CENTER"
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
FILESW=FALSE
ON MODE GOSUB @INITSPD,@INITANM
'===========
' MAIN LOOP
'===========
@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:FILESW=TRUE
IF FILESW THEN @RESTART
'--- :EXIT
IF BRP==&H40 THEN EXITSW=TRUE
IF EXITSW==FALSE THEN @MLOOP

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

'====================
' reset SPANM() work
'====================
@RESETANM
EDW=3:EDH=11: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","SCALEX","SCALEY",100,0,9999
DATA "RT","ANGLE","    ",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
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:SPCLR
GOSUB @BACK:CLS:LOCATE 0,29
PRINT "=ADJUST =MOVE =EXIT =FILE";
LOCATE 42,29:PRINT VER$;
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:SPCLR
GCLS _BACK:CLS
GRID 0,0,320,240,16,16,LC
TBOX 29,26,5,4,0,""," DEF","@SPD"
TBOX 31,0,9,2,0,"",LAY$[LAYTP],"@LAY"
'TBOX 36,0,4,3,0,"","x ","@ZOOM"
TBOX 32,12,7,2,0,"","ANMTEST","@ANMPLAY"
'--- viewer
CPX=31:CPY=3:CPW=9:CPH=9
OLDSPNO=-1
'--- tab:type
EDX=14:EDY=1:EDCOLX=0
TPX=EDX-4:TPY=EDY+EDH*2+2:TPW=3:TPH=1
TBOX TPX-1,TPY-1,22,2,0,""," ","@TP"
XX=(TPX-1)*8:YY=(TPY-1)*8-9:C=_WHITE:SY=18
GFILL XX,YY,XX+(MAXTP*TPW*8)+8,YY+SY+4,_BACK
FOR I=0 TO MAXTP-1
 XX=(TPX+I*TPW)*8
 GFILL XX-3,YY-2,XX+TPW*8-7,YY+SY-1,C
 GFILL XX-2,YY+SY,XX+TPW*8-8,YY+SY,C
NEXT
OLDTPIX=-1
'--- edit matrix
TBOX EDX-5,EDY,22,EDH*2+1,1,"","","@ED"
XX=(EDX-5)*8:C=_WHITE
GPUTSTR XX,0,"FRAME",C
GPUTSTR XX+38,0," WAIT",C
FOR I=0 TO EDH-2
 YY=(I*2+EDY)*8+19
 GFILL XX,YY,XX+156,YY+1,C
NEXT
YY=EDY*8
FOR I=0 TO 2
 XX=(EDX*8)-4+I*40
 GFILL XX,YY,XX+1,YY+EDH*16+2,C
NEXT
'--- button
FPX=22:FPY=27
TBOX FPX-1,FPY-1,7,2,0,""," FRAME ","@FR"
'TBOX 23,24,3,3,0,"","C","@FRCOPY"
'TBOX 23,27,3,3,0,"","P","@FRPASTE"
LPX=22:LPY=29
TBOX LPX-1,LPY-1,4,2,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,26,6,2,0,""," TREE ","@NDLVL"
TBOX 9,28,6,2,0,""," NODE ","@NDINC"
TBOX 15,26,5,2,0,"","COPY","@NDCP"
TBOX 15,28,5,2,0,"","PASTE","@NDPS"
'--- action selector
GC=6:ACX=1:ACY=1:ACH=8
TBOX ACX-1,ACY-1,9,ACH+2,1,"","","@AC"
TBOX 0,ACH+2,4,2,0,"","COPY","@ACCP"
TBOX 4,ACH+2,5,2,0,"","PASTE","@ACPS"
GC=OLDGC
'--- file
TBOX 34,26,6,2,0,"","LOAD","@LDANM"
TBOX 34,28,4,2,0,"","SAVE","@SVANM"
TBOX 38,28,2,2,0,"","","@END"
'--- 
X=31:Y=14:F$="@EDENTER"
GOSUB @NUMINIT
' 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 '0フレームだけきょうちょう
  PRINT S$;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:XX=LPX*8-2:YY=LPY*8-4
 S$=" ∞ ":IF L THEN S$=STR$(L,3)
 GFILL XX-1,YY,XX+23,YY+7,_WHITE
 GPUTSTR XX,YY,S$,_TEXT
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,CPY-1:COLOR WC,0
 PRINT "DEF:";STR$(V1,4)
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$=STR$(N,4)
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
'
@EDINIT
GETWORK IH OUT X,Y,W,H,D,S$
YMAX=MAXFR-EDH
SW=FALSE:GOSUB @SLIDER
RETURN
'---
@EDTOUCH
OFS=EDOFS:YMAX=MAXFR-EDH
SW=TRUE:GOSUB @SLIDER
'IF TCHREP()==FALSE THEN VY=0
EDOFS=OFS+VY
IF EDOFS<0 THEN EDOFS=0
IF EDOFS>YMAX THEN EDOFS=YMAX
'--- 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
'
@FRTOUCH
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
XX=(TPX+MAXTP*TPW)*8:YY=TPY*8-7
IF TCX>XX THEN RETURN
IF TCY<YY THEN RETURN
GOSUB @EDSAVE
TPIX=(TTX-TPX) DIV TPW
FRCNT=ASYS%[ACIX,NDIX,TPIX,_FRCNT]
GOSUB @EDLOAD
'
@TPPUT
XX=TPX*8:YY=TPY*8-9:C=_BACK
'GFILL XX-3,YY-2,XX+(MAXTP*TPW*8)-6,YY+10,C
FOR I=0 TO MAXTP-1
 XX=(TPX+I*TPW)*8:C=_BACK
 IF TPIX==I THEN C=_WHITE
 GFILL XX-3,YY-1,XX+TPW*8-7,YY-2,C
 GPUTSTR XX,YY+2,TP$[I,0],_TEXT
NEXT
'--- edit information
COLOR GC,0
XX=EDX*8+30:YY=EDY*8-8
GFILL XX,YY,XX+100,YY+7,_BACK
FOR I=1 TO EDW-1
 XX=(EDX+I*5)*8-2:YY=(EDY-1)*8
 GPUTSTR XX,YY,TP$[TPIX,I],_YELLOW
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
'
@ACINIT
GETWORK IH OUT X,Y,W,H,D,S$
YMAX=MAXAC-ACH
SW=FALSE:GOSUB @SLIDER
RETURN
'---
@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:YMAX=MAXAC-ACH 'リストぶんをぬいたかず
'HX=200:HY=120
'HX=9999
SW=TRUE: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=YMAX'-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
XX=X*8-6:YY=(Y-2)*8-5
GFILL XX,YY,XX+64,YY+7,_WHITE
GPUTSTR XX,YY,LAY$[LAYTP],_TEXT
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
DATA "SLOT1にアニメーションを出力"
DATA "よろしいですか?",""
R=DLG("@ANMPLAYTOUCH",1,"アニメーション出力")
IF R==-1 THEN RETURN
'
DISPLAY 0:VISIBLE 1,0,0,0:CLS
PRGEDIT 1
IF PRGSIZE(1)>0 THEN PRGDEL -1 'けす
'---
GOSUB @BACK:CLS
S$="SLOT1:CREATE PROGRAM"
LOCATE 0,12:TXLINEB
PRINT " "*((50-LEN(S$)) DIV 2)+S$
TXLINEB
GOSUB @EDSAVE
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(16,16,16):C=RGB(48,48,64)
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,28,7,2,0,""," RETURN","@ATEND"
TBOX 16,28,8,2,0,"","SAVESLOT1","@ATSAVE"

'================
' ANIMATION TEST
'================
DISPLAY 0:VISIBLE 1,1,1,1:CLS
USE 1:GOSUB "1:@ANMINIT"
ATSP=0:ATAC=0:ATHX=200:ATHY=120
CALL "1: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
 CALL "1: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(48,48,64)
RETURN

'---
@ATENDTOUCH
ATSW=FALSE
RETURN

'---
@ATSAVETOUCH
GOSUB @FSAVESLOT1
DISPLAY 1
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 "WHILE N<MAXND"
PRGSET " IX=SP+N:SPCLR IX:INC N"
PRGSET "WEND"
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 SP,HX,HY" '2015.4.10(SPTOP→SP)
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=2: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]
'---
@SPDDATA
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,HY"
DATA "%+4D",0,-999,999 'home x
DATA "%+4D",0,-999,999 'home y
DATA "ROT-HV"
DATA " %S" ,0,0,1 '
DATA " %S" ,0,0,1 '
DATA "ROT-90"
DATA " %3D",0,0,3 '0/90/180/270
DATA "    ",0,0,0 'empty
RESTORE @SPDDATA
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
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:SPCLR
GOSUB @BACK:CLS
LOCATE 0,29
PRINT "=SELECT =MOVE ";
PRINT "=EXIT =FILE";
LOCATE 42,29:PRINT VER$;
OLL=LAYTP:LAYTP=0
GRID 0,0,400,240,16,16,LC
LAYTP=OLL
'--- show def1
SPSET 0,0:SPOFS 0,200,120,SPZ
SPHOME 0,0,0:SPSHOW 0
'---
DISPLAY 1:VISIBLE 1,1,1,1:SPCLR
GCLS _BACK:CLS
TBOX 0,0,24,24,1,"","","@TMB"
T$="SPDEF:"+" "*42+" -8     +8"
TBOX 24,0,16,PRH+7,0,T$,"","@PR"
TBOX 29,26,5,4,0,""," ANIM","@ANM"
'---
TBOX  0,24,4,2,0,"","-4","@TBMOV"
TBOX  4,24,4,2,0,"","+4","@TBMOV"
TBOX  0,26,4,2,0,"","-64","@TBMOV"
TBOX  4,26,4,2,0,"","+64","@TBMOV"
TBOX  0,28,4,2,0,"","-256","@TBMOV"
TBOX  4,28,4,2,0,"","+256","@TBMOV"
'---
TBOX 31,12,4,2,0,"","COPY","@CPY"
TBOX 35,12,5,2,0,"","PASTE","@PST"
CPX=24:CPY=12:CPW=7:CPH=7
TBOX CPX,CPY,CPW,CPH,0,"","",""
'--- file
TBOX 34,26,6,2,0,"","LOAD","@LDDEF"
TBOX 34,28,4,2,0,"","SAVE","@SVDEF"
TBOX 38,28,2,2,0,"","","@END"
'---
XX=(PRX-6)*8:YY=PRY*8-5:W=15*8+4
FOR I=0 TO 4
 GFILL XX,YY+I*16,XX+W,YY+I*16+1,_WHITE
 GPUTSTR XX+4,YY+I*16+5,PN$[I],_WHITE
NEXT
XX=(PRX-1)*8+4:YY=PRY*8-5:H=10*8
GFILL XX,YY,XX+1,YY+H,_WHITE
GFILL XX+40,YY,XX+41,YY+H,_WHITE
'---
X=31:Y=14:F$="@PRENTER"
GOSUB @NUMINIT
'--- 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 STR$(TBIX,4)
SPSHOW 0
RETURN

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

'
' thumbnail
'
@TMBINIT
GETWORK IH OUT X,Y,W,H,D,S$
TMBID=IH:YMAX=(MAXDEF/2)-2:OFS=0
SW=FALSE:GOSUB @SLIDER
RETURN

'============
' TMB PUT
'============
@TMBPUT
DISPLAY 0
SPCHR 0,TBIX
'--- spdef index
DISPLAY 1
XX=(PRX-5)*8-4+36:YY=(PRY-1)*8-5
GFILL XX,YY,XX+32,YY+7,_WHITE
GPUTSTR XX,YY,STR$(TBIX),_TEXT
'--- image 2x2
FOR H=0 TO TBH-1
 FOR W=0 TO TBW-1
  '--- cursor box
  C=_WHITE
  IF TBOX==W && TBOY==H THEN
   IF (FC AND 31)<16 THEN C=_RED
  ENDIF
  X=(W*10+2)*8-4:Y=(H*11+2)*8-4
  GBOX X  ,Y-1,X+71,Y+72,C
  GBOX X-1,Y  ,X+72,Y+71,C
  I=W+H*TBW:N=I+(OFS*2)
  GFILL X+2,Y+73,X+30,Y+80,C
  GLINE X+3,Y+81,X+29,Y+81,C
  GPUTSTR X+4,Y+73,STR$(N,4),_TEXT
  '--- image(sprite)
  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+4,Y+4,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
'--- image select cursor
@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
'--- 
GOSUB @TMBOFSCLC
RETURN

'=======
' TOUCH
'=======
@TMBTOUCH
GETWORK IH OUT X,Y,W,H,D,S$
YMAX=(MAXDEF/2)-2
SW=TRUE:GOSUB @SLIDER
'--- slider 
IF VX || VY THEN
 '--- cursor
 VVX=VX:VVY=VY
 GOSUB @TMBMOVE
ELSEIF TTX<SLX THEN
 '--- image select
 TBOX=(TTX DIV 12)
 TBOY=((TTY-2) DIV 12)
ENDIF
'---
GOSUB @TMBNOCLC
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
'---
@TMBOFSCLC
YMAX=(MAXDEF/2)-2
PG=TBW*TBH:XX=OFS:OFS=OFS+VY
IF OFS<0    THEN OFS=0
IF OFS>YMAX THEN OFS=YMAX
'--- slider refresh
IF XX!=OFS THEN
 GETWORK TMBID OUT X,Y,W,H,D,S$
 GOSUB @PUTSLIDER
 GETWORK IH OUT X,Y,W,H,D,S$
ENDIF
'--- 
@TMBNOCLC
GOSUB @PRSAVE
TBIX=(OFS*2)+TBOX+(TBOY*TBW)
GOSUB @PRLOAD
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 _ANMBACK
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:SLX=(X+W-2)*8-1:YY=Y*8-5
WW=12:HH=H*8+7
'---
IF SW THEN
 IF D==0 || TCS==0 THEN RETURN
 '--- slider area
 IF TCY<YY  || TCY>=YY+HH-1  THEN RETURN
 IF TCX<SLX || TCX>=SLX+WW+8 THEN RETURN
 '--- check: button
 IF TCY<YY+24    THEN VY=-1
 IF TCY>YY+HH-24 THEN VY=1
 '--- 
ENDIF
'---
SLY=YY+24:SLH=(HH-24*2) 'スライドできるはんい
SLSY=FLOOR(SLH/(YMAX+1)) 'サムのサイズ
IF SLSY<8 THEN SLSY=8
SLH=SLH-SLSY 'サムのサイズをひいたながさ
IF SLH<0 THEN SLH=1
IF VY!=0 THEN
 '---
 IF TCHREP()==FALSE THEN VY=0
 '--- オフセットにかさん
 JJ=OFS+VY
 IF JJ<0 THEN JJ=0
 IF JJ>YMAX THEN JJ=YMAX
 '--- 
 YY=FLOOR(JJ*(SLH/YMAX))
 GOSUB @PUTTHUMB
 RETURN
 '---
ENDIF
'--- スライドいちからオフセットをもとめる
IF SW THEN YY=TCY-SLY ELSE YY=0
'---
OFS=FLOOR(YY/(SLH/YMAX))
IF OFS>YMAX THEN OFS=YMAX
YY=OFS*(SLH/YMAX)
GOSUB @PUTTHUMB
RETURN

'============
' slider put
'============
@PUTSLIDER
VY=0:SLX=(X+W-2)*8-1:YY=Y*8-5
WW=12:HH=H*8+7
SLY=YY+24:SLH=(HH-24*2) 'スライドできるはんい
SLSY=FLOOR(SLH/(YMAX+1)) 'サムのサイズ
IF SLSY<8 THEN SLSY=8
SLH=SLH-SLSY 'サムのサイズをひいたながさ
IF SLH<0 THEN SLH=1
YY=OFS*(SLH/YMAX)
'---
@PUTTHUMB
GFILL SLX-1,SLY-2,SLX+WW,SLY+SLH+SLSY+1,_BLUE
YY=YY+SLY
GFILL SLX+1,YY,SLX+WW-2,YY+SLSY-1,_WHITE
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$+"INIT":GOSUB @PROC
 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: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
'---
DATA "機能を選んでボタンを押して下さい"
DATA " "
DATA "Aボタン:LOAD（データ読み込み）"
DATA "Xボタン:SAVE（データ保存）"
DATA "Yボタン:スプライト用画像読み込み"
DATA " "
DATA "Bボタン:ツールに戻る"
DATA ""
R=DLG( "@FILE",-1,"ファイル管理メニュー" )
J$=""
IF R==128 THEN J$="@FLOAD"
IF R==130 THEN J$="@FSAVE"
IF R==131 THEN J$="@FGRP4LOAD"
IF J$!="" && CHKLABEL(J$) THEN GOSUB J$
'---
@FEND
VISIBLE 1,1,1,1:DISPLAY 1:CLS
RETURN

'==========
' GRP4LOAD
'==========
@FGRP4LOAD
FILESW=TRUE:C$="LOADするイメージの名前"
N$=GETNAME$("GRP4",TMPGRP$,"",14,C$)
TMPGRP$=TMP$
IF N$!="" THEN LOAD N$
RETURN

'===========
' SLOT1SAVE
'===========
@FSAVESLOT1
FILESW=TRUE:C$="SAVEするアニメプログラムの名前"
N$=GETNAME$("PRG1",TMPPRG$,"",10,C$)
TMPPRG$=TMP$
IF N$!="" THEN SAVE N$
RETURN

'======
' SAVE
'======
@FSAVE
DATA "保存対象を選んで下さい"
DATA " "
DATA "Aボタン：SPDEF(定義)"
DATA "Xボタン：SPANIM"
'DATA "Yボタン："
DATA " "
DATA "Bボタン：ツールに戻る"
DATA ""
R=DLG( "@FSAVE",-1,"保存対象の選択" )
IF R==129 THEN RETURN
IF R==128 THEN GOSUB @SVDEFTOUCH
IF R==130 THEN GOSUB @SVANMTOUCH
GOTO @FSAVE

'===============
' SAVE ANM DATA
'===============
@SVANMTOUCH
FILESW=TRUE:C$="SAVEするアニメの名前"
N$=GETNAME$("DAT",TMPANM$,"ANM",10,C$)
TMPANM$=TMP$
IF N$!="" THEN SAVEANM N$
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

'===============
' SAVE DEF DATA
'===============
@SVDEFTOUCH
FILESW=TRUE:C$="SAVEするDEFの名前"
N$=GETNAME$("DAT",TMPDEF$,"DEF",10,C$)
TMPDEF$=TMP$
IF N$!="" THEN SAVEDEF N$
RETURN
'===============
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
DATA "読み込む対象を選んで下さい"
DATA " "
DATA "Aボタン：SPDEF(定義)"
DATA "Xボタン：SPANIM"
'DATA "Yボタン："
DATA " "
DATA "Bボタン：ツールに戻る"
DATA ""
R=DLG( "@FLOAD",-1,"読み込む対象の選択" )
IF R==129 THEN RETURN
IF R==128 THEN GOSUB @LDDEFTOUCH
IF R==130 THEN GOSUB @LDANMTOUCH
GOTO @FLOAD

'===============
' LOAD ANM SUB
'===============
@LDANMTOUCH
FILESW=TRUE:C$="LOADするアニメの名前"
N$=GETNAME$("DAT",TMPANM$,"ANM",10,C$)
TMPANM$=TMP$
IF N$=="" THEN RETURN
'---
IF LOADANM(N$)==FALSE THEN RETURN
'---
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%
IF RESULT!=TRUE THEN RETURN FALSE
'--- 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
'---
RETURN TRUE
END

'==============
' LOAD DEF SUB
'==============
@LDDEFTOUCH
FILESW=TRUE:C$="LOADするDEFの名前"
N$=GETNAME$("DAT",TMPANM$,"DEF",10,C$)
TMPDEF$=TMP$
IF N$=="" THEN RETURN
'---
IF LOADDEF(N$)==FALSE THEN RETURN
'---
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

'===============
' LOAD DEF DATA
'===============
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%
IF RESULT!=TRUE THEN RETURN FALSE
'--- HEADER
TOP=HEADMAX
'--- DWORK%[]
COPY DWORK%,0,W%,TOP,DSZ
TOP=TOP+DSZ
'---
RETURN TRUE
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

'====================
' cmd:get text value
'====================
DEF GPUTSTR X,Y,T$,C
VAR I,L=LEN(T$)
VAR C$
FOR I=0 TO L-1
 C$=MID$(T$,I,1):GPUTCHR X,Y,C$,C
 IF C$==" " THEN X=X+1 ELSE X=X+6
NEXT
END

'=================
' 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
'---
VAR WX=X*8,WY=Y*8,WW=W*8-2,WH=H*8-3
VAR OX=WX,OY=WY
'--- window
GBOX WX,WY+1,WX+WW-1,WY+WH-2,_WHITE
GBOX WX+1,WY,WX+WW-2,WY+WH-1,_WHITE
C=_WHITE:IF T$=="" THEN C=_GRAY
GFILL WX+2,WY+2,WX+WW-3,WY+WH-3,C
'--- caption
IF C$!="" THEN
 GFILL WX+2,WY+2,WX+WW-3,WY+10,_WHITE
 GPUTSTR WX+2,WY+3,C$,_TEXT
ENDIF
'--- slider
IF S!=0 THEN
 INC WX,WW-18:WY=OY
 IF C$!="" THEN INC WY,16
 GFILL WX,WY+2,WX+1,WY+WH-3,_WHITE
 '
 GFILL WX,WY+2,WX+15,WY+16,_WHITE
 GPUTSTR WX+5,WY+5,"",_TEXT
 '
 GFILL WX,WY+WH-17,WX+15,WY+WH-2,_WHITE
 GPUTSTR WX+5,WY+WH-12,"",_TEXT
ENDIF
'--- text
IF T$!="" THEN
 IF C$!="" THEN OY=OY+8
 GPUTSTR OX+3,OY+3,T$,_TEXT
ENDIF
'
END
ページトップへ