scroll-1.20250228: Level.hs

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 Term
import Term.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 e = case inputCharacter e of
		Just c -> case M.lookup c charMap of
			Just (CharControl (Movement d)) -> Just d
			_ -> Nothing
		Nothing -> 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  |    "
	  , "    |__  ___   __   ___  ___|    "
	  , "  =(________________________)=   "
	  , "                                 "
	  ]
	]