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