home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Supplement / Unsupported / Optionals / FourTone < prev    next >
Encoding:
Text File  |  1986-02-08  |  2.3 KB  |  95 lines  |  [TEXT/MACA]
  1. \ FourTone - Four Tone synthesizer driver
  2. \ written June 23 1985 by John Papiewski
  3. \ v 1.1 July 9 Fix Bugs !!! add no-wait (asynchonous) code
  4.  
  5. \ must first load: Drvr & Struct1
  6.  
  7. :Class FourTone <Super PBDrvr
  8.  
  9.     Int duration
  10.     Var snd1rate
  11.     Var snd1phase
  12.     Var snd2rate
  13.     Var snd2phase
  14.     Var snd3rate
  15.     Var snd3phase
  16.     Var snd4rate
  17.     Var snd4phase
  18.     Var snd1wave
  19.     Var snd2wave
  20.     Var snd3wave
  21.     Var snd4wave
  22.  
  23.     Int FTRMode
  24.     Var SndPtr
  25.  
  26. :M OpenSound: -4 Put: IORefnum Put: IOcomp 6 put: IOReq
  27.     Abs: FTRMode   Put: IOBuffer
  28.     " .Sound" Name: Super open: Super
  29. ;M
  30.  
  31. :M SetPitch: { Tone1 Tone2 Tone3 Tone4 -- }
  32.     Tone1 Put: Snd1Rate
  33.     Tone2 Put: Snd2Rate
  34.     Tone3 Put: Snd3Rate
  35.     Tone4 Put: Snd4Rate
  36. ;M
  37.  
  38. :M SetDur: { Dur -- }  \ Set duration in ticks (60/second)
  39.     dur Put: duration 10 Put: snd1phase 10 Put: snd2phase
  40.     10 Put: snd3phase 10 Put: snd4phase
  41. ;M
  42.  
  43. :M SetWave: { Wave1 Wave2 Wave3 Wave4 -- }  \ Assign waveform arrays to each
  44.     Wave1 Put: Snd1wave  Wave2 Put: Snd2wave   \ voice
  45.     Wave3 Put: Snd3wave  Wave4 Put: Snd3wave
  46. ;M
  47.  
  48. :M StartSnd:        \ regular driver
  49.     Abs: Duration  Put: SndPtr
  50.     1 Put: FtrMode  \  -1 = Square wave, 1 = Four-Tone, 0 = Free-form  
  51.     Addr: FTRmode 6 Write: Self
  52.     drop
  53. ;M
  54. :M NWStartSnd:  { Proc -- }    \ no-wait (asynchonous) driver
  55.     Abs: Duration  Put: SndPtr
  56.     1 Put: FtrMode  \  -1 = Square wave, 1 = Four-Tone, 0 = Free-form  
  57.     Proc Addr: FTRmode 6 WriteNW: Self
  58.     drop
  59. ;M
  60. ;Class
  61.  
  62. :CLass WaveForm <Super Barray   \ Describe the waveform structure here
  63. :M SawInit: 255 0 do i i To: Self loop ;M   \ fill array with sawtooth
  64. :M Squinit: Clear: Self 127 0 Do 255 i To: self loop ;M  \ Square Wave
  65. :M TriInit: 63 0 Do 127 i 2* + i TO: Self Loop  \ Triangle
  66.     191 64 Do 383 i -2 * + i To: Self Loop
  67.     255 192 Do i 192 - 2* i To: Self Loop
  68. ;M
  69. :M  FBWave: Abs: Self 4 + ;M
  70. ;Class
  71.  
  72. \ Here's an example :
  73. 0 value FTDone
  74. :Proc FourDone 1 -> FTdone ;Proc     \ Used to tell when no-wait write is done
  75.  
  76. 256 WaveForm Sawtooth
  77. 256 WaveForm Triangle
  78. 256 WaveForm Square
  79. SawInit: Sawtooth
  80. SquInit: Square
  81. TriInit: Triangle
  82. FourTone Buzz
  83. OpenSound: Buzz
  84. FbWave: Triangle FBWave: Square Fbwave: Sawtooth dup SetWave: Buzz
  85. cr cr
  86. ." Four-Tone Sound Demo"
  87. : Buzzarre
  88. 250000 50000 DO
  89. 5 SetDur: Buzz
  90. i 3000 i +  1000 i + 0 SetPitch: Buzz
  91. StartSnd: Buzz
  92. 1000 +Loop
  93. ;
  94. Buzzarre
  95.