Proggies

[Dav]

Ah, my apologies to mnrvovrfc.

I understand how you feel, bplus.   Perhaps outside code may not be wanted this time since it’s a competition for their forum members, but do whatever you think is best. Thanks for the compliment of considering the code share worthy.

- Dav

[bplus]

Ah, my apologies to mnrvovrfc.

I understand how you feel, bplus.   Perhaps outside code may not be wanted this time since it’s a competition for their forum members, but do whatever you think is best. Thanks for the compliment of considering the code share worthy.

- Dav

Ah good point about interforum contest! thanks that decides it.

You know when you make 10 lines of code do all that stuff in living color I am going to be impressed! I don't think I am alone on this

[Dav]

Hey bplus, here's another little proggie you may like, a fake voronoi like pattern plasma.

- Dav

Code: (Select All)

'fake-voronoi-plasma.bas

'Dav, OCT/2023

Screen _NewImage(800, 600, 32)

Do

    For x = 0 To _Width Step 2

        For y = 0 To _Height Step 2

            d = Sqr(((x - y) ^ 2) + t + ((y - x) ^ 2) + t)

            Line (x, y)-Step(2, 2), _RGBA((d + x + t) Mod 255, (d + y + t) Mod 255, (d + t) Mod 255, 10), BF

        Next

    Next

    t = t + 1

    _Limit 30

Loop Until InKey$ = Chr$(27)

[bplus]

Hey bplus, here's another little proggie you may like, a fake voronoi like pattern plasma.

- Dav

Code: (Select All)

'fake-voronoi-plasma.bas

'Dav, OCT/2023

Screen _NewImage(800, 600, 32)

Do

    For x = 0 To _Width Step 2

        For y = 0 To _Height Step 2

            d = Sqr(((x - y) ^ 2) + t + ((y - x) ^ 2) + t)

            Line (x, y)-Step(2, 2), _RGBA((d + x + t) Mod 255, (d + y + t) Mod 255, (d + t) Mod 255, 10), BF

        Next

    Next

    t = t + 1

    _Limit 30

Loop Until InKey$ = Chr$(27)

I am seeing no Plasma nor Voronoi; thought about adding it... feeling lazy today. Maybe when I am up at 3AM unable to sleep.

Hey maybe you want to try? For Voronoi add 3 to a dozen points to measure the screen (x, y) distance to each save the shortest distance. Maybe try a polygon and rotate it? Get nice symmetry in image.

For plasma, rd(i) = rnd or rnd*rnd same for green gn(i) and blue bl(i)
_RGB32(127 + 127 * Sin(rd(n) * cN), 127 + 127 * Sin(gn(n) * cN), 127 + 127 * Sin(bl(n) * cN))
for CN use the dist, Then move the half dozen points around should be interesting!

Wait that is too, too much calculation. BTW I commented out LIMIT in code above and didn't speed up the graphics.

[CharlieJV]

Hey bplus, here's another little proggie you may like, a fake voronoi like pattern plasma.

- Dav

Code: (Select All)

'fake-voronoi-plasma.bas

'Dav, OCT/2023

Screen _NewImage(800, 600, 32)

Do

    For x = 0 To _Width Step 2

        For y = 0 To _Height Step 2

            d = Sqr(((x - y) ^ 2) + t + ((y - x) ^ 2) + t)

            Line (x, y)-Step(2, 2), _RGBA((d + x + t) Mod 255, (d + y + t) Mod 255, (d + t) Mod 255, 10), BF

        Next

    Next

    t = t + 1

    _Limit 30

Loop Until InKey$ = Chr$(27)

That's a nice proggie, Dav.

I had to significantly drop the resolution, but I'm pretty happy with the port: https://basicanywheremachine-news.blogsp...ogram.html

[bplus]

Cranky? Sorry @Dav if I might have sounded cranky in my comments above. I really like these ideas you guys present for proggies!

Lets see some:

Real Plasma PLUS Voronoi

!!! Warning: Extremely bright and moving colors may cause Epileptic fits !!!

Code: (Select All)

'Option _Explicit
_Title "Real Plasma and Voronoi, press key for new scheme" '2023-10-19  b+ overhaul of
'fake-voronoi-plasma.bas Dav, OCT/2023

Screen _NewImage(600, 600, 32)
'_ScreenMove 290, 40
Randomize Timer
$If WEB Then
        Import G2D From "lib/graphics/2d.bas"
$End If

' cap all shared variables
Dim Shared As Long CX, CY, Radius
' modified by Setup
Dim Shared As Single Rd, Gn, Bl ' plasma colorsfor RGB
Dim Shared As Long NP ' voronoi pt count mod in setup
Dim Shared As Single Angle ' mod in setup
Dim Shared As Long Direction ' mod random turning clockwise or counter

