+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Ellipse trace (/showthread.php?tid=824)
Ellipse trace - james2464 - 08-28-2022
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]](https://i.ibb.co/DQXjKkH/ellipsetrace.png)
RE: Ellipse trace - bplus - 08-28-2022
Nice work!
RE: Ellipse trace - james2464 - 08-28-2022
(08-28-2022, 09:01 PM)bplus Wrote: Nice work!
Thanks!