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