プログラムリスト
SYS/SBGED

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

'
' GRAPHIC EDITOR
'
' (c)2014 SmileBoom Co.Ltd.
'

'---
VER$="1.0":TXZ=200:GRZ=0:SPZ=250:BGZ=500
XSCREEN 2:GPH=2:GPL=3
COLOR 15,0:CLS:RP1=15:RP2=1
FOR I=0 TO 3:BREPEAT I,RP1,RP2:NEXT
FOR I=0 TO 1
 DISPLAY I
 GPRIO GRZ
 VISIBLE 1,1,1,1
NEXT

'
' initialize
'
LC=RGB(64,64,64):BC=RGB(96,96,96)
WC=RGB(255,255,255)
GR1C=RGB(255, 64,200):GR1S=8
GR2C=RGB(128, 96, 96):GR2S=2
'
DEFCX=3:DEFCY=8:DEFCMAX=DEFCX*DEFCY
DIM COL[3],DEFCOL[DEFCMAX,3]
'
ZCMAX=8:DIM ZC[ZCMAX]
DATA 1,2,3,4,6,8,12,16
FOR I=0 TO ZCMAX-1:READ ZC[I]:NEXT
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=17
DIM FNCST[FNCMAX],FNCTX$[FNCMAX]
DIM FNCX[FNCMAX],FNCY[FNCMAX]
DIM FNCW[FNCMAX],FNCH[FNCMAX]
'
DATA "PSET",  4,210,40,16 '0
DATA "LINE", 44,210,40,16 '1
DATA "PAINT",84,210,48,16 '2
DATA "FL",  4,226,24,16 '3
DATA "CP", 28,226,24,16 '4
DATA "", 52,226,24,16 '5
DATA "", 76,226,24,16 '6
DATA "90",100,226,24,16 '7
'
DATA "G0",140,210,24,16 '8
DATA "G1",140,226,24,16 '9
DATA "SP",164,210,24,16 '10
DATA "BG",164,226,24,16 '11
'
DATA "UD",196,210,24,16 '12
DATA "",220,210,24,16 '13
DATA "x8",220,226,24,16 '14
'
DATA "+",252,210,16,16 '15
DATA "-",252,226,16,16 '16
'
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
'---
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
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)
SFT=BTN AND &H300
BRP=BUTTON(1)
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
 GOTO @RESTART
ENDIF
'--- :EXIT
IF BRP==&H40 THEN EXITSW=TRUE
IF EXITSW==FALSE THEN @MLOOP

'======
' EXIT
'======
DISPLAY 0:VISIBLE 1,0,0,0:CLS
PRINT "EXIT":TXLINEB
K$=GETKEY$("ARE YOU SURE?[Y/N]")
IF K$!="Y" THEN
 EXITSW=FALSE
 GOTO @RESTART
ENDIF
'---
EXEC "SYS/SBSMILE"
END

'=========
' HI MAIN
'=========
@HIMAIN
DISPLAY 0:GPAGE GPH,GPH
XS=0:YS=0:AX=SVX:AY=SVY
IF AX==0 && AY==0 THEN
 AX=BVX:AY=BVY
 IF CMD>=CMDSEL_TOP THEN
  IF CPMD==0 THEN AX=0:AY=0
 ENDIF
ENDIF
IF STEP8SW THEN AX=AX*8:AY=AY*8
OX=HX:OY=HY:HX=HX+AX:HY=HY+AY
W=400-ZW:H=240-ZH
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
'---
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 THEN
 GOSUB @LOGRID
 GOSUB @HIGRID
ENDIF
C=(MAINCNT AND 31)*4+127
C=RGB(C,0,0):X=HX:Y=HY
'---
@HICSR
GBOX X+1,Y,X+ZW-2,Y+ZH-1,C
GBOX X,Y+1,X+ZW-1,Y+ZH-2,C
SPOFS 0,HOX,HOY,HZ
'---
IF GRIDSW==0 THEN RETURN
S$=FORMAT$("%3D,%3D",HX-HOX,HY-HOY)
LOCATE 0,29:PRINT S$;
RETURN

'=========
' LO MAIN
'=========
@LOMAIN
DISPLAY 1:C$=" "*6
IF SFT THEN C$=""
LOCATE 34,0:PRINT C$;
'---
IF TCS>0 THEN
 GOSUB @COLSEL
 GOSUB @RGBSEL
 GOSUB @SELDEFCOL
 GOSUB @FUNCSUB
ELSE
 GOSUB @DRAWEND
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
'---
X=HX-HOX:Y=HY-HOY
SPOFS 0,LX-(X*ZM),LY-(Y*ZM),LZ
GOSUB @COLCSR
'---
S$=""
IF CMD>=CMDSEL_TOP THEN
 S$=S$+FORMAT$("(%3D,%3D)",CPW,CPH)
ENDIF
S$=S$+FORMAT$(" x%02D",ZM)
LOCATE 34-LEN(S$),25:PRINT S$;
RETURN

'======
' UNDO
'======
@UNDOSAVE
DISPLAY 0
GPAGE GPH,GPH
GCOPY GP,0,  0,511,255,0,256,1
GPAGE GPH,GPL
GCOPY GP,0,256,511,511,0,256,1
DISPLAY 1
FNCST[UNDOIX]=1:PUTBUT UNDOIX
RETURN
'
@UNDOLOAD
IF FNCST[UNDOIX]!=1 THEN RETURN
DISPLAY 0
GPAGE GPH,GP
GCOPY GPH,0,256,511,511,0,  0,1
GPAGE GPH,GP
GCOPY GPL,0,256,511,511,0,256,1
DISPLAY 1
FNCST[UNDOIX]=-1:PUTBUT UNDOIX
RETURN

'============
' REV MODE
'============
@REVH
IF CPMD==0 THEN @CSRSUB
'
GOSUB @UNDOSAVE
GPAGE GPL,GP
X=HX-HOX:Y=HY-HOY:W=CPW-1:H=CPH-1
FOR OX=0 TO (W DIV 2)
 FOR OY=0 TO H-1
  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
X=HX-HOX:Y=HY-HOY:W=CPW-1:H=CPH-1
FOR OY=0 TO (H DIV 2)
 FOR OX=0 TO W-1
  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
X=HX-HOX:Y=HY-HOY:W=CPW-1:M=W-1
FOR I=0 TO (CPW DIV 2)
 FOR J=0 TO M
  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
X=HX-HOX:Y=HY-HOY:W=CPW-1:H=CPH-1
GFILL X,Y,X+W,Y+H,CC
GPAGE GPL,GPL
GOSUB @CPCSROFF
GOSUB @LOGRID
RETURN

'===========
' COPY MODE
'===========
@COPY
IF CPMD==0 THEN @CSRSUB
'
C=((FC>>2) AND &H7)*&H10000000
C=C OR &H80FFFFFF
'
DISPLAY 0
SPCHR 1,SRCU,SRCV,CPW,CPH
SPOFS 1,HX,HY,-200
SPCOLOR 1,C
SPSHOW 1
'
DISPLAY 1
SPCHR 1,SRCU,SRCV,CPW,CPH
SPSCALE 1,ZM,ZM
SPOFS 1,8+CPX*ZM,8+CPY*ZM,-200
SPCOLOR 1,C
SPSHOW 1
'
GOSUB @PUTCPCSR
'
IF BRP AND &H20 THEN
 GOSUB @CPCSROFF
 RETURN
ENDIF
'
IF (BRP AND &H10)==0 THEN RETURN

' paste

DISPLAY 0:GPAGE GPH,GP
X=SRCU:Y=SRCV:W=CPW-1:H=CPH-1
DX=HX-HOX:DY=HY-HOY
GCOPY X,Y,X+W,Y+H,DX,DY,SFT
DISPLAY 1
RETURN

'---
@CSRSUB
VX=BVX:VY=BVY
IF STEP8SW THEN VX=VX*8:VY=VY*8
'
IF BRP AND &H10 THEN
 CPMD=1
 SRCU=CPX+(HX-HOX)
 SRCV=CPY+(HY-HOY)
 OLDHW=ZW:OLDHH=ZH
 ZW=CPW:ZH=CPH
 GOSUB @HIGRID
 DISPLAY 1
 GOSUB @UNDOSAVE
 RETURN
