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 Game.LambdaHack.Msg
import qualified Game.LambdaHack.Color as Color
import Game.LambdaHack.State
import Game.LambdaHack.PointXY
import Game.LambdaHack.Point
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 Game.LambdaHack.FOV
import qualified Game.LambdaHack.Feature as F
import Game.LambdaHack.Time
data ColorMode =
ColorFull
| ColorBW
draw :: ColorMode -> Kind.COps -> Perception -> State -> Overlay
-> Color.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} = slevel s
(_, Actor{bkind, bhp, bloc}, bitems) = findActorAnyLevel splayer s
ActorKind{ahp, asmell} = okind bkind
reachable = debugTotalReachable per
visible = totalVisible per
(msgTop, over) = 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 -> show dice ++ "+" ++ show (Item.jpower sw)
_ -> show (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
sm = IM.findWithDefault timeZero loc0 lsmell
sml = sm `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
(char, fg0) =
case L.find (\ m -> loc0 == Actor.bloc m) (IM.elems lactor) of
_ | ctargeting /= TgtOff
&& slid == creturnLn
&& L.elem loc0 bl ->
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 && timeScale sml 10 >= smellTimeout s ->
(timeToDigit (smellTimeout s) sml, 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
status =
take 28 (ldesc ++ repeat ' ') ++
take 9 ("L: " ++ show (Dungeon.levelNumber slid) ++ repeat ' ') ++
take 11 ("$: " ++ show wealth ++ repeat ' ') ++
take 14 ("Dmg: " ++ damage ++ repeat ' ') ++
take 32 ("HP: " ++ show bhp ++
" (" ++ show (maxDice ahp) ++ ")" ++ repeat ' ')
toWidth :: Int -> String -> String
toWidth n x = take n (x ++ repeat ' ')
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 status
in Color.SingleFrame{..}
animate :: State -> Diary -> Kind.COps -> Perception -> Color.Animation
-> [Maybe Color.SingleFrame]
animate s Diary{sreport} cops per anim =
let xsize = lxsize $ slevel s
over = renderReport sreport
topLineOnly = padMsg xsize over
basicFrame = draw ColorFull cops per s [topLineOnly]
in rederAnim s basicFrame anim
rederAnim :: State -> Color.SingleFrame -> Color.Animation
-> [Maybe Color.SingleFrame]
rederAnim s basicFrame anim =
let Level{lxsize, lysize} = slevel s
modifyFrame Color.SingleFrame{sfLevel = levelOld, ..} am =
let fLine y lineOld =
let f l (x, acOld) =
let loc = toPoint lxsize (PointXY (x, y))
!ac = fromMaybe acOld $ IM.lookup loc am
in ac : l
in L.foldl' f [] (zip [lxsize1,lxsize2..0] (reverse lineOld))
sfLevel =
let f l (y, lineOld) = let !line = fLine y lineOld in line : l
in L.foldl' f [] (zip [lysize1,lysize2..0] (reverse levelOld))
in Just Color.SingleFrame{..}
in map (modifyFrame basicFrame) anim