SmileBASIC

プログラムリスト

SU_STOMP

スクリーンショット

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


'======================================
'
' Graphical Effector Example
'
' Ver.1.00 2016/02/26
'
' (C)2016 SmileBoom
'
'======================================
OPTION STRICT

VAR FX1ON=FALSE
VAR FX2ON=TRUE
VAR FX3ON=TRUE

VAR SIZE=1024
VAR CENTER=32768
VAR SRATE=32730
VAR PI2=PI()*2
DIM SIGBUF[SIZE]

'=============================
DIM PV[6]
DIM PS$[6]
PS$[0]="DELAY TIME"
PS$[1]="DELAY FEETBACK"
PS$[2]="PITCH SHIFTER PITCH"
PS$[3]="PITCH SHIFTER LEVEL"
PS$[4]="DISTORTION DRIVE"
PS$[5]="DISTORTION LEVEL"

PV[0]=50
PV[1]=50
PV[2]=50
PV[3]=50
PV[4]=50
PV[5]=50

'======================================
'FX1 DISTORTION
'======================================
DIM FX1DRIVE=21000-(PV[4]*200)
DIM FX1LEVEL=5+PV[5]/5

DEF FX1 BUF
 IF !FX1ON THEN RETURN
 VAR I
 'NOISE GATE
 FOR I=0 TO SIZE-1
  IF ABS(BUF[I])<150 THEN BUF[I]=0
 NEXT
 'CLIP
 ARYOP #AOPCLP,BUF,BUF,-FX1DRIVE,FX1DRIVE
 'BOOST
 VAR DIST=1+PV[4]/40
 VAR BOOST=FX1LEVEL*DIST*DIST*DIST/50
 ARYOP #AOPMUL,BUF,BUF,BOOST
END

'======================================
'FX2 PITCH SHIFTER
'======================================
VAR FX2PITCH=0.7+PV[2]/50*1.3
VAR FX2LEVEL=0.1+PV[3]/100*1.9
DIM FX2FI[SIZE]
DIM FX2FOR[SIZE]
DIM FX2FOI[SIZE]
DIM FX2TMPR[SIZE]
DIM FX2TMPI[SIZE]
DIM FX2W[SIZE]
FFTWFN FX2W,#WFRECT
VAR FX2HALF=SIZE/2

DEF FX2 BUF
 IF !FX2ON THEN RETURN
 VAR I,IDX
 FFT FX2FOR,FX2FOI,BUF,FX2FI,FX2W
 FILL FX2TMPR,0
 FILL FX2TMPI,0
 FOR I=0 TO FX2HALF
  IDX=FLOOR(I*FX2PITCH)
  IF IDX>FX2HALF THEN CONTINUE
  INC FX2TMPR[IDX],FX2FOR[I]
  INC FX2TMPI[IDX],FX2FOI[I]
 NEXT
 IFFT FX2FOR,FX2FOI,FX2TMPR,FX2TMPI
 ARYOP #AOPMUL,BUF,FX2FOR,FX2LEVEL
END


'======================================
'FX3 DELAY
'======================================
VAR FX3TIME=(PV[0] DIV 3)+1
VAR FX3FB=PV[1]
VAR DLYBUFSIZE=SIZE*100
DIM DLYBUF[DLYBUFSIZE]
VAR DLY_WR,DLY_RD
DIM DLTMPBUF[SIZE]

DEF FX3 BUF
 IF !FX3ON THEN RETURN
 DIM FB=0.6*FX3FB/100
 DLY_RD=DLY_WR-(SIZE*FX3TIME)
 IF DLY_RD<0 THEN DLY_RD=DLY_RD+DLYBUFSIZE
 COPY DLTMPBUF,0,DLYBUF,DLY_RD,SIZE
 ARYOP #AOPMAD,BUF,DLTMPBUF,FB,BUF
 DLY_WR=RINGCOPY(DLYBUF,DLY_WR,BUF,0,SIZE)
END

'======================================
'LIMITTER
'======================================
DEF LIMITTER BUF
 ARYOP #AOPCLP,BUF,BUF,-32768,32767
END

'======================================
'DRAW WAVEFORM IMAGE
'======================================
VAR DWCNT=0
DEF DRAWWAVE BUF
 INC DWCNT
 IF DWCNT>20 THEN
  DWCNT=0
  DISPLAY 0
  GFILL 65,70,265,130,GRAY(150)
  VAR I
  FOR I=0 TO 200
   GLINE I+65,100,I+65,100-BUF[I*5]/1100,GRAY(90)
  NEXT
  DISPLAY 1
 ENDIF
END

