• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

Betovsky

Jogo da Vida

5 mensagens neste tópico

Bem após ter ficado deprimido com a derrota do SCP frente ao SLB, fui ver se arranjava alguma coisa para me animar.

Decidi então implementar o jogo da vida em Haskell.

Ainda não está acabado. Neste momento está a receber o ficheiro do tabuleiro inicial como argumento na altura da execução da aplicação e está a usar a forma tradicional 23/3. Ou seja, uma célula continua viva se tiver 2 ou 3 células a rodear e uma célula nasce se tiver à sua volta 3 células vivas. Neste momento está a mostrar o tabuleiro na consola pausando a cada tick.

Os próximos passos serão por a ser definivel por argumento a versão do jogo da vida a ser usado, por exemplo 23/36. Também a possibilidade de em vez de indicar um ficheiro com um tabuleiro já feito, indicar antes o tamanho do tabuleiro e o número de células a serem geradas aleatóriamente no tabuleiro. E depois passar toda a parte da visualização da consola para uma janela gráfica, provavelmente OpenGL.

Segue o código para quem interessar.

import Data.IntMap (IntMap(..), empty, insert, showTree, member, union, foldWithKey)
import System.Environment (getArgs)
import Control.Arrow ((***))
import Foreign (unsafePerformIO)

-- Conjunto de células vivas, basicamente uma árvore optimizada para ints
-- O Int será a posicao global da célula no board
type Celulas = IntMap ()

main = do 
args <- getArgs
case args of
	[fBoard] -> readFile fBoard >>= play . iniciaBoard 
	_        -> putStrLn "Cruomo!!!"  -- yep, cruomo cruomo cruomo !!!!


play board = do 
mostraBoard board 			-- Mostra a board actual
putStrLn "Continue..."			
s <- getLine				    -- Espera pelo enter
case s of
	"sair" -> return ()		
	_      -> play (actualizaBoard board)   -- Efectua o "tick"

--------------------------------------------------------------------------------------------------------------
-- iniciação do ambiente ------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------

-- É presumido que o board será rectangular, em k a largura é obtida pela primeira linha
iniciaBoard txt = (x, y, celulas)
where
linhas = lines txt 
x = length linhas
y = if x == 0 then 0 else length $ head linhas
celulas = trataLinhas empty y 0 linhas

-- Processa cada 1 das linhas do Board
trataLinhas celulas    _       _     []    = celulas
trataLinhas celulas tamLinha indice (x:xs) = trataLinhas celulas' tamLinha (indice + 1) xs
where celulas' = trataColunas celulas tamLinha indice 0 x

-- Processa cada coluna para um determinada linha
trataColunas celulas    _         _            _         []   = celulas
trataColunas celulas tamLinha indiceLinha indiceColuna (y:ys) = 
trataColunas celulas' tamLinha indiceLinha (indiceColuna + 1) ys
	where celulas' = if y == '1' 
			     then insert (getPosGlobal tamLinha (indiceLinha, indiceColuna)) () celulas
			     else celulas

--------------------------------------------------------------------------------------------------------------
-- Mostra o estado do ambiente -------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------

-- Imprime o board em texto, será por OpenGL no futuro
mostraBoard (x,y,celulas) = mapM_ (mostraLinha y celulas) [0..x-1]

mostraLinha y celulas x = mapM_ (mostraCelula celulas (x*y)) [0..y-1] >> novaLinha

-- Célula viva será 1, morta será 0
mostraCelula celulas l y | (l+y) `member` celulas = putChar '1'
                                | otherwise                   = putChar '0'


--------------------------------------------------------------------------------------------------------------
-- Actualizar o ambiente -------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------

-- Actualiza as células vivas <-- junção das células que permanecem vivas com as células que renascem
actualizaBoard (x,y, celulas) = (x,y,celulas')
where
celulasVivas = foldWithKey (funVivos celulas y) empty celulas		    -- Verifica para cada célula viva
celulasRenascidas = foldl (funMortos celulas y) empty [0..(x*y)-1]	  -- Verifica para cada posição do board
celulas' = celulasVivas `union` celulasRenascidas				-- união...

-- Verifica se uma dada celula (chave) continua viva
funVivos celulas tamLinha chave _ celulasVivas = if ePraFicarVivo then insert chave () celulasVivas else celulasVivas
where
posicao = getPosMatriz tamLinha chave		       -- Posicao na matriz (x,y)
vizinhos = obterVizinhos tamLinha posicao		-- Obtem lista de vizinhos da posicao
vizinhosVivos = obterVizinhosVivos celulas vizinhos    -- Filtra os vizinhos para os que estão vivos
ePraFicarVivo = vizinhosVivos `elem` [2,3]		-- Permanece vivo se estiver rodeada por 2 ou 3 células
							-- Irá ser definivel no arranque no futuro

-- Verifica se uma dada celula (chave) renasce (não é filtrada as células que já se encontram vivas) [será necessário??]
funMortos celulas tamLinha renascidas chave = if ePraRenascer then insert chave () renascidas else renascidas
where
posicao = getPosMatriz tamLinha chave			-- Posicao na matriz (x,y)
vizinhos = obterVizinhos tamLinha posicao		 -- Obtem lista de vizinhos da posicao
vizinhosVivos = obterVizinhosVivos celulas vizinhos	-- Filtra os vizinhos para os que estão vivos
ePraRenascer = vizinhosVivos `elem` [3]			 -- Renasce se estiver rodeado por 3 células vivas
							-- Irá ser definivel no arranque no futuro

--------------------------------------------------------------------------------------------------------------
-- Auxiliares ------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------

-- Para aceitar em tuplos
uncurriedProd = uncurry (***)

-- Mudar de linha
novaLinha = putStrLn ""

-- Converter de posicao global para posicao em matriz (x,y) e o inverso
getPosGlobal tamLinha (x,y) = tamLinha * x + y
getPosMatriz tamLinha pos = pos `divMod` tamLinha

-- lista de funções para obter as 8 coordenadas vizinhas de uma dada posicao
vizinhosL = [(pred, pred), (pred, id), (pred, succ), (id, pred), (id, succ), (succ, pred), (succ, id), (succ, succ)]

-- aplica a lista de funções de vizinhos a uma posicao e filtra os vizinhos que ficam de fora do board
-- necessário caso a posicao esteja na margem do board
obterVizinhos tamLinha pos = map (getPosGlobal tamLinha) $ filtrarVizinhos tamLinha $ map (`uncurriedProd` pos) vizinhosL

-- filtra as coordenadas que estão fora da board
filtrarVizinhos maxY = filter ( and . (\ e -> map ($e) [(>=0).fst, (>=0).snd, (<maxY).snd]))

-- Indica o numero dos vizinhos que se encontram vivos
obterVizinhosVivos celulas = length . filter id . map (`member` celulas)

-- print o conteudo de um valor [DEBUG]
p v = unsafePerformIO (return v >>= \z-> print z >> return z)

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Bem após ter ficado deprimido com a derrota do SCP frente ao SLB, fui ver se arranjava alguma coisa para me animar.

Derrota ou empate? :(

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Bem após ter ficado deprimido com a derrota do SCP frente ao SLB, fui ver se arranjava alguma coisa para me animar.

Derrota ou empate? :(

Derrota do SCP e da verdade desportiva. Já não via tamanha coisa à 500 anos :)

Bem e segue uma nova versão, provavelmente a final já que não devo pegar mais nisto e de já ter novos projectos em mente.

Bem, nesta versão já aceita gerar um board aleatoriamente e já é em OpenGL. Não pesco muito de OpenGL portanto não sei se está feita da melhor maneira. Existem vários problemas, por exemplo não estou a tratar do redimensionamento da janela e é presumido que ela será sempre do mesmo tamanho.

import Data.IntMap (IntMap(..), empty, insert, showTree, member, union, foldWithKey, keys)
import Control.Arrow ((***))
import Foreign (unsafePerformIO)
import Data.List (nub)
import System.Random (getStdGen, randomRs)
import Graphics.UI.GLUT
import Data.IORef
import System.Exit

-- Conjunto de células vivas, basicamente uma árvore optimizada para ints
-- O Int será a posicao global da célula no board
type Celulas = IntMap ()

main = do 
(progName, args) <- getArgsAndInitialize
case args of
	[fBoard]              -> readFile fBoard >>= play . iniciaBoard
	[tamanho, numCelulas] -> getStdGen >>= play . iniciaBoardR (read tamanho) (read numCelulas)
	_                     -> putStrLn "Cruomo!!!" -- yep, cruomo cruomo cruomo !!!!


play board@(x, y, celulas) = do 
initialDisplayMode $= [DoubleBuffered]
createWindow "Jogo da Vida"
boardRef <- newIORef board
windowSize $= Size 600 600
displayCallback $= display boardRef
--	idleCallback $= Just (idle boardRef)
keyboardMouseCallback $= Just (keyboard boardRef)
mainLoop

--------------------------------------------------------------------------------------------------------------
-- iniciação do ambiente -------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------

-- Iniciar por ficheiro texto
-- É presumido que o board será rectangular, em k a largura é obtida pela primeira linha
iniciaBoard txt = (x, y, celulas)
where
linhas = lines txt 
x = length linhas
y = if x == 0 then 0 else length $ head linhas
celulas = trataLinhas empty y 0 linhas

-- Processa cada 1 das linhas do Board
trataLinhas celulas    _       _     []    = celulas
trataLinhas celulas tamLinha indice (x:xs) = trataLinhas celulas' tamLinha (indice + 1) xs
where celulas' = trataColunas celulas tamLinha indice 0 x

-- Processa cada coluna para um determinada linha
trataColunas celulas    _         _            _         []   = celulas
trataColunas celulas tamLinha indiceLinha indiceColuna (y:ys) = 
trataColunas celulas' tamLinha indiceLinha (indiceColuna + 1) ys
	where celulas' = if y == '1' 
                                 then insert (getPosGlobal tamLinha (indiceLinha, indiceColuna)) () celulas
                                 else celulas

-- Iniciar aleatoriamente
iniciaBoardR tamanho numCelulas gen = (tamanho, tamanho, celulas)
where
maxPos = tamanho * tamanho - 1
posicoes = (take numCelulas) . nub . randomRs (0, maxPos) $ gen
celulas = foldl inserirCelula empty posicoes
inserirCelula board celula = insert celula () board

--------------------------------------------------------------------------------------------------------------
-- Mostra o estado do ambiente -------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------

-- Evento para renderizar o board
display board = do
clear [ColorBuffer]
(x, y, celulas) <- get board
let points = map ((convertePoint x y) . (getPosMatriz y)) (keys celulas) -- Obtem as coordenadas das celulas vivas
pointSize $= fromIntegral (600 `div` x - 2)                              -- O tamanho que terá cada célula
renderPoints points
swapBuffers

-- Converte a representação do ponto na matriz para ponto de OpenGL
convertePoint tamX tamY (x, y) = (y' + ajustamento, (negate x') - ajustamento, 0)
where
ajustamento = 1 / (fromIntegral tamX)
x' = (fromIntegral (x * 2) / fromIntegral tamX) - 1
y' = (fromIntegral (y * 2) / fromIntegral tamY) - 1

-- Evento para teclado
-- ESPAÇO para passar para a geração seguinte
-- 'q' para sair
keyboard board (Char ' ') Down _ _ = do
b <- get board
board $= actualizaBoard b
postRedisplay Nothing
keyboard _ (Char 'q') Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ _ = return ()

-- Evento para idle, caso se quiser por o "tick" automático
idle board = do
b <- get board
board $= actualizaBoard b
postRedisplay Nothing


renderPoints :: [(GLfloat,GLfloat,GLfloat)] -> IO ()
renderPoints = renderPrimitive Points . mapM_ (\(x,y,z)->vertex $ Vertex3 x y z)

--------------------------------------------------------------------------------------------------------------
-- Actualizar o ambiente -------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------

-- Actualiza as células vivas <-- junção das células que permanecem vivas com as células que renascem
actualizaBoard (x,y, celulas) = (x,y,celulas')
where
celulasVivas = foldWithKey (funVivos celulas y) empty celulas		-- Verifica para cada célula viva
celulasRenascidas = foldl (funMortos celulas y) empty [0..(x*y)-1]      -- Verifica para cada posição do board
celulas' = celulasVivas `union` celulasRenascidas                       -- união...

-- Verifica se uma dada celula (chave) continua viva
funVivos celulas tamLinha chave _ celulasVivas = if ePraFicarVivo then insert chave () celulasVivas else celulasVivas
where
posicao = getPosMatriz tamLinha chave			-- Posicao na matriz (x,y)
vizinhos = obterVizinhos tamLinha posicao               -- Obtem lista de vizinhos da posicao
vizinhosVivos = obterVizinhosVivos celulas vizinhos     -- Filtra os vizinhos para os que estão vivos
ePraFicarVivo = vizinhosVivos `elem` [2,3]              -- Permanece vivo se estiver rodeada por 2 ou 3 células
                                                                -- Irá ser definivel no arranque no futuro

-- Verifica se uma dada celula (chave) renasce (não é filtrada as células que já se encontram vivas) [será necessário??]
funMortos celulas tamLinha renascidas chave = if ePraRenascer then insert chave () renascidas else renascidas
where
posicao = getPosMatriz tamLinha chave                  -- Posicao na matriz (x,y)
vizinhos = obterVizinhos tamLinha posicao              -- Obtem lista de vizinhos da posicao
vizinhosVivos = obterVizinhosVivos celulas vizinhos    -- Filtra os vizinhos para os que estão vivos
ePraRenascer = vizinhosVivos `elem` [3]                -- Renasce se estiver rodeado por 3 células vivas
                                                               -- Irá ser definivel no arranque no futuro

--------------------------------------------------------------------------------------------------------------
-- Auxiliares ------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------

-- Para aceitar em tuplos
uncurriedProd = uncurry (***)

-- Mudar de linha
novaLinha = putStrLn ""

-- Converter de posicao global para posicao em matriz (x,y) e o inverso
getPosGlobal tamLinha (x,y) = tamLinha * x + y
getPosMatriz tamLinha pos = pos `divMod` tamLinha

-- lista de funções para obter as 8 coordenadas vizinhas de uma dada posicao
vizinhosL = [(pred, pred), (pred, id), (pred, succ), (id, pred), (id, succ), (succ, pred), (succ, id), (succ, succ)]

-- aplica a lista de funções de vizinhos a uma posicao e filtra os vizinhos que ficam de fora do board
-- necessário caso a posicao esteja na margem do board
obterVizinhos tamLinha pos = map (getPosGlobal tamLinha) $ filtrarVizinhos tamLinha $ map (`uncurriedProd` pos) vizinhosL

-- filtra as coordenadas que estão fora da board
filtrarVizinhos maxY = filter ( and . (\ e -> map ($e) [(>=0).fst, (>=0).snd, (<maxY).snd]))

-- Indica o numero dos vizinhos que se encontram vivos
obterVizinhosVivos celulas = length . filter id . map (`member` celulas)

-- print o conteudo de um valor [DEBUG]
p v = unsafePerformIO (return v >>= \z-> print z >> return z)

Para quem quiser testar deixo em anexo, o executável já compilado (Windows). Para correr basta fazer algo do tipo "lifeOpenGL 100 2500". Ou seja, um board 100x100 com no inicio 2500 celulas.

O resto pessoal só precisa de compilar e de ter o OpenGL.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora