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

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

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

Post by elsairon »

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: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

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

Post by elsairon »

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: 1741
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Post by rdc »

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

Post by elsairon »

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: 1741
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Post by rdc »

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

Post by rdc »

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

Post by elsairon »

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.
Post Reply