Difference between revisions of "Input.device"

From Freepascal Amiga wiki
Jump to navigation Jump to search
(→‎The unit: Added)
 
Line 15: Line 15:
  
  
=== Example: ( insert example title ) ===
+
=== Example: Show keyboard + mouse qualifiers  ===
  
There's no example available.
+
Simple example showing how to use PeekQualifiers() function. It displays the active qualifiers for keyboard and mouse.
  
  
Line 23: Line 23:
  
 
<source lang="pascal">
 
<source lang="pascal">
 +
program ShowKeyQualifiers;
 +
 +
 +
{$MODE OBJFPC}{$H+}
 +
Uses
 +
  sysutils,
 +
  exec, amigados,
 +
  aros_device_input;
 +
 +
 +
Type
 +
  {$packset 1}
 +
  {$packenum 1}
 +
 
 +
  TQualifierBits =
 +
  (
 +
    FIEQUALIFIERB_LSHIFT        , // = 0;
 +
    FIEQUALIFIERB_RSHIFT        , // = 1;
 +
    FIEQUALIFIERB_CAPSLOCK      , // = 2;
 +
    FIEQUALIFIERB_CONTROL        , // = 3;
 +
    FIEQUALIFIERB_LALT          , // = 4;
 +
    FIEQUALIFIERB_RALT          , // = 5;
 +
    FIEQUALIFIERB_LCOMMAND      , // = 6;
 +
    FIEQUALIFIERB_RCOMMAND      , // = 7;
 +
    FIEQUALIFIERB_NUMERICPAD    , // = 8;
 +
    FIEQUALIFIERB_REPEAT        , // = 9;
 +
    FIEQUALIFIERB_INTERRUPT      , // = 10;
 +
    FIEQUALIFIERB_MULTIBROADCAST , // = 11;
 +
    FIEQUALIFIERB_MIDBUTTON      , // = 12;
 +
    FIEQUALIFIERB_RBUTTON        , // = 13;
 +
    FIEQUALIFIERB_LEFTBUTTON    , // = 14;
 +
    FIEQUALIFIERB_RELATIVEMOUSE    // = 15;
 +
  );
 +
 
 +
  TQualifiers = Set of TQualifierBits;
 +
 
 +
 
 +
Function QualsToStr(quals: TQualifiers): String;
 +
Const
 +
  QualifierNames : Array[TQualifierBits] of pchar =
 +
  (
 +
    'LSHIFT', 'RSHIFT',
 +
    'CAPSLOCK',
 +
    'CTRL',
 +
    'LALT', 'RALT',
 +
    'LCOMMAND', 'RCOMMAND',
 +
    'NUMLOCK',
 +
    'REPEAT',
 +
    'INTERRUPT',
 +
    'BROADCAST',
 +
    'MMOUSEBTN',
 +
    'RMOUSEBTN',
 +
    'LMOUSEBTN',
 +
    'MOUSEWHEELBTN'
 +
  );
 +
Var
 +
  s: String; B: TQualifierBits;
 +
begin
 +
  S := '';
 +
  For B := Low(B) to High(B) do
 +
  begin
 +
    if B in quals then
 +
    begin
 +
      if S <> '' then S := S + '+';
 +
      S := S + QualifierNames[B];
 +
    end;
 +
  end;
 +
  Result := '[' + S + ']';
 +
end;
 +
 +
 +
 +
procedure doTest;
 +
Var
 +
  InputBase : pLibrary absolute aros_device_input.InputBase;  // Make sure to initialize original library base.
 +
  InputIO  : pIORequest;
 +
  quals    : UWORD;
 +
Var
 +
  mp : pMsgPort;
 +
begin
 +
  mp := CreateMsgPort;
 +
 
 +
  if (mp <> nil) then
 +
  begin
 +
    InputIO := CreateIORequest(mp, sizeof (TIOStdReq));
 +
 +
    if (InputIO <> nil) then
 +
    begin
 +
 
 +
      If (0 = OpenDevice('input.device', 0, InputIO, 0)) then
 +
      begin
 +
        writeln('checking qualifiers');
 +
        InputBase := pLibrary(InputIO^.io_Device);
 +
   
 +
        If (Inputbase <> nil) then
 +
        begin
 +
          Quals := PeekQualifier;
 +
          WriteLn('Qualifiers (UWORD) = ', QualsToStr(TQualifiers(Quals)));
 +
        end; 
 +
 +
        CloseDevice(InputIO);
 +
      end;
 +
 +
      DeleteIORequest(InputIO);
 +
    end;
 +
 +
    DeleteMsgPort(mp);
 +
  end;
 +
end;
 +
 +
 +
begin
 +
  writeln('enter');
 +
  DoTest;
 +
  writeln('leave');
 +
end.
 
</source>
 
</source>
 
  
 
=== Example: ( insert example title ) ===
 
=== Example: ( insert example title ) ===

Latest revision as of 23:06, 21 March 2015

Short explanatory description not available.


Description

There's no description available.


Usage

