Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Plasma Studies
#1
Probably one of my signature code themes, I've played with Plasma the color sequencing method and with Plasma the 2D blobs. This thread is a study of the latter.
________________________________________________________________________________________________

The earliest QB64 file I can find is Ectoplasm more about Ghost busters than plasma the blobs but close enough:
Code: (Select All)
_Title "Ectoplasm" 'mod of Galileo's at Retro 2019-06-22 B+
'open window 256, 256
Screen _NewImage(256, 256, 32)
Randomize Timer
'sh=peek("winheight")
sh = _Height
'sw=peek("winwidth")
sw = _Width
d = 1
Do
    'tm = peek("secondsrunning")
    tm = Timer(.001)
    dr = ran(256): dg = ran(256): db = ran(256)
    w = w + 5 / 83 '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< get things moving
    For y = 0 To sh
        For x = 0 To sw
            vl = Sin(distance(x + tm, y, 128, 128) / 8 + w)
            vl = vl + Sin(distance(x, y, 64, 64) / 8)
            vl = vl + Sin(distance(x, y + tm / 7, 192, 64) / 7)
            vl = vl + Sin(distance(x, y, 192, 100) / 8)
            clr = 255 / (1.00001 * Abs(vl))
            r = .9 * Abs(clr - dr): g = .4 * Abs(clr - dg): b = .5 * Abs(clr - db)
            'COLOR r, g, b
            'dot x, y
            PSet (x, y), _RGB32(r, g, b)
        Next
    Next
    If w > 1000 Or w < -1000 Then w = 0: d = d * -1
    _Display
    _Limit 200
Loop
Function distance (x1, y1, x2, y2) '//between two points x1,y1 and x2,y2
    distance = ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
End Function
Function ran% (sing)
    ran% = Int(Rnd * sing) + 1
End Function


Attached Files Image(s)
   
b = b + ...
Reply
#2
The real study begins in late Jan 2020 with Plasmatic:
Code: (Select All)
_Title "Plasmatic  press spacebar for new coloring set" ' b+ 2020-01-20 translated and modified from SmallBASIC
'Plasma Magnifico - updated 2015-11-26 for Android
'This program creates a plasma surface, which looks oily or silky.

Const xmax = 800, ymax = 600
Type xy
    x As Single
    y As Single
    dx As Single
    dy As Single
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 40