'======================================
'SIGNAL PROCESSING
'======================================
DEF AUDIO_PROC OUTBUF,INBUF
 'CONVERT ARRAY VALUE FROM 0..65535 TO -32768..+32767
 ARYOP #AOPSUB,SIGBUF,INBUF,CENTER

 'SIGNAL PROCESSING FUNCTIONS
 FX1 SIGBUF
 FX2 SIGBUF
 FX3 SIGBUF
 LIMITTER SIGBUF
 DRAWWAVE SIGBUF

 'CONVERT ARRAY VALUE FROM -32768..+32767 TO 0..65535
 ARYOP #AOPADD,OUTBUF,SIGBUF,CENTER
END

'======================================
'GUI
'======================================
DIM KNOB_POS[6,2]
DIM KNOB_CSR=0
DIM KNOB_DRG=-1
DIM KNOB_DRGP[2]
DIM KNOB_DRGV
DIM KNOB_DRGX
DIM KNOB_DRGS

DEF KNOB_TOUCH X,Y
 DIM I
 FOR I=0 TO 5
  IF X>=KNOB_POS[I,0] && X<=KNOB_POS[I,0]+32 THEN
   IF Y>=KNOB_POS[I,1] && Y<=KNOB_POS[I,1]+32 THEN
    UPDATE_INFO I
    KNOB_DRG=I
    KNOB_DRGV=PV[I]
    KNOB_DRGP[0]=X
    KNOB_DRGP[1]=Y
    KNOB_DRGX=100
    KNOB_DRGS=KNOB_DRGX/100
    RETURN
   ENDIF
  ENDIF
 NEXT
END

DIM SW_POS[3,2]

DEF SW_TOUCH X,Y
 DIM I
 FOR I=0 TO 2
  IF X>=SW_POS[I,0] && X<=SW_POS[I,0]+18 THEN
   IF Y>=SW_POS[I,1] && Y<=SW_POS[I,1]+18 THEN
    IF I==0 THEN
     FX3ON=!FX3ON
     LED_SET 7*0+6,FX3ON
     IF FX3ON THEN
      INFOTEXT "DELAY ON"
     ELSE
      INFOTEXT "DELAY OFF"
     ENDIF
    ELSEIF I==1 THEN
     FX2ON=!FX2ON
     LED_SET 7*1+6,FX2ON
     IF FX2ON THEN
      INFOTEXT "PITCH SHIFTER ON"
     ELSE
      INFOTEXT "PITCH SHIFTER OFF"
     ENDIF
    ELSEIF I==2 THEN
     FX1ON=!FX1ON
     LED_SET 7*2+6,FX1ON
     IF FX1ON THEN
      INFOTEXT "DISTORTION ON"
     ELSE
      INFOTEXT "DISTORTION OFF"
     ENDIF
    ENDIF
    RETURN
   ENDIF
  ENDIF
 NEXT
END


'=============================
DEF INFO S$,V
 DISPLAY 0
 LOCATE 8,23
 COLOR 1
 PRINT S$;" : ";V;"                   "
 DISPLAY 1
END

DEF INFOTEXT S
 DISPLAY 0
 LOCATE 8,23
 COLOR 1
 PRINT S;"                                     "
 DISPLAY 1
END

DIM KNOBSP_NO[6]
KNOBSP_NO[0]=7*0+0
KNOBSP_NO[1]=7*0+1
KNOBSP_NO[2]=7*1+0
KNOBSP_NO[3]=7*1+1
KNOBSP_NO[4]=7*2+0
KNOBSP_NO[5]=7*2+1

DEF UPDATE_KNOB N
 VAR V=PV[N]
 BLACKKNOB_SET KNOBSP_NO[N],V
 IF N==0 THEN
  FX3TIME=(PV[0] DIV 3)+1
 ELSEIF N==1 THEN
  FX3FB=PV[1]
 ELSEIF N==2 THEN
  FX2PITCH=0.7+PV[2]/50*1.3
 ELSEIF N==3 THEN
  FX2LEVEL=0.1+PV[3]/100*1.9
 ELSEIF N==4 THEN
  FX1DRIVE=21000-(PV[4]*200)
 ELSEIF N==5 THEN
  FX1LEVEL=5+PV[5]/5
 ENDIF
END

DEF UPDATE_INFO N
 INFO PS$[N],PV[N]
END

DEF UPDATE_VIEW N
 UPDATE_KNOB N
 UPDATE_INFO N
END

'=============================
DEF DRAWCASE X,Y,W,H,R,C
 VAR IX0=X+R
 VAR IX1=X+W-R
 VAR IY0=Y+R
 VAR IY1=Y+H-R
 VAR IW=W-R*2
 VAR IH=H-R*2
 VAR I,J
 VAR D,L
 FOR I=X TO X+W+10
  FOR J=Y TO Y+H+10
   D=CHECK_LIGHT(I,J,IX0+10,IY0+10,IW,IH,R)
   IF D>0 THEN
    D=D/30
    IF D>50 THEN D=50
    GPSET I,J,DARK(I,J,D*6)
   ENDIF

   D=CHECK_RCORNER(I,J,IX0,IY0,IW,IH,R)
   IF D<0 THEN
    GPSET I,J,C
    IF RND(10)<5 THEN
     GPSET I,J,SHINE(I,J,RND(30))
    ENDIF
   ENDIF

   VAR IN=D
   IF IN<0 THEN
    D=CHECK_LIGHT(I,J,IX0,IY0,IW,IH,R)
    IF D>0 THEN
     D=R-(D/10)
     IF D<0 THEN D=0
     GPSET I,J,DARK(I,J,D*2)
    ENDIF
   ENDIF

   IF IN<0 THEN
    D=CHECK_HILIGHT(I,J,X,Y,W,H,R)
    GPSET I,J,SHINE(I,J,D*D/4)
   ENDIF

  NEXT
 NEXT
