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

Add view debug option

Browse Source
This commit is contained in:
justin
2021-10-03 18:47:11 +01:00
parent b526517404
commit df9a8ea242
7 changed files with 35 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen.hs
+7 -10
View File
@@ -25,20 +25,17 @@ import qualified IntMapHelp as IM
import Control.Monad.State
import Control.Lens
placeSpot' :: World -> ((Point2,Float) , Placement) -> World
placeSpot' w (shift, plmnt) =
let (i,w') = placeSpotID (shiftPSBy' shift (_placementSpot plmnt)) w
in maybe w' (curry (placeSpot' w') shift) (_idPlacement plmnt i)
placeSpot :: World -> ((Point2,Float) , Placement) -> World
placeSpot w (shift, plmnt) =
let (i,w') = placeSpotID (shiftPSBy shift (_placementSpot plmnt)) w
in maybe w' (curry (placeSpot w') shift) (_idPlacement plmnt i)
shiftPlacement :: (Point2,Float) -> Placement -> Placement
shiftPlacement shift (Placement ps f) = Placement (shiftPSBy' shift ps)
shiftPlacement shift (Placement ps f) = Placement (shiftPSBy shift ps)
(fmap (fmap $ shiftPlacement shift) f)
shiftPSBy'
:: (Point2,Float)
-> PlacementSpot
-> PlacementSpot
shiftPSBy' (pos,rot) ps = ps
shiftPSBy :: (Point2,Float) -> PlacementSpot -> PlacementSpot
shiftPSBy (pos,rot) ps = ps
& psPos %~ shiftPointBy (pos,rot)
& psRot %~ (+ rot)