home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / WEDITS22.ZIP / WEINPUT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-08-19  |  11.2 KB  |  423 lines
  1. UNIT WEInput;
  2. { -- This is the Input Module of WWIVEdit 2.2
  3.   -- Last Modified: 8/19/91
  4.   -- Written By:
  5.   --   Adam Caldwell
  6.   --
  7.   -- This code is limited Public Domain (see WWIVEDIT.PAS for more details)
  8.   --
  9.   -- Purpose : Encapsulate as much of the input as possible
  10.   --
  11.   -- Known Errors : None
  12.   --
  13.   -- Planned Enhancements : None
  14.   -- }
  15. INTERFACE
  16. {$R-,V-,S-,B-,E-,N-}   { These Optomize things as much as possible }
  17.  
  18. USES WEVars;
  19.  
  20. CONST
  21.   TimingConstant=8;
  22.  
  23. FUNCTION GetKey:char;
  24. FUNCTION GetControlLine:String;
  25. FUNCTION ReadSet(s:charset):char;
  26. FUNCTION GetArrow : Edfun;
  27. FUNCTION GetFun(VAR ch:char):EdFun;
  28. FUNCTION TimeKey(n : word) : char;
  29. FUNCTION Yn : boolean;
  30.  
  31. IMPLEMENTATION
  32.  
  33. USES WETime, WEChat, WEKbd, WEOutput;
  34.  
  35. FUNCTION GetBoxChar(setn, ch:char) : Char;
  36. { Allows insertion of a line drawing character... needs major work }
  37. CONST
  38.   boxes:ARRAY['1'..'4'] OF string[9] =
  39.     ( '█▄▓▌ ▐▒▀░','└─┘│ │┌─┐','╚═╝║ ║╔═╗',' ┴ ├┼┤ ┬ ');
  40. BEGIN
  41.    GetBoxChar:=boxes[setn][ord(ch)-ord('0')]
  42. END;
  43.  
  44. FUNCTION GetExtendedCommand1:EdFun;
  45. { Gets Extended command from ^K key (mostly block commands) }
  46. VAR
  47.   ch:char;
  48.   Fun : EdFun;
  49.   Fast : Boolean;
  50. BEGIN
  51.   Fast:=KeyPressed;
  52.   IF NOT Fast THEN
  53.     StatusLine3(C0+'^K');
  54.   Fun := None;
  55.   ch:=GetKey;
  56.   IF (NOT Fast) AND (ch IN [#32..#255]-[#127]) THEN prompt(ch);
  57.   CASE upcase(ch) OF
  58.     'U' : Fun := Up;     'D' : Fun := Down;  'L' : Fun := Left;
  59.     'R' : Fun := Right;
  60.     'B' : Fun := MarkStart;
  61.     'E','K' : Fun := MarkEnd;
  62.     'M','V' : Fun := MoveBlock;
  63.     'S' : Fun := ShowBlockStat;
  64.     'C' : Fun := CopyBlock;
  65.     'Y' : Fun := DeleteBlock;
  66.     'W' : Fun := ToggleWhere;
  67.     'J' : Fun := Jump;
  68.   END;
  69.   GetExtendedCommand1:=Fun;
  70.   IF NOT Fast THEN
  71.     StatusLine3('');
  72. END;
  73.  
  74. FUNCTION GetExtendedCommand2(VAR ch:char):EdFun;
  75. { Gets Extended command off of ^Q... Still works for insertLiteral too }
  76. VAR
  77.   Fun:EdFun;
  78.   c : char;
  79.   Fast : boolean;
  80. BEGIN
  81.   Fast:=KeyPressed;
  82.   IF NOT Fast THEN
  83.     StatusLine3(C0+'^Q');
  84.   Fun := None;
  85.   ch:=GetKey;
  86.   IF (NOT Fast) AND (ch IN [#32..#255]-[#127]) THEN prompt(ch);
  87.   IF ch IN [#0..#31,#127] THEN Fun:=InsertChar;
  88.   CASE upcase(ch) OF
  89.     'Y' : Fun := DelEOL;
  90.     'F' : Fun := Find;
  91.     'L' : Fun := FindLast;
  92.     '1'..'4' : BEGIN
  93.       c:=GetKey;
  94.       Fun:=InsertChar;
  95.       IF c IN ['0'..'9'] THEN
  96.         ch:=GetBoxChar(ch,c)
  97.       ELSE Fun:=None;
  98.     END;
  99.   END;
  100.   GetExtendedCommand2:=Fun;
  101.   IF NOT Fast THEN
  102.     StatusLine3('');
  103. END;
  104.  
  105.  
  106.  
  107.  
  108.  
  109. FUNCTION GetFun(VAR ch:char):EdFun;
  110. { Does type bulk of the keyboard interpretation... Melts all of the different
  111.   input styles together [IBM, ANSI, & Control Keys] }
  112. VAR
  113.   r:ExtTrans;
  114.   s,s1:string;
  115.   i:integer;
  116.   t:text;
  117. BEGIN
  118.   GetFun:=None;
  119.   ch:=GetKey;
  120.   IF NOT (ch IN [#0..#31,#127]) THEN GetFun:=InsertChar;
  121.   IF CH in EditorKeys THEN
  122.     CASE ch of
  123.       DelWordLeft  : GetFun:=EraseWordLeft;
  124.       FastLeft     : GetFun:=WordLeft;     FastRight    : GetFun:=WordRight;
  125.       BackSpaceKey : GetFun:=Backspace;    _DEL_        : GetFun:=DelChar;
  126.       RedisplayKey : GetFun:=RedisplayAll; DelLineKey   : GetFun:=DelLine;
  127.       TabKey       : GetFun:=Tab;          UpKey        : GetFun:=Up;
  128.       PgUpKey      : GetFun:=PgUp;         LeftKey      : GetFun:=Left;
  129.       RightKey     : GetFun:=Right;        DownKey      : GetFun:=Down;
  130.       PgDnKey      : GetFun:=PgDn;         ToggleInsKey : GetFun:=ToggleInsert;
  131.       DelKey       : GetFun:=DelChar;
  132.       EnterKey     : GetFun:=Enter;        WWIVColorKey : GetFun:=WWIVColor;
  133.       CenterLineKey: GetFun:=CenterLine;   DelSOLKey    : GetFun:=DelSOL;
  134.       HelpKey      : GetFun:=GetHelp;      DelLeftKey   : GetFun:=GoBack;
  135.       RepeatLastFindKey : GetFun:=FindLast;
  136.       ToggleFullScreenKey : GetFun :=ToggleFullScreen;
  137.  
  138.       ExtendedKey1 : GetFun:=GetExtendedCommand1;
  139.       ExtendedKey2 : GetFun:=GetExtendedCommand2(ch);
  140.     END
  141.   ELSE IF Ch=#0 THEN
  142.   BEGIN
  143.     ch:=GetKey;
  144.     CASE ch OF
  145.        #71:GetFun := Home; #72:GetFun := Up;   #73:GetFun := PgUp;
  146.        #75:GetFun := Left;                     #77:GetFun := Right;
  147.        #79:GetFun := _End; #80:GetFun := Down; #81:GetFun := PgDn;
  148.                            #82:GetFun:=ToggleInsert; #83:GetFun := DelChar;
  149.        #119,#132:GetFun := Top;     { Ctrl-Home Ctrl-PgDn }
  150.        #117,#118:GetFun := Bottom;  { Ctrl-End  Ctrl-PgDn }
  151.        #115:GetFun := WordLeft;     { Ctrl-Left Arrow }
  152.        #116:GetFun := WordRight;    { Ctrl-Right Arrow }
  153.        #59 :GetFun := GetHelp;      { F1 }
  154.        #30 :GetFun := AbortPost;    { Alt-A }
  155.        #31 :GetFun := ExitAndSave;  { Alt-S }
  156.        #17 :GetFun := SaveAndContinue;{ Alt-W }
  157.        #46 :GetFun := CenterLine;   { Alt-C }
  158.        #25 :GetFun := WWIVColor;    { Alt-P }
  159.     ELSE IF TrueKeyboard THEN
  160.        CASE ch OF
  161.          #23 :GetFun := InsertFile;   { Alt-I }
  162.          #68 :BEGIN Chat(LineLen,ScreenHeight); ch:=#0; GetFun:=None END; {F10}
  163.        ELSE
  164.        BEGIN
  165.          GetFun:=None;
  166.          IF OkLocalMacros THEN
  167.          BEGIN
  168.            reset(transtable);
  169.              seek(transtable,ord(ch));
  170.              read(transtable,r);
  171.              s:='';
  172.              IF r[1]<>#0 THEN
  173.              BEGIN
  174.                s:=s+r[1]+r[2]+r[3];
  175.                IF r[2]=#0 THEN s[0]:=#1
  176.                ELSE if r[3]=#0 THEN s[0]:=#2;
  177.              END;
  178.              IF s<>'' THEN
  179.              BEGIN
  180.                assign(t,StartupDir+'MACROS.LCL');
  181.                reset(t);
  182.                WHILE (NOT EOF(t)) AND (s1<>s+':') DO
  183.                  readln(t,s1);
  184.                IF s1=s+':' THEN
  185.                REPEAT
  186.                  readln(t,s1);
  187.                  IF (length(s1)>0) AND (s1[1]=^B) THEN BEGIN
  188.                    s1[1]:='/';
  189.                    system.insert('C:',s1,2)
  190.                  END;
  191.                  IF (length(s1)>0) AND (s1[1]='~') THEN
  192.                    system.delete(s1,1,1);
  193.                  IF s1[length(s1)]<>'~'
  194.                    THEN s1:=s1+^M
  195.                    ELSE system.delete(s1,length(s1),1);
  196.                  FOR i:=1 TO length(s1) DO
  197.                    CASE s1[i] OF
  198.                      ^C : s1[i]:=WWIVColorKey;
  199.                      ^H : s1[i]:=DelLeftKey;
  200.                    END;
  201.                  IF s1<>':'+s+^M THEN StuffIn(s1);
  202.                UNTIL s1=':'+s+^M;
  203.                close(t);
  204.              END;
  205.            END
  206.          END;
  207.      END
  208.     END;
  209.   END;
  210.   IF ch=#$E0 THEN BEGIN
  211.     IF empty
  212.       THEN ch:=TimeKey(TimingConstant)
  213.       ELSE ch:=ReadKey;
  214.     IF ch=#255 THEN BEGIN
  215.       GetFun:=InsertChar;
  216.       ch:=#$E0;
  217.     END ELSE
  218.       CASE ch OF
  219.         #$48 : GetFun:=Up;
  220.         #$50 : GetFun:=Down;
  221.         #$4B : GetFun:=Left;
  222.         #$4D : GetFun:=Right;
  223.         #$1C : GetFun:=Enter;
  224.         #$52 : GetFun:=ToggleInsert;
  225.         #$47 : GetFun:=Home;
  226.         #$49 : GetFun:=PgUp;
  227.         #$51 : GetFun:=PgDn;
  228.         #$4F : GetFun:=_End;
  229.         #$53 : GetFun:=DelChar
  230.       ELSE BEGIN
  231.         StuffIn(ch);
  232.         ch:=#$E0;
  233.         GetFun:=InsertChar
  234.       END;
  235.     END;
  236.   END;
  237.   IF ch=#27 THEN BEGIN
  238.     IF empty
  239.       THEN ch:=timekey(TimingConstant)
  240.       ELSE ch:=GetKey;
  241.     IF ch=#255 THEN GetFun := NormalExit;
  242.     IF ch<>#255 THEN
  243.       IF (ch='[') OR (ch='O') THEN
  244.       BEGIN
  245.         ch:=GetKey;
  246.         CASE ch OF
  247.           'H' : GetFun:=Home; 'A' : GetFun:=Up;
  248.           'D' : GetFun:=Left;                     'C' : GetFun:=Right;
  249.           'K' : GetFun:=_End; 'B' : GetFun:=Down;
  250.                               'r' : GetFun:=ToggleInsert;  'n' : GetFun:=DelChar;
  251.           'P' : GetFun:=GetHelp;
  252.         END
  253.       END
  254.       ELSE IF upcase(ch)='S' THEN
  255.         BEGIN
  256.           GetFun := ExitAndSave;
  257.         END
  258.       ELSE GetFun:=NormalExit
  259.   END;
  260. END;
  261.  
  262.  
  263. FUNCTION GetKey:CHAR;
  264. VAR
  265.   warned : boolean;
  266.   ch : char;
  267. BEGIN
  268.   BeforeNext;
  269.   LastKey := timer;
  270.   Warned:=false;
  271.   REPEAT
  272.     IF (KeyStatusFlag AND 3)=3 THEN BEGIN {Enter Chat mode by hitting both }
  273.       Chat(LineLen,ScreenHeight);         {Shift keys at once              }
  274.       LastKey:=Timer;
  275.       Warned:=False;
  276.     END;
  277.     IF (KeyStatusFlag AND 12)=12 THEN     {Control & Alt Together          }
  278.       Local:=TRUE;
  279. (*    IF (KeyStatusFlag AND 6)=6 THEN {control & left shift together   } *)
  280. (*      Local:=FALSE; *) { Some people complained about this one... uncomment if you want it }
  281.     IF LastKey>Timer THEN LastKey:=0;     {Special case for midnight       }
  282.     IF (Not warned) AND (Timer-Lastkey>WarnTime) THEN
  283.     BEGIN
  284.       IF NOT Local THEN
  285.         warned := TRUE;
  286.       write(#7#7#7);
  287.     END;
  288.   UNTIL (KeyPressed) OR (Timer-Lastkey>DisconnectTime);
  289.   IF KeyPressed THEN
  290.     GetKey:=ReadKey
  291. {  BEGIN
  292.     ch := readkey;
  293.     IF (ch=#0) AND (NOT TrueKeyboard)
  294.       THEN GetKey:=ReadKey
  295.       ELSE GetKey:=ch;
  296.   END}
  297.   ELSE BEGIN
  298.     clrscr;
  299.     Print('Editor Time-Out');
  300.     Halt
  301.   END;
  302.   AfterNext;
  303. END;
  304.  
  305. FUNCTION GetControlLine:String;
  306. { Allows user to input a line, and shows all "control" characters as inverted }
  307. VAR
  308.   s:string;
  309.   ch:char;
  310. BEGIN
  311.   s:='';
  312.   StatusLine2(C0);
  313.   REPEAT
  314.     ch:=GetKey;
  315.     IF not (ch in [^H,^Z]) THEN
  316.     BEGIN
  317.       s:=s+ch;
  318.       IF ch<#32
  319.         THEN WriteControl(ch)
  320.         ELSE write(ch);
  321.     END
  322.     ELSE IF (length(s)>0) AND (ch=^H) THEN
  323.     BEGIN
  324.       delete(s,length(s),1);
  325.       write(#8#32#8);
  326.     END;
  327.   UNTIL (ch=^Z) OR (length(s)=80);
  328.   GetControlLine:=s;
  329. END;
  330.  
  331. FUNCTION ReadSet(s:charset):char;
  332. { Waits for a key from user, until user presses a key in the set S }
  333. VAR ch:char;
  334. BEGIN
  335.   REPEAT ch:=upcase(GetKey) UNTIL ch IN s;
  336.   ReadSet:=ch;
  337.   IF ch IN [#32..#126] THEN write(ch);
  338. END;
  339.  
  340. FUNCTION TimeKey(n : word) : char;
  341. VAR ch : char;
  342. BEGIN
  343.   n:=n*100;
  344.   WHILE Empty AND (n > 0) DO
  345.     dec(n);
  346.   IF Empty
  347.     THEN ch  :=  #255
  348.     ELSE ch:=readkey;
  349.   TimeKey  :=  ch
  350. END;
  351.  
  352.  
  353. FUNCTION GetArrow : EdFun;
  354. { allows for the arrows [control key type, ibm type, and ANSI type], as well
  355.   as ENTER and ESC }
  356. VAR
  357.   ch:char;
  358.   f:EdFun;
  359. BEGIN
  360.   f:=None;
  361.   WHILE f=None DO
  362.   BEGIN
  363.     ch:=GetKey;
  364.     IF NOT (ch IN [#0,#27,EnterKey,LeftKey,RightKey,UpKey,DownKey]) THEN
  365.       F:=None;
  366.     IF CH in EditorKeys THEN
  367.     CASE ch of
  368.       UpKey    : F:=Up;
  369.       LeftKey  : F:=Left;
  370.       RightKey : F:=Right;
  371.       DownKey  : F:=Down;
  372.       EnterKey : F:=Enter;
  373.     END
  374.     ELSE IF Ch=#0 THEN
  375.     BEGIN
  376.       ch:=GetKey;
  377.       CASE ch OF
  378.          #72 : F:=Up;
  379.          #75 : F:=Left;
  380.          #77 : F:=Right;
  381.          #80 : F:=Down;
  382.       END;
  383.     END;
  384.     IF ch=#27 THEN BEGIN
  385.       IF empty
  386.         THEN ch:=timekey(TimingConstant)
  387.         ELSE ch:=ReadKey;
  388.       IF ch=#255 THEN F := NormalExit;
  389.       IF ch<>#255 THEN
  390.         IF (ch='[') OR (ch='O') THEN
  391.         BEGIN
  392.           ch:=GetKey;
  393.           CASE ch OF
  394.             'A' : F:=Up;
  395.             'D' : F:=Left;
  396.             'C' : F:=Right;
  397.             'B' : F:=Down;
  398.           END
  399.         END
  400.     END
  401.   END;
  402.   getarrow:=f;
  403. END;
  404.  
  405. FUNCTION yn : boolean;
  406. VAR c : char;
  407. BEGIN
  408.   ansic('1');
  409.   repeat
  410.     c:=upcase(readkey)
  411.   until (c IN ['Y','N',#13]);
  412.   IF (c = 'Y') OR (c=#13) THEN
  413.   BEGIN
  414.     print('Yes');
  415.     yn  :=  true;
  416.   END ELSE
  417.   BEGIN
  418.     print('No');
  419.     yn  :=  false;
  420.   END;
  421. END;
  422.  
  423. END.