  indexbase 0
  uses corewin
  uses "waves.h"

  string       cr=chr(13)+chr(10)
  string       tab=chr(9)

  %stereo
  #ifdef stereo
  WAVEFORMATEX wfx
  wfx.wFormatTag      = WAVE_FORMAT_PCM '
  wfx.nChannels       = 2               'channels
  wfx.nSamplesPerSec  = 44100           'sample rate
  wfx.nAvgBytesPerSec = 176400          'wfx.nBlockAlign * wfx.nSamplesPerSec
  wfx.nBlockAlign     = 4               '(wfx.wBitsPerSample * wfx.nChannels)/8
  wfx.wBitsPerSample  = 16              'sample size
  wfx.cbSize          = 0               'SIZE OF _extra_ info
  '
  #else
  '
  WAVEFORMATEX wfx
  wfx.wFormatTag      = WAVE_FORMAT_PCM '
  wfx.nChannels       = 1               'channels
  wfx.nSamplesPerSec  = 44100           'sample rate
  wfx.nAvgBytesPerSec = 88200           'wfx.nBlockAlign * wfx.nSamplesPerSec
  wfx.nBlockAlign     = 2               '(wfx.wBitsPerSample * wfx.nChannels)/8
  wfx.wBitsPerSample  = 16              'sample size
  wfx.cbSize          = 0               'SIZE OF _extra_ info
  #endif

  'Multiple Channel Audio
  'http://msdn.microsoft.com/en-us/windows/hardware/gg463006#E6C




  single ipuls,pi2
  ipuls=1/(88200*wfx.nchannels)
  pi2=2*pi


