Add custom cursor

This commit is contained in:
2021-03-26 11:44:13 +01:00
parent b46adf9898
commit e3e54165a9
4 changed files with 23 additions and 14 deletions
+5 -2
View File
@@ -36,13 +36,16 @@ import qualified SDL as SDL
import qualified SDL.Mixer as Mix import qualified SDL.Mixer as Mix
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
cursorVis :: Bool -> IO ()
cursorVis b = SDL.cursorVisible $= b
main :: IO () main :: IO ()
main = do main = do
(sizex,sizey) <- loadConfig (sizex,sizey) <- loadConfig
setupLoop setupLoop
(sizex,sizey) (sizex,sizey)
(doPreload >>= resizeSpareFBO sizex sizey) (cursorVis False >> doPreload >>= resizeSpareFBO sizex sizey)
cleanUpPreload (\x -> cursorVis True >> cleanUpPreload x)
(fmap (setWindowSize sizex sizey) firstWorld) (fmap (setWindowSize sizex sizey) firstWorld)
( \preData w -> do ( \preData w -> do
startTicks <- SDL.ticks startTicks <- SDL.ticks
+9
View File
@@ -42,10 +42,19 @@ fixedCoordPictures :: World -> Picture
fixedCoordPictures w = pictures fixedCoordPictures w = pictures
[ hudDrawings w [ hudDrawings w
, scaler . onLayer MenuLayer $ menuScreen w , scaler . onLayer MenuLayer $ menuScreen w
, customMouseCursor w
] ]
where where
scaler = setDepth (-1) . scale (2 / _windowX w) (2 / _windowY w) scaler = setDepth (-1) . scale (2 / _windowX w) (2 / _windowY w)
customMouseCursor :: World -> Picture
customMouseCursor w =
setDepth (-1)
. scale (2 /_windowX w) (2/ _windowY w)
. uncurry translate (_mousePos w)
$ circleSolid 5
testPic :: World -> [Picture] testPic :: World -> [Picture]
testPic w = [blank] testPic w = [blank]
+4 -7
View File
@@ -14,7 +14,7 @@ import qualified Data.IntMap as IM
import Control.Lens import Control.Lens
hudDrawings :: World -> Picture hudDrawings :: World -> Picture
hudDrawings w = setLayer 1 . setDepth (-1) . pictures $ hudDrawings w = setLayer 1 . setDepth (-0.5) . pictures $
[ scaler . dShadCol white $ displayHP 0 w [ scaler . dShadCol white $ displayHP 0 w
, scaler . translate (-390) 20 . scale 0.05 0.05 . dShadCol white $ text (_testString w) , scaler . translate (-390) 20 . scale 0.05 0.05 . dShadCol white $ text (_testString w)
] ]
@@ -28,7 +28,7 @@ hudDrawings w = setLayer 1 . setDepth (-1) . pictures $
drawInventory :: World -> [Picture] drawInventory :: World -> [Picture]
drawInventory w = drawInventory w =
[ closeObjectTexts w [ closeObjectTexts w
, scaler $ drawCursor (itCol (yourItem w)) w , scaler $ drawItemSelectCursor (itCol (yourItem w)) w
] ]
++ displayInv 0 w ++ displayInv 0 w
where where
@@ -67,9 +67,6 @@ drawLocations w = displayListTopLeft locs w
zoom = _carteZoom w zoom = _carteZoom w
locTexts = fst . unzip $ locs locTexts = fst . unzip $ locs
bFunc (x,y) (z,w) = pictures bFunc (x,y) (z,w) = pictures
--[ bezierQuad (withAlpha 0.2 white) (withAlpha 0.2 white) 0.01 0.01 (x,y) (0,y) (z,w)
--, bezierQuad (withAlpha 0.5 white) (withAlpha 0.5 white) 0.005 0.005 (x,y) (0,y) (z,w)
--, bezierQuad (withAlpha 0.5 white) (withAlpha 0.5 white) 0.002 0.002 (x,y) (0,y) (z,w)
[ bezierQuad (withAlpha 0.0 white) (withAlpha 0.2 white) 0.050 0.010 (x,y) (0,y) (z,w) [ bezierQuad (withAlpha 0.0 white) (withAlpha 0.2 white) 0.050 0.010 (x,y) (0,y) (z,w)
, bezierQuad (withAlpha 0.0 white) (withAlpha 0.5 white) 0.045 0.005 (x,y) (0,y) (z,w) , bezierQuad (withAlpha 0.0 white) (withAlpha 0.5 white) 0.045 0.005 (x,y) (0,y) (z,w)
, bezierQuad (withAlpha 0.0 white) (withAlpha 0.5 white) 0.035 0.002 (x,y) (0,y) (z,w) , bezierQuad (withAlpha 0.0 white) (withAlpha 0.5 white) 0.035 0.002 (x,y) (0,y) (z,w)
@@ -158,8 +155,8 @@ dShadCol c p = pictures $
, color c p , color c p
] ]
drawCursor :: Color -> World -> Picture drawItemSelectCursor :: Color -> World -> Picture
drawCursor c w = setLayer 1 drawItemSelectCursor c w = setLayer 1
$ translate (105-halfWidth w) $ translate (105-halfWidth w)
(halfHeight w - (20* (fromIntegral iPos)) - 20 (halfHeight w - (20* (fromIntegral iPos)) - 20
) )
+3 -3
View File
@@ -8,10 +8,10 @@ import Graphics.Rendering.OpenGL (GLfloat)
perspectiveMatrix :: Float -> Float -> Point2 -> Point2 -> Point2 -> [GLfloat] perspectiveMatrix :: Float -> Float -> Point2 -> Point2 -> Point2 -> [GLfloat]
perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) = perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
let scalMat = Linear.Matrix.transpose $ let scalMat = Linear.Matrix.transpose $ V4
V4 (V4 (2*zoom/winx) 0 0 (0::GLfloat)) (V4 (2*zoom/winx) 0 0 (0::GLfloat))
(V4 0 (2*zoom/winy) 0 0) (V4 0 (2*zoom/winy) 0 0)
(V4 0 0 1 0) (V4 0 0 0.5 0) --scale to make walls shorter
(V4 0 0 0 1) (V4 0 0 0 1)
rotMat = Linear.Matrix.transpose $ rotMat = Linear.Matrix.transpose $
V4 (V4 (cos rot) (sin (-rot)) 0 0) V4 (V4 (cos rot) (sin (-rot)) 0 0)