SmileBASIC

プログラムリスト

SYS/SBWAV

スクリーンショット

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


'
' WAVE EDITOR for プチコンBIG (C)SmileBoom
'
' 8bit/32000sample
' single wave only
'
XON WIIU
MAXSP=256:MAXBG=2:BGZ=300:SPZ=200:GRZ=100
SCW=854:SCH=480:SCL=2
XSCREEN 6,6,6,MAXSP,MAXBG
WIDTH 16,16
VER=1.6:RP1=15:RP2=2
FOR I=0 TO 7:BREPEAT I,RP1,RP2:NEXT
OFFC=8:SELC=9:GC=14:WC=15
MICDV=0
LGC=RGB(16,16,16):GGC=RGB(64,64,64)
FOR I=0 TO 1
 DISPLAY I:VISIBLE 1,1,1,1:CLS
 COLOR WC,0:GPAGE I,I:GPRIO 500
 SPPAGE 2:BGPAGE 5:SPCLR
NEXT
'---
DTREAD OUT Y,M,D:Y=Y-2000
TMP$=FORMAT$("%02D%02D%02D",Y,M,D)
'---
_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)
_GREEN  =RGB(0,160,20)
_BLUE   =RGB(20,50,90)
_TAB    =RGB(80,80,100)
_ANMBACK=RGB(32,32,48)
_YELLOW =RGB(220,190,60)
'---
_TXC=_WHITE

'=======
' reset
'=======
@WORKRESET
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]
'--- zoom step
@DTZM
DATA 40,80,160,320
MAXZM=4:DIM ZMCNT[MAXZM]:COPY ZMCNT,@DTZM
'--- mic divice
@DTDV
DATA "WiiU","USB"
MAXDV=2:DIM DV$[MAXDV]:COPY DV$,@DTDV
'--- default wavedata
WVSIZE=32000'16384
WVC=RGB(255,255,255)
WVZ=(100/128):WEZ=(128/100)
DIM WV%[WVSIZE]
'GOSUB @FCLEAR
GOSUB @FSINEWAVE
'GOSUB @FPULSEWAVE

'=========
' restart
'=========
@RESTART
FILESW=FALSW
BWCNT=0
'--- 
BNO =224 'BEEP index
'--- 
BIT =0 '0=8bit,1=16bit
RATE=0 '0=8180,1=10910,2=16360,3=32730
WLEN=2 'wave length(sec)
'--- 
'NOTE=66+12 'base note 66+(6*S)
NOTE=66
'--- 
EGA=127 'eg attack
EGD=127 'eg decay
EGS=127 'eg sustain
EGR=127 'eg release
'--- HI
DISPLAY 0:VISIBLE 1,1,1,1:GPAGE 0,0:GCLS
SPOFX=32
SPCLIP 8*SCL+SPOFX,0,(400-9)*SCL+SPOFX,240*SCL-1
C=RGB(16,64,128)
GRID 8*SCL+SPOFX,16*SCL,(400-8)*SCL+SPOFX,(240-24)*SCL,32*SCL,10*SCL,C,0,0
HCY=116
GLINE 0,HCY*SCL,SCW-1,HCY*SCL,RGB(0,0,192)
GOSUB @PUTSTAT
'--- wave view sprite x2
SPW=512:SPH=200
FOR P=0 TO 1
 SPSET P,0,P*SPH,SPW,SPH,1
 SPOFS P,(P*SPW+8)*SCL+SPOFX,16*SCL,SPZ
 SPCOLOR P,RGB(128,200,200,200)
 SPSCALE P,SCL,SCL
 SPSHOW P
