+- 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: Rotate and Scale Mesh Shape (/showthread.php?tid=1179)
Pages:
1
2
Rotate and Scale Mesh Shape - King Mocker - 11-24-2022
I found and converted a program to display a shape from several points from a BBC Micro Advanced Graphics book from 1983.
The program only displayed it and ended.
Once I had replicated that I decided to make it a bit fancier and added some extra bits to it.
Code: (Select All)
Option _Explicit
Screen _NewImage(800, 600, 32)
Dim As Integer x(30), y(30)
Dim As Integer N, XC, YC, size, i, j
Dim As Integer dx, dy, scale, maxsize, minsize, maxdxy, shape
Dim As Integer framecounter
Dim As Single alpha, spinspeed, adif
Dim As Long shapecolor
'##################################
' Setup some default values
'##################################
XC = 300 + Int(Rnd * 200): YC = 200 + Int(Rnd * 200)
N = 10
alpha = 0
spinspeed = 0.005
size = 150: scale = 10: minsize = 50: maxsize = 200
dx = 5 + Int(Rnd * 5) + 1: dy = 5 + Int(Rnd * 5) + 1: maxdxy = 40
shape = 1: shapecolor = _RGB32(240, 240, 240)
framecounter = 0
'#####################################################
'## Main loop
'#####################################################
Do
'##################################################################################################################
'## Calculate a new LIMIT based on the size of the shape,
'## smaller shape faster speed, larger shape slower speed
'##################################################################################################################
_Limit Int((220 - size) * 0.15 + 10)
Cls , _RGB32(0, 0, 0)
Locate 1, 1: Print "Left/Right: Dec/Inc Spin Speed. Down/Up: Dec/Inc. size -/+: Dec/Inc # of Points"
Locate 2, 1: Print "Q/W : Dec/Inc X direction D/E : Dec/Inc Y direction Space: Change Shape"
'##################################
'## Generate new points for the shape
'##################################
adif = (2 * _Pi / N) + spinspeed
For i = 1 To N
x(i) = Cos(alpha) * size + XC: y(i) = Sin(alpha) * size + YC
alpha = alpha + adif
Next i
'##################
'## Draw the shape
'##################
For i = 1 To N - 1
For j = i + 1 To N
If shape = 1 Then
Line (x(i), y(i))-(x(j), y(j)), shapecolor ' Draws only lines
Else
Line (x(i), y(i))-(x(j), y(j)), shapecolor, B ' Draws Boxes
End If
Next j
Next i
_Display
'##############################
' Get new shape screen position
'##############################
XC = XC + dx
YC = YC + dy
'##########################################################################################################################################
'## Process Key presses
'##########################################################################################################################################
If _KeyDown(20480) And size >= minsize And XC >= size + scale And YC >= size + scale Then size = size - scale ' UP Arrow
If _KeyDown(18432) And size <= maxsize Then ' Press DOWN Arrow and Size is not at maxiumum size
If _Width - size - (2 * scale) > XC And _Height - size - (2 * scale) > YC Then ' is not off right or bottom of screen
If XC >= size + (2 * scale) And YC >= size + (2 * scale) Then ' is not off left or top of screen
size = size + scale ' Increase Size of shape
End If
End If
End If
If _KeyDown(19200) And spinspeed > -0.02 Then spinspeed = spinspeed - 0.001 ' Left Arrow Key - Decrease Spin Speed
If _KeyDown(19712) And spinspeed < 0.02 Then spinspeed = spinspeed + 0.001 ' Right Arrow Key - Increase Spin Speed
If (_KeyDown(81) Or _KeyDown(113)) And Abs(dx) > 1 Then ' Press Q, reduce X direction
If Abs(dx) >= 1 And Abs(dx) <= maxdxy Then dx = Sgn(dx) * Abs(dx) - (Sgn(dx) * 1)
End If
If (_KeyDown(87) Or _KeyDown(119)) And Abs(dx) < maxdxy Then ' Press W, increase X direction
If Abs(dx) >= 1 And Abs(dx) <= maxdxy Then dx = Sgn(dx) * Abs(dx) + (Sgn(dx) * 1)
End If
If (_KeyDown(69) Or _KeyDown(101)) And Abs(dy) < maxdxy Then ' Press E, increase Y direction
If Abs(dy) >= 1 And Abs(dy) <= maxdxy Then dy = Sgn(dy) * Abs(dy) + (Sgn(dy) * 1)
End If
If (_KeyDown(68) Or _KeyDown(100)) And Abs(dy) > 1 Then ' Press D, decrease Y direction
If Abs(dy) >= 1 And Abs(dy) <= maxdxy Then dy = Sgn(dy) * Abs(dy) - (Sgn(dy) * 1)
End If
If _KeyDown(45) And N > 3 Then N = N - 1 ' Press - key, decrease points on shape
If _KeyDown(43) And N < 30 Then N = N + 1 ' Press + key, increase points on shape
If _KeyDown(32) And framecounter Mod 3 = 0 Then shape = shape * -1 ' Press Space to change shape, only once every 3 frames
'##########################################################################################################################################
'#####################################################################
'## change direction of shape and keep it within the screen boundaries
'#####################################################################
If XC > _Width - size - scale Then dx = -dx
If XC < size Then dx = -dx
If YC >= _Height - size - scale Then dy = -dy
If YC < size Then dy = -dy
framecounter = (framecounter Mod 100) + 1
Loop Until _KeyDown(27)
SystemRE: Rotate and Scale Mesh Shape - bplus - 11-24-2022
Wow that does allot for that little bit of code, very nice!
RE: Rotate and Scale Mesh Shape - King Mocker - 11-24-2022
Thanks for the praise bplus.
I have a couple of questions coming from making this:
1. Is there a UCASE$ equivalent when using _KEYDOWN, rather than having to specify values for both upper and lower case keys?
2. Can someone suggest a better method for toggling the shape using a single key and without affecting the speed of the main loop?
Without the 'framecounter mod' kludge it toggles too fast to be user friendly.
RE: Rotate and Scale Mesh Shape - SMcNeill - 11-24-2022
K = _KEYHIT
SELECT CASE K AND NOT 32 'ignores the 5th-bit, which is the case flag
...
RE: Rotate and Scale Mesh Shape - King Mocker - 11-24-2022
Thanks Steve.
Here is a modified section of the affected code.
Don't forget to add:
Dim k as integer
....or just remove the Option _Explicit line at the top.
Code: (Select All)
k = _KeyHit
Select Case k And Not 32
Case 81: If Abs(dx) > 1 Then
If Abs(dx) >= 1 And Abs(dx) <= maxdxy Then dx = Sgn(dx) * Abs(dx) - (Sgn(dx) * 1)
End If
Case 87: If Abs(dx) < maxdxy Then
If Abs(dx) >= 1 And Abs(dx) <= maxdxy Then dx = Sgn(dx) * Abs(dx) + (Sgn(dx) * 1)
End If
Case 69: If Abs(dy) < maxdxy Then
If Abs(dy) >= 1 And Abs(dy) <= maxdxy Then dy = Sgn(dy) * Abs(dy) + (Sgn(dy) * 1)
End If
Case 68: If Abs(dy) > 1 Then
If Abs(dy) >= 1 And Abs(dy) <= maxdxy Then dy = Sgn(dy) * Abs(dy) - (Sgn(dy) * 1)
End If
End SelectRE: Rotate and Scale Mesh Shape - King Mocker - 11-24-2022
Just curious,,doesn't _Keyhit use the same key press repeat delay that Inkey$ uses?
So, why use this in place of k=ucase$(inkey$)? Apart from the cool looking code.
RE: Rotate and Scale Mesh Shape - King Mocker - 11-24-2022
I've updated it to use INKEY$.
This removed the use of the framecounter hack used to control the speed of the spacebar toggle.
I have also changed the keys to a more popular WASD set to control the direction.
Code: (Select All)
Option _Explicit
Screen _NewImage(800, 600, 32)
Dim As Integer x(30), y(30)
Dim As Integer N, XC, YC, size, i, j
Dim As Integer dx, dy, scale, maxsize, minsize, maxdxy, shape
Dim As Single alpha, spinspeed, adif
Dim As Long shapecolor
Dim As String k
'##################################
' Setup some default values
'##################################
XC = 300 + Int(Rnd * 200): YC = 200 + Int(Rnd * 200) ' Assign XC and YC around the center ofthe screen
N = 10 ' Number of Points in the shape - maximum 30
alpha = 0
spinspeed = 0.005 ' +/- Spin speed of the shape
size = 150: scale = 10: minsize = 50: maxsize = 200
dx = 5 + Int(Rnd * 5) + 1: dy = 5 + Int(Rnd * 5) + 1: maxdxy = 40
shape = 1: shapecolor = _RGB32(240, 240, 240)
'#####################################################
'## Main loop
'#####################################################
Do
'##################################################################################################################
'## Calculate a new LIMIT based on the size of the shape,
'## smaller shape faster speed, larger shape slower speed
'##################################################################################################################
_Limit Int((220 - size) * 0.15 + 10)
Cls , _RGB32(0, 0, 0)
Locate 1, 1: Print "Left/Right: Dec/Inc Spin Speed. Down/Up: Dec/Inc. size -/+: Dec/Inc # of Points"
Locate 2, 1: Print "A/D : Dec/Inc X direction W/S : Dec/Inc Y direction Space: Change Shape"
'#####################################
'## Generate new points for the shape
'#####################################
adif = (2 * _Pi / N) + spinspeed
For i = 1 To N
x(i) = Cos(alpha) * size + XC: y(i) = Sin(alpha) * size + YC
alpha = alpha + adif
Next i
'##################
'## Draw the shape
'##################
For i = 1 To N - 1
For j = i + 1 To N
If shape = 1 Then
Line (x(i), y(i))-(x(j), y(j)), shapecolor ' Draws only lines
Else
Line (x(i), y(i))-(x(j), y(j)), shapecolor, B ' Draws Boxes
End If
Next j
Next i
_Display
'##############################
' Get new shape screen position
'##############################
XC = XC + dx
YC = YC + dy
'##########################################################################################################################################
'## Process Key presses
'##########################################################################################################################################
If _KeyDown(20480) And size >= minsize And XC >= size + scale And YC >= size + scale Then size = size - scale ' UP Arrow
If _KeyDown(18432) And size <= maxsize Then ' Press DOWN Arrow and Size is not at maxiumum size
If _Width - size - (2 * scale) > XC And _Height - size - (2 * scale) > YC Then ' is not off right or bottom of screen
If XC >= size + (2 * scale) And YC >= size + (2 * scale) Then ' is not off left or top of screen
size = size + scale ' Increase Size of shape
End If
End If
End If
If _KeyDown(19200) And spinspeed > -0.02 Then spinspeed = spinspeed - 0.001 ' Left Arrow Key - Decrease Spin Speed
If _KeyDown(19712) And spinspeed < 0.02 Then spinspeed = spinspeed + 0.001 ' Right Arrow Key - Increase Spin Speed
k = UCase$(InKey$)
Select Case k
Case "A": If Abs(dx) > 1 Then ' 65
If Abs(dx) >= 1 And Abs(dx) <= maxdxy Then dx = Sgn(dx) * Abs(dx) - (Sgn(dx) * 1)
End If
Case "D": If Abs(dx) < maxdxy Then '68
If Abs(dx) >= 1 And Abs(dx) <= maxdxy Then dx = Sgn(dx) * Abs(dx) + (Sgn(dx) * 1)
End If
Case "W": If Abs(dy) < maxdxy Then '87
If Abs(dy) >= 1 And Abs(dy) <= maxdxy Then dy = Sgn(dy) * Abs(dy) + (Sgn(dy) * 1)
End If
Case "S": If Abs(dy) > 1 Then '83
If Abs(dy) >= 1 And Abs(dy) <= maxdxy Then dy = Sgn(dy) * Abs(dy) - (Sgn(dy) * 1)
End If
End Select
If k = "-" And N > 3 Then N = N - 1 ' Press - key, decrease points on shape
If k = "+" And N < 30 Then N = N + 1 ' Press + key, increase points on shape
If k = " " Then shape = shape * -1 ' Press Space to change shape, only once every 3 frames
'##########################################################################################################################################
'#####################################################################
'## change direction of shape and keep it within the screen boundaries
'#####################################################################
If XC > _Width - size - scale Then dx = -dx
If XC < size Then dx = -dx
If YC >= _Height - size - scale Then dy = -dy
If YC < size Then dy = -dy
Loop Until k = Chr$(27)
SystemRE: Rotate and Scale Mesh Shape - james2464 - 11-24-2022
Nice program...the geometry becomes really interesting.
I don't think I've seen OPTION _EXPLICIT before. (Maybe I just didn't notice it yet)
After checking the wiki to see what it's about, I don't really understand. How do I request this for a keyword of the day?
RE: Rotate and Scale Mesh Shape - bplus - 11-24-2022
Happy Thanksgiving all!
@jame2464 Option _Explicit makes you DIM everything before you can use it. It's just for developing code.
It saves allot of typos but is extra work unless you did have an undetected typo. It won't save you from using the wrong variable already DIM's ;-))
RE: Rotate and Scale Mesh Shape - james2464 - 11-24-2022
(11-24-2022, 08:20 PM)bplus Wrote: Happy Thanksgiving all!
@jame2464 Option _Explicit makes you DIM everything before you can use it. It's just for developing code.
It saves allot of typos but is extra work unless you did have an undetected typo. It won't save you from using the wrong variable already DIM's ;-))
Thanks! Straightforward enough - I'll try it out. Nice to know it might be helpful.