Gloss

Gloss

https://hackage.haskell.org/package/gloss Gloss is a framework for programming graphical applications in Haskell, which implements the Script:Functional MVC design pattern.

Gloss is easy to setup, provides abstractions for drawing graphics, and outlines the MVC components clearly. We’ll implement a simple simulation of the 101companies employees to illustrate the concepts.

Hello world in Gloss would look like:

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

Beyond the hello world example, we'll see how functional MVC is present in Gloss:

Our model is defined by a datatype. Ours will be just company itself! Nothing particular to 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.

view :: Company -> Picture

The controller, 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 every frame. 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 ()

• Display is the window the game will run in. This can be either FullScreen or InWindow "Nice Window" (width, height) (10, 10) in which the parameters are the window title, the width and height of the window, and its starting position.
• The Color is for the background color of the window. The simplest colors are black and white, and there are other functions to create colors
• The Int is the number of frames in a second. Every new frame, the frameUpdate function we defined previously is called (and the float passed to it is how much time each frame lasts). For example, 60 would mean 60 frames per second, and each time the function would be passed 1/60 = 0.016 seconds as an argument.
• The world type variable stands for our model. This parameter is the initial state of our model. We’d use some initialCompany :: Company here.
• The world -> Picture function is our view function. We’d pass view :: Company -> Picture here.
• The Event -> world -> world function is half of our controller. Given an event, we update the model. We’d pass handleEvent :: Event -> Company -> Company.
• The (Float -> world -> world) function is the other half of the controller. It is called every step/frame of our application (the frame rate is defined in the Int parameter above). We’d pass frameUpdate :: Float -> Company -> Company here.

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?

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.

• The window has a width and a height, say 400x400
• Each picture has a pair of coordinates, for it’s position on the x and y axis. By default this position is (0,0).
• The origin (coordinates (0, 0)) is located in the middle of the window. Taking the window of 400x400, the center of the left border would be at (-200, 0), the right border would be at (200, 0), the center of the top border would be at (0, 200) and the bottom border at (0, -200)

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.

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 code for this project can be found in Contribution:haskellGloss