diff --git a/GUI.hs b/GUI.hs --- a/GUI.hs +++ b/GUI.hs @@ -12,7 +12,7 @@ import Control.Monad import Data.Map (Map, (!)) import qualified Data.Map as Map -import LostCities +import LostCities hiding (dynamic) import Utils import List import Text.Printf @@ -22,26 +22,43 @@ -- setup the GUI -- toplevel function ------------------------------------------------------------- -gui = do sf <- statusField [text := "Welcome to Lost Cities"] - top <- frame [text := "Lost Cities", statusBar := [sf]] - - p1 <- panel top [] +gui = do top <- frame [text := "Lost Cities", on paint := dcClearRect] + + -- application menus + mainMenu <- menuPane [text := "&Game"] + menuQuit mainMenu [help := "Quit this program", + on command := close top] + + helpMenu <- menuHelp [] + rules <- menuItem helpMenu [text := "Rules", + help := "About the game rules", + on command := infoRules top] + about <- menuAbout helpMenu [help := "About this program", + on command := infoAbout top] + + -- status field + status <- statusField [text := "Welcome to Lost Cities"] + set top [statusBar := [status], menuBar := [mainMenu, helpMenu]] + + -- expedition and discard piles + p1 <- panel top [on paint := dcClearRect] exps1<- sequence [newExpedition p1 [owner := Computer] | c<-colors] exps2<- sequence [newExpedition p1 [owner := Human] | c<-colors] discards <- sequence [newDiscard p1 [] | c<-colors] deck <- newDeck p1 [enabled := False] - p2 <- panel top [] + -- player's hand and buttons + p2 <- panel top [on paint := dcClearRect] hand <- newHand p2 [] b1 <- button p2 [text := "Play"] b2 <- button p2 [text := "Discard"] - -- initial game position + -- setup initial game position game <- newGame "Human" "Computer" vgame <- varCreate game -- display info message - let display msg = set sf [text := msg] + let display msg = set status [text := msg] -- perform some gameplay action let withPlay action cont @@ -126,13 +143,13 @@ ------------------------------------- -- timer event to play the computer ------------------------------------- - t <- timer top - [interval := 1000, - on command := + t <- timer top [interval := 1000] + set t [on command := do { g <- varGet vgame ; if endGame g then do { let txt = showScore g ; display txt + ; set t [enabled := False] ; infoDialog top "Game end" txt ; close top } @@ -155,22 +172,45 @@ set top [layout := column 8 [container p1 $ - grid 0 0 [ glue : map (marginRight.alignBottom.vfill.widget) exps1 ++ - [glue, glue], - glue : map (fill.widget) discards ++ - [marginLeft (widget deck), glue], - glue : map (marginRight.alignTop.vfill.widget) exps2 - ++ [glue]] + grid 0 0 $ + [ [glue] ++ + map (marginRight.alignBottom.vfill.widget) exps1 + ++ [glue], + [glue] ++ + map (hfill.widget) discards + ++ [marginLeft (hfill (widget deck))], + [glue] ++ + map (marginRight.alignTop.vfill.widget) exps2 + ++ [glue] + ] , container p2 $ row 16 [glue, widget hand, - valignCenter (column 8 [widget b1,widget b2]), - glue]]] + alignCenter (column 8 [widget b1,widget b2]), glue + ]]] + -- updateDeck game updateHand (active game) where + -- miscelaneous dialogs + infoRules w = infoDialog w "About the game rules" $ + init $ + unlines ["Based on the Lost Cities card game by Reiner Knizia", + "Please visit the Boardgamegeek web page for reviews, rules and more information:", + "http://www.boardgamegeek.com/boardgame/50"] + infoAbout w + = infoDialog w "About this program" $ + init $ + unlines ["Copyleft 2009 Pedro Vasconcelos ", + "", + "This program is free software distributed under the GNU Public License", + "Please see the included LICENSE file or visit my web page:", + "http://www.ncc.up.pt/~pbv/stuff/lostcities"] + + + -- show a move in textual form showMove (a1,a2) = showAction1 a1 ++ " & " ++ showAction2 a2 showAction1 (Play (c,v)) = "played " ++ show c ++ " " ++ showFace v @@ -180,7 +220,6 @@ showFace v | v>0 = show v | otherwise = "multiplier" - showScore g = name p1 ++ ": " ++ show s1 ++ " points, " ++ name p2 ++ ": " ++ show s2 ++ " points." @@ -191,7 +230,6 @@ - -- set cursor pointer for a window cursorSet True = cursorHand cursorSet False = cursorArrow @@ -243,7 +281,6 @@ let n = 7 let w = handWindow h set w [layout := space (n*dx+cardWidth) (dy+cardHeight)] - refit w repaint w @@ -295,8 +332,9 @@ return h where -- draw method - do_draw h dc (Rect x y _ _) - = do dx <- varGet (handDx h) + do_draw h dc rect@(Rect x y _ _) + = do --dcClearRect dc rect + dx <- varGet (handDx h) -- dy <- get h deltaY dy <- dcGetTextHeight dc varSet (handDy h) dy @@ -370,7 +408,7 @@ where -- drawing method -- - do_draw exp dc (Rect x y w h) + do_draw exp dc rect@(Rect x y w h) = do cs <- get exp cards own <- get exp owner -- inquire text height in current DC @@ -414,7 +452,8 @@ instance Cards DiscardPile where cards = newAttr "cards" getter setter where getter = varGet . discardPile - setter = varSet . discardPile + setter d cs = do varSet (discardPile d) cs + refresh d instance ClickAction DiscardPile where @@ -452,8 +491,6 @@ -- only draw the top card (list head) drawCardlist (zip cs [pt x y]) dc - -- background color (brown) - boardBgcolor = colorRGB 160 82 45 ---------------------------------------- @@ -477,7 +514,6 @@ let w = deckWindow d set w [layout := space (cardWidth+2*k) (cardHeight+2*k), tooltip := show n ++ " cards left"] - refit w repaint w @@ -493,7 +529,7 @@ setter = varSet . deckAction --- custom attribute: size of deck (number of cards to draw) +-- custom attribute: number of cards left decksize :: Attr Deck Int decksize = newAttr "decksize" getter setter where getter d = varGet (deckSize d) @@ -520,19 +556,20 @@ return d where -- drawing method - do_draw d dc (Rect x y _ _) - = do n <- get d decksize + do_draw d dc rect@(Rect x y _ _) + = do --dcClearRect dc rect + n <- get d decksize let k = ceiling (fromIntegral n/10) let pts = [pt (x+2*i) (y+2*i) | i<-[0..k-1]] sequence_ [draw_back dc pt | pt<-pts] -- draw a card back draw_back dc pt - = do roundedRect dc r cardRadius [penColor := grey, - brush := brushSolid grey] + = do roundedRect dc r cardRadius [penColor := cardBgcolor, + brush := brushSolid cardBgcolor] roundedRect dc r cardRadius [penColor := black, - brushColor := black, - brushKind := BrushHatch HatchCrossDiag] + brushColor := black, + brushKind := BrushHatch HatchCrossDiag] where r = Rect x y cardWidth cardHeight x = pointX pt y = pointY pt @@ -556,7 +593,7 @@ sz <- getTextExtent dc "99" sequence_ [drawCard card dc sz pt | (card,pt) <- cardpts] where - myFont = fontSwiss { _fontSize=10, _fontWeight=WeightBold } + myFont = fontSwiss { _fontWeight=WeightBold } -- draw a single card @@ -583,19 +620,21 @@ wxColor Yellow = yellow wxColor Red = red wxColor Green = green -wxColor Blue = cyan +wxColor Blue = myblue + where myblue = colorRGB 0 220 255 -- reads better over black bg + -- convert a card face value to a string showFace :: Int -> String -showFace n | n==0 = " \x2718" -- multiplication sign +showFace n | n==0 = " X" -- multiplication sign | otherwise = printf "%2d" n {- Alternative symbols for investment cards: check marks: U+2713, U+2714 - multiplication sign: U+2715, U+2716 + multiplication sign: U+2715, U+2716, U+2718 ballot marks: U+2717, U+2718 signing hands: U+F02D U+270D U+E41E U+E01B -} @@ -606,6 +645,11 @@ cardRadius :: Double cardRadius = 5 + + +-- background color for board and cards +boardBgcolor = colorRGB 160 82 45 +cardBgcolor = colorRGB 200 190 150 diff --git a/lostcities.cabal b/lostcities.cabal --- a/lostcities.cabal +++ b/lostcities.cabal @@ -1,14 +1,14 @@ Name: lostcities -Version: 0.1 +Version: 0.2 Cabal-Version: >= 1.2 License: GPL License-file: LICENSE Author: Pedro Vasconcelos -Maintainer: pbv@dcc.fc.up.pt -Homepage: http://www.dcc.fc.up.pt/~pbv/stuff/lostcities +Maintainer: pbv@ncc.up.pt +Homepage: http://www.ncc.up.pt/~pbv/stuff/lostcities Copyright: (c) 2009 Pedro Vasconcelos Synopsis: An implementation of an adictive two-player card game -Description: Game originally designed by Reiner Knizia +Description: Based on the card game designed by Reiner Knizia. In this implementation you play against the computer. Build-Type: Simple Category: Game