SmileBASIC

プログラムリスト

SYS/SBGED

スクリーンショット

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


' GRAPHIC EDITOR for プチコンBIG
'
' (c)2014-2016 SmileBoom Co.Ltd.
'
' #透明をBACKCOLORで扱う
' #色見本廃止(ダイレクトに変化)
' #BGでイメージ表示に変更
' #ゴサ補正の都合で、倍率3/6/12廃止
' #コピー系をタッチ操作に変更
' #フォント読み込み追加
'
XON WIIU
VER$="1.8":TXZ=200:GRZ=0:SPZ=250:BGZ=500
FRW=1024:FRH=1024:SCW=854:SCH=480
BGW=64:BGH=64:TTW=FLOOR(SCW/8):TTH=60
XSCREEN 6,6,6,10,2:GPH=2:GPL=3
COLOR 15,0:CLS:RP1=15:RP2=1
FOR I=0 TO 3:BREPEAT I,RP1,RP2:NEXT
DIM OLDBC[2]
FOR I=0 TO 1
 DISPLAY I:VISIBLE 1,1,1,1
 OLDBC[I]=BACKCOLOR()
 GPRIO GRZ:SPPAGE 4:SPCLR
 BGPAGE 5:BGSCREEN 0,BGW,BGH:BGCLIP 0
 FOR J=0 TO 3
  OX=(J DIV 2)*32
  OY=(J MOD 2)*32
  FOR Y=0 TO 31
   FOR X=0 TO 31
    BGPUT 0,X+OX,Y+OY,(X+Y*32)+1024*J
   NEXT
  NEXT
 NEXT
NEXT
'---
COLX=(8+3)*34*2-2:COLY=4*2

'
' initialize
'
LC=RGB(64,64,64):BC=RGB(96,96,96)
WC=RGB(255,255,255)
GR1C=RGB(155,155,155):GR1S=8
GR2C=RGB( 50, 50, 50):GR2S=2
_WHITE=RGB(240,240,240)
'
DEFCX=3:DEFCY=8:DEFCMAX=DEFCX*DEFCY
DIM COL[3],DEFCOL[DEFCMAX,3]
DIM CBF[0]
P_CBF=0
'
ZCMAX=5:DIM ZC[ZCMAX]
@DT_ZC
DATA 1,2,4,8,16
COPY ZC,@DT_ZC
ZCNT=3:ZM=ZC[ZCNT]
'
GBKMAX=4:DIM GBK[GBKMAX]
DATA 0,1,4,5
FOR I=0 TO GBKMAX-1:READ GBK[I]:NEXT
'---
FNCMAX=24
DIM FNCST[FNCMAX],FNCTX$[FNCMAX]
DIM FNCX[FNCMAX],FNCY[FNCMAX]
DIM FNCW[FNCMAX],FNCH[FNCMAX]
'
DATA "PSET",  4*2,209*2,32*2,12*2 '0
DATA "LINE", 37*2,209*2,29*2,12*2 '1
DATA "PAINT",67*2,209*2,35*2,12*2 '2
DATA "FILL",103*2,209*2,32*2,12*2 '3
'
DATA "COPY",  4*2,225*2,32*2,12*2 '4
DATA "",   37*2,225*2,19*2,12*2 '5
DATA "",   57*2,225*2,19*2,12*2 '6
DATA "R90",  77*2,225*2,19*2,12*2 '7

DATA "G0",144*2,209*2,20*2,12*2 '8
DATA "G1",164*2,209*2,20*2,12*2 '9
DATA "SP",184*2,209*2,20*2,12*2 '10
DATA "BG",204*2,209*2,20*2,12*2 '11
'
DATA "UNDO", 97*2,225*2,24*2,12*2 '12
DATA "REDO",122*2,225*2,24*2,12*2 '13
'
DATA "GRID",227*2,209*2,29*2,12*2 '14
DATA "8",256*2,209*2,15*2,12*2 '15
'
DATA "1",246*2,225*2,13*2,12*2 '16
DATA "2",260*2,225*2,13*2,12*2 '17
DATA "4",274*2,225*2,13*2,12*2 '18
DATA "8",288*2,225*2,13*2,12*2 '19
DATA "16",302*2,225*2,20*2,12*2 '20
'
DATA "LOAD",340*2,225*2,31*2,12*2 '21
DATA "SAVE",372*2,225*2,31*2,12*2 '22
DATA "",406*2,225*2,14*2,12*2 '23
'---
FOR I=0 TO FNCMAX-1
 READ FNCTX$[I]
 READ FNCX[I],FNCY[I]
 READ FNCW[I],FNCH[I]
NEXT
'---
CMD_PSET=0:CMD_LINE =1:CMD_PAINT=2
CMD_FILL=3:CMD_COPY =4:CMD_REVH =5
CMD_REVV=6:CMD_REV90=7
CMDMAX=8
CMD_PSET_END=10:CMD_LINE_END =11:CMD_PAINT_END=12
CMD_FILL_END=13:CMD_COPY_END =14:CMD_REVH_END =15
CMD_REVV_END=16:CMD_REV90_END=17
CMDSEL_TOP=CMD_FILL
'---
GPIXTOP=8:UNDOIX=12:REDOIX=13
GRIDIX=14:STEP8IX=15:ZOOMIX=16
LOADIX=21:SAVEIX=22:EXITIX=23
'---
TMPNAME$=""
DATA "G0","G1","SP","BG"
DIM FNAME$[4]
FOR I=0 TO 3
 READ F$
 DTREAD OUT Y,M,D:Y=Y-2000
 F$=FORMAT$("%S_%02D%02D%02D",F$,Y,M,D)
 FNAME$[I]=F$
NEXT
'---
DIM UNWK%[FRW*FRH]
DIM CPWK%[FRW*FRH]
CMD=CMD_PSET
COLNO=15:OLDCOLNO=COLNO
HX=0:HY=0:HZ=500:HOX=0:HOY=0
LX=0:LY=0:LZ=0:LOX=0:LOY=0
LZM=0:GRIDSW=1:STEP8SW=1
GPIX=2:GP=GBK[GPIX]:CPMD=0:CPP=0:UNDOSW=0
GOSUB @INITCPCSR
EXITSW=FALSE
'---
@RESTART
FILESW=FALSE
'---
GOSUB @DISPINIT
'---
OLDMC=MAINCNT
GM=-1:GX=0:GY=0
'---
@TOFFLOOP
BTN=BUTTON(0)
STICK OUT STX,STY
TOUCH OUT TCS,TCX,TCY
VSYNC 1
IF TS>0 THEN @TOFFLOOP
STC=0
'===========
' main loop
'===========
@MLOOP
BTN=BUTTON(0):BRP=BUTTON(1)
SFT=BTN AND &H300
BUTVEC BRP OUT BVX,BVY
STICK OUT STX,STY
GOSUB @STKSUB
TOUCH OUT TCS,TCX,TCY
'---
GOSUB @HIMAIN
GOSUB @LOMAIN
'---
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
'======
@TOOLEND
DATA "ツールを終了しますか？",""
IF DLG("@TOOLEND",1,"Xボタンによる終了確認")==-1 THEN
 EXITSW=FALSE:GOTO @RESTART
