SXML (Simple XML parser)

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
paul doe
Posts: 922
Joined: Jul 25, 2017 17:22
Location: Argentina

SXML (Simple XML parser)

Postby paul doe » Mar 01, 2019 0:33

While I was working on my entry for Lachie's competition, I coded a simple XML parser that somebody could also find useful. It's pretty barebones, but gets the job done (mostly). All it does is parse the file into a representation that can be used directly with FreeBasic. It can be found here:

https://github.com/glasyalabolas/fb-sxml

Having this little snippet allows me to use some vector graphics program (such as Inkscape) to edit levels for games, instead of having to code my own (yay!):

Image

It can be used to entirely data-drive your apps/games, use path data from SVG files to render vectorial graphics, and many other applications. I provided two SVG files to test the parser, but please test it with other files to see if they are parsed correctly (it parses all of the SVG/XML files I have on my system, but...)

Report any mishaps so I can promptly correct them. Thanks.
Last edited by paul doe on Mar 19, 2019 22:43, edited 1 time in total.
badidea
Posts: 1545
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: SXML (Simple XML parser)

Postby badidea » Mar 01, 2019 9:05

That looks like a very useful tool. Can you also render the SVG-files in FreeBASIC, or is that still work in progress?

Two small remarks:
* content = SXML.loadFile( "data/SmallWorld-all.svg" ) should be content = SXML.loadFile( "SmallWorld-all.svg" )
* I get a lot of these warnings (fbc 1.0.5): sxml-parser.bi(319) warning 38(0): Mixing operand data types may have undefined results

Also, can't Cairo (https://en.wikipedia.org/wiki/Cairo_(graphics)) be used to load and draw SVG-files?
paul doe
Posts: 922
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: SXML (Simple XML parser)

Postby paul doe » Mar 01, 2019 10:01

badidea wrote:That looks like a very useful tool. Can you also render the SVG-files in FreeBASIC, or is that still work in progress?

Yes, you can. However, all this code does is parsing the XML file into a data structure (a linked list). I'll show a more useful implementation later (that uses some hashed list, so you can either iterate the document like in the example or access elements/attributes by ID). This is just a little snippet, so consider it a 'proof of concept' at this stage =D
badidea wrote:Two small remarks:
* content = SXML.loadFile( "data/SmallWorld-all.svg" ) should be content = SXML.loadFile( "SmallWorld-all.svg" )

Oh, I forgot that. Well spotted, thanks.
badidea wrote:* I get a lot of these warnings (fbc 1.0.5): sxml-parser.bi(319) warning 38(0): Mixing operand data types may have undefined results

These warnings aren't displayed anymore in fbc 1.0.6 (the expression is evaluated as it should). This happens when you do something like this:

Code: Select all

dim as integer _
  a = 2, b = 3
dim as boolean _
  c = true

if( _
  a > b andAlso c = true ) then
  '' Whatever
end if

In versions prior to 1.06.0, you had to express it like this instead:

Code: Select all

/' ... '/

if( _
  cbool( a > b ) andAlso c = true ) then
  '' Whatever
end if

badidea wrote:Also, can't Cairo (https://en.wikipedia.org/wiki/Cairo_(graphics)) be used to load and draw SVG-files?

Nope. Cairo just concerns itself with rendering, it doesn't provide any functionality to load SVG files. Also, you need to implement the rendering backend yourself, using Cairo primitives to perform the drawing to a surface, which isn't so trivial a task. As soon as I can, I'll post some implementation that uses Cairo to render a SVG to a plain fb.image buffer that you can then blit to the screen or another buffer as usual.
paul doe
Posts: 922
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: SXML (Simple XML parser)

Postby paul doe » Mar 03, 2019 5:20

Ok, I updated the repo now. Provided is a simple object-oriented interface that is pretty easy to use. In sxml-example-2.bas there's an example of how to use it. As usual, any bugs/report, any questions/ask. Now, on to the SVG renderer...
TheRaven
Posts: 10
Joined: Mar 09, 2019 18:42

Re: SXML (Simple XML parser)

Postby TheRaven » Mar 09, 2019 18:59

Awesome stuff.
Kind of a big fan of XML myself --its benefits start to show when utilized in larger projects, naught so much in the smaller possibly obscuring the technology's greater importance. Good to see it's getting some face time in the FreeBASIC user group. Good work.
paul doe
Posts: 922
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: SXML (Simple XML parser)

Postby paul doe » Mar 19, 2019 22:53

TheRaven wrote:Awesome stuff.
Kind of a big fan of XML myself --its benefits start to show when utilized in larger projects, naught so much in the smaller possibly obscuring the technology's greater importance. Good to see it's getting some face time in the FreeBASIC user group. Good work.

Thanks, glad you liked it.

Indeed, XML is a pretty cool (if a little verbose) way to data-drive your apps, and the possibilities are virtually limitless. Of course, as you state, the app has to be somewhat sizable, if not you're just killing ants with a sledgehammer ;)

