QBJS Swimming fish with Kelp

[bplus]

@dbox once again I am stumped trying to get this going on QBJS

Code: (Select All)

'Option _Explicit
'_Title "     Fish:    press m for more,    l for less" 'b+ 2021-12-03
'
Dim Shared sw, sh, LHead$, LBody$, LTail$, RHead$, RBody$, RTail$
sw = 1024: sh = 700
LHead$ = "<*": LBody$ = ")": LTail$ = ">{"
RHead$ = "*>": RBody$ = "(": RTail$ = "}<"
Type fish
    As Integer LFish, X, Y, DX
    As String fish
    As _Unsigned Long Colr
End Type

Screen _NewImage(sw, sh, 32)

Color _RGB32(220), _RGB32(0, 0, 60)
Cls
'_PrintMode _KeepBackground
Dim As Integer i, nFish
Dim k$
nFish = 40

'restart:
ReDim Shared school(1 To nFish) As fish, kelp(sw, sh) As _Unsigned Long
growKelp
For i = 1 To nFish
    NewFish i, -1
Next
Do
    Cls
    k$ = InKey$
    'If k$ = "m" Then ' more fish
    '    nFish = nFish * 2
    '    If nFish > 300 Then Beep: nFish = 300
    '    'GoTo restart
    'End If
    'If k$ = "l" Then ' less fish
    '    nFish = nFish / 2
    '    If nFish < 4 Then Beep: nFish = 4
    '    'GoTo restart
    'End If
    For i = 1 To nFish ' draw fish behind kelp
        If _Red32(school(i).Colr) < 160 Then
            Color school(i).Colr
            _PrintString (school(i).X, school(i).Y), school(i).fish 'draw fish
            school(i).X = school(i).X + school(i).DX
            If school(i).LFish Then
                If school(i).X + Len(school(i).fish) * 8 < 0 Then NewFish i, 0
            Else
                If school(i).X - Len(school(i).fish) * 8 > _Width Then NewFish i, 0
            End If
        End If
    Next
    showKelp
    For i = 1 To nFish ' draw fish in from of kelp
        If _Red32(school(i).Colr) >= 160 Then
            Color school(i).Colr
            _PrintString (school(i).X, school(i).Y), school(i).fish 'draw fish
            school(i).X = school(i).X + school(i).DX
            If school(i).LFish Then
                If school(i).X + Len(school(i).fish) * 8 < 0 Then NewFish i, 0
            Else
                If school(i).X - Len(school(i).fish) * 8 > _Width Then NewFish i, 0
            End If
        End If
    Next

    _Display
    _Limit 10
Loop Until _KeyDown(27)

Sub NewFish (i, initTF)
    Dim gray
    gray = Rnd * 200 + 55
    school(i).Colr = _RGB32(gray) ' color
    If Rnd > .5 Then
        school(i).LFish = -1
        school(i).fish = LHead$ + String$(Int(Rnd * 5) + -2 * (gray > 160) + 1, LBody$) + LTail$
    Else
        school(i).LFish = 0
        school(i).fish = RTail$ + String$(Int(Rnd * 5) + -2 * (gray > 160) + 1, RBody$) + RHead$
    End If
    If initTF Then
        school(i).X = _Width * Rnd
    Else
        If school(i).LFish Then school(i).X = _Width + Rnd * 35 Else school(i).X = -35 * Rnd - Len(school(i).fish) * 8
    End If
    If gray > 160 Then
        If school(i).LFish Then school(i).DX = -18 * Rnd - 3 Else school(i).DX = 18 * Rnd + 3
    Else
        If school(i).LFish Then school(i).DX = -6 * Rnd - 1 Else school(i).DX = 6 * Rnd + 1
    End If
    school(i).Y = _Height * Rnd
End Sub

Sub growKelp
    Dim kelps, x, y, r
    ReDim kelp(sw, sh) As _Unsigned Long
    kelps = Int(Rnd * 20) + 20
    For x = 1 To kelps
        kelp(Int(Rnd * sw / 8), (sh - 16) / 16) = _RGB32(0, Rnd * 128, 0)
    Next
    For y = sh / 16 To 0 Step -1
        For x = 0 To sw / 8
            If kelp(x, y + 1) Then
                r = Int(Rnd * 23) + 1
                Select Case r
                    Case 1, 2, 3, 18 '1 branch node
                        If x - 1 >= 0 Then kelp(x - 1, y) = kelp(x, y + 1)
                    Case 4, 5, 6, 7, 8, 9, 21 '1 branch node
                        kelp(x, y) = kelp(x, y + 1)
                    Case 10, 11, 12, 20 '1 branch node
                        If x + 1 <= sw Then kelp(x + 1, y) = kelp(x, y + 1)
                    Case 13, 14, 15, 16, 17, 19 '2 branch node
                        If x - 1 >= 0 Then kelp(x - 1, y) = kelp(x, y + 1)
                        If x + 1 <= sw Then kelp(x + 1, y) = kelp(x, y + 1)
                End Select
            End If
        Next
    Next
