justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Make buttons without labels inactive

Browse Source
This commit is contained in:
jgk
2021-03-08 17:03:58 +01:00
parent 70f8914767
commit 9f58066dba
4 changed files with 52 additions and 89 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+2 -1
View File
@@ -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)
src/Dodge/CreatureActions.hs
+34 -67
View File
@@ -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
src/Dodge/KeyEvents.hs
+1 -9
View File
@@ -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
src/Dodge/Rendering.hs
+15 -12
View File
@@ -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