--{-# LANGUAGE TupleSections #-} module Dodge.Render.Picture ( worldPictures , wallsAndWindows , lightsForGloom , fixedCoordPictures ) where import Dodge.Data --import Dodge.Update.Camera --import Dodge.GameRoom import Dodge.Base import Dodge.Base.Window import Dodge.Zone import Dodge.Graph import Dodge.Picture.SizeInvariant import Dodge.Picture.Layer import Dodge.Render.HUD import Dodge.Render.MenuScreen import Dodge.Render.ShapePicture import Dodge.SoundLogic.LoadSound import Dodge.Config.Data import Dodge.GameRoom import Dodge.Update.Camera import Sound.Data import Geometry import Picture import ShapePicture import Control.Lens import Data.Maybe import Data.List (partition) import qualified Data.IntMap.Lazy as IM import qualified Data.Map as M worldPictures :: World -> Picture worldPictures w = pictures [pictures (_decorations w) ,concatMapPic (_spPicture . dbArg _prDraw) $ _props w ,concatMapPic (crDraw w) . IM.filter crIsClose $ _creatures w ,concatMapPic (dbArg _ptDraw) $ _particles w ,concatMapPic (dbArg _lsPict) $ _lightSources w ,testPic w ,concatMapPic (_spPicture . floorItemSPic) $ _floorItems w ,concatMapPic clDraw $ _clouds w ,concatMapPic ppDraw $ _pressPlates w ,concatMapPic btDraw $ _buttons w ,concatMapPic drawWallFloor $ wallFloorsToDraw w ,soundPics w ,viewBoundaries w ,drawPathing w ] where crIsClose cr = dist (_crPos cr) camCen < winSize winSize = 30 + max (getWindowX w) (getWindowY w) camCen = _cameraCenter w fixedCoordPictures :: World -> Picture fixedCoordPictures w = case _menuLayers w of [] -> pictures [ hudDrawings w , customMouseCursor w ] (lay:_) -> scaler . onLayer MenuDepth $ menuScreen w lay where scaler = setDepth (-1) . scale (2 / getWindowX w) (2 / getWindowY w) customMouseCursor :: World -> Picture customMouseCursor w = scale (2 /getWindowX w) (2/ getWindowY w) . uncurryV translate (_mousePos w) . color white $ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ] testPic :: World -> Picture testPic _ = [] drawPathing :: World -> Picture drawPathing w | _debug_pathing (_config w) = -- setLayer 5 $ (color green . pictures . map (flip thickLine 5 . tflat2) $ graphToEdges gr) <> concatMap dispInc (graphToIncidence gr) | otherwise = [] where dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n gr = _pathGraph w viewBoundaries :: World -> Picture viewBoundaries w | _debug_view_boundaries (_config w) = setLayer 5 $ color green (concatMap (polygonWire . _grBound) grs) <> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w) | otherwise = [] where p = _crPos $ you w grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) soundPics :: World -> Picture soundPics w | _show_sound (_config w) = pictures $ M.map (soundPic w) $ _playingSounds w | otherwise = [] soundPic :: World -> Sound -> Picture soundPic w s = fixedSizePicClampArrow 50 50 thePic p w where p = _soundPos s thePic = rotate (_cameraRot w) . scale theScale theScale . centerText . soundToOnomato $ _soundChunkID s theScale = 0.15 * f (_soundVolume s * 0.0001) f x = 1 - 0.5 * (1 - x) crDraw :: World -> Creature -> Picture crDraw w c = _spPicture $ _crPict c c w ppDraw :: PressPlate -> Picture ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c) btDraw :: Button -> Picture btDraw c = uncurryV translate (_btPos c) $ rotate (_btRot c) (_spPicture $ _btPict c c) clDraw :: Cloud -> Picture clDraw c = translate3 (_clPos c) (_clPict c c) wallFloorsToDraw :: World -> [Wall] wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w where onScreen wall = uncurry (lineOnScreen w) $ _wlLine wall isVisible wl | wl ^? wlDraw == Just False = False | otherwise = onScreen wl lineOnScreen :: World -> Point2 -> Point2 -> Bool lineOnScreen w p1 p2 = pointInPolygon p1 sp || pointInPolygon p2 sp || any (isJust . uncurry (intersectSegSeg p1 p2)) sps where sp = screenPolygon w sps = zip sp (tail sp ++ [head sp]) drawWallFloor :: Wall -> Picture drawWallFloor wl = if _wlIsSeeThrough wl then setDepth 0.9 . color c $ polygon [x,x +.+ n2,y+.+n2, y] else blank where (x,y) = _wlLine wl c = _wlColor wl n2 = 15 *.* (vNormal . errorNormalizeVDR $ y -.- x) errorNormalizeVDR :: Point2 -> Point2 errorNormalizeVDR (V2 0 0) = error "problem with function: errorNormalizeVDR in DodgeRendering" errorNormalizeVDR p = normalizeV p wallsAndWindows :: World -> ( [((Point2,Point2),Point4)] ,[((Point2,Point2),Point4)] ) wallsAndWindows w = (map f wls, map f wins) where f wl = (_wlLine wl, _wlColor wl) (wins,wls) = partition _wlIsSeeThrough . IM.elems . IM.filter _wlDraw $ wallsDoubleScreen w lightsForGloom :: World -> [(Point3,Float,Point3)] lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTLS (_tempLightSources w) where getLS ls | dist campos (fst2 $ _lsPos ls) > 1000 = Nothing | otherwise = Just ( _lsPos ls, _lsRad ls^(2::Int) , _lsIntensity ls) getTLS ls | dist campos (fst2 $ _tlsPos ls) > 1000 = Nothing | otherwise = Just ( _tlsPos ls, _tlsRad ls^(2::Int), _tlsIntensity ls) campos = _cameraCenter w fst2 (V3 a b _) = V2 a b