ovals and eggs

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

ovals and eggs

Post by BasicCoder2 »

Some time ago I posted code to draw and rotate ovals this is an updated version that also has a start and end angle. I used the start and end angles to draw an egg like shape. You can rotate this "egg" with the space bar. Note I use degrees not radians.

Code: Select all

 'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radians

screenres 640,480,32

dim shared as single ww  'angle of rotation in degrees

sub drawOval(cx as integer, cy as integer, ww as double, r1 as double, r2 as double, cc as ulong, angle1 as double, angle2 as double)
    
    dim as double dx,dy
    dim as integer x1,y1,x2,y2
    dim as double steps
    'compute minimum pixels for circle for maximum radius
    if r1>r2 then
        steps = 360/(r1*TwoPi)
    else
        steps = 360/(r2*TwoPi)
    end if
    'circle center
    circle (cx,cy),5,rgb(0,0,255)
    for angle as double = angle1*DtoR to angle2*DtoR step steps*DtoR
        dx = Cos(angle)
        dy = Sin(angle)
        x1 = dx*r1
        y1 = dy*r2
       ' rotate around cx,cy
        x2 = Cos(ww*DtoR) * x1 - Sin(ww*DtoR) * y1
        y2 = Cos(ww*DtoR) * y1 + Sin(ww*DtoR) * x1    
        pset (x2+cx,y2+cy),cc
    next angle
end sub

do
    
    if inkey=" " then
        ww = ww + 1
        if ww>259 then ww = 360-ww
    end if
    
    screenlock
    cls
    locate 2,2
    print "PRESS SPACE BAR TO ROTATE EGG"
    drawOval(320,240,ww,100,100,rgb(255,0,0),0,180)
    drawOval(320,240,ww,100,200,rgb(0,255,0),180,360)
    screenunlock
    
    sleep 2
loop until multikey(&H01)

neil
Posts: 555
Joined: Mar 17, 2022 23:26

Re: ovals and eggs

Post by neil »

Maybe there's another method to draw the golden spiral.

Code: Select all

Screenres 600,500
Color 15
Cls
Dim as Single x1,x2,y1,y2,i,a,b,c
Dim As String s

x1 = 250
y1 = 320
x2 = 240
y2 = 310

a = 1
b = 2
s = "ASDW"
CIRCLE (x2, y1), a * 10, , , 11 / 7
FOR i = 1 TO 10
    x1 = x2
    y1 = y2
    IF MID(s, i, 1) = "A" THEN
        x2 = x2 - (a * 10)
        y2 = y2 + (a * 10)
        CIRCLE (x1, y2), a * 10, , 11 / 7, 22 / 7
    ELSEIF MID(s, i, 1) = "S" THEN
        x2 = x2 + (a * 10)
        y2 = y2 + (a * 10)
        CIRCLE (x2, y1), a * 10, , 22 / 7, 66 / 14
    ELSEIF MID(s, i, 1) = "D" THEN
        x2 = x2 + (a * 10)
        y2 = y2 - (a * 10)
        CIRCLE (x1, y2), a * 10, , 66 / 14
    ELSE
        x2 = x2 - (a * 10)
        y2 = y2 - (a * 10)
        CIRCLE (x2, y1), a * 10, , , 11 / 7
    END IF
    s = s + s
    c = a + b
    a = b
    b = c
NEXT i
sleep
END
Post Reply