PnORK (a game you cannot loose!)

Advanced game related topics
Post Reply
User avatar
Rook Zimbabwe
Addict
Addict
Posts: 4322
Joined: Tue Jan 02, 2007 8:16 pm
Location: Cypress TX
Contact:
Contact Rook Zimbabwe

PnORK (a game you cannot loose!)

Post by Rook Zimbabwe »

I have included my pitiful sourcecode and all images in this ZIP file.

RESOURCES:
http://www.bluemesapc.com/Downloads/pnork1.zip
:D

code:

Code: Select all



Enumeration
  #Window_0
EndEnumeration

Enumeration
  #Image_15
  #Image_14
  #Image_13
  #Image_12
  #Image_11
  #Image_10
  #Image_9
  #Image_8
  #Image_7
  #Image_6
  #Image_5
  #Image_4
  #Image_3
  #Image_2
  #Image_1
  #Sprite_RED
  #Sprite_BLACK
 EndEnumeration

Structure VisualDesignerGadgets
  Gadget.l
  EventFunction.l
EndStructure

Global NewList EventProcedures.VisualDesignerGadgets()

UsePNGImageDecoder()

Global Image1, Image2, Image3, Image4
Global CLICK ; variable to count clicks and force reset to 1
Global piecetoplay ; whatimage to unhide

Declare CheckClick()

CLICK = 1 ; set for RED

