Can a macro generate enum from list of string variables?[NO]

General FreeBASIC programming questions.
elsairon
Posts: 207
Joined: Jul 02, 2005 14:51

Can a macro generate enum from list of string variables?[NO]

Postby elsairon » May 05, 2011 0:22

Hi All,

Short version:
Is it possible to use a macro to automatically generate an
enum definition based off an array of string names.

Explanation:

I'm using compiler version 0.21.1 with the following flags:
-lang fb -maxerr inf -w all -w next -w param -v -exx

I have some data files that are parsed to load data into two
parrallel arrays. One holds a string name of a terrain type,
the other holds the various data for movability, etc.

I'm wanting to use an enum as an index into the arrays, yet
have the code remain flexible to handle new types of terrains
being added without having to manually add enum indexes in the
program to match each newly added type.

Example of part of my terrain data

Code: Select all

[GRASS]
COL: GREEN
MOV: ALLOW_MOVE
OBS: ALLOW_LIGHT

[DIRT]
COL: BROWN
MOV: ALLOW_MOVE
OBS: ALLOW_LIGHT

[FLOOR]
COL: WHITE
MOV: ALLOW_MOVE
OBS: ALLOW_LIGHT

[WATER]
COL: LIGHT_BLUE
MOV: ALLOW_MOVE
OBS: ALLOW_LIGHT


I had before an enum as an index I would update by hand
each time I added a new type of data.

Example of enum used

Code: Select all

Enum Terrain Types
   GRASS = 1
   DIRT
   FLOOR
   WATER
   MAX_TERRAIN_TYPES = WATER
End Enum


I would then use the enum for ease of indexing into data arrays.

I can think of a way that I could automatically generate a
seperate .bi file when the code is parsed, and then #include
that .bi (with the enum definition) in it.

This would require a seperate step, re-compiling the code each
time the file was updated.

I want to be able to easily add new data definition and have the
code (enum definitions) expand to handle them automatically.

So far I have not had much success with the macro (I'm not
sure if its possible, I have not used macros before other
than simple #defines)

Latest attempt at macro to create an enum from list of strings.

Code: Select all

dim as integer x = 2
dim as string * 5 s ( 1 to x ) = { "WORLD", "ROGUE" }

#macro hacked_enum( x, test_string())
    "Enum Index_String_Values"
        dim as integer d
        for d = 1 to x
            string_test(d) & "= " & d
        next
        "MAX_TERRAIN_TYPES = " & string_test(x)
   
    "End Enum"
#endmacro
           

dim as integer test_enum_val

test_enum_val = WORLD
? WORLD

sleep


Maybe a generated list of defines could serve the same purpose?
Last edited by elsairon on May 05, 2011 0:53, edited 1 time in total.
D.J.Peters
Posts: 8132
Joined: May 28, 2005 3:28
Contact:

Postby D.J.Peters » May 05, 2011 0:44

The problem is an ENUM is COMPILE time
but your terrain data is RUNTIME you know !

why not simpler ?

Joshy

Code: Select all

enum TERRAIN_COLOR
  GREEN = RGB(0,255,0)
  BROWN = RGB(128,64,0)
  WHITE = RGB(255,255,255)
  LIGHT_BLUE = RGB(32,32,255)
end enum
enum TERRAIN_FLAG
  ALLOW_NONE   = 0
  ALLOW_MOVE   = 1
  ALLOW_LIGHT  = 2
  ALLOW_SHADOW = 4
end enum

type TERRAIN_ATTRIBUTE
  as TERRAIN_COLOR col
  as TERRAIN_FLAG  mov
  as TERRAIN_FLAG  obs
end type


dim as TERRAIN_ATTRIBUTE GRASS=TYPE(GREEN     ,ALLOW_MOVE,ALLOW_LIGHT)
dim as TERRAIN_ATTRIBUTE DIRT =TYPE(BROWN     ,ALLOW_MOVE,ALLOW_LIGHT)
dim as TERRAIN_ATTRIBUTE FLOOR=TYPE(WHITE     ,ALLOW_MOVE,ALLOW_LIGHT)
dim as TERRAIN_ATTRIBUTE WATER=TYPE(LIGHT_BLUE,ALLOW_MOVE,ALLOW_LIGHT)

' here a new terrain type
dim as TERRAIN_ATTRIBUTE SKY=TYPE(LIGHT_BLUE,ALLOW_NONE,ALLOW_SHADOW)
elsairon
Posts: 207
Joined: Jul 02, 2005 14:51

Postby elsairon » May 05, 2011 0:56

Thanks DJ :)

