VBNET:Blockanoidz

From GDWiki

Jump to: navigation, search

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]]]
Personal tools