Tcl Source Code

Artifact 008554a8e0888976f735da15d08ce7853e14da3c:

Attachment "tst_chan.tcl" to ticket [1904907fff] added by schwarzkopf 2008-03-01 02:38:05.

---

lappend auto_path .teapot/repository/package/linux-glibc2.3-x86_64/lib
lappend auto_path /opt/ActiveTcl-8.5/lib
#package require Memchan

set contents [string repeat "this is a tring to test on\n" 1000]

namespace eval ::vchan {

    variable chans
    variable idx
    variable basemap

    set basemap(start) 0
    set basemap(end) 0
    set basemap(current) 0

    proc initialize {chan mode} {
        variable chans
        variable idx

        set chans($chan) ""
        set idx($chan) 0

        return [list initialize finalize watch read write seek]
    }

    proc finalize {chan} {
        variable chans
        variable idx

        unset chans($chan)
        unset idx($chan)

        return
    }

    proc watch {chan eventspec} {
    }

    proc read {chan count} {

        variable idx
        variable chans

        set len [string length $chans($chan)]
        if {$count > $len} {
            set idx($chan) $len
            return $chans($chan)
        }
        set idx($chan) $count
        return [string range $chans($chan) $idx($chan) ${count}-1]
    }

    proc write {chan data} {
        variable idx
        variable chans

        ## probably should start at idx
        append chans($chan) $data
        #set idx($chan) [string length $chans($chan)]

        return
    }

    proc seek {chan offset {base start}} {
        variable idx
        variable basemap
        variable chans

        set basemap(current) $idx($chan)
        set basemap(end) [string length $chans($chan)]

        set idx($chan) [expr {$basemap($base) + $offset}]
 
        if {$idx($chan) > $basemap(end)} {
            set idx($chan) $basemap(end)
        }

        return [return $idx($chan)]
    }

    namespace ensemble create
    namespace export initialize finalize read write seek watch
}

#set chan create 

set fid [chan create {r w} ::vchan]

chan puts $fid "HELLO THERE"
#chan seek $fid 0 start
set data [read $fid]
#catch {chan close $fid}

#set fid2 [open junkit.txt w+]
#chan puts $fid2 "THIS IS JUNK"
#set data [read $fid2]