home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
071.lha
/
Lissajoo.BAS
< prev
next >
Wrap
BASIC Source File
|
1980-07-10
|
9KB
|
282 lines
' LISSAJOUS ---- This AmigaBASIC program allows the user to produce both
' "classical" and "aliased" Lissajous figures. Aliased
' patterns are seen on a digital oscilloscope when the
' sampling rate used is too low for the frequencies
' at the inputs.
'
'This program was written by Clark Leslie ( CI$ [74030,1162] ) October 1987.
'It is placed into the public domain and may be freely distributed.
DEFINT a-Z
DIM X(1000),Y(1000)
XWidth=340:XCenter=320
YWidth=152:YCenter=79
PI!=3.1416
PIx2!=PI!*2
TraceColor=4
HalfXWidth=XWidth/2
HalfYWidth=YWidth/2
XTopLft=XCenter-HalfXWidth-1
YTopLft=YCenter-HalfYWidth-1
XBotRt=XCenter+HalfXWidth+1
YBotRt=YCenter+HalfYWidth+1
LEdge=18
REdge=614
'***** Digitize sine waves and normalize to screen window.
CLS
PRINT
PRINT "Please wait while I calculate 1000 sine values."
LOCATE 10,36
PRINT "LISSAJOUS"
LOCATE 11,39
PRINT "by"
LOCATE 12,34
PRINT "Clark Leslie"
FOR Alpha!=0 TO PIx2! STEP PIx2!/1000 'The 1000 elements of arrays
SinAlpha!=SIN(Alpha!) 'X() & Y() represent a sine
X(Angle)= HalfXWidth*SinAlpha!+XCenter 'wave from 0 to 360°.
Y(Angle)= -1*HalfYWidth*SinAlpha!+YCenter 'Y is minus for +Y up.
Angle=Angle+1
NEXT Alpha!
X(1000)=X(0):Y(1000)=Y(0)
'***** Set up screen
SCREEN 1,640,200,4,2
WINDOW 2,"Lissajous",,12,1
request1$="Click on DoIt to control scope."
request2$="Click on Demo to see demo first."
CALL Requester
start:
GOSUB GetColors
GOSUB InitScope
IF answer=0 THEN Demonstrate
Set: LINE (LEdge,YTopLft)-(REdge,YBotRt),2,bf 'Erase scope screen.
Xfreq=Current(0)*100 + Current(1) 'Current() holds either
Yfreq=Current(2)*100 + Current(3) 'default values or new
Phase=Current(4)*1000/360 'values from mouse.
XAngle1=0:YAngle1=Phase
LOCATE TextRow(0),77 'Print current values.
PRINT USING "###";Xfreq;
LOCATE TextRow(2),77
PRINT USING "###";Yfreq;
LOCATE TextRow(4),57
PRINT USING "###";Current(4);
Scope: Xangle2=XAngle1+Xfreq 'Sample rates (X&Yfreq)
IF Xangle2>1000 THEN Xangle2=Xangle2-1000 'are added to current
YAngle2=YAngle1+Yfreq 'position in array.
IF YAngle2>1000 THEN YAngle2=YAngle2-1000
LINE (X(XAngle1),Y(YAngle1))-(X(Xangle2),Y(YAngle2)),TraceColor
XAngle1=Xangle2 'Make last endpoint next
YAngle1=YAngle2 'start point.
TraceColor=TraceColor+1 'Draw each segment in a
IF TraceColor>15 THEN TraceColor=4 'different color.(Leave
'system colors 0-3 alone.)
'***** This mouse routine adapted from the Speech Demo.
WHILE MOUSE(0)<>0 'This executes if mouse
mouseX=MOUSE(1) 'left button pushed.
mouseY=MOUSE(2)
FOR i=0 TO 4 'For each gadget, see if
IF mouseX>=x1(i) AND mouseX<=x2(i) THEN 'pointer is in box.
IF mouseY>=y1(i) AND mouseY<=y2(i) THEN
v!=(mouseX-x1(i))/(x2(i)-x1(i)) 'Find relative position.
Current(i)=min(i)+v!*(max(i)-min(i)) 'Convert to value.
GOSUB DrawControl 'Redraw slider position.
END IF
END IF
NEXT i
GOTO Set 'Got new value, start
WEND 'over.
GOTO Scope 'No click, so continue.
' ==================== SUBROUTINES =========================
GetColors:
FOR i=4 TO 15
READ R!,G!,B!
PALETTE i,R!,G!,B!
NEXT
RETURN
' Red Grn Blue
4 DATA 1.00, 0.00, 0.00
5 DATA 0.93, 0.33, 0.00
6 DATA 0.73, 0.47, 0.00
7 DATA 1.00, 1.00, 0.00
8 DATA 0.60, 0.80, 0.00
9 DATA 0.00, 0.60, 0.00
10 DATA 0.00, 0.40, 0.20
11 DATA 0.00, 0.53, 1.00
12 DATA 0.00, 0.00, 0.67
13 DATA 0.53, 0.00, 0.47
14 DATA 0.33, 0.00, 0.00
15 DATA 0.60, 0.33, 0.00
InitScope:
LINE (0,0)-(639,199),10,bf 'Fill entire window.
FOR i=0 TO 4
READ nam$(i),min(i),max(i),Current(i) 'Set up defaults for
READ TextRow(i),TextCol(i),BoxRight(i) 'gadgets.
DATA "X Freq-Coarse",0, 9, 0,21, 3,61
DATA "X Freq-Fine" ,0, 99,20,21,26,311
DATA "Y Freq-Coarse",0, 9, 0,22, 3,61
DATA "Y Freq-Fine" ,0, 99,20,22,26,311
DATA "Phase " ,0,180,90,23, 3,371
COLOR 1,10
LOCATE TextRow(i),TextCol(i) 'Print gadget titles.
PRINT nam$(i);
x1(i)=WINDOW(4)+11
y1(i)=WINDOW(5)-6
x2(i)=WINDOW(4)+BoxRight(i)
y2(i)=WINDOW(5)
LINE (x1(i)+4,y1(i)+1)-(x2(i)+4,y2(i)+1),14,bf 'Draw drop shadows
'for gadgets.
GOSUB DrawControl
NEXT
LOCATE 23,8 ' Print degree character.
PRINT CHR$(176);
RETURN
'***** Draws control box for control gadgets
DrawControl:
LINE (x1(i),y1(i))-(x2(i),y2(i)),9,bf 'Draw gadget box.
X!=(Current(i)-min(i))/(max(i)-min(i)) 'Calculate current slider
X!=x1(i)+X!*(x2(i)-x1(i)) 'position.
xx=INT(X!)
LINE (xx-1,y1(i))-(xx+1,y2(i)),2,bf 'Draw current slider.
RETURN
Demonstrate:
FOR j=0 TO 9
FOR i=0 TO 4
READ Current(i)
GOSUB DrawControl
NEXT i
READ Cycles
' XC XF YC YF Ph Cycles
DATA 0 , 20 , 0 , 20 , 45 , 150
DATA 0 , 20 , 0 , 30 , 90 , 200
DATA 4 , 5 , 4 , 5 , 60 , 200
DATA 4 , 55 , 4 , 55 , 130 , 400
DATA 5 , 5 , 5 , 2 , 160 , 600
DATA 5 , 56 , 6 , 67 , 90 , 400
DATA 3 , 33 , 6 , 67 , 90 , 600
DATA 7 , 50 , 4 , 85 , 90 , 600
DATA 8 , 33 , 3 , 33 , 140 , 600
DATA 1 , 96 , 9 , 2 , 90 , 400
DemoSet: LINE (LEdge,YTopLft)-(REdge,YBotRt),2,bf
Xfreq=Current(0)*100 + Current(1)
Yfreq=Current(2)*100 + Current(3)
Phase=Current(4)*1000/360
XAngle1=0:YAngle1=Phase
LOCATE TextRow(0),77
PRINT USING "###";Xfreq;
LOCATE TextRow(2),77
PRINT USING "###";Yfreq;
LOCATE TextRow(4),57
PRINT USING "###";Current(4);
FOR k=0 TO Cycles
DemoScope: Xangle2=XAngle1+Xfreq
IF Xangle2>1000 THEN Xangle2=Xangle2-1000
YAngle2=YAngle1+Yfreq
IF YAngle2>1000 THEN YAngle2=YAngle2-1000
LINE (X(XAngle1),Y(YAngle1))-(X(Xangle2),Y(YAngle2)),TraceColor
XAngle1=Xangle2
YAngle1=YAngle2
TraceColor=TraceColor+1
IF TraceColor>15 THEN TraceColor=4
NEXT k
NEXT j
RESTORE 'Reset DATA pointer.
answer=1
LINE (LEdge,YTopLft)-(REdge,YBotRt),2,bf 'Erase scope.
LOCATE 10,33
PRINT "Now you try it!"
FOR Wt=1 TO 10000:NEXT
GOTO start 'Start again without demo.
'This subprogram is taken from the March 1986 COMPUTE! magazine.
RequesterSub:
SUB Requester STATIC
SHARED request1$,request2$,answer: ' Global variables
'Add screen parameter (if needed) to next line.
WINDOW 3,"Program Request",(0,0)-(311,45),16,1
'The following lines truncate input if too long.
'If preferences is set for 60 columns,
'use maxwidth=INT(WINDOW(2)/10) for next line;
'otherwise use maxwidth=INT(WINDOW(2)/8).
maxwidth=INT(WINDOW(2)/8)
request1$=LEFT$(request1$,maxwidth)
request2$=LEFT$(request2$,maxwidth)
PRINT request1$:PRINT request2$
'This section draws buttons.
LINE (12,20)-(88,38),1,B
LINE (152,20)-(228,38),1,B
LOCATE 4,1:PRINT PTAB(20);"DoIt";
PRINT PTAB(160);"Demo"
'This section gets input.
reqloop:
WHILE MOUSE(0)=0:WEND:'Wait for button click.
m1=MOUSE(1):m2=MOUSE(2)
IF m1>12 AND m1<88 AND m2>20 AND m2<38 THEN
answer=1:'DoIt was selected.
LINE (12,20)-(88,38),1,bf:'Flash DoIt box.
WHILE MOUSE(0)<>0:WEND:'Wait for button release.
WINDOW CLOSE 3:EXIT SUB
ELSE
IF m1>152 AND m1<228 AND m2>20 AND m2<38 THEN
answer=0:'Demo was selected.
LINE (152,20)-(228,38),1,bf:'Flash Demo box.
WHILE MOUSE(0)<>0:WEND:'Wait for button release.
WINDOW CLOSE 3:EXIT SUB
ELSE
GOTO reqloop
END IF
END IF
GOTO reqloop
END SUB