I'm busy right now coding a SVG rendering backend that uses this code as a base. As soon as I have it ready, I'll post it here too (since I've updated the SXML a little also), and I'll show some really cool things you can do with XML using this code, such as data-drive your games/apps, and even embed your own code/scripting language/GLSL within XML elements.
TheRaven
Posts: 10
Joined: Mar 09, 2019 18:42

Re: SXML (Simple XML parser)

Postby TheRaven » Apr 09, 2019 14:18

Awesome!
Also a fan of SVG --it will be the future as the W3C inferred back in the late 90s to early 2Ks, espcially since UHD and the like are starting to proliferate. Also believe SVG should inherit the web as the new web-page succeeding html5 (kind of advocate SVG).

XML can be verbose, but with parsers supporting XSLT it becomes really awesome really fast.

Glad to hear that your kicking some XML butt and rocking an SVG parser; been thinking about doing the same since WPF fell out. I really like the visage of WPF (XAML), there was also MXML (Adobe/Apache Flex) and a little bit of Glade UI offering up inspiration too.

Looking forward to hearing about your successes; best in in things to you!
paul doe
Posts: 922
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: SXML (Simple XML parser)

Postby paul doe » Apr 09, 2019 20:12

TheRaven wrote:Awesome!
Also a fan of SVG --it will be the future as the W3C inferred back in the late 90s to early 2Ks, espcially since UHD and the like are starting to proliferate. Also believe SVG should inherit the web as the new web-page succeeding html5 (kind of advocate SVG).
...

Yes, SVG is pretty cool. It's getting a little complex but I think the direction is going is fine. With some of the new functionality (like vector effects) it's also useful for a lot of tasks, not only vectorial drawings. However, the syntax is too lax for my taste and should be stricter (like JSON), otherwise the parsing will become a nightmare very soon (it already is, to some extent).
TheRaven wrote:...
XML can be verbose, but with parsers supporting XSLT it becomes really awesome really fast.

Glad to hear that your kicking some XML butt and rocking an SVG parser; been thinking about doing the same since WPF fell out. I really like the visage of WPF (XAML), there was also MXML (Adobe/Apache Flex) and a little bit of Glade UI offering up inspiration too.

Indeed, I've been eyeballing XAML and I think it's pretty cool. It also fits in nicely with my primary interest (game development). For UI/UX, it's awesome (Microsoft Fluent, anyone? =D)

I've decided to code it in native FreeBasic because, well, there's no solution for SVG in FreeBasic at the moment, and as you say, it's super useful to have. Think about it: scripting, rendering and data description, all in the same package ;)
TheRaven wrote:...
Looking forward to hearing about your successes; best in in things to you!

Thank you very much for your kind words. So, stay tuned! I'll post an update soon enough ;)
Tourist Trap
Posts: 2768
Joined: Jun 02, 2015 16:24

Re: SXML (Simple XML parser)

Postby Tourist Trap » Apr 10, 2019 19:14

Hi all, hi Paul,

I find your work very great. I may someday learn from it to go somewhere with some small project of mine where I try to parse some xml in order to make a viewer. Here it is, and as you see it's not good. This way however, by doing myself, I feel more apt to detect superior effort when it comes into sight :)

Code: Select all

 '(this below is only a preview for setting concept up)

'*******************************************************
'simple attempt for an xml-like file viewer in freebasic
'*******************************************************
'___please set the file location for your local disk____
'_______________________________________________________
#define _logFile  _ 
      "D:/TEMP/ERR/err1.txt"

'* program will then:
'- copy the file into a string array
'- define a convenient user defined type
'- parse the file and make it an array of the udt
'- demonstrate the concept of the graphical viewer


'-------------------------------------------------------
#include "fbgfx.bi"

dim as double startTime   = TIMER
screenRes 800, 500, 32, 1, fb.GFX_NO_FRAME
color , rgb(100,100,080)
cls

print ">reading file: "; _logFile

'                                     read the text file
'-------------------------------------------------------
dim as integer f => freeFile()
open _logFile for input as #f
   '
   dim as integer index => -1
   dim as string stringLine(any)
   while not eof(f)
      index += 1
      redim preserve stringLine(uBound(stringLine) + 1)
      input #f, stringLine(index)
      'trim no more useful indentation space
      stringLine(index) = trim(stringLine(index))
   wend
   '
close #f
'--> stringLine() array now holds the text file content
'--> index is the string line total number in the array

print ">..done"
print ">creating infoblock object"

'      define a type implementing an xml-like data block
'-------------------------------------------------------
type INFOBLOCK
      as string         _tagName
      as string         _textContent(any)
      as integer         _startLineIndex
      as integer         _endLineIndex
      as integer         _hierarchyLevel
      as integer         _childrenNodeCount
      as INFOBLOCK ptr   _childrenNodeRefArray(any)
end type 'INFOBLOCK

'      parse the stringLine array for INFOBLOCK building
'-------------------------------------------------------
dim as INFOBLOCK   infoBlockArray(any)
dim as integer       hierarchyLevel

for i as integer = 0 to index
   'test if stringLine is a tag and behave accordingly
   select case left(stringLine(i), 1)
      case "<"
         select case mid(stringLine(i), 2, 1)
            case "!"
               'should be a comment tag
               '
            case "/"
               'should be an ending block tag
               hierarchyLevel -= 1
               'retrieve the infoBlock item index
               dim as integer j = uBound(infoBlockArray)
               while j>0 and infoBlockArray(j)._endLineIndex<>-1
                  j -= 1
               wend
               'fill other fields about the block
               infoBlockArray(j)._endLineIndex = i
               infoBlockArray(j)._childrenNodeCount = uBound(infoBlockArray) - j
               redim as INFOBLOCK ptr _ 
               (infoBlockArray(j)._childrenNodeRefArray)( _ 
                                               infoBlockArray(j)._endLineIndex - _ 
                                               infoBlockArray(j)._startLineIndex + _ 
                                               1 _ 
                                               )
               for k as integer = j to j + infoBlockArray(j)._childrenNodeCount
                  infoBlockArray(j)._childrenNodeRefArray(k - j) = @infoBlockArray(k)
               next k
               'retrieve now what should be the encapsulated text
               redim (infoBlockArray(j)._textContent)(0)
               infoBlockArray(j)._textContent(0) = "(no text content)"
               '
               dim as INFOBLOCK ptr hLevelPlus1SubnodeArray(any)
               for k as integer = 0 to infoBlockArray(j)._childrenNodeCount
                  if infoBlockArray(j)._childrenNodeRefArray(k)->_hierarchyLevel<>_ 
                              (infoBlockArray(j)._hierarchyLevel + 1) then continue for
                  redim preserve _ 
                  hLevelPlus1SubnodeArray(uBound(hLevelPlus1SubnodeArray) + 1)
                  hLevelPlus1SubnodeArray(uBound(hLevelPlus1SubnodeArray)) = _ 
                                    infoBlockArray(j)._childrenNodeRefArray(k)
               next k
               '
               dim as integer textIntervalStartLine   => _ 
                              infoBlockArray(j)._startLineIndex
               dim as integer textIntervalEndLine      => _ 
                              infoBlockArray(j)._endLineIndex
               if uBound(hLevelPlus1SubnodeArray)=-1 then
                  redim preserve _ 
                     (infoBlockArray(j)._textContent)( _ 
                                              uBound(infoBlockArray(j)._textContent) - _ 
                                              1 + _ 
                                              textIntervalEndLine - _
                                              textIntervalStartLine _
                                              )
                  for n as integer = 1 to textIntervalEndLine - textIntervalStartLine - 1
                     infoBlockArray(j)._textContent(n - 1) = stringLine(textIntervalStartLine + n)
                  next n                  
                  exit select
               end if
               '
               for k as integer = 0 to uBound(hLevelPlus1SubnodeArray)
                  textIntervalEndLine = hLevelPlus1SubnodeArray(k)->_startLineIndex
                  redim preserve _ 
                  (infoBlockArray(j)._textContent)( _ 
                                           uBound(infoBlockArray(j)._textContent) - _
                                           1 + _ 
                                           textIntervalEndLine - _
                                           textIntervalStartLine _
                                           )
                  for n as integer = 1 to textIntervalEndLine - textIntervalStartLine - 1
                     infoBlockArray(j)._textContent(uBound(infoBlockArray(j)._textContent) + n - 2) = _ 
                                                   stringLine(textIntervalStartLine + n)
                  next n
                  textIntervalStartLine = hLevelPlus1SubnodeArray(k)->_endLineIndex
               next k
               textIntervalEndLine = infoBlockArray(j)._endLineIndex
               redim preserve _
               (infoBlockArray(j)._textContent)( _ 
                                        uBound(infoBlockArray(j)._textContent) - _
                                        1 + _ 
                                        textIntervalEndLine - _
                                        textIntervalStartLine _
                                        )
               for n as integer = 1 to textIntervalEndLine - textIntervalStartLine - 1
                  infoBlockArray(j)._textContent(uBound(infoBlockArray(j)._textContent) + n - 2) = _ 
                                                stringLine(textIntervalStartLine + n)
               next n               
               '
            case else               
               'should be a starting block tag
               hierarchyLevel += 1
               'retrieve the block tagName
               redim preserve infoBlockArray(uBound(infoBlockArray) + 1)
               infoBlockArray(uBound(infoBlockArray))._tagName = _ 
                  mid(stringLine(i), 2, inStr(stringLine(i),">") - 2)
               'fill other fields about the block
               with infoBlockArray(uBound(infoBlockArray))
                  ._hierarchyLevel = hierarchyLevel
                  ._startLineIndex = i
                  ._endLineIndex = -1
               end with 'infoBlockArray(uBound(infoBlockArray))
               '
         end select 'mid(stringLine(i), 2, 1)
   end select 'left(stringLine(i), 1)
next i

print ">..done"
print ">creating infobox object"

'                      graphical display initial setting
'-------------------------------------------------------
'note: this is rather in a messy state from here
'      (maybe even more than the previous part) 
'      works enough yet to prove the concept    

type INFOBOX
   declare constructor()
   declare constructor(byval as INFOBLOCK ptr, _ 
                  byval as integer, _ 
                  byval as integer)
   declare function FillHierarchyPlusOneRefArray() as integer
   declare static sub AddInfoBoxRefArray(() as INFOBOX ptr)
   declare sub MarkChildrenDrawable()
   declare sub UnMarkChildrenDrawable()
   declare sub TestInfoBox()
   declare sub DrawInfoBox()
      as integer         _hierarchyLevel
      as INFOBLOCK ptr   _infoBlockPtr
      as integer         _topLeftCornerX
      as integer         _topLeftCornerY
      as integer         _boxWidth
      as integer         _boxHeigth
      as integer         _hierarchyLevelPlusOneInfoBlockCount
      as INFOBLOCK ptr   _levelPlusOneInfoBlockRefArray(any)
      as integer         _miniBtnX
      as integer         _miniBtnY
      as integer         _miniBtnW
      as integer         _miniBtnH
      as double         _lastClickedTime
      as boolean         _mouseOver
      as boolean         _mouseClick
      as boolean         _isUnfold
      as boolean         _isToDraw
   static as INFOBOX ptr   infoBoxRefArray(any)
end type 'INFOBOX
dim as INFOBOX ptr   INFOBOX.infoBoxRefArray(any)

constructor INFOBOX()
   ' this constructor doesn't really serve us; just here because
   ' using REDIM with INFOBOX() (asfaik) requires the default 
   ' constructor if a non-default constructor stands aside
   with THIS
      ._infoBlockPtr      => 0
      ._hierarchyLevel   => 1
      ._hierarchyLevelPlusOneInfoBlockCount => -1
      'redim (._levelPlusOneInfoBlockRefArray)(0)
      ._topLeftCornerX   => 10
      ._topLeftCornerY   => 10
      ._boxWidth         => 250
      ._boxHeigth         => 25
      ._miniBtnX         => ._topLeftCornerX + ._boxWidth - 15
      ._miniBtnY         => ._topLeftCornerY + ._boxHeigth - 15
      ._miniBtnW         => 10
      ._miniBtnH         => 10
      ._lastClickedTime   => 0
      ._mouseOver         => FALSE
      ._mouseClick      => FALSE
      ._isUnfold         => FALSE
      ._isToDraw         => FALSE
   end with 'THIS
end constructor 'INFOBOX default constructor
constructor INFOBOX(byval IB   as INFOBLOCK ptr, _ 
               byval TLCX   as integer, _ 
               byval TLCY   as integer)
   with THIS
      ._infoBlockPtr      => IB
      ._hierarchyLevel   => IB->_hierarchyLevel
      ._hierarchyLevelPlusOneInfoBlockCount => .FillHierarchyPlusOneRefArray()
      ._topLeftCornerX   => TLCX
      ._topLeftCornerY   => TLCY
      dim as integer maxTextLength = len(IB->_tagName)
      for i as integer = 0 to uBound(IB->_textContent) - 1
         if len(IB->_textContent(i))>maxTextLength then maxTextLength = len(IB->_textContent(i))
      next i
      ._boxWidth         => maxTextLength*8 + 122
      ._boxHeigth         => iif((uBound(IB->_textContent) + 1)*8>25, _ 
                           (uBound(IB->_textContent) + 1)*8, _ 
                           25)
      ._miniBtnX         => ._topLeftCornerX + ._boxWidth - 15
      ._miniBtnY         => ._topLeftCornerY + ._boxHeigth - 15
      ._miniBtnW         => 10
      ._miniBtnH         => 10
      ._lastClickedTime   => 0
      ._mouseOver         => FALSE
      ._mouseClick      => FALSE
      ._isUnfold         => FALSE
      ._isToDraw         => FALSE
   end with 'THIS
end constructor 'INFOBOX(valINFOBLOCK_PTR,{valINT}*2)
function INFOBOX.FillHierarchyPlusOneRefArray() as integer
   dim as integer counter = -1
   for i as integer = 1 to THIS._infoBlockPtr->_childrenNodeCount
      'note: do not use uBound(_childrenNodeRefArray)
      '      use _childrenNodeCount as the equivalent
      '  or, unexpected miscounting is to be expected
      if THIS._infoBlockPtr->_childrenNodeRefArray(i)->_hierarchyLevel=_ 
                                 (THIS._hierarchyLevel + 1) then
         counter += 1
         redim preserve (THIS._levelPlusOneInfoBlockRefArray)(counter)
         THIS._levelPlusOneInfoBlockRefArray(counter) = _ 
                     THIS._infoBlockPtr->_childrenNodeRefArray(i)
      end if
   next i
   '---->
   return counter
end function 'INT:=INFOBOX.FillHierarchyPlusOneRefArray()
sub INFOBOX.AddInfoBoxRefArray(IBXRef() as INFOBOX ptr)
   redim as INFOBOX ptr INFOBOX.infoBoxRefArray(uBound(IBXRef))
paul doe
Posts: 922
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: SXML (Simple XML parser)

Postby paul doe » Apr 10, 2019 20:49

Hi, Tourist Trap

Well, thanks, glad you found it useful. Yes, reinventing some wheels by yourself is always a pretty enlightening experience ;) You're coding a viewer for what? Just the XML structure, or some other data?
Tourist Trap
Posts: 2768
Joined: Jun 02, 2015 16:24