NEXT
GOSUB @ALLWVPUT
'---
CSP=2:COFS=0:CX=0:CY=16:CW=64:CH=200
SPSET CSP,0,SPH*2,1
SPCOLOR CSP,RGB(64,255,0,0)
GOSUB @CSRPUT
'--- LO
DISPLAY 1:VISIBLE 1,1,1,1:GPAGE 1,1
WIDTH 16
GCLS RGB(32,32,48)
GFILL 240*SCL,0,319*SCL,239*SCL,RGB(32,32,32)
'--- 
EDY=4:EDZM=1:EDST=ZMCNT[EDZM]
TBOX 0,EDY-1,34+8,27,0,"","",""
LCY=100+(EDY*8)
'--- 
OLDOFS=-1:SLDX=1:SLDY=1:SLDW=38
TBOX SLDX-1,SLDY-1,SLDW+2,3,0,"","","@SLD"
'--- 
FOR X=0 TO 40
 S$="":IF (X AND 7)==0 THEN S$=""
 C=14:IF (X DIV 8) AND 1 THEN C=12
 COLOR C
 FOR Y=0 TO (CH DIV 8)-1
  LOCATE X+1,Y+EDY:PRINT S$;
 NEXT
NEXT
COLOR 15
'--- 
TBOX 34+8, 3,10,2,0,"","  CUT","@CUTF"
TBOX 34+8, 5,10,2,0,"","CUT  ","@CUTB"
TBOX 34+8, 7,10,6,0,""," ","@ZM"
TBOX 34+8,13,10,2,0,"","REPT","@REPT"
TBOX 34+8,15,10,4,0,""," ","@DV"
'---
TBOX 38+11,19,3,2,0,"","","@END"
TBOX 34+8, 22,5,2,0,"","LOAD","@LOAD"
TBOX 34+13,22,5,2,0,"","SAVE","@SAVE"
'---
_TXC=_GREEN
TBOX 34+8,24,10,3,0,"","PLAY","@PLAY"
_TXC=_RED
TBOX 34+8,27,10,3,0,"","REC","@REC"
_TXC=_WHITE
'---
OLDCX=-1:OLDSCRL=0

'=============
' wave change
'=============
@WVCHANGE
GOSUB @ALLWVPUT
GOSUB @CSRPUT
GOSUB @EDWAVPUT
GOSUB @PUTOFS

'===========
' 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
GOSUB @CSRMOVE
GOSUB @CSRPUT
GOSUB @WVEDIT
'--- 
IF OLDZM!=EDZM THEN GOSUB @EDWAVPUT
OLDZM=EDZM
'--- 
FC=FC+1
VSYNC 1
'--- :PLAY
IF BRP AND &H10 THEN GOSUB @PLAYBEEP
'--- :RECORD
IF BRP AND &H20 THEN GOSUB @RECORD
'--- :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 "ツールを終了しますか?"
DATA ""
'---
IF DLG("@ENDTOUCH",1,"Xボタンによる終了確認")==-1 THEN
 EXITSW=FALSE:GOTO @RESTART
ENDIF
'---
@DLGSAVE
DATA "終了する前にデータを保存しますか?"
DATA ""
'---
IF DLG( "@DLGSAVE",1,"データ保存確認" )==1 THEN
 GOSUB @FSAVE
ENDIF
'---
EXEC "SYS/SBSMILE"
END

'========
' cursor
'========
@CSRPUT
DISPLAY 0
SPOFS CSP,(CX+8)*SCL+SPOFX,CY*SCL,-256
SPSCALE CSP,EDST*SCL/16,CH*SCL/16
A=64+(MAINCNT AND 31)
SPCOLOR CSP,RGB(A,255,0,0)
RETURN
'---
@CSRMOVE
ST=(EDST/2):VX=SVX*ST
IF VX!=0 THEN
 CX=(CX DIV ST)*ST
ELSE
 IF BRP AND 4 THEN VX=VX-1
 IF BRP AND 8 THEN VX=VX+1
