Updated 2012-04-27 03:33:06 by RLE

This page has some type implementations in the framework mentioned in OO libraries.

Summary
stream
an abstract type.

The subtypes of this type need to provide the implementations for open, close, read, seek, tell. It presently provides foreach implementation.
 foreach - foreach <obj> <picked_item> <block to act on picked item>
dir
is a subtype of type stream. Provides a stream abstraction of dir. Provides open, close, read, seek, tell methods.
tell
gives present position.
seek
moves the position.
read
item in present position and position is advanced.

Usage
 dir create a /tmp # object creation
 > read a          # reads the current item in the stream
 > foreach a item { puts $item }  # foreach is the iterator for the stream items.

Modified proc ">"
 proc > { args } {
  set obj [lindex $args 1 ]
  upvar $obj myobj
   set handler $myobj(handler)
   set myobj(level) [ expr [info level] - 1 ]
   lvarpop args 1
   lvarpush args myobj 1
   $handler  $args
 }

Type implementations:

Dir - type
 package require Tclx
 proc dir { args } {
    if {! [ string equal [lindex $args 0] create ] } {
     set args [lindex $args 0] 
    }
    set ref [lindex $args 1 ]
    set action [lindex $args 0]
    upvar  $ref myref
    switch $action {
          create {
              array set myref [list handler dir]
              array set myref [list dir [lindex $args 2 ]]
              array set myref [list items [ glob $myref(dir)/* ] ]
              array set myref [list position -1 ]
          }
          open {
              array set myref [list position -1 ]
          } 
          read {
              set pres_elem {}
              set max_position [ expr [llength $myref(items)] - 1 ]
              if { $myref(position) < $max_position } {
                  incr myref(position)
                  set pres_elem  [ lindex $myref(items) $myref(position) ]
              }
              return $pres_elem
          } 
          seek {
              set index [lindex $args 2 ]
              if  {$index <  [ llength $myref(items)]} {
                  array set myref [list position [lindex $args 2] ]        
              }
          } 
          tell {
              return $myref(position)
          }
          close {
              array set myref [list position -1 ]        
          }
          default {
             lvarpop args 1 
             lvarpush args  myref 1
             set myargs  $args 
             stream $myargs
          }
      }

 }

Stream - type
 proc stream { myargs } {
  set args $myargs
  set ref [lindex $args 1 ]
  set action [lindex $args 0]
  upvar  $ref myref
  set handler $myref(handler)

  switch $action \
      foreach {
          $handler {open myref}   
          while 1  {
              set item [ $handler {read myref} ]
              if { $item != {} } {
                  upvar $myref(level) [lindex $args 2 ] elem
                  set elem $item
                  uplevel $myref(level) [lindex $args 3 ]
              } else {
                  break ;
              }
          }
      }
 }