{"id":58,"date":"2008-01-01T00:18:28","date_gmt":"2008-01-01T07:18:28","guid":{"rendered":"http:\/\/www.elbeno.com\/haskell_soe_blog\/?p=58"},"modified":"2008-01-08T10:12:22","modified_gmt":"2008-01-08T18:12:22","slug":"exercise-104","status":"publish","type":"post","link":"https:\/\/www.elbeno.com\/haskell_soe_blog\/?p=58","title":{"rendered":"Exercise 10.4"},"content":{"rendered":"<p>A quick look at Graphics.SOE reveals that <tt>getWindowEvent<\/tt> is the right function to trap mouse down, up, and move events separately.<\/p>\n<pre lang=\"haskell\">{-\r\nmaybeClear is useful for avoiding flicker when not dragging objects.\r\nA real flicker-free solution should use double-buffering of course -\r\nthis code still flickers terribly while dragging.\r\n-}\r\n\r\nmaybeClear :: Bool -> Window -> IO ()\r\nmaybeClear b w\r\n    = if b\r\n      then do clearWindow w\r\n      else return ()\r\n\r\n{-\r\nThe program is in two halves: either we're waiting for a click (not dragging),\r\nor we're waiting for a release (dragging). Waiting for a click is almost\r\nidentical to the previous definition of loop, except for the event\r\nfunction.\r\n-}\r\n\r\nwaitForClick :: Window -> [(Color, Region)] -> Bool -> IO ()\r\nwaitForClick w regs b\r\n    = do maybeClear b w\r\n         sequence_ [drawRegionInWindow w c r | (c,r) <- reverse regs]\r\n         event <- getWindowEvent w\r\n         case event of\r\n           (Button (x,y) True True) ->\r\n               let aux (_,r) = r `containsR` (pixelToInch (x - xWin2),\r\n                                              pixelToInch (yWin2 - y))\r\n               in case (break aux regs) of\r\n                    (_, []) -> closeWindow w\r\n                    (top, hit:bot) -> waitForRelease (x,y) (x,y) w \r\n                                     (hit : (top++bot)) True\r\n           _ -> waitForClick w regs False\r\n\r\n{-\r\nWhile dragging, we keep track of the initial click coordinates and translate\r\nthe Region at the head of the list by the offset of the current mouse \r\ncoordinates. When the mouse button is released, we go back to waiting \r\nfor a click, leaving the head Region where it is.\r\n-}\r\n\r\nwaitForRelease :: Point -> Point -> Window -> [(Color, Region)] -> Bool -> IO ()\r\nwaitForRelease (origx, origy) (x,y) w regs b\r\n    = do maybeClear b w\r\n         sequence_ [drawRegionInWindow w c r | (c,r) <- reverse $ tail regs]\r\n         let (c,r) = head regs\r\n             newHeadReg = (Translate (pixelToInch (x - origx), pixelToInch(origy - y)) r)\r\n         drawRegionInWindow w c newHeadReg\r\n         event <- getWindowEvent w\r\n         case event of\r\n           (Button (x,y) True False) -> waitForClick w ((c,newHeadReg) : (tail regs)) True\r\n           (MouseMove pt) -> waitForRelease (origx,origy) pt w regs True\r\n           _ -> waitForRelease (origx,origy) (x,y) w regs False\r\n\r\n{-\r\nAll that remains is to drive the drag and drop functionality with some boilerplate\r\ndraw and main functions.\r\n-}\r\n\r\ndraw3 :: String -> Picture -> IO ()\r\ndraw3 s p = runGraphics $\r\n            do w <- openWindow s (xWin, yWin)\r\n               waitForClick w (pictToList p) True\r\n\r\nmain = draw3 \"Drag and Drop\" pic<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>A quick look at Graphics.SOE reveals that getWindowEvent is the right function to trap mouse down, up, and move events separately. {- maybeClear is useful for avoiding flicker when not dragging objects. A real flicker-free solution should use double-buffering of course &#8211; this code still flickers terribly while dragging. -} maybeClear :: Bool -> Window [&hellip;]<\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":[],"categories":[1],"tags":[],"_links":{"self":[{"href":"https:\/\/www.elbeno.com\/haskell_soe_blog\/index.php?rest_route=\/wp\/v2\/posts\/58"}],"collection":[{"href":"https:\/\/www.elbeno.com\/haskell_soe_blog\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.elbeno.com\/haskell_soe_blog\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.elbeno.com\/haskell_soe_blog\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/www.elbeno.com\/haskell_soe_blog\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=58"}],"version-history":[{"count":0,"href":"https:\/\/www.elbeno.com\/haskell_soe_blog\/index.php?rest_route=\/wp\/v2\/posts\/58\/revisions"}],"wp:attachment":[{"href":"https:\/\/www.elbeno.com\/haskell_soe_blog\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=58"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.elbeno.com\/haskell_soe_blog\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=58"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.elbeno.com\/haskell_soe_blog\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=58"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}