ENDIF
'
IF VX || VY THEN
 GOSUB @CLRCPCSR
 '---
 OLDX=CPX:OLDY=CPY:OLDW=CPW:OLDH=CPH
 CPW=CPW+VX
 IF CPW<8  THEN CPW=8
 IF CPW>ZW THEN CPW=ZW
 CPH=CPH+VY
 IF CPH<8  THEN CPH=8
 IF CPH>ZH THEN CPH=ZH
 '---
 IF CMD==CMD_REV90 THEN
  IF VX THEN CPH=CPW
  IF VY THEN CPW=CPH
  IF CPH>ZH THEN
   CPH=ZH:CPW=ZH
  ENDIF
 ENDIF
 '---
 GOSUB @LOGRID
ENDIF
'
GOSUB @PUTCPCSR
RETURN

' copy cursor

@INITCPCSR
CPX=0:CPY=0:CPW=8:CPH=8
@CPCSROFF
IF CPMD==1 THEN
 DISPLAY 0:SPHIDE 1:GOSUB @HIGRID
 DISPLAY 1:SPHIDE 1:GOSUB @LOGRID
 ZW=OLDHW:ZH=OLDHH
ENDIF
CPMD=0
RETURN
'
@CLRCPCSR
C=0:GOTO @CPCSRSUB
'
@PUTCPCSR
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
GBOX X,Y,X+W-1,Y+H-1,C
GBOX X+1,Y+1,X+W-2,Y+H-2,C
RETURN

'==============
' TOOL CONTROL
'==============
@DRAWEND
IF GM==-1 THEN RETURN
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
'
CC=RGB( COL[0],COL[1],COL[2])
IF COLNO==0 THEN CC=CC AND &HFFFE
GOSUB "@"+FNCTX$[CMD]+F$
RETURN

'--- SPOIT
@SPOIT
GPAGE GPL,GP
CC=GSPOIT(DX,DY)
RGBREAD CC OUT COL[0],COL[1],COL[2]
GPAGE GPL,GPL
GOSUB @PUTRGB
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 VZ=1:GOTO @SETZOOM
IF NO==ZOOMIX+1 THEN VZ=-1:GOTO @SETZOOM

RETURN

'======
' ZOOM
'======
@SETZOOM
DISPLAY 0
C=0:X=HX:Y=HY
GOSUB @HICSR
GOSUB @HIGRID
'
DISPLAY 1
GOSUB @CLRCPCSR
OLDZCNT=ZCNT:ZCNT=ZCNT+VZ
IF ZCNT<0  THEN ZCNT=0
IF ZCNT>=ZCMAX THEN ZCNT=ZCMAX-1
ZM=ZC[ZCNT]
SPSCALE 0,ZM,ZM
ZW=(LW/ZM):ZH=(LH/ZM)
GOSUB @LOGRID
IF OLDZCNT!=ZCNT THEN
 GOSUB @INITCPCSR
 GOSUB @PUTCPCSR
ENDIF
RETURN

'---
@SETSTEP8
STEP8SW=STEP8SW XOR 1
FNCST[NO]=STEP8SW-1
PUTBUT NO
RETURN

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

'---
@SETGP
SETGPAGE NO-GPIXTOP
'--- copy mode clear
GOSUB @INITCPCSR
RETURN

'---
@SETTOOL
IF CMD==NO THEN RETURN
'
GOSUB @INITCPCSR
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
'
LOCATE 1,25:PRINT " "*16;
IF CMD>=CMDSEL_TOP THEN
 LOCATE 1,25
 PRINT " :OK :BACK ";
ENDIF
RETURN

