PureBasic Forums - English

Posted: **Sun Mar 21, 2004 1:49 am**

Code updated for 5.20+

I had a few hours to waste away, so I made this little nifty program. It is very custumizable and it would make for a good screensaver, no?

Code: Select all

;______________________________________________________________________

;<-._.-._.-._.-._.- Space Snake -._.-._.-._.-._.->

; > > > Programmed By Driak Travo <-._.-._.-._.->

;This would make for a nifty Screensaver. . . No? Press Escape to quit

;______________________________________________________________________

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 Sprite!")
EndIf

If OpenScreen(800,600,16,"") = 0
  End
EndIf

Structure RCircle
  X.i
  Y.i
  S.i
  Type.i
  Fade.i
EndStructure
Global NewList OCircle.RCircle()

Global XDir
Global YDir
Global Size
Global SetSize
Global PlayerX
Global PlayerY
Global SnakeColor 
PlayerX = 400
PlayerY = 300
XDir = Random(1)
YDir = Random(1)
ChangeSizeSpeed = 1

;- CHANGE VARIABLES
;You can change the following variables to custumize the program
NumberOfStars = 100
MoveSpeed = 2
SnakeColor = 5 ;1=Red 2=Green 3=Blue 4=Purple 5=Yellow 6=White
SnakeSize = 30
BackRedColor = 0
BackGreenColor = 0
BackBlueColor = 0

Procedure AddOCircle(X,Y,Siz)
  AddElement(OCircle())
  OCircle()\X = X
  OCircle()\Y = Y
  OCircle()\S = Siz
  OCircle()\Fade = 70
EndProcedure

Procedure UpdateCircles()
  If ListSize(OCircle()) > 0
    ResetList(OCircle())
    StartDrawing(ScreenOutput())
      While NextElement(OCircle())
        If OCircle()\Type = 0
          OCircle()\Fade + 5
          If OCircle()\Fade = 255
            OCircle()\Type = 1
          EndIf
        ElseIf OCircle()\Type = 1
          OCircle()\Fade - 5
          If OCircle()\Fade = 0
            DeleteElement(OCircle())
            Continue
          EndIf
        EndIf
        Color = OCircle()\Fade
        If SnakeColor = 1
          Circle(OCircle()\X,OCircle()\Y,OCircle()\S,RGB(Color,0,0))
        ElseIf SnakeColor = 2
          Circle(OCircle()\X,OCircle()\Y,OCircle()\S,RGB(0,Color,0))
        ElseIf SnakeColor = 3
          Circle(OCircle()\X,OCircle()\Y,OCircle()\S,RGB(0,0,Color))
        ElseIf SnakeColor = 4
          Circle(OCircle()\X,OCircle()\Y,OCircle()\S,RGB(Color,0,Color))
        ElseIf SnakeColor = 5
          Circle(OCircle()\X,OCircle()\Y,OCircle()\S,RGB(Color,Color,0))
        ElseIf SnakeColor = 6
          Circle(OCircle()\X,OCircle()\Y,OCircle()\S,RGB(Color,Color,Color))
        EndIf
      Wend
    StopDrawing()
  EndIf
EndProcedure

Structure Star
  X.f
  Y.f
EndStructure
Global NewList Star.Star()

Procedure AddStar()
  AddElement(Star())
  Star()\X = Random(800)
  Star()\Y = Random(600)
EndProcedure
AddElement(Star())

Procedure UpdateStars()
  If ListSize(Star()) > 0
    ResetList(Star())
    NextElement(Star())
    StartDrawing(ScreenOutput())
      ;Draw Stars
      While NextElement(Star())
        Color = Random(100)+155
        Circle(Star()\X+ShakeX,Star()\Y+ShakeY,(Random(100)/100)+1,RGB(Color,color,color))
      Wend
      ;Draw Border
    StopDrawing()
  EndIf
EndProcedure

For X = 1 To NumberOfStars
  AddStar()
Next X

Repeat
  ClearScreen(RGB(BackRedColor,BackGreenColor,BackBlueColor))
  UpdateStars()
  UpdateCircles()
  FlipBuffers()
  
  If Size < SetSize
    Size + ChangeSizeSpeed
  ElseIf Size > SetSize
    Size - ChangeSizeSpeed
  ElseIf Size = SetSize
    realsize = SnakeSize/2
    SetSize = Random(realsize)+realsize
  EndIf
  
  If XDir = 1
    PlayerX + MoveSpeed 
  ElseIf XDir = 0
    PlayerX - MoveSpeed 
  EndIf
  
  If PlayerX > 800-(Size/2)
    XDir = 0
    YDir = Random(1)
  ElseIf PlayerX < (Size/2)
    XDir = 1
    YDir = Random(1)
  EndIf
  
  If YDir = 1
    PlayerY + MoveSpeed 
  ElseIf YDir = 0
    PlayerY - MoveSpeed 
  EndIf
  
  If PlayerY > 600-(Size/2)
    YDir = 0
    XDir = Random(1)
  ElseIf PlayerY < (Size/2)
    YDir = 1
    XDir = Random(1)
  EndIf
  
  AddOCircle(PlayerX,PlayerY,Size)
  
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Escape)
    End
  EndIf
ForEver

Hope you enjoy. . . I guess

