LISSAJOUS demo - FreeWare, listed 10-26-2005

   10 ' lissagw.bas - FREEWARE 2005
   20 GOTO 60 ' begin
   30 SAVE"lissagw.bas",A:LIST-40
   40 GOTO 610 ' wait for key
   50 GOTO 640 ' centered text
   60 SCREEN 9:CLS:PI=4*ATN(1):DEFSTR M,Q:Q=MKI$(0)
   70 DIM X(7,13),Y(7,13),EM(7),M(17),EX(100),EY(100)
   80 EM(1)=13:EM(2)=7:EM(3)=7:EM(4)=6:EM(5)=2:EM(6)=2:EM(7)=5
   90 M(1)="LISSAJOUS Figures idea from Hans Lauwerier"
  100 M(2)="GWBASIC by Eric Tchong"
  110 M(3)=" <1> Lissajous figure 1"
  120 M(4)=" <2> Lissajous figure 2"
  130 M(5)=" <3> Lissajous figure 3"
  140 M(6)=" <4> Cats              "
  150 M(7)=" <5> Fourier           "
  160 M(8)=" <6> Web               "
  170 M(9)=" <7> Diagonals         "
  180 M(10)=" <8> Star many angles  "
  190 M(11)=" <9> Astroide          "
  200 M(12)="<10> Cycloid          "
  210 M(13)="<11> Turnline         "
  220 M(14)="<12> Wirling square   "
  230 M(15)="Choose 1..10   -1 = stop program"
  240 M(16)="Press any key for menu..."
  250 FOR I=1 TO 15
  260  GOSUB 50
  270  IF I=2 OR I=14 THEN PRINT
  280 NEXT
  290 LOCATE 18,30:INPUT CH:IF CH=-1 THEN 460
  300 IF CH<1 OR CH>12 THEN 290
  310 ON CH GOTO 330,480,670,790,1010,1150,1250,1370,1490,1560,1710,1830

  320 ' first lissajous
  330 CLS:WINDOW (-2,-1.5)-(2,1.5)
  340 A=4/3:EM=15:N=22:F=.5
  350 S=N/EM:F=2*PI*F:H=.005:T=0
  360 LSET Q=MKI$(0)
  370 WHILE CVI(Q)=0
  380  X=A*SIN(T)
  390  Y=SIN(S*T+F)
  400  PSET (X, Y)
  410  MID$(Q,1)=INKEY$:IF CVI(Q) THEN 430
  420  T=T+H:IF T>2*EM*PI THEN 450
  430 WEND
  440 GOTO 360
  450 LOCATE 23,1:I=16:GOSUB 50:GOSUB 40:CLS:GOTO 250
  460 SCREEN 0,0,0:CLS:END

  470 ' second lissajous
  480 CLS:WINDOW (-2,-1.5)-(2,1.5)
  490 A=1:B=.5:S=2.45:T=0:H=.01
  500 LINE (-A-B-.1,-1.1)-(A+B+.1,1.1),,B
  510 LSET Q=MKI$(0)
  520 WHILE CVI(Q)=0
  530  X=A*COS(T)+B*COS(S*T)
  540  Y=SIN(T)
  550  IF T=0 THEN PSET (X,Y) ELSE LINE -(X,Y)
  560  MID$(Q,1)=INKEY$:IF CVI(Q) THEN 580
  570  T=T+H:IF T>315 THEN 450
  580 WEND
  590 GOTO 510

  600 ' wait for key
  610 LSET Q=MKI$(0)
  620 WHILE CVI(Q)=0:MID$(Q,1)=INKEY$:WEND:RETURN

  630 ' centered text
  640 X=(80-LEN(M(I)))/2
  650 PRINT TAB(X) M(I):RETURN

  660 ' third lissajous
  670 CLS:WINDOW (-3.2,-2.4)-(3.2,2.4)
  680 A=11/7:R=.6:H=.02:T=0
  690 LSET Q=MKI$(0)
  700 WHILE CVI(Q)=0
  710  X=COS(T):Y=SIN(T)
  720  X1=X+R*COS(A*T):Y1=Y+R*SIN(A*T)
  730  PSET (X1,Y1),14
  740  MID$(Q,1)=INKEY$:IF CVI(Q) THEN 760
  750  T=T+H:IF T>315 THEN 450
  760 WEND
  770 GOTO 690

  780 ' cats
  790 CLS:WINDOW (6,6)-(114,87):RESTORE
  800 FOR I=1 TO 7:FOR J=1 TO EM(I)
  810  READ X(I,J),Y(I,J)
  820 NEXT:NEXT
  830 FOR I=1 TO 6
  840  FOR J=1 TO 8
  850   FOR K=1 TO 7
  860    PSET (12*J+X(K,1),12*I+Y(K,1))
  870    FOR L=2 TO EM(K)
  880     LINE -(12*J+X(K,L),12*I+Y(K,L))
  890    NEXT
  900   NEXT
  910  NEXT
  920 NEXT
  930 GOSUB 40:CLS:GOTO 250
  940 DATA 0,0,-1,4,0,8,0,12,3,9,9,9,12
  950 DATA 12,12,8,11,4,12,0,9,-3,3,-3,0,0
  960 DATA 2,2,1.5,3,2.5,4,3.5,4,4,3.5,4,2,2,2
  970 DATA 8,2,8,3.5,8.5,4,9.5,4,10.5,3,10,2,8,2
  980 DATA 2,1,10,1,6,.6,6,-.5,6,.6,2,1,3,4,3,2.5,9,4,9,2.5
  990 DATA 2.5,-.5,4,-1.5,6,-1,8,-1.5,9.5,-.5

 1000 ' fourier
 1010 CLS:WINDOW (-8,-3)-(8,3)
 1020 FOR I=1 TO 8:B(I)=1/I:NEXT
 1030 JMAX=1000
 1040 LINE (-2*PI,0)-(2*PI,0)
 1050 FOR J=0 TO JMAX
 1060  X=-2*PI+4*PI*J/JMAX
 1070  S=0
 1080  FOR K=1 TO 8
 1090   S=S+B(K)*SIN(K*X)
 1100  NEXT
 1110  IF J=0 THEN PSET (X,S) ELSE LINE -(X,S)
 1120 NEXT
 1130 GOTO 450

 1140 ' web
 1150 CLS:WINDOW (-.2,-1.2)-(1.2,1.2):N=16
 1160 FOR I=0 TO N
 1170  FOR J=0 TO N
 1180   C=ABS(I-J)
 1190   X1=I/N:Y1=1:X2=J/N:Y2=-1
 1200   IF C MOD 2 = 1 THEN LINE (X1,Y1)-(X2,Y2),C
 1210  NEXT
 1220 NEXT
 1230 GOTO 930

 1240 ' diagonals
 1250 CLS:WINDOW (-1.6,-1.2)-(1.6,1.2):N=17
 1260 FOR K=1 TO N
 1270  EX(K)=COS(2*K*PI/N)
 1280  EY(K)=SIN(2*K*PI/N)
 1290 NEXT
 1300 FOR I=1 TO N
 1310  FOR J=1 TO I-1
 1320   LINE (EX(I),EY(I))-(EX(J),EY(J))
 1330  NEXT
 1340 NEXT
 1350 GOTO 930

 1360 ' star many angles
 1370 CLS:WINDOW (-1.6,-1.2)-(1.6,1.2)
 1380 N=33:P=11:EQ=17
 1390 FOR K=0 TO N-1
 1400  EX(K)=COS(2*K*PI/N)
 1410  EY(K)=SIN(2*K*PI/N)
 1420 NEXT
 1430 FOR I=P TO EQ:FOR J=0 TO N-1
 1440  K=(I+J) MOD N
 1450  LINE (EX(J),EY(J))-(EX(K),EY(K))
 1460 NEXT:NEXT
 1470 GOTO 930

 1480 ' astroide
 1490 CLS:WINDOW (-1.6,-1.2)-(1.6,1.2):N=64
 1500 FOR I=0 TO N-1
 1510  T=2*PI*I/N
 1520  LINE (COS(T),0)-(0,SIN(T))
 1530 NEXT
 1540 GOTO 930

 1550 ' cycloid
 1560 CLS:EPS=.0001:WINDOW (-1.6,-1.2)-(1.6,1.2)
 1570 K=1:L=3:A=.8:N=80:LINE (-1,-1)-(1,1),,B
 1580 FOR J=0 TO N
 1590  T=2*PI*L*J/N
 1600  A1=COS(T):B1=SIN(T)
 1610  A2=COS(K*T/L):B2=SIN(K*T/L+EPS)
 1620  P=B1-B2:EQ=A1-A2:R=(A1*B2-A2*B1)*A:S=1
 1630  IF ABS(EQ-R)<=ABS(P) THEN U(S)=(EQ-R)/P:V(S)=-1:S=S+1
 1640  IF ABS(EQ+R)<=ABS(P) THEN U(S)=-(EQ+R)/P:V(S)=1:S=S+1
 1650  IF ABS(P-R)<ABS(EQ) THEN U(S)=-1:V(S)=(P-R)/EQ:S=S+1
 1660  IF ABS(P+R)<ABS(EQ) THEN U(S)=1:V(S)=-(P+R)/EQ:S=S+1
 1670  LINE (U(1),V(1))-(U(2),V(2))
 1680 NEXT
 1690 GOTO 930

 1700 ' turnline
 1710 CLS:WINDOW (-2,-1.5)-(2,1.5)
 1720 A=.4:B=6:R=.6:N=256:EM=3
 1730 FOR K=0 TO EM-1
 1740  FOR L=0 TO N-1
 1750   RK=R^K:T1=2*L*PI/N:T2=B*L*PI/N
 1760   X0=RK*COS(T1):Y0=RK*SIN(T1)
 1770   X1=A*RK*COS(T2):Y1=A*RK*SIN(T2)
 1780   LINE (X0-X1,Y0-Y1)-(X0+X1,Y0+Y1)
 1790  NEXT 
 1800 NEXT
 1810 GOTO 930

 1820 ' wirling square
 1830 CLS:WINDOW (-1.6,-1.2)-(1.6,1.2):P=4:B=.05
 1840 A=PI*(1-2/P):C=SIN(A)/(SIN(B)+SIN(A+B))
 1850 FOR K=0 TO P
 1860  T=(2*K+1)*PI/P
 1870  EX(K)=SIN(T):EY(K)=COS(T)
 1880 NEXT
 1890 FOR N=1 TO 64
 1900  PSET (EX(0),EY(0))
 1910   FOR L=1 TO P
 1920    LINE -(EX(L),EY(L))
 1930   NEXT
 1940   FOR EM=0 TO P
 1950    Z=EX(EM)
 1960    EX(EM)=(EX(EM)*COS(B)-EY(EM)*SIN(B))*C
 1970    EY(EM)=(Z*SIN(B)+EY(EM)*COS(B))*C
 1980   NEXT
 1990 NEXT
 2000 GOTO 450