Re: SXML (Simple XML parser)

Postby Tourist Trap » Apr 13, 2019 12:53

paul doe wrote:You're coding a viewer for what? Just the XML structure, or some other data?

Hi Paul,

I tried this in order to be able to separate the xml decoration from the data content. If you read a xml file, even with syntax highlighting it's uggly. With some effort we can still keep the xml strucure visible (hierarchical levels of the data are important and reflected in the xml structure) and, nonetheless, we could have the data well hihglighted in some more appealing fashion than usual.
That's what I was thinking of mainly. It's not really about xml, I prefer geojson for what I really may need in my life, and it's quite different. But I have to start with something and xml looks more widespread than Json too.

Here is the full version of the above snippet, something went wrong last time in coying:

Code: Select all

'(this below is only a preview for setting concept up)

'*******************************************************
'simple attempt for an xml-like file viewer in freebasic
'*******************************************************
'___please set the file location for your local disk____
'_______________________________________________________
#define _logFile  _
      "D:/TEMP/ERR/err1.txt"      ''change this one to try parse something (in general this wont go very far...)

'* program will then:
'- copy the file into a string array
'- define a convenient user defined type
'- parse the file and make it an array of the udt
'- demonstrate the concept of the graphical viewer


'-------------------------------------------------------
#include "fbgfx.bi"

