+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: bplus (https://qb64phoenix.com/forum/forumdisplay.php?fid=36)
+---- Thread: Proggies (/showthread.php?tid=162)
RE: Proggies - NakedApe - 06-14-2024
Very cool. It looks like jewelry. Me like.
RE: Proggies - PhilOfPerth - 06-14-2024
(06-14-2024, 01:58 AM)bplus Wrote: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!
RE: Proggies - vince - 06-14-2024
yeah looks like decorative sewing, very nice mod
RE: Proggies - bplus - 06-14-2024
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 FunctionRE: Proggies - Dav - 06-14-2024
Awesome star proggie! Gets a +1 from me.
- Dav
RE: Proggies - bplus - 06-19-2024
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 Functionlook like it needs some sort of blending
RE: Proggies - madscijr - 06-20-2024
(06-19-2024, 10:14 PM)bplus Wrote:Flame On...
look like it needs some sort of blending
I love all these neat little "proggies" - keep up the good work!
RE: Proggies - Dav - 06-20-2024
(06-19-2024, 10:14 PM)bplus Wrote: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
RE: Proggies - bplus - 06-20-2024
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?
RE: Proggies - dbox - 06-20-2024
Nice one @bplus!
Obligitory QBJS version: