プチコン3号(SmileBASIC) 高度サウンドユニットを利用したモノシンセ試作

DB_MSYNTH.BAS

'============================================
'monosynth(仮)
'@myu314
'============================================
OPTION STRICT
OPTION DEFINT

'============================================
'Utility
'============================================
'Undefined
VAR _UNDEF$,_UNDEF[0]
'Math
IF 0 THEN
 VAR _INF[0],_NAN[0]
 VAR _PI[0],_2PI[0],_PI_2[0]
ENDIF
_INF =POW(2,1024)
_NAN =_INF-_INF
_PI  =PI()
_2PI =PI()*2
_PI_2=PI()/2
'Allocate
DEF ARRAY%(N): VAR T%[N]: RETURN T%: END
DEF ARRAY#(N): VAR T#[N]: RETURN T#: END
DEF ARRAY$(N): VAR T$[N]: RETURN T$: END
DEF ARRAY2%(N,M): VAR T%[N,M]: RETURN T%: END
DEF ARRAY2#(N,M): VAR T#[N,M]: RETURN T#: END
DEF ARRAY2$(N,M): VAR T$[N,M]: RETURN T$: END


'============================================
'WaveTable Generator
'============================================
VAR K_WG_BUFSIZE=128
VAR K_WG_GRP_X  =0
VAR K_WG_GRP_Y  =0

VAR WG_RATE
VAR WG_BUF[0]
VAR WG_REST
VAR WG_WAV[0]
VAR WG_POS#,WG_SPD#
VAR WG_PITCH#
VAR WG_GAIN#,WG_PGAIN#
VAR WG_MUL[0],WG_NR[0]
VAR WG_FP[0]
VAR WG_FC#,WG_Q#
VAR WG_T#[0],WG_T%[0]

DEF WG_INIT SAMPLERATE
 VAR I
 WG_RATE=SAMPLERATE
 'buffer
 WG_BUF=ARRAY%(K_WG_BUFSIZE)
 WG_REST=0
 'wavetable
 WG_WAV=_UNDEF
 WG_POS#=0
 WG_SPD#=0
 WG_PITCH#=60
 WG_GAIN#=0: WG_PGAIN#=0
 'lookup table
 WG_MUL=ARRAY%(K_WG_BUFSIZE)
 WG_NR=ARRAY#(K_WG_BUFSIZE)
 I=0
 REPEAT
  WG_MUL[I]=I
  WG_NR[I]=(K_WG_BUFSIZE-I)/K_WG_BUFSIZE
  I=I+1
 UNTIL K_WG_BUFSIZE<=I
 'filter
 WG_FP=ARRAY#(13)
 WG_LPF WG_RATE/2,1
 'temporary
 WG_T#=ARRAY#(K_WG_BUFSIZE)
 WG_T%=ARRAY%(K_WG_BUFSIZE)
END

DEF WG_DEINIT
 WG_BUF=_UNDEF
 WG_WAV=_UNDEF
 WG_MUL=_UNDEF
 WG_NR=_UNDEF
 WG_FP=_UNDEF
 WG_T#=_UNDEF
 WG_T%=_UNDEF
END

DEF WG_PITCH NO#
 WG_PITCH#=NO#
 WG_SPD#=440*POW(2,(NO#-69)/12)*LEN(WG_WAV)/WG_RATE
END

DEF WG_GAIN GAIN#
 WG_GAIN#=GAIN#
END

DEF WG_WAV WAV[]
 WG_WAV=WAV
 WG_POS#=0
 WG_PITCH WG_PITCH#
END

DEF WG_LPF FC#,Q#
 WG_FC#=FC#: WG_Q#=Q#
 BQPARAM WG_FP,#BQLPF,WG_RATE,FC#,Q#
END

DEF WG_RENDER(DST[],DST_OFS,SIZE)
 VAR N,L=LEN(WG_WAV),LB=K_WG_BUFSIZE-1
 WHILE 0<SIZE
  IF !WG_REST THEN
   IF L<=0 THEN
    FILL WG_BUF,0
   ELSE
    'calc position
    ARYOP #AOPMAD,WG_T#,WG_MUL,WG_SPD#,WG_POS#
    ARYOP #AOPDIV,WG_T%,WG_T#,L
    ARYOP #AOPMAD,WG_T#,WG_T%,-L,WG_T#
    WG_POS#=WG_T#[LB]+WG_SPD#
    'fetch
    GLOAD K_WG_GRP_X,K_WG_GRP_Y,K_WG_BUFSIZE,1,WG_T#,WG_WAV,TRUE
    GSAVE K_WG_GRP_X,K_WG_GRP_Y,K_WG_BUFSIZE,1,WG_T%,1
    ARYOP #AOPADD,WG_T%,WG_T%,-32768
    'filter
    BIQUAD WG_T%,WG_T%,WG_FP
    'gain
    ARYOP #AOPMAD,WG_T#,WG_NR,WG_PGAIN#-WG_GAIN#,WG_GAIN#
    ARYOP #AOPMUL,WG_BUF,WG_T%,WG_T#
    WG_PGAIN#=WG_GAIN#
   ENDIF
   WG_REST=K_WG_BUFSIZE
  ENDIF
  N=MIN(SIZE,WG_REST)
  DST_OFS=RINGCOPY(DST,DST_OFS,WG_BUF,K_WG_BUFSIZE-WG_REST,N)
  SIZE=SIZE-N
  WG_REST=WG_REST-N
 WEND
 RETURN DST_OFS
END


'============================================
'Main
'============================================
VAR K_SAMPLERATE=32728
VAR K_BUFSIZE   =2048
VAR K_BUFMASK   =K_BUFSIZE-1
VAR K_WAVELEN   =8192
VAR K_MAX_FC    =15000
VAR K_MIN_FC    =50

DEF SINWAVE(L)
 VAR I,T,W[0]
 W=ARRAY%(L)
 I=0: REPEAT
  T=30000*SIN(_2PI*I/L)+32768
  W[I]=RGB((T AND 1)<<8,(T>>8),(T>>3) AND &HF8,(T<<2) AND &HF8)
 I=I+1: UNTIL L<=I
 RETURN W
END

DEF SAWWAVE(L)
 VAR I,T,W[0]
 W=ARRAY%(L)
 I=0: REPEAT
  T=2768+60000*I/L
  W[I]=RGB((T AND 1)<<8,(T>>8),(T>>3) AND &HF8,(T<<2) AND &HF8)
 I=I+1: UNTIL L<=I
 RETURN W
END

DEF SQRWAVE(L)
 VAR W[0],T,N=L>>1
 W=ARRAY%(L)
 T=2769
 T=RGB((T AND 1)<<8,(T>>8),(T>>3) AND &HF8,(T<<2) AND &HF8)
 FILL W,T,0,N
 T=62767
 T=RGB((T AND 1)<<8,(T>>8),(T>>3) AND &HF8,(T<<2) AND &HF8)
 FILL W,T,N,L-N
 RETURN W
END

DEF TRIWAVE(L)
 VAR W[0]
 W=ARRAY%(L)
 VAR A,T
 VAR I,N=L>>2,P1=2*N-1,P2=2*N,P3=L-1
 I=0: REPEAT
  A=30000*I/N
  T=A+32768
  T=RGB((T AND 1)<<8,(T>>8),(T>>3) AND &HF8,(T<<2) AND &HF8)
  W[I]=T: W[P1-I]=T
  T=32768-A
  T=RGB((T AND 1)<<8,(T>>8),(T>>3) AND &HF8,(T<<2) AND &HF8)
  W[I+P2]=T: W[P3-I]=T
 I=I+1: UNTIL N<=I
 RETURN W
END

DEF KEY2STR(K#)
 VAR K=ROUND(MAX(0,K#))
 RETURN FORMAT$("%2S%2D",MID$("C C#D D#E F F#G G#A A#B ",(K MOD 12)<<1,2),(K DIV 12)-1)
END

DEF USAGE
 ?"Play"
 ?" ←→Pitch"
 ?" ↑↓Gain"
 ?
 ?"Filter"
 ?" ←→Cutoff Frequency"
 ?" ↑↓Resonance"
 ?
 ?"Wave"
 ?" ← Saw"
 ?" → Square"
 ?" ↑ Triangle"
 ?" ↓ Sine"
 ?
 ?"Exit"
END

DEF MAIN
 ACLS
 XSCREEN 3
 USAGE
 DISPLAY 1
 VAR BUF[K_BUFSIZE]
 VAR BUFPOS
 VAR W_SAW[0],W_SQR[0],W_TRI[0],W_SIN[0]
 VAR PITCH#,CPITCH#
 VAR GAIN#,CGAIN#
 VAR CUT#,CCUT#
 VAR RES#,CRES#
 VAR BT,TT,TX,TY,SX#,SY#
 VAR CURR_CNT,PREV_CNT
 'init
 W_SAW=SAWWAVE(K_WAVELEN)
 W_SQR=SQRWAVE(K_WAVELEN)
 W_TRI=TRIWAVE(K_WAVELEN)
 W_SIN=SINWAVE(K_WAVELEN)
 WG_INIT K_SAMPLERATE
 WG_WAV W_SAW
 WAIT
 PREV_CNT=MAINCNT
 PCMSTREAM BUF,K_SAMPLERATE
 PCMPOS=0
 BUFPOS=0
 WHILE !(BUTTON() AND #X)
  BT=BUTTON(1)
  IF BT AND #LEFT  THEN WG_WAV W_SAW
  IF BT AND #RIGHT THEN WG_WAV W_SQR
  IF BT AND #UP    THEN WG_WAV W_TRI
  IF BT AND #DOWN  THEN WG_WAV W_SIN
  IF BT AND #A THEN BGMPLAY "V100 O4C"
  STICK OUT SX#,SY#
  CUT#=MAX(K_MIN_FC,MIN(K_MAX_FC,(K_MAX_FC*POW(SX#/1.5+0.5,2))))
  RES#=MAX(1/65536,POW(MAX(0,MIN(1,SY#/1.5+0.5)),2)*2)
  TOUCH OUT TT,TX,TY
  IF TT THEN
   PITCH#=(TX>>3)+49
   GAIN#=0.75*(240-TY)/240
  ELSE
   GAIN#=0
  ENDIF
  'update params
  CPITCH#=(PITCH#-CPITCH#)*0.5+CPITCH#
  CGAIN# =( GAIN#- CGAIN#)*0.5+CGAIN#
  CCUT#  =(  CUT#-  CCUT#)*0.25+CCUT#
  CRES#  =(  RES#-  CRES#)*0.25+CRES#
  WG_PITCH CPITCH#
  WG_GAIN CGAIN#
  WG_LPF CCUT#,CRES#
  'display params
  CLS
  ?        "KEY : "    ;KEY2STR(CPITCH#)
  ?FORMAT$("GAIN: %.2F",CGAIN#)
  ?FORMAT$("CUT : %D"  ,CCUT#)
  ?FORMAT$("RES : %.2F",CRES#)
  'render
  REPEAT
   BUFPOS=WG_RENDER(BUF,BUFPOS,PCMPOS-BUFPOS AND K_BUFMASK)
   CURR_CNT=MAINCNT
  UNTIL PREV_CNT<CURR_CNT
  PREV_CNT=CURR_CNT
 WEND
 'deinit
 WG_DEINIT
END

MAIN