frmmain.class

Gambas is a graphical development environment based on a Basic interpreter, like Visual Basic. It us

'***********Snake Example Game*********************************
'***********By: Ahmad Kamal <[e-mail]>******************
'***********Written for Gambas: gambas.sourceforge.net*********
'***********V1.0: 02-Aug-2003**********************************
'***********V1.1: 16-Apr-2004**********************************
'***********Added SDL sound support****************************

PUBLIC CONST arrow_left AS Integer = 4114
PUBLIC CONST arrow_right AS Integer = 4116
PUBLIC CONST arrow_up AS Integer = 4115
PUBLIC CONST arrow_down AS Integer = 4117

PUBLIC Head_Direction AS String

PUBLIC Xpos AS NEW Integer[]                    'Snake's Xpositions, Xpos[0] = head
PUBLIC Ypos AS NEW Integer[]                    'Snake's Ypositions, Ypos[0] = head
PUBLIC Tailpos AS NEW Integer[]                 'Array holding the index of the square to be moved. Xpos[ TailPos[0] ] is Xposition of the tail. TailPos keeps rotating
PUBLIC AppleXpos AS NEW Integer[]           'Apples Xpos
PUBLIC AppleYpos AS NEW Integer[]           'Apples Ypos

PUBLIC Score AS Integer
PUBLIC Speed AS String

PUBLIC hPictHead AS NEW Picture
PUBLIC hPictBody AS NEW Picture
PUBLIC hPictApple AS NEW Picture

PUBLIC StartSound AS Sound
PUBLIC EatSound AS Sound 
PUBLIC DeadSound AS Sound 

PUBLIC SUB Form_Open()

   DIM i AS Integer
   Randomize()
   
   StartSound = NEW Sound ("start.wav")  'Pre-load all sounds FOR speed issues
   EatSound = NEW Sound ("eat.wav")      'Although, one SDL component could handle
   DeadSound = NEW Sound ("dead.wav")    'All of them!
   
   MenuGrandMa_Click()
   InitSnake
   UpdateScoreBoard
   Play("start")
   
   ME.Text = "Snake v1.0"
   hPictHead.Load("FrmIcon.png")                            'BM: Load form icon, does this work? KDE shows an arrow! SystemMenu instead
   ME.Icon = hPictHead                                              'The same as head icon but in a standard size

   Dwg.background=Color.Black                               'BM: ?????????? Doesn't work

   Draw.Begin(dwg)
   Draw.ForeColor = &HAA0000&                               'Faded red
   Draw.Font.Name = "Serif"
   Draw.Font.Size = 120                                               'Give me real big font
   FOR i =  1 TO 10                                                       'Trick to draw 3D text
   IF i = 10 THEN Draw.ForeColor = &HFF0000&        'This is the last layer, so make it pure red
   Draw.text("Snake", (dwg.clientW - Draw.TextWidth("Snake") ) /2 -i, ( dwg.Height + Draw.TextHeight("Snake") ) /2 - i - 50)
   NEXT 
   Draw.Font.Size = 18
   Draw.Text("ver 1.0 by: Ahmad Kamal", (dwg.clientW - Draw.TextWidth("ver 1.0 by: Ahmad Kamal") ) /2, 100)
   
   hPictHead.Load("head.png")                       'Load images
   'hPictHead.Mask(Color.white)
   hPictBody.Load("body.png")
   hPictApple.Load("apple.png")
   
   TimerApple_Timer()                                     'Init apples location array
 
   Draw.End
END


PUBLIC SUB Form_KeyPress()
'This function stores the snake direction taken from the keyboard in head_direction
  
  DIM tmp AS Integer
  
  SELECT Key.Code
    CASE arrow_left
      IF (Head_Direction <> "right") THEN Head_Direction = "left"     'Snake isn't supposed to go backwards!
    CASE arrow_right
      IF (Head_Direction <> "left") THEN Head_Direction = "right"
    CASE arrow_up
      IF (Head_Direction <> "down") THEN Head_Direction = "up"
    CASE arrow_down
      IF (Head_Direction <> "up") THEN Head_Direction = "down"
  END SELECT

END