ENDIF
'---
FOR I=0 TO 1
 DISPLAY I:GPAGE I,I
 BACKCOLOR OLDBC[I]
 SPPAGE 4:SPCLR
 BGPAGE 5:BGCLR 0:BGCLIP 0
NEXT
LN=LEN(CBF)-1
IF LN>=0 THEN
 FOR I=0 TO LN
  A=POP(CBF)
 NEXT
ENDIF
'---
EXEC "SYS/SBSMILE"
END

'=========
' HI MAIN
'=========
@HIMAIN
DISPLAY 0:GPAGE GPH,GPH
'--- ボタン/スティックの変化量
AX=SVX:AY=SVY:CM=0
IF !AX && !AY THEN AX=BVX:AY=BVY
IF STEP8() THEN AX=AX*8:AY=AY*8
'--- green cursor
IF CMD>=CMD_FILL THEN
 '---
 IF TCS>0 THEN RETURN
 '--- 先にgreenを動かす
 S=ZC[ZCNT]:CVX=0:CVY=0:CM=1
 CPX=CPX+AX:W=(LW DIV S)-CPW
 CPY=CPY+AY:H=(LH DIV S)-CPH
 IF CPX<0 THEN CPX=0:DEC CVX
 IF CPX>W THEN CPX=W:INC CVX
 IF CPY<0 THEN CPY=0:DEC CVY
 IF CPY>H THEN CPY=H:INC CVY
 '---
 AX=CVX:AY=CVY
 IF STEP8() THEN AX=AX*8:AY=AY*8
ENDIF
'--- red cursor
OX=HX:OY=HY
W=(SCW-(LW/ZM)):H=(SCH-(LH/ZM))
HX=HX+AX:HY=HY+AY:XS=0:YS=0
IF HX<0 THEN XS=HX:HX=0
IF HX>W THEN XS=HX-W:HX=W
IF HY<0 THEN YS=HY:HY=0
IF HY>H THEN YS=HY-H:HY=H
'--- offset
OOX=HOX:OOY=HOY
HOX=HOX-XS:HOY=HOY-YS
IF HOX<-HW THEN HOX=-HW
IF HOX>0   THEN HOX=0
IF HOY<-HH THEN HOY=-HH
IF HOY>0   THEN HOY=0
'---
I=(OX-HX) OR (OY-HY)
I=I+(OOX-HOX) OR (OOY-HOY)
IF I || CM THEN
 GOSUB @LOGRID:GOSUB @HIGRID
ENDIF
C=(MAINCNT AND 31)*4+127
C=RGB(C,0,0):X=HX:Y=HY
'---
@HICSR
IF CPMD==1 THEN X=X+CPX:Y=Y+CPY
GBOX X+1,Y,X+ZW-2,Y+ZH-1,C
GBOX X,Y+1,X+ZW-1,Y+ZH-2,C
'--- 上スクロール
BGOFS 0,-HOX,-HOY,HZ
SPOFS 1,HOX,HOY,HZ
'---
IF GRIDSW==0 THEN RETURN
'---
S$=STR$(HX-HOX,3)+","+STR$(HY-HOY,3)
S$=S$+"(x"+STR$(ZM,2)+") "
LOCATE 0,TTH-1:PRINT S$;
'---
IF CMD>=CMDSEL_TOP THEN
 S$=":OK("
 INC S$,STR$(CPW,3)+","+STR$(CPH,3)+") "
 IF CMD==CMD_COPY && CPMD THEN
  INC S$,":END "
 ENDIF
ELSE
 S$="押しながらタッチでスポイト     "
ENDIF
PRINT S$;
RETURN

'=========
' LO MAIN
'=========
@LOMAIN
DISPLAY 1
IF TCS>0 THEN
 GOSUB @COLSEL
 GOSUB @RGBSEL
 IF TCS==1 THEN GOSUB @FUNCSUB
ELSE
 GOSUB @DRAWEND 'FILL・COPYなどは何もしない
ENDIF
'---
I=CMD-CMDSEL_TOP
IF I>=0 THEN
 ON I GOSUB @FILL,@COPY,@REVH,@REVV,@REV90
ELSE
 IF TCS>0 THEN GOSUB @DRAWSUB
ENDIF
'--- 下スクロール
@SETOFSLO
X=HX-HOX:Y=HY-HOY
BGOFS 0,X,Y,LZ
SPOFS 10,16-X*ZM,16-Y*ZM,LZ
GOSUB @COLCSR
RETURN

'===========
' COPY MODE
'===========
@COPY
IF CPMD==0 THEN @CSRSUB

'--- ペースト範囲点滅
GOSUB @PUTSP
GOSUB @PUTCPCSR
'--- :キャンセル
IF BRP AND &H20 THEN
 GOSUB @CPCSROFF:RETURN
ENDIF
'--- :決定
IF (BRP AND &H10)==0 THEN CPP=0:RETURN
'--- ペースト決定
IF CPP==1 THEN RETURN
CPP=1
DISPLAY 0:GPAGE GPH,GP
GOSUB @CLCUVWH
DX=(HX-HOX)+CPX:DY=(HY-HOY)+CPY

'COPY_BEGIN
SET_CMD CMD_COPY

GED_COPY DX,DY,CWW-1,CHH-1,CPWK%,SFT
GLOAD DX,DY,CWW,CHH,CPWK%,0,SFT

'COPY_END
END_CMD CMD_COPY_END

DISPLAY 1
RETURN

'--- タッチで、始点とサイズを決める
@CSRSUB
VX=BVX:VY=BVY
NX=TCX-LOX:NY=TCY-LOY
IF STEP8() THEN
 VX=VX*8:VY=VY*8
 NX=(NX/8)*8:NY=(NY/8)*8
ENDIF
'--- :始点とサイズ決定
IF BRP AND &H10 THEN @COPY1ST
'--- 始点変更
IF TCS THEN
 IF NX<0 OR NX>=LW THEN RETURN
 IF NY<0 OR NY>=LH THEN RETURN
ENDIF
'--- スケール分調整
NX=NX DIV ZM:NY=NY DIV ZM
RX=NX MOD ZM:RY=NY MOD ZM
IF STEP8() THEN
 NX=(NX DIV 8)*8
 NY=(NY DIV 8)*8
ENDIF
SX=NX-DOX:SY=NY-DOY
'--- 
IF TCS==0 THEN
 '--- 始点とサイズ決定
 IF CSW THEN CSW=0:GOTO @COPY1ST
ELSEIF TCS==1 THEN
 '--- タッチ開始
 GOSUB @CLRCPCSR
 DOX=NX:DOY=NY
 CPX=NX:CPY=NY
ELSEIF TCS>1 THEN
 '--- 選択中
 GOSUB @CLRCPCSR
 CPW=SX:CPH=SY:CSW=1 'サイズ選択中
 SO=1:IF STEP8() THEN SO=8
 CPW=CPW+SO:IF SX<0 THEN CPW=CPW-SO
 CPH=CPH+SO:IF SY<0 THEN CPH=CPH-SO
ENDIF
'---
GOSUB @PUTCPCSR
RETURN

