Proggies

[dbox]

OK thanks different systems = different results.

What browser and OS versions are you running?  Also, out of curiosity, what is your screen resolution?

[bplus]

Opera on Windows 10-64
   

[Unseen Machine]

In the middle of the night, I wake up and have an idea to slightly improve with more consistent pattern bplus old classic Particle Fountain. 

DUDE! This looks awesome...permission to mod it/gl it to show it off in full splendour?

Unseen

[bplus]

If you are talking to me, yes, you don't have to ask but it is nice compliment specially from a burning skull LOL

IMHO it is already in it's simple splendor

Update: Ah that quote IS from me in #88 just after the spider crop circle

[bplus]

Quick little demo on Plasma~& and ResetPlasma for beautiful coloring.

This is called "Plasma Deluxe"

Code: (Select All)

_Title "Plasma Deluxe" 'b+ 2025-11-02
Screen _NewImage(1200, 600, 32)
_ScreenMove 50, 60
_PrintMode _KeepBackground
_Font _LoadFont("Arial.ttf", 128)
Dim Shared cN, pR, pG, pB
While _KeyDown(27) = 0
    Cls
    x = 0
    resetPlasma
    For y = 0 To 480 Step 2
        x = x + 1.4
        Color Plasma~&
        _PrintString (x, y), "Plasma Deluxe"
        _Display
        _Limit 100
    Next
    _Delay 1.5
Wend

Function Plasma~& ()
    cN = cN + 1 ''Dim Shared cN, pR, pG, pB
    Plasma~& = _RGB32(127 + 127 * Sin(pR * cN), 127 + 127 * Sin(pG * cN), 127 + 127 * Sin(pB * cN))
End Function

Sub resetPlasma ()
    ''Dim Shared cN, pR, pG, pB
    pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2: cN = 0
End Sub

   

[madscijr]

Can you post that program where you used curves in lieu of fonts? That would be innaresting to see...

[bplus]

see here: https://qb64phoenix.com/forum/showthread...7#pid36967

[madscijr]

Wow, thanks! I love the funky colors these draw!

[bplus]

How the heck is this not in here (Proggies) already? This is one of my all time favorites started in JB I think from a mod of tsh73 post. Acoording to several searches I haven't posted this???

Shell of Another Color

Code: (Select All)

_Title "Shell of another color 3" 'b+2020-01-25
'inspired by "shell-like thing" by tsh73 Jan 2020 at JB
' 2020-01-27 Shell of another color 3 adds more improvements

Screen _NewImage(660, 660, 32)
_ScreenMove 300, 40
Dim x(1600), y(1600), c As _Unsigned Long
cx = 340: cy = 390
For a = 0 To _Pi(8) Step _Pi(2 / 400) ' load x, y arrays
    x(i) = cx + ra * Cos(a): y(i) = cy + ra * Sin(a)
    dr = dr + 1 / 1700: ra = ra + dr ^ 2: i = i + 1
Next
While 1
    R = Rnd ^ 2: G = Rnd ^ 2: B = Rnd ^ 2: PN = 0: size = 1
    For i = 0 To 1139
        dx = x(i + 400) - x(i): dy = y(i + 400) - y(i)
        dist = Sqr(dx * dx + dy * dy): dx = dx / dist: dy = dy / dist: PN = PN + .73
        If i > 820 Then
            size = 3
        ElseIf i > 380 Then
            size = 2
        End If
        For j = 0 To dist
            shade = 1 - ((dist / 2 - j + 1 / 2) / (dist / 2)) ^ 2
            c = _RGB32(shade * Int(127 + 127 * Sin(R * PN)), shade * Int(127 + 127 * Sin(G * PN)), shade * Int(127 + 127 * Sin(B * PN)))
            fcirc x(i) + j * dx, y(i) + j * dy, size, c
        Next
    Next
    _Display
    _Delay 2
Wend

'from Steve Gold standard
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
    Dim Radius As Integer, RadiusError As Integer
    Dim X As Integer, Y As Integer
    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 Sub

   

[NakedApe]

That's a cool one, plus! Me likey.