Input.device

From Freepascal Amiga wiki
Jump to navigation Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.

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.