'
' capture
'
@COPY1ST
GOSUB @CLCUVWH
CPX=XX:CPY=YY:CPW=CWW:CPH=CHH
CPMD=1:VSW=((CMD-CMDSEL_TOP)==1)
'--- 90度回転は、正方形サイズ
IF CMD==CMD_REV90 THEN
 IF CPW>CPH THEN CPW=CPH
 IF CPH>CPW THEN CPH=CPW
ENDIF
'---
DISPLAY 0
GSAVE GP,SRCU,SRCV,CWW,CHH,CPWK%,0
SPPAGE GP
IF VSW THEN SPSHOW 0 ELSE SPHIDE 0
SPCHR 0,SRCU,SRCV,CWW,CHH 'CSR-HI
OLDHW=ZW:OLDHH=ZH
ZW=CWW:ZH=CHH
GOSUB @HIGRID
'---
DISPLAY 1
SPPAGE GP
IF VSW THEN SPSHOW 0 ELSE SPHIDE 0
SPCHR 0,SRCU,SRCV,CWW,CHH 'CSR-LO
ZW=OLDHW:ZH=OLDHH
GOSUB @LOGRID
ZW=CWW:ZH=CHH
'---
GOSUB @PUTSP
RETURN

'
' コピー内容のスプライト表示
'
@PUTSP
OD=DISPLAY()
C=(FC AND 31)*4+128
C=RGB(C,255,255,255)
DISPLAY 0:SPOFS 0,HX+CPX,HY+CPY:SPCOLOR 0,C
X=CPX*ZC[ZCNT]:Y=CPY*ZC[ZCNT]
DISPLAY 1:SPOFS 0,LX+X,LY+Y:SPCOLOR 0,C
DISPLAY OD
RETURN

'
' マイナスと8ステップを考慮したUVWH計算
'
@CLCUVWH
XX=CPX:CWW=CPW
SO=1:IF STEP8() THEN SO=8
IF CWW<0 THEN XX=(XX+CWW):CWW=-CWW+SO
YY=CPY:CHH=CPH
IF CHH<0 THEN YY=(YY+CHH):CHH=-CHH+SO
SRCU=XX+(HX-HOX)
SRCV=YY+(HY-HOY)
RETURN

'
' copy cursor
'
@INITCPCSR
CPX=0:CPY=0:CPW=8:CPH=8
'---
@CPCSROFF
IF CPMD==1 THEN
 DISPLAY 0:SPHIDE 0:GOSUB @HIGRID
 DISPLAY 1:SPHIDE 0:GOSUB @LOGRID
 ZW=OLDHW:ZH=OLDHH
ENDIF
'---
CPMD=0:CSW=0
RETURN
'
'---
@CLRCPCSR
IF CMD<CMDSEL_TOP THEN RETURN
C=0:GOTO @CPCSRSUB
'
@PUTCPCSR
GOSUB @LOGRID
'---
C=RGB(0,255,0)
IF CPMD==0 THEN
 C=RGB(0,32+(FC AND 15)*10,0)
ENDIF
'
@CPCSRSUB
IF CMD<CMDSEL_TOP THEN RETURN
DISPLAY 1
X=CPX*S+8*2:Y=CPY*S+8*2
S=ZC[ZCNT]:W=CPW*S:H=CPH*S
SS=S:SO=2
IF STEP8() THEN SS=S*8:SO=2
IF W<0 THEN X=X+SS-SO:W=W-SS+(SO*2)
IF H<0 THEN Y=Y+SS-SO:H=H-SS+(SO*2)
'---
GCLIP 1,LOX,LOY,LOX+LW-1,LOY+LH-1
GBOX X,Y,X+W-1,Y+H-1,C
GBOX X+1,Y+1,X+W-2,Y+H-2,C
GCLIP 1
RETURN

'======
' UNDO
'======
@UNDO
 I=P_CBF
 IF I<=0 || FNCST[UNDOIX]==-2 THEN RETURN
 FNCST[REDOIX]=-1:PUTBUT REDOIX
 C=CBF[I]:DEC I
 ON C GOTO @UNDO_SKIP,@UNDO_SKIP,@UNDO_SKIP,@UNDO_SKIP,@UNDO_SKIP,@UNDO_SKIP,@UNDO_SKIP,@UNDO_SKIP,@UNDO_SKIP,@UNDO_SKIP,@UNDO_PSET,@UNDO_LINE,@UNDO_PAINT,@UNDO_FILL,@UNDO_COPY,@UNDO_REVH,@UNDO_REVV,@UNDO_REV90
'
@UNDO_SKIP
RETURN
'
@UNDO_END
 IF P_CBF<=0 THEN FNCST[UNDOIX]=-2:PUTBUT UNDOIX
RETURN
'
@UNDO_COMMON
 GPAGE GPL,GP
 WHILE 1
  C=CBF[I]:DEC I
  IF C==CK THEN BREAK
  OC=CBF[I]:DEC I
  NC=CBF[I]:DEC I
  PX=CBF[I]:DEC I
  PY=CBF[I]:DEC I
  DEC I
  GPSET PX,PY,OC
 WEND
 GPAGE GPL,GPL
 P_CBF=I
RETURN
'
@UNDO_PSET
 CK=CMD_PSET:GOSUB @UNDO_COMMON
GOTO @UNDO_END
'
@UNDO_LINE
 CK=CMD_LINE:GOSUB @UNDO_COMMON
GOTO @UNDO_END
'
@UNDO_PAINT
 GPAGE GPL,GP
  OC=CBF[I]:DEC I
  NC=CBF[I]:DEC I
  PX=CBF[I]:DEC I
  PY=CBF[I]:DEC I
  GPAINT PX,PY,OC
 GPAGE GPL,GPL
 DEC I
 P_CBF=I
GOTO @UNDO_END
'
@UNDO_FILL
 PX1=CBF[I]:DEC I
 PY1=CBF[I]:DEC I
 PX2=CBF[I]:DEC I
 PY2=CBF[I]:DEC I
 CL=CBF[I]:DEC I
 GPAGE GPL,GP
 FOR Y=PY2 TO PY1 STEP -1
  FOR X=PX2 TO PX1 STEP -1
   GPSET X,Y,CBF[I]:DEC I
  NEXT
 NEXT
 GPAGE GPL,GPL
 DEC I,6
 P_CBF=I
GOTO @UNDO_END
'
@UNDO_COPY
 PX1=CBF[I]:DEC I
 PY1=CBF[I]:DEC I
 PX2=CBF[I]:DEC I
 PY2=CBF[I]:DEC I
 GPAGE GPL,GP
 FOR Y=PY2 TO PY1 STEP -1
  FOR X=PX2 TO PX1 STEP -1
   GPSET X,Y,CBF[I]:DEC I
   DEC I
  NEXT
 NEXT
 GPAGE GPL,GPL
 DEC I,5
 P_CBF=I
GOTO @UNDO_END
'
@UNDO_REVH
 H=CBF[I]:DEC I
 W=CBF[I]:DEC I
 Y=CBF[I]:DEC I
 X=CBF[I]:DEC I
 GPAGE GPL,GP
 FOR OX=0 TO (W DIV 2)
  FOR OY=0 TO H
   C1=GSPOIT(X+OX,Y+OY)
   C2=GSPOIT(X+W-OX,Y+OY)
   GPSET X+W-OX,Y+OY,C1
   GPSET X+OX,Y+OY,C2
  NEXT
 NEXT
 GPAGE GPL,GPL
 DEC I
 P_CBF=I
