module Game.LambdaHack.Draw
( ColorMode(..), draw, animate
) where
import qualified Data.IntSet as IS
import qualified Data.List as L
import qualified Data.IntMap as IM
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Game.LambdaHack.Msg
import qualified Game.LambdaHack.Color as Color
import Game.LambdaHack.Animation (SingleFrame(..), Animation, rederAnim)
import Game.LambdaHack.State
import Game.LambdaHack.PointXY
import Game.LambdaHack.Point
import Game.LambdaHack.Vector
import Game.LambdaHack.Level
import Game.LambdaHack.Effect
import Game.LambdaHack.Perception
import Game.LambdaHack.Actor as Actor
import Game.LambdaHack.ActorState
import qualified Game.LambdaHack.Dungeon as Dungeon
import Game.LambdaHack.Content.ActorKind
import Game.LambdaHack.Content.TileKind
import Game.LambdaHack.Content.ItemKind
import qualified Game.LambdaHack.Item as Item
import Game.LambdaHack.Random
import qualified Game.LambdaHack.Kind as Kind
import qualified Game.LambdaHack.Feature as F
import Game.LambdaHack.Time
import Game.LambdaHack.Config
data ColorMode =
ColorFull
| ColorBW
draw :: ColorMode -> Kind.COps -> Perception -> State -> Overlay
-> SingleFrame
draw dm cops per s@State{ scursor=Cursor{..}
, sflavour, slid, splayer, sdebug
} overlay =
let Kind.COps{ coactor=Kind.Ops{okind}
, coitem=coitem@Kind.Ops{okind=iokind}
, cotile=Kind.Ops{okind=tokind, ouniqGroup} } = cops
DebugMode{smarkVision, somniscient} = sdebug
lvl@Level{lxsize, lysize, lsmell, ldesc, lactor, ltime, lclear, lseen} =
slevel s
(_, mpl@Actor{bkind, bhp, bloc}, bitems) = findActorAnyLevel splayer s
ActorKind{ahp, asmell} = okind bkind
reachable = debugTotalReachable per
visible = totalVisible per
(msgTop, over, msgBottom) = stringByLocation lxsize lysize overlay
(sSml, sVis) = case smarkVision of
Just Blind -> (True, True)
Just _ -> (False, True)
Nothing | asmell -> (True, False)
Nothing -> (False, False)
lAt = if somniscient then at else rememberAt
liAt = if somniscient then atI else rememberAtI
sVisBG = if sVis
then \ vis rea -> if vis
then Color.Blue
else if rea
then Color.Magenta
else Color.defBG
else \ _vis _rea -> Color.defBG
(_, wealth) = calculateTotal coitem s
damage = case Item.strongestSword cops bitems of
Just sw -> case ieffect $ iokind $ Item.jkind sw of
Wound dice -> showT dice <> "+" <> showT (Item.jpower sw)
_ -> showT (Item.jpower sw)
Nothing -> "3d1"
bl = fromMaybe [] $ bla lxsize lysize ceps bloc clocation
dis pxy =
let loc0 = toPoint lxsize pxy
tile = lvl `lAt` loc0
tk = tokind tile
items = lvl `liAt` loc0
sml = IM.findWithDefault timeZero loc0 lsmell
smlt = sml `timeAdd` timeNegate ltime
viewActor loc Actor{bkind = bkind2, bsymbol, bcolor}
| loc == bloc && slid == creturnLn =
(symbol, Color.defBG)
| otherwise = (symbol, color)
where
ActorKind{asymbol, acolor} = okind bkind2
color = fromMaybe acolor bcolor
symbol = fromMaybe asymbol bsymbol
rainbow loc = toEnum $ loc `rem` 14 + 1
actorsHere = IM.elems lactor
(char, fg0) =
case ( L.find (\ m -> loc0 == Actor.bloc m) actorsHere
, L.find (\ m -> clocation == Actor.bloc m) actorsHere ) of
(_, actorTgt) | ctargeting /= TgtOff
&& (slid == creturnLn
&& L.elem loc0 bl
|| (case actorTgt of
Just (Actor{ btarget=TPath p
, bloc=prLoc }) ->
L.elem loc0 $ shiftPath prLoc p
_ -> False))
->
let unknownId = ouniqGroup "unknown space"
in ('*', case (vis, F.Walkable `elem` tfeature tk) of
_ | tile == unknownId -> Color.BrBlack
(True, True) -> Color.BrGreen
(True, False) -> Color.BrRed
(False, True) -> Color.Green
(False, False) -> Color.Red)
(Just m, _) | somniscient || vis -> viewActor loc0 m
_ | sSml && smlt > timeZero ->
(timeToDigit (smellTimeout s) smlt, rainbow loc0)
| otherwise ->
case items of
[] -> (tsymbol tk, if vis then tcolor tk else tcolor2 tk)
i : _ -> Item.viewItem coitem (Item.jkind i) sflavour
vis = IS.member loc0 visible
rea = IS.member loc0 reachable
bg0 = if ctargeting /= TgtOff && loc0 == clocation
then Color.defFG
else sVisBG vis rea
reverseVideo = Color.Attr{ fg = Color.bg Color.defaultAttr
, bg = Color.fg Color.defaultAttr
}
optVisually attr@Color.Attr{fg, bg} =
if (fg == Color.defBG)
|| (bg == Color.defFG && fg == Color.defFG)
then reverseVideo
else attr
a = case dm of
ColorBW -> Color.defaultAttr
ColorFull -> optVisually Color.Attr{fg = fg0, bg = bg0}
in case over pxy of
Just c -> Color.AttrChar Color.defaultAttr c
_ -> Color.AttrChar a char
seenN = 100 * lseen `div` lclear
seenTxt | seenN == 100 = "all"
| otherwise = T.justifyRight 2 ' ' (showT seenN) <> "%"
braceSign | braced mpl ltime = "{"
| otherwise = " "
lvlN = T.justifyLeft 2 ' ' (showT $ Dungeon.levelNumber slid)
stats =
T.justifyLeft 11 ' ' ("[" <> seenTxt <+> "seen]") <+>
T.justifyLeft 9 ' ' ("$:" <+> showT wealth) <+>
T.justifyLeft 11 ' ' ("Dmg:" <+> damage) <+>
T.justifyLeft 13 ' ' (braceSign <> "HP:" <+> showT bhp
<+> "(" <> showT (maxDice ahp) <> ")")
widthForDesc = lxsize T.length stats T.length lvlN 3
status = lvlN <+> T.justifyLeft widthForDesc ' ' ldesc <+> stats
toWidth :: Int -> Text -> Text
toWidth n x = T.take n (T.justifyLeft n ' ' x)
fLine y =
let f l x = let !ac = dis (PointXY (x, y)) in ac : l
in L.foldl' f [] [lxsize1,lxsize2..0]
sfLevel =
let f l y = let !line = fLine y in line : l
in L.foldl' f [] [lysize1,lysize2..0]
sfTop = toWidth lxsize $ msgTop
sfBottom = toWidth (lxsize 1) $ fromMaybe status $ msgBottom
in SingleFrame{..}
animate :: State -> Diary -> Kind.COps -> Perception -> Animation
-> [Maybe SingleFrame]
animate s Diary{sreport} cops per anim =
let Level{lxsize, lysize} = slevel s
over = renderReport sreport
topLineOnly = padMsg lxsize over
basicFrame = draw ColorFull cops per s [topLineOnly]
in rederAnim lxsize lysize basicFrame anim