home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / RkrmSrc / Intuition / Mouse_Keyboard / mousetest.e < prev    next >
Encoding:
Text File  |  1996-08-29  |  5.9 KB  |  175 lines
  1. -> mousetest.e - Read position and button events from the mouse.
  2.  
  3. OPT OSVERSION=37
  4.  
  5. MODULE 'devices/inputevent',
  6.        'exec/ports',
  7.        'graphics/gfxbase',
  8.        'graphics/rastport',
  9.        'graphics/text',
  10.        'intuition/intuition',
  11.        'intuition/screens'
  12.  
  13. ENUM ERR_NONE, ERR_DRAW, ERR_PUB, ERR_WIN
  14.  
  15. RAISE ERR_DRAW IF GetScreenDrawInfo()=NIL,
  16.       ERR_PUB  IF LockPubScreen()=NIL,
  17.       ERR_WIN  IF OpenWindowTagList()=NIL
  18.  
  19. -> E-Note: C version should use this for a string...
  20. CONST BUFSIZE=15
  21.  
  22. -> Something to use to track the time between messages to test for
  23. -> double-clicks.
  24. OBJECT myTimeVal
  25.   leftSeconds, leftMicros
  26.   rightSeconds, rightMicros
  27. ENDOBJECT
  28.  
  29. PROC main() HANDLE
  30.   DEF win=NIL:PTR TO window, scr=NIL:PTR TO screen,
  31.       dr_info=NIL:PTR TO drawinfo, width, gfx:PTR TO gfxbase
  32.  
  33.   -> Lock the default public screen in order to read its DrawInfo data
  34.   scr:=LockPubScreen(NIL)
  35.  
  36.   dr_info:=GetScreenDrawInfo(scr)
  37.  
  38.   -> Use wider of space needed for output (18 chars and spaces) or titlebar
  39.   -> text plus room for titlebar gads (approx 18 each)
  40.   -> E-Note: get the right type for gfxbase
  41.   gfx:=gfxbase
  42.   width:=Max(gfx.defaultfont.xsize * 18,
  43.              (18*2)+TextLength(scr.rastport, 'MouseTest', STRLEN))
  44.  
  45.   win:=OpenWindowTagList(NIL,
  46.                         [WA_TOP,    20,
  47.                          WA_LEFT,   100,
  48.                          WA_INNERWIDTH,  width,
  49.                          WA_HEIGHT, (2*gfx.defaultfont.ysize)+
  50.                                     scr.wbortop+scr.font.ysize+1+scr.wborbottom,
  51.                          WA_FLAGS, WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET OR
  52.                                      WFLG_ACTIVATE  OR WFLG_REPORTMOUSE OR
  53.                                      WFLG_RMBTRAP   OR WFLG_DRAGBAR,
  54.                          WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_RAWKEY OR
  55.                                      IDCMP_MOUSEMOVE OR IDCMP_MOUSEBUTTONS,
  56.                          WA_TITLE, 'MouseTest',
  57.                          WA_PUBSCREEN, scr,
  58.                          NIL])
  59.  
  60.   WriteF('Monitors the Mouse:\n')
  61.   WriteF('    Move Mouse, Click and DoubleClick in Windows\n')
  62.  
  63.   SetAPen(win.rport, dr_info.pens[TEXTPEN])
  64.   SetBPen(win.rport, dr_info.pens[BACKGROUNDPEN])
  65.   SetDrMd(win.rport, RP_JAM2)
  66.  
  67.   process_window(win)
  68.  
  69. EXCEPT DO
  70.   IF win THEN CloseWindow(win)
  71.   IF dr_info THEN FreeScreenDrawInfo(scr, dr_info)
  72.   IF scr THEN UnlockPubScreen(NIL, scr)
  73.   SELECT exception
  74.   CASE ERR_DRAW; WriteF('Error: Failed to get DrawInfo for screen\n')
  75.   CASE ERR_PUB;  WriteF('Error: Failed to lock public screen\n')
  76.   CASE ERR_WIN;  WriteF('Error: Failed to open window\n')
  77.   ENDSELECT
  78. ENDPROC
  79.  
  80. -> process_window() - Simple message loop for processing IntuiMessages
  81. PROC process_window(win:PTR TO window)
  82.   -> E-Note: C version failed to use BUFSIZE!
  83.   DEF going, msg:PTR TO intuimessage, class, tv, prt_buff[BUFSIZE]:STRING,
  84.       xText, yText  -> Places to position text in window
  85.  
  86.   -> E-Note: going rather than done saves a lot of Not()-ing
  87.   going:=TRUE
  88.   tv:=[0, 0, 0, 0]:myTimeVal
  89.   xText:=win.borderleft+(win.ifont.xsize*2)
  90.   yText:=win.bordertop+3+win.ifont.baseline
  91.  
  92.   -> E-Note: we can't use WaitIMessage() because we want mousex, mousey
  93.   WHILE going
  94.     Wait(Shl(1, win.userport.sigbit))
  95.     WHILE going AND (msg:=GetMsg(win.userport))
  96.       class:=msg.class
  97.       SELECT class
  98.       CASE IDCMP_CLOSEWINDOW
  99.         going:=FALSE
  100.  
  101.       -> NOTE NOTE NOTE:  If the mouse queue backs up a lot, Intuition will
  102.       -> start dropping MOUSEMOVE messages off the end until the queue is
  103.       -> serviced.  This may cause the program to lose some of the MOUSEMOVE
  104.       -> events at the end of the stream.
  105.       ->
  106.       -> Look in the window structure if you need the true position of the
  107.       -> mouse pointer at any given time.  Look in the MOUSEBUTTONS message if
  108.       -> you need position when it clicked.  An alternate to this processing
  109.       -> would be to set a flag that a mousemove event arrived, then print the
  110.       -> position of the mouse outside of a "WHILE GetMsg()" loop.  This allows
  111.       -> a single processing call for many mouse events, which speeds up
  112.       -> processing A LOT!  Something like:
  113.       ->
  114.       -> WHILE GetMsg()
  115.       ->   IF class=IDCMP_MOUSEMOVE THEN mouse_flag:= TRUE
  116.       ->    ReplyMsg()  -> NOTE: copy out all needed fields first !
  117.       -> ENDWHILE
  118.       -> IF mouse_flag
  119.       ->   process_mouse_event()
  120.       ->   mouse_flag:=FALSE
  121.       -> ENDIF
  122.       ->
  123.       -> You can also use IDCMP_INTUITICKS for slower paced messages (all
  124.       -> messages have mouse coordinates.)
  125.       CASE IDCMP_MOUSEMOVE
  126.     -> Show the current position of the mouse relative to the upper left
  127.         -> hand corner of our window
  128.     Move(win.rport, xText, yText)
  129.     StringF(prt_buff, 'X=\d[5] Y=\d[5]', msg.mousex, msg.mousey)
  130.         Text(win.rport, prt_buff, BUFSIZE)
  131.       CASE IDCMP_MOUSEBUTTONS
  132.         doButtons(msg, tv)
  133.       ENDSELECT
  134.       ReplyMsg(msg)
  135.     ENDWHILE
  136.   ENDWHILE
  137. ENDPROC
  138.  
  139. -> Show what mouse buttons where pushed
  140. PROC doButtons(msg:PTR TO intuimessage, tv:PTR TO myTimeVal)
  141.   DEF code
  142.   IF msg.qualifier AND (IEQUALIFIER_LSHIFT OR IEQUALIFIER_RSHIFT)
  143.     WriteF('Shift ')
  144.   ENDIF
  145.  
  146.   code:=msg.code
  147.   SELECT code
  148.   CASE SELECTDOWN
  149.     WriteF('Left Button Down at X=\d Y=\d', msg.mousex, msg.mousey)
  150.     IF DoubleClick(tv.leftSeconds, tv.leftMicros, msg.seconds, msg.micros)
  151.       WriteF(' DoubleClick!')
  152.     ELSE
  153.       tv.leftSeconds:=msg.seconds
  154.       tv.leftMicros:=msg.micros
  155.       tv.rightSeconds:=0
  156.       tv.rightMicros:=0
  157.     ENDIF
  158.   CASE SELECTUP
  159.     WriteF('Left Button Up   at X=\d Y=\d', msg.mousex, msg.mousey)
  160.   CASE MENUDOWN
  161.     WriteF('Right Button Down at X=\d Y=\d', msg.mousex, msg.mousey)
  162.     IF DoubleClick(tv.rightSeconds, tv.rightMicros, msg.seconds, msg.micros)
  163.       WriteF(' DoubleClick!')
  164.     ELSE
  165.       tv.leftSeconds:=0
  166.       tv.leftMicros:=0
  167.       tv.rightSeconds:=msg.seconds
  168.       tv.rightMicros:=msg.micros
  169.     ENDIF
  170.   CASE MENUUP
  171.     WriteF('Right Button Up   at X=\d Y=\d', msg.mousex, msg.mousey)
  172.   ENDSELECT
  173.   WriteF('\n')
  174. ENDPROC
  175.