1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
# -*- tcl -*-
# # ## ### ##### ######## #############
# (C) 2009 Andreas Kupries
# @@ Meta Begin
# Package tcl::transform::spacer 1
# Meta as::author {Andreas Kupries}
# Meta as::copyright 2009
# Meta as::license BSD
# Meta description Implementation of a spacer
# Meta description transformation, using Tcl 8.6's
# Meta description transformation reflection support. Uses
# Meta description counters to implement the transformation,
# Meta description i.e. decide where to insert the spacing.
# Meta description Exports a single command adding a new
# Meta description transform of this type to a channel. One
# Meta description argument, the channel to extend. No
# Meta description result.
# Meta platform tcl
# Meta require tcl::transform::core
# Meta require {Tcl 8.6}
# @@ Meta End
# # ## ### ##### ######## #############
package require Tcl 8.6
package require tcl::transform::core
# # ## ### ##### ######## #############
namespace eval ::tcl::transform {}
proc ::tcl::transform::spacer {chan n {space { }}} {
::chan push $chan [spacer::implementation new $n $space]
return
}
oo::class create ::tcl::transform::spacer::implementation {
superclass tcl::transform::core ;# -> initialize, finalize, destructor
# This transformation is intended for streaming operation. Seeking
# the channel while it is active may cause undesirable
# output. Proper behaviour may require the destruction of the
# transform before seeking.
method write {c data} {
# add spacing, data is split into groups of delta chars.
set result {}
set len [string length $data]
if {$woffset} {
# The beginning of the buffer is the remainder of the
# partial group found at the end of the buffer in the last
# call. It may still be partial, if the current buffer is
# short enough.
if {($woffset + $len) < $delta} {
# Yes, the group is still not fully covered.
# Move the offset forward, and return the whole
# buffer. spacing is not needed yet.
incr woffset $len
return $data
}
# The buffer completes the group. Add it and the following
# spacing, then fix the offset to start the processing of
# the groups coming after at the proper location.
set stop [expr {$delta - $woffset - 1}]
append result [string range $data 0 $stop]
append result $spacing
set woffset $stop
incr woffset
}
# Process full groups in the middle of the incoming buffer.
set at $woffset
set stop [expr {$at + $delta - 1}]
while {$stop < $len} {
append result [string range $data $at $stop]
append result $spacing
incr at $delta
incr stop $delta
}
# Process partial group at the end of the buffer and remember
# the offset, for the processing of the group remainder in the
# next call.
if {($at < $len) && ($stop >= $len)} {
append result [string range $data $at end]
}
set woffset [expr {$len - $at}]
return $result
}
method read {c data} {
# remove spacing from groups of delta+sdelta chars, keeping
# the first delta in each group.
set result {}
set iter [expr {$delta + $sdelta}]
set at 0
if {$roffset} {
if {$roffset < $delta} {
append result [string range $data 0 ${roffset}-1]
}
incr at [expr {$iter - $roffset}]
}
set len [string length $data]
set end [expr {$at + $delta - 1}]
set stop [expr {$at + $iter - 1}]
while {$stop < $len} {
append result [string range $data $at $end]
incr at $iter
incr end $iter
incr stop $iter
}
if {$end < $len} {
append result [string range $data $at $end]
set roffset [expr {$len - $end + 1}]
} elseif {$at < $len} {
append result [string range $data $at end]
set roffset [expr {$len - $at}]
}
return [list $result $roffset]
}
# # ## ### ##### ######## #############
constructor {n space} {
set roffset 0
set woffset 0
set delta $n
set spacing $space
set sdelta [string length $spacing]
return
}
# # ## ### ##### ######## #############
variable roffset woffset delta spacing sdelta
# # ## ### ##### ######## #############
}
# # ## ### ##### ######## #############
package provide tcl::transform::spacer 1
return
|
