QPawn.hs

   1 {-# LANGUAGE ForeignFunctionInterface #-}
   2
   3 module Main where
   4
   5 import Foreign
   6 import Foreign.C.Types
   7 import Data.Int
   8
   9 -- | foreign imports
  10 foreign import ccall "qpawn.c init"
  11     c_init :: IO ()
  12
  13 foreign import ccall "qpawn.c quit"
  14     c_quit :: IO ()
  15
  16 foreign import ccall "qpawn.c clear"
  17     c_clear :: IO ()
  18
  19 foreign import ccall "qpawn.c draw"
  20     c_draw :: IO ()
  21
  22 foreign import ccall "qpawn.c pixel"
  23     c_pixel :: CInt -> CInt -> IO ()
  24
  25 foreign import ccall "qpawn.c color"
  26     c_color :: CInt -> CInt -> CInt -> IO ()
  27
  28 foreign import ccall "qpawn.c sleep"
  29     c_sleep :: CInt -> IO ()
  30
  31 foreign import ccall "qpawn.c line"
  32     c_line :: CInt -> CInt -> CInt -> CInt ->  IO ()
  33
  34 foreign import ccall "qpawn.c rect"
  35     c_rect :: CInt -> CInt -> CInt -> CInt ->  IO ()
  36
  37 -- | actual code
  38 ap2 :: (a -> a -> b) -> [a] -> b
  39 ap2 f (a:b:_) = f a b
  40 ap2 _ _       = error "a list too small given to ap2"
  41
  42 ap3 :: (a -> a -> a -> b) -> [a] -> b
  43 ap3 f (a:b:c:_) = f a b c
  44 ap3 _ _         = error "a list too small given to ap3"
  45
  46 ap4 :: (a -> a -> a -> a -> b) -> [a] -> b
  47 ap4 f (a:b:c:d:_) = f a b c d
  48 ap4 _ _           = error "a list too small given to ap4"
  49
  50 cint :: (Integral a) => a -> CInt
  51 cint n = (fromIntegral n) :: CInt
  52
  53 cints :: (Integral a) => [a] -> [CInt]
  54 cints = map cint
  55
  56 color :: [Int] ->  IO ()
  57 color = ap3 c_color . cints
  58
  59 pixel :: [Int] -> IO ()
  60 pixel = ap2 c_pixel . cints
  61
  62 line :: [Int] -> IO ()
  63 line = ap4 c_line . cints
  64
  65 rect :: [Int] -> IO ()
  66 rect = ap4 c_rect . cints
  67
  68 clear :: IO ()
  69 clear = c_clear
  70
  71 sleep :: Int -> IO ()
  72 sleep = c_sleep . cint
  73
  74 draw :: IO ()
  75 draw = c_draw
  76
  77 main :: IO ()
  78 main = do c_init
  79           color [0,0,0]
  80           clear
  81           draw
  82           sleep 2
  83           color [255, 255, 255]
  84           line [-255,-255, 255, 255]
  85           color [200, 80, 100]
  86           rect [0, 0, 50, 50]
  87           draw
  88           sleep 2
  89           c_quit