END

DEF CHECK_RCORNER(PX,PY,X,Y,W,H,R)
 VAR DX,DY
 IF PX<X THEN
  IF PY<Y THEN
   DX=X-PX
   DY=Y-PY
  ELSEIF PY>Y+H THEN
   DX=X-PX
   DY=PY-(Y+H)
  ELSE
   RETURN (X-R)-PX
  ENDIF

 ELSEIF PX>X+W THEN
  IF PY<Y THEN
   DX=PX-(X+W)
   DY=PY-Y
  ELSEIF PY>Y+H THEN
   DX=PX-(X+W)
   DY=PY-(Y+H)
  ELSE
   RETURN PX-(X+W+R)
  ENDIF

 ELSE
  IF PY<Y THEN
   RETURN (Y-R)-PY
  ELSEIF PY>Y+H THEN
   RETURN PY-(Y+H+R)
  ELSE
   RETURN -1
  ENDIF
 ENDIF
 RETURN (DX*DX+DY*DY)-R*R
END

DEF CHECK_LIGHT(PX,PY,X,Y,W,H,R)
 VAR DX,DY
 IF PX<X THEN
  IF PY<Y THEN
   DX=X-PX
   DY=Y-PY
  ELSEIF PY>Y+H THEN
   DX=X-PX
   DY=PY-(Y+H)
  ELSE
   DX=PX-X
   DY=0
  ENDIF

 ELSEIF PX>X+W THEN
  IF PY<Y THEN
   DX=PX-(X+W)
   DY=PY-Y
  ELSEIF PY>Y+H THEN
   DX=PX-(X+W)
   DY=PY-(Y+H)
  ELSE
   DX=(X+W)-PX
   DY=0
  ENDIF

 ELSE
  IF PY<Y THEN
   DX=0
   DY=PY-Y
  ELSEIF PY<(Y+H) THEN
   RETURN 0
  ELSE
   DX=0
   DY=(Y+H)-PY
  ENDIF
 ENDIF
 IF R*R-(DX*DX+DY*DY)<0 THEN RETURN 0
 RETURN R*R-(DX*DX+DY*DY)
END

DEF CHECK_HILIGHT(PX,PY,X,Y,W,H,R)
 VAR DX,DY
 VAR LV=0,LH=0

 IF (PX>=X)&&(PX<=X+R*2) THEN
  IF (PY>=Y)&&(PY<=Y+H) THEN
   LV=PX-X
   IF LV<R/4 THEN
    LV=R-(R-LV*4)
   ELSE
    LV=R-LV/2
   ENDIF
  ENDIF
 ENDIF

 IF (PY>=Y)&&(PY<=Y+R*2) THEN
  IF (PX>=X)&&(PX<=X+H) THEN
   LH=PY-Y
   IF LH<R/4 THEN
    LH=R-(R-LH*4)
   ELSE
    LH=R-LH/2
   ENDIF
  ENDIF
 ENDIF

 RETURN LV+LH
END

DEF GRAY(N)
 RETURN RGB(N,N,N)
END

DEF RGRAY(N)
 VAR R=N+RND(60)-30
 IF R<0 THEN R=0
 IF R>255THEN R=255
 RETURN RGB(R,R,R)
END

DEF CIRCLEFILL X,Y,R,C
 GCIRCLE X,Y,R,RGB(255,0,0)
 GPAINT X,Y,C,RGB(255,0,0)
 GCIRCLE X,Y,R,C
END

DEF CIRCLEDARK X,Y,R,N
 VAR I,J,D,DK
 FOR I=-R TO R
  FOR J=-R TO R
   D=SQR(I*I+J*J)
   IF D<=R THEN
    DK=N*MIN(R-D-1,5)/5
    GPSET X+J,Y+I,DARK(X+J,Y+I,DK)
   ENDIF
  NEXT
 NEXT
END

DEF DARK(X,Y,D)
 VAR P,R,G,B
 P=GSPOIT(X,Y)
 RGBREAD P OUT R,G,B
 R=R-D
 G=G-D
 B=B-D
 IF R<0 THEN R=0
 IF G<0 THEN G=0
 IF B<0 THEN B=0
 RETURN RGB(R,G,B)
END

