Posts: 3,446
Threads: 376
Joined: Apr 2022
Reputation:
345
There's no Randomize Timer involved, so this seems to be a system thing. Mine has one set number (453 I think). Dav's has a set number (800something). I don't know why those numbers are different, but it's a random thing. Maybe different compilers start you off with a different seed? Or one rounds a value differently somewhere along the way?
We've swapped compilers and such things regularly for bugfixes and whatnot, so it's just something involved with it, I'd imagine. Before, you were just getting lucky with your system giving you blocks scattered enough not to catch a worm.. Cause here's a question: What happens if you draw a white block OVER an existing worm? Like it pops up inside it or something? Wouldn't that lead to this endless loop of trying to move when it can't, as it's now caged inside?
Boxes on every side could trap a worm, but a box growing around a worm seems more likely to me. But since these are random boxes, who knows when that might have happened with the old compiler/version? On run 400? 800? or 80000?
Posts: 4,693
Threads: 222
Joined: Apr 2022
Reputation:
322
Yeah looking at all those Exit Fors and the TryAgain: line, worms were getting trapped all the time.
The wormS drawing code needs to be a worm drawing code with far less adaption to the worm yard.
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 811
Threads: 128
Joined: Apr 2022
Reputation:
135
About to leave for a new years day cookout, but wanted to share a little worm saver before leaving.
Hope you guys have a great day!
- Dav
Code: (Select All)
Option _Explicit
Randomize Timer
Screen _NewImage(1000, 640, 32)
Dim worms, wormmin, wormmax, i
worms = 50 'number of worms on screen
wormmin = 7 'smallest size a worm can get
wormmax = 16 'largest size an worm can get
Dim wormx(worms), wormy(worms), wormsiz(worms), wormgro(worms), wormdir(worms)
Dim wormred(worms), wormgrn(worms), wormblu(worms)
'generate worm values
For i = 1 To worms
wormx(i) = Rnd * _Width 'x pos
wormy(i) = Rnd * _Height 'y pos
wormsiz(i) = wormmin + (Rnd * wormmax - wormmin) 'worm size
wormgro(i) = Int(Rnd * 2) 'way worm is changing, 0=shrinking, 1=growing
wormdir(i) = Int(Rnd * 4) 'random direction worm can drift (4 different ways)
wormred(i) = Rnd * 255 'red color
wormgrn(i) = Rnd * 255 'grn color
wormblu(i) = Rnd * 255 'blu color
Next
Do
For i = 1 To worms
fc wormx(i), wormy(i), wormsiz(i), _RGB(wormred(i), wormgrn(i), wormblu(i)), 1
'== change worm values
'if worm is shrinking, subtract from size, else add to it
If wormgro(i) = 0 Then
wormsiz(i) = wormsiz(i) - .1
Else
wormsiz(i) = wormsiz(i) + .1
End If
'if worm reaches maximum size, switch growth value to 0 to start shrinking now
If wormsiz(i) >= wormmax Then wormgro(i) = 0
'if worm reaches minimum size, switch growth value to 1 to start growing now
If wormsiz(i) <= wormmin Then wormgro(i) = 1
'move worm in 1 of 4 directions we generated, and +x,-x,+y,-y to it.
If wormdir(i) = 0 Then wormx(i) = wormx(i) + 2 'drift right
If wormdir(i) = 1 Then wormx(i) = wormx(i) - 2 'drift left
If wormdir(i) = 2 Then wormy(i) = wormy(i) + 2 'drift down
If wormdir(i) = 3 Then wormy(i) = wormy(i) - 2 'drift up
'change drifting direction now and then
If Int(Rnd * 25) = 1 Then wormdir(i) = Int(Rnd * 4)
'this creates the shakiness. randomly adjust x/y positions by +/-2 each step
If Int(Rnd * 2) = 0 Then wormx(i) = wormx(i) + 2 Else wormx(i) = wormx(i) - 2
If Int(Rnd * 2) = 0 Then wormy(i) = wormy(i) + 2 Else wormy(i) = wormy(i) - 2
'below handles if worm goes off screen, let it dissapear completely
If wormx(i) > _Width + wormsiz(i) Then wormx(i) = -wormsiz(i)
If wormx(i) < -wormsiz(i) Then wormx(i) = _Width + wormsiz(i)
If wormy(i) > _Height + wormsiz(i) Then wormy(i) = -wormsiz(i)
If wormy(i) < -wormsiz(i) Then wormy(i) = _Height + wormsiz(i)
Next
_Display
_Limit 30
Loop Until InKey$ <> ""
Sub fc (cx As Integer, cy As Integer, radius As Integer, clr~&, grad)
Dim red, grn, blu, alpha, r2, y, x, i, dis, red2, grn2, blu2, clr2~&
If radius = 0 Then Exit Sub ' safety bail
If grad = 1 Then
red = _Red32(clr~&)
grn = _Green32(clr~&)
blu = _Blue32(clr~&)
alpha = _Alpha32(clr~&)
End If
r2 = radius * radius
For y = -radius To radius
x = Sqr(r2 - y * y)
' If doing gradient
If grad = 1 Then
For i = -x To x
dis = Sqr(i * i + y * y) / radius
red2 = red * (1 - dis) + (red / 2) * dis
grn2 = grn * (1 - dis) + (grn / 2) * dis
blu2 = blu * (1 - dis) + (blu / 2) * dis
clr2~& = _RGBA(red2, grn2, blu2, alpha)
Line (cx + i, cy + y)-(cx + i, cy + y), clr2~&, BF
Next
Else
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
End If
Next
End Sub
Posts: 4,693
Threads: 222
Joined: Apr 2022
Reputation:
322
01-01-2026, 05:39 PM
(This post was last modified: 01-01-2026, 05:39 PM by bplus.)
Heres mine:
Code: (Select All) Option _Explicit
_Title "From DrawWorm to Living Spaghetti" 'bplus mod 2026-01-01 from:
'_Title "DrawWorms Test and Demo, worms should avoid Yellow and White" 'b+ 2021-10-06
' This is intended for Crypt-O-Gram Puzzle but may use else where also.
' This needs to be done in background on the side and updated with main loop in program using it.
' 2026-01-01 attempting to make living spaghetti from this worm program
' 1. no more black background where worm crawls
' 2. no more black ouline of segmented worm
' 3. color greasy spaghetti on very light brown pasta
' 4. makeover drawWorms to DrawStrand
' 5. no worm Yard
' Use general Object
Type Object
X As Single ' usu top left corner could be center depending on object
Y As Single ' ditto
W As Single ' width or maybe radius
H As Single ' height or length
DX As Single ' moving opjects
DY As Single ' ditto
DIR As Single ' short for direction or heading usu a radian angle
S As Single ' perhaps a scaling factor, speed or size
Act As Integer ' lives countdown or just plain ACTive TF
C1 As _Unsigned Long ' a foreground color
C2 As _Unsigned Long ' a background or 2nd color OR C1 to c2 Range?
End Type
Const nStrand = 30
Const xmax = 800, ymax = 600
Screen _NewImage(xmax, ymax, 32)
_Delay .1
_ScreenMove _Middle
Dim Shared Strand(1 To nStrand) As Object
Dim maxStrandLength
maxStrandLength = 650 ' max strand(i).H
Dim Shared XX(1 To nStrand, 1 To maxStrandLength), YY(1 To nStrand, 1 To maxStrandLength)
Dim As Long i, j
'init
For i = 1 To nStrand
NewStrand i
Next
For j = 1 To maxStrandLength
Cls
For i = 1 To nStrand
DrawStrand i
Next
_Display
Next
Do
Cls
For i = 1 To nStrand
DrawStrand i
Next
_Limit 60
_Display
Loop Until _KeyDown(27)
Sub DrawStrand (i) ' one frame in main loop
Dim x, y
Dim As Long j
If Rnd < .5 Then
Strand(i).DX = Strand(i).DX + .8 * Rnd - .4
Else
Strand(i).DY = Strand(i).DY + .8 * Rnd - .4
End If
If Abs(Strand(i).DX) > .5 * Strand(i).S Then Strand(i).DX = Strand(i).DX * .5 'not too big a change
If Abs(Strand(i).DY) > .5 * Strand(i).S Then Strand(i).DY = Strand(i).DY * .5
x = Strand(i).X + Strand(i).DX * Strand(i).S
y = Strand(i).Y + Strand(i).DY * Strand(i).S
If x < 0 Or x > _Width - 1 Then 'stay inbounds of screen
Strand(i).DX = -Strand(i).DX
x = x + Strand(i).S * 2 * Strand(i).DX ' double back
End If
If y < 0 Or y > _Height - 1 Then 'stay inbounds of screen
Strand(i).DY = -Strand(i).DY
y = y + Strand(i).S * 2 * Strand(i).DY ' double back
End If
For j = Strand(i).H To 2 Step -1
XX(i, j) = XX(i, j - 1): YY(i, j) = YY(i, j - 1) ' crawl towards head
If XX(i, j) And YY(i, j) Then Fcirc XX(i, j), YY(i, j), Strand(i).W, Strand(i).C1
'Fcirc x(i, j), y(i, j), Strand(i).W, Strand(i).C1
Next
XX(i, 1) = x: YY(i, 1) = y ' update head
Fcirc XX(i, 1), YY(i, 1), Strand(i).W, Strand(i).C1
Strand(i).X = x: Strand(i).Y = y
End Sub
Sub NewStrand (i)
Strand(i).X = _Width * Rnd
Strand(i).Y = _Height * Rnd
Strand(i).DIR = _Pi(2 * Rnd)
Strand(i).DX = Cos(Strand(i).DIR)
Strand(i).DY = Sin(Strand(i).DIR)
Strand(i).W = 6 ' radius
Strand(i).H = 650 - Rnd * 300 ' length
Strand(i).S = 2 ' speed
Strand(i).C1 = _RGB32(255 - 90 * Rnd, 255 - 60 * Rnd, 150 - 120 * Rnd)
End Sub
Sub Fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
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 Sub
I am so hungry now!
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 2,910
Threads: 305
Joined: Apr 2022
Reputation:
167
Well at least Steve didn't title it: Pete's Colon Challenge! Folks age 70 and over have more than enough colon challenges to deal with.
Pete 
Posts: 4,693
Threads: 222
Joined: Apr 2022
Reputation:
322
Ok less flat spaghetti but much slower too:
Code: (Select All) Option _Explicit
_Title "From DrawWorm to Living Spaghetti 2" 'bplus mod 2026-01-01 from:
'_Title "DrawWorms Test and Demo, worms should avoid Yellow and White" 'b+ 2021-10-06
' This is intended for Crypt-O-Gram Puzzle but may use else where also.
' This needs to be done in background on the side and updated with main loop in program using it.
' 2026-01-01 attempting to make living spaghetti from this worm program
' 1. no more black background where worm crawls
' 2. no more black ouline of segmented worm
' 3. color greasy spaghetti on very light brown pasta
' 4. makeover drawWorms to DrawStrand
' 5. no worm Yard
' Living Spaghetti 2 color strands in Fake 3D
' Use general Object
Type Object
X As Single ' usu top left corner could be center depending on object
Y As Single ' ditto
W As Single ' width or maybe radius
H As Single ' height or length
DX As Single ' moving opjects
DY As Single ' ditto
DIR As Single ' short for direction or heading usu a radian angle
S As Single ' perhaps a scaling factor, speed or size
Act As Integer ' lives countdown or just plain ACTive TF
C1 As _Unsigned Long ' a foreground color
C2 As _Unsigned Long ' a background or 2nd color OR C1 to c2 Range?
End Type
Const nStrand = 20
Const xmax = 800, ymax = 600
Screen _NewImage(xmax, ymax, 32)
_Delay .1
_ScreenMove _Middle
Dim Shared Strand(1 To nStrand) As Object
Dim Shared maxStrandLength
maxStrandLength = 1500 ' max strand(i).H
Dim Shared XX(1 To nStrand, 1 To maxStrandLength), YY(1 To nStrand, 1 To maxStrandLength)
Dim As Long i, j
'init
For i = 1 To nStrand
NewStrand i
Next
For j = 1 To maxStrandLength
Cls
For i = 1 To nStrand
DrawStrand i
Next
_Display
Next
Do
Cls
For i = 1 To nStrand
DrawStrand i
Next
_Display
Loop Until _KeyDown(27)
Sub DrawStrand (i) ' one frame in main loop
Dim x, y
Dim As Long j, r
Dim As _Unsigned Long colr
If Rnd < .5 Then
Strand(i).DX = Strand(i).DX + .4 * Rnd - .2
Else
Strand(i).DY = Strand(i).DY + .4 * Rnd - .2
End If
If Abs(Strand(i).DX) > .65 * Strand(i).S Then Strand(i).DX = Strand(i).DX * .5 'not too big a change
If Abs(Strand(i).DY) > .65 * Strand(i).S Then Strand(i).DY = Strand(i).DY * .5
x = Strand(i).X + Strand(i).DX * Strand(i).S
y = Strand(i).Y + Strand(i).DY * Strand(i).S
If x < 0 Or x > _Width - 1 Then 'stay inbounds of screen
Strand(i).DX = -Strand(i).DX
x = x + Strand(i).S * 2 * Strand(i).DX ' double back
End If
If y < 0 Or y > _Height - 1 Then 'stay inbounds of screen
Strand(i).DY = -Strand(i).DY
y = y + Strand(i).S * 2 * Strand(i).DY ' double back
End If
For r = Strand(i).W To 1 Step -1
colr = Ink~&(Strand(i).C1, _RGB32(255, 200, 150), (Strand(i).W - r) / Strand(i).W)
For j = Strand(i).H To 2 Step -1
XX(i, j) = XX(i, j - 1): YY(i, j) = YY(i, j - 1) ' crawl towards head
'If XX(i, j) And YY(i, j) Then Fcirc XX(i, j), YY(i, j), Strand(i).W, Strand(i).C1
Fcirc XX(i, j), YY(i, j), r, colr
Next
Next
XX(i, 1) = x: YY(i, 1) = y ' update head
Fcirc XX(i, 1), YY(i, 1), Strand(i).W, colr
Strand(i).X = x: Strand(i).Y = y
End Sub
Sub NewStrand (i)
Strand(i).X = _Width * Rnd
Strand(i).Y = _Height * Rnd
Strand(i).DIR = _Pi(2 * Rnd)
Strand(i).DX = Cos(Strand(i).DIR)
Strand(i).DY = Sin(Strand(i).DIR)
Strand(i).W = 6 ' radius
Strand(i).H = maxStrandLength - Rnd * 300 ' length
Strand(i).S = 2 ' speed
Strand(i).C1 = _RGB32(180 - 90 * Rnd, 195 - 60 * Rnd, 85 - 60 * Rnd)
End Sub
Sub Fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
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 Sub
Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
End Sub
Function Ink~& (c1 As _Unsigned Long, c2 As _Unsigned Long, fr##)
Dim R1, G1, B1, A1, R2, G2, B2, A2
cAnalysis c1, R1, G1, B1, A1
cAnalysis c2, R2, G2, B2, A2
Ink~& = _RGB32(R1 + (R2 - R1) * fr##, G1 + (G2 - G1) * fr##, B1 + (B2 - B1) * fr##, A1 + (A2 - A1) * fr##)
End Function
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
|