Image1= CatchImage(#PB_Any, ?Image1)
Image2= CatchImage(#PB_Any, ?Image2)
Image3= CatchImage(#PB_Any, ?Image3)
Image4= CatchImage(#PB_Any, ?Image4)

DataSection
Image1:
  IncludeBinary "b3.png"
Image2:
  IncludeBinary "tile.png"
Image3:
  IncludeBinary "red1.ico"
Image4:
  IncludeBinary "blak1.ico"
EndDataSection

Global Dim gamearray(1,1) ; holds what colored piece is where... 0 = empty, 1=red, 2=black
Global Dim xarray(3) ; X locations for sprites
Global Dim yarray(3) ; y locations for sprites

zed = 0

For x = 0 To 1
  For y = 0 To 1
    gamearray(x,y) = zed
  Next
Next

xarray(0) = 30
xarray(1) = 30
xarray(2) = 130
xarray(3) = 130

yarray(0) = 30
yarray(1) = 130
yarray(2) = 130
yarray(3) = 260

Procedure BlackTurn()
  startagain:
  x = Random(1)
  y = Random(1)
  Debug "PICKED: "+Str(x)+" , "+Str(y)
    where = gamearray(x,y)
      If where > 0
        Goto startagain
      EndIf

    If x = 0 And y = 0
      Debug "BLACK PUT 0,0"
      gamearray(0,0) = 2
        HideGadget(#Image_12,0)
    ElseIf x = 0 And y = 1
       Debug "BLACK PUT 0,1"
      gamearray(0,1) = 2
        HideGadget(#Image_13,0)
    ElseIf x = 1 And y = 0
       Debug "BLACK PUT 1,0"
      gamearray(1,0) = 2
        HideGadget(#Image_14,0)
    ElseIf x = 1 And y = 1
       Debug "BLACK PUT 1,1"
      gamearray(1,1) = 2
        HideGadget(#Image_15,0)
    EndIf
    ; CheckClick()
EndProcedure

Procedure Check4Win()
; this is a mind numbingly simple way to do this
Title$ = "PnORK!!!"

key1 = gamearray(0,0)
key2 = gamearray(0,1)
key3 = gamearray(1,0)
key4 = gamearray(1,1)
; once we have read all points of the array

jamba = key1 + key2 + key3 + key4
If jamba > 3 ; must be at least 2 game turns... so Piece 1 = 1 and piece 2 = 2// 1 + 2 = 3
  If key1 = key2 ; across
    dir$ = "ACROSS 1,2"
      Text$ = "PLAYER "+Str(CLICK)+" HAS WOn!"+Chr(10)+"PnORK "+dir$
        MessageRequester(Title$, Text$)
          End
  ElseIf key1 = key3 ; down
    dir$ = "DOWn 1,3"
      Text$ = "PLAYER 1 HAS WOn!"+Chr(10)+"PnORK "+dir$
        MessageRequester(Title$, Text$)
          End
  ElseIf key1 = key4 ; diagonal
    dir$ = "DIAGOnAL 1,4"
      Text$ = "PLAYER "+Str(CLICK)+" HAS WOn!"+Chr(10)+"PnORK "+dir$
        MessageRequester(Title$, Text$)
         End
   ElseIf key2 = key4 ; diagonal
    dir$ = "DOWn 2,4"
      Text$ = "PLAYER "+Str(CLICK)+" HAS WOn!"+Chr(10)+"PnORK "+dir$
        MessageRequester(Title$, Text$)
         End
   ElseIf key2 = key3 ; diagonal
    dir$ = "DIAGOnAL 3,2"
      Text$ = "PLAYER "+Str(CLICK)+" HAS WOn!"+Chr(10)+"PnORK "+dir$
        MessageRequester(Title$, Text$)
         End
   ElseIf key3 = key4 ; diagonal
    dir$ = "ACROSS 3,4"
      Text$ = "PLAYER "+Str(CLICK)+" HAS WOn!"+Chr(10)+"PnORK "+dir$
        MessageRequester(Title$, Text$)
         End
   
   EndIf
   
EndIf
EndProcedure

Procedure CheckClick()
;*
  EndProcedure

Procedure PutitHERE(x,y,piecetoplay)
CheckClick()
piece = gamearray(x,y)
Debug "COLOR THERE: "+Str(piece)
Select piece
  Case 0
    gamearray(x,y) = 1
      HideGadget(piecetoplay,0)
      Check4Win()
  Case 1
    Check4Win()
  Case 2
    Check4Win()
  EndSelect

EndProcedure

Procedure Image_15_Event(Window, Event, Gadget, Type)
  Debug "BLACK 1,1"
EndProcedure

Procedure Image_14_Event(Window, Event, Gadget, Type)
  Debug " BLACK 1,0"
EndProcedure

Procedure Image_13_Event(Window, Event, Gadget, Type)
  Debug "BLACK  0,1"
EndProcedure

Procedure Image_12_Event(Window, Event, Gadget, Type)
  Debug "BLACK  0 , 0"
EndProcedure

Procedure Image_11_Event(Window, Event, Gadget, Type)
  Debug "#Image_11 - RED 1,1"
EndProcedure

Procedure Image_10_Event(Window, Event, Gadget, Type)
  Debug "#Image_10 - RED 1,0"
EndProcedure

Procedure Image_9_Event(Window, Event, Gadget, Type)
  Debug "#Image_9 - RED 0,1"
EndProcedure

Procedure Image_8_Event(Window, Event, Gadget, Type)
  Debug "#Image_8 - RED 0,0"
EndProcedure

Procedure Image_7_Event(Window, Event, Gadget, Type)
  Debug "#Image_7 - BLACK"
EndProcedure

Procedure Image_6_Event(Window, Event, Gadget, Type)
  Debug "#Image_6 - RED"
EndProcedure

Procedure Image_5_Event(Window, Event, Gadget, Type)
  Debug "#Image_5 - SQUARE 11"
   If CLICK = 1
    piecetoplay = #Image_11
  PutitHERE(1,1, piecetoplay)
  ElseIf CLICK = 2
    piecetoplay = #Image_15
  PutitHERE(1,1, piecetoplay)
  EndIf
  BlackTurn()
EndProcedure

Procedure Image_4_Event(Window, Event, Gadget, Type)
  Debug "#Image_4 - SQUARE 10"
   If CLICK = 1
    piecetoplay = #Image_10
  PutitHERE(1,0, piecetoplay)
  ElseIf CLICK = 2
    piecetoplay = #Image_14
  PutitHERE(1,0, piecetoplay)
  EndIf
  BlackTurn()
EndProcedure

Procedure Image_3_Event(Window, Event, Gadget, Type)
  Debug "#Image_3 - SQUARE 01"
  If CLICK = 1
    piecetoplay = #Image_9
  PutitHERE(0,1, piecetoplay)
  ElseIf CLICK = 2
    piecetoplay = #Image_13
  PutitHERE(0,1, piecetoplay)
  EndIf
  BlackTurn()
EndProcedure

Procedure Image_2_Event(Window, Event, Gadget, Type)
  Debug "#Image_2 - SQUARE 00"
  If CLICK = 1
    piecetoplay = #Image_8
  PutitHERE(0,0, piecetoplay)
  ElseIf CLICK = 2
    piecetoplay = #Image_12
  PutitHERE(0,0, piecetoplay)
  EndIf
  BlackTurn()
EndProcedure


Procedure RegisterGadgetEvent(Gadget, *Function)
  
  If IsGadget(Gadget)
    AddElement(EventProcedures())
    EventProcedures()\Gadget        = Gadget
    EventProcedures()\EventFunction = *Function
  EndIf
  
EndProcedure

Procedure CallEventFunction(Window, Event, Gadget, Type)
  
  ForEach EventProcedures()
    If EventProcedures()\Gadget = Gadget
      CallFunctionFast(EventProcedures()\EventFunction, Window, Event, Gadget, Type)
      LastElement(EventProcedures())
    EndIf
  Next
  
EndProcedure

Procedure Open_Window_0()
  
  If OpenWindow(#Window_0, 5, 5, 821, 665, "PnORK 0.a",  #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_TitleBar )
    If CreateGadgetList(WindowID(#Window_0))
      
      ImageGadget(#Image_2, 20, 50, 1, 1, ImageID(Image2)) ; 00
      RegisterGadgetEvent(#Image_2, @Image_2_Event()) 
      ImageGadget(#Image_3, 340, 65, 1, 1, ImageID(Image2)) ; 01
      RegisterGadgetEvent(#Image_3, @Image_3_Event())
      ImageGadget(#Image_4, 20, 320, 1, 1, ImageID(Image2)) ; 10
      RegisterGadgetEvent(#Image_4, @Image_4_Event())
      ImageGadget(#Image_5, 340, 320, 1, 1, ImageID(Image2)) ; 11
      RegisterGadgetEvent(#Image_5, @Image_5_Event())
      ImageGadget(#Image_6, 675, 15, 128, 128, ImageID(Image3)) ; red
      RegisterGadgetEvent(#Image_6, @Image_6_Event())
      ImageGadget(#Image_7, 670, 515, 128, 128, ImageID(Image4)) ; black
      RegisterGadgetEvent(#Image_7, @Image_7_Event())
      ImageGadget(#Image_1, 10, 10, 225, 230, ImageID(Image1)) ; board
      
      ImageGadget(#Image_8,75,75, 128, 128, ImageID(Image3)) ; red 00 
      RegisterGadgetEvent(#Image_8, @Image_8_Event())
      ImageGadget(#Image_9,375,90, 128, 128, ImageID(Image3)) ; red 01
      RegisterGadgetEvent(#Image_9, @Image_9_Event())
      ImageGadget(#Image_10,95,385, 128, 128, ImageID(Image3)) ; red 10
      RegisterGadgetEvent(#Image_10, @Image_10_Event())
      ImageGadget(#Image_11,375,393, 128, 128, ImageID(Image3)) ; red 11
      RegisterGadgetEvent(#Image_11, @Image_11_Event())
      
      ImageGadget(#Image_12, 85 , 85, 128, 128, ImageID(Image4)) ; black 00
      RegisterGadgetEvent(#Image_12, @Image_12_Event())
      ImageGadget(#Image_13, 375,90, 128, 128, ImageID(Image4)) ; black 01
      RegisterGadgetEvent(#Image_13, @Image_13_Event())
      ImageGadget(#Image_14, 95,385, 128, 128, ImageID(Image4)) ; black 10
      RegisterGadgetEvent(#Image_14, @Image_14_Event())
      ImageGadget(#Image_15, 375,393, 128, 128, ImageID(Image4)) ; black 11
      RegisterGadgetEvent(#Image_15, @Image_15_Event())
      
    EndIf
  EndIf
EndProcedure

Open_Window_0()

; ******************  For some reason you have to hide the images and then unhide them to clean the board... 
;                                       this is weird because image sizes are 1,1 in the open window!
HideGadget(#Image_2,1)
HideGadget(#Image_2,0)
  HideGadget(#Image_3,1)
  HideGadget(#Image_3,0)
    HideGadget(#Image_4,1)
    HideGadget(#Image_4,0)
      HideGadget(#Image_5,1)
      HideGadget(#Image_5,0)

HideGadget(#Image_8, 1)
HideGadget(#Image_9, 1)
HideGadget(#Image_10, 1)
HideGadget(#Image_11, 1)
HideGadget(#Image_12, 1)
HideGadget(#Image_13, 1)
HideGadget(#Image_14, 1)
HideGadget(#Image_15, 1)

Repeat
  
  Event  = WaitWindowEvent()
  Gadget = EventGadget()
  Type   = EventType()
  Window = EventWindow()
  
  Select Event
    Case #PB_Event_Gadget
      CallEventFunction(Window, Event, Gadget, Type)
      
  EndSelect
  
Until Event = #PB_Event_CloseWindow

End
You move first. You win! 8)

Interesting is that the tiles I use to check which square you click on are 1,1 in width and hight... yet they still cover the area...

Why?
Binarily speaking... it takes 10 to Tango!!!

Image
http://www.bluemesapc.com/
Top
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8452
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

The width and height parameters of an image gadget are not determined by the values you code. They reflect the width and height of the image contained in the gadget. I usually just code 0,0 for those values as it'll autosize to the image placed in the gadget anyway. There may be some use for them that hasn't occurred to me, but imho they could be done away with as they're for the most part meaningless.
BERESHEIT
Top
User avatar
Rook Zimbabwe
Addict
Addict
Posts: 4322
Joined: Tue Jan 02, 2007 8:16 pm
Location: Cypress TX
Contact:
Contact Rook Zimbabwe

Post by Rook Zimbabwe »

But the interesting part is: The image does not show up... it should only tile correctly in the upper left corner. In all other corners it should be off pattern.

When I set the WxH to 1... it dissappears, but the selector field apparently remains at the full size of the image.

I am going to change the tile image to a black and white checkerboard and see!
Binarily speaking... it takes 10 to Tango!!!

Image
http://www.bluemesapc.com/
Top
User avatar
Rook Zimbabwe
Addict
Addict
Posts: 4322
Joined: Tue Jan 02, 2007 8:16 pm
Location: Cypress TX
Contact:
Contact Rook Zimbabwe

Post by Rook Zimbabwe »

It works!

You see a flash of the checkerboard right at the start. Probably solved by having a load screen... Then you simply have the area to click in, even though the images are collapsed to 1,1 for width and height!

This means board games are going to be easier to make in PB than I thought! :D
Binarily speaking... it takes 10 to Tango!!!

Image
http://www.bluemesapc.com/
Top
Post Reply

Return to “Game Programming”