ENDIF
'---
CX=CX+FLOOR(VX):OVX=0:MX=400-16-EDST
IF CX<0  THEN CX= 0:OVX=VX
IF CX>MX THEN CX=MX:OVX=VX
'---
COFS=COFS+OVX:MX=WVSIZE-400-16
IF COFS<0  THEN COFS=0
IF COFS>MX THEN COFS=MX
'---
IF OLDX==COFS+CX THEN RETURN
GOSUB @MAKEWAV
OLDX=COFS+CX
'---
GOSUB @EDWAVPUT
'---
@PUTOFS
DISPLAY 0
S$=RIGHT$("     "+STR$(COFS),5)
S$=S$+"/"+RIGHT$("     "+STR$(COFS+CX),5)
S$=S$+"/"+RIGHT$(" "+STR$(EDST),3)
S$=S$+"("+STR$(WVSIZE)+")"
LOCATE 50-LEN(S$),0:PRINT S$;
RETURN

'
' GET & CONVERT WAVEDATA
'
@GETWAV
WY=WV%[IX]
IF WY<0 THEN WY=0
IF WY>255 THEN WY=255
WY=(WY-128)*WVZ
RETURN

'=============
' PUT ALLWAVE
'=============
@ALLWVPUT
OX=COFS:SX=384:C=0
GOSUB @MKWAVSUB
'--- cursor sprite x1
GPAGE 0,2
X=0:Y=SPH*2
GFILL X,Y,(X+15),(Y+15),RGB(255,255,255)
GPAGE 0,0
RETURN

'
' make upper wave
'
@MAKEWAV
BX=OLDOFS:SX=COFS-BX
IF SX==0 THEN RETURN
'---
IF SX>0 THEN
 C=0:OX=BX+384
ELSE
 C=0:OX=BX+SX
ENDIF
SX=ABS(SX)
'---
@MKWAVSUB
DISPLAY 0
GPAGE 0,2
IX=OX:C=RGB(64,C,C,C)
FOR I=0 TO SX-1
 X=IX AND 511
 P=(((IX DIV 512) AND 1)*SPH)
 GLINE X,P,X,(P+SPH)-1,C
 IF IX<WVSIZE THEN
  GOSUB @GETWAV
  GLINE X,(P+100),X,(P+100+WY),WVC
 ENDIF
 IX=IX+1
NEXT
GPAGE 0,0
'---
OX=COFS AND 511
PG=(COFS DIV 512) AND 1
OX=-OX
FOR I=0 TO 1
' PRINT OX;"/";PG;",";
 SPCHR I,0,PG*SPH,SPW,SPH,1
 SPOFS I,(OX+8)*SCL+SPOFX,16*SCL,SPZ
 PG=(PG+1) AND 1
 OX=OX+SPW
NEXT
'---
OLDSCRL=COFS
RETURN

'
' in IX:
'
@SETLINE
DISPLAY 0
GPAGE 0,2
C=RGB(64,0,0,0)
X=IX AND 511
P=(((IX DIV 512) AND 1)*SPH)
GLINE X,P,X,P+SPH-1,C
GOSUB @GETWAV
GLINE X,(P+100),X,(P+100+WY),WVC
GPAGE 0,0
RETURN

'==============
' PUT EDITWAVE
'==============
@EDWAVPUT
DISPLAY 1
W=(32+8)*8:X=8
GFILL X*SCL,(LCY-100)*SCL,(X+W)*SCL-1,(LCY+100)*SCL,_BACK
'---
W=W DIV EDST
FOR I=0 TO EDST-1
 X=8+I*W:IX=COFS+CX+I
 IF IX<WVSIZE THEN
  GOSUB @GETWAV
  C=RGB(220,220,220)
  IF I AND 1 THEN C=RGB(192,192,200)
  GFILL X*SCL,LCY*SCL,(X+W)*SCL-1,(WY+LCY)*SCL,C
 ELSE
  GFILL X*SCL,LCY*SCL,(X+W)*SCL-1,LCY*SCL,RGB(0,0,0)
 ENDIF
NEXT
RETURN

