Hack partially working gui line to dropped items

This commit is contained in:
2021-07-28 20:58:39 +02:00
parent ee553c6e49
commit 25a6186e7b
5 changed files with 22 additions and 22 deletions
+1 -1
View File
@@ -34,7 +34,7 @@ import qualified Control.Foldl as F
--import Data.List --import Data.List
--import Data.Bifunctor --import Data.Bifunctor
--import Data.Function --import Data.Function
import qualified Data.IntMap.Strict as IM --import qualified Data.IntMap.Strict as IM
--import qualified Data.Map as M --import qualified Data.Map as M
--import qualified Data.Set as S --import qualified Data.Set as S
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
+3 -5
View File
@@ -214,7 +214,7 @@ closeObjectTexts w = pictures $ zipWith renderList [(0::Int)..] (map colAndText
let p' = ( pushout - halfWidth w + 130 let p' = ( pushout - halfWidth w + 130
, halfHeight w - 20* (fromIntegral invPos +1) + 2.5 , halfHeight w - 20* (fromIntegral invPos +1) + 2.5
) )
return $ lineCol return $ flip thickLineCol (1 / halfWidth w)
[(itScreenPos, withAlpha 0 col) [(itScreenPos, withAlpha 0 col)
,(sc p' , col) ,(sc p' , col)
,(sc p , col) ,(sc p , col)
@@ -222,8 +222,8 @@ closeObjectTexts w = pictures $ zipWith renderList [(0::Int)..] (map colAndText
{- | Colour picture and add black drop shadow. -} {- | Colour picture and add black drop shadow. -}
dShadCol :: Color -> Picture -> Picture dShadCol :: Color -> Picture -> Picture
dShadCol c p = pictures dShadCol c p = pictures
[ color c p [ color black $ uncurry translate (1.2,-1.2) p
, color black $ uncurry translate (1.2,-1.2) p , color c p
] ]
drawListCursor :: Color -> Int -> World -> Picture drawListCursor :: Color -> Int -> World -> Picture
@@ -264,9 +264,7 @@ cursorAt wth col xoff yoff yint w = winScale w
,( wth,12.5) ,( wth,12.5)
] ]
displayHP :: Int -> World -> Picture displayHP :: Int -> World -> Picture
displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $ displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $
scale 0.2 0.2 $ text $ reverse $ take 5 $ (++ repeat ' ') $ reverse $ show scale 0.2 0.2 $ text $ reverse $ take 5 $ (++ repeat ' ') $ reverse $ show
$ _crHP $ _creatures w IM.! n $ _crHP $ _creatures w IM.! n
+2 -1
View File
@@ -12,6 +12,7 @@ module Picture
, thickArc , thickArc
, thickCircle , thickCircle
, thickLine , thickLine
, thickLineCol
, circleSolid , circleSolid
, circleSolidCol , circleSolidCol
, circle , circle
@@ -260,7 +261,7 @@ thickLineCol ps t = pictures $ f ps
,(y +.+ n x y,c') ,(y +.+ n x y,c')
] : f ((y,c'):ys) ] : f ((y,c'):ys)
f _ = [] f _ = []
n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b)) n a b = (t*0.5) *.* safeNormalizeV (vNormal (a -.- b))
thickCircle :: Float -> Float -> Picture thickCircle :: Float -> Float -> Picture
{-# INLINE thickCircle #-} {-# INLINE thickCircle #-}
+1 -1
View File
@@ -19,7 +19,7 @@ import Control.Monad
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
import Graphics.GL.Core43 import Graphics.GL.Core43
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import Data.Bifunctor --import Data.Bifunctor
--import Text.RawString.QQ --import Text.RawString.QQ
--import Linear.Matrix --import Linear.Matrix
--import Linear.V4 --import Linear.V4
+15 -14
View File
@@ -10,8 +10,8 @@ import Shader.Data
import Shader.Parameters import Shader.Parameters
import Picture.Data import Picture.Data
import Data.Maybe --import Data.Maybe
import Data.List --import Data.List
import Foreign import Foreign
import Control.Monad import Control.Monad
import qualified Control.Foldl as F import qualified Control.Foldl as F
@@ -35,15 +35,16 @@ pokeVertices
-> IO Int -> IO Int
pokeVertices toFs ptr stride n rt = foldM (pokeVertex ptr stride) n (toFs rt) pokeVertices toFs ptr stride n rt = foldM (pokeVertex ptr stride) n (toFs rt)
getterPicShad :: VertexType -> Getting a (PicShads a) a getterPicShad :: VertexType -> PicShads a -> a
getterPicShad PolyV = psPoly --{-# INLINE getterPicShad #-}
getterPicShad PolyzV{} = psPolyz getterPicShad PolyV = _psPoly
getterPicShad BezV{} = psBez getterPicShad PolyzV{} = _psPolyz
getterPicShad TextV{} = psText getterPicShad BezV{} = _psBez
getterPicShad ArcV{} = psArc getterPicShad TextV{} = _psText
getterPicShad EllV = psEll getterPicShad ArcV{} = _psArc
getterPicShad EllV = _psEll
--setterPicShad :: VertexType -> ASetter setterPicShad :: VertexType -> ASetter (PicShads a) (PicShads a) a a
setterPicShad PolyV = psPoly setterPicShad PolyV = psPoly
setterPicShad PolyzV{} = psPolyz setterPicShad PolyzV{} = psPolyz
setterPicShad BezV{} = psBez setterPicShad BezV{} = psBez
@@ -55,8 +56,8 @@ pokeVX' :: PicShads VShader -> PicShads Int -> Verx -> IO (PicShads Int)
pokeVX' shads count vx = do pokeVX' shads count vx = do
let f = setterPicShad (_vxType vx) let f = setterPicShad (_vxType vx)
g = getterPicShad (_vxType vx) g = getterPicShad (_vxType vx)
vshad = shads ^. g vshad = g shads
n = count ^. g n = g count
theVBO = _vaoVBO $ _vshaderVAO vshad theVBO = _vaoVBO $ _vshaderVAO vshad
ptr = _vboPointer theVBO ptr = _vboPointer theVBO
stride = _vboStride theVBO stride = _vboStride theVBO
@@ -69,8 +70,8 @@ pokeVX shads laycounts vx = do
offset = _vxLayer vx offset = _vxLayer vx
counts = laycounts IM.! offset counts = laycounts IM.! offset
getF = getterPicShad theType getF = getterPicShad theType
vshad = shads ^. getF vshad = getF shads
n = counts ^. getF n = getF counts
theVBO = _vaoVBO $ _vshaderVAO vshad theVBO = _vaoVBO $ _vshaderVAO vshad
ptr = _vboPointer theVBO ptr = _vboPointer theVBO
stride = _vboStride theVBO stride = _vboStride theVBO