Graphical Applications in Haskell with MVC and Gloss

Jun 27, 2022

This is the first of two parts on creating interactive graphical applications with functional programming, in Haskell; this first part, using the Model-View-Controller pattern in its functional flavour through gloss. The MVC pattern is common accross all languages and goes by many names. For example, it's how smartphone applications are structured in Android Studio.

These are lecture notes from my guest lecture at Universität Koblenz. Because the example was presented live in a demo, it appears a bit out of the blue in the standalone write-up. However, the source code with the complete example is available here.

1 MVC

Model–view–controller (MVC) is a software architectural pattern commonly used for developing user interfaces that divide the related program logic into three interconnected elements.

MVC says that an interactive application should consist roughly of three main parts – Model, View, and Controller.

And the three relate in the following manner:

MVC diagram from Wikipedia

2 Functional MVC: Gloss

How does the model-view-controller idea translate into functional programming? It turns out to be quite simple because the three parts match basic FP concepts.

We’ll focus on the library Gloss to develop a graphical application. Gloss is very easy to setup, provides abstractions for drawing graphics, and outlines the MVC compoonents clearly. We’ll implement a simple simulation of the 101companies employees to illustrate the concepts.

To define the model, the structure which is updated thorought the program, we simply define a new datatype that models the application to be updated and displayed. Our model will be just company itself! Nothing of Gloss comes in here.

-- | Our model
data Company = Company Name [Employee]

data Employee = Employee Name Address Salary

The view, as mentioned before, is just a function from the model to the graphics to be drawn. With Gloss, the graphics to be displayed are defined with the Picture type. That means this is the function signature

view :: Company -> Picture

Ahead, we’ll see how to display things on the screen with Gloss and further inspect the Picture type.

The model, in gloss, actually consists of two separate functions. The first updates the model when events (of type Event) happen, and the second updates the model when time passes. We could name these two functions handleEvent and frameUpdate.

handleEvent :: Event -> Company -> Company
frameUpdate :: Float -> Company -> Company

the Float in frameUpdate is the time passed since the last frame. We’ll look at frames and events ahead.

Finally, to put this all together, gloss provides a function that takes an initial model, the view function, the controller functions, and runs the described application.

Which means that if with a datatype and those three functions defined, we’re ready to run our graphical application.

The function is:

-- | Play a game in a window.
play    :: Display                      -- ^ Display mode.
        -> Color                        -- ^ Background color.
        -> Int                          -- ^ Number of simulation steps to take for each second of real time.
        -> world                        -- ^ The initial world.
        -> (world -> Picture)           -- ^ A function to convert the world a picture.
        -> (Event -> world -> world)    -- ^ A function to handle input events.
        -> (Float -> world -> world)    -- ^ A function to step the world one iteration.
                                        --   It is passed the period of time (in seconds) needing to be advanced.
        -> IO ()

There’s quite a bit more happening here so let’s go over each parameter:

And the return type is IO ()! Meaning we can call this directly from main. The main program would look like:

main :: IO ()
main =
    play
        FullScreen
        black          -- Background color
        30             -- Number of frames for each second of real time.
        initialCompany -- The company at the beginning of the game
        view           -- How to display a company?
        handleEvent    -- How to react to events?
        frameUpdate    -- What to do every frame?

2.1 Picture

In this section we explain how to create Pictures, and how the 101company’s view is implemented.

In Gloss, Pictures are the building blocks out of which we build a graphical application. There exist multiple ways of creating pictures; the simplest ones are to directly use the data constructors for Picture.

For example, these would be valid pictures.

-- Draws a circle with radius 5
Circle 5    :: Picture

-- Draws some text rotated by 90º degrees
Rotate 90 (Text "Hello")    :: Picture

-- Draws both simultaneously on the screen
Pictures [Circle 5, Rotate 90 (Text "Hello")]   :: Picture

As we see, we can combine pictures using the Pictures data constructor, Rotate, Translate, and Scale them (with those data constructors), and create them from scratch as with Circle, Polygon, etc.

This is more evident from the definition of Picture. Here is a bit from the pictures documentation

data Picture
        -- | A blank picture, with nothing in it.
        = Blank

        -- | A convex polygon filled with a solid color.
        | Polygon       Path

        -- | A circle with the given radius.
        | Circle        Float

        -- | A circle with the given radius and thickness.
        --   If the thickness is 0 then this is equivalent to `Circle`.
        | ThickCircle   Float Float

        -- | Some text to draw with a vector font.
        | Text          String

        -- | A picture translated by the given x and y coordinates.
        | Translate     Float Float     Picture

        -- | A picture rotated clockwise by the given angle (in degrees).
        | Rotate        Float           Picture

        -- | A picture scaled by the given x and y factors.
        | Scale         Float   Float   Picture

        -- | A picture consisting of several others.
        | Pictures      [Picture]

        | ... -- ommited for brevity

Now that we’ve seen the concept of pictures, and know that they will be displayed by the main function, we must still consider how they’re laid out on the window.

Now we can get to creating the view for our company! We’ll display our company employees on the screen, one circle for each. The bigger the circle, the bigger the pay.

data Company = Company Name Employees
data Employee = Employee Name Address Salary

view :: Company -> Picture
view (Company _ employees) =

    -- We map each employee to its picture
    let emPics = map empToPicture employees

    -- And make one big picture out of all of them
     in Pictures emPics

