module Level where import qualified Data.Vector as V import Data.Vector ((!)) import qualified Data.Map as M import Data.List import Data.Char import Data.Default import Data.Function import Control.Monad.ST import Control.Monad.State.Strict import UI.NCurses import Types import Level.Border import Level.Padding import qualified Level.Tutorial import qualified Level.Coleridge import qualified Level.Beowulf import qualified Level.Joyce import View import Curses import Player import CharMap levelFor :: Rand -> Difficulty -> (Level, Level) levelFor r d = case d of Easy -> (tutorial, coleridge) Medium -> (coleridge, beowulf (length coleridge)) Hard -> (beowulf 1000, joyce 1000) where tutorial = Level.Tutorial.level coleridge = Level.Coleridge.level r beowulf = Level.Beowulf.level r joyce = Level.Joyce.level r -- back is cut or padded to be same length as front levelVectors :: (Level, Level) -> (V.Vector (V.Vector Char), V.Vector (V.Vector Char)) levelVectors (front, back) = (frontv, backv) where frontv = addBorder front len = V.length frontv backpadded = take len $ back ++ concat (cycle levelPadding) backv = padmore $ addBorder backpadded -- Adding border may result in back being shorter than front -- fix by replicating the last line from the back, with -- all non-border chars whited out. padmore v = case len - V.length v of n | n > 0 -> V.concat [ v , V.replicate n $ V.map makeempty $ V.tail v ! 0 ] | otherwise -> v makeempty c | isBoundry c = c | otherwise = ' ' emptyLevel :: Level -> Bool emptyLevel [] = True emptyLevel ls = all null ls -- Resulting list is sorted with rarest letters first. calcLetterFrequencies :: String -> [(Char, Integer)] calcLetterFrequencies = sortBy (compare `on` snd) . M.toList . count . filter isAlpha where count = foldl' (\m c -> M.insertWith (+) (toLower c) 1 m) M.empty select :: Palette -> Maybe Integer -> Curses Difficulty select palette timeoutms = do w <- liftIO levelSelectionWorld go w initialViewOffset initialp where initialp = def { playerHead = pos , playerBody = map mkseg [1..playerLen initialp] } mkseg n = Segment (xpos - n, ypos) DRight CurrentSide Nothing False pos@(xpos, ypos) = (15,4) go w off pl = do vw <- liftIO $ stToIO $ freezeWorld w let view = View vw pl [] False (v, off') <- displayView view palette timeoutms off case input =<< v of Nothing -> go w off' pl Just DDive -> return (posToDifficulty (getPos pl)) Just d -> do let newseg = Segment (getPos pl) d CurrentSide Nothing False let pl' = pl { playerHead = offsetPos (directionOffset d) (playerHead pl) , playerBody = shiftBody pl newseg } go w off' pl' input (EventCharacter c) = case M.lookup c charMap of Just (CharControl (Movement d)) -> Just d _ -> Nothing input e = arrowDirection e levelSelectionWorld :: IO World levelSelectionWorld = V.thaw . V.fromList =<< mapM (V.thaw . V.fromList) (concat $ map fst levelSelectScreen) posToDifficulty :: Pos -> Difficulty posToDifficulty (_, y) | y > length zones - 1 = Hard | y < 0 = Easy | otherwise = zones !! y where zones = concatMap (\(ls, z) -> replicate (length ls) z) levelSelectScreen levelSelectScreen :: [([String], Difficulty)] levelSelectScreen = flip zip [Easy, Easy, Medium, Hard] $ map (map (replicate 20 ' ' ++)) -- note: all lines must be equal length! [ [ " Press [d] to dive into Scroll " ] , [ " __________________________ " , " =(__________________________)= " , " | Easy | " , " | | " , " | Tutorial + Xanadu | " , " |__ ___ __ ___ __| " , " =(_________________________)= " ] , [ " _________________________ " , " =(_________________________)= " , " | Medium | " , " | | " , " | Xanadu + Beowulf | " , " |__ __ __ ___ _ __| " , " =(________________________)= " ] , [ " _________________________ " , " =(_________________________)= " , " | Hard | " , " | | " , " | Beowulf + Ulysses | " , " |__ ___ __ ___ ___| " , " =(________________________)= " , " " ] ]