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