DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / bbcp.git / blob


81d265f15a4038d77ca4eda240d48e5379117926
[bbcp.git] / Trurl-based / Dev / Mod / Selectors.txt
1 MODULE DevSelectors;
2
3 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/Selectors.odc *)
4 (* DO NOT EDIT *)
5
6 IMPORT
7 Ports, Stores, Models, Views, Controllers, Fonts, Properties, TextModels, TextViews, TextSetters;
8
9
10 CONST
11 left* = 1; middle* = 2; right* = 3;
12
13 minVersion = 0; currentVersion = 0;
14
15 changeSelectorsKey = "#Dev:Change Selectors";
16
17
18 TYPE
19 Selector* = POINTER TO RECORD (Views.View)
20 position-: INTEGER; (* left, middle, right *)
21 leftHidden: TextModels.Model; (* valid iff (position = left) *)
22 rightHidden: TextModels.Model (* valid iff (position = left) *)
23 END;
24
25 Directory* = POINTER TO ABSTRACT RECORD END;
26
27 StdDirectory = POINTER TO RECORD (Directory) END;
28
29
30 VAR
31 dir-, stdDir-: Directory;
32
33
34 PROCEDURE (d: Directory) New* (position: INTEGER): Selector, NEW, ABSTRACT;
35
36
37 PROCEDURE GetFirst (selector: Selector; OUT first: Selector; OUT pos: INTEGER);
38 VAR c: Models.Context; rd: TextModels.Reader; v: Views.View; nest: INTEGER;
39 BEGIN
40 c := selector.context; first := NIL; pos := 0;
41 WITH c: TextModels.Context DO
42 IF selector.position = left THEN
43 first := selector
44 ELSE
45 rd := c.ThisModel().NewReader(NIL); rd.SetPos(c.Pos());
46 nest := 1; pos := 1; rd.ReadPrevView(v);
47 WHILE (v # NIL) & (nest > 0) DO
48 WITH v: Selector DO
49 IF v.position = left THEN DEC(nest);
50 IF nest = 0 THEN first := v END
51 ELSIF v.position = right THEN INC(nest)
52 ELSIF nest = 1 THEN INC(pos)
53 END
54 ELSE
55 END;
56 rd.ReadPrevView(v)
57 END
58 END
59 ELSE (* selector not embedded in a text *)
60 END;
61 ASSERT((first = NIL) OR (first.position = left), 100)
62 END GetFirst;
63
64 PROCEDURE GetNext (rd: TextModels.Reader; OUT next: Selector);
65 VAR nest: INTEGER; v: Views.View;
66 BEGIN
67 nest := 1; next := NIL; rd.ReadView(v);
68 WHILE v # NIL DO
69 WITH v: Selector DO
70 IF v.position = left THEN INC(nest)
71 ELSIF nest = 1 THEN next := v; RETURN
72 ELSIF v.position = right THEN DEC(nest)
73 END
74 ELSE
75 END;
76 rd.ReadView(v)
77 END
78 END GetNext;
79
80 PROCEDURE CalcSize (f: Selector; OUT w, h: INTEGER);
81 VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, fw: INTEGER;
82 BEGIN
83 c := f.context;
84 IF (c # NIL) & (c IS TextModels.Context) THEN
85 a := c(TextModels.Context).Attr();
86 font := a.font
87 ELSE font := Fonts.dir.Default();
88 END;
89 font.GetBounds(asc, dsc, fw);
90 h := asc + dsc; w := 3 * h DIV 4
91 END CalcSize;
92
93 PROCEDURE GetSection (first: Selector; rd: TextModels.Reader; n: INTEGER; OUT name: ARRAY OF CHAR);
94 VAR i, p0, p1: INTEGER; ch: CHAR; sel: Selector;
95 BEGIN
96 sel := first;
97 IF first.leftHidden.Length() > 0 THEN
98 rd := first.leftHidden.NewReader(rd); rd.SetPos(0);
99 REPEAT p0 := rd.Pos(); GetNext(rd, sel); DEC(n) UNTIL (n < 0) OR (sel = NIL);
100 IF sel = NIL THEN INC(n) END;
101 p1 := rd.Pos() - 1
102 END;
103 IF n >= 0 THEN
104 rd := first.context(TextModels.Context).ThisModel().NewReader(rd);
105 rd.SetPos(first.context(TextModels.Context).Pos() + 1);
106 REPEAT p0 := rd.Pos(); GetNext(rd, sel); DEC(n) UNTIL (n < 0) OR (sel = NIL) OR (sel.position = right);
107 p1 := rd.Pos() - 1
108 END;
109 IF (n >= 0) & (first.rightHidden.Length() > 0) THEN
110 rd := first.rightHidden.NewReader(rd); rd.SetPos(1);
111 REPEAT p0 := rd.Pos(); GetNext(rd, sel); DEC(n) UNTIL (n < 0) OR (sel = NIL);
112 p1 := rd.Pos() - 1;
113 IF sel = NIL THEN p1 := first.rightHidden.Length() END
114 END;
115 IF n < 0 THEN
116 rd.SetPos(p0); rd.ReadChar(ch); i := 0;
117 WHILE (ch <= " ") & (rd.Pos() <= p1) DO rd.ReadChar(ch) END;
118 WHILE (i < LEN(name) - 1) & (rd.Pos() <= p1) & (ch # 0X) DO
119 IF ch >= " " THEN name[i] := ch; INC(i) END;
120 rd.ReadChar(ch)
121 END;
122 WHILE (i > 0) & (name[i - 1] = " ") DO DEC(i) END;
123 name[i] := 0X
124 ELSE
125 name := 7FX + ""
126 END
127 END GetSection;
128
129
130 PROCEDURE ChangeSelector (first: Selector; rd: TextModels.Reader; selection: INTEGER);
131 VAR pos, p0, len, s: INTEGER; text: TextModels.Model; sel: Selector;
132 BEGIN
133 text := rd.Base();
134 pos := first.context(TextModels.Context).Pos() + 1;
135 (* expand *)
136 rd.SetPos(pos);
137 REPEAT GetNext(rd, sel) UNTIL (sel = NIL) OR (sel.position = right);
138 IF sel # NIL THEN
139 len := first.rightHidden.Length();
140 IF len > 0 THEN text.Insert(rd.Pos() - 1, first.rightHidden, 0, len) END;
141 len := first.leftHidden.Length();
142 IF len > 0 THEN text.Insert(pos, first.leftHidden, 0, len) END;
143 IF selection # 0 THEN (* collapse *)
144 rd.SetPos(pos); s := 0;
145 REPEAT GetNext(rd, sel); INC(s) UNTIL (s = selection) OR (sel = NIL) OR (sel.position = right);
146 IF (sel # NIL) & (sel.position = middle) THEN
147 first.leftHidden.Insert(0, text, pos, rd.Pos());
148 rd.SetPos(pos); GetNext(rd, sel);
149 p0 := rd.Pos() - 1;
150 WHILE (sel # NIL) & (sel.position # right) DO GetNext(rd, sel) END;
151 IF sel # NIL THEN
152 first.rightHidden.Insert(0, text, p0, rd.Pos() - 1)
153 END
154 END
155 END
156 END;
157 rd.SetPos(pos)
158 END ChangeSelector;
159
160 PROCEDURE ChangeThis (
161 text: TextModels.Model; rd, rd1: TextModels.Reader; title: ARRAY OF CHAR; selection: INTEGER
162 );
163 VAR v: Views.View; str: ARRAY 256 OF CHAR;
164 BEGIN
165 rd := text.NewReader(rd);
166 rd.SetPos(0); rd.ReadView(v);
167 WHILE v # NIL DO
168 WITH v: Selector DO
169 IF v.position = left THEN
170 GetSection(v, rd1, 0, str);
171 IF str = title THEN
172 ChangeSelector(v, rd, selection)
173 END;
174 IF v.leftHidden.Length() > 0 THEN ChangeThis(v.leftHidden, NIL, rd1, title, selection) END;
175 IF v.rightHidden.Length() > 0 THEN ChangeThis(v.rightHidden, NIL, rd1, title, selection) END
176 END
177 ELSE
178 END;
179 rd.ReadView(v)
180 END
181 END ChangeThis;
182
183 PROCEDURE Change* (text: TextModels.Model; title: ARRAY OF CHAR; selection: INTEGER);
184 VAR rd, rd1: TextModels.Reader; script: Stores.Operation;
185 BEGIN
186 rd := text.NewReader(NIL);
187 rd1 := text.NewReader(NIL);
188 Models.BeginModification(Models.clean, text);
189 Models.BeginScript(text, changeSelectorsKey, script);
190 ChangeThis(text, rd, rd1, title, selection);
191 Models.EndScript(text, script);
192 Models.EndModification(Models.clean, text);
193 END Change;
194
195 PROCEDURE ChangeTo* (text: TextModels.Model; title, entry: ARRAY OF CHAR);
196 VAR rd, rd1: TextModels.Reader; str: ARRAY 256 OF CHAR; v: Views.View; sel: INTEGER;
197 BEGIN
198 rd := text.NewReader(NIL);
199 rd1 := text.NewReader(NIL);
200 rd.SetPos(0); rd.ReadView(v);
201 WHILE v # NIL DO
202 WITH v: Selector DO
203 IF v.position = left THEN
204 GetSection(v, rd1, 0, str);
205 IF title = str THEN
206 sel := 0;
207 REPEAT
208 INC(sel); GetSection(v, rd1, sel, str)
209 UNTIL (str[0] = 7FX) OR (str = entry);
210 IF str[0] # 7FX THEN
211 Change(text, title, sel);
212 RETURN
213 END
214 END
215 END
216 ELSE
217 END;
218 rd.ReadView(v)
219 END
220 END ChangeTo;
221
222
223 PROCEDURE (selector: Selector) HandlePropMsg- (VAR msg: Properties.Message);
224 VAR c: Models.Context; a: TextModels.Attributes; asc, w: INTEGER;
225 BEGIN
226 WITH msg: Properties.SizePref DO CalcSize(selector, msg.w, msg.h)
227 | msg: Properties.ResizePref DO msg.fixed := TRUE;
228 | msg: Properties.FocusPref DO msg.hotFocus := TRUE;
229 | msg: TextSetters.Pref DO c := selector.context;
230 IF (c # NIL) & (c IS TextModels.Context) THEN
231 a := c(TextModels.Context).Attr();
232 a.font.GetBounds(asc, msg.dsc, w)
233 END
234 ELSE (*selector.HandlePropMsg^(msg);*)
235 END
236 END HandlePropMsg;
237
238 PROCEDURE Track (selector: Selector; f: Views.Frame; x, y: INTEGER; buttons: SET; VAR hit: BOOLEAN);
239 VAR a: TextModels.Attributes; font: Fonts.Font; c: Models.Context;
240 w, h, asc, dsc, fw: INTEGER; isDown, in, in0: BOOLEAN; modifiers: SET;
241 BEGIN
242 c := selector.context; hit := FALSE;
243 WITH c: TextModels.Context DO
244 a := c.Attr(); font := a.font;
245 c.GetSize(w, h); in0 := FALSE;
246 in := (0 <= x) & (x < w) & (0 <= y) & (y < h);
247 REPEAT
248 IF in # in0 THEN
249 f.MarkRect(0, 0, w, h, Ports.fill, Ports.hilite, FALSE); in0 := in
250 END;
251 f.Input(x, y, modifiers, isDown);
252 in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
253 UNTIL ~isDown;
254 IF in0 THEN hit := TRUE;
255 font.GetBounds(asc, dsc, fw);
256 f.MarkRect(0, 0, w, asc + dsc, Ports.fill, Ports.hilite, FALSE);
257 END
258 ELSE
259 END
260 END Track;
261
262 PROCEDURE (selector: Selector) HandleCtrlMsg* (
263 f: Views.Frame; VAR msg: Views.CtrlMessage; VAR focus: Views.View
264 );
265 VAR hit: BOOLEAN; sel, pos: INTEGER; text: TextModels.Model; title: ARRAY 256 OF CHAR; first: Selector;
266 BEGIN
267 WITH msg: Controllers.TrackMsg DO
268 IF selector.context IS TextModels.Context THEN
269 Track(selector, f, msg.x, msg.y, msg.modifiers, hit);
270 IF hit THEN
271 text := selector.context(TextModels.Context).ThisModel();
272 GetFirst(selector, first, pos);
273 IF first # NIL THEN
274 GetSection(first, NIL, 0, title);
275 IF selector.position = middle THEN sel := pos ELSE sel := 0 END;
276 Change(text, title, sel);
277 text := selector.context(TextModels.Context).ThisModel();
278 IF TextViews.FocusText() = text THEN
279 pos := selector.context(TextModels.Context).Pos();
280 TextViews.ShowRange(text, pos, pos+1, TRUE)
281 END
282 END
283 END
284 END
285 | msg: Controllers.PollCursorMsg DO
286 msg.cursor := Ports.refCursor;
287 ELSE
288 END
289 END HandleCtrlMsg;
290
291 PROCEDURE (selector: Selector) Restore* (f: Views.Frame; l, t, r, b: INTEGER);
292 VAR w, h, d: INTEGER;
293 BEGIN
294 selector.context.GetSize(w, h);
295 (*
296 GetFirst(selector, first, pos);
297 *)
298 w := w - w MOD f.unit; d := 2 * f.dot;
299 f.DrawLine(d, d, w - d, d, d, Ports.grey25);
300 f.DrawLine(d, h - d, w - d, h - d, d, Ports.grey25);
301 IF selector.position # right THEN f.DrawLine(d, d, d, h - d, d, Ports.grey25) END;
302 IF selector.position # left THEN f.DrawLine(w - d, d, w - d, h - d, d, Ports.grey25) END
303 END Restore;
304
305 PROCEDURE (selector: Selector) CopyFromSimpleView- (source: Views.View);
306 BEGIN
307 (* selector.CopyFrom^(source); *)
308 WITH source: Selector DO
309 selector.position := source.position;
310 IF source.leftHidden # NIL THEN
311 selector.leftHidden := TextModels.CloneOf(source.leftHidden);
312 selector.leftHidden.InsertCopy(0, source.leftHidden, 0, source.leftHidden.Length())
313 END;
314 IF source.rightHidden # NIL THEN
315 selector.rightHidden := TextModels.CloneOf(source.rightHidden);
316 selector.rightHidden.InsertCopy(0, source.rightHidden, 0, source.rightHidden.Length())
317 END
318 END
319 END CopyFromSimpleView;
320
321 PROCEDURE (selector: Selector) InitContext* (context: Models.Context);
322 BEGIN
323 selector.InitContext^(context);
324 IF selector.position = left THEN
325 WITH context: TextModels.Context DO
326 IF selector.leftHidden = NIL THEN
327 selector.leftHidden := TextModels.CloneOf(context.ThisModel());
328 Stores.Join(selector, selector.leftHidden);
329 END;
330 IF selector.rightHidden = NIL THEN
331 selector.rightHidden := TextModels.CloneOf(context.ThisModel());
332 Stores.Join(selector, selector.rightHidden)
333 END
334 ELSE
335 END
336 END
337 END InitContext;
338
339 PROCEDURE (selector: Selector) Internalize- (VAR rd: Stores.Reader);
340 VAR version: INTEGER; store: Stores.Store;
341 BEGIN
342 selector.Internalize^(rd);
343 IF rd.cancelled THEN RETURN END;
344 rd.ReadVersion(minVersion, currentVersion, version);
345 IF rd.cancelled THEN RETURN END;
346 rd.ReadInt(selector.position);
347 rd.ReadStore(store);
348 IF store # NIL THEN selector.leftHidden := store(TextModels.Model)
349 ELSE selector.leftHidden := NIL
350 END;
351 rd.ReadStore(store);
352 IF store # NIL THEN selector.rightHidden := store(TextModels.Model)
353 ELSE selector.rightHidden := NIL
354 END
355 END Internalize;
356
357 PROCEDURE (selector: Selector) Externalize- (VAR wr: Stores.Writer);
358 BEGIN
359 selector.Externalize^(wr);
360 wr.WriteVersion(currentVersion);
361 wr.WriteInt(selector.position);
362 wr.WriteStore(selector.leftHidden);
363 wr.WriteStore(selector.rightHidden)
364 END Externalize;
365
366
367 PROCEDURE (d: StdDirectory) New (position: INTEGER): Selector;
368 VAR selector: Selector;
369 BEGIN
370 NEW(selector);
371 selector.position := position;
372 RETURN selector
373 END New;
374
375 PROCEDURE SetDir* (d: Directory);
376 BEGIN
377 ASSERT(d # NIL, 20);
378 dir := d
379 END SetDir;
380
381
382 PROCEDURE DepositLeft*;
383 BEGIN
384 Views.Deposit(dir.New(left))
385 END DepositLeft;
386
387 PROCEDURE DepositMiddle*;
388 BEGIN
389 Views.Deposit(dir.New(middle))
390 END DepositMiddle;
391
392 PROCEDURE DepositRight*;
393 BEGIN
394 Views.Deposit(dir.New(right))
395 END DepositRight;
396
397
398 PROCEDURE InitMod;
399 VAR d: StdDirectory;
400 BEGIN
401 NEW(d); dir := d; stdDir := d;
402 END InitMod;
403
404 BEGIN
405 InitMod
406 END DevSelectors.
407
408
409 "Insert Left" "*F5" "DevSelectors.DepositLeft; StdCmds.PasteView" "StdCmds.PasteViewGuard"
410 "Insert Middle" "*F6" "DevSelectors.DepositMiddle; StdCmds.PasteView" "StdCmds.PasteViewGuard"
411 "Insert Right" "*F7" "DevSelectors.DepositRight; StdCmds.PasteView" "StdCmds.PasteViewGuard"
[FORK] BlackBox Cross-Platform (Windows, GNU/Linux, OpenBSD, FreeBSD)
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024