<commit_before>module Level where

import System.Random
import Control.Monad

import Data.Binary
import Data.Map as M
import Data.Set as S
import Data.List as L

import Geometry
import Monster

data Level = Level
              { lname     :: String,
                lsize     :: (Y,X),
                lmonsters :: [Monster],
                lmap      :: LMap }
  deriving Show

updateLMap :: Level -> (LMap -> LMap) -> Level
updateLMap lvl f = lvl { lmap = f (lmap lvl) }

instance Binary Level where
  put (Level nm sz@(sy,sx) ms lmap) = 
        do
          put nm
          put sz
          put ms
          put [ lmap ! (y,x) | y <- [0..sy], x <- [0..sx] ]
  get = do
          nm <- get
          sz@(sy,sx) <- get
          ms <- get
          xs <- get
          let lmap = M.fromList (zip [ (y,x) | y <- [0..sy], x <- [0..sx] ] xs)
          return (Level nm sz ms lmap)

type LMap = Map (Y,X) (Tile,Tile)

at         l p = fst (findWithDefault (Unknown, Unknown) p l)
rememberAt l p = snd (findWithDefault (Unknown, Unknown) p l)

data Tile = Rock
          | Opening HV
          | Floor
          | Unknown
          | Corridor
          | Wall HV
          | Stairs VDir (Maybe (Level, Loc))
          | Door HV Bool
  deriving Show

-- forget stuff you cannot see anyway
-- mainly for space efficiency in save files
flat :: Tile -> Tile
flat (Stairs d _) = Stairs d Nothing
flat x            = x

instance Binary Tile where
  put Rock         = putWord8 0
  put (Opening d)  = putWord8 1 >> put d
  put Floor        = putWord8 2
  put Unknown      = putWord8 3
  put Corridor     = putWord8 4
  put (Wall d)     = putWord8 5 >> put d
  put (Stairs d n) = putWord8 6 >> put d >> put n
  put (Door d o)   = putWord8 7 >> put d >> put o
  get = do
          tag <- getWord8
          case tag of
            0 -> return Rock
            1 -> liftM Opening get
            2 -> return Floor
            3 -> return Unknown
            4 -> return Corridor
            5 -> liftM Wall get
            6 -> liftM2 Stairs get get
            7 -> liftM2 Door get get
            _ -> fail "no parse (Tile)"

data HV = Horiz | Vert
  deriving (Eq, Show, Bounded)

fromHV Horiz = True
fromHV Vert  = False

toHV True  = Horiz
toHV False = Vert

instance Random HV where
  randomR (a,b) g = case randomR (fromHV a,fromHV b) g of
                      (b,g') -> (toHV b,g')
  random g = randomR (minBound, maxBound) g

binaryChoice :: a -> a -> IO a
binaryChoice p0 p1 =
  do
    b <- randomRIO (False,True)
    return (if b then p0 else p1)

instance Binary HV where
  put Horiz = put True
  put Vert  = put False
  get = get >>= \ b -> if b then return Horiz else return Vert

data VDir = Up | Down
  deriving (Eq, Show)

instance Binary VDir where
  put Up   = put True
  put Down = put False
  get = get >>= \ b -> if b then return Up else return Down

instance Eq Tile where
  Rock == Rock = True
  Opening d == Opening d' = d == d'
  Floor == Floor = True
  Unknown == Unknown = True
  Corridor == Corridor = True
  Wall d == Wall d' = d == d'
  Stairs d _ == Stairs d' _ = d == d'
  Door d o == Door d' o' = d == d' && o == o'
  _ == _ = False

closed, open, light :: Tile -> Bool
closed = not . open
open Floor = True
open (Opening _) = True
open (Door _ o) = o
open Corridor = True
open (Stairs _ _) = True
open _ = False<commit_msg>added comments<commit_after>module Level where

import System.Random
import Control.Monad

import Data.Binary
import Data.Map as M
import Data.Set as S
import Data.List as L

import Geometry
import Monster

data Level = Level
              { lname     :: String,
                lsize     :: (Y,X),
                lmonsters :: [Monster],
                lmap      :: LMap }
  deriving Show

