hetris 0.1 → 0.2
raw patch · 7 files changed
+25/−128 lines, 7 filesdep +hscursessetup-changed
Dependencies added: hscurses
Files
- Setup.hs +1/−1
- hetris.cabal +4/−5
- src/Curses.hsc +0/−94
- src/Input.lhs +2/−2
- src/Output.lhs +10/−14
- src/UI.lhs +8/−7
- wrap.c +0/−5
Setup.hs view
@@ -2,4 +2,4 @@ import Distribution.Simple -main = defaultMainWithHooks defaultUserHooks+main = defaultMainWithHooks simpleUserHooks
hetris.cabal view
@@ -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 <igloo@earth.li> 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
− src/Curses.hsc
@@ -1,94 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}--- vim: set syntax=haskell tw=72:---- Part of Hetris--#include <curses.h>--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 ()
src/Input.lhs view
@@ -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
src/Output.lhs view
@@ -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}
src/UI.lhs view
@@ -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}
− wrap.c
@@ -1,5 +0,0 @@-#include <curses.h>--void w_getmaxyx(WINDOW *w, int *y, int *x) {- getmaxyx(w, *y, *x);-}