qbjs evolving program #1

[grymmjack]

On IRC back in the day, we used to play "neverending story".

How it worked:

The first person would provide a sentence or paragraph.

The next person picks up where that last person left off and continues.

e.g.:

First person: Once upon a time there was a pig that
Second person: had smelly breath and could talk like a human.

Story then is concatenated from that point:

"Once upon a time there was a pig that had smelly breath and could talk like a human."

... repeat ...

Let's try the same thing with qbjs!

The only change would be that you have to copy and paste the code from what you make into a new one in the qbjs.org site to get your version to persist for everyone. The other thing would be we should try to preserve what already is there, but extend on it. That is, don't do asshole things like in a SCREEN 0 text start thing, CLS the damned screen (be kind and have fun)?

Let's see what happens and where it goes.

@dbox you go first!

[dbox]

Ok how about this to get us started... Press "F" to Fire.

[dbox]

Ok, I found my initial attempt to be too boring.  Plus, I didn't read all of @grymmjack's instructions.  Hopefully this will be a more fun start.

[bplus]

What happened to the thing I just saw shooting from bottom left and right to center scope sight?

It disappeared! just after I ran it. I must have caught it between edits?

[dbox]

What happened to the thing I just saw shooting from bottom left and right to center scope sight?

It disappeared! just after I ran it. I must have caught it between edits?

Might want to refresh the page.  That is the latest version and that is what I'm seeing now.

[bplus]

OK well its back without a refresh, I just went and posted something in another thread.

Ah but now the code is disappeared and the Run/Stop screen is stuck on stop.

Lets see what happens when I get out of this thread and come back again.

Wait, now refresh does work, man! all these fancy gadgets!

[mnrvovrfc]

Trying to draw more interest in this thread:

The "dumbface" subprogram could be removed if it's not acceptable by the moderators LOL...

[bplus]

[qbjs]
https://qbjs.org/?code=SW1wb3J0IEcyRCBGc...VlbmQgc3Vi
[/qbjs]

I swear I have no frick'n luck with this!

Code: (Select All)

Import G2D From "lib/graphics/2d.bas"

Const PVELOCITY = 10



Screen _NewImage(800, 550, 32)



Type Photon

    x As Integer

    y As Integer

    active As Integer

    direction As Integer

End Type



Dim Shared photons(50) As Photon

Dim Shared firing As Integer

Dim Shared psound(10) As Long

Dim Shared nextPSound As Integer

dim shared nose as long

Dim p As Integer

For p = 1 To UBound(psound)

    psound(p) = _SndOpen("https://opengameart.org/sites/default/files/laser7.wav")

Next p



Dim key As Integer

Do

    If _KeyDown(70) Or _KeyDown(102)

        If Not firing Then

            firing = -1

            FirePhotons

        End If

    Else

        firing = 0

    End If

    

    Cls

    MovePhotons

    DrawPhotons

    dumbface

    ' Draw the HUD last so it appears on top of everything else

    DrawHUD

    _Limit 60

Loop



Sub DrawHUD

    ' Draw the heads up display

    Dim hcolor As _Unsigned Long

    hcolor = _RGBA(200, 255, 200, 200)



    Line (30, 30)-(70, 30), hcolor

    Line (30, 30)-(30, 70), hcolor

    Line (770, 30)-(730, 30), hcolor

    Line (770, 30)-(770, 70), hcolor

    Line (30, 520)-(70, 520), hcolor

    Line (30, 520)-(30, 480), hcolor

    Line (770, 520)-(730, 520), hcolor

    Line (770, 520)-(770, 480), hcolor



    G2D.LineWidth 1

    Circle (400, 275), 15, hcolor

    Line (400, 245)-(400, 305), hcolor

    Line (370, 275)-(430, 275), hcolor

End Sub



Sub DrawPhotons

    Dim As Integer i, j

    For i = 1 To UBound(photons)

        If photons(i).active Then

            Dim a As Integer

            a = 255

            For j = 0 To 50 Step 2

                G2D.FillCircle photons(i).x - j * 2 * photons(i).direction, photons(i).y + j * 1.35, 6, _RGBA(255, 100, 100, a)

                a = a - 20

            Next j

        End If

    Next i

End Sub



Sub MovePhotons

    Dim i As Integer

    For i = 1 To UBound(photons)

        If photons(i).active Then

            photons(i).x = photons(i).x + 2 * PVELOCITY * photons(i).direction

            photons(i).y = photons(i).y - 1.35 * PVELOCITY

            

            If (photons(i).direction > 0 And photons(i).x > _Width / 2) Or _

              (photons(i).direction < 0 And photons(i).x < _Width / 2) Then

              if nose < 150 then nose = nose + 1 ' else explode!

                photons(i).active = 0

            End If

            

        End If

    Next i

End Sub



Sub FirePhotons

    Dim i As Integer

    i = NextPhoton

    If i > 0 Then

        photons(i).x = 0

        photons(i).y = _Height

        photons(i).active = -1

        photons(i).direction = 1

    End If

    i = NextPhoton

    If i > 0 Then

        photons(i).x = _Width

        photons(i).y = _Height

        photons(i).active = -1

        photons(i).direction = -1

        

        nextPSound = nextPSound + 1

        If nextPSound > UBound(psound) Then nextPSound = 1

        _SndPlay psound(nextPSound)

    End If

End Sub



Function NextPhoton

    Dim i As Integer

    For i = 1 To UBound(photons)

        If Not photons(i).active Then

            NextPhoton = i

            Exit Function

        End If

    Next i

    NextPhoton = 0

End Function



sub dumbface

    dim wd as integer, ht as integer, htradius as single, ccolor as long

    dim ww as integer, i as integer

    wd = _width \ 3

    ht = _height \ 2

    htradius = ht - (_height \ 5)

    ccolor = _RGBA(255, 32, 128, 128)

    ww = _width \ 2

    for i = 1 to nose  ' sorry G2D.Fillcircle did not work for me

    circle (400, 275), i, &HFFFF0000

    next

    ht = ht - (_height \ 8)

    ww = ww - (_width \ 8)

    circle (ww, ht), 20, ccolor

    ww = (_width \ 2) + (_width \ 8)

    circle (ww, ht), 20, ccolor

    ww = (_width \ 2) - (_width \ 8)

    ht = (_height \ 2) + (_height \ 7)

    pset (ww, ht), ccolor

    ww = (_width \ 2) + (_width \ 8)

    line -(ww, ht), ccolor

    ww = _width \ 2

    G2D.Ellipse ww, ht, 100, 30, 0, ccolor

end sub

There it is! Finally

[dbox]

Ha, love it @bplus!

If you want to use FillCircle the following will work instead of the for loop you have on line 135:

Code: (Select All)

    G2D.FillCircle 400, 275, nose, &HFFFF0000

[bplus]

That's what I tried, are we very case sensitive?

I am going to try and explode the nose next and then if nobody has an idea I am going pop in a space ship to shoot at.