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

Add 8-way cardinal/intercardinal datatype

Browse Source
This commit is contained in:
justin
2024-10-18 12:39:46 +01:00
parent d256bc0443
commit 8b6f5529ff
12 changed files with 267 additions and 157 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/CardinalPoint.hs
+11
View File
@@ -12,3 +12,14 @@ cardVec cp = case cp of
South -> V2 0 (-1)
East -> V2 1 0
West -> V2 (-1) 0
cardEightVec :: CardinalEightPoint -> Point2
cardEightVec cp = case cp of
North8 -> V2 0 1
NorthEast8 -> V2 1 1
East8 -> V2 1 0
SouthEast8 -> V2 1 (-1)
South8 -> V2 0 (-1)
SouthWest8 -> V2 (-1) (-1)
West8 -> V2 (-1) 0
NorthWest8 -> V2 (-1) 1
src/Dodge/Data/CardinalPoint.hs
+12 -1
View File
@@ -5,7 +5,18 @@ data CardinalPoint
| East
| South
| West
deriving (Eq, Ord, Show)
deriving (Eq, Ord, Show, Bounded, Enum)
data CardinalEightPoint
= North8
| NorthEast8
| East8
| SouthEast8
| South8
| SouthWest8
| West8
| NorthWest8
deriving (Eq, Ord, Show, Bounded, Enum)
data CardinalCover
= NSEW
src/Dodge/Data/HUD.hs
+8 -1
View File
@@ -19,9 +19,15 @@ data HUDElement
}
| DisplayCarte
data MouseInventorySelection = NoMouseSel
| MouseInvSelect
{_misSelStart :: (Int,Int), _misMaybeEnd :: Maybe (Int,Int)}
| MouseInvChosen
{_misChosenStart :: (Int,Int), _misChosenEnd :: (Int,Int)}
data SubInventory
= NoSubInventory
{ _nsSelected :: Maybe (Int,Int)
{ _nsSelected :: MouseInventorySelection
, _nsMouseOver :: Maybe (Int,Int)
}
| ExamineInventory
@@ -44,3 +50,4 @@ data HUD = HUD
makeLenses ''HUD
makeLenses ''HUDElement
makeLenses ''SubInventory
makeLenses ''MouseInventorySelection
src/Dodge/Default/World.hs
+4 -1
View File
@@ -161,7 +161,10 @@ defaultHUD =
defaultDisplayInventory :: HUDElement
defaultDisplayInventory =
DisplayInventory
{ _subInventory = NoSubInventory {_nsSelected = Just (0,2), _nsMouseOver = Just (0,3)}
{ _subInventory = NoSubInventory
{_nsSelected = MouseInvChosen (0,0) (0,2)
, _nsMouseOver = Just (0,3)
}
, _diSections = defaultInvSections
}
src/Dodge/DisplayInventory.hs
+1 -1
View File
@@ -31,7 +31,7 @@ import Regex
toggleCombineInv :: Universe -> Universe
toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory
.~ NoSubInventory Nothing Nothing
.~ NoSubInventory NoMouseSel Nothing
_ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
updateCombinePositioning :: Universe -> Universe
src/Dodge/Render/HUD.hs
+36 -5
View File
@@ -3,6 +3,7 @@
module Dodge.Render.HUD (
drawHUD,
selNumPos, -- this shoud probably be pushed back here
selNumPosCardinal, -- this shoud probably be pushed back here
) where
import Dodge.SelectionSections
@@ -30,7 +31,6 @@ import Dodge.Render.Connectors
import Dodge.Render.HUD.Carte
import Dodge.Render.List
import Dodge.ScreenPos
import Dodge.SelectionSections
import Dodge.SelectionSections.Draw
import Geometry
import qualified IntMapHelp as IM
@@ -80,13 +80,19 @@ drawDIMouseOver w = fromMaybe mempty $ do
let idp = invDisplayParams w
return . color (withAlpha 0.5 white) $ selSecDrawCursorAt (0,i) 10 idp sss
getMouseInvSel :: World -> Maybe ((Int,Int),(Int,Int))
getMouseInvSel w = case w ^? hud . hudElement . subInventory . nsSelected of
Just (MouseInvSelect s (Just e)) -> Just (s,e)
Just (MouseInvChosen s e) -> Just (s,e)
_ -> Nothing
drawDISelections :: World -> Configuration -> Picture
drawDISelections w cfig = fromMaybe mempty $ do
(i,j) <- w ^? hud . hudElement . subInventory . nsSelected . _Just
((i,j),(a,b)) <- getMouseInvSel w
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
tp <- selNumPos cfig idp sss 0 i
bp <- selNumPos cfig idp sss 0 j
tp <- selNumPosCardinal NorthWest8 cfig idp sss i j
bp <- selNumPosCardinal SouthWest8 cfig idp sss a b
return . color red $ line [tp,bp]
@@ -353,12 +359,37 @@ selNumPos ::
Int ->
Int ->
Maybe Point2
selNumPos cfig ldp sss i j = do
selNumPos = selNumPosCardinal West8
--selNumPos cfig ldp sss i j = do
-- ipos <- selSecYint i j sss
-- size <- selSecSelSize i j sss
-- indent <- sss ^? sssSections . ix i . ssItems . ix j . siOffX
-- return $
-- screenPosAbs cfig (ldp ^. ldpPos)
-- + V2
-- (10 * s * fromIntegral indent)
-- (negate (20 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5))
-- where
-- s = _ldpScale ldp
-- ygap = _ldpVerticalGap ldp
-- need to be able to determine a selection item's width for this
selNumPosCardinal ::
CardinalEightPoint ->
Configuration ->
ListDisplayParams ->
SelectionSections a ->
Int ->
Int ->
Maybe Point2
selNumPosCardinal card cfig ldp sss i j = do
ipos <- selSecYint i j sss
size <- selSecSelSize i j sss
indent <- sss ^? sssSections . ix i . ssItems . ix j . siOffX
let offset = cardEightVec card * V2 0 (fromIntegral size * 0.5 * 20 * s)
return $
screenPosAbs cfig (ldp ^. ldpPos)
+ offset
+ V2
(10 * s * fromIntegral indent)
(negate (20 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5))
src/Dodge/SelectionSections.hs
+21 -14
View File
@@ -6,9 +6,12 @@ module Dodge.SelectionSections (
setFirstPosSelectionSections,
selSecYint,
selSecSelSize,
inverseSelSecYint,
posSelSecYint,
inverseSelNumPos,
) where
import Control.Monad
import qualified Control.Foldl as L
import Dodge.ScreenPos
import Geometry.Data
@@ -130,8 +133,8 @@ selSecSelSize :: Int -> Int -> SelectionSections a -> Maybe Int
selSecSelSize i j sss = fmap length $ sss ^? sssSections . ix i . ssItems . ix j . siPictures
-- need to check that the vertical gap is correctly put in here
posSelSecYint :: Configuration -> ListDisplayParams -> Point2 -> Int
posSelSecYint cfig ldp (V2 _ y) = floor $ (y0 - y) / (20 / ldp ^. ldpScale + ldp ^. ldpVerticalGap)
posSelSecYint :: Configuration -> ListDisplayParams -> Float -> Int
posSelSecYint cfig ldp y = floor $ (y0 - y) / (20 / ldp ^. ldpScale + ldp ^. ldpVerticalGap)
where
V2 _ y0 = screenPosAbs cfig (ldp ^. ldpPos)
@@ -159,16 +162,20 @@ inverseSelSecYint yint sss = do
let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
j <- L.fold (L.findIndex (\x -> x - _ssOffset ss > yint)) ls
return (i,j)
--
-- ss <- sss ^? sssSections . ix i
-- return . (secpos +)
-- . subtract (ss ^. ssOffset)
-- . sum
-- . fmap _siHeight
-- . fst
-- $ IM.split j (ss ^. ssItems)
-- where
-- secpos = sum . fmap (length . _ssShownItems) . fst $ IM.split i $ sss ^. sssSections
inverseSelSecYintXPosCheck :: Configuration -> ListDisplayParams
-> Float -> Int -> SelectionSections a -> Maybe (Int,Int)
inverseSelSecYintXPosCheck cfig ldp x yint sss = do
((i,ss),othersss) <- IM.minViewWithKey (_sssSections sss)
let l = length $ _ssShownItems ss
V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos)
guard (x - x0 < 150) -- HACK, should determine selection item width and offset below
if l <= yint
then inverseSelSecYint (yint - l) (sss & sssSections .~ othersss)
else do
let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
j <- L.fold (L.findIndex (\val -> val - _ssOffset ss > yint)) ls
return (i,j)
inverseSelNumPos ::
Configuration ->
@@ -176,8 +183,8 @@ inverseSelNumPos ::
SelectionSections a ->
Point2 ->
Maybe (Int,Int)
inverseSelNumPos cfig ldp sss pos = --Just (0,posSelSecYint cfig ldp pos)
inverseSelSecYint (posSelSecYint cfig ldp pos) sss
inverseSelNumPos cfig ldp sss (V2 x y) =
inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y) sss
--getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int
--getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm
src/Dodge/Terminal.hs
+1 -1
View File
@@ -222,7 +222,7 @@ disconnectTerminal tm =
exitTerminalSubInv :: World -> World
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory Nothing Nothing
Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory NoMouseSel Nothing
_ -> w
damageCodeCommand :: TerminalCommand
src/Dodge/Update.hs
+27 -4
View File
@@ -278,6 +278,7 @@ functionalUpdate u =
. over uvWorld updateRBList
. over uvWorld updateCloseObjects
. over uvWorld updateWheelEvents
. over uvWorld (updateMouseInventorySelection (u ^. uvConfig))
. over uvWorld (updateMouseOverInventory (u ^. uvConfig))
. over uvWorld zoneClouds
. over uvWorld zoneCreatures
@@ -291,14 +292,36 @@ checkTermDist w = fromMaybe w $ do
btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
guard $ dist btpos (_crPos $ you w) > 40
return (w & hud . hudElement . subInventory .~ NoSubInventory Nothing Nothing)
return (w & hud . hudElement . subInventory .~ NoSubInventory NoMouseSel Nothing)
updateMouseInventorySelection :: Configuration -> World -> World
updateMouseInventorySelection cfig w
| leftclickstart = case msel of
Nothing -> fromMaybe w $ do
ysel <- mysel
return $ w & hud . hudElement . subInventory . nsSelected .~ MouseInvSelect ysel Nothing
Just (i,j) -> w & hud . hudElement . subInventory . nsSelected .~
MouseInvChosen (i,j) (i,j)
| leftclickheld = w
| otherwise = w
where
leftclickstart = w ^? input . mouseButtons . ix ButtonLeft == Just 0
leftclickheld = ButtonLeft `M.member` (w ^. input . mouseButtons)
mpos = w ^. input . mousePos
ldp = invDisplayParams w
msel = do
sss <- msss
inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
mysel = do
sss <- msss
inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
msss = w ^? hud . hudElement . diSections
updateMouseOverInventory :: Configuration -> World -> World
updateMouseOverInventory cfig w = fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
guard $ w ^. input . mouseMoving
let x = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
return $ w & hud . hudElement . subInventory . nsMouseOver .~ x
return $ w & hud . hudElement . subInventory . nsMouseOver .~
inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
where
ldp = invDisplayParams w
src/Dodge/Update/Input/InGame.hs
+5 -5
View File
@@ -226,9 +226,9 @@ spaceAction w = case w ^. hud . hudElement of
& worldEventFlags . at InventoryChange ?~ ()
_ -> w
DisplayInventory{_subInventory = DisplayTerminal{}} ->
w & hud . hudElement . subInventory .~ NoSubInventory Nothing Nothing
w & hud . hudElement . subInventory .~ NoSubInventory NoMouseSel Nothing
& worldEventFlags . at InventoryChange ?~ ()
_ -> w & hud . hudElement . subInventory .~ NoSubInventory Nothing Nothing
_ -> w & hud . hudElement . subInventory .~ NoSubInventory NoMouseSel Nothing
where
theLoc =
doWorldPos
@@ -240,14 +240,14 @@ toggleMap u = case u ^. uvWorld . hud . hudElement of
DisplayCarte ->
u & uvWorld . hud . hudElement
.~ DisplayInventory
{ _subInventory = NoSubInventory Nothing Nothing
{ _subInventory = NoSubInventory NoMouseSel Nothing
, _diSections = defaultInvSections
}
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte
toggleTweakInv :: World -> World
toggleTweakInv w = case w ^? hud . hudElement . subInventory of
Just ExamineInventory{} -> w & thepointer .~ NoSubInventory Nothing Nothing
Just ExamineInventory{} -> w & thepointer .~ NoSubInventory NoMouseSel Nothing
_ -> w & thepointer .~ ExamineInventory -- mi
where
thepointer = hud . hudElement . subInventory
@@ -265,4 +265,4 @@ tryCombine sss w = fromMaybe w $ do
maybeExitCombine :: Universe -> Universe
maybeExitCombine u
| ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons) = u
| otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory Nothing Nothing
| otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory NoMouseSel Nothing