GOTO @UNDO_END
'
@UNDO_REVV
 H=CBF[I]:DEC I
 W=CBF[I]:DEC I
 Y=CBF[I]:DEC I
 X=CBF[I]:DEC I
 GPAGE GPL,GP
 FOR OY=0 TO (H DIV 2)
  FOR OX=0 TO W
   C1=GSPOIT(X+OX,Y+OY)
   C2=GSPOIT(X+OX,Y+H-OY)
   GPSET X+OX,Y+H-OY,C1
   GPSET X+OX,Y+OY,C2
  NEXT
 NEXT
 GPAGE GPL,GPL
 DEC I
 P_CBF=I
GOTO @UNDO_END
'
@UNDO_REV90
 CWW=CBF[I]:DEC I
 W=CBF[I]:DEC I
 Y=CBF[I]:DEC I
 X=CBF[I]:DEC I
 M=W
 GPAGE GPL,GP
 FOR K=0 TO (CWW DIV 2)-1
  FOR J=0 TO M-1
   C1=GSPOIT(X+K+J  ,Y+K    )
   C2=GSPOIT(X+W-K  ,Y+K+J  )
   C3=GSPOIT(X+W-K-J,Y+W-K  )
   C4=GSPOIT(X+K    ,Y+W-K-J)
   GPSET X+K+J  ,Y+K    ,C2
   GPSET X+W-K  ,Y+K+J  ,C3
   GPSET X+W-K-J,Y+W-K  ,C4
   GPSET X+K    ,Y+W-K-J,C1
  NEXT
  M=M-2
 NEXT
 GPAGE GPL,GPL
 DEC I
 P_CBF=I
GOTO @UNDO_END

'======
' REDO
'======
@REDO
 I=P_CBF
 IF I>=LEN(CBF)-1 || FNCST[REDOIX]==-2 THEN RETURN
 FNCST[UNDOIX]=-1:PUTBUT UNDOIX
 INC I:C=CBF[I]
 ON C GOTO @REDO_PSET,@REDO_LINE,@REDO_PAINT,@REDO_FILL,@REDO_COPY,@REDO_REVH,@REDO_REVV,@REDO_REV90,@REDO_SKIP,@REDO_SKIP,@REDO_SKIP,@REDO_SKIP,@REDO_SKIP,@REDO_SKIP,@REDO_SKIP,@REDO_SKIP,@REDO_SKIP,@REDO_SKIP
'
@REDO_SKIP
RETURN
'
@REDO_END
 IF P_CBF>=LEN(CBF)-1 THEN FNCST[REDOIX]=-2:PUTBUT REDOIX
RETURN
'
@REDO_COMMON
 GPAGE GPL,GP
 WHILE 1
  INC I:C=CBF[I]
  IF C==CK THEN BREAK
  INC I:PY=CBF[I]
  INC I:PX=CBF[I]
  INC I:NC=CBF[I]
  INC I:OC=CBF[I]
  INC I
  GPSET PX,PY,NC
 WEND
 GPAGE GPL,GPL
 P_CBF=I
RETURN
'
@REDO_PSET
 CK=CMD_PSET_END:GOSUB @REDO_COMMON
GOTO @REDO_END
'
@REDO_LINE
 CK=CMD_LINE_END:GOSUB @REDO_COMMON
GOTO @REDO_END
'
@REDO_PAINT
 GPAGE GPL,GP
  INC I:PY=CBF[I]
  INC I:PX=CBF[I]
  INC I:NC=CBF[I]
  INC I:OC=CBF[I]
  GPAINT PX,PY,NC
 GPAGE GPL,GPL
 INC I
 P_CBF=I
GOTO @REDO_END
'
@REDO_FILL
 INC I:PX1=CBF[I]
 INC I:PY1=CBF[I]
 INC I:PX2=CBF[I]
 INC I:PY2=CBF[I]
 INC I:CL=CBF[I]
 GPAGE GPL,GP
 FOR Y=PY1 TO PY2
  FOR X=PX1 TO PX2
   INC I:GPSET X,Y,CL
  NEXT
 NEXT
 GPAGE GPL,GPL
 INC I,6
 P_CBF=I
GOTO @REDO_END
'
@REDO_COPY
 INC I:PX1=CBF[I]
 INC I:PY1=CBF[I]
 INC I:PX2=CBF[I]
 INC I:PY2=CBF[I]
 GPAGE GPL,GP
 FOR Y=PY1 TO PY2
  FOR X=PX1 TO PX2
   INC I:GPSET X,Y,CBF[I]
   INC I
  NEXT
 NEXT
 GPAGE GPL,GPL
 INC I,5
 P_CBF=I
GOTO @REDO_END
'
@REDO_REVH
 INC I:X=CBF[I]
 INC I:Y=CBF[I]
 INC I:W=CBF[I]
 INC I:H=CBF[I]
 GPAGE GPL,GP
 FOR OX=0 TO (W DIV 2)
  FOR OY=0 TO H
   C1=GSPOIT(X+OX,Y+OY)
   C2=GSPOIT(X+W-OX,Y+OY)
   GPSET X+W-OX,Y+OY,C1
   GPSET X+OX,Y+OY,C2
  NEXT
 NEXT
 GPAGE GPL,GPL
 INC I
 P_CBF=I
GOTO @REDO_END
'
@REDO_REVV
 INC I:X=CBF[I]
 INC I:Y=CBF[I]
 INC I:W=CBF[I]
 INC I:H=CBF[I]
 GPAGE GPL,GP
 FOR OY=0 TO (H DIV 2)
  FOR OX=0 TO W
   C1=GSPOIT(X+OX,Y+OY)
   C2=GSPOIT(X+OX,Y+H-OY)
   GPSET X+OX,Y+H-OY,C1
   GPSET X+OX,Y+OY,C2
  NEXT
 NEXT
 GPAGE GPL,GPL
 INC I
 P_CBF=I
GOTO @REDO_END
'
@REDO_REV90
 INC I:X=CBF[I]
 INC I:Y=CBF[I]
 INC I:W=CBF[I]
 INC I:CWW=CBF[I]
 M=W
 GPAGE GPL,GP
 FOR K=0 TO (CWW DIV 2)-1
  FOR J=0 TO M-1
   C1=GSPOIT(X+K+J  ,Y+K    )
   C2=GSPOIT(X+W-K  ,Y+K+J  )
   C3=GSPOIT(X+W-K-J,Y+W-K  )
   C4=GSPOIT(X+K    ,Y+W-K-J)
   GPSET X+K+J  ,Y+K    ,C4
   GPSET X+W-K  ,Y+K+J  ,C1
   GPSET X+W-K-J,Y+W-K  ,C2
   GPSET X+K    ,Y+W-K-J,C3
  NEXT
  M=M-2
 NEXT
 GPAGE GPL,GPL
 INC I
 P_CBF=I
GOTO @REDO_END

'============
' REV MODE
'============
@REVH
IF CPMD==0 THEN @CSRSUB

'REVH_BEGIN
SET_CMD CMD_REVH

