This implementation of the Marching Box Algorithm makes use of some clever programming for code readability, however it may not be inherently easy to read for beginners, but it is a good example of how to implement an algorithm such as this one, in a clean way.

It may not be the fastest implementation but this code has served me well in the past and it turns out to be quite easy to maintain as well.

The primary application is to traverse for example bitmaps, you could implement a bucket fill or follow a contour easily, however more patterns may be required depending on your requirements.

I’ve used this, among with a peucker implementation, to create rough vector representations of bitmaps in the past. You may have to add exclusions or rules if you don’t want to check the extra 4 directions in diagonal, this depends on the type of images or data you’ll be working with.

EnableExplicit

Enumeration
	#MARCHING_BOX_PATTERN_A
	#MARCHING_BOX_PATTERN_B
	#MARCHING_BOX_PATTERN_C
	#MARCHING_BOX_PATTERN_D
EndEnumeration

Enumeration
	#MARCHING_BOX_ADD
	#MARCHING_BOX_SUB
EndEnumeration

Structure MARCHING_BOX_PATTERN
	field.i[4] 								; holds the pattern variables.
	*variable.Integer 						; variable we'll manipulate if the pattern matches.
	operator.i 								; flat to either increment or decrement on actual *variable
EndStructure

Structure MARCHING_BOX
	List pattern.MARCHING_BOX_PATTERN()
EndStructure

Declare.i marchingbox_create( *tx.Integer, *ty.Integer, *foreground.Integer, *background.Integer )
Declare.i marchingbox_destroy( *this.MARCHING_BOX )
Declare.i marchingbox_pattern_add( *this.MARCHING_BOX, *a.Integer, *b.Integer, *c.Integer, *d.Integer, *variable.Integer, operator.i )
Declare.i marchingbox_pattern_matches( *this.MARCHING_BOX_PATTERN, a.i, b.i, c.i, d.i )