I think I didn't clearly understand the difference in the compile time/ run time divide and that caused my confusion.
rdc
Posts: 1725
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Postby rdc » May 05, 2011 10:32

This is one of those areas where a class can really simplify your programming. You can encapsulate the terrain information in the class based on your data file, and then ask the class object for information about a terrain type. You could also add iterators to the class to iterate through the terrain types as well.

The nice part of this is that when you update the data file, the new information will automatically be added to the class. It will also enable you to get rid of your parallel arrays since those will be encapsulated in the class (using pointer arrays).

I can work up an example if you like of what I am talking about.
elsairon
Posts: 207
Joined: Jul 02, 2005 14:51

Postby elsairon » May 06, 2011 0:32

That sounds good.

To make my project easier I wanted to be able to easily add and remove additional data/stats to creatures, terrain, items, etc.

I chose to use parallel arrays and enums as that was an easy way for me to add multiple additional stats and types of stats without breaking any of the current code, while I iterate on my game design.

I chose the best solution I could think of at the time, having no experience with classes.

An example would help me determine if I classes would work better than my current solution.

Here is an example of my current terrain code:

It has dependencies on other parts of the system but could give you an idea of the method I have been using.

data file (.txt)

Code: Select all

# =================
# Terrain Info File
# =================
# Name: Valid Values
# ===== ============
# COL:   COLOR
# SYM:   SYMBOL (Printable Ascii Character)
# MOV:    BLOCK_MOVE, ALLOW_MOVE
# OBS:   BLOCK_LIGHT, ALLOW_LIGHT

[GRASS]
COL: GREEN
SYM: .
MOV: ALLOW_MOVE
OBS: ALLOW_LIGHT

[DIRT]
COL: BROWN
SYM: .
MOV: ALLOW_MOVE
OBS: ALLOW_LIGHT

[FLOOR]
COL: WHITE
SYM: .
MOV: ALLOW_MOVE
OBS: ALLOW_LIGHT

[WATER]
COL: LIGHT_BLUE
SYM: ~
MOV: ALLOW_MOVE
OBS: ALLOW_LIGHT

[TREE]
COL: LIGHT_GREEN
SYM: &
MOV: ALLOW_MOVE
OBS: BLOCK_LIGHT

[SCRUB]
COL: GREEN
SYM: ;
MOV: ALLOW_MOVE
OBS: ALLOW_LIGHT

[WALL]
COL: WHITE
SYM: #
MOV: BLOCK_MOVE
OBS: BLOCK_LIGHT

[OPEN_DOOR]
COL: BROWN
SYM: '
MOV: ALLOW_MOVE
OBS: ALLOW_LIGHT

[CLOSED_DOOR]
COL: BROWN
SYM: +
MOV: BLOCK_MOVE
OBS: BLOCK_LIGHT


.bi

Code: Select all

'--------------------------------------------------------------------
'
':: pre-processer
'
'--------------------------------------------------------------------
#pragma once



'--------------------------------------------------------------------
'
':: enumerations
'
'--------------------------------------------------------------------
enum terrain_stats
    TERRAIN_INDEX = 1
    TERRAIN_SYMBOL
    TERRAIN_COLOR
    TERRAIN_MOVE
    TERRAIN_OPACITY
    MAX_TERRAIN_DATA
end enum
   

' HACK
' direct index into terrain types that are loaded in from file
' this needs to be updated each time a new type is added
' if code will have direct access need...
enum terrain_type_indexes
    GRASS = 1
    DIRT
    FLOOR
    WATER
    TREE
    SCRUB
    WALL
    OPEN_DOOR
    CLOSED_DOOR
    MAX_TERRAIN_TYPE_INDEXES = CLOSED_DOOR
