1# -*- tcl -*-
2# # ## ### ##### ######## #############
3# (C) 2009 Andreas Kupries
4
5# @@ Meta Begin
6# Package tcl::chan::fifo2 1
7# Meta as::author {Andreas Kupries}
8# Meta as::copyright 2009
9# Meta as::license BSD
10# Meta as::notes   This fifo2 command does not have to
11# Meta as::notes   deal with the pesky details of
12# Meta as::notes   threading for cross-thread
13# Meta as::notes   communication. That is hidden in the
14# Meta as::notes   implementation of reflected
15# Meta as::notes   channels. It is less optimal as the
16# Meta as::notes   command provided by Memchan as this
17# Meta as::notes   fifo2 may involve three threads when
18# Meta as::notes   sending data around: The threads the
19# Meta as::notes   two endpoints are in, and the thread
20# Meta as::notes   holding this code. Memchan's C
21# Meta as::notes   implementation does not need this last
22# Meta as::notes   intermediary thread.
23# Meta description Re-implementation of Memchan's fifo2
24# Meta description channel. Based on Tcl 8.5's channel
25# Meta description reflection support. Exports a single
26# Meta description command for the creation of new
27# Meta description channels. No arguments. Result are the
28# Meta description handles of the two new channels.
29# Meta platform tcl
30# Meta require TclOO
31# Meta require tcl::chan::halfpipe
32# Meta require {Tcl 8.5}
33# @@ Meta End
34# # ## ### ##### ######## #############
35
36package require Tcl 8.5
37package require TclOO
38package require tcl::chan::halfpipe
39
40# # ## ### ##### ######## #############
41
42namespace eval ::tcl::chan {}
43
44proc ::tcl::chan::fifo2 {} {
45
46    set coordinator [fifo2::implementation new]
47
48    lassign [halfpipe \
49	       -write-command [list $coordinator froma] \
50	       -close-command [list $coordinator closeda]] \
51	a ha
52
53    lassign [halfpipe \
54	       -write-command [list $coordinator fromb] \
55	       -close-command [list $coordinator closedb]] \
56	b hb
57
58    $coordinator connect $a $ha $b $hb
59
60    return [list $a $b]
61}
62
63oo::class create ::tcl::chan::fifo2::implementation {
64    method connect {thea theha theb thehb} {
65	set a $thea
66	set b $theb
67	set ha $theha
68	set hb $thehb
69	return
70    }
71
72    method closeda {c} {
73	set a {}
74	if {$b ne {}} {
75	    close $b
76	    set b {}
77	}
78	my destroy
79	return
80    }
81
82    method closedb {c} {
83	set b {}
84	if {$a ne {}} {
85	    close $a
86	    set a {}
87	}
88	my destroy
89	return
90    }
91
92    method froma {c bytes} {
93	$hb put $bytes
94	return
95    }
96
97    method fromb {c bytes} {
98	$ha put $bytes
99	return
100    }
101
102    # # ## ### ##### ######## #############
103
104    variable a b ha hb
105
106    # # ## ### ##### ######## #############
107}
108
109# # ## ### ##### ######## #############
110package provide tcl::chan::fifo2 1
111return
112