'ellipse180802 'john.erich.ebner@gmail.com 'r = a*(1-e^2)/(1+(e*cos(ang))) '1-e^2 = (1+e)*(1-e) 'dr = (r1-r)/dtime 'right focus if ang = 0 r=a(1-e) 'left focus if ang = pi r=a(1+e) 'dtime = time per wedge or dArea 'third side by law of cosines = 'side = sqr(r^2+r1^2 - 2*r*r1*cos(anginc)) 'dside=(side1-side):dside/dtime = velocity 'area law of sines = 'areainc = r*r1*.5*sin(anginc) 'approx segment area also ok 'sin(anginc)= anginc since anginc is small 'd=((r+r1)*.5)^2*.5*anginc 'x = r*sin(ang)+x0 'y = r*cos(ang)+y0 mainwin 86 12 'nomainwin WindowWidth = 700 WindowHeight = 720 wedges=23 open "ellipse180802" for graphics as #1 gosub [datetime] z=wedges+2 dim a(z):dim r(z):dim s(z):dim t(z) dim a1(z):dim r1(z):dim ab(z):dim rb(z) #1, "color black ; down ; size 1 " '#1, "rule "; _R2_NOTXORPEN c=0:gosub [ellipsesub] gosub [saveas] goto [exit] '********************************* [ellipsesub] gosub [constants] gosub [body] gosub [savSmall] gosub [savBig] gosub [spokebig] gosub [spokesmall] gosub [perimeter] 'for k =0 to 2 gosub [dots] 'next k return '********************************* [constants] a=300 e = 0 'eccentricity .5 and wedges 21 dot=23 lildot=4 mult=.2'size of small ellipse pi = asn(1)*2 eccy = sqr(1 - e^2) b=a*eccy y0=b+30 ellipse=pi*a*b wedge=ellipse/wedges 'wedges wedgedivider=1000 dArea=wedge/wedgedivider '#1 "font auriel 14 " #1 "font courier 14 " #1 "color black ; backcolor white " #1 "place ";x0-a*(1+e)-20;" ";y0-b+10' #1 "\ wedges = ";wedges #1 "\ a = ";a #1 "\ e = ";e if c = 0 then x0=a*(1+e)+30 'if c = 1 then x0=a*(1+e)+30:e=.7 'if c = 2 then x0=x0+2*a+30:e=.5 'if c = 3 then x0=x0+2*a+30:e=.2 print "a = ";a;" b = ";b;" pi*a*b = ellipse = ";ellipse print " wedges = ";wedges;" wedge = ";wedge;" anginc = ";anginc return '************************************************** [body] ang(0)=0:z=0:n=0:sumsides=0 r = a*(1 - e^2)/(1 + (e*cos(ang))) 'right focus ang 0 r(0)=r do n=n+1 'wedge counter do r1= a*(1 - e^2)/(1 + (e*cos(ang))) 'ang varies dAng=asn(dArea/(r*r1*.5)) 'third dSide=sqr(r^2+r1^2 - 2*r*r1*cos(dAng)) ang=ang+dAng wedgesum=wedgesum+dArea sumsides=sumsides+dSide z=z+1:rold=r:r1old=r1:r=r1 loop while wedge>wedgesum+.1'loop to increment ang and wedgesum wedgesum=0 a(n)=ang:r(n)=r:t(n)=sumsides:s(n)=t(n)-t(n-1) 'assign a(n) r(n) loop while ellipse>wedge*n+.1 'loop to increment wedge counter print "body wedgedivider ";wedgedivider;" * wedges = "; wedges*wedgedivider print "constant area segments";" sumsides = ";sumsides;" dArea = ";dArea;" pixels^2" print "dAng = ";dAng;" degrees = ";dAng*57.3 return '************************************************** [perimeter] n=0 ang=0 sumsides=0 'calc r r = a*(1 - e^2)/(1 + (e*cos(ang))) 'right focus with ang 0 #1 "place "; r*cos(ang)+x0;" "; r*sin(ang)+y0 'place on a circle of r radius while r varies with ang #1 "color lightgray ; circlefilled 5 " do n=n+1 'wedge counter do r1= a*(1 - e^2)/(1 + (e*cos(ang))) 'ang varies dAng=asn(dArea/(r*r1*.5)) dSide=sqr(r^2+r1^2 - 2*r*r1*cos(dAng)) wedgesum=wedgesum+dArea sumsides=sumsides+dSide #1 "goto "; r*cos(ang)+x0;" "; r*sin(ang)+y0 ang=ang+dAng z=z+1:rold=r:r1old=r1:r=r1 loop while wedge>wedgesum+.1'loop to wedgesum=wedgesum-wedge 'print "ang = ";ang; " rold = ";rold;" r1 = ";r1 loop while ellipse>wedge*n 'loop to increment wedge counter return '************************************************** [savSmall] for n=0 to wedges a1(n)=a(n)-pi r1(n)=r(n)*mult 'print "savSmall n = ";n;" a1(n)= ";a1(n);" r1(n)= ";r1(n) next n return '************************************************** [savBig] for n=0 to wedges ab(n)=a(n)-pi rb(n)=r(n) 'print "savBig n= ";n;" ab(n)= ";ab(n);" rb(n)= ";rb(n) next n return '************************************************** [dots] DefaultDir\$ = "C:\Users\asus\Desktop\wav" '#1, "cls " n=1 w=665:h=665 '[dodots] 'replace second "place" with "goto" to draw connecting dipoles while n<=wedges #1 "place "; r(n)*cos(a(n))+x0;" "; r(n)*sin(a(n))+y0 'for zzz=1 to 1e6:next zzz #1 "color red ; backcolor red ;circlefilled";" ";dot #1 "place "; r1(n)*cos(a1(n))+x0;" "; r1(n)*sin(a1(n))+y0 #1 "color blue ; backcolor blue ; circlefilled";" ";lildot playwave "C:\Users\asus\Desktop\wav\tic.wav " 'playwave "C:\Users\asus\Desktop\wav\t220.wav " goto [e1]'tick to erase dots 'gosub [saveinc] 'these next four lines erase the dots #1 "place "; r(n)*cos(a(n))+x0;" "; r(n)*sin(a(n))+y0 #1 "color red ; backcolor red ; circlefilled";" ";dot #1 "place "; r1(n)*cos(a1(n))+x0;" "; r1(n)*sin(a1(n))+y0 #1 "color blue ; backcolor blue ; circlefilled";" ";lildot [e1] n=n+1 wend playwave "" return '************************************************** [spokebig] s=1 '#1 "color lightgray" #1 "color red" while s<=wedges #1 " place ";x0;" "; y0 #1 " goto "; r(s)*cos(a(s))+x0;" "; r(s)*sin(a(s))+y0 s=s+1 for zzz=0 to 25000:next zzz '#1 "color lightgray" #1 "color red" wend return '************************************************** [spokesmall] '#1 "color lightgray" #1 "color blue" s=0 while r(s)>0 #1 "place ";x0;" "; y0 #1 "goto "; r1(s)*cos(a1(s))+x0;" "; r1(s)*sin(a1(s))+y0 s=s+1 wend '#1 "color lightgray" #1 "color red" return '************************************************** [focusdots] '#1 "circle "; 2*a #1 "backcolor blue" #1 "place "; x0 ;" "; y0'right focus #1 "circlefilled 5"; #1 "backcolor red" '#1 "place "; x0-(2*a*e) ; " " ; y0 ;'left focus '#1 "circlefilled 5 "; return '************************************************** [exit] #1 "flush " 'gosub [saveas] wait '#1, "discard" 'no redraw info kept close #1 end '************************************************** [datetime] print "DefaultDir\$ = ";DefaultDir\$ print date\$("yyyy/mm/dd") yy\$=mid\$(date\$("yyyy/mm/dd"),3,2) mm\$=mid\$(date\$("yyyy/mm/dd"),6,2) dd\$=mid\$(date\$("yyyy/mm/dd"),9,2) print "time\$()=",time\$() hr\$=left\$(time\$(),2) mi\$=mid\$(time\$(),4,2) se\$=right\$(time\$(),2) ss\$="." filename\$="ellipse"+yy\$+mm\$+dd\$+ss\$+hr\$+mi\$+se\$ print "filename\$=",filename\$ 'ellipse170209 return '************************************************** [saveas] h=660:v=660 #1 "getbmp drawing 1 1 "; h;" ";v #1 "place 1 1 "; #1 "box "; h; " "; v; #1 "flush" filedialog "Save as...", filename\$, filename\$ if filename\$ = "" then wait filename\$ = filename\$ + ".bmp" bmpsave "drawing", filename\$ return '************************************************** [saveinc] ' w=1080:h=490 #1 "getbmp drawing 1 1 "; w;" ";h '#1 "drawbmp drawing "; w ;" ";1;" ";w;" ";h '#1 "getbmp drawing 1 1 "; w+w;" ";h '#1 "place 0 0" '#1 "box ";w;" ";h 'makes blinks in image ctr\$= str\$(ctr):ctr\$="000"+ctr\$:ctr\$=right\$(ctr\$,3) filename\$ = "oval" +ctr\$+ ".bmp" 'if filename\$ = "" then wait 'filedialog "Save as...", ".bmp", filename\$ bmpsave "drawing", filename\$ unloadbmp "drawing" ctr=ctr+1 return '**************************************************