updateLMap :: Level -> (LMap -> LMap) -> Level
updateLMap lvl f = lvl { lmap = f (lmap lvl) }

instance Binary Level where
  put (Level nm sz@(sy,sx) ms lmap) = 
        do
          put nm
          put sz
          put ms
          put [ lmap ! (y,x) | y <- [0..sy], x <- [0..sx] ]
  get = do
          nm <- get
          sz@(sy,sx) <- get
          ms <- get
          xs <- get
          let lmap = M.fromList (zip [ (y,x) | y <- [0..sy], x <- [0..sx] ] xs)
          return (Level nm sz ms lmap)

type LMap = Map (Y,X) (Tile,Tile)

at         l p = fst (findWithDefault (Unknown, Unknown) p l)
rememberAt l p = snd (findWithDefault (Unknown, Unknown) p l)

data Tile = Rock
          | Opening HV
          | Floor
          | Unknown
          | Corridor
          | Wall HV
          | Stairs VDir (Maybe (Level, Loc))
          | Door HV Bool
  deriving Show

-- forget stuff you cannot see anyway
-- mainly for space efficiency in save files
flat :: Tile -> Tile
flat (Stairs d _) = Stairs d Nothing
flat x            = x

instance Binary Tile where
  put Rock         = putWord8 0
  put (Opening d)  = putWord8 1 >> put d
  put Floor        = putWord8 2
  put Unknown      = putWord8 3
  put Corridor     = putWord8 4
  put (Wall d)     = putWord8 5 >> put d
  put (Stairs d n) = putWord8 6 >> put d >> put n
  put (Door d o)   = putWord8 7 >> put d >> put o
  get = do
          tag <- getWord8
          case tag of
            0 -> return Rock
            1 -> liftM Opening get
            2 -> return Floor
            3 -> return Unknown
            4 -> return Corridor
            5 -> liftM Wall get
            6 -> liftM2 Stairs get get
            7 -> liftM2 Door get get
            _ -> fail "no parse (Tile)"

data HV = Horiz | Vert
  deriving (Eq, Show, Bounded)

fromHV Horiz = True
fromHV Vert  = False

toHV True  = Horiz
toHV False = Vert

instance Random HV where
  randomR (a,b) g = case randomR (fromHV a,fromHV b) g of
                      (b,g') -> (toHV b,g')
  random g = randomR (minBound, maxBound) g

binaryChoice :: a -> a -> IO a
binaryChoice p0 p1 =
  do
    b <- randomRIO (False,True)
    return (if b then p0 else p1)

instance Binary HV where
  put Horiz = put True
  put Vert  = put False
  get = get >>= \ b -> if b then return Horiz else return Vert

data VDir = Up | Down
  deriving (Eq, Show)

instance Binary VDir where
  put Up   = put True
  put Down = put False
  get = get >>= \ b -> if b then return Up else return Down

instance Eq Tile where
  Rock == Rock = True
  Opening d == Opening d' = d == d'
  Floor == Floor = True
  Unknown == Unknown = True
  Corridor == Corridor = True
  Wall d == Wall d' = d == d'
  Stairs d _ == Stairs d' _ = d == d'
  Door d o == Door d' o' = d == d' && o == o'
  _ == _ = False

-- closed: blocks moves and light
-- open: allows moves and light
-- light: is light on its own
-- passive: reflects light from adjacent positions
-- exclusively passive: cannot be seen from an adjacent position in darkness
closed, open, light :: Tile -> Bool
closed = not . open
open Floor = True
open (Opening _) = True
open (Door _ o) = o
open Corridor = True
open (Stairs _ _) = True
open _ = False
{'fraction_non_alphanumeric': 0.10134451351742085, 'fraction_numerical': 0.010119994217146162, 'mean_word_length': 1.8190709046454767, 'pattern_counts': {'":': 0, '<': 23, '<?xml version=': 0, '>': 73, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2686637', 'n_tokens_mistral': 2374, 'n_tokens_neox': 2245, 'n_words': 936}