GPAGE GPL,GP
GOSUB @CLCUVWH
X=SRCU:Y=SRCV:W=CWW-1:H=CHH-1

GED_REV X,Y,W,H

FOR OX=0 TO (W DIV 2)
 FOR OY=0 TO H
  C1=GSPOIT(X+OX,Y+OY)
  C2=GSPOIT(X+W-OX,Y+OY)
  GPSET X+W-OX,Y+OY,C1
  GPSET X+OX,Y+OY,C2
 NEXT
NEXT
GPAGE GPL,GPL

'REVH_END
END_CMD CMD_REVH_END

GOSUB @CPCSROFF
GOSUB @LOGRID
RETURN

'============
' REV MODE
'============
@REVV
IF CPMD==0 THEN @CSRSUB

'REVV_BEGIN
SET_CMD CMD_REVV

GPAGE GPL,GP
GOSUB @CLCUVWH
X=SRCU:Y=SRCV:W=CWW-1:H=CHH-1

GED_REV X,Y,W,H

FOR OY=0 TO (H DIV 2)
 FOR OX=0 TO W
  C1=GSPOIT(X+OX,Y+OY)
  C2=GSPOIT(X+OX,Y+H-OY)
  GPSET X+OX,Y+H-OY,C1
  GPSET X+OX,Y+OY,C2
 NEXT
NEXT
GPAGE GPL,GPL

'REVV_END
END_CMD CMD_REVV_END

GOSUB @CPCSROFF
GOSUB @LOGRID
RETURN

'============
' REV90 MODE
'============
@REV90
IF CPMD==0 THEN @CSRSUB

'REV90_BEGIN
SET_CMD CMD_REV90

GPAGE GPL,GP
GOSUB @CLCUVWH
X=SRCU:Y=SRCV:W=CWW-1:M=W

GED_REV X,Y,W,CWW

FOR I=0 TO (CWW DIV 2)-1
 FOR J=0 TO M-1
  C1=GSPOIT(X+I+J  ,Y+I    )
  C2=GSPOIT(X+W-I  ,Y+I+J  )
  C3=GSPOIT(X+W-I-J,Y+W-I  )
  C4=GSPOIT(X+I    ,Y+W-I-J)
  GPSET X+I+J  ,Y+I    ,C4
  GPSET X+W-I  ,Y+I+J  ,C1
  GPSET X+W-I-J,Y+W-I  ,C2
  GPSET X+I    ,Y+W-I-J,C3
 NEXT
 M=M-2
NEXT
GPAGE GPL,GPL

'REV90_END
END_CMD CMD_REV90_END

GOSUB @CPCSROFF
GOSUB @LOGRID
RETURN

'===========
' FILL MODE
'===========
@FILL
IF CPMD==0 THEN @CSRSUB

'FILL_BEGIN
SET_CMD CMD_FILL

GPAGE GPL,GP
GOSUB @CLCUVWH
X=SRCU:Y=SRCV
GED_FILL X,Y,X+CWW-1,Y+CHH-1,CC
GPAGE GPL,GPL
GOSUB @CPCSROFF
GOSUB @LOGRID

'FILL_END
END_CMD CMD_FILL_END

RETURN

'==============
' TOOL CONTROL
'==============
@DRAWEND
IF GM<=-1 THEN RETURN 'FILLやCOPYは何もしない
'---
X=TCX-LOX:Y=TCY-LOY:F$="END"
GOTO @DRAWJP

'---
@DRAWSUB
X=TCX-LOX:Y=TCY-LOY:F$=""
IF X<0 || Y<0 THEN RETURN
IF X>LW-1 THEN RETURN
IF Y>LH-1 THEN RETURN

'---
@DRAWJP
GPAGE GPL,GPL
DX=FLOOR(X/ZM)+(HX-HOX)
DY=FLOOR(Y/ZM)+(HY-HOY)
IF SFT THEN @SPOIT
'---
GOSUB "@"+FNCTX$[CMD]+F$
RETURN

'--- SPOIT
@SPOIT
GPAGE GPL,GP
CC=GSPOIT(DX,DY)
RGBREAD CC OUT A,COL[0],COL[1],COL[2]
GPAGE GPL,GPL
'--- 透明?
IF A==0 THEN
 COLNO=0
 A=BACKCOLOR()
 RGBREAD A OUT COL[0],COL[1],COL[2]
ENDIF
DEFCOL[COLNO,0]=COL[0]
DEFCOL[COLNO,1]=COL[1]
DEFCOL[COLNO,2]=COL[2]
'---
GOSUB @SETCOL
GOSUB @MAKEGRAD
GOSUB @PUTCOLOR
GM=-1
RETURN

'--- PSET
@PSET
IF GM==-1 THEN
 'PSET_BEGIN
 SET_CMD CMD_PSET

 GX=DX:GY=DY:GM=0
 ODX=-1:ODY=-1
ENDIF
IF ODX==DX && ODY==DY THEN RETURN
ODX=DX:ODY=DY
GPAGE GPL,GP
GED_LINE GX,GY,DX,DY,CC
GX=DX:GY=DY
GPAGE GPL,GPL
RETURN
@PSETEND

'PSET_END
END_CMD CMD_PSET_END

GM=-1
RETURN

'--- PAINT
@PAINT
IF TCS!=1 THEN RETURN

'PAINT_BEGIN
SET_CMD CMD_PAINT

GPAGE GPL,GP
GED_PAINT DX,DY,CC
GPAGE GPL,GPL
@PAINTEND

'PAINT_END
END_CMD CMD_PAINT_END

GM=-1
RETURN

'--- LINE
@LINE
ON GM GOTO @LINE2ND
'LINE_BEGIN
SET_CMD CMD_LINE
OGX=X:OGY=Y:GX=OGX:GY=OGY:GM=0
RETURN
'
@LINE2ND
GX=X:GY=Y:GOSUB @LOGRID
GLINE OGX+LOX,OGY+LOY,GX+LOX,GY+LOY,CC
RETURN
'
@LINEEND
GPAGE GPL,GP
GX=FLOOR(OGX/ZM)+(HX-HOX)
GY=FLOOR(OGY/ZM)+(HY-HOY)
GED_LINE GX,GY,DX,DY,CC
GPAGE GPL,GPL
GOSUB @LOGRID

'LINE_END
END_CMD CMD_LINE_END

GM=-1
RETURN

'=================
' FUNCTION BUTTON
'=================
@FUNCSUB
IF TCS>1 THEN
 I=TCS-RP1:IF I<0 THEN RETURN
 IF (I MOD RP2)>0 THEN RETURN
ENDIF
'
FOR NO=0 TO FNCMAX-1
 X=FNCX[NO]:Y=FNCY[NO]
 W=FNCW[NO]:H=FNCH[NO]
 IF TCX<X || TCX>X+W THEN CONTINUE
 IF TCY<Y || TCY>Y+H THEN CONTINUE
 BREAK
NEXT
'---
IF NO<CMDMAX THEN @SETTOOL
IF NO<GPIXTOP+4 THEN @SETGP
IF NO==UNDOIX THEN GOSUB @UNDO
IF NO==REDOIX THEN GOSUB @REDO
IF NO==GRIDIX THEN @SETGRID
IF NO==STEP8IX THEN @SETSTEP8
IF NO>=ZOOMIX THEN
 IF NO<ZOOMIX+ZCMAX THEN @SETZOOM
