Rotate and Scale Mesh Shape
#16
I've done another one.
Similar to the first one but subtly different. It has an interesting effect when bouncing off the edges when the speed is increased, and when the number of points is changed.


Code: (Select All)
Option _Explicit
Screen _NewImage(800, 600, 32)

' Triangle variables
Dim Shared As Integer XD(30), YD(30)
Dim Shared As Single AD, AD2, RD
Dim Shared As Single M, NI
Dim Shared As Single R, A2, A

Dim Shared As Long linecolor, linecolor2

'common variables
Dim Shared As Integer x(30), y(30)
Dim Shared As Integer N, XC, YC, size, i, j

Dim Shared As Integer dx, dy, scale, maxsize, minsize, maxdxy, shape
Dim Shared As Single alpha, spinspeed, adif
Dim Shared As Long shapecolor
Dim Shared As String k

linecolor = _RGB32(200, 200, 200)
linecolor2 = _RGB32(200, 0, 0)

'#####################################################
'## Main loop
'#####################################################
XC = 400: YC = 300
size = 150: scale = 10: minsize = 50: maxsize = 200
dx = 5 + Int(Rnd * 5) + 1: dy = 5 + Int(Rnd * 5) + 1: maxdxy = 40

TriangleMesh
End


'#####################################################
Sub TriangleMesh ()
    linecolor = _RGB32(200, 200, 200)
    linecolor2 = _RGB32(200, 0, 0)


    N = 20 ' Outer Ring line count
    M = 5 ' Inner Ring Line count

    AD = _Pi / N:
    AD2 = 2 * AD: A2 = 0: A = A2
    RD = 1 / M

    Do
        _Limit 10
        R = 1: A = A2

        For i = 1 To N
            x(i) = Cos(A) * size + XC: y(i) = Sin(A) * size + YC
            A = A + AD2
        Next i

        Cls , _RGB32(0, 0, 0)
        Locate 1, 1: Print "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"

        For j = 1 To M
            R = R - RD: A2 = A2 + AD: A = A2

            For i = 1 To N
                XD(i) = R * Cos(A) * size + XC: YD(i) = R * Sin(A) * size + YC:
                A = A + AD2
            Next i

            '##################
            '## Draw the shape
            '##################
            For i = 1 To N
                NI = (i Mod N) + 1
                Line (x(i), y(i))-(x(NI), y(NI)), linecolor2
                Line -(XD(i), YD(i)), linecolor
                Line -(x(i), y(i)), linecolor
            Next i

            'Set outer to inner ring
            For i = 1 To N: x(i) = XD(i): y(i) = YD(i): Next i
        Next j

        _Display

        k = UCase$(InKey$)
        WASD
        If k = "-" And M > 3 Then M = M - 1 '                                            Press - key, decrease points on shape
        If k = "+" And M < 15 Then M = M + 1 '                                           Press + key, increase points on shape

        '##############################
        ' Get new shape screen position
        '##############################
        XC = XC + dx
        YC = YC + dy

        '#####################################################################
        '## change direction of shape and keep it within the screen boundaries
        '#####################################################################
        If XC > _Width - size - scale Then dx = -dx
        If XC < size + scale Then dx = -dx
        If YC >= _Height - size - scale Then dy = -dy
        If YC < size + scale Then dy = -dy

    Loop Until k = Chr$(27)
End Sub

'##########################################################################################################################################
Sub WASD ()
    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

    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

End Sub
Reply


Messages In This Thread
Rotate and Scale Mesh Shape - by King Mocker - 11-24-2022, 03:07 AM
RE: Rotate and Scale Mesh Shape - by bplus - 11-24-2022, 03:16 AM
RE: Rotate and Scale Mesh Shape - by King Mocker - 11-24-2022, 04:14 PM
RE: Rotate and Scale Mesh Shape - by SMcNeill - 11-24-2022, 04:37 PM
RE: Rotate and Scale Mesh Shape - by King Mocker - 11-24-2022, 05:10 PM
RE: Rotate and Scale Mesh Shape - by King Mocker - 11-24-2022, 05:35 PM
RE: Rotate and Scale Mesh Shape - by SMcNeill - 11-25-2022, 06:28 PM
RE: Rotate and Scale Mesh Shape - by King Mocker - 11-24-2022, 06:04 PM
RE: Rotate and Scale Mesh Shape - by james2464 - 11-24-2022, 07:19 PM
RE: Rotate and Scale Mesh Shape - by TerryRitchie - 11-24-2022, 09:49 PM
RE: Rotate and Scale Mesh Shape - by bplus - 11-24-2022, 08:20 PM
RE: Rotate and Scale Mesh Shape - by james2464 - 11-24-2022, 08:35 PM
RE: Rotate and Scale Mesh Shape - by james2464 - 11-24-2022, 10:05 PM
RE: Rotate and Scale Mesh Shape - by mnrvovrfc - 11-24-2022, 10:45 PM
RE: Rotate and Scale Mesh Shape - by TerryRitchie - 11-24-2022, 11:33 PM
RE: Rotate and Scale Mesh Shape - by mnrvovrfc - 11-25-2022, 12:00 AM
RE: Rotate and Scale Mesh Shape - by SMcNeill - 11-25-2022, 06:40 PM
RE: Rotate and Scale Mesh Shape - by King Mocker - 11-25-2022, 03:41 AM
RE: Rotate and Scale Mesh Shape - by bplus - 11-25-2022, 02:12 PM



Users browsing this thread: 6 Guest(s)