Ellipse trace
#1
Hey all,

Excuse my messy code.   I've been playing around with this some more...I wanted to simulate using a string and two pins to draw an ellipse on paper.   I also wanted to rotate around in increments based on angle, which was tricky for me.   Got it working though, and then added more stuff after that.    Cheers.

Code: (Select All)
'ellipse trace
'james2464


Dim scx, scy As Integer

scx = 800
scy = 600

Screen _NewImage(scx, scy, 32)

Randomize Timer

Const PI = 3.141592654#

Dim c0(100) As Long

Dim x
Dim xx, yy

xx = scx / 2
yy = scy / 2


c0(0) = _RGB(0, 0, 0)
c0(1) = _RGB(25, 25, 25)
c0(2) = _RGB(255, 0, 0)
c0(3) = _RGB(0, 200, 100)
c0(4) = _RGB(0, 200, 150)
c0(5) = _RGB(0, 0, 255)
c0(6) = _RGB(255, 0, 0)
c0(7) = _RGB(255, 0, 255)
c0(8) = _RGB(125, 0, 255)
c0(9) = _RGB(0, 125, 255)
c0(10) = _RGB(255, 0, 125)




Cls

Locate 10, 10
Input "Ellipse Width (40-280) ? ", A
Locate 12, 10
Input "Ellipse Height (40-280) ?", B


Cls


If A > 280 Then A = 280
If A < 40 Then A = 40

If B > 280 Then B = 280
If B < 40 Then B = 40


If A >= B Then
    C = Sqr(A ^ 2 - B ^ 2)
    C1 = xx - C / 2
    C2 = xx + C / 2
    C3 = yy
    C4 = yy
Else
    C = Sqr(B ^ 2 - A ^ 2)
    C1 = xx
    C2 = xx
    C3 = yy - C / 2
    C4 = yy + C / 2
End If



'===== display axis lines
Line (0, yy)-(scx, yy), c0(1)
Line (xx, 0)-(xx, scy), c0(1)




'===== parameters
dv = .02 '              time delay value
d90 = 15 '              divisions per 90 degrees
pt = 2 '                point size aka circle size
cc1 = 1 '              line colour
cc2 = 4 '              line colour
di = 90 / d90
tg = 2