Also, Check out this, It is the same program with different settings

Code: Select all

;______________________________________________________________________

;<-._.-._.-._.-._.- Space Snake -._.-._.-._.-._.->

; > > > Programmed By Driak Travo <-._.-._.-._.->

;This would make for a nifty Screensaver. . . No? Press Escape to quit

;______________________________________________________________________

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 Sprite!")
EndIf

If OpenScreen(800,600,16,"") = 0
  End
EndIf

Structure RCircle
  X.i
  Y.i
  S.i
  Type.i
  Fade.i
EndStructure
Global NewList OCircle.RCircle()

Global XDir
Global YDir
Global Size
Global SetSize
Global PlayerX
Global PlayerY
Global SnakeColor 
PlayerX = 400
PlayerY = 300
XDir = Random(1)
YDir = Random(1)
ChangeSizeSpeed = 1

;- CHANGE VARIABLES
;You can change the following variables to custumize the program
NumberOfStars = 0
MoveSpeed = 50
SnakeColor = 2 ;1=Red 2=Green 3=Blue 4=Purple 5=Yellow 6=White
SnakeSize = 95
BackRedColor = 0
BackGreenColor = 20
BackBlueColor = 0

Procedure AddOCircle(X,Y,Siz)
  AddElement(OCircle())
  OCircle()\X = X
  OCircle()\Y = Y
  OCircle()\S = Siz
  OCircle()\Fade = 70
EndProcedure

Procedure UpdateCircles()
  If ListSize(OCircle()) > 0
    ResetList(OCircle())
    StartDrawing(ScreenOutput())
      While NextElement(OCircle())
        If OCircle()\Type = 0
          OCircle()\Fade + 5
          If OCircle()\Fade = 255
            OCircle()\Type = 1
          EndIf
        ElseIf OCircle()\Type = 1
          OCircle()\Fade - 5
          If OCircle()\Fade = 0
            DeleteElement(OCircle())
            Continue
          EndIf
        EndIf
        Color = OCircle()\Fade
        If SnakeColor = 1
          Circle(OCircle()\X,OCircle()\Y,OCircle()\S,RGB(Color,0,0))
        ElseIf SnakeColor = 2
          Circle(OCircle()\X,OCircle()\Y,OCircle()\S,RGB(0,Color,0))
        ElseIf SnakeColor = 3
          Circle(OCircle()\X,OCircle()\Y,OCircle()\S,RGB(0,0,Color))
        ElseIf SnakeColor = 4
          Circle(OCircle()\X,OCircle()\Y,OCircle()\S,RGB(Color,0,Color))
        ElseIf SnakeColor = 5
          Circle(OCircle()\X,OCircle()\Y,OCircle()\S,RGB(Color,Color,0))
        ElseIf SnakeColor = 6
          Circle(OCircle()\X,OCircle()\Y,OCircle()\S,RGB(Color,Color,Color))
        EndIf
      Wend
    StopDrawing()
  EndIf
EndProcedure

Structure Star
  X.f
  Y.f
EndStructure
Global NewList Star.Star()

Procedure AddStar()
  AddElement(Star())
  Star()\X = Random(800)
  Star()\Y = Random(600)
EndProcedure
AddElement(Star())

Procedure UpdateStars()
  If ListSize(Star()) > 0
    ResetList(Star())
    NextElement(Star())
    StartDrawing(ScreenOutput())
      ;Draw Stars
      While NextElement(Star())
        Color = Random(100)+155
        Circle(Star()\X+ShakeX,Star()\Y+ShakeY,(Random(100)/100)+1,RGB(Color,color,color))
      Wend
      ;Draw Border
    StopDrawing()
  EndIf
EndProcedure

For X = 1 To NumberOfStars
  AddStar()
Next X

Repeat
  ClearScreen(RGB(BackRedColor,BackGreenColor,BackBlueColor))
  UpdateStars()
  UpdateCircles()
  FlipBuffers()
  
  If Size < SetSize
    Size + ChangeSizeSpeed
  ElseIf Size > SetSize
    Size - ChangeSizeSpeed
  ElseIf Size = SetSize
    realsize = SnakeSize/2
    SetSize = Random(realsize)+realsize
  EndIf
  
  If XDir = 1
    PlayerX + MoveSpeed 
  ElseIf XDir = 0
    PlayerX - MoveSpeed 
  EndIf
  
  If PlayerX > 800-(Size/2)
    XDir = 0
    YDir = Random(1)
  ElseIf PlayerX < (Size/2)
    XDir = 1
    YDir = Random(1)
  EndIf
  
  If YDir = 1
    PlayerY + MoveSpeed 
  ElseIf YDir = 0
    PlayerY - MoveSpeed 
  EndIf
  
  If PlayerY > 600-(Size/2)
    YDir = 0
    XDir = Random(1)
  ElseIf PlayerY < (Size/2)
    YDir = 1
    XDir = Random(1)
  EndIf
  
  AddOCircle(PlayerX,PlayerY,Size)
  
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Escape)
    End
  EndIf
ForEver

Posted: **Sat Mar 27, 2004 3:41 am**

with some modifying could be a good screensaver
on the second one sometimes the ball gets outside of the screen

PureBasic Forums - English

Space Snake << Program I made when I was bored

Space Snake << Program I made when I was bored