SmileBASIC

プログラムリスト

SYS/SBGED

スクリーンショット

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


'
' GRAPHIC EDITOR
'
' (c)2014-2016 SmileBoom Co.Ltd.
'
' #透明をBACKCOLORで扱う
' #色見本廃止(ダイレクトに変化)
' #BGでイメージ表示に変更
' #ゴサ補正の都合で、倍率3/6/12廃止
' #コピー系をタッチ操作に変更
' #フォント読み込み追加
'
VER$="1.7":TXZ=200:GRZ=0:SPZ=250:BGZ=500
XSCREEN 2,256,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,32,32:BGCLIP 0
 FOR Y=0 TO 31
  FOR X=0 TO 31
   BGPUT 0,X,Y,(X+Y*32)+1024
  NEXT
 NEXT
NEXT
'---
COLX=8*34-2:COLY=4

'
' 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]
'
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=23
DIM FNCST[FNCMAX],FNCTX$[FNCMAX]
DIM FNCX[FNCMAX],FNCY[FNCMAX]
DIM FNCW[FNCMAX],FNCH[FNCMAX]
'
DATA "PSET",  4,209,32,12 '0
DATA "LINE", 37,209,29,12 '1
DATA "PAINT",67,209,35,12 '2
DATA "FILL",103,209,32,12 '3
'
DATA "COPY",  4,225,32,12 '4
DATA "",   37,225,19,12 '5
DATA "",   57,225,19,12 '6
DATA "R90",  77,225,25,12 '7

