2votos

BUSCAMINAS en Haskell

por josejuan hace 5 años

Mi primera aplicación GUI en Haskell, por probar las wxWidget.

Hacer el juego "buscaminas" en java-eclipse

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
import Graphics.UI.WX 
import System.Random.Shuffle 
import qualified Control.Monad as M 
 
main :: IO () 
main = start (buscaminas 15 10 15) 
 
ix :: [[a]] -> Int -> Int -> a 
ix v x y = (v!!y)!!x 
 
buscaminas :: Int -> Int -> Int -> IO () 
buscaminas w h nm = do 
    f <- frame [text := "Buscaminas"] 
    p <- panel f [] 
    m <- shuffleM [0..w*h-1] >>= return . take nm 
    buttons <- mapG (\x y -> button p [ text := "?"++ if elem (x+y*w) m then " " else "" 
                                      , clientSize := sz 24 24]) 
    mapC (\x y c -> set c [on command := onClick x y buttons f]) buttons 
    set f [layout := fill $ margin 30 $ container p $ grid 0 0 (map (map widget) buttons)] 
    where mapG io = mapM (\y -> mapM (\x -> io x y) [0..w-1]) [0..h-1] 
          mapC io b = mapG (\x y -> io x y $ ix b x y) 
          endGame m b f = do 
            set f [text := m] 
            mapC (\_ _ c -> set c [enabled := False]) b 
            return () 
          onClick x y b f = do 
            t <- get (ix b x y) text 
            case t of 
                "?" -> do open x y b 
                          ts <- mapC (\_ _ c -> get c text) b >>= return.filter ("?"==).concat 
                          when (null ts) $ endGame "¡YOU WIN!" b f 
                "? " -> endGame "¡BOOOOOOOM!" b f 
                _ -> return () 
          inbound x y = x >= 0 && y >= 0 && x < w && y < h 
          open x y b = 
            M.when (inbound x y) $ do 
                let c = ix b x y 
                t <- get c text 
                M.when (t == "?") $ do 
                    r <- mapM (\z@(u, v) -> get (ix b u v) text >>= \w -> return (z, w)) 
                            [(u, v) | u <- [x-1..x+1], v <- [y-1..y+1], u /= x || v /= y, inbound u v] 
                    let rf = map fst $ filter (\(_, t) -> t == "?") r 
                        rm = map fst $ filter (\(_, t) -> t == "? ") r 
                        nrm = length rm 
                    set c [text := show nrm, enabled := False, bgcolor := colorRGB 100 100 100] 
                    when (nrm == 0) $ mapM_ (\(u, v) -> open u v b) rf 
1 comentario

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.