-
Notifications
You must be signed in to change notification settings - Fork 7
/
Copy pathactors.fs
193 lines (164 loc) · 6.44 KB
/
actors.fs
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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
\ actor 23nov97py
debugging class actor
public: object ptr called gadget ptr caller
method set ( -- )
method reset ( -- )
method toggle ( -- )
method fetch ( -- x1 .. xn )
method store ( x1 .. xn -- )
method click ( x y b n -- ... )
method key ( key sh -- )
method enter ( -- )
method leave ( -- )
method assign ( x1 .. xn -- )
method set-called ( o -- )
\ all methods send appropriate messages to called/caller
\ Use: <actor> (set|reset|toggle|fetch|store|click|enter|leave)
\ actor 23nov97py
how: : init ( o -- ) bind called ;
: set fetch 0= IF true store THEN ;
: reset fetch IF false store THEN ;
: toggle fetch 0= store ;
: click dup 0= IF 2drop 2drop EXIT THEN
caller >released IF toggle THEN ;
: key ( key sh -- ) drop dup bl = swap #cr = or
IF caller xywh 2drop 1 2 click THEN ;
: enter ( cr ." enter" ) ;
: leave ( cr ." leave" ) ;
: assign ;
: set-called bind called ;
class;
\ actor 23aug97py
actor class toggle
public: cell var do-set cell var do-reset
cell var set?
how: : init ( o state xtset xtreset -- )
do-reset ! do-set ! assign super init ;
: assign ( flag -- ) set? ! ;
: fetch ( -- flag ) set? @ ;
: store ( flag -- ) set? !
set? @ IF do-set ELSE do-reset THEN @ called send ;
: click dup 0= IF 2drop 2drop EXIT THEN
toggle caller >released drop ;
class;
\ actor 05mar07py
actor class toggle-var
public: cell var addr cell var xt
how: : init ( o var xt -- ) xt ! assign super init ;
: fetch ( -- n ) addr @ @ ;
: store ( n -- ) addr @ ! xt @ called send ;
: assign ( addr -- ) addr ! ;
class;
toggle-var class toggle-num
public: cell var num
how: : assign ( o num var -- ) super assign num ! ;
: !if ( n num addr -- ) rot IF ! ELSE nip on THEN ;
: fetch ( -- flag ) num @ addr @ @ = ;
: store ( n -- ) num @ addr @ !if xt @ called send ;
class;
\ toggle bit 05mar07py
toggle-var class toggle-bit
public: cell var bit
how: : fetch ( -- n ) addr @ bit @ bit@ ;
: store ( n -- ) >r addr @ bit @
r> IF +bit ELSE -bit THEN
xt @ called send ;
: assign ( addr bit -- ) bit ! addr ! ;
class;
\ actor 25sep99py
actor class toggle-state
public: cell var do-store cell var do-fetch
how: : init ( o xtstore xtfetch -- )
do-fetch ! do-store ! super init ;
: fetch ( -- x1 .. xn ) do-fetch @ called send ;
: store ( x1 .. xn -- ) do-store @ called send ;
class;
actor class simple
public: cell var do-it
how: : init ( o xt -- ) do-it ! super init ;
: fetch 0 ;
: store do-it @ called send drop ;
class;
\ actor 25sep99py
: noop-act 0 ['] noop simple new ;
simple class click
how: : click store ;
: fetch ;
: store do-it @ called send ;
class;
simple class data-act
public: cell var data
how: : init ( o data xt -- ) swap data ! super init ;
: store data @ super store ;
class;
\ actor 31aug97py
toggle-state class scale-act
public: cell var max
how: : init ( o do-store do-fetch max -- )
assign super init ;
: assign ( max -- ) max ! ;
: fetch max @ do-fetch @ called send ;
class;
scale-act class slider-act
public: cell var step
how: \ init ( o do-store do-fetch max step -- )
: assign step ! super assign ;
: fetch max @ step @ do-fetch @ called send ;
class;
\ actor 12apr98py
actor class scale-var
public: cell var max cell var pos
how: : init ( o pos max -- ) assign super init ;
: assign ( pos max -- ) max ! pos ! ;
: fetch max @ pos @ ;
: store pos ! ;
class;
scale-var class slider-var
public: cell var step
how: : assign ( o pos max step -- ) step ! super assign ;
: fetch max @ step @ pos @ ;
class;
\ actor 24sep99py
scale-var class scale-do
public: cell var action
how: : init ( o n max xt -- ) action ! super init ;
: store super store pos @ action @ called send ;
class;
slider-var class slider-do
public: cell var action
how: : init ( o n max step xt -- ) action ! super init ;
: store super store pos @ action @ called send ;
class;
\ actor simplification 05mar07py
: noop-i ; immediate
synonym S[ [:
synonym DT[ [:
synonym T[ [:
synonym TS[ [:
synonym CK[ [:
synonym SC[ [:
synonym SL[ [:
synonym ]T[ [:
synonym CP[ noop-i
synonym ]CP noop-i
: ]S postpone ;] simple postpone new ; immediate restrict
: ]DT postpone ;] data-act postpone new ; immediate restrict
: ]T postpone ;] toggle postpone new ; immediate restrict
: ]CK postpone ;] click postpone new ; immediate restrict
: ][ postpone ;] postpone [: ; immediate restrict
: ]TS postpone ;] toggle-state postpone new ;
immediate restrict
: ]N ; immediate
: ]TERM ; immediate
\ other simplifications 05mar07py
: C[ ; immediate restrict
: ]SC postpone ;] scale-do postpone new ; immediate restrict
: ]SL postpone ;] slider-do postpone new ; immediate restrict
: TV[ ; immediate restrict
: TB[ ; immediate restrict
: TN[ ; immediate restrict
: ]TV postpone ;] toggle-var postpone new ; immediate restrict
: ]TB postpone ;] toggle-bit postpone new ; immediate restrict
: ]TN postpone ;] toggle-num postpone new ; immediate restrict
: DF[ postpone dup postpone >o ; immediate restrict
: ]DF postpone o> ; immediate restrict