end enum


   
'--------------------------------------------------------------------
'
':: type declarations
'
'--------------------------------------------------------------------
type TerrainType
    s ( 1 to MAX_TERRAIN_DATA - 1 ) as integer
end type




'--------------------------------------------------------------------
'
':: procedure declarations
'
'--------------------------------------------------------------------
declare function get_terrain_type_index _
    ( _
        byref t_name as string _
    ) as integer

declare sub new_init_terrain _
    ( _
    )

declare function get_max_number_of_terrain_types _
    ( _
    ) as integer
   
declare sub new_parse_terrain _
    ( _
        byval _words as integer _
    )

declare sub dump_terrain_types _
    ( _
    )

declare sub set_number_of_terrain_types _
    ( _
        byval _num as integer _
    )

declare function get_number_of_terrain_types _
    ( _
    ) as integer

declare sub set_terrain_stat _
    ( _
        byval the_index as integer, _
        byval data_type as integer, _
        byval new_value as integer _
    )
   
declare function get_terrain_stat _
    ( _
        byval t_index as integer, _
        byval _field  as integer _
    ) as integer
   
declare sub set_terrain_name _
    ( _
        byval _terrain as integer, _
        byref _name    as string _
    )
   
declare function get_terrain_name _
    ( _
        byval _terrain as integer _
    ) as string



.bas

Code: Select all

'--------------------------------------------------------------------
'
':: includes
'
'--------------------------------------------------------------------
#include once "terrain.bi"



'--------------------------------------------------------------------
'
':: variables
'
'--------------------------------------------------------------------
dim shared as integer terrain_types, max_terrain_types
max_terrain_types = 1
redim shared as TerrainType terrain ( max_terrain_types )
redim shared as string terrain_title ( max_terrain_types )


'--------------------------------------------------------------------
'
':: procedures
'
'--------------------------------------------------------------------
private sub test_terrain _
    ( _
    )

    dim as integer _types
    _types = get_number_of_terrain_types
   
    dim as integer count, t_sym, t_move, t_opacity, t_color
    dim as string t_name, fail_reason
    for count = 1 to _types
       
        t_name = get_terrain_name( count )
        fail_reason = ""
       
        ' test symbol exists in proper range
        t_sym = get_terrain_stat( count, TERRAIN_SYMBOL )
        select case t_sym
        case 1 to 255 'accept ascii
        case else
            fail_reason =  "Invalid SYM: <symbol> value (" & t_sym & _
                           ") for (" & t_name & ")"
        end select
       
        ' test valid move value
        t_move = get_terrain_stat( count, TERRAIN_MOVE )
        select case t_move
        case ALLOW_MOVE, BLOCK_MOVE
        case else
            fail_reason =  "Invalid MOV <movement> value (" & t_move & _
                           ") for (" & t_name & ")"
        end select
       
        ' test valid opacity value
        t_opacity = get_terrain_stat( count, TERRAIN_OPACITY )
        select case t_opacity
        case ALLOW_LIGHT, BLOCK_LIGHT
        case else
            fail_reason =  "Invalid OBS <obsucrity> value (" & t_opacity & _
                           ") for (" & t_name & ")"
        end select
       
        ' test valid color
        't_color = get_terrain_stat( count, TERRAIN_COLOR )
       
        if len( fail_reason ) then
            dump "test_terrain():terrain.bas"
            dump "...TEST FAILED"
            dump "......" & fail_reason
            dump "......"
            dump "...... Fix terrain info file and try again."
            sleep
            end
        end if
       
    next

end sub



function get_max_number_of_terrain_types _
    ( _
    ) as integer
   
    return max_terrain_types
   
end function



function get_number_of_terrain_types _
    ( _
    ) as integer
   
    return terrain_types

end function



sub set_number_of_terrain_types _
    ( _
        byval new_num as integer _
    )
   
    dim as integer cur_max, expand_buffer = 10
    cur_max = get_max_number_of_terrain_types
   
    if new_num >= cur_max then
       
        max_terrain_types = new_num + expand_buffer
        redim preserve as TerrainType terrain ( max_terrain_types )
        redim preserve as string terrain_title ( max_terrain_types )
      '  dump "...expanded max terrain type arrays to " & new_num
       
    end if
   
    terrain_types = new_num
   
   ' dump "...exiting set_number_of_terrain_types()":sleep
   
end sub



sub set_terrain_stat _
    ( _
        byval the_index as integer, _
        byval data_type as integer, _
        byval new_value as integer _
    )
   
    terrain ( the_index ).s ( data_type ) = new_value
   
end sub



function get_terrain_stat _
    ( _
        byval _terrain as integer, _
        byval _stat as integer _
    ) as integer
   
    return terrain ( _terrain ).s ( _stat )
   
end function



sub set_terrain_name _
    ( _
        byval _terrain as integer, _
        byref _name as string _
    )
   
'    dump "set_terrain_name()"
'    dump "... _terrain:" & _terrain
'    dump "... _name   :" & _name
   
    terrain_title ( _terrain ) = _name
   
end sub



function get_terrain_name _
    ( _
        byval _terrain as integer _
    ) as string
   
   return terrain_title ( _terrain )
   
end function



sub new_init_terrain _
    ( _
    )
   
    dump "... loading terrain types"
   
    dim as integer ff
    ff = freefile
   
    dim as integer array_size
    array_size = MAX_TERRAIN_DATA
   
    open "..\dat\new_terrain.txt" for input as #ff
   
    'dump "new_init_terrain()"
   
    dim as integer array_index
    dim as string scan_string
    do
        line input #1, scan_string
        scan_string = trim( scan_string )
        if len( scan_string ) and left( scan_string, 1 ) <> "#" then
            array_index = new_split_string( scan_string, array_size )
            if array_index > 0 then
                new_parse_terrain( array_index )
            end if
        end if       
    loop until eof( ff )
   
    close #ff
   
    test_terrain()
   
    dump "... terrain types initialized"
   
end sub



private sub new_parse_terrain _
    ( _
        byval _words as integer _
    )
   
    static cur_template_name as string
    static cur_template_index as integer
   
'    dump "new_parse_terrain()"
'   
'    dump "...parsing " & _words & " words."   
'    dump "...cur_temp:" & cur_template_index
'    dump "...cur_terrain :" & cur_template_name
   
'    dim as integer count
'    for count = 1 to _words
'        dump "..." & get_parse_array_val( count )
'    next
   
    dim as string _name
    _name = get_parse_array_val( 1 )
   
    ' ///////////////////////////////
   
    ' Start processing a new template
   
    ' ///////////////////////////////
    if left( _name, 1 ) = "[" then
       
        ' /////////////////////////////////////////////////////
       
        ' Start parsing the next template
        ' Strip leading '[' and trailing ']' from template name
       
        ' /////////////////////////////////////////////////////
        dim as integer lenname
        dim as string tempname
        lenname = len( _name )
        tempname = left( _name, lenname - 1 )
        tempname = right( tempname, lenname - 2 )
       
        cur_template_index += 1
        set_number_of_terrain_types( cur_template_index )
        set_terrain_stat( cur_template_index, TERRAIN_INDEX, _
                          cur_template_index )
       
        cur_template_name = tempname
        set_terrain_name( cur_template_index, tempname )
       
'        dump "...init template " & cur_template_index & ", " & _
'              get_terrain_name( cur_template_index )

    ' //////////////////////////////////
   
    ' Add data to template if any to add
   
    ' //////////////////////////////////
    elseif len( _name ) then
       
        ' ////////////////////////////
       
        ' Add data to current template
       
        ' ////////////////////////////
       
      '  dump "... parsing " & _name & " values."
       
        dim as string _value
        _value = get_parse_array_val( 2 )
               
        select case _name
       
        case "COL"
            dim as string temp_color
            temp_color = _value
            'dump "...using color :" & temp_color
           
            dim as integer color_val
            color_val = new_parse_color_word( temp_color )
           
            set_terrain_stat( cur_template_index, TERRAIN_COLOR, _
                              color_val )
           
        case "SYM"
            set_terrain_stat( cur_template_index, TERRAIN_SYMBOL, _
                              asc( _value ) )
           
        case "MOV"
           
            'dump "...MOV value = " & _value
           
            dim as integer move_val
           
            select case _value
           
            case "BLOCK_MOVE"
                ' BLOCK_MOVE is dependant on map.bi
                move_val = BLOCK_MOVE
               
            case "ALLOW_MOVE"
                ' ALLOW_MOVE is dependant on map.bi
                move_val = ALLOW_MOVE
               
            case else
                dump "WARNING : Invalid MOV value"
                dump "... new_parse_terrain(): terrain.bas"
                dump "...index    :" & cur_template_index
                dump "...template :" & cur_template_name
                dump "...MOV:" & _value
               
            end select
           
            set_terrain_stat( cur_template_index, TERRAIN_MOVE, move_val )
           
        case "OBS"
            dim as integer sightval
           
            select case _value
           
            case "BLOCK_LIGHT"
                ' BLOCK_MOVE is dependant on map.bi
                sightval = BLOCK_LIGHT
               
            case "ALLOW_LIGHT"
                ' ALLOW_MOVE is dependant on map.bi
                sightval = ALLOW_LIGHT
               
            case else
                dump "WARNING:Invalid OBS value"
                dump "... new_parse_terrain():terrain.bas"
                dump "... index    :" & cur_template_index
                dump "... template :" & cur_template_name
                dump "... OBS:" & _value

            end select
           
            set_terrain_stat( cur_template_index, TERRAIN_OPACITY, _
                              sightval )

        case else
            dump "WARNING:Invalid name"
            dump "... new_parse_terrain():terrain.bas"
            dump "... index    :" & cur_template_index
            dump "... template :" & cur_template_name
            dump "... name (" & _name & ")"
            sleep: end

        end select
    else
        dump "...empty array processed"
    end if
       
end sub



sub dump_terrain_types _
    ( _
    )
   
    dim as integer tempint, _temps, tempcolor
    tempint = get_number_of_terrain_types()
    dump tempint & " total terrain types."
    dim as string t_str
    for _temps = 1 to tempint
        dump ""
        dump "NAME   :" & get_terrain_name( _temps )
        dump "INDEX  :" & get_terrain_stat( _temps, TERRAIN_INDEX   )
       
        t_str = get_map_cell_flag_name( _
                get_terrain_stat( _temps, TERRAIN_MOVE ))
        dump "MOVE   :" & t_str
       
        t_str = get_map_cell_flag_name( _
                get_terrain_stat( _temps, TERRAIN_OPACITY ))
        dump "OPACITY:" & t_str
       
        dump "COLOR  :" & get_terrain_stat( _temps, TERRAIN_COLOR   )
        dump "SYMBOL :" & chr(get_terrain_stat( _temps, TERRAIN_SYMBOL  ))
    next
   
end sub



function get_terrain_type_index _
    ( _
        byref ter_name as string _
    ) as integer
   
    dim as integer num_ter
    num_ter = get_number_of_terrain_types
   
    ' look through terrain name array for match
    dim as integer count
    dim as string test_name
    for count = 1 to num_ter
        test_name = get_terrain_name ( count )
        if test_name = ter_name then
            ' return matching index
            return count
        end if
    next
   
    ' throw an error
    dump "ERROR: No matching terrain index found"
    dump "... terrain name (" &  ter_name & ")"
    dump "... get_terrain_type_index():terrain.bas"
    sleep
    end
   
end function


(edit: fix error)
rdc
Posts: 1725
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Postby rdc » May 06, 2011 1:56

I'll work up an example using your data file. It might give you some ideas on what is possible.
rdc
Posts: 1725
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Postby rdc » May 06, 2011 19:07

Here is a little example of what I was talking about:

Code: Select all

'This example loads a terrain data file into a class object that can be quieried for information
'about a specific terrain type.


Namespace iTerrain

Const FALSE = 0 'Make these Const so they will be scoped.
Const TRUE = Not FALSE
Const NULL = 0
Const WHITESPACE = Chr(32) & Chr(9)

'Terrian ids.
Enum tids
   GRASS = 1
   DIRT
   FLOOR
   WATER
   TREE
   SCRUB
   WALL
   OPEN_DOOR
   CLOSED_DOOR
End Enum
'Color numbers.
Enum cids
   BLACK
   BLUE
   GREEN
   CYAN
   RED
   MAGENTA
   BROWN
   WHITE
   GRAY
   BRIGHT_BLUE
   BRIGHT_GREEN
   BRIGHT_CYAN
   BRIGHT_RED
   PINK
   YELLOW
   BRIGHT_WHITE
End Enum
'Movement types.
Enum mids
   ALLOW_MOVE
   BLOCK_MOVE
End Enum
'Light types.
Enum lids
   ALLOW_LIGHT
   BLOCK_LIGHT
End Enum

'The terrain type information.
Type tInfo
   trTID As tids          'Terrain types.
   trDesc As String * 15  'Terrain description.
   trColor As cids        'Color numbers.
   trSymbol As String * 1 'Symbol.
   trMove As mids         'Movement.
   trLight As lids        'Light.
End Type

'Terrain class.
Type tTerrain
   Private:
   trCnt As Integer         'The number of items in the pointer array.
   trInfo As tInfo Ptr      'The lookup list of terrain data.
   Declare Sub ClearData () 'Deallocates any data and clean up class.
   Public:
   Declare Constructor ()
   Declare Destructor ()
   Declare Function LoadData (fname As String) As Integer 'Returns TRUE if data loaded fine.
   Declare Function GetData(tid As tids, ti As tInfo) As Integer 'Return TRUE if data found.
End Type

'Deallocates any data and cleans up class.
Sub tTerrain.ClearData ()
   If trInfo <> NULL Then
      DeAllocate trInfo
      trInfo = NULL
   EndIf
End Sub

'Inits the data field.
Constructor tTerrain ()
   ClearData
End Constructor

'Cleans up the class.
Destructor tTerrain ()
   ClearData