dim as double startTime   = TIMER
screenRes 800, 500, 32, 1, fb.GFX_NO_FRAME
color , rgb(100,100,080)
cls

print ">reading file: "; _logFile

'                                     read the text file
'-------------------------------------------------------
dim as integer f => freeFile()
open _logFile for input as #f
   '
   dim as integer index => -1
   dim as string stringLine(any)
   while not eof(f)
      index += 1
      redim preserve stringLine(uBound(stringLine) + 1)
      input #f, stringLine(index)
      'trim no more useful indentation space
      stringLine(index) = trim(stringLine(index))
   wend
   '
close #f
'--> stringLine() array now holds the text file content
'--> index is the string line total number in the array

print ">..done"
print ">creating infoblock object"

'      define a type implementing an xml-like data block
'-------------------------------------------------------
type INFOBLOCK
      as string         _tagName
      as string         _textContent(any)
      as integer         _startLineIndex
      as integer         _endLineIndex
      as integer         _hierarchyLevel
      as integer         _childrenNodeCount
      as INFOBLOCK ptr   _childrenNodeRefArray(any)
end type 'INFOBLOCK

'      parse the stringLine array for INFOBLOCK building
'-------------------------------------------------------
dim as INFOBLOCK   infoBlockArray(any)
dim as integer       hierarchyLevel

