Proggies

[NakedApe]

Very cool. It looks like jewelry. Me like.

[PhilOfPerth]

Curlies

Code: (Select All)

Screen _NewImage(1200, 700, 12)
_ScreenMove 40, 20
Color 15, 4
For j = 3.14 To 6.28 Step .0314
    Cls: c = c + 1: Print c, "press any..."
    x = 600: x1 = x: y = 350: f = 0
    For z = 1 To 200000
        f = f + j: g = f * f * .25
        x = x + Cos(g): x1 = x1 - Cos(g)
        y = y + Sin(g): p = z Mod 255
        PSet (x, y), _RGB(p, p, p)
        PSet (x1, y), _RGB(p, p, p)
    Next
    Sleep
Next

I could see a jewellery-designer using this for inspiration for necklaces, brooches etc.
Fascinating result from so few lines of code!

[vince]

yeah looks like decorative sewing, very nice mod

[bplus]

Star Vortex

Warning: spinning flashing colors

Code: (Select All)

_Title "Star Vortex: key 3 to 9 for star points, spacebar for color change"
' Star Vortex.bas  SmallBASIC 0.12.9 [B+=MGA] 2017-04-19
' Inspired by Andy Amaya's recent Neon Vortex at SdlBasic

' ++++++++++++     Instructions !   +++++++++++++
' Press Spacebar to change Plasma Coloring Setting
' Press Number keys 3 to 9 for that many pointed stars
'+++++++++++++++++++++++++++++++++++++++++++++++++++++

Randomize Timer
Const xmax = 500
Const ymax = 500
Const cx = xmax / 2
Const cy = ymax / 2
Dim Shared pR, pG, pB, pN

Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 20

nP = 5: ao = 0
resetPlasma
While _KeyDown(27) = 0
    k$ = InKey$
    If Len(k$) = 1 Then
        If k$ = " " Then resetPlasma
        If Val(k$) > 2 And Val(k$) <= 9 Then nP = Val(k$)
    End If
    aoo = 0
    For i = 170 To 10 Step -1
        star cx, cy, i, 3 * i, nP, i + ao, setPlasma~&
    Next
    _Display
    ao = ao - 5
Wend

Sub star (x, y, rInner, rOuter, nPoints, angleOffset, K As _Unsigned Long)
    ' x, y are same as for circle,
    ' rInner is center circle radius
    ' rOuter is the outer most point of star
    ' nPoints is the number of points,
    ' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
    ' this is to allow us to spin the polygon of n sides
    Dim pAngle, radAngleOffset, x1, y1, x2, y2, x3, y3, i As Long

    pAngle = _D2R(360 / nPoints): radAngleOffset = _D2R(angleOffset)
    x1 = x + rInner * Cos(radAngleOffset)
    y1 = y + rInner * Sin(radAngleOffset)
    For i = 0 To nPoints - 1
        x2 = x + rOuter * Cos(i * pAngle + radAngleOffset + .5 * pAngle)
        y2 = y + rOuter * Sin(i * pAngle + radAngleOffset + .5 * pAngle)
        x3 = x + rInner * Cos((i + 1) * pAngle + radAngleOffset)
        y3 = y + rInner * Sin((i + 1) * pAngle + radAngleOffset)
        FillTriangle x1, y1, x2, y2, x3, y3, K
        'triangles leaked
        Line (x1, y1)-(x2, y2), K
        Line (x2, y2)-(x3, y3), K
        Line (x3, y3)-(x1, y1), K
        x1 = x3: y1 = y3
    Next
    Paint (x, y), K, K
End Sub

Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    $Checking:Off
    Static a&, m As _MEM
    If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
    _MemPut m, m.OFFSET, K
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    $Checking:On
End Sub

Sub resetPlasma
    'all globals
    pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2: pN = 0
End Sub

Function setPlasma~& () 'all globals
    pN = pN + 1
    setPlasma~& = _RGB32(127 + 99 * Sin(pR * pN), 127 + 99 * Sin(pG * pN), 127 + 99 * Sin(pB * pN))
End Function

   

[Dav]

Awesome star proggie!  Gets a +1 from me.

- Dav

[bplus]

Flame On