There is no usage information available.


Examples

Example: Show keyboard + mouse qualifiers

Simple example showing how to use PeekQualifiers() function. It displays the active qualifiers for keyboard and mouse.


program ShowKeyQualifiers;


{$MODE OBJFPC}{$H+}
Uses
  sysutils,
  exec, amigados,
  aros_device_input;


Type
  {$packset 1}
  {$packenum 1}
  
  TQualifierBits = 
  (
    FIEQUALIFIERB_LSHIFT         , // = 0;
    FIEQUALIFIERB_RSHIFT         , // = 1;
    FIEQUALIFIERB_CAPSLOCK       , // = 2;
    FIEQUALIFIERB_CONTROL        , // = 3;
    FIEQUALIFIERB_LALT           , // = 4;
    FIEQUALIFIERB_RALT           , // = 5;
    FIEQUALIFIERB_LCOMMAND       , // = 6;
    FIEQUALIFIERB_RCOMMAND       , // = 7;
    FIEQUALIFIERB_NUMERICPAD     , // = 8;
    FIEQUALIFIERB_REPEAT         , // = 9;
    FIEQUALIFIERB_INTERRUPT      , // = 10;
    FIEQUALIFIERB_MULTIBROADCAST , // = 11;
    FIEQUALIFIERB_MIDBUTTON      , // = 12;
    FIEQUALIFIERB_RBUTTON        , // = 13;
    FIEQUALIFIERB_LEFTBUTTON     , // = 14;
    FIEQUALIFIERB_RELATIVEMOUSE    // = 15;
  );
  
  TQualifiers = Set of TQualifierBits;
  
  
Function QualsToStr(quals: TQualifiers): String;
Const
  QualifierNames : Array[TQualifierBits] of pchar =
  (
    'LSHIFT', 'RSHIFT',
    'CAPSLOCK',
    'CTRL',
    'LALT', 'RALT',
    'LCOMMAND', 'RCOMMAND',
    'NUMLOCK',
    'REPEAT',
    'INTERRUPT',
    'BROADCAST',
    'MMOUSEBTN',
    'RMOUSEBTN',
    'LMOUSEBTN',
    'MOUSEWHEELBTN'
  );
Var 
  s: String; B: TQualifierBits;
begin
  S := '';
  For B := Low(B) to High(B) do
  begin
    if B in quals then
    begin
      if S <> '' then S := S + '+';
      S := S + QualifierNames[B];
    end;
  end;
  Result := '[' + S + ']';
end;


 
procedure doTest;
Var
  InputBase : pLibrary absolute aros_device_input.InputBase;  // Make sure to initialize original library base.
  InputIO   : pIORequest;
  quals     : UWORD;
Var
  mp : pMsgPort;
begin
  mp := CreateMsgPort;
  
  if (mp <> nil) then
  begin
    InputIO := CreateIORequest(mp, sizeof (TIOStdReq));

    if (InputIO <> nil) then
    begin
  
      If (0 = OpenDevice('input.device', 0, InputIO, 0)) then
      begin
        writeln('checking qualifiers');
        InputBase := pLibrary(InputIO^.io_Device);
    
        If (Inputbase <> nil) then
        begin
          Quals := PeekQualifier;
          WriteLn('Qualifiers (UWORD) = ', QualsToStr(TQualifiers(Quals)));
        end;  

        CloseDevice(InputIO);
      end;

      DeleteIORequest(InputIO);
    end;

    DeleteMsgPort(mp);
  end;
end;


begin
  writeln('enter');
  DoTest; 
  writeln('leave');
end.

Example: ( insert example title )

There's no example available.



Example: ( insert example title )

There's no example available.



The unit

unit aros_device_input;

{$MODE OBJFPC}{$H+}

interface

Uses
  Exec;

Const
  IND_ADDHANDLER    = (CMD_NONSTD + 0);
  IND_REMHANDLER    = (CMD_NONSTD + 1);
  IND_WRITEEVENT    = (CMD_NONSTD + 2);
  IND_SETTHRESH     = (CMD_NONSTD + 3);
  IND_SETPERIOD     = (CMD_NONSTD + 4);
  IND_SETMPORT      = (CMD_NONSTD + 5);
  IND_SETMTYPE      = (CMD_NONSTD + 6);
  IND_SETMTRIG      = (CMD_NONSTD + 7);

  IND_ADDEVENT      = (CMD_NONSTD + 15); //* V50! */

Type
  //* The following is AROS-specific, experimental and subject to change */
  TInputDevice      = record
    id_Device       : TDevice;
    id_Flags        : ULONG;
  end;

Const
  IDF_SWAP_BUTTONS  = $0001;


// qualifiers are located in unit inputevent (e.g. IEQUALIFIERB_LSHIFT)


Var
  InputBase : pLibrary = nil;


  Function PeekQualifier(): UWORD; syscall InputBase 7;


Implementation

end.


Unit documentation

Currently there's no Free Pascal specific documentation available for this unit. Please consult the original SDK.