1module Level where 2 3import qualified Data.Vector as V 4import Data.Vector ((!)) 5import qualified Data.Map as M 6import Data.List 7import Data.Char 8import Data.Default 9import Data.Function 10import Control.Monad.ST 11import Control.Monad.State.Strict 12import UI.NCurses 13 14import Types 15import Level.Border 16import Level.Padding 17import qualified Level.Tutorial 18import qualified Level.Coleridge 19import qualified Level.Beowulf 20import qualified Level.Joyce 21import View 22import Curses 23import Player 24import CharMap 25 26levelFor :: Rand -> Difficulty -> (Level, Level) 27levelFor r d = case d of 28 Easy -> (tutorial, coleridge) 29 Medium -> (coleridge, beowulf (length coleridge)) 30 Hard -> (beowulf 1000, joyce 1000) 31 where 32 tutorial = Level.Tutorial.level 33 coleridge = Level.Coleridge.level r 34 beowulf = Level.Beowulf.level r 35 joyce = Level.Joyce.level r 36 37-- back is cut or padded to be same length as front 38levelVectors :: (Level, Level) -> (V.Vector (V.Vector Char), V.Vector (V.Vector Char)) 39levelVectors (front, back) = (frontv, backv) 40 where 41 frontv = addBorder front 42 len = V.length frontv 43 44 backpadded = take len $ back ++ concat (cycle levelPadding) 45 backv = padmore $ addBorder backpadded 46 47 -- Adding border may result in back being shorter than front 48 -- fix by replicating the last line from the back, with 49 -- all non-border chars whited out. 50 padmore v = case len - V.length v of 51 n 52 | n > 0 -> V.concat 53 [ v 54 , V.replicate n $ V.map makeempty $ 55 V.tail v ! 0 56 ] 57 | otherwise -> v 58 makeempty c 59 | isBoundry c = c 60 | otherwise = ' ' 61 62emptyLevel :: Level -> Bool 63emptyLevel [] = True 64emptyLevel ls = all null ls 65 66-- Resulting list is sorted with rarest letters first. 67calcLetterFrequencies :: String -> [(Char, Integer)] 68calcLetterFrequencies = sortBy (compare `on` snd) . M.toList . count . filter isAlpha 69 where 70 count = foldl' (\m c -> M.insertWith (+) (toLower c) 1 m) M.empty 71 72select :: Palette -> Maybe Integer -> Curses Difficulty 73select palette timeoutms = do 74 w <- liftIO levelSelectionWorld 75 go w initialViewOffset initialp 76 where 77 initialp = def 78 { playerHead = pos 79 , playerBody = map mkseg [1..playerLen initialp] 80 } 81 mkseg n = Segment (xpos - n, ypos) DRight CurrentSide Nothing False 82 pos@(xpos, ypos) = (15,4) 83 84 go w off pl = do 85 vw <- liftIO $ stToIO $ freezeWorld w 86 let view = View vw pl [] False 87 (v, off') <- displayView view palette timeoutms off 88 case input =<< v of 89 Nothing -> go w off' pl 90 Just DDive -> return (posToDifficulty (getPos pl)) 91 Just d -> do 92 let newseg = Segment (getPos pl) d CurrentSide Nothing False 93 let pl' = pl 94 { playerHead = offsetPos (directionOffset d) (playerHead pl) 95 , playerBody = shiftBody pl newseg 96 } 97 go w off' pl' 98 99 input (EventCharacter c) = case M.lookup c charMap of 100 Just (CharControl (Movement d)) -> Just d 101 _ -> Nothing 102 input e = arrowDirection e 103 104levelSelectionWorld :: IO World 105levelSelectionWorld = 106 V.thaw . V.fromList =<< 107 mapM (V.thaw . V.fromList) (concat $ map fst levelSelectScreen) 108 109posToDifficulty :: Pos -> Difficulty 110posToDifficulty (_, y) 111 | y > length zones - 1 = Hard 112 | y < 0 = Easy 113 | otherwise = zones !! y 114 where 115 zones = concatMap (\(ls, z) -> replicate (length ls) z) levelSelectScreen 116 117levelSelectScreen :: [([String], Difficulty)] 118levelSelectScreen = flip zip [Easy, Easy, Medium, Hard] $ 119 map (map (replicate 20 ' ' ++)) 120 -- note: all lines must be equal length! 121 [ [ " Press [d] to dive into Scroll " 122 ] 123 , [ " __________________________ " 124 , " =(__________________________)= " 125 , " | Easy | " 126 , " | | " 127 , " | Tutorial + Xanadu | " 128 , " |__ ___ __ ___ __| " 129 , " =(_________________________)= " 130 ] 131 , [ " _________________________ " 132 , " =(_________________________)= " 133 , " | Medium | " 134 , " | | " 135 , " | Xanadu + Beowulf | " 136 , " |__ __ __ ___ _ __| " 137 , " =(________________________)= " 138 ] 139 , [ " _________________________ " 140 , " =(_________________________)= " 141 , " | Hard | " 142 , " | | " 143 , " | Beowulf + Ulysses | " 144 , " |__ ___ __ ___ ___| " 145 , " =(________________________)= " 146 , " " 147 ] 148 ] 149