Simple Fountain program

Share your advanced PureBasic knowledge/code with the community.
DriakTravo
Enthusiast
Enthusiast
Posts: 346
Joined: Fri Oct 10, 2003 12:42 am
Location: Tampa,FL,USA
Contact:

Simple Fountain program

Post by DriakTravo »

Code: Select all

  EndStructure
  NewList Fader.Fader()
  NewList Water.Water()
  
;- Procedures
  Procedure CreateFader(X.f,Y.f,Width.f,Height.f)
    AddElement(Fader())
    Fader()\X = X
    Fader()\Y = Y
    Fader()\Width = Width
    Fader()\Height = Height
    Fader()\Fade = 0
    Fader()\FadeDir = 0
  EndProcedure
  Procedure UpdateFader()
    If CountList(Fader()) > 0
      ResetList(Fader())
      StartDrawing(ScreenOutput())
      While NextElement(Fader())
        If Fader()\FadeDir = 0
          Fader()\Fade + 10
          If Fader()\Fade > 200
            Fader()\FadeDir = 1
          EndIf
        Else
          Fader()\Fade - 10
          If Fader()\Fade < 10
            DeleteElement(Fader())
            Continue
          EndIf
        EndIf
        Line(Fader()\X,Fader()\Y,Fader()\Width,Fader()\Height,RGB(0,0,Fader()\Fade))
      Wend
      StopDrawing()
    EndIf
  EndProcedure
  Procedure CreateWater()
    AddElement(Water())
    Water()\X = 100
    Water()\Y = 960
    Water()\XS = ((Random(PowerSide*200)+PowerSide*200)/100)+5
    Water()\YS = PowerUp
    Water()\NOH = 1
  EndProcedure
  Procedure UpdateWater()
    If CountList(Water()) > 0
      ResetList(Water())
      While NextElement(Water())
        CreateFader(Water()\X,Water()\Y,Water()\XS,Water()\YS)
        Water()\X + Water()\XS
        Water()\Y + Water()\YS
        If Water()\YS < Gravity
          Water()\YS + Force
        EndIf
        If Water()\X > 1280 Or Water()\X < 0
          DeleteElement(Water())
          Continue
        EndIf
        If Water()\Y > 960        
          DeleteElement(Water())
          Continue
        EndIf
      Wend
    EndIf
  EndProcedure

;- Main Loop
Repeat
  ClearScreen(0,0,0)
  UpdateFader()
  FlipBuffers()
  UpdateWater()
  
  If Counter = TimeDelay
    Counter = 0
    PowerUp.l = -(Random(Power)+2)
    CreateWater()
    Beep_(-(PowerUp*100),50)
  EndIf
  Counter + 1
  
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_All)
    End
  EndIf
It's fun! . . . Sorry, I haven't posted anything in a while, figure I needed to post something.
DriakTravo
Enthusiast
Enthusiast
Posts: 346
Joined: Fri Oct 10, 2003 12:42 am
Location: Tampa,FL,USA
Contact:

Re: Simple Fountain program

Post by DriakTravo »

Code: Select all

;_______________________
;-     Introduction     \___
;---------------------------\
;_.-._.-._.-._.-._.-._.-._.-
;>>>>> Fountian v1.00 <<<<<<
;_.-._.-._.-._.-._.-._.-._.-

;Written by Driak Travo
;Have fun changing the variables! ;)

;_______________________
;- Start Of Program Code\___
;---------------------------\

;- Init Devices
If InitMouse() = 0
  MessageRequester("Error","Error loading Mouse!")
EndIf
If InitKeyboard() = 0
  MessageRequester("Error","Error loading Keyboard!")
EndIf
If InitSprite() = 0
  MessageRequester("Error","Error loading DirectX!")
EndIf

;- Open Screen
If OpenScreen(1280,960,32,"") = 0
  End
EndIf

;- Variables
SkyColorRed = 0
SkyColorGreen = 0
SkyColorBlue = 0

Global PowerUp.l
Global PowerSide.l
Global Gravity.l
Global Force.f
Power = 25
PowerSide.l = 1
Gravity.l = 100
Force.f = 0.40
TimeDelay = 20

;- Structures
  Structure Fader
    X.f
    Y.f
    Width.f
    Height.f
    Fade.l
    FadeDir.l
  EndStructure
  Structure Water
    X.f
    Y.f
    XS.f
    YS.f
    NOH.f
  EndStructure
  NewList Fader.Fader()
  NewList Water.Water()
  
;- Procedures
  Procedure CreateFader(X.f,Y.f,Width.f,Height.f)
    AddElement(Fader())
    Fader()\X = X
    Fader()\Y = Y
    Fader()\Width = Width
    Fader()\Height = Height
    Fader()\Fade = 0
    Fader()\FadeDir = 0
  EndProcedure
  Procedure UpdateFader()
    If CountList(Fader()) > 0
      ResetList(Fader())
      StartDrawing(ScreenOutput())
      While NextElement(Fader())
        If Fader()\FadeDir = 0
          Fader()\Fade + 10
          If Fader()\Fade > 200
            Fader()\FadeDir = 1
          EndIf
        Else
          Fader()\Fade - 10
          If Fader()\Fade < 10
            DeleteElement(Fader())
            Continue
          EndIf
        EndIf
        Line(Fader()\X,Fader()\Y,Fader()\Width,Fader()\Height,RGB(0,0,Fader()\Fade))
      Wend
      StopDrawing()
    EndIf
  EndProcedure
  Procedure CreateWater()
    AddElement(Water())
    Water()\X = 100
    Water()\Y = 960
    Water()\XS = ((Random(PowerSide*200)+PowerSide*200)/100)+5
    Water()\YS = PowerUp
    Water()\NOH = 1
  EndProcedure
  Procedure UpdateWater()
    If CountList(Water()) > 0
      ResetList(Water())
      While NextElement(Water())
        CreateFader(Water()\X,Water()\Y,Water()\XS,Water()\YS)
        Water()\X + Water()\XS
        Water()\Y + Water()\YS
        If Water()\YS < Gravity
          Water()\YS + Force
        EndIf
        If Water()\X > 1280 Or Water()\X < 0
          DeleteElement(Water())
          Continue
        EndIf
        If Water()\Y > 960        
          DeleteElement(Water())
          Continue
        EndIf
      Wend
    EndIf
  EndProcedure

;- Main Loop
Repeat
  ClearScreen(0,0,0)
  UpdateFader()
  FlipBuffers()
  UpdateWater()
  
  If Counter = TimeDelay
    Counter = 0
    PowerUp.l = -(Random(Power)+2)
    CreateWater()
    Beep_(-(PowerUp*100),50)
  EndIf
  Counter + 1
  
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_All)
    End
  EndIf
ForEver
It's fun! . . . Sorry, I haven't posted anything in a while, figure I needed to post something.[/quote]
LarsG
Enthusiast
Enthusiast
Posts: 713
Joined: Mon Jun 02, 2003 1:06 pm
Location: Norway
Contact:

Post by LarsG »

nice effect..
I had to change the resolution abit tho, as it was somewhat odd, and my gfx-card didn't handle it..

AMD Athlon XP2400, 512 MB RAM, Hercules 3D Prophet 9600 256MB RAM, WinXP
PIII 800MHz, 320 MB RAM, Nvidia Riva Tnt 2 Mach 64 (32MB), WinXP + Linux
17" iMac, 1.8 GHz G5, 512 MB DDR-RAM, 80 GB HD, 64 MB Geforce FX 5200, SuperDrive, OSX
Post Reply