3
\$\begingroup\$

I'm new to both GTK and Haskell, so I'd appreciate any in both. I'm making an application which for the purposes of this question is just drawing a window that shows a red circle getting larger until it touches the edges of the window.

I have a CircleGUI.hs module which defines the following functions:

module CircleGUI where

import qualified Circles.Circles as Circles
import qualified Graphics.UI.Gtk as Gtk

type Window = Gtk.Window

-- start title
-- Must be called exactly once, before any other commands.
-- Makes a window with the title 'title' centered on the screen,
-- with dimensions equal to half the screen size in both directions.
start :: String -> IO Window

-- finish window
-- Must be called exactly once, after all other commands.
-- Takes current thread to be main GUI thread.
finish :: Window -> IO ()

-- size window
-- Returns window's (width, height).
size :: Window -> IO (Int, Int)

-- postDisplay window action
-- Registers action to be done after window has been displayed.
postDisplay :: Window -> IO () -> IO ()

-- addCircles window circle
-- Adds a canvas to the window with the circle pointed to by 'circle'
-- drawn in red. Since the pointer is mutable, its position will be updated.
--
-- After making a mutation to the parameter circle transaction variable,
-- make sure to call the update handler. This is safe to do on any thread
-- (it notifies the main event dispatch loop asynchronously).
--
-- The update function should only be called from one thread at a time,
-- by the same thread that mutates the parameter circle reference.
--
-- Note that the update can only be called after the window is displayed;
-- in other words, after calling 'finish'. Thus a method which updates the
-- variable should do so on another thread which is started by a call
-- to 'postDisplay'
addCircles :: Window -> IORef.IORef Circles.Circle -> IO (IO ())

I think that Window indeed defines an abstract data type (the goal was for no GTK to leak into the main module), so hopefully a user of CircleGUI can't, say, call another GTK method on a Window object.

The Circle type is defined in another module, where I hope to keep things pure:

module Circles.Circles where

data Circle = Circle { xCoord :: Int, yCoord :: Int, radius :: Int }
  deriving (Eq)

-- toTuple circle
-- Returns the tuple (x, y, r) for the circle.
toTuple :: Circle -> (Int, Int, Int)
toTuple (Circle { xCoord = x, yCoord = y, radius = r }) = (x, y, r)

Finally, the main module looks like this:

-- Main file
-- Generates a window with a red circle which continues expancing in
-- the window until it reaches the edges.

import qualified Circles.Circles as Circles
import qualified CircleGUI.CircleGUI as CircleGUI
import qualified Control.Concurrent as Concurrent
import qualified Control.Monad as Monad
import qualified Data.IORef as IORef

-- Asyc "circle enlargment" task which simulates an animation
-- as a calculation generates a new circle.
enlargeCircle :: IO () -> IORef.IORef Circles.Circle -> Int -> IO ()
enlargeCircle update circle maxRadius =
  let
    increment = max 1 $ maxRadius `div` 100
    enlarge = do
      (x, y, r) <- IORef.readIORef circle >>= return . Circles.toTuple
      Monad.when (r < maxRadius) $
    IORef.writeIORef circle $ Circles.Circle x y $ r + increment
      return r
    loop = do
      r <- enlarge
      putStrLn $ "radius " ++ show r
      update
      Concurrent.threadDelay 100000
      Monad.when (r < maxRadius) loop
  in loop

main :: IO ()
main = do
  -- Generate the window and retreive its sizes
  window <- CircleGUI.start "Circles"
  (w, h) <- CircleGUI.size window

  -- Put red circle in the center, then add the circles to a canvas
  -- and retrieve the mutable redCircle updater.
  let maxRadius = min w h `div` 2
  redCircle <- IORef.newIORef $ Circles.Circle (w `div` 2) (h `div` 2) 0
  update <- CircleGUI.addCircles window redCircle

  -- Set a thread to make the redCircle larger as time goes on.
  CircleGUI.postDisplay window $ Monad.void . Concurrent.forkIO $
    enlargeCircle update redCircle maxRadius

  -- Add them to the canvas and display
  CircleGUI.finish window