DEF FOOTSW_NAT X,Y
 X=X+3
 Y=Y+3
 VAR R=11
 VAR TH=0.5
 DIM XY[6,2]
 VAR I
 FOR I=0 TO 5
  XY[I,0]=X-SIN(TH+2*PI()*I/6)*R
  XY[I,1]=Y-COS(TH+2*PI()*I/6)*R
 NEXT
 VAR NX,NY
 FOR I=0 TO 5
  IF I<5 THEN
   NX=XY[I+1,0]
   NY=XY[I+1,1]
  ELSE
   NX=XY[0,0]
   NY=XY[0,1]
  ENDIF
  GTRI X,Y,XY[I,0],XY[I,1],NX,NY,GRAY(100+10*I)
 NEXT
 GLINE XY[1,0],XY[1,1],XY[0,0],XY[0,1],GRAY(230)
 GLINE XY[0,0],XY[0,1],XY[5,0],XY[5,1],GRAY(230)
 GLINE XY[4,0],XY[4,1],XY[3,0],XY[3,1],GRAY(0)
 GLINE XY[3,0],XY[3,1],XY[2,0],XY[2,1],GRAY(0)
END
VAR SW_NO=0
DEF FOOTSW X,Y,R
 FOOTSW_NAT X,Y
 CIRCLEDARK X+5,Y+5,R+4,90
 VAR I
 FOR I=0 TO R-1
  CIRCLEFILL X,Y,R-I,GRAY(150-5*I)
 NEXT
 FOR I=0 TO R-1
  WARC X,Y,R - I,255-10*I
 NEXT
 GCIRCLE X,Y,R+1,150+180,300+180,0,GRAY(125)
 SW_POS[SW_NO,0]=X-R
 SW_POS[SW_NO,1]=Y-R
 INC SW_NO
END

DEF WARC X,Y,R,C
 VAR T=10
 VAR T1=T'+RND(4)-2
 VAR T2=T+70'+RND(4)-2
 VAR T3=T+180'+RND(4)-2
 VAR T4=T+180+70'+RND(4)-2
 WARCSUB X,Y,R,C,T1,T2,T3,T4
END

DEF WARCSUB X,Y,R,C,T1,T2,T3,T4
 C=200
 GCIRCLE X,Y,R,T1,T2,0,RGRAY(C)
 GCIRCLE X,Y+1,R,T1,T2,0,RGRAY(C)
 GCIRCLE X,Y,R,T3,T4,0,RGRAY(C)
 GCIRCLE X,Y+1,R,T3,T4,0,RGRAY(C)

 C=240
 INC T1,20
 DEC T2,20
 INC T3,20
 DEC T4,20
 GCIRCLE X,Y,R,T1,T2,0,RGRAY(C)
 GCIRCLE X,Y+1,R,T1,T2,0,RGRAY(C)
 GCIRCLE X,Y,R,T3,T4,0,RGRAY(C)
 GCIRCLE X,Y+1,R,T3,T4,0,RGRAY(C)
END

DEF SHINE(X,Y,D)
 VAR P,R,G,B
 P=GSPOIT(X,Y)
 RGBREAD P OUT R,G,B
 R=R+D
 G=G+D
 B=B+D
 VAR T=255
 IF R>T THEN R=T
 IF G>T THEN G=T
 IF B>T THEN B=T
 RETURN RGB(R,G,B)
END

DEF RFILL X,Y,W,H,C
 VAR I
 VAR R=5
 FOR I=0 TO R-1
  GFILL X+I,Y+R-I,X+W-I,Y+H-(R-I),C
 NEXT
END

DEF WOODFLR X,Y,W,H,BW,BH
 DEC BW
 DEC BH
 VAR I
 VAR C,RR,RG,RB,DR,DG,DB,RY
 VAR X0=X,Y0=Y
 VAR OS=BW/2
 WHILE (Y0+H>Y)
  X=X0
  WHILE (X0+W>X)
   RR=113+RND(10)-5
   RG=80+RND(10)-5
   RB=37+RND(10)-5
   C=RGB(RR,RG,RB)
   GFILL X-OS,Y,X+BW-OS,Y+BH,C

   FOR I=0 TO 20
    DR=96+RND(10)-5
    DG=67+RND(10)-5
    DB=33+RND(10)-5
    C=RGB(DR,DG,DB)
    RY=Y+RND(BH)
    GLINE X-OS,RY,X+BW-OS,RY,C
   NEXT

   C=RGB(RR+20,RG+20,RB+20)
   GLINE X-OS,Y,X-OS,Y+BH,C
   GLINE X-OS,Y,X+BW-OS,Y,C
   C=RGB(RR-20,RG-20,RB-20)
   GLINE X-OS,Y+BH,X+BW-OS,Y+BH,C
   GLINE X+BW-OS,Y,X+BW-OS,Y+BW,C

   INC X,BW+1
  WEND
  INC Y,BH+1
  IF OS>0 THEN
   OS=0
  ELSE
   OS=BW/2
  ENDIF
 WEND
