Functional Reactive Programming with Yampa (FRP.Yampa) in Haskell

This is an example of a functional reactive program using Yampa. To run this, I assume that you have already installed GHC from www.haskell.org.

My FRP program initially clears the screen to position the cursor at an intial X and Y. It senses the user key input such as 'h', 'j', 'k', 'l' to move the cursor left, down, up, right, respectively. A character 'F' moves in a random way together. The programs terminates automatically after a specified period time.

You can install Yampa by
  $ cabal install Yampa

and also you may need ANSI terminal library by
  $ cabal install ansi-terminal


Here is the cursor movement program. You need to compile and run it by
  $ ghc Main.hs
  $ ./Main


{-# LANGUAGE Arrows #-}

module Main where

import Prelude hiding (init)
import FRP.Yampa
import System.Console.ANSI
import System.IO
import System.Random
import Data.Time.Clock.POSIX
import Data.IORef

-- 
time_to_last = 20

cursor_x0 = 40
cursor_y0 = 10

window_x   = 0
window_y   = 0
window_width  = 80
window_height = 20

random_num = 5000

--
main = do
  hSetBuffering stdin NoBuffering
  hSetEcho stdout False
  t <- getPOSIXTime
  timeRef <- newIORef t
  posRef <- newIORef (cursor_x0,cursor_y0)
  friend_posRef <- newIORef (cursor_x0+10,cursor_y0+10)
  reactimate init (sense timeRef) (actuate posRef friend_posRef) sf
  
init :: IO Char
init = do  
  clearScreen
  return ' '
  
sense :: IORef POSIXTime -> Bool -> IO (DTime, Maybe Char)
sense timeRef b = do   
  t' <- getPOSIXTime
  t  <- readIORef timeRef
  let dt = realToFrac (t' - t)
  writeIORef timeRef t'
  maybech <- nonBlockingGetChar
  return (dt, maybech)
  
actuate :: IORef (Int,Int) -> IORef (Int,Int) -> Bool -> (Char, Bool) -> IO Bool
actuate posRef friend_posRef b (ch, x) = do
  xy <- readIORef posRef
  let xy' = moveCursor ch xy
  writeIORef posRef xy'
  
  friend_xy <- readIORef friend_posRef
  rnd_x <- randomRIO (-random_num,random_num) :: IO Int
  rnd_y <- randomRIO (-random_num,random_num) :: IO Int
  
  let friend_xy' = 
        if (rnd_x == -1 || rnd_x == 0 || rnd_x == 1) 
        then window (fst friend_xy + rnd_x, snd friend_xy)
        else if (rnd_y == -1 || rnd_y == 0 || rnd_y == 1) 
             then window (fst friend_xy, snd friend_xy + rnd_y)
             else friend_xy
             
  writeIORef friend_posRef friend_xy'
  
  if friend_xy /= friend_xy'
    then do setCursorPosition (snd friend_xy) (fst friend_xy) 
            putStr " "
            setCursorPosition (snd friend_xy') (fst friend_xy')
            putStr "F" 
    else return ()
  
  setCursorPosition (snd xy') (fst xy')
  
  return x
         
sf :: SF Char (Char, Bool)
sf = proc x -> do
  b <- arr (\t -> if t < time_to_last then False else True) <<< time -< ()
  returnA -< (x, b)
  
-- Utility
  
nonBlockingGetChar :: IO (Maybe Char)
nonBlockingGetChar = do
  ready <- hReady stdin
  if ready 
    then do c <- hGetChar stdin
            return (Just c)
    else return (Just ' ')
   
  
moveCursor 'h' (x,y) = window (x-1, y)
moveCursor 'j' (x,y) = window (x, y+1)
moveCursor 'k' (x,y) = window (x, y-1)
moveCursor 'l' (x,y) = window (x+1, y)
moveCursor c   (x,y) = window (x,y)

window (x, y) = 
  (if x < window_x 
   then window_x 
   else if x > window_width 
        then window_width 
        else x,
   
   if y < window_y 
   then window_y 
   else if y > window_height 
        then window_height 
        else y)