The entire current application (which works, at least on my machine) with install instructions is available at this repository. Please note there's a tad more there than the amount I abstracted away, most notably I'm also displaying some static black circles in the background.

Now, on to specific questions:

  1. I've found that I needed to use Circles.toTuple just to unfold a circle because I've found the qualified record syntax was so verbose (when I needed to get all 3 fields. Is there a more idiomatic way to do so?

  2. Am I using GTK correctly? The way I have addCircles implemented, I have a handler added to a DrawingArea's onExpose event which updates the entire canvas; that is:

    addCircles window circle = do
      -- Generate a canvas that takes up the entire window
      (w, h) <- size window
      canvas <- Gtk.drawingAreaNew
      _ <- Gtk.onSizeRequest canvas $ return (Gtk.Requisition w h)
    
      -- Set the repaint handler and add to the window
      _ <- Gtk.onExpose canvas $ updateCanvas canvas
      Gtk.containerAdd window canvas
    
      -- Create the update function. First, generate a reference to a
      -- "history," the last circle that was drawn (its region needs to be
      -- invalidated because it no longer exists there).
      history <- IORef.readIORef circle >>= IORef.newIORef
      return $ invalidateMutableCircle history canvas
      where
        drawCircle drawWindow drawContext circ =
          let (x, y, r) = Circles.toTuple circ
          (cx, cy, rr) = (x - r, y - r, r * 2)
          in Gtk.drawArc drawWindow drawContext False cx cy rr rr 0 (64 * 360)
        updateCanvas canvas _ = do
          drawWindow <- Gtk.widgetGetDrawWindow canvas
          redAndThin <- Gtk.gcNewWithValues drawWindow $
                    Gtk.newGCValues { Gtk.foreground = Gtk.Color 65535 0 0 }
          circleSnapshot <- IORef.readIORef circle
          drawCircle drawWindow redAndThin circleSnapshot
          return True
        invalidateMutableCircle history canvas = Gtk.postGUIAsync $ do
          current <- IORef.readIORef circle
          prev <- IORef.readIORef history
          Monad.unless (current == prev) $ do
            drawWindow <- Gtk.widgetGetDrawWindow canvas
            let invalidateRegions = do
              Gtk.drawWindowInvalidateRect drawWindow (bounding prev) True
              Gtk.drawWindowInvalidateRect drawWindow (bounding current) True
            Gtk.postGUIAsync invalidateRegions
            IORef.writeIORef history current
        bounding circ =
          let (x, y, r) = Circles.toTuple circ
          buffer = 5
          br = r + buffer
          in Gtk.Rectangle (x - br) (y - br) (2 * br) (2 * br)
    

I'm worried that GTK is redrawing the entire canvas even if I invalidate just the specific region. Could someone please confirm? Also, I noticed I need "declare" I'm about to paint a region. Does this actually do anything?

  1. Is using IORef in the way I have safe? Initially I used STM.TVar but then I found that I only ever transferred the reference across the threads once, on the forkIO call. After that only the worker thread reads/writes to it. In general though, would a writeIORef be atomic? I know in the C++ memory model, for example, if I just wrote to a shared pointer variable there's no guarantee it's in a valid state (i.e., other threads would see it be switched atomically to the new value).

  2. This start...finish sequence seems too procedural and stateful to me. An idea I had was that it be more appropriate for CircleGUI to offer a single method, guiMain :: String -> (Int -> Int -> IO (IORef.IORef Circles.Circle, IO ())) -> IO () which accepts an action that's given the width and height and generates the circle reference and onExpose handler? The implementation would go something like this:

     guiMain title action = do
       window <- start title
       sz <- size window
       (circ, handler) <- action (fst sz) (snd sz)
       finish window
    

I like this because it gets rid of the leaky GUI abstractions made by CircleGUI. However, at some point we have to worry less about leakiness of abstractions and more about re-usability of code. The issue I'm seeing here is that the only chance to communicate information from the action to GUI is in one method return, and I envision that tuple getting really big and honestly the CircleGUI.guiMain method will eventually become less of an orthogonal component to LargeCircle and more of a highly coupled component.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.