Untitled

mail@pastecode.io avatar
unknown
plain_text
a year ago
5.0 kB
1
Indexable
Never
module Main where

import Graphics.Gloss
import Graphics.Gloss.Interface.Pure.Game


data Direcao = Este
              |Oeste
              |Norte
              |Sul
                     deriving (Show, Eq, Read)

type Pontos = Int
type Posicao = (Float,Float)


dimensao :: (Int,Int)
dimensao = (400,400)

data Estado = E Posicao (Maybe Direcao) deriving (Show, Eq, Read)

{-
data Estado = E (Float,Float) Int EstadoJogo

data EstadoJogo = Menu Inicial
                | Menu Pausa
                | Menu Final
                | Jogo 

test :: String -> Picture
-}



estadoInicial :: Estado
estadoInicial = E (0,0) Nothing




desenhaEstado :: Estado -> Picture
desenhaEstado (E (x,y) dir) = translate x y poligono
   where poligono :: Picture
         poligono = color red $ polygon [(0,0), (10,0), (10,10), (0,10), (0,0)]


--desenhaMenuInicial :: Estado -> Picture
--desenhaMenuInicial (E _ (x,y) dir p) = translate x y poligono
--       where poligono :: Picture
--        poligono = color red $ polygon [(0,0), (10,0), (10,10), (0,10), (0,0)]

--desenhaMenuPausa :: Estado -> Picture
--desenhaMenuPausa 


reageEvento :: Event -> Estado -> Estado
reageEvento (EventKey (SpecialKey KeyUp)    Down _ _) (E (x,y) dir) = E (x, y) (Just Norte)
reageEvento (EventKey (SpecialKey KeyUp)    Up _ _)   (E (x,y) dir) = E (x, y) Nothing
reageEvento (EventKey (SpecialKey KeyDown)  Down _ _) (E (x,y) dir) = E (x, y) (Just Sul)
reageEvento (EventKey (SpecialKey KeyDown)  Up _ _)   (E (x,y) dir) = E (x, y) Nothing
reageEvento (EventKey (SpecialKey KeyLeft)  Down _ _) (E (x,y) dir) = E (x, y) (Just Oeste)
reageEvento (EventKey (SpecialKey KeyLeft)  Up _ _)   (E (x,y) dir) = E (x, y) Nothing
reageEvento (EventKey (SpecialKey KeyRight) Down _ _) (E (x,y) dir) = E (x, y) (Just Este)
reageEvento (EventKey (SpecialKey KeyRight) Up _ _)   (E (x,y) dir) = E (x, y) Nothing
reageEvento (EventKey (Char 'w')  Down _ _) (E (x,y) dir) = E (x, y) (Just Norte)
reageEvento (EventKey (Char 'w')  Up _ _)   (E (x,y) dir) = E (x, y) Nothing
reageEvento (EventKey (Char 's')  Down _ _) (E (x,y) dir) = E (x, y) (Just Sul)
reageEvento (EventKey (Char 's')  Up _ _)   (E (x,y) dir) = E (x, y) Nothing
reageEvento (EventKey (Char 'a')  Down _ _) (E (x,y) dir) = E (x, y) (Just Oeste)
reageEvento (EventKey (Char 'a')  Up _ _)   (E (x,y) dir) = E (x, y) Nothing
reageEvento (EventKey (Char 'd')  Down _ _) (E (x,y) dir) = E (x, y) (Just Este)
reageEvento (EventKey (Char 'd')  Up _ _)   (E (x,y) dir) = E (x, y) Nothing
reageEvento _ s = s  -- ignora qualquer outro evento

movimentaX :: Estado -> Posicao -> Maybe Direcao -> Estado
movimentaX (E (x0,y0) oldDir) (x,y) dir = let checkX = x + 10 <= (fromIntegral $ fst dimensao) / 2 
                                                    && x >= (negate $ (fromIntegral $ fst dimensao) / 2)--gg
                                          in if checkX
                                                 then (E (x,y0) dir)
                                                 else (E (x0,y0) oldDir)

movimentaY :: Estado -> Posicao -> Maybe Direcao -> Estado
movimentaY (E (x0,y0) oldDir) (x,y) dir = let checkY = y + 10 <= (fromIntegral $ snd dimensao) / 2
                                                    && y >= (negate $ (fromIntegral $ snd dimensao) / 2)
                                          in if checkY
                                                 then (E (x0,y) dir)
                                                 else (E (x0,y0) oldDir)

movimenta :: Estado -> Posicao -> Maybe Direcao -> Estado
movimenta estado posicao dir = movimentaY ( movimentaX estado posicao dir) posicao dir

--eventosMenu :: Event -> Estado -> Estado
--eventosMenu (EventKey (Char '1') Down _ _) (E (Menu Inicial) _ _ _) = let (E _ pos dir p) = estadoInicial
--eventosMenu (EventKey (Char '1') Down _ _) 
                                          
reageTempo :: Float -> Estado -> Estado
reageTempo n estado@(E (x,y) dir) = case dir of
                                   Just Norte -> movimenta estado (x,y + 4.7) (Just Norte)
                                   Just Sul -> movimenta estado (x, y - 5.3) (Just Sul)
                                   Just Este -> movimenta estado (x + 5,y-0.3) ( Just Este)
                                   Just Oeste -> movimenta estado (x - 5, y-0.3) (Just Oeste)
                                   Nothing -> movimenta estado (x , y-0.3) ( Nothing)


fr:: Int
fr = 50

dm :: Display
dm = InWindow
       "Novo Jogo"  -- título da janela
       (400, 400)   -- dimensão da janela
       (200,200)    -- posição no ecran

corFundo = (greyN 0.5) 

main :: IO ()
main = do play dm             -- janela onde irá decorrer o jogo
               corFundo       -- cor do fundo da janela
               fr             -- frame rate
               estadoInicial  -- define estado inicial do jogo
               desenhaEstado  -- desenha o estado do jogo
               reageEvento    -- reage a um evento
               reageTempo     -- reage ao passar do tempo
Leave a Comment