justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Partially working ellipse shader

Browse Source
This commit is contained in:
justin
2021-03-10 03:29:10 +01:00
parent bfbd0b6fef
commit cddf7d1f8f
12 changed files with 229 additions and 172 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Rendering.hs
+3 -105
View File
@@ -2,7 +2,9 @@ module Dodge.Rendering where
-- imports {{{
import Dodge.Data
import Dodge.Base
import Dodge.Inventory
--import Dodge.Inventory
import Dodge.Rendering.HUD
import Geometry
import Picture
@@ -14,7 +16,6 @@ import Control.Monad.State
import Data.List
import Data.Bifunctor
import Data.Function
import Control.Applicative
import Control.Lens
@@ -56,109 +57,6 @@ fixedCoordPictures w = pictures
]
where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
closeObjectTexts :: World -> Picture
closeObjectTexts w = pictures $ (zipWith ren [0..] $ map toTs $ _closeActiveObjects w)
++ maybeToList maybeLine
where toTs (Left x) = (_itInvColor $ _flIt x, _itName $ _flIt x)
toTs (Right x) = (white, _btText x)
ren i (c,t) = scale (2/_windowX w) (2/_windowY w)
. tran
. translate (xtran i) (0 - 20 * fromIntegral i)
. scale 0.1 0.1 $ color c $ text t
tran = case freeSlot of
Just i -> translate (pushout - halfWidth w) (halfHeight w - 20* (fromIntegral i +1))
Nothing -> translate (0.25*_windowX w) (0.25*_windowY w)
freeSlot = checkInvSlotsYou' (fmap _flIt mayIt) w
mayObj = listToMaybe $ _closeActiveObjects w
mayIt = mayObj >>= maybeLeft
maybeLeft (Left x) = Just x
maybeLeft _ = Nothing
pushout = 200
xtran 0 = case mayIt of Nothing -> 25
_ -> -25
xtran _ = 0
objPos obj = case obj of Left flit -> _flItPos flit
Right bt -> _btPos bt
objText obj = case obj of Left flit -> _itName $ _flIt flit
Right bt -> _btText bt
mayScreenPos = fmap objPos mayObj >>= (\thePos -> Just (sc $ rotateV (0 - _cameraRot w) $ _cameraZoom w *.* (thePos -.- _cameraPos w)))
sc (x, y) = (x*2/_windowX w, y*2/_windowY w)
maybeLine = do
itScreenPos <- mayScreenPos
theText <- fmap objText mayObj
let textWidth = 9 * fromIntegral (length theText)
let col = fromMaybe white $ fmap (_itInvColor . _flIt) mayIt
let p = case freeSlot of
Just i -> ( textWidth + xtran 0 + pushout - halfWidth w
, halfHeight w - 20* (fromIntegral i +1) + 2.5
)
Nothing -> ( 0.25*_windowX w
, 0.25*_windowY w
)
let p' = case freeSlot of
Just i -> ( pushout - halfWidth w + 130
, halfHeight w - 20* (fromIntegral i +1) + 2.5
)
Nothing -> ( 0.25*_windowX w
, 0.25*_windowY w
)
return $ lineCol
[(itScreenPos, withAlpha 0 col)
,(sc p' , col)
,(sc p , col)
]
activeObjectText :: World -> Picture
activeObjectText w = case closestActiveObject w of
Nothing -> Blank
Just (Right bt) -> pictures
[ scale (2/_windowX w) (2/_windowY w)
$ translate (0.35*_windowX w) (0.25*_windowY w)
$ scale 0.1 0.1 $ text $ _btText bt
, lineCol [(p , withAlpha 0 white)
,((0.5,0.5) , white )
,((0.65,0.5), white )
]
]
where sc (x, y) = (x*2/_windowX w, y*2/_windowY w)
p = sc $ rotateV (0 - _cameraRot w) $ _cameraZoom w *.* (_btPos bt -.- _cameraPos w)
Just (Left flit)
-> pictures
[ color col $ scale (2/_windowX w) (2/_windowY w)
$ t
$ scale 0.1 0.1 $ text itText
, lineCol [(itScreenPos, withAlpha 0 col)
,(sc p' , col)
,(sc p , col)
]
]
where sc (x, y) = (x*2/_windowX w, y*2/_windowY w)
col = _itInvColor theIt
theIt = _flIt flit
itScreenPos = sc $ rotateV (0 - _cameraRot w) $ _cameraZoom w *.* (_flItPos flit -.- _cameraPos w)
freeSlot = checkInvSlotsYou theIt w
t = case freeSlot of
Just i -> translate (pushout - halfWidth w) (halfHeight w - 20* (fromIntegral i +1))
Nothing -> translate (0.25*_windowX w) (0.25*_windowY w)
p = case freeSlot of
Just i -> ( pushout - halfWidth w + textWidth
, halfHeight w - 20* (fromIntegral i +1) + 2.5
)
Nothing -> ( 0.25*_windowX w
, 0.25*_windowY w
)
p' = case freeSlot of
Just i -> ( pushout - halfWidth w + 130
, halfHeight w - 20* (fromIntegral i +1) + 2.5
)
Nothing -> ( 0.25*_windowX w
, 0.25*_windowY w
)
itText = _itName $ _flIt flit
textWidth = 9 * fromIntegral (length itText)
pushout = 80
worldPictures :: World -> Picture
worldPictures w