Dim c(360) As _Unsigned Long, p(6) As xy, f(6)
restart:
r = Rnd: g = Rnd: b = Rnd: i = 0
For n = 1 To 5
    r1 = r: g1 = g: b1 = b
    Do: r = Rnd: Loop Until Abs(r - r1) > .2
    Do: g = Rnd: Loop Until Abs(g - g1) > .2
    Do: b = Rnd: Loop Until Abs(g - g1) > .2
    For m = 0 To 17: m1 = 17 - m
        f1 = (m * r) / 18: f2 = (m * g) / 18: f3 = (m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m + m1 * r) / 18: f2 = (m + m1 * g) / 18: f3 = (m + m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m1 + m * r) / 18: f2 = (m1 + m * g) / 18: f3 = (m1 + m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m1 * r) / 18: f2 = (m1 * g) / 18: f3 = (m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
Next

For n = 0 To 5
    p(n).x = Rnd * xmax: p(n).y = Rnd * ymax: p(n).dx = Rnd * 2 - 1: p(n).dy = Rnd * 2 - 1
    f(n) = Rnd * .1
Next

While _KeyDown(27) = 0
    If InKey$ = " " Then GoTo restart
    For i = 0 To 5
        p(i).x = p(i).x + p(i).dx
        If p(i).x > xmax Or p(i).x < 0 Then p(i).dx = -p(i).dx
        p(i).y = p(i).y + p(i).dy
        If p(i).y > ymax Or p(i).y < 0 Then p(i).dy = -p(i).dy
    Next
    For y = 0 To ymax - 1 Step 2
        For x = 0 To xmax - 1 Step 2
            d = 0
            For n = 0 To 5
                dx = x - p(n).x: dy = y - p(n).y
                k = Sqr(dx * dx + dy * dy)
                d = d + (Sin(k * f(n)) + 1) / 2
            Next n: d = d * 60
            Line (x, y)-Step(2, 2), c(d), BF
        Next
    Next
    _Display
    _Limit 100
Wend

Function rgbf~& (n1, n2, n3)
    rgbf~& = _RGB32(n1 * 255, n2 * 255, n3 * 255)
End Function


Attached Files Image(s)
   
b = b + ...
Reply
#3
Here I play with 3 points of plasma bouncing them off borders like balls:
Code: (Select All)
_Title "Plasmatic 3 Points Test Mod, press spacebar for new color set" 'b+ 2020-01-22
' from Plasmatic nPoints Test Mod.bas 2020-01-22
' from Plasmatic  press spacebar for new coloring set" ' b+ 2020-01-20 translated and modified from SmallBASIC
'Plasma Magnifico - updated 2015-11-26 for Android
'This program creates a plasma surface, which looks oily or silky.
'==================================================================================================================
'
'                          Experiments with ordered set of points, can we tell the pattern underneath?
'
'==================================================================================================================

Const xmax = 800, ymax = 600, nPoints = 3
Type xy
    x As Single
    y As Single
    dx As Single
    dy As Single
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 40

Dim c((nPoints + 1) * 80) As _Unsigned Long, p(1 To nPoints) As xy, f(1 To nPoints), cc As _Unsigned Long
restart:
Cls
r = Rnd: g = Rnd: b = Rnd: i = 0
For n = 1 To nPoints
    r1 = r: g1 = g: b1 = b
    Do: r = Rnd: Loop Until Abs(r - r1) > .2
    Do: g = Rnd: Loop Until Abs(g - g1) > .2
    Do: b = Rnd: Loop Until Abs(g - g1) > .2
    For m = 0 To 17: m1 = 17 - m
        f1 = (m * r) / 18: f2 = (m * g) / 18: f3 = (m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m + m1 * r) / 18: f2 = (m + m1 * g) / 18: f3 = (m + m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m1 + m * r) / 18: f2 = (m1 + m * g) / 18: f3 = (m1 + m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m1 * r) / 18: f2 = (m1 * g) / 18: f3 = (m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
Next

For n = 1 To nPoints
    p(n).x = Rnd * xmax: p(n).y = Rnd * ymax: p(n).dx = 5 * (Rnd * 2 - 1): p(n).dy = 5 * (Rnd * 2 - 1)
    f(n) = .2
Next

While _KeyDown(27) = 0
    If InKey$ = " " Then GoTo restart
    ca = ca + da
    For i = 1 To nPoints
        p(i).x = p(i).x + p(i).dx
        p(i).y = p(i).y + p(i).dy
        If p(i).x < 0 Or p(i).x > xmax Then p(i).dx = -p(i).dx
        If p(i).y < 0 Or p(i).y > ymax Then p(i).dy = -p(i).dy
    Next

    For y = 0 To ymax - 1 Step 2
        For x = 0 To xmax - 1 Step 2
            d = 0
            For n = 1 To nPoints
                dx = x - p(n).x: dy = y - p(n).y
                k = Sqr(dx * dx + dy * dy)
                d = d + (Sin(k * f(n)) + 1) / 2
            Next n: d = d * 60
            Line (x, y)-Step(2, 2), c(d), BF
        Next
    Next
    For i = 1 To nPoints
        For rd = 0 To 10 Step .25
            Circle (p(i).x, p(i).y), rd, &HFFFFFF00
        Next
    Next
    _Display
    _Limit 30
Wend

Function rgbf~& (n1, n2, n3)
    rgbf~& = _RGB32(n1 * 255, n2 * 255, n3 * 255)
End Function


Attached Files Image(s)
   
b = b + ...
Reply
#4
Here I find a new way to mix colors for Plasma and get away from Classic White high contrast:
Code: (Select All)
_Title "Color Mixing 4 Plasmatic" ' b+ 2020-01-23
' continued study of what makes Plasmatic tick, here the color pallete created

Const xmax = 800, ymax = 600
Type xy
    x As Single
    y As Single
    dx As Single
    dy As Single
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 10
Randomize Timer
Dim c(360) As _Unsigned Long, p(6) As xy, f(6), i As Integer, r As Integer, g As Integer, b As Integer, m As Integer
Dim r1 As Integer, g1 As Integer, b1 As Integer
Dim r2 As Integer, g2 As Integer, b2 As Integer
restart:
If mode < .5 Then
    r1 = Rnd * 255: g1 = Rnd * 255: b1 = Rnd * 255
    r2 = Rnd * 255: g2 = Rnd * 255: b2 = Rnd * 255
    t$ = "t to toggle Current Mode New Plasma Option:  Between Cell Color" + Str$(r1) + Str$(g1) + Str$(b1) + "   Center Cell Color " + Str$(r2) + Str$(g2) + Str$(b2)
Else
    r2 = 255: g2 = 255: b2 = 255 'regular Plasma
    r1 = 0: g1 = 0: b1 = 0
    t$ = "t to toggle Current Mode Traditional Plasma:   Between Cell Color" + Str$(r1) + Str$(g1) + Str$(b1) + "   Center Cell Color" + Str$(r2) + Str$(g2) + Str$(b2)
End If

For i = 0 To 360
    If i Mod 60 = 0 Then r = Rnd * 255: g = Rnd * 255: b = Rnd * 255
    m = i Mod 60
    Select Case m
        Case Is < 15: c(i) = midInk(r1, g1, b1, r, g, b, m / 15)
        Case Is < 30: c(i) = midInk(r, g, b, r2, g2, b2, (m - 15) / 15)
        Case Is < 45: c(i) = midInk(r2, g2, b2, r, g, b, (m - 30) / 15)
        Case Is < 60: c(i) = midInk(r, g, b, r1, g1, b1, (m - 45) / 15)
    End Select
Next

For n = 0 To 5
    p(n).x = Rnd * xmax: p(n).y = Rnd * ymax: p(n).dx = Rnd * 2 - 1: p(n).dy = Rnd * 2 - 1
    f(n) = .1 * Rnd
Next

While _KeyDown(27) = 0
    k$ = InKey$
    If k$ = " " Then GoTo restart
    If k$ = "t" Then mode = 1 - mode: GoTo restart
    t = Timer(.001)
    For i = 0 To 5
        p(i).x = p(i).x + p(i).dx
        If p(i).x > xmax Or p(i).x < 0 Then p(i).dx = -p(i).dx
        p(i).y = p(i).y + p(i).dy
        If p(i).y > ymax Or p(i).y < 0 Then p(i).dy = -p(i).dy
    Next
    _Title t$
    For y = 0 To ymax - 1 Step 2
        For x = 0 To xmax - 1 Step 2
            d = 0
            For n = 0 To 5
                dx = x - p(n).x: dy = y - p(n).y
                k = Sqr(dx * dx + dy * dy)
                'k = _HYPOT(dx, dy)
                d = d + (Sin(k * f(n)) + 1) / 2
            Next n: d = d * 60
            Line (x, y)-Step(2, 2), c(d), BF
        Next
    Next
    Locate 1, 1: Print Using "#.####"; Timer(.001) - t
    _Display
    '_LIMIT 100
Wend

Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    midInk~& = _RGBA32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##, 255)
End Function

   
b = b + ...
Reply
#5
Then I like the new color mixing and want to show off the difference so this displays both in same testing app just use t to toggle between 2 styles:
Code: (Select All)
Option _Explicit
_Title "Plasmatic 5 Color Shading" ' b+ 2020-01-26
' Hopefully this will add shading to the new color options found in Pasmatic 4.

Const xxmax = 800, yymax = 600, xmax = 900, ymax = 740, xoff = (xmax - xxmax) \ 2, yoff = (ymax - yymax) \ 2
Type xy
    x As Single
    y As Single
    dx As Single
    dy As Single
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 250, 0
Randomize Timer
Dim c(360) As _Unsigned Long, p(6) As xy, f(6)
Dim i As Integer, m As Integer, n As Integer, mode As Integer, k$, t, x, y, d, dx, dy, dist, s
Dim r As Integer, g As Integer, b As Integer, r1 As Integer, g1 As Integer, b1 As Integer, r2 As Integer, g2 As Integer, b2 As Integer

restart: 'select rgb1 and rgb2 based on mode of color mixing
If mode = 0 Then 'new plasma option ANY color for border and ANY color for middle
    r1 = Rnd * 255: g1 = Rnd * 255: b1 = Rnd * 255: r2 = Rnd * 255: g2 = Rnd * 255: b2 = Rnd * 255
Else ' traditional high contrast plasma black borders, white centers
    r1 = 0: g1 = 0: b1 = 0: r2 = 255: g2 = 255: b2 = 255 'regular Plasma
End If

' create 6 x 60 bands of color palette based on coloring mode (rgb1 set and rgb2 set)
For i = 0 To 360
    If i Mod 60 = 0 Then r = Rnd * 255: g = Rnd * 255: b = Rnd * 255
    m = i Mod 60
    s = 1 - ((30 - m + .5) / 30) ^ 2
    Select Case m
        Case Is < 15: c(i) = midInk(s * r1, s * g1, s * b1, s * r, s * g, s * b, m / 15) '        1st stage increase rgb1 towards rgb color in 15 steps
        Case Is < 30: c(i) = midInk(s * r, s * g, s * b, s * r2, s * g2, s * b2, (m - 15) / 15) ' 2nd stage increase rgb color towards rgb2 set in 15 steps
        Case Is < 45: c(i) = midInk(s * r2, s * g2, s * b2, s * r, s * g, s * b, (m - 30) / 15) ' 3rd stage decrease rgb2 color back to rgb color in 15 steps
        Case Is < 60: c(i) = midInk(s * r, s * g, s * b, s * r1, s * g1, s * b1, (m - 45) / 15) ' 4th and finally decrease rgb back to starting rgb1 set in 15 steps
    End Select
Next

' behind the scenes variables for motion, weighting and shaping color mixing
For n = 0 To 5
    p(n).x = Rnd * xmax: p(n).y = Rnd * yymax: p(n).dx = Rnd * 2 - 1: p(n).dy = Rnd * 2 - 1
    f(n) = .1 * Rnd
Next

'screen labeling 3 lines for title above, 1 line instructions below
Cls
If mode = 0 Then
    yCP yoff - 60, "New Color Options for Plasma:"
Else
    yCP yoff - 60, "Traditional High Contrast Plasma: Black Borders and White Centers"
End If
yCP yoff - 40, "Shaded Borders: RGB(" + TS$(r1 \ 1) + ", " + TS$(g1 \ 1) + ", " + TS$(b1 \ 1) + ")"
yCP yoff - 20, "Centers: RGB(" + TS$(r2 \ 1) + ", " + TS$(g2 \ 1) + ", " + TS$(b2 \ 1) + ")"
yCP yoff + yymax + 10, "Press t to toggle between Traditional and New Color Options Plasma"
yCP yoff + yymax + 30, "Press spacebar to get a new color set."

While _KeyDown(27) = 0
    k$ = InKey$
    If k$ = " " Then GoTo restart
    If k$ = "t" Then mode = 1 - mode: GoTo restart
    t = Timer(.001)
    For i = 0 To 5
        p(i).x = p(i).x + p(i).dx
        If p(i).x > xxmax Then p(i).dx = -p(i).dx: p(i).x = xxmax
        If p(i).x < 0 Then p(i).dx = -p(i).dx: p(i).x = 0
        p(i).y = p(i).y + p(i).dy
        If p(i).y > xxmax Then p(i).dy = -p(i).dy: p(i).y = yymax
        If p(i).y < 0 Then p(i).dy = -p(i).dy: p(i).y = 0
    Next
    For y = 0 To yymax - 1 Step 2
        For x = 0 To xxmax - 1 Step 2
            d = 0
            For n = 0 To 5
                dx = x - p(n).x: dy = y - p(n).y
                dist = Sqr(dx * dx + dy * dy)
                'dist = _HYPOT(dx, dy)    'this may work faster on another system
                d = d + (Sin(dist * f(n)) + 1) / 2
            Next n: d = d * 60
            Line (x + xoff, y + yoff)-Step(2, 2), c(d), BF
        Next
    Next
    yCP yoff + yymax + 50, Space$(50)
    yCP yoff + yymax + 50, TS$(Int(1000 * (Timer(.001) - t))) + " ms per frame"
    _Display
Wend

Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    midInk~& = _RGBA32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##, 255)
End Function

Sub yCP (y, s$) 'for xmax pixel wide graphics screen Center Print at pixel y row
    _PrintString ((_Width - Len(s$) * 8) / 2, y), s$
End Sub

Function TS$ (n As Integer)
    TS$ = _Trim$(Str$(n))
End Function


Attached Files Image(s)
   
b = b + ...
Reply
#6
Then I start attempting faster frame Plasma letting small squares of color replace pixels:
Code: (Select All)
Option _Explicit
_Title "Plasmatic 5.1 Speed Tests" ' b+ 2020-01-26
' Try no SQR for distance

Const xxmax = 700, yymax = 500, xmax = 900, ymax = 740, xoff = (xmax - xxmax) \ 2, yoff = (ymax - yymax) \ 2
Type xy
    x As Single
    y As Single
    dx As Single
    dy As Single
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 250, 0
Randomize Timer
Dim c(1440) As _Unsigned Long, p(6) As xy, f(6)
Dim i As Integer, m As Integer, n As Integer, mode As Integer, cnt As Integer, k$, t, x, y, d, dx, dy, dist, s, stepper, tot
Dim r As Integer, g As Integer, b As Integer, r1 As Integer, g1 As Integer, b1 As Integer, r2 As Integer, g2 As Integer, b2 As Integer

restart: 'select rgb1 and rgb2 based on mode of color mixing
If mode = 0 Then 'new plasma option ANY color for border and ANY color for middle
    r1 = Rnd * 255: g1 = Rnd * 255: b1 = Rnd * 255: r2 = Rnd * 255: g2 = Rnd * 255: b2 = Rnd * 255
Else ' traditional high contrast plasma black borders, white centers
    r1 = 0: g1 = 0: b1 = 0: r2 = 255: g2 = 255: b2 = 255 'regular Plasma
End If

' create 6 x 60 bands of color palette based on coloring mode (rgb1 set and rgb2 set)
For i = 0 To 720
    If i Mod 60 = 0 Then r = Rnd * 255: g = Rnd * 255: b = Rnd * 255
    m = i Mod 60
    s = 1 - ((30 - m + .5) / 30) ^ 2
    Select Case m
        Case Is < 15: c(i) = midInk(s * r1, s * g1, s * b1, s * r, s * g, s * b, m / 15) '        1st stage increase rgb1 towards rgb color in 15 steps
        Case Is < 30: c(i) = midInk(s * r, s * g, s * b, s * r2, s * g2, s * b2, (m - 15) / 15) ' 2nd stage increase rgb color towards rgb2 set in 15 steps
        Case Is < 45: c(i) = midInk(s * r2, s * g2, s * b2, s * r, s * g, s * b, (m - 30) / 15) ' 3rd stage decrease rgb2 color back to rgb color in 15 steps
        Case Is < 60: c(i) = midInk(s * r, s * g, s * b, s * r1, s * g1, s * b1, (m - 45) / 15) ' 4th and finally decrease rgb back to starting rgb1 set in 15 steps
    End Select
Next

' behind the scenes variables for motion, weighting and shaping color mixing
For n = 0 To 6
    p(n).x = Rnd * xmax: p(n).y = Rnd * yymax: p(n).dx = Rnd * 2 - 1: p(n).dy = Rnd * 2 - 1
    f(n) = .09 * Rnd
Next

'screen labeling 3 lines for title above, 1 line instructions below
Cls
If mode = 0 Then
    yCP yoff - 60, "New Color Options for Plasma:"
Else
    yCP yoff - 60, "Traditional High Contrast Plasma: Black Borders and White Centers"
End If
yCP yoff - 40, "Shaded Borders: RGB(" + TS$(r1 \ 1) + ", " + TS$(g1 \ 1) + ", " + TS$(b1 \ 1) + ")"
yCP yoff - 20, "Centers: RGB(" + TS$(r2 \ 1) + ", " + TS$(g2 \ 1) + ", " + TS$(b2 \ 1) + ")"
yCP yoff + yymax + 10, "Press t to toggle between Traditional and New Color Options Plasma"
yCP yoff + yymax + 30, "Press spacebar to get a new color set."

While _KeyDown(27) = 0
    k$ = InKey$
    If k$ = " " Then GoTo restart
    If k$ = "t" Then mode = 1 - mode: GoTo restart
    t = Timer(.001)
    For i = 0 To 6
        p(i).x = p(i).x + p(i).dx
        If p(i).x > 2 * xxmax Then p(i).dx = -p(i).dx: p(i).x = 2 * xxmax
        If p(i).x < -xxmax Then p(i).dx = -p(i).dx: p(i).x = -xxmax
        p(i).y = p(i).y + p(i).dy
        If p(i).y > 2 * yymax Then p(i).dy = -p(i).dy: p(i).y = 2 * yymax
        If p(i).y < -yymax Then p(i).dy = -p(i).dy: p(i).y = -yymax
    Next
    stepper = 3
    For y = 0 To yymax - 1 Step stepper
        For x = 0 To xxmax - 1 Step stepper
            d = 0
            For n = 0 To 6
                dx = x - p(n).x: dy = y - p(n).y
                dist = .0005 * (dx * dx + dy * dy)
                'dist = SQR(dx * dx + dy * dy)
                'dist = _HYPOT(dx, dy)    'this may work faster on another system
                d = d + (Sin(dist * f(n)) + 1) / 2
            Next n: d = d * 120
            Line (x + xoff, y + yoff)-Step(stepper, stepper), c(d), BF
        Next
    Next
    cnt = cnt + 1
    tot = tot + Timer(.001) - t
    If cnt = 100 Then
        yCP yoff + yymax + 50, Space$(50)
        yCP yoff + yymax + 50, Right$("   " + TS$(Int(1000 * tot / 100)), 4) + " ms per frame"
        cnt = 0: tot = 0
    End If
    _Display
Wend

Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    midInk~& = _RGBA32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##, 255)
End Function

Sub yCP (y, s$) 'for xmax pixel wide graphics screen Center Print at pixel y row
    _PrintString ((_Width - Len(s$) * 8) / 2, y), s$
End Sub

Function TS$ (n As Integer)
    TS$ = _Trim$(Str$(n))
End Function


Attached Files Image(s)
   
b = b + ...
Reply
#7
Somewhen about this time Ken starts or requests Lava Lamp:
Code: (Select All)
'Lava Lamp modified by Ken G. and from b+ and from SmallBASIC.   mod again B+
_Title "press spacebar" ' b+ 2020-01-20 translated and modified from SmallBASIC
'Plasma Magnifico - updated 2015-11-26 for Android
'This program creates a plasma surface, which looks oily or silky.

Const xmax = 250, ymax = 600
Type xy
    x As Single
    y As Single
    dx As Single
    dy As Single
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 40

Dim c(360) As _Unsigned Long, p(6) As xy, f(6)

restart:
r = Rnd: g = Rnd: b = Rnd: i = 0
For n = 1 To 2
    r1 = r: g1 = g: b1 = b
    Do: r = Rnd: Loop Until Abs(r - r1) > .2
    Do: g = Rnd: Loop Until Abs(g - g1) > .2
    Do: b = Rnd: Loop Until Abs(g - g1) > .2
    For m = 0 To 17: m1 = 17 - m
        f1 = (m * r) / 18: f2 = (m * g) / 18: f3 = (m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m + m1 * r) / 18: f2 = (m + m1 * g) / 18: f3 = (m + m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m1 + m * r) / 18: f2 = (m1 + m * g) / 18: f3 = (m1 + m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m1 * r) / 18: f2 = (m1 * g) / 18: f3 = (m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
Next

For n = 0 To 2
    p(n).x = Rnd * xmax: p(n).y = Rnd * ymax: p(n).dx = .25 * (Rnd * 2 - 1): p(n).dy = 2 * (Rnd * 2 - 1)
    f(n) = .015
Next

While _KeyDown(27) = 0
    Cls
    If InKey$ = " " Then GoTo restart
    For i = 0 To 2
        p(i).x = p(i).x + p(i).dx
        If p(i).x > xmax - 50 Or p(i).x < 50 Then p(i).dx = -p(i).dx
        p(i).y = p(i).y + p(i).dy
        If p(i).y > ymax + 100 Or p(i).y < -100 Then p(i).dy = -p(i).dy
    Next
    For y = 0 To ymax - 1 Step 2
        For x = 0 To xmax - 1 Step 2
            d = 0
            For n = 0 To 2
                dx = x - p(n).x: dy = y - p(n).y
                k = Sqr(dx * dx + dy * dy)
                d = d + (Sin(k * f(n)) + 1) / 2
            Next n: d = d * 60
            Line (x, y)-Step(2, 2), c(d), BF
        Next
    Next
    _Display
    _Limit 20
Wend

Function rgbf~& (n1, n2, n3)
    rgbf~& = _RGB32(n1 * 255, n2 * 255, n3 * 255)
End Function


Attached Files Image(s)
   
b = b + ...
Reply
#8
This one is for johnno:
Code: (Select All)
Option _Explicit
_Title "Plasmatic Water Textures maybe" ' b+ 2020-01-26
' Hopefully this will add shading to the new color options found in Pasmatic 4.
' 2022-01-31 try water textures

Const xxmax = 800, yymax = 600, xmax = 900, ymax = 740, xoff = (xmax - xxmax) \ 2, yoff = (ymax - yymax) \ 2
Type xy
    x As Single
    y As Single
    dx As Single
    dy As Single
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 250, 0
Randomize Timer
Dim c(360) As _Unsigned Long, p(10) As xy, f(10)
Dim i As Integer, m As Integer, n As Integer, mode As Integer, k$, t, x, y, d, dx, dy, dist, s
Dim r As Integer, g As Integer, b As Integer, r1 As Integer, g1 As Integer, b1 As Integer, r2 As Integer, g2 As Integer, b2 As Integer

restart: 'select rgb1 and rgb2 based on mode of color mixing
If mode = 0 Then 'new plasma option ANY color for border and ANY color for middle
    r1 = 0: g1 = 0: b1 = 100 + Rnd * 155: r2 = 255: g2 = 255: b2 = 200 + Rnd * 55
Else ' traditional high contrast plasma black borders, white centers
    r1 = 0: g1 = 0: b1 = 0: r2 = 255: g2 = 255: b2 = 255 'regular Plasma
End If

' create 6 x 60 bands of color palette based on coloring mode (rgb1 set and rgb2 set)
For i = 0 To 360
    If i Mod 60 = 0 Then r = 0: g = 0: b = 100 + Rnd * 155
    m = i Mod 60
    s = 1 - ((30 - m + .5) / 30) ^ 2
    Select Case m
        Case Is < 15: c(i) = midInk(s * r1, s * g1, s * b1, s * r, s * g, s * b, m / 15) '        1st stage increase rgb1 towards rgb color in 15 steps
        Case Is < 30: c(i) = midInk(s * r, s * g, s * b, s * r2, s * g2, s * b2, (m - 15) / 15) ' 2nd stage increase rgb color towards rgb2 set in 15 steps
        Case Is < 45: c(i) = midInk(s * r2, s * g2, s * b2, s * r, s * g, s * b, (m - 30) / 15) ' 3rd stage decrease rgb2 color back to rgb color in 15 steps
        Case Is < 60: c(i) = midInk(s * r, s * g, s * b, s * r1, s * g1, s * b1, (m - 45) / 15) ' 4th and finally decrease rgb back to starting rgb1 set in 15 steps
    End Select
Next

' behind the scenes variables for motion, weighting and shaping color mixing
For n = 0 To 2
    p(n).x = Rnd * xmax: p(n).y = Rnd * yymax: p(n).dx = Rnd * 2 - 1: p(n).dy = Rnd * 2 - 1
    f(n) = .1 * Rnd
Next

'screen labeling 3 lines for title above, 1 line instructions below
Cls
If mode = 0 Then
    yCP yoff - 60, "New Color Options for Plasma:"
Else
    yCP yoff - 60, "Traditional High Contrast Plasma: Black Borders and White Centers"
End If
yCP yoff - 40, "Shaded Borders: RGB(" + TS$(r1 \ 1) + ", " + TS$(g1 \ 1) + ", " + TS$(b1 \ 1) + ")"
yCP yoff - 20, "Centers: RGB(" + TS$(r2 \ 1) + ", " + TS$(g2 \ 1) + ", " + TS$(b2 \ 1) + ")"
yCP yoff + yymax + 10, "Press t to toggle between Traditional and New Color Options Plasma"
yCP yoff + yymax + 30, "Press spacebar to get a new color set."

While _KeyDown(27) = 0
    k$ = InKey$
    If k$ = " " Then GoTo restart
    If k$ = "t" Then mode = 1 - mode: GoTo restart
    t = Timer(.001)
    For i = 0 To 5
        p(i).x = p(i).x + p(i).dx
        If p(i).x > xxmax Then p(i).dx = -p(i).dx: p(i).x = xxmax
        If p(i).x < 0 Then p(i).dx = -p(i).dx: p(i).x = 0
        p(i).y = p(i).y + p(i).dy
        If p(i).y > xxmax Then p(i).dy = -p(i).dy: p(i).y = yymax
        If p(i).y < 0 Then p(i).dy = -p(i).dy: p(i).y = 0
    Next
    For y = 0 To yymax - 1 Step 2
        For x = 0 To xxmax - 1 Step 2
            d = 0
            For n = 0 To 5
                dx = x - p(n).x: dy = y - p(n).y
                dist = Sqr(dx * dx + dy * dy)
                'dist = _HYPOT(dx, dy)    'this may work faster on another system
                d = d + (Sin(dist * f(n)) + 1) / 2
            Next n: d = d * 60
            Line (x + xoff, y + yoff)-Step(2, 2), c(d), BF
        Next
    Next
    yCP yoff + yymax + 50, Space$(50)
    yCP yoff + yymax + 50, TS$(Int(1000 * (Timer(.001) - t))) + " ms per frame"
    _Display
Wend

Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    midInk~& = _RGBA32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##, 255)
End Function

Sub yCP (y, s$) 'for xmax pixel wide graphics screen Center Print at pixel y row
    _PrintString ((_Width - Len(s$) * 8) / 2, y), s$
End Sub

Function TS$ (n As Integer)
    TS$ = _Trim$(Str$(n))
End Function


Attached Files Image(s)
   
b = b + ...
Reply
#9
One experiment with number of points I updated very recently:
Code: (Select All)
_Title "Plasmatic nPoints Test #2, press spacebar for new color set" 'b+ 2020-01-22
' from Plasmatic  press spacebar for new coloring set" ' b+ 2020-01-20 translated and modified from SmallBASIC
'Plasma Magnifico - updated 2015-11-26 for Android
'This program creates a plasma surface, which looks oily or silky.

'2022-05-02 take nPoints out of const and change with spacebar
Const xmax = 800, ymax = 600 '<<<<<<<<<<<<<<<<<< use 1 to 8 after 8 it runs too slow to enjoy most interesting is 1 or 2
Type xy
    x As Single
    y As Single
    dx As Single
    dy As Single
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 40

restart:
nPoints = Int(Rnd * 15) + 1
_Title "  Plasmatic N Points =" + Str$(nPoints)
ReDim c((nPoints + 1) * 80) As _Unsigned Long, p(nPoints) As xy, f(nPoints)
Cls
r = Rnd: g = Rnd: b = Rnd: i = 0
For n = 1 To nPoints
    r1 = r: g1 = g: b1 = b
    Do: r = Rnd: Loop Until Abs(r - r1) > .1
    Do: g = Rnd: Loop Until Abs(g - g1) > .1
    Do: b = Rnd: Loop Until Abs(g - g1) > .1
    For m = 0 To 17: m1 = 17 - m
        f1 = (m * r) / 18: f2 = (m * g) / 18: f3 = (m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m + m1 * r) / 18: f2 = (m + m1 * g) / 18: f3 = (m + m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m1 + m * r) / 18: f2 = (m1 + m * g) / 18: f3 = (m1 + m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m1 * r) / 18: f2 = (m1 * g) / 18: f3 = (m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
Next

For n = 0 To nPoints
    p(n).x = Rnd * xmax: p(n).y = Rnd * ymax: p(n).dx = Rnd * 2 - 1: p(n).dy = Rnd * 2 - 1
    f(n) = Rnd * .1
Next

While _KeyDown(27) = 0
    If InKey$ = " " Then GoTo restart
    For i = 0 To nPoints
        p(i).x = p(i).x + p(i).dx
        If p(i).x > xmax Or p(i).x < 0 Then p(i).dx = -p(i).dx
        p(i).y = p(i).y + p(i).dy
        If p(i).y > ymax Or p(i).y < 0 Then p(i).dy = -p(i).dy
    Next

    For y = 0 To ymax - 1 Step 2
        For x = 0 To xmax - 1 Step 2
            d = 0
            For n = 0 To nPoints
                dx = x - p(n).x: dy = y - p(n).y
                k = Sqr(dx * dx + dy * dy)
                d = d + (Sin(k * f(n)) + 1) / 2
            Next n: d = d * 60
            Line (x, y)-Step(2, 2), c(d), BF
        Next
    Next
    _Display
    _Limit 100
Wend

Function rgbf~& (n1, n2, n3)
    rgbf~& = _RGB32(n1 * 255, n2 * 255, n3 * 255)
End Function

One point almost takes us back to Ectoplasm.
   
b = b + ...
Reply
#10
But what would Pete do?

Maybe this:
Code: (Select All)
_Title "Ansii Plasma - press spacebar for new set of points, be sure to swirl your mouse in the stuff!" ' b+ 2021-11-11
_ScreenMove 100, 40

Type xy
    x As Single
    y As Single
    dx As Single
    dy As Single
End Type

Randomize Timer
Width 150, 80
_Font 8

nP = 6
Dim p(1 To nP) As xy, f(6)

restart:
For n = 1 To nP
    p(n).x = Rnd * _Width: p(n).y = Rnd * _Height: p(n).dx = .25 * (Rnd * 2 - 1): p(n).dy = 2 * (Rnd * 2 - 1)
    f(n) = n * .015
Next

While _KeyDown(27) = 0
    Cls
    If InKey$ = " " Then GoTo restart
    For i = 1 To nP - 1
        p(i).x = p(i).x + p(i).dx
        If p(i).x > _Width - 1 Or p(i).x < 1 Then p(i).dx = -p(i).dx
        If p(i).x < 1 Then p(i).x = 1: If p(i).x > _Width Then p(i).x = _Width
        p(i).y = p(i).y + p(i).dy
        If p(i).y > _Height Or p(i).y < 1 Then p(i).dy = -p(i).dy
        If p(i).y < 1 Then p(i).y = 1: If p(i).y > _Height Then p(i).y = _Height
    Next
    While _MouseInput: Wend
    p(nP).x = _MouseX: p(nP).y = _MouseY
    For y = 1 To _Height
        For x = 1 To _Width
            d = 0
            For n = 1 To nP
                dx = x - p(n).x: dy = y - p(n).y
                k = Sqr(dx * dx + dy * dy)
                d = d + (Sin(k * f(n)) + 1) / 2
            Next
            Locate y, x: Print Chr$(Int(d * 20));
        Next
    Next
    _Display
    _Limit 40
Wend

   
b = b + ...
Reply




Users browsing this thread: 1 Guest(s)