'======
' edit
'======
@WVEDIT
IF TCS==0 THEN RETURN
'---
EX=TTX-1:EY=(TCY/SCL)-LCY
IF (TCY/SCL)<EDY*8-4 THEN RETURN
IF FLOOR(TCX/SCL)>=41*8 THEN RETURN
IF EY<-100 THEN EY=-100
IF EY> 100 THEN EY= 100
IF EX< 0 THEN EX= 0
IF EX>31 THEN EX=31
'---
EX=TCX/SCL-8:IF EX<0 THEN RETURN
W=1:IF EDST>0 THEN W=8 DIV (EDST DIV 40)
EX=EX DIV W
IF SFT THEN EX=(EX DIV 2)*2
'---
DISPLAY 1
IF EY<-100 THEN EY=-100
IF EY> 100 THEN EY= 100
'---
IX=COFS+CX+EX
IF IX<WVSIZE THEN
 WV%[IX]=EY*WEZ+&H80
 IF WV%[IX]<0 THEN WV%[IX]=0
 IF WV%[IX]>255 THEN WV%[IX]=255
 GOSUB @SETLINE
ENDIF
'---
GOSUB @EDWAVPUT
RETURN

'=============
' side slider
'=============
@SLDTOUCH
XX=TTX-1
IF XX<0 || XX>37 THEN RETURN
IF TTY>1 THEN RETURN
COFS=XX*(WVSIZE DIV SLDW)
IF COFS>WVSIZE-400 THEN COFS=WVSIZE-400
OLDOFS=-1:GOSUB @SLDPUT
GOSUB @ALLWVPUT
RETURN
'---
@SLDPUT
DISPLAY 1
XX=COFS+CX
IF OLDOFS!=XX THEN
 LOCATE SLDX,SLDY:PRINT" "*SLDW
 XX=XX DIV (WVSIZE DIV SLDW)
 LOCATE SLDX+XX,SLDY:PRINT""
ENDIF
OLDOFS=COFS
RETURN

'======
' ZOOM
'======
@ZMPUT
XZ=X*8:YZ=(Y-2)*8
GFILL (XZ-4)*SCL,(YZ-4)*SCL,(XZ+36)*SCL,(YZ+(MAXZM*8))*SCL,_WHITE
'--- cursor back
YZ=((Y-2)+EDZM)*8
GFILL (XZ-4)*SCL,(YZ-1)*SCL,(XZ+36)*SCL,(YZ+7)*SCL,_RED
GBOX  (XZ-3)*SCL,(YZ-2)*SCL,(XZ+35)*SCL,(YZ+8)*SCL,_RED
'--- 
C=_TEXT
FOR I=0 TO MAXZM-1
 S$="":YZ=((Y-2)+I)*8
 IF I==EDZM THEN S$=""
 GPUTSTR XZ,YZ,S$+"  "+STR$(ZMCNT[I],3),C
NEXT
RETURN
'---
@ZMTOUCH
IF TCS!=1 THEN RETURN
I=TTY-(Y+1)
IF I<0 || I>MAXZM-1 THEN RETURN
EDZM=I
EDST=ZMCNT[EDZM]
GOSUB @PUTOFS
RETURN

'========
' DEVICE
'========
@DVPUT
XZ=X*8:YZ=(Y-2)*8
GFILL (XZ-4)*SCL,(YZ-4)*SCL,(XZ+44)*SCL,(YZ+(MAXDV*8))*SCL,_WHITE
'--- cursor back
YZ=((Y-2)+MICDV)*8
GFILL (XZ-4)*SCL,(YZ-1)*SCL,(XZ+44)*SCL,(YZ+7)*SCL,_RED
GBOX  (XZ-3)*SCL,(YZ-2)*SCL,(XZ+43)*SCL,(YZ+8)*SCL,_RED
'--- 
C=_TEXT
FOR I=0 TO MAXDV-1
 S$="":YZ=((Y-2)+I)*8
 IF I==MICDV THEN S$=""
 GPUTSTR XZ,YZ,S$+DV$[I],C
