Commit | Line | Data |
---|---|---|
15e0efc7 SM |
1 | { GPC demo program for the CRT unit. |
2 | ||
ab422c4d | 3 | Copyright (C) 1999-2006, 2013 Free Software Foundation, Inc. |
15e0efc7 SM |
4 | |
5 | Author: Frank Heckenbach <frank@pascal.gnu.de> | |
6 | ||
7 | This program is free software; you can redistribute it and/or | |
8 | modify it under the terms of the GNU General Public License as | |
9 | published by the Free Software Foundation, version 2. | |
10 | ||
11 | This program is distributed in the hope that it will be useful, | |
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
14 | General Public License for more details. | |
15 | ||
16 | You should have received a copy of the GNU General Public License | |
fee0bd5f | 17 | along with this program. If not, see <http://www.gnu.org/licenses/>. |
15e0efc7 SM |
18 | |
19 | As a special exception, if you incorporate even large parts of the | |
20 | code of this demo program into another program with substantially | |
21 | different functionality, this does not cause the other program to | |
22 | be covered by the GNU General Public License. This exception does | |
23 | not however invalidate any other reasons why it might be covered | |
24 | by the GNU General Public License. } | |
25 | ||
26 | {$gnu-pascal,I+} | |
27 | ||
c4f268a1 SM |
28 | // Free-pascal style comment. |
29 | ||
15e0efc7 SM |
30 | program CRTDemo; |
31 | ||
32 | uses GPC, CRT; | |
33 | ||
34 | type | |
35 | TFrameChars = array [1 .. 8] of Char; | |
36 | TSimulateBlockCursorKind = (bc_None, bc_Blink, bc_Static); | |
37 | ||
38 | const | |
39 | SingleFrame: TFrameChars = (chCornerTLS, chLineHS, chCornerTRS, chLineVS, chLineVS, chCornerBLS, chLineHS, chCornerBRS); | |
40 | DoubleFrame: TFrameChars = (chCornerTLD, chLineHD, chCornerTRD, chLineVD, chLineVD, chCornerBLD, chLineHD, chCornerBRD); | |
41 | ||
42 | var | |
43 | ScrollState: Boolean = True; | |
44 | SimulateBlockCursorKind: TSimulateBlockCursorKind = bc_None; | |
45 | CursorShape: TCursorShape = CursorNormal; | |
46 | MainPanel: TPanel; | |
47 | OrigScreenSize: TPoint; | |
48 | ||
49 | procedure FrameWin (const Title: String; const Frame: TFrameChars; TitleInverse: Boolean); | |
50 | var | |
51 | w, h, y, Color: Integer; | |
52 | Attr: TTextAttr; | |
53 | begin | |
54 | HideCursor; | |
55 | SetPCCharSet (True); | |
56 | ClrScr; | |
57 | w := GetXMax; | |
58 | h := GetYMax; | |
59 | WriteCharAt (1, 1, 1, Frame[1], TextAttr); | |
60 | WriteCharAt (2, 1, w - 2, Frame[2], TextAttr); | |
61 | WriteCharAt (w, 1, 1, Frame[3], TextAttr); | |
62 | for y := 2 to h - 1 do | |
63 | begin | |
64 | WriteCharAt (1, y, 1, Frame[4], TextAttr); | |
65 | WriteCharAt (w, y, 1, Frame[5], TextAttr) | |
66 | end; | |
67 | WriteCharAt (1, h, 1, Frame[6], TextAttr); | |
68 | WriteCharAt (2, h, w - 2, Frame[7], TextAttr); | |
69 | WriteCharAt (w, h, 1, Frame[8], TextAttr); | |
70 | SetPCCharSet (False); | |
71 | Attr := TextAttr; | |
72 | if TitleInverse then | |
73 | begin | |
74 | Color := GetTextColor; | |
75 | TextColor (GetTextBackground); | |
76 | TextBackground (Color) | |
77 | end; | |
78 | WriteStrAt ((w - Length (Title)) div 2 + 1, 1, Title, TextAttr); | |
79 | TextAttr := Attr | |
80 | end; | |
81 | ||
82 | function GetKey (TimeOut: Integer) = Key: TKey; forward; | |
83 | ||
84 | procedure ClosePopUpWindow; | |
85 | begin | |
86 | PanelDelete (GetActivePanel); | |
87 | PanelDelete (GetActivePanel) | |
88 | end; | |
89 | ||
90 | function PopUpConfirm (XSize, YSize: Integer; const Msg: String): Boolean; | |
91 | var | |
92 | ax, ay: Integer; | |
93 | Key: TKey; | |
94 | SSize: TPoint; | |
95 | begin | |
96 | repeat | |
97 | SSize := ScreenSize; | |
98 | ax := (SSize.x - XSize - 4) div 2 + 1; | |
99 | ay := (SSize.y - YSize - 4) div 2 + 1; | |
100 | PanelNew (ax, ay, ax + XSize + 3, ay + YSize + 1, False); | |
101 | TextBackground (Black); | |
102 | TextColor (Yellow); | |
103 | SetControlChars (True); | |
104 | FrameWin ('', DoubleFrame, False); | |
105 | NormalCursor; | |
106 | PanelNew (ax + 2, ay + 1, ax + XSize + 2, ay + YSize, False); | |
107 | ClrScr; | |
108 | Write (Msg); | |
109 | Key := GetKey (-1); | |
110 | if Key = kbScreenSizeChanged then ClosePopUpWindow | |
111 | until Key <> kbScreenSizeChanged; | |
112 | PopUpConfirm := not (Key in [kbEsc, kbAltEsc]) | |
113 | end; | |
114 | ||
115 | procedure MainDraw; | |
116 | begin | |
117 | WriteLn ('3, F3 : Open a window'); | |
118 | WriteLn ('4, F4 : Close window'); | |
119 | WriteLn ('5, F5 : Previous window'); | |
120 | WriteLn ('6, F6 : Next window'); | |
121 | WriteLn ('7, F7 : Move window'); | |
122 | WriteLn ('8, F8 : Resize window'); | |
123 | Write ('q, Esc: Quit') | |
124 | end; | |
125 | ||
126 | procedure StatusDraw; | |
127 | const | |
128 | YesNo: array [Boolean] of String [3] = ('No', 'Yes'); | |
129 | SimulateBlockCursorIDs: array [TSimulateBlockCursorKind] of String [8] = ('Off', 'Blinking', 'Static'); | |
130 | CursorShapeIDs: array [TCursorShape] of String [7] = ('Ignored', 'Hidden', 'Normal', 'Fat', 'Block'); | |
131 | var | |
132 | SSize: TPoint; | |
133 | begin | |
134 | WriteLn ('You can change some of the following'); | |
135 | WriteLn ('settings by pressing the key shown'); | |
136 | WriteLn ('in parentheses. Naturally, color and'); | |
137 | WriteLn ('changing the cursor shape or screen'); | |
138 | WriteLn ('size does not work on all terminals.'); | |
139 | WriteLn; | |
140 | WriteLn ('XCurses version: ', YesNo[XCRT]); | |
141 | WriteLn ('CRTSavePreviousScreen: ', YesNo[CRTSavePreviousScreenWorks]); | |
142 | WriteLn ('(M)onochrome: ', YesNo[IsMonochrome]); | |
143 | SSize := ScreenSize; | |
144 | WriteLn ('Screen (C)olumns: ', SSize.x); | |
145 | WriteLn ('Screen (L)ines: ', SSize.y); | |
146 | WriteLn ('(R)estore screen size'); | |
147 | WriteLn ('(B)reak checking: ', YesNo[CheckBreak]); | |
148 | WriteLn ('(S)crolling: ', YesNo[ScrollState]); | |
149 | WriteLn ('S(i)mulated block cursor: ', SimulateBlockCursorIDs[SimulateBlockCursorKind]); | |
150 | Write ('C(u)rsor shape: ', CursorShapeIDs[CursorShape]); | |
151 | GotoXY (36, WhereY) | |
152 | end; | |
153 | ||
154 | procedure RedrawAll; forward; | |
155 | procedure CheckScreenSize; forward; | |
156 | ||
157 | procedure StatusKey (Key: TKey); | |
158 | var SSize, NewSize: TPoint; | |
159 | begin | |
160 | case LoCase (Key2Char (Key)) of | |
161 | 'm': begin | |
162 | SetMonochrome (not IsMonochrome); | |
163 | RedrawAll | |
164 | end; | |
165 | 'c': begin | |
166 | SSize := ScreenSize; | |
167 | if SSize.x > 40 then | |
168 | NewSize.x := 40 | |
169 | else | |
170 | NewSize.x := 80; | |
171 | if SSize.y > 25 then | |
172 | NewSize.y := 50 | |
173 | else | |
174 | NewSize.y := 25; | |
175 | SetScreenSize (NewSize.x, NewSize.y); | |
176 | CheckScreenSize | |
177 | end; | |
178 | 'l': begin | |
179 | SSize := ScreenSize; | |
180 | if SSize.x > 40 then | |
181 | NewSize.x := 80 | |
182 | else | |
183 | NewSize.x := 40; | |
184 | if SSize.y > 25 then | |
185 | NewSize.y := 25 | |
186 | else | |
187 | NewSize.y := 50; | |
188 | SetScreenSize (NewSize.x, NewSize.y); | |
189 | CheckScreenSize | |
190 | end; | |
191 | 'r': begin | |
192 | SetScreenSize (OrigScreenSize.x, OrigScreenSize.y); | |
193 | CheckScreenSize | |
194 | end; | |
195 | 'b': CheckBreak := not CheckBreak; | |
196 | 's': ScrollState := not ScrollState; | |
197 | 'i': if SimulateBlockCursorKind = High (SimulateBlockCursorKind) then | |
198 | SimulateBlockCursorKind := Low (SimulateBlockCursorKind) | |
199 | else | |
200 | Inc (SimulateBlockCursorKind); | |
201 | 'u': case CursorShape of | |
202 | CursorNormal: CursorShape := CursorBlock; | |
203 | CursorFat, | |
204 | CursorBlock : CursorShape := CursorHidden; | |
205 | else CursorShape := CursorNormal | |
206 | end; | |
207 | end; | |
208 | ClrScr; | |
209 | StatusDraw | |
210 | end; | |
211 | ||
212 | procedure TextAttrDemo; | |
213 | var f, b, y, x1, y1, x2, y2, Fill, n1, n2, n3: Integer; | |
214 | begin | |
215 | GetWindow (x1, y1, x2, y2); | |
216 | Window (x1 - 1, y1, x2, y2); | |
217 | TextColor (White); | |
218 | TextBackground (Blue); | |
219 | ClrScr; | |
220 | SetScroll (False); | |
221 | Fill := GetXMax - 32; | |
222 | for y := 1 to GetYMax do | |
223 | begin | |
224 | GotoXY (1, y); | |
225 | b := (y - 1) mod 16; | |
226 | n1 := 0; | |
227 | for f := 0 to 15 do | |
228 | begin | |
229 | TextAttr := f + 16 * b; | |
230 | n2 := (Fill * (1 + 2 * f) + 16) div 32; | |
231 | n3 := (Fill * (2 + 2 * f) + 16) div 32; | |
232 | Write ('' : n2 - n1, NumericBaseDigitsUpper[b], NumericBaseDigitsUpper[f], '' : n3 - n2); | |
233 | n1 := n3 | |
234 | end | |
235 | end | |
236 | end; | |
237 | ||
238 | procedure CharSetDemo (UsePCCharSet: Boolean); | |
239 | var h, l, y, x1, y1, x2, y2, Fill, n1, n2: Integer; | |
240 | begin | |
241 | GetWindow (x1, y1, x2, y2); | |
242 | Window (x1 - 1, y1, x2, y2); | |
243 | ClrScr; | |
244 | SetScroll (False); | |
245 | SetPCCharSet (UsePCCharSet); | |
246 | SetControlChars (False); | |
247 | Fill := GetXMax - 35; | |
248 | for y := 1 to GetYMax do | |
249 | begin | |
250 | GotoXY (1, y); | |
251 | h := (y - 2) mod 16; | |
252 | n1 := (Fill + 9) div 18; | |
253 | if y = 1 then | |
254 | Write ('' : 3 + n1) | |
255 | else | |
256 | Write (16 * h : 3 + n1); | |
257 | for l := 0 to 15 do | |
258 | begin | |
259 | n2 := (Fill * (2 + l) + 9) div 18; | |
260 | if y = 1 then | |
261 | Write ('' : n2 - n1, l : 2) | |
262 | else | |
263 | Write ('' : n2 - n1 + 1, Chr (16 * h + l)); | |
264 | n1 := n2 | |
265 | end | |
266 | end | |
267 | end; | |
268 | ||
269 | procedure NormalCharSetDemo; | |
270 | begin | |
271 | CharSetDemo (False) | |
272 | end; | |
273 | ||
274 | procedure PCCharSetDemo; | |
275 | begin | |
276 | CharSetDemo (True) | |
277 | end; | |
278 | ||
279 | procedure FKeyDemoDraw; | |
280 | var x1, y1, x2, y2: Integer; | |
281 | begin | |
282 | GetWindow (x1, y1, x2, y2); | |
283 | Window (x1, y1, x2 - 1, y2); | |
284 | ClrScr; | |
285 | SetScroll (False); | |
286 | WriteLn ('You can type the following keys'); | |
287 | WriteLn ('(function keys if present on the'); | |
288 | WriteLn ('terminal, letters as alternatives):'); | |
289 | GotoXY (1, 4); | |
290 | WriteLn ('S, Left : left (wrap-around)'); | |
291 | WriteLn ('D, Right : right (wrap-around)'); | |
292 | WriteLn ('E, Up : up (wrap-around)'); | |
293 | WriteLn ('X, Down : down (wrap-around)'); | |
294 | WriteLn ('A, Home : go to first column'); | |
295 | WriteLn ('F, End : go to last column'); | |
296 | WriteLn ('R, Page Up : go to first line'); | |
297 | WriteLn ('C, Page Down: go to last line'); | |
298 | WriteLn ('Y, Ctrl-PgUp: first column and line'); | |
299 | GotoXY (1, 13); | |
300 | WriteLn ('B, Ctrl-PgDn: last column and line'); | |
301 | WriteLn ('Z, Ctrl-Home: clear screen'); | |
302 | WriteLn ('N, Ctrl-End : clear to end of line'); | |
303 | WriteLn ('V, Insert : insert a line'); | |
304 | WriteLn ('T, Delete : delete a line'); | |
305 | WriteLn ('# : beep'); | |
306 | WriteLn ('* : flash'); | |
307 | WriteLn ('Tab, Enter, Backspace, other'); | |
308 | WriteLn (' normal characters: write text') | |
309 | end; | |
310 | ||
311 | procedure FKeyDemoKey (Key: TKey); | |
312 | const TabSize = 8; | |
313 | var | |
314 | ch: Char; | |
315 | NewX: Integer; | |
316 | begin | |
317 | case LoCaseKey (Key) of | |
318 | Ord ('s'), kbLeft : if WhereX = 1 then GotoXY (GetXMax, WhereY) else GotoXY (WhereX - 1, WhereY); | |
319 | Ord ('d'), kbRight : if WhereX = GetXMax then GotoXY (1, WhereY) else GotoXY (WhereX + 1, WhereY); | |
320 | Ord ('e'), kbUp : if WhereY = 1 then GotoXY (WhereX, GetYMax) else GotoXY (WhereX, WhereY - 1); | |
321 | Ord ('x'), kbDown : if WhereY = GetYMax then GotoXY (WhereX, 1) else GotoXY (WhereX, WhereY + 1); | |
322 | Ord ('a'), kbHome : Write (chCR); | |
323 | Ord ('f'), kbEnd : GotoXY (GetXMax, WhereY); | |
324 | Ord ('r'), kbPgUp : GotoXY (WhereX, 1); | |
325 | Ord ('c'), kbPgDn : GotoXY (WhereX, GetYMax); | |
326 | Ord ('y'), kbCtrlPgUp: GotoXY (1, 1); | |
327 | Ord ('b'), kbCtrlPgDn: GotoXY (GetXMax, GetYMax); | |
328 | Ord ('z'), kbCtrlHome: ClrScr; | |
329 | Ord ('n'), kbCtrlEnd : ClrEOL; | |
330 | Ord ('v'), kbIns : InsLine; | |
331 | Ord ('t'), kbDel : DelLine; | |
332 | Ord ('#') : Beep; | |
333 | Ord ('*') : Flash; | |
334 | kbTab : begin | |
335 | NewX := ((WhereX - 1) div TabSize + 1) * TabSize + 1; | |
336 | if NewX <= GetXMax then GotoXY (NewX, WhereY) else WriteLn | |
337 | end; | |
338 | kbCR : WriteLn; | |
339 | kbBkSp : Write (chBkSp, ' ', chBkSp); | |
340 | else ch := Key2Char (Key); | |
341 | if ch <> #0 then Write (ch) | |
342 | end | |
343 | end; | |
344 | ||
345 | procedure KeyDemoDraw; | |
346 | begin | |
347 | WriteLn ('Press some keys ...') | |
348 | end; | |
349 | ||
350 | procedure KeyDemoKey (Key: TKey); | |
351 | var ch: Char; | |
352 | begin | |
353 | ch := Key2Char (Key); | |
354 | if ch <> #0 then | |
355 | begin | |
356 | Write ('Normal key'); | |
357 | if IsPrintable (ch) then Write (' `', ch, ''''); | |
358 | WriteLn (', ASCII #', Ord (ch)) | |
359 | end | |
360 | else | |
361 | WriteLn ('Special key ', Ord (Key2Scan (Key))) | |
362 | end; | |
363 | ||
364 | procedure IOSelectPeriodical; | |
365 | var | |
366 | CurrentTime: TimeStamp; | |
367 | s: String (8); | |
368 | i: Integer; | |
369 | begin | |
370 | GetTimeStamp (CurrentTime); | |
371 | with CurrentTime do | |
372 | WriteStr (s, Hour : 2, ':', Minute : 2, ':', Second : 2); | |
373 | for i := 1 to Length (s) do | |
374 | if s[i] = ' ' then s[i] := '0'; | |
375 | GotoXY (1, 12); | |
376 | Write ('The time is: ', s) | |
377 | end; | |
378 | ||
379 | procedure IOSelectDraw; | |
380 | begin | |
381 | WriteLn ('IOSelect is a way to handle I/O from'); | |
382 | WriteLn ('or to several places simultaneously,'); | |
383 | WriteLn ('without having to use threads or'); | |
384 | WriteLn ('signal/interrupt handlers or waste'); | |
385 | WriteLn ('CPU time with busy waiting.'); | |
386 | WriteLn; | |
387 | WriteLn ('This demo shows how IOSelect works'); | |
388 | WriteLn ('in connection with CRT. It displays'); | |
389 | WriteLn ('a clock, but still reacts to user'); | |
390 | WriteLn ('input immediately.'); | |
391 | IOSelectPeriodical | |
392 | end; | |
393 | ||
394 | procedure ModifierPeriodical; | |
395 | const | |
396 | Pressed: array [Boolean] of String [8] = ('Released', 'Pressed'); | |
397 | ModifierNames: array [1 .. 7] of record | |
398 | Modifier: Integer; | |
399 | Name: String (17) | |
400 | end = | |
401 | ((shLeftShift, 'Left Shift'), | |
402 | (shRightShift, 'Right Shift'), | |
403 | (shLeftCtrl, 'Left Control'), | |
404 | (shRightCtrl, 'Right Control'), | |
405 | (shAlt, 'Alt (left)'), | |
406 | (shAltGr, 'AltGr (right Alt)'), | |
407 | (shExtra, 'Extra')); | |
408 | var | |
409 | ShiftState, i: Integer; | |
410 | begin | |
411 | ShiftState := GetShiftState; | |
412 | for i := 1 to 7 do | |
413 | with ModifierNames[i] do | |
414 | begin | |
415 | GotoXY (1, 4 + i); | |
416 | ClrEOL; | |
417 | Write (Name, ':'); | |
418 | GotoXY (20, WhereY); | |
419 | Write (Pressed[(ShiftState and Modifier) <> 0]) | |
420 | end | |
421 | end; | |
422 | ||
423 | procedure ModifierDraw; | |
424 | begin | |
425 | WriteLn ('Modifier keys (NOTE: only'); | |
426 | WriteLn ('available on some systems;'); | |
427 | WriteLn ('X11: only after key press):'); | |
428 | ModifierPeriodical | |
429 | end; | |
430 | ||
431 | procedure ChecksDraw; | |
432 | begin | |
433 | WriteLn ('(O)S shell'); | |
434 | WriteLn ('OS shell with (C)learing'); | |
435 | WriteLn ('(R)efresh check'); | |
436 | Write ('(S)ound check') | |
437 | end; | |
438 | ||
439 | procedure ChecksKey (Key: TKey); | |
440 | var | |
441 | i, j: Integer; | |
442 | WasteTime: Real; attribute (volatile); | |
443 | ||
444 | procedure DoOSShell; | |
445 | var | |
446 | Result: Integer; | |
447 | Shell: TString; | |
448 | begin | |
449 | Shell := GetShellPath (Null); | |
450 | {$I-} | |
451 | Result := Execute (Shell); | |
452 | {$I+} | |
453 | if (InOutRes <> 0) or (Result <> 0) then | |
454 | begin | |
455 | ClrScr; | |
456 | if InOutRes <> 0 then | |
457 | WriteLn (GetIOErrorMessage, ' while trying to execute `', Shell, '''.') | |
458 | else | |
459 | WriteLn ('`', Shell, ''' returned status ', Result, '.'); | |
460 | Write ('Any key to continue.'); | |
461 | BlockCursor; | |
462 | Discard (GetKey (-1)) | |
463 | end | |
464 | end; | |
465 | ||
466 | begin | |
467 | case LoCase (Key2Char (Key)) of | |
468 | 'o': begin | |
469 | if PopUpConfirm (36, 12, 'You will now get an OS shell. Unless' + NewLine + | |
470 | 'CRTDemo is running in its own (GUI)' + NewLine + | |
471 | 'window, the shell will run on the' + NewLine + | |
472 | 'same screen as CRTDemo which is not' + NewLine + | |
473 | 'cleared before the shell is started.' + NewLine + | |
474 | 'If possible, the screen contents are' + NewLine + | |
475 | 'restored to the state before CRTDemo' + NewLine + | |
476 | 'was started. After leaving the shell' + NewLine + | |
477 | 'in the usual way (usually by enter-' + NewLine + | |
478 | 'ing `exit''), you will get back to' + NewLine + | |
479 | 'the demo. <ESC> to abort, any other' + NewLine + | |
480 | 'key to start.') then | |
481 | begin | |
482 | RestoreTerminal (True); | |
483 | DoOSShell | |
484 | end; | |
485 | ClosePopUpWindow | |
486 | end; | |
487 | 'c': begin | |
488 | if PopUpConfirm (36, 9, 'You will now get an OS shell. Unless' + NewLine + | |
489 | 'CRTDemo is running in its own (GUI)' + NewLine + | |
490 | 'window, the screen will be cleared,' + NewLine + | |
491 | 'and the cursor will be moved to the' + NewLine + | |
492 | 'top before the shell is started.' + NewLine + | |
493 | 'After leaving the shell in the usual' + NewLine + | |
494 | 'way (usually by entering `exit''),' + NewLine + | |
495 | 'you will get back to the demo. <ESC>' + NewLine + | |
496 | 'to abort, any other key to start.') then | |
497 | begin | |
498 | RestoreTerminalClearCRT; | |
499 | DoOSShell | |
500 | end; | |
501 | ClosePopUpWindow | |
502 | end; | |
503 | 'r': begin | |
504 | if PopUpConfirm (36, 11, 'The program will now get busy with' + NewLine + | |
505 | 'some dummy computations. However,' + NewLine + | |
506 | 'CRT output in the form of dots will' + NewLine + | |
507 | 'still appear continuously one by one' + NewLine + | |
508 | '(rather than the whole line at once' + NewLine + | |
509 | 'in the end). While running, the test' + NewLine + | |
510 | 'cannot be interrupted. <ESC> to' + NewLine + | |
511 | 'abort, any other key to start.') then | |
512 | begin | |
513 | SetCRTUpdate (UpdateRegularly); | |
514 | BlockCursor; | |
515 | WriteLn; | |
516 | WriteLn; | |
517 | for i := 1 to GetXMax - 2 do | |
518 | begin | |
519 | Write ('.'); | |
520 | for j := 1 to 400000 do WasteTime := Random | |
521 | end; | |
522 | SetCRTUpdate (UpdateInput); | |
523 | WriteLn; | |
524 | Write ('Press any key.'); | |
525 | Discard (GetKey (-1)) | |
526 | end; | |
527 | ClosePopUpWindow | |
528 | end; | |
529 | 's': begin | |
530 | if PopUpConfirm (32, 4, 'You will now hear some sounds if' + NewLine + | |
531 | 'supported (otherwise there will' + NewLine + | |
532 | 'just be a short pause). <ESC> to' + NewLine + | |
533 | 'abort, any other key to start.') then | |
534 | begin | |
535 | BlockCursor; | |
536 | for i := 0 to 7 do | |
537 | begin | |
538 | Sound (Round (440 * 2 ** (Round (i * 12 / 7 + 0.3) / 12))); | |
539 | if GetKey (400000) in [kbEsc, kbAltEsc] then Break | |
540 | end; | |
541 | NoSound | |
542 | end; | |
543 | ClosePopUpWindow | |
544 | end; | |
545 | end | |
546 | end; | |
547 | ||
548 | type | |
549 | PWindowList = ^TWindowList; | |
550 | TWindowList = record | |
551 | Next, Prev: PWindowList; | |
552 | Panel, FramePanel: TPanel; | |
553 | WindowType: Integer; | |
554 | x1, y1, xs, ys: Integer; | |
555 | State: (ws_None, ws_Moving, ws_Resizing); | |
556 | end; | |
557 | ||
558 | TKeyProc = procedure (Key: TKey); | |
559 | TProcedure = procedure; | |
560 | ||
561 | const | |
562 | MenuNameLength = 16; | |
563 | WindowTypes: array [0 .. 9] of record | |
564 | DrawProc, | |
565 | PeriodicalProc: procedure; | |
566 | KeyProc : TKeyProc; | |
567 | Name : String (MenuNameLength); | |
568 | Color, | |
569 | Background, | |
570 | MinSizeX, | |
571 | MinSizeY, | |
572 | PrefSizeX, | |
573 | PrefSizeY : Integer; | |
574 | RedrawAlways, | |
575 | WantCursor : Boolean | |
576 | end = | |
577 | ((MainDraw , nil , nil , 'CRT Demo' , LightGreen, Blue , 26, 7, 0, 0, False, False), | |
578 | (StatusDraw , nil , StatusKey , 'Status' , White , Red , 38, 16, 0, 0, True, True), | |
579 | (TextAttrDemo , nil , nil , 'Text Attributes' , White , Blue , 32, 16, 64, 16, False, False), | |
580 | (NormalCharSetDemo, nil , nil , 'Character Set' , Black , Green , 35, 17, 53, 17, False, False), | |
581 | (PCCharSetDemo , nil , nil , 'PC Character Set', Black , Brown , 35, 17, 53, 17, False, False), | |
582 | (KeyDemoDraw , nil , KeyDemoKey , 'Keys' , Blue , LightGray, 29, 5, -1, -1, False, True), | |
583 | (FKeyDemoDraw , nil , FKeyDemoKey, 'Function Keys' , Blue , LightGray, 37, 22, -1, -1, False, True), | |
584 | (ModifierDraw , ModifierPeriodical, nil , 'Modifier Keys' , Black , Cyan , 29, 11, 0, 0, True, False), | |
585 | (IOSelectDraw , IOSelectPeriodical, nil , 'IOSelect Demo' , White , Magenta , 38, 12, 0, 0, False, False), | |
586 | (ChecksDraw , nil , ChecksKey , 'Various Checks' , Black , Red , 26, 4, 0, 0, False, False)); | |
587 | ||
588 | MenuMax = High (WindowTypes); | |
589 | MenuXSize = MenuNameLength + 4; | |
590 | MenuYSize = MenuMax + 2; | |
591 | ||
592 | var | |
593 | WindowList: PWindowList = nil; | |
594 | ||
595 | procedure RedrawFrame (p: PWindowList); | |
596 | begin | |
597 | with p^, WindowTypes[WindowType] do | |
598 | begin | |
599 | PanelActivate (FramePanel); | |
600 | Window (x1, y1, x1 + xs - 1, y1 + ys - 1); | |
601 | ClrScr; | |
602 | case State of | |
603 | ws_None : if p = WindowList then | |
604 | FrameWin (' ' + Name + ' ', DoubleFrame, True) | |
605 | else | |
606 | FrameWin (' ' + Name + ' ', SingleFrame, False); | |
607 | ws_Moving : FrameWin (' Move Window ', SingleFrame, True); | |
608 | ws_Resizing: FrameWin (' Resize Window ', SingleFrame, True); | |
609 | end | |
610 | end | |
611 | end; | |
612 | ||
613 | procedure DrawWindow (p: PWindowList); | |
614 | begin | |
615 | with p^, WindowTypes[WindowType] do | |
616 | begin | |
617 | RedrawFrame (p); | |
618 | PanelActivate (Panel); | |
619 | Window (x1 + 2, y1 + 1, x1 + xs - 2, y1 + ys - 2); | |
620 | ClrScr; | |
621 | DrawProc | |
622 | end | |
623 | end; | |
624 | ||
625 | procedure RedrawAll; | |
626 | var | |
627 | LastPanel: TPanel; | |
628 | p: PWindowList; | |
629 | x2, y2: Integer; | |
630 | begin | |
631 | LastPanel := GetActivePanel; | |
632 | PanelActivate (MainPanel); | |
633 | TextBackground (Blue); | |
634 | ClrScr; | |
635 | p := WindowList; | |
636 | if p <> nil then | |
637 | repeat | |
638 | with p^ do | |
639 | begin | |
640 | PanelActivate (FramePanel); | |
641 | GetWindow (x1, y1, x2, y2); { updated automatically by CRT } | |
642 | xs := x2 - x1 + 1; | |
643 | ys := y2 - y1 + 1 | |
644 | end; | |
645 | DrawWindow (p); | |
646 | p := p^.Next | |
647 | until p = WindowList; | |
648 | PanelActivate (LastPanel) | |
649 | end; | |
650 | ||
651 | procedure CheckScreenSize; | |
652 | var | |
653 | LastPanel: TPanel; | |
654 | MinScreenSizeX, MinScreenSizeY, i: Integer; | |
655 | SSize: TPoint; | |
656 | begin | |
657 | LastPanel := GetActivePanel; | |
658 | PanelActivate (MainPanel); | |
659 | HideCursor; | |
660 | MinScreenSizeX := MenuXSize; | |
661 | MinScreenSizeY := MenuYSize; | |
662 | for i := Low (WindowTypes) to High (WindowTypes) do | |
663 | with WindowTypes[i] do | |
664 | begin | |
665 | MinScreenSizeX := Max (MinScreenSizeX, MinSizeX + 2); | |
666 | MinScreenSizeY := Max (MinScreenSizeY, MinSizeY + 2) | |
667 | end; | |
668 | SSize := ScreenSize; | |
669 | Window (1, 1, SSize.x, SSize.y); | |
670 | if (SSize.x < MinScreenSizeX) or (SSize.y < MinScreenSizeY) then | |
671 | begin | |
672 | NormVideo; | |
673 | ClrScr; | |
674 | RestoreTerminal (True); | |
675 | WriteLn (StdErr, 'Sorry, your screen is too small for this demo (', SSize.x, 'x', SSize.y, ').'); | |
676 | WriteLn (StdErr, 'You need at least ', MinScreenSizeX, 'x', MinScreenSizeY, ' characters.'); | |
677 | Halt (2) | |
678 | end; | |
679 | PanelActivate (LastPanel); | |
680 | RedrawAll | |
681 | end; | |
682 | ||
683 | procedure Die; attribute (noreturn); | |
684 | begin | |
685 | NoSound; | |
686 | RestoreTerminalClearCRT; | |
687 | WriteLn (StdErr, 'You''re trying to kill me. Since I have break checking turned off,'); | |
688 | WriteLn (StdErr, 'I''m not dying, but I''ll do you a favour and terminate now.'); | |
689 | Halt (3) | |
690 | end; | |
691 | ||
692 | function GetKey (TimeOut: Integer) = Key: TKey; | |
693 | var | |
694 | NeedSelect, SelectValue: Integer; | |
695 | SimulateBlockCursorCurrent: TSimulateBlockCursorKind; | |
696 | SelectInput: array [1 .. 1] of PAnyFile = (@Input); | |
697 | NextSelectTime: MicroSecondTimeType = 0; attribute (static); | |
698 | TimeOutTime: MicroSecondTimeType; | |
699 | LastPanel: TPanel; | |
700 | p: PWindowList; | |
701 | begin | |
702 | LastPanel := GetActivePanel; | |
703 | if TimeOut < 0 then | |
704 | TimeOutTime := High (TimeOutTime) | |
705 | else | |
706 | TimeOutTime := GetMicroSecondTime + TimeOut; | |
707 | NeedSelect := 0; | |
708 | if TimeOut >= 0 then | |
709 | Inc (NeedSelect); | |
710 | SimulateBlockCursorCurrent := SimulateBlockCursorKind; | |
711 | if SimulateBlockCursorCurrent <> bc_None then | |
712 | Inc (NeedSelect); | |
713 | p := WindowList; | |
714 | repeat | |
715 | if @WindowTypes[p^.WindowType].PeriodicalProc <> nil then | |
716 | Inc (NeedSelect); | |
717 | p := p^.Next | |
718 | until p = WindowList; | |
719 | p := WindowList; | |
720 | repeat | |
721 | with p^, WindowTypes[WindowType] do | |
722 | if RedrawAlways then | |
723 | begin | |
724 | PanelActivate (Panel); | |
725 | ClrScr; | |
726 | DrawProc | |
727 | end; | |
728 | p := p^.Next | |
729 | until p = WindowList; | |
730 | if NeedSelect <> 0 then | |
731 | repeat | |
732 | CRTUpdate; | |
733 | SelectValue := IOSelectRead (SelectInput, Max (0, Min (NextSelectTime, TimeOutTime) - GetMicroSecondTime)); | |
734 | if SelectValue = 0 then | |
735 | begin | |
736 | case SimulateBlockCursorCurrent of | |
737 | bc_None : ; | |
738 | bc_Blink : SimulateBlockCursor; | |
739 | bc_Static: begin | |
740 | SimulateBlockCursor; | |
741 | SimulateBlockCursorCurrent := bc_None; | |
742 | Dec (NeedSelect) | |
743 | end | |
744 | end; | |
745 | NextSelectTime := GetMicroSecondTime + 120000; | |
746 | p := WindowList; | |
747 | repeat | |
748 | with p^, WindowTypes[WindowType] do | |
749 | if @PeriodicalProc <> nil then | |
750 | begin | |
751 | PanelActivate (Panel); | |
752 | PeriodicalProc | |
753 | end; | |
754 | p := p^.Next | |
755 | until p = WindowList | |
756 | end; | |
757 | until (NeedSelect = 0) or (SelectValue <> 0) or ((TimeOut >= 0) and (GetMicroSecondTime >= TimeOutTime)); | |
758 | if NeedSelect = 0 then | |
759 | SelectValue := 1; | |
760 | if SelectValue = 0 then | |
761 | Key := 0 | |
762 | else | |
763 | Key := ReadKeyWord; | |
764 | if SimulateBlockCursorKind <> bc_None then | |
765 | SimulateBlockCursorOff; | |
766 | if IsDeadlySignal (Key) then Die; | |
767 | if Key = kbScreenSizeChanged then CheckScreenSize; | |
768 | PanelActivate (LastPanel) | |
769 | end; | |
770 | ||
771 | function Menu = n: Integer; | |
772 | var | |
773 | i, ax, ay: Integer; | |
774 | Key: TKey; | |
775 | Done: Boolean; | |
776 | SSize: TPoint; | |
777 | begin | |
778 | n := 1; | |
779 | repeat | |
780 | SSize := ScreenSize; | |
781 | ax := (SSize.x - MenuXSize) div 2 + 1; | |
782 | ay := (SSize.y - MenuYSize) div 2 + 1; | |
783 | PanelNew (ax, ay, ax + MenuXSize - 1, ay + MenuYSize - 1, False); | |
784 | SetControlChars (True); | |
785 | TextColor (Blue); | |
786 | TextBackground (LightGray); | |
787 | FrameWin (' Select Window ', DoubleFrame, True); | |
788 | IgnoreCursor; | |
789 | PanelNew (ax + 1, ay + 1, ax + MenuXSize - 2, ay + MenuYSize - 2, False); | |
790 | ClrScr; | |
791 | TextColor (Black); | |
792 | SetScroll (False); | |
793 | Done := False; | |
794 | repeat | |
795 | for i := 1 to MenuMax do | |
796 | begin | |
797 | GotoXY (1, i); | |
798 | if i = n then | |
799 | TextBackground (Green) | |
800 | else | |
801 | TextBackground (LightGray); | |
802 | ClrEOL; | |
803 | Write (' ', WindowTypes[i].Name); | |
804 | ChangeTextAttr (2, i, 1, Red + $10 * GetTextBackground) | |
805 | end; | |
806 | Key := GetKey (-1); | |
807 | case LoCaseKey (Key) of | |
808 | kbUp : if n = 1 then n := MenuMax else Dec (n); | |
809 | kbDown : if n = MenuMax then n := 1 else Inc (n); | |
810 | kbHome, | |
811 | kbPgUp, | |
812 | kbCtrlPgUp, | |
813 | kbCtrlHome : n := 1; | |
814 | kbEnd, | |
815 | kbPgDn, | |
816 | kbCtrlPgDn, | |
817 | kbCtrlEnd : n := MenuMax; | |
818 | kbCR : Done := True; | |
819 | kbEsc, kbAltEsc : begin | |
820 | n := -1; | |
821 | Done := True | |
822 | end; | |
823 | Ord ('a') .. Ord ('z'): begin | |
824 | i := MenuMax; | |
825 | while (i > 0) and (LoCase (Key2Char (Key)) <> LoCase (WindowTypes[i].Name[1])) do Dec (i); | |
826 | if i > 0 then | |
827 | begin | |
828 | n := i; | |
829 | Done := True | |
830 | end | |
831 | end; | |
832 | end | |
833 | until Done or (Key = kbScreenSizeChanged); | |
834 | ClosePopUpWindow | |
835 | until Key <> kbScreenSizeChanged | |
836 | end; | |
837 | ||
838 | procedure NewWindow (WindowType, ax, ay: Integer); | |
839 | var | |
840 | p, LastWindow: PWindowList; | |
841 | MaxX1, MaxY1: Integer; | |
842 | SSize: TPoint; | |
843 | begin | |
844 | New (p); | |
845 | if WindowList = nil then | |
846 | begin | |
847 | p^.Prev := p; | |
848 | p^.Next := p | |
849 | end | |
850 | else | |
851 | begin | |
852 | p^.Prev := WindowList; | |
853 | p^.Next := WindowList^.Next; | |
854 | p^.Prev^.Next := p; | |
855 | p^.Next^.Prev := p; | |
856 | end; | |
857 | p^.WindowType := WindowType; | |
858 | with p^, WindowTypes[WindowType] do | |
859 | begin | |
860 | SSize := ScreenSize; | |
861 | if PrefSizeX > 0 then xs := PrefSizeX else xs := MinSizeX; | |
862 | if PrefSizeY > 0 then ys := PrefSizeY else ys := MinSizeY; | |
863 | xs := Min (xs + 2, SSize.x); | |
864 | ys := Min (ys + 2, SSize.y); | |
865 | MaxX1 := SSize.x - xs + 1; | |
866 | MaxY1 := SSize.y - ys + 1; | |
867 | if ax = 0 then x1 := Random (MaxX1) + 1 else x1 := Min (ax, MaxX1); | |
868 | if ay = 0 then y1 := Random (MaxY1) + 1 else y1 := Min (ay, MaxY1); | |
869 | if (ax = 0) and (PrefSizeX < 0) then Inc (xs, Random (SSize.x - x1 - xs + 2)); | |
870 | if (ax = 0) and (PrefSizeY < 0) then Inc (ys, Random (SSize.y - y1 - ys + 2)); | |
871 | State := ws_None; | |
872 | PanelNew (1, 1, 1, 1, False); | |
873 | FramePanel := GetActivePanel; | |
874 | SetControlChars (True); | |
875 | TextColor (Color); | |
876 | TextBackground (Background); | |
877 | PanelNew (1, 1, 1, 1, False); | |
878 | SetPCCharSet (False); | |
879 | Panel := GetActivePanel; | |
880 | end; | |
881 | LastWindow := WindowList; | |
882 | WindowList := p; | |
883 | if LastWindow <> nil then RedrawFrame (LastWindow); | |
884 | DrawWindow (p) | |
885 | end; | |
886 | ||
887 | procedure OpenWindow; | |
888 | var WindowType: Integer; | |
889 | begin | |
890 | WindowType := Menu; | |
891 | if WindowType >= 0 then NewWindow (WindowType, 0, 0) | |
892 | end; | |
893 | ||
894 | procedure NextWindow; | |
895 | var LastWindow: PWindowList; | |
896 | begin | |
897 | LastWindow := WindowList; | |
898 | WindowList := WindowList^.Next; | |
899 | PanelTop (WindowList^.FramePanel); | |
900 | PanelTop (WindowList^.Panel); | |
901 | RedrawFrame (LastWindow); | |
902 | RedrawFrame (WindowList) | |
903 | end; | |
904 | ||
905 | procedure PreviousWindow; | |
906 | var LastWindow: PWindowList; | |
907 | begin | |
908 | PanelMoveAbove (WindowList^.Panel, MainPanel); | |
909 | PanelMoveAbove (WindowList^.FramePanel, MainPanel); | |
910 | LastWindow := WindowList; | |
911 | WindowList := WindowList^.Prev; | |
912 | RedrawFrame (LastWindow); | |
913 | RedrawFrame (WindowList) | |
914 | end; | |
915 | ||
916 | procedure CloseWindow; | |
917 | var p: PWindowList; | |
918 | begin | |
919 | if WindowList^.WindowType <> 0 then | |
920 | begin | |
921 | p := WindowList; | |
922 | NextWindow; | |
923 | PanelDelete (p^.FramePanel); | |
924 | PanelDelete (p^.Panel); | |
925 | p^.Next^.Prev := p^.Prev; | |
926 | p^.Prev^.Next := p^.Next; | |
927 | Dispose (p) | |
928 | end | |
929 | end; | |
930 | ||
931 | procedure MoveWindow; | |
932 | var | |
933 | Done, Changed: Boolean; | |
934 | SSize: TPoint; | |
935 | begin | |
936 | with WindowList^ do | |
937 | begin | |
938 | Done := False; | |
939 | Changed := True; | |
940 | State := ws_Moving; | |
941 | repeat | |
942 | if Changed then DrawWindow (WindowList); | |
943 | Changed := True; | |
944 | case LoCaseKey (GetKey (-1)) of | |
945 | Ord ('s'), kbLeft : if x1 > 1 then Dec (x1); | |
946 | Ord ('d'), kbRight : if x1 + xs - 1 < ScreenSize.x then Inc (x1); | |
947 | Ord ('e'), kbUp : if y1 > 1 then Dec (y1); | |
948 | Ord ('x'), kbDown : if y1 + ys - 1 < ScreenSize.y then Inc (y1); | |
949 | Ord ('a'), kbHome : x1 := 1; | |
950 | Ord ('f'), kbEnd : x1 := ScreenSize.x - xs + 1; | |
951 | Ord ('r'), kbPgUp : y1 := 1; | |
952 | Ord ('c'), kbPgDn : y1 := ScreenSize.y - ys + 1; | |
953 | Ord ('y'), kbCtrlPgUp: begin | |
954 | x1 := 1; | |
955 | y1 := 1 | |
956 | end; | |
957 | Ord ('b'), kbCtrlPgDn: begin | |
958 | SSize := ScreenSize; | |
959 | x1 := SSize.x - xs + 1; | |
960 | y1 := SSize.y - ys + 1 | |
961 | end; | |
962 | kbCR, | |
963 | kbEsc, kbAltEsc : Done := True; | |
964 | else Changed := False | |
965 | end | |
966 | until Done; | |
967 | State := ws_None; | |
968 | DrawWindow (WindowList) | |
969 | end | |
970 | end; | |
971 | ||
972 | procedure ResizeWindow; | |
973 | var | |
974 | Done, Changed: Boolean; | |
975 | SSize: TPoint; | |
976 | begin | |
977 | with WindowList^, WindowTypes[WindowType] do | |
978 | begin | |
979 | Done := False; | |
980 | Changed := True; | |
981 | State := ws_Resizing; | |
982 | repeat | |
983 | if Changed then DrawWindow (WindowList); | |
984 | Changed := True; | |
985 | case LoCaseKey (GetKey (-1)) of | |
986 | Ord ('s'), kbLeft : if xs > MinSizeX + 2 then Dec (xs); | |
987 | Ord ('d'), kbRight : if x1 + xs - 1 < ScreenSize.x then Inc (xs); | |
988 | Ord ('e'), kbUp : if ys > MinSizeY + 2 then Dec (ys); | |
989 | Ord ('x'), kbDown : if y1 + ys - 1 < ScreenSize.y then Inc (ys); | |
990 | Ord ('a'), kbHome : xs := MinSizeX + 2; | |
991 | Ord ('f'), kbEnd : xs := ScreenSize.x - x1 + 1; | |
992 | Ord ('r'), kbPgUp : ys := MinSizeY + 2; | |
993 | Ord ('c'), kbPgDn : ys := ScreenSize.y - y1 + 1; | |
994 | Ord ('y'), kbCtrlPgUp: begin | |
995 | xs := MinSizeX + 2; | |
996 | ys := MinSizeY + 2 | |
997 | end; | |
998 | Ord ('b'), kbCtrlPgDn: begin | |
999 | SSize := ScreenSize; | |
1000 | xs := SSize.x - x1 + 1; | |
1001 | ys := SSize.y - y1 + 1 | |
1002 | end; | |
1003 | kbCR, | |
1004 | kbEsc, kbAltEsc : Done := True; | |
1005 | else Changed := False | |
1006 | end | |
1007 | until Done; | |
1008 | State := ws_None; | |
1009 | DrawWindow (WindowList) | |
1010 | end | |
1011 | end; | |
1012 | ||
1013 | procedure ActivateCursor; | |
1014 | begin | |
1015 | with WindowList^, WindowTypes[WindowType] do | |
1016 | begin | |
1017 | PanelActivate (Panel); | |
1018 | if WantCursor then | |
1019 | SetCursorShape (CursorShape) | |
1020 | else | |
1021 | HideCursor | |
1022 | end; | |
1023 | SetScroll (ScrollState) | |
1024 | end; | |
1025 | ||
1026 | var | |
1027 | Key: TKey; | |
1028 | ScreenShot, Done: Boolean; | |
1029 | ||
1030 | begin | |
1031 | ScreenShot := ParamStr (1) = '--screenshot'; | |
1032 | if ParamCount <> Ord (ScreenShot) then | |
1033 | begin | |
1034 | RestoreTerminal (True); | |
1035 | WriteLn (StdErr, ParamStr (0), ': invalid argument `', ParamStr (Ord (ScreenShot) + 1), ''''); | |
1036 | Halt (1) | |
1037 | end; | |
1038 | CRTSavePreviousScreen (True); | |
1039 | SetCRTUpdate (UpdateInput); | |
1040 | MainPanel := GetActivePanel; | |
1041 | CheckScreenSize; | |
1042 | OrigScreenSize := ScreenSize; | |
1043 | if ScreenShot then | |
1044 | begin | |
1045 | CursorShape := CursorBlock; | |
1046 | NewWindow (6, 1, 1); | |
1047 | NewWindow (2, 1, MaxInt); | |
1048 | NewWindow (8, MaxInt, 1); | |
1049 | NewWindow (5, 1, 27); | |
1050 | KeyDemoKey (Ord ('f')); | |
1051 | KeyDemoKey (246); | |
1052 | KeyDemoKey (kbDown); | |
1053 | NewWindow (3, MaxInt, 13); | |
1054 | NewWindow (4, MaxInt, 31); | |
1055 | NewWindow (7, MaxInt, MaxInt); | |
1056 | NewWindow (9, MaxInt, 33); | |
1057 | NewWindow (0, 1, 2); | |
1058 | NewWindow (1, 1, 14); | |
1059 | ActivateCursor; | |
1060 | OpenWindow | |
1061 | end | |
1062 | else | |
1063 | NewWindow (0, 3, 2); | |
1064 | Done := False; | |
1065 | repeat | |
1066 | ActivateCursor; | |
1067 | Key := GetKey (-1); | |
1068 | case LoCaseKey (Key) of | |
1069 | Ord ('3'), kbF3 : OpenWindow; | |
1070 | Ord ('4'), kbF4 : CloseWindow; | |
1071 | Ord ('5'), kbF5 : PreviousWindow; | |
1072 | Ord ('6'), kbF6 : NextWindow; | |
1073 | Ord ('7'), kbF7 : MoveWindow; | |
1074 | Ord ('8'), kbF8 : ResizeWindow; | |
1075 | Ord ('q'), kbEsc, | |
1076 | kbAltEsc: Done := True; | |
1077 | else | |
1078 | if WindowList <> nil then | |
1079 | with WindowList^, WindowTypes[WindowType] do | |
1080 | if @KeyProc <> nil then | |
1081 | begin | |
1082 | TextColor (Color); | |
1083 | TextBackground (Background); | |
1084 | KeyProc (Key) | |
1085 | end | |
1086 | end | |
1087 | until Done | |
1088 | end. |