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

Improve scroll selection/inventory modification

Browse Source
This commit is contained in:
justin
2026-03-24 19:21:04 +00:00
parent 5b297643db
commit 8ff2f37af5
16 changed files with 532 additions and 432 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/Button.hs
+49 -45
View File
@@ -1,4 +1,8 @@
module Dodge.Placement.Instance.Button where
module Dodge.Placement.Instance.Button (
putLitButOnPos,
extTrigLitPos,
putLitButOnPosExtTrig,
) where
import Color
import Control.Lens
@@ -8,54 +12,54 @@ import Dodge.LevelGen.PlacementHelper
import Dodge.LevelGen.Switch
import Dodge.LightSource
import Dodge.Placement.Instance.LightSource
import Dodge.PlacementSpot
--import Dodge.PlacementSpot
import Geometry
import Shape
triggerSwitchSPic :: Color -> Color -> PlacementSpot -> Placement
triggerSwitchSPic c1 c2 ps = psPtCont ps (PutTrigger False) $
\tp ->
Just $
pContID
ps
( PutButton
( makeSwitch
c1
c2
(SetTrigger True $ trigid tp)
(SetTrigger False $ trigid tp)
)
)
(const Nothing)
where
trigid tp = fromJust $ _plMID tp
--triggerSwitchSPic :: Color -> Color -> PlacementSpot -> Placement
--triggerSwitchSPic c1 c2 ps = psPtCont ps (PutTrigger False) $
-- \tp ->
-- Just $
-- pContID
-- ps
-- ( PutButton
-- ( makeSwitch
-- c1
-- c2
-- (SetTrigger True $ trigid tp)
-- (SetTrigger False $ trigid tp)
-- )
-- )
-- (const Nothing)
-- where
-- trigid tp = fromJust $ _plMID tp
--
--triggerSwitchSPicLight :: Color -> Color -> PlacementSpot -> Placement
--triggerSwitchSPicLight c1 c2 ps = psPtCont ps (PutTrigger False) $
-- \tp -> Just $
-- pContID atFstLnkOut (PutLS thels) $
-- \lsid ->
-- Just $
-- pContID
-- ps
-- (PutButton (makeSwitch c1 c2 (oneff lsid $ trigid tp) (offeff lsid $ trigid tp)))
-- (const Nothing)
-- where
-- thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
-- trigid tp = fromJust $ _plMID tp
-- oneff lsid tid = WorldEffects [SetLSCol (V3 0 0.5 0) lsid, SetTrigger True tid]
-- offeff lsid tid = WorldEffects [SetLSCol (V3 0.5 0 0) lsid, SetTrigger False tid]
triggerSwitchSPicLight :: Color -> Color -> PlacementSpot -> Placement
triggerSwitchSPicLight c1 c2 ps = psPtCont ps (PutTrigger False) $
\tp -> Just $
pContID atFstLnkOut (PutLS thels) $
\lsid ->
Just $
pContID
ps
(PutButton (makeSwitch c1 c2 (oneff lsid $ trigid tp) (offeff lsid $ trigid tp)))
(const Nothing)
where
thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
trigid tp = fromJust $ _plMID tp
oneff lsid tid = WorldEffects [SetLSCol (V3 0 0.5 0) lsid, SetTrigger True tid]
offeff lsid tid = WorldEffects [SetLSCol (V3 0.5 0 0) lsid, SetTrigger False tid]
triggerSwitch :: Color -> PlacementSpot -> Placement
triggerSwitch col ps = psPtCont ps (PutTrigger False) $
\tp ->
Just $
pContID
ps
(PutButton (makeSwitch col col (SetTrigger True $ trigid tp) (SetTrigger False $ trigid tp)))
(const Nothing)
where
trigid tp = fromJust $ _plMID tp
--triggerSwitch :: Color -> PlacementSpot -> Placement
--triggerSwitch col ps = psPtCont ps (PutTrigger False) $
-- \tp ->
-- Just $
-- pContID
-- ps
-- (PutButton (makeSwitch col col (SetTrigger True $ trigid tp) (SetTrigger False $ trigid tp)))
-- (const Nothing)
-- where
-- trigid tp = fromJust $ _plMID tp
putLitButOnPos :: Color -> PlacementSpot -> (Placement -> Maybe Placement) -> Placement
putLitButOnPos col theps subpl =
src/Dodge/Placement/Instance/LightSource.hs
+4 -25
View File
@@ -45,7 +45,7 @@ mntLSOn shapeF ls wallp lsp@(V3 lx ly _) =
ps0jPushPS (PutLabel "light") .
ps0jPushPS (putShape $ shapeF wallp lsp)
--ps0j (PutLabel "light") .
--ps0j (putShape . setCol $ shapeF wallp lsp)
--ps0j (putShape $ shapeF wallp lsp)
. pt0 (PutLS $ ls & lsParam . lsPos .~ lsp')
where
lsp' = lsp -.-.- V3 x y 1
@@ -96,38 +96,17 @@ aShape wallpos (V3 x y z) = girder (z + 2) 20 10 pout wallpos
pout = V2 x y -.- 2 *.* squashNormalizeV (V2 x y -.- wallpos)
vShape :: Point2 -> Point3 -> Shape
vShape wallpos (V3 x y z) =
thinHighBar z wallposUp lxy
<> thinHighBar z wallposDown lxy
vShape p (V3 x y z) = abar n <> abar (-n)
where
abar a = thinHighBar z (p + a) lxy
lxy = V2 x y
n = vNormal (wallpos -.- lxy)
wallposUp = wallpos +.+ n
wallposDown = wallpos -.- n
n = vNormal (p - lxy)
mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement
mntLS shp wallp lampp = mntLSOn shp defaultLS wallp lampp (const Nothing)
where
defaultLS = LS 0 $ LSParam 0 300 0.6
--mntLSCol :: (Point2 -> Point3 -> Shape) -> Color -> Point2 -> Point3 -> Placement
--mntLSCol shp col wallp lampp = mntLSOn shp (Just col) defaultLS wallp lampp (const Nothing)
-- where
-- defaultLS = LS 0 $ LSParam 0 200 0.6
--mntLSLampCol :: (Point2 -> Point3 -> Shape) -> Color -> Point2 -> Point3 -> Placement
--mntLSLampCol shp (V4 x y z _) wallp lampp =
-- mntLSOn
-- shp
-- Nothing
-- (defaultLS & lsParam . lsCol .~ col)
-- wallp
-- lampp
-- (const Nothing)
-- where
-- col = V3 x y z
-- defaultLS = LS 0 $ LSParam 0 200 0.6
mntLSCond ::
(Point2 -> Point3 -> Shape) ->
-- -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))