qbjs evolving program #1
#8
[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 Smile
b = b + ...
Reply


Messages In This Thread
qbjs evolving program #1 - by grymmjack - 06-03-2023, 05:27 PM
RE: qbjs evolving program #1 - by dbox - 06-03-2023, 08:15 PM
RE: qbjs evolving program #1 - by dbox - 06-05-2023, 04:07 PM
RE: qbjs evolving program #1 - by bplus - 06-05-2023, 04:21 PM
RE: qbjs evolving program #1 - by dbox - 06-05-2023, 04:25 PM
RE: qbjs evolving program #1 - by bplus - 06-05-2023, 04:36 PM
RE: qbjs evolving program #1 - by mnrvovrfc - 06-07-2023, 09:27 PM
RE: qbjs evolving program #1 - by bplus - 06-07-2023, 11:41 PM
RE: qbjs evolving program #1 - by dbox - 06-07-2023, 11:53 PM
RE: qbjs evolving program #1 - by bplus - 06-07-2023, 11:58 PM
RE: qbjs evolving program #1 - by dbox - 06-08-2023, 12:08 AM
RE: qbjs evolving program #1 - by bplus - 06-08-2023, 01:17 AM
RE: qbjs evolving program #1 - by bplus - 06-08-2023, 01:23 AM
RE: qbjs evolving program #1 - by dbox - 06-08-2023, 03:41 AM
RE: qbjs evolving program #1 - by dbox - 06-08-2023, 03:49 AM
RE: qbjs evolving program #1 - by mnrvovrfc - 06-08-2023, 11:14 AM
RE: qbjs evolving program #1 - by bplus - 06-08-2023, 01:21 PM
RE: qbjs evolving program #1 - by bplus - 06-08-2023, 06:11 PM
RE: qbjs evolving program #1 - by bplus - 06-08-2023, 06:42 PM
RE: qbjs evolving program #1 - by mnrvovrfc - 06-09-2023, 05:52 AM
RE: qbjs evolving program #1 - by bplus - 06-09-2023, 01:04 PM
RE: qbjs evolving program #1 - by bplus - 06-09-2023, 04:50 PM
RE: qbjs evolving program #1 - by grymmjack - 06-09-2023, 10:38 PM
RE: qbjs evolving program #1 - by bplus - 06-10-2023, 01:29 AM
RE: qbjs evolving program #1 - by grymmjack - 06-10-2023, 09:32 PM
RE: qbjs evolving program #1 - by vince - 06-09-2023, 05:06 PM
RE: qbjs evolving program #1 - by mnrvovrfc - 06-09-2023, 10:49 PM
RE: qbjs evolving program #1 - by vince - 06-09-2023, 11:35 PM
RE: qbjs evolving program #1 - by bplus - 06-10-2023, 09:59 PM



Users browsing this thread: 2 Guest(s)