Posts: 3,563
Threads: 164
Joined: Apr 2022
Reputation:
171
Oh look it's almost that time of the month!
Code: (Select All) _Title "Halloween Time" 'B+ 2019-10-22
' 2019-10-23 attempt to change transparency gradually to loose blinking
Const m = 350
Screen _NewImage(720, 720, 32)
_ScreenMove 500, 10
Dim Shared sprt(15, 15)
For y = 0 To 15
For x = 0 To 15
Read sprt(x, y)
Next
Next
Dim Shared sprt2(15, 15)
For y = 0 To 15
For x = 0 To 15
Read sprt2(x, y)
Next
Next
Dim Shared bx, by, bf
dt = 1
Do
Cls
'angles
hour% = Int(t# / 3600)
If hour% > 12 Then showHr# = t# / 3600 - 12 Else showHr# = t# / 3600
min# = t# / 60 - hour% * 60
sec# = t# - hour% * 3600 - Int(min#) * 60
'face
For r = 340 To 0 Step -1
If r < 150 Then
c~& = _RGB32(200 - 50 * r / 100, 150 - 100 * r / 100, 0)
Else
c~& = _RGB32(200 - 50 * r / 100, 150 - 100 * r / 100, 40 - r / 340)
End If
fcirc m, m, r, c~&
Next
For i = 0 To 59
If i Mod 5 = 0 Then r = 2 Else r = 1
Circle (350 + 330 * Cos(i * _Pi(2 / 60)), 350 + 330 * Sin(i * _Pi(2 / 60))), r
Next
'some triangles
t = t + dt
If t > 180 Then dt = -dt: t = 180
If t < 1 Then dt = -dt: t = 1
ry~& = _RGBA32(255, 255, 140, t)
ftri 290, 335, 305, 365, 335, 350, ry~&
ftri 410, 335, 395, 365, 365, 350, ry~&
ftri 330, 380, 350, 360, 370, 380, ry~&
ftri 290, 420, 350, 400, 350, 410, ry~&
ftri 410, 420, 350, 400, 350, 410, ry~&
fcirc m, m, 150, ry~& 'more orange glow
'arms and legs
x1 = 210 * Cos(showHr# * _Pi(2 / 12) - _Pi / 2)
y1 = 210 * Sin(showHr# * _Pi(2 / 12) - _Pi / 2)
x2 = 260 * Cos(min# * _Pi(2 / 60) - _Pi / 2)
y2 = 260 * Sin(min# * _Pi(2 / 60) - _Pi / 2)
Line (m, m)-Step(x1, y1), _RGB32(255, 255, 255, 50)
Line (m, m)-Step(x2, y2), _RGB32(255, 255, 255, 50)
drawSpinner m + x1, m + y1, .5, _Atan2(y1, x1), &HFF331800
drawSpinner m + x2, m + y2, .3, _Atan2(y2, x2), &HFF221100
'seconds fly by...
bx = 350 + 290 * Cos(sec# * _Pi(2 / 60) - _Pi / 2)
by = 350 + 290 * Sin(sec# * _Pi(2 / 60) - _Pi / 2)
drawb
_Display
_Limit 5
t# = Timer
Loop Until _KeyDown(27)
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,1,1,0,0,0,0,0,0,0,1,1,0,0,0
Data 1,1,0,0,1,0,0,1,0,0,1,0,0,1,1,0
Data 0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0
Data 0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0
Data 0,0,0,0,1,0,1,1,1,0,0,1,0,0,0,0
Data 0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0
Data 0,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0
Data 0,1,0,0,0,0,0,0,0,0,0,0,0,0,1,0
Data 0,1,0,0,0,0,0,0,0,0,0,0,0,0,1,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Sub drawb
bf = (bf + 1) Mod 5
sz = 3
If bf = 0 Then
For y = 0 To 15
For x = 0 To 15
If sprt2(x, y) Then Line (x * sz + bx - 7.5 * sz, .5 * y * sz + by - 7.5 * sz)-Step(sz, sz), _RGB32(0, 0, 0), BF
Next
Next
Else
For y = 0 To 15
For x = 0 To 15
If sprt(x, y) Then Line (x * sz + bx - 7.5 * sz, y * sz + by - 7.5 * sz)-Step(sz, sz), _RGB32(0, 0, 0), BF
Next
Next
End If
End Sub
Sub drawSpinner (x As Integer, y As Integer, scale As Single, heading As Single, c As _Unsigned Long)
Dim x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd, red, blue, green
Static switch As Integer
switch = switch + 2
switch = switch Mod 16 + 1
red = _Red32(c): green = _Green32(c): blue = _Blue32(c)
r = 10 * scale
x1 = x + r * Cos(heading): y1 = y + r * Sin(heading)
r = 2 * r 'lg lengths
For lg = 1 To 8
If lg < 5 Then
a = heading + .9 * lg * _Pi(1 / 5) + (lg = switch) * _Pi(1 / 10)
Else
a = heading - .9 * (lg - 4) * _Pi(1 / 5) - (lg = switch) * _Pi(1 / 10)
End If
x2 = x1 + r * Cos(a): y2 = y1 + r * Sin(a)
drawLink x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(red + 20, green + 10, blue + 5)
If lg = 1 Or lg = 2 Or lg = 7 Or lg = 8 Then d = -1 Else d = 1
a1 = a + d * _Pi(1 / 12)
x3 = x2 + r * 1.5 * Cos(a1): y3 = y2 + r * 1.5 * Sin(a1)
drawLink x2, y2, 2 * scale, x3, y3, scale, _RGB32(red + 35, green + 17, blue + 8)
rd = Int(Rnd * 8) + 1
a2 = a1 + d * _Pi(1 / 8) * rd / 8
x4 = x3 + r * 1.5 * Cos(a2): y4 = y3 + r * 1.5 * Sin(a2)
drawLink x3, y3, scale, x4, y4, scale, _RGB32(red + 50, green + 25, blue + 12)
Next
r = r * .5
fcirc x1, y1, r, _RGB32(red - 20, green - 10, blue - 5)
x2 = x1 + (r + 1) * Cos(heading - _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading - _Pi(1 / 12))
fcirc x2, y2, r * .2, &HFF000000
x2 = x1 + (r + 1) * Cos(heading + _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading + _Pi(1 / 12))
fcirc x2, y2, r * .2, &HFF000000
r = r * 2
x1 = x + r * .9 * Cos(heading + _Pi): y1 = y + r * .9 * Sin(heading + _Pi)
TiltedEllipseFill 0, x1, y1, r, .7 * r, heading + _Pi, _RGB32(red, green, blue)
End Sub
Sub drawLink (x1, y1, r1, x2, y2, r2, c As _Unsigned Long)
Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
a = _Atan2(y2 - y1, x2 - x1)
a1 = a + _Pi(1 / 2)
a2 = a - _Pi(1 / 2)
x3 = x1 + r1 * Cos(a1): y3 = y1 + r1 * Sin(a1)
x4 = x1 + r1 * Cos(a2): y4 = y1 + r1 * Sin(a2)
x5 = x2 + r2 * Cos(a1): y5 = y2 + r2 * Sin(a1)
x6 = x2 + r2 * Cos(a2): y6 = y2 + r2 * Sin(a2)
fquad x3, y3, x4, y4, x5, y5, x6, y6, c
fcirc x1, y1, r1, c
fcirc x2, y2, r2, c
End Sub
'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
Sub fquad (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long)
ftri x1, y1, x2, y2, x4, y4, c
ftri x3, y3, x4, y4, x1, y1, c
End Sub
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim a&
a& = _NewImage(1, 1, 32)
_Dest a&
PSet (0, 0), K
_Dest 0
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
_FreeImage a& '<<< this is important!
End Sub
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Sub TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c As _Unsigned Long)
Dim max As Integer, mx2 As Integer, i As Integer, j As Integer, k As Single, lasti As Single, lastj As Single
Dim prc As _Unsigned Long, tef As Long
prc = _RGB32(255, 255, 255, 255)
If a > b Then max = a + 1 Else max = b + 1
mx2 = max + max
tef = _NewImage(mx2, mx2)
_Dest tef
_Source tef 'point wont read without this!
For k = 0 To 6.2832 + .05 Step .1
i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang)
If k <> 0 Then
Line (lasti, lastj)-(i, j), prc
Else
PSet (i, j), prc
End If
lasti = i: lastj = j
Next
Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer
For y = 0 To mx2
x = 0
While Point(x, y) <> prc And x < mx2
x = x + 1
Wend
xleft(y) = x
While Point(x, y) = prc And x < mx2
x = x + 1
Wend
While Point(x, y) <> prc And x < mx2
x = x + 1
Wend
If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x
Next
_Dest destHandle&
For y = 0 To mx2
If xleft(y) <> mx2 Then Line (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF
Next
_FreeImage tef
End Sub
b = b + ...
Posts: 1,859
Threads: 190
Joined: Apr 2022
Reputation:
88
Well I think I learned something here. Working with the angular formula and mouse coordinates I was able to make a mouse mimic a joystick.
Hold right button to down to move in the direction of the mouse pointer or click left button to just move all at once.
Code: (Select All) yy = 3: xx = 1
LOCATE yy, xx: PRINT "*";
DO
_LIMIT 60
WHILE _MOUSEINPUT: WEND
mx = _MOUSEX
my = _MOUSEY
lb = _MOUSEBUTTON(1)
rb = _MOUSEBUTTON(2)
b$ = INKEY$
IF LEN(b$) THEN
SELECT CASE b$
CASE CHR$(0) + "K"
IF POS(0) > 1 THEN LOCATE , POS(0) - 1
CASE CHR$(0) + "M"
IF POS(0) < _WIDTH THEN LOCATE , POS(0) + 1
CASE CHR$(0) + "H"
IF CSRLIN > 1 THEN LOCATE CSRLIN - 1, POS(0)
CASE CHR$(0) + "P"
IF CSRLIN < _HEIGHT THEN LOCATE CSRLIN + 1, POS(0)
END SELECT
END IF
IF ABS(z1 - TIMER) > .2 THEN
z1 = TIMER
IF rb THEN
' Angle formula by bplus ------------------------------
cx = POS(0): cy = CSRLIN
stepX = ABS(cx - mx): stepY = ABS(cy - my)
dAng = INT(_R2D(_ATAN2(my - cy, mx - cx)) + .5)
IF dAng < 0 THEN dAng = dAng + 360
IF dAng <= 90 THEN
startA = 0: endA = dAng: ra = dAng
ELSEIF dAng <= 180 THEN
startA = dAng: endA = 180: ra = 90 - (dAng - 90)
ELSEIF dAng <= 270 THEN
startA = 180: endA = dAng: ra = dAng - 180
ELSEIF dAng <= 360 THEN
startA = dAng: endA = 360: ra = 90 - (dAng - 270)
END IF
'-------------------------------------------------------
m_y = 0: m_x = 0
IF ra <= 90 AND ra >= 50 THEN
IF my > CSRLIN THEN
x$ = "down": m_y = 1: m_x = 0
ELSE
x$ = "up": m_y = -1: m_x = 0
END IF
ELSEIF ra < 50 AND ra >= 15 THEN
IF mx > POS(0) AND my > CSRLIN THEN
x$ = "down right": m_y = 1: m_x = 2
ELSEIF mx < POS(0) AND my > CSRLIN THEN
x$ = "down left": m_y = 1: m_x = -2
ELSEIF mx > POS(0) AND my < CSRLIN THEN
x$ = "up right": m_y = -1: m_x = 2
ELSEIF mx < POS(0) AND my < CSRLIN THEN
x$ = "up left": m_y = -1: m_x = -2
END IF
ELSEIF ra < 15 AND ra >= 0 THEN
IF mx > POS(0) THEN
x$ = "right": m_y = 0: m_x = 2
ELSE
x$ = "left": m_y = 0: m_x = -2
END IF
END IF
y2 = CSRLIN: x2 = POS(0): LOCATE 1, 1: PRINT x1; " "; x2; " "; ra; " "; x$; " ";: LOCATE y2, x2
LOCATE yy, xx: PRINT " ";: yy = yy + m_y: xx = xx + m_x: LOCATE yy, xx: PRINT "*";
END IF
END IF
IF lb THEN LOCATE yy, xx: PRINT " ";: LOCATE my, mx: PRINT "*";: yy = my: xx = mx
LOOP
I'm not sure I have the exact degrees worked out, but it seems to be pretty close.
Pete
Posts: 3,563
Threads: 164
Joined: Apr 2022
Reputation:
171
10-08-2022, 10:25 AM
(This post was last modified: 05-10-2024, 11:30 AM by bplus.)
What is all this?
Code: (Select All) IF dAng <= 90 THEN
startA = 0: endA = dAng: ra = dAng
ELSEIF dAng <= 180 THEN
startA = dAng: endA = 180: ra = 90 - (dAng - 90)
ELSEIF dAng <= 270 THEN
startA = 180: endA = dAng: ra = dAng - 180
ELSEIF dAng <= 360 THEN
startA = dAng: endA = 360: ra = 90 - (dAng - 270)
END IF
'-----
Update: I did write that but it was for comparing to a Cartesia graph, angles as positive arcs from x-axis. Sigh
This should be easy to understand:
Code: (Select All) Screen _NewImage(800, 600, 32)
stepSize = 15: x = _Width / 2: y = _Height / 2 ' got to start somewhere
Do
Cls
_PrintString (x - 4, y - 8), "*"
While _MouseInput: Wend
mx = _MouseX: my = _MouseY: mb1 = _MouseButton(1): mb2 = _MouseButton(2)
If mb1 Then ' relocate at mouse
x = mx: y = my: _Delay .25
ElseIf mb2 Then ' move position towards mouse
angle = _Atan2(my - y, mx - x) ' angle of mouse to current x, y position
x = x + stepSize * Cos(angle): y = y + stepSize * Sin(angle)
_Delay .25
End If
_Display
_Limit 30
Loop
And here if you can only move left/right OR up/down like in a maze:
Code: (Select All) Screen _NewImage(800, 600, 32)
stepSize = 15: x = _Width / 2: y = _Height / 2 ' got to start somewhere
Do
Cls
_PrintString (x - 4, y - 8), "*"
While _MouseInput: Wend
mx = _MouseX: my = _MouseY: mb1 = _MouseButton(1): mb2 = _MouseButton(2)
If mb1 Then
x = mx: y = my: _Delay .25
ElseIf mb2 Then
angle = _Atan2(my - y, mx - x) ' angle of mouse to current x, y position
dx = stepSize * Cos(angle): dy = stepSize * Sin(angle)
If Abs(dx) >= Abs(dy) Then
x = x + stepSize * Sgn(dx)
Else
y = y + stepSize * Sgn(dy)
End If
_Delay .25
End If
_Display
_Limit 30
Loop
EDIT: i am looking at this code years later and need instructions
USE Left Mouse click to SET a point to step towards, use Right Mouse clicks to STEP towards the set point
b = b + ...
Posts: 1,859
Threads: 190
Joined: Apr 2022
Reputation:
88
10-08-2022, 03:17 PM
(This post was last modified: 10-08-2022, 03:17 PM by Pete.)
The part enclosed in...
'----------------------------------------------------------------------
cx = POS(0): cy = CSRLIN
stepX = ABS(cx - mx): stepY = ABS(cy - my)
dAng = INT(_R2D(_ATAN2(my - cy, mx - cx)) + .5)
IF dAng < 0 THEN dAng = dAng + 360
IF dAng <= 90 THEN
startA = 0: endA = dAng: ra = dAng
ELSEIF dAng <= 180 THEN
startA = dAng: endA = 180: ra = 90 - (dAng - 90)
ELSEIF dAng <= 270 THEN
startA = 180: endA = dAng: ra = dAng - 180
ELSEIF dAng <= 360 THEN
startA = dAng: endA = 360: ra = 90 - (dAng - 270)
END IF
'----------------------------------------------------------------------
...is a portion of the code you posted in post #1 of this thread: https://qb64phoenix.com/forum/showthread...31#pid4631
I'll have a look at the other methods, too. I've never had the need to use trig functions in a program prior to this, so this is new and interesting stuff fr me, and I have a use for it now, to boot!
Thanks,
Pete
Posts: 3,563
Threads: 164
Joined: Apr 2022
Reputation:
171
Crap! Sorry, thanks @Pete for link. I was figuring out the yellow arc to put the angle between 0 and 90 degrees from x axis. That was for comparing to Cartesia method, as you will notice the x and y axis in center of diagram. Raspberries!
Looks like my hope to not add to the confusion was a bust.
b = b + ...
Posts: 1,859
Threads: 190
Joined: Apr 2022
Reputation:
88
Posts: 3,563
Threads: 164
Joined: Apr 2022
Reputation:
171
05-10-2024, 01:42 PM
(This post was last modified: 05-10-2024, 10:37 PM by bplus.)
SUB routine Orbit
Code: (Select All) ' !!!!!! featuring the use of this SUB routine !!!!
Sub orbit (X_Origin, Y_Origin, Degrees, Radius, xOut, yOut) ' all default single should be ok
xOut = X_Origin + Radius * Cos(_D2R(Degrees))
yOut = Y_Origin + Radius * Sin(_D2R(Degrees))
End Sub
Code: (Select All) Option _Explicit
_Title "orbit demo" 'b+ 2024-05-10
'============================== Main
Const Xmax = 1000, Ymax = 700
Const Thick = 2
Const Arc_Radius = 100
Const Sin_color = _RGB32(0, 0, 255)
Const Cos_color = _RGB32(0, 128, 0)
Const Radius_color = _RGB32(255, 0, 0)
Const Ang_color = _RGB32(255, 255, 0)
Const White = _RGB32(255, 255, 255)
Const Origin_color = _RGB32(255, 128, 0)
Dim cx, cy, mx, my, stepX, stepY, Radius, dAng, xOut, yOut, x, y
cx = Xmax / 2: cy = Ymax / 2
Screen _NewImage(Xmax, Ymax, 32)
_ScreenMove 60, 0
_PrintMode _KeepBackground
_MouseMove cx + 100, cy + 100 ' get ball rolling
While 1
Cls
Color White
Locate 2, 18
Print "Move your mouse clockwise starting at 0 due East to see Basics Angle in Degrees increase."
Locate 5, 68
Print "Orbit ";
Color Origin_color
Print "X_Origin, Y_Origin,";
Color Ang_color
Print " Degrees,";
Color Radius_color
Print " Radius,";
Color White
Print " xOut, yOut"
'draw horizontal through center of screen
Line (70, cy)-(Xmax - 70, cy), Cos_color
' draw vertical line through center of screen
Line (cx, 70)-(cx, Ymax - 70), Sin_color
'poll mouse
While _MouseInput: Wend ' updates all mouse stuff except wheel
mx = _MouseX: my = _MouseY 'get mouse location
'draw our Color Coded Trig Triangle
ThickLine cx, cy, mx, cy, 1, Cos_color
ThickLine mx, cy, mx, my, 1, Sin_color
ThickLine cx, cy, mx, my, Thick, Radius_color
stepX = Abs(cx - mx): stepY = Abs(cy - my)
Radius = Int(((stepX ^ 2 + stepY ^ 2) ^ .5))
'to draw angle need to do some math
'dAng = mouse angle to 0 Degrees due East
dAng = Int(_R2D(_Atan2(my - cy, mx - cx)) + .5)
If dAng < 0 Then dAng = dAng + 360
Color Ang_color
ThickArc cx, cy, Radius, 0, dAng, Thick
'report all numbers color coded
Color Ang_color
Locate 5, 3: Print "Yellow Angle (in Degrees) ~ "; dAng
Color Radius_color
Locate 7, 7: Print " Length red Radius ~ "; Radius
Color Sin_color
Locate 9, 7: Print " Length blue Opp side ~ "; stepY \ 1
Color Cos_color
Locate 8, 7: Print "Length green Adj side ~ "; stepX \ 1
Color White
Locate 11, 1: Print " Ratios: (if no division by 0)"
If Radius <> 0 Then
Color Cos_color
Locate 12, 8: Print "COS = Adj ";
Color Radius_color
Print "/ Radius ";
Color White
Print "~ "; Left$(Str$(stepX / Radius), 6)
Color Sin_color
Locate 13, 8: Print "SIN = Opp ";
Color Radius_color
Print "/ Radius ";
Color White
Print "~ "; Left$(Str$(stepY / Radius), 6)
End If
Color White
orbit cx, cy, dAng, Radius, xOut, yOut ' mouse here
orbit cx, cy, dAng, Radius + 50, x, y ' set label here
label x, y, "(xOut, yOut) = (" + _Trim$(Str$(xOut \ 1)) + "," + Str$(yOut \ 1) + ")"
Color Origin_color
label cx, cy - 10, "(X_Origin, Y_Origin) = (" + _Trim$(Str$(cx)) + "," + Str$(cy) + ")"
_Display
_Limit 60
Wend
' !!!!!! featuring the use of this SUB routine !!!!
Sub orbit (X_Origin, Y_Origin, Degrees, Radius, xOut, yOut) ' all default single should be ok
xOut = X_Origin + Radius * Cos(_D2R(Degrees))
yOut = Y_Origin + Radius * Sin(_D2R(Degrees))
End Sub
Sub label (xc, yc, text$)
Dim th2, pw2
th2 = _FontHeight / 2
pw2 = _PrintWidth(text$) / 2
_PrintString (xc - pw2 + 1.25, yc - th2 + .5), text$
End Sub
Sub ThickArc (xCenter, yCenter, arcRadius, dAngleStart, dAngleEnd, rThick)
Dim rAngle, rAngleStart, rAngleEnd, x1, y1, Stepper
'draws an Arc with center at xCenter, yCenter, Radius from center is arcRadius
'for SmallBASIC angle 0 Degrees is due East and angle increases clockwise towards South
'THIS SUB IS SETUP TO DRAW AN ARC IN CLOCKWISE DIRECTION
'dAngleStart is where to start Angle in Degrees
' so make the dAngleStart the first ray clockwise from 0 Degrees that starts angle drawing clockwise
'dAngleEnd is where the arc ends going clockwise with positive Degrees
' so if the arc end goes past 0 Degrees clockwise from dAngleStart
' express the end angle as 360 + angle
'rThick is the Radius of the many,many tiny circles this will draw to make the arc thick
' so if rThick = 2 the circles will have a Radius of 2 pixels and arc will be 4 pixels thick
If arcRadius < 1 Then PSet (xCenter, yCenter): Exit Sub
rAngleStart = _D2R(dAngleStart): rAngleEnd = _D2R(dAngleEnd)
If Int(rThick) = 0 Then Stepper = 1 / (arcRadius * _Pi) Else Stepper = rThick / (arcRadius * _Pi / 2)
For rAngle = rAngleStart To rAngleEnd Step Stepper
x1 = arcRadius * Cos(rAngle): y1 = arcRadius * Sin(rAngle)
If Int(rThick) < 1 Then
PSet (xCenter + x1, yCenter + y1)
Else
fcirc xCenter + x1, yCenter + y1, rThick, Ang_color
End If
Next
End Sub
Sub ThickLine (x1, y1, x2, y2, rThick, K As _Unsigned Long)
Dim length, stepx, stepy, dx, dy, i
'x1,y1 is one endpoint of line
'x2,y2 is the other endpoint of the line
'rThick is the Radius of the tiny circles that will be drawn
' from one end point to the other to create the thick line
'Yes, the line will then extend beyond the endpoints with circular ends.
stepx = x2 - x1
stepy = y2 - y1
length = (stepx ^ 2 + stepy ^ 2) ^ .5
If length Then
dx = stepx / length: dy = stepy / length
For i = 0 To length
fcirc x1 + dx * i, y1 + dy * i, rThick, K
Next
End If
End Sub
Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
edit: changed order of parameters in orbit to follow sequence of next post
start at point x-origin, y-origin
turn in degrees direction
walk forward radius pixels
you are now at point x-out, y-out
b = b + ...
Posts: 3,563
Threads: 164
Joined: Apr 2022
Reputation:
171
05-10-2024, 10:18 PM
(This post was last modified: 05-10-2024, 11:08 PM by bplus.)
another way to look at orbit:
Code: (Select All) ' !!!!!! featuring the use of this SUB routine !!!!
Sub orbit (X_Origin, Y_Origin, Degrees, Radius, xOut, yOut) ' all default single should be ok
xOut = X_Origin + Radius * Cos(_D2R(Degrees))
yOut = Y_Origin + Radius * Sin(_D2R(Degrees))
End Sub
imagine standing at point (X_Origin, Y_Origin)
now turn so you are facing Degrees direction
next step forward Radius pixels
you are now at point (xOut, yOut)
edit: so the sub parameters now follow that order
Here is simpler demo, make a pentagram
Code: (Select All) _Title "orbit demo make pentagram " 'b+ 2024-05-10
Const Xmax = 700, Ymax = 700
Screen _NewImage(Xmax, Ymax, 32)
x = _Width / 2: y = _Height / 2 ' start in center of screen
pentAngle = 72 ' the angles inside a pentagram are 360 / 5 = 72 degrees
forward = 100
For turn = 1 To 5 ' turn
orbit x, y, Angle, forward, nextx, nexty
Line (x, y)-(nextx, nexty)
Angle = Angle + pentAngle ' the absolute angle from 0 degrees accumulates at every turn
x = nextx: y = nexty ' restart where we left off
_Limit 2
Next
' !!!!!! featuring the use of this SUB routine !!!!
Sub orbit (X_Origin, Y_Origin, Degrees, Radius, xOut, yOut) ' all default single should be ok
xOut = X_Origin + Radius * Cos(_D2R(Degrees))
yOut = Y_Origin + Radius * Sin(_D2R(Degrees))
End Sub
and for fun a pentagram spiral
Code: (Select All) _Title "orbit demo make pentagram spiral " 'b+ 2024-05-10
Const Xmax = 700, Ymax = 700
Screen _NewImage(Xmax, Ymax, 32)
x = _Width / 2: y = _Height / 2 ' start in center of screen
pentAngle = 72 ' the angles inside a pentagram are 360 / 5 = 72 degrees
forward = 10
While y > 0 And y < _Height
orbit x, y, Angle, forward, nextx, nexty
Line (x, y)-(nextx, nexty)
forward = forward + 10
Angle = Angle + pentAngle ' the absolute angle from 0 degrees accumulates at every turn
x = nextx: y = nexty ' restart where we left off
_Limit 2
Wend
' !!!!!! featuring the use of this SUB routine !!!!
Sub orbit (X_Origin, Y_Origin, Degrees, Radius, xOut, yOut) ' all default single should be ok
xOut = X_Origin + Radius * Cos(_D2R(Degrees))
yOut = Y_Origin + Radius * Sin(_D2R(Degrees))
End Sub
wait did you want the pentagram to point up?
Code: (Select All) _Title "orbit demo make pentagram spiral " 'b+ 2024-05-10
Const Xmax = 700, Ymax = 700
Screen _NewImage(Xmax, Ymax, 32)
x = _Width / 2: y = _Height / 2 ' start in center of screen
pentAngle = 72 ' the angles inside a pentagram are 360 / 5 = 72 degrees
forward = 10
angle = -36
While y > 0 And y < _Height
orbit x, y, angle, forward, nextx, nexty
Line (x, y)-(nextx, nexty)
forward = forward + 10
angle = angle + pentAngle ' the absolute angle from 0 degrees accumulates at every turn
x = nextx: y = nexty ' restart where we left off
_Limit 2
Wend
' !!!!!! featuring the use of this SUB routine !!!!
Sub orbit (X_Origin, Y_Origin, Degrees, Radius, xOut, yOut) ' all default single should be ok
xOut = X_Origin + Radius * Cos(_D2R(Degrees))
yOut = Y_Origin + Radius * Sin(_D2R(Degrees))
End Sub
b = b + ...
|
