home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 071.lha / Lissajoo.BAS < prev    next >
Encoding:
BASIC Source File  |  1980-07-10  |  9.0 KB  |  282 lines
  1.  
  2. ' LISSAJOUS ---- This AmigaBASIC program allows the user to produce both
  3. '                "classical" and "aliased" Lissajous figures. Aliased
  4. '                patterns are seen on a digital oscilloscope when the
  5. '                sampling rate used is too low for the frequencies
  6. '                at the inputs. 
  7. '
  8. 'This program was written by Clark Leslie ( CI$ [74030,1162] ) October 1987.
  9. 'It is placed into the public domain and may be freely distributed.                
  10.                 
  11. DEFINT a-Z
  12. DIM X(1000),Y(1000)
  13. XWidth=340:XCenter=320
  14. YWidth=152:YCenter=79
  15. PI!=3.1416
  16. PIx2!=PI!*2
  17. TraceColor=4
  18. HalfXWidth=XWidth/2
  19. HalfYWidth=YWidth/2
  20. XTopLft=XCenter-HalfXWidth-1
  21. YTopLft=YCenter-HalfYWidth-1
  22. XBotRt=XCenter+HalfXWidth+1
  23. YBotRt=YCenter+HalfYWidth+1
  24. LEdge=18
  25. REdge=614
  26.  
  27.  
  28. '***** Digitize sine waves and normalize to screen window.
  29.  
  30. CLS
  31. PRINT 
  32. PRINT  "Please wait while I calculate 1000 sine values."
  33. LOCATE 10,36
  34. PRINT "LISSAJOUS"
  35. LOCATE 11,39
  36. PRINT "by"
  37. LOCATE 12,34
  38. PRINT  "Clark  Leslie"
  39.  
  40. FOR Alpha!=0 TO PIx2! STEP PIx2!/1000         'The 1000 elements of arrays
  41.   SinAlpha!=SIN(Alpha!)                       'X() & Y() represent a sine
  42.   X(Angle)= HalfXWidth*SinAlpha!+XCenter      'wave from 0 to 360°.
  43.   Y(Angle)= -1*HalfYWidth*SinAlpha!+YCenter   'Y is minus for +Y up.
  44.   Angle=Angle+1
  45. NEXT Alpha!
  46.   X(1000)=X(0):Y(1000)=Y(0)
  47.  
  48. '***** Set up screen
  49.  
  50. SCREEN 1,640,200,4,2
  51. WINDOW 2,"Lissajous",,12,1
  52. request1$="Click on DoIt to control scope."
  53. request2$="Click on Demo to see demo first."
  54. CALL Requester
  55.  
  56. start:
  57.  
  58. GOSUB GetColors
  59. GOSUB InitScope
  60.  
  61. IF answer=0 THEN Demonstrate
  62.      
  63.         
  64. Set:    LINE (LEdge,YTopLft)-(REdge,YBotRt),2,bf    'Erase scope screen.
  65.           Xfreq=Current(0)*100 + Current(1)         'Current() holds either
  66.           Yfreq=Current(2)*100 + Current(3)         'default values or new
  67.           Phase=Current(4)*1000/360                 'values from mouse. 
  68.           XAngle1=0:YAngle1=Phase
  69.              LOCATE TextRow(0),77                   'Print current values.
  70.              PRINT  USING "###";Xfreq;
  71.              LOCATE TextRow(2),77
  72.              PRINT  USING "###";Yfreq;
  73.              LOCATE TextRow(4),57
  74.              PRINT  USING "###";Current(4);
  75.              
  76.                                    
  77. Scope:    Xangle2=XAngle1+Xfreq                       'Sample rates (X&Yfreq) 
  78.             IF Xangle2>1000 THEN Xangle2=Xangle2-1000 'are added to current
  79.           YAngle2=YAngle1+Yfreq                       'position in array.
  80.             IF YAngle2>1000 THEN YAngle2=YAngle2-1000  
  81.           
  82.           LINE (X(XAngle1),Y(YAngle1))-(X(Xangle2),Y(YAngle2)),TraceColor
  83.           
  84.           XAngle1=Xangle2                     'Make last endpoint next
  85.           YAngle1=YAngle2                     'start point.
  86.           TraceColor=TraceColor+1             'Draw each segment in a
  87.           IF TraceColor>15 THEN TraceColor=4  'different color.(Leave
  88.                                               'system colors 0-3 alone.)
  89.  
  90. '***** This mouse routine adapted from the Speech Demo.
  91.  
  92.     WHILE MOUSE(0)<>0                              'This executes if mouse
  93.       mouseX=MOUSE(1)                              'left button pushed.
  94.       mouseY=MOUSE(2)
  95.       FOR i=0 TO 4                                 'For each gadget, see if
  96.         IF mouseX>=x1(i) AND mouseX<=x2(i) THEN    'pointer is in box.
  97.           IF mouseY>=y1(i) AND mouseY<=y2(i) THEN
  98.             v!=(mouseX-x1(i))/(x2(i)-x1(i))        'Find relative position.
  99.             Current(i)=min(i)+v!*(max(i)-min(i))   'Convert to value.
  100.             GOSUB DrawControl                      'Redraw slider position.
  101.           END IF
  102.         END IF
  103.       NEXT i
  104.       GOTO Set                                     'Got new value, start 
  105.     WEND                                           'over.
  106.  
  107.   GOTO Scope                                       'No click, so continue.
  108.  
  109.  
  110. ' ==================== SUBROUTINES =========================
  111.  
  112.   GetColors:
  113.     FOR i=4 TO 15
  114.       READ R!,G!,B!
  115.       PALETTE i,R!,G!,B!
  116.     NEXT
  117.   RETURN  
  118.     
  119. '         Red   Grn  Blue
  120.  
  121. 4  DATA  1.00, 0.00, 0.00         
  122. 5  DATA  0.93, 0.33, 0.00         
  123. 6  DATA  0.73, 0.47, 0.00
  124. 7  DATA  1.00, 1.00, 0.00
  125. 8  DATA  0.60, 0.80, 0.00
  126. 9  DATA  0.00, 0.60, 0.00
  127. 10 DATA  0.00, 0.40, 0.20
  128. 11 DATA  0.00, 0.53, 1.00
  129. 12 DATA  0.00, 0.00, 0.67
  130. 13 DATA  0.53, 0.00, 0.47
  131. 14 DATA  0.33, 0.00, 0.00
  132. 15 DATA  0.60, 0.33, 0.00
  133.       
  134.   
  135. InitScope:
  136.     
  137.     LINE (0,0)-(639,199),10,bf                     'Fill entire window.
  138.     
  139.     FOR i=0 TO 4
  140.       
  141.       READ nam$(i),min(i),max(i),Current(i)        'Set up defaults for
  142.       READ TextRow(i),TextCol(i),BoxRight(i)       'gadgets.
  143.            
  144.           DATA "X Freq-Coarse",0,  9, 0,21, 3,61
  145.           DATA "X Freq-Fine"  ,0, 99,20,21,26,311
  146.           DATA "Y Freq-Coarse",0,  9, 0,22, 3,61    
  147.           DATA "Y Freq-Fine"  ,0, 99,20,22,26,311
  148.           DATA "Phase "       ,0,180,90,23, 3,371
  149.       
  150.       COLOR 1,10    
  151.       LOCATE TextRow(i),TextCol(i)                 'Print gadget titles.
  152.       PRINT nam$(i);
  153.       x1(i)=WINDOW(4)+11
  154.       y1(i)=WINDOW(5)-6
  155.       x2(i)=WINDOW(4)+BoxRight(i)
  156.       y2(i)=WINDOW(5)
  157.       LINE (x1(i)+4,y1(i)+1)-(x2(i)+4,y2(i)+1),14,bf   'Draw drop shadows
  158.                                                        'for gadgets.
  159.       GOSUB DrawControl
  160.  
  161.     NEXT
  162.   
  163.     LOCATE 23,8        ' Print degree character.
  164.     PRINT  CHR$(176);
  165.     
  166. RETURN
  167.  
  168.  
  169. '***** Draws control box for control gadgets
  170.  
  171. DrawControl:
  172.   LINE (x1(i),y1(i))-(x2(i),y2(i)),9,bf       'Draw gadget box.
  173.   X!=(Current(i)-min(i))/(max(i)-min(i))      'Calculate current slider
  174.   X!=x1(i)+X!*(x2(i)-x1(i))                   'position.
  175.   xx=INT(X!)
  176.   LINE (xx-1,y1(i))-(xx+1,y2(i)),2,bf         'Draw current slider.
  177.   RETURN
  178.   
  179.              
  180.    
  181. Demonstrate:         
  182.   
  183.     FOR j=0 TO 9
  184.         FOR i=0 TO 4
  185.         READ Current(i)        
  186.         GOSUB DrawControl
  187.         NEXT i
  188.         READ Cycles
  189.         
  190. '        XC     XF     YC     YF     Ph    Cycles
  191. DATA      0  ,  20  ,   0  ,  20  ,  45  ,  150
  192. DATA      0  ,  20  ,   0  ,  30  ,  90  ,  200
  193. DATA      4  ,   5  ,   4  ,   5  ,  60  ,  200
  194. DATA      4  ,  55  ,   4  ,  55  , 130  ,  400
  195. DATA      5  ,   5  ,   5  ,   2  , 160  ,  600
  196. DATA      5  ,  56  ,   6  ,  67  ,  90  ,  400
  197. DATA      3  ,  33  ,   6  ,  67  ,  90  ,  600
  198. DATA      7  ,  50  ,   4  ,  85  ,  90  ,  600
  199. DATA      8  ,  33  ,   3  ,  33  , 140  ,  600
  200. DATA      1  ,  96  ,   9  ,   2  ,  90  ,  400
  201.  
  202.                                 
  203. DemoSet:  LINE (LEdge,YTopLft)-(REdge,YBotRt),2,bf
  204.           Xfreq=Current(0)*100 + Current(1)
  205.           Yfreq=Current(2)*100 + Current(3)
  206.           Phase=Current(4)*1000/360
  207.           XAngle1=0:YAngle1=Phase
  208.              LOCATE TextRow(0),77
  209.              PRINT  USING "###";Xfreq;
  210.              LOCATE TextRow(2),77
  211.              PRINT  USING "###";Yfreq;
  212.              LOCATE TextRow(4),57
  213.              PRINT  USING "###";Current(4);
  214.         
  215.         FOR k=0 TO Cycles          
  216.         
  217. DemoScope: Xangle2=XAngle1+Xfreq
  218.              IF Xangle2>1000 THEN Xangle2=Xangle2-1000
  219.            YAngle2=YAngle1+Yfreq 
  220.              IF YAngle2>1000 THEN YAngle2=YAngle2-1000  
  221.            
  222.            LINE (X(XAngle1),Y(YAngle1))-(X(Xangle2),Y(YAngle2)),TraceColor
  223.           
  224.            XAngle1=Xangle2          
  225.            YAngle1=YAngle2
  226.            TraceColor=TraceColor+1
  227.            IF TraceColor>15 THEN TraceColor=4
  228.         NEXT k
  229.     NEXT j
  230.     RESTORE                                     'Reset DATA pointer.
  231.     answer=1
  232.     LINE (LEdge,YTopLft)-(REdge,YBotRt),2,bf    'Erase scope.
  233.     LOCATE 10,33
  234.     PRINT "Now you try it!"
  235.     FOR Wt=1 TO 10000:NEXT
  236.     GOTO start                                  'Start again without demo.
  237.                          
  238. 'This subprogram is taken from the March 1986 COMPUTE! magazine.
  239. RequesterSub:
  240. SUB Requester STATIC
  241.   SHARED request1$,request2$,answer: ' Global variables
  242.   'Add screen parameter (if needed) to next line.
  243.   WINDOW 3,"Program Request",(0,0)-(311,45),16,1
  244.   'The following lines truncate input if too long.
  245.   'If preferences is set for 60 columns,
  246.   'use maxwidth=INT(WINDOW(2)/10) for next line;
  247.   'otherwise use maxwidth=INT(WINDOW(2)/8).
  248.   maxwidth=INT(WINDOW(2)/8)
  249.   request1$=LEFT$(request1$,maxwidth)
  250.   request2$=LEFT$(request2$,maxwidth)
  251.   PRINT  request1$:PRINT  request2$
  252.   'This section draws buttons.
  253.   LINE (12,20)-(88,38),1,B
  254.   LINE (152,20)-(228,38),1,B
  255.   LOCATE 4,1:PRINT  PTAB(20);"DoIt";
  256.   PRINT  PTAB(160);"Demo"
  257.   'This section gets input.
  258.   reqloop:
  259.     WHILE MOUSE(0)=0:WEND:'Wait for button click.
  260.     m1=MOUSE(1):m2=MOUSE(2)
  261.     IF m1>12 AND m1<88 AND m2>20 AND m2<38 THEN
  262.       answer=1:'DoIt was selected.
  263.       LINE (12,20)-(88,38),1,bf:'Flash DoIt box.
  264.       WHILE MOUSE(0)<>0:WEND:'Wait for button release.
  265.       WINDOW CLOSE 3:EXIT SUB
  266.     ELSE
  267.       IF m1>152 AND m1<228 AND m2>20 AND m2<38 THEN
  268.         answer=0:'Demo was selected.
  269.         LINE (152,20)-(228,38),1,bf:'Flash Demo box.
  270.         WHILE MOUSE(0)<>0:WEND:'Wait for button release.
  271.         WINDOW CLOSE 3:EXIT SUB
  272.       ELSE
  273.         GOTO reqloop
  274.       END IF
  275.     END IF
  276.   GOTO reqloop
  277. END SUB
  278.       
  279.                 
  280.   
  281.    
  282.