'======== main loop
Do
    'control panel
    Line (3, 8)-(115, 50), c0(3), BF
    Line (4, 10)-(114, 49), c0(0), BF

    Line (3, 51)-(115, 150), c0(3), BF
    Line (4, 52)-(114, 149), c0(0), BF

    Line (3, 151)-(115, 215), c0(3), BF
    Line (4, 152)-(114, 214), c0(0), BF

    Line (3, 151)-(115, 230), c0(3), BF
    Line (4, 152)-(114, 229), c0(0), BF

    Line (3, 231)-(115, 260), c0(3), BF
    Line (4, 232)-(114, 258), c0(0), BF


    Color c0(4)
    Locate 2, 3
    Print "Height:"; B
    Locate 3, 3
    Print "Width: "; A
    Locate 5, 3
    Color c0(9)
    Print "CONTROLS"
    Locate 6, 3
    Print "Height +: w"
    Locate 7, 3
    Print "Height -: s"
    Locate 8, 3
    Print "Width +:  d"
    Locate 9, 3
    Print "Width -:  a"
    Locate 11, 3
    Print "Tracing:  t"
    Locate 12, 3
    Print "Erase:    e"


    Locate 13, 3
    Print "Speed +:  k"
    Locate 14, 3
    Print "Speed -:  j"

    sp$ = "Speed: .###"
    Color c0(4)
    Locate 16, 3
    Print Using sp$; dv








    flag = di
    xold = 0
    yold = B
    j = 0
    lpexit = 0
    Do
        j = j + .01
        y = B - j
        x = Sqr((1 - y ^ 2 / B ^ 2) * A ^ 2)
        a42 = 0 - (Atn(x / y) * -57.2957795131)
        PSet (xx + x, yy - y), c0(2)
        If y > 0 Then
            If a42 >= flag Then
                If tg > 0 Then
                    Line (C1, C3)-(xx + xold, yy - yold), c0(cc1)
                    Line (C2, C4)-(xx + xold, yy - yold), c0(cc1)
                End If
                If tg = 2 Then
                    Line (C1, C3)-(xx + x, yy - y), c0(cc2)
                    Line (C2, C4)-(xx + x, yy - y), c0(cc2)
                End If
                Circle (xx + x, yy - y), pt, c0(2)
                _Delay dv
                flag = flag + di
                xold = x
                yold = y
            End If
        Else
            lpexit = 1
        End If
    Loop Until lpexit = 1

    If tg > 0 Then
        Line (C1, C3)-(xx + xold, yy - yold), c0(cc1)
        Line (C2, C4)-(xx + xold, yy - yold), c0(cc1)
    End If
    If tg = 2 Then
        Line (C1, C3)-(xx + A, yy - 0), c0(cc2)
        Line (C2, C4)-(xx + A, yy - 0), c0(cc2)
    End If
    Circle (xx + A, yy - 0), pt, c0(2)
    _Delay dv




    lpexit = 0
    flag = di
    xold = A
    yold = 0
    j = B
    Do
        j = j - .01
        If j > 0 Then
            y = B - j
            x = Sqr((1 - y ^ 2 / B ^ 2) * A ^ 2)
            a42 = 90 - (Atn(x / y) * 57.2957795131)
            PSet (xx + x, yy + y), c0(2)
            If a42 > flag Then
                If tg > 0 Then
                    Line (C1, C3)-(xx + xold, yy + yold), c0(cc1)
                    Line (C2, C4)-(xx + xold, yy + yold), c0(cc1)
                End If
                If tg = 2 Then
                    Line (C1, C3)-(xx + x, yy + y), c0(cc2)
                    Line (C2, C4)-(xx + x, yy + y), c0(cc2)
                End If
                Circle (xx + x, yy + y), pt, c0(2)
                _Delay dv
                flag = flag + di
                xold = x
                yold = y
            End If
        Else
            lpexit = 1
        End If
    Loop Until lpexit = 1


    If tg > 0 Then
        Line (C1, C3)-(xx + xold, yy + yold), c0(cc1)
        Line (C2, C4)-(xx + xold, yy + yold), c0(cc1)
    End If
    If tg = 2 Then
        Line (C1, C3)-(xx + 0, yy + B), c0(cc2)
        Line (C2, C4)-(xx + 0, yy + B), c0(cc2)
    End If
    Circle (xx + 0, yy + B), pt, c0(2)
    _Delay dv




    lpexit = 0
    flag = di
    j = 0
    xold = 0
    yold = B
    Do
        j = j + .01
        y = B - j

        x = Sqr((1 - y ^ 2 / B ^ 2) * A ^ 2)
        a42 = 0 - (Atn(x / y) * -57.2957795131)
        PSet (xx - x, yy + y), c0(2)
        If y > 0 Then
            If a42 >= flag Then
                If tg > 0 Then
                    Line (C1, C3)-(xx - xold, yy + yold), c0(cc1)
                    Line (C2, C4)-(xx - xold, yy + yold), c0(cc1)
                End If
                If tg = 2 Then
                    Line (C1, C3)-(xx - x, yy + y), c0(cc2)
                    Line (C2, C4)-(xx - x, yy + y), c0(cc2)
                End If
                Circle (xx - x, yy + y), pt, c0(2)
                _Delay dv
                flag = flag + di
                xold = x
                yold = y
            End If
        Else
            lpexit = 1
        End If
    Loop Until lpexit = 1




    If tg > 0 Then
        Line (C1, C3)-(xx - xold, yy + yold), c0(cc1)
        Line (C2, C4)-(xx - xold, yy + yold), c0(cc1)
    End If
    If tg = 2 Then
        Line (C1, C3)-(xx - A, yy + 0), c0(cc2)
        Line (C2, C4)-(xx - A, yy + 0), c0(cc2)
    End If
    Circle (xx - A, yy + 0), pt, c0(2)
    _Delay dv



    lpexit = 0
    flag = di
    j = B
    xold = A
    yold = 0
    Do
        j = j - .01
        If j > 0 Then
            y = B - j
            x = Sqr((1 - y ^ 2 / B ^ 2) * A ^ 2)
            a42 = 90 - (Atn(x / y) * 57.2957795131)
            PSet (xx - x, yy - y), c0(2)
            If a42 >= flag Then
                If tg > 0 Then
                    Line (C1, C3)-(xx - xold, yy - yold), c0(cc1)
                    Line (C2, C4)-(xx - xold, yy - yold), c0(cc1)
                End If
                If tg = 2 Then
                    Line (C1, C3)-(xx - x, yy - y), c0(cc2)
                    Line (C2, C4)-(xx - x, yy - y), c0(cc2)
                End If
                Circle (xx - x, yy - y), pt, c0(2)
                _Delay dv
                flag = flag + di
                xold = x
                yold = y
            End If
        Else
            lpexit = 1
        End If
    Loop Until lpexit = 1

    If tg > 0 Then
        Line (C1, C3)-(xx - xold, yy - yold), c0(cc1)
        Line (C2, C4)-(xx - xold, yy - yold), c0(cc1)
    End If
    If tg = 2 Then
        Line (C1, C3)-(xx - 0, yy - B), c0(cc2)
        Line (C1, C4)-(xx - 0, yy - B), c0(cc2)
    End If
    Circle (xx - 0, yy - B), pt, c0(2)
    _Delay dv


    '======================================================

    'adjust height using "w" and "s"
    'adjust width using "a" and "d"
    keypress$ = InKey$


    If keypress$ = Chr$(100) Then A = A + 5
    If keypress$ = Chr$(97) Then A = A - 5

    If keypress$ = Chr$(119) Then B = B + 5
    If keypress$ = Chr$(115) Then B = B - 5

    If keypress$ = Chr$(116) Then tg = tg + 1

    If tg > 2 Then tg = 0

    If keypress$ = Chr$(106) Then dv = dv * 2
    If keypress$ = Chr$(107) Then dv = dv / 2

    If dv > .16 Then dv = .16
    If dv < .002 Then dv = .002

    If keypress$ = Chr$(101) Then
        Line (xx - 290, yy - 290)-(xx + 290, yy + 290), c0(0), BF
        Line (0, yy)-(scx, yy), c0(1)
        Line (xx, 0)-(xx, scy), c0(1)
    End If

    If A > 280 Then A = 280
    If A < 40 Then A = 40

    If B > 280 Then B = 280
    If B < 40 Then B = 40

    If A >= B Then
        C = Sqr(A ^ 2 - B ^ 2)
        C1 = xx - C / 2
        C2 = xx + C / 2
        C3 = yy
        C4 = yy
    Else
        C = Sqr(B ^ 2 - A ^ 2)
        C1 = xx
        C2 = xx
        C3 = yy - C / 2
        C4 = yy + C / 2
    End If



Loop


End




[Image: ellipsetrace.png]
Reply
#2
Nice work!
b = b + ...
Reply
#3
(08-28-2022, 09:01 PM)bplus Wrote: Nice work!

Thanks!
Reply




Users browsing this thread: 1 Guest(s)