NEXT
RETURN
'---
@DVTOUCH
IF TCS!=1 THEN RETURN
I=TTY-(Y+1)
IF I<0 || I>MAXDV-1 THEN RETURN
MICDV=I
RETURN

'===========
' CUT FRONT
'===========
@CUTFTOUCH
IF TCS!=1 THEN RETURN
S=COFS+CX
IF S==0 THEN RETURN
COPY WV%,0,WV%,S,WVSIZE-S
FOR I=0 TO S-1
 WV%[WVSIZE-1-I]=128
NEXT
GOSUB @ALLWVPUT
GOSUB @EDWAVPUT
RETURN

'==========
' CUT BACK
'==========
@CUTBTOUCH
IF TCS!=1 THEN RETURN
S=COFS+CX+EDST
IF S>=WVSIZE THEN RETURN
FOR I=0 TO (WVSIZE-S)-1
 WV%[S+I]=128
NEXT
GOSUB @ALLWVPUT
GOSUB @EDWAVPUT
RETURN

'=============
' REPEAT COPY
'=============
@REPTTOUCH
IF TCS!=1 THEN RETURN
S=WVSIZE DIV EDST
FOR I=1 TO S-1
 COPY WV%,I*EDST,WV%,0,EDST
NEXT
GOSUB @ALLWVPUT
GOSUB @EDWAVPUT
RETURN

'======
' PLAY
'======
@PLAYTOUCH
IF TCS!=1 THEN RETURN
WAVSETA BNO,EGA,EGD,EGS,EGR,WV%,NOTE
BGMPLAY "@224L8O3CDEFGAB<CDEFGAB<CDEFGAB"
RETURN

'===========
' BEEP PLAY
'===========
@PLAYBEEP
WAVSETA BNO,EGA,EGD,EGS,EGR,WV%,NOTE
BEEP BNO
RETURN

'========
' RECORD
'========
@RECTOUCH
IF TCS!=1 THEN RETURN
@RECORD
DISPLAY 0
VISIBLE 1,0,0,0:CLS
XON MIC '1秒たたないとロクオンできない
'--- 
PRINT "RECORDING":TXLINEB
FOR I=0 TO 2
 PRINT "READY:";3-I
 WAIT 60
NEXT
'---
PRINT "RECORD START"
MICSTART MICDV,WLEN
WAIT WLEN*60
MICSAVE 0,WVSIZE,WV%
PRINT "RECORD END"
WAIT 30
XOFF MIC
'---
FOR I=0 TO WVSIZE-1
 A#=WV%[I]/32768
 WV%[I]=A#*127+&H80
NEXT
'---
VISIBLE 1,1,1,1:CLS
GOSUB @ALLWVPUT
GOSUB @EDWAVPUT

'---
@PUTSTAT
DISPLAY 0:CLS
BW=BWCNT
TBOX 0+2,1,50,27,0,"","",""
LOCATE 2,28
PRINT "/=SCROLL =BEEP ";
PRINT "=FILE =EXIT";
LOCATE 2,0
PRINT "WAVE editor ";
PRINT FORMAT$("ver%.2F",VER)
BWCNT=BW
RETURN

'==========
' hit main
'==========
@HITMAIN
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
FOR IH=0 TO BWCNT-1
 DISPLAY 1
 GETWORK IH OUT X,Y,W,H,D,S$
 IF D==0 THEN CONTINUE
 IF S$=="" THEN CONTINUE
 X=X+1:Y=Y+3:H=H-4
 J$=S$+"PUT":GOSUB @PROC
NEXT
RETURN

'====================
' 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*SCL):TTY=TCY DIV (8*SCL)
RETURN

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