ENDIF
'---
IF NO==LOADIX THEN GOSUB @FLOAD
IF NO==SAVEIX THEN GOSUB @FSAVE
IF NO==EXITIX THEN GOSUB @TOOLEND
RETURN

'======
' ZOOM
'======
@SETZOOM
DISPLAY 0
HX=(HX DIV 8)*8
HY=(HY DIV 8)*8
C=0:X=HX:Y=HY
GOSUB @HICSR
GOSUB @HIGRID
DISPLAY 1
GOSUB @CLRCPCSR
'---
OLDZCNT=ZCNT:ZCNT=NO-ZOOMIX
ZM=ZC[ZCNT]
FNCST[OLDZCNT+ZOOMIX]=-1
PUTBUT OLDZCNT+ZOOMIX
FNCST[NO]=0
PUTBUT NO
'---
BGSCALE 0,ZM,ZM
SPSCALE 0,ZM,ZM
SPSCALE 10,ZM,ZM
'---
ZW=(LW/ZM):ZH=(LH/ZM)
GOSUB @LOGRID
IF OLDZCNT!=ZCNT THEN
 GOSUB @CLRCPCSR
 GOSUB @INITCPCSR
 GOSUB @PUTCPCSR
ENDIF
RETURN

'---
@SETSTEP8
GOSUB @CLRCPCSR
STEP8SW=STEP8SW XOR 1
FNCST[NO]=STEP8SW-1
PUTBUT NO
GOSUB @PUTCPCSR
RETURN
'---
DEF STEP8()
VAR I=STEP8SW
IF ZCNT==ZCMAX-1 THEN I=0
RETURN I
END

'---
@SETGRID
GRIDSW=GRIDSW XOR 1
FNCST[NO]=GRIDSW-1
PUTBUT NO
GOSUB @HIGRID
GOSUB @LOGRID
RETURN

'---
@SETGP
GPN=NO-GPIXTOP
IF GPN==2 THEN
 DISPLAY 0:SPPAGE 4
 DISPLAY 1:SPPAGE 4
ELSEIF GPN==3 THEN
 DISPLAY 0:SPPAGE 5
 DISPLAY 1:SPPAGE 5
ELSE
 DISPLAY 0:SPPAGE GPN
 DISPLAY 1:SPPAGE GPN
ENDIF
SETGPAGE GPN
RETURN

'---
@SETTOOL
IF CMD==NO THEN RETURN
'---
IF CMD>=CMDSEL_TOP && NO<CMDSEL_TOP THEN
GOSUB @CPCSROFF
ENDIF
'---
@SETTOOL0
GOSUB @LOGRID
CMD=NO
FOR I=0 TO CMDMAX-1
 FNCST[I]=-1
 IF I==NO THEN FNCST[I]=1
 PUTBUT I
NEXT
GM=-1:CPMD=0
RETURN

'============
' RGB SLIDER
'============
@RGBSEL
X=RGBX:Y=RGBY-8
IF TCX<X OR TCY<Y THEN RETURN
IF TCY>Y+64*2+16 THEN RETURN
'---
X=FLOOR((TCX-X)/(16*2))
Y=FLOOR((TCY-(Y+8))/2)*4
IF Y<0 THEN Y=0
IF Y>255 THEN Y=255
COL[X]=255-Y
'---
DEFCOL[COLNO,0]=COL[0]
DEFCOL[COLNO,1]=COL[1]
DEFCOL[COLNO,2]=COL[2]
A=255 '15/9/7
CC=RGB(A,COL[0],COL[1],COL[2]) '15/9/7
GOSUB @PUTCOLOR
GOSUB @MAKEGRAD
'---
SETBACKCOL
'---
@PUTRGB
GOSUB @PUTDEFCOL
'---
OX=RGBX+2*2:OY=RGBY:C2=RGB(0,0,0)
FOR I=0 TO 2
 IF I==0 THEN C=RGB(255,0,0)
 IF I==1 THEN C=RGB(0,255,0)
 IF I==2 THEN C=RGB(0,0,255)
 GFILL OX,OY,OX+12*2,OY+(64*2-1),C
 J=127-FLOOR(COL[I]/2)
 IF J THEN GFILL OX,OY,OX+12*2,OY+J,C2
 NX=OX-2*2:NY=(17*8*2)-1
 GFILL NX,NY,NX+17*2,NY+7*2,BC
 VPUTNO NX+8,NY+8,COL[I],#WHITE
 OX=OX+16*2
NEXT
RETURN

'=======
' COLOR
'=======
@PUTDEFCOL
OX=RGBX:OY=17*8*2-1
GFILL OX,OY,OX+32*2,OY+8*2,BC
'GPUTCHR OX,OY,RIGHT$("000"+HEX$(CC),4),WC
RETURN
'---
@PUTCOLOR
A=0
FOR X=0 TO DEFCX-1
 FOR Y=0 TO DEFCY-1
  I=X*DEFCY+Y
  R=DEFCOL[I,0]
  G=DEFCOL[I,1]
  B=DEFCOL[I,2]
  OX=COLX+X*16*2
  OY=COLY+Y*16*2
  C=RGB(A,R,G,B):A=255
  GFILL OX,OY,OX+(16*2-2),OY+(16*2-2),C
  GBOX  OX,OY,OX+(16*2-1),OY+(16*2-1),LC
 NEXT
NEXT
'---
SETBACKCOL
'
OX=COLX:OY=COLY
GLINE OX+1,OY+14*2,OX+14*2,OY+1,WC
'
OX=COLX+32*2:OY=COLY:C=WC
GBOX OX+1,OY+1,OX+(16*2-2),OY+(16*2-2),C
GBOX OX+1,OY+16*7*2+1,OX+(16*2-2),OY+16*7*2+(16*2-2),C
RETURN

'---
DEF SETBACKCOL
VAR R=DEFCOL[0,0]
VAR G=DEFCOL[0,1]
VAR B=DEFCOL[0,2]
VAR C=RGB(R,G,B)
DISPLAY 0:BACKCOLOR C
DISPLAY 1:BACKCOLOR C
END

'---
@MAKEGRAD
R=DEFCOL[16,0]
G=DEFCOL[16,1]
B=DEFCOL[16,2]
VR=(DEFCOL[23,0]-R)/8
VG=(DEFCOL[23,1]-G)/8
VB=(DEFCOL[23,2]-B)/8
FOR I=17 TO 22
 R=R+VR:IF R>255 THEN R=255
 G=G+VG:IF G>255 THEN G=255
 B=B+VB:IF B>255 THEN B=255
 DEFCOL[I,0]=FLOOR(R)
 DEFCOL[I,1]=FLOOR(G)
 DEFCOL[I,2]=FLOOR(B)
NEXT
RETURN

