Game menu Prototype

Share your advanced PureBasic knowledge/code with the community.
User avatar
Guimauve
Enthusiast
Enthusiast
Posts: 742
Joined: Wed Oct 22, 2003 2:51 am
Location: Canada

Game menu Prototype

Post by Guimauve »

Hello everyone

Today a very simple ClickableTextGadget.

Have fun !

Regards
Guimauve

[EDIT] A small optimisation in the cursor drawing.

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Game menu Prototype
; File : Game menu Prototype.pb
; File Version : 1.0.1
; Programmation : OK
; Programmed by : Guimauve
; Date : 21-08-2006
; Last Update : 21-08-2006
; Coded for PureBasic V4.00
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

ProcedureDLL.b MouseReleasedButton(ButtonNumber.b)
  
  Static Appel.b, Appuyee.b, Relachee.b, Memoire.b
  
  If Appel = #False
    
    Relachee = #False
    Memoire = #False
    Appel = #True
    
  EndIf 
  
  Appuyee = MouseButton(ButtonNumber)
  
  If Appuyee = #True 
    
    Relachee = #False 
    Memoire = #True
    
  EndIf 
  
  If Appuyee = #False And Relachee = #False And Memoire = #True 
    
    Relachee = #True
    Appel = #False 
    
  EndIf 
  
  ProcedureReturn Relachee
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Constants Enumeration >>>>>

Enumeration 
  
  #State_Normal
  #State_FlyOver
  #State_Clicked
  
EndEnumeration

Enumeration 
  
  #Menu_New_Game
  #Menu_Return_Game
  #Menu_Quit_Game
  
  #Menu_Max_Size
  
EndEnumeration

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; AUTOMATICALLY GENERATED CODE, DO NOT MODIFY
; UNLESS YOU REALLY, REALLY, REALLY MEAN IT !!
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure declaration >>>>>

Structure ClickableText
  
  PosX.w
  PosY.w
  Width.w
  Height.w
  Text.s
  Color.l
  FlyColor.l
  EffexColor.l
  state.b
  ClickDown.b
  ClickUp.b
  Option.b
  FontID.l
  
EndStructure

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Access macros >>>>>

Macro ClickableTextPosX(GadgetA)
  
  GadgetA\PosX
  
EndMacro

Macro ClickableTextPosY(GadgetA)
  
  GadgetA\PosY
  
EndMacro

Macro ClickableTextWidth(GadgetA)
  
  GadgetA\Width
  
EndMacro

Macro ClickableTextHeight(GadgetA)
  
  GadgetA\Height
  
EndMacro

Macro ClickableTextText(GadgetA)
  
  GadgetA\Text
  
EndMacro

Macro ClickableTextColor(GadgetA)
  
  GadgetA\Color
  
EndMacro

Macro ClickableTextFlyColor(GadgetA)
  
  GadgetA\FlyColor
  
EndMacro

Macro ClickableTextEffexColor(GadgetA)
  
  GadgetA\EffexColor
  
EndMacro

Macro ClickableTextState(GadgetA)
  
  GadgetA\state
  
EndMacro

Macro ClickableTextClickDown(GadgetA)
  
  GadgetA\ClickDown
  
EndMacro

Macro ClickableTextClickUp(GadgetA)
  
  GadgetA\ClickUp
  
EndMacro

Macro ClickableTextOption(GadgetA)
  
  GadgetA\Option
  
EndMacro

Macro ClickableTextFontID(GadgetA)
  
  GadgetA\FontID
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 31 ms <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ClickableTextGadget >>>>>