/*

  http://www.musicmasterworks.com/WhereMathMeetsMusic.html
  http://en.wikipedia.org/wiki/Heptatonic_scale
  '

  --------------------------------------------------
    C   C#  D   D#  E   F   F#  G   G#  A   A#  B   note names (with sharps)
    C   Db  D   Eb  E   F   Gb  G   Ab  A   Bb  B   note names (with flats)
    03  04  05  06  07  08  09  10  11  00  01  02  note number (A above middle C=440Hz)
    1   2   3   4   5   6   7   8   9   0   -   =   qwerty keyboard
    49  50  51  52  53  54  55  56  57  48  45  61  ascii encode
    60  61  62  63  64  65  66  67  68  69  70  71  midi note number (middle c=60)
  --------------------------------------------------
  
  midi octave 5
  C5=220*pow(2,3/12) 'middle C 261.63Hz
  A5=440Hz

  ======= 
  G STAVE
  =======

   G               O
  -F--------------O---------------
   E             O
  -D------------O-----------------
   C           O
  -B----------O-------------------
   A         O
  -G--------O---------------------
   F       O
  -E------O-----------------------
   D     0
  -C----O----
   B   O
  -A--O-----


  http://en.wikipedia.org/wiki/Equal_temperament

  HARMONIC APPROXIMATIONS: pow(2,n/12)

  name             note ratio  frac err   rating
  ----------------------------------------------------
  Unison           0    1.000  1/1  .000  -000  =====
  Minor Second     1    1.059 16/15 .008  -120  .
  Major Second     2    1.122  9/8  .003  -024  ==
  Minor Third      3    1.189  6/5  .011  -055  =
  Major Third      4    1.266  5/4  .016  -064  =
  Perfect Fourth   5    1.335  4/3  .002  -006  ====
  Augmented Fpurth 6    1.414  7/5  .014  -070  .   
  Perfect Fifth    7    1.498  3/2  .002  -004  ====
  Minor Sixth      8    1.587  8/5  .013  -065  =
  Major Sixth      9    1.682  5/3  .022  -066  =
  Minor Seventh    10   1.782  9/5  .018  -090  .
  Major Seventh    11   1.888 15/8  .013  -104  .
  Octave           12   2.000  2/1  .000  -000  =====




*/

  string scale[32]
  '
  scale(1)="13580"   'pentatonic c major
  scale(2)="1468-"   'pentatonic c minor
  scale(3)="13579-"  'hexatonic c major
  scale(4)="14678-"  'hexatonic c minor
  scale(5)="135680=" 'heptatonic c major
  scale(6)="134689-" 'heptatonic c minor
  scale(7)="134789=" 'hungarian gypsy c
  scale(8)="134789=" 'spanish gypsy c
  scale(16)="1234"
  scale(17)="160"
  scale(18)="816"
  '
  sys FirstMScale=1
  sys LastMScale=8


  'GENERAL FUNCTIONS

  sys sys_seed=12345

  Function Rand(sys z1, z2) as sys
    sys    rnd 
    mov    eax,z2
    sub    eax,z1
    inc    eax
    imul   edx,sys_Seed,0x8088405
    inc    edx
    mov    sys_Seed,edx
    mul    edx
    add    edx,z1
    mov    rnd,edx
    return rnd
  End Function 



  'WAVEFORMS
  '
  function Noise(sys i) as Single
  ===============================
  static single f, d=1/0x7fffffff
  mov eax,i
  xor eax,0x35353535
  imul eax,eax
  ror eax,17
  imul eax,i
  ror eax,7
  push eax
  fild dWord [esp]
  add esp,4
  fmul dWord d
  fstp dWord function
  End Function

  function NoiseInterp(sys i, single r) as Single
  ===============================================
  single b,e
  b=1+noise i
  e=1+noise i+1
  return 1-b*(1-r)-e*r 'interpolation
  End Function

  function square(single phase) as single
  if phase>=.5 then return -1 else return 1
  end function

  function sqrd(single phase) as single
  =====================================
  #noinit
  single p
  static single q=.25,m=16
  if phase<=.25 then p=q-phase : return 1-p*p*m
  if phase<=.5 then p=phase-q : return 1-p*p*m
  if phase<=.75 then p=phase-.5 : p=q-p : return p*p*m-1
  p=phase-.75 : return p*p*m-1
  end function

  function triangle(single phase) as single
  =========================================
  phase+=.25 'shift 90 degrees
  if phase>1 then phase-=1
  if phase>=.5 then return 3-phase*4 else return phase*4-1
  end function

  function sawtooth(single phase) as single
  =========================================
  return phase*2-1
  end function

  function PulseWidth(single phase,start) as single
  =================================================
  if phase>=.5 then
    if phase<1-start then return -1
  else
    if phase>=start then return 1
  end if
  end function
  '
  'q1 = (q and w.bufmask)>>1
  'q2 = ((q-reverbt) and bufmask)>>1
  'abuf[q1]=(abuf[q2]*reverba)+(a*nreverba)
  'q+=2
  '
  #if sizeof sys = 8

  def SendToBuffer
  ================
  mov rdx,q
  and rdx,w.bufmask
  mov rcx,w.buf
  add rcx,rdx
  sub rdx,reverbt
  and rdx,w.bufmask
  add rdx,w.buf
  fild word [rdx]
  fmul dword reverba
  fld dword a
  fmul dword nreverba
  faddp st1
  fistp word [rcx]
  add q,2
  end def

  #else '32bit

  def SendToBuffer
  ================
  mov edx,q
  and edx,w.bufmask
  mov ecx,w.buf
  add ecx,edx
  sub edx,reverbt
  and edx,w.bufmask
  add edx,w.buf
  fild word [edx]
  fmul dword reverba
  fld dword a
  fmul dword nreverba
  faddp st1
  fistp word [ecx]
  add q,2
  end def

  #endif

  ' a callback when sound buffer is empty
  '--------------------------------------
  '
  sub wavonotify(sys  hw, uMsg, dwInstance, dwParam1, dwParam2), callback
  =======================================================================
  if umsg=MM_WOM_DONE then
  end if
  end sub


  static short wdas[0x10000] '128Kb
  static float wdaf[0x10000] '256Kb

  =============
  class WaveOut
  =============


  sys       err
  sys       hwavo
  sys       buf
  sys       bufmask
  WAVEHDR   whdr
  MMTIME    mmPosData


  ' To get position in a looping buffer
  '------------------------------------
  '
  method wavopos() as long
  ========================
  WaveOutGetPosition( hwavo,mmPosData,sizeof(mmPosData))
  return MMPosData.u.cb
  end method


  ' To transfer data into the audio buffer
  '---------------------------------------
  '
  '
  method wavowr()
  ===============
  sys a
  @whdr.lpData=buf
  whdr.dwBufferLength=0x8000*2*wfx.nchannels 'len das
  whdr.dwloops=-1
  a=WHDR_DONE
  not a 'clear flag
  whdr.dwFlags = whdr.dwFlags and a or WHDR_BEGINLOOP or WHDR_ENDLOOP
  err=waveOutWrite(hwavo, whdr, sizeof(whdr))
  'print err
  end method

 
  method WavoStart()
  ==================
  sys audn
  'wdas=nuls(0x10000*wfx.nchannels) 'blank sound canvas
  buf=@wdas 'buf=*das
  #ifdef stereo
  bufmask=0x1ffff 'len(das)-1
  #else
  bufmask=0x0ffff 'len(das)-1
  #endif
  mmPosData.wType=TIME_BYTES
  '
  err=waveOutOpen( hwavo, WAVE_MAPPER, wfx, @wavonotify, audn, CALLBACK_FUNCTION)
  'print err
  err=waveOutPrepareHeader(hwavo, whdr, sizeof(whdr))
  'print err
  '
  wavowr() 'start looping buffer
  sleep 10 'ensures clean start
  end method


  method WavoEnd()
  ================
  waveOutBreakLoop(hwavo)
  sleep 10
  waveOutUnPrepareHeader(hwavo, whdr,sizeof(whdr))
  waveoutclose(hwavo)
  end method


  end class


'#recordof waveout
 