for i as integer = 0 to index
   'test if stringLine is a tag and behave accordingly
   select case left(stringLine(i), 1)
      case "<"
         select case mid(stringLine(i), 2, 1)
            case "!"
               'should be a comment tag
               '
            case "/"
               'should be an ending block tag
               hierarchyLevel -= 1
               'retrieve the infoBlock item index
               dim as integer j = uBound(infoBlockArray)
               while j>0 and infoBlockArray(j)._endLineIndex<>-1
                  j -= 1
               wend
               'fill other fields about the block
               infoBlockArray(j)._endLineIndex = i
               infoBlockArray(j)._childrenNodeCount = uBound(infoBlockArray) - j
               redim as INFOBLOCK ptr _
               (infoBlockArray(j)._childrenNodeRefArray)( _
                                               infoBlockArray(j)._endLineIndex - _
                                               infoBlockArray(j)._startLineIndex + _
                                               1 _
                                               )
               for k as integer = j to j + infoBlockArray(j)._childrenNodeCount
                  infoBlockArray(j)._childrenNodeRefArray(k - j) = @infoBlockArray(k)
               next k
               'retrieve now what should be the encapsulated text
               redim (infoBlockArray(j)._textContent)(0)
               infoBlockArray(j)._textContent(0) = "(no text content)"
               '
               dim as INFOBLOCK ptr hLevelPlus1SubnodeArray(any)
               for k as integer = 0 to infoBlockArray(j)._childrenNodeCount
                  if infoBlockArray(j)._childrenNodeRefArray(k)->_hierarchyLevel<>_
                              (infoBlockArray(j)._hierarchyLevel + 1) then continue for
                  redim preserve _
                  hLevelPlus1SubnodeArray(uBound(hLevelPlus1SubnodeArray) + 1)
                  hLevelPlus1SubnodeArray(uBound(hLevelPlus1SubnodeArray)) = _
                                    infoBlockArray(j)._childrenNodeRefArray(k)
               next k
               '
               dim as integer textIntervalStartLine   => _
                              infoBlockArray(j)._startLineIndex
               dim as integer textIntervalEndLine      => _
                              infoBlockArray(j)._endLineIndex
               if uBound(hLevelPlus1SubnodeArray)=-1 then
                  redim preserve _
                     (infoBlockArray(j)._textContent)( _
                                              uBound(infoBlockArray(j)._textContent) - _
                                              1 + _
                                              textIntervalEndLine - _
                                              textIntervalStartLine _
                                              )
                  for n as integer = 1 to textIntervalEndLine - textIntervalStartLine - 1
                     infoBlockArray(j)._textContent(n - 1) = stringLine(textIntervalStartLine + n)
                  next n                 
                  exit select
               end if
               '
               for k as integer = 0 to uBound(hLevelPlus1SubnodeArray)
                  textIntervalEndLine = hLevelPlus1SubnodeArray(k)->_startLineIndex
                  redim preserve _
                  (infoBlockArray(j)._textContent)( _
                                           uBound(infoBlockArray(j)._textContent) - _
                                           1 + _
                                           textIntervalEndLine - _
                                           textIntervalStartLine _
                                           )
                  for n as integer = 1 to textIntervalEndLine - textIntervalStartLine - 1
                     infoBlockArray(j)._textContent(uBound(infoBlockArray(j)._textContent) + n - 2) = _
                                                   stringLine(textIntervalStartLine + n)
                  next n
                  textIntervalStartLine = hLevelPlus1SubnodeArray(k)->_endLineIndex
               next k
               textIntervalEndLine = infoBlockArray(j)._endLineIndex
               redim preserve _
               (infoBlockArray(j)._textContent)( _
                                        uBound(infoBlockArray(j)._textContent) - _
                                        1 + _
                                        textIntervalEndLine - _
                                        textIntervalStartLine _
                                        )
               for n as integer = 1 to textIntervalEndLine - textIntervalStartLine - 1
                  infoBlockArray(j)._textContent(uBound(infoBlockArray(j)._textContent) + n - 2) = _
                                                stringLine(textIntervalStartLine + n)
               next n               
               '
            case else               
               'should be a starting block tag
               hierarchyLevel += 1
               'retrieve the block tagName
               redim preserve infoBlockArray(uBound(infoBlockArray) + 1)
               infoBlockArray(uBound(infoBlockArray))._tagName = _
                  mid(stringLine(i), 2, inStr(stringLine(i),">") - 2)
               'fill other fields about the block
               with infoBlockArray(uBound(infoBlockArray))
                  ._hierarchyLevel = hierarchyLevel
                  ._startLineIndex = i
                  ._endLineIndex = -1
               end with 'infoBlockArray(uBound(infoBlockArray))
               '
         end select 'mid(stringLine(i), 2, 1)
   end select 'left(stringLine(i), 1)
