home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 375.lha / Keyboard / Keyboard.mod < prev    next >
Encoding:
Modula Implementation  |  1980-02-02  |  10.0 KB  |  295 lines
  1. IMPLEMENTATION MODULE Keyboard;
  2. (*******************************************************************************
  3. Name         : Keyboard.mod
  4. Version      : 1.0
  5. Purpose      : Enables access to RAWKEY events via Intuition.
  6. Author       : Peter Graham Evans. Translation into Modula-2 of a program
  7.              : in the C language by Fabbian G. Dufoe, III on Fish Disk 291.
  8. Language     : Modula-2. Used TDI Modula-2 version 3.01a which I received
  9.              : in the first quarter 1988 from M2S in Bristol, England.
  10. Status       : This is a public domain program and thus can be used for
  11.              : commercial or non commerial purposes.
  12. Date Started : 12/MAR/90.
  13. Date Complete: 25/MAR/90.
  14. Modified     : 18/MAR/90.Renamed the procedures.
  15.              : 19/MAR/90.fixed up some code incorrectly translated.
  16.              : 22/MAR/90.removed some extraneous variables;changed the way
  17.              :           the ConsoleDevice was set up
  18.              : 25/MAR/90.eliminated the need for an InputEventPtr;changed
  19.              :           many CASE statements that I had blindly translated
  20.              :           into Modula-2 into IF statements cutting down size
  21.              :           of link file considerably. In fact I saved 36
  22.              :           bytes for each one.
  23. *******************************************************************************)
  24.  
  25. (* Based on the C Language source code Keyboard.h and Keyboard.c on the
  26. public domain Fish Disk library disk 291 by Fabbian Dufoe. *)
  27.  
  28. FROM ConsoleDevice IMPORT ConsoleBase, ConsoleName, KeyMapPtr, RawKeyConvert;
  29. FROM Devices       IMPORT CloseDevice, DevicePtr, OpenDevice;
  30. FROM InputEvents   IMPORT IEQualifierSet, InputEvent, rawKey, UpPrefix;
  31. FROM Intuition     IMPORT IDCMPFlagSet, IntuiMessagePtr, RawKey;
  32. FROM IO            IMPORT IOStdReq, IOStdReqPtr;
  33. FROM SYSTEM        IMPORT ADDRESS, ADR, BYTE, NULL;
  34.  
  35. VAR
  36.   Console       : IOStdReq;
  37.   Consoledevice : DevicePtr;
  38.  
  39. PROCEDURE OpenKey() : INTEGER;
  40. (* For information on OpenDevice see pB-27 of ROM Kernal Manual
  41. where it states "A unit of -1 indicates that no actual console is to
  42. be opened; this is used to get a pointer to the device library vector.".
  43.    Unfortunately TDI's implementation of OpenDevice requires the
  44. unit to be a LONGCARD. This is incorrect and we have to force a -1 in here.*)
  45.  
  46. TYPE
  47.   ConvertRec = RECORD
  48.                  CASE : CARDINAL OF
  49.                    1 : pseudolongcard : LONGCARD;  | (* this will have
  50.                                                      -1 moved into it! *)
  51.                    2 : longint        : LONGINT;
  52.                  END;
  53.                END; (* record *)
  54. VAR
  55.   Convert        : ConvertRec;
  56.  
  57. BEGIN
  58.  
  59.   Convert.longint:=-1; (* Place -1 in the long integer *)
  60.  
  61.   IF OpenDevice(ConsoleName, Convert.pseudolongcard, ADR(Console), 0)
  62.                                                                 <> 0 THEN
  63.     RETURN -1;
  64.   END;
  65.   Consoledevice:=Console.ioReq.ioDevice;
  66.   ConsoleBase:=ADDRESS(Consoledevice); (* Note that ConsoleBase is the
  67.                                        Modula-2 name for C's ConsoleDevice *)
  68.   (* The book Amiga C for Advanced Programmers by Bleek, Jennrich, Schulz
  69.   published by Data Becker GmbH  ISBN 0-916439-88-7 on page 406 states
  70.     "The RawKeyConvert function is part of the console device. This
  71.     function can be accessed by selecting a pointer to console base
  72.     without opening the console device first, because the function can
  73.     be called like a library function. You receive the pointer to console
  74.     device by calling:
  75.     OpenConsole("console.device",-1L,IOStd,0L);  .....".
  76.   *)
  77.   RETURN 0;
  78. END OpenKey;
  79.  
  80. PROCEDURE CloseKey;
  81. BEGIN
  82.   IF Consoledevice <> NULL THEN
  83.     CloseDevice(ADR(Console));
  84.   END;
  85. END CloseKey;
  86.  
  87. PROCEDURE DeadKeyConvert(VAR KeyMessage : IntuiMessagePtr; (* in     *)
  88.                          VAR KeyBuffer  : ARRAY OF CHAR;   (* in/out *)
  89.                              BufferSize : INTEGER;         (* in     *)
  90.                          VAR KeyMap     : KeyMapPtr        (* in     *) ) :
  91.                                                            LONGINT;
  92. (* FUNCTION
  93.       This function converts an Intuition RAWKEY message to the kind of
  94.       keycodes returned by the Console Device.  It uses the Console Device's
  95.       RawKeyConvert() function.
  96.  
  97.    INPUT
  98.       KeyMessage - a pointer to the intuition message
  99.       KeyBuffer - a pointer to the buffer the user supplied for keycodes
  100.       BufferSize - the size of KeyBuffer
  101.       KeyMap - a pointer to a KeyMap structure to be used for the
  102.                conversion.  A NULL value selects the default KeyMap.
  103.  
  104.    RESULTS
  105.       The function returns -2 if the message was not a RAWKEY class
  106.       message.  If the number of keycodes produced was greater than
  107.       BufferSize the function returns -1.  Otherwise the function returns
  108.       the number of keycodes it placed in the buffer.
  109. *)
  110. VAR
  111.   addressptr    : POINTER TO ADDRESS;
  112.   Inputevent    : InputEvent;
  113. BEGIN
  114.   IF KeyMessage^.Class <> IDCMPFlagSet{RawKey} THEN
  115.     RETURN -2;
  116.   END;
  117.   addressptr:=KeyMessage^.IAddress;
  118.   WITH Inputevent DO
  119.     ieNextEvent:=NULL;
  120.     ieClass    :=rawKey;
  121.     ieSubClass :=BYTE(0);
  122.     ieCode     :=KeyMessage^.Code;
  123.     ieQualifier:=IEQualifierSet(KeyMessage^.Qualifier);
  124.     ieAddr     :=addressptr^;
  125.   END; (* WITH *)
  126.   RETURN RawKeyConvert(ADR(Inputevent), ADR(KeyBuffer),
  127.                         LONGCARD(BufferSize), KeyMap);
  128. END DeadKeyConvert;
  129.  
  130. PROCEDURE ReadKey(VAR KeyMessage : IntuiMessagePtr; (* in  *)
  131.                   VAR KeyID      : INTEGER;         (* out *)
  132.                   VAR KeyMap     : KeyMapPtr        (* in  *) ):INTEGER;
  133. (* FUNCTION
  134.       This routine converts an Intuition RAWKEY message to an ASCII
  135.       character or an integer code identifying the special key pressed.
  136.  
  137.    INPUT
  138.       KeyMessage - a pointer to the Intuition message
  139.       KeyID - a pointer used to return the ID code of a function key
  140.       KeyMap - a pointer to the keymap structure to be used for the
  141.                conversion.  A NULL pointer specifies the default keymap.
  142.  
  143.    RETURNS
  144.       If the function converts a RAWKEY message to an ASCII character it
  145.       returns that character.  It returns zero if a special key was pressed
  146.       and it places the key's ID code in the integer pointed to by KeyID.
  147.       If the message was not a RAWKEY class message or if it was a "key up"
  148.       message ReadKey() returns -2.  The calling program can ignore any
  149.       calls which return -2.  If it fails it returns -1.
  150. *)
  151. VAR
  152.   actual    : LONGINT;
  153.   KeyBuffer : ARRAY [0..9] OF CHAR;
  154. BEGIN
  155.   KeyID:=0;
  156.   IF KeyMessage^.Class <> IDCMPFlagSet{RawKey} THEN
  157.     RETURN -2;
  158.   END;
  159.       (* If it's not a RAWKEY message we'll just ignore it.  We tell the
  160.          caller it can ignore it, too. *)
  161.   IF (BITSET(KeyMessage^.Code) * BITSET(UpPrefix)) = BITSET(UpPrefix) THEN
  162.     RETURN -2;
  163.   END;
  164.       (* If it's a key up message we'll ignore it and tell the caller to
  165.          ignore it, too. *)
  166.   actual:=DeadKeyConvert(KeyMessage, KeyBuffer, 10, KeyMap);
  167.   IF actual = 1 THEN
  168.     RETURN INTEGER(KeyBuffer[0]);
  169.       (* If DeadKeyConvert() converted the message to a single code we can
  170.          return it to the caller. *)
  171.   END;
  172.   IF actual = -1 THEN
  173.     RETURN -1; (* If DeadKeyConvert overflowed its buffer there is error *)
  174.   END;
  175.    IF KeyBuffer[0] = CSI THEN
  176.       CASE KeyBuffer[1] OF
  177.       space:
  178.          CASE KeyBuffer[2] OF
  179.          '@':
  180.             KeyID:=KSRIGHT;       |
  181.          'A':
  182.             KeyID:=KSLEFT;
  183.          ELSE
  184.          END;                  |
  185.       '?':
  186.          IF KeyBuffer[2] = '~' THEN
  187.            KeyID:=KHELP;
  188.          END;                  |
  189.       '0':
  190.          IF KeyBuffer[2] = '~' THEN
  191.            KeyID:=KF1;
  192.          END;                  |
  193.       '1':
  194.          CASE KeyBuffer[2] OF
  195.          '~':
  196.             KeyID:=KF2;         |
  197.          '0':
  198.             IF KeyBuffer[3] = '~' THEN
  199.               KeyID:=KSF1;
  200.             END;                |
  201.          '1':
  202.             IF KeyBuffer[3] = '~' THEN
  203.               KeyID:=KSF2;
  204.             END;                |
  205.          '2':
  206.             IF KeyBuffer[3] = '~' THEN
  207.               KeyID:=KSF3;
  208.             END;                |
  209.          '3':
  210.             IF KeyBuffer[3] = '~' THEN
  211.               KeyID:=KSF4;
  212.             END;                |
  213.          '4':
  214.             IF KeyBuffer[3] = '~' THEN
  215.               KeyID:=KSF5;
  216.             END;                |
  217.          '5':
  218.             IF KeyBuffer[3] = '~' THEN
  219.               KeyID:=KSF6;
  220.             END;                |
  221.          '6':
  222.             IF KeyBuffer[3] = '~' THEN
  223.               KeyID:=KSF7;
  224.             END;                |
  225.          '7':
  226.             IF KeyBuffer[3] = '~' THEN
  227.               KeyID:=KSF8;
  228.             END;                |
  229.          '8':
  230.             IF KeyBuffer[3] = '~' THEN
  231.               KeyID:=KSF9;
  232.             END;                |
  233.          '9':
  234.             IF KeyBuffer[3] = '~' THEN
  235.               KeyID:=KSF10;
  236.             END;
  237.          ELSE
  238.          END;                  |
  239.       '2':
  240.          IF KeyBuffer[2] = '~' THEN
  241.            KeyID:=KF3;
  242.          END;                  |
  243.       '3':
  244.          IF KeyBuffer[2] = '~' THEN
  245.            KeyID:=KF4;
  246.          END;                  |
  247.       '4':
  248.          IF KeyBuffer[2] = '~' THEN
  249.            KeyID:=KF5;
  250.          END;                  |
  251.       '5':
  252.          IF KeyBuffer[2] = '~' THEN
  253.            KeyID:=KF6;
  254.          END;                  |
  255.       '6':
  256.          IF KeyBuffer[2] = '~' THEN
  257.            KeyID:=KF7;
  258.          END;                  |
  259.       '7':
  260.          IF KeyBuffer[2] = '~' THEN
  261.            KeyID:=KF8;
  262.          END;                  |
  263.       '8':
  264.          IF KeyBuffer[2] = '~' THEN
  265.            KeyID:=KF9;
  266.          END;                  |
  267.       '9':
  268.          IF KeyBuffer[2] = '~' THEN
  269.            KeyID:=KF10;
  270.          END;                  |
  271.       'A':
  272.          KeyID:=KUP;           |
  273.       'B':
  274.          KeyID:=KDOWN;         |
  275.       'C':
  276.          KeyID:=KRIGHT;        |
  277.       'D':
  278.          KeyID:=KLEFT;         |
  279.       'S':
  280.          KeyID:=KSDOWN;        |
  281.       'T':
  282.          KeyID:=KSUP;
  283.       ELSE
  284.       END;
  285.    ELSE
  286.    END;
  287.    IF KeyID = 0 THEN
  288.      RETURN -1;
  289.    ELSE
  290.      RETURN 0;
  291.    END;
  292. END ReadKey;
  293.  
  294. END Keyboard.
  295.