'============
' RGB SLIDER
'============
@RGBSEL
X=RGBX:Y=RGBY
IF TCX<X OR TCY<Y THEN RETURN
IF TCY>Y+63 THEN RETURN
'---
X=FLOOR((TCX-X)/16)
Y=FLOOR((TCY-Y))*4
IF Y>0 THEN Y=Y+4
IF Y>255 THEN Y=255
COL[X]=Y
'---
@PUTRGB
GOSUB @PUTDEFCOL
'---
OX=RGBX+2:OY=RGBY+2
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,RGB(0,0,0)
 GFILL OX,OY,OX+12,OY+(COL[I]/4),C
 VPUTNO 35+I*2,25,COL[I]
 OX=OX+16
NEXT
RETURN

'===============
' DEFAULT COLOR
'===============
@SELDEFCOL
X=COLX+4:Y=COLY+8*16+2+4
IF TCX<X OR TCY<Y THEN @PUTDEFCOL
IF TCY>Y+18 THEN @PUTDEFCOL
IF SFT==0 THEN @PUTDEFCOL
'---
DEFCOL[COLNO,0]=COL[0]
DEFCOL[COLNO,1]=COL[1]
DEFCOL[COLNO,2]=COL[2]
GOSUB @SETCOL
GOSUB @MAKEGRAD
GOSUB @PUTCOLOR
'---
@PUTDEFCOL
CC=RGB( COL[0],COL[1],COL[2])
OX=COLX+4:OY=COLY+8*16+2+4
GFILL OX,OY,OX+39,OY+18,CC
LOCATE 35,29
PRINT RIGHT$("000"+HEX$(CC),4);
RETURN
'---
@PUTCOLOR
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+1:OY=COLY+Y*16+1
  C=RGB(R,G,B)
  GFILL OX+1,OY,OX+12,OY+13,C
  GFILL OX,OY+1,OX+13,OY+12,C
 NEXT
NEXT
'
OX=COLX:OY=COLY
GBOX OX+1,OY,OX+14,OY+15,WC
GBOX OX,OY+1,OX+15,OY+14,WC
GLINE OX+12,OY+3,OX+3,OY+12,WC
'
OX=COLX+32:OY=COLY
GBOX OX+1,OY,OX+14,OY+127,WC
GBOX OX,OY+1,OX+15,OY+126,WC
GBOX OX,OY+15,OX+15,OY+112,WC
GBOX OX,OY+16,OX+15,OY+111,WC
RETURN

'---
@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=FLOOR(OLDCOLNO/DEFCY)*2+34
 PY=FLOOR(OLDCOLNO MOD DEFCY)*2+1
 LOCATE PX,PY  :PRINT"  ";
 LOCATE PX,PY+1:PRINT"  ";
ENDIF
'---
@SETCOL
COL[0]=DEFCOL[COLNO,0]
COL[1]=DEFCOL[COLNO,1]
COL[2]=DEFCOL[COLNO,2]
IF COLNO==0 THEN
 C=RGB(COL[0],COL[1],COL[2])
 DISPLAY 0
 BACKCOLOR C
 DISPLAY 1
 BACKCOLOR C
ENDIF
OLDCOLNO=COLNO
GOSUB @PUTRGB
'---
@COLCSR
DISPLAY 1
X=FLOOR(COLNO/DEFCY)*2+34
Y=FLOOR(COLNO MOD DEFCY)*2+1
C=14:IF (MAINCNT AND 31)<15 THEN C=15
COLOR C
LOCATE X,Y  :PRINT"";
LOCATE X,Y+1:PRINT"";
COLOR 15
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 ver"+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
GFILL LOX,LOY,LOX+LW-1,LOY+LH-1,0
IF GRIDSW==0 THEN RETURN
'
X=LOX:TX=HX-HOX:OX=TX MOD GR1S
Y=LOY:TY=HY-HOY:OY=TY MOD GR1S
FOR I=-OY TO ZH-1 STEP GR1S
 IF I>=0 THEN
  C=GR1C
  IF (((TY+I) DIV GR1S) MOD GR2S)THEN C=LC
  YY=Y+I*ZM:GLINE X,YY,X+LW-1,YY,C
 ENDIF
NEXT
FOR I=-OX TO ZW-1 STEP GR1S
 IF I>=0 THEN
  C=GR1C
  IF (((TX+I) DIV GR1S) MOD GR2S)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