next i

print ">..done"
print ">creating infobox object"

'                      graphical display initial setting
'-------------------------------------------------------
'note: this is rather in a messy state from here
'      (maybe even more than the previous part)
'      works enough yet to prove the concept   

type INFOBOX
   declare constructor()
   declare constructor(byval as INFOBLOCK ptr, _
                  byval as integer, _
                  byval as integer)
   declare function FillHierarchyPlusOneRefArray() as integer
   declare static sub AddInfoBoxRefArray(() as INFOBOX ptr)
   declare sub MarkChildrenDrawable()
   declare sub UnMarkChildrenDrawable()
   declare sub TestInfoBox()
   declare sub DrawInfoBox()
      as integer         _hierarchyLevel
      as INFOBLOCK ptr   _infoBlockPtr
      as integer         _topLeftCornerX
      as integer         _topLeftCornerY
      as integer         _boxWidth
      as integer         _boxHeigth
      as integer         _hierarchyLevelPlusOneInfoBlockCount
      as INFOBLOCK ptr   _levelPlusOneInfoBlockRefArray(any)
      as integer         _miniBtnX
      as integer         _miniBtnY
      as integer         _miniBtnW
      as integer         _miniBtnH
      as double         _lastClickedTime
      as boolean         _mouseOver
      as boolean         _mouseClick
      as boolean         _isUnfold
      as boolean         _isToDraw
   static as INFOBOX ptr   infoBoxRefArray(any)
