Proggies

[Dav]

These are cool! Hey, @bplus, no I didn’t get any feeling of a cranky response. All’s good! I’m late replying because I’ve been ripping up shag carpet all day. The tack strips and nails are what take so long.

I was hoping my little post would get a plasma code response from you.  Thanks!

- Dav

[bplus]

Plasma Plus Vonoroi Variation #3

Growing and collapsing points that move around screen:

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

[vince]

if this isn't a mod

[bplus]

Well I guess it runs a little faster but can't change settings? Using mouse for 1 point is good.

[GareBear]

bplus, add _Fullscreen between Screen _NewImage(800, 600) 32 and Type statement for full screen. It used to be I couldn't handle this without getting dizzy. It works great on a 11 year old laptop.

[bplus]

bplus, add _Fullscreen between Screen _NewImage(800, 600) 32 and Type statement for full screen. It used to be I couldn't handle this without getting dizzy. It works great on a 11 year old laptop.

Oh thanks but for this one, I want to share with folks that don't have QB64. QBJS doesn't do _FullScreen.

I do use _Fullscreen in the Screen Saver programs, it is nice when code remains somewhat proportional to laptop screen.

[dbox]

bplus, add _Fullscreen between Screen _NewImage(800, 600) 32 and Type statement for full screen. It used to be I couldn't handle this without getting dizzy. It works great on a 11 year old laptop.

Oh thanks but for this one, I want to share with folks that don't have QB64. QBJS doesn't do _FullScreen.

I do use _Fullscreen in the Screen Saver programs, it is nice when code remains somewhat proportional to laptop screen.

What?  @bplus, QBJS has supported _Fullscreen for a long time.

[bplus]

What? @bplus, QBJS has supported _Fullscreen for a long time.

Oops sorry. Man did I know this once?



OK that IS nice!

[bplus]

It's Voronoi NOT Vonoroi

https://en.wikipedia.org/wiki/Voronoi_diagram

[bplus]

Here is something CharlieJV started on another forum that I of course had to mod! ; - ) )

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

When r = 150
   

When r = 75
   

As usual the still shots don't do justice to the animation.