empToPicture :: Employee -> Picture
empToPicture (Employee name _ salary) =

    -- We'll combine both the text and the circle into one picture
    Pictures
        [ Text name -- Draw the employee's name
        , Circle (salary*0.02) -- Draw a circle with radius proportional to salary
        ]

An attentive reader might comment that all employees will be displayed on top of each other. They’re right since all pictures are by default positioned at (0,0)

In the demo, I drew each employee evenly spaced from the others around an non-visible circle. The idea is to divide 360º by the number of employees and then calculate their position using sin and cosine. There’s no need to go over all the details, so here’s a plausible implementation of that should explain itself.

view :: Company -> Picture
view (Company _ employees) =

    -- We map each employee (with its number) to its picture
    let emPics = map empToPicture (zip [0..] employees)

    -- And make one big picture out of all of them
     in Pictures emPics

  where
    nEmployees :: Float
    nEmployees = fromIntegral (length employees)

    empToPicture :: (Float, Employee) -> Picture
    empToPicture (i, Employee name _ salary) =

        -- Move the picture according to calculation
        Translate (150*cos (2*pi*i/nEmployees)) (150*sin (2*pi*i/nEmployees)) $

            -- We'll combine both the text and the circle into one picture
            Pictures
                [ Text name -- Draw the employee's name
                , Circle (salary*0.02) -- Draw a circle with radius proportional to salary
                ]

This will layout our employees around the center, evenly spaced.

To finalize, we’ll add some color to the circles. We want employees which are paid a lot of money to be represented with red circles, the ones which are paid little money to be yellow, and the others to be orange.

Where we currently define the circle, we’ll rather define a colored circle

-- Before
Circle (salary*0.02)

-- After
Color (mkColor salary) (Circle (salary*0.02))
  where
    mkColor s
      | s > 10000 = red
      | s > 1000 = orange
      | otherwise = yellow

To display just the view without defining the controller we can use the display function. This one is a bit simpler than play because it only cares about the view.

main :: IO ()
main
 = display
        (InWindow
               "Hello World"     -- window title
                (400, 150)       -- window size
                (10, 10))        -- window position
        white                    -- background color
        (view initialCompany)    -- picture to display

For the final demo code see the Display module.

2.2 Event

In this section we explain Gloss’s Events, and how the 101company’s controller is implemented.

In Gloss, the Event type models the possible input events in the application, such as mouse clicks, key presses, window resizes, ….

Everytime such an event occurs, the controller function with type Event -> world -> world is called and the input event passed as the first argument.

Events are defined by its data constructors:

data Event
    = EventKey    Key KeyState Modifiers (Float, Float)
    | EventMotion (Float, Float)
    | EventResize (Int, Int)

EventKey is the data constructor for event involving a Key, which could be a mouse click or a key press, since Key is defined as

data Key
        = Char        Char
        | SpecialKey  SpecialKey
        | MouseButton MouseButton

A Key might be a simple character key, a special key, or a mouse button. For more information on the latter two types you might check the documentation

A KeyState indicates whether the key is pressed down, or released. We’ll use Up, since in our simulation we only care about when the user “finishes” pressing a key, not while they’re pressing it

data KeyState
        = Down
        | Up

Our controller function will have to pattern match on Event to decide how the model should be updated.

We want to react to three different events: When C is pressed we cut the salaries of the employees in half; when A is pressed we add an employee; when D is pressed we delete an employee.

eventHandler :: Event -> Company -> Company
eventHandler evt c = case evt of
    -- 'c' key was pressed, cut
    EventKey (Key 'c') Up _ _ -> cut c

    -- 'd' key was pressed, delete
    EventKey (Key 'd') Up _ _ -> deleteEmp c

    -- 'a' key was pressed, add
    EventKey (Key 'a') Up _ _ -> addEmp c
     
    -- For all other cases we return the company unchanged
    _ -> c

The cut, deleteEmp and addEmp are simple functions of type Company -> Company

As for the other part of the controller: We want the salary of all employees to be raised every frame.

We can write our Float -> Company -> Company to raise the employees salaries by 10€ everytime it’s called – as long as the employee earns less than 10000€.

frameUpdate :: Float -> Company -> Company
frameUpdate _ (Company n emps) =
    Company n $ map (raise (< 10000) 10) emps
  where
    raise :: (Salary -> Bool) -> Salary -> Employee -> Employee
    raise p inc (Employee n a s) = Employee n a ((if p s then inc else 0) + s)

The demo code can be read in the Main module.

2.3 Gloss

Gloss is a framework for programming graphical applications in Haskell, which is itself described in terms of the MVC pattern.

In Haskell (and other strongly-typed functional programming languages) in particular, the MVC pattern is less loosely defined than usual, and can be more clearly identified in the code. This is because the we can “strongly” encode our model with types and the view and controller are simply functions defined in terms of the model type. Pure functions and user-defined types get us a clearer distinction between the three.

Hello World:

main :: IO ()
main
 = display
        (InWindow
               "Hello World"     -- window title
                (400, 150)       -- window size
                (10, 10))        -- window position
        white                    -- background color
        picture                  -- picture to display

picture :: Picture
picture = Translate (-170) (-20) -- shift the text to the middle of the window
        $ Scale 0.5 0.5          -- display it half the original size
        $ Text "Hello World"     -- text to display