end type 'INFOBOX
dim as INFOBOX ptr   INFOBOX.infoBoxRefArray(any)

constructor INFOBOX()
   ' this constructor doesn't really serve us; just here because
   ' using REDIM with INFOBOX() (asfaik) requires the default
   ' constructor if a non-default constructor stands aside
   with THIS
      ._infoBlockPtr      => 0
      ._hierarchyLevel   => 1
      ._hierarchyLevelPlusOneInfoBlockCount => -1
      'redim (._levelPlusOneInfoBlockRefArray)(0)
      ._topLeftCornerX   => 10
      ._topLeftCornerY   => 10
      ._boxWidth         => 250
      ._boxHeigth         => 25
      ._miniBtnX         => ._topLeftCornerX + ._boxWidth - 15
      ._miniBtnY         => ._topLeftCornerY + ._boxHeigth - 15
      ._miniBtnW         => 10
      ._miniBtnH         => 10
      ._lastClickedTime   => 0
      ._mouseOver         => FALSE
      ._mouseClick      => FALSE
      ._isUnfold         => FALSE
      ._isToDraw         => FALSE
   end with 'THIS
end constructor 'INFOBOX default constructor
constructor INFOBOX(byval IB   as INFOBLOCK ptr, _
               byval TLCX   as integer, _
               byval TLCY   as integer)
   with THIS
      ._infoBlockPtr      => IB
      ._hierarchyLevel   => IB->_hierarchyLevel
      ._hierarchyLevelPlusOneInfoBlockCount => .FillHierarchyPlusOneRefArray()
      ._topLeftCornerX   => TLCX
      ._topLeftCornerY   => TLCY
      dim as integer maxTextLength = len(IB->_tagName)
      for i as integer = 0 to uBound(IB->_textContent) - 1
         if len(IB->_textContent(i))>maxTextLength then maxTextLength = len(IB->_textContent(i))
      next i
      ._boxWidth         => maxTextLength*8 + 122
      ._boxHeigth         => iif((uBound(IB->_textContent) + 1)*8>25, _
                           (uBound(IB->_textContent) + 1)*8, _
                           25)
      ._miniBtnX         => ._topLeftCornerX + ._boxWidth - 15
      ._miniBtnY         => ._topLeftCornerY + ._boxHeigth - 15
      ._miniBtnW         => 10
      ._miniBtnH         => 10
      ._lastClickedTime   => 0
      ._mouseOver         => FALSE
      ._mouseClick      => FALSE
      ._isUnfold         => FALSE
      ._isToDraw         => FALSE
   end with 'THIS
end constructor 'INFOBOX(valINFOBLOCK_PTR,{valINT}*2)
function INFOBOX.FillHierarchyPlusOneRefArray() as integer
   dim as integer counter = -1
   for i as integer = 1 to THIS._infoBlockPtr->_childrenNodeCount
      'note: do not use uBound(_childrenNodeRefArray)
      '      use _childrenNodeCount as the equivalent
      '  or, unexpected miscounting is to be expected
      if THIS._infoBlockPtr->_childrenNodeRefArray(i)->_hierarchyLevel=_
                                 (THIS._hierarchyLevel + 1) then
         counter += 1
         redim preserve (THIS._levelPlusOneInfoBlockRefArray)(counter)
         THIS._levelPlusOneInfoBlockRefArray(counter) = _
                     THIS._infoBlockPtr->_childrenNodeRefArray(i)
      end if
   next i
   '---->
   return counter
end function 'INT:=INFOBOX.FillHierarchyPlusOneRefArray()
sub INFOBOX.AddInfoBoxRefArray(IBXRef() as INFOBOX ptr)
   redim as INFOBOX ptr INFOBOX.infoBoxRefArray(uBound(IBXRef))
   for i as integer = 0 to uBound(IBXRef)
      INFOBOX.infoBoxRefArray(i) = IBXRef(i)
   next i
end sub 'INFOBOX.AddInfoBoxRefArray()
sub INFOBOX.MarkChildrenDrawable()
   for i as integer = 0 to THIS._hierarchyLevelPlusOneInfoBlockCount
      for j as integer = 0 to uBound(INFOBOX.infoBoxRefArray)
         if THIS._levelPlusOneInfoBlockRefArray(i)=_
                        INFOBOX.infoBoxRefArray(j)->_infoBlockPtr then
            *INFOBOX.infoBoxRefArray(j)   = _
                  INFOBOX((THIS._levelPlusOneInfoBlockRefArray(i)), _
                        THIS._topLeftCornerX + THIS._boxWidth + 10, _
                        (i+1)*(THIS._topLeftCornerY + THIS._boxHeigth) + 10)
            INFOBOX.infoBoxRefArray(j)->_isToDraw = TRUE
         end if
      next j
   next i
