Rev 735 | Go to most recent revision | Details | 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 *) |
||
| 6 | (* Revision: 2022-02-12 *) |
||
| 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); |
||
| 26 | procedure DrawTitleBar(str: string); |
||
| 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 | |||
| 190 | procedure DrawTitleBar(str: string); |
||
| 191 | begin |
||
| 192 | DrawTextBar(str, 1); |
||
| 193 | end; |
||
| 194 | |||
| 195 | procedure DrawStatusBar(str: string); |
||
| 196 | begin |
||
| 197 | DrawTextBar(str, ScreenHeight); |
||
| 198 | end; |
||
| 199 | |||
| 200 | function DrawSelectionList(X, Y, ListWidth, ListHeight: integer; |
||
| 201 | items: PStringList; allowESC: boolean; |
||
| 202 | Title: string; borderStrength: integer): integer; |
||
| 203 | var |
||
| 204 | i: integer; |
||
| 205 | itemIndex: integer; |
||
| 206 | sc: char; |
||
| 207 | iStartScope, iEndScope: integer; |
||
| 208 | label |
||
| 209 | doAgain; |
||
| 210 | begin |
||
| 211 | if borderStrength = 1 then |
||
| 212 | begin |
||
| 213 | DrawThinBorder(X-1, Y-1, ListWidth+2, ListHeight+2); |
||
| 214 | end; |
||
| 215 | |||
| 216 | if borderStrength = 2 then |
||
| 217 | begin |
||
| 218 | DrawDoubleBorder(X-1, Y-1, ListWidth+2, ListHeight+2); |
||
| 219 | end; |
||
| 220 | |||
| 221 | if Title <> '' then |
||
| 222 | begin |
||
| 223 | if borderStrength > 0 then |
||
| 224 | GoToXY(X+1, Y-1) |
||
| 225 | else |
||
| 226 | GoToXY(X, Y-1); |
||
| 227 | Write(Title); |
||
| 228 | end; |
||
| 229 | |||
| 230 | (*CursorOff;*) |
||
| 231 | |||
| 232 | itemIndex := 0; |
||
| 233 | iStartScope := itemIndex; |
||
| 234 | iEndScope := itemIndex + ListHeight; |
||
| 235 | |||
| 236 | doAgain: |
||
| 237 | |||
| 238 | if itemIndex < 0 then |
||
| 239 | itemIndex := 0; |
||
| 240 | if itemIndex > ListCount(items)-1 then |
||
| 241 | itemIndex := ListCount(items)-1; |
||
| 242 | |||
| 243 | if itemIndex < iStartScope then |
||
| 244 | begin |
||
| 245 | Dec(iEndScope); |
||
| 246 | Dec(iStartScope); |
||
| 247 | end; |
||
| 248 | |||
| 249 | if itemIndex > iEndScope-1 then |
||
| 250 | begin |
||
| 251 | Inc(iEndScope); |
||
| 252 | Inc(iStartScope); |
||
| 253 | end; |
||
| 254 | |||
| 255 | if borderStrength > 0 then |
||
| 256 | begin |
||
| 257 | (* Show scroll arrows *) |
||
| 258 | GotoXY(X+ListWidth, Y); |
||
| 259 | if iStartScope > 0 then |
||
| 260 | begin |
||
| 261 | TextBackground(White); |
||
| 262 | TextColor(Black); |
||
| 263 | WriteLn(#$18(*ArrowUp*)); |
||
| 264 | TextBackground(Black); |
||
| 265 | TextColor(White); |
||
| 266 | end |
||
| 267 | else if borderStrength = 1 then |
||
| 268 | WriteLn(ThinLineChars[4]) |
||
| 269 | else if borderStrength = 2 then |
||
| 270 | WriteLn(DoubleLineChars[4]); |
||
| 271 | |||
| 272 | GotoXY(X+ListWidth, Y+ListHeight-1); |
||
| 273 | if ListCount(items) > iEndScope then |
||
| 274 | begin |
||
| 275 | TextBackground(White); |
||
| 276 | TextColor(Black); |
||
| 277 | WriteLn(#$19(*ArrowDown*)); |
||
| 278 | TextBackground(Black); |
||
| 279 | TextColor(White); |
||
| 280 | end |
||
| 281 | else if borderStrength = 1 then |
||
| 282 | WriteLn(ThinLineChars[4]) |
||
| 283 | else if borderStrength = 2 then |
||
| 284 | WriteLn(DoubleLineChars[4]); |
||
| 285 | end; |
||
| 286 | |||
| 287 | for i := iStartScope to iEndScope-1 do |
||
| 288 | begin |
||
| 289 | if itemIndex = i then |
||
| 290 | begin |
||
| 291 | TextColor(Black); |
||
| 292 | TextBackground(White); |
||
| 293 | end |
||
| 294 | else |
||
| 295 | begin |
||
| 296 | TextColor(White); |
||
| 297 | TextBackground(Black); |
||
| 298 | end; |
||
| 299 | GotoXY(x,y+i-iStartScope); |
||
| 300 | if i > ListCount(items)-1 then |
||
| 301 | Write(FillRight('', ListWidth, ' ')) |
||
| 302 | else |
||
| 303 | Write(FillRight(ListGetElement(items, i), ListWidth, ' ')); |
||
| 304 | TextColor(White); |
||
| 305 | TextBackground(Black); |
||
| 306 | end; |
||
| 307 | |||
| 308 | repeat |
||
| 309 | GotoXY(ScreenWidth, ScreenHeight); |
||
| 310 | |||
| 311 | sc := ReadKey; |
||
| 312 | if sc = #$00(*ExtendedKeyCode*) then |
||
| 313 | begin |
||
| 314 | sc := ReadKey; |
||
| 315 | if sc = #$48(*UpKey*) then |
||
| 316 | begin |
||
| 317 | dec(itemIndex); |
||
| 318 | goto doAgain; |
||
| 319 | end |
||
| 320 | else if sc = #$50(*DownKey*) then |
||
| 321 | begin |
||
| 322 | inc(itemIndex); |
||
| 323 | goto doAgain; |
||
| 324 | end |
||
| 325 | else if sc = #$47(*POS1*) then |
||
| 326 | begin |
||
| 327 | itemIndex := 0; |
||
| 328 | goto doAgain; |
||
| 329 | end |
||
| 330 | else if sc = #$4F(*END*) then |
||
| 331 | begin |
||
| 332 | itemIndex := ListCount(items); |
||
| 333 | goto doAgain; |
||
| 334 | end; |
||
| 335 | end; |
||
| 336 | |||
| 337 | if sc = #13(*Return*) then |
||
| 338 | begin |
||
| 339 | DrawSelectionList := itemIndex; |
||
| 340 | break; |
||
| 341 | end; |
||
| 342 | |||
| 343 | if allowESC and (sc = #27(*ESC*)) then |
||
| 344 | begin |
||
| 345 | DrawSelectionList := -1; |
||
| 346 | break; |
||
| 347 | end; |
||
| 348 | until false; |
||
| 349 | |||
| 350 | (*CursorOn;*) |
||
| 351 | end; |
||
| 352 | |||
| 353 | procedure ClearSection(x, y, width, height: integer); |
||
| 354 | var |
||
| 355 | ix, iy: integer; |
||
| 356 | begin |
||
| 357 | for iy := y to y+height-1 do |
||
| 358 | begin |
||
| 359 | for ix := x to x+width-1 do |
||
| 360 | begin |
||
| 361 | GoToXY(ix,iy); |
||
| 362 | Write(' '); |
||
| 363 | end; |
||
| 364 | end; |
||
| 365 | end; |
||
| 366 | |||
| 367 | function QueryVal(var s: string; initX, initY, width, height: integer; |
||
| 368 | Title: string; borderStrength: integer): boolean; |
||
| 369 | var |
||
| 370 | x, y: integer; |
||
| 371 | i, j: integer; |
||
| 372 | sc: char; |
||
| 373 | stmp: string; |
||
| 374 | begin |
||
| 375 | if borderStrength = 1 then |
||
| 376 | DrawThinBorder(initX-1,initY-1,width+2,height+2); |
||
| 377 | if borderStrength = 2 then |
||
| 378 | DrawDoubleBorder(initX-1,initY-1,width+2,height+2); |
||
| 379 | if title <> '' then |
||
| 380 | begin |
||
| 381 | if borderStrength > 0 then |
||
| 382 | GoToXY(initX+1, initY-1) |
||
| 383 | else |
||
| 384 | GoToXY(initX, initY-1); |
||
| 385 | Write(title); |
||
| 386 | end; |
||
| 387 | ClearSection(initX,initY,width,height); |
||
| 388 | |||
| 389 | x := initX; |
||
| 390 | y := initY; |
||
| 391 | |||
| 392 | (* Write existing string value and set cursor *) |
||
| 393 | stmp := s; |
||
| 394 | s := ''; |
||
| 395 | for i := 1 to Length(stmp) do |
||
| 396 | begin |
||
| 397 | if stmp[i] = #10 then |
||
| 398 | begin |
||
| 399 | s := s + stmp[i]; |
||
| 400 | continue; |
||
| 401 | end; |
||
| 402 | |||
| 403 | GoToXY(x,y); |
||
| 404 | s := s + stmp[i]; |
||
| 405 | Write(stmp[i]); |
||
| 406 | Inc(x); |
||
| 407 | |||
| 408 | if (x=initX+width-1) and (y=initY+height-1) then |
||
| 409 | begin |
||
| 410 | (* Attention: Data following after this will be lost! *) |
||
| 411 | break; |
||
| 412 | end; |
||
| 413 | |||
| 414 | if stmp[i] = #13 then |
||
| 415 | begin |
||
| 416 | if y=initY+height-1 then |
||
| 417 | begin |
||
| 418 | (* Attention: Data following after this will be lost! *) |
||
| 419 | s := Copy(s, 1, Length(s)-1); |
||
| 420 | Dec(x); |
||
| 421 | break; |
||
| 422 | end; |
||
| 423 | x := initX; |
||
| 424 | Inc(y); |
||
| 425 | continue; |
||
| 426 | end; |
||
| 427 | |||
| 428 | if x=initX+width then |
||
| 429 | begin |
||
| 430 | Inc(y); |
||
| 431 | x := initX; |
||
| 432 | end; |
||
| 433 | end; |
||
| 434 | |||
| 435 | repeat |
||
| 436 | GotoXY(x, y); |
||
| 437 | sc := ReadKey; |
||
| 438 | |||
| 439 | if sc = #0 then |
||
| 440 | begin |
||
| 441 | (* Extended key code *) |
||
| 442 | sc := ReadKey; |
||
| 443 | (* TODO: Implement keys like DEL, END, POS1, and ArrowKeys *) |
||
| 444 | Beep; |
||
| 445 | continue; |
||
| 446 | end |
||
| 447 | else if sc = #8(*Backspace*) then |
||
| 448 | begin |
||
| 449 | if x <= initX then |
||
| 450 | begin |
||
| 451 | if y = initY then |
||
| 452 | begin |
||
| 453 | Beep; |
||
| 454 | continue; |
||
| 455 | end; |
||
| 456 | Dec(y); |
||
| 457 | |||
| 458 | (* Find out length of previous line *) |
||
| 459 | j := Length(s)-2(*CRLF*); |
||
| 460 | while (j >= 0) do |
||
| 461 | begin |
||
| 462 | if (s[j]=#13) or (s[j]=#10) then break; |
||
| 463 | Dec(j); |
||
| 464 | end; |
||
| 465 | j := Length(s)-2(*CRLF*)-j; |
||
| 466 | x := initX + j; |
||
| 467 | s := Copy(s, 1, Length(s)-1); (* Remove #10 now. #13 will be removed below *) |
||
| 468 | end |
||
| 469 | else |
||
| 470 | begin |
||
| 471 | Dec(x); |
||
| 472 | end; |
||
| 473 | GotoXY(x, y); |
||
| 474 | Write(' '); |
||
| 475 | GotoXY(x, y); |
||
| 476 | s := Copy(s, 1, Length(s)-1); |
||
| 477 | continue; |
||
| 478 | end |
||
| 479 | else if sc = #13(*Return*) then |
||
| 480 | begin |
||
| 481 | if GetShiftState and kbRightShift <> 0 then |
||
| 482 | begin |
||
| 483 | if y=initY+height-1 then |
||
| 484 | begin |
||
| 485 | Beep; |
||
| 486 | continue; |
||
| 487 | end; |
||
| 488 | s := s + #13 + #10; |
||
| 489 | x := initX; |
||
| 490 | Inc(y); |
||
| 491 | end |
||
| 492 | else |
||
| 493 | begin |
||
| 494 | QueryVal := true; |
||
| 495 | exit; |
||
| 496 | end; |
||
| 497 | end |
||
| 498 | else if sc = #27(*ESC*) then |
||
| 499 | begin |
||
| 500 | QueryVal := false; |
||
| 501 | exit; |
||
| 502 | end |
||
| 503 | else |
||
| 504 | begin |
||
| 505 | if (x=initX+width-1) and (y=initY+height-1) then |
||
| 506 | begin |
||
| 507 | Beep; |
||
| 508 | continue; |
||
| 509 | end; |
||
| 510 | s := s + sc; |
||
| 511 | Write(sc); |
||
| 512 | Inc(x); |
||
| 513 | if x >= initX+width then |
||
| 514 | begin |
||
| 515 | Inc(y); |
||
| 516 | x := initX; |
||
| 517 | end; |
||
| 518 | end; |
||
| 519 | until false; |
||
| 520 | end; |
||
| 521 | |||
| 522 | procedure ShowMessage(msg: string; title: string; dobeep: boolean); |
||
| 523 | var |
||
| 524 | x, y, w, h: integer; |
||
| 525 | begin |
||
| 526 | x := SINGLE_LINE_BOX_PADDING_INNER; |
||
| 527 | y := ScreenHeight div 2 - 1; |
||
| 528 | w := ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2; |
||
| 529 | h := 1; |
||
| 530 | DrawDoubleBorder(x-1, y, w+2, h+2); |
||
| 531 | ClearSection(x, y+1, w-2, h); |
||
| 532 | if title <> '' then |
||
| 533 | begin |
||
| 534 | GoToXY(x+1, y); |
||
| 535 | Write(title); |
||
| 536 | end; |
||
| 537 | GoToXY(x, y+1); |
||
| 538 | Write(msg); |
||
| 539 | if DoBeep then Beep; |
||
| 540 | end; |
||
| 541 | |||
| 542 | end. |