From 2310bd1b090ae8471bedf6d8ea9620f80aa0f806 Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 9 Mar 2021 01:18:44 +0100 Subject: [PATCH] Improve control over floor items and buttons --- app/Main.hs | 1 - src/Dodge/Data.hs | 1 + src/Dodge/KeyEvents.hs | 8 +++-- src/Dodge/Prototypes.hs | 1 + src/Dodge/Rendering.hs | 69 ++++++++++++++++++++++++++++++++++++----- src/Dodge/Update.hs | 2 ++ src/Loop.hs | 1 + 7 files changed, 72 insertions(+), 11 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 4915ad4a9..e24d34de7 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -31,7 +31,6 @@ import System.Random import qualified SDL as SDL import qualified SDL.Mixer as Mix import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) ---Mix.openAudio Mix.defaultAudio 256 >> initWorld = initialWorld { _randGen = mkStdGen 2 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index d7a3d12c3..67ad1b543 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -86,6 +86,7 @@ data World = World , _mapDisplay :: (Bool, Float) , _lightSources :: !(IM.IntMap LightSource) , _tempLightSources :: ![TempLightSource] + , _closeActiveObjects :: [Either FloorItem Button] } --deriving (Show) type Drawing = Picture diff --git a/src/Dodge/KeyEvents.hs b/src/Dodge/KeyEvents.hs index 615da578e..5ac62c3ed 100644 --- a/src/Dodge/KeyEvents.hs +++ b/src/Dodge/KeyEvents.hs @@ -104,7 +104,8 @@ wheelUpEvent :: World -> World wheelUpEvent w = case _mapDisplay w of (True,z) -> w & mapDisplay . _2 .~ min 0.3 (z+(0.1*z)) - _ | rbPressed -> fromMaybe w $ (yourItem w ^? itScrollUp) <*> pure (_crInvSel (you w)) + _ | rbPressed -> fromMaybe (closeObjScrollUp w) + $ (yourItem w ^? itScrollUp) <*> pure (_crInvSel (you w)) <*> pure w | lbPressed -> w {_cameraZoom = _cameraZoom w + 0.1} | otherwise -> upInvPos w @@ -115,7 +116,8 @@ wheelDownEvent :: World -> World wheelDownEvent w = case _mapDisplay w of (True,z) -> w & mapDisplay . _2 .~ max 0.05 (z-(0.1*z)) - _ | rbPressed -> fromMaybe w $ (yourItem w ^? itScrollDown) <*> pure (_crInvSel (you w)) + _ | rbPressed -> fromMaybe (closeObjScrollDown w) + $ (yourItem w ^? itScrollDown) <*> pure (_crInvSel (you w)) <*> pure w | lbPressed -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01} | otherwise -> downInvPos w @@ -172,7 +174,7 @@ mouseActionsWorld keys w rotation = angleBetween (_mousePos w) (_lbClickMousePos w) spaceAction :: World -> World -spaceAction w = case closestActiveObject w of +spaceAction w = case listToMaybe $ _closeActiveObjects w of Just (Left flit) -> pickUpItem' flit w Just (Right but) -> _btEvent but but w Nothing -> w diff --git a/src/Dodge/Prototypes.hs b/src/Dodge/Prototypes.hs index 63a124edf..046d35416 100644 --- a/src/Dodge/Prototypes.hs +++ b/src/Dodge/Prototypes.hs @@ -224,6 +224,7 @@ basicWorld = World , _mapDisplay = (False, 0.2) , _lightSources = IM.empty , _tempLightSources = [youLight] + , _closeActiveObjects = [] } youLight = -- LS {_lsEff = \w _ p -> (logistic 1 1 1 (d p w * 0.01) ) diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index 50f190670..51ab6ae2d 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Rendering.hs @@ -29,7 +29,8 @@ fixedCoordPictures w = pictures -- [ scaler $ onLayer LabelLayer $ pictures [ppLabels, btLabels] [ scaler $ hudDrawings w , scaler $ onLayer MenuLayer menuScreen - , onLayer InvLayer $ activeObjectText w + --, onLayer InvLayer $ activeObjectText w + , onLayer InvLayer $ closeObjectTexts w ] where scaler = scale (2 / _windowX w) (2 / _windowY w) menuScreen :: Picture @@ -55,18 +56,72 @@ 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 -> ( pushout - halfWidth w + textWidth + , 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.25*_windowX w) (0.25*_windowY w) + $ translate (0.35*_windowX w) (0.25*_windowY w) $ scale 0.1 0.1 $ text $ _btText bt - , line [sc $ rotateV (0 - _cameraRot w) $ _cameraZoom w *.* (_btPos bt -.- _cameraPos w) - ,(0.5,0.5) - ] + , 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) @@ -506,8 +561,8 @@ drawFFShadow w ff , y] displayHP :: Int -> World -> Picture -displayHP n w = translate (halfWidth w-70) (halfHeight w-40) $ - scale 0.2 0.2 $ text $ show +displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $ + scale 0.2 0.2 $ text $ reverse $ take 5 $ (++ repeat ' ') $ reverse $ show $ _crHP $ _creatures w IM.! n testPic w = blank diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index fbfcfb0cb..66f44688b 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -6,6 +6,7 @@ import Dodge.WallCreatureCollisions import Dodge.LevelGen.Block import Dodge.Camera import Dodge.SoundLogic +import Dodge.Inventory import Geometry @@ -34,6 +35,7 @@ update w $ updateBlocks -- $ zoning $ updateSeenWalls $ updateSoundQueue + $ updateCloseObjects w w2 = -- updateWeaponCounters $ simpleCrSprings diff --git a/src/Loop.hs b/src/Loop.hs index 50bf646fb..cd296d6f4 100644 --- a/src/Loop.hs +++ b/src/Loop.hs @@ -61,6 +61,7 @@ setupLoop wName xSize ySize GL.clearColor $= GL.Color4 0 0.5 0 1 GL.clearDepth $= (200) swapInterval $= ImmediateUpdates + GL.lineSmooth $= GL.Enabled doLoop setup window startWorld sideEffects eventFn worldFn )