end sub 'INFOBOX.MarkChildrenDrawable(refINFOBOX_PTR())
sub INFOBOX.UnMarkChildrenDrawable()
   'note: should take care of the in-depth recursion
   for i as integer = 0 to THIS._hierarchyLevelPlusOneInfoBlockCount
      for j as integer = 0 to uBound(INFOBOX.infoBoxRefArray)
         if THIS._levelPlusOneInfoBlockRefArray(i)=_
                        INFOBOX.infoBoxRefArray(j)->_infoBlockPtr then
            INFOBOX.infoBoxRefArray(j)->_isToDraw = FALSE
         end if
      next j
   next i
end sub 'INFOBOX.UnMarkChildrenDrawable()
sub INFOBOX.TestInfoBox()
   dim as integer   gmX, gmY, gmBtn1
   getMouse gmX, gmY, , gmBtn1
   if gmX>THIS._miniBtnX and _
      gmX<(THIS._miniBtnX + _miniBtnW) and _
      gmY>THIS._miniBtnY and _
      gmY<(THIS._miniBtnY + _miniBtnH) then
      if THIS._mouseOver=FALSE then THIS._mouseOver = TRUE
      if gmBtn1=+1 then
         if THIS._mouseClick=FALSE then THIS._mouseClick = TRUE
         if (TIMER - THIS._lastClickedTime)>.5 then
            THIS._lastClickedTime = TIMER
            THIS._isUnfold = not THIS._isUnfold
         end if
      else
         if THIS._mouseClick=TRUE then THIS._mouseClick = FALSE
      end if
   else
      if THIS._mouseOver=TRUE then THIS._mouseOver = FALSE
      if THIS._mouseClick=TRUE then THIS._mouseClick = FALSE
   end if
end sub 'INFOBOX.TestInfoBox()
sub INFOBOX.DrawInfoBox()
   THIS.TestInfoBox
   line (THIS._topLeftCornerX, THIS._topLeftCornerY)- _
       (THIS._topLeftCornerX + THIS._boxWidth, _
        THIS._topLeftCornerY + THIS._boxHeigth), _
       iif(THIS._mouseOver, rgb(200,180,140), rgb(200,190,120)), _
       bf
   draw string (THIS._topLeftCornerX, THIS._topLeftCornerY), _
            uCase(str(THIS._infoBlockPtr->_tagName)), _
            rgb(255,255,200)
   for i as integer = 0 to uBound(THIS._infoBlockPtr->_textContent)
      draw string (THIS._topLeftCornerX, i*8 + THIS._topLeftCornerY + 10), _
               str(THIS._infoBlockPtr->_textContent(i)), _
               rgb(255,255,050)   
   next i
   '
   line (THIS._miniBtnX, THIS._miniBtnY)- _
       (THIS._miniBtnX + _miniBtnW, _
        THIS._miniBtnY + _miniBtnH), _
       iif(THIS._isUnfold, rgb(200,100,100), rgb(100,000,200)), _
       bf
   if THIS._isUnfold then
      for i as integer = 0 to THIS._hierarchyLevelPlusOneInfoBlockCount
         'note: this below for debug purpose
         '? : ? : ? : ? : ? : ?
         '? i, THIS._levelPlusOneInfoBlockRefArray(i)->_tagName
      next i
      THIS.MarkChildrenDrawable()
   else
      THIS.UnMarkChildrenDrawable()
   end if
end sub 'INFOBOX.DrawInfoBox()

'-------------------------------------------------------
'make whole INFOBOX array from the global scope
dim as INFOBOX ptr   infoBoxRefArray(uBound(infoBlockArray))
for i as integer = 0 to uBound(infoBlockArray)
   infoBoxRefArray(i) => cAllocate(1, sizeOf(INFOBOX))
   *infoBoxRefArray(i) => INFOBOX(@(infoBlockArray(i)), _
                        10, _
                        10)
   if infoBlockArray(i)._hierarchyLevel=1 then _
                  infoBoxRefArray(i)->_isToDraw = TRUE
next i
INFOBOX.AddInfoBoxRefArray(infoBoxRefArray())

'-------------------------------------------------------

print ">..done"
print ">launching the viewer..."
print ">ellaped time = "; TIMER - startTime
print
print "[AWAITING KEY PRESS TO CONTINUE]"
sleep
cls

'                            graphical display main loop
'-------------------------------------------------------
do
   screenLock
   cls
   for i as integer = 0 to uBound(infoBlockArray)
      if infoBoxRefArray(i)->_isToDraw then infoBoxRefArray(i)->DrawInfoBox()
   next i
   screenUnlock
   
   sleep 15
loop until inkey=chr(27)
'/


sleep
end 0

'[EOF]

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 42 guests