packages feed

GeBoP (empty) → 1.7

raw patch · 94 files changed

+3409/−0 lines, 94 filesdep +basedep +directorydep +haskell98setup-changedbinary-added

Dependencies added: base, directory, haskell98, wx, wxcore

Files

+ Ataxx.hs view
@@ -0,0 +1,180 @@+
+-------------
+-- Ataxx --
+-------------
+
+module Ataxx (Ataxx, ataxx) where
+
+import Game
+import Array
+-- import Graphics.UI.WX
+import Graphics.UI.WX     hiding (border)
+import Graphics.UI.WXCore
+import Tools
+
+data Ataxx = Ataxx (Array (Int, Int) (Maybe Player)) deriving (Eq, Show)
+
+type AtaxxMove = Maybe ((Int, Int), (Int, Int))
+
+ataxx :: Ataxx
+ataxx = undefined
+
+instance Game Ataxx where
+
+  name _ = "ataxx"
+
+  standard _ = Properties { players = 2, boardsize = 7, human = [True, False] }
+  
+  possible _ = PropertyRange { playersrange = [2], boardsizerange = [5 .. 9] }
+  
+  new pr = let s = boardsize pr
+           in Ataxx $ array ((0, 0), (s - 1, s - 1))
+              [((x, y), Nothing) | x <- [0 .. s - 1], y <- [0 .. s - 1]]
+              // [ ((0    , 0    ), Just 0)
+                 , ((0    , s - 1), Just 1)
+                 , ((s - 1, 0    ), Just 1)
+                 , ((s - 1, s - 1), Just 0)
+                 ]
+  
+  moves pr p (Ataxx s) = map (move $ boardsize pr) (allMoves (boardsize pr) p s)
+
+  showmove pr p (Ataxx s) i = case allMoves (boardsize pr) p s !! i
+                              of Nothing -> "skip turn"
+                                 Just ((x1, y1), (x2, y2)) -> "abcdefghi" !! x1 : show (boardsize pr - y1)
+                                                    ++ "-" ++ "abcdefghi" !! x2 : show (boardsize pr - y2)
+  
+  value pr p (Ataxx s) 
+    | null $ moves pr p (Ataxx s) = (\i -> [i, -i]) $ (fromInteger . toInteger) $ signum $ count $ elems s
+    | otherwise = (\i -> let f = (fromInteger . toInteger) i / (fromInteger . toInteger) (sqr $ boardsize pr) in [f, -f]) $ count $ elems s
+    where
+      count :: [Maybe Player] -> Int
+      count []             =  0
+      count (Nothing : fs) =      count fs
+      count (Just 0  : fs) =  1 + count fs
+      count (Just 1  : fs) = -1 + count fs
+
+  board p pr vart ia move = do
+
+    marble <- bitmapCreateLoad "images\\marble.bmp" wxBITMAP_TYPE_ANY
+    varg <- varCreate $ grate rectZero 0 (0, 0) sizeZero
+    vare <- varCreate (Nothing :: Maybe (Int, Int))
+
+    let 
+    
+      onpaint :: DC () -> Rect -> IO ()
+      onpaint dc r = do
+        t <- varGet vart
+        e <- varGet vare
+        let Ataxx st = state t
+            bsz      = boardsize pr
+        b <- border dc (bsz, bsz)
+        let g = grate r b (bsz, bsz) (Size 1 1)
+        varSet varg g
+        tileBitmap dc r marble
+        for 0 (bsz - 1) (\i -> do
+          drawTextRect dc [['A' ..] !! i]  $ edge g (i,  -1)
+          drawTextRect dc [['A' ..] !! i]  $ edge g (i, bsz)
+          drawTextRect dc (show (bsz - i)) $ edge g ( -1, i)
+          drawTextRect dc (show (bsz - i)) $ edge g (bsz, i)
+          )
+        drawGrate dc g [brushKind := BrushTransparent]
+        for 0 (bsz - 1) (\i -> for 0 (bsz - 1) (\j ->
+          case st ! (i, j) of Just p  -> drawPiece p dc $ field g (i, j)
+                              Nothing -> return ()
+          ))
+        case e of
+          Nothing     -> return ()
+          Just (i, j) -> drawBrightPiece dc $ field g (i, j)
+        if human pr !! player t && allMoves (boardsize pr) (player t) st == [Nothing]
+          then wait p 1 $ do
+            when ia $ infoDialog p "You can't move!" "You have to skip this turn, since there are no possible moves."
+            move 0
+          else return ()
+
+      onclick :: Point -> IO ()
+      onclick pt = do 
+        t <- varGet vart
+        g <- varGet varg
+        let Ataxx st = state t
+            n        = locate g pt
+        when (inRange (bounds st) n) $ when (st ! n == Just (player t)) $ do
+          varSet vare $ Just n
+          repaint p
+
+      onunclick :: Point -> IO ()
+      onunclick pt = do 
+        t <- varGet vart
+        g <- varGet varg
+        e <- varGet vare
+        case e of
+          Nothing -> return ()
+          Just m  -> do
+            let Ataxx st = state t
+                n        = locate g pt
+            varSet vare Nothing
+            repaint p
+            case lookup (Just (m, n)) $ zip (allMoves (boardsize pr) (player t) st) [0..] of
+              Nothing -> return ()
+              Just  i -> move i
+
+    set p [ on click    := onclick
+          , on unclick  := onunclick
+          , on paint    := onpaint
+          , on resize  ::= repaint
+          ]
+
+allMoves :: Int -> Player -> Array (Int, Int) (Maybe Player) -> [AtaxxMove]
+allMoves bsz p s
+    | (null $ valid p s) && (not $ null $ valid (1 - p) s) = [Nothing]
+    | dead (1 - p) (elems s)                               = []
+    | otherwise                                            = map (Just) $ valid p s
+    where
+      valid :: Player -> Array (Int, Int) (Maybe Player) -> [((Int, Int), (Int, Int))]
+      valid p s = concatMap complete $ filter ((== Just p) . (s !)) $ indices s
+        where
+          complete :: (Int, Int) -> [((Int, Int), (Int, Int))]
+          complete xy = zip (repeat xy) (from xy)
+          from :: (Int, Int) -> [(Int, Int)]
+          from xy = filter (flip check Nothing) $ map (xy +-) $ grows ++ jumps
+          check :: (Int, Int) -> Maybe Player -> Bool
+          check m f | not $ inRange (bounds s) m = False
+                    | otherwise                  = s ! m == f
+      dead :: Player -> [Maybe Player] -> Bool
+      dead p (Just q  : fs) = p /= q && dead p fs
+      dead p (Nothing : fs) =           dead p fs
+      dead p []             = True
+
+move :: Int -> AtaxxMove -> (Player, Ataxx) -> (Player, Ataxx)
+move bsz (Just (f, t)) (p, Ataxx s) = (1 - p, Ataxx $ s // (phase1 ++ phase2))
+  where 
+    phase1 :: [((Int, Int), Maybe Player)]
+    phase1 | t `elem` map (+- f) jumps = [(f, Nothing), (t, Just p)]
+           | otherwise                 = [              (t, Just p)]
+    phase2 :: [((Int, Int), Maybe Player)]
+    phase2 = zip (filter (flip check $ Just $ 1 - p) $ map (+- t) grows) $ repeat $ Just p
+    check :: (Int, Int) -> Maybe Player -> Bool
+    check m f | not $ inRange (bounds s) m = False
+              | otherwise                  = s ! m == f
+move _ Nothing (p, rs) = (1 - p, rs)
+
+grows :: [(Int, Int)]
+grows = concat [[(x, 1), (-x, -1), (-1, x), (1, -x)] | x <- [ 0 .. 1]]
+
+jumps :: [(Int, Int)]
+jumps = concat [[(x, 2), (-x, -2), (-2, x), (2, -x)] | x <- [-1 .. 2]]
+
+(+-) :: Num a => (a, a) -> (a, a) -> (a, a)
+(a, b) +- (c, d) = (a + c, b + d)
+
+drawPiece :: Player -> DC () -> Rect -> IO ()
+drawPiece p dc (Rect x y w h) = do
+  case p of 0 -> set dc [brushColor := rgb 32 96 192]
+            1 -> set dc [brushColor := rgb 192 96 32]
+            _ -> set dc [brushColor := white]
+  circle dc (pt (x + w `div` 2) (y + h `div` 2)) (2 * (min w h) `div` 5) []
+
+drawBrightPiece :: DC () -> Rect -> IO ()
+drawBrightPiece dc (Rect x y w h) = do
+  set dc [penWidth := 2, penColor := yellow, brushKind := BrushTransparent]
+  circle dc (pt (x + w `div` 2) (y + h `div` 2)) (2 * (min w h) `div` 5) []
+
+ Bamp.hs view
@@ -0,0 +1,175 @@+
+----------
+-- Bamp --
+----------
+
+module Bamp (Bamp, bamp) where
+
+import Game
+import Array
+import Graphics.UI.WX     hiding (border)
+import Graphics.UI.WXCore
+import Tools
+
+data BampField
+  = Empty
+  | Portal Player
+  | Piece Player
+  | Ball
+  deriving (Eq, Show)
+
+isPortal :: BampField -> Bool
+isPortal (Portal _) = True
+isPortal _          = False
+
+isPiece :: BampField -> Bool
+isPiece (Piece _) = True
+isPiece _         = False
+
+data Bamp = Bamp (Array (Int, Int) BampField) deriving (Eq, Show)
+
+bamp :: Bamp
+bamp = undefined
+
+instance Game Bamp where
+
+  name _ = "bamp"
+
+  standard _ = Properties { players = 4, boardsize = 8, human = [True, False, False, False] }
+
+  possible _ = PropertyRange { playersrange = [4], boardsizerange = [6, 8 .. 12] }
+  
+  new pr = let s = boardsize pr
+               h = s `div` 2
+           in Bamp $ array ((0, 0), (s - 1, s - 1))
+              [((x, y), Empty) | x <- [0 .. s - 1], y <- [0 .. s - 1]]
+              // concat [[((0    ,     i), Piece 0), ((    i, 0    ), Piece 0)] | i <- [0 .. h - 1]]
+              // concat [[((0    , h + i), Piece 1), ((    i, s - 1), Piece 1)] | i <- [0 .. h - 1]]
+              // concat [[((s - 1, h + i), Piece 2), ((h + i, s - 1), Piece 2)] | i <- [0 .. h - 1]]
+              // concat [[((s - 1,     i), Piece 3), ((h + i, 0    ), Piece 3)] | i <- [0 .. h - 1]]
+              // [((1    , 1    ), Ball    )]
+{-{
+              // [ ((0    , 0    ), Portal 0)
+                 , ((0    , s - 1), Portal 1)
+                 , ((s - 1, s - 1), Portal 2)
+                 , ((s - 1, 0    ), Portal 3)
+                 , ((1    , 1    ), Ball    )
+                 ]
+}-}  
+  moves pr p (Bamp s) = map (move $ boardsize pr) (allMoves (boardsize pr) p s)
+
+  showmove pr p (Bamp s) i = let (x, y) = allMoves (boardsize pr) p s !! i
+                             in ['a' ..] !! x : show (boardsize pr - y)
+  
+  value pr p (Bamp s)
+    | null $ moves pr p (Bamp s) = let bsz = boardsize pr
+                                   in owner bsz (findBall s) |> 1 $ replicate 4 (-1)
+{-{
+                                   in case findBall s
+                                      of (x, y) | (x, y) == (0      , 0      ) -> [ 1, -1, -1, -1]
+                                                | (x, y) == (0      , bsz - 1) -> [-1,  1, -1, -1]
+                                                | (x, y) == (bsz - 1, bsz - 1) -> [-1, -1,  1, -1]
+                                                | (x, y) == (bsz - 1, 0      ) -> [-1, -1, -1,  1]
+                                         _ -> [0, 0, 0, 0]
+}-}
+    | otherwise = [0, 0, 0, 0]
+
+  board p pr vart ia move = do
+
+    marble <- bitmapCreateLoad "images\\marble.bmp" wxBITMAP_TYPE_ANY
+    varg <- varCreate $ grate rectZero 0 (0, 0) sizeZero
+
+    let 
+    
+      onpaint :: DC () -> Rect -> IO ()
+      onpaint dc r = do
+        return ()
+        t <- varGet vart
+        let Bamp st = state t
+            bsz     = boardsize pr
+        b <- border dc (bsz, bsz)
+        let g       = grate r b (bsz, bsz) (Size 1 1)
+        varSet varg g
+        tileBitmap dc r marble
+        for 0 (bsz - 1) (\i -> do
+          drawTextRect dc [['A' ..] !! i]  $ edge g (i,  -1)
+          drawTextRect dc [['A' ..] !! i]  $ edge g (i, bsz)
+          drawTextRect dc (show (bsz - i)) $ edge g ( -1, i)
+          drawTextRect dc (show (bsz - i)) $ edge g (bsz, i)
+          )
+        for 0 (bsz - 1) (\i -> for 0 (bsz - 1) (\j ->
+          drawRect dc (field g (i, j)) [brushKind := BrushTransparent, penColor := setLum 0.2 $ colorplayer $ owner bsz (i, j)]
+          ))
+        for 0 (bsz - 1) (\i -> for 0 (bsz - 1) (\j ->
+          drawField dc (field g (i, j)) (st ! (i, j))
+          ))
+
+      onclick :: Point -> IO ()
+      onclick pt = do 
+        t <- varGet vart
+        g <- varGet varg
+        let Bamp st = state t
+            n       = locate g pt
+        case lookup n $ zip (allMoves (boardsize pr) (player t) st) [0..] of
+          Nothing -> return ()
+          Just  i -> move i
+
+    set p [ on click    := onclick
+          , on paint    := onpaint
+          , on resize  ::= repaint
+          ]
+
+owner :: Int -> (Int, Int) -> Player
+owner bsz (i, j)
+  | 2 * i <  bsz && 2 * j <  bsz = 0
+  | 2 * i <  bsz && 2 * j >= bsz = 1
+  | 2 * i >= bsz && 2 * j >= bsz = 2
+  | 2 * i >= bsz && 2 * j <  bsz = 3
+
+drawField :: DC () -> Rect -> BampField -> IO ()
+drawField dc (Rect x y w h) Empty      = return ()
+drawField dc (Rect x y w h) (Portal p) = circle dc (pt (x + w `div` 2) (y + h `div` 2)) (2 * (min w h) `div` 5) [penColor := colorplayer p, penWidth := 2, brushKind := BrushTransparent]
+drawField dc (Rect x y w h) (Piece  p) = drawRect dc (Rect (x + w `div` 10) (y + h `div` 10) (w - w `div` 5) (h - h `div` 5)) [brushColor := colorplayer p]
+drawField dc (Rect x y w h) Ball       = circle dc (pt (x + w `div` 2) (y + h `div` 2)) (2 * (min w h) `div` 5) [brushColor := rgb 100 80 40]
+
+allMoves :: Int -> Player -> Array (Int, Int) BampField -> [(Int, Int)]
+allMoves bsz p s = filter valid $ filter (\i -> s ! i == Piece p) $ indices s
+ where
+  (a, b) = findBall s
+  valid :: (Int, Int) -> Bool
+  valid (x, y) | x /= a && y /= b = False
+               | x < a = all (\i -> ok (i, y)) [x + 1 .. a + 1]
+               | x > a = all (\i -> ok (i, y)) [a - 1 .. x - 1]
+               | y < b = all (\j -> ok (x, j)) [y + 1 .. b + 1]
+               | y > b = all (\j -> ok (x, j)) [b - 1 .. y - 1]
+  ok :: (Int, Int) -> Bool
+  ok t = inRange (bounds s) t
+      && case s ! t of Piece _ -> False
+                       _       -> True
+
+move :: Int -> (Int, Int) -> (Player, Bamp) -> (Player, Bamp)
+move bsz (x, y) (p, Bamp s) = let (a, b) = findBall s
+                                  new = follow (a, b) (signum (a - x), signum (b - y))
+                              in (owner bsz new, Bamp $ s // [((x, y), Empty), ((a, b), Piece p), (new, Ball)])
+ where
+  follow :: (Int, Int) -> (Int, Int) -> (Int, Int)
+  follow (x, y) (dx, dy)
+    | not $ inRange (bounds s) (x + dx, y + dy) = (x, y)
+    | s ! (x + dx, y + dy) == Empty             = follow (x + dx, y + dy) (dx, dy)
+    | isPortal $ s ! (x + dx, y + dy)           = follow (x + dx, y + dy) (dx, dy)
+    | otherwise                                 = (x, y)
+
+findBall :: Array (Int, Int) BampField -> (Int, Int)
+findBall s = case dropWhile (not.(== Ball).snd) $ assocs s
+             of ((i, Ball):_) -> i
+                []            -> (0, 0)
+
+colorplayer :: Int -> Color
+colorplayer 0 = hsl 0.66 1   0.5
+colorplayer 1 = hsl 0    1   0.5
+colorplayer 2 = hsl 0.33 1   0.5
+colorplayer 3 = hsl 0.82 1   0.5
+colorplayer 4 = hsl 0.11 0.7 0.5
+colorplayer 5 = hsl 0    0   0.5
+colorplayer _ = hsl 0    0   0
+
+ GUI.hs view
@@ -0,0 +1,782 @@+{-# OPTIONS -fglasgow-exts #-}
+
+---------
+-- GUI -- 
+---------
+
+module GUI (gui, version) where
+
+import Game
+-- import Graphics.UI.WX
+import Graphics.UI.WX     hiding (bitmap)
+import Graphics.UI.WXCore
+import Random
+import Char
+import Tools
+import List
+
+version :: String
+version = "1.7" 
+
+gui :: [GeneralGame] -> IO ()
+gui games = do
+
+  {--== CREATION PHASE ==--}
+
+  f <- mdiParentFrame []
+  c <- mdiParentFrameGetClientWindow f
+  
+  mGame  <- menuPane        []
+  iNew   <- menuItem  mGame []
+  ()     <- menuLine  mGame 
+  iQuit  <- menuQuit  mGame []
+ 
+  mHelp  <- menuHelp        []
+  iHelp  <- menuItem  mHelp []
+  iAbout <- menuAbout mHelp []
+
+  field  <- statusField []
+
+  logo   <- bitmapCreateLoad "images\\gebop.bmp" wxBITMAP_TYPE_ANY
+
+  {--== DEFENITION PHASE ==--}
+
+  let onpaint :: DC () -> Rect -> IO ()
+      onpaint dc r = do
+        tileBitmap dc r logo
+
+  {--== MODIFICATION PHASE ==--}
+
+  set mGame  [ text := "&Game"                                                      ]
+  set iNew   [ text := "&New Game\tCtrl+N", help := "Start a new game"              , on command := newgame f games] 
+  set iQuit  [                              help := "Quit the application"          , on command := close f] 
+  set iHelp  [ text := "&Contents"        , help := "Show the contents of GeBoP"    , on command := html f "help\\index.html"]
+  set iAbout [                              help := "Information about this program", on command := infoDialog f "About GeBoP" about]
+
+  set f [ visible           := True
+        , clientSize        := sz 640 480
+        , picture           := "gebop.ico"
+        , text              := "GeBoP"
+        , menuBar           := [mGame, mHelp] 
+        , statusBar         := [field]
+        ]
+  
+  set c [ on paint    := onpaint
+        , on resize  ::= repaint
+        ]
+  
+  return ()
+
+newgame :: MDIParentFrame () -> [GeneralGame] -> IO ()
+newgame mdiparent games = do 
+  mi <- askGame
+  case mi of 
+    Nothing -> return ()
+    Just i  -> do
+      let gc = games !! i
+          pr = (\(Game g) -> standard g) gc
+          ra = (\(Game g) -> possible g) gc
+      msettings <- askSettings pr ra
+      case msettings of 
+        Nothing -> return ()
+        Just settings -> do
+          (\(Game g) -> game mdiparent g settings (newgame mdiparent games)) $ gc
+          return ()
+          
+  where
+  
+    askGame :: IO (Maybe Int)
+    askGame = do
+      d   <- dialog     mdiparent [text := "Choose a game"]
+      mes <- staticText d [text := "There are currently " ++ numberword (length games) ++ " games you can play."]
+      ok  <- button     d [text := "Play", tooltip := "click to proceed"]
+      can <- button     d [text := "Cancel", tooltip := "click to cancel"]
+      r   <- radioBox   d Vertical (map (\(Game g) -> name g) games) [tooltip := "select a game"]
+      set d [ layout := margin 4 $ column 4
+              [ widget mes
+              , hfill        $ widget r
+              , hfloatCentre $ row 4 [widget ok, widget can]
+              ]
+            ]
+      showModal d (\stop -> do
+        set ok  [on command := get r selection >>= stop . Just]
+        set can [on command := stop Nothing]
+                            )
+      
+    askSettings :: Properties -> PropertyRange -> IO (Maybe Properties)
+    askSettings pr ra = do
+      let pra = playersrange ra
+          bra = sort $ boardsizerange ra
+      d <- dialog mdiparent [text := "Settings"]
+      mes <- staticText d [text := "Select the settings."]
+      ok  <- button     d [text := "Play", tooltip := "click to start the game"]
+      can <- button     d [text := "Cancel", tooltip := "click to cancel"]
+      cbs <- sequence $ replicate (maximum pra) $ checkBox d [tooltip := "should this player participate?"]
+      sts <- sequence $ map (\i -> staticText d [text := "player " ++ show i]) [1 .. maximum pra]
+      rbs <- sequence $ replicate (maximum pra) $ radioBox d Horizontal ["Human", "Computer"] [tooltip := "will you play this player?"]
+      sequence_ $ map (\i -> set (cbs !!! (i - 1)) [enabled := False]) [1 .. minimum pra]
+      let check b i = do set (cbs !!! (i - 1)) [checked := b]
+                         set (sts !!! (i - 1)) [enabled := b]
+                         set (rbs !!! (i - 1)) [enabled := b]
+          click True  i | i `elem` pra = do for 1 i $ check True
+                        | otherwise    = click True (i + 1)
+          click False i | (i - 1) `elem` pra = do for i (maximum pra) $ check False
+                        | otherwise          = click False (i - 1)
+      for 1 (maximum pra) (\i -> check False i)
+      click True $ players pr
+      sequence_ $ zipWith (\i h -> set (rbs !!! (i - 1)) [selection := if h then 0 else 1]) [1 ..] (human pr)
+      sequence_ $ map (\i -> set (cbs !!! (i - 1)) [on command ::= \cb -> get cb checked >>= flip click i]) [1 .. maximum pra]
+      sli <- if length (bra) == 1 then return Nothing
+             else fmap Just $ hslider d False 0 (length bra - 1) [selection := maybe 0 id $ elemIndex (boardsize pr) bra, tooltip := "select the size of the board"]
+      let hcselection = map (\i -> [vfloatCentre $ widget $ cbs !!! (i - 1), vfloatCentre $ widget $ sts !!! (i - 1), widget $ rbs !!! (i - 1)]) [1 .. maximum pra]
+          selections = case sli of
+            Nothing -> grid 4 4 hcselection
+            Just s  -> column 4 [ grid 4 4 hcselection
+                                , hfill $ widget s
+                                , row 4 [label "small", glue, label "large"]
+                                ]
+      set d [ layout := margin 4 $ column 4
+              [ widget mes
+              , selections
+              , hfloatCentre $ row 4 [widget ok, widget can]
+              ]
+            ]
+      showModal d (\stop -> do
+        set ok  [on command := do
+          p <- fmap (length . takeWhile id) $ sequence $ map (flip get checked) cbs
+          h <- sequence $ (map.fmap) (== 0) $ map (flip get selection) rbs
+          b <- case sli of Nothing -> return $ boardsize pr
+                           Just s -> fmap (bra !!!) $ get s selection
+          stop $ Just Properties {players = p, human = h, boardsize = b}]
+        set can [on command := stop Nothing]
+                            )
+
+game :: Game g => MDIParentFrame () -> g -> Properties -> IO () -> IO ()
+game mdiparent g pr newg = do
+
+  {--== CREATION PHASE ==--}
+
+  f <- mdiChildFrame mdiparent []
+  
+  mGame  <- menuPane         []
+  iNew   <- menuItem  mGame  []
+  iAgain <- menuItem  mGame  []
+  ()     <- menuLine  mGame 
+  iClose <- menuItem  mGame  []
+  iQuit  <- menuQuit  mGame  []
+  mBrain <- menuPane         []
+  iOpen  <- menuItem  mBrain []
+  mHelp  <- menuHelp         []
+  iHelp  <- menuItem  mHelp  []
+  iRules <- menuItem  mHelp  []
+  iInfo  <- menuItem  mHelp  []
+  iAbout <- menuAbout mHelp  []
+
+  logoblue   <- bitmap "blue"
+  logored    <- bitmap "red"
+  logogreen  <- bitmap "green"
+  logopurple <- bitmap "purple"
+  logobrown  <- bitmap "brown"
+  logogrey   <- bitmap "grey"
+
+  turn   <- bitmap "turn"
+  winner <- bitmap "winner"
+
+  humanbmp    <- bitmap "human"
+  computerbmp <- bitmap "computer"
+
+  vart <- varCreate $ createtree g pr
+  varb <- varCreate $ emptyBrain
+
+  p <- panel f []
+
+  clock <- timer f []
+                    
+  ps <- sequence $ replicate (players pr) $ panel f []
+  ss <- sequence $ map (\p -> hslider p False 0 10 []) ps
+  bs <- sequence $ map (\p -> singleListBox p []) ps
+
+--{  field <- statusField []
+
+  {--== DEFENITION PHASE ==--}
+
+  let 
+  
+    stopClock :: IO ()
+    stopClock = do timerStop clock
+                   info "clock stopped"
+
+    ifhuman :: IO () -> IO ()
+    ifhuman io = do t <- getTree
+                    if human pr !!! player t && movesnr t > 0 then io else return ()
+
+    ifcomputer :: IO () -> IO ()
+    ifcomputer io = do t <- getTree
+                       if human pr !!! player t || movesnr t == 0 then return () else io
+  
+    getTree = varGet vart
+    setTree = varSet vart
+    updateTree = varUpdate vart
+  
+    logo :: Int -> Bitmap ()
+    logo 0 = logoblue
+    logo 1 = logored
+    logo 2 = logogreen
+    logo 3 = logopurple
+    logo 4 = logobrown
+    logo 5 = logogrey
+    
+    onpaintplayer :: Int -> DC () -> Rect -> IO ()
+    onpaintplayer i dc r@(Rect x y w h) = do
+      let xi = (w - 40) `div` 2
+      drawBitmap dc (logo i) (pt xi 10) True []
+      t <- getTree
+      drawRect dc (Rect xi 60 40 40) [brushKind := BrushTransparent]
+      for 0 (floor $ 19 * val t !!! i) (\j -> line dc (pt (xi + 1) (80 - j)) (pt (xi + 39) (80 - j)) [penColor := green])
+      for (floor $ 18 * val t !!! i) 0 (\j -> line dc (pt (xi + 1) (80 - j)) (pt (xi + 39) (80 - j)) [penColor := red  ])
+      line dc (pt xi 80) (pt (xi + 40) 80) []
+      if player t == i && movesnr t > 0 then drawBitmap dc turn (pt xi 110) True [] else return ()
+      drawBitmap dc (if human pr !!! i then humanbmp else computerbmp) (pt xi 160) True []
+      ifIO (win i) $ drawBitmap dc winner (pt xi 110) True []
+
+    oncommand i = do
+      t <- getTree
+      when (player t == i) $ send clock
+
+    playerpanel i p sli box = do
+      but <- button p []
+      stt <- staticText p []
+      itemAppend box $ ""
+
+      set sli [ clientSize := Size 60 20
+              , color      := setLum 0.25 $ colorplayer i
+              , bgcolor    := setLum 0.95 $ colorplayer i
+              , on command := do v <- sliderGetValue sli
+                                 set stt [text := show (2 ^ v) ++ " sec"]
+              , visible    := not (human pr !!! i)
+              , selection  := 3
+              ]
+      set stt [ clientSize := Size 70 20
+              , text       := "8 sec"
+              , color      := setLum 0.25 $ colorplayer i
+              , bgcolor    := setLum 0.95 $ colorplayer i
+              , visible    := not (human pr !!! i)
+              ]
+      set but [ clientSize := sz 60 20
+              , text       := "move now"
+              , color      := setLum 0.25 $ colorplayer i
+              , bgcolor    := setLum 0.95 $ colorplayer i
+              , on command := oncommand i
+              , visible    := not (human pr !!! i)
+              ] 
+      set box [ clientSize := Size 60 20
+              , color      := setLum 0.25 $ colorplayer i
+              , bgcolor    := setLum 0.95 $ colorplayer i
+              , on select  := do info ("select " ++ show i)
+                                 s <- get box selection
+                                 mapM_ (\b -> set b [selection := s]) bs
+              ]
+      set p [ bgcolor    := setLum 0.95 $ colorplayer i
+            , clientSize := Size 80 0
+            , on paint   := onpaintplayer i
+            , layout     := margin 4 $ column 4
+              [ space 72 210
+              , hfill                $ widget sli
+              ,         hfloatCentre $ widget stt
+              ,         hfloatCentre $ widget but
+              , vfill $ hfloatCentre $ widget box
+              ]
+            ]
+      return ()
+
+    boxInsert :: Player -> String -> IO ()
+    boxInsert p s = do
+      let b = (bs !!! p)
+      i <- get b itemCount
+      vs <- mapM (\p -> get (bs !!! p) (item $ i - 1)) [p .. length bs - 1]
+      when (not $ all null vs) $ mapM_ (\b -> itemAppend b "") bs
+      i <- get b itemCount
+      set b [item (i - 1) := s]
+      mapM_ (\b -> set b [selection := i - 1]) bs
+
+    win :: Int -> IO Bool
+    win i = do
+      t <- getTree
+      return $ (movesnr t == 0) && (val t !!! i == 1)
+
+    gamename = (\(c : cs) -> toUpper c : cs) $ name g
+
+    repaintall :: IO ()
+    repaintall = do repaint p
+                    sequence_ $ map repaint ps
+  
+    startClock :: IO ()
+    startClock = do t <- getTree
+                    v <- sliderGetValue $ ss !!! player t
+                    let int = 1000 * 2 ^ v
+                    timerStart clock int True
+                    info "clock started"
+                    
+    next :: Int -> IO ()
+    next n = do t <- getTree
+                updateTree (shear n)
+                u <- getTree
+                b <- varGet varb
+                bRefresh b
+                boxInsert (player t) $ showmove pr (player t) (state t) (childid u)
+                repaintall
+                if movesnr t == 0
+                  then do infoDialog f "End of Game" $ "The game ended with value " ++ show (val u)
+                          info "end of this game"
+                  else do ifcomputer $ info "computer's turn" >> think >> startClock
+                          ifhuman $ info "player's turn"
+
+    onidle :: IO Bool
+    onidle = do ifcomputer $ do think
+                                u <- getTree
+                                when (movesnr u == 1) movenow
+                                when (closed u) movenow
+                --{ andere constructie (ook denken in spelertijd?)
+                t <- getTree
+                return $ human pr !!! player t
+
+    think :: IO ()
+    think = do t <- getTree
+               js <- randomList
+               let p = path followcombination js t
+--{               let p = path followbest js t
+               updateTree $ step p
+               u <- getTree
+
+               when (val t /= val u) $ sequence_ $ map repaint ps
+               b <- varGet varb
+               bUpdatePath b p
+
+               return ()
+
+    movenow :: IO ()
+    movenow = ifcomputer $ do
+      stopClock
+      t <- getTree
+      i <- randomElement $ best t
+      info "computer moves"
+      next i
+
+    newquick :: IO ()
+    newquick = do stopClock
+                  setTree $ createtree g pr
+                  info "new game started"
+                  sequence_ $ map (\b -> set b [items := [" "]]) bs
+                  repaintall
+                  ifcomputer $ info "computer's turn" >> startClock
+                  return ()
+
+    showRules :: IO ()
+    showRules = html f $ "help\\rules_" ++ gamename ++ ".html"
+    
+    showInfo :: IO ()
+    showInfo = html f $ "help\\info_" ++ gamename ++ ".html"
+
+    playerinput :: Int -> IO ()
+    playerinput i = do
+      info $ "moverequest: " ++ show i
+      ifhuman $ do
+        t <- getTree
+        when (0 <= i && i < movesnr t) $ info "correct move" >> next i
+
+  {--== MODIFICATION PHASE ==--}
+
+  sequence_ $ zipWith4 playerpanel [0..] ps ss bs
+
+  board p pr vart True playerinput
+
+  set mGame  [ text := "&Game"                                                                                                                                      ]
+  set iNew   [ text := "&New Game\tCtrl+N"        , help := "Start a new game"                                 , on command := newg                                 ]
+  set iAgain [ text := "Play &Again\tCtrl+A"      , help := "Play again with the same settings"                , on command := newquick >> varGet varb >>= bRefresh ]
+  set iClose [ text := "&Close\tCtrl+C"           , help := "Close this game"                                  , on command := close f                              ]
+  set iQuit  [                                      help := "Quit the application"                             , on command := close mdiparent                      ]
+  set mBrain [ text := "&Brain"                                                                                                                                     ]
+  set iOpen  [ text := "&Open\tCtrl+B"            , help := "Open the brain for " ++ gamename                  , on command := brain mdiparent pr vart varb newg    ]
+  set iHelp  [ text := "&Contents"                , help := "Show the contents of GeBoP"                       , on command := html f "help\\index.html"            ]
+  set iRules [ text := gamename ++ " &Rules"      , help := "Display the rules of this game"                   , on command := showRules                            ]
+  set iInfo  [ text := gamename ++ " &Information", help := "Display some background information on this game" , on command := showInfo                             ]
+  set iAbout [                                      help := "Information about this program"                   , on command := infoDialog f "About GeBoP" about     ]
+
+  set clock [ on command := info "alarm" >> movenow ]
+
+  set p [ clientSize := sz 400 400 ]
+
+  set f [ text              := gamename
+        , menuBar           := [mGame, mBrain, mHelp] 
+        , layout            := row 0 ( fill (widget p)
+                                     : map (vfill . widget) ps
+                                     )
+        , on idle           := onidle
+        , picture           := "gebop.ico"
+        , on closing        :~ \io -> do b <- varGet varb
+                                         bClose b
+                                         io
+--{        , statusBar := [field]
+        ]
+
+  ifhuman $ stopClock
+
+  return ()
+
+data Brain
+  = Brain { bClose      :: IO ()
+          , bUpdatePath :: [Int] -> IO ()
+          , bRefresh    :: IO ()
+          }
+
+emptyBrain :: Brain
+emptyBrain
+  = Brain { bClose      =         return ()
+          , bUpdatePath = const $ return ()
+          , bRefresh    =         return ()
+          }
+
+brain :: Game g => MDIParentFrame () -> Properties -> Var (Tree g) -> Var Brain -> IO () -> IO ()
+brain mdiparent pr vart varb newg = do
+
+  {--== CREATION PHASE ==--}
+
+  f <- mdiChildFrame mdiparent []
+  sw <- splitterWindow f []
+ 
+  pLeft  <- panel sw []
+  pRight <- panel sw []
+  pBoard <- panel pRight []
+  pValue <- panel pRight []
+  pInfo  <- panel pRight []
+
+  mGame  <- menuPane         []
+  iNew   <- menuItem  mGame  []
+  ()     <- menuLine  mGame
+  iQuit  <- menuQuit  mGame  []
+  mBrain <- menuPane         []
+  iClose <- menuItem  mBrain []
+  iMini  <- menuItem  mBrain []
+  iLarge <- menuItem  mBrain []
+  mHelp  <- menuHelp         []
+  iHelp  <- menuItem  mHelp  []
+  iBrain <- menuItem  mHelp  []
+  iAbout <- menuAbout mHelp  []
+
+  logos  <- mapM (bitmap.nameplayer) [0 .. 5]
+  winner <- bitmap "winner"
+  leeg   <- bitmap "empty"
+
+  bPlayer   <- staticBitmapCreate pRight (-1) (logos !!! 0) rectNull (-1)
+
+  tPlayer   <- staticText pRight []
+  tMind     <- staticText pInfo []
+  tMaxd     <- staticText pInfo []
+  tVolume   <- staticText pInfo []
+
+  tc <- treeCtrl pLeft []
+
+  g <- varGet vart >>= return . state
+  varu <- varCopy vart
+
+  {--== DEFENITION PHASE ==--}
+
+  let 
+
+    gamename :: String
+    gamename = (\(c : cs) -> toUpper c : cs) $ name g
+
+    getData :: TreeItem -> IO [Int]
+    getData item = do
+      mmovs <- unsafeTreeCtrlGetItemClientData tc item
+      case mmovs of Just movs -> return movs
+                    Nothing   -> return []
+
+    setImages :: Bool -> IO ()
+    setImages True = do
+      il <- imageListCreate (Size 40 40) True 0
+      sequence_ $ map (bitmapImageList il) $ map nameplayer [0 .. 5]
+      sequence_ $ map (bitmapHighImageList il) $ map nameplayer [0 .. 5]
+      bitmapImageList il "brain"
+      treeCtrlAssignImageList tc il
+    setImages False = do
+      il <- imageListCreate (Size 10 10) True 0
+      sequence_ $ map (bitmapImageList il) $ map ("small_" ++) $ map nameplayer [0 .. 5]
+      sequence_ $ map (bitmapHighImageList il) $ map ("small_" ++) $ map nameplayer [0 .. 5]
+      bitmapImageList il "small_brain"
+      treeCtrlAssignImageList tc il
+
+    onmini :: IO ()
+    onmini = do
+      set f [clientSize := sz 256 100]
+      splitterWindowSetSashPosition sw 128 True
+   
+    onpaintValue :: DC () -> Rect -> IO ()
+    onpaintValue dc (Rect x y w_ h) = do
+      let pl = players pr
+          w = min (w_) (20 * pl)
+          r = Rect x y w h
+--{      line dc (pt 0 0) (pt w h) []
+--{      line dc (pt 0 h) (pt w 0) []
+      u <- varGet varu
+      for 0 (pl - 1) (\i -> do
+        let xi  = x + w * i `div` pl
+            xi1 = x + w * (i + 1) `div` pl
+        for 0 (floor $ 19 * val u !!! i) (\j -> line dc (pt (xi + 1) (20 - j)) (pt (xi1) (20 - j)) [penColor := colorplayer i])
+        for (floor $ 18 * val u !!! i) 0 (\j -> line dc (pt (xi + 1) (20 - j)) (pt (xi1) (20 - j)) [penColor := setLum 0.4 $ colorplayer i])
+        )
+      drawRect dc r [brushKind := BrushTransparent]
+      line dc (pt x 20) (pt (x + w) 20) []
+
+    onTreeEvent :: EventTree -> IO ()
+    onTreeEvent (TreeItemExpanding item veto) | treeItemIsOk item = do
+      wxcBeginBusyCursor
+      children <- treeCtrlGetChildren tc item
+      mapM_ visualise children
+      wxcEndBusyCursor
+      propagateEvent
+    onTreeEvent (TreeSelChanged item olditem) | treeItemIsOk item = do
+      wxcBeginBusyCursor
+      selectRight item
+      wxcEndBusyCursor
+      propagateEvent
+    onTreeEvent _ = propagateEvent
+
+    visualise :: TreeItem -> IO ()
+    visualise item = do
+      c <- treeCtrlItemHasChildren tc item
+      when (c == 0) $ giveBirth item
+      updateThickness item
+      updateImages item
+
+    selectRight :: TreeItem -> IO ()
+    selectRight item = do
+      updateRight item
+      t <- varGet varu
+      staticBitmapSetBitmap bPlayer (logos !!! player t)
+      when (movesnr t == 0) $ staticBitmapSetBitmap bPlayer (if any (== 1) (val t) then winner else leeg)
+      repaint pBoard
+
+    updateRight :: TreeItem -> IO ()
+    updateRight item = do
+      t <- gametree item
+      varSet varu t
+      set tMind     [text := "complete depth: " ++ show (mind     t)]
+      set tMaxd     [text := "maximum depth: "  ++ show (maxd     t)]
+      set tVolume   [text := "volume: "         ++ show (volume   t)]
+      repaint pValue
+
+    bClose :: IO ()
+    bClose = close f
+
+    bUpdatePath :: [Int] -> IO ()
+    bUpdatePath path = do
+      root <- treeCtrlGetRootItem tc
+      updatePath root path
+     where
+      updatePath :: TreeItem -> [Int] -> IO ()
+      updatePath item path = do
+        updateThickness item
+        updateImages item
+        ifIO (treeCtrlIsSelected tc item) $ updateRight item
+        ifIO (treeCtrlIsExpanded tc item) $ case path of
+          (i:is) -> do cs <- treeCtrlGetChildren tc item
+                       updatePath (cs !! i) is
+          [] -> return ()
+
+    bRefresh :: IO ()
+    bRefresh = do
+      treeCtrlDeleteAllItems tc
+--{      root <- treeCtrlAddRoot tc "current situation" 5 (-1) objectNull
+      root <- treeCtrlAddRoot tc "current situation" 12 12 objectNull
+      treeCtrlSetItemClientData tc root (return ()) []
+      giveBirth root
+      updateThickness root
+      updateImages root
+      treeCtrlSelectItem tc root
+      selectRight root
+
+    giveBirth :: TreeItem -> IO ()
+    giveBirth item = do
+      movs <- getData item
+      t <- gametree item
+      for 0 (movesnr t - 1) (\i -> do
+        let u = shear i t
+            m = showmove pr (player t) (state t) i
+--{        jtem <- treeCtrlAppendItem tc item (show i ++ " (" ++ m ++ ")") (player t) (-1) objectNull 
+        jtem <- treeCtrlAppendItem tc item (show i ++ " (" ++ m ++ ")") (-1) (-1) objectNull 
+        treeCtrlSetItemClientData tc jtem (return ()) (movs ++ [i])
+        updateThickness jtem
+        )
+      treeCtrlSetItemHasChildren tc item (movesnr t > 0)
+
+    updateThickness :: TreeItem -> IO ()
+    updateThickness item = do
+      t <- gametree item
+      let itemcolor | filled t  = black
+                    | otherwise = grey
+      treeCtrlSetItemTextColour tc item itemcolor
+      treeCtrlSetItemBold       tc item (closed t)
+  
+    updateImages :: TreeItem -> IO ()
+    updateImages item = do
+      t <- gametree item
+      c <- treeCtrlItemHasChildren tc item
+      cs <- treeCtrlGetChildren tc item
+      when (c > 0) $ for 0 (movesnr t - 1) (\i -> do
+        let offset | i `elem` best t = 6
+                   | otherwise       = 0
+        setImage (cs !! i) (offset + player t)
+        )
+
+    setImage :: TreeItem -> Int -> IO ()
+    setImage item i = do
+      j <- treeCtrlGetItemImage tc item 0 --{ wxTreeItemIcon_Normal
+      when (i /= j) $ do
+        treeCtrlSetItemImage tc item i 0 --{ wxTreeItemIcon_Normal
+        treeCtrlSetItemImage tc item i 1 --{ wxTreeItemIcon_Selected
+--{        treeCtrlSetItemImage tc item i 2 --{ wxTreeItemIcon_Expanded
+--{        treeCtrlSetItemImage tc item i 3 --{ wxTreeItemIcon_SelectedExpanded
+
+--  gametree :: TreeItem -> IO (Tree g)
+    gametree item = do
+      t <- varGet vart
+      movs <- getData item
+      return $ gametree_ movs t
+     where
+--    gametree_ :: [Int] -> Tree g -> Tree g
+      gametree_ (i:is) t | i >= 0 && i < movesnr t = gametree_ is $ shear i t
+      gametree_ _      t = t
+
+
+    playerinput :: Int -> IO ()
+    playerinput i = do
+      info $ "brain moverequest: " ++ show i
+      item <- treeCtrlGetSelection tc
+      t <- gametree item
+      cs <- treeCtrlGetChildren tc item
+      when (0 <= i && i < movesnr t) $ do
+        treeCtrlExpand tc item
+        treeCtrlSelectItem tc (cs !! i)
+
+  {--== MODIFICATION PHASE ==--}
+
+  board pBoard pr varu False playerinput
+
+  bRefresh
+--  setImages True
+  setImages False
+        
+
+  varSet varb $ Brain bClose bUpdatePath bRefresh
+
+  set mGame  [ text := "&Game"                                                                                                                                     ] 
+  set iNew   [ text := "&New Game\tCtrl+N"        , help := "Start a new game"                                 , on command  := newg                               ]
+  set iQuit  [                                      help := "Quit the application"                             , on command  := close mdiparent                    ] 
+  set mBrain [ text := "&Brain"                                                                                                                                    ] 
+  set iClose [ text := "&Close\tCtrl+C"           , help := "Close the brain for " ++ gamename                 , on command  := close f                            ]  
+  set iMini  [ text := "&Minimal\tCtrl+M"         , help := "Minimize the brain size"                          , on command  := onmini                             ]  
+  set iLarge [ text := "&Large Icons\tCtrl+L"     , checkable := True, checked := False                        , on command ::= (>>= setImages) . flip get checked ]  
+  set iHelp  [ text := "&Contents"                , help := "Show the contents of GeBoP"                       , on command  := html f "help\\index.html"          ]
+  set iBrain [ text := "The &Brain"               , help := "Shows help about the brain viewer"                , on command  := html f "help\\brain.html"          ]
+  set iAbout [                                      help := "Information about this program"                   , on command  := infoDialog f "About GeBoP" about   ]
+
+  set tc [ on treeEvent := onTreeEvent
+         ] 
+
+  set pLeft [ layout := fill $ widget tc
+            ]
+
+  set pValue [ clientSize := Size 40 40
+             , on paint   := onpaintValue
+             , on resize ::= repaint
+             ]
+
+  set pInfo [ layout := fill $ column 4 $
+              [ widget tMind    
+              , widget tMaxd    
+              , widget tVolume    
+              ]
+            ]
+
+  set pBoard [ on resize ::= repaint
+             ] 
+
+  set pRight [ layout := margin 4 $ column 4 $
+               [ row 4 [widget bPlayer, fill $ widget pValue]
+               , hfill $ widget pInfo
+               ,  fill $ widget pBoard
+               ]
+             ]
+
+  set f [ text              := gamename ++ " Brain"
+        , menuBar           := [mGame, mBrain, mHelp] 
+        , layout            := fill $ vsplit sw 4 200 (widget pLeft) (widget pRight)
+        , picture           := "brain.ico"
+        , clientSize        := Size 480 360
+        , on closing        :~ (varSet varb emptyBrain >>)
+        ]
+        
+colorplayer :: Int -> Color
+colorplayer 0 = hsl 0.66 1   0.5
+colorplayer 1 = hsl 0    1   0.5
+colorplayer 2 = hsl 0.33 1   0.5
+colorplayer 3 = hsl 0.82 1   0.5
+colorplayer 4 = hsl 0.11 0.7 0.5
+colorplayer 5 = hsl 0    0   0.5
+colorplayer _ = hsl 0    0   0
+
+nameplayer :: Int -> String
+nameplayer 0 = "blue"
+nameplayer 1 = "red"
+nameplayer 2 = "green"
+nameplayer 3 = "purple"
+nameplayer 4 = "brown"
+nameplayer 5 = "grey"
+nameplayer _ = "black"
+
+info :: String -> IO ()
+info s = do
+  putStrLn $ "[" ++ s ++ "]"
+  return ()
+  
+html :: Window a -> FilePath -> IO ()
+html w f = do
+  d <- dialog w [text := "Help"]
+  -- w <- htmlWindowCreate d (-1) (rect (point 0 0) (size 640 480)) 0 []
+  w <- htmlWindowCreate d (-1) (rect (point 0 0) (Size 640 480)) 0 []
+  htmlWindowLoadPage w f
+  set d [layout := widget w, visible := True]
+  return ()
+
+about = "GeBoP - General Boardgames Player"
+     ++ "\nversion " ++ version
+     ++ "\n"
+     ++ "\nby Maarten Löffler"
+     ++ "\nmloffler@cs.uu.nl"
+     ++ "\n"
+     ++ "\nGeBoP was written using wxHaskell"
+     
+bitmap :: String -> IO (Bitmap ())
+bitmap name = do bmp    <- bitmapCreateLoad ("images\\" ++ name ++      ".bmp") wxBITMAP_TYPE_ANY
+                 mskbmp <- bitmapCreateLoad ("images\\" ++ name ++ "_mask.bmp") wxBITMAP_TYPE_ANY 
+                 bitmapSetDepth mskbmp 1
+                 msk    <- maskCreate mskbmp
+                 bitmapSetMask bmp msk
+                 return bmp
+
+bitmapImageList :: ImageList () -> String -> IO ()
+bitmapImageList il name = do
+  bmp    <- bitmapCreateLoad ("images\\" ++ name ++      ".bmp") wxBITMAP_TYPE_ANY
+  mskbmp <- bitmapCreateLoad ("images\\" ++ name ++ "_mask.bmp") wxBITMAP_TYPE_ANY 
+  bitmapSetDepth mskbmp 1
+  imageListAddBitmap il bmp mskbmp
+  return ()
+
+bitmapHighImageList :: ImageList () -> String -> IO ()
+bitmapHighImageList il name = do
+  bmp    <- bitmapCreateLoad ("images\\high_" ++ name ++      ".bmp") wxBITMAP_TYPE_ANY
+  mskbmp <- bitmapCreateLoad ("images\\"      ++ name ++ "_mask.bmp") wxBITMAP_TYPE_ANY 
+  bitmapSetDepth mskbmp 1
+  imageListAddBitmap il bmp mskbmp
+  return ()
+ Game.hs view
@@ -0,0 +1,165 @@+{-# OPTIONS -fglasgow-exts #-}
+
+module Game where
+
+import Graphics.UI.WX hiding (children, value)
+import Array
+import Tools
+
+----------------
+-- class Game --
+----------------
+
+type Player = Int
+type Move g = (Player, g) -> (Player, g)
+type Value  = [Float]
+
+data Properties
+  = Properties { players   :: Int
+               , boardsize :: Int
+               , human     :: [Bool]
+               }
+  deriving Show
+
+data PropertyRange
+  = PropertyRange { playersrange   :: [Int]
+                  , boardsizerange :: [Int]
+                  }
+
+class (Eq g, Show g) => Game g where
+
+  name        :: g -> String
+--{  rules       :: g -> String
+--{  information :: g -> String
+
+  standard    :: g -> Properties
+  possible    :: g -> PropertyRange
+  
+  new         :: Properties -> g
+
+  moves       :: Properties -> Player -> g -> [Move g]
+  showmove    :: Properties -> Player -> g -> Int -> String
+
+  value       :: Properties -> Player -> g -> Value
+
+  board       :: Panel ()   -> Properties -> Var (Tree g) -> Bool -> (Int -> IO ()) -> IO ()
+
+data GeneralGame = forall g. Game g => Game g
+
+---------------
+-- data Tree --
+---------------
+
+data Game g => Tree g
+  = Node { player   :: Player
+         , state    :: g
+         , movesnr  :: Int
+         , childid  :: Int
+         , mov      :: Array Int (Move g) --{ onnodig?
+         , children :: Array Int (Tree g)
+         , val      :: Value -- should be equally good for the current player
+                               --{ misschien handig om een set te nemen ipv list?
+                               --{ maar: voor gemiddeldes juist weer niet! (ook in algoritme?)
+                               --{ in dat geval: maar een entry per zet! (dus length best = length val)
+                               --{ > nee! we doen gewoon 1 value, het gemiddelde van alle bests
+                               --{ val = average $ map val best
+         , best     :: [Int]
+         , filled   :: Bool
+         , closed   :: Bool
+         , mind     :: Inf Int
+         , maxd     :: Int
+         , volume   :: Int
+         }
+
+buildtree :: Game g => Properties -> Player -> g -> Tree g
+buildtree prop p g = let ms = moves prop p g
+                         nr = length ms
+                     in Node { player   = p
+                             , state    = g
+                             , movesnr  = nr
+                             , childid  = 0
+                             , mov      = array (0, nr - 1) $ zip [0 ..] $ ms
+                             , children = array (0, nr - 1) $ map (\(i, m) -> (i, (child m) {childid = i})) $ zip [0 ..] ms
+                             , val      = value prop p g
+                             , best     = []
+                             , filled   = False
+                             , closed   = False
+                             , mind     = 0
+                             , maxd     = 0
+                             , volume   = 0
+                             }
+  where
+--  child :: Move g -> Tree g
+    child m = uncurry (buildtree prop) (m (p, g))
+    
+createtree :: Game g => g -> Properties -> Tree g
+createtree _ p = buildtree p 0 $ new p
+
+-----------------------
+-- Tree manipulation --
+-----------------------
+
+better :: Player -> Value -> Value -> Ordering
+better p v w | p < 0 || p >= length v || p >= length w = error $ "Game.better: index " ++ show p ++ " out of bounds"
+             | otherwise                               = compare (v !! p) (w !! p)
+
+computeVal :: Game g => Tree g -> Tree g
+computeVal t = let kids = assocs $ children t                    
+                   vals = map (\(i, k) -> (i, val k)) kids
+                   good = maximumWith (\(_,v) (_,w) -> better (player t) v w) vals
+               in t { best = map fst good
+                    , val  = zipWithn average $ map snd good --{ veranderen als val set is ipv list
+                    }
+
+-- shear cuts a branch off and makes it the new tree
+shear :: Game g => Int -> Tree g -> Tree g
+shear i t = children t ! i
+
+-- grow makes the tree grow at its root (which should be a leaf)
+grow :: Game g => Tree g -> Tree g
+grow t | movesnr t == 0 = t {closed = True, filled = True, mind = inf, maxd = 1, volume = 1}
+       | otherwise      = computeVal $ t   {filled = True, mind = 1  , maxd = 1, volume = 1}
+
+-- update recomputes val, best, mind and maxd given the index of the altered child
+--{ update moet efficienter dan altijd computeVal!
+update :: Game g => Int -> Tree g -> Tree g
+update i t = computeVal
+           $ t { closed = and $ map closed $ elems $ children t
+               , mind   = case filter (not . closed) $ elems $ children t
+                          of []   -> inf
+                             kids -> minimum $ map ((+ 1) . mind) kids
+               , maxd   = maximum $ map ((+ 1) . maxd) $ elems $ children t
+               , volume = 1 + sum (map volume $ elems $ children t)
+               }
+
+-- path computes a path to a leaf to update, given a leaf-choosing algorithm f
+path :: Game g => (Tree g -> [Int]) -> [Int] -> Tree g -> [Int]
+path f (j:js) t = case f t of [] -> []
+                              is -> let i = is !! (j `mod` length is)
+                                    in i : path f js (children t ! i)
+
+-- step makes the tree grow at exactly one leaf, given a path
+step :: Game g => [Int] -> Tree g -> Tree g
+step []     t = grow t
+step (i:is) t 
+  | filled t  = let u = step is (children t ! i)
+                in  update i $ t {children = children t // [(i, u)]}
+  | otherwise = grow t
+
+followcombination :: Game g => Tree g -> [Int]
+followcombination t = followshortest t ++ followbest t
+
+followshortest :: Game g => Tree g -> [Int]
+followshortest t | not $ filled t = []
+                 | closed t       = []
+                 | otherwise      = let open = filter (\(i, k) -> not $ closed k) $ assocs $ children t
+                                        minds = map (\(i, k) -> (i, mind k)) open
+                                    in map fst $ minimumWith (\(_, p) (_, q) -> compare p q) minds
+
+followbest :: Game g => Tree g -> [Int]
+followbest t = case filter (\i -> not $ closed $ children t ! i) $ best t of
+                 [] -> followopen t
+                 b  -> b
+                 
+followopen :: Game g => Tree g -> [Int]
+followopen t = map fst $ filter (not.closed.snd) $ assocs $ children t
+ GeBoP.cabal view
@@ -0,0 +1,121 @@+Name:           GeBoP
+Synopsis:       Several games
+Description: 
+  The games: Ataxx, Bamp, Halma, Hez, Kram, Nim, Reversi, TicTacToe, and Zenix
+Homepage:       http://www.haskell.org/haskellwiki/GeBoP
+Version:        1.7
+License:        BSD3
+License-file:   LICENSE.txt
+Author:         Maarten Löffler
+Maintainer:     Maarten Löffler <loffler@cs.uu.nl>
+Stability:      Stable
+Cabal-Version:  >= 1.2
+Build-type:     Simple
+Category:       Game
+Tested-with:    GHC == 6.10.4
+Extra-Source-Files:
+                readme.txt,
+                Ataxx.hs,
+                Bamp.hs,
+                Game.hs,
+                GUI.hs,
+                Halma.hs,
+                Hex.hs,
+                HSL.hs,
+                Inf.hs,
+                Kram.hs,
+                Nim.hs,
+                Reversi.hs,
+                TicTacToe.hs,
+                Tools.hs,
+                Zenix.hs
+
+Data-dir:       .
+Data-files:     gebop.ico, 
+                brain.ico,
+                images/blue.bmp,
+                images/blue_mask.bmp,
+                images/brain.bmp,
+                images/brain_mask.bmp,
+                images/brown.bmp,
+                images/brown_mask.bmp,
+                images/computer.bmp,
+                images/computer_mask.bmp,
+                images/empty.bmp,
+                images/empty_mask.bmp,
+                images/gebop.bmp,
+                images/green.bmp,
+                images/green_mask.bmp,
+                images/grey.bmp,
+                images/grey_mask.bmp,
+                images/high_blue.bmp,
+                images/high_brown.bmp,
+                images/high_green.bmp,
+                images/high_grey.bmp,
+                images/high_purple.bmp,
+                images/high_red.bmp,
+                images/high_small_blue.bmp,
+                images/high_small_brown.bmp,
+                images/high_small_green.bmp,
+                images/high_small_grey.bmp,
+                images/high_small_purple.bmp,
+                images/high_small_red.bmp,
+                images/human.bmp,
+                images/human_mask.bmp,
+                images/marble.bmp,
+                images/purple.bmp,
+                images/purple_mask.bmp,
+                images/red.bmp,
+                images/red_mask.bmp,
+                images/small_blue.bmp,
+                images/small_blue_mask.bmp,
+                images/small_brain.bmp,
+                images/small_brain_mask.bmp,
+                images/small_brown.bmp,
+                images/small_brown_mask.bmp,
+                images/small_green.bmp,
+                images/small_green_mask.bmp,
+                images/small_grey.bmp,
+                images/small_grey_mask.bmp,
+                images/small_purple.bmp,
+                images/small_purple_mask.bmp,
+                images/small_red.bmp,
+                images/small_red_mask.bmp,
+                images/turn.bmp,
+                images/turn_mask.bmp,
+                images/winner.bmp,
+                images/winner_mask.bmp
+                help/brain.html
+                help/gebop.bmp
+                help/index.html
+                help/info_ataxx.html
+                help/info_bamp.html
+                help/info_halma.html
+                help/info_hex.html
+                help/info_kram.html
+                help/info_nim.html
+                help/info_reversi.html
+                help/info_tictactoe.html
+                help/info_zenix.html
+                help/rules_ataxx.html
+                help/rules_bamp.html
+                help/rules_halma.html
+                help/rules_hex.html
+                help/rules_kram.html
+                help/rules_nim.html
+                help/rules_reversi.html
+                help/rules_tictactoe.html
+                help/rules_zenix.html
+
+Executable gebop
+  Build-Depends:
+                base < 3.1, 
+                wxcore >= 0.11 && < 0.12, 
+                wx >= 0.11 && < 0.12, 
+                haskell98 < 1.1, 
+                directory < 1.1
+  Main-Is:      Main.hs
+
+-- The following can only work, when GeBoP stops printing trace data:
+--  if os(mingw32)
+--    GHC-Options: "-optl-mwindows"
+ HSL.hs view
@@ -0,0 +1,83 @@+
+---------
+-- HSL -- 
+---------
+
+module HSL 
+  ( hsl
+  , colorHSL, colorHue, colorSat, colorLum
+  , setHue, setSat, setLum
+  ) where
+
+import Graphics.UI.WX
+
+hsl      :: Float -> Float -> Float -> Color
+colorHSL :: Color -> (Float, Float, Float)
+colorHue :: Color -> Float
+colorSat :: Color -> Float
+colorLum :: Color -> Float
+setHue   :: Float -> Color -> Color
+setSat   :: Float -> Color -> Color
+setLum   :: Float -> Color -> Color
+
+hsl h s l
+  | h < 0 || h > 1 || s < 0 || s > 1 || l < 0 || l > 1 = error "hsl: out of range"
+  | s == 0 = let v = round $ 255 * l
+             in rgb v v v
+  | otherwise = let var_2 | l < 0.5   = l * (1 + s)
+                          | otherwise = (l + s) - (s * l)
+                    var_1 = 2 * l - var_2
+                    r = round $ 255 * hue2rgb var_1 var_2 (h + 1/3)
+                    g = round $ 255 * hue2rgb var_1 var_2  h
+                    b = round $ 255 * hue2rgb var_1 var_2 (h - 1/3)
+                in rgb r g b
+
+hue2rgb :: Float -> Float -> Float -> Float
+hue2rgb v1 v2 vh = let vh_ | vh < 0    = vh + 1
+                           | vh > 1    = vh - 1
+                           | otherwise = vh
+                       v | 6 * vh_ < 1 = v1 + (v2 - v1) * 6 * vh_
+                         | 2 * vh_ < 1 = v2
+                         | 3 * vh_ < 2 = v1 + (v2 - v1) * (2/3 - vh_) * 6
+                         | otherwise   = v1
+                   in v
+
+colorHSL c =
+  let var_r = (fromInteger . toInteger $ colorRed   c) / 255
+      var_g = (fromInteger . toInteger $ colorGreen c) / 255
+      var_b = (fromInteger . toInteger $ colorBlue  c) / 255
+      var_min = minimum [var_r, var_g, var_b]
+      var_max = maximum [var_r, var_g, var_b]
+      del_max = var_max - var_min
+      l = (var_max + var_min) / 2
+      s | del_max == 0 = 0
+        | l < 0.5      = del_max / (    var_max + var_min)
+        | otherwise    = del_max / (2 - var_max - var_min)
+      del_r = ((var_max - var_r) / 6 + del_max / 2) / del_max
+      del_g = ((var_max - var_g) / 6 + del_max / 2) / del_max
+      del_b = ((var_max - var_b) / 6 + del_max / 2) / del_max
+      h_ | del_max == 0     = 0
+         | var_r == var_max = del_b - del_g
+         | var_g == var_max = 1/3 + del_r - del_b
+         | var_b == var_max = 2/3 + del_g - del_r
+      h | h_ < 0 = h_ + 1
+        | h_ > 1 = h_ - 1
+  in (h_, s, l)
+
+colorHue = (\(h, _, _) -> h) . colorHSL
+
+colorSat = (\(_, s, _) -> s) . colorHSL
+
+colorLum = (\(_, _, l) -> l) . colorHSL
+
+setHue h c 
+  | h < 0 || h > 1 = error "setHue: out of range"
+  | otherwise      = let (_, s, l) = colorHSL c in hsl h s l
+
+setSat s c 
+  | s < 0 || s > 1 = error "setSat: out of range"
+  | otherwise      = let (h, _, l) = colorHSL c in hsl h s l
+
+setLum l c 
+  | l < 0 || l > 1 = error "setLum: out of range"
+  | otherwise      = let (h, s, _) = colorHSL c in hsl h s l
+ Halma.hs view
@@ -0,0 +1,267 @@+
+-----------
+-- Halma --
+-----------
+
+module Halma (Halma, halma) where
+
+import Game
+import Array
+-- import Graphics.UI.WX
+import Graphics.UI.WX     hiding (border)
+import Graphics.UI.WXCore
+import Tools
+
+data Halma = Halma (Array (Int, Int) (Maybe Player)) deriving (Eq, Show)
+
+type HalmaMove = ((Int, Int), (Int, Int))
+
+halma :: Halma
+halma = undefined
+
+instance Game Halma where
+
+  name _ = "halma"
+
+  standard _ = Properties    { players = 2, boardsize = 8, human = [True, False, False, False, False, False] }
+  possible _ = PropertyRange { playersrange = [2, 3, 4, 6], boardsizerange = [8] }
+
+  new pr = let empty = [((x, y), Nothing) | x <- [-8 .. 8], y <- [-8 .. 8]]
+           in Halma $ array ((-8, -8), (8, 8)) empty // concatMap (\p -> map (\t -> (t, Just p)) $ startpos $ pos pr p) [0 .. players pr - 1]
+  
+  moves pr p (Halma s) = map (move pr) (allMoves pr p s)
+
+  showmove pr p (Halma s) i = let ((x1, y1), (x2, y2)) = allMoves pr p s !! i
+                              in "abcdefghijklmnopq" !! (x1 + 8) : show (9 - y1) ++ "-" ++ "abcdefghijklmnopq" !! (x2 + 8) : show (9 - y2)
+  
+  value pr p (Halma st) | null $ allMoves pr p st = let winners = map snd $ filter (\(d, _) -> d == 20) $ zip totaldists [0..]
+                                                    in foldr ($) (replicate (players pr) (-1)) $ map (|> 1) winners
+                        | otherwise               = map myvalue [0 .. players pr - 1]
+    where
+      totaldists :: [Int]
+      totaldists = map totaldist [0 .. players pr - 1]
+      totaldist :: Player -> Int
+      totaldist p = let mypieces = map (\(i, e) -> i) $ filter (\(i, e) -> e == Just p) $ assocs st
+                    in sum $ map (dist pr p) mypieces
+      myvalue :: Player -> Float
+      myvalue p = let d = sum (map totaldist [0 .. players pr - 1]) - (players pr) * totaldist p
+                  in (fromInteger . toInteger) d  / (fromInteger . toInteger) (120 * (players pr))
+
+  board p pr vart ia move = do
+
+    marble <- bitmapCreateLoad "images\\marble.bmp" wxBITMAP_TYPE_ANY
+    varg <- varCreate $ grate rectZero 0 (0, 0) sizeZero
+    vare <- varCreate (Nothing :: Maybe (Int, Int))
+
+    let 
+    
+      onpaint :: DC () -> Rect -> IO ()
+      onpaint dc r = do
+        t <- varGet vart
+        e <- varGet vare
+        b_ <- border dc (16, 16)
+        let g_ = grate r b_ (26, 17) (Size 4 7)
+        b <- fit dc (16, 16) $ rectWidth (field g_ (0, 0))
+        let Halma st = state t
+            g = grate r b (26, 17) (Size 4 7)
+            radius = rectHeight (field g (0, 0)) `div` 3
+            lin' :: Rect -> Rect -> IO ()
+            lin' (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2) = do
+              line dc (pt (x1 + w1) (y1 + h1 `div` 2)) (pt (x2 + w2) (y2 + h2 `div` 2)) []
+            lin :: (Int, Int) -> (Int, Int) -> IO ()
+            lin p q = lin' (field g $ tograte p) (field g $ tograte q)
+        varSet varg g
+        tileBitmap dc r marble
+--{        drawGrate dc g [penColor := yellow]
+        for 0 16 (\j -> do
+          let i = head $ dropWhile (\i -> inside $ fromgrate (i, j)) [13 ..]
+          drawTextRect dc (show $ 17 - j) $ field g ( i - 1, j) |#| field g (     i, j)
+          drawTextRect dc (show $ 17 - j) $ field g (25 - i, j) |#| field g (26 - i, j)
+          let d = (i  - 1 + 3 * j) `div` 2 - 18
+              e = (25 - i + 3 * j) `div` 2 - 18
+          drawTextRect dc [['A' ..] !! (16 - j)] $ field g (i  - 1 - d, j - d) |#| field g (i  - 1 - d, j - 1 - d)
+          drawTextRect dc [['A' ..] !! (16 - j)] $ field g (25 - i - e, j - e) |#| field g (25 - i - e, j - 1 - e)
+          )
+        for 0 4 (\n -> do
+          lin (  - 4,  n - 8) (n - 4,  n - 8)
+          lin (n - 8,  n - 4) (    4,  n - 4)
+          lin (  - 4,  n    ) (n + 4,  n    )
+          lin (n    ,  n + 4) (    4,  n + 4)
+          lin (n - 8,    - 4) (n - 8,  n - 4)
+          lin (n - 4,  n - 8) (n - 4,      4)
+          lin (n    ,    - 4) (n    ,  n + 4)
+          lin (n + 4,  n    ) (n + 4,      4)
+          lin (  - 4, -n + 4) (n - 4,      4)
+          lin (n - 8,    - 4) (    4, -n + 8)
+          lin (  - 4, -n - 4) (n + 4,      4)
+          lin (n    ,    - 4) (    4, -n    )
+          )
+        for 0 24 (\i -> for 0 16 (\j ->
+          when (even (i + j)) $ when (inside $ fromgrate (i, j)) $
+            drawPiece dc (field g (i, j)) radius (st ! fromgrate (i, j))
+                   ) )
+        case e of Just p  -> drawBrightPiece dc (field g $ tograte p) radius
+                  Nothing -> return ()
+         
+      onclick :: Point -> IO ()
+      onclick pt = do 
+        t <- varGet vart
+        e <- varGet vare
+        g <- varGet varg
+        let Halma st = state t
+            n = fromgrate $ locate g pt
+        case (e, inside n) of
+          (Nothing, True ) -> when (st ! n == Just (player t)) $ varSet vare (Just n) >> repaint p
+          (_      , False) -> varSet vare Nothing >> repaint p
+          (Just te, True ) -> case lookup (te, n) $ zip (allMoves pr (player t) st) [0..] of
+            Nothing -> varSet vare Nothing >> repaint p
+            Just  i -> varSet vare Nothing >> repaint p >> move i
+
+    set p [ on click    := onclick
+          , on unclick  := onclick
+          , on paint    := onpaint
+          , on resize  ::= repaint
+          ]
+
+    return ()
+
+fit :: DC () -> (Int, Int) -> Int -> IO Int
+fit dc t m = do
+  s <- get dc fontSize
+  fit_ dc (s + 6)
+ where
+  fit_ :: DC () -> Int -> IO Int
+  fit_ dc 1 = border dc t
+  fit_ dc s = do
+    set dc [fontSize := s - 1]
+    b <- border dc t
+    if b <= m then return b
+              else fit_ dc (s - 1)
+
+drawPiece :: DC () -> Rect -> Int -> Maybe Player -> IO ()
+drawPiece dc (Rect x y w h) r mp = circle dc (pt (x + w) (y + h `div` 2)) r [brushColor := col mp]
+
+drawBrightPiece :: DC () -> Rect -> Int -> IO ()
+drawBrightPiece dc (Rect x y w h) r = circle dc (pt (x + w) (y + h `div` 2)) r [brushKind := BrushTransparent, penWidth := 3, penColor := yellow]
+
+tograte :: (Int, Int) -> (Int, Int)
+tograte (i, j) = (12 + 2 * i - j, 8 + j)
+
+fromgrate :: (Int, Int) -> (Int, Int)
+fromgrate (i, j) = (-10 + (i + j) `div` 2, -8 + j)
+
+-- x = ½ (i + j) - 10
+-- y = j - 8
+
+col :: Maybe Player -> Color
+col p = case p of 
+  Nothing -> white
+  Just 0  -> blue
+  Just 1  -> red
+  Just 2  -> green
+  Just 3  -> rgb 160 0 192
+  Just 4  -> rgb 192 128 0
+  Just 5  -> grey
+  _       -> black
+
+(+-) :: Num a => (a, a) -> (a, a) -> (a, a)
+(a, b) +- (c, d) = (a + c, b + d)
+
+allMoves :: Properties -> Player -> Array (Int, Int) (Maybe Player) -> [HalmaMove]
+allMoves pr p st | p == 0 && 20 `elem` (map totaldist [0 .. players pr - 1]) = []
+                 | otherwise = stepmoves ++ jumpmoves
+  where
+    mypieces :: Player -> [(Int, Int)]
+    mypieces p = map (\(i, e) -> i) $ filter (\(i, e) -> e == Just p) $ assocs st
+    stepmoves :: [HalmaMove]
+    stepmoves = let potmoves = concatMap (\t -> map (\s -> (t, t +- s)) $ steps pr p) (mypieces p)
+                in filter (\(f, t) -> inside t && st ! t == Nothing) potmoves
+    jumpmoves :: [HalmaMove]
+    jumpmoves =  concatMap (\t -> map (\s -> (t, s)) $ floodfill t []) (mypieces p)
+    floodfill :: (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
+    floodfill t fs = let news = map (\j -> t +- j +- j)
+                              $ filter (\j -> let u = t +- j +- j
+                                              in inside u 
+                                              && st ! (t +- j) /= Nothing
+                                              && st ! u == Nothing
+                                              && not (u `elem` fs)
+                                       )
+                              $ halfjumps
+                     in foldr ($) fs $ map (\u -> floodfill u . (u :)) news
+    totaldist :: Player -> Int
+    totaldist p = sum $ map (dist pr p) $ mypieces p
+
+steps :: Properties -> Player -> [(Int, Int)]
+steps pr p = steppos (pos pr p)
+  where
+    steppos 0 = [( 1,  1), ( 1,  0), ( 0, -1), (-1, -1)]
+    steppos 1 = [( 0,  1), ( 1,  1), ( 1,  0), ( 0, -1)]
+    steppos 2 = [(-1,  0), ( 0,  1), ( 1,  1), ( 1,  0)]
+    steppos 3 = [(-1, -1), (-1,  0), ( 0,  1), ( 1,  1)]
+    steppos 4 = [( 0, -1), (-1, -1), (-1,  0), ( 0,  1)]
+    steppos 5 = [( 1,  0), ( 0, -1), (-1, -1), (-1,  0)]
+
+jumps :: [(Int, Int)]
+jumps = map (\(x, y) -> (2 * x, 2 * y)) halfjumps
+
+halfjumps :: [(Int, Int)]
+halfjumps = [(1, 1), (1, 0), (0, -1), (-1, -1), (-1, 0), (0, 1)]
+
+dist :: Properties -> Player -> (Int, Int) -> Int
+dist pr p t = distpos (pos pr p) t
+  where
+    distpos 0 (x, y) = 8 - x + y + max 0 (-4 + x    ) + max 0 (-4 - y    )
+    distpos 1 (x, y) = 8 - x     + max 0 (-4 + x - y) + max 0 (-4 + y    )
+    distpos 2 (x, y) = 8     - y + max 0 (-4 + x    ) + max 0 (-4 + y - x)
+    distpos 3 (x, y) = 8 + x - y + max 0 (-4 - x    ) + max 0 (-4 + y    )
+    distpos 4 (x, y) = 8 + x     + max 0 (-4 - x + y) + max 0 (-4 - y    )
+    distpos 5 (x, y) = 8     + y + max 0 (-4 - x    ) + max 0 (-4 - y + x)
+
+move :: Properties -> HalmaMove -> (Player, Halma) -> (Player, Halma)
+move pr (f, t) (p, Halma s) = ( (p + 1) `mod` players pr
+                              , Halma $ s // [(f, Nothing), (t, Just p)]
+                              )
+
+startpos 0 = [(x, y) | x <- [-4 .. -1], y <- [x + 5 ..     4]]
+startpos 1 = [(x, y) | x <- [-8 .. -5], y <- [  - 4 .. x + 4]]
+startpos 2 = [(x, y) | x <- [-4 .. -1], y <- [x - 4 ..   - 5]]
+startpos 3 = [(x, y) | x <- [ 1 ..  4], y <- [  - 4 .. x - 5]]
+startpos 4 = [(x, y) | x <- [ 5 ..  8], y <- [x - 4 ..     4]]
+startpos 5 = [(x, y) | x <- [ 1 ..  4], y <- [    5 .. x + 4]]
+
+pos :: Properties -> Player -> Int
+pos pr p | players pr == 2 = [0, 3      ] !! p
+         | players pr == 3 = [0, 2, 4   ] !! p
+         | players pr == 4 = [0, 1, 3, 4] !! p
+         | players pr == 6 = p
+
+inside :: (Int, Int) -> Bool
+inside (x, y) = (x >= -4 && y <= 4 && x <= y + 4)
+             || (y >= -4 && x <= 4 && y <= x + 4)
+
+{- the halmaboard internally look like this:
+
+y/j
+
+-8 ....x............
+-7 ....xx...........
+-6 ....xxx..........
+-5 ....xxxx.........
+-4 xxxx*****xxxx....
+-3 .xxx******xxx....
+-2 ..xx*******xx....
+-1 ...x********x....
+ 0 ....*********....
+ 1 ....x********x...
+ 2 ....xx*******xx..
+ 3 ....xxx******xxx.
+ 4 ....xxxx*****xxxx
+ 5 .........xxxx....
+ 6 ..........xxx....
+ 7 ...........xx....
+ 8 ............x....
+
+   87654321012345678 x/i
+   --------
+  
+-}
+ Hex.hs view
@@ -0,0 +1,177 @@+
+
+{-{ http://en2.wikipedia.org/wiki/Hex_(game) }-}
+
+
+---------
+-- Hex --
+---------
+
+module Hex (Hex, hex) where
+
+import Game
+import Array
+import Graphics.UI.WX     hiding (border)
+import Graphics.UI.WXCore
+import Tools
+
+data Hex = Hex (Array (Int, Int) (Maybe Player)) deriving (Eq, Show)
+
+type HexMove = (Int, Int)
+
+hex :: Hex
+hex = undefined
+
+instance Game Hex where
+
+  name _ = "hex"
+
+  standard _ = Properties    { players = 2, boardsize = 11, human = [True, False] }
+  possible _ = PropertyRange { playersrange = [2], boardsizerange = [5 .. 15] }
+
+  new pr = let bsz = boardsize pr
+           in Hex $ array ((0, 0), (bsz - 1, bsz - 1)) [((x, y), Nothing) | x <- [0 .. bsz - 1], y <- [0 .. bsz - 1]]
+  
+  moves pr p (Hex st) = map (move pr) (allMoves pr p st)
+
+  showmove pr p (Hex s) i = case allMoves pr p s !! i
+                            of (x, y) -> ['a' ..] !! x : show (1 + y)
+
+  value pr p (Hex st) 
+    | win st (boardsize pr) 0 = [ 1, -1]
+    | win st (boardsize pr) 1 = [-1,  1]
+    | otherwise               = [ 0,  0]
+
+  board p pr vart ia move = do
+
+    marble <- bitmapCreateLoad "images\\marble.bmp" wxBITMAP_TYPE_ANY
+    varg <- varCreate $ grate rectZero 0 (0, 0) sizeZero
+
+    let 
+
+      onpaint :: DC () -> Rect -> IO ()
+      onpaint dc r = do
+        t <- varGet vart
+        let Hex st = state t
+            bsz = boardsize pr
+        b <- border dc (bsz, bsz)
+        let g = grate r b (2 * bsz + 1, 2 * bsz + 2) (Size 7 4)
+            radius = rectWidth (field g (0, 0)) `div` 3
+            lin' :: Rect -> Rect -> Color -> IO ()
+            lin' (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2) c = do
+              line dc (pt (x1 + w1 `div` 2) (y1 + h1)) (pt (x2 + w2 `div` 2) (y2 + h2)) [penWidth := 4, penColor := c]
+            lin :: (Int, Int) -> (Int, Int) -> Color -> IO ()
+            lin p q = lin' (field g $ tograte bsz p) (field g $ tograte bsz q)
+        varSet varg g
+        tileBitmap dc r marble
+--{        drawGrate dc g [penColor := yellow]
+        for 0 (bsz - 1) (\i -> do
+          drawTextRect dc [['A' ..] !! i] $ field g (bsz + 2 + i, 2 * bsz + 1 - i) |#| field g (bsz + 2 + i, 2 * bsz + 2 - i)
+          drawTextRect dc (show (i + 1))  $ field g (bsz - 2 - i, 2 * bsz + 1 - i) |#| field g (bsz - 2 - i, 2 * bsz + 2 - i)
+          )
+        lin (0, -1) (bsz - 1, -1) blue
+        lin (0, bsz) (bsz - 1, bsz) blue
+        lin (-1, 0) (-1, bsz - 1) red
+        lin (bsz, 0) (bsz, bsz - 1) red
+        for 0 (bsz - 1) (\i -> for 0 (bsz - 1) (\j ->
+          drawPiece dc (field g $ tograte bsz (i, j)) radius (st ! (i, j))
+                   ) )
+
+      onclick :: Point -> IO ()
+      onclick pt = do 
+        t <- varGet vart
+        g <- varGet varg
+        let Hex st = state t
+            bsz = boardsize pr
+            n = fromgrate bsz $ locate g pt
+        case lookup n $ zip (allMoves pr (player t) st) [0..] of
+            Nothing -> return ()
+            Just  i -> move i
+
+    set p [ on click    := onclick
+          , on paint    := onpaint
+          , on resize  ::= repaint
+          ]
+
+    return ()
+
+drawPiece :: DC () -> Rect -> Int -> Maybe Player -> IO ()
+drawPiece dc (Rect x y w h) r mp = do
+  circle dc (pt (x + w `div` 2) (y + h)) (max 1 (r `div` 5)) [brushColor := black]
+  case mp of Just 0 -> circle dc (pt (x + w `div` 2) (y + h)) r [brushKind := BrushTransparent, penColor := blue, penWidth := 3]
+             Just 1 -> circle dc (pt (x + w `div` 2) (y + h)) r [brushKind := BrushTransparent, penColor := red , penWidth := 3]
+             Nothing -> return ()
+
+tograte :: Int -> (Int, Int) -> (Int, Int)
+tograte bsz (i, j) = (bsz + i - j, 2 * bsz - 1 - i - j)
+
+fromgrate :: Int -> (Int, Int) -> (Int, Int)
+fromgrate bsz (i, j) = ((bsz + i - j) `div` 2, (3 * bsz - i - j) `div` 2)
+
+{-
+i = s - 1 + x - y
+j = 2s - 2 - x - y
+
+i + j = 3s - 3 - 2y
+2y = 3s - 3 - i - j
+y = (...) / 2
+
+i - j = -s + 1 + 2x
+2x = s - 1 + i - j
+-}
+
+(+-) :: Num a => (a, a) -> (a, a) -> (a, a)
+(a, b) +- (c, d) = (a + c, b + d)
+
+allMoves :: Properties -> Player -> Array (Int, Int) (Maybe Player) -> [HexMove]
+allMoves pr p st 
+  | win st (boardsize pr) (1 - p) = []
+  | otherwise = map fst $ filter ((== Nothing) . snd) $ assocs st
+
+move :: Properties -> HexMove -> (Player, Hex) -> (Player, Hex)
+move pr place (p, Hex s) = (1 - p, Hex $ s // [(place, Just p)])
+
+win :: Array (Int, Int) (Maybe Player) -> Int -> Player -> Bool
+win st bsz 0 = any ((== bsz - 1) . snd) $ floodfill st 0 (zip [0 .. bsz - 1] [-1, -1 ..])
+win st bsz 1 = any ((== bsz - 1) . fst) $ floodfill st 1 (zip [-1, -1 ..] [0 .. bsz - 1])
+   
+floodfill :: Array (Int, Int) (Maybe Player) -> Player -> [(Int, Int)] -> [(Int, Int)]
+floodfill st p togo = floodfill_ p togo []
+ where
+  floodfill_ :: Player -> [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
+  floodfill_ p []         known = known
+  floodfill_ p (f : togo) known = let new  = filter (not . flip elem known) $ map (f +-) steps
+                                      good = filter (\f -> st ! f == Just p) $ filter (inRange (bounds st)) new
+                                  in floodfill_ p (togo ++ good) (known ++ good)
+
+steps :: [(Int, Int)]
+steps = [(1, 1), (1, 0), (0, -1), (-1, -1), (-1, 0), (0, 1)]
+
+jumps :: [((Int, Int), [(Int, Int)])]
+jumps = [ (( 2,  1), [( 1,  0), ( 1,  1)])
+        , (( 1,  2), [( 0,  1), ( 1,  1)])
+        , ((-1,  1), [( 0,  1), (-1,  0)])
+        , ((-2, -1), [(-1,  0), (-1, -1)])
+        , ((-1, -2), [( 0, -1), (-1, -1)])
+        , (( 1, -1), [( 1,  0), ( 0, -1)])
+        ]
+
+
+{- the hexboard internally look like this:
+
+
+                  *
+               *     *
+            *     *     *
+         *     *     *     *
+      *     *     *     *     *
+   *     *     *     *     *     *
+*     *     *     *     *     *     *
+   *     *     *     *     *     *
+      j     *     *     *     i
+         *     *     *     *
+            2     *     2
+               1     1
+                  0     
+ 
+-}
+ Inf.hs view
@@ -0,0 +1,56 @@+
+---------
+-- Inf --
+---------
+
+module Inf
+  ( Inf
+  , inf, fin
+  ) where
+
+data Inf a
+  = Finite a
+  | Infinite Bool
+  deriving Eq
+
+instance Show a => Show (Inf a) where
+  show (Finite x)       = show x
+  show (Infinite True ) = "<+inf>"
+  show (Infinite False) = "<-inf>"
+
+instance Ord a => Ord (Inf a) where
+  compare (Finite   x    ) (Finite   y)     = compare x y
+  compare (Infinite b    ) (Infinite c)     = compare b c
+  compare (Infinite True ) _                = GT
+  compare (Infinite False) _                = LT
+  compare _                (Infinite True ) = LT
+  compare _                (Infinite False) = GT
+
+instance Num a => Num (Inf a) where
+  Finite   x     + Finite   y     = Finite (x + y)
+  Infinite True  + Infinite False = error "<+inf> + <-inf>"
+  Infinite False + Infinite True  = error "<-inf> + <+inf>"
+  Infinite True  + _              = Infinite True
+  Infinite False + _              = Infinite False
+  _              + Infinite True  = Infinite True
+  _              + Infinite False = Infinite False
+  Finite   x     * Finite   y     = Finite (x * y)
+  Infinite b     * Infinite c     = Infinite (b == c)
+  Infinite _     * Finite   0     = error "<inf> * 0"
+  Finite   0     * Infinite _     = error "0 * <inf>"
+  Infinite b     * Finite   x     = Infinite (b == (signum x == 1))
+  Finite   x     * Infinite b     = Infinite ((signum x == 1) == b)
+  negate (Infinite b    ) = Infinite (not    b)
+  negate (Finite   x    ) = Finite   (negate x)
+  signum (Infinite True ) =  1
+  signum (Infinite False) = -1
+  signum (Finite   x    ) = Finite (signum x)
+  abs    (Infinite _    ) = Infinite True
+  abs    (Finite   x    ) = Finite (abs x)
+  fromInteger x           = Finite (fromInteger x)
+  
+fin :: a -> Inf a 
+fin = Finite
+
+inf :: Inf a
+inf = Infinite True
+ Kram.hs view
@@ -0,0 +1,125 @@+
+----------
+-- Kram --
+----------
+
+module Kram (Kram, kram) where
+
+import Game
+import Array
+import Graphics.UI.WX     hiding (border)
+import Graphics.UI.WXCore
+import Tools
+
+data Kram = Kram (Array (Int, Int) (Either Player Bool)) deriving (Eq, Show)
+
+kram :: Kram
+kram = undefined
+
+instance Game Kram where
+
+  name _ = "kram"
+
+  standard _ = Properties { players = 2, boardsize = 5, human = [True, False] }
+
+  possible _ = PropertyRange { playersrange = [2], boardsizerange = [4 .. 7] }
+  
+  new pr = let s = boardsize pr
+           in Kram $ array ((0, 0), (s - 1, s - 1)) [((x, y), Right False) | x <- [0 .. s - 1], y <- [0 .. s - 1]]
+  
+  moves pr p (Kram s) = map (move $ boardsize pr) (allMoves (boardsize pr) p s)
+
+  showmove pr p (Kram s) i = case allMoves (boardsize pr) p s !! i
+                             of Nothing -> "skip turn"
+                                Just (x, y) -> sm (x, y) ++ ":" ++ case p
+                                                                   of 0 -> sm (x + 1, y)
+                                                                      1 -> sm (x, y + 1)
+                                                                      _ -> "error"
+    where
+      sm :: (Int, Int) -> String
+      sm (x, y) = "abcdefghij" !! x : show (boardsize pr - y)
+  
+  value pr p (Kram s) 
+    | null $ moves pr p (Kram s) = (\i -> [i, -i]) $ (fromInteger . toInteger) $ signum $ count $ elems s
+    | otherwise = (\i -> let f = (fromInteger . toInteger) i / (fromInteger . toInteger) (sqr $ boardsize pr) in [f, -f]) $ open + count (elems s)
+    where
+      open :: Int
+      open = length (moves pr 0 (Kram s)) - length (moves pr 1 (Kram s))
+      count :: [Either Player Bool] -> Int
+      count []             =  0
+      count (Right _ : fs) =      count fs
+      count (Left 0  : fs) =  1 + count fs
+      count (Left 1  : fs) = -1 + count fs
+
+  board p pr vart ia move = do
+
+    marble <- bitmapCreateLoad "images\\marble.bmp" wxBITMAP_TYPE_ANY
+    varg <- varCreate $ grate rectZero 0 (0, 0) sizeZero
+
+    let 
+    
+      onpaint :: DC () -> Rect -> IO ()
+      onpaint dc r = do
+        t <- varGet vart
+        let Kram st = state t
+            bsz     = boardsize pr
+        b <- border dc (bsz, bsz)
+        let g       = grate r b (bsz, bsz) (Size 1 1)
+        varSet varg g
+        tileBitmap dc r marble
+        for 0 (bsz - 1) (\i -> do
+          drawTextRect dc [['A' ..] !! i]  $ edge g (i,  -1)
+          drawTextRect dc [['A' ..] !! i]  $ edge g (i, bsz)
+          drawTextRect dc (show (bsz - i)) $ edge g ( -1, i)
+          drawTextRect dc (show (bsz - i)) $ edge g (bsz, i)
+          )
+        drawGrate dc g [brushKind := BrushTransparent]
+        for 0 (bsz - 1) (\i -> for 0 (bsz - 1) (\j ->
+          case st ! (i, j) of Left p  -> drawPiece p dc (field g (i, j))
+                              Right _ -> return ()
+          ))
+        if human pr !! player t && allMoves (boardsize pr) (player t) st == [Nothing]
+          then wait p 1 $ do
+            when ia $ infoDialog p "You can't move!" "You have to skip this turn, since there are no possible moves."
+            move 0
+          else return ()
+
+      onclick :: Point -> IO ()
+      onclick pt = do 
+        t <- varGet vart
+        g <- varGet varg
+        let Kram st = state t
+            n       = Just $ locate g pt
+        case lookup n $ zip (allMoves (boardsize pr) (player t) st) [0..] of
+          Nothing -> return ()
+          Just  i -> move i
+
+    set p [ on click    := onclick
+          , on paint    := onpaint
+          , on resize  ::= repaint
+          ]
+
+drawPiece :: Player -> DC () -> Rect -> IO ()
+drawPiece 0 dc (Rect x y w h) = do
+  set dc [brushColor := rgb 96 16 255 ]
+  drawRect dc (Rect (x + w `div` 10) (y + h `div` 10) (2 * w - w `div` 5) (h - h `div` 5)) []
+drawPiece 1 dc (Rect x y w h) = do
+  set dc [brushColor := rgb 192 64 16 ]
+  drawRect dc (Rect (x + w `div` 10) (y + h `div` 10) (w - w `div` 5) (2 * h - h `div` 5)) []
+
+allMoves :: Int -> Player -> Array (Int, Int) (Either Player Bool) -> [Maybe (Int, Int)]
+allMoves bsz p s 
+  | (null $ valid p s) && (not $ null $ valid (1 - p) s) = [Nothing]
+  | otherwise                                            = map Just $ valid p s
+  where
+    valid :: Player -> Array (Int, Int) (Either Player Bool) -> [(Int, Int)]
+    valid p s = filter mag $ indices s
+      where
+        mag :: (Int, Int) -> Bool
+        mag (x, y) | p == 0 = x < bsz - 1 && s ! (x, y) == Right False && s ! (x + 1, y) == Right False 
+        mag (x, y) | p == 1 = y < bsz - 1 && s ! (x, y) == Right False && s ! (x, y + 1) == Right False 
+
+move :: Int -> Maybe (Int, Int) -> (Player, Kram) -> (Player, Kram)
+move bsz (Just (x, y)) (0, Kram s) = (1, Kram $ s // [((x, y), Left 0), ((x + 1, y), Right True)])
+move bsz (Just (x, y)) (1, Kram s) = (0, Kram $ s // [((x, y), Left 1), ((x, y + 1), Right True)])
+move _ Nothing (p, ks) = (1 - p, ks)
+ LICENSE.txt view
@@ -0,0 +1,24 @@+Copyright (c) 2003, 2004 Maarten Löffler
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. The name of the author may not be used to endorse or promote products
+   derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Main.hs view
@@ -0,0 +1,44 @@+
+----------
+-- MAIN --
+----------
+
+module Main where
+
+import Game
+import Graphics.UI.WX
+import GUI
+
+import Ataxx
+import Bamp
+import Halma
+import Hex
+import Kram
+import Nim
+import Reversi
+import TicTacToe
+import Zenix
+
+import System.Directory   (setCurrentDirectory)
+import Paths_GeBoP        (getDataDir)
+
+games :: [GeneralGame]
+games = [ Game ataxx
+        , Game bamp
+        , Game halma
+        , Game hex
+        , Game kram
+        , Game nim
+        , Game reversi
+        , Game tictactoe
+        , Game zenix
+        ]
+
+main :: IO ()
+main =
+  getDataDir          >>=
+  setCurrentDirectory >> 
+  start (gui games)
+
+exit :: IO ()
+exit = putStrLn "When will you learn you have to use :q?"
+ Nim.hs view
@@ -0,0 +1,79 @@+
+---------
+-- NIM --
+---------
+
+module Nim (Nim, nim) where
+
+import Game
+import Graphics.UI.WX
+import Graphics.UI.WXCore
+import Tools
+
+data Nim = Nim Int deriving (Show, Eq)
+
+nim :: Nim
+nim = undefined
+
+instance Game Nim where
+
+  name _ = "nim"
+
+  standard _ = Properties { players = 2, boardsize = 21, human = [True, False, False] }
+  
+  possible _ = PropertyRange { playersrange = [2, 3], boardsizerange = [1 .. 100] }
+  
+  new pr = Nim $ boardsize pr
+  
+  moves pr _ (Nim n) = map (move pr) $ filter (<= n) [1 .. 3]
+
+  showmove _ _ _ i = numberword (i + 1)
+
+  value pr p (Nim n)
+    | n == 0    = (prev p |> 1) $ replicate (players pr) (negate 1)
+    | otherwise = replicate (players pr) 0
+    where 
+      prev :: Player -> Player
+      prev p = (p - 1) `mod` players pr
+
+  board p pr vart _ move = do
+
+    st <- staticText p [ text := "There are currently quite a number of rods.\n" ]
+    b1 <- button p []
+    b2 <- button p []
+    b3 <- button p []
+
+    let 
+
+      onpaint dc r = do
+        t <- varGet vart
+        let Nim n = state t
+        set st [ text := "There are currently " ++ numberword n ++ " rods.\n"
+                      ++ "How many will you take away?" ]
+
+    set b1 [ text := "one rod"   , on command := move 0 ]
+    set b2 [ text := "two rods"  , on command := move 1 ]
+    set b3 [ text := "three rods", on command := move 2 ]
+
+    set p [ layout   := floatCentre $ column 4 [ centre $ widget st
+                                               , row 4 [widget b1, widget b2, widget b3] 
+                                               ]
+          , on paint := onpaint
+          ]
+          
+    return ()
+
+dist :: Int -> Int -> Int
+dist x y = let i = x * x + y * y
+               f = fromInteger $ toInteger i
+               s = sqrt f
+           in floor s
+
+drawButton :: Int -> DC () -> Rect -> IO ()
+drawButton n dc (Rect x y w h) =
+  do circle dc (pt (x + w `div` 2) (y + h `div` 2)) (min w h `div` 2) [brushKind := BrushTransparent]
+     let t = w `div` (n + 1)
+     for 1 n (\i -> line dc (pt (x + i * t) (y + h `div` 5)) (pt (x + i * t) (y + h - h `div` 5)) [])
+
+move :: Properties -> Int -> (Player, Nim) -> (Player, Nim)
+move pr n (p, Nim m) = ((p + 1) `mod` players pr, Nim (m - n))
+ Reversi.hs view
@@ -0,0 +1,146 @@+
+-------------
+-- Reversi --
+-------------
+
+module Reversi (Reversi, reversi) where
+
+import Game
+import Array
+-- import Graphics.UI.WX
+import Graphics.UI.WX     hiding (border)
+import Graphics.UI.WXCore
+import Tools
+
+data Reversi = Reversi (Array (Int, Int) (Maybe Player)) deriving (Eq, Show)
+
+reversi :: Reversi
+reversi = undefined
+
+instance Game Reversi where
+
+  name _ = "reversi"
+
+  standard _ = Properties { players = 2, boardsize = 8, human = [True, False] }
+
+  possible _ = PropertyRange { playersrange = [2], boardsizerange = [6, 8, 10] }
+
+  new pr = let s = boardsize pr
+               h = s `div` 2
+           in Reversi $ array ((0, 0), (s - 1, s - 1))
+              [((x, y), Nothing) | x <- [0 .. s - 1], y <- [0 .. s - 1]]
+              // [ ((h - 1, h - 1), Just 0)
+                 , ((h    , h - 1), Just 1)
+                 , ((h - 1, h    ), Just 1)
+                 , ((h    , h    ), Just 0)
+                 ]
+  
+  moves pr p (Reversi s) = map (move $ boardsize pr) (allMoves (boardsize pr) p s)
+
+  showmove pr p (Reversi s) i = case allMoves (boardsize pr) p s !! i
+                                of Nothing -> "skip turn"
+                                   Just (x, y) -> "abcdefghij" !! x : show (boardsize pr - y)
+  
+  value pr p (Reversi s) 
+    | null $ moves pr p (Reversi s) = (\i -> [i, -i]) $ (fromInteger . toInteger) $ signum $ count $ elems s
+    | otherwise = (\i -> let f = (fromInteger . toInteger) i / (fromInteger . toInteger) (sqr $ boardsize pr) in [f, -f]) $ count $ elems s
+    where
+      count :: [Maybe Player] -> Int
+      count []             =  0
+      count (Nothing : fs) =      count fs
+      count (Just 0  : fs) =  1 + count fs
+      count (Just 1  : fs) = -1 + count fs
+
+  board p pr vart ia move = do
+
+    marble <- bitmapCreateLoad "images\\marble.bmp" wxBITMAP_TYPE_ANY
+    varg <- varCreate $ grate rectZero 0 (0, 0) sizeZero
+
+    let 
+    
+      onpaint :: DC () -> Rect -> IO ()
+      onpaint dc r = do
+        t <- varGet vart
+        let Reversi st = state t
+            bsz        = boardsize pr
+        b <- border dc (bsz, bsz)
+        let g = grate r b (bsz, bsz) (Size 1 1)
+        varSet varg g
+        tileBitmap dc r marble
+        for 0 (bsz - 1) (\i -> do
+          drawTextRect dc [['A' ..] !! i]  $ edge g (i,  -1)
+          drawTextRect dc [['A' ..] !! i]  $ edge g (i, bsz)
+          drawTextRect dc (show (bsz - i)) $ edge g ( -1, i)
+          drawTextRect dc (show (bsz - i)) $ edge g (bsz, i)
+          )
+        drawGrate dc g [brushKind := BrushTransparent]
+        for 0 (bsz - 1) (\i -> for 0 (bsz - 1) (\j ->
+          case st ! (i, j) of Just p  -> drawPiece p dc $ field g (i, j)
+                              Nothing -> return ()
+          ))
+        if human pr !! player t && allMoves (boardsize pr) (player t) st == [Nothing]
+          then wait p 1 $ do
+            when ia $ infoDialog p "You can't move!" "You have to skip this turn, since there are no possible moves."
+            move 0
+          else return ()
+
+      onclick :: Point -> IO ()
+      onclick pt = do 
+        t <- varGet vart
+        g <- varGet varg
+        let Reversi st = state t
+            n          = Just $ locate g pt
+        case lookup n $ zip (allMoves (boardsize pr) (player t) st) [0..] of
+          Nothing -> return ()
+          Just  i -> move i
+
+    set p [ on click    := onclick
+          , on paint    := onpaint
+          , on resize  ::= repaint
+          ]
+
+drawPiece :: Player -> DC () -> Rect -> IO ()
+drawPiece p dc (Rect x y w h) = do
+  case p of 0 -> set dc [brushColor := rgb 96 16 255 ]
+            1 -> set dc [brushColor := rgb 192 64 16 ]
+            _ -> set dc [brushColor := white]
+  circle dc (pt (x + w `div` 2) (y + h `div` 2)) (2 * (min w h) `div` 5) []
+
+(+-) :: Num a => (a, a) -> (a, a) -> (a, a)
+(a, b) +- (c, d) = (a + c, b + d)
+
+allMoves :: Int -> Player -> Array (Int, Int) (Maybe Player) -> [Maybe (Int, Int)]
+allMoves bsz p s 
+  | (null $ valid p s) && (not $ null $ valid (1 - p) s) = [Nothing]
+  | otherwise                                              = map Just $ valid p s
+  where
+    valid :: Player -> Array (Int, Int) (Maybe Player) -> [(Int, Int)]
+    valid p s = filter (\xy -> or $ map (scan xy) dirs) . filter ((== Nothing) . (s !)) $ indices s 
+      where
+        dirs :: [(Int, Int)]
+        dirs = [(x, y) | x <- [-1 .. 1], y <- [-1 .. 1]]
+        scan  :: (Int, Int) -> (Int, Int) -> Bool
+        scan  xy dxy =  check (xy +- dxy) (Just $ 1 - p) && scan1 (xy +- dxy) dxy
+        scan1 :: (Int, Int) -> (Int, Int) -> Bool
+        scan1 xy dxy =  check (xy +- dxy) (Just       p)
+                    || (check (xy +- dxy) (Just $ 1 - p) && scan1 (xy +- dxy) dxy)
+        check :: (Int, Int) -> Maybe Player -> Bool
+        check m f | not $ inRange (bounds s) m = False
+                  | otherwise                  = s ! m == f
+
+move :: Int -> Maybe (Int, Int) -> (Player, Reversi) -> (Player, Reversi)
+move bsz (Just m) (p, Reversi s) = (1 - p, Reversi $ s // ((m, Just p) : concatMap (scan m) dirs))
+  where
+    dirs :: [(Int, Int)]
+    dirs = [(x, y) | x <- [-1 .. 1], y <- [-1 .. 1]]
+    scan  :: (Int, Int) -> (Int, Int) -> [((Int, Int), Maybe Player)]
+    scan  xy dxy | check (xy +- dxy) (Just $ 1 - p) = scan1 (xy +- dxy) dxy [(xy +- dxy, Just p)]
+                 | otherwise                          = []
+    scan1 :: (Int, Int) -> (Int, Int) -> [((Int, Int), Maybe Player)] -> [((Int, Int), Maybe Player)]
+    scan1 xy dxy cs | check (xy +- dxy) (Just       p) = cs
+                    | check (xy +- dxy) (Just $ 1 - p) = scan1 (xy +- dxy) dxy $ (xy +- dxy, Just p) : cs
+                    | otherwise                          = []
+    check :: (Int, Int) -> Maybe Player -> Bool
+    check m f | not $ inRange (bounds s) m = False
+              | otherwise                  = s ! m == f
+move _ Nothing (p, rs) = (1 - p, rs)
+ Setup.lhs view
@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMainWithHooks simpleUserHooks
+
+ TicTacToe.hs view
@@ -0,0 +1,113 @@+
+---------------
+-- TicTacToe --
+---------------
+
+module TicTacToe (TicTacToe, tictactoe) where
+
+import Game
+import Graphics.UI.WX hiding (border)
+import Graphics.UI.WXCore
+import Tools
+
+data TicTacToe = TicTacToe [Maybe Player] deriving (Eq, Show)
+
+tictactoe :: TicTacToe
+tictactoe = undefined
+
+instance Game TicTacToe where
+
+  name _ = "tictactoe"
+{-
+rules _ =    "Tictactoe"
+          ++ "\n"
+          ++ "\nTictactoe is played on a 3x3 board."
+          ++ "\nTwo players put their pieces in empty squares in turns."
+          ++ "\nThe first player to make a row of three pieces wins."
+  information _ =    "Tictactoe is one of the easiest and best known strategic boardgames"
+                ++ "\nin the world. You will probably find it in every book or program on"
+                ++ "\ngame theory, and this one is no exception."
+-}
+  standard _ = Properties { players = 2, boardsize = 3, human = [True, False] }
+
+  possible _ = PropertyRange { playersrange = [2], boardsizerange = [3] }
+  
+  new p = TicTacToe $ replicate 9 Nothing
+  
+  moves _ _ (TicTacToe s)
+    | any (\p -> any (tttwinning p s) tttrows) [0, 1] = []
+    | otherwise                                       = map (move . snd) $ possiblemoves s
+
+  showmove pr p (TicTacToe s) i = let j = snd (possiblemoves s !! i)
+                                  in ["abc" !! (j `mod` 3), "321" !! (j `div` 3)]
+
+  value _ _ (TicTacToe s) | any (tttwinning 0 s) tttrows = [ 1, -1]
+                          | any (tttwinning 1 s) tttrows = [-1,  1]
+                          | otherwise                    = [ 0,  0]
+
+  board p pr vart ia move = do
+
+    marble <- bitmapCreateLoad "images\\marble.bmp" wxBITMAP_TYPE_ANY
+    varg <- varCreate $ grate rectZero 0 (0, 0) sizeZero
+
+    let 
+
+      onpaint :: DC () -> Rect -> IO ()
+      onpaint dc r = do
+        t <- varGet vart
+        let TicTacToe st = state t
+        b <- border dc (3, 3)
+        let g = grate r b (3, 3) (Size 1 1)
+        varSet varg g
+        tileBitmap dc r marble
+        for 0 2 (\i -> do
+          drawTextRect dc ["ABC" !! i]   $ edge g (i, -1)
+          drawTextRect dc ["ABC" !! i]   $ edge g (i,  3)
+          drawTextRect dc (show (3 - i)) $ edge g (-1, i)
+          drawTextRect dc (show (3 - i)) $ edge g ( 3, i)
+          )
+        drawGrate dc g [brushKind := BrushTransparent]
+        for 0 2 (\i -> for 0 2 (\j ->
+          case st !! (i + 3 * j) of Just 0  -> drawCross  dc $ field g (i, j)
+                                    Just 1  -> drawCircle dc $ field g (i, j)
+                                    Nothing -> return ()
+          ))
+         
+      onclick :: Point -> IO ()
+      onclick pt = do 
+        t <- varGet vart
+        g <- varGet varg
+        let TicTacToe st = state t
+            (i, j)       = locate g pt
+            n | i < 0 || i >= 3 || j < 0 || j >= 3 = -1
+              | otherwise = (i + 3 * j)
+        case lookup n (zip (map snd $ possiblemoves st) [0..]) of
+          Nothing -> return ()
+          Just n  -> move n
+
+    set p [ on click := onclick
+          , on paint := onpaint
+          ]
+          
+    return ()
+
+possiblemoves :: [Maybe Player] -> [(Maybe Player, Int)]
+possiblemoves st = filter ((== Nothing) . fst) $ zip st [0 .. 8]
+
+drawCross :: DC () -> Rect -> IO ()
+drawCross dc (Rect x y w h) =
+  do line dc (pt (x + w `div` 10) (y + h `div` 10)) (pt (x + w - w `div` 10) (y + h - h `div` 10)) [penColor := blue, penWidth := 2]
+     line dc (pt (x + w `div` 10) (y + h - h `div` 10)) (pt (x + w - w `div` 10) (y + h `div` 10)) [penColor := blue, penWidth := 2]
+
+drawCircle :: DC () -> Rect -> IO ()
+drawCircle dc (Rect x y w h) =
+  do circle dc (pt (x + w `div` 2) (y + h `div` 2)) (2 * (min w h) `div` 5) [penColor := red, penWidth := 2, brushKind := BrushTransparent]
+
+move :: Int -> (Player, TicTacToe) -> (Player, TicTacToe)
+move n (p, TicTacToe s) = (1 - p, TicTacToe $ (n |> Just p) s)
+
+tttrows :: [[Int]]
+tttrows = [[0, 1, 2], [3, 4, 5], [6, 7, 8], [0, 3, 6], [1, 4, 7], [2, 5, 8], [0, 4, 8], [2, 4, 6]]
+
+tttwinning :: Player -> [Maybe Player] -> [Int] -> Bool
+tttwinning p s is = all (== Just p) $ map (s !!) is
+ Tools.hs view
@@ -0,0 +1,218 @@+
+-----------
+-- Tools --
+-----------
+
+module Tools 
+  ( module HSL
+  , module Inf
+  , module Tools
+  ) where
+
+import Random
+import List
+
+import Graphics.UI.WX
+import Graphics.UI.WXCore
+
+import HSL
+import Inf
+
+-- list functions --
+
+maximumWith, minimumWith :: (a -> a -> Ordering) -> [a] -> [a]
+maximumWith p []       = []
+maximumWith p (x : xs) = case maximumWith p xs
+                         of []       -> [x]
+                            (y : ys) -> case p x y
+                                        of GT -> x :     []
+                                           EQ -> x : y : ys
+                                           LT ->     y : ys
+minimumWith = maximumWith . flip
+
+(|>) :: Int -> a -> [a] -> [a]
+(|>) 0 y (x : xs) = y : xs
+(|>) n y (x : xs) = x : (|>) (n - 1) y xs
+(|>) _ _ _        = error "(|>): index out of bounds"
+
+(!!!) :: Show a => [a] -> Int -> a
+es !!! i | i < 0 || i >= length es = error $ show i ++ " !!! " ++ show es
+         | otherwise               = es !! i
+
+sepWith :: [a] -> [[a]] -> [a]
+sepWith _ []         = []
+sepWith _ [as]       = as
+sepWith s (as : ass) = as ++ s ++ sepWith s ass
+
+zipWithn :: ([a] -> b) -> [[a]] -> [b]
+zipWithn f = map f . transpose
+
+randomList :: IO [Int]
+randomList = do i <- randomIO
+                let g = mkStdGen i
+                return $ randoms g
+
+randomElement :: [a] -> IO a
+randomElement [] = error "randomElement: empty list"
+randomElement xs = do i <- randomRIO (0, length xs - 1)
+                      return $ xs !! i
+
+-- io functions --
+
+for :: Int -> Int -> (Int -> IO ()) -> IO ()
+for x y f = sequence_ $ map f [x..y]
+
+ifIO :: (IO Bool) -> IO () -> IO ()
+ifIO iob io = do b <- iob
+                 if b then io else return ()
+
+varCopy :: Var a -> IO (Var a)
+varCopy = flip (>>=) varCreate . varGet
+
+-- other --
+
+numberword :: Int -> String
+numberword x | x < 0 = "minus " ++ numberword (negate x)
+numberword  0 = "zero"
+numberword  1 = "one"
+numberword  2 = "two"
+numberword  3 = "three"
+numberword  4 = "four"
+numberword  5 = "five"
+numberword  6 = "six"
+numberword  7 = "seven"
+numberword  8 = "eight"
+numberword  9 = "nine"
+numberword 10 = "ten"
+numberword 11 = "eleven"
+numberword 12 = "twelve"
+numberword 13 = "thirteen"
+numberword 15 = "fifteen"
+numberword 18 = "eighteen"
+numberword x | x < 20 = numberword (x - 10) ++ "teen"
+numberword 20 = "twenty"
+numberword 30 = "thirty"
+numberword 40 = "forty"
+numberword 50 = "fifty"
+numberword 80 = "eighty"
+numberword x |           x < 10 ^  2 = largenumber 1 "ty"        "-" x
+             |           x < 10 ^  3 = largenumber 2 " hundred"  " " x
+             |           x < 10 ^  6 = largenumber 3 " thousand" " " x
+             |           x < 10 ^  9 = largenumber 6 " million"  " " x
+             | toInteger x < 10 ^ 12 = largenumber 9 " billion"  " " x
+  where
+    largenumber :: Int -> String -> String -> Int -> String
+    largenumber q s t x
+      | x `mod` (10 ^ q) == 0 = numberword (x `div` (10 ^ q)) ++ s
+      | otherwise = numberword (x - x `mod` (10 ^ q)) ++ t ++ numberword (x `mod` (10 ^ q))
+numberword _ = "unknown number"
+
+sqr :: Int -> Int
+sqr x = x * x
+
+average :: [Float] -> Float
+average xs = sum xs / (fromInteger . toInteger) (length xs)
+
+-- wx functions --
+
+type Wire = Graphics.UI.WX.Timer
+
+wire :: Window a -> [Prop Wire] -> IO Wire
+wire f ps = do w <- timer f ps
+               timerStop w
+               return w
+
+send :: Wire -> IO ()
+send w = do timerStart w 1 True
+            return ()
+
+wait :: Window a -> Int -> IO () -> IO ()
+wait w n action = do
+  t <- timer w []
+  set t [interval := n, on command := set t [enabled := False] >> action]
+  
+
+cut :: Ord a => (a, a) -> a -> a
+cut (l, u) x 
+  | x < l     = l
+  | x > u     = u
+  | otherwise = x
+
+
+tileBitmap :: DC () -> Rect -> Bitmap () -> IO ()
+tileBitmap dc (Rect x y w h) bmp = do
+  bw <- bitmapGetWidth  bmp
+  bh <- bitmapGetHeight bmp
+  for 0 (w `div` bw) (\i ->
+    for 0 (h `div` bh) (\j ->
+      drawBitmap dc bmp (pt (i * bw) (j * bh)) False []))
+
+-- grates -- 
+
+data Grate = Grate Rect (Int, Int) Int
+
+grate :: Rect -> Int -> (Int, Int) -> Size -> Grate
+grate (Rect x y w h) b (m, n) (Size u v) =
+  grate_ (Rect (x + b) (y + b) (w - 2 * b) (h - 2 * b))
+  where
+    grate_ :: Rect -> Grate
+    grate_ (Rect x y w h) =
+      let t = min (w * n * v) (h * m * u)
+          w_ = t `div` (n * v)
+          h_ = t `div` (m * u)
+          x_ = (x + (w - w_) `div` 2)
+          y_ = (y + (h - h_) `div` 2) 
+      in Grate (Rect x_ y_ w_ h_) (m, n) b
+
+
+field :: Grate -> (Int, Int) -> Rect
+field (Grate (Rect x y w h) (m, n) _) (i, j) =
+  let fx, fy :: Int -> Int
+      fx i = x + i * w `div` m
+      fy j = y + j * h `div` n
+  in Rect (fx i) (fy j) (fx (i + 1) - fx i) (fy (j + 1) - fy j)
+
+locate :: Grate -> Point -> (Int, Int)
+locate (Grate (Rect x y w h) (m, n) _) (Point px py) =
+  ((px - x) * m `div` w, (py - y) * n `div` h)
+
+drawGrate :: DC () -> Grate -> [Prop (DC ())] -> IO ()
+drawGrate dc g@(Grate _ (m, n) _) options =
+  for 0 (m - 1) (\i -> for 0 (n - 1) (\j ->
+    drawRect dc (field g (i, j)) options
+                )                    )
+                
+edge :: Grate -> (Int, Int) -> Rect
+edge g@(Grate _ (m, n) b) (i, j) =
+  let Rect x y w h = field g (i, j)
+      x_ | i == -1   = x + w - b
+         | otherwise = x
+      y_ | j == -1   = y + h - b
+         | otherwise = y
+      w_ | i < 0 || i >= m = b
+         | otherwise       = w
+      h_ | j < 0 || j >= n = b
+         | otherwise       = h
+  in Rect x_ y_ w_ h_
+  
+drawTextRect :: DC () -> String -> Rect -> IO ()
+drawTextRect dc s (Rect x y w h) = do
+  Size u v <- getTextExtent dc s
+  drawText dc s (pt (x + (w - u) `div` 2) (y + (h - v) `div` 2)) []
+    
+border :: DC () -> (Int, Int) -> IO Int
+border dc (m, n) = do
+  let ms = map show [1 .. m]
+      ns = map (:[]) $ take n ['A' ..]
+  hs <- sequence $ map (getTextExtent dc) ms
+  ws <- sequence $ map (getTextExtent dc) ns
+  return $ maximum (map sizeH hs ++ map sizeW ws)
+  
+bounding :: Rect -> Rect -> Rect
+bounding (Rect x y w h) (Rect x_ y_ w_ h_) =
+  let r = x + w; r_ = x_ + w_
+      b = y + h; b_ = y_ + h_
+  in rectBetween (pt (min x x_) (min y y_)) (pt (max r r_) (max b b_))
+
+(|#|) :: Rect -> Rect -> Rect
+(|#|) = bounding
+ Zenix.hs view
@@ -0,0 +1,191 @@+
+
+{-{ http://en2.wikipedia.org/wiki/Zenix_(game) }-}
+
+
+-----------
+-- Zenix --
+-----------
+
+module Zenix (Zenix, zenix) where
+
+import Game
+import Array
+import Graphics.UI.WX     hiding (border)
+import Graphics.UI.WXCore
+import Tools
+
+data Zenix = Zenix (Array (Int, Int) (Maybe Player)) deriving (Eq, Show)
+
+type ZenixMove = (Int, Int)
+
+zenix :: Zenix
+zenix = undefined
+
+instance Game Zenix where
+
+  name _ = "zenix"
+
+  standard _ = Properties    { players = 2, boardsize = 8, human = [True, False, False] }
+  possible _ = PropertyRange { playersrange = [2, 3], boardsizerange = [4 .. 12] }
+
+  new pr = let bsz = boardsize pr
+           in Zenix $ array ((0, 0), (bsz - 1, bsz - 1)) [((x, y), Nothing) | x <- [0 .. bsz - 1], y <- [0 .. bsz - 1]]
+  
+  moves pr p (Zenix st) = map (move pr) (allMoves pr p st)
+
+  showmove pr p (Zenix s) i = case allMoves pr p s !! i
+                            of (x, y) -> ['a' ..] !! x : show (1 + y)
+
+  value pr p (Zenix st) 
+    | null $ allMoves pr p st = let winners = map fst $ filter (\(i, c) -> c == maximum chains) $ zip [0 ..] chains
+                                in  foldr ($) (replicate (players pr) (-1)) $ map (|> 1) winners
+    | otherwise               = map myvalue [0 .. players pr - 1]
+   where
+    bsz = boardsize pr
+    chains :: [Int]
+    chains = map (\p -> scan p bsz []) [0 .. players pr - 1]
+    myvalue :: Player -> Float
+    myvalue p = let t = fromInteger . toInteger $ (players pr) * (chains !! p) - sum chains
+                    n = fromInteger . toInteger $ 2 * bsz
+                in t / n
+    scan :: Player -> Int -> [Int] -> Int
+    scan p y _ | y >= bsz = scan p (bsz - 1) [0 .. bsz]
+    scan p y [] = bsz - y
+    scan p y xs = scan p (y - 1) $ filter good [0 .. y]
+     where
+      good :: Int -> Bool
+      good x = st ! (x, y) == Just p
+            && (x `elem` xs || (x + 1) `elem` xs)
+
+  board p pr vart ia move = do
+
+    marble <- bitmapCreateLoad "images\\marble.bmp" wxBITMAP_TYPE_ANY
+    varg <- varCreate $ grate rectZero 0 (0, 0) sizeZero
+
+    let 
+
+      onpaint :: DC () -> Rect -> IO ()
+      onpaint dc r = do
+        t <- varGet vart
+        let Zenix st = state t
+            bsz = boardsize pr
+        b <- border dc (bsz, bsz)
+        let g = grate r b (2 * bsz, bsz) (Size 4 7)
+            radius = rectWidth (field g (0, 0))
+            lin' :: Rect -> Rect -> Color -> IO ()
+            lin' (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2) c = do
+              line dc (pt (x1 + w1 `div` 2) (y1 + h1)) (pt (x2 + w2 `div` 2) (y2 + h2)) [penWidth := 4, penColor := c]
+            lin :: (Int, Int) -> (Int, Int) -> Color -> IO ()
+            lin p q = lin' (field g $ tograte bsz p) (field g $ tograte bsz q)
+        varSet varg g
+        tileBitmap dc r marble
+--{        drawGrate dc g [penColor := yellow]
+        for 0 (bsz - 1) (\i -> do
+          drawTextRect dc [['A' ..] !! i] $ edge g (2 * i, bsz)
+          drawTextRect dc (show (i + 1))  $ field g (i - 1, bsz - i - 1)
+          )
+        for 0 (bsz - 1) (\i -> for 0 (bsz - 1) (\j ->
+          when (j - i >= 0) $ drawPiece dc (field g $ tograte bsz (i, j)) radius (st ! (i, j))
+          ))
+
+      onclick :: Point -> IO ()
+      onclick pt = do 
+        t <- varGet vart
+        g <- varGet varg
+        let Zenix st = state t
+            bsz = boardsize pr
+            n = fromgrate bsz $ locate g pt
+        case lookup n $ zip (allMoves pr (player t) st) [0..] of
+            Nothing -> return ()
+            Just  i -> move i
+
+    set p [ on click    := onclick
+          , on paint    := onpaint
+          , on resize  ::= repaint
+          ]
+
+    return ()
+
+drawPiece :: DC () -> Rect -> Int -> Maybe Player -> IO ()
+drawPiece dc (Rect x y w h) r mp = do
+  case mp of Just 0  -> circle dc (pt x (y + h `div` 2)) r [brushKind := BrushSolid, brushColor := blue ]
+             Just 1  -> circle dc (pt x (y + h `div` 2)) r [brushKind := BrushSolid, brushColor := red  ]
+             Just 2  -> circle dc (pt x (y + h `div` 2)) r [brushKind := BrushSolid, brushColor := green]
+             Nothing -> circle dc (pt x (y + h `div` 2)) r [brushKind := BrushTransparent]
+
+(+-) :: Num a => (a, a) -> (a, a) -> (a, a)
+(a, b) +- (c, d) = (a + c, b + d)
+
+allMoves :: Properties -> Player -> Array (Int, Int) (Maybe Player) -> [ZenixMove]
+allMoves pr p st 
+  | otherwise = filter free $ indices st
+ where
+  bsz = boardsize pr
+  free :: ZenixMove -> Bool
+  free (x, y) = y - x >= 0
+             && st ! (x, y) == Nothing
+             && (y == bsz - 1 || (st ! (x, y + 1) /= Nothing && st ! (x + 1, y + 1) /= Nothing))
+
+move :: Properties -> ZenixMove -> (Player, Zenix) -> (Player, Zenix)
+move pr place (p, Zenix s) = ( (p + 1) `mod` players pr
+                             , Zenix $ s // [(place, Just p)]
+                             )
+
+{-{
+win :: Array (Int, Int) (Maybe Player) -> Int -> Player -> Bool
+win st bsz 0 = any ((== bsz - 1) . snd) $ floodfill st 0 (zip [0 .. bsz - 1] [-1, -1 ..])
+win st bsz 1 = any ((== bsz - 1) . fst) $ floodfill st 1 (zip [-1, -1 ..] [0 .. bsz - 1])
+   
+floodfill :: Array (Int, Int) (Maybe Player) -> Player -> [(Int, Int)] -> [(Int, Int)]
+floodfill st p togo = floodfill_ p togo []
+ where
+  floodfill_ :: Player -> [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
+  floodfill_ p []         known = known
+  floodfill_ p (f : togo) known = let new  = filter (not . flip elem known) $ map (f +-) steps
+                                      good = filter (\f -> st ! f == Just p) $ filter (inRange (bounds st)) new
+                                  in floodfill_ p (togo ++ good) (known ++ good)
+
+steps :: [(Int, Int)]
+steps = [(1, 1), (1, 0), (0, -1), (-1, -1), (-1, 0), (0, 1)]
+
+jumps :: [((Int, Int), [(Int, Int)])]
+jumps = [ (( 2,  1), [( 1,  0), ( 1,  1)])
+        , (( 1,  2), [( 0,  1), ( 1,  1)])
+        , ((-1,  1), [( 0,  1), (-1,  0)])
+        , ((-2, -1), [(-1,  0), (-1, -1)])
+        , ((-1, -2), [( 0, -1), (-1, -1)])
+        , (( 1, -1), [( 1,  0), ( 0, -1)])
+        ]
+}-}
+
+tograte :: Int -> (Int, Int) -> (Int, Int)
+tograte bsz (i, j) = (bsz + 2 * i - j, j)
+
+fromgrate :: Int -> (Int, Int) -> (Int, Int)
+fromgrate bsz (i, j) = ((i + j - bsz + 1) `div` 2, j)
+
+{-
+i = s - 1 + x - y
+j = 2s - 2 - x - y
+
+i + j = 3s - 3 - 2y
+2y = 3s - 3 - i - j
+y = (...) / 2
+
+i - j = -s + 1 + 2x
+2x = s - 1 + i - j
+-}
+
+
+{- the zenixboard internally look like this:
+
+0      *
+1     * *
+2    * * *
+3   * * * *
+4  * * * * *
+5 * * * * * *
+ 0 1 2 3 4 5
+ 
+-}
+ brain.ico view

binary file changed (absent → 5694 bytes)

+ gebop.ico view

binary file changed (absent → 5694 bytes)

+ help/brain.html view
@@ -0,0 +1,33 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> The Brain Viewer </H2>
+
+    GeBoP features a brain viewer which enables you to explore the computer's internal game tree. To open the brain viewer, first start a game. Next, select 'Open' in the 'Brain' menu. You can open a seperate brain viewer for each open game. <BR>
+
+    <BR>
+
+    The brain viewer consists of two components. To the left, there is a tree view. To the right, there is a situation panel. In the tree view, you can browse the game tree. The situation panel will show statistics about the currently selected situation in the tree view. <BR>
+
+    <BR>
+
+    At the start, there is only one item in the tree view, called 'current situation'. If you double click this item, a list will expand with all possible moves for the current player. Each item represents a new situation. In turn, you can expand these new items with a list with all possible moves for the next player in this new situation. <BR>
+
+    <BR>
+
+    Each item in the tree view has an icon which tells you which player would make the move in question. The best moves, based on the computer's current information, are displayed with a highlighted icon. Next to the icon is the move. This can be grey, black or bold. If it is grey, it means that it has not yet been seen by the computer. If it is black, it has been seen. If it is bold, it means that this situation has been completely computed, that every possible compination of moves from that point on has been seen. <BR>
+
+    <BR>
+
+    The situation panel on the right side of the brain viewer consists of three parts. The upper part shows an icon for the player who has to move in this situation. Next to it is a bar that shows the value of this situation. The middle part shows the complete depth, the maximum depth and the volume of this situation. The complete depth states how many sublevels of this situation have been completely computed. The maximim depth states the depth of the deepest sublevel that has been computed yet. The volume is the number of computed subsituations. Finally, the lower part consists of a graphical representation of the current situation, the way it looks in the normal game window. You can actually make moves in this part, this will result in selecting another situation in the tree view. <BR>
+
+    <BR>
+
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/gebop.bmp view

binary file changed (absent → 42294 bytes)

+ help/index.html view
@@ -0,0 +1,39 @@+<HTML>
+
+  <BODY>
+
+    <IMG SRC="gebop.bmp"> <BR>
+
+    <H2> Contents </H2>
+
+    Welcome to GeBoP, the General Boardgames Player. GeBoP currently has nine games.
+
+    <H2> Games </H2>
+
+    <B> Ataxx     &nbsp; </B> <A HREF="rules_ataxx.html"    > Rules </A> &nbsp; <A HREF="info_ataxx.html"    > Information </A>
+    <BR>
+    <B> Bamp      &nbsp; </B> <A HREF="rules_bamp.html"     > Rules </A> &nbsp; <A HREF="info_bamp.html"     > Information </A>
+    <BR>
+    <B> Halma     &nbsp; </B> <A HREF="rules_halma.html"    > Rules </A> &nbsp; <A HREF="info_halma.html"    > Information </A>
+    <BR>
+    <B> Hex       &nbsp; </B> <A HREF="rules_hex.html"      > Rules </A> &nbsp; <A HREF="info_hex.html"      > Information </A>
+    <BR>
+    <B> Kram      &nbsp; </B> <A HREF="rules_kram.html"     > Rules </A> &nbsp; <A HREF="info_kram.html"     > Information </A>
+    <BR>
+    <B> Nim       &nbsp; </B> <A HREF="rules_nim.html"      > Rules </A> &nbsp; <A HREF="info_nim.html"      > Information </A>
+    <BR>
+    <B> Reversi   &nbsp; </B> <A HREF="rules_reversi.html"  > Rules </A> &nbsp; <A HREF="info_reversi.html"  > Information </A>
+    <BR>
+    <B> Tictactoe &nbsp; </B> <A HREF="rules_tictactoe.html"> Rules </A> &nbsp; <A HREF="info_tictactoe.html"> Information </A>
+    <BR>
+    <B> Zenix     &nbsp; </B> <A HREF="rules_zenix.html"    > Rules </A> &nbsp; <A HREF="info_zenix.html"    > Information </A>
+
+    <H2> Components </H2>
+
+    The <A HREF="brain.html"> brain viewer </A>
+
+
+
+  </BODY>
+
+</HTML>
+ help/info_ataxx.html view
@@ -0,0 +1,21 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Ataxx Information </H2>
+
+    Ataxx is a game known by many names, including
+    Hexxagon, Chello, Backstab, and Splat.
+
+    The game is one of the subgames of the 7th guest.
+    There is also a variant of the game which uses
+    hexagons instead of squares.
+
+    <H3> <A HREF="rules_ataxx.html"> Ataxx Rules </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/info_bamp.html view
@@ -0,0 +1,20 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Bamp Information </H2>
+
+    This is a game I designed myself. GeBoP supports games where the order in which the players move depends on the moves, and is not fixed a priori. However, I could not find such a game anywhere... <BR>
+
+    <BR>
+
+    The reason might be that it is very difficult to plan a strategy in such a game, since you never know when you will be allowed to move again. Still, it is interesting to study this type of games.
+
+    <H3> <A HREF="rules_bamp.html"> Bamp Rules </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/info_halma.html view
@@ -0,0 +1,20 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Halma Information </H2>
+
+    Halma was originally played on a square board, with
+    two or four players. It was first played on the star
+    shaped board in Germany. Later it became well known
+    by the name of Chinese Checkers, which doesn't really
+    have any connection with China.
+
+    <H3> <A HREF="rules_halma.html"> Halma Rules </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/info_hex.html view
@@ -0,0 +1,16 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Hex Information </H2>
+
+    Hex was independently invented by Piet Hein and John Nash around 1940.
+
+    <H3> <A HREF="rules_hex.html"> Hex Rules </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/info_kram.html view
@@ -0,0 +1,16 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Kram Information </H2>
+
+    Kram, or Cram, is a simple strategic game that has been invented many times.
+
+    <H3> <A HREF="rules_kram.html"> Kram Rules </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/info_nim.html view
@@ -0,0 +1,16 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Nim Information </H2>
+
+    Nim is very well known as example game for game theory. There is an easy way to win the game if the starting number of rods is right. It becomes more interesting when there are more players, or more piles of rods (which isn't an option here).
+
+    <H3> <A HREF="rules_nim.html"> Nim Rules </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/info_reversi.html view
@@ -0,0 +1,18 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Reversi Information </H2>
+
+    Reversi was invented in England in 1888. In 1975 the game
+    was reïntroduced under the name Othello, with a minor change
+    of the rules.
+
+    <H3> <A HREF="rules_reversi.html"> Reversi Rules </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/info_tictactoe.html view
@@ -0,0 +1,18 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Tictactoe Information </H2>
+
+    Tictactoe is one of the easiest and best known strategic boardgames
+    in the world. You will probably find it in every book or program on
+    game theory, and this one is no exception.
+
+    <H3> <A HREF="rules_tictactoe.html"> Tictactoe Rules </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/info_zenix.html view
@@ -0,0 +1,14 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Zenix Information </H2>
+
+    <H3> <A HREF="rules_zenix.html"> Zenix Rules </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/rules_ataxx.html view
@@ -0,0 +1,16 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Ataxx Rules </H2>
+
+    The object is to have more pieces in your color than your oponent. To do this you can move your pieces around. You can either move a piece to an adjacent square, it will then create a copy of itself. Alternatively, you can move a piece two squares away. After moving your piece, all pieces adjacent to the destination square will turn your color. When you can't move you have to skip your turn. When you can move you have to move.
+
+    <H3> <A HREF="info_ataxx.html"> Ataxx Information </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/rules_bamp.html view
@@ -0,0 +1,20 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Bamp Rules </H2>
+
+    In Bamp, there is one ball, and a number of squares in four colors. The board is devided in four quadrants, each belonging to a player. When the ball is in your quadrant, you have to make a move. If you can't, you win. <BR>
+
+    <BR>
+
+    You make a move by selecting one of your square pieces that is in the same row or column as the ball. The piece will move to the position where the ball is, and the ball will move as far as possible in the same direction. If it ends up in another quadrant, another player moves.
+
+    <H3> <A HREF="info_bamp.html"> Bamp Information </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/rules_halma.html view
@@ -0,0 +1,20 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Halma Rules </H2>
+
+    The object of Halma is to be the first player to bring all your
+    pieces to the other end of the board.
+    You can move your pieces forward and sideward, but not backwards.
+    Instead of just moving, you can also jump over any number of
+    other pieces. Just point where you want to go.
+
+    <H3> <A HREF="info_halma.html"> Halma Information </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/rules_hex.html view
@@ -0,0 +1,20 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Hex Rules </H2>
+
+    The object of Hex is to connect two sides of the board together with
+    a chain of circles. The blue player should connect the two blue sides,
+    while the red player must try to connect the two red sides. A chain
+    consists of adjacent circles of the same color. One of the players must
+    eventually win, it is not possible to end this game in a draw.
+
+    <H3> <A HREF="info_hex.html"> Hex Information </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/rules_kram.html view
@@ -0,0 +1,21 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Kram Rules </H2>
+
+    In Kram, there are two players who must place rectangular pieces on the
+    board. One of the players may only place them horizontally, while the
+    other player must place the pieces vertically. Each piece is the size of
+    two squares on the board. The object of the game is to place more pieces
+    than your opponent. To place a piece, click on the square where you want
+    the left or upper half of your piece to be.
+
+    <H3> <A HREF="info_kram.html"> Kram Information </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/rules_nim.html view
@@ -0,0 +1,16 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Nim Rules </H2>
+
+    The rules for this game are very easy. Each player takes one, two or three rods. The player who takes the last rod wins.
+
+    <H3> <A HREF="info_nim.html"> Nim Information </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/rules_reversi.html view
@@ -0,0 +1,21 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Reversi Rules </H2>
+
+    The object of the game is to get more pieces in your color than the opponent.
+    Every move you put a piece onto the board, such that you surround a line of your opponents pieces.
+    The line can be horizontal, vertical, or diagonal.
+    After you put your piece onto the board, all od the surrounded piecs become your color.
+    If you can make no legal move, you must skip your turn.
+    If you can make a legal move, you may not skip your turn.
+
+    <H3> <A HREF="info_reversi.html"> Reversi Information </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/rules_tictactoe.html view
@@ -0,0 +1,18 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Tictactoe Rules </H2>
+
+    Tictactoe is played on a 3x3 board.
+    Two players put their pieces in empty squares in turns.
+    The first player to make a row of three pieces wins.
+
+    <H3> <A HREF="info_tictactoe.html"> Tictactoe Information </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ help/rules_zenix.html view
@@ -0,0 +1,20 @@+<HTML>
+
+  <BODY>
+
+    <A HREF="index.html"> <IMG SRC="gebop.bmp"> </A> <BR>
+
+    <H2> Zenix Rules </H2>
+
+    In Zenix, you have to make the highest connected chain of pieces in your color. Placing the pieces is subject to gravity, so you can only place a piece at the bottom or on top of two adjacent other pieces. <BR>
+
+    <BR>
+
+    A chain must always start at the bottom row, and go upward. The highest piece of your color that is connected with the bottom row, is the one that determines your score.
+
+    <H3> <A HREF="info_zenix.html"> Zenix Information </A> </H3>
+    <H3> <A HREF="index.html"> Index </A> </H3>
+
+  </BODY>
+
+</HTML>
+ images/blue.bmp view

binary file changed (absent → 4854 bytes)

+ images/blue_mask.bmp view

binary file changed (absent → 4854 bytes)

+ images/brain.bmp view

binary file changed (absent → 4854 bytes)

+ images/brain_mask.bmp view

binary file changed (absent → 4854 bytes)

+ images/brown.bmp view

binary file changed (absent → 4854 bytes)

+ images/brown_mask.bmp view

binary file changed (absent → 4854 bytes)

+ images/computer.bmp view

binary file changed (absent → 4854 bytes)

+ images/computer_mask.bmp view

binary file changed (absent → 4854 bytes)

+ images/empty.bmp view

binary file changed (absent → 382 bytes)

+ images/empty_mask.bmp view

binary file changed (absent → 382 bytes)

+ images/gebop.bmp view

binary file changed (absent → 40478 bytes)

+ images/green.bmp view

binary file changed (absent → 4854 bytes)

+ images/green_mask.bmp view

binary file changed (absent → 4854 bytes)

+ images/grey.bmp view

binary file changed (absent → 4854 bytes)

+ images/grey_mask.bmp view

binary file changed (absent → 4854 bytes)

+ images/high_blue.bmp view

binary file changed (absent → 4854 bytes)

+ images/high_brown.bmp view

binary file changed (absent → 4854 bytes)

+ images/high_green.bmp view

binary file changed (absent → 4854 bytes)

+ images/high_grey.bmp view

binary file changed (absent → 4854 bytes)

+ images/high_purple.bmp view

binary file changed (absent → 4854 bytes)

+ images/high_red.bmp view

binary file changed (absent → 4854 bytes)

+ images/high_small_blue.bmp view

binary file changed (absent → 374 bytes)

+ images/high_small_brown.bmp view

binary file changed (absent → 374 bytes)

+ images/high_small_green.bmp view

binary file changed (absent → 374 bytes)

+ images/high_small_grey.bmp view

binary file changed (absent → 374 bytes)

+ images/high_small_purple.bmp view

binary file changed (absent → 374 bytes)

+ images/high_small_red.bmp view

binary file changed (absent → 374 bytes)

+ images/human.bmp view

binary file changed (absent → 4854 bytes)

+ images/human_mask.bmp view

binary file changed (absent → 4854 bytes)

+ images/marble.bmp view

binary file changed (absent → 49590 bytes)

+ images/purple.bmp view

binary file changed (absent → 4854 bytes)

+ images/purple_mask.bmp view

binary file changed (absent → 4854 bytes)

+ images/red.bmp view

binary file changed (absent → 4854 bytes)

+ images/red_mask.bmp view

binary file changed (absent → 4854 bytes)

+ images/small_blue.bmp view

binary file changed (absent → 374 bytes)

+ images/small_blue_mask.bmp view

binary file changed (absent → 102 bytes)

+ images/small_brain.bmp view

binary file changed (absent → 374 bytes)

+ images/small_brain_mask.bmp view

binary file changed (absent → 374 bytes)

+ images/small_brown.bmp view

binary file changed (absent → 374 bytes)

+ images/small_brown_mask.bmp view

binary file changed (absent → 102 bytes)

+ images/small_green.bmp view

binary file changed (absent → 374 bytes)

+ images/small_green_mask.bmp view

binary file changed (absent → 102 bytes)

+ images/small_grey.bmp view

binary file changed (absent → 374 bytes)

+ images/small_grey_mask.bmp view

binary file changed (absent → 102 bytes)

+ images/small_purple.bmp view

binary file changed (absent → 374 bytes)

+ images/small_purple_mask.bmp view

binary file changed (absent → 102 bytes)

+ images/small_red.bmp view

binary file changed (absent → 374 bytes)

+ images/small_red_mask.bmp view

binary file changed (absent → 102 bytes)

+ images/turn.bmp view

binary file changed (absent → 4854 bytes)

+ images/turn_mask.bmp view

binary file changed (absent → 4854 bytes)

+ images/winner.bmp view

binary file changed (absent → 4854 bytes)

+ images/winner_mask.bmp view

binary file changed (absent → 4854 bytes)

+ readme.txt view
@@ -0,0 +1,55 @@+-----------------------
+-- GeBoP version 1.7 --
+-----------------------
+
+This is the readme.txt file that comes with the source code of GeBoP, version 1.7. This source consists of the following files:
+
+* 15 Haskell source code files
+*  2 Icon files
+*    This readme file
+* 52 Bitmap images in a directory called 'images'
+* 20 HTML files and a bitmap in a directory called 'help'
+
+------------------------------------
+-- meaning of the various modules --
+------------------------------------
+
+* Game
+GeBoP works with a class Game, which is defined in the module Game. This class describes the general properties a boardgame should have. The Game module also includes the concept of a game tree, and a general algorithm to traverse this tree in order to find sensible moves.
+
+* Ataxx, Bamp, Halma, Hez, Kram, Nim, Reversi, TicTacToe, and Zenix
+These are the implemented games. Each of these modules contains an instance of the Game class.
+
+* GUI
+GUI is the module that contains the GUI itself. 
+
+* Tools
+This module is just an unstructured bunch of functions I use in other modules :).
+
+* HSL
+This module implements the HSL color model.
+
+* Inf
+This module defines the set of integers including two extra values <+infinity> and <-infinity>
+
+* Main
+Main just imports the games and starts the GUI.
+
+--------------------------
+-- state of the program --
+--------------------------
+
+Version 1.7 of GeBoP is a nice and complete version. However, I could still do some work on the algorithms for playing the computer uses, and some of the games use rather naïve evaluation functions at the moment. I plan to do this some time in the near or otherwise far future.
+
+Since you are reading this file, you are probably a Haskell programmer. If you feel like implementing your favorite game for GeBoP, please go ahead and mail it to me when you're done :)
+
+--------
+-- me --
+--------
+
+My name is Maarten Löffler. I am currently a student at Utrecht University. 
+
+I wrote GeBoP in my free time, because I like games and I like Haskell. When wxHaskell came to be, it became even more fun because of the nice graphical effects :)
+
+website at www.students.cs.uu.nl/people/mloffler
+email   at mloffler@cs.uu.nl