Add custom cursor
This commit is contained in:
+5
-2
@@ -36,13 +36,16 @@ import qualified SDL as SDL
|
||||
import qualified SDL.Mixer as Mix
|
||||
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
|
||||
|
||||
cursorVis :: Bool -> IO ()
|
||||
cursorVis b = SDL.cursorVisible $= b
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
(sizex,sizey) <- loadConfig
|
||||
setupLoop
|
||||
(sizex,sizey)
|
||||
(doPreload >>= resizeSpareFBO sizex sizey)
|
||||
cleanUpPreload
|
||||
(cursorVis False >> doPreload >>= resizeSpareFBO sizex sizey)
|
||||
(\x -> cursorVis True >> cleanUpPreload x)
|
||||
(fmap (setWindowSize sizex sizey) firstWorld)
|
||||
( \preData w -> do
|
||||
startTicks <- SDL.ticks
|
||||
|
||||
@@ -42,10 +42,19 @@ fixedCoordPictures :: World -> Picture
|
||||
fixedCoordPictures w = pictures
|
||||
[ hudDrawings w
|
||||
, scaler . onLayer MenuLayer $ menuScreen w
|
||||
, customMouseCursor w
|
||||
]
|
||||
where
|
||||
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 w = [blank]
|
||||
|
||||
|
||||
@@ -14,7 +14,7 @@ import qualified Data.IntMap as IM
|
||||
import Control.Lens
|
||||
|
||||
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 . 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 w =
|
||||
[ closeObjectTexts w
|
||||
, scaler $ drawCursor (itCol (yourItem w)) w
|
||||
, scaler $ drawItemSelectCursor (itCol (yourItem w)) w
|
||||
]
|
||||
++ displayInv 0 w
|
||||
where
|
||||
@@ -67,9 +67,6 @@ drawLocations w = displayListTopLeft locs w
|
||||
zoom = _carteZoom w
|
||||
locTexts = fst . unzip $ locs
|
||||
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.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)
|
||||
@@ -158,8 +155,8 @@ dShadCol c p = pictures $
|
||||
, color c p
|
||||
]
|
||||
|
||||
drawCursor :: Color -> World -> Picture
|
||||
drawCursor c w = setLayer 1
|
||||
drawItemSelectCursor :: Color -> World -> Picture
|
||||
drawItemSelectCursor c w = setLayer 1
|
||||
$ translate (105-halfWidth w)
|
||||
(halfHeight w - (20* (fromIntegral iPos)) - 20
|
||||
)
|
||||
|
||||
+5
-5
@@ -8,11 +8,11 @@ import Graphics.Rendering.OpenGL (GLfloat)
|
||||
|
||||
perspectiveMatrix :: Float -> Float -> Point2 -> Point2 -> Point2 -> [GLfloat]
|
||||
perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
|
||||
let scalMat = Linear.Matrix.transpose $
|
||||
V4 (V4 (2*zoom/winx) 0 0 (0::GLfloat))
|
||||
(V4 0 (2*zoom/winy) 0 0)
|
||||
(V4 0 0 1 0)
|
||||
(V4 0 0 0 1)
|
||||
let scalMat = Linear.Matrix.transpose $ V4
|
||||
(V4 (2*zoom/winx) 0 0 (0::GLfloat))
|
||||
(V4 0 (2*zoom/winy) 0 0)
|
||||
(V4 0 0 0.5 0) --scale to make walls shorter
|
||||
(V4 0 0 0 1)
|
||||
rotMat = Linear.Matrix.transpose $
|
||||
V4 (V4 (cos rot) (sin (-rot)) 0 0)
|
||||
(V4 (sin rot) (cos rot) 0 0)
|
||||
|
||||
Reference in New Issue
Block a user