Type Implementations

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 ;
              }
          }
      }
 }

Category Object Orientation