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