'================
' COLOR SELECTOR
'================
@COLSEL
X=COLX:Y=COLY
IF TCX<X OR TCY<Y THEN RETURN
IF TCY>Y+16*8*2-1 THEN RETURN
'---
X=FLOOR((TCX-X)/(16*2))
Y=FLOOR((TCY-Y)/(16*2))
COLNO=X*DEFCY+Y
IF COLNO==OLDCOLNO THEN RETURN
'--- 古いカーソル消す
IF OLDCOLNO>=0 THEN
 PX=COLX+(FLOOR(OLDCOLNO/DEFCY)*16*2)
 PY=COLY+(FLOOR(OLDCOLNO MOD DEFCY)*16*2)
 GBOX PX,PY,PX+(16*2-1),PY+(16*2-1),BC
ENDIF
'---
@SETCOL
COL[0]=DEFCOL[COLNO,0]
COL[1]=DEFCOL[COLNO,1]
COL[2]=DEFCOL[COLNO,2]
OLDCOLNO=COLNO
GOSUB @PUTRGB
'---
A=255:IF COLNO==0 THEN A=0
CC=RGB( A, COL[0],COL[1],COL[2])
'---
@COLCSR
DISPLAY 1
X=COLX+(FLOOR(COLNO/DEFCY)*16*2)
Y=COLY+(FLOOR(COLNO MOD DEFCY)*16*2)
GBOX X,Y,X+(16*2-1),Y+(16*2-1),WC
RETURN

'======
' GRID
'======
@HIGRID
DISPLAY 0:GPAGE GPH,GPH
GFILL 0,0,SCW-1,SCH-1,0
LOCATE 0,TTH-1:PRINT " "*50;
IF GRIDSW==0 THEN RETURN
'
S$="FILE EXIT v"+VER$
LOCATE TTW-LEN(S$),TTH-1:PRINT S$;
'
X=HOX AND 15:Y=HOY AND 15
'
FOR I=0 TO SCW-1 STEP GR1S*GR2S
 GLINE X+I,0,X+I,SCH-1,LC
NEXT
FOR I=0 TO SCH-1 STEP GR1S*GR2S
 GLINE 0,Y+I,SCW-1,Y+I,LC
NEXT
GFILL 0,SCH-10,SCW,SCH-1,LC
RETURN
'---
@LOGRID
DISPLAY 1:GPAGE GPL,GPL
LGW=(LW/ZM):LGH=(LH/ZM)
'---
GFILL LOX-3,LOY-2,LOX+LW+3,LOY+LH+2,_WHITE
GFILL LOX-2,LOY-3,LOX+LW+2,LOY+LH+3,_WHITE
GFILL LOX,LOY,LOX+LW-1,LOY+LH-1,0
IF GRIDSW==0 THEN RETURN
'---
G1=GR1S:G2=GR2S
IF ZCNT==ZCMAX-1 THEN G1=1:G2=8
'---
X=LOX:TX=HX-HOX:OX=TX MOD G1
Y=LOY:TY=HY-HOY:OY=TY MOD G1
'---
FOR I=-OY TO LGH STEP G1
 IF I>=0 THEN
  C=GR1C
  IF (((TY+I) DIV G1) MOD G2)THEN C=LC
  YY=Y+I*ZM:GLINE X,YY,X+LW-1,YY,C
 ENDIF
NEXT
FOR I=-OX TO LGW STEP G1
 IF I>=0 THEN
  C=GR1C
  IF (((TX+I) DIV G1) MOD G2)THEN C=LC
  XX=X+I*ZM:GLINE XX,Y,XX,Y+LH-1,C
 ENDIF
NEXT
RETURN

'============
' INITIALIZE
'============
@DISPINIT
'
' HI
'
DISPLAY 0:VISIBLE 1,1,1,1:CLS
GPAGE GPH,GPH:GPRIO 100:GCLS 0
HW=FRW-SCW:HH=FRH-SCH
BGOFS 0,HX,HY,HZ
SPSET 0,0:SPHIDE 0  'COPYCSR
SPDEF 1,0,0,16,16
SPSET 1,1           'HI BGPUT0
SPOFS 1,-HX,-HY,HZ

'
' LO
'
DISPLAY 1:VISIBLE 1,1,1,1:CLS
GPAGE GPL,GPL:GPRIO 100:GCLS BC
'---
SPSET 10,1          'LO BGPUT0
'---
X=142*2:Y=202*2:W=82*2:H=21*2
GFILL X,Y,X+W-1,Y+H-1,_WHITE
GFILL X+1,Y+H,X+W-2,Y+H,_WHITE
'--- function
FOR I=0 TO FNCMAX-1
 V=-1
 IF I==TOOLNO  THEN V=1
 IF I==GRIDIX  THEN V=GRIDSW-1
 IF I==STEP8IX THEN V=STEP8SW-1
 IF I==UNDOIX || I==REDOIX THEN V=-2
 FNCST[I]=V
 PUTBUT I
NEXT
'--- zoom
LOX=8*2:LOY=8*2:LW=(8+3)*32*2:LH=8*24*2
SPSET 0,0:SPHIDE 0 'COPYCSR
SPOFS 0,LOX,LOY
BGCLIP 0,LOX,LOY,LOX+LW-1,LOY+LH-1
BGHOME 0,8*2,8*2
SPCLIP LOX,LOY,LOX+LW-1,LOY+LH-1
SPOFS 10,8*2,8*2

LX=LOX:LY=LOY:LZ=500
NO=ZOOMIX+2:GOSUB @SETZOOM
GOSUB @SETOFSLO

'--- low color palette
@PALDATA
DATA   0,  0,  0
DATA  63, 63, 63
DATA 255, 31,  0
DATA 255, 95,192
DATA   0, 63,240
DATA 127, 63,255
DATA   0,191,255
DATA 151, 94, 46
'
DATA 255,160,  0
DATA 255,203,167
DATA   0,127,  0
DATA   0,240, 31
DATA 255,224,  0
DATA 191,191,191
DATA   0,  0,  0
DATA 255,255,255
'
DATA  10, 10, 10
DATA   0,  0,  0
DATA   0,  0,  0
DATA   0,  0,  0
DATA   0,  0,  0
DATA   0,  0,  0
DATA   0,  0,  0
DATA 200,200,200
'
RESTORE @PALDATA
FOR I=0 TO (DEFCX*DEFCY)-1
 READ DEFCOL[I,0]
 READ DEFCOL[I,1]
 READ DEFCOL[I,2]
NEXT
GOSUB @MAKEGRAD
'---
RGBX=COLX:RGBY=COLY+18*8*2-4
GOSUB @PUTCOLOR
GOSUB @SETCOL
GOSUB @PUTCPCSR
'---
SETGPAGE GPIX
GOSUB @HIGRID
GOSUB @LOGRID
RETURN

'--------------------------------
' user function
'--------------------------------

'--- 
DEF VPUTNO X,Y,NO,VC
VAR S$=RIGHT$("  "+STR$(NO),3)
GPUTCHR X,Y,MID$(S$,0,1),VC
GPUTCHR X+5,Y,MID$(S$,1,1),VC
GPUTCHR X+10,Y,MID$(S$,2,1),VC
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
VAR O,X,Y,W,H,C,N,V
O=DISPLAY():DISPLAY 1
X=FNCX[I]:Y=FNCY[I]:W=FNCW[I]:H=FNCH[I]
C=RGB(240,192,32)
IF I>=GPIXTOP   THEN C=RGB( 46,122,240)
IF FNCST[I]==-1 THEN C=RGB(160,160,160)
IF FNCST[I]==-2 THEN C=RGB( 81, 81, 81)
GFILL X+1,Y,  X+W-4,Y+H,C
GFILL X,  Y+1,X+W-3,Y+H-1,C
'--- text
INC X,2:INC Y,3:C=RGB(0,0,0)
FOR N=0 TO LEN(FNCTX$[I])-1
 C$=MID$(FNCTX$[I],N,1)
 V=6:IF C$=="I" THEN DEC X:V=5
 GPUTCHR X,Y,C$,C:INC X,V