End Sub

Sub showKelp
    Dim y, x
    For y = 0 To sh / 16
        For x = 0 To sw / 8
            If kelp(x, y) Then
                Color kelp(x, y)
                _PrintString (x * 8, y * 16), Mid$("kelp", Int(Rnd * 4) + 1, 1)
            End If
        Next
    Next
End Sub

[dbox]

Hey @bplus,

It looks like the same issue that you have found with at least one other example.  The current version of QBJS doesn't support the new QB64 way of defining variables (e.g. As Integer LFish) inside custom type definitions yet.  I'll put it on the list for the next release.

I was able to get this working by just flattening out the fish Type definition:

[bplus]

Good! Thanks but what happened to the Kelp?

[dbox]

Oh, there it is:

[bplus]

That's it! I tried flattening the ReDim Shared Kelp() array but for some reason that didn't work. Maybe I forgot the first change with Type???

@dbox Is that all you changed to see Kelp? Or was there something else in subroutines? 
Sorry if this is pestering you but I'd like to share this on other forums like Aurel's or Friends where not all folks have or even think they like QB64.

[dbox]

Not pestering at all @bplus, happy to help!

What I changed to get the kelp working was to add a call to Fix() to force some of those values to integers when accessing or setting array values.  QBJS is a bit more flexible with values that can be passed to arrays.  So, it doesn't explicitly convert floating point numbers to integers when they are passed in as an array index.  This is in part so it can natively support associative arrays (dictionaries).  You can see more about this in QBJS Fun Fact #3.

[bplus]

Not pestering at all @bplus, happy to help!

What I changed to get the kelp working was to add a call to Fix() to force some of those values to integers when accessing or setting array values.  QBJS is a bit more flexible with values that can be passed to arrays.  So, it doesn't explicitly convert floating point numbers to integers when they are passed in as an array index.  This is in part so it can natively support associative arrays (dictionaries).  You can see more about this in QBJS Fun Fact #3.

@dbox Eeeh! I thought things would get "fixed" automatically because the Kelp array has the _Unsigned Long Type = only positive integers.

ReDim Shared kelp(sw, sh) As _Unsigned Long

wait this FIX was needed???
r = Fix(Int(Rnd * 23) + 1)
why doesn't INT alone fix it?  You have to FIX a number already made integer?

 hmm.. the +1 is + .99999 or 1.000001 ie float?

Sorry don't mean to be argumentative but I remember things better if they make sense to me.

[dbox]

@dbox Eeeh! I thought things would get "fixed" automatically because the Kelp array has the _Unsigned Long Type = only positive integers.

ReDim Shared kelp(sw, sh) As _Unsigned Long

I'm afraid that only affects the value stored in the array.  The reason the Fix() is needed is due to the fact that there are places where floating point values were passed in as the index to the array.

So, here's a simple example to illustrate the point.  If you run this in QB64:

Code: (Select All)

Dim numbers(10) As _Unsigned Long



numbers(1.2) = 20

numbers(1.3) = 30



Print numbers(1.2)

Print numbers(1.3)

It will print:

Code: (Select All)

30
30

However, if you run the same example in QBJS it will print:

Code: (Select All)

20
30

wait this FIX was needed???
r = Fix(Int(Rnd * 23) + 1)
why doesn't INT alone fix it?  You have to FIX a number already made integer?

Ha, no, not in this case.  I must have just got carried away with calls to Fix()

Sorry don't mean to be argumentative but I remember things better if they make sense to me.

I'm all for spirited discussions and I don't mind critique.  That's the kind of feedback I need to make QBJS better.

[CharlieJV]

I must have just got carried away with calls to Fix()

Ah, "fixated", happens to the best of us at times.

Groan ...

[dbox]

The more I think about it the more inclined I am to change the way this is working in the next release of QBJS to increase compatibility with QB64.  I think instead of extending the array to also support associative arrays (dictionaries), I'll pull this functionality out into a new type called Dictionary.  Then I can implicitly convert any index values passed to an array to an integer, just as in QB64.