From 9f58066dbaddec8d94509b6e1b4e4d17d57bbb4b Mon Sep 17 00:00:00 2001 From: jgk Date: Mon, 8 Mar 2021 17:03:58 +0100 Subject: [PATCH] Make buttons without labels inactive --- app/Main.hs | 3 +- src/Dodge/CreatureActions.hs | 101 ++++++++++++----------------------- src/Dodge/KeyEvents.hs | 10 +--- src/Dodge/Rendering.hs | 27 +++++----- 4 files changed, 52 insertions(+), 89 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 0de3df4ad..4915ad4a9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -63,7 +63,8 @@ main = do blendFunc $= (SrcAlpha,OneMinusSrcAlpha) renderTree (_renderData preData) (_cameraRot w) (_cameraZoom w) (_cameraPos w) (_windowX w,_windowY w) - (picToLTree (Just 1) $ fixedCoordPictures w) + --(picToLTree (Just 1) $ fixedCoordPictures w) + (picToLTree Nothing $ fixedCoordPictures w) endRenderTicks <- SDL.ticks playSoundQueue (_soundData preData) (_soundQueue w) newSoundData <- playAndUpdate (_sounds w) (_soundData preData) diff --git a/src/Dodge/CreatureActions.hs b/src/Dodge/CreatureActions.hs index 78de6cd5d..a68621e90 100644 --- a/src/Dodge/CreatureActions.hs +++ b/src/Dodge/CreatureActions.hs @@ -5,6 +5,7 @@ import Dodge.Data import Dodge.Base import Dodge.SoundLogic import Dodge.WorldActions +import Dodge.Inventory import Geometry import Picture @@ -244,39 +245,6 @@ useItem2 n (Weapon {_wpFire=eff}) w = eff n w useItem2 n (Throwable {_twFire = eff}) w = eff n w useItem2 _ _ w = w -rmInvItem :: Int -> World -> World -rmInvItem n w = - let i = _crInvSel (_creatures w IM.! n) - item = _crInv (_creatures w IM.! n) IM.! i - itRef = creatures . ix n . crInv . ix i - in case item of - Consumable {_itAmount = 1} -> set itRef NoItem w - Craftable {_itAmount = 1} -> set itRef NoItem w - Equipment {_itAmount = 1} -> set itRef NoItem w - Throwable {_itAmount = 1} -> set itRef NoItem w - Consumable {_itAmount = x} -> over (itRef . itAmount) (\y-> y-1) w - Craftable {_itAmount = x} -> over (itRef . itAmount) (\y-> y-1) w - Equipment {_itAmount = x} -> over (itRef . itAmount) (\y-> y-1) w - Throwable {_itAmount = x} -> over (itRef . itAmount) (\y-> y-1) w - _ -> set itRef NoItem w - -dropItem :: World -> World -dropItem w = case yourItem w of - NoItem -> w - it -> rmInvItem (_yourID w) $ over floorItems (IM.insert flid theflit) - $ updateLocation - $ soundOnce putDownSound - $ set randGen g w - where (rot, g) = randomR (-pi,pi) $ _randGen w - offset = _crRad (you w) *.* unitVectorAtAngle rot - updateLocation w = case it ^? itID of - Just (Just i) -> w & itemPositions . ix i .~ OnFloor flid - _ -> w - flid = newKey $ _floorItems w - theflit = FlIt {_flIt = set itAmount 1 it - ,_flItPos = offset +.+ _crPos (you w) - ,_flItRot = rot - ,_flItID = flid} useItemAmmoCheck :: Int -> World -> World useItemAmmoCheck n w @@ -292,40 +260,6 @@ useItemAmmoCheck n w _ -> False -closestItem :: World -> Maybe Int -closestItem w = fmap fst $ listToMaybe $ sortBy cf $ IM.toList - $ fmap (dist yourP . _flItPos) $ _floorItems w - where yourP = _crPos $ you w - cf (_,x) (_,y) = compare x y - -pickUpItem' :: FloorItem -> World -> World -pickUpItem' flit w = case maybeInvSlot of - Nothing -> w - Just i -> soundOnce pickUpSound - $ updateItLocation i - $ w & floorItems %~ IM.delete (_flItID flit) - & creatures . ix 0 . crInv . ix i %~ addItem' it - where - it = _flIt flit - maybeInvSlot = checkInvSlots it (_crInv (_creatures w IM.! 0)) - updateItLocation invid w' - = case _itID it of Nothing -> w' - Just j -> w' & itemPositions . ix j .~ InInv 0 invid - -checkInvSlots :: Item -> IM.IntMap Item -> Maybe Int -checkInvSlots it its = fmap fst $ find cond $ IM.toList its - where cond (_,NoItem) = True - cond (_,it' ) = itNotFull it' && _itName it == _itName it' - -addItem' :: Item -> Item -> Item -addItem' it NoItem = it -addItem' it it' = it' & itAmount +~ 1 - -numInventorySlots :: Int -numInventorySlots = 9 - -itNotFull :: Item -> Bool -itNotFull it = _itMaxStack it > _itAmount it createItemAt :: Point2 -> FloorItem -> World -> World createItemAt p it w = over floorItems (IM.insert i (set flItPos p @@ -360,3 +294,36 @@ reverseDir n = over (creatures . ix n . crDir) (+ pi) turnBy :: Float -> Int -> World -> World turnBy a n = over (creatures . ix n . crDir) (+ a) + +dropItem :: World -> World +dropItem w = case yourItem w of + NoItem -> w + it -> rmInvItem (_yourID w) $ over floorItems (IM.insert flid theflit) + $ updateLocation + $ soundOnce putDownSound + $ set randGen g w + where (rot, g) = randomR (-pi,pi) $ _randGen w + offset = _crRad (you w) *.* unitVectorAtAngle rot + updateLocation w = case it ^? itID of + Just (Just i) -> w & itemPositions . ix i .~ OnFloor flid + _ -> w + flid = newKey $ _floorItems w + theflit = FlIt {_flIt = set itAmount 1 it + ,_flItPos = offset +.+ _crPos (you w) + ,_flItRot = rot + ,_flItID = flid} + +pickUpItem' :: FloorItem -> World -> World +pickUpItem' flit w = case maybeInvSlot of + Nothing -> w + Just i -> soundOnce pickUpSound + $ updateItLocation i + $ w & floorItems %~ IM.delete (_flItID flit) + & creatures . ix 0 . crInv . ix i %~ addItem it + where + it = _flIt flit + maybeInvSlot = checkInvSlots it (_crInv (_creatures w IM.! 0)) + updateItLocation invid w' + = case _itID it of Nothing -> w' + Just j -> w' & itemPositions . ix j .~ InInv 0 invid + diff --git a/src/Dodge/KeyEvents.hs b/src/Dodge/KeyEvents.hs index eef50e7db..615da578e 100644 --- a/src/Dodge/KeyEvents.hs +++ b/src/Dodge/KeyEvents.hs @@ -4,6 +4,7 @@ import Dodge.Data import Dodge.Base import Dodge.CreatureActions import Dodge.SoundLogic +import Dodge.Inventory import Geometry @@ -170,15 +171,6 @@ mouseActionsWorld keys w ---theItem = _crInv (you w) IM.! _crInvSel (you w) rotation = angleBetween (_mousePos w) (_lbClickMousePos w) --- for now, left are floor items, right are buttons -closestActiveObject :: World -> Maybe (Either FloorItem Button) -closestActiveObject w = listToMaybe $ sortBy (compare `on` dist ypos . pos) $ actObjs - where ypos = _crPos $ you w - actObjs = filter (\obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w) - $ map Left (IM.elems $ _floorItems w) ++ map Right (IM.elems $ _buttons w) - pos (Right x) = _btPos x - pos (Left x) = _flItPos x - spaceAction :: World -> World spaceAction w = case closestActiveObject w of Just (Left flit) -> pickUpItem' flit w diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index 0b2f64c88..92a3cee64 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Rendering.hs @@ -2,6 +2,8 @@ module Dodge.Rendering where -- imports {{{ import Dodge.Data import Dodge.Base +import Dodge.Inventory + import Geometry import Picture @@ -27,6 +29,7 @@ fixedCoordPictures w = pictures -- [ scaler $ onLayer LabelLayer $ pictures [ppLabels, btLabels] [ scaler $ hudDrawings w , scaler $ onLayer MenuLayer menuScreen + , onLayer InvLayer $ activeObjectText w ] where scaler = scale (2 / _windowX w) (2 / _windowY w) menuScreen :: Picture @@ -52,6 +55,18 @@ fixedCoordPictures w = pictures ] where tst x y sc t = translate x y $ scale sc sc $ color white $ text t +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) + $ scale 0.1 0.1 $ text $ _btText bt + , line [ (0,0),(0.5,0.5)] + ] + where btp = _btPos bt + Just (Left flit) -> blank + worldPictures :: World -> Picture worldPictures w = pictures $ concat [ decPicts @@ -86,9 +101,6 @@ worldPictures w yourPos = _crPos $ you w yourRot = _crDir $ you w yourRad = _crRad $ you w - -- itFloorPicts = zipWith (uncurry translate) (map _flItPos (IM.elems (_floorItems w))) - -- (map (_itFloorPict . _flIt) (IM.elems (_floorItems w))) - -- scaler = onLayer LabelLayer . setLayer 1 itLabels = map (scaler . drawItemName w) (IM.elems (_floorItems w)) ppLabels = map (scaler . drawPPText w) (IM.elems (_pressPlates w)) @@ -378,21 +390,12 @@ drawButText w bt | magV (_crPos (you w) -.- _btPos bt) < 100 , tranItPos' $ line [(-8,10),(-15,10),(-15,-10),(-8,-10)] , tranItPos' $ line [( 8,10),( 15,10),( 15,-10),( 8,-10)] ] --- = t $ rotate (_cameraRot w) --- $ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)] --- , scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)] --- ,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white --- $ scale 0.1 0.1 $ text $ _btText bt --- ] | otherwise = blank where tranItPos' = uncurry translate (_btPos bt) . rotate (_cameraRot w) t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w)) . rotate (_cameraRot w) zoom = _cameraZoom w --- where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w)) --- zoom = _cameraZoom w --- scLine = dShadCol white . line . fmap (sqrt zoom *.*) drawPPText :: World -> PressPlate -> Picture drawPPText w pp | magV (_crPos (you w) -.- _ppPos pp) < 100