Balloon Attack

Everything related to 3D programming
User avatar
DK_PETER
Addict
Addict
Posts: 904
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:

Balloon Attack

Post by DK_PETER »

Code: Select all

;By DK_PETER
;Simple balloon attack game
;Shoot the ballons before they hit the ground
EnableExplicit

DeclareModule _balloon
 
  Declare.i Init()
  Declare.i Resolution(Width.i = #PB_Ignore, Height.i = #PB_Ignore, Title.s = "", FullScreen.i = #False)
  Declare.i RunBalloon()
 
EndDeclareModule

Module _balloon 
 
  Structure _Genvars
    fs.i
    cam.i
    lgt.i
    win.i
    w.i
    h.i
    balloonsShotDown.i
    balloonsExploded.i
  EndStructure
 
  Structure _meshData
    id.i
    ms.i
    ma.i
    tx.i
    hit.i
  EndStructure
 
  Structure _particles
    id.i
    BurnStart.i
  EndStructure
 
  Structure _Objects
    street._meshData
    List build._meshData()
    ball._meshData[11]
    cloud._meshData
  EndStructure
 
  Declare.i Geo_Object_Creation()
 
  Global gv._Genvars, ob._Objects, geo.i, sight.i, Grav.f = -1, firemat.i, firetex.i
  Global NewList burn.i(), NewList explode._particles(), interv.i, mDown.i = #False
  Global bLine.i
 
  Procedure.i Init()
    If InitEngine3D() = 0
      MessageRequester("Ogre 3D Init failure", "Failed to initialize Ogre3D", #PB_MessageRequester_Ok)
      End
    EndIf
    If InitSprite() = 0
      MessageRequester("Sprite Init failure", "Failed to initialize sprite", #PB_MessageRequester_Ok)
      End
    EndIf
    If InitKeyboard() = 0
      MessageRequester("Keyboard error", "Unable to initialize keyboard", #PB_MessageRequester_Ok)
      End
    EndIf
    If InitMouse() = 0
      MessageRequester("Mouse error", "Unable to initialize mouse", #PB_MessageRequester_Ok)
      End
    EndIf
  EndProcedure
 
  Procedure.i Resolution(Width.i = #PB_Ignore, Height.i = #PB_Ignore, Title.s = "", FullScreen.i = #False)
    Protected sw.i, sh.i, x.i, y.i
    gv\fs = FullScreen
    If Width = #PB_Ignore Or Height = #PB_Ignore
      ExamineDesktops()
      gv\w = DesktopWidth(0) : gv\h = DesktopHeight(0)
    Else
      gv\w = Width : gv\h = Height
    EndIf
    Select FullScreen
      Case #False
        gv\win = OpenWindow(#PB_Any, 0, 0, gv\w, gv\h, Title, #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
        OpenWindowedScreen(WindowID(gv\win), 0, 0, gv\w, gv\h, #False, 0, 0)
      Default
        OpenScreen(gv\w, gv\h, 32, Title, #PB_Screen_SmartSynchronization, 60)
    EndSelect

    gv\cam = CreateCamera(#PB_Any, 0, 0, 100, 100)
    MoveCamera(gv\cam, 500, 200, 500)
    gv\lgt = CreateLight(#PB_Any, $39C5C9, 2000, 1000, 3000, #PB_Light_Directional)
    LightDirection(gv\lgt, -1, 0.6, -1)
    sw = ScreenWidth()/40 : sh = ScreenHeight()/30
    sight = CreateSprite(#PB_Any, sw, sh)
    StartDrawing(SpriteOutput(sight))
    LineXY(0, sh/2, (sw/2)-5, sh/2, $E4BE0A)
    LineXY(sw/2, 0, sw/2, sh/2-5, $E4BE0A)
    LineXY(sw, sh/2, (sw/2)+5, sh/2, $E4BE0A)
    LineXY(sw/2, sh, sw/2, sh/2+5, $E4BE0A)
    StopDrawing()
    TransparentSpriteColor(sight,$0)
    WorldGravity(Grav)
    firetex = CreateTexture(#PB_Any, 20, 20)
    StartDrawing(TextureOutput(firetex))
    DrawingMode(#PB_2DDrawing_Gradient)
    FrontColor($001BFF) : BackColor($00F2FF)
    CircularGradient(10, 10, 8)
    Circle(10, 10, 8)
    StopDrawing()
    firemat = CreateMaterial(#PB_Any, TextureID(firetex))
    MaterialBlendingMode(firemat, #PB_Material_Add)
    bLine = CreateSprite(#PB_Any, ScreenWidth(), ScreenHeight()/2)
    StartDrawing(SpriteOutput(bLine))
    LineXY(0, SpriteHeight(bLine), SpriteWidth(bLine)/2, 0, $C6C833)
    LineXY(ScreenWidth(), SpriteHeight(bLine), SpriteWidth(bLine)/2, 0, $C6C833)
    StopDrawing()
    TransparentSpriteColor(bLine, 0)
  EndProcedure
 
  Procedure.i CloudCreations()
    Protected x.i, y.i, col.i, tm.i
    With ob\cloud
      \ms = CreatePlane(#PB_Any, 2000, 2000, 1 , 1, 1, 1)
      \tx = CreateTexture(#PB_Any, 512, 512)
      StartDrawing(TextureOutput(\tx))
      DrawingMode(#PB_2DDrawing_AllChannels)
      For x = 1 To 511
        For y = 1 To 511
          col = Random(255,150)
          Plot(x, y, RGBA(col,col,col,Random(255,170)))
        Next y
      Next x
      StopDrawing()
      tm = CreateTexture(#PB_Any, 512, 512)
      StartDrawing(TextureOutput(tm))
      DrawingMode(#PB_2DDrawing_AllChannels)
      For x = 1 To 511
        For y = 1 To 511
          col = Random(155,0)
          Plot(x, y, RGBA(col,col,col,Random(255,10)))
        Next y
      Next x
      StopDrawing()
      \ma = CreateMaterial(#PB_Any, TextureID(tm))
      AddMaterialLayer(\ma, TextureID(\tx), #PB_Material_Modulate)
      ;AddMaterialLayer(\ma, TextureID(\tx), #PB_Material_Modulate)
      DisableMaterialLighting(\ma,#False)
      ScaleMaterial(\ma, 5, 5, 0)
      ScaleMaterial(\ma, 6, 6, 1)
      ScrollMaterial(\ma, 0.0001, -0.0002, #PB_Material_Animated,0)
      ScrollMaterial(\ma, -0.0001, 0.0002, #PB_Material_Animated,1)
      RotateMaterial(\ma, 0.0001, #PB_Material_Animated,1)
      \id = CreateEntity(#PB_Any, MeshID(\ms), MaterialID(\ma), 0, 400, 0, 0)
      RotateEntity(\id, 180, 0, 0, #PB_Absolute)
      ScaleEntity(\id, 100, 100, 100)
    EndWith 
    ProcedureReturn #True
  EndProcedure
 
  Procedure.i ParticleCheck()
    If ListSize(explode()) > 0
      ForEach explode()
        If ElapsedMilliseconds() - explode()\BurnStart > 500
          FreeParticleEmitter(explode()\id)
          DeleteElement(explode())
        EndIf
      Next
    EndIf
    If ListSize(burn()) > 10
      ReleaseMouse(1)
      MessageRequester("Game over!", "City has been burned to a crisp" + #CRLF$ + "Score: "+ Str(gv\balloonsShotDown))
      End
    EndIf
    ProcedureReturn #True
  EndProcedure
 
  Procedure.i Geo_Object_Creation()
    Protected x.i, z.i, newv.i
    geo = CreateStaticGeometry(#PB_Any, 3000, 50, 3000, #True)
    ob\street\ms = CreatePlane(#PB_Any, 3000, 3000, 1, 1, 1, 1)
    ob\street\tx = CreateTexture(#PB_Any, 1000, 1000)
    StartDrawing(TextureOutput(ob\street\tx))
    Box(0, 0, 1000, 1000, $00870D)
    For y = 0 To 1000 Step 30
      For x = 0 To 1000 Step 30
        DrawingMode(#PB_2DDrawing_Default)
        Box(x, y, 10, 1000, $000000)
        Box(x, y, 1000, 10, $000000)
        DrawingMode(#PB_2DDrawing_Outlined)
        RoundBox(x-20, y-20, 20, 20, 2, 2, $C0C0C0)
      Next x
    Next y
    StopDrawing()
    ob\street\ma = CreateMaterial(#PB_Any, TextureID(ob\street\tx))
    ob\street\id = CreateEntity(#PB_Any, MeshID(ob\street\ms), MaterialID(ob\street\ma), 5, 0, 5, 0)
    EntityPhysicBody(ob\street\id, #PB_Entity_StaticBody , 1)
    For z = 0 To 3000 Step 200
      For x = 0 To 3000 Step 200
        AddElement(ob\build())
        With ob\build()
          \ms = CreateCylinder(#PB_Any, Random(10,5), Random(10,2), Random(5,2), 1, 0)
          \tx = CreateTexture(#PB_Any, 32, 32)
          StartDrawing(TextureOutput(\tx))
          Box(0, 0, 32, 32, RGB(Random(255,10), Random(255,10), Random(255,10)))
          StopDrawing()
          \ma = CreateMaterial(#PB_Any, TextureID(\tx))
          \id = CreateEntity(#PB_Any, MeshID(\ms), MaterialID(\ma))
          AddStaticGeometryEntity(geo, EntityID(\id), 1500-x, 0, 1500-z, Random(6,3) , MeshRadius(\ms) * 5, Random(6,3))
        EndWith
      Next x
    Next z
    BuildStaticGeometry(geo)
    ProcedureReturn #True
  EndProcedure
 
  Procedure.i Buildballoons()
    Protected col.i
    For x = 0 To 10
      With ob\ball[x]
        \ms = CreateSphere(#PB_Any, 5)
        \tx = CreateTexture(#PB_Any, 10, 10)
        StartDrawing(TextureOutput(\tx))
        col = Random(200,60)
        Box(0, 0, 10, 10, RGB(col,col,col))
        StopDrawing()
        \ma = CreateMaterial(#PB_Any, TextureID(\tx))
        \id = x
        CreateEntity(\id, MeshID(\ms), MaterialID(\ma), 1500 - Random(2000,100), Random(800, 420), 1500 - Random(2000,100), 1)
        EntityPhysicBody(\id, #PB_Entity_SphereBody , 0.0001)
      EndWith
    Next x
    ProcedureReturn #True
  EndProcedure
 
  Procedure.i RunBalloon()
    Protected retval.i
    retval = Geo_Object_Creation()
    retval = Buildballoons()
    retval = CloudCreations()
   
    Repeat
     
      If gv\fs = #False : Repeat : ev = WindowEvent() : Until ev = 0 : EndIf
     
      ExamineMouse()
     
      RotateCamera(gv\cam, MouseDeltaY()*0.05, -MouseDeltaX()*0.05, 0, #PB_Relative)

      RenderWorld()
     
      ret = MouseRayCast(gv\cam, ScreenWidth()/2, ScreenHeight()/2 , 1)
      If ret > -1
        If MouseButton(#PB_MouseButton_Left) And mDown = #False ;Click only
          With ob\ball[ret]
            ;bang
            PointPick(gv\cam, ScreenWidth()/2, ScreenHeight()/2) ;Get direction
            AddElement(explode())
            explode()\id = CreateParticleEmitter(#PB_Any, 1, 1, 1,#PB_Particle_Point, EntityX(\id), EntityY(\id), EntityZ(\id))
            ParticleEmissionRate(explode()\id, 400)
            ParticleMaterial(explode()\id, MaterialID(CopyMaterial(firemat,#PB_Any)))
            ParticleSize(explode()\id, 10, 10)
            ParticleVelocity(explode()\id, 216, 429)
            ParticleTimeToLive(explode()\id, 10.5, 36)
            ParticleEmitterDirection(explode()\id, PickX(), PickY(), PickZ())
            MoveEntity(ob\ball[ret]\id, 1500 - Random(2000,100), Random(800, 420), 1500 - Random(2000,100), #PB_Absolute)
            explode()\BurnStart = ElapsedMilliseconds()
            gv\balloonsShotDown + 1
            mDown = #True
          EndWith
        EndIf
      EndIf

      For x = 0 To 10
        If EntityY(ob\ball[x]\id,#PB_Absolute) <= 5 ; hit
          ;boom
          AddElement(burn())
          burn() = CreateParticleEmitter(#PB_Any, 50, 50, 50,#PB_Particle_Box)
          ParticleEmissionRate(burn(), 200)
          ParticleEmitterDirection(burn(), 0, 1, 0)
          ParticleMaterial(burn(), MaterialID(CopyMaterial(firemat,#PB_Any)))
          ParticleSize(burn(), 10, 40)
          ParticleVelocity(burn(), 0.5, 1.6)
          ParticleTimeToLive(burn(), 0.5, 1)
          MoveParticleEmitter(burn(), EntityX(ob\ball[x]\id), 5, EntityZ(ob\ball[x]\id))
          MoveEntity(ob\ball[x]\id, 1500 - Random(2000,100), Random(800, 420), 1500 - Random(2000,100), #PB_Absolute)
          gv\balloonsExploded + 1
        EndIf
      Next x
      
      If MouseButton(#PB_MouseButton_Left) = 0
        mDown = #False
      Else
        DisplayTransparentSprite(bLine, 1,ScreenHeight()/2)
      EndIf
      
      ParticleCheck()
     
      ExamineKeyboard()
     
      DisplayTransparentSprite(sight, ScreenWidth()/2-SpriteWidth(sight)/2, ScreenHeight()/2-SpriteHeight(sight)/2)
      
      FlipBuffers() 
     
   Until KeyboardPushed(#PB_Key_Escape)
  EndProcedure
EndModule

_balloon::Init()
_balloon::Resolution()
_balloon::RunBalloon()
Last edited by DK_PETER on Tue May 19, 2015 11:09 am, edited 1 time in total.
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
Julian
Enthusiast
Enthusiast
Posts: 276
Joined: Tue May 24, 2011 1:36 pm

Re: Balloon Attack

Post by Julian »

Nice game. Came across a little bug.
Image
You also might want to thread out your mouse polling as it stutters due to high poll rate flooding the event queue as per : http://www.purebasic.fr/english/viewtop ... 13&t=53829
User avatar
DK_PETER
Addict
Addict
Posts: 904
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:

Re: Balloon Attack

Post by DK_PETER »

Hey Julian.

I know about the Raze(o)r problem and you can easily fix it yourself.
This it added here for educational purposes only.
I've changed some of the code and added something extra.
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
Post Reply