END

DEF BLACKKNOB_INIT
 GPAGE 0,4
 VAR DN=4
 VAR I,J,K
 VAR X,Y
 VAR TH
 VAR R=16
 VAR RR=R+2
 VAR SIZE=RR*2+1
 GFILL 0,50,399,50+SIZE*4,0
 FOR I=0 TO 30
  VAR IX=I MOD 10
  VAR IY=I DIV 10

  X=SIZE*IX+RR
  Y=SIZE*IY+RR+50
  TH=RAD((15-I)*9)
  VAR RX=SIN(TH)*R
  VAR RY=COS(TH)*R
  VAR RX1=SIN(TH-0.25)*R*1.08
  VAR RY1=COS(TH-0.25)*R*1.08
  VAR RX2=SIN(TH+0.25)*R*1.08
  VAR RY2=COS(TH+0.25)*R*1.08

  VAR P0X=X+RX1
  VAR P0Y=Y+RY1
  VAR P1X=X+RX2
  VAR P1Y=Y+RY2
  VAR P2X=X-RX1
  VAR P2Y=Y-RY1
  VAR P3X=X-RX2
  VAR P3Y=Y-RY2

  VAR L=R*2+1
  VAR SX=(P0X-P3X)/L
  VAR SY=(P0Y-P3Y)/L

  FOR J=0 TO L-1 STEP 0.1
   GLINE P0X-SX*J,P0Y-SY*J,P1X-SX*J,P1Y-SY*J,GRAY(0)
   GLINE P0X-SX*J,P0Y-SY*J,P1X-SX*(J+1),P1Y-SY*(J+1),GRAY(0)
   GLINE P0X-SX*(J+1),P0Y-SY*(J+1),P1X-SX*J,P1Y-SY*J,GRAY(0)
  NEXT
  GLINE X-RX,Y-RY,X-RX*0.4,Y-RY*0.4,GRAY(180)

  FOR J=0 TO R
   FOR K=-R TO R
    VAR C=GSPOIT(X+K,Y+J)
    IF C==RGB(0,0,0) THEN
     GPSET X+K,Y+J,GRAY(20+J*4)
    ENDIF
   NEXT
  NEXT

  VAR SLOPE
  SLOPE=ATAN(P1Y-P0Y,P1X-P0X)
  GLINE P0X,P0Y,P1X,P1Y,GRAY(30+SLOPE*10)

  SLOPE=ATAN(P2Y-P1Y,P2X-P1X)
  GLINE P1X,P1Y,P2X,P2Y,GRAY(30+SLOPE*10)

  SLOPE=ATAN(P3Y-P2Y,P3X-P2X)
  GLINE P2X,P2Y,P3X,P3Y,GRAY(30+SLOPE*10)

  SLOPE=ATAN(P0Y-P3Y,P0X-P3X)
  GLINE P3X,P3Y,P0X,P0Y,GRAY(30+SLOPE*10)
  SPDEF DN,X-RR,Y-RR,SIZE,SIZE,RR,RR
  INC DN

 NEXT
 GPAGE 0,0
END

DEF STRETCH(V,IMIN,IMAX,OMIN,OMAX)
 VAR IRANGE=IMAX-IMIN
 VAR ORANGE=OMAX-OMIN
 VAR IV=(V-IMIN)/IRANGE
 RETURN OMIN+IV*ORANGE
END

DEF BLACKKNOB_SET N,V
 VAR VV=STRETCH(V,0,100,0,30)
 SPIMG N,4+VV
END

DEF BLACKKNOB_HANDLE N,X,Y
 VAR M=N+0
 VAR DN=4+15
 SPSET M,DN
 SPOFS M,X,Y
 SPSHOW M
END

DEF BLACKKNOB N,X,Y,R,V
 'BASE
 CIRCLEFILL X,Y,R,0
 VAR I,J
 FOR I=1 TO R
  FOR J=-R TO R
   IF I*I+J*J<R*R THEN
    GPSET X+J,Y-I,GRAY(20+I*5)
   ENDIF
  NEXT
 NEXT

 BLACKKNOB_HANDLE N,X,Y
 KNOB_POS[KNOB_CSR,0]=X-R
 KNOB_POS[KNOB_CSR,1]=Y-R
 INC KNOB_CSR

 BLACKKNOB_SET N,50
END

VAR SP_NO=0

