;Norms 2D Tank battle game ;inspired by Geline Olores that loved playing Wally ;a 2D platform game ;I was wanting something simple to write that was also fun ;- Top ;place all include files here IncludeFile "MyINI.pb" ;- Initialize ;just trap all those crittical errors early If InitSprite() = 0 Or InitPalette() = 0 Or InitKeyboard() = 0 MessageRequester("Error", "Can't open DirectX 7 or later", 0) End EndIf If InitSprite3D()=0 MessageRequester("Error","Can't open 3D sprite",0) End EndIf If InitSound() = 0 MessageRequester("Error", "Can't open DirectX 7 Or Sound Card is not present", 0) End EndIf ;- NetworkINI ;specialised startup code for internet use ;if not available, its simple ignored .... Global NetworkOK NetWorkOK=InitNetwork() #maxbuffer=2000 #datasize=42 ;Global *Buffer Global Dim *InBuffer(4) Global Dim *OutBuffer(4) Global Port Port=1666 Global GameMode Global NetID Global LastPlayer ;this is the send buffer, not the receive buffer *InBuffer(0)=AllocateMemory(#maxbuffer) *OutBuffer(0)=AllocateMemory(#maxbuffer) ; Gamemodes.............. ; 0 - offline ; 1 - host ; 2 - join Global ThisUser ; If joining a game, ThisUser is assigned by the host ; the host is always player 1 Global AltUser ; if two users are using 1 PC ; set this to identify an extra player ;- PI ;#PI=3.14159265 ;- PlayerStruct Structure PlayerStruct BufCount.l LastUpdate.l LastIN.l ThreadID.l Score.l ID.l Sprite3D.l Name.s CID.l x.f y.f dx.f dy.f heading.l lastshot.l image.l controls.l altplayer.l DoSound.l visible.l Vend.l bouncy.l Bend.l deathbomb.l Dend.l flash.l EndStructure Global Dim Player.PlayerStruct(4) Global Engine.l Global Boom.l engine=CatchSound(#PB_Any,?Motor) Boom=CatchSound(#PB_Any,?Bang) ;- ShotStruct Structure ShotStruct x.f y.f life.l dx.f dy.f stuck.l bouncy.l deathbomb.l EndStructure Global ShotImage.l ShotImage=CatchImage(#PB_Any,?AShot) ;ShotImage=UseImage(ShotImage) ShotImage=ImageID(ShotImage) Global ShotSound.l ShotSound=CatchSound(#PB_Any,?Doot) Global NewList Shot.ShotStruct() ;- The Room Map #WallSize=16 Global Dim Room.l(32,32) Global WallImage.l Global FloorImage.l Global FloorVImage.l Global FloorBImage.l Global FloorDImage.l WallImage=CatchImage(#PB_Any,?Wall) FloorImage=CatchImage(#PB_Any,?Floor) FloorVImage=CatchImage(#PB_Any,?FloorV) FloorBImage=CatchImage(#PB_Any,?FloorB) FloorDImage=CatchImage(#PB_Any,?FloorD) WallImage=ImageID(WallImage) FloorImage=ImageID(Floorimage) FloorVImage=ImageID(FloorVimage) FloorBImage=ImageID(FloorBimage) FloorDImage=ImageID(FloorDimage) ;- Copywrite msg$="Created by Norm Feb 2007" msg$=msg$+Chr(10)+Chr(10)+"Inspired by Geline Olores playing Wally World" msg$=msg$+Chr(10)+"And the old Atari game Tank Battle" MessageRequester("Tank", msg$, 0) ;- Game Globals Global MasterTimer.l Global MasterDelay.l Global GameName.s Global HostName.s Global GameStart.l Global Dim PowerUp.l(5) Global RunPath.s RunPath=GetRunPath() If Left(RunName.s,9) = "PureBasic" RunPath="C:\Program Files\PureBasic\Projects\Tank\" EndIf IniFile=RunPath+"Tank.ini" GameName=INI_ReadString("Setup", "Name", "Empty.map") For n=0 To 5 PowerUp(n)=INI_ReadInteger("Powerups","P"+Trim(Str(n)),0) Next n AltUser=INI_ReadInteger("Setup","Players",0) Global HelpFile.s HelpFile=RunPath+"Tank.html" ;- procedures Procedure GetHelp(context.s) ;context should be the actual target location ;on the page If Len(context) ;fn$=Chr(34)+"iexplorer "+HelpFile+context+Chr(34) If RunProgram("iexplore.exe",HelpFile+context,RunPath)=0 If RunProgram(HelpFile)=0 MessageRequester("Tank","Can't find help file"+Chr(10)+HelpFile,#MB_ICONSTOP) EndIf EndIf Else If RunProgram(HelpFile)=0 MessageRequester("Tank","Can't find help file"+Chr(10)+HelpFile,#MB_ICONSTOP) EndIf EndIf EndProcedure Procedure LoadRoom() loaded.l=0 GameStart=0 ;also need to kill all shots ResetList(Shot()) While NextElement(Shot()) DeleteElement(Shot()) Wend If Len(GameName) If FileSize(GameName) ;load a file ;ok lets actually load it If ReadFile(0,GameName) INI_WriteString( "Setup", "Name",GameName) For z=0 To 31 row.s=ReadString(0) For x=0 To 31 c.s=Mid(row,x+1,1) If Len(c)<1 Break EndIf ac.l=Asc(c) Select ac Case 35 ;# Room(x,z)=1 Case 49 ;player 1 start location Player(1)\x=x*#WallSize Player(1)\y=z*#WallSize Player(1)\heading=180 Case 50 Player(2)\x=x*#WallSize Player(2)\y=z*#WallSize player(2)\heading=0 Case 51 Player(3)\x=x*#WallSize Player(3)\y=z*#WallSize Player(3)\heading=90 Case 52 Player(4)\x=x*#WallSize Player(4)\y=z*#WallSize player(4)\heading=270 Case 66 ;B Powerup Room(x,z)=2 Case 68 ;D Power Up Room(x,z)=3 Case 86 ;V power up Room(x,z)=4 Default Room(x,z)=0 EndSelect Next x If Eof(0) Break EndIf Next z CloseFile(0) loaded=1 Else MessageRequester("Tank","Unable to open file "+Chr(10)+GameName,#MB_ICONSTOP) EndIf Else MessageRequester("Tank","Unable to locate file "+Chr(10)+GameName,#MB_ICONSTOP) EndIf EndIf ;first make a standard room ;this is to ensure there are walls around room For S=0 To 31 Room(S,0)=1 Room(0,S)=1 Room(S,31)=1 Room(31,S)=1 Next S If loaded=0 GameName="" ;player start locations Player(1)\x=15*#WallSize Player(1)\y=3*#WallSize Player(1)\heading=180 Player(2)\x=15*#WallSize Player(2)\y=28*#WallSize player(2)\heading=0 Player(3)\x=3*#WallSize Player(3)\y=15*#WallSize Player(3)\heading=90 Player(4)\x=28*#WallSize Player(4)\y=15*#WallSize player(4)\heading=270 EndIf EndProcedure Procedure KillPlayers() ;this just resets players For p=1 To 4 Player(P)\bouncy=0 Player(P)\Visible=1 Player(P)\DeathBomb=0 Player(p)\ID=0 Player(P)\BufCount=0 Player(P)\CID=0 Player(P)\LastIN=0 Player(P)\LastUpdate=0 Player(p)\AltPlayer=0 Next p EndProcedure Procedure.l WrapAngle(A.l) If A>360 ProcedureReturn A-360 ElseIf A<0 ProcedureReturn A+360 EndIf ProcedureReturn A EndProcedure Procedure.l GetPlayer(CID.l) ;scan for a player with this CID PN.l=0 For Player=1 To 4 If Player(Player)\CID=CID PN=Player Break EndIf Next player ProcedureReturn PN EndProcedure Procedure SendThread(shooting.l) ;shooting=0 if nobody shooting ;shooting=1 if ThisUser Shoots ;Shooting=2 if AltUser shoots ;Shooting=3 if both are shooting ;setting Shooting to (0-Player) indicates a special message from the host ;to Player. Used to identify user and game status ;other codes .... ;Shooting= -5 from clien to host=request for map file ;Shooting=5 from host to all clients is a GameStart command ;Shooting= -6 from client to host = ready to start game ;this just obtains current tank status If Shooting<0 PN.l=-Shooting If PN>4 PN=ThisUser EndIf Else PN=ThisUser EndIf If Shooting<0 Player(PN)\LastUpdate=GetTickCount_()+500 ;start with header information PokeW(*OutBuffer(ThisUser),#DataSize) PokeW(*OutBuffer(ThisUser)+2,PN) PokeW(*OutBuffer(ThisUser)+4,ThisUser) PokeW(*OutBuffer(ThisUser)+6,shooting) fn.s=GetFilePart(GameName) PokeW(*OutBuffer(ThisUser)+8,Len(fn)) PokeF(*OutBuffer(ThisUser)+10,Player(PN)\x) PokeF(*OutBuffer(ThisUser)+14,Player(PN)\y) PokeW(*OutBuffer(ThisUser)+18,Player(PN)\Bouncy) PokeW(*OutBuffer(ThisUser)+20,Player(ThisUser)\Visible) PokeW(*OutBuffer(ThisUser)+22,Player(ThisUser)\DeathBomb) PokeS(*OutBuffer(ThisUser)+24,fn,Len(fn)) ElseIf Shooting=5 ;prepare for game start Player(PN)\LastUpdate=GetTickCount_()+500 PokeW(*OutBuffer(ThisUser),#DataSize) PokeW(*OutBuffer(ThisUser)+2,PN) PokeW(*OutBuffer(ThisUser)+4,ThisUser) PokeW(*OutBuffer(ThisUser)+6,shooting) dw.l=8 For pup.l=0 To 5 PokeW(*OutBuffer(ThisUser)+dw,PowerUP(pup)) dw + 2 Next pup Else RandomSeed(42) Player(ThisUser)\LastUpdate=GetTickCount_() ;start with header information PokeW(*OutBuffer(ThisUser),#DataSize) PokeW(*OutBuffer(ThisUser)+2,ThisUser) PokeW(*OutBuffer(ThisUser)+4,AltUser) PokeW(*OutBuffer(ThisUser)+6,shooting) PokeW(*OutBuffer(ThisUser)+8,Player(ThisUser)\heading) PokeF(*OutBuffer(ThisUser)+10,Player(ThisUser)\x) PokeF(*OutBuffer(ThisUser)+14,Player(ThisUser)\y) PokeW(*OutBuffer(ThisUser)+18,Player(ThisUser)\Bouncy) If Player(ThisUser)\flash>GetTickCount_() PokeW(*OutBuffer(ThisUser)+20,1) Else PokeW(*OutBuffer(ThisUser)+20,Player(ThisUser)\Visible) EndIf PokeW(*OutBuffer(ThisUser)+22,Player(ThisUser)\DeathBomb) If AltUser Player(ThisUser+1)\LastUpdate=Player(ThisUser)\LastUpdate PokeW(*OutBuffer(ThisUser)+24,Player(ThisUser+1)\heading) PokeF(*OutBuffer(ThisUser)+26,Player(ThisUser+1)\x) PokeF(*OutBuffer(ThisUser)+30,Player(ThisUser+1)\y) PokeW(*OutBuffer(ThisUser)+34,Player(ThisUser+1)\Bouncy) If Player(ThisUser+1)\flash>GetTickCount_() PokeW(*OutBuffer(ThisUser)+36,1) Else PokeW(*OutBuffer(ThisUser)+36,Player(ThisUser+1)\Visible) EndIf PokeW(*OutBuffer(ThisUser)+38,Player(ThisUser+1)\DeathBomb) EndIf EndIf If GameMode=1 And Shooting>=0 ;send to all users stillonline.l=0 sp.l=1 If AltUser sp=2 EndIf For player=sp To 4 If Player(Player)\CID Result = SendNetworkData(Player(Player)\CID, *OutBuffer(ThisUser), #DataSize) If result<#DataSize ;If result<0 MessageRequester("Tank Battle Network Error","Unable to send update to Player "+Str(Player)+" disconnecting player.",#MB_ICONSTOP) CloseNetworkConnection(Player(Player)\CID) Player(Player)\CID=0 Player(Player)\ID=0 Player(Player)\BufCount=0 ;Else ;begin resending ; timeout.l=GetTickCount_()+2000 ; Repeat ; CallDebugger ; Result = SendNetworkData(Player(Player)\CID, *OutBuffer(ThisUser), #DataSize) ; If GetTickCount_()>timeout ; MessageRequester("Tank Battle Network Error","Player "+Str(Player)+" is not responding.",#MB_ICONSTOP) ; CloseNetworkConnection(Player(Player)\CID) ; Player(Player)\CID=0 ; Player(Player)\ID=0 ; Break ; EndIf ; Until result=#DataSize ; If result=#DataSize ; stillonline=1 ; EndIf ;EndIf Else stillonline=1 EndIf EndIf Next player If stillonline=0 And GameStart>0 MessageRequester("Tank Battle Network Error","No players detected. Switching to offline mode.",#MB_ICONSTOP) CloseNetworkServer(NetID) Player(1)\CID=0 Player(1)\BufCount=0 gamemode=0 NetID=0 EndIf Else thisCID.l=Player(PN)\CID If GameMode=2 ThisCID=Player(1)\CID EndIf If ThisCID Result = SendNetworkData(ThisCID, *OutBuffer(ThisUser), #DataSize) If result<#DataSize ;If result<0 MessageRequester("Tank Battle Network Error","Unable to send update. Switching to offline play",#MB_ICONSTOP) CloseNetworkConnection(ThisCID) GameMode=0 Player(1)\CID=0 NetID=0 Player(1)\BufCount=0 ;Else ;begin resending ;timeout.l=GetTickCount_()+2000 ;Repeat ; Result = SendNetworkData(ThisCID, *OutBuffer(ThisUser), #DataSize) ; If GetTickCount_()>timeout ; MessageRequester("Tank Battle Network Error","Server is not responding. Switching to offline play",#MB_ICONSTOP) ; gamemode=0 ; Break ; EndIf ;Until result=#DataSize ;EndIf EndIf Else MessageRequester("Tank Battle Network Error","Invalid Socket ID for Player "+Str(PN),#MB_ICONSTOP) GameMode=0 EndIf EndIf ;the thread has finished Player(PN)\ThreadID=0 EndProcedure Procedure SendUpdate(shooting.l) ;If Player(ThisUser)\ThreadID ; WaitThread(Player(ThisUser)\ThreadID) ;EndIf ;Player(ThisUser)\ThreadID=CreateThread(@SendThread(),shooting) SendThread(shooting) EndProcedure Procedure.l GetData(PN.l) ;this just reads the data that was sent ;the return value indicates if valid data ... Result.l = ReceiveNetworkData(Player(PN.l)\CID, *InBuffer(PN.l)+Player(PN.l)\BufCount,#MaxBuffer ) If Result>0 If gamemode=1 ;we are the host, so we must relay this to all users sp.l=2 If AltUser sp=3 EndIf For Player=sp To 4 If Player<>PN If Player(Player)\CID Result2 = SendNetworkData(Player(Player)\CID, *InBuffer(PN)+Player(PN.l)\BufCount, Result) If Result2<>Result ;something wrong with Player Player(Player)\ID=0 CloseNetworkConnection(Player(Player)\CID) Player(Player)\CID=0 Player(Player)\BufCount=0 If Player(Player)\AltPlayer Player(Player+1)\ID=0 Player(Player+1)\CID=0 Player(Player+1)\BufCount=0 EndIf EndIf EndIf EndIf Next player EndIf fulldata.l=Result+Player(PN.l)\BufCount If FullData=#DataSize ;good data Player(PN.l)\BufCount=0 ProcedureReturn 1 Else If FullData>#DataSize ;flag that multiple datas are here Player(PN.l)\BufCount=FullData ProcedureReturn 2 Else ;data is not complete Player(PN.l)\BufCount=Player(PN.l)\BufCount+Result ProcedureReturn 0 EndIf ;modified, just through out all data until no more incoming ;Player(pn)\BufCount=0 ProcedureReturn 0 EndIf Else MessageRequester("Tank Battle Network Error","Input Buffer full? Switching to offline play",#MB_ICONSTOP) If gamemode=2 GameMode=0 CloseNetworkConnection(Player(PN.l)\CID) Player(PN)\CID=0 Player(1)\CID=0 Player(1)\ID=0 Player(1)\BufCount=0 If Player(1)\AltPlayer Player(2)\ID=0 Player(2)\CID=0 Player(2)\BufCount=0 EndIf NetID=0 Else ;we are the server and having probs For P=1 To 4 If Player(P)\CID If Player(P)\CID<>NetID CloseNetworkConnection(Player(P)\CID) Player(P)\CID=0 Player(P)\ID=0 Player(P)\BufCount=0 If Player(P)\AltPlayer Player(P+1)\CID=0 Player(P+1)\ID=0 Player(P+1)\BufCount=0 EndIf EndIf EndIf Next P Player(1)\CID=0 Player(1)\BufCount=0 CloseNetworkServer(NetID) NetID=0 GameMode=0 EndIf ProcedureReturn 0 EndIf EndProcedure Procedure HandleData(PN.l) ;this takes the recieved data and translates it .... Player(PN)\LastIN=GetTickCount_() ;skip the header stuff ;PokeW(*InBuffer(ThisUser),#DataSize) Player.l=PeekW(*InBuffer(PN)+2) If PeekW(*InBuffer(PN))<>#Datasize ;For B=0 To 42 Step 2 ; Debug Str(B)+" = "+Str(PeekW(*InBuffer(PN)+B)) ;Next B ;CallDebugger ;Debug "invalid data detected" ProcedureReturn EndIf Player(Player)\LastIN=GetTickCount_() Player(Player)\ID=Player shooting.l=PeekW(*InBuffer(PN)+6) If shooting<>5 Player(Player)\x=PeekF(*InBuffer(PN)+10) Player(Player)\y=PeekF(*InBuffer(PN)+14) Player(Player)\Bouncy=PeekW(*InBuffer(PN)+18) Player(Player)\Visible=PeekW(*InBuffer(PN)+20) Player(Player)\DeathBomb=PeekW(*InBuffer(PN)+22) Player(Player)\ID=Player EndIf If shooting<0 If shooting=-6 ;this is a request to the host to indicate ready for game start If GameStart SendUpdate(5) EndIf ElseIf shooting=-5 ;this is a request to the host for a game file If gamemode=1 SendNetworkFile(Player(Player)\CID,GameName) EndIf Else ;this is from the host If gamemode=2 ThisUser=Player FLen=PeekW(*InBuffer(PN)+8) HostName=PeekS(*InBuffer(PN)+24) If AltUser Player(Player+1)\ID=Player+1 Player(Player+1)\Bouncy=PeekW(*InBuffer(PN)+18) Player(Player+1)\Visible=PeekW(*InBuffer(PN)+20) Player(Player+1)\DeathBomb=PeekW(*InBuffer(PN)+22) Player(Player)\AltPlayer=1 EndIf ;see if we have this file If FileSize(RunPath+HostName)>0 GameName=RunPath+HostName LoadRoom() Else ;request host to send file SendUpdate(-5) EndIf EndIf EndIf Else If shooting=5 ;this is a game start command gamestart=1 ;setup the game menu dw.l=8 For pup.l=0 To 5 PowerUP(pup)=PeekW(*InBuffer(PN)+dw) dw + 2 SetMenuItemState(0,10+pup,PowerUP(pup)) Next pup If PowerUp(5)>0 And PowerUp(1)=0 ;powerups are locked ... ;so all players start with this setup For p2.l=1 To 4 If PowerUp(2) Player(p2)\Bouncy=1 EndIf If PowerUp(3) Player(p2)\visible=0 EndIf If PowerUp(4) Player(p2)\DeathBomb=1 EndIf Next p2 EndIf Else ;this has not been read yet Player(Player)\AltPlayer=PeekW(*InBuffer(PN)+4) Player(Player)\heading=PeekW(*InBuffer(PN)+8) If Player(Player)\visible Player(Player)\flash=GetTickCount_()+500 Else Player(Player)\flash=GetTickCount_()-100 EndIf ;Player(Player)\visible=0 If Player(Player)\AltPlayer Player(Player+1)\ID=Player+1 Player(Player+1)\LastIN=Player(Player)\LastIN Player(Player+1)\heading=PeekW(*InBuffer(PN)+24) Player(Player+1)\x=PeekF(*InBuffer(PN)+26) Player(Player+1)\y=PeekF(*InBuffer(PN)+30) Player(Player+1)\Bouncy=PeekW(*InBuffer(PN)+34) Player(Player+1)\Visible=PeekW(*InBuffer(PN)+36) ;Debug "recieving player "+Str(Player+1)+" = "+Str(Player(Player+1)\Visible) If PeekW(*InBuffer(PN)+36) Player(Player+1)\flash=GetTickCount_()+500 Else Player(Player+1)\flash=GetTickCount_()-100 EndIf ;Player(Player+1)\Visible=0 Player(Player+1)\DeathBomb=PeekW(*InBuffer(PN)+38) EndIf If shooting&1 RandomSeed(42) ;shoot ;If Player(Player)\lastshot=#Datasize HandleData(PN) EndIf Until Player(PN)\BufCount<#Datasize EndIf EndIf Case 3 ;get a file If GameMode=2 Player(1)\LastIn=GetTickCount_() ;only clients get a file from the host ReceiveNetworkFile(CID, HostName) ;then, reload the level GameName=HostName LoadRoom() EndIf Case 4 ;client disconnected CloseNetworkConnection(CID) Player(PN)\CID=0 Player(PN)\ID=0 Player(PN)\BufCount=0 EndSelect ;also check for players not responding If gamemode=1 sp.l=2 If AltUser sp=3 EndIf online.l=0 For p.l=sp To 4 If Player(p)\CID If Player(p)\LastIN If Player(p)\LastINThisUser If AltUser=0 Player(Player)\ID=0 Else If ThisUser+1<>Player Player(Player)\ID=0 EndIf EndIf EndIf EndIf Next Player Else CloseNetworkConnection(Player(1)\CID) GameMode=0 GameStart=0 Player(1)\CID=0 Player(1)\BufCount=0 quit=1 KillPlayers() LoadRoom() EndIf EndIf EndIf Until quit EndProcedure Procedure LoadPlayers() Player(1)\name="Red" ;Player(1)\ID=4 Player(1)\image=CatchSprite(#PB_Any, ?TankR,#PB_Sprite_Texture) Player(2)\name="Green" ;Player(2)\ID=5 Player(2)\image=CatchSprite(#PB_Any, ?TankG,#PB_Sprite_Texture) Player(3)\name="Yellow" ;Player(3)\ID=7 Player(3)\image=CatchSprite(#PB_Any, ?TankY,#PB_Sprite_Texture) Player(4)\name="Blue" ;Player(4)\ID=6 Player(4)\image=CatchSprite(#PB_Any, ?TankB,#PB_Sprite_Texture) For P=1 To 4 Player(P)\Sprite3D=CreateSprite3D(#PB_Any,Player(P)\image) If *InBuffer(P)=0 *InBuffer(P)=AllocateMemory(#maxbuffer) EndIf If *OutBuffer(P)=0 *OutBuffer(P)=AllocateMemory(#maxbuffer) EndIf Player(P)\BufCount=0 Next P EndProcedure Procedure.l AreaCollision(x1.l,y1.l,w1.l,x3.l,y3.l,w2.l) ;x2.l=x1+w1 ;y2.l=y1+w1 ;x4.l=x3+w2 ;y4.l=y3+w2 If x3x1 If y3y1 ProcedureReturn 1 EndIf EndIf EndIf EndIf ProcedureReturn 0 EndProcedure Procedure FullHit(x.f,y.f) ;this is to correct faulty collision stuff ;first determine which "room" we are in rmx.l=x/#WallSize rmy.l=y/#WallSize If Room(rmx,rmy)=1 If AreaCollision(rmx*#WallSize,rmy*#WallSize,#WallSize,x,y,2) ProcedureReturn 1 Else ProcedureReturn 0 EndIf Else ProcedureReturn 0 EndIf EndProcedure Procedure PaintRoom() rx=0 For x=0 To 31 rz=0 For z=0 To 31 Select Room(x,z) Case 1 ;make a wall DrawImage(WallImage,rx,rz) Case 2 DrawImage(FloorBImage,rx,rz) Case 3 DrawImage(FloorDImage,rx,rz) Case 4 DrawImage(FloorVImage,rx,rz) Default DrawImage(FloorImage,rx,rz) EndSelect If Room(x,z)=1 ;check collisions agains shots ResetList(Shot()) While NextElement(Shot()) If AreaCollision(rx,rz,#WallSize,Shot()\x,Shot()\y,4) If Shot()\DeathBomb<>0 And Shot()\DeathBombGetTickCount_() DeleteElement(Shot()) Else Shot()\Stuck=GetTickCount_()+100 PlaySound(ShotSound) ;undo move Shot()\x - Shot()\dx Shot()\y - Shot()\dy ;test x move boink.l=0 If AreaCollision(rx,rz,#WallSize,Shot()\x+Shot()\dx,Shot()\y,4) Shot()\dx=-Shot()\dx boink=1 EndIf If AreaCollision(rx,rz,#WallSize,Shot()\x,Shot()\y+Shot()\dy,4) Shot()\dy=-Shot()\dy boink=1 EndIf If boink=0 ;Shot()\dx=-Shot()\dx ;shot()\dy=-shot()\dy If FullHit(Shot()\x+Shot()\dx,Shot()\y) Shot()\dx=-Shot()\dx EndIf If FullHit(Shot()\x,Shot()\y+Shot()\dy) Shot()\dy=-Shot()\dy EndIf EndIf EndIf Else DeleteElement(Shot()) bf=0 EndIf If df>1000 PlaySound(ShotSound) For s=1 To 5 AddElement(Shot()) rad.f=#PI*Random(359)/180 Shot()\dx=2*Cos(rad) shot()\dy=2*Sin(rad) Shot()\x=DeathX shot()\y=DeathY df=df/2 Shot()\Life=df+ GetTickCount_() Shot()\DeathBomb=GetTickCount_()+4000 Shot()\Bouncy=bf Next s EndIf EndIf Wend EndIf If Room(x,z) ;check against players For p=1 To 4 If Player(p)\ID ;Player(p)\x + Player(p)\dx ;Player(P)\y + Player(p)\dy If AreaCollision(rx,rz,#WallSize,Player(p)\x,Player(p)\y,#WallSize) Player(p)\flash=GetTickCount_()+2000 Select Room(x,z) Case 1 ;undo move times 2 Player(p)\x - Player(p)\dx Player(p)\x - Player(p)\dx Player(p)\y - Player(p)\dy Player(P)\y - Player(p)\dy Player(p)\dx=0 Player(p)\dy=0 Case 2 Room(x,z)=0 Player(P)\Bouncy=1 Player(P)\Bend=GetTickCount_()+300000 Case 3 Room(x,z)=0 Player(p)\DEnd=GetTickCount_()+120000 Player(p)\DeathBomb=1 Case 4 Room(x,z)=0 Player(p)\Visible=0 Player(p)\Vend=GetTickCount_()+60000 EndSelect EndIf EndIf Next p EndIf rz=rz+#WallSize Next z rx=rx+#WallSize Next x ;paint shots and move them If gamestart ResetList(Shot()) While NextElement(Shot()) ;bonk.l=0 ;If FullHit(Shot()\x+Shot()\dx,Shot()\y) ; bonk +1 ;EndIf ;If FullHit(Shot()\x,Shot()\y+Shot()\dy) ; bonk + 2 ;EndIf ;If bonk=0 ; If FullHit(Shot()\x+Shot()\dx,Shot()\y+Shot()\dy) ; bonk=3 ; EndIf ;EndIf ;If Bonk&1 ; Shot()\dx=-Shot()\dx ;EndIf ;If Bonk&2 ; shot()\dy=-Shot()\dy ;EndIf Shot()\x + Shot()\dx Shot()\y + Shot()\dy DrawImage(ShotImage,Shot()\x,Shot()\y) If Shot()\lifep If Player(p2)\ID If AreaCollision(Player(p)\x,Player(p)\y,#WallSize,Player(p2)\x,Player(p2)\y,#WallSize) Player(p)\x - Player(p)\dx Player(p)\y - Player(p)\dy Player(p)\dx=0 Player(p)\dy=0 If Player(p)\visible=0 ;flash player Player(p)\flash=GetTickCount_()+2000 EndIf Break EndIf EndIf EndIf Next p2 ;check players against shots ResetList(Shot()) While NextElement(Shot()) If AreaCollision(Player(p)\x,Player(p)\y,#WallSize,Shot()\x,Shot()\y,2) DeleteElement(Shot()) PlaySound(Boom) Player(p)\flash=GetTickCount_()+2000 Repeat ok.l=1 Player(p)\x=Random(400)+50 Player(p)\y=Random(400)+50 gx=Player(p)\x/#WallSize gy=Player(p)\y/#WallSize ;check walls For x=gx-1 To gx+1 For y=gy-1 To gy+1 If Room(x,y) ok=0 Break 2 EndIf Next y Next x ;check other players If ok For p2=1 To 4 If p2<>p If AreaCollision(Player(p)\x,Player(p)\y,#WallSize,Player(p2)\x,Player(p2)\y,#WallSize) ok=0 Break EndIf EndIf Next p2 EndIf Until OK EndIf Wend If Player(p)\Sprite3D v.l=0 If Player(p)\flash>GetTickCount_() v=1 Else If p=ThisUser If AltUser=0 v=1 Else If GameMode v=1 EndIf EndIf EndIf If p=ThisUser+1 If AltUser If GameMode v=1 EndIf EndIf EndIf If Player(p)\visible v=1 EndIf EndIf If v RotateSprite3D(Player(p)\Sprite3D,Player(p)\heading,0) DisplaySprite3D(Player(p)\Sprite3D, Player(p)\x, Player(p)\y) EndIf EndIf EndIf Next p Stop3D() Else MessageRequester("Tank Battle","Unable to do 3d?",0) EndIf EndProcedure Procedure HandleKeys() quit.l=0 If ExamineKeyboard() quit=KeyboardPushed(#PB_Key_Escape) If KeyboardPushed(#PB_Key_F1) GetHelp("#Contents") EndIf If GameStart ;first check for standard user controls DoMotor.l=0 If KeyboardPushed(#PB_Key_Left) Player(ThisUser)\heading=WrapAngle(Player(ThisUser)\heading -2) DoMotor=1 EndIf If KeyboardPushed(#PB_Key_Up) ;move player .... rad.f=#PI*WrapAngle(Player(ThisUser)\heading-90)/180 Player(ThisUser)\dx=2*Cos(rad) Player(ThisUser)\dy=2*Sin(rad) DoMotor=1 Else ;turn off movement Player(ThisUser)\dx=0 Player(ThisUser)\dy=0 EndIf If KeyboardPushed(#PB_Key_Right) Player(ThisUser)\heading=WrapAngle(Player(ThisUser)\heading +2) DoMotor=1 EndIf shooting.l=0 If KeyboardPushed(#PB_Key_Down) ;move player .... rad.f=#PI*WrapAngle(Player(ThisUser)\heading-90)/180 Player(ThisUser)\dx=-Cos(rad) Player(ThisUser)\dy=-Sin(rad) DoMotor=1 EndIf If DoMotor If Player(ThisUser)\DoSound=0 Player(ThisUser)\DoSound=1 PlaySound(Engine,1) EndIf Else If Player(ThisUser)\DoSound Player(ThisUser)\DoSound=0 StopSound(Engine) EndIf EndIf If KeyboardPushed(#PB_Key_RightShift) ;shoot If Player(ThisUser)\lastshot2 GameStart=1 RandomSeed(#DataSize) EndIf If GameMode=0 ;offline only ThisUser=1 KillPlayers() Player(ThisUser)\ID=1 Player(ThisUser)\AltPlayer=AltUser If AltUser Player(2)\ID=2 EndIf If PowerUp(5)>0 And PowerUp(1)=0 ;powerups are locked ... ;so all players start with this setup For player=1 To 4 If PowerUp(2) Player(player)\Bouncy=1 EndIf If PowerUp(3) Player(player)\visible=0 EndIf If PowerUp(4) Player(player)\DeathBomb=1 EndIf Next player EndIf ElseIf GameMode=1 ThisUser=1 ;KillPlayers() Player(ThisUser)\ID=1 Player(ThisUser)\AltPlayer=AltUser If AltUser Player(2)\ID=2 EndIf If PowerUp(5)>0 And PowerUp(1)=0 ;powerups are locked ... ;so all players start with this setup For player=1 To 4 If PowerUp(2) Player(player)\Bouncy=1 EndIf If PowerUp(3) Player(player)\visible=0 EndIf If PowerUp(4) Player(player)\DeathBomb=1 EndIf Next player EndIf SendUpdate(5) EndIf Case 6 ;exit game quit=1 ;- Change Port Case 7 ;change network port ;change port If GameMode If MessageRequester("Tank","Terminate existing network game?",#PB_MessageRequester_YesNo)=6 ;close the connection If gamemode=1 CloseNetworkServer(NetID) Else CloseNetworkConnection(NetID) EndIf gamemode=0 GameStart=0 KillPlayers() If port p.s=Str(port) Else p.s="1666" EndIf p=InputRequester("Tank","What is the new user port?",p) ;open a new one port=Val(p) EndIf Else ;change port GameStart=0 KillPlayers() If port p.s=Str(port) Else p.s="1666" EndIf p=InputRequester("Tank","What is the new user port?",p) ;open a new one port=Val(p) EndIf ;- Game Setup Case 8 ;one player on this PC AltUser=0 SetMenuItemState(0,8,1) SetMenuItemState(0,9,0) INI_WriteInteger( "Setup", "Players", AltUser) Case 9 ;Two players on this PC AltUser=1 SetMenuItemState(0,8,0) SetMenuItemState(0,9,1) INI_WriteInteger( "Setup", "Players", AltUser) Case 10 ;use all powerups If gamemode=2 MessageRequester("Tank","Only the host can change game options",0) Else PowerUp(0)=1 PowerUp(1)=0 For n=2 To 4 PowerUp(n)=1 Next n For n=0 To 4 SetMenuItemState(0,menu+n,PowerUp(n)) INI_WriteInteger("PowerUps","P"+Trim(Str(n)),PowerUp(n)) Next n EndIf Case 11 ;No PowerUps If gamemode=2 MessageRequester("Tank","Only the host can change game options",0) Else For n=0 To 5 PowerUp(n)=0 Next n PowerUp(1)=1 For n=0 To 5 SetMenuItemState(0,menu+n-1,PowerUp(n)) INI_WriteInteger("PowerUps","P"+Trim(Str(n)),PowerUp(n)) Next n EndIf Case 16 ;Load custom level If gamemode=2 MessageRequester("Tank","Only the host can change game options",0) Else ;ok fn.s=OpenFileRequester("Load a Tank Map",RunPath+"Empty.map","Levels (*.map)|*.map|Text (*.txt)|*.txt|All Files (*.*)|*.*",0) If Len(fn) GameName=fn LoadRoom() If GameMode sp.l=2 If AltUser sp=3 EndIf For Player.l=sp.l To 4 If Player(Player)\CID SendUpdate(-Player) EndIf Next Player EndIf EndIf EndIf Case 17 GetHelp("#Contents") Case 18 GetHelp("#Play") Case 19 GetHelp("#Internet") Case 20 ;about ShowAbout("Tank Battle","v1.0 enjoy") Default ;ensure this is a power up menu item If gamemode=2 MessageRequester("Tank","Only the host can change game options",0) Else If menu>11 If menu<16 ;ok ... determine PU item PU=menu-10 PowerUp(PU)=1-PowerUp(PU) SetMenuItemState(0,menu,PowerUp(pu)) INI_WriteInteger("PowerUps","P"+Trim(Str(PU)),PowerUp(PU)) PowerUp(1)=0 SetMenuItemState(0,11,0) INI_WriteInteger("PowerUps","P1",0) EndIf EndIf EndIf EndSelect ProcedureReturn quit EndProcedure Procedure PlayGame() LoadPlayers() LoadRoom() ThisUser=1 Repeat StartDrawing(ScreenOutput()) PaintRoom() PaintRoom() StopDrawing() If IsScreenActive() If quit=0 quit=HandleKeys() EndIf EndIf PaintPlayers() FlipBuffers() Delay(1) MasterDelay=GetTickCount_()-MasterTimer MasterTimer=GetTickCount_() WE.l=WindowEvent() If WE=#PB_Event_CloseWindow quit=1 ElseIf WE=#PB_Event_Menu quit=HandleMenu() EndIf If GameMode If Player(ThisUser)\LastUpdate