lostcities 0.1 → 0.2
raw patch · 2 files changed
+88/−44 lines, 2 files
Files
- GUI.hs +84/−40
- lostcities.cabal +4/−4
GUI.hs view
@@ -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 <pbv@ncc.up.pt>",+ "",+ "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
lostcities.cabal view
@@ -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