| author | Claus Gittinger <cg@exept.de> |
| Thu, 30 Jun 2016 18:18:01 +0200 | |
| changeset 3978 | e4c47408edb2 |
| parent 3291 | facd0cfd0781 |
| child 4326 | 5aca213f1a71 |
| permissions | -rw-r--r-- |
| 1015 | 1 |
"{ Package: 'stx:libbasic2' }"
|
2 |
||
| 3978 | 3 |
"{ NameSpace: Smalltalk }"
|
4 |
||
| 1015 | 5 |
Stream subclass:#InternalPipeStream |
| 3978 | 6 |
instanceVariableNames:'queue closed contentsSpecies' |
| 1015 | 7 |
classVariableNames:'' |
8 |
poolDictionaries:'' |
|
9 |
category:'Streams' |
|
10 |
! |
|
11 |
||
| 1016 | 12 |
!InternalPipeStream class methodsFor:'documentation'! |
13 |
||
14 |
documentation |
|
15 |
" |
|
16 |
not useful on its own, but can be used to talk to a vt100 |
|
17 |
terminal view ... |
|
| 3978 | 18 |
|
| 1016 | 19 |
See example. |
20 |
" |
|
21 |
! |
|
22 |
||
23 |
examples |
|
24 |
" |
|
25 |
[exBegin] |
|
26 |
|p| |
|
27 |
||
28 |
p := InternalPipeStream new. |
|
29 |
[ |
|
30 |
10 timesRepeat:[ |
|
31 |
p nextPutLine:'hello' |
|
32 |
]. |
|
33 |
] fork. |
|
34 |
||
35 |
[ |
|
36 |
10 timesRepeat:[ |
|
37 |
Transcript showCR:p nextLine |
|
38 |
]. |
|
39 |
] fork. |
|
40 |
[exEnd] |
|
41 |
||
42 |
[exBegin] |
|
|
3291
facd0cfd0781
Fixed examples (added missing vars, dot at the end of statement)
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3128
diff
changeset
|
43 |
|userInput elizasOutput top terminal| |
| 1016 | 44 |
|
45 |
userInput := InternalPipeStream new. |
|
46 |
elizasOutput := InternalPipeStream new. |
|
47 |
||
48 |
top := StandardSystemView new. |
|
49 |
terminal := VT100TerminalView openOnInput: userInput output:elizasOutput in:top. |
|
50 |
||
51 |
top extent:(terminal preferredExtent). |
|
52 |
top label:'The doctor is in'. |
|
53 |
top iconLabel:'doctor'. |
|
54 |
top open. |
|
55 |
top waitUntilVisible. |
|
| 3978 | 56 |
top onChangeEvaluate:[:what :aParameter :changedObject | what == #destroyed ifTrue:[userInput close]]. |
| 1016 | 57 |
|
58 |
terminal translateNLToCRNL:true. |
|
59 |
terminal inputTranslateCRToNL:true. |
|
60 |
terminal localEcho:true. |
|
61 |
||
62 |
elizasOutput nextPutLine:'Hi, I am Eliza'. |
|
| 3978 | 63 |
elizasOutput nextPutLine:'What is your problem (type end to finish conversation) ?'. |
| 1016 | 64 |
elizasOutput nextPutLine:''. |
65 |
elizasOutput nextPutAll:'>'. |
|
66 |
||
67 |
[top realized] whileTrue:[ |
|
68 |
|line answer matchingRule| |
|
69 |
||
70 |
line := userInput nextLine. |
|
| 3978 | 71 |
((line isEmptyOrNil and:[userInput atEnd]) or:[ #('quit' 'exit' 'end' 'bye') includes:line ]) ifTrue:[
|
| 1016 | 72 |
top destroy. |
73 |
^ self |
|
74 |
]. |
|
75 |
||
|
3291
facd0cfd0781
Fixed examples (added missing vars, dot at the end of statement)
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3128
diff
changeset
|
76 |
answer := 'Tell me more.'. |
| 1016 | 77 |
elizasOutput nextPutLine:answer. |
78 |
elizasOutput nextPutAll:'>'. |
|
79 |
]. |
|
80 |
[exEnd] |
|
81 |
" |
|
82 |
! ! |
|
| 1015 | 83 |
|
84 |
!InternalPipeStream class methodsFor:'instance creation'! |
|
85 |
||
86 |
new |
|
87 |
^ self basicNew initialize |
|
88 |
! ! |
|
89 |
||
90 |
!InternalPipeStream methodsFor:'accessing'! |
|
91 |
||
92 |
atEnd |
|
| 3978 | 93 |
^ closed and:[queue isEmpty] |
| 1015 | 94 |
! |
95 |
||
96 |
close |
|
| 3978 | 97 |
"if there is any partner waiting at either side of the queue, |
98 |
tell it that the pipe is no longer active. |
|
99 |
(readers will read an EOF condition, writers will get a write error). |
|
100 |
Either side may close the internal pipe." |
|
101 |
||
102 |
closed := true. |
|
103 |
queue readSemaphore signalForAll |
|
104 |
! |
|
105 |
||
106 |
isOpen |
|
107 |
^ closed not |
|
| 1015 | 108 |
! |
109 |
||
110 |
next |
|
111 |
"return the next element from the stream (might block until something is written)" |
|
112 |
||
| 3978 | 113 |
(closed and:[queue isEmpty]) ifTrue:[^ self pastEndRead]. |
| 1015 | 114 |
^ queue next |
115 |
! |
|
116 |
||
117 |
nextAvailableBytes:nMax into:aBuffer startingAt:startIndex |
|
118 |
|n idx ch| |
|
119 |
||
| 3978 | 120 |
(closed and:[queue isEmpty and:[self pastEndRead isNil]]) ifTrue:[^ 0]. |
121 |
||
| 1015 | 122 |
n := 0. |
123 |
idx := startIndex. |
|
124 |
[n <= nMax] whileTrue:[ |
|
125 |
ch := queue nextIfEmpty:[^ n ]. |
|
126 |
aBuffer at:idx put:ch. |
|
127 |
idx := idx + 1. |
|
128 |
n := n + 1 |
|
129 |
]. |
|
130 |
^ n |
|
131 |
! |
|
132 |
||
| 3978 | 133 |
nextPut:anObject |
| 1015 | 134 |
"write an element (might wakeup readers)" |
135 |
||
| 3978 | 136 |
closed ifTrue:[ self errorNotOpen]. |
137 |
queue nextPut:anObject |
|
138 |
||
139 |
" |
|
140 |
|s| |
|
141 |
s := InternalPipeStream new. |
|
142 |
s nextPut:$a. |
|
143 |
s nextPut:$b. |
|
144 |
s nextPut:$c. |
|
145 |
" |
|
| 3128 | 146 |
! |
147 |
||
148 |
size |
|
149 |
^ queue size |
|
| 1015 | 150 |
! ! |
151 |
||
152 |
!InternalPipeStream methodsFor:'initialization'! |
|
153 |
||
| 3978 | 154 |
contentsSpecies:aClass |
155 |
"by default, I will return a String of elements, if reading multiple elements. |
|
156 |
However, you may change this to eg. an array, if desired" |
|
157 |
||
158 |
contentsSpecies := aClass. |
|
159 |
! |
|
160 |
||
| 1015 | 161 |
initialize |
162 |
queue := SharedQueue new. |
|
| 3978 | 163 |
closed := false. |
164 |
! ! |
|
165 |
||
166 |
!InternalPipeStream methodsFor:'queries'! |
|
167 |
||
168 |
contentsSpecies |
|
169 |
^ contentsSpecies ? String |
|
| 1015 | 170 |
! ! |
171 |
||
172 |
!InternalPipeStream methodsFor:'synchronization'! |
|
173 |
||
174 |
readWait |
|
175 |
queue readSemaphore wait |
|
| 3978 | 176 |
! |
177 |
||
178 |
writeWaitWithTimeoutMs:timeout |
|
179 |
queue writeSemaphore waitWithTimeoutMs:timeout |
|
| 1015 | 180 |
! ! |
181 |
||
182 |
!InternalPipeStream class methodsFor:'documentation'! |
|
183 |
||
184 |
version |
|
| 3978 | 185 |
^ '$Header$' |
| 1015 | 186 |
! ! |
| 3128 | 187 |