DEF STOMP X,Y,C,S,P1,P2
 DRAWCASE X,Y,90,150,20,C
 GFILL X-2,Y+55,X+0,Y+55+9,GRAY(200)
 GFILL X-2,Y+65,X+0,Y+65+9,GRAY(110)
 GFILL X+90,Y+55,X+92,Y+55+9,GRAY(130)
 GFILL X+90,Y+65,X+92,Y+65+9,GRAY(80)
 FOOTSW X+45,Y+120,8
 GPUTCHR2 X+10,Y+65,P1,200
 GPUTCHR2 X+48,Y+65,P2,180
 CIRCLEDARK X+25+4,Y+40+4,19,45
 CIRCLEDARK X+68+4,Y+40+4,19,45
 BLACKKNOB SP_NO,X+25,Y+40,16,50
 INC SP_NO
 BLACKKNOB SP_NO,X+68,Y+40,16,50
 INC SP_NO
 DRAW_LOGO X+20,Y+85,SP_NO,12,S
 SP_NO=SP_NO+LEN(S)
 CIRCLEFILL X+40+7,Y+10+7,3,0
 LED SP_NO,X+40,Y+10
 LED_SET SP_NO,TRUE
 INC SP_NO
END

DEF RPANEL X,Y,W,H
 'HAIR LINE
 VAR R=6
 VAR I,J,K,D,RN
 VAR X0,X1,X2,Y0,RX,XMIN,XMAX
 VAR RR=16
 VAR IX0=X+RR
 VAR IX1=X+W-RR
 VAR IY0=Y+RR
 VAR IY1=Y+H-RR
 VAR IW=W-RR*2
 VAR IH=H-RR*2

 FOR I=X TO X+W+10
  FOR J=Y TO Y+H+10
   D=CHECK_LIGHT(I,J,IX0+10,IY0+10,IW,IH,RR)
   IF D>0 THEN
    D=D/30
    IF D>50 THEN D=50
    GPSET I,J,DARK(I,J,D*5)
   ENDIF
  NEXT
 NEXT

 FOR I=0 TO H
  RN=RND(15)+200-I/2
  X0=X
  X1=X0+RND(5)+1
  X2=X+W
  Y0=Y+I

  IF I<R THEN
   RX=R-SIN(ACOS((R-I)/R))*R
   XMIN=X+RX
   XMAX=X+W-RX
   X0=MAX(X0,XMIN)
   X1=MAX(X1,XMIN)
   X0=MIN(X0,XMAX)
   X1=MIN(X1,XMAX)
   X2=MIN(X2,XMAX)
  ENDIF

  IF I>H-R THEN
   RX=R-SIN(ACOS((H-I-R)/R))*R
   XMIN=X+RX
   XMAX=X+W-RX
   X0=MAX(X0,XMIN)
   X1=MAX(X1,XMIN)
   X0=MIN(X0,XMAX)
   X1=MIN(X1,XMAX)
   X2=MIN(X2,XMAX)
  ENDIF

  WHILE X0 < X2
   IF X1>X2-1 THEN
    X1=X2-1
   ENDIF   
   GLINE X0,Y0,X1,Y0,GRAY(RN)
   DEC RN
   X0=X1+1
   X1=X0+RND(5)+1
  WEND

  VAR PX,PY
  PY=Y+I
  FOR J=0 TO W
   PX=X+J
   IF (PX>=XMIN)&&(PX<=XMAX) THEN
    IF (I>=0)&&(I<=6) THEN
     GPSET PX,PY,SHINE(PX,PY,(COS(RAD(I*180/6))+1)*30)
    ENDIF
   ENDIF

   IF (PX>XMIN)&&(PX<XMIN+6) THEN
    K=PX-XMIN
    GPSET PX,PY,SHINE(PX,PY,(COS(RAD(K*180/6))+1)*30)
   ENDIF

   IF (PX<=XMAX)&&(PX>XMAX-6) THEN
    K=XMAX-PX
    GPSET PX,PY,DARK(PX,PY,(COS(RAD(K*180/6))+1)*30)
   ENDIF

   IF (PX>=XMIN)&&(PX<=XMAX) THEN
    IF (I>=H-6)&&(I<=H) THEN
     GPSET PX,PY,DARK(PX,PY,(COS(RAD((H-I)*180/6))+1)*30)
    ENDIF
   ENDIF

  NEXT
 NEXT

END


DEF UPPERPANEL X,Y,C,S
 RPANEL X,Y,350,200',5,C
 GFILL X+20,Y+20,X+330,Y+140,RGB(0,0,0)
 VAR LX,LY,LW,LH
 LX=60
 LY=60
 LW=210
 LH=80
 GFILL LX,LY,LX+LW,LY+LH,RGB(150,150,150)
 VAR I,J
 FOR I=0 TO 5
  GLINE LX+I,LY+I,LX+LW,LY+I,GRAY(100+(150-100)/5*I)
 NEXT
 FOR I=0 TO 5
  GLINE LX+I,LY+I,LX+I,LY+LH,GRAY(100+(150-100)/5*I)
 NEXT
 LX=X+20
 LY=Y+20
 LW=310
 LH=140
 LY=180
 LH=12
 LW=270

 LX=X+40

 GFILL X+20,Y+150,X+330,Y+182,RGB(0,0,0)
 GFILL LX,LY,LX+LW,LY+LH,RGB(150,150,150)

 FOR I=0 TO 5
  GLINE LX+I,LY+I,LX+LW,LY+I,GRAY(100+(150-100)/5*I)
 NEXT
 FOR I=0 TO 5
  GLINE LX+I,LY+I,LX+I,LY+LH,GRAY(100+(150-100)/5*I)
 NEXT
 DRAW_LOGO X+255,Y+40,SP_NO,14,S

 COLOR 15,0
 GPUTTEXT 35,12.0," EXIT"
 GPUTTEXT 35,13.5," DS-1"
 GPUTTEXT 35,15.0," PS-1"
 GPUTTEXT 35,16.5," DL-1"
END

DEF GPUTTEXT X,Y,S
 GPUTCHR X*8,Y*8,S,1,1,GRAY(180)
END

'=======================
DEF GPUTCHR2 X,Y,S,C
 VAR I
 VAR C$
 FOR I=0 TO LEN(S)-1
  C$=MID$(S,I,1)
  GPUTCHR X+6*I,Y,C$,GRAY(C-I*10)
 NEXT
END

DEF DRAW_LOGO X,Y,M,SP,S
 VAR I
 VAR C$
 FOR I=0 TO LEN(S)-1
  C$=MID$(S,I,1)
  SPSET M,ASC(C$)
  SPOFS M,X+I*SP,Y,-100
  SPCOLOR M,RGB(80,255,255,255)
  SPSCALE M,1,1
  INC M
 NEXT
END

'=============
'DRAW LED
'=============
DEF LEDSP_INIT
 GPAGE 0,4

 VAR X=40
 VAR Y=170
 VAR R=7

 GFILL X,Y,X+27,Y+13,0

 VAR DN=2
 CIRCLEFILL X+R,Y+R,6,RGB(30,0,0)
 CIRCLEFILL X+R,Y+R,5,RGB(50,0,0)
 CIRCLEFILL X+R,Y+R,4,RGB(100,0,0)
 CIRCLEFILL X+R,Y+R,3,RGB(210,40,40)
 CIRCLEFILL X+R-1,Y+R-1,1,RGB(255,150,150)
 SPDEF DN,X,Y,14,14,0,0,&H21

 DN=3
 X=X+14
 CIRCLEFILL X+R,Y+R,3,RGB(40,10,8)
 CIRCLEFILL X+R,Y+R,2,RGB(80,20,16)
 CIRCLEFILL X+R-1,Y+R-1,1,RGB(150,80,80)
 SPDEF DN,X,Y,14,14

 GPAGE 0,0
END

DEF LED N,X,Y
 VAR M=N+0
 VAR DN=3
 SPSET M,DN
 SPOFS M,X,Y
 SPSHOW M
END

DEF LED_SET N,FLAG
 VAR M=N+0
 IF FLAG THEN
  SPIMG M,2
 ELSE
  SPIMG M,3
 ENDIF
END

DEF SPIMG M,N
 SPANIM M,"I",1,N,1
END

DEF BCHECK(B0,B1,B)
 IF ((B0 AND B)==0) && ((B1 AND B)!=0) THEN
  RETURN TRUE
 ENDIF
 RETURN FALSE
END

'======================================
'MAIN LOOP
'======================================
VAR LOOP=TRUE

DEF MAINLOOP
 VAR NUM_AREA=8
 VAR CUR_AREA=NUM_AREA-2
 VAR READPOS
 VAR LASTPOS=0
 DIM STREAMBUF[SIZE*NUM_AREA]
 DIM MICBUF[SIZE]
 DIM TMPBUF[SIZE]

 FILL STREAMBUF,0
 PCMSTREAM STREAMBUF

 XON MIC
 MICSTART 3,1,0 '32730Hz 16bit Loop

 WHILE LOOP
  'WAIT DATA
  MICREADY LASTPOS
  'UPDATE INPUT POINTER
  READPOS=LASTPOS
  LASTPOS=MICPOS
  'READ DATA FROM MIC
  MICGET READPOS,MICBUF
  'SIGNAL PROCESSING
  AUDIO_PROC TMPBUF,MICBUF
  'WRITE DATA TO STREAM
  COPY STREAMBUF,CUR_AREA*SIZE,TMPBUF,0,SIZE
  'UPDATE STREAMBUF WRITE POINTER
  CUR_AREA=(CUR_AREA+1) MOD NUM_AREA
 WEND

 XOFF MIC
 PCMSTOP
END

'======================================
'WAIT FOR MIC STATUS UNTIL ENOUGH DATA SIZE
'======================================
DEF MICREADY LASTPOS
 VAR POS,READABLE_SIZE
 REPEAT
  POS=MICPOS
  IF POS<LASTPOS THEN POS=POS+MICSIZE
  READABLE_SIZE=POS-LASTPOS
  CHECK_UI
 UNTIL READABLE_SIZE>=SIZE
END

