diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -2,4 +2,4 @@ import Distribution.Simple -main = defaultMainWithHooks defaultUserHooks +main = defaultMainWithHooks simpleUserHooks diff --git a/hetris.cabal b/hetris.cabal --- a/hetris.cabal +++ b/hetris.cabal @@ -1,5 +1,5 @@ name: hetris -version: 0.1 +version: 0.2 synopsis: Text Tetris description: This is a simple reimplementation of Tetris which uses the Curses interface to run in a terminal. @@ -10,7 +10,7 @@ maintainer: Ian Lynagh homepage: http://web.comlab.ox.ac.uk/oucl/work/ian.lynagh/Hetris/ -build-depends: base>3, random, array, old-time +build-depends: base>3, random, array, old-time, hscurses>=1.3 build-type: Simple data-files: README, TECH, TODO tested-with: GHC==6.8.2 @@ -18,9 +18,8 @@ executable: hetris main-is: Hetris.lhs hs-source-dirs: src -other-modules: Board, Data, Input, Output, Pieces, UI, Curses -c-sources: wrap.c +other-modules: Board, Data, Input, Output, Pieces, UI extra-libraries: curses -ghc-options: -O2 -Wall -optl-Wl,-s +ghc-options: -Wall -optl-Wl,-s ghc-prof-options: -prof -auto-all diff --git a/src/Curses.hsc b/src/Curses.hsc deleted file mode 100644 --- a/src/Curses.hsc +++ /dev/null @@ -1,94 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} --- vim: set syntax=haskell tw=72: - --- Part of Hetris - -#include - -module Curses (PWindow, - ChType, - cERR, - cKEY_UP, - cKEY_DOWN, - cKEY_LEFT, - cKEY_RIGHT, - cTRUE, - cACS_BLOCK, - initscr, - cbreak, - noecho, - getch, - nonl, - halfdelay, - intrflush, - keypad, - stdscr, - timeout, - curs_set, - mvaddstr, - mvaddch, - addstr, - refresh, - endwin, - getmaxyx, - move, - errI, - errP, - ) where - -import Foreign -import Foreign.C - -data Window = Window -type PWindow = Ptr Window -type NBool = #type bool -type ChType = #type chtype - -cERR :: CInt -cERR = #const ERR -cKEY_UP, cKEY_DOWN, cKEY_LEFT, cKEY_RIGHT :: ChType -cKEY_UP = #const KEY_UP -cKEY_DOWN = #const KEY_DOWN -cKEY_LEFT = #const KEY_LEFT -cKEY_RIGHT = #const KEY_RIGHT -cTRUE :: NBool -cTRUE = #const TRUE -cACS_BLOCK :: ChType -cACS_BLOCK = #const ACS_BLOCK -foreign import ccall unsafe "static curses.h initscr" initscr :: IO PWindow -foreign import ccall unsafe "static curses.h cbreak" cbreak :: IO CInt -foreign import ccall unsafe "static curses.h noecho" noecho :: IO CInt -foreign import ccall unsafe "static curses.h getch" getch :: IO CInt -foreign import ccall unsafe "static curses.h nonl" nonl :: IO CInt -foreign import ccall unsafe "static curses.h halfdelay" halfdelay :: CInt -> IO CInt -foreign import ccall unsafe "static curses.h intrflush" intrflush :: PWindow -> CInt -> IO CInt -foreign import ccall unsafe "static curses.h keypad" keypad :: PWindow -> NBool -> IO CInt -foreign import ccall unsafe "static curses.h &stdscr" stdscr :: Ptr PWindow -foreign import ccall unsafe "static curses.h timeout" timeout :: CInt -> IO () -foreign import ccall unsafe "static curses.h mvaddstr" mvaddstr :: CInt -> CInt -> CString -> IO () -foreign import ccall unsafe "static curses.h mvaddch" mvaddch :: CInt -> CInt -> ChType -> IO () -foreign import ccall unsafe "static curses.h addstr" addstr :: CString -> IO () -foreign import ccall unsafe "static curses.h refresh" refresh :: IO CInt -foreign import ccall unsafe "static curses.h move" move :: CInt -> CInt -> IO CInt -foreign import ccall unsafe "static curses.h curs_set" curs_set :: CInt -> IO CInt -foreign import ccall unsafe "static curses.h endwin" endwin :: IO CInt -foreign import ccall unsafe "static wrap.h w_getmaxyx" wgetmaxyx :: PWindow -> Ptr CInt -> Ptr CInt -> IO () -getmaxyx :: PWindow -> IO (CInt, CInt) -getmaxyx w = alloca $ \py -> - alloca $ \px -> - do wgetmaxyx w py px - y <- peek py - x <- peek px - return (y, x) - -errI :: IO CInt -> IO () -errI f = do r <- f - if r == cERR then do _ <- endwin - error "curses returned an error" - else return () - -errP :: IO (Ptr a) -> IO () -errP f = do p <- f - if p == nullPtr then do _ <- endwin - error "curses returned an error" - else return () diff --git a/src/Input.lhs b/src/Input.lhs --- a/src/Input.lhs +++ b/src/Input.lhs @@ -19,7 +19,7 @@ \begin{code} module Input (get_event) where -import Curses +import UI.HSCurses.Curses (timeout, getch, cERR, cKEY_LEFT, cKEY_RIGHT, cKEY_DOWN, cKEY_UP) import Data import Foreign.C.Types @@ -33,7 +33,7 @@ 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 +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 diff --git a/src/Output.lhs b/src/Output.lhs --- a/src/Output.lhs +++ b/src/Output.lhs @@ -26,10 +26,9 @@ \begin{code} module Output (max_size, make_board, do_changes) where -import Data -import Curses +import Data -- (Vector, Change, On, Off, Delay) +import UI.HSCurses.Curses (scrSize, refresh, timeout, getch, ChType, mvAddCh) import Data.Char -import Foreign.Storable \end{code} Continuing our practise of separating constants out of the main code, we @@ -46,8 +45,8 @@ 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{getmaxyx} function to find the height and width of -the window passed (XXX while this can't use stdscr is getmaxyx really +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 @@ -57,12 +56,9 @@ \begin{code} max_size :: IO (Vector, Vector) -max_size = do w <- peek stdscr - (height, width) <- getmaxyx w - let width' = fromIntegral (width `div` 2) - height' = fromIntegral height - return (width' - 2 * border_width, - height' - 2 * border_height) +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 @@ -95,7 +91,7 @@ \begin{code} do_changes :: [Change] -> IO () do_changes cs = do mapM_ do_change cs - errI refresh + refresh return () \end{code} @@ -123,8 +119,8 @@ \begin{code} write :: Vector -> Vector -> ChType -> IO () -write x y c = do mvaddch y' x' c - mvaddch y' (x' + 1) c +write x y c = do mvAddCh y' x' c + mvAddCh y' (x' + 1) c where y' = fromIntegral y x' = fromIntegral $ 2 * x \end{code} diff --git a/src/UI.lhs b/src/UI.lhs --- a/src/UI.lhs +++ b/src/UI.lhs @@ -23,7 +23,7 @@ import Data -import Curses +import UI.HSCurses.Curses (initScr, cBreak, echo, keypad, cursSet, CursorVisibility(..), endWin) import Input import Output @@ -42,12 +42,13 @@ value. \begin{code} + init_ui :: IO (Vector, Vector) -init_ui = do w <- initscr - errI $ cbreak - errI $ noecho - errI $ keypad w cTRUE - errI $ curs_set 0 +init_ui = do w <- initScr + cBreak True + echo False + keypad w True + cursSet CursorInvisible max_size \end{code} @@ -56,7 +57,7 @@ \begin{code} shutdown_ui :: IO () -shutdown_ui = do _ <- endwin +shutdown_ui = do _ <- endWin return () \end{code} diff --git a/wrap.c b/wrap.c deleted file mode 100644 --- a/wrap.c +++ /dev/null @@ -1,5 +0,0 @@ -#include - -void w_getmaxyx(WINDOW *w, int *y, int *x) { - getmaxyx(w, *y, *x); -}