Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * TERM.MOD - COMMS Toolkit terminal emulation * 5 * * 6 * COPYRIGHT (C) 1988..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 IMPLEMENTATION MODULE Term; 12 IMPORT SYSTEM,Lib,IO,Str,Window,Keyboard; 13 14 TYPE 15 CharSets = (UK,US,SpecialChar); 16 Attributes = (Blue,Green,Red,Bold,BlueBack,GreenBack,RedBack,Blink); 17 AttrSet = SET OF Attributes; ***** ^ not supported yet 18 AttributeMap = ARRAY[0..23],[0..79] OF AttrSet; ***** ^ not supported yet 19 CharMap = ARRAY[0..23],[0..79] OF CHAR; 20 21 CONST 22 NormalAttr = AttrSet{Blue,Green,Red}; (* Lightgray on Black *) 23 24 VAR 25 G0,G1,CurrCharSet : CharSets; 26 (* for handling protected field attributes *) 27 CurrAttr,ProtAttr : AttrSet; 28 Map : AttributeMap; 29 ScrMap : CharMap; 30 cx,cy,p1,p2, 31 ScreenTop, 32 ScreenBottom : CARDINAL; 33 DECPrivate, 34 OriginMode,AutoWrap, 35 NewLineMode,KbdLocked, 36 LocalEcho,ANSIKeys, 37 NumKeyPad,Protected, 38 EditMode,DeferredEdit, 39 DeferredTransmit, 40 TransmitOK, 41 WantsFullPage, 42 Initialised : BOOLEAN; 43 TransmitMode : (Line,PartialPage,FullPage); 44 VTMode : Emulations; 45 RxState : (Normal,GotESC,GotBrack,GotLParen,GotRParen,GotHash,ReadingP1,ReadingP2,VT52Line,VT52Col,ANSICmd); 46 TabStop : ARRAY[0..79] OF BOOLEAN; 47 CSave : RECORD 48 cx,cy : CARDINAL; 49 Top,Bottom : CARDINAL; 50 OrgMode : BOOLEAN; 51 END; 52 Kbd : RECORD 53 rptr,wptr : CARDINAL; 54 Buff : ARRAY[0..255] OF CHAR; 55 END; 56 57 (*.............................................*) 58 59 PROCEDURE SetColor(NewAttr:AttrSet); 60 BEGIN 61 Window.TextColor(VAL(Window.Color,SHORTCARD(NewAttr) MOD 16)); 62 Window.TextBackground(VAL(Window.Color,SHORTCARD(NewAttr) DIV 16)); 63 END SetColor; 64 65 (*.............................................*) 66 67 PROCEDURE ResetTerm; 68 VAR 69 i : CARDINAL; 70 BEGIN 71 VTMode := EmVT100; 72 RxState := Normal; 73 G0 := US; 74 G1 := SpecialChar; 75 CurrCharSet := G0; 76 ScreenTop := 0; 77 ScreenBottom := 23; 78 OriginMode := FALSE; 79 AutoWrap := TRUE; 80 NewLineMode := FALSE; 81 KbdLocked := FALSE; 82 LocalEcho := FALSE; 83 ANSIKeys := TRUE; 84 NumKeyPad := TRUE; 85 Protected := FALSE; 86 EditMode := FALSE; 87 DeferredEdit := FALSE; 88 DeferredTransmit := FALSE; 89 TransmitMode := Line; 90 WantsFullPage := FALSE; 91 CurrAttr := NormalAttr; 92 ProtAttr := CurrAttr; 93 SetColor(CurrAttr); 94 Lib.Fill(ADR(Map),SIZE(Map),NormalAttr); 95 Lib.Fill(ADR(ScrMap),SIZE(ScrMap),' '); 96 cx := 0; 97 cy := 0; 98 WITH CSave DO 99 cx := 0; 100 cy := 0; 101 Top := 0; 102 Bottom := 23; 103 OrgMode := FALSE; 104 END; 105 FOR i:=0 TO 79 DO 106 TabStop[i] := (i MOD 8)=0; 107 END; 108 WITH Kbd DO 109 rptr := 0; 110 wptr := 0; 111 END; 112 END ResetTerm; 113 114 (*.............................................*) 115 116 PROCEDURE StuffKbdBuffer(s:ARRAY OF CHAR; Lnth:CARDINAL); 117 VAR 118 i : CARDINAL; 119 BEGIN 120 i:=0; 121 WHILE i23 THEN 135 y:=23; 136 END; 137 IF x>79 THEN 138 x:=79; 139 END; 140 Window.GotoXY(x+1,y+1); 141 cx:=x; 142 cy:=y; 143 END GotoXY; 144 145 (*.............................................*) 146 147 PROCEDURE SelectEmulation(Which:Emulations); 148 BEGIN 149 ResetTerm; 150 Window.Clear; 151 GotoXY(0,0); 152 VTMode := Which; 153 END SelectEmulation; 154 155 (*.............................................*) 156 157 PROCEDURE Scroll(lines:INTEGER); 158 VAR 159 i : CARDINAL; 160 x,y : CARDINAL; 161 l : ARRAY[0..Window.ScreenWidth-1] OF WORD; 162 BEGIN 163 (* Do physical scroll *) 164 x := Window.WhereX(); 165 y := Window.WhereY(); 166 IF lines = 0 THEN 167 FOR i := ScreenTop+1 TO ScreenBottom+1 DO 168 Window.GotoXY(1,i); 169 Window.ClrEol; 170 END; 171 ELSE 172 REPEAT 173 IF lines < 0 THEN 174 FOR i := ScreenBottom TO ScreenTop+1 BY -1 DO 175 Window.RdBufferLn(Window.Used(),1,i,SYSTEM.ADR(l),80); 176 Window.WrBufferLn(Window.Used(),1,i+1,SYSTEM.ADR(l),80); 177 END; 178 Window.GotoXY(1,ScreenTop+1); 179 Window.ClrEol; 180 INC(lines); 181 ELSE 182 FOR i := ScreenTop+2 TO ScreenBottom+1 DO 183 Window.RdBufferLn(Window.Used(),1,i,SYSTEM.ADR(l),80); 184 Window.WrBufferLn(Window.Used(),1,i-1,SYSTEM.ADR(l),80); 185 END; 186 Window.GotoXY(1,ScreenBottom+1); 187 Window.ClrEol; 188 DEC(lines); 189 END; 190 UNTIL ABS(lines) = 0; 191 END; 192 Window.GotoXY(x,y); 193 (* Now scroll attribute map *) 194 IF lines<>0 THEN 195 IF lines>0 THEN (* Scroll up *) 196 i:=ScreenTop; 197 REPEAT 198 Map[i] := Map[i+1]; 199 ScrMap[i] := ScrMap[i+1]; 200 INC(i); 201 UNTIL i=ScreenBottom; 202 ELSE (* Scroll down *) 203 i:=ScreenBottom; 204 REPEAT 205 Map[i] := Map[i-1]; 206 ScrMap[i] := ScrMap[i-1]; 207 DEC(i); 208 UNTIL i=ScreenTop; 209 END; 210 Lib.Fill(ADR(Map[i]),80,NormalAttr); 211 Lib.Fill(ADR(ScrMap[i]),80,' '); 212 END; 213 END Scroll; 214 215 (*.......................................*) 216 217 PROCEDURE Translate(c:CHAR):CHAR; 218 CONST 219 FormChars = ' ±????øñ??Ù¿ÚÀÅÄÄÄÄÄôÁ³óòãØœ='; 220 BEGIN 221 IF CurrCharSet<>US THEN 222 IF CurrCharSet=SpecialChar THEN 223 IF (c>=CHR(95)) AND (c<=CHR(126)) THEN 224 c := FormChars[ORD(c)-95]; 225 END; 226 ELSIF c='#' THEN (* Must be UK char set *) 227 c := 'œ'; 228 END; 229 END; 230 RETURN c; 231 END Translate; 232 233 (*.............................................*) 234 235 PROCEDURE FindUnprotected():BOOLEAN; 236 BEGIN 237 IF Map[cy,cx]-ProtAttr<>AttrSet{} THEN RETURN(TRUE) END; 238 LOOP 239 IF Map[cy,cx]-ProtAttr=AttrSet{} THEN 240 (* on a protected char position - skip! *) 241 IF cx=79 THEN 242 IF cy0 THEN 265 GotoXY(cx-1,cy); 266 END; | 267 9 : IF cx<79 THEN 268 REPEAT 269 INC(cx); 270 UNTIL (cx=79) OR (TabStop[cx]); 271 GotoXY(cx,cy); 272 END; | 273 10..12 : IF NewLineMode THEN 274 cx:=0; 275 END; 276 IF cy=ScreenBottom THEN 277 Scroll(1); 278 ELSE 279 INC(cy); 280 END; 281 GotoXY(cx,cy); | 282 13 : GotoXY(0,cy); | 283 14 : CurrCharSet := G1; | 284 15 : CurrCharSet := G0; | 285 END 286 ELSE 287 IF (NOT Protected) OR FindUnprotected() THEN 288 Map[cy,cx] := CurrAttr; 289 ScrMap[cy,cx] := c; 290 IO.WrChar(Translate(c)); 291 IF (cx=79) AND (AutoWrap) THEN 292 Output(CHR(10)); GotoXY(0,cy); 293 ELSIF cx<79 THEN 294 INC(cx); 295 END; 296 END; 297 END; 298 END Output; 299 300 (*.............................................*) 301 302 PROCEDURE DECModeChange(c:CHAR); 303 VAR 304 Lnth : CARDINAL; 305 Seq : ARRAY[0..9] OF CHAR; 306 BEGIN 307 CASE p1 OF 308 0 : (*Error -ignore*) | 309 1 : (*Cursor Key*) 310 IF NOT NumKeyPad THEN 311 ANSIKeys := c='l'; 312 END; | 313 2 : IF c='l' THEN 314 SelectEmulation(EmVT52); 315 END; | 316 3 : (*Select 80/132 Columns - not supported*) | 317 4 : (*Select smooth/jump scrolling - not supported*)| 318 5 : (*Normal or Reverse Screen - not implemented*) | 319 6 : (*origin*) 320 OriginMode := c='h'; | 321 7 : (*Auto-wrap*) 322 AutoWrap := c='h'; | 323 8 : (*Kbd Auto-repeat on/off - not supported*) | 324 10 : (*Editing*) 325 EditMode := c='h'; | 326 11 : (*Line Transmit*) 327 IF c='h' THEN 328 TransmitMode := Line 329 ELSIF WantsFullPage THEN 330 TransmitMode := FullPage 331 ELSE 332 TransmitMode := PartialPage 333 END; | 334 13 : (*Space compression / Field delimiter*) | 335 14 : (*Transmit execution*) 336 DeferredTransmit := (c='l'); | 337 15 : (* Printer status request *) 338 IF c='n' THEN 339 Seq:=' [?13n'; 340 Seq[0]:=CHR(27); 341 StuffKbdBuffer(Seq,6); 342 END; | 343 16 : (*Edit key execution*) 344 DeferredEdit := c='l'; | 345 18 : (*Printer form feed*) | 346 19 : (*Printer extent*) | 347 END; 348 END DECModeChange; 349 350 (*.............................................*) 351 352 PROCEDURE EraseField(x,y,w:CARDINAL); 353 VAR 354 i,oldx,oldy : CARDINAL; 355 BEGIN 356 (* This routine is only called if protected fields are in effect *) 357 oldx:=cx; 358 oldy:=cy; 359 i:=0; 360 GotoXY(x,y); 361 WHILE iAttrSet{} THEN 363 Map[y,x+i] := CurrAttr; 364 ScrMap[y,x+i] := ' '; 365 IO.WrChar(' '); 366 ELSE 367 GotoXY(x+i+1,cy); 368 END; 369 INC(i); 370 END; 371 GotoXY(oldx,oldy); 372 END EraseField; 373 374 (*.............................................*) 375 376 PROCEDURE EraseLineToCursor; 377 BEGIN 378 IF Protected THEN 379 EraseField(0,cy,cx+1); 380 ELSE 381 Lib.Fill(ADR(Map[cy]),cx+1,NormalAttr); 382 Lib.Fill(ADR(ScrMap[cy]),cx+1,' '); 383 Window.DirectWrite(0,cy,ADR(ScrMap[cy]),cx); 384 END; 385 END EraseLineToCursor; 386 387 (*.............................................*) 388 389 PROCEDURE EraseCursorToEol; 390 BEGIN 391 IF Protected THEN 392 EraseField(cx,cy,cx+1); 393 ELSE 394 Window.ClrEol; 395 END; 396 END EraseCursorToEol; 397 398 (*.............................................*) 399 400 PROCEDURE EraseScreenToCursor; 401 VAR 402 i,x,y : CARDINAL; 403 BEGIN 404 i:=0; 405 x:=cx; 406 y:=cy; 407 WHILE iProtAttr) DO 447 INC(i); 448 END; 449 Max := i-1; 450 ELSE 451 Max := 79; 452 END; 453 RETURN Max; 454 END FieldWidth; 455 456 (*.............................................*) 457 458 PROCEDURE DelChar; 459 VAR 460 i,Max : CARDINAL; 461 a : AttrSet; 462 BEGIN 463 Max := FieldWidth(); 464 IF Max=0 THEN 465 RETURN; 466 END; 467 i:=cx; 468 a:=Map[cy,i]; 469 SetColor(a); 470 WHILE ia THEN 474 a:=Map[cy,i]; SetColor(a); 475 END; 476 IO.WrChar(ScrMap[cy,i]); 477 INC(i); 478 END; 479 IF Map[cy,i]<>a THEN 480 a:=Map[cy,i]; 481 SetColor(a); 482 END; 483 ScrMap[cy,i]:=' '; 484 IO.WrChar(' '); 485 GotoXY(cx,cy); 486 END DelChar; 487 488 (*.............................................*) 489 490 PROCEDURE GetCursorPosition(VAR s:ARRAY OF CHAR; VAR Lnth:CARDINAL); 491 VAR 492 TempStr : ARRAY[0..9] OF CHAR; 493 Ok : BOOLEAN; 494 BEGIN 495 Str.CardToStr(LONGCARD(cy+1),TempStr,10,Ok); 496 Str.CardToStr(LONGCARD(cx+1),s,10,Ok); 497 Lnth := Str.Length(TempStr)+Str.Length(s)+4; 498 Str.Concat(TempStr,' [',TempStr); 499 Str.Concat(s,';',s); 500 Str.Concat(s,TempStr,s); 501 Str.Concat(s,s,'R'); 502 s[0]:=CHR(27); 503 END GetCursorPosition; 504 505 (*.............................................*) 506 507 PROCEDURE Transmit; 508 (* not implemented *) 509 END Transmit; 510 511 (*.............................................*) 512 513 PROCEDURE CursorMovement ( dir : CHAR ; dist : CARDINAL ); 514 BEGIN 515 IF dist=0 THEN 516 dist:=1; 517 END ; 518 CASE dir OF 519 'A' : IF dist>cy THEN 520 cy:=0; 521 ELSE 522 DEC(cy,dist); 523 END; | 524 'B' : INC(cy,dist); 525 IF cy>ScreenBottom THEN 526 cy := ScreenBottom; 527 END; | 528 'C' : INC(cx,dist); 529 IF cy>79 THEN 530 cy := 79; 531 END; | 532 'D' : IF dist>cx THEN 533 cx:=0; 534 ELSE 535 DEC(cx,dist); 536 END; | 537 END; 538 GotoXY(cx,cy); 539 END CursorMovement ; 540 541 (*.............................................*) 542 543 544 PROCEDURE EraseCommand ( type : CHAR ; function : CARDINAL ); 545 VAR 546 x,y : CARDINAL; 547 BEGIN 548 CASE type OF 549 'J' : CASE function OF 550 0 : ClrEos; | 551 1 : EraseScreenToCursor; | 552 2 : x:=cx; 553 y:=cy; 554 GotoXY(0,0); 555 ClrEos; 556 GotoXY(x,y); | 557 END; | 558 'K' : CASE function OF 559 0 : EraseCursorToEol; | 560 1 : EraseLineToCursor; | 561 2 : x:=cx; 562 GotoXY(0,cy); 563 EraseCursorToEol; 564 GotoXY(x,cy); | 565 END; | 566 END ; 567 END EraseCommand ; 568 569 (*.............................................*) 570 571 PROCEDURE CheckCode(c:CHAR); 572 VAR 573 x,y : CARDINAL; 574 Seq : ARRAY[0..9] OF CHAR; 575 BEGIN 576 IF DECPrivate THEN 577 DECModeChange(c) 578 ELSE 579 CASE c OF 580 'A'..'D' : CursorMovement(c,p1); | 581 'c' : (* Device attributes request *) 582 Seq:=' [?7c'; 583 Seq[0]:=CHR(27); 584 StuffKbdBuffer(Seq,5); | 585 'g' : IF p1=0 THEN 586 TabStop[cx]:=FALSE; 587 ELSIF p1=3 THEN 588 FOR x:=0 TO 79 DO 589 TabStop[x]:=FALSE; 590 END; 591 END; | 592 'H','f' : IF p1=0 THEN 593 p1:=1; 594 END; 595 IF p2=0 THEN 596 p2:=1; 597 END; 598 GotoXY(p2-1,p1-1); | 599 'h','l' : CASE p1 OF 600 2 : KbdLocked := (c='h'); | 601 6 : Protected := (c='l'); | 602 12 : LocalEcho := (c='l'); | 603 16 : WantsFullPage := (c='h'); | 604 20 : NewLineMode := (c='h'); | 605 END; | 606 'J','K' : EraseCommand(c,p1); | 607 'L' : IF (cy>=ScreenTop) AND (cy<=ScreenBottom) THEN 608 y:=ScreenTop; 609 ScreenTop:=cy; 610 WHILE p1>0 DO 611 Scroll(-1); 612 DEC(p1); 613 END; 614 ScreenTop:=y; 615 END; | 616 'M' : IF (cy>=ScreenTop) AND (cy<=ScreenBottom) THEN 617 y:=ScreenTop; 618 ScreenTop:=cy; 619 WHILE p1>0 DO 620 Scroll(1); 621 DEC(p1); 622 END; 623 ScreenTop:=y; 624 END; | 625 'm' : (* Select graphic rendition *) 626 CASE p1 OF 627 0 : CurrAttr := NormalAttr ; | 628 1 : INCL(CurrAttr,Bold); | 629 4 : CurrAttr := CurrAttr-AttrSet{Red,Green}+AttrSet{Blue};| 630 5 : INCL(CurrAttr,Blink); | 631 7 : CurrAttr := AttrSet( 632 (SHORTCARD(CurrAttr*AttrSet{Red,Green,Blue})<<4)+ 633 (SHORTCARD(CurrAttr*AttrSet{RedBack,GreenBack,BlueBack})>>4)+ 634 (SHORTCARD(CurrAttr*AttrSet{Bold,Blink})));| 635 8 : CurrAttr := AttrSet{}; | 636 END; 637 SetColor(CurrAttr); | 638 'n' : (* Device status reports *) 639 Seq[0]:=CHR(27); 640 Seq[1]:='['; 641 Seq[3]:='n'; 642 x:=4; 643 CASE p1 OF 644 5 : Seq[2]:='0';(* VDU status request *) | 645 6 : GetCursorPosition(Seq,x); | 646 ELSE 647 x := 0; 648 END; 649 IF x>0 THEN 650 StuffKbdBuffer(Seq,x); 651 END; | 652 'P' : WHILE p1>0 DO 653 DelChar; 654 DEC(p1); 655 END; | 656 'r' : IF (p1>=1) AND (p2>0) AND (p2<=24) AND (p1>4)+ 673 (SHORTCARD(ProtAttr*AttrSet{Bold,Blink})));| 674 8 : ProtAttr := AttrSet{}; | 675 ELSE 676 IF p1=254 THEN 677 ProtAttr:=NormalAttr; 678 END; 679 END; 680 681 END; 682 END; 683 END CheckCode; 684 685 (*.............................................*) 686 687 PROCEDURE ShortCode(c:CHAR); 688 VAR 689 x,y : CARDINAL; 690 Seq : ARRAY[0..9] OF CHAR; 691 BEGIN 692 CASE c OF 693 'c' : (* Reset *) 694 SelectEmulation(EmVT100); | 695 'D' : IF cy<23 THEN 696 GotoXY(cx,cy+1); 697 ELSE 698 Scroll(1); 699 END; | 700 'E' : Output(CHR(10)); 701 GotoXY(0,cy); | 702 'H' : TabStop[cx]:=TRUE; | 703 'M' : IF cy>0 THEN 704 GotoXY(cx,cy-1); 705 ELSE 706 Scroll(-1); 707 END; | 708 'N' : (* G2 char set - not supported *) | 709 'Z' : (* Identity Request *) 710 Seq:=' [?7c'; 711 Seq[0]:=CHR(27); 712 StuffKbdBuffer(Seq,5); | 713 'O' : (* G3 char set - not supported *) | 714 '7' : CSave.cx:=cx; 715 CSave.cy:=cy; 716 WITH CSave DO 717 Top:=ScreenTop; 718 Bottom:=ScreenBottom; 719 OrgMode:=OriginMode; 720 END; | 721 '8' : WITH CSave DO 722 ScreenTop:=Top; 723 ScreenBottom:=Bottom; 724 OriginMode:=OrgMode; 725 GotoXY(cx,cy); 726 END; | 727 '=' : NumKeyPad := FALSE;(* application keypad mode *)| 728 '>' : NumKeyPad := TRUE; 729 ANSIKeys := TRUE; | 730 END; 731 END ShortCode; 732 733 (*.............................................*) 734 735 PROCEDURE NewCharSet(c:CHAR; VAR Gx:CharSets); 736 BEGIN 737 CASE c OF 738 'A' : Gx:=UK; | 739 'B' : Gx:=US; | 740 '0' : Gx:=SpecialChar; | 741 '1' : (* not supported *) | 742 '2' : (* not supported *) | 743 END; 744 END NewCharSet; 745 746 (*.............................................*) 747 748 PROCEDURE VT100RxSM(c:CHAR); 749 BEGIN 750 CASE RxState OF 751 Normal : IF c=CHR(27) THEN 752 DECPrivate := FALSE; 753 p1:=0; 754 p2:=0; 755 RxState := GotESC 756 ELSE 757 Output(c) 758 END; | 759 GotESC : IF c='[' THEN 760 RxState := GotBrack 761 ELSIF c='(' THEN 762 RxState := GotLParen 763 ELSIF c=')' THEN 764 RxState := GotRParen 765 ELSIF c='#' THEN 766 RxState := GotHash 767 ELSE 768 ShortCode(c); 769 RxState := Normal; 770 END; | 771 GotBrack : IF c='?' THEN 772 DECPrivate := TRUE; 773 RxState := ReadingP1; 774 ELSIF (c>='0') AND (c<='9') THEN 775 p1 := ORD(c)-48; 776 RxState := ReadingP1; 777 ELSIF (c=';') THEN 778 RxState := ReadingP2; 779 ELSE 780 CheckCode(c); 781 RxState := Normal; 782 END; | 783 GotLParen : NewCharSet(c,G0); 784 RxState := Normal; | 785 GotRParen : NewCharSet(c,G1); 786 RxState := Normal; | 787 GotHash : RxState := Normal; (* ignore line attributes *) | 788 ReadingP1 : IF (c>='0') AND (c<='9') THEN 789 p1 := p1*10 + ORD(c)-48; 790 ELSIF c=';' THEN 791 RxState := ReadingP2 792 ELSE 793 CheckCode(c); 794 RxState := Normal; 795 END; | 796 ReadingP2 : IF (c>='0') AND (c<='9') THEN 797 p2 := p2*10 + ORD(c)-48; 798 ELSE 799 CheckCode(c); 800 RxState := Normal; 801 END; | 802 END; 803 END VT100RxSM; 804 805 (*.............................................*) 806 807 VAR 808 CursorY : CARDINAL; 809 810 PROCEDURE VT52RxSM(c:CHAR); 811 VAR 812 Seq : ARRAY[0..3] OF CHAR; 813 BEGIN 814 CASE RxState OF 815 Normal : IF c=CHR(27) THEN 816 RxState:=GotESC 817 ELSE 818 Output(c) 819 END; | 820 GotESC : CASE c OF 821 '<' : SelectEmulation(EmVT100); | 822 '=' : NumKeyPad:=FALSE; | 823 '>' : NumKeyPad:=TRUE; | 824 'F' : CurrCharSet:=SpecialChar; | 825 'G' : CurrCharSet:=US; | 826 'A'..'D' : CursorMovement(c,1); | 827 'H' : GotoXY(0,0); | 828 'Y' : RxState := VT52Line; | 829 'I' : IF cy>ScreenTop THEN 830 DEC(cy); 831 ELSE 832 Scroll(-1); 833 END; 834 GotoXY(cx,cy); | 835 'K' : EraseCursorToEol; | 836 'J' : ClrEos; | 837 'Z' : Seq:=' /Z'; 838 Seq[0]:=CHR(27); 839 StuffKbdBuffer(Seq,3); | 840 END; 841 IF RxState<>VT52Line THEN 842 RxState:=Normal; 843 END; | 844 VT52Line : IF c>=' ' THEN 845 CursorY := ORD(c)-32; 846 RxState := VT52Col; 847 ELSE 848 RxState := Normal; 849 END; | 850 VT52Col : IF c>=' ' THEN 851 GotoXY(ORD(c)-32,CursorY); 852 END; 853 RxState := Normal; | 854 END; 855 END VT52RxSM; 856 857 (*.............................................*) 858 VAR 859 ANSIp : ARRAY[1..9] OF CARDINAL ; 860 ANSIn : [0..9]; 861 PROCEDURE ANSIRxSM(c:CHAR); 862 (* Reduced PC compatible ANSI driver *) 863 VAR 864 i : CARDINAL; 865 W : Window.WinType; 866 wc : Window.Color; 867 Seq : ARRAY[0..9] OF CHAR; 868 BEGIN 869 CASE RxState OF 870 Normal : IF c=CHR(27) THEN 871 RxState:=GotESC; 872 ELSE 873 Output(c); 874 END; | 875 GotESC : IF c='[' THEN 876 RxState:=ANSICmd; 877 FOR i := 1 TO 9 DO 878 ANSIp[i] := 0; 879 END ; 880 ANSIn := 1; 881 ELSE 882 Output(c); 883 RxState:=Normal; 884 END; | 885 ANSICmd : RxState:=Normal; 886 CASE c OF 887 '0'..'9' : ANSIp[ANSIn] := ANSIp[ANSIn]*10+ORD(c)-ORD('0'); 888 RxState:=ANSICmd; | 889 ';' : IF ANSIn<9 THEN 890 INC(ANSIn); 891 END; 892 RxState:=ANSICmd; | 893 'f','H' : IF ANSIp[1] > 0 THEN 894 DEC(ANSIp[1]); 895 END; 896 IF ANSIp[2] > 0 THEN 897 DEC(ANSIp[2]); 898 END; 899 GotoXY(ANSIp[2],ANSIp[1]); | 900 'A'..'D' : CursorMovement(c,ANSIp[1]); | 901 'J','K' : EraseCommand(c,ANSIp[1]); | 902 's' : CSave.cx:=cx; 903 CSave.cy:=cy; | 904 'u' : GotoXY(CSave.cx,CSave.cy); | 905 'n' : IF ANSIp[1]=6 THEN 906 GetCursorPosition(Seq,i); 907 IF i>0 THEN 908 StuffKbdBuffer(Seq,i); 909 END; 910 END; | 911 'm' : FOR i := 1 TO ANSIn DO 912 CASE ANSIp[i] OF 913 0 : CurrAttr := NormalAttr; | 914 1 : INCL(CurrAttr,Bold); | 915 4 : CurrAttr := CurrAttr-AttrSet{Red,Green}+AttrSet{Blue}; | 916 5 : INCL(CurrAttr,Blink); | 917 7 : CurrAttr := AttrSet((SHORTCARD(CurrAttr*AttrSet{Red,Green,Blue})<<4)+(SHORTCARD(CurrAttr*AttrSet{RedBack,GreenBack,BlueBack})>>4)+(SHORTCARD(CurrAttr*AttrSet{Bold,Blink})));| 918 8 : CurrAttr := AttrSet{}; | 919 30 : CurrAttr := CurrAttr-AttrSet{Red,Green,Blue}; | 920 31 : CurrAttr := CurrAttr-AttrSet{Green,Blue}+AttrSet{Red}; | 921 32 : CurrAttr := CurrAttr-AttrSet{Red,Blue}+AttrSet{Green}; | 922 33 : CurrAttr := CurrAttr-AttrSet{Blue}+AttrSet{Red,Green}; | 923 34 : CurrAttr := CurrAttr-AttrSet{Red,Green}+AttrSet{Blue}; | 924 35 : CurrAttr := CurrAttr-AttrSet{Green}+AttrSet{Red,Blue}; | 925 36 : CurrAttr := CurrAttr-AttrSet{Red}+AttrSet{Blue,Green}; | 926 37 : CurrAttr := CurrAttr+AttrSet{Red,Blue,Green}; | 927 40 : CurrAttr := CurrAttr-AttrSet{RedBack,GreenBack,BlueBack}; | 928 41 : CurrAttr := CurrAttr-AttrSet{GreenBack,BlueBack}+AttrSet{RedBack}; | 929 42 : CurrAttr := CurrAttr-AttrSet{RedBack,BlueBack}+AttrSet{GreenBack}; | 930 43 : CurrAttr := CurrAttr-AttrSet{BlueBack}+AttrSet{RedBack,GreenBack}; | 931 44 : CurrAttr := CurrAttr-AttrSet{RedBack,GreenBack}+AttrSet{BlueBack}; | 932 45 : CurrAttr := CurrAttr-AttrSet{GreenBack}+AttrSet{RedBack,BlueBack}; | 933 46 : CurrAttr := CurrAttr-AttrSet{RedBack}+AttrSet{BlueBack,GreenBack}; | 934 47 : CurrAttr := CurrAttr+AttrSet{RedBack,BlueBack,GreenBack}; | 935 END; 936 SetColor(CurrAttr); 937 END; 938 ELSE 939 Output(c); 940 END; 941 END; 942 END ANSIRxSM; 943 944 (*.............................................*) 945 946 PROCEDURE WrChar(c:CHAR); 947 BEGIN 948 IF ORD(c)>127 THEN 949 c:=CHR(ORD(c)-128); 950 END; 951 CASE VTMode OF 952 EmVT100: VT100RxSM(c); (* call VT100 receive state machine *) | 953 EmVT52: VT52RxSM(c); (* call VT52 receive state machine *) | 954 EmANSI: ANSIRxSM(c); (* call ANSI receive state machine *) | 955 END; 956 END WrChar; 957 958 (*.............................................*) 959 960 PROCEDURE KeyTranslate; 961 (* Emulate sequences produced by VT100 or VT52 keyboard. There is a *) 962 (* dearth of keypad keys on the IBM for this, so instead, to use *) 963 (* cursor keys you use the unshifted keys. To access the numeric *) 964 (* keypad (or the application keys in alterate mode) you hold down *) 965 (* shift while pressing the appropriate keys. This still leaves us *) 966 (* five keys short for the keypad "enter" and PF1..PF4. The "Enter" *) 967 (* key is produced by F6 on the PC, and PF1..PF4 correspond to F7..F8*) 968 (* on the PC. *) 969 VAR 970 c : CHAR; 971 Lnth : CARDINAL; 972 Seq : ARRAY[0..2] OF CHAR; 973 BEGIN 974 c := Keyboard.RdKey(); 975 IF c=0C THEN 976 (* NOTE: Alt-Key combinations are reserved for use by the comms *) 977 (* package, so if this turns out to be one we need to insert the*) 978 (* preceding NUL into the kbd.buff also, otherwise the equivalent*) 979 (* VT100 sequence gets stuffed into the keyboard buffer. *) 980 c := Keyboard.RdKey(); 981 Seq[0]:=CHR(27); 982 Lnth:=3; 983 IF c=CHR(64) THEN 984 IF NumKeyPad THEN 985 Seq[0]:=CHR(13); 986 Lnth:=1; 987 IF NewLineMode THEN 988 Seq[1]:=CHR(10); 989 Lnth:=2; 990 END; 991 ELSE 992 Seq[1]:='O'; 993 Seq[2]:='M'; 994 END; 995 ELSIF (c>=CHR(65)) AND (c<=CHR(68)) THEN 996 IF VTMode=EmVT100 THEN 997 Seq[1]:='O'; 998 ELSE 999 Seq[1]:='?'; 1000 END; 1001 CASE ORD(c) OF 1002 65 : Seq[2]:='P'; | 1003 66 : Seq[2]:='Q'; | 1004 67 : Seq[2]:='R'; | 1005 68 : Seq[2]:='S'; | 1006 END; 1007 IF (VTMode=EmVT52) AND (NumKeyPad) THEN 1008 Seq[1]:=Seq[2]; 1009 Lnth:=2; 1010 END; 1011 ELSE 1012 IF ANSIKeys THEN 1013 Seq[1]:='['; 1014 ELSE 1015 Seq[1]:='O'; 1016 END; 1017 CASE ORD(c) OF 1018 72 : Seq[2]:='A'; (* cursor up *) | 1019 75 : Seq[2]:='D'; (* cursor left *) | 1020 77 : Seq[2]:='C'; (* cursor right *) | 1021 80 : Seq[2]:='B'; (* cursor down *) | 1022 ELSE 1023 Seq[0]:=0C; Seq[1]:=c; StuffKbdBuffer(Seq,2); 1024 RETURN 1025 END; 1026 IF VTMode=EmVT52 THEN 1027 Seq[1]:=Seq[2]; 1028 Lnth:=2; 1029 END; 1030 END; 1031 StuffKbdBuffer(Seq,Lnth); 1032 ELSIF (Keyboard.ScanCode>=CHR(71)) AND (Keyboard.ScanCode<=CHR(83)) THEN 1033 IF NumKeyPad THEN 1034 IF c='+' THEN 1035 c:=','; 1036 END; 1037 StuffKbdBuffer(c,1); 1038 ELSE 1039 Seq[0]:=CHR(27); 1040 IF VTMode=EmVT100 THEN 1041 Seq[1]:='O'; 1042 ELSE 1043 Seq[1]:='?'; 1044 END; 1045 CASE c OF 1046 '0' : Seq[2]:='p'; | 1047 '1' : Seq[2]:='q'; | 1048 '2' : Seq[2]:='r'; | 1049 '3' : Seq[2]:='s'; | 1050 '4' : Seq[2]:='t'; | 1051 '5' : Seq[2]:='u'; | 1052 '6' : Seq[2]:='v'; | 1053 '7' : Seq[2]:='w'; | 1054 '8' : Seq[2]:='x'; | 1055 '9' : Seq[2]:='y'; | 1056 '-' : Seq[2]:='m'; | 1057 '+' : Seq[2]:='l'; | 1058 '.' : Seq[2]:='n'; | 1059 END; 1060 StuffKbdBuffer(Seq,3); 1061 END; 1062 ELSE 1063 Seq[0]:=c; 1064 Lnth:=1; 1065 IF (c=CHR(13)) AND (NewLineMode) THEN 1066 Seq[1]:=CHR(10); Lnth:=2; 1067 END; 1068 StuffKbdBuffer(Seq,Lnth); 1069 END; 1070 END KeyTranslate; 1071 1072 (*.............................................*) 1073 1074 PROCEDURE RdKey():CHAR; 1075 VAR 1076 c : CHAR; 1077 BEGIN 1078 LOOP 1079 WITH Kbd DO 1080 IF rptr<>wptr THEN 1081 c:=Buff[rptr]; 1082 rptr:=(rptr+1) MOD 100H; 1083 EXIT 1084 ELSE 1085 KeyTranslate(); 1086 END; 1087 END; 1088 END; 1089 RETURN c; 1090 END RdKey; 1091 1092 (*.............................................*) 1093 1094 PROCEDURE KeyPressed():BOOLEAN; 1095 BEGIN 1096 IF Kbd.rptr<>Kbd.wptr THEN 1097 RETURN TRUE 1098 ELSIF Keyboard.KeyPressed() THEN 1099 KeyTranslate(); 1100 RETURN KeyPressed(); 1101 ELSE 1102 RETURN FALSE 1103 END; 1104 END KeyPressed; 1105 1106 (*.............................................*) 1107 1108 PROCEDURE ClearScreen; 1109 BEGIN 1110 GotoXY(0,0); 1111 ClrEos; 1112 END ClearScreen; 1113 1114 (*.............................................*) 1115 1116 PROCEDURE EmulateVT100; 1117 BEGIN 1118 SelectEmulation(EmVT100); 1119 END EmulateVT100; 1120 1121 (*.............................................*) 1122 1123 PROCEDURE EmulateVT52; 1124 BEGIN 1125 SelectEmulation(EmVT52); 1126 END EmulateVT52; 1127 1128 (*.............................................*) 1129 1130 PROCEDURE EmulateANSI; 1131 BEGIN 1132 SelectEmulation(EmANSI); 1133 END EmulateANSI; 1134 1135 (*.............................................*) 1136 1137 PROCEDURE Emulation():Emulations; 1138 BEGIN 1139 RETURN VTMode; 1140 END Emulation; 1141 1142 (*.............................................*) 1143 1144 BEGIN 1145 ResetTerm; 1146 END Term. 2 errors