home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 025.lha / Synthesizer (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1987-04-02  |  11.1 KB  |  355 lines
  1. REM *** This program lets you experiment with producing various types
  2. REM *** of sounds, by variations in volume, duration, frequency and
  3. REM *** waveform.
  4. REM ***                   M. Meyers  [71455,1472]
  5.  
  6.  
  7.  
  8. DEFINT i,j,h
  9. DIM freq(28),frequency.v0(28),frequency.v1(28),wave0%(500),wave1%(500)
  10. DIM wavedef%(500)
  11. GOSUB initctrls
  12. FOR i=1 TO 28 : READ freq(i)
  13.   frequency.v0(i)=freq(i) : frequency.v1(i)=freq(i)
  14. NEXT i
  15. DIM organ%(255) : RESTORE organ
  16. FOR i=0 TO 255 : READ organ%(i) : NEXT i  
  17. GOSUB drawkeys
  18. FOR i=1 TO 28 : col=1 : GOSUB sounder : col=2 : GOSUB markkey : NEXT i
  19. PALETTE 3,0.8,0.6,0.53
  20.  
  21. '******** main loop ***********
  22.  
  23. aloop:
  24.   a$=INKEY$
  25.   GOSUB mouser
  26.   ON MENU GOSUB menu.handeler
  27.   IF a$=CHR$(139) THEN GOSUB helpmenu
  28.   IF a$="" THEN GOTO aloop
  29.   GOSUB keyhandeler
  30. GOTO aloop
  31. END
  32.  
  33. '******** program routines **********
  34.  
  35. menu.handeler:
  36.   menuid=MENU(0)
  37.   menuitem=MENU(1)
  38.   ' LOCATE 5,12:PRINT menuid;menuitem  ' *** debug ***
  39.   IF menuid=1 AND menuitem=1 THEN WAVE wvoice,SIN
  40.   IF menuid=1 AND menuitem=2 THEN GOSUB newwave
  41.   IF menuid=1 AND menuitem=3 THEN
  42.     WAVE wvoice,organ%
  43.   END IF
  44.   IF menuid=2 AND menuitem=1 THEN MENU OFF: MENU RESET: CLS: STOP
  45.   IF menuid=3 AND menuitem=1 THEN
  46.     wvoice=0 : LOCATE 18,68 : PRINT wvoice;
  47.   ELSEIF menuid=3 AND menuitem=2 THEN
  48.     wvoice=1 : LOCATE 18,68 : PRINT wvoice; 
  49.   END IF
  50. RETURN
  51.  
  52. initctrls:
  53.    ' voice 1
  54.   LINE(50,10)-(200,30),2,b : LOCATE 5,10: PRINT "Volume v1";
  55.   LINE(250,10)-(400,30),2,b : LOCATE 5,37 : PRINT "Duration v1";
  56.   LINE(450,10)-(600,30),2,b : LOCATE 5,61 : PRINT "Frequency v1";
  57.   LINE(523,10)-(527,30),2,bf
  58.   b=1:x=110:y=30:GOSUB volctrl.v1  ' set up initial volume
  59.   b=1:x=270:y=30:GOSUB durctrl.v1  ' set up initial duration
  60.    ' voice 0
  61.   LINE(50,40)-(200,60),2,b : LOCATE 9,10: PRINT "Volume v0";
  62.   LINE(250,40)-(400,60),2,b : LOCATE 9,37 : PRINT "Duration v0";
  63.   LINE(450,40)-(600,60),2,b : LOCATE 9,61 : PRINT "Frequency v0";
  64.   LINE(523,40)-(527,60),2,bf
  65.   b=1:x=170:y=60:GOSUB volctrl.v0  ' set up initial volume
  66.   b=1:x=270:y=60:GOSUB durctrl.v0  ' set up initial duration
  67.    ' define keyboard
  68.    LOCATE 14,15 : PRINT "Voice One";
  69.    LOCATE 20,15 : PRINT "Voice Zero";
  70.    ' waveform area
  71.   wvoice=0:LOCATE 18,52 : PRINT "Active Voice is ";wvoice;
  72.   MENU RESET
  73.   MENU 1,0,1,"Waveform Menu"
  74.   MENU 1,1,1,"Use Sin Waveform"
  75.   MENU 1,2,1,"Create Custom Waveform"
  76.   MENU 1,3,1,"Use Organ Waveform"
  77.   MENU 2,0,1,"Program Execution"
  78.   MENU 2,1,1,"Stop Program"
  79.   MENU 3,0,1,"Waveform Voice Selection"
  80.   MENU 3,1,1,"Voice 0"
  81.   MENU 3,2,1,"Voice 1"
  82.   MENU 4,0,1,""
  83.   MENU ON
  84.   ' show how to get help
  85.   LOCATE 14,50 : PRINT "  Press   HELP   for help"
  86.   LINE(463,100)-(510,115),1,b
  87. RETURN
  88.  
  89. newwave:
  90.   IF wvoice=0 THEN ERASE wave0% : DIM wave0%(500)
  91.   IF wvoice=1 THEN ERASE wave1% : DIM wave1%(500) 
  92.   SCREEN 2,400,256,3,4
  93.   WINDOW 2,"Waveform Window",(100,50)-(600,150),0
  94.   WINDOW OUTPUT 2
  95.   LINE (250,0)-(250,100),2
  96.   LINE (0,50)-(500,50),2
  97.   WHILE b=0
  98.     b=MOUSE(0):x=MOUSE(1):y=MOUSE(2)
  99.   WEND
  100.   x1=x:y1=y:wvctr%=0:ix=x:iy=y 
  101. newinit:  
  102.    b=MOUSE(0):x=MOUSE(1):y=MOUSE(2):actw=0
  103.    IF b<>0 THEN LINE(x1,y1)-(x,y),3
  104.    x1=x:y1=y
  105.    IF y<51 THEN pw=127-(y*2.54) : actw=1
  106.    IF y>50 THEN mw=(y-50)*-2.54 : actw=2 : IF mw<-128 THEN mw=-128
  107.    IF mw>-3 THEN mw=0
  108.    IF (ix<>x OR iy<>y) AND b<>0 THEN wvctr%=wvctr%+1
  109.    IF actw=1 THEN
  110.      IF wvoice=0 THEN wave0%(wvctr%)=pw
  111.      IF wvoice=1 THEN wave1%(wvctr%)=pw
  112.    END IF
  113.    IF actw=2 THEN
  114.      IF wvoice=0 THEN wave0%(wvctr%)=mw
  115.      IF wvoice=1 THEN wave1%(wvctr%)=mw
  116.    END IF
  117.    'LOCATE 5,5 : PRINT "mouser";b;x;y;pw;mw ' debug
  118.     LOCATE 12,27 : PRINT "Points ="; : PRINT USING "#####";wvctr%; 
  119.    IF b<>0 AND x=0 AND y=0 THEN GOTO closeit
  120.    ix=x:iy=y
  121.    GOTO newinit:
  122. closeit:
  123.   SCREEN CLOSE 2
  124.   WINDOW CLOSE 2
  125.   ERASE wavedef% : IF wvctr%>256 THEN DIM wavedef%(wvctr%) :ELSE DIM wavedef%(256)
  126.   IF wvoice=0 THEN
  127.     FOR i1=1 TO wvctr%
  128.       wavedef%(i1)=wave0%(i1)
  129.     NEXT i1
  130.     WAVE 0,wavedef%
  131.   END IF
  132.   IF wvoice=1 THEN
  133.    FOR i1=1 TO wvctr% 
  134.      wavedef%(i1)=wave1%(i1)
  135.    NEXT i1
  136.    WAVE 1,wavedef%
  137.   END IF
  138.   'GOSUB check
  139. RETURN
  140.  
  141. check:   ' **** debug -- will display the waveforms  ****
  142.   LPRINT "wvoice =";wvoice 
  143.   FOR i=0 TO wvctr% : LPRINT wave0%(i); wave1%(i); wavedef%(i) : NEXT
  144. RETURN
  145.     
  146. mouser:
  147.   b=MOUSE(0):x=MOUSE(1):y=MOUSE(2)
  148.   IF b<>0 AND x>49 AND x<201 AND y>9 AND y<31 THEN GOSUB volctrl.v1
  149.   IF b<>0 AND x>249 AND x<401 AND y>9 AND y<31 THEN GOSUB durctrl.v1
  150.   IF b<>0 AND x>449 AND x<601 AND y>9 AND y<31 THEN GOSUB freqctrl.v1
  151.   IF b<>0 AND x>49 AND x<201 AND y>39 AND y<61 THEN GOSUB volctrl.v0
  152.   IF b<>0 AND x>249 AND x<401 AND y>39 AND y<61 THEN GOSUB durctrl.v0
  153.   IF b<>0 AND x>449 AND x<601 AND y>39 AND y<61 THEN GOSUB freqctrl.v0
  154.   'LOCATE 20,50 : PRINT "mouser";b;x;y  '*** debug ***
  155. RETURN
  156.  
  157. freqctrl.v1:
  158.   WHILE b<>0 AND x>451 AND x<599 AND y>9 AND y<31 
  159.     IF x<523 THEN
  160.       LINE (523,11)-(452,29),0,bf
  161.       LINE (523,11)-(x,29),3,bf
  162.       fm=x-450 : IF fm<1 THEN fm=1
  163.       fm=fm/70 : fm=1*fm : IF fm>1 THEN fm=1
  164.     END IF
  165.     IF x>527 THEN
  166.       LINE (527,11)-(599,29),0,bf
  167.       LINE (527,11)-(x,29),3,bf
  168.       fm=x-450 : IF fm<1 THEN fm=1
  169.       fm=fm/70 : fm=1.2*fm-0.375: IF fm<1 THEN fm=1
  170.     END IF    
  171.     b=MOUSE(0):x=MOUSE(1):y=MOUSE(2)
  172.   'LOCATE 1,63:PRINT USING "#.###";fm;  ' debug 
  173.   WEND
  174.   FOR j=1 TO 28 : frequency.v1(j)=freq(j)*fm : NEXT j
  175. RETURN
  176.  
  177. freqctrl.v0:
  178.   WHILE b<>0 AND x>451 AND x<599 AND y>39 AND y<61 
  179.     IF x<523 THEN
  180.       LINE (523,41)-(452,59),0,bf
  181.       LINE (523,41)-(x,59),3,bf
  182.       fm=x-450 : IF fm<1 THEN fm=1
  183.       fm=fm/70 : fm=1*fm : IF fm>1 THEN fm=1
  184.     END IF
  185.     IF x>527 THEN
  186.       LINE (527,41)-(599,59),0,bf
  187.       LINE (527,41)-(x,59),3,bf
  188.       fm=x-450 : IF fm<1 THEN fm=1
  189.       fm=fm/70 : fm=1.2*fm-0.375: IF fm<1 THEN fm=1
  190.     END IF    
  191.     b=MOUSE(0):x=MOUSE(1):y=MOUSE(2)
  192.     'LOCATE 10,63:PRINT USING "#.###";fm;  ' debug 
  193.   WEND
  194.   FOR j=1 TO 28 : frequency.v0(j)=freq(j)*fm : NEXT j
  195. RETURN
  196.  
  197. durctrl.v1:
  198.   WHILE b<>0 AND x>251 AND x<399 AND y>9 AND y<31 
  199.     LINE (252,11)-(399,29),0,bf
  200.     LINE (252,11)-(x,29),3,bf
  201.     duration.v1=x-250 : IF duration.v1<1 THEN duration.v1=1
  202.     duration.v1=duration.v1/150 : duration.v1=24*duration.v1
  203.     b=MOUSE(0):x=MOUSE(1):y=MOUSE(2)   
  204.     'LOCATE 1,39 : PRINT "d = ";duration.v1;  ' debug
  205.   WEND
  206. RETURN
  207.  
  208. durctrl.v0:
  209.   WHILE b<>0 AND x>251 AND x<399 AND y>39 AND y<61 
  210.     LINE (252,41)-(399,59),0,bf
  211.     LINE (252,41)-(x,59),3,bf
  212.     duration.v0=x-250 : IF duration.v0<1 THEN duration.v0=1
  213.     duration.v0=duration.v0/150 : duration.v0=24*duration.v0
  214.     b=MOUSE(0):x=MOUSE(1):y=MOUSE(2)   
  215.     'LOCATE 10,39 : PRINT "d = ";duration.v0;  ' debug
  216.   WEND
  217. RETURN
  218.  
  219. volctrl.v1:
  220.   WHILE b<>0 AND x>51 AND x<199 AND y>9 AND y<31 
  221.     LINE (52,11)-(199,29),0,bf
  222.     LINE (52,11)-(x,29),3,bf 
  223.     volume.v1=x-50 : IF volume.v1<1 THEN volume.v1=1
  224.     volume.v1=volume.v1/150 : volume.v1=255*volume.v1
  225.     b=MOUSE(0):x=MOUSE(1):y=MOUSE(2)        
  226.     'LOCATE  1,12 : PRINT "v = ";volume.v1;  ' debug
  227.   WEND
  228. RETURN
  229.  
  230. volctrl.v0:
  231.   WHILE b<>0 AND x>51 AND x<199 AND y>39 AND y<61 
  232.     LINE (52,41)-(199,59),0,bf
  233.     LINE (52,41)-(x,59),3,bf 
  234.     volume.v0=x-50 : IF volume.v0<1 THEN volume.v0=1
  235.     volume.v0=volume.v0/150 : volume.v0=255*volume.v0
  236.     b=MOUSE(0):x=MOUSE(1):y=MOUSE(2)        
  237.     'LOCATE  10,12 : PRINT "v = ";volume.v0;  ' debug
  238.   WEND
  239. RETURN
  240.  
  241. sounder:   
  242.  'SOUND WAIT
  243.   IF i<15 THEN SOUND frequency.v0(i),duration.v0,volume.v0,0
  244.   IF i>14 THEN SOUND frequency.v1(i),duration.v1,volume.v1,1
  245.   'SOUND RESUME
  246. RETURN
  247.   
  248. markkey:
  249.   IF i<15 THEN
  250.      y=125
  251.      CIRCLE(40+(18*i),y),5,col
  252.      PAINT(40+(18*i),y),col,col
  253.   END IF
  254.   IF i>14 THEN
  255.      y=75
  256.      CIRCLE(40+(18*(i-14)),y),5,col
  257.      PAINT(40+(18*(i-14)),y),col,col
  258.   END IF  
  259. RETURN  
  260.   
  261. drawkeys:
  262.   LINE(50,75)-(250,100),1,b
  263.   FOR i=0 TO 250 STEP 18
  264.     LINE(50+i,75)-(50+i+15,100),1,bf
  265.   NEXT i 
  266.   LINE(50,125)-(250,150),1,b    
  267.   FOR i=0 TO 250 STEP 18
  268.     LINE(50+i,125)-(50+i+15,150),1,bf
  269.   NEXT i  
  270. RETURN
  271.  
  272. helpmenu:
  273.   WINDOW 3,"Help Window",(50,20)-(600,180),8
  274.   WINDOW OUTPUT 3
  275.   PRINT "This program lets you experiment with creating different types of
  276.   PRINT "sounds.  Use the right mouse button to see and select from the
  277.   PRINT "progam menus.
  278.   PRINT
  279.   PRINT "To change the volume, duration or frequency controls, move the
  280.   PRINT "mouse within the desired box while holding down the left button.
  281.   PRINT "If you select 'custom waveform' from the menu, use the mouse
  282.   PRINT "(holding the left button down to draw) to draw the waveform you
  283.   PRINT "want to use.  Try to use more than 256 points, but less then 500.
  284.   PRINT "To exit from the waveform screen, move the mouse pointer just to
  285.   PRINT "left of the 'W' in 'Waveform' (outside the Waveform Window) and
  286.   PRINT "press the left button.
  287.   PRINT
  288.   PRINT "Sounds are activated from the keyboard.  Voice 1 is played with the
  289.   PRINT "top row of keys (123...) while voice 0 is played with the 'ASDF...'
  290.   PRINT "row plus then (,./) keys.  Keep caps lock off!
  291.   PRINT
  292.   PRINT "Exit this menu by pressing the left mouse button
  293.   b=0
  294.   WHILE b=0
  295.     b=MOUSE(0)
  296.   WEND 
  297.   WINDOW CLOSE 3
  298. RETURN
  299.  
  300. frequencytable:
  301. DATA 130.81,146.83,164.81,174.61,196.00,220.00,246.94,261.63,293.66
  302. DATA 329.63,349.23,392.00,440.00,493.88
  303. DATA 523.25,587.33,659.26,701.00,783.99,880.00,993.00,1046.50,1174.70
  304. DATA 1318.50,1396.90,1568.00,1760.00,1975.50
  305.  
  306. keyhandeler:
  307.   IF a$="a" THEN i=1 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  308.   IF a$="s" THEN i=2 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  309.   IF a$="d" THEN i=3 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  310.   IF a$="f" THEN i=4 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  311.   IF a$="g" THEN i=5 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  312.   IF a$="h" THEN i=6 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  313.   IF a$="j" THEN i=7 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  314.   IF a$="k" THEN i=8 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  315.   IF a$="l" THEN i=9 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  316.   IF a$=";" THEN i=10 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  317.   IF a$="'" THEN i=11 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  318.   IF a$="," THEN i=12 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  319.   IF a$="." THEN i=13 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  320.   IF a$="/" THEN i=14 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  321.   IF a$="`" THEN i=15 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  322.   IF a$="1" THEN i=16 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  323.   IF a$="2" THEN i=17 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  324.   IF a$="3" THEN i=18 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  325.   IF a$="4" THEN i=19 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  326.   IF a$="5" THEN i=20 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  327.   IF a$="6" THEN i=21 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  328.   IF a$="7" THEN i=22:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  329.   IF a$="8" THEN i=23:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  330.   IF a$="9" THEN i=24:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  331.   IF a$="0" THEN i=25:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  332.   IF a$="-" THEN i=26:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  333.   IF a$="=" THEN i=27:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  334.   IF a$="\" THEN i=28:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN
  335. RETURN
  336.  
  337. organ:
  338.  DATA 0, 8, 15, 23, 30, 37, 44, 51, 57, 63, 69, 74, 79, 83, 87, 91
  339.  DATA 93, 96, 98, 99, 100, 100, 100, 99, 98, 97, 95, 92, 89, 86, 83, 79
  340.  DATA 75, 71, 66, 62, 57, 52, 48, 43, 39, 34, 30, 25, 21, 18, 14, 11
  341.  DATA 8, 5, 3, 0,-1,-3,-4,-5,-5,-6,-6,-5,-5,-4,-3,-1
  342.  DATA 0, 2, 3, 5, 7, 9, 11, 13, 15, 17, 18, 20, 21, 23, 24, 25
  343.  DATA 26, 26, 27, 27, 27, 27, 27, 26, 25, 24, 23, 22, 20, 18, 17, 15
  344.  DATA 13, 11, 9, 7, 5, 3, 1,-1,-3,-5,-6,-8,-9,-10,-11,-12
  345.  DATA -12,-13,-13,-13,-13,-13,-12,-11,-11,-10,-8,-7,-6,-4,-3,-2
  346.  DATA 0, 2, 3, 4, 6, 7, 8, 10, 11, 11, 12, 13, 13, 13, 13, 13
  347.  DATA 12, 12, 11, 10, 9, 8, 6, 5, 3, 1,-1,-3,-5,-7,-9,-11
  348.  DATA -13,-15,-17,-18,-20,-22,-23,-24,-25,-26,-27,-27,-27,-27,-27,-26
  349.  DATA -26,-25,-24,-23,-21,-20,-18,-17,-15,-13,-11,-9,-7,-5,-3,-2
  350.  DATA 0, 1, 3, 4, 5, 5, 6, 6, 5, 5, 4, 3, 1, 0,-3,-5
  351.  DATA -8,-11,-14,-18,-21,-25,-30,-34,-39,-43,-48,-52,-57,-62,-66,-71
  352.  DATA -75,-79,-83,-86,-89,-92,-95,-97,-98,-99,-100,-100,-100,-99,-98,-96
  353.  DATA -93,-91,-87,-83,-79,-74,-69,-63,-57,-51,-44,-37,-30,-23,-15,-8
  354.  
  355.