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