home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / progm / tot4.zip / TOTINPUT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-11  |  27KB  |  1,060 lines

  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.00                             }
  6.  
  7. Unit totINPUT;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:
  12.  
  13. }
  14.  
  15.  
  16. INTERFACE
  17.  
  18. uses DOS,CRT;
  19.  
  20. Const
  21.     StuffBufferSize = 30;
  22.  
  23. Type
  24.  
  25. InputIdleProc    = procedure;
  26. InputPressedProc = procedure(var W:word);
  27. CharProc         = procedure(W:word);
  28. CaseFunc         = function(Ch:char):char;
  29. CharSet = set of char;
  30.  
  31. pAlphabetOBJ = ^AlphabetOBJ;
  32. AlphabetOBJ = object
  33.    vUpper: CharSet;
  34.    vLower: CharSet;
  35.    vPunctuation: CharSet;
  36.    vUpCaseFunc: CaseFunc;
  37.    vLoCaseFunc: CaseFunc;
  38.    {methods...}
  39.    constructor Init;
  40.    procedure   AssignUpCaseFunc(Func:caseFunc);
  41.    procedure   AssignLoCaseFunc(Func:caseFunc);
  42.    procedure   SetUpper(Letters:CharSet);
  43.    procedure   SetLower(Letters:CharSet);
  44.    procedure   SetPunctuation(Letters:CharSet);
  45.    function    IsUpper(K:word): boolean;
  46.    function    IsLower(K:word): boolean;
  47.    function    IsLetter(K:word): boolean;
  48.    function    IsPunctuation(K:word): boolean;
  49.    function    GetUpCase(Ch:char):char;
  50.    function    GetLoCase(Ch:char):char;
  51.    destructor  Done;
  52. end; {AlphabetOBJ}
  53.  
  54. pMouseOBJ = ^MouseOBJ;
  55. MouseOBJ = object
  56.    vInstalled: boolean;   {is the system equipped with a mouse}
  57.    vButtons: byte;        {how many buttons on mouse}
  58.    vLeftHanded: boolean;  {is right button Enter?}
  59.    vIntr: integer;        {mouse interrupt number}
  60.    vVisible: boolean;     {is mouse cursor visible?}
  61.    {methods}
  62.    constructor Init;
  63.    procedure   Reset;
  64.    function    Installed:boolean;
  65.    procedure   CheckInstalled;
  66.    procedure   Show;
  67.    procedure   Hide;
  68.    procedure   Move(X,Y : integer);
  69.    procedure   Confine(X1,Y1,X2,Y2:integer);
  70.    function    Released(Button: integer; var X,Y: byte): byte;
  71.    function    Pressed(Button: integer; var X,Y: byte): byte;
  72.    function    InZone(X1,Y1,X2,Y2: byte):boolean;
  73.    procedure   Location(var X,Y : byte);
  74.    procedure   Status(var L,C,R:boolean; var X,Y : byte);
  75.    function    Visible: boolean;
  76.    procedure   SetMouseCursorStyle(OrdChar,Attr:byte);
  77.    procedure   SetLeft(On:boolean);
  78.    function    GetButtons: byte;
  79.    destructor  Done;
  80. end; {MouseOBJ}
  81.  
  82. pKeyOBJ = ^KeyOBJ;
  83. KeyOBJ = object
  84.    vMouseMethod: byte;        {0-no mouse, 1-cursor emulation, 2-freefloating mouse}
  85.    vBuffer: array[1..StuffBufferSize] of word;
  86.    vBufferHead: word;         {next character from buffer}
  87.    vBufferTail:word;          {last valid character in buffer}
  88.    vLastkey: word;            {the last key pressed}
  89.    vLastX:byte;               {location of mouse when button pressed}
  90.    vLastY:byte;               {                -"-                  }
  91.    vClick: boolean;           {click after every keypress?}
  92.    vHorizSensitivity: byte;   {no of characters}
  93.    vVertSensitivity: byte;    {      -"-       }
  94.    vWaitForDouble: boolean;
  95.    vIdleHook: InputIdleProc;
  96.    vPressedHook: InputPressedProc;
  97.    vExtended : boolean;       {is it an extended keyboard}
  98.    vButtons : byte;
  99.    {methods...}
  100.    constructor Init;
  101.    procedure   AssignIdleHook(PassedProc: InputIdleProc);
  102.    procedure   AssignPressedHook(PassedProc: InputPressedProc);
  103.    function    Extended: boolean;
  104.    procedure   SetCaps(On:boolean);
  105.    procedure   SetNum(On:boolean);
  106.    procedure   SetScroll(On:boolean);
  107.    function    GetCaps:boolean;
  108.    function    GetNum:boolean;
  109.    function    GetScroll:boolean;
  110.    procedure   SetRepeatRate(Delay,Rate:byte);
  111.    procedure   SetFast;
  112.    procedure   SetSlow;
  113.    procedure   SetMouseMethod(Method:byte);
  114.    procedure   SetClick(On: boolean);
  115.    procedure   SetDouble(On:boolean);
  116.    function    GetDouble:boolean;
  117.    procedure   Click;
  118.    procedure   SetHoriz(Sensitivity:byte);
  119.    procedure   SetVert(Sensitivity:byte);
  120.    procedure   GetInput;
  121.    function    LastKey: word;
  122.    function    LastChar: char;
  123.    function    LastX: byte;
  124.    function    LastY: byte;
  125.    function    GetKey: word;
  126.    procedure   FlushBuffer;
  127.    procedure   StuffBuffer(W:word);
  128.    procedure   StuffBufferStr(Str:string);
  129.    function    Keypressed: boolean;
  130.    procedure   DelayKey(Mills:longint);
  131.    function    AltPressed:boolean;
  132.    function    CtrlPressed:boolean;
  133.    function    LeftShiftPressed: boolean;
  134.    function    RightShiftPressed: boolean;
  135.    function    ShiftPressed: boolean;
  136.    destructor  Done;
  137. end; {KeyOBJ}
  138.  
  139. procedure NoInputIdleHook;
  140. procedure NoInputPressedHook(var W:word);
  141. function  Altkey(K: word): word;
  142. procedure inputINIT;
  143.  
  144. VAR
  145.    AlphabetTOT: ^AlphabetOBJ;
  146.    Mouse: MouseOBJ;
  147.    Key:   KeyOBJ;
  148.  
  149. IMPLEMENTATION
  150. var
  151.    KeyStatusBits : word absolute $0040:$0017;
  152.  
  153. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  154. {                                                               }
  155. {     U N I T   P R O C E D U R E S   &   F U N C T I O N S     }
  156. {                                                               }
  157. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  158.  
  159. {$F+}
  160.  procedure NoInputIdleHook;
  161.  {empty procs}
  162.  begin end; {NoInputIdleHook}
  163.  
  164.  procedure NoInputPressedHook(var W:word);
  165.  {empty procs}
  166.  begin end; {NoInputPressedHook}
  167.  
  168.  function EnglishUpCase(Ch:char):char;
  169.  {}
  170.  begin
  171.     EnglishUpCase := upcase(Ch);
  172.  end; {EnglishUpCase}
  173. (*
  174.  inline($58/$3C/$61/$72/$39/$3C/$7A/$76/$33/$3C/$84/$75/$02/$B0/$8E
  175.  /$3C/$94/$75/$02/$B0/$99/$3C/$81/$75/$02/$B0/$9A
  176.  /$3C/$87/$75/$02/$B0/$80/$3C/$86/$75/$02/$B0/$BF
  177.  /$3C/$82/$75/$02/$B0/$90/$3C/$91/$75/$02/$B0/$92
  178.  /$3C/$A4/$75/$02/$B0/$A5/$EB/03/90/$2C/$20);
  179. *)
  180.  function EnglishLoCase(Ch:char):char;
  181.  {}
  182.  begin
  183.    if Ch in ['A'..'Z'] then
  184.       EnglishLoCase := chr(ord(Ch) + 32)
  185.    else
  186.       EnglishLoCase := Ch;
  187.  end; {EnglishLoCase}
  188.  (*
  189.  inline($58/$3C/$41/$72/$39/$3C/$5A/$76/$33/$3C/$8E/$75/$02/$B0/$B4
  190.  /$3C/$99/$75/$02/$B0/$94/$3C/$9A/$75/$02/$B0/$81
  191.  /$3C/$8D/$75/$02/$B0/$87/$3C/$8F/$75/$02/$B0/$86
  192.  /$3C/$9D/$75/$02/$B0/$82/$3C/$92/$75/$02/$B0/$91
  193.  /$3C/$A5/$75/$02/$B0/$A4/$EB/03/90/$04/$20);
  194.  *)
  195. {$F-}
  196.  
  197. function Altkey(K: word): word;
  198. {returns the Alt keycode equivalent of a number or letter}
  199. var AK: word;
  200. begin
  201.    Case K of
  202.       65:AK:=286; 66:AK:=304; 67:AK:=302; 68:AK:=288; 69:AK:=274; 70:AK:=289;
  203.       71:AK:=290; 72:AK:=291; 73:AK:=279; 74:AK:=292; 75:AK:=293; 76:AK:=294;
  204.       77:AK:=306; 78:AK:=305; 79:AK:=280; 80:AK:=281; 81:AK:=272; 82:AK:=275;
  205.       83:AK:=287; 84:AK:=276; 85:AK:=278; 86:AK:=303; 87:AK:=273; 88:AK:=301;
  206.       89:AK:=277; 90:AK:=300; 48:AK:=385;
  207.    else if (K >= 49) and (K <= 57) then
  208.            AK := K + 327
  209.         else 
  210.            AK := 0;
  211.    end; {case}
  212.    AltKey := AK;
  213. end; {AltKey}
  214. {|||||||||||||||||||||||||||||||||||||||||||||||||}
  215. {                                                 }
  216. {     A l p h a b e t O B J    M E T H O D S      }
  217. {                                                 }
  218. {|||||||||||||||||||||||||||||||||||||||||||||||||}
  219. constructor AlphabetOBJ.Init;
  220. {}
  221. begin
  222.    vUpper := ['A'..'Z'];
  223.    vLower := ['a'..'z'];
  224.    vPunctuation := [',',';',':','.',' '];
  225.    AssignUpcaseFunc(EnglishUpcase);
  226.    AssignLocaseFunc(EnglishLocase);
  227. end; {AlphabetOBJ.Init}
  228.  
  229. procedure AlphabetOBJ.AssignUpCaseFunc(Func:caseFunc);
  230. {}
  231. begin
  232.    vUpCaseFunc := Func;
  233. end; {AlphabetOBJ.AssignUpCaseFunc}
  234.  
  235. procedure AlphabetOBJ.AssignLoCaseFunc(Func:caseFunc);
  236. {}
  237. begin
  238.    vLoCaseFunc := Func;
  239. end; {AlphabetOBJ.AssignLoCaseFunc}
  240.  
  241. procedure AlphabetOBJ.SetUpper(Letters:CharSet);
  242. {}
  243. begin
  244.    vUpper := Letters;
  245. end; {AlphabetOBJ.SetUpper}
  246.  
  247. procedure AlphabetOBJ.SetLower(Letters:CharSet);
  248. {}
  249. begin
  250.    vLower := Letters;
  251. end; {AlphabetOBJ.SetLower}
  252.  
  253. procedure AlphabetOBJ.SetPunctuation(Letters:CharSet);
  254. {}
  255. begin
  256.    vPunctuation := Letters;
  257. end; {AlphabetOBJ.SetPunctuation}
  258.  
  259. function AlphabetOBJ.IsUpper(K:word): boolean;
  260. {}
  261. begin
  262.    if K > 255 then
  263.      IsUpper := false
  264.    else
  265.      IsUpper := chr(K) in vUpper;
  266. end; {AlphabetOBJ.IsUpper}
  267.  
  268. function AlphabetOBJ.IsLower(K:word): boolean;
  269. {}
  270. begin
  271.    if K > 255 then
  272.      IsLower := false
  273.    else
  274.      IsLower := chr(K) in vLower;
  275. end; {AlphabetOBJ.IsLower}
  276.  
  277. function AlphabetOBJ.IsLetter(K:word): boolean;
  278. {}
  279. begin
  280.    if K > 255 then
  281.      IsLetter := false
  282.    else
  283.      IsLetter := (chr(K) in vUpper) or (chr(K) in vLower);
  284. end; {AlphabetOBJ.IsLetter}
  285.  
  286. function AlphabetOBJ.IsPunctuation(K:word): boolean;
  287. {}
  288. begin
  289.    if K > 255 then
  290.      IsPunctuation := false
  291.    else
  292.    IsPunctuation := chr(K) in vPunctuation;
  293. end; {AlphabetOBJ.IsPunctuation}
  294.  
  295. function AlphabetOBJ.GetUpCase(Ch:char):char;
  296. {}
  297. begin
  298.    GetUpCase := vUpCaseFunc(Ch);
  299. end; {AlphabetOBJ.GetUpCase}
  300.  
  301. function AlphabetOBJ.GetLoCase(Ch:char):char;
  302. {}
  303. begin
  304.    GetLoCase := vLoCaseFunc(Ch);
  305. end;{AlphabetOBJ.GetLoCase}
  306.  
  307. destructor AlphabetOBJ.Done;
  308. {}
  309. begin
  310. end; {AlphabetOBJ.Done}
  311. {|||||||||||||||||||||||||||||||||||||||||||}
  312. {                                           }
  313. {     M o u s e O B J    M E T H O D S      }
  314. {                                           }
  315. {|||||||||||||||||||||||||||||||||||||||||||}
  316. constructor MouseOBJ.Init;
  317. {}
  318. begin
  319.   CheckInstalled;
  320.   If vInstalled then
  321.   begin
  322.      vIntr := $33;
  323.      vVisible := false;
  324.      Reset;
  325.   end
  326.   else
  327.      vVisible := false;
  328. end; {MouseOBJ.Init}
  329.  
  330. procedure MouseOBJ.CheckInstalled;
  331. {}
  332. var
  333.   MouseInterruptPtr : pointer absolute $0000:$00CC;
  334.  
  335.     Function InterruptLoaded:boolean;
  336.     var
  337.       Reg: registers;
  338.     begin
  339.        Reg.Ax := 0;
  340.        Intr($33,Reg);
  341.        InterruptLoaded :=  Reg.Ax <> 0;
  342.     end;
  343.  
  344. begin
  345.    vButtons := 0;
  346.    if (MouseInterruptPtr = nil)
  347.    or (byte(MouseInterruptPtr) = $CF) then
  348.       vInstalled := false          {don't call interrupt if vector is zero}
  349.    else
  350.       vInstalled := Interruptloaded;
  351. end; {MouseOBJ.CheckInstalled}
  352.  
  353. procedure MouseOBJ.Reset;
  354. {}
  355. var Regs : registers;
  356. begin
  357.    if vInstalled then
  358.    begin
  359.       Regs.Ax := $00;
  360.       Intr(vIntr,Regs);
  361.       vButtons := Regs.Bx;
  362.       vVisible := false;
  363.    end;
  364. end; {MouseOBJ.Reset}
  365.  
  366. function MouseOBJ.Installed:boolean;
  367. {}
  368. begin
  369.     Installed := vInstalled;
  370. end; {MouseOBJ.Installed}
  371.  
  372. procedure MouseOBJ.Show;
  373. {}
  374. var Regs : registers;
  375. begin
  376.    if (vInstalled) and (not vVisible) then
  377.    begin
  378.       Regs.Ax := $01;
  379.       Intr(vIntr,Regs);
  380.       vVisible := true;
  381.    end;
  382. end; {MouseOBJ.Show}
  383.  
  384. procedure MouseOBJ.Hide;
  385. {}
  386. var Regs : registers;
  387. begin
  388.    if vInstalled and vVisible then
  389.    begin
  390.       Regs.Ax := $02;
  391.       Intr(vIntr,Regs);
  392.       vVisible := false;
  393.    end;
  394. end; {MouseOBJ.Hide}
  395.  
  396. procedure MouseOBJ.Move(X,Y : integer);
  397. {X and Y are character positions not pixel positions}
  398. var Regs : registers;
  399. begin
  400.    if vInstalled then
  401.    begin
  402.       with Regs do
  403.       begin
  404.          Ax := $04;
  405.          Cx := pred(X*8);   {8 pixels per character}
  406.          Dx := pred(Y*8);   {         "-"          }
  407.       end; {with}
  408.       Intr(vIntr,Regs);
  409.    end;
  410. end; {MouseOBJ.Move}
  411.  
  412. procedure MouseOBJ.Confine(X1,Y1,X2,Y2:integer);
  413. {}
  414. var Regs : registers;
  415. begin
  416.    if vInstalled then
  417.       with Regs do
  418.       begin
  419.          {horizontal}
  420.          Ax := $07;
  421.          Cx := pred(X1*8);
  422.          Dx := pred(X2*8);
  423.          intr(vIntr,Regs);
  424.          {vertical}
  425.          Ax := $08;
  426.          Cx := pred(Y1*8);
  427.          Dx := pred(Y2*8);
  428.          intr(vIntr,Regs);
  429.       end;
  430. end; {MouseOBJ.Confine}
  431.  
  432. function MouseOBJ.Released(Button: integer; var X,Y: byte): byte;
  433. {}
  434. var Regs : registers;
  435. begin
  436.    if vInstalled then
  437.       with Regs do
  438.       begin
  439.          Ax := 6;
  440.          Bx := Button;
  441.          intr(vIntr,Regs);
  442.          Released := Bx;
  443.          X := succ(Cx div 8);
  444.          Y := succ(Dx div 8);
  445.       end;
  446. end; {MouseOBJ.Released}
  447.  
  448. function MouseOBJ.Pressed(Button: integer; var X,Y: byte): byte;
  449. {}
  450. var Regs : registers;
  451. begin
  452.    if vInstalled then
  453.       with Regs do
  454.       begin
  455.          Ax := 5;
  456.          Bx := Button;
  457.          intr(vIntr,Regs);
  458.          Pressed := Bx;
  459.          X := succ(Cx div 8);
  460.          Y := succ(Dx div 8);
  461.       end;
  462. end; {MouseOBJ.Pressed}
  463.  
  464. function MouseOBJ.InZone(X1,Y1,X2,Y2: byte):boolean;
  465. {}
  466. var X,Y: byte;
  467. begin
  468.    if vInstalled and vVisible then
  469.    begin
  470.       Location(X,Y);
  471.       InZone := (X >= X1) and (X <= X2) and (Y >= Y1) and (Y <= Y2);
  472.    end
  473.    else
  474.       InZone := false;
  475. end; {MouseOBJ.InZone}
  476.  
  477. procedure MouseOBJ.Location(var X,Y : byte);
  478. {}
  479. var Regs : registers;
  480. begin
  481.    if vInstalled then
  482.       with Regs do
  483.       begin
  484.          Ax := 3;
  485.          intr(vIntr,Regs);
  486.          X := succ(Cx div 8);
  487.          Y := succ(Dx div 8);
  488.       end; {with}
  489. end; {MouseOBJ.Location}
  490.  
  491. procedure MouseOBJ.Status(var L,C,R:boolean; var X,Y : byte);
  492. {}
  493. var Regs : registers;
  494. begin
  495.    if vInstalled then
  496.    begin
  497.       with Regs do
  498.       begin
  499.          Ax := 3;
  500.          intr(vIntr,Regs);
  501.          X := succ(Cx div 8);
  502.          Y := succ(Dx div 8);
  503.          L := ((BX and $01) = $01);
  504.          R := ((BX and $02) = $02);
  505.          C := ((BX and $04) = $04);
  506.       end; {with}
  507.    end
  508.    else
  509.    begin
  510.       L := false;
  511.       C := false;
  512.       R := false;
  513.       X := 1;
  514.       Y := 1;
  515.    end;
  516. end; {MouseOBJ.Status}
  517.  
  518. procedure MouseOBJ.SetMouseCursorStyle(OrdChar,Attr: byte);
  519. var
  520.   Reg: registers;
  521. begin
  522.    if vInstalled then
  523.    begin
  524.       Reg.Ax := 10;
  525.       Reg.Bx := 0;        {software text cursor}
  526.       if Attr = 0 then
  527.          Reg.CX := $7700
  528.       else
  529.          Reg.Cx := $00;
  530.       Reg.Dl := OrdChar;
  531.       Reg.Dh := Attr;
  532.       Intr($33,Reg);
  533.    end;
  534. end; {MouseOBJ.SetMouseCursorStyle}
  535.  
  536. function MouseOBJ.Visible:boolean;
  537. {}
  538. begin
  539.    Visible := vVisible;
  540. end; {MouseOBJ.Visible}
  541.  
  542. function MouseOBJ.GetButtons: byte;
  543. {}
  544. begin
  545.    GetButtons := vButtons;
  546. end; {MouseOBJ.GetButtons}
  547.  
  548. procedure MouseOBJ.SetLeft(On:boolean);
  549. {}
  550. begin
  551.    vLeftHanded := On;
  552. end; {MouseOBJ.SetLeft}
  553.  
  554. destructor MouseOBJ.Done;
  555. {}
  556. begin end;
  557. {|||||||||||||||||||||||||||||||||||||||}
  558. {                                       }
  559. {     K e y O B J    M e t h o d s      }
  560. {                                       }
  561. {|||||||||||||||||||||||||||||||||||||||}
  562. constructor KeyOBJ.Init;
  563. {}
  564. var
  565.    ExtStatus: byte absolute $0000:$0496;
  566. begin
  567.    vExtended := (ExtStatus <> 0);
  568.    vIdleHook := NoInputIdleHook;
  569.    vPressedHook := NoInputPressedHook;
  570.    vBufferHead := 1;
  571.    vBufferTail := 1;
  572.    vHorizSensitivity := 1;
  573.    vVertSensitivity := 1;
  574.    vClick := false;
  575.    vLastKey := 0;
  576.    vWaitForDouble := false;
  577.    vButtons := 0;
  578.    SetMouseMethod(2);
  579. end; {KeyOBJ.Init}
  580.  
  581. procedure KeyOBJ.AssignIdleHook(PassedProc: InputIdleProc);
  582. {}
  583. begin
  584.    vIdleHook := PassedProc;
  585. end; {KeyOBJ.AssignIdleHook}
  586.  
  587. procedure KeyOBJ.AssignPressedHook(PassedProc: InputPressedProc);
  588. {}
  589. begin
  590.    vPressedHook := PassedProc;
  591. end; {KeyOBJ.AssignPressedHook}
  592.  
  593. function KeyOBJ.Extended:boolean;
  594. {}
  595. begin
  596.     Extended := vExtended;
  597. end; {KeyOBJ.Extended}
  598.  
  599. procedure KeyOBJ.SetCaps(On:boolean);
  600. {}
  601. begin
  602.    If On then
  603.       KeyStatusBits := (KeyStatusBits or $40)
  604.    else
  605.       KeyStatusBits := (KeyStatusBits and $BF);
  606. end; {KeyOBJ.SetCaps}
  607.  
  608. procedure KeyOBJ.SetNum(On:boolean);
  609. {}
  610. begin
  611.    If On then
  612.       KeyStatusBits := (KeyStatusBits or $20)
  613.    else
  614.       KeyStatusBits := (KeyStatusBits and $DF);
  615. end; {KeyOBJ.SetNum}
  616.  
  617. procedure KeyOBJ.SetScroll(On:boolean);
  618. {}
  619. begin
  620.    If On then
  621.       KeyStatusBits := (KeyStatusBits or $10)
  622.    else
  623.       KeyStatusBits := (KeyStatusBits and $EF);
  624. end; {KeyOBJ.SetScroll}
  625.  
  626. function KeyOBJ.GetCaps:boolean;
  627. {}
  628. var CapsOnW : word;
  629. begin
  630.    CapsOnW := swap(KeyStatusBits);
  631.    GetCaps := (CapsOnW and $4000) <> 0;
  632. end; {KeyOBJ.GetCaps}
  633.  
  634. function KeyOBJ.GetNum:boolean;
  635. {}
  636. var NumOnW : word;
  637. begin
  638.    NumOnW := swap(KeyStatusBits);
  639.    GetNum := (NumOnW and $2000) <> 0;
  640. end; {KeyOBJ.GetNum}
  641.  
  642. function KeyOBJ.GetScroll:boolean;
  643. {}
  644. var ScrollOnW : word;
  645. begin
  646.    ScrollOnW := swap(KeyStatusBits);
  647.    GetScroll := (ScrollOnW and $1000) <> 0;
  648. end; {KeyOBJ.GetScroll}
  649.  
  650. procedure KeyOBJ.SetRepeatRate(Delay,Rate:byte);
  651. {}
  652. var Regs : registers;
  653. begin
  654.   with Regs do
  655.   begin
  656.      Ah := 3;
  657.      Al := 5;
  658.      Bl := Rate;
  659.      Bh := pred(Delay);
  660.      Intr($16,Regs);
  661.   end;
  662. end; {KeyOBJ.SetRepeatRate}
  663.  
  664. procedure KeyOBJ.SetFast;
  665. {}
  666. begin
  667.    SetRepeatRate(1,0);
  668. end; {KeyOBJ.SetFast}
  669.  
  670. procedure KeyOBJ.SetSlow;
  671. {}
  672. begin
  673.    SetRepeatRate(2,$14);
  674. end; {KeyOBJ.SetSlow}
  675.  
  676. procedure KeyOBJ.SetMouseMethod(Method:byte);
  677. {}
  678. begin
  679.    if (Method in [1,2]) and Mouse.Installed then
  680.    begin
  681.       vMouseMethod := Method;
  682.       vButtons := Mouse.GetButtons;
  683.    end
  684.    else
  685.       vMouseMethod := 0;
  686. end; {KeyOBJ.SetMouseMethod}
  687.  
  688. procedure KeyOBJ.SetHoriz(Sensitivity:byte);
  689. {}
  690. begin
  691.    vHorizSensitivity := Sensitivity;
  692. end; {KeyOBJ.SetHoriz}
  693.  
  694. procedure KeyOBJ.SetVert(Sensitivity:byte);
  695. {}
  696. begin
  697.    vVertSensitivity := Sensitivity;
  698. end; {KeyOBJ.SetHoriz}
  699.  
  700. procedure KeyOBJ.SetClick(On: boolean);
  701. {}
  702. begin
  703.    vClick := On;
  704. end; {KeyOBJ.SetClick}
  705.  
  706. procedure KeyOBJ.SetDouble(On:boolean);
  707. {}
  708. begin
  709.    vWaitForDouble := On;
  710. end; {KeyOBJ.SetDouble}
  711.  
  712. function KeyOBJ.GetDouble:boolean;
  713. {}
  714. begin
  715.    GetDouble := vWaitForDouble;
  716. end; {KeyOBJ.GetDouble}
  717.  
  718. procedure KeyOBJ.Click;
  719. {}
  720. begin
  721.    Sound(1000);
  722.    Sound(50);
  723.    delay(5);
  724.    nosound;
  725. end; {KeyOBJ.Click}
  726.  
  727. procedure KeyOBJ.GetInput;
  728. {waits for a keypress or mouse activity}
  729. Const
  730.    H = 40;
  731.    V = 13;
  732.    SlowDelay = 350;    {was 200}
  733.    QwikDelay = 20;
  734.    LastPress: longint = 0;
  735.    ClockTicks = 18.2;
  736. Var
  737.    L,C,R : boolean;
  738.    Action: boolean;
  739.    Finished: boolean;
  740.    ThisPress: Longint;
  741.    Temp, TempX,TempY,X,Y: byte;
  742.    Ch : char;
  743.    KeyWord : word;
  744.    InitDelay:word;
  745.    LeftPresses, RightPresses, CenterPresses: word;
  746.    ButtonCombinations: byte;
  747.  
  748. begin
  749.    if vWaitForDouble then
  750.       InitDelay := SlowDelay
  751.    else
  752.       InitDelay := 100;
  753.    if vBufferHead <> vBufferTail then  {read from object buffer}
  754.    begin
  755.       Keyword := vBuffer[vBufferHead];
  756.       if vBufferHead < StuffBufferSize then
  757.          Inc(vBufferHead)
  758.       else
  759.          vBufferHead := 1;
  760.    end
  761.    else       {wait for keypress or mouse action}
  762.    begin
  763.       if vMouseMethod = 1 then
  764.          Mouse.Move(H,V);
  765.       Action := false;
  766.       Finished := false;
  767.       repeat
  768.          vIdleHook;   {call the users idle hook procedure}
  769.          if vMouseMethod > 0 then
  770.          begin
  771.             ThisPress := MemL[$40:$6C];   {get time}
  772.             Keyword := 0;
  773.             Mouse.Status(L,C,R,X,Y);
  774.             if L or R or C then {a button is being depressed}
  775.             begin
  776.                Finished := true;
  777.                { Next is the mouse speed up effect }
  778.                if ((ThisPress - LastPress) / ClockTicks)*1000 > InitDelay+200 then
  779.                begin
  780.                   delay(InitDelay);          {check for double click}
  781.                   LeftPresses := Mouse.Released(0,TempX,TempY);
  782.                   RightPresses := Mouse.Released(1,TempX,TempY);
  783.                   if vButtons > 2 then
  784.                      CenterPresses := Mouse.Released(2,TempX,TempY)
  785.                   else
  786.                      CenterPresses := 0;
  787.                   {Check for mouse combinations}
  788.                   ButtonCombinations :=   ord(LeftPresses > 0)
  789.                                         + 2*ord(RightPresses > 0)
  790.                                         + 4*ord(CenterPresses > 0);
  791.                   case ButtonCombinations of
  792.                      1: Keyword := 513;  {left button}
  793.                      2: Keyword := 514;  {right button}
  794.                      3: Keyword := 516;  {left+right}
  795.                      4: Keyword := 515;  {center button}
  796.                      5: Keyword := 517;  {left+center}
  797.                      6: Keyword := 518;  {center+right}
  798.                      7: Keyword := 519;  {all three buttons}
  799.                   end;
  800.                   if LeftPresses > 1 then
  801.                      Keyword := 523      {double left}
  802.                   else if RightPresses > 1 then
  803.                      Keyword := 524      {double right}
  804.                   else if CenterPresses > 1 then
  805.                      Keyword := 525;     {double center}
  806.                end
  807.                else
  808.                   delay(QwikDelay);
  809.                LastPress := ThisPress;
  810.                If Keyword = 0 then
  811.                begin
  812.                   if L then
  813.                      Keyword := 513
  814.                   else
  815.                     if R then
  816.                        Keyword := 514
  817.                     else
  818.                        Keyword := 515;
  819.                end;
  820.             end;
  821.             Temp := Mouse.Pressed(0,TempX,TempY);   {clear the mouse buffers}
  822.             Temp := Mouse.Pressed(1,TempX,TempY);
  823.             Temp := Mouse.Pressed(2,TempX,TempY);
  824.             Temp := Mouse.Released(0,TempX,TempY);
  825.             Temp := Mouse.Released(1,TempX,TempY);
  826.             Temp := Mouse.Released(2,TempX,TempY);
  827.             if vMouseMethod = 1 then
  828.             begin
  829.                Mouse.Location(X,Y);
  830.                if Y - V > vVertSensitivity then
  831.                begin
  832.                   Keyword :=  584;   {mouse up}
  833.                   Finished := true;
  834.                end
  835.                else if V - Y > vVertSensitivity then
  836.                begin
  837.                   Keyword :=  592;   {mouse down}
  838.                   Finished := true;
  839.                end
  840.                else if X - H > vHorizSensitivity then
  841.                begin
  842.                   Keyword :=  589;   {mouse right}
  843.                   Finished := true;
  844.                end
  845.                else if H - X > vHorizSensitivity then
  846.                begin
  847.                   Keyword :=  587;   {mouse left}
  848.                   Finished := true;
  849.                end
  850.             end;
  851.          end; {if}
  852.          If KeyPressed or Finished then
  853.             Action := true;
  854.       until Action;
  855.       if not finished then
  856.       begin
  857.         Ch := ReadKey;
  858.         if Ch = #0 then
  859.         begin
  860.             Ch := Readkey;
  861.             Keyword := 256+ord(Ch);
  862.             if (KeyWord >= 327) and (Keyword <= 339) then
  863.             begin
  864.                if AltPressed then
  865.                   inc(Keyword,80)
  866.                else if ShiftPressed then
  867.                   inc(Keyword,100)
  868.                else if CtrlPressed then
  869.                   inc(Keyword,120);
  870.             end;
  871.         end
  872.         else
  873.            KeyWord := ord(Ch);
  874.       end;
  875.  
  876.    end;
  877.    vPressedHook(Keyword);
  878.    vLastKey := Keyword;
  879.    vLastX := X;
  880.    vLastY := Y;
  881.    if vClick then
  882.       Click;
  883. end; {KeyOBJ.GetInput}
  884.  
  885. function KeyOBJ.Lastkey: word;
  886. {}
  887. begin
  888.    LastKey := vLastKey;
  889. end; {KeyOBJ.Lastkey}
  890.  
  891. function KeyOBJ.GetKey: word;
  892. {}
  893. begin
  894.    GetInput;
  895.    GetKey := vLastKey;
  896. end; {KeyOBJ.GetKey}
  897.  
  898. function KeyOBJ.LastChar: char;
  899. {}
  900. begin
  901.    if vLastKey < 256 then
  902.       LastChar := chr(LastKey)
  903.    else
  904.       LastChar := #0;
  905. end; {KeyOBJ.LastChar}
  906.  
  907. function KeyOBJ.LastX: byte;
  908. {}
  909. begin
  910.    LastX := vLastX;
  911. end; {KeyOBJ.LastX}
  912.  
  913. function KeyOBJ.LastY: byte;
  914. {}
  915. begin
  916.    LastY := vLastY;
  917. end; {KeyOBJ.LastY}
  918.  
  919. procedure KeyOBJ.FlushBuffer;
  920. {}
  921. var Regs: registers;
  922. begin
  923.    vBufferTail := VBufferHead; {empty program buffer}
  924.    with Regs do
  925.    begin
  926.       Ax := ($0c shl 8) or 6;
  927.       Dx := $00ff;
  928.    end;
  929.    Intr($21,Regs);
  930. end; {KeyOBJ.FlushBuffer}
  931.  
  932. procedure KeyOBJ.StuffBuffer(W:word);
  933. {adds word to program keyboard buffer}
  934. begin
  935.    if (vBufferTail + 1 = vBufferHead) 
  936.    or ((vBufferTail = StuffBufferSize) and (vBufferHead = 1)) then
  937.       exit; {buffer full}     
  938.    vBuffer[vBufferTail] := W;
  939.    if vBufferTail < StuffBufferSize then
  940.       inc(vBufferTail)
  941.    else
  942.       vBufferTail := 1;
  943. end; {KeyOBJ.StuffBuffer}
  944.  
  945. procedure KeyOBJ.StuffBufferStr(Str:string);
  946. {}
  947. var I,L : byte;
  948. begin
  949.    if Str <> '' then
  950.    begin
  951.       I := 1;
  952.       L := length(Str);
  953.       if L > StuffBufferSize then
  954.          L := StuffBufferSize;
  955.       while I <= L do
  956.       begin
  957.          StuffBuffer(ord(Str[I]));
  958.          inc(I);
  959.       end;
  960.    end; 
  961. end; {KeyOBJ.StuffBufferStr}
  962.  
  963. function KeyOBJ.Keypressed: boolean;
  964. {}
  965. begin
  966.    KeyPressed := (CRT.Keypressed) or (vBufferTail <> vBufferHead);
  967. end; {KeyOBJ.KeyPressed}
  968.  
  969. procedure KeyOBJ.DelayKey(Mills:longint);
  970. {}
  971. var
  972.   EndTime: longint;
  973.   Now: longint;
  974.  
  975.    procedure SetNull;
  976.    begin
  977.       vLastKey := 0;
  978.       vLastX := 0;
  979.       vLastY := 0;
  980.    end;
  981.  
  982. begin
  983.    if Mills <= 0 then
  984.       SetNull
  985.    else
  986.    begin
  987.       EndTime := MemL[$40:$6C] + trunc( (Mills/1000)*18.2);
  988.       Repeat
  989.          Now := MemL[$40:$6C];
  990.       until Keypressed or (Now >= EndTime);
  991.       if KeyPressed then
  992.          GetInput
  993.       else
  994.          SetNull;
  995.    end;
  996. end; {KeyOBJ.DelayKey}
  997.  
  998. function KeyOBJ.AltPressed:boolean;
  999. var
  1000.   AltW : word;
  1001. begin
  1002.    AltW := swap(KeyStatusBits);
  1003.    AltPressed := (AltW and $0800) <> 0;
  1004. end; {KeyOBJ.AltPressed}
  1005.  
  1006. function KeyOBJ.CtrlPressed:boolean;
  1007. var
  1008.   CtrlW : word;
  1009. begin
  1010.    CtrlW := swap(KeyStatusBits);
  1011.    CtrlPressed := (CtrlW and $0400) <> 0;
  1012. end; {KeyOBJ.CtrlPressed}
  1013.  
  1014. function KeyOBJ.LeftShiftPressed: boolean;
  1015. {}
  1016. var LSW : word;
  1017. begin
  1018.    LSW := swap(KeyStatusBits);
  1019.    LeftShiftPressed := (LSW and $0200) <> 0;
  1020. end; {LeftShiftPressed}
  1021.  
  1022. function KeyOBJ.RightShiftPressed: boolean;
  1023. {}
  1024. var RSW : word;
  1025. begin
  1026.    RSW := swap(KeyStatusBits);
  1027.    RightShiftPressed := (RSW and $0100) <> 0;
  1028. end; {RightShiftPressed}
  1029.  
  1030. function KeyOBJ.ShiftPressed: boolean;
  1031. {}
  1032. var SW : word;
  1033. begin
  1034.    SW := swap(KeyStatusBits);
  1035.    ShiftPressed := ((SW and $0200) <> 0) or ((SW and $0100) <> 0);
  1036. end; {ShiftPressed}
  1037.  
  1038. destructor KeyOBJ.Done;
  1039. {}
  1040. begin end; {of desc KeyOBJ.Done}
  1041. {|||||||||||||||||||||||||||||||||||||||||||||||}
  1042. {                                               }
  1043. {     U N I T   I N I T I A L I Z A T I O N     }
  1044. {                                               }
  1045. {|||||||||||||||||||||||||||||||||||||||||||||||}
  1046. procedure InputInit;
  1047. {initilizes objects and global variables}
  1048. begin
  1049.    new(AlphabetTOT,Init);
  1050.    Mouse.Init;
  1051.    Key.Init;
  1052. end;
  1053.  
  1054. {end of unit - add intialization routines below}
  1055. {$IFNDEF OVERLAY}
  1056. begin
  1057.    InputInit;
  1058. {$ENDIF}
  1059. end.
  1060.