hetris-0.2: src/Output.lhs

% vim: set tw=72:

% Part of Hetris

\section{Output: Concrete curses implementation}

If we were to use a single character for each square of the playing
area, and indeed the rest of the board, then the squares would be
significantly taller than they are wide. To counteract this we will
treat each pair of characters on a line as a single entity as far as
drawing the board is concerned; this will give them a roughly square
appearance.

The \hsmodule{Output} module is responsible for the other two functions
exported by the \hsmodule{UI} module, and also needs to provide the
concrete implementation of this module with a function giving the
largest size the interface can accommodate.

Unsurprisingly we import the \hsmodule{Data} module, as well as the
\hsmodule{Curses} module to provide types for the functions. We also use
the \hsmodule{Char} module to convert characters into their numeric
ASCII values.

XXX Storable

\begin{code}
module Output (max_size, make_board, do_changes) where

import Data -- (Vector, Change, On, Off, Delay)
import UI.HSCurses.Curses (scrSize, refresh, timeout, getch, ChType, mvAddCh)
import Data.Char
\end{code}

Continuing our practise of separating constants out of the main code, we
define values representing the minimum amount of white space we require
around the playing area. A border of one empty character around one
solid character, a total width of 2, all the way round is quite
aesthetically pleasing so we go with that.

\begin{code}
border_width, border_height :: Vector
border_width = 2
border_height = 2
\end{code}

Our first commitment to the outside world is to provide a function that
returns the maximum size of user interface we can draw. We first use the
curses \hsfunction{scrSize} function to find the height and width of
the window passed (XXX while this can't use stdScr is scrSize really
width and height?). As we are treating characters in pairs along the
horizontal axis we need to divide this width by 2 (rounding down), and
then we use \hsfunction{fromIntegral} to convert the coordinates into
\hstype{CInt}s. Finally we need to subtract twice the appropriate border
sizes from the dimensions, once for the top/left and again for the
bottom/right. Note that width is the first component of the result.

\begin{code}
max_size :: IO (Vector, Vector)
max_size = do (height, width) <- scrSize
              return ((width `div` 2) - 2 * border_width,
                       height - 2 * border_height)
\end{code}

Our second commitment is to provide a function to allow the user of the
module to draw a new board. We make a list of screen coordinates
comprising the border\footnote{Technically they are not screen
coordinates; the coordinate $(x, y)$ maps to both $(2x, y)$ and
$(2x + 1, y)$ in real screen coordinates} and convert `X' to a
\hstype{ChType} (XXX should be ACS\_BLOCK). then we use the
\hsfunction{write} function to write an `X' to each of these
coordinates.

\begin{code}
make_board :: Vector -> Vector -> IO ()
make_board width height = do let c = fromIntegral $ ord 'X'
                             mapM_ (flip (uncurry write) c) border
    where border = [(x, border_height - 1)      | x <- xs]
                ++ [(x, border_height + height) | x <- xs]
                ++ [(border_width - 1,       y) | y <- ys]
                ++ [(border_width + width, y)   | y <- ys]
          xs = [border_width - 1..border_width + width]
          ys = [border_height..border_height - 1 + height]
\end{code}

Our final external commitment is a function that performs a list of
changes to update the screen. To do this we use \hsfunction{mapM\_} with
a function that performs a single change and finish up by calling the
curses \hsfunction{refresh} function to make sure the changes are
reflected on the screen.

\begin{code}
do_changes :: [Change] -> IO ()
do_changes cs = do mapM_ do_change cs
                   refresh
                   return ()
\end{code}

Performing a single change is a simple case analysis. To turn a square
on we paint a `\#' in it; to turn a square off we paint a blank space in
it. For a delay we set the timeout to 500ms and call \hsfunction{getch}.
This could be cut short by the user pressing a key, but the effort
required to work around this cannot be justified---think of it as a
feature.

\begin{code}
do_change :: Change -> IO ()
-- do_change (On x y) = paint_square x y cACS_BLOCK
do_change (On x y) = paint_square_c x y '#'
do_change (Off x y) = paint_square_c x y ' '
do_change Delay = do timeout 500
                     _ <- getch
                     return ()
\end{code}

We still have a couple of functions left to tidy up. First let us look
at \hsfunction{write}. This takes an $x$ and $y$ coordinate and a
\hstype{ChType} and writes it at the corresponding pair of screen
coordinates.

\begin{code}
write :: Vector -> Vector -> ChType -> IO ()
write x y c = do mvAddCh y' x' c
                 mvAddCh y' (x' + 1) c
    where y' = fromIntegral y
          x' = fromIntegral $ 2 * x
\end{code}

The \hsfunction{paint\_square\_c} function is similar; it writes a
\hstype{Char} at given playing area coordinates. The hard work is done
by \hsfunction{paint\_square}, with the harder work being done by
\hsfunction{write}.

\begin{code}
paint_square_c :: Vector -> Vector -> Char -> IO ()
paint_square_c x y c = paint_square x y (fromIntegral $ ord c)

paint_square :: Vector -> Vector -> ChType -> IO ()
paint_square x y c = write (x + border_width) (y + border_height) c
\end{code}