SPSET 0,0,0,512,512:SPSHOW 0
HW=512-400:HH=512-240
SPOFS 0,HX,HY,HZ
SPSET 1,0,0,16,16,0 'COPYCSR
'
' LO
'
DISPLAY 1:VISIBLE 1,1,1,1:CLS
GPAGE GPL,GPL:GPRIO 100:GCLS BC
'LOCATE 0,0:PRINT ""+""*32+"";
'FOR I=1 TO 24
' LOCATE 0,I:PRINT ""+" "*32+"";
'NEXT
'LOCATE 0,25:PRINT ""+""*32+"";

'--- 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,0,512,512:SPSHOW 0
LX=LOX:LY=LOY:LZ=500
VZ=0:GOSUB @SETZOOM
SPOFS 0,LX,LY,LZ
SPSCALE 0,ZM,ZM
SPSET 1,0,0,16,16,0 'COPYCSR

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

'--- current color
COLX=8*34:COLY=8
CCX=COLX:CCY=COLY+8*16+2
GFILL CCX,CCY,CCX+47,CCY+26,RGB(255,255,255)
GFILL CCX+2,CCY+2,CCX+45,CCY+24,RGB(0,0,0)
RGBX=COLX:RGBY=CCY+24+4
GOSUB @PUTCOLOR
GOSUB @SETCOL
GOSUB @PUTDEFCOL
GOSUB @PUTCPCSR

'---
SETGPAGE GPIX
GOSUB @HIGRID
GOSUB @LOGRID
RETURN

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

'--- 
DEF VPUTNO X,Y,NO
 S$=RIGHT$("  "+STR$(NO),3)
 LOCATE X,Y  :PRINT MID$(S$,0,1)
 LOCATE X,Y+1:PRINT MID$(S$,1,1)
 LOCATE X,Y+2:PRINT MID$(S$,2,1)
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( 16, 92,240)
 IF FNCST[I]==-1 THEN C=RGB(160,160,160)
 GFILL X+1,Y,  X+W-4,Y+13,C
 GFILL X,  Y+1,X+W-3,Y+12,C
 '--- text
 X=FLOOR(X/8)+1:Y=FLOOR(Y/8)+1
 COLOR 1:LOCATE X,Y
 PRINT FNCTX$[I];
 COLOR 15
 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:SPPAGE GP
 SPCHR 0,0,0,512,512
 DISPLAY 1:SPPAGE GP
 SPCHR 0,0,0,512,512
 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
DISPLAY 0:VISIBLE 1,0,0,0:CLS
PRINT "FILE UTILITY":TXLINEB
PRINT "'L'=LOAD"
PRINT "'S'=SAVE"
PRINT "'X'=EXIT"
TXLINE
'
@FUTLOOP
K$=GETKEY$("command?[L/S/X]")
J$=""
IF K$=="L" THEN J$="@FLOAD"
IF K$=="S" THEN J$="@FSAVE"
IF K$=="X" THEN EXITSW=TRUE
'---
IF J$!="" && CHKLABEL(J$) THEN GOSUB J$
'---
@FEND
VISIBLE 1,1,1,1:DISPLAY 1:CLS
RETURN

'======
' SAVE
'======
@FSAVE
PRINT "SAVE":TXLINEB
N$=GETNAME$()
K$=GETKEY$(" save("+N$+")[Y/N]")
IF K$=="Y" THEN
 SAVE N$:TXLINE
ENDIF
RETURN

'======
' LOAD
'======
@FLOAD
PRINT "LOAD":TXLINEB
N$=GETNAME$()
K$=GETKEY$(" load("+N$+")[Y/N]")
IF K$=="Y" THEN
 LOAD N$:TXLINE
ENDIF
RETURN

'==========
' GET NAME
'==========
DEF GETNAME$()
 LINPUT " filename:";F$
 IF F$=="" THEN F$="SBGED_"+STR$(GP)
 F$="GRP"+STR$(GP)+":"+F$
 RETURN F$
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