Macro ClickableTextGadget(GadgetA, P_PosX, P_PosY, P_Text, P_Color, P_FlyColor, P_EffexColor, P_Option = 0, P_FontID = #PB_Default)
  
  ClickableTextPosX(GadgetA) = P_PosX
  ClickableTextPosY(GadgetA) = P_PosY
  ClickableTextText(GadgetA) = P_Text
  ClickableTextColor(GadgetA) = P_Color
  ClickableTextFlyColor(GadgetA) = P_FlyColor
  ClickableTextEffexColor(GadgetA) = P_EffexColor
  ClickableTextOption(GadgetA) = P_Option
  ClickableTextFontID(GadgetA) = P_FontID
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< MouseFlyOverClickableText <<<<<

Procedure.b MouseFlyOverClickableText(*GadgetA.ClickableText)
  
  If MouseX() > ClickableTextPosX(*GadgetA)
    If MouseX() < (ClickableTextPosX(*GadgetA) + ClickableTextWidth(*GadgetA))
      If MouseY() > ClickableTextPosY(*GadgetA)
        If MouseY() < (ClickableTextPosY(*GadgetA) + ClickableTextHeight(*GadgetA))
          FlyOver.b = #True 
        EndIf 
      EndIf  
    EndIf  
  EndIf 
  
  ProcedureReturn FlyOver
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< DrawClickableTextGadget <<<<<

Procedure DrawClickableTextGadget(*GadgetA.ClickableText)
  
  StartDrawing(ScreenOutput());>
    
    If ClickableTextFontID(*GadgetA) <> #PB_Default
      DrawingFont(FontID(ClickableTextFontID(*GadgetA)))
    EndIf 
    
    ClickableTextWidth(*GadgetA) = TextWidth(ClickableTextText(*GadgetA))
    ClickableTextHeight(*GadgetA) = TextHeight(ClickableTextText(*GadgetA))
    
    If ClickableTextOption(*GadgetA) = 1 
      
      ClickableTextPosX(*GadgetA) = (GetSystemMetrics_(#SM_CXSCREEN) - ClickableTextWidth(*GadgetA)) >> 1
      
    EndIf
    
    If ClickableTextState(*GadgetA) = #State_Normal
      
      Txt_x = ClickableTextPosX(*GadgetA)
      Txt_y = ClickableTextPosY(*GadgetA)
      TxtColor = ClickableTextColor(*GadgetA)
      
    ElseIf ClickableTextState(*GadgetA) = #State_FlyOver
      
      Txt_x = ClickableTextPosX(*GadgetA) - 1
      Txt_y = ClickableTextPosY(*GadgetA) - 1
      TxtColor = ClickableTextFlyColor(*GadgetA)
      
    ElseIf ClickableTextState(*GadgetA) = #State_Clicked
      
      Txt_x = ClickableTextPosX(*GadgetA) + 1
      Txt_y = ClickableTextPosY(*GadgetA) + 1
      TxtColor = ClickableTextEffexColor(*GadgetA)
      
    EndIf 
    
    DrawingMode(#PB_2DDrawing_Transparent)
    
    DrawText(Txt_x, Txt_y, ClickableTextText(*GadgetA), TxtColor)
    
  StopDrawing();<
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; AUTOMATICALLY GENERATED CODE, DO NOT MODIFY
; UNLESS YOU REALLY, REALLY, REALLY MEAN IT !!
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure declaration >>>>>

Structure Menu
  
  EventID.l
  GadgetList.ClickableText[#Menu_Max_Size]
  
EndStructure

; <<<<<<<<<<<<<<<<<<<<
; <<<<< Mutators >>>>>

Macro SetMenuEventID(ObjetA, P_EventID)
  
  ObjetA\EventID = P_EventID
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Observators >>>>>

Macro GetMenuEventID(ObjetA)
  
  ObjetA\EventID
  
EndMacro

Macro GetMenuGadgetList(ObjetA, Index)
  
  ObjetA\GadgetList[Index]
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 16 ms <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<
; <<<<< DrawMenu >>>>>
  
Procedure DrawMenu(*ObjetA.Menu)
  
  For Index = 0 To #Menu_Max_Size - 1
    
    ClickableTextClickDown(GetMenuGadgetList(*ObjetA, Index)) = #False
    
    If MouseFlyOverClickableText(GetMenuGadgetList(*ObjetA, Index)) And MouseButton(1) = 1
      
      ClickableTextClickDown(GetMenuGadgetList(*ObjetA, Index)) = #True
      ClickableTextState(GetMenuGadgetList(*ObjetA, Index)) = #State_Clicked
      
    ElseIf MouseFlyOverClickableText(GetMenuGadgetList(*ObjetA, Index)) = #True
      
      ClickableTextState(GetMenuGadgetList(*ObjetA, Index)) = #State_FlyOver
      
    ElseIf MouseFlyOverClickableText(GetMenuGadgetList(*ObjetA, Index)) = #False
      
      ClickableTextState(GetMenuGadgetList(*ObjetA, Index)) = #State_Normal
      
    EndIf
    
    DrawClickableTextGadget(GetMenuGadgetList(*ObjetA, Index))
    
  Next
  
  If MouseReleasedButton(1) = 1
    
    For Index = 0 To #Menu_Max_Size - 1
      
      If MouseFlyOverClickableText(GetMenuGadgetList(*ObjetA, Index)) = #True
        
        SetMenuEventID(*ObjetA, Index)
        Break
        
      Else 
        
        ClickableTextState(GetMenuGadgetList(*ObjetA, Index)) = #State_Normal
        SetMenuEventID(*ObjetA, -1)
        
      EndIf
      
    Next
    
  EndIf 
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< DrawScreenMenu >>>>>

Procedure NewGameScreen(Text.s)
  
  LoadFont(5, "Comic Sans MS", 14, #PB_Font_Bold)
  
  Repeat
    
    ClearScreen(#Black) 
    
    StartDrawing(ScreenOutput());>
      
      DrawingMode(#PB_2DDrawing_Transparent)
      DrawingFont(FontID(5))
      DrawText(5,5, "Game mode : " + Text, RGB($99, $33, $FF))
      DrawText(5,30, "Press ESCAPE to Return to the Main Menu", RGB($99, $33, $FF))
      
    StopDrawing();<
    
    ExamineKeyboard() 
    FlipBuffers() 
    
  Until KeyboardPushed(#PB_Key_Escape)
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Game menu Prototype <<<<<

ScreenW = GetSystemMetrics_(#SM_CXSCREEN)
ScreenH = GetSystemMetrics_(#SM_CYSCREEN)
Title.s = "Game menu Prototype"
#Cursor = 125

If InitKeyboard() = 0 Or InitSprite() = 0 Or InitSprite3D() = 0 Or InitMouse() = 0
  
  MessageRequester("ERROR","Can't initialize DirectX !",#MB_ICONERROR)
  End 
  
EndIf 

If OpenScreen(ScreenW, ScreenH, 32, Title) = 0 
  
  If OpenScreen(ScreenW, ScreenH, 24, Title) = 0 
    
    If OpenScreen(ScreenW, ScreenH, 16, Title) = 0 
      
      MessageRequester("ERROR", "Can't open DirectX screen !", #MB_ICONERROR)
      End
      
    EndIf
    
  EndIf
  
EndIf 

If CreateSprite(#Cursor, 32,32, #PB_Sprite_Texture)
  
  StartDrawing(SpriteOutput(#Cursor));>
    
    For Coord = 0 To 14
      Circle(Coord,3,3,#Red) 
      Circle(3,Coord,3,#Red) 
    Next

    For Coord = 0 To 27 Step 1
      Circle(Coord,Coord,3,#Red) 
    Next

  StopDrawing();<
  
  CreateSprite3D(#Cursor, #Cursor)
  
EndIf

SetMenuEventID(MainMenu.Menu, -1)
  
LoadFont(0, "Comic Sans MS", 20, #PB_Font_Bold | #PB_Font_Underline)
  
ClickableTextGadget(GetMenuGadgetList(MainMenu, #Menu_New_Game), 0, ScreenH >> 1, "New Game", #Green, #Yellow, #Red, 1, 0)
ClickableTextGadget(GetMenuGadgetList(MainMenu, #Menu_Return_Game), 0, (ScreenH >> 1) + 40, "Return to Current", #Green, #Yellow, #Red, 1, 0)
ClickableTextGadget(GetMenuGadgetList(MainMenu, #Menu_Quit_Game), 0, (ScreenH >> 1) + 80, "Quit", #Green, #Yellow, #Red, 1, 0)
  
Repeat
  
  ClearScreen(#Black) 
  
  DrawMenu(MainMenu)
  
  Select GetMenuEventID(MainMenu)
    
    Case #Menu_New_Game
      NewGameScreen("New Game")
      SetMenuEventID(MainMenu, -1)
      
    Case #Menu_Return_Game
      NewGameScreen("Return Current game")
      SetMenuEventID(MainMenu, -1)
      
    Case #Menu_Quit_Game
      Quit = #True
      
  EndSelect
  
  Start3D();>
    DisplaySprite3D(#Cursor, MouseX(), MouseY())
  Stop3D();<
  
  ExamineMouse()
  FlipBuffers() 
  
Until Quit = #True
  
CloseScreen()
End 

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
User avatar
Joakim Christiansen
Addict
Addict
Posts: 2452
Joined: Wed Dec 22, 2004 4:12 pm
Location: Norway
Contact:

Post by Joakim Christiansen »

And here is mine, I put together some code i'm using in a game.
The Options button will send you to another menu, the Single Player button will start "the game", and the Exit button will end the shit.

Code: Select all

;Game menu example by Joakim L. Christiansen
;v1.0 - 2006.08.22
;Have fun ;)

;-Constants
#Name      = "The Game"
#Version   = "v1.0 Alpha 1"
#Copyright = "Copyright © 2006 Some Stupid Guy."
#ScreenWidth  = 1024
#ScreenHeight = 768
#ScreenDepth  = 32

;-Enumeration
Enumeration ;Menues
  #mnu_None
  #mnu_Main
  #mnu_SinglePlayer
  #mnu_HostGame
  #mnu_JoinGame
  #mnu_Options
EndEnumeration
Enumeration ;Fonts
  #fnt_Impact_18
  #fnt_Impact_24
  #fnt_Impact_120
EndEnumeration
Enumeration ;Sprites
  #spr_Cursor
  #spr_ScreenShot
EndEnumeration

;-Variables
Global MB_Left, Menu = #mnu_Main

;-Procedures
Procedure DrawTextCentered(X,Y,String$)
  DrawText(X-TextWidth(String$)/2,Y-TextHeight(String$)/2,String$)
EndProcedure
Procedure DrawTextXCentered(X,Y,String$)
  DrawText(X-TextWidth(String$)/2,Y,String$)
EndProcedure
Procedure MB_Left() ;0 = False, 1 = Pressed, 2 = Down, 3 = Released
  If MouseButton(1)
    If MB_Left = 0
      MB_Left = 1
    Else
      MB_Left = 2
    EndIf
  Else
    If MB_Left = 3
      MB_Left = 0
    ElseIf MB_Left = 2
      MB_Left = 3
    EndIf
  EndIf
EndProcedure
Procedure SaveScreen()
  Static Number
  Number + 1
  GrabSprite(#spr_ScreenShot,0,0,#ScreenWidth,#ScreenHeight)
  SaveSprite(#spr_ScreenShot,"screenshot"+Str(Number)+".bmp")
  FreeSprite(#spr_ScreenShot)
EndProcedure
Procedure.l DrawMenuButton(X,Y,Text$)
  Protected Pressed, Width = 300, Height = 48
  X - Width/2
  
  Box(X,Y,Width,Height,RGB(0,96,64))
  If MouseX() > X And MouseX() < X+Width And MouseY() > Y And MouseY() < Y+Height
    If MB_Left = 3
      Pressed = #True
      MB_Left = 0
    EndIf
    Box(X+3,Y+3,Width-6,Height-6,RGB(0,184,64))
    FrontColor(RGB(200,0,0))
  Else
    Box(X+3,Y+3,Width-6,Height-6,RGB(0,128,64))
    FrontColor(RGB(100,0,0))
  EndIf
  
  DrawingFont(FontID(#fnt_Impact_24))
  DrawTextCentered(X+Width/2,Y+Height/2,Text$)
  
  ProcedureReturn Pressed
EndProcedure
Procedure.l MainMenu()
  Protected Selected = -1
  
  Repeat
    ExamineKeyboard(): ExamineMouse(): MB_Left()
    If KeyboardReleased(#PB_Key_Escape)
      Selected = 4
    ElseIf KeyboardReleased(#PB_Key_F12)
      SaveScreen()
    EndIf
    
    Delay(2): FlipBuffers(): ClearScreen(#Black)
    
    StartDrawing(ScreenOutput())
      DrawingMode(#PB_2DDrawing_Transparent)
      
      FrontColor(RGB(0,0,198))
      DrawingFont(FontID(#fnt_Impact_120))
      DrawTextXCentered(#ScreenWidth/2,68,#Name)
      
      FrontColor(RGB(198,0,0))
      DrawingFont(FontID(#fnt_Impact_24))
      DrawTextXCentered(#ScreenWidth/2,240,#Version)
      
      DrawingFont(FontID(#fnt_Impact_18))
      DrawTextXCentered(#ScreenWidth/2,620,#Copyright)
      DrawTextXCentered(#ScreenWidth/2,645,"All rights reserved.")
      
      If DrawMenuButton(#ScreenWidth/2,300,"Single player")
        Selected = 0
      ElseIf DrawMenuButton(#ScreenWidth/2,362,"Host game")
        Selected = 1
      ElseIf DrawMenuButton(#ScreenWidth/2,424,"Join game")
        Selected = 2
      ElseIf DrawMenuButton(#ScreenWidth/2,486,"Options")
        Selected = 3
      ElseIf DrawMenuButton(#ScreenWidth/2,548,"Exit")
        Selected = 4
      EndIf
    StopDrawing()
    
    DisplayTransparentSprite(#spr_Cursor,MouseX()-16,MouseY()-16)
  Until Selected > -1
  
  ProcedureReturn Selected
EndProcedure
Procedure.l Options()
  Protected Selected = -1
  
  Repeat
    ExamineKeyboard(): ExamineMouse(): MB_Left()
    If KeyboardReleased(#PB_Key_Escape)
      Selected = 0
    ElseIf KeyboardReleased(#PB_Key_F12)
      SaveScreen()
    EndIf
    
    Delay(2): FlipBuffers(): ClearScreen(#Black)
    
    StartDrawing(ScreenOutput())
      DrawingMode(#PB_2DDrawing_Transparent)
      
      FrontColor(RGB(0,0,198))
      DrawingFont(FontID(#fnt_Impact_120))
      DrawTextXCentered(#ScreenWidth/2,68,"Options")
      
      FrontColor(RGB(198,0,0))
      DrawingFont(FontID(#fnt_Impact_24))
      DrawTextXCentered(#ScreenWidth/2,240,"Game options")
      
      If DrawMenuButton(#ScreenWidth/2,548,"Back")
        Selected = 0
      EndIf
    StopDrawing()
    
    DisplayTransparentSprite(#spr_Cursor,MouseX()-16,MouseY()-16)
  Until Selected > -1
  
  ProcedureReturn Selected
EndProcedure

;-Initialize and open screen
If Not (InitKeyboard() And InitMouse() And InitSprite())
  MessageRequester("Warning!","DirectX 7 or later not found!",#MB_ICONWARNING)
  End
EndIf
If Not OpenScreen(#ScreenWidth,#ScreenHeight,#ScreenDepth,#Name)
  MessageRequester("Warning!","Can't open a "+Str(#ScreenWidth)+"x"+Str(#ScreenHeight)+" "+Str(#ScreenDepth)+"bit screen!",#MB_ICONWARNING)
  End
EndIf

;-Load resources
;LoadFont(#fnt_Arial_08_Bold,"Arial",8,#PB_Font_Bold)
LoadFont(#fnt_Impact_18,"Impact",18)
LoadFont(#fnt_Impact_24,"Impact",24)
LoadFont(#fnt_Impact_120,"Impact",120)
;Create a crappy mouse cursor
CreateSprite(#spr_Cursor,32,32)
StartDrawing(SpriteOutput(#spr_Cursor))
  DrawingMode(#PB_2DDrawing_Outlined)
  Circle(16,16,16,#Red)
  Circle(16,16,1,#Red)
StopDrawing()

MouseLocate(#ScreenWidth/2,415)

;-Main loop start
Repeat
  ;-Menu handling
  Select Menu
    Case #mnu_Main
      Select MainMenu()
        Case 0: Menu = #mnu_None ;Single player
        Case 1: ;Host game
        Case 2: ;Join game
        Case 3: Menu = #mnu_Options
        Case 4: Break
      EndSelect
    Case #mnu_Options
      Select Options()
        Case 0: Menu = #mnu_Main
      EndSelect
  EndSelect
  If Menu <> #mnu_None: Continue: EndIf
  
  ;-The game...
  Delay(2): FlipBuffers(): ClearScreen(#Black)
  
  StartDrawing(ScreenOutput())
    DrawingMode(#PB_2DDrawing_Transparent)
    FrontColor(RGB(0,0,198))
    DrawingFont(FontID(#fnt_Impact_18))
    DrawTextXCentered(#ScreenWidth/2,100,"You lose! Press escape to continue! (really fun game)")
  StopDrawing()
  
  ExamineKeyboard()
  If KeyboardReleased(#PB_Key_Escape)
    Menu = #mnu_Main
  EndIf
ForEver
I like logic, hence I dislike humans but love computers.
Dare
Addict
Addict
Posts: 1965
Joined: Mon May 29, 2006 1:01 am
Location: Outback

Post by Dare »

Thanks guys!

Very nice.

Now if someone can create the equivalent of a dynamic listview with selectable items, or a combobox, (to, eg, pick a saved game when there could be none to many) then this would be awesome ... :D
Dare2 cut down to size
mskuma
Enthusiast
Enthusiast
Posts: 573
Joined: Sat Dec 03, 2005 1:31 am
Location: Australia

Post by mskuma »

I second the thanks :D great stuff.

I've always admired this game menu (direct download link here) from this page. One day I'd like to port it to PB.
dracflamloc
Addict
Addict
Posts: 1648
Joined: Mon Sep 20, 2004 3:52 pm
Contact:

Post by dracflamloc »

I really think we should start a cross platform opensource GUI platform for pb for using the sprite libraries.
User avatar
Guimauve
Enthusiast
Enthusiast
Posts: 742
Joined: Wed Oct 22, 2003 2:51 am
Location: Canada

Post by Guimauve »

Ok let's go to version 2.0.0

It's basically the same as Version 1.0.0 I have just replaced the Menu Structure
by a dynamic array.

Remember, it's just an exemple. I have created this code for a small project,
an Asteroids clone 2D game. I will be able to show this small game soon.

Regards
Guimauve

EDIT : Version 2.0.1 Final !

I have just removed Clickup and ClickDown flag.

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Game menu Prototype
; File : Game menu Prototype.pb
; File Version : 2.0.1
; Programmation : OK
; Programmed by : Guimauve
; Date : 21-08-2006
; Last Update : 26-08-2006
; Coded for PureBasic V4.00
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

ProcedureDLL.b MouseReleasedButton(ButtonNumber.b)
  
  Static Appel.b, Appuyee.b, Relachee.b, Memoire.b
  
  If Appel = #False
    
    Relachee = #False
    Memoire = #False
    Appel = #True
    
  EndIf 
  
  Appuyee = MouseButton(ButtonNumber)
  
  If Appuyee = #True 
    
    Relachee = #False 
    Memoire = #True
    
  EndIf 
  
  If Appuyee = #False And Relachee = #False And Memoire = #True 
    
    Relachee = #True
    Appel = #False 
    
  EndIf 
  
  ProcedureReturn Relachee
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Constants Enumeration >>>>>

Enumeration 
  
  #State_Normal
  #State_FlyOver
  #State_Clicked
  
EndEnumeration

Enumeration 
  
  #Menu_New_Game
  #Menu_Return_Game
  #Menu_Quit_Game
  
  #Menu_Max_Size
  
EndEnumeration

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; AUTOMATICALLY GENERATED CODE, DO NOT MODIFY
; UNLESS YOU REALLY, REALLY, REALLY MEAN IT !!
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure declaration >>>>>

Structure ClickableText
  
  PosX.w
  PosY.w
  Width.w
  Height.w
  Text.s
  Color.l
  FlyColor.l
  EffexColor.l
  State.b
  Option.b
  FontID.l
  
EndStructure

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Access macros >>>>>

Macro ClickableTextPosX(GadgetA)
  
  GadgetA\PosX
  
EndMacro

Macro ClickableTextPosY(GadgetA)
  
  GadgetA\PosY
  
EndMacro

Macro ClickableTextWidth(GadgetA)
  
  GadgetA\Width
  
EndMacro

Macro ClickableTextHeight(GadgetA)
  
  GadgetA\Height
  
EndMacro

Macro ClickableTextText(GadgetA)
  
  GadgetA\Text
  
EndMacro

Macro ClickableTextColor(GadgetA)
  
  GadgetA\Color
  
EndMacro

Macro ClickableTextFlyColor(GadgetA)
  
  GadgetA\FlyColor
  
EndMacro

Macro ClickableTextEffexColor(GadgetA)
  
  GadgetA\EffexColor
  
EndMacro

Macro ClickableTextState(GadgetA)
  
  GadgetA\state
  
EndMacro

Macro ClickableTextOption(GadgetA)
  
  GadgetA\Option
  
EndMacro

Macro ClickableTextFontID(GadgetA)
  
  GadgetA\FontID
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 16 ms <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ClickableTextGadget >>>>>

Procedure ClickableTextGadget(*GadgetA.ClickableText, P_PosX.w, P_PosY.w, P_Text.s, P_Color.l, P_FlyColor.l, P_EffexColor.l, P_Option.b = 0, P_FontID.l = #PB_Default)
  
  ClickableTextPosX(*GadgetA) = P_PosX
  ClickableTextPosY(*GadgetA) = P_PosY
  ClickableTextText(*GadgetA) = P_Text
  ClickableTextColor(*GadgetA) = P_Color
  ClickableTextFlyColor(*GadgetA) = P_FlyColor
  ClickableTextEffexColor(*GadgetA) = P_EffexColor
  ClickableTextOption(*GadgetA) = P_Option
  ClickableTextFontID(*GadgetA) = P_FontID
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< MouseFlyOverClickableText <<<<<

Procedure.b MouseFlyOverClickableText(*GadgetA.ClickableText)
  
  If MouseX() > ClickableTextPosX(*GadgetA)
    If MouseX() < (ClickableTextPosX(*GadgetA) + ClickableTextWidth(*GadgetA))
      If MouseY() > ClickableTextPosY(*GadgetA)
        If MouseY() < (ClickableTextPosY(*GadgetA) + ClickableTextHeight(*GadgetA))
          FlyOver.b = #True 
        EndIf 
      EndIf  
    EndIf  
  EndIf 
  
  ProcedureReturn FlyOver
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< DrawClickableTextGadget <<<<<

Procedure DrawClickableTextGadget(*GadgetA.ClickableText)
  
  StartDrawing(ScreenOutput());>
    
    If ClickableTextFontID(*GadgetA) <> #PB_Default
      DrawingFont(FontID(ClickableTextFontID(*GadgetA)))
    EndIf 
    
    ClickableTextWidth(*GadgetA) = TextWidth(ClickableTextText(*GadgetA))
    ClickableTextHeight(*GadgetA) = TextHeight(ClickableTextText(*GadgetA))
    
    If ClickableTextOption(*GadgetA) = 1 
      
      ClickableTextPosX(*GadgetA) = (GetSystemMetrics_(#SM_CXSCREEN) - ClickableTextWidth(*GadgetA)) >> 1
      
    EndIf
    
    If ClickableTextState(*GadgetA) = #State_Normal
      
      Txt_x = ClickableTextPosX(*GadgetA)
      Txt_y = ClickableTextPosY(*GadgetA)
      TxtColor = ClickableTextColor(*GadgetA)
      
    ElseIf ClickableTextState(*GadgetA) = #State_FlyOver
      
      Txt_x = ClickableTextPosX(*GadgetA) - 2
      Txt_y = ClickableTextPosY(*GadgetA) - 2
      TxtColor = ClickableTextFlyColor(*GadgetA)
      
    ElseIf ClickableTextState(*GadgetA) = #State_Clicked
      
      Txt_x = ClickableTextPosX(*GadgetA) + 2
      Txt_y = ClickableTextPosY(*GadgetA) + 2
      TxtColor = ClickableTextEffexColor(*GadgetA)
      
    EndIf 
    
    DrawingMode(#PB_2DDrawing_Transparent)
    
    DrawText(Txt_x, Txt_y, ClickableTextText(*GadgetA), TxtColor)
    
  StopDrawing();<
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ClickableTextEvent >>>>>
  
Procedure ClickableTextEvent(Array.ClickableText(1))
  
  EventID = -1
  
  For Index = 0 To PeekL(@Array() - 8) - 1
    
    If MouseFlyOverClickableText(Array(Index)) And MouseButton(1) = 1

      ClickableTextState(Array(Index)) = #State_Clicked
      
    ElseIf MouseFlyOverClickableText(Array(Index)) = #True
      
      ClickableTextState(Array(Index)) = #State_FlyOver
      
    ElseIf MouseFlyOverClickableText(Array(Index)) = #False
      
      ClickableTextState(Array(Index)) = #State_Normal
      
    EndIf
    
    DrawClickableTextGadget(Array(Index))
    
  Next
  
  If MouseReleasedButton(1) = 1
    
    For Index = 0 To PeekL(@Array() - 8) - 1
      
      If MouseFlyOverClickableText(Array(Index)) = #True
        
        EventID = Index
        Break
        
      Else 
        
        ClickableTextState(Array(Index)) = #State_Normal

      EndIf
      
    Next
    
  EndIf 
  
  ProcedureReturn EventID
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< DrawScreenMenu >>>>>

Procedure NewGameScreen(Text.s)
  
  LoadFont(5, "Comic Sans MS", 14, #PB_Font_Bold)
  
  Repeat
    
    ClearScreen(#Black) 
    
    StartDrawing(ScreenOutput());>
      
      DrawingMode(#PB_2DDrawing_Transparent)
      DrawingFont(FontID(5))
      DrawText(5,5, "Game mode : " + Text, RGB($99, $33, $FF))
      DrawText(5,30, "Press ESCAPE to Return to the Main Menu", RGB($99, $33, $FF))
      
    StopDrawing();<
    
    ExamineKeyboard() 
    FlipBuffers() 
    
  Until KeyboardPushed(#PB_Key_Escape)
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Game menu Prototype <<<<<

ScreenW = GetSystemMetrics_(#SM_CXSCREEN)
ScreenH = GetSystemMetrics_(#SM_CYSCREEN)
Title.s = "Game menu Prototype"
#Cursor = 125

If InitKeyboard() = 0 Or InitSprite() = 0 Or InitSprite3D() = 0 Or InitMouse() = 0
  
  MessageRequester("ERROR","Can't initialize DirectX !",#MB_ICONERROR)
  End 
  
EndIf 

If OpenScreen(ScreenW, ScreenH, 32, Title) = 0 
  
  If OpenScreen(ScreenW, ScreenH, 24, Title) = 0 
    
    If OpenScreen(ScreenW, ScreenH, 16, Title) = 0 
      
      MessageRequester("ERROR", "Can't open DirectX screen !", #MB_ICONERROR)
      End
      
    EndIf
    
  EndIf
  
EndIf 

If CreateSprite(#Cursor, 32,32, #PB_Sprite_Texture)
  
  StartDrawing(SpriteOutput(#Cursor));>
    
    For Coord = 2 To 20
      Circle(Coord,4,4,#Blue) 
      Circle(4,Coord,4,#Blue) 
    Next

    For Coord = 6 To 27 Step 1
      Circle(Coord,Coord,4,#Blue) 
    Next
 
  StopDrawing();<
  
  CreateSprite3D(#Cursor, #Cursor)
  
EndIf
 
LoadFont(0, "Comic Sans MS", 20, #PB_Font_Bold | #PB_Font_Underline)
  
Dim MenuGadget.ClickableText(#Menu_Max_Size-1)

ClickableTextGadget(MenuGadget(#Menu_New_Game), 0, ScreenH >> 1, "New Game", #Green, #Yellow, #Red, 1, 0)
ClickableTextGadget(MenuGadget(#Menu_Return_Game), 0, (ScreenH >> 1) + 40, "Resume Game", #Green, #Yellow, #Red, 1, 0)
ClickableTextGadget(MenuGadget(#Menu_Quit_Game), 0, (ScreenH >> 1) + 80, "Quit", #Green, #Yellow, #Red, 1, 0)
  
MouseLocate(400,400)

Repeat
  
  ClearScreen(#Black) 
  ExamineMouse()
  
  Select ClickableTextEvent(MenuGadget())
    
    Case #Menu_New_Game
      NewGameScreen("New Game")
  
    Case #Menu_Return_Game
      NewGameScreen("Resume Game")
      
    Case #Menu_Quit_Game
      Quit = #True
      
  EndSelect
  
  Start3D();>
    DisplaySprite3D(#Cursor, MouseX(), MouseY())
  Stop3D();<
  
  
  FlipBuffers() 
  
Until Quit = #True
  
CloseScreen()
End 

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
Post Reply