Rev 738 | Rev 747 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
733 | daniel-mar | 1 | unit VTSCUI; |
2 | |||
3 | (************************************************) |
||
4 | (* VTSCUI.PAS *) |
||
5 | (* Author: Daniel Marschall *) |
||
735 | daniel-mar | 6 | (* Revision: 2022-02-14 *) |
733 | daniel-mar | 7 | (* License: Apache 2.0 *) |
8 | (* This file contains: *) |
||
9 | (* - ViaThinkSoft CUI (Console User Interface) *) |
||
10 | (************************************************) |
||
11 | |||
12 | interface |
||
13 | |||
14 | uses |
||
15 | StrList; |
||
16 | |||
17 | const |
||
18 | ScreenWidth = 80; |
||
19 | ScreenHeight = 25; |
||
20 | SINGLE_LINE_BOX_PADDING = 3; |
||
21 | SINGLE_LINE_BOX_PADDING_INNER = 10; |
||
22 | |||
23 | procedure DrawThinBorder(x, y, width, height: integer); |
||
24 | procedure DrawDoubleBorder(x, y, width, height: integer); |
||
25 | procedure DrawTextBar(str: string; line: integer); |
||
738 | daniel-mar | 26 | procedure DrawTitleBar(center, left, right: string); |
733 | daniel-mar | 27 | procedure DrawStatusBar(str: string); |
28 | function DrawSelectionList(X, Y, ListWidth, ListHeight: integer; |
||
29 | items: PStringList; allowESC: boolean; |
||
30 | Title: string; borderStrength: integer): integer; |
||
31 | procedure ClearSection(x, y, width, height: integer); |
||
32 | function QueryVal(var s: string; initX, initY, width, height: integer; |
||
33 | Title: string; borderStrength: integer): boolean; |
||
34 | procedure ShowMessage(msg: string; title: string; dobeep: boolean); |
||
35 | |||
36 | implementation |
||
37 | |||
38 | uses |
||
39 | Crt, Drivers, VtsFuncs; |
||
40 | |||
41 | type |
||
42 | TCharDefs = array[0..7] of char; |
||
43 | |||
44 | const |
||
45 | ThinLineChars: TCharDefs = |
||
46 | ( #$DA, #$C4, #$BF, |
||
47 | #$B3, #$B3, |
||
48 | #$C0, #$C4, #$D9 |
||
49 | ); |
||
50 | DoubleLineChars: TCharDefs = |
||
51 | ( #$C9, #$CD, #$BB, |
||
52 | #$BA, #$BA, |
||
53 | #$C8, #$CD, #$BC |
||
54 | ); |
||
55 | |||
56 | function FillRight(str: string; len: integer; c: char): string; |
||
57 | var |
||
58 | s: string; |
||
59 | i: integer; |
||
60 | begin |
||
61 | s := str; |
||
62 | for i := Length(str) to len-1 do |
||
63 | begin |
||
64 | s := s + c; |
||
65 | end; |
||
66 | FillRight := s; |
||
67 | end; |
||
68 | |||
69 | procedure DrawBorder(x, y, width, height, thickness: integer); |
||
70 | var |
||
71 | ix,iy: integer; |
||
72 | chars: TCharDefs; |
||
73 | begin |
||
74 | if thickness = 1 then |
||
75 | chars := ThinLineChars; |
||
76 | if thickness = 2 then |
||
77 | chars := DoubleLineChars; |
||
78 | |||
79 | (* Top line *) |
||
80 | if y >= 1 then |
||
81 | begin |
||
82 | (* Top left corner *) |
||
83 | if x >= 1 then |
||
84 | begin |
||
85 | GotoXY(x,y); |
||
86 | Write(chars[0]); |
||
87 | end |
||
88 | else |
||
89 | begin |
||
90 | GotoXY(1,y); |
||
91 | end; |
||
92 | |||
93 | (* Top edge *) |
||
94 | for ix := 1 to width-2 do |
||
95 | Write(chars[1]); |
||
96 | |||
97 | (* Top right corner *) |
||
98 | if x+width-1 <= ScreenWidth then |
||
99 | Write(chars[2]); |
||
100 | end; |
||
101 | |||
102 | (* Left edge *) |
||
103 | for iy := 1 to height-2 do |
||
104 | begin |
||
105 | if (x >= 1) and (x <= ScreenWidth) and |
||
106 | (y+iy >= 1) and (y+iy <= ScreenHeight) then |
||
107 | begin |
||
108 | GotoXY(x,y+iy); |
||
109 | Write(chars[3]); |
||
110 | end; |
||
111 | end; |
||
112 | |||
113 | (* Right edge *) |
||
114 | for iy := 1 to height-2 do |
||
115 | begin |
||
116 | if (x+width-1 >= 1) and (x+width-1 <= ScreenWidth) and |
||
117 | (y+iy >= 1) and (y+iy <= ScreenHeight) then |
||
118 | begin |
||
119 | GotoXY(x+width-1,y+iy); |
||
120 | Write(chars[4]); |
||
121 | end; |
||
122 | end; |
||
123 | |||
124 | (* Bottom line *) |
||
125 | if y+height-1 <= ScreenHeight then |
||
126 | begin |
||
127 | (* Bottom left corner *) |
||
128 | if x >= 1 then |
||
129 | begin |
||
130 | GotoXY(x,y+height-1); |
||
131 | Write(chars[5]); |
||
132 | end |
||
133 | else |
||
134 | begin |
||
135 | GotoXY(1,y+height-1); |
||
136 | end; |
||
137 | |||
138 | (* Bottom edge *) |
||
139 | for ix := 1 to width-2 do |
||
140 | Write(chars[6]); |
||
141 | |||
142 | (* Bottom right corner *) |
||
143 | if x+width-1 <= ScreenWidth then |
||
144 | Write(chars[7]); |
||
145 | end; |
||
146 | end; |
||
147 | |||
148 | procedure DrawThinBorder(x, y, width, height: integer); |
||
149 | begin |
||
150 | DrawBorder(x, y, width, height, 1); |
||
151 | end; |
||
152 | |||
153 | procedure DrawDoubleBorder(x, y, width, height: integer); |
||
154 | begin |
||
155 | DrawBorder(x, y, width, height, 2); |
||
156 | end; |
||
157 | |||
158 | procedure DrawTextBar(str: string; line: integer); |
||
159 | var |
||
160 | i, left, right: integer; |
||
161 | len: integer; |
||
162 | begin |
||
163 | GotoXY(1,line); |
||
164 | |||
165 | TextBackground(White); |
||
166 | TextColor(Black); |
||
167 | len := Length(str); |
||
168 | |||
169 | left := round((ScreenWidth-len)/2); |
||
170 | right := ScreenWidth - left - len; |
||
171 | |||
172 | for i := 1 to left do |
||
173 | begin |
||
174 | Write(' '); |
||
175 | end; |
||
176 | |||
177 | Write(str); |
||
178 | |||
179 | (* TODO: If we do "for i := 1 to right", then the console will scroll *) |
||
180 | (* since the char in the right bottom corner is written! *) |
||
181 | for i := 1 to right-1 do |
||
182 | begin |
||
183 | Write(' '); |
||
184 | end; |
||
185 | |||
186 | TextBackground(Black); |
||
187 | TextColor(White); |
||
188 | end; |
||
189 | |||
738 | daniel-mar | 190 | procedure DrawTitleBar(center, left, right: string); |
733 | daniel-mar | 191 | begin |
738 | daniel-mar | 192 | DrawTextBar(center, 1); |
193 | |||
194 | (* Put left text into the title bar *) |
||
195 | GoToXY(1,1); |
||
196 | TextBackground(White); |
||
197 | TextColor(Black); |
||
198 | WriteLn(left); |
||
199 | TextBackground(Black); |
||
200 | TextColor(White); |
||
201 | |||
202 | (* Put right text into the title bar *) |
||
203 | GotoXY(ScreenWidth-Length(right)+1,1); |
||
204 | TextBackground(White); |
||
205 | TextColor(Black); |
||
206 | WriteLn(right); |
||
207 | TextBackground(Black); |
||
208 | TextColor(White); |
||
733 | daniel-mar | 209 | end; |
210 | |||
211 | procedure DrawStatusBar(str: string); |
||
212 | begin |
||
213 | DrawTextBar(str, ScreenHeight); |
||
214 | end; |
||
215 | |||
216 | function DrawSelectionList(X, Y, ListWidth, ListHeight: integer; |
||
217 | items: PStringList; allowESC: boolean; |
||
218 | Title: string; borderStrength: integer): integer; |
||
219 | var |
||
220 | i: integer; |
||
221 | itemIndex: integer; |
||
222 | sc: char; |
||
223 | iStartScope, iEndScope: integer; |
||
735 | daniel-mar | 224 | sTmp: string; |
733 | daniel-mar | 225 | label |
226 | doAgain; |
||
227 | begin |
||
228 | if borderStrength = 1 then |
||
229 | begin |
||
230 | DrawThinBorder(X-1, Y-1, ListWidth+2, ListHeight+2); |
||
231 | end; |
||
232 | |||
233 | if borderStrength = 2 then |
||
234 | begin |
||
235 | DrawDoubleBorder(X-1, Y-1, ListWidth+2, ListHeight+2); |
||
236 | end; |
||
237 | |||
238 | if Title <> '' then |
||
239 | begin |
||
240 | if borderStrength > 0 then |
||
241 | GoToXY(X+1, Y-1) |
||
242 | else |
||
243 | GoToXY(X, Y-1); |
||
244 | Write(Title); |
||
245 | end; |
||
246 | |||
247 | (*CursorOff;*) |
||
248 | |||
249 | itemIndex := 0; |
||
250 | iStartScope := itemIndex; |
||
251 | iEndScope := itemIndex + ListHeight; |
||
252 | |||
253 | doAgain: |
||
254 | |||
255 | if itemIndex < 0 then |
||
256 | itemIndex := 0; |
||
257 | if itemIndex > ListCount(items)-1 then |
||
258 | itemIndex := ListCount(items)-1; |
||
259 | |||
260 | if itemIndex < iStartScope then |
||
261 | begin |
||
262 | Dec(iEndScope); |
||
263 | Dec(iStartScope); |
||
264 | end; |
||
265 | |||
266 | if itemIndex > iEndScope-1 then |
||
267 | begin |
||
268 | Inc(iEndScope); |
||
269 | Inc(iStartScope); |
||
270 | end; |
||
271 | |||
272 | if borderStrength > 0 then |
||
273 | begin |
||
274 | (* Show scroll arrows *) |
||
275 | GotoXY(X+ListWidth, Y); |
||
276 | if iStartScope > 0 then |
||
277 | begin |
||
278 | TextBackground(White); |
||
279 | TextColor(Black); |
||
280 | WriteLn(#$18(*ArrowUp*)); |
||
281 | TextBackground(Black); |
||
282 | TextColor(White); |
||
283 | end |
||
284 | else if borderStrength = 1 then |
||
285 | WriteLn(ThinLineChars[4]) |
||
286 | else if borderStrength = 2 then |
||
287 | WriteLn(DoubleLineChars[4]); |
||
288 | |||
289 | GotoXY(X+ListWidth, Y+ListHeight-1); |
||
290 | if ListCount(items) > iEndScope then |
||
291 | begin |
||
292 | TextBackground(White); |
||
293 | TextColor(Black); |
||
294 | WriteLn(#$19(*ArrowDown*)); |
||
295 | TextBackground(Black); |
||
296 | TextColor(White); |
||
297 | end |
||
298 | else if borderStrength = 1 then |
||
299 | WriteLn(ThinLineChars[4]) |
||
300 | else if borderStrength = 2 then |
||
301 | WriteLn(DoubleLineChars[4]); |
||
302 | end; |
||
303 | |||
304 | for i := iStartScope to iEndScope-1 do |
||
305 | begin |
||
306 | if itemIndex = i then |
||
307 | begin |
||
308 | TextColor(Black); |
||
309 | TextBackground(White); |
||
310 | end |
||
311 | else |
||
312 | begin |
||
313 | TextColor(White); |
||
314 | TextBackground(Black); |
||
315 | end; |
||
316 | GotoXY(x,y+i-iStartScope); |
||
317 | if i > ListCount(items)-1 then |
||
318 | Write(FillRight('', ListWidth, ' ')) |
||
319 | else |
||
735 | daniel-mar | 320 | begin |
321 | sTmp := ListGetElement(items, i); |
||
740 | daniel-mar | 322 | sTmp := TrimLineToWidth(sTmp, ListWidth); |
735 | daniel-mar | 323 | Write(FillRight(sTmp, ListWidth, ' ')); |
324 | end; |
||
733 | daniel-mar | 325 | TextColor(White); |
326 | TextBackground(Black); |
||
327 | end; |
||
328 | |||
329 | repeat |
||
330 | GotoXY(ScreenWidth, ScreenHeight); |
||
331 | |||
332 | sc := ReadKey; |
||
333 | if sc = #$00(*ExtendedKeyCode*) then |
||
334 | begin |
||
335 | sc := ReadKey; |
||
336 | if sc = #$48(*UpKey*) then |
||
337 | begin |
||
338 | dec(itemIndex); |
||
339 | goto doAgain; |
||
340 | end |
||
341 | else if sc = #$50(*DownKey*) then |
||
342 | begin |
||
343 | inc(itemIndex); |
||
344 | goto doAgain; |
||
345 | end |
||
346 | else if sc = #$47(*POS1*) then |
||
347 | begin |
||
348 | itemIndex := 0; |
||
740 | daniel-mar | 349 | iStartScope := 0; |
350 | iEndScope := iStartScope + ListHeight; |
||
733 | daniel-mar | 351 | goto doAgain; |
352 | end |
||
353 | else if sc = #$4F(*END*) then |
||
354 | begin |
||
740 | daniel-mar | 355 | itemIndex := ListCount(items)-1; |
356 | iStartScope := itemIndex - Min(ListHeight,ListCount(items)); |
||
357 | iEndScope := itemIndex; |
||
733 | daniel-mar | 358 | goto doAgain; |
359 | end; |
||
360 | end; |
||
361 | |||
362 | if sc = #13(*Return*) then |
||
363 | begin |
||
364 | DrawSelectionList := itemIndex; |
||
365 | break; |
||
366 | end; |
||
367 | |||
368 | if allowESC and (sc = #27(*ESC*)) then |
||
369 | begin |
||
370 | DrawSelectionList := -1; |
||
371 | break; |
||
372 | end; |
||
373 | until false; |
||
374 | |||
375 | (*CursorOn;*) |
||
376 | end; |
||
377 | |||
378 | procedure ClearSection(x, y, width, height: integer); |
||
379 | var |
||
380 | ix, iy: integer; |
||
381 | begin |
||
382 | for iy := y to y+height-1 do |
||
383 | begin |
||
384 | for ix := x to x+width-1 do |
||
385 | begin |
||
386 | GoToXY(ix,iy); |
||
387 | Write(' '); |
||
388 | end; |
||
389 | end; |
||
390 | end; |
||
391 | |||
392 | function QueryVal(var s: string; initX, initY, width, height: integer; |
||
393 | Title: string; borderStrength: integer): boolean; |
||
394 | var |
||
395 | x, y: integer; |
||
396 | i, j: integer; |
||
397 | sc: char; |
||
398 | stmp: string; |
||
399 | begin |
||
400 | if borderStrength = 1 then |
||
401 | DrawThinBorder(initX-1,initY-1,width+2,height+2); |
||
402 | if borderStrength = 2 then |
||
403 | DrawDoubleBorder(initX-1,initY-1,width+2,height+2); |
||
404 | if title <> '' then |
||
405 | begin |
||
406 | if borderStrength > 0 then |
||
407 | GoToXY(initX+1, initY-1) |
||
408 | else |
||
409 | GoToXY(initX, initY-1); |
||
410 | Write(title); |
||
411 | end; |
||
412 | ClearSection(initX,initY,width,height); |
||
413 | |||
414 | x := initX; |
||
415 | y := initY; |
||
416 | |||
417 | (* Write existing string value and set cursor *) |
||
418 | stmp := s; |
||
419 | s := ''; |
||
420 | for i := 1 to Length(stmp) do |
||
421 | begin |
||
422 | if stmp[i] = #10 then |
||
423 | begin |
||
424 | s := s + stmp[i]; |
||
425 | continue; |
||
426 | end; |
||
427 | |||
428 | GoToXY(x,y); |
||
429 | s := s + stmp[i]; |
||
430 | Write(stmp[i]); |
||
431 | Inc(x); |
||
432 | |||
433 | if (x=initX+width-1) and (y=initY+height-1) then |
||
434 | begin |
||
435 | (* Attention: Data following after this will be lost! *) |
||
436 | break; |
||
437 | end; |
||
438 | |||
439 | if stmp[i] = #13 then |
||
440 | begin |
||
441 | if y=initY+height-1 then |
||
442 | begin |
||
443 | (* Attention: Data following after this will be lost! *) |
||
444 | s := Copy(s, 1, Length(s)-1); |
||
445 | Dec(x); |
||
446 | break; |
||
447 | end; |
||
448 | x := initX; |
||
449 | Inc(y); |
||
450 | continue; |
||
451 | end; |
||
452 | |||
453 | if x=initX+width then |
||
454 | begin |
||
455 | Inc(y); |
||
456 | x := initX; |
||
457 | end; |
||
458 | end; |
||
459 | |||
460 | repeat |
||
461 | GotoXY(x, y); |
||
462 | sc := ReadKey; |
||
463 | |||
464 | if sc = #0 then |
||
465 | begin |
||
466 | (* Extended key code *) |
||
467 | sc := ReadKey; |
||
468 | (* TODO: Implement keys like DEL, END, POS1, and ArrowKeys *) |
||
469 | Beep; |
||
470 | continue; |
||
471 | end |
||
472 | else if sc = #8(*Backspace*) then |
||
473 | begin |
||
474 | if x <= initX then |
||
475 | begin |
||
476 | if y = initY then |
||
477 | begin |
||
478 | Beep; |
||
479 | continue; |
||
480 | end; |
||
481 | Dec(y); |
||
482 | |||
483 | (* Find out length of previous line *) |
||
484 | j := Length(s)-2(*CRLF*); |
||
485 | while (j >= 0) do |
||
486 | begin |
||
487 | if (s[j]=#13) or (s[j]=#10) then break; |
||
488 | Dec(j); |
||
489 | end; |
||
490 | j := Length(s)-2(*CRLF*)-j; |
||
491 | x := initX + j; |
||
492 | s := Copy(s, 1, Length(s)-1); (* Remove #10 now. #13 will be removed below *) |
||
493 | end |
||
494 | else |
||
495 | begin |
||
496 | Dec(x); |
||
497 | end; |
||
498 | GotoXY(x, y); |
||
499 | Write(' '); |
||
500 | GotoXY(x, y); |
||
501 | s := Copy(s, 1, Length(s)-1); |
||
502 | continue; |
||
503 | end |
||
504 | else if sc = #13(*Return*) then |
||
505 | begin |
||
506 | if GetShiftState and kbRightShift <> 0 then |
||
507 | begin |
||
508 | if y=initY+height-1 then |
||
509 | begin |
||
510 | Beep; |
||
511 | continue; |
||
512 | end; |
||
513 | s := s + #13 + #10; |
||
514 | x := initX; |
||
515 | Inc(y); |
||
516 | end |
||
517 | else |
||
518 | begin |
||
519 | QueryVal := true; |
||
520 | exit; |
||
521 | end; |
||
522 | end |
||
523 | else if sc = #27(*ESC*) then |
||
524 | begin |
||
525 | QueryVal := false; |
||
526 | exit; |
||
527 | end |
||
528 | else |
||
529 | begin |
||
530 | if (x=initX+width-1) and (y=initY+height-1) then |
||
531 | begin |
||
532 | Beep; |
||
533 | continue; |
||
534 | end; |
||
535 | s := s + sc; |
||
536 | Write(sc); |
||
537 | Inc(x); |
||
538 | if x >= initX+width then |
||
539 | begin |
||
540 | Inc(y); |
||
541 | x := initX; |
||
542 | end; |
||
543 | end; |
||
544 | until false; |
||
545 | end; |
||
546 | |||
547 | procedure ShowMessage(msg: string; title: string; dobeep: boolean); |
||
548 | var |
||
549 | x, y, w, h: integer; |
||
550 | begin |
||
551 | x := SINGLE_LINE_BOX_PADDING_INNER; |
||
552 | y := ScreenHeight div 2 - 1; |
||
553 | w := ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2; |
||
554 | h := 1; |
||
555 | DrawDoubleBorder(x-1, y, w+2, h+2); |
||
556 | ClearSection(x, y+1, w-2, h); |
||
557 | if title <> '' then |
||
558 | begin |
||
559 | GoToXY(x+1, y); |
||
560 | Write(title); |
||
561 | end; |
||
562 | GoToXY(x, y+1); |
||
563 | Write(msg); |
||
564 | if DoBeep then Beep; |
||
565 | end; |
||
566 | |||
567 | end. |