DATA "G0",144,209,20,12 '8
DATA "G1",164,209,20,12 '9
DATA "SP",184,209,20,12 '10
DATA "BG",204,209,20,12 '11
'
DATA "UNDO",103,225,32,12 '12
'
DATA "GRID",227,209,29,12 '13
DATA "8",256,209,15,12 '14
'
DATA "1",146,225,13,12 '15
DATA "2",160,225,13,12 '16
DATA "4",174,225,13,12 '17
DATA "8",188,225,13,12 '18
DATA "16",202,225,20,12 '19
'
DATA "LOAD",240,225,31,12 '20
DATA "SAVE",272,225,31,12 '21
DATA "",306,225,14,12 '22
'---
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
CMDSEL_TOP=CMD_FILL
'---
GPIXTOP=8:UNDOIX=12
GRIDIX=13:STEP8IX=14:ZOOMIX=15
'---
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%[512*512]
DIM CPWK%[512*512]
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: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
'---
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=(400-(LW/ZM)):H=(240-(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
'---
IF GRIDSW==0 THEN RETURN
'---
S$=STR$(HX-HOX,3)+","+STR$(HY-HOY,3)
S$=S$+"(x"+STR$(ZM,2)+") "
LOCATE 0,29: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
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 RETURN
'--- ペースト決定
DISPLAY 0:GPAGE GPH,GP
GOSUB @CLCUVWH
DX=(HX-HOX)+CPX:DY=(HY-HOY)+CPY
GLOAD DX,DY,CWW,CHH,CPWK%,0,SFT
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
GOSUB @UNDOSAVE
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:Y=CPY*S+8
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
'======
@UNDOSAVE
DISPLAY 0
GPAGE GPH,GP
GSAVE GP,0,0,511,511,UNWK%,0
DISPLAY 1
FNCST[UNDOIX]=1:PUTBUT UNDOIX
RETURN
'
@UNDOLOAD
IF FNCST[UNDOIX]!=1 THEN RETURN
DISPLAY 0
GPAGE GPH,GP
GLOAD 0,0,511,511,UNWK%,0,TRUE
DISPLAY 1
FNCST[UNDOIX]=-1:PUTBUT UNDOIX
RETURN

'============
' REV MODE
'============
@REVH
IF CPMD==0 THEN @CSRSUB
'
GOSUB @UNDOSAVE
GPAGE GPL,GP
GOSUB @CLCUVWH
X=SRCU:Y=SRCV:W=CWW-1:H=CHH-1
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
GOSUB @CPCSROFF
GOSUB @LOGRID
RETURN

'============
' REV MODE
'============
@REVV
IF CPMD==0 THEN @CSRSUB
'
GOSUB @UNDOSAVE
GPAGE GPL,GP
GOSUB @CLCUVWH
X=SRCU:Y=SRCV:W=CWW-1:H=CHH-1
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
GOSUB @CPCSROFF
GOSUB @LOGRID
RETURN

'============
' REV90 MODE
'============
@REV90
IF CPMD==0 THEN @CSRSUB
'
GOSUB @UNDOSAVE
GPAGE GPL,GP
GOSUB @CLCUVWH
X=SRCU:Y=SRCV:W=CWW-1:M=W
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
GOSUB @CPCSROFF
GOSUB @LOGRID
RETURN

'===========
' FILL MODE
'===========
@FILL
IF CPMD==0 THEN @CSRSUB
'
GOSUB @UNDOSAVE
GPAGE GPL,GP
GOSUB @CLCUVWH
X=SRCU:Y=SRCV
GFILL X,Y,X+CWW-1,Y+CHH-1,CC
GPAGE GPL,GPL
GOSUB @CPCSROFF
GOSUB @LOGRID
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 OR 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
 GOSUB @UNDOSAVE
 GX=DX:GY=DY:GM=0
ENDIF
GPAGE GPL,GP
GLINE GX,GY,DX,DY,CC
GX=DX:GY=DY
GPAGE GPL,GPL
RETURN
@PSETEND
GM=-1
RETURN

'--- PAINT
@PAINT
IF TCS!=1 THEN RETURN
GOSUB @UNDOSAVE
GPAGE GPL,GP
GPAINT DX,DY,CC
GPAGE GPL,GPL
@PAINTEND
GM=-1
RETURN

'--- LINE
@LINE
ON GM GOTO @LINE2ND
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
GOSUB @UNDOSAVE
GPAGE GPL,GP
GX=FLOOR(OGX/ZM)+(HX-HOX)
GY=FLOOR(OGY/ZM)+(HY-HOY)
GLINE GX,GY,DX,DY,CC
GPAGE GPL,GPL
GOSUB @LOGRID
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 @UNDOLOAD
IF NO==GRIDIX THEN @SETGRID
IF NO==STEP8IX THEN @SETSTEP8
IF NO>=ZOOMIX THEN
 IF NO<ZOOMIX+ZCMAX THEN @SETZOOM
ENDIF
'---
IF NO==20 THEN GOSUB @FLOAD
IF NO==21 THEN GOSUB @FSAVE
IF NO==22 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
'---
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
SETGPAGE NO-GPIXTOP
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+16 THEN RETURN
'---
X=FLOOR((TCX-X)/16)
Y=FLOOR((TCY-(Y+8))/2)*8
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: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,OY+63,C
 J=63-FLOOR(COL[I]/4)
 IF J THEN GFILL OX,OY,OX+12,OY+J,C2
 NX=OX-2:NY=(17*8)-1
 GFILL NX,NY,NX+17,NY+7,BC
 VPUTNO NX,NY,COL[I],#WHITE
 OX=OX+16
NEXT
RETURN

'=======
' COLOR
'=======
@PUTDEFCOL
OX=35*8-2:OY=17*8-1
GFILL OX,OY,OX+32,OY+8,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
  OY=COLY+Y*16
  C=RGB(A,R,G,B):A=255
  GFILL OX,OY,OX+14,OY+14,C
  GBOX  OX,OY,OX+15,OY+15,LC
 NEXT
NEXT
'---
SETBACKCOL
'
OX=COLX:OY=COLY
GLINE OX+1,OY+14,OX+14,OY+1,WC
'
OX=COLX+32:OY=COLY:C=WC
GBOX OX+1,OY+1,OX+14,OY+14,C
GBOX OX+1,OY+16*7+1,OX+14,OY+16*7+14,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-1 THEN RETURN
'---
X=FLOOR((TCX-X)/16)
Y=FLOOR((TCY-Y)/16)
COLNO=X*DEFCY+Y
IF COLNO==OLDCOLNO THEN RETURN
'--- 古いカーソル消す
IF OLDCOLNO>=0 THEN
 PX=COLX+(FLOOR(OLDCOLNO/DEFCY)*16)
 PY=COLY+(FLOOR(OLDCOLNO MOD DEFCY)*16)
 GBOX PX,PY,PX+15,PY+15,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)
Y=COLY+(FLOOR(COLNO MOD DEFCY)*16)
GBOX X,Y,X+15,Y+15,WC
RETURN

'======
' GRID
'======
@HIGRID
DISPLAY 0:GPAGE GPH,GPH
GFILL 0,0,399,239,0
LOCATE 0,29:PRINT " "*50;
IF GRIDSW==0 THEN RETURN
'
S$="FILE EXIT v"+VER$
LOCATE 50-LEN(S$),29:PRINT S$;
'
X=HOX AND 15:Y=HOY AND 15
'
FOR I=0 TO 399 STEP GR1S*GR2S
 GLINE X+I,0,X+I,239,LC
NEXT
FOR I=0 TO 239 STEP GR1S*GR2S
 GLINE 0,Y+I,399,Y+I,LC
NEXT
GFILL 0,230,399,239,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=512-400:HH=512-240
BGOFS 0,HX,HY,HZ
SPSET 0,0:SPHIDE 0 'COPYCSR

'
' LO
'
DISPLAY 1:VISIBLE 1,1,1,1:CLS
GPAGE GPL,GPL:GPRIO 100:GCLS BC
'---
X=142:Y=202:W=82:H=21
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
 FNCST[I]=V
 PUTBUT I
NEXT
'--- zoom
LOX=8:LOY=8:LW=8*32:LH=8*24
SPSET 0,0:SPHIDE 0 'COPYCSR
SPOFS 0,LOX,LOY
BGCLIP 0,LOX,LOY,LOX+LW-1,LOY+LH-1
BGHOME 0,8,8
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=CCY+19*8-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
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)
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%[512*512]
GSAVE -1,0,0,512,512,T%,0
VAR VP,WP
GPAGE VP,P
GLOAD 0,0,512,512,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
ページトップへ