Code: (Select All)

_Title "Flame on by bplus 2017-11-23"
' flame on.bas SmallBASIC 0.12.9 (B+=MGA) 2017-11-22

Const xmax = 800
Const ymax = 600

Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 60 'adjust as needed _MIDDLE needs a delay .5 or more for me

xxmax = 200: yymax = 75 'pixels too slow
xstep = xmax / xxmax: ystep = ymax / yymax
Dim p&(300) 'pallette
For i = 1 To 100
    fr = 240 * i / 100 + 15
    p&(i) = _RGB(fr, 0, 0)
    p&(i + 100) = _RGB(255, fr, 0)
    p&(i + 200) = _RGB(255, 255, fr)
Next
Dim f(xxmax, yymax + 2) 'fire array and seed
For x = 0 To xxmax
    f(x, yymax + 1) = Int(Rnd * 2) * 300
    f(x, yymax + 2) = 300
Next
Color , &HFF4444DD
While 1 'main fire
    Cls
    For x = 1 To xxmax - 1 'shift fire seed a bit
        r = Rnd
        If r < .15 Then
            f(x, yymax + 1) = f(x - 1, yymax + 1)
        ElseIf r < .3 Then
            f(x, yymax + 1) = f(x + 1, yymax + 1)
        ElseIf r < .35 Then
            f(x, yymax + 1) = Int(Rnd * 2) * 300
        End If
    Next
    For y = 0 To yymax 'fire based literally on 4 pixels below it like cellular automata
        For x = 1 To xxmax - 1
            f(x, y) = max((f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x - 1, y + 2)) / 4 - 5, 0)
            Line (x * xstep, y * ystep)-Step(xstep, ystep), p&(f(x, y)), BF
        Next
    Next
    _Display
Wend
Function max (a, b)
    If a > b Then max = a Else max = b
End Function

   
look like it needs some sort of blending

[madscijr]

Flame On

...
look like it needs some sort of blending

I love all these neat little "proggies" - keep up the good work!

[Dav]

Flame On

Code: (Select All)

_Title "Flame on by bplus 2017-11-23"
' flame on.bas SmallBASIC 0.12.9 (B+=MGA) 2017-11-22

Const xmax = 800
Const ymax = 600

Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 60 'adjust as needed _MIDDLE needs a delay .5 or more for me

xxmax = 200: yymax = 75 'pixels too slow
xstep = xmax / xxmax: ystep = ymax / yymax
Dim p&(300) 'pallette
For i = 1 To 100
    fr = 240 * i / 100 + 15
    p&(i) = _RGB(fr, 0, 0)
    p&(i + 100) = _RGB(255, fr, 0)
    p&(i + 200) = _RGB(255, 255, fr)
Next
Dim f(xxmax, yymax + 2) 'fire array and seed
For x = 0 To xxmax
    f(x, yymax + 1) = Int(Rnd * 2) * 300
    f(x, yymax + 2) = 300
Next
Color , &HFF4444DD
While 1 'main fire
    Cls
    For x = 1 To xxmax - 1 'shift fire seed a bit
        r = Rnd
        If r < .15 Then
            f(x, yymax + 1) = f(x - 1, yymax + 1)
        ElseIf r < .3 Then
            f(x, yymax + 1) = f(x + 1, yymax + 1)
        ElseIf r < .35 Then
            f(x, yymax + 1) = Int(Rnd * 2) * 300
        End If
    Next
    For y = 0 To yymax 'fire based literally on 4 pixels below it like cellular automata
        For x = 1 To xxmax - 1
            f(x, y) = max((f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x - 1, y + 2)) / 4 - 5, 0)
            Line (x * xstep, y * ystep)-Step(xstep, ystep), p&(f(x, y)), BF
        Next
    Next
    _Display
Wend
Function max (a, b)
    If a > b Then max = a Else max = b
End Function

look like it needs some sort of blending

Nice one!  With a back background it looks flawless.

- Dav

[bplus]

oops sorry @Dav, i edited your post instead of making my reply this:

thanks yes that is where this snippet came from. i wonder if i change palette of colors so they blend towards background color instead of black?

[dbox]

Nice one @bplus!

Obligitory QBJS version: