Proggies - Printable Version

Code: (Select All)

_Title "Plasma Plus Vonoroi 3" ' b+ 2023-10

' move points that are either holes or humps!



'$If WEB Then

'        Import G2D From "lib/graphics/2d.bas"

'$End If

Screen _NewImage(800, 600, 32)

Type Pt_Type

    X As Single ' location

    Y As Single

    DX As Single ' moving points

    DY As Single

    HoleTF As Long ' TF hole of not (= bump/ hill) here is the new twist!

End Type



Dim Shared As Single Rd, Gn, Bl

Dim Shared As Long NP

ReDim Shared Pt(1 To 1) As Pt_Type

Dim As Long x, y

Dim As Single d, dist, f

Dim As Long i, savei

Dim As Single t

Dim k$

Dim c As _Unsigned Long

Setup

Do

    For y = 0 To _Height - 1 Step 2

        For x = 0 To _Width - 1 Step 2

            d = 10000

            For i = 1 To NP

                dist = _Hypot(x - Pt(i).X, y - Pt(i).Y)

                If dist < d Then d = dist: savei = i

            Next

            If Pt(savei).HoleTF Then

                d = t - d

            Else

                d = t + d

            End If

            c = _RGB32(127 + 127 * Sin(Rd * d), 127 + 127 * Sin(Gn * d), 127 + 127 * Sin(Bl * d))

            Line (x, y)-Step(2, 2), c, BF

        Next

    Next

    For i = 1 To NP ' move along

        If Pt(i).X + Pt(i).DX < 0 Or Pt(i).X + Pt(i).DX > _Width - 1 Then Pt(i).DX = -Pt(i).DX

        If Pt(i).Y + Pt(i).DY < 0 Or Pt(i).Y + Pt(i).DY > _Height - 1 Then Pt(i).DY = -Pt(i).DY

        Pt(i).X = Pt(i).X + Pt(i).DX: Pt(i).Y = Pt(i).Y + Pt(i).DY

    Next

    t = t + 1

    k$ = InKey$

    If Len(k$) Then

        Setup: t = 0

    End If

    _Display

    _Limit 30 'ha!

Loop Until _KeyDown(27)



Sub Setup

    Dim As Long i

    Rd = Rnd * Rnd: Gn = Rnd * Rnd: Bl = Rnd * Rnd

    NP = Int(Rnd * 50) + 3

    ReDim Pt(1 To NP) As Pt_Type

    For i = 1 To NP

        Pt(i).X = Int(Rnd * _Width)

        Pt(i).Y = Int(Rnd * _Height)

        Pt(i).DX = (2 * Int(Rnd * 2) - 1) * (Rnd * 5 + .5)

        Pt(i).DY = (2 * Int(Rnd * 2) - 1) * (Rnd * 5 + .5)

        Pt(i).HoleTF = Int(Rnd * 2)

    Next

End Sub

Code: (Select All)

_Title "Color Rotation" ' bplus 2024-01-06

sw = 1200: sh = 600

Screen _NewImage(sw, sh, 32)

_ScreenMove (_DesktopWidth - sw) / 2, (_DesktopHeight - sh) / 2

Randomize Timer

cx = sw / 2: cy = sh / 2 ' screen center

r = 150 ' radius of the iso triangles from center

r2 = r * 2

s = Sqr(2) * r / 4

While _KeyDown(27) = 0

    For cy = r To sh Step r2

        For cx = r To sw Step r2

            n = n + 10

            a = _Pi(2 / n) 'deterimine the central angle of all the triangles

            Randomize Using n

            ReDim pal~&(1 To n)

            For i = 1 To n

                pal~&(i) = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)

            Next

            For c = 1 To n ' draw the triangles into an image we will be spinning

                x1 = cx + r * Cos((c - 1) * a + rot): y1 = cy + r * Sin((c - 1) * a + rot)

                If c > 1 Then

                    ftri lastx, lasty, x1, y1, cx, cy, pal~&(c)

                Else

                    savex = x1: saveY = y1

                End If

                lastx = x1: lasty = y1

            Next

            ftri savex, saveY, lastx, lasty, cx, cy, pal~&(1)

            Line (cx - r, cy - r)-Step(r2, s), &HFF000000, BF

            Line (cx - r, cy - r)-Step(s, r2), &HFF000000, BF

            Line (cx + r, cy + r)-Step(-r2, -s), &HFF000000, BF

            Line (cx + r, cy + r)-Step(-s, -r2), &HFF000000, BF

        Next

    Next

    _Display

    _Limit 60

    rot = rot + .01

    n = 0

Wend



Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)

    Dim D As Long

    Static a&

    D = _Dest

    If a& = 0 Then a& = _NewImage(1, 1, 32)

    _Dest a&

    _DontBlend a& '  '<<<< new 2019-12-16 fix

    PSet (0, 0), K

    _Blend a& '<<<< new 2019-12-16 fix

    _Dest D

    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)

End Sub