VBNET:Blockanoidz
From GDWiki
This is a test page to demonstrate the possiblility of using "wiki power" to creating and writing
community based programming projects.
This page is still a work in progress and the idea is
still evolving!
A prerelease of the WikiCompiler app is now availible, and demontrates that the idea is possible!
WikiCompiler.zip 49Kb (Release 2 - April 7, 2005)
Contents |
[edit] Project Blockanoidz
[edit] Project Information
Whoa - yep I am definatly going to have to add in multi page project support for the WikiCompiler right away. This page is huge!
You will need to download the BlockanoidzGameFiles.zip game data file to run the game.
BlockanoidzGameFiles.zip 139Kb
BlockanoidzGameFiles.zip 139Kb - Mirror 1
You will need to download the BlockanoidzReferences.zip game references and place them in your library path in order for the game to compile.
BlockanoidzReferences.zip 1Mb
[edit] How to Compile
- 1: Create a folder called "Blockanoidz". (You can name the folder whatever you want)
- 2: Download these two files and extract them into the "Blockanoidz" folder you created.
- 3: Download and run the WikiCompiler Release 3 applcation. WikiCompiler
- 4: Specify "http://gpwiki.org/index.php/VBNET:Blockanoidz" for the source URL
- 5: Click the "Options" tab and set the destination folder to the "Blockanoidz" you created.
- 6: Click the "Assembly Folders" tab and add the "Blockanoidz" you created.
- 7: Click the compile button to compile the Blockanoidz game.
- 8: A new sub folder will be created within the "Blockanoidz" folder you created called "Blockanoidz".
- 9: Now copy the Blockanoidz.exe file within that newly created folder and copy it to the original "Blockanoidz" folder you created.
- 10: To run the game just drag and drop the Game.txt file onto the Blockanoidz.exe app top play that game map. (Game play mechanics have not been implemented yet)
- [[[PROJECTSTART:Blockanoidz:::EXE]]]
- [[[REFERENCE:System.dll]]]
- [[[REFERENCE:System.Data.dll]]]
- [[[REFERENCE:System.Drawing.dll]]]
- [[[REFERENCE:System.Windows.Forms.dll]]]
- [[[REFERENCE:System.Xml.dll]]]
- [[[REFERENCE:Microsoft.VisualBasic.dll]]]
- [[[REFERENCE:mscorlib.dll]]]
- [[[REFERENCE:Microsoft.DirectX.dll]]]
- [[[REFERENCE:Microsoft.DirectX.DirectInput.dll]]]
- [[[REFERENCE:Microsoft.DirectX.DirectDraw.dll]]]
- [[[REFERENCE:Microsoft.DirectX.Direct3D.dll]]]
- [[[REFERENCE:Microsoft.DirectX.Direct3DX.dll]]]
- [[[REFERENCE:Microsoft.DirectX.AudioVideoPlayback.dll]]]
- [[[REFERENCE:dx9t.dll]]]
[edit] Project Files
[edit] AssemblyInfo.vb
[[[FILESTART:AssemblyInfo.vb]]]
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("")>
<Assembly: AssemblyCopyright("")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
'<Assembly: Guid("19CED997-9CB5-4533-B887-F114BB35B3F0")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion("1.0.*")>
[[[FILEEND:AssemblyInfo.vb]]]
[edit] BallCollection.vb
[[[FILESTART:BallCollection.vb]]]
Imports Microsoft
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D.Geometry
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports DXTools
Imports System.Collections
Imports Microsoft.DirectX.DirectInput.CooperativeLevelFlags
Public Class BallCollection
Implements IEnumerable, IDisposable
Private mobjItems As System.Collections.ArrayList
Public Sub New()
mobjItems = New System.Collections.ArrayList()
End Sub
Public Sub SwapItem(ByVal Index1 As Integer, ByVal Index2 As Integer)
Dim intFirst, intLast As Integer
Dim objFirst, objLast As Object
' do err chech
If Index1 < 0 Or Index1 > mobjItems.Count - 1 Then Exit Sub
If Index2 < 0 Or Index2 > mobjItems.Count - 1 Then Exit Sub
If Index1 = Index2 Then Exit Sub
If Index1 < Index2 Then intFirst = Index1 Else intFirst = Index2
If Index1 > Index2 Then intLast = Index1 Else intLast = Index2
' store items
objFirst = mobjItems(intFirst)
objLast = mobjItems(intLast)
' remove from list
mobjItems.RemoveAt(intLast)
mobjItems.RemoveAt(intFirst)
' reinsert
mobjItems.Insert(intFirst, objFirst)
mobjItems.Insert(intLast, objLast)
End Sub
Public Function GetEnumerator() As System.Collections.IEnumerator Implements System.Collections.IEnumerable.GetEnumerator
Return New BallCollectionEnumerator(Me)
End Function
Public Sub Dispose() Implements System.IDisposable.Dispose
GC.SuppressFinalize(Me)
End Sub
Public Function Add(ByVal Item As BallEntity) As Integer
Return mobjItems.Add(Item)
End Function
Public Sub Clear()
mobjItems.Clear()
End Sub
Public ReadOnly Property Count() As Integer
Get
Return mobjItems.Count
End Get
End Property
Public Function IndexOf(ByVal Item As BallEntity) As Integer
Return mobjItems.IndexOf(Item)
End Function
Public Sub Insert(ByVal Index As Integer, ByVal Item As BallEntity)
mobjItems.Insert(Index, Item)
End Sub
Default Public Property Item(ByVal Index As Integer) As BallEntity
Get
Return CType(mobjItems.Item(Index), BallEntity)
End Get
Set(ByVal Value As BallEntity)
mobjItems(Index) = Value
End Set
End Property
Public Sub Remove(ByVal Item As BallEntity)
mobjItems.Remove(Item)
End Sub
Public Sub Remove(ByVal Index As Integer)
mobjItems.RemoveAt(Index)
End Sub
Public Sub Remove(ByVal Index As Integer, ByVal Count As Integer)
mobjItems.RemoveRange(Index, Count)
End Sub
Class BallCollectionEnumerator
Implements IEnumerator
Private mobjParent As BallCollection
Private CurrentEntry As BallEntity
Private mintCurrentIndex As Integer = 0
' Create a reference back to the object instance that
' owns this Enumberator.
Public Sub New(ByVal xParent As BallCollection)
mobjParent = xParent
End Sub
Public ReadOnly Property Current() As Object Implements System.Collections.IEnumerator.Current
Get
Return CurrentEntry
End Get
End Property
Public Function MoveNext() As Boolean Implements System.Collections.IEnumerator.MoveNext
' If we've itterated until we've reached the last one,
' then stop!
If mintCurrentIndex < mobjParent.Count Then
CurrentEntry = mobjParent.Item(mintCurrentIndex)
mintCurrentIndex += 1
Return True
Else
mobjParent.Dispose()
Return False
End If
End Function
Public Sub Reset() Implements System.Collections.IEnumerator.Reset
mintCurrentIndex = 0
End Sub
End Class
End Class
[[[FILEEND:BallCollection.vb]]]
[edit] Entity.vb
[[[FILESTART:Entity.vb]]]
Imports Microsoft
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D.Geometry
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports DXTools
Imports Microsoft.DirectX.DirectInput.CooperativeLevelFlags
Public Class Entity
Public Sprite As Sprite2D
Public Health As Single
Protected Friend mintCurrentAnimation As Integer = -1
Protected Friend mobjAnimations As New Collections.Specialized.StringCollection()
Public Sub UpdateAnimation(ByVal TimeValue As Long)
Dim Values(12) As Single
' no animation has been set so we can just exit
If mintCurrentAnimation = -1 Or mobjAnimations.Count = 0 Then Exit Sub
' update current animation incase a animation was added or removed. This ensures animation is kept within bounds
If mintCurrentAnimation < -1 Then
mintCurrentAnimation = -1
Exit Sub
End If
If mintCurrentAnimation > mobjAnimations.Count - 1 Then mintCurrentAnimation = mobjAnimations.Count - 1
' store animation name
Dim cAni As String
cAni = mobjAnimations(mintCurrentAnimation)
' get animation values
GetTrackValue(cAni, "XCenter", TimeValue, Values(0))
GetTrackValue(cAni, "YCenter", TimeValue, Values(1))
GetTrackValue(cAni, "Rotation", TimeValue, Values(2))
GetTrackValue(cAni, "XScale", TimeValue, Values(3))
GetTrackValue(cAni, "YScale", TimeValue, Values(4))
GetTrackValue(cAni, "Left", TimeValue, Values(5))
GetTrackValue(cAni, "Top", TimeValue, Values(6))
GetTrackValue(cAni, "Width", TimeValue, Values(7))
GetTrackValue(cAni, "Height", TimeValue, Values(8))
GetTrackValue(cAni, "Alpha", TimeValue, Values(9))
GetTrackValue(cAni, "Red", TimeValue, Values(10))
GetTrackValue(cAni, "Green", TimeValue, Values(11))
GetTrackValue(cAni, "Blue", TimeValue, Values(12))
' update sprite values
With Me.Sprite
.CenterX = Values(0)
.CenterY = Values(1)
.Rotation = Values(2)
.ScaleX = Values(3)
.ScaleY = Values(4)
.Rectangle = New Rectangle(CInt(Values(5)), CInt(Values(6)), CInt(Values(7)), CInt(Values(8)))
.Color = Color.FromArgb(CInt(Values(9)), CInt(Values(10)), CInt(Values(11)), CInt(Values(12)))
End With
End Sub
Public Property CurrentAnimation() As Integer
Get
Return mintCurrentAnimation
End Get
Set(ByVal Value As Integer)
mintCurrentAnimation = Value
' prevent current animation from exceeding bounds
If mintCurrentAnimation < -1 Then mintCurrentAnimation = 1
If mintCurrentAnimation > mobjAnimations.Count - 1 Then mintCurrentAnimation = mobjAnimations.Count - 1
End Set
End Property
Public ReadOnly Property Animations() As Collections.Specialized.StringCollection
Get
Return mobjAnimations
End Get
End Property
End Class
[[[FILEEND:Entity.vb]]]
[edit] EntityCollection.vb
[[[FILESTART:EntityCollection.vb]]]
Imports Microsoft
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D.Geometry
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports DXTools
Imports System.Collections
Imports Microsoft.DirectX.DirectInput.CooperativeLevelFlags
Public Class EntityCollection
Implements IEnumerable, IDisposable
Private mobjItems As System.Collections.ArrayList
Public Sub New()
mobjItems = New System.Collections.ArrayList()
End Sub
Public Sub SwapItem(ByVal Index1 As Integer, ByVal Index2 As Integer)
Dim intFirst, intLast As Integer
Dim objFirst, objLast As Object
' do err chech
If Index1 < 0 Or Index1 > mobjItems.Count - 1 Then Exit Sub
If Index2 < 0 Or Index2 > mobjItems.Count - 1 Then Exit Sub
If Index1 = Index2 Then Exit Sub
If Index1 < Index2 Then intFirst = Index1 Else intFirst = Index2
If Index1 > Index2 Then intLast = Index1 Else intLast = Index2
' store items
objFirst = mobjItems(intFirst)
objLast = mobjItems(intLast)
' remove from list
mobjItems.RemoveAt(intLast)
mobjItems.RemoveAt(intFirst)
' reinsert
mobjItems.Insert(intFirst, objFirst)
mobjItems.Insert(intLast, objLast)
End Sub
Public Function GetEnumerator() As System.Collections.IEnumerator Implements System.Collections.IEnumerable.GetEnumerator
Return New EntityCollectionEnumerator(Me)
End Function
Public Sub Dispose() Implements System.IDisposable.Dispose
GC.SuppressFinalize(Me)
End Sub
Public Function Add(ByVal Item As Entity) As Integer
Return mobjItems.Add(Item)
End Function
Public Sub Clear()
mobjItems.Clear()
End Sub
Public ReadOnly Property Count() As Integer
Get
Return mobjItems.Count
End Get
End Property
Public Function IndexOf(ByVal Item As Entity) As Integer
Return mobjItems.IndexOf(Item)
End Function
Public Sub Insert(ByVal Index As Integer, ByVal Item As Entity)
mobjItems.Insert(Index, Item)
End Sub
Default Public Property Item(ByVal Index As Integer) As Entity
Get
Return CType(mobjItems.Item(Index), Entity)
End Get
Set(ByVal Value As Entity)
mobjItems(Index) = Value
End Set
End Property
Public Sub Remove(ByVal Item As Entity)
mobjItems.Remove(Item)
End Sub
Public Sub Remove(ByVal Index As Integer)
mobjItems.RemoveAt(Index)
End Sub
Public Sub Remove(ByVal Index As Integer, ByVal Count As Integer)
mobjItems.RemoveRange(Index, Count)
End Sub
Class EntityCollectionEnumerator
Implements IEnumerator
Private mobjParent As EntityCollection
Private CurrentEntry As Entity
Private mintCurrentIndex As Integer = 0
' Create a reference back to the object instance that
' owns this Enumberator.
Public Sub New(ByVal xParent As EntityCollection)
mobjParent = xParent
End Sub
Public ReadOnly Property Current() As Object Implements System.Collections.IEnumerator.Current
Get
Return CurrentEntry
End Get
End Property
Public Function MoveNext() As Boolean Implements System.Collections.IEnumerator.MoveNext
' If we've itterated until we've reached the last one,
' then stop!
If mintCurrentIndex < mobjParent.Count Then
CurrentEntry = mobjParent.Item(mintCurrentIndex)
mintCurrentIndex += 1
Return True
Else
mobjParent.Dispose()
Return False
End If
End Function
Public Sub Reset() Implements System.Collections.IEnumerator.Reset
mintCurrentIndex = 0
End Sub
End Class
End Class
[[[FILEEND:EntityCollection.vb]]]
[edit] GameLoader.vb
[[[FILESTART:GameLoader.vb]]]
Imports Microsoft
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D.Geometry
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports DXTools
Imports Microsoft.DirectX.DirectInput.CooperativeLevelFlags
Imports Microsoft.VisualBasic
Public Module GameLoader
Public Sub LoadGame()
Dim File, Data As String
' remove any prev references to game objects
If gobjBlocks Is Nothing = False Then gobjBlocks = Nothing
If gobjPlayers Is Nothing = False Then gobjPlayers = Nothing
If gobjBalls Is Nothing = False Then gobjBalls = Nothing
' check if a game file was specified
If Environment.GetCommandLineArgs.Length < 2 Then Throw New ArgumentException("No game file was specified on the command line.")
' read game data file
File = Environment.GetCommandLineArgs(1)
If IO.File.Exists(File) = False Then Throw New IO.FileNotFoundException("File not found!", File)
Data = ReadFile(File)
If Data Is Nothing Then Throw New IO.FileLoadException("Could not read file!", File)
If Data = "" Then Throw New IO.FileLoadException("File apears to be empty!", File)
' get lines
Dim Lines As New Collections.Specialized.StringCollection()
Lines.AddRange(Data.Split(vbCr.ToCharArray))
' trim all lines
Dim idx As Integer
idx = 0
While idx < Lines.Count
Lines(idx) = Lines(idx).Trim
If Lines(idx) = "" Or Lines(idx).StartsWith("--") Then
Lines.RemoveAt(idx)
Else
idx += 1
End If
End While
' process game file header
ProcessHeader(File, Lines)
' process textures
ProcessTextures(File, Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Game data appears to be empty!")
' process animations
ProcessAnimations(Lines)
' create game objects
gobjBlocks = New EntityCollection()
gobjPlayers = New PlayerCollection()
gobjBalls = New BallCollection()
' process blocks
ProcessBlocks(Lines)
' process balls
ProcessBalls(Lines)
' process players
ProcessPlayers(Lines)
End Sub
Private Sub ProcessPlayers(ByVal Lines As Collections.Specialized.StringCollection)
' get number of textures
Dim PlayerCount As Integer
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting player count but end of file occoured!")
If IsNumeric(Lines(0)) = False Then Throw New Data.DataException("Was expecting a numerical value for player count!")
' store animation count
PlayerCount = CInt(Lines(0))
' line no longer needed
Lines.RemoveAt(0)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting " & PlayerCount.ToString & " more players but end of file occoured!")
' read animations
While PlayerCount > 0
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting " & PlayerCount.ToString & " more players but end of file occoured!")
' get ball info values
Dim Data As String
Data = Lines(0)
Dim Parts() As String
Parts = Data.Split(","c)
If Parts.Length <> 7 Then Throw New Data.DataException("Was expecting 7 values for the player but got " & Parts.Length.ToString & ".")
If IsNumeric(Parts(0)) = False Or IsNumeric(Parts(1)) = False Then Throw New Data.DataException("The position of the player does not appear to be a numeric value.")
If IsNumeric(Parts(2)) = False Then Throw New Data.DataException("The health of the player does not appear to be a numeric value.")
If CSng(Parts(2)) <= 0 Then Throw New Data.DataException("The Health value for the player cannot be 0 or less. Declared health value was " & CSng(Parts(2)).ToString & ".")
If IsNumeric(Parts(3)) = False Then Throw New Data.DataException("The speed of the player does not appear to be a numeric value.")
If CSng(Parts(3)) <= 0 Then Throw New Data.DataException("The speed value for the player cannot be 0 or less. Declared speed value was " & CSng(Parts(3)).ToString & ".")
Parts(4) = Parts(4).Trim
Parts(5) = Parts(5).Trim
Parts(6) = Parts(6).Trim
' check if default block animation exists
If AnimationExists(Parts(4)) = False Then Throw New Data.DataException("The declared default animation (" & Parts(4) & ") does not exist!")
' check if hit block animation exists
If AnimationExists(Parts(5)) = False Then Throw New Data.DataException("The declared hit animation (" & Parts(5) & ") does not exist!")
' check if distroyed block animation exists
If AnimationExists(Parts(6)) = False Then Throw New Data.DataException("The declared destroyed animation (" & Parts(6) & ") does not exist!")
' every thing seems to be in order so add the block
Dim Player As New PlayerEntity()
Player.Animations.AddRange(New String() {Parts(4), Parts(5), Parts(6)})
Player.CurrentAnimation = 0 ' default animation
Player.Health = CSng(Parts(2))
Player.Speed = CSng(Parts(3))
Player.Sprite.X = CSng(Parts(0))
Player.Sprite.Y = CSng(Parts(1))
' add ball to list
gobjPlayers.Add(Player)
' we can now remove the line
Lines.RemoveAt(0)
PlayerCount -= 1
End While
End Sub
Private Sub ProcessBalls(ByVal Lines As Collections.Specialized.StringCollection)
' get number of textures
Dim BallCount As Integer
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting ball count but end of file occoured!")
If IsNumeric(Lines(0)) = False Then Throw New Data.DataException("Was expecting a numerical value for ball count!")
' store animation count
BallCount = CInt(Lines(0))
' line no longer needed
Lines.RemoveAt(0)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting " & BallCount.ToString & " more balls but end of file occoured!")
' read animations
While BallCount > 0
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting " & BallCount.ToString & " more balls but end of file occoured!")
' get ball info values
Dim Data As String
Data = Lines(0)
Dim Parts() As String
Parts = Data.Split(","c)
If Parts.Length <> 9 Then Throw New Data.DataException("Was expecting 9 values for the ball but got " & Parts.Length.ToString & ".")
' position
If IsNumeric(Parts(0)) = False Or IsNumeric(Parts(1)) = False Then Throw New Data.DataException("The position of the ball does not appear to be a numeric value.")
' health
If IsNumeric(Parts(2)) = False Then Throw New Data.DataException("The health of the ball does not appear to be a numeric value.")
If CSng(Parts(2)) <= 0 Then Throw New Data.DataException("The health value for the ball cannot be 0 or less. Declared health value was " & CSng(Parts(2)).ToString & ".")
' damage
If IsNumeric(Parts(3)) = False Then Throw New Data.DataException("The damage of the ball does not appear to be a numeric value.")
If CSng(Parts(3)) <= 0 Then Throw New Data.DataException("The damage value for the ball cannot be 0 or less. Declared damage value was " & CSng(Parts(3)).ToString & ".")
' angle
If IsNumeric(Parts(4)) = False Then Throw New Data.DataException("The angle of the ball does not appear to be a numeric value.")
If CSng(Parts(4)) <= 0 Then Throw New Data.DataException("The angle value for the ball cannot be 0 or less. Declared angle value was " & CSng(Parts(4)).ToString & ".")
' speed
If IsNumeric(Parts(5)) = False Then Throw New Data.DataException("The speed of the ball does not appear to be a numeric value.")
If CSng(Parts(5)) <= 0 Then Throw New Data.DataException("The speed value for the ball cannot be 0 or less. Declared speed value was " & CSng(Parts(5)).ToString & ".")
Parts(6) = Parts(6).Trim
Parts(7) = Parts(7).Trim
Parts(8) = Parts(8).Trim
' check if default block animation exists
If AnimationExists(Parts(6)) = False Then Throw New Data.DataException("The declared default animation (" & Parts(6) & ") does not exist!")
' check if hit block animation exists
If AnimationExists(Parts(7)) = False Then Throw New Data.DataException("The declared hit animation (" & Parts(7) & ") does not exist!")
' check if distroyed block animation exists
If AnimationExists(Parts(8)) = False Then Throw New Data.DataException("The declared destroyed animation (" & Parts(8) & ") does not exist!")
' every thing seems to be in order so add the block
Dim Ball As New BallEntity()
Ball.Animations.AddRange(New String() {Parts(6), Parts(7), Parts(8)})
Ball.CurrentAnimation = 0 ' default animation
Ball.Health = CSng(Parts(2))
Ball.Damage = CSng(Parts(3))
Ball.Angle = CSng(Parts(4))
Ball.Speed = CSng(Parts(5))
Ball.Sprite.X = CSng(Parts(0))
Ball.Sprite.Y = CSng(Parts(1))
' add ball to list
gobjBalls.Add(Ball)
' we can now remove the line
Lines.RemoveAt(0)
BallCount -= 1
End While
End Sub
Private Sub ProcessBlocks(ByVal Lines As Collections.Specialized.StringCollection)
' get number of textures
Dim BlockCount As Integer
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting block count but end of file occoured!")
If IsNumeric(Lines(0)) = False Then Throw New Data.DataException("Was expecting a numerical value for block count!")
' store animation count
BlockCount = CInt(Lines(0))
' line no longer needed
Lines.RemoveAt(0)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting " & BlockCount.ToString & " more blocks but end of file occoured!")
' read animations
While BlockCount > 0
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting " & BlockCount.ToString & " more blocks but end of file occoured!")
' get block info values
Dim Data As String
Data = Lines(0)
Dim Parts() As String
Parts = Data.Split(","c)
If Parts.Length <> 6 Then Throw New Data.DataException("Was expecting 6 values for the block but got " & Parts.Length.ToString & ".")
If IsNumeric(Parts(0)) = False Or IsNumeric(Parts(1)) = False Then Throw New Data.DataException("The position of the block does not appear to be a numeric value.")
If IsNumeric(Parts(2)) = False Then Throw New Data.DataException("The health of the block does not appear to be a numeric value.")
If CSng(Parts(2)) <= 0 Then Throw New Data.DataException("The Health value for the block cannot be 0 or less. Declared health value was " & CSng(Parts(2)).ToString & ".")
Parts(3) = Parts(3).Trim
Parts(4) = Parts(4).Trim
Parts(5) = Parts(5).Trim
' check if default block animation exists
If AnimationExists(Parts(3)) = False Then Throw New Data.DataException("The declared default animation (" & Parts(3) & ") does not exist!")
' check if hit block animation exists
If AnimationExists(Parts(4)) = False Then Throw New Data.DataException("The declared hit animation (" & Parts(4) & ") does not exist!")
' check if distroyed block animation exists
If AnimationExists(Parts(5)) = False Then Throw New Data.DataException("The declared destroyed animation (" & Parts(5) & ") does not exist!")
' every thing seems to be in order so add the block
Dim Block As New Entity()
Block.Animations.AddRange(New String() {Parts(3), Parts(4), Parts(5)})
Block.CurrentAnimation = 0 ' default animation
Block.Health = CSng(Parts(2))
Block.Sprite.X = CSng(Parts(0))
Block.Sprite.Y = CSng(Parts(1))
' add block to arraylist
gobjBlocks.Add(Block)
' we can now remove the line
Lines.RemoveAt(0)
BlockCount -= 1
End While
End Sub
Private Sub ProcessAnimations(ByVal Lines As Collections.Specialized.StringCollection)
' get number of textures
Dim AnimationCount As Integer
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting animation count but end of file occoured!")
If IsNumeric(Lines(0)) = False Then Throw New Data.DataException("Was expecting a numerical value for animation count!")
' store animation count
AnimationCount = CInt(Lines(0))
' line no longer needed
Lines.RemoveAt(0)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting " & AnimationCount.ToString & " more animations but end of file occoured!")
' read animations
While AnimationCount > 0
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting " & AnimationCount.ToString & " more animations but end of file occoured!")
' get animation name
Dim AnimationName As String
AnimationName = Lines(0)
' line no longer needed
Lines.RemoveAt(0)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting animation texture but end of file occoured!")
' cut off any comments
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting animation texture filename but end of file occoured!")
' get animation texture
Dim AnimationTexture As String
AnimationTexture = IO.Path.GetFileName(Lines(0))
' check if texture exists/had been added
If TextureExists(AnimationTexture) = False Then Throw New Data.DataException("Animation seems to be referencing a texture that was not declared in the texture list!")
' line no longer needed
Lines.RemoveAt(0)
' cut off any comments
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting animation key frame count but end of file occoured!")
' add animation and tracks for the animation
AddAnimation(AnimationName)
AddTrack(AnimationName, "XCenter")
AddTrack(AnimationName, "YCenter")
AddTrack(AnimationName, "Rotation")
AddTrack(AnimationName, "XScale")
AddTrack(AnimationName, "YScale")
AddTrack(AnimationName, "Left")
AddTrack(AnimationName, "Top")
AddTrack(AnimationName, "Width")
AddTrack(AnimationName, "Height")
AddTrack(AnimationName, "Alpha")
AddTrack(AnimationName, "Red")
AddTrack(AnimationName, "Green")
AddTrack(AnimationName, "Blue")
gobjAnimationTextures.Add(AnimationName, AnimationTexture)
' process any animation keys
ProcessAnimationKeyFrames(AnimationName, Lines)
AnimationCount -= 1
End While
End Sub
Private Sub ProcessAnimationKeyFrames(ByVal AnimationName As String, ByVal Lines As Collections.Specialized.StringCollection)
' get number of textures
Dim KeyCount As Integer
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting animation key frame count but end of file occoured!")
If IsNumeric(Lines(0)) = False Then Throw New Data.DataException("Was expecting a numerical value for animation key frame count!")
' store animation count
KeyCount = CInt(Lines(0))
' line no longer needed
Lines.RemoveAt(0)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting " & KeyCount.ToString & " more key frames but end of file occoured!")
' read key frames
While KeyCount > 0
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting " & KeyCount.ToString & " more key frames but end of file occoured!")
' get key frame values
Dim Data As String
Data = Lines(0)
Dim Parts() As String
Parts = Data.Split(","c)
If Parts.Length <> 14 Then Throw New Data.DataException("Was expecting 14 values for the key frame but got " & Parts.Length.ToString & ".")
If AllKeyValuesAreNumeric(Parts) = False Then Throw New Data.DataException("One of the key frames for animation (" & AnimationName & ") was not numeric.")
' convert values
Dim Values() As Single
Values = GetAllKeyValues(Parts)
Dim TimeValue As Long
' calc key frame time and convert to ticks
TimeValue = TimeSpan.FromMilliseconds(CInt(Values(0))).Ticks
' convert rotation to radian
Values(3) = DegreeToRadian(Values(3))
' add key frame values to animation
AddTrackKey(AnimationName, "XCenter", TimeValue, Values(1))
AddTrackKey(AnimationName, "YCenter", TimeValue, Values(2))
AddTrackKey(AnimationName, "Rotation", TimeValue, Values(3))
AddTrackKey(AnimationName, "XScale", TimeValue, Values(4))
AddTrackKey(AnimationName, "YScale", TimeValue, Values(5))
AddTrackKey(AnimationName, "Left", TimeValue, Values(6))
AddTrackKey(AnimationName, "Top", TimeValue, Values(7))
AddTrackKey(AnimationName, "Width", TimeValue, Values(8))
AddTrackKey(AnimationName, "Height", TimeValue, Values(9))
AddTrackKey(AnimationName, "Alpha", TimeValue, Values(10))
AddTrackKey(AnimationName, "Red", TimeValue, Values(11))
AddTrackKey(AnimationName, "Green", TimeValue, Values(12))
AddTrackKey(AnimationName, "Blue", TimeValue, Values(13))
' we can now remove the line
Lines.RemoveAt(0)
KeyCount -= 1
End While
End Sub
Public Function GetAllKeyValues(ByVal Values() As String) As Single()
Dim idx As Integer
Dim V() As Single
ReDim V(Values.Length - 1)
For idx = 0 To Values.Length - 1
V(idx) = CSng(Values(idx).Trim)
Next
Return V
End Function
Public Function AllKeyValuesAreNumeric(ByVal Values() As String, Optional ByVal LastIndex As Integer = -1) As Boolean
Dim idx As Integer
For idx = 0 To Values.Length - 1
If IsNumeric(Values(idx).Trim) = False Then Return False
If idx = LastIndex Then Exit For
Next
Return True
End Function
Private Sub ProcessHeader(ByVal File As String, ByVal Lines As Collections.Specialized.StringCollection)
' check if game file starts with header
If Lines(0).Trim.ToLower.StartsWith("[-blockanoidz-]") = False Then Throw New IO.FileLoadException("Does not appear to be valid game file!", File)
' we can now remove line
Lines.RemoveAt(0)
If Lines.Count = 0 Then Throw New Data.DataException("Game data appears to be empty!")
' remove any comments
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Game data does not appear to contain game info!")
End Sub
Private Sub ProcessTextures(ByVal GameFile As String, ByVal Lines As Collections.Specialized.StringCollection)
' get number of textures
Dim TextureCount As Integer
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting texture count but end of file occoured!")
' check if value is numeric
If IsNumeric(Lines(0)) = False Then Throw New Data.DataException("Was expecting a numerical value for texture count!")
' store texture count
TextureCount = CInt(Lines(0))
' line no longer needed
Lines.RemoveAt(0)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting " & TextureCount.ToString & " more textures but end of file occoured!")
' read texture filenames
While TextureCount > 0
CutComments(Lines)
' throw error if no data left to be read
If Lines.Count = 0 Then Throw New Data.DataException("Was expecting " & TextureCount.ToString & " more texture files but end of file occoured!")
' get texture file name with a relative path
Dim TexFile As String
TexFile = IO.Path.Combine(IO.Path.GetDirectoryName(GameFile), Lines(0))
If IO.File.Exists(TexFile) = False Then Throw New IO.FileNotFoundException("Texture file seems to be missing!", TexFile)
' file must exist so we try to load it
Dim Tex As Direct3D.Texture
Tex = Nothing
Tex = LoadTexture(TexFile)
If Tex Is Nothing Then Throw New IO.FileLoadException("Texture file could not be loaded!", TexFile)
' add texture to the list
AddTexture(IO.Path.GetFileName(TexFile), Tex)
' we can now remove the line
Lines.RemoveAt(0)
TextureCount -= 1
End While
End Sub
Private Sub CutComments(ByVal Lines As Collections.Specialized.StringCollection)
' remove any comments or blank lines that fallow
While Lines.Count > 0
If Lines(0).Trim = "" Or Lines(0).Trim.StartsWith("--") Then
Lines.RemoveAt(0)
Else
Exit While
End If
End While
End Sub
Public Function WriteFile(ByVal File As String, ByVal Data As String) As Boolean
Try
If IO.File.Exists(File) Then IO.File.Delete(File)
Dim F As IO.StreamWriter = IO.File.CreateText(File)
F.Write(Data)
F.Close()
F = Nothing
Catch ex As Exception
Return False
End Try
Return True
End Function
Public Function ReadFile(ByVal File As String) As String
Dim Tmp As String = Nothing
Try
If IO.File.Exists(File) = False Then Throw New IO.FileNotFoundException("The file does not appear to exist!", File)
Dim F As IO.StreamReader = IO.File.OpenText(File)
Tmp = F.ReadToEnd
F.Close()
F = Nothing
Catch ex As Exception
Tmp = Nothing
End Try
Return Tmp
End Function
End Module
[[[FILEEND:GameLoader.vb]]]
[edit] General.vb
[[[FILESTART:General.vb]]]
Imports Microsoft
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D.Geometry
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports DXTools
Imports Microsoft.DirectX.DirectInput.CooperativeLevelFlags
Imports Microsoft.VisualBasic
Public Class BallEntity
Inherits Entity
Public Damage As Single
Public Angle As Single
Public Speed As Single
End Class
Public Class PlayerEntity
Inherits Entity
Public Speed As Single
End Class
Public Module General
Friend gobjForm As Form
Friend gblnRunning As Boolean
Friend gobjMouse As DirectInput.Device
Friend gobjKB As DirectInput.Device
Friend gobjBlocks As EntityCollection
Friend gobjPlayers As PlayerCollection
Friend gobjBalls As BallCollection
Friend gobjAnimationTextures As Collections.Hashtable
Friend gintCurrentPlayer As Integer = -1
Friend gintRenderInterval As Long = TimeSpan.TicksPerSecond \ 66 ' 66 fps
<STAThread()> _
Public Sub Main()
InitGame()
' attempt to load game file(s)
Try
LoadGame()
If gobjPlayers.Count > 0 Then gintCurrentPlayer = 0
'Catch dae As Data.DataException
'Catch fle As IO.FileLoadException
'Catch fl As IO.FileNotFoundException
Catch ex As Exception
MessageBox.Show(ex.ToString)
ShutDownGame()
Exit Sub
End Try
GameLoop()
ShutDownGame()
End Sub
Private Sub GameLoop()
Dim TheTime As Long
Dim LastRenderTime As Long
gblnRunning = True
While gblnRunning
' store current time
TheTime = Now.Ticks
' get input
Dim KBState As DirectInput.KeyboardState
KBState = gobjKB.GetCurrentKeyboardState
If KBState(DirectInput.Key.Escape) Then Exit While
' update ball pos
UpdateBallPosition()
' update animations
UpdateAnimations(TheTime)
' we only need to render every render interval
' this allows us to control our fps
If TheTime > LastRenderTime + gintRenderInterval Then
' render scene
RenderScene()
LastRenderTime = TheTime
End If
' Application.DoEvents()
End While
gblnRunning = False
End Sub
Private Sub UpdateAnimations(ByVal TheTime As Long)
Dim idx As Integer
' update player animation
With gobjPlayers(gintCurrentPlayer)
'gobjPlayer.Sprite.X = gobjMouse.CurrentMouseState.X
.UpdateAnimation(TheTime)
.Sprite.Texture = CStr(gobjAnimationTextures(.Animations(.CurrentAnimation)))
End With
' update ball animation
For idx = 0 To gobjBalls.Count - 1
With gobjBalls(idx)
'gobjPlayer.Sprite.X = gobjMouse.CurrentMouseState.X
.UpdateAnimation(TheTime)
.Sprite.Texture = CStr(gobjAnimationTextures(.Animations(.CurrentAnimation)))
End With
Next
' update block animation
For idx = 0 To gobjBlocks.Count - 1
With gobjBlocks(idx)
'gobjPlayer.Sprite.X = gobjMouse.CurrentMouseState.X
.UpdateAnimation(TheTime)
.Sprite.Texture = CStr(gobjAnimationTextures(.Animations(.CurrentAnimation)))
End With
Next
End Sub
Private Sub UpdateBallPosition()
End Sub
Private Sub FormClosing(ByVal sender As Object, ByVal r As System.ComponentModel.CancelEventArgs)
gblnRunning = False
End Sub
Private Sub InitGame()
gobjForm = New Form()
With gobjForm
.Text = "Blockanoidz"
' make sure client area is 640 x 480
.Size = New Size(.Size.Width + (640 - .ClientSize.Width), .Size.Height + (480 - .ClientSize.Height))
.MaximizeBox = False
.MinimizeBox = False
.StartPosition = FormStartPosition.CenterScreen
.FormBorderStyle = FormBorderStyle.FixedDialog
AddHandler gobjForm.Closing, AddressOf FormClosing
.Show()
End With
gobjAnimationTextures = New Collections.Hashtable()
' init graphics and input
InitGraphics(gobjForm, True)
InitInput()
End Sub
Private Sub InitInput()
If gobjMouse Is Nothing = False Then gobjMouse.Dispose()
gobjMouse = Nothing
If gobjKB Is Nothing = False Then gobjKB.Dispose()
gobjKB = Nothing
gobjMouse = New DirectInput.Device(DirectInput.SystemGuid.Mouse)
gobjKB = New DirectInput.Device(DirectInput.SystemGuid.Keyboard)
gobjMouse.SetCooperativeLevel(gobjForm, Exclusive Or Foreground) ' NonExclusive Or Background)
gobjKB.SetCooperativeLevel(gobjForm, NonExclusive Or Background) ' Exclusive Or Foreground)
gobjMouse.Acquire()
gobjKB.Acquire()
End Sub
Private Sub ShutDownGame()
Try
RemoveHandler gobjForm.Closing, AddressOf FormClosing
ShutdownGraphics()
RemoveAllStoredResources()
If gobjMouse Is Nothing = False Then gobjMouse.Dispose()
gobjMouse = Nothing
If gobjKB Is Nothing = False Then gobjKB.Dispose()
gobjKB = Nothing
gobjForm.Dispose()
gobjForm = Nothing
' remove any prev references to game objects
gobjBlocks.Dispose()
gobjPlayers.Dispose()
gobjBalls.Dispose()
gobjBlocks = Nothing
gobjPlayers = Nothing
gobjBalls = Nothing
gobjAnimationTextures.Clear()
gobjAnimationTextures = Nothing
Catch ex As Exception
End Try
End Sub
End Module
[[[FILEEND:General.vb]]]
[edit] PlayerCollection.vb
[[[FILESTART:PlayerCollection.vb]]]
Imports Microsoft
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D.Geometry
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports DXTools
Imports System.Collections
Imports Microsoft.DirectX.DirectInput.CooperativeLevelFlags
Public Class PlayerCollection
Implements IEnumerable, IDisposable
Private mobjItems As System.Collections.ArrayList
Public Sub New()
mobjItems = New System.Collections.ArrayList()
End Sub
Public Sub SwapItem(ByVal Index1 As Integer, ByVal Index2 As Integer)
Dim intFirst, intLast As Integer
Dim objFirst, objLast As Object
' do err chech
If Index1 < 0 Or Index1 > mobjItems.Count - 1 Then Exit Sub
If Index2 < 0 Or Index2 > mobjItems.Count - 1 Then Exit Sub
If Index1 = Index2 Then Exit Sub
If Index1 < Index2 Then intFirst = Index1 Else intFirst = Index2
If Index1 > Index2 Then intLast = Index1 Else intLast = Index2
' store items
objFirst = mobjItems(intFirst)
objLast = mobjItems(intLast)
' remove from list
mobjItems.RemoveAt(intLast)
mobjItems.RemoveAt(intFirst)
' reinsert
mobjItems.Insert(intFirst, objFirst)
mobjItems.Insert(intLast, objLast)
End Sub
Public Function GetEnumerator() As System.Collections.IEnumerator Implements System.Collections.IEnumerable.GetEnumerator
Return New PlayerCollectionEnumerator(Me)
End Function
Public Sub Dispose() Implements System.IDisposable.Dispose
GC.SuppressFinalize(Me)
End Sub
Public Function Add(ByVal Item As PlayerEntity) As Integer
Return mobjItems.Add(Item)
End Function
Public Sub Clear()
mobjItems.Clear()
End Sub
Public ReadOnly Property Count() As Integer
Get
Return mobjItems.Count
End Get
End Property
Public Function IndexOf(ByVal Item As PlayerEntity) As Integer
Return mobjItems.IndexOf(Item)
End Function
Public Sub Insert(ByVal Index As Integer, ByVal Item As PlayerEntity)
mobjItems.Insert(Index, Item)
End Sub
Default Public Property Item(ByVal Index As Integer) As PlayerEntity
Get
Return CType(mobjItems.Item(Index), PlayerEntity)
End Get
Set(ByVal Value As PlayerEntity)
mobjItems(Index) = Value
End Set
End Property
Public Sub Remove(ByVal Item As PlayerEntity)
mobjItems.Remove(Item)
End Sub
Public Sub Remove(ByVal Index As Integer)
mobjItems.RemoveAt(Index)
End Sub
Public Sub Remove(ByVal Index As Integer, ByVal Count As Integer)
mobjItems.RemoveRange(Index, Count)
End Sub
Class PlayerCollectionEnumerator
Implements IEnumerator
Private mobjParent As PlayerCollection
Private CurrentEntry As PlayerEntity
Private mintCurrentIndex As Integer = 0
' Create a reference back to the object instance that
' owns this Enumberator.
Public Sub New(ByVal xParent As PlayerCollection)
mobjParent = xParent
End Sub
Public ReadOnly Property Current() As Object Implements System.Collections.IEnumerator.Current
Get
Return CurrentEntry
End Get
End Property
Public Function MoveNext() As Boolean Implements System.Collections.IEnumerator.MoveNext
' If we've itterated until we've reached the last one,
' then stop!
If mintCurrentIndex < mobjParent.Count Then
CurrentEntry = mobjParent.Item(mintCurrentIndex)
mintCurrentIndex += 1
Return True
Else
mobjParent.Dispose()
Return False
End If
End Function
Public Sub Reset() Implements System.Collections.IEnumerator.Reset
mintCurrentIndex = 0
End Sub
End Class
End Class
[[[FILEEND:PlayerCollection.vb]]]
[edit] Rendering.vb
[[[FILESTART:Rendering.vb]]]
Imports Microsoft
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D.Geometry
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports DXTools
Imports Microsoft.DirectX.DirectInput.CooperativeLevelFlags
Public Module Rendering
Public Sub RenderScene()
BeginScene()
BeginSpriteRender()
' render blocks
Dim idx As Integer
idx = 0
While idx < gobjBlocks.Count
DrawSprite(gobjBlocks(idx).Sprite)
idx += 1
End While
' render player
DrawSprite(gobjPlayers(gintCurrentPlayer).Sprite)
' render ball
idx = 0
While idx < gobjBalls.Count
DrawSprite(gobjBalls(idx).Sprite)
idx += 1
End While
EndSpriteRender()
EndScene()
End Sub
End Module
[[[FILEEND:Rendering.vb]]]
- [[[PROJECTEND:Blockanoidz]]]

