[agtk-devel] tcl wrapper to aglib

[Claude B. <Cla...@li...>]

Hi folks,

I have started playing with the Tcl interface to aglib.

I have a few comments/requests/etc.:

* it exits immediately as soon as any kind of error
  is detected. It should be possible to propagate an
  error message to the Tcl client without stopping the
  process in many cases (except perhaps when an inconsistency
  of the internal data is detected)

  Else some error checking may be performed at Tcl level, eg:

  proc AG2_CreateAnnotation {id anchorId1 anchorId2 annotationType} {
    if {[ExistsAnnotation $id]} {
      error "Annotation '$id' already exists"
    }
    if {![ExistsAnchor $anchorId1]} { error "Anchor '$anchorId1' does not exist" }
    if {![ExistsAnchor $anchorId2]} { error "Anchor '$anchorId2' does not exist" }
    return [AG_CreateAnnotation $id $anchorId1 $anchorId2 $annotationType]
  }

* an inconsistency does not seem to be detected in following case:

   CreateAnnotation a n1 n2
   DeleteAnchor n1
  => n1 remains referenced in annotation a
  (delete op should have been forbidden)

* in the IDL specs, there seems to be some redundancy between 
   DeleteFeature vs. UnsetFeature ?
  (or else I may have forgotten their difference...)

* a function like "GetAnnotationType" seems to be lacking?

* there seems to be no way to see the difference between an unset
  offset and one set to -1; should we assume that no negative offset
  will be used? else there should be something like "HasOffset anchorId"

* in the ag.tcl there is a small typo for a $epsilon becoming $spsilon



As an application, I put below a piece of Tcl code checking that
an AG is indeed an acyclic, correctly oriented, anchored graph.
(here, unset offset is checked through -1 value)

Best,
  Claude


##########################################################

  # Check that a whole graph is well-formed:
  #   right temporal order of anchors, no loop.
  # Raise an error in case of loop or wrong temporal order.
  proc CheckAG {agId} {
    # For each anchor, we compute its left and right boundaries
    # recursively and store the result in an array.
    # As a side effect, loops are detected in this step.
    # Both arrays are reused as a cache for subsequent searchs,
    # so we don't parse the same arcs twice in the same direction.
    foreach id [AG_GetAnnotationSeqByOffset $agId 0.0 0.0] {
      # Get offset of start anchor or lower boundary instead
      set start [AG_GetStartAnchor $id]
      set l [AG_GetAnchorOffset $start]
      if {$l == -1} {
        set l [anchorBoundary $start "lower" left]
      }
      # Get offset of end anchor or upper boundary instead
      set end [AG_GetEndAnchor $id]
      set r [AG_GetAnchorOffset $end]
      if {$r == -1} {
        set r [anchorBoundary $end "upper" right]
      }
      # Check order of start/end anchor
      if {$end != $start && $l != -1 && $r != -1 && $l >= $r} {
        error "Wrong temporal order of start/end anchors for annotation $id"
      }
    }
  }

  # Returns nearest temporal boundary of $id anchor in $dir (upper or lower) direction
  proc anchorBoundary {id dir {arrayNam ""} {stack ""}} {
    # Prevent circular lock and multiple loops
    if {$arrayNam != ""} {
      upvar $arrayNam cycl
    }
    if {[info exists cycl($id)]} {
      if {[lsearch -exact $stack $id] >= 0} {
        error "Loop detected within graph (back to anchor $id)"
      }
      return $cycl($id)
    } else {
      set cycl($id) ""
      lappend stack $id
    }
    # Adjust direction of search
    if {$dir == "upper"} {
      set lst [AG_GetOutgoingAnnotationSet $id]
      set flag "AG_GetEndAnchor"
      set comp ">"
    } else {
      set lst [AG_GetIncomingAnnotationSet $id]
      set flag "AG_GetStartAnchor"
      set comp "<"
    }
    # Recursive search of the nearest timed anchor
    set nearest ""
    foreach arc $lst {
      set node [$flag $arc]
      if {$node == $id} continue
      set off [AG_GetAnchorOffset $node]
      if {$off == -1} {
        set off [anchorBoundary $node $dir cycl $stack]
      }
      if {$nearest == "" || ($off != -1 && [expr $nearest $comp $off])} {
        set nearest $off
      }
    }
    set cycl($id) $nearest
    if {$nearest == ""} {
      error "No $dir boundary found for '$id'"
    }
    return $nearest
  }