hetris-0.1: src/Input.lhs

% vim: set tw=72:

% Part of Hetris

\section{Input: Concrete curses implementation}

For the input side of the user interface we will need a number of
modules. It will come as no surprise that we need to import the
\hsmodule{Curses} and \hsmodule{Data} modules. In order to give types
to all of the functions we will need to be able to refer to the C types
returned by the FFI functions, so \hsmodule{CTypes} also needs to be
imported. The \hsmodule{Time} module is used to measure the elapsed time
and the \hsmodule{Char} module is used to convert between characters and
\hstype{Int}s.

There is only one input function exported by the \hsmodule{UI} abstract
module, namely \hsfunction{get\_event}, so that is all we export here.

\begin{code}
module Input (get_event) where

import Curses
import Data

import Foreign.C.Types
import System.Time
import Data.Char
\end{code}

The specification does not allow the delay to be less than or equal to
zero, so we give an error if this is the case. Note that we check the
value of the delay after it has been converted to a \hstype{CInt} as the
conversion process may not preserve the value.

Otherwise we set the timeout to what was requested, make a note of the
current time, and call \hsfunction{getch} to wait for a key to be
pressed. When this happens, or it times out, we record the time again.
Finally we return a tuple with the event corresponding to the key
pressed (which will be \hsfunction{cERR} if a timeout occurred) and the
time elapsed between the two times recorded; for both components an
additional function is used---these are described below.

\begin{code}
get_event :: Delay -> IO (Event, Delay)
get_event delay
 | delay' <= 0 = error "Input.get_event: delay <= 0"
 | otherwise = do timeout delay'
                  start <- getClockTime
                  c <- getch
                  end <- getClockTime
                  return (key_to_event c, elapsed_time start end)
    where delay' = fromIntegral delay
\end{code}

Some keys, which are represented as \hstype{CInt}s by the
\hstype{Curses} library, have events tupled with them in a lookup list
\hsfunction{key\_events} suitable for use with \hsfunction{lookup}. If
the key we are passed is not mapped to anything then we return the event
\hsconstructor{None} instead.

\begin{code}
key_to_event :: CInt -> Event
key_to_event k = maybe None id (lookup k key_events)
\end{code}

The construction of the lookup list is uninteresting. We just built it
piece by piece and concatenate the pieces together.

\begin{code}
key_events :: [(CInt, Event)]
key_events = [(cERR, Tick)] ++ movement ++ rotations ++ control
    where to_event e = map (\c -> (c, e))
          conv_char = fromIntegral . ord

          movement = lefts ++ rights ++ downs ++ drops
          rotations = rot_lefts ++ rot_rights
          control = quits

          lefts = to_event MLeft [conv_char 'j', fromIntegral cKEY_LEFT]
          rights = to_event MRight [conv_char 'l', fromIntegral cKEY_RIGHT]
          downs = to_event MDown [conv_char 'k', fromIntegral cKEY_DOWN]
          drops = to_event Drop [conv_char ' ']
          rot_lefts = to_event RotR [conv_char 'u', fromIntegral cKEY_UP]
          rot_rights = to_event RotR [conv_char 'i']
          quits = to_event Quit [conv_char 'q']
\end{code}

Sadly Haskell doesn't provide an easy way to measure the time between
two points in time. The best we can get from the standard libraries is a
\hstype{TimeDiff}. We assume that less than a minute passes between the
two times---a reasonable assumption in this context!

\begin{code}
elapsed_time :: ClockTime -> ClockTime -> Delay
elapsed_time start end = t `max` 0
    where t = case diffClockTimes end start of
                  (TimeDiff 0 0 0 0 0 secs psecs) ->
                      let secs' = 1000 * fromIntegral secs
                          psecs' = fromIntegral (psecs `div` 1000000000)
                      in secs' + psecs'
                  td -> error ("Input.elapsed_time: " ++ show td)
\end{code}