PUBLIC SUB TmrEngine_Timer()
'This is the main game engine. With every tick, the game status get updated.

  DIM i AS Integer
  DIM hPictHeadRotated AS NEW picture

  'Here we will move the snake. Instead of moving each & every square of the snake
  'We will use an optimized method. Only the head moves one step forward & the
  'Tail moves to where the head previously was. That way, all the snake seems to be moving!
  
  Xpos[TailPos[0]] = Xpos[0]                                        'Tail goes to head
  Ypos[TailPos[0]] = Ypos[0]
  TailPos.add(TailPos.pop(),0)                                     'Array is rotated => Last element is put as first element, i.e. new tail is calculated
  
  SELECT Head_Direction                                           'See the current head direction and start moving
    CASE "left"
      Xpos[0] = Xpos[0] - 20
      hPictHeadRotated = hPictHead.Image.Rotate(180).Picture        'Snake looks to where it's going :)
    CASE "right"
      Xpos[0] = Xpos[0] + 20
      hPictHeadRotated = hPictHead
    CASE "up"
      Ypos[0] = Ypos[0] - 20
      hPictHeadRotated = hPictHead.Image.Rotate(-90).Picture
    CASE "down"
      Ypos[0] = Ypos[0] + 20
      hPictHeadRotated = hPictHead.Image.Rotate(90).Picture
  END SELECT
  
  
  'Begin drawing
  Dwg.Clear                                                                      'Clear old game drawings
  Draw.Begin(Dwg)

    FOR i = 1 TO Xpos.count - 1                                       'Draw snake
      Draw.Picture(hPictBody, Xpos[i], Ypos[i])
    NEXT
    
    FOR i = 0 TO 2                                                            'Draw apples
      Draw.Picture(hPictApple, AppleXpos[i], AppleYpos[i])
    NEXT
  
  Draw.Picture(hPictHeadRotated, Xpos[0], Ypos[0])        'BM: Why doesn't the head appear on top? put hPictHead, and it will !!!
  
  Draw.End
  
    IF (SnakeHasEatenApple()) THEN 
      Play("eat")
      MakeSnakeLonger                                                   '4th Generation programming :)
      INC Score
    END IF
    
    UpdateSpeed                                                             'Should snake go faster?
    UpdateScoreBoard                                                    'Write score & speed on screen
  
    IF (SnakeHitTheWall()) THEN SnakeDies                  'G4 again ;)
    
    IF (SnakeBitHimself()) THEN SnakeDies                   'So cool
    
    IF (SnakeAteAllApples()) THEN                                 'If you've eaten the 3 apples, throw some more apples
     TimerApple_Timer()                                                  'Call the timer manually
     TimerApple.Enabled = FALSE                                   'Timer is disabled and re-enabled to reset it's internal timer
     TimerApple.Enabled = TRUE
   END IF

END

PUBLIC SUB TimerApple_Timer()

  DIM i AS Integer                                                          'Throw 3 random apples all over the screen
  AppleXpos.clear
  AppleYpos.clear
  FOR i = 0 TO 2
    AppleXpos.add(Int(Rnd(1,30)) * 20 , i)
    AppleYpos.add(Int(Rnd(1,20)) * 20 , i)
  NEXT

END

PUBLIC SUB MakeSnakeLonger()

    Xpos.add(Xpos[Tailpos[0]] )                   'Add a new square to where the tail square is, to make the snake longer
    Ypos.add(Ypos[Tailpos[0]] )

    TailPos.add(TailPos[0])                         'Remember when we said, tailpos keeps rotating. Now we have put an extra
    TailPos.remove(0)                                 'Square, to make it move instead of the real tail, we make a back rotation (in
    TailPos.add(Xpos.Length - 1 ,0)           'opposite direction). First element => Last position, then index of new tail
                                                                  'gets added at location 0. Remember, TailPos[0] is the index of the tail!!!

END

PUBLIC FUNCTION SnakeHasEatenApple() AS Boolean

  DIM RetVal AS Boolean
  DIM TmpAppleX AS Integer
  DIM TmpAppleY AS Integer
  DIM i AS Integer
  
  RetVal = FALSE
  
    FOR i = 0 TO 2
    
      TmpAppleX = AppleXpos[i]
      TmpAppleY = AppleYpos[i]
      IF ( Xpos[0] =(TmpAppleX) AND Ypos[0] = (TmpAppleY) ) THEN      'Snake head on an apple?
        AppleXpos[i] = -100                                                                          'Hide eaten apples
        AppleYpos[i] = -100
        RetVal = TRUE
      END IF
    
    NEXT
      
    
  RETURN RetVal

END


PUBLIC FUNCTION SnakeHitTheWall() AS Boolean

  IF (Xpos[0] < 0 OR Ypos[0] < 0 OR Xpos[0] >=600 OR Ypos[0] >= 400 ) THEN    'Duh
    RETURN TRUE
  ELSE
    RETURN FALSE
  END IF

END

PUBLIC SUB SnakeDies()

  TmrEngine.Enabled = FALSE
  TimerApple.Enabled = FALSE
  Play("dead")
  Message("The snake's soul will always be remembered.\nGame Over!!\nYou scored: " & score & "\nPress Game -> New to play again.")
  
END


