foo.hs

import Data.Bits
import Data.Word
import Data.IORef
import qualified Graphics.UI.SDL as SDL
import qualified Graphics.UI.SDL.Primitives as SDL

main = do
  SDL.init [SDL.InitEverything]
  SDL.setVideoMode 640 480 32 []
  var <- newIORef (0, 0)
  eventLoop var

eventLoop :: IORef (Int, Int) -> IO ()
eventLoop var = do
  event <- SDL.pollEvent
  case event of
      (SDL.KeyDown (SDL.Keysym SDL.SDLK_DOWN _ _))  -> modifyIORef var (\(x, y) -> (x, y-1))
      (SDL.KeyDown (SDL.Keysym SDL.SDLK_UP _ _))    -> modifyIORef var (\(x, y) -> (x, y+1))
      (SDL.KeyDown (SDL.Keysym SDL.SDLK_LEFT _ _))  -> modifyIORef var (\(x, y) -> (x-1, y))
      (SDL.KeyDown (SDL.Keysym SDL.SDLK_RIGHT _ _)) -> modifyIORef var (\(x, y) -> (x+1, y))
      _ -> return ()
  xy <- readIORef var
  renderBox xy
  eventLoop var

renderBox :: (Int, Int) -> IO ()
renderBox (x, y) = do
  screen <- SDL.getVideoSurface
  SDL.box screen (SDL.Rect x y 100 100) $ rgbColor 255 255 255
  SDL.flip screen
  return ()

-- stolen from ocharles :P https://github.com/ocharles/netwire-classics/blob/master/asteroids/Asteroids.hs#L158
rgbColor :: Word8 -> Word8 -> Word8 -> SDL.Pixel
rgbColor r g b = SDL.Pixel (shiftL (fi r) 24 .|.
                            shiftL (fi g) 16 .|.
                            shiftL (fi b) 8  .|.
                            255)
  where fi = fromIntegral