home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 300-399 / ff344.lzh / Keyboard / RawDemo.mod < prev    next >
Text File  |  1990-04-14  |  8KB  |  211 lines
  1. MODULE RawDemo;
  2. (*******************************************************************************
  3. Name         : RawDemo
  4. Version      : 1.0
  5. Purpose      : Tests access to RAWKEY events via Intuition in module
  6.              : Keyboard
  7. Author       : Peter Graham Evans. Translation into Modula-2 of a program
  8.              : in the C language by Fabbian G. Dufoe, III on Fish Disk 291.
  9. Language     : Modula-2. Uses TDI Modula-2 version 3.01a which I received
  10.              : in the first quarter 1988 from M2S in Bristol, England.
  11. Status       : This is a public domain program and thus can be used for
  12.              : commercial or non commercial purposes.
  13. Date Started : 18/MAR/90.
  14. Date Complete: 24/MAR/90.
  15. Modified     : 25/MAR/90.added further comments and tidied up
  16. *******************************************************************************)
  17.  
  18. FROM ConsoleDevice IMPORT KeyMapPtr;
  19. FROM GraphicsLibrary      IMPORT Jam1;
  20. FROM InOut         IMPORT Write, WriteInt, WriteString, WriteLn;
  21. FROM Intuition     IMPORT IntuitionBase, IntuiMessagePtr, WBenchScreen,
  22.                           WindowFlags, IDCMPFlagSet, IDCMPFlags,
  23.                           WindowPtr, IntuitionText, NewWindow,
  24.                           ScreenFlagSet, IntuitionName, WindowFlagSet,
  25.                           PrintIText, SmartRefresh;
  26. FROM Keyboard      IMPORT CloseKey, OpenKey, ReadKey,
  27.                           KUP, KDOWN, KRIGHT, KLEFT, KSUP, KSDOWN, KSRIGHT,
  28.                           KSLEFT, KHELP, KF1, KF2, KF3, KF4, KF5, KF6, KF7,
  29.                           KF8, KF9, KF10, KSF1, KSF2, KSF3, KSF4, KSF5,
  30.                           KSF6, KSF7, KSF8, KSF9, KSF10;
  31. FROM Libraries     IMPORT OpenLibrary, CloseLibrary;
  32. FROM Ports         IMPORT WaitPort, GetMsg, ReplyMsg, MessagePtr;
  33. FROM Rasters       IMPORT RastPortPtr;
  34. FROM SYSTEM        IMPORT ADR, BYTE, NULL;
  35. FROM Windows       IMPORT OpenWindow, CloseWindow;
  36.  
  37. (* [Based on the C Language source code RawDemo.c on the public domain Fish
  38. Disk library disk 291 by Fabbian Dufoe.
  39.    I have changed the names of the procedures to make them more readable.]
  40.  
  41.    by Fabbian G. Dufoe, III
  42.    This is a public domain program.  You may use it any way you want.
  43.  
  44.    This program demonstrates the use of the OpenReadConsole(), ReadKey(),
  45.    and CloseReadConsole() functions in Keyboard.c  [These names have
  46.    been changed.]
  47.  
  48.    [If you have any problems with using these modules or have any other
  49. comment then please contact  Mr. Peter G.Evans
  50.                              "Erehwon"
  51.                              37 Charles Street
  52.                              Cheltenham
  53.                              Victoria 3192
  54.                              Australia
  55.                     tele     (03) 5842765
  56.                              +61 3 584 2765       ]
  57. *)
  58.  
  59. VAR
  60.   window : WindowPtr;
  61.   rastp  : RastPortPtr;
  62.   IText1 : IntuitionText;
  63.   message: IntuiMessagePtr;
  64.   Text1  : ARRAY [0..14] OF CHAR;
  65.   Title1 : ARRAY [0..19] OF CHAR; (* The text for the window title must be
  66.                                   outside the procedure InitWindow because
  67.                                   local variables disappear when the
  68.                                   procedure exits. If you put it inside
  69.                                   InitWindow the title will disappear when
  70.                                   you move the window or click in another
  71.                                   window then go back to this window.
  72.                                   Page 6 AmiProject # 6 Jan/Feb 1987
  73.                                   was the clue in article 'Using Menus With
  74.                                   Intuition' by Richie Bielak. *)
  75.  
  76. PROCEDURE InitWindow () : WindowPtr;
  77. (* Open a window and return a pointer to it *)
  78.  
  79. VAR
  80.   neww   : NewWindow;
  81.  
  82. BEGIN
  83.   Title1:="RawDemo in Modula-2";
  84.   WITH neww DO
  85.     LeftEdge   := 0;
  86.     TopEdge    := 10;
  87.     Width      := 550;
  88.     Height     := 190;
  89.     DetailPen  := BYTE(0);
  90.     BlockPen   := BYTE(1);
  91.     IDCMPFlags := IDCMPFlagSet{CloseWindowFlag,RawKey,MouseButtons};
  92.     Flags      := WindowFlagSet{WindowDrag,WindowDepth,WindowClose,
  93.                               WindowSizing,Activate} + SmartRefresh;
  94.     FirstGadget:= NULL;
  95.     CheckMark  := NULL;
  96.     Title      := ADR(Title1);
  97.     Screen     := NULL;
  98.     BitMap     := NULL;
  99.     MinWidth   := 10;
  100.     MinHeight  := 10;
  101.     MaxWidth   := 640;
  102.     MaxHeight  := 400;
  103.     Type       := ScreenFlagSet{WBenchScreen};
  104.   END; (* WITH *)
  105.   RETURN OpenWindow(neww);
  106. END InitWindow;
  107.  
  108. PROCEDURE PrintKey (VAR KeyMessage : IntuiMessagePtr);
  109. VAR
  110.   KeyID : INTEGER;
  111.   Key   : INTEGER;
  112.   KeyMap: KeyMapPtr;
  113. BEGIN
  114.    KeyMap:=NULL;
  115.    Key:=ReadKey(KeyMessage, KeyID, KeyMap);
  116.    IF (Key = -1) OR (Key = -2) THEN
  117.      RETURN
  118.    END;
  119.    IF Key <> 0 THEN
  120.      WriteString("Key: ");
  121.      Write(CHAR(Key)); WriteLn;
  122.    ELSE (* Key = 0 *)
  123.      CASE KeyID OF
  124.        KUP:     WriteString("K_UP");       |
  125.        KDOWN:   WriteString("K_DOWN");     |
  126.        KRIGHT:  WriteString("K_RIGHT");    |
  127.        KLEFT:   WriteString("K_LEFT");     |
  128.        KSUP:    WriteString("K_S_UP");     |
  129.        KSDOWN:  WriteString("K_S_DOWN");   |
  130.        KSRIGHT: WriteString("K_S_RIGHT");  |
  131.        KSLEFT:  WriteString("K_S_LEFT");   |
  132.        KHELP:   WriteString("K_HELP");     |
  133.        KF1:     WriteString("K_F1");       |
  134.        KF2:     WriteString("K_F2");       |
  135.        KF3:     WriteString("K_F3");       |
  136.        KF4:     WriteString("K_F4");       |
  137.        KF5:     WriteString("K_F5");       |
  138.        KF6:     WriteString("K_F6");       |
  139.        KF7:     WriteString("K_F7");       |
  140.        KF8:     WriteString("K_F8");       |
  141.        KF9:     WriteString("K_F9");       |
  142.        KF10:    WriteString("K_F10");      |
  143.        KSF1:    WriteString("K_S_F1");     |
  144.        KSF2:    WriteString("K_S_F2");     |
  145.        KSF3:    WriteString("K_S_F3");     |
  146.        KSF4:    WriteString("K_S_F4");     |
  147.        KSF5:    WriteString("K_S_F5");     |
  148.        KSF6:    WriteString("K_S_F6");     |
  149.        KSF7:    WriteString("K_S_F7");     |
  150.        KSF8:    WriteString("K_S_F8");     |
  151.        KSF9:    WriteString("K_S_F9");     |
  152.        KSF10:   WriteString("K_S_F10");
  153.      ELSE
  154.      END; (* CASE *)
  155.      WriteLn;
  156.    END; (* IF *)
  157. END PrintKey;
  158.  
  159. BEGIN
  160.   IntuitionBase:=OpenLibrary(IntuitionName, 0);
  161.   IF IntuitionBase <> NULL THEN
  162.     IF OpenKey() = 0 THEN
  163.       window:=InitWindow();
  164.       IF window <> NULL THEN
  165.         rastp:=window^.RPort;
  166.         Text1:="Type some keys.";
  167.         WITH IText1 DO
  168.           FrontPen := BYTE(1);
  169.           BackPen  := BYTE(0);
  170.           DrawMode := BYTE(Jam1);
  171.           LeftEdge := 4;
  172.           TopEdge  := 12;
  173.           ITextFont:= NULL;
  174.           IText    := ADR(Text1);
  175.           NextText := NULL;
  176.         END; (* WITH *)
  177.         PrintIText(rastp, IText1, 0, 0);
  178.         REPEAT
  179.           message:=IntuiMessagePtr(WaitPort(window^.UserPort));
  180.           LOOP
  181.             message:=IntuiMessagePtr(GetMsg(window^.UserPort));
  182.             IF message = NULL THEN EXIT END;
  183.             IF message^.Class = IDCMPFlagSet{CloseWindowFlag} THEN
  184.             ELSIF message^.Class = IDCMPFlagSet{RawKey} THEN
  185.                           PrintKey(message);
  186.             ELSIF message^.Class = IDCMPFlagSet{MouseButtons} THEN
  187.                           WriteString("Mouse X: ");
  188.                           WriteInt(message^.MouseX, 3);
  189.                           WriteString("    Y: ");
  190.                           WriteInt(message^.MouseY, 3);
  191.                           WriteLn;
  192.             END; (* IF *)
  193.             ReplyMsg(MessagePtr(message)); (* ReplyMsg must be AFTER doing
  194.                                            our ReadKey stuff *)
  195.             EXIT;
  196.           END; (* LOOP *)
  197.         UNTIL message^.Class = IDCMPFlagSet{CloseWindowFlag};
  198.         CloseWindow(window);
  199.       ELSE
  200.         WriteString("OpenWindow failed"); WriteLn;
  201.       END;
  202.       CloseKey;
  203.     ELSE
  204.       WriteString("OpenKey failed."); WriteLn;
  205.     END;
  206.     CloseLibrary(IntuitionBase);
  207.   ELSE
  208.     WriteString("OpenLibrary failed for intuition.library."); WriteLn;
  209.   END;
  210. END RawDemo.
  211.