Procedure.i marchingbox_create( *tx.Integer, *ty.Integer, *foreground.Integer, *background.Integer )
	
	Define.MARCHING_BOX *this = AllocateMemory( SizeOf(MARCHING_BOX) )
	If *this
		InitializeStructure( *this, MARCHING_BOX )
		
		marchingbox_pattern_add( *this, *foreground, *foreground, *foreground, *foreground, *tx, #MARCHING_BOX_ADD )
		marchingbox_pattern_add( *this, *foreground, *background, *foreground, *foreground, *tx, #MARCHING_BOX_ADD )
		marchingbox_pattern_add( *this, *foreground, *background, *foreground, *background, *ty, #MARCHING_BOX_ADD )
		marchingbox_pattern_add( *this, *foreground, *foreground, *foreground, *background, *ty, #MARCHING_BOX_ADD )
		
		marchingbox_pattern_add( *this, *background, *background, *foreground, *foreground, *tx, #MARCHING_BOX_ADD )
		marchingbox_pattern_add( *this, *background, *foreground, *foreground, *foreground, *ty, #MARCHING_BOX_SUB )
		marchingbox_pattern_add( *this, *background, *foreground, *background, *foreground, *ty, #MARCHING_BOX_SUB )
		marchingbox_pattern_add( *this, *foreground, *foreground, *background, *foreground, *tx, #MARCHING_BOX_SUB )
		
		marchingbox_pattern_add( *this, *foreground, *foreground, *background, *background, *tx, #MARCHING_BOX_SUB )
		marchingbox_pattern_add( *this, *background, *foreground, *background, *background, *ty, #MARCHING_BOX_SUB )			
		marchingbox_pattern_add( *this, *foreground, *background, *background, *background, *tx, #MARCHING_BOX_SUB )
		marchingbox_pattern_add( *this, *background, *background, *foreground, *background, *ty, #MARCHING_BOX_ADD )
		
		marchingbox_pattern_add( *this, *background, *background, *background, *foreground, *tx, #MARCHING_BOX_ADD )
		marchingbox_pattern_add( *this, *background, *foreground, *foreground, *background, *ty, #MARCHING_BOX_SUB )
		marchingbox_pattern_add( *this, *foreground, *background, *background, *foreground, *tx, #MARCHING_BOX_SUB )
		marchingbox_pattern_add( *this, *background, *background, *background, *background, #Null, #Null )
		
		ProcedureReturn *this
	EndIf

EndProcedure

Procedure.i marchingbox_destroy( *this.MARCHING_BOX )

	If *this
		ClearStructure( *this, MARCHING_BOX )
		ProcedureReturn FreeMemory(*this)
	EndIf

EndProcedure

Procedure.i marchingbox_pattern_add( *this.MARCHING_BOX, *a.Integer, *b.Integer, *c.Integer, *d.Integer, *variable.Integer, operator.i )
	
	If *this
		If AddElement( *this\pattern() )
			
			*this\pattern()\field[ #MARCHING_BOX_PATTERN_A ] 	= *a\i
			*this\pattern()\field[ #MARCHING_BOX_PATTERN_B ] 	= *b\i
			*this\pattern()\field[ #MARCHING_BOX_PATTERN_C ] 	= *c\i
			*this\pattern()\field[ #MARCHING_BOX_PATTERN_D ] 	= *d\i
			*this\pattern()\variable 													= *variable
			*this\pattern()\operator 													= operator
			
		EndIf
	EndIf
	
EndProcedure

Procedure.i marchingbox_pattern_matches( *this.MARCHING_BOX_PATTERN, a.i, b.i, c.i, d.i )
	
	If *this
		If *this\variable <> #Null
			If *this\field[ #MARCHING_BOX_PATTERN_A ] = a
				If *this\field[ #MARCHING_BOX_PATTERN_B ] = b
					If *this\field[ #MARCHING_BOX_PATTERN_C ] = c
						If *this\field[ #MARCHING_BOX_PATTERN_D ] = d
							
							Select *this\operator
								Case #MARCHING_BOX_ADD
									*this\variable\i + 1
								Case #MARCHING_BOX_SUB
									*this\variable\i - 1
								Default
									ProcedureReturn #False
							EndSelect
							
							ProcedureReturn #True
							
						EndIf
					EndIf
				EndIf
			EndIf
		EndIf
	EndIf
	
EndProcedure

 
Probable optimizations include denesting and less error checking on the match procedure for the release version, however that’s also implementation dependent.

This original implementation was aimed toward image manipulation, hence you’ll notice some variable names aren’t generic, but relevant to the subject. You may change this as you please.

At any rate, enjoy!

Cheers,
Gus

Intro:

Here’s a small but useful io function, The basic routine is also included for less demanding uses.

This function will read a text file into a string, the Ex (extended) functionality allows for defining size constraints to the return string and positioning of the file pointer for location/seeking purposes.

On big text files and in cases where you want to limit memory usage, this is a very useful routine. Otherwise the basic function works just fine.

The extended routine can also be used with a callback to set a progress bar, based on data size you can also calculate the remaining time, however that’s all beyond the scope of this post.

Code:

Procedure.s FileToStringEx( FileName.s, Flags.i = #PB_Default, NewLineCharacter.s = #CRLF$, LimitSize.i = #PB_Ignore, BeginPosition.i = #PB_Ignore, BufferSize.i = 4096 )
	
	If (FileName)
		
		Define.s ReturnString = ""
		
		Define.i fp = ReadFile( #PB_Any, FileName )
		If IsFile(fp)
			
			If BufferSize > 0
				FileBuffersSize( fp, BufferSize )
			EndIf
			
			If BeginPosition <> #PB_Ignore
				FileSeek( fp, BeginPosition )
			EndIf
			
			While Not Eof(fp)
				
				ReturnString + ReadString( fp, Flags, LimitSize ) + NewLineCharacter
				
				If LimitSize <> #PB_Ignore
					If Len(ReturnString) => LimitSize
						Break
					EndIf
				EndIf
				
			Wend
			
			CloseFile(fp)
		EndIf
		
		ProcedureReturn ReturnString
		
	EndIf
	
EndProcedure

Procedure.s FileToString( FileName.s, NewLineCharacter.s = #CRLF$, BufferSize = 4096 )
	
	If (FileName)
		
		Define.s ReturnString = ""
		
		Define.i fp = ReadFile( #PB_Any, FileName )
		If IsFile(fp)
			FileBuffersSize( fp, BufferSize )
			While Not Eof(fp)
				ReturnString + ReadString( fp ) + NewLineCharacter
			Wend
			CloseFile(fp)
		EndIf
		
		ProcedureReturn ReturnString
		
	EndIf
	
EndProcedure

Use example:

Define.s ResultingString = ""
ResultingString = FileToStringEx( "data.txt", #PB_Ascii, #CRLF$, 100, 0 ) ; read 100 characters from position 0, read as ascii, use CRLF, from data.txt.
Debug ResultingString

Keep in mind that with the basic routine the whole file will be read into memory, so you have to beware of this detail.

If you never expect file sizes to exceed a certain range, this won’t be an issue. Otherwise use the Ex function to prevent memory and other performance related issues.

If the file is not found the return string is empty, this is the expected behavior, no error codes are used but you can easily implement this.

Have fun!

Let the strippin’ begin!

This is a basic implementation of PHP’s strip_tags() for PureBasic, it’s not fully optimized but it’s fast enough for most applications. It doesn’t use native string manipulation functions, instead it parses through each character of the string.

Naturally it’s going to be faster than using REGEXP, but not as flexible. Lots of room for improvement, but for now it is what it is!

Procedure.s strip_tags( *szInput.character)
	Define.s szOutput
	
	If (*szInput)
				
		Repeat
			
			If (*szInput\c = '< ')
				;Strip markup tags (completely)
				Repeat
					;-ToDo: add support for selective tag stripping!
					*szInput + SizeOf(CHARACTER)
				Until *szInput\c = '>'
				
			Else
				
				;Not a tag?, process for entities or send to output directly
				Define.c ThisCharacter = *szInput\c
				Select ThisCharacter
					Case '&' ;Entity
						*szInput + SizeOf(CHARACTER)
						If *szInput\c = '#'
							*szInput + SizeOf(CHARACTER)
							Define.s szEntity
							Repeat
								szEntity + Chr(*szInput\c)
								*szInput + SizeOf(CHARACTER)
							Until *szInput\c = ';'
							szOutput + Chr(Val(szEntity))
						EndIf
					Default
						szOutput + Chr( ThisCharacter )
				EndSelect
				
			EndIf
			
			*szInput + SizeOf(CHARACTER)
		Until *szInput\c = #Null
		ProcedureReturn (szOutput)
		
	EndIf
	
EndProcedure

Simple use example:

Define.s test = "
Test paragraph.
 Other text"

Debug test
Debug strip_tags(@test)

Got any ideas on how to improve this?, let me know!

Enjoy,
Gus

Sometimes plain text needs to be formatted in non common ways. In this case we’ve got filenames where spaces have been converted to either “-” or “_” and each word may or may not be capitalized. The idea is to have a certain degree of uniformity on the user interface so the labels are formatted to meet these requirements.

One of the steps involved is to simply capitalize every word in the string. In this case we are also recovering the space characters prior to formatting.

We don’t know if the first character is part of a word or if it’s just a space, due to the actual requirements of this application multiple spaces are ignored and trimmed to a single instance.

To avoid using multiple string manipulation function calls, we handle all of the manipulation through low level code (without going into ASM). This way we avoid the use of Trim(), LCase(), Mid(), Left(), Right(), etc. To speed things up.

Procedure.s CapitalizeString( StringInput.s )
	
	Define.Character *ptr = @StringInput
	Define.s ReturnString = ""
	
	If *ptr
		Define.i flag_firstchar = #False
		Repeat
			
			If *ptr\c = ' ' And Not flag_firstchar ; in case the first character is a space, let's trim it.
				*ptr + SizeOf(Character)
			EndIf
			
			If *ptr\c => 'A' And *ptr\c < = 'Z' ; lower case everything
				*ptr\c + 32
			EndIf
			
			If Not flag_firstchar
				flag_firstchar = #True
				ReturnString + Chr(*ptr\c - 32)
				*ptr + SizeOf(Character)
			EndIf
			
			If *ptr\c = ' '
				flag_firstchar = #False
			EndIf
			
			ReturnString + Chr(*ptr\c)
			*ptr + SizeOf(Character)
			
		Until *ptr\c = #Null
	EndIf	
	
	ProcedureReturn ReturnString
	
EndProcedure

The routine is quite simple and allows for all kinds of modifications, since we are performing all of the string manipulation ourselves. We assume ASCII to be the input and output.

That's all for now, just had a need for this and couldn't find a proper function out there (only a "let's see who can make it faster and forget about readability" war at the official forums, not very handy for real world projects).

Have fun,
Cheers!

When dealing with string maps, being able to easily load them from a file is a must. For example take language files for different local translations. The simplest, cleanest format would be CSV. The ideal data structure? — A hash map.

While trivial, this code will come in handy for many other things!

EnableExplicit
#CSV_QUOTE 	= "'"
#CSV_SEPARATOR 	= ","

Procedure IsEvenNumber(N)
   ProcedureReturn ( 1 - 1 & N )
EndProcedure
 
Procedure IsOddNumber(N)
   ProcedureReturn ( 1 & N )
EndProcedure 

Procedure.s RemoveQuotes( String.s )
	
	If Left(String, 1) = #CSV_QUOTE
		String = Mid( String, 2 )
	EndIf
	If Right(String, 1) = #CSV_QUOTE
		String = Left( String, Len(String) - 1 )
	EndIf
	
	ProcedureReturn String
EndProcedure

Procedure.i LoadStringMap( FileName.s, Map StringMap.s() )
	; escaping of quotes is currently not supported
	; if an uneven number of quotes is found on a line, the line is ignored.
	
	Define.i fp = ReadFile( #PB_Any, FileName )
	If IsFile(fp)
		
		While Not Eof(fp)
			
			Define.s line = Trim(ReadString( fp ))
			If line
				If CountString( line, #CSV_SEPARATOR ) => 1
					
					Define.i quote_count = CountString( line, #CSV_QUOTE )
					If IsEvenNumber( quote_count )
						
						Define.s key		= RemoveQuotes( StringField( line, 2, #CSV_QUOTE ) ) 
						Define.s content	= RemoveQuotes( StringField( line, 4, #CSV_QUOTE ) )
						
						StringMap( key ) 	= content
						
					EndIf
					
				EndIf
			EndIf
			
		Wend
		
		CloseFile(fp)
		ProcedureReturn MapSize( StringMap() )
	EndIf
	
EndProcedure

Example of data:

'Update', 'Actualizar'
'Databases', 'Bases de datos'
'Program', 'Programa'
'Options', 'Opciones'
'Export', 'Exportar'

Example of use:

NewMap spanish.s()
LoadStringMap( "locale/spanish.csv", spanish() )

ForEach spanish()
	
	Debug MapKey(spanish())
	Debug spanish()
	
Next

Couldn’t be easier!
Cheers.