' local
Dim As Long x, y ' from screen
ReDim As Single px(1 To NP), py(1 To NP) ' voronoi points hopefully a spinning polygon
Dim As Single px, py, d, dist ' Voronoi calcs point and distance
Dim As Single da ' is polygon animating index
Dim As Long i, t ' indexes i a regular one and t for plasma color
Dim k$ ' polling keypresses
Dim c As _Unsigned Long ' plasma color line is soooooo long! save it in c container

'once and for all time
CX = _Width / 2: CY = _Height / 2: Radius = _Height / 3

Setup
Do
    For y = 0 To _Height - 1 Step 4
        For x = 0 To _Width - 1 Step 4
            d = 100000 ' too big!
            For i = 1 To NP
                px = CX + Radius * Cos(i * Angle + da)
                py = CY + Radius * Sin(i * Angle + da)
                dist = Sqr(((x - px) ^ 2) + ((y - py) ^ 2))
                If dist < d Then d = dist
            Next
            d = d + t
            c = _RGB32(127 + 127 * Sin(Rd * d), 127 + 127 * Sin(Gn * d), 127 + 127 * Sin(Bl * d))
            FCirc x, y, 3, c
        Next
    Next

    'animate!
    t = t + 2: da = da + _Pi(2 / 90) * Direction
    k$ = InKey$
    If Len(k$) Then
        If Asc(k$) = 27 Then
            End
        Else 'reset plasma
            Setup: t = 0
        End If
    End If
    _Display
    _Limit 30 'ha!
Loop Until InKey$ = Chr$(27)

Sub Setup ' reset shared
    'setup plasma for RGB color
    Rd = Rnd * Rnd: Gn = Rnd * Rnd: Bl = Rnd * Rnd

    'setup voronoi variables for calcs
    NP = Int(Rnd * 10) + 3 ' 9 + 3 max    number of poly points
    Angle = _Pi(2 / NP) ' angle between
    Direction = 2 * Int(Rnd * 2) - 1 ' turn clockwise or the other wise
End Sub

' this sub for circle fill so can use code in QBJS wo mod
Sub FCirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    $If WEB Then
            G2D.FillCircle CX, CY, R, C
    $Else
        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 If
End Sub

   


@Dbox this works in QBJS barely. Oddly QBJS is not respecting the screen size 600 x 600 nor is it handling keypress detection very well if at all??

I can fix screen size if I dump $If WEB but still no keypress poll? I thought I had it once while testing???

For keypress, it is probably too busy calculating graphics to bother to poll for keypress?

[dbox]

@Dbox this works in QBJS barely. Oddly QBJS is not respecting the screen size 600 x 600 nor is it handling keypress detection very well if at all??

I can fix screen size if I dump $If WEB but still no keypress poll? I thought I had it once while testing???

For keypress, it is probably too busy calculating graphics to bother to poll for keypress?

Very interesting... I'll have to look into that further.

[dbox]

Hey @bplus, I found a fix for it.  Most of the issue was that Import statements need to be placed at the top of the program.  There does seem to be a bug with InKey not returning the correct codes for the Esc key.  I'll put in a ticket for a fix in the next release.

[bplus]

Hey @dbox your post here in QB64pe IS taking my keypresses! So all I needed do is put the $IF at the very start of program before anything else. OK! easy! except to remember ;-))


Update: Oh you took out the check for escape keypress! Any other changes?

Man my CPU is running like heck the fan, the fan, when I leave the QBJS running!

Oh ZXDunny may have pointed to way to fake the Vonoroi

[bplus]

Not fake a cool variation!

Another Plasma Plus Vonoroi!

Code: (Select All)

'$If WEB Then
'        Import G2D From "lib/graphics/2d.bas"
'$End If
Screen _NewImage(800, 600, 32)
Dim Shared As Single Rd, Gn, Bl
Dim Shared As Long NP
ReDim Shared As Long Px(1 To NP), Py(1 To NP)
Dim As Long x, y
Dim As Single d, dist
Dim As Long i
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 - Px(i), y - Py(i))
                If dist < d Then d = dist
            Next
            d = d + t
            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
    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 As Long Px(1 To NP), Py(1 To NP)
    For i = 1 To NP
        Px(i) = Int(Rnd * _Width)
        Py(i) = Int(Rnd * _Height)
    Next
End Sub

Stripped down and less screen and bigger pixel for QBJS:


Code variation inspired by ZXDunny