Ticket #1191: soegtk.patch

File soegtk.patch, 3.5 kB (added by guest, 4 years ago)

Patch for soegtk/Graphics/SOE/Gtk.hs.pp to implement getWindowTick

  • soegtk/Graphics/SOE/Gtk.hs.pp

    # Description: Fix soegtk to have a window tick
    #  This fixes the package to behave in the way described in the book
    #  "The Haskell School of Expression"
    #  .
    #  The patch was submitted to upstream, but has not been reviewed yet.
    # Author: Julian Gilbey <jdg@debian.org>
    # Last-Update: 2010-05-02
    a b  
    7979  maybeGetWindowEvent, 
    8080  getWindowEvent, 
    8181  Word32, 
     82  getWindowTick, 
    8283  timeGetTime, 
    8384  word32ToInt 
    8485  ) where 
     
    138139  window :: Gtk.Window, 
    139140  canvas :: Gtk.DrawingArea, 
    140141  graphicVar :: MVar Graphic, 
    141   eventsChan :: Chan Event 
     142  eventsChan :: Chan Event, 
     143  tickChan :: Chan Tick 
    142144} 
    143145 
    144146openWindow :: Title -> Size -> IO Window 
    145147openWindow title size = 
    146   openWindowEx title Nothing (Just size) drawBufferedGraphic 
     148  openWindowEx title Nothing (Just size) drawBufferedGraphic Nothing 
    147149 
    148 openWindowEx :: Title -> Maybe Point -> Maybe Size -> RedrawMode -> IO Window 
    149 openWindowEx title position size (RedrawMode useDoubleBuffer) = 
     150openWindowEx :: Title -> Maybe Point -> Maybe Size -> RedrawMode -> 
     151                Maybe Time -> IO Window 
     152openWindowEx title position size (RedrawMode useDoubleBuffer) tick = 
    150153  Gtk.postGUISync $ do 
    151154  window <- Gtk.windowNew 
    152155  Gtk.windowSetTitle window title 
     
    169172  graphicVar <- newMVar emptyGraphic 
    170173  eventsChan <- newChan 
    171174 
     175  tickChan <- newChan 
     176 
    172177  -- set up the fonts 
    173178#ifdef USE_CAIRO 
    174179  pc <- Gtk.Cairo.cairoCreateContext Nothing 
     
    213218#endif 
    214219    return True 
    215220 
    216   Gtk.onDelete window $ \_ -> do writeChan eventsChan Closed 
    217                                  Gtk.widgetHide window 
    218                                  return True 
    219                       
     221  case tick of 
     222    Just t  -> do timer <- Gtk.timeoutAddFull 
     223                           (writeChan tickChan () >> return True) 
     224                           Gtk.priorityDefaultIdle t 
     225                  Gtk.onDelete window $ \_ -> do writeChan eventsChan Closed 
     226                                                 Gtk.timeoutRemove timer 
     227                                                 Gtk.widgetHide window 
     228                                                 return True 
     229                  return () 
     230    Nothing -> do Gtk.onDelete window $ \_ -> do writeChan eventsChan Closed 
     231                                                 Gtk.widgetHide window 
     232                                                 return True 
     233                  return () 
     234 
    220235  Gtk.onMotionNotify canvas True $ \Gtk.Motion { Gtk.eventX=x, Gtk.eventY=y} -> 
    221236    writeChan eventsChan MouseMove { 
    222237      pt = (round x, round y) 
     
    249264    window  = window, 
    250265    canvas  = canvas, 
    251266    graphicVar = graphicVar, 
    252     eventsChan = eventsChan 
     267    eventsChan = eventsChan, 
     268    tickChan = tickChan 
    253269  } 
    254270 
    255271getWindowSize :: Window -> IO Size 
     
    766782getRBP :: Window -> IO Point 
    767783getRBP w = getButton w 2 True 
    768784 
     785--------------------------------- 
     786-- Window Tick Handling Functions 
     787--------------------------------- 
     788 
     789type Time = Int 
     790 
     791type Tick = () 
     792 
     793-- We make sure we completely clear the channel when getting a window tick, 
     794-- so that if we have been delayed, we don't keep running to catch up with 
     795-- ourselves 
     796getWindowTick :: Window -> IO () 
     797getWindowTick w = do readChan (tickChan w) 
     798                     noTicks <- isEmptyChan (tickChan w) 
     799                     if not noTicks then getWindowTick w else return () 
     800 
    769801timeGetTime :: IO Word32 
    770802timeGetTime = do 
    771803  System.Time.TOD sec psec <- System.Time.getClockTime