'======================================
'READ MIC DATA
'======================================
DEF MICGET POS,ARY
 DIM TMP[SIZE]
 VAR SIZE1,SIZE2
 IF (POS+SIZE)<=MICSIZE THEN
  MICSAVE POS,SIZE,ARY
 ELSE
  SIZE1=MICSIZE-POS
  SIZE2=SIZE-SIZE1
  MICSAVE POS,SIZE1,ARY
  MICSAVE 0,SIZE2,TMP
  COPY ARY,SIZE1,TMP,0,SIZE2
 ENDIF
END

'======================================
VAR BTN0=0
VAR BTN1=0
VAR TX,TY,STTM
VAR TOUCH_REL=TRUE

DEF CHECK_UI
 'CHECK BUTTON STATUS
 BTN1=BUTTON(0)
 IF BCHECK(BTN0,BTN1,#A) THEN
  FX1ON=!FX1ON
  LED_SET 7*2+6,FX1ON
  IF FX1ON THEN
   INFOTEXT "DISTORTION ON"
  ELSE
   INFOTEXT "DISTORTION OFF"
  ENDIF
 ENDIF
 IF BCHECK(BTN0,BTN1,#B) THEN
  FX2ON=!FX2ON
  LED_SET 7*1+6,FX2ON
  IF FX2ON THEN
   INFOTEXT "PITCH SHIFTER ON"
  ELSE
   INFOTEXT "PITCH SHIFTER OFF"
  ENDIF
 ENDIF
 IF BCHECK(BTN0,BTN1,#Y) THEN
  FX3ON=!FX3ON
  LED_SET 7*0+6,FX3ON
  IF FX3ON THEN
   INFOTEXT "DELAY ON"
  ELSE
   INFOTEXT "DELAY OFF"
  ENDIF
 ENDIF
 IF BCHECK(BTN0,BTN1,#X) THEN
  LOOP=FALSE
  RETURN
 ENDIF
 BTN0=BTN1

 'CHECK TOUCH STATUS
 TOUCH OUT STTM,TX,TY

 IF STTM>0 && KNOB_DRG==-1 THEN
   KNOB_TOUCH TX,TY
   IF TOUCH_REL THEN
    SW_TOUCH TX,TY
    TOUCH_REL=FALSE
   ENDIF
 ELSE
  TOUCH_REL=TRUE
 ENDIF
 IF STTM==0 THEN
  IF KNOB_DRG>=0 THEN
   UPDATE_VIEW KNOB_DRG
   KNOB_DRG=-1
  ENDIF
 ENDIF

 'CHECK DRAG
 IF KNOB_DRG>=0 THEN
  VAR N=KNOB_DRG
  VAR V=TX-KNOB_DRGP[0]+KNOB_DRGP[1]-TY
  PV[N]=KNOB_DRGV+FLOOR(V*KNOB_DRGS)
  IF PV[N]>KNOB_DRGX THEN PV[N]=KNOB_DRGX
  IF PV[N]<0 THEN PV[N]=0
  UPDATE_KNOB N
  UPDATE_INFO N
 ENDIF
END

'=======================
'ENTRY POINT
'=======================
ACLS
XOFF MIC

BLACKKNOB_INIT
LEDSP_INIT
XSCREEN 2

DISPLAY 0
WOODFLR 0,0,499,239,200,45
UPPERPANEL 20,20,RGB(70,70,70),"STOMP"

DISPLAY 1

WOODFLR 0,0,499,239,200,45

SPSET 30,192,480,288-192,512-480
SPOFS 30,200,5

VAR I,J,C
FOR I=0 TO 349
 FOR J=0 TO 13
  C=(13-J)*6
  IF C>40 THEN C=40
  GPSET I,108+J+10,DARK(I,108+J+10,C)
 NEXT
NEXT

FOR I=0 TO 8
 C=SIN(RAD(I*22+45))*50
 GLINE 0,110+I,349,110+I,GRAY(C+0)
NEXT

FOR I=0 TO 13
 C=SIN(RAD(I*18+40))*60+100
 IF C>155 THEN C=C+60
 IF C>240 THEN C=240
 GLINE   0,108+I, 10,108+I,GRAY(C)
 GLINE  75,108+I,135,108+I,GRAY(C)
 GLINE 180,108+I,240,108+I,GRAY(C)
 GLINE 309,108+I,319,108+I,GRAY(C)
NEXT

VAR SX=105
STOMP 8+SX*0,50,RGB(30,30,100),"DL-1","TIME","F.BACK"
STOMP 8+SX*1,50,RGB(100,80,30),"PS-1","PITCH"," LEVEL"
STOMP 8+SX*2,50,RGB(30,30,30), "DS-1","DRIVE"," LEVEL"

LED_SET 7*2+6,FX1ON
LED_SET 7*1+6,FX2ON
LED_SET 7*0+6,FX3ON

FOR I=0 TO 5
 UPDATE_KNOB I
NEXT

INFOTEXT "Effector"

MAINLOOP

ACLS
END
'======================================
'END
'======================================
ページトップへ