'=============
' put strings
'=============
DEF GPUTSTR X,Y,T$,C
VAR I,L=LEN(T$)
VAR C$
FOR I=0 TO L-1
 C$=MID$(T$,I,1)
 IF C$!=" " THEN
  GPUTCHR16 X*SCL,Y*SCL,C$,C
  X=X+8
 ELSE
  X=X+1
 ENDIF
NEXT
END

'==================
' text step 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*SCL,(WY+1)*SCL,(WX+WW-1)*SCL,(WY+WH-2)*SCL,_TXC
GBOX (WX+1)*SCL,WY*SCL,(WX+WW-2)*SCL,(WY+WH-1)*SCL,_TXC
C=_TXC:IF T$=="" THEN C=_GRAY
GFILL (WX+2)*SCL,(WY+2)*SCL,(WX+WW-3)*SCL,(WY+WH-3)*SCL,C
'--- caption
IF C$!="" THEN
 GFILL (WX+2)*SCL,(WY+2)*SCL,(WX+WW-3)*SCL,(WY+10)*SCL,_TXC
 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*SCL,(WY+2)*SCL,(WX+1)*SCL,(WY+WH-3)*SCL,_TXC
 '
 GFILL WX*SCL,(WY+2)*SCL,(WX+15)*SCL,(WY+16)*SCL,_TXC
 GPUTSTR WX+5,WY+5,"",_TEXT
 '
 GFILL WX*SCL,(WY+WH-17)*SCL,(WX+15)*SCL,(WY+WH-2)*SCL,_TXC
 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

'====================
' 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,OX,OY
 GTX=GTX-OX:GTY=GTY-OY
 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
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$="@FMAKE"
IF J$!="" && CHKLABEL(J$) THEN GOSUB J$
'---
@FEND
VISIBLE 1,1,1,1:GOSUB @PUTSTAT
DISPLAY 1:CLS
RETURN

'======
' MAKE
'======
@FMAKE
DATA "生成する波形種類を選んで下さい"
DATA " "
DATA "Aボタン:サイン波"
DATA "Xボタン:矩形波"
DATA "Yボタン:波形なし"
DATA " "
DATA "Bボタン:ツールに戻る"
DATA ""
R=DLG( "@FMAKE",-1,"生成する波形の選択" )
'---
IF R==128 THEN @FSINEWAVE
IF R==130 THEN @FPULSEWAVE
IF R==131 THEN @FCLEAR
'---
RETURN
'--- clear WAVE
@FCLEAR
FOR S=0 TO WVSIZE-1
 WV%[S]=&H80 'center
NEXT
RETURN
'--- make SINE WAVE
@FSINEWAVE
FOR S=0 TO WVSIZE-1
' A=SIN(RAD((360/(WVSIZE/512))*S))
 A=SIN(RAD((360/(WVSIZE/16))*S))
 A=A*((1/WVSIZE)*(WVSIZE-S))
' A=SIN(RAD(S*12))
' A=A+SIN(RAD((360/WVSIZE)*S))
' A=A*0.5
 WV%[WVTOP+S]=A*127+&H80
NEXT
RETURN
'--- make PULSE WAVE
@FPULSEWAVE
DIM VV[2]:VV[0]=1:VV[1]=-1
AA=-1
FOR S=0 TO WVSIZE-1
 A=VV[(S DIV 16) AND 1]
 A=A*((1/WVSIZE)*(WVSIZE-S))
 WV%[S]=A*127+&H80
NEXT
RETURN

'======
' SAVE
'======
@SAVETOUCH
@FSAVE
FILESW=TRUE:C$="SAVEするWAVEの名前"
N$=GETNAME$("DAT",TMP$,"WAV","",10,C$)
IF N$!="" THEN SAVE N$,WV%
RETURN

'======
' LOAD
'======
@LOADTOUCH
@FLOAD
FILESW=TRUE:C$="LOADするWAVEの名前"
N$=GETNAME$("DAT",TMP$,"WAV","",10,C$)
IF N$!="" THEN LOAD N$,WV%
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

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




ページトップへ