End Destructor
'Returns TRUE if data loaded fine.
Function tTerrain.LoadData (fname As String) As Integer
   Dim datlist() As String 'The data in the file, minus the comments.
   Dim As Integer ret = TRUE, fh, cnt, chk
   Dim As String ln, itm, value
   Dim tmpptr As iTerrain.tInfo Ptr 'Used in Reallocate.
   
   'Initialzise the working arrays.
   ReDim datlist(0 To 0)
   'Attempt to open the dat file.
   fh = FreeFile
   If Open(fname For Input As #fh) =  0 Then
      'Load the dat file into an array since it will be much faster.
      Do While Not Eof(fh)
         'Get the next line.
         Line Input #fh, ln
         ln = Trim(ln, Any WHITESPACE)
         'Skip empty lines.
         If Len(ln) > 0 Then
            'Check for comment.
            If Mid(ln, 1, 1) <> "#" Then
               cnt += 1
               ReDim Preserve datlist(0 To cnt)
               ln = UCase(ln)
               datlist(cnt) = ln
            EndIf
         End If
      Loop
      Close
      'Load the data for each section.
      cnt = 0
      'Get the terrain names, i.e. GRASS.
      For i As Integer = 1 To UBound(datlist)
         'Look for section header.
         If InStr(datlist(i), "[") > 0 Then
            'Found section. Expand the the pointer array.
            cnt += 1
            tmpptr = ReAllocate(trInfo, cnt * SizeOf(tInfo))
            'Make sure we have a valid pointer.
            If tmpptr = NULL Then
               'Just exit since we can't go on.
               Print "Could not allocate memory."
               Return ret
            Else
               'Everything is fine, so set the new pointer.
               trInfo = tmpptr
               'Set the new count.
               trCnt = cnt
               'Get the terrain id based on the section name.
               If InStr(datlist(i), "GRASS") > 0 Then
                  'Pointer arrays are zero based.
                  trInfo[trCnt - 1].trTID = GRASS
                  trInfo[trCnt - 1].trDesc = "GRASS"
               ElseIf InStr(datlist(i), "DIRT") > 0 Then
                  trInfo[trCnt - 1].trTID = DIRT
                  trInfo[trCnt - 1].trDesc = "DIRT"
               ElseIf InStr(datlist(i), "FLOOR") > 0 Then
                  trInfo[trCnt - 1].trTID = FLOOR
                  trInfo[trCnt - 1].trDesc = "FLOOR"
               ElseIf InStr(datlist(i), "WATER") > 0 Then
                  trInfo[trCnt - 1].trTID = WATER
                  trInfo[trCnt - 1].trDesc = "WATER"
               ElseIf InStr(datlist(i), "TREE") > 0 Then
                  trInfo[trCnt - 1].trTID = TREE
                  trInfo[trCnt - 1].trDesc = "TREE"
               ElseIf InStr(datlist(i), "SCRUB") > 0 Then
                  trInfo[trCnt - 1].trTID = SCRUB
                  trInfo[trCnt - 1].trDesc = "SCRUB"
               ElseIf InStr(datlist(i), "WALL") > 0 Then
                  trInfo[trCnt - 1].trTID = WALL
                  trInfo[trCnt - 1].trDesc = "WALL"
               ElseIf InStr(datlist(i), "OPEN_DOOR") > 0 Then
                  trInfo[trCnt - 1].trTID = OPEN_DOOR
                  trInfo[trCnt - 1].trDesc = "OPEN DOOR"
               ElseIf InStr(datlist(i), "CLOSED_DOOR") > 0 Then
                  trInfo[trCnt - 1].trTID = CLOSED_DOOR
                  trInfo[trCnt - 1].trDesc = "CLOSED DOOR"
               EndIf
               'Get each data item under the section.
               For j As Integer = i + 1 To UBound(datlist)
                  'If we are at the next section then exit.
                  If InStr(datlist(j), "[") > 0 Then
                     Exit For
                  EndIf
                  'Look for data item name, such as 'COL'.
                  If InStr(datlist(j), "COL") > 0 Then
                     'Look for the color names.
                     If InStr(datlist(j), "BLACK") > 0 Then
                        trInfo[trCnt - 1].trColor = BLACK
                     ElseIf InStr(datlist(j), "BLUE") > 0 Then
                        trInfo[trCnt - 1].trColor = BLUE
                     ElseIf InStr(datlist(j), "GREEN") > 0 Then
                        trInfo[trCnt - 1].trColor = GREEN
                     ElseIf InStr(datlist(j), "CYAN") > 0 Then
                        trInfo[trCnt - 1].trColor = CYAN
                     ElseIf InStr(datlist(j), "RED") > 0 Then
                        trInfo[trCnt - 1].trColor = RED
                     ElseIf InStr(datlist(j), "MAGENTA") > 0 Then
                        trInfo[trCnt - 1].trColor = MAGENTA
                     ElseIf InStr(datlist(j), "BROWN") > 0 Then
                        trInfo[trCnt - 1].trColor = BROWN
                     ElseIf InStr(datlist(j), "WHITE") > 0 Then
                        trInfo[trCnt - 1].trColor = WHITE
                     ElseIf InStr(datlist(j), "GRAY") > 0 Then
                        trInfo[trCnt - 1].trColor = GRAY
                     ElseIf InStr(datlist(j), "BRIGHT_BLUE") > 0 Then
                        trInfo[trCnt - 1].trColor = BRIGHT_BLUE
                     ElseIf InStr(datlist(j), "BRIGHT_GREEN") > 0 Then
                        trInfo[trCnt - 1].trColor = BRIGHT_GREEN
                     ElseIf InStr(datlist(j), "BRIGHT_CYAN") > 0 Then
                        trInfo[trCnt - 1].trColor = BRIGHT_CYAN
                     ElseIf InStr(datlist(j), "BRIGHT_RED") > 0 Then
                        trInfo[trCnt - 1].trColor = BRIGHT_RED
                     ElseIf InStr(datlist(j), "PINK") > 0 Then
                        trInfo[trCnt - 1].trColor = PINK
                     ElseIf InStr(datlist(j), "BRIGHT_WHITE") > 0 Then
                        trInfo[trCnt - 1].trColor = BRIGHT_WHITE
                     EndIf
                  'Look for the movement item.
                  ElseIf InStr(datlist(j), "MOV") > 0 Then
                     'Get the movement data.
                  If InStr(datlist(j), "ALLOW_MOVE") > 0 Then
                        trInfo[trCnt - 1].trMove = ALLOW_MOVE
                     ElseIf InStr(datlist(j), "BLOCK_MOVE") > 0 Then
                        trInfo[trCnt - 1].trMove = BLOCK_MOVE
                     End If
                  'Look for the light item.
                  ElseIf InStr(datlist(j), "OBS") > 0 Then
                     'Get the light data.
                     If InStr(datlist(j), "ALLOW_LIGHT") > 0 Then
                        trInfo[trCnt - 1].trLight = ALLOW_LIGHT
                     ElseIf InStr(datlist(j), "BLOCK_LIGHT") > 0 Then
                        trInfo[trCnt - 1].trLight = BLOCK_LIGHT
                     End If
                  'Look for the symbol item.
                  ElseIf InStr(datlist(j), "SYM") > 0 Then
                     'Get the symbol data.
                     chk = InStr(datlist(j), ":")
                     If chk > 1 And chk < Len(datlist(j)) Then
                        trInfo[trCnt - 1].trSymbol = Trim(Mid(datlist(j), chk + 1), Any WHITESPACE)
                     End If
                  EndIf
               Next
            EndIf
         EndIf
      Next         
   Else
      Print "Could not open file " & fname & "."
      ret = FALSE
   EndIf
   
   Return ret
End Function

'Looks for id in pointer array. Returns TRUE if cound, FALSE if not.
Function tTerrain.GetData(tid As tids, ti As tInfo) As Integer
   Dim As Integer ret = FALSE
   
   'Iterate through pointer array.
   For i As Integer = 0 To trCnt - 1
      'Look for matching ID.
      If trInfo[i].trTID = tid Then
         ret = TRUE
         ti = trInfo[i]
         Exit For
      EndIf
   Next
   
   Return ret
End Function

End Namespace

'Scope the class.
Sub Main
   Dim myTC As iTerrain.tTerrain 'Class object,
   Dim trInfo As iTerrain.tInfo 'Terrain info type.
   Dim As Integer ret 'Return value.
   
   ret = myTC.LoadData("terrain.dat")   
   'Look for each terrain type and get the data for it.
   For i As iTerrain.tids = iTerrain.tids.GRASS To iTerrain.tids.CLOSED_DOOR
      ret = myTC.GetData(i, trInfo)
      If ret = iTerrain.FALSE Then
         Print "Could not get data for id " & i & "."
      Else
         Print "Desc: " & trInfo.trDesc
         Print "ID: " & trInfo.trTID
         Print "Color: " & trInfo.trColor
         Print "Symbol: " & trInfo.trSymbol
         Print "Move: " & trInfo.trMove
         Print "Light: " & trInfo.trLight
         Print ""
      EndIf
   Next
   
End Sub

Main
Sleep


This parses the data in the dat file and then loads the information into a pointer array in the class. You can then query the class about a certain terrain type and get all the info associated with the terrain.

This type of object needs to be global since when it goes out of scope, it will automatically delete all the information in the pointer array.
elsairon
Posts: 207
Joined: Jul 02, 2005 14:51

Postby elsairon » May 06, 2011 20:03

rdc wrote:Here is a little example of what I was talking about:


Thanks rdc. I will see what I can learn from this. :)

(edit) I really appreciate your sharing this, I am studying your example carefully.

Return to “General”

Who is online

Users browsing this forum: No registered users and 2 guests