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