PUBLIC SUB MenuNew_Click()
  
  DIM i AS Integer
  
  Head_Direction = ""                         'Reset everything
  Score = 0
  MenuGrandMa_Click()                     'Reset speed
    
  InitSnake
  TimerApple_Timer

  TmrEngine.Enabled = TRUE
  TimerApple.Enabled = TRUE

END

PUBLIC SUB MenuPause_Click()

  IF (MenuPause.Caption = "&Pause"  AND (TmrEngine.Enabled = TRUE )) THEN
    TmrEngine.Enabled = FALSE
    TimerApple.Enabled = FALSE
    MenuPause.Caption = "Un&Pause"
  ELSE IF (MenuPause.Caption = "Un&Pause"  AND (TmrEngine.Enabled = FALSE )) THEN
    TmrEngine.Enabled = TRUE
    TimerApple.Enabled = TRUE
    MenuPause.Caption = "&Pause"
  END IF

END

PUBLIC SUB MenuQuit_Click()

  FrmMain.Close
  
END

PUBLIC SUB MenuGrandMa_Click()

  TmrEngine.delay = 150
  TimerApple.delay = 8000
  Speed = "GrandMa"

END


PUBLIC SUB MenuCool_Click()

    TmrEngine.delay = 100
    TimerApple.delay = 5000
    Speed = "Cool"

END


PUBLIC SUB MenuSpeedFreak_Click()

  TmrEngine.delay = 50
  TimerApple.delay = 2500
  Speed = "Speed Freak"

END

PUBLIC SUB MenuHowToPlay_Click()

  DIM Help AS String
  
  Help = "The Rules are simple:\n"
  Help = Help & "Eat as many apples as you can\n"
  Help = Help & "Do not Hit the walls, or bite yourself!\n\n"
  Help = Help & "Use the arrow keys to move the snake"
  
  Message(Help)
  
END


PUBLIC SUB InitSnake()

  DIM i AS Integer
  
  Xpos.Clear()
  Ypos.Clear()
  TailPos.Clear()

   FOR i  = 0 TO 3
    Xpos.add(0,i)
    Ypos.add(0,i)
  NEXT                                          'BM: Here i exists with value 4, shouldn't it be 3?!

   TailPos.add(3,0)
   TailPos.add(2,1)
   TailPos.add(1,2)
   
END

PUBLIC FUNCTION SnakeAteAllApples() AS Boolean
  
  'IF ( AppleXpos[0] = AppleXpos[1] = AppleXpos[2] = -100) THEN                 'BM: Doesn't work
  IF ( (AppleXpos[0] = -100) AND (AppleXpos[1] = -100) AND (AppleXpos[2] = -100) ) THEN
  RETURN TRUE
  ELSE
  RETURN FALSE
  END IF
  
END

PUBLIC SUB UpdateScoreBoard()
  
   LblScore.Text = "Score: " & Score
   LblSpeed.Text = "Speed: " & Speed
  
END

PUBLIC SUB UpdateSpeed()
  
  IF MenuAutoAdvanceSpeed.checked THEN
    IF (Score > 19 AND Speed = "GrandMa") THEN MenuCool_Click
    IF (Score > 79 AND Speed = "Cool") THEN MenuSpeedFreak_Click    'Let's kill ur snake :)
  END IF
   
END

PUBLIC SUB MenuAutoAdvanceSpeed_Click()

  MenuAutoAdvanceSpeed.Checked = NOT MenuAutoAdvanceSpeed.checked       'Toggle menu checking
  
END

PUBLIC FUNCTION SnakeBitHimself() AS Boolean
  
  DIM RetVal AS Boolean
  DIM TmpAppleX AS Integer
  DIM TmpAppleY AS Integer
  DIM i AS Integer
  
  RetVal = FALSE
  
    FOR i = 1 TO (Xpos.Length - 1)
    
      TmpAppleX = Xpos[i]
      TmpAppleY = Ypos[i]
      IF ( Xpos[0] =(TmpAppleX) AND Ypos[0] = (TmpAppleY) AND Xpos[0] <> 0) THEN        'Snake head on part of its body?
        RetVal = TRUE
      END IF
    
    NEXT
      
  RETURN RetVal
    
END

PUBLIC SUB MenuAbout_Click()

  DIM About AS String
  
  About = "Snake v1.0\nBy: Ahmad Kamal <[e-mail]>\nWritten for Gambas http://gambas.sf.net"
  Message(About)

END

PUBLIC SUB Play(sound AS String)
'I know it's slow, but I had to give it sound!!!
'Now I can safely move on to writing Quake17 ;)
  
'  EXEC [ "playwave", "/tmp/" & sound & ".wav" ]
  SELECT CASE sound
    CASE "start"
      startsound.Play ()
    CASE "eat"
      eatsound.Play ()
    CASE "dead"
      deadsound.Play ()
  END SELECT
END