NEXT
DISPLAY O
END

'---
DEF SETGPAGE G
GPIX=G '0/1/2/3
'
FOR I=0 TO 3
 N=GPIXTOP+I:FNCST[N]=-1
 IF I==G THEN FNCST[N]=GBK[G]
 PUTBUT N
NEXT
'
GP=FNCST[ GPIXTOP+G ]
O=DISPLAY()
DISPLAY 0:BGPAGE GP
DISPLAY 1:BGPAGE GP
DISPLAY O
END

'====================
' 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

'==============
' FILE UTILITY
'==============
@FILE
DATA "機能を選んでボタンを押して下さい"
DATA " "
DATA "Aボタン:LOAD（データ読み込み）"
DATA "Xボタン:SAVE（データ保存）"
DATA "Yボタン:フォント読み込み"
DATA "Bボタン:ツールに戻る"
DATA ""
R=DLG( "@FILE",-1,"ファイル管理メニュー" )
J$=""
IF R==128 THEN J$="@FLOAD" '
IF R==129 THEN J$="" '
IF R==130 THEN J$="@FSAVE" '
IF R==131 THEN J$="@FFONT" '
IF J$!="" && CHKLABEL(J$) THEN GOSUB J$
FILESW=TRUE
RETURN

'======
' FONT
'======
@FFONT
GETFONT GP
RETURN
'---
DEF GETFONT P
DIM T%[FRW*FRH]
GSAVE -1,0,0,FRW,FRH,T%,0
VAR VP,WP
GPAGE VP,P
GLOAD 0,0,FRW,FRH,T%,0,1
GPAGE VP,WP
END

'======
' SAVE
'======
@FSAVE
GOSUB @INITCPCSR
GOSUB @LOGRID
FILESW=TRUE:C$="SAVEするイメージの名前"
G$="GRP"+STR$(GBK[GPIX])
FN$=FNAME$[GPIX]
N$=GETNAME$(G$,FN$,"","",14,C$)
FNAME$[GPIX]=TMP$
IF N$!="" THEN SAVE N$
'---
NO=CMD_PSET:GOSUB @SETTOOL0
RETURN

'======
' LOAD
'======
@FLOAD
FILESW=TRUE:C$="LOADするイメージの名前"
G$="GRP"+STR$(GBK[GPIX])
FN$=FNAME$[GPIX]
N$=GETNAME$(G$,FN$,"","",14,C$)
FNAME$[GPIX]=TMP$
IF N$!="" THEN LOAD N$
'---
NO=CMD_PSET:GOSUB @SETTOOL0
RETURN

'===================
' GET NAME(GRPONLY)
'===================
DEF GETNAME$( G$,F$,T$,E$,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$
IF E$!="" THEN F$=F$+"_"+E$
RETURN F$
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

'====================
' SET COMMAND BUFFER
'====================
DEF SET_CMD C
 P_LAST=LEN(CBF)-1
 IF P_CBF<P_LAST THEN 
  'DELETE BUFFER
  FOR I=1 TO P_LAST-P_CBF
   A=POP(CBF)
  NEXT
  FNCST[REDOIX]=-2:PUTBUT REDOIX
 ENDIF
 'SET COMMAND
 P_CBF=LEN(CBF)
 PUSH CBF,C
 FNCST[UNDOIX]=-1:PUTBUT UNDOIX
END

'====================
' END COMMAND BUFFER
'====================
DEF END_CMD C
 'END COMMAND
 P_CBF=LEN(CBF)
 PUSH CBF,C
END

'==========
' GED_PSET
'==========
DEF GED_PSET PX,PY,CL
 PUSH CBF,-1            'DUMMY COMMAND ID
 PUSH CBF,PY            'POS Y
 PUSH CBF,PX            'POS x
 PUSH CBF,CL            'NEW COLOR
 PUSH CBF,GSPOIT(PX,PY) 'OLD COLOR
 PUSH CBF,-1            'DUMMY COMMAND ID
 GPSET PX,PY,CL
END

'==========
' GED_LINE
'==========
DEF GED_LINE PX1,PY1,PX2,PY2,CL
 VAR LN=MAX(ABS(PX2-PX1),ABS(PY2-PY1))+1
 VAR PX,PY,XN,YN
 PX=PX1
 PY=PY1
 XN=(PX2-PX1)/LN
 YN=(PY2-PY1)/LN
 FOR I=0 TO LN
  GED_PSET ROUND(PX),ROUND(PY),CL
  PX=PX+XN
  PY=PY+YN
 NEXT
END

'===========
' GED_PAINT
'===========
DEF GED_PAINT PX,PY,CL
 PUSH CBF,PY            'POS Y
 PUSH CBF,PX            'POS x
 PUSH CBF,CL            'NEW COLOR
 PUSH CBF,GSPOIT(PX,PY) 'OLD COLOR
 GPAINT PX,PY,CL
END

'==========
' GED_FILL
'==========
DEF GED_FILL PX1,PY1,PX2,PY2,CL
 VAR X,Y
 'SET UNDO INFO
 PUSH CBF,PX1
 PUSH CBF,PY1
 PUSH CBF,PX2
 PUSH CBF,PY2
 PUSH CBF,CL
 FOR Y=PY1 TO PY2
  FOR X=PX1 TO PX2
   PUSH CBF,GSPOIT(X,Y)
   GPSET X,Y,CL
  NEXT
 NEXT
 'SET REDO INFO
 PUSH CBF,CL
 PUSH CBF,PY2
 PUSH CBF,PX2
 PUSH CBF,PY1
 PUSH CBF,PX1
END

'==========
' GED_COPY
'==========
DEF GED_COPY PX1,PY1,WW,HH,DT%,SFT
 VAR X,Y,CS,CD,CT
 CT=0
 'SET UNDO INFO
 PUSH CBF,PX1
 PUSH CBF,PY1
 PUSH CBF,PX1+WW
 PUSH CBF,PY1+HH
 FOR Y=PY1 TO PY1+HH
  FOR X=PX1 TO PX1+WW
   CS=GSPOIT(X,Y)
   CD=DT%[CT]
   IF SFT==0 && (CD AND &HFF000000)==0 THEN CD=CS
   PUSH CBF,CD
   PUSH CBF,CS
   INC CT
  NEXT
 NEXT
 'SET REDO INFO
 PUSH CBF,PY1+HH
 PUSH CBF,PX1+WW
 PUSH CBF,PY1
 PUSH CBF,PX1
END

'=========
' GED_REV
'=========
DEF GED_REV PX,PY,WW,HH
 PUSH CBF,PX
 PUSH CBF,PY
 PUSH CBF,WW
 PUSH CBF,HH
END
ページトップへ