diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 1645a9175..f04961fc3 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -44,7 +44,7 @@ import Dodge.Creature.Rationality --import Dodge.Item import Dodge.Picture.Layer import Picture ---import Geometry +import Geometry.Data import qualified IntMapHelp as IM --import Data.List @@ -140,8 +140,8 @@ addArmour = over crInv insarmour ID 0. -} startCr :: Creature startCr = defaultCreature - { _crPos = (0,0) - , _crOldPos = (0,0) + { _crPos = (V2 0 0) + , _crOldPos = (V2 0 0) , _crDir = pi/2 , _crMvDir = pi/2 , _crID = 0 diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 4dbe0b628..4cbce3eae 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -68,8 +68,8 @@ blinkAction cr w = soundOnce teleSound where distR = 120 distortionBulge = - [(p3,p3 +.+ (distR,0), p3 +.+ (0,distR),0.1) - ,(cpos,cpos +.+ (distR,0), cpos +.+ (0,distR),1.9) + [(p3,p3 +.+ (V2 distR 0), p3 +.+ (V2 0 distR),0.1) + ,(cpos,cpos +.+ (V2 distR 0), cpos +.+ (V2 0 distR),1.9) ] cid = _crID cr p1 = mouseWorldPos w diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 09e0353db..1ef91d9db 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -17,7 +17,7 @@ import Dodge.WorldEvent.Sound import Dodge.Creature.Update hiding (CRUpdate) import Picture import qualified IntMapHelp as IM ---import Geometry +import Geometry.Data import Geometry.Vector3D import Polyhedra @@ -36,7 +36,7 @@ lamp h = defaultInanimate } lampPic :: Float -> Picture lampPic h = pictures - [ setLayer 0 $ pictures . map (helpPoly3D . map ((, blue) . (-.-.- (2.5,2.5,0)))) $ boxXYZ 5 5 (h-1) + [ setLayer 0 $ pictures . map (helpPoly3D . map ((, blue) . (-.-.- (V3 2.5 2.5 0)))) $ boxXYZ 5 5 (h-1) , setLayer 1 $ setDepth h $ color white $ circleSolid 3 ] @@ -44,8 +44,8 @@ initialiseLamp :: Float -> CRUpdate initialiseLamp h w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLamp h i) where i = IM.newKey $ _lightSources $ f w -- to give different lights different keys - addLS = over lightSources (IM.insert i (lightAt (x,y,h) i)) - (x,y) = _crPos cr + addLS = over lightSources (IM.insert i (lightAt (V3 x y h) i)) + (V2 x y) = _crPos cr updateLamp :: Float -> Int -> CRUpdate updateLamp h i = unrandUpdate handleLS internalUpdate @@ -56,7 +56,7 @@ updateLamp h i = unrandUpdate handleLS internalUpdate | otherwise = w & lightSources . ix i . lsPos .~ f cPos where cPos = _crPos cr - f (x,y) = (x,y,h) + f (V2 x y) = (V3 x y h) internalUpdate cr | _crHP cr < 0 = Nothing | otherwise = Just $ doDamage cr diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs index 58658e7bc..70dbe6fc8 100644 --- a/src/Dodge/Creature/LauncherCrit.hs +++ b/src/Dodge/Creature/LauncherCrit.hs @@ -16,7 +16,7 @@ import Dodge.Creature.State --import Dodge.Creature.State.Data import Dodge.Item.Weapon.Launcher --import Dodge.Item.Consumable ---import Geometry +import Geometry.Data import Picture import qualified Data.IntMap.Strict as IM @@ -37,7 +37,7 @@ launcherCrit = defaultCreature >=> reloadOverrideR >=> targetYouWhenCognizantR >=> overrideInternalR - (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + (onBoth (&&) crHasTarget (crStratConMatches (GetTo (V2 0 0)))) (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) , _crActionPlan = ActionPlan { _crImpulse = [] diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index 73ed4bb07..c0665b374 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -45,7 +45,7 @@ ltAutoCrit = defaultCreature >=> reloadOverrideR >=> targetYouWhenCognizantR >=> overrideInternalR - (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + (onBoth (&&) crHasTarget (crStratConMatches (GetTo (V2 0 0)))) (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) , _crActionPlan = ActionPlan { _crImpulse = [] @@ -64,9 +64,9 @@ chooseMovement cr w | dist cpos p > 200 = DoImpulses [UseItem,TurnToward p 0.05 , MoveForward 3] | dist cpos p < 80 = DoImpulses [UseItem,TurnToward p 0.05, MoveForward (-3) ] | errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4 - = DoImpulses [UseItem,TurnToward p' 0.01, Move (0,3)] + = DoImpulses [UseItem,TurnToward p' 0.01, Move (V2 0 3)] | otherwise - = DoImpulses [UseItem,TurnToward p' 0.05, Move (0,3)] + = DoImpulses [UseItem,TurnToward p' 0.05, Move (V2 0 3)] where cpos = _crPos cr tcr = _creatures w IM.! 0 diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index 38f8ddade..1fe71dd00 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -39,7 +39,7 @@ pistolCrit = defaultCreature >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (V2 0 0)))) ( \ _ -> crActionPlan . crStrategy .~ WatchAndWait ) , _crActionPlan = ActionPlan { _crImpulse = [] @@ -81,19 +81,19 @@ chooseMovement' cr w = takeOneWeighted [chargeProb,retreatProb,strafeProb,strafe `DoImpulsesAlongside` 3 `DoReplicate` - ImpulsesList (replicate 9 [Move (3,0)] ++ [[Move (3,0),UseItem]]) + ImpulsesList (replicate 9 [Move (V2 3 0)] ++ [[Move (V2 3 0),UseItem]]) strafeLeftActions = DoImpulses [TurnToward yposr (2*pi)] `DoActionThen` 3 `DoReplicate` - ImpulsesList (replicate 9 [Move (0,3)] ++ [[Move (0,3),UseItem]]) + ImpulsesList (replicate 9 [Move (V2 0 3)] ++ [[Move (V2 0 3),UseItem]]) strafeRightActions = DoImpulses [TurnToward yposl (2*pi)] `DoActionThen` 3 `DoReplicate` - ImpulsesList (replicate 9 [Move (0,-3)] ++ [[Move (0,-3),UseItem]]) + ImpulsesList (replicate 9 [Move (V2 (0) (-3))] ++ [[Move (V2 (0) (-3)),UseItem]]) yposl = ypos -.- 100 *.* vNormal (normalizeV $ ypos -.- cpos) yposr = ypos +.+ 100 *.* vNormal (normalizeV $ ypos -.- cpos) @@ -103,7 +103,7 @@ retreatActions tcr cr = `DoImpulsesAlongside` 3 `DoReplicate` - ImpulsesList (replicate 9 [Move (-3,0)] ++ [[UseItem]]) + ImpulsesList (replicate 9 [Move (V2 (-3) (0))] ++ [[UseItem]]) where cpos = _crPos cr tpos = _crPos tcr diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs index f8fdbb9d0..64ab25f8a 100644 --- a/src/Dodge/Creature/SentinelAI.hs +++ b/src/Dodge/Creature/SentinelAI.hs @@ -11,7 +11,7 @@ import Dodge.Creature.Rationality import Dodge.Creature.AlertLevel --import Dodge.Creature.State --import Dodge.Creature.State.Data ---import Geometry +import Geometry.Data --import Picture --import Dodge.RandomHelp @@ -39,7 +39,7 @@ sentinelAI = sentinelExtraWatchUpdate DoImpulses [ChangeStrategy WatchAndWait] , AimAtCloseSlow { _targetID = tcid - , _targetSeenAt = (0,0) -- hack + , _targetSeenAt = (V2 0 0) -- hack , _aimSpeed = 0.2 , _slowAimSpeed = 0.01 , _slowAimAngle = pi/8 @@ -66,13 +66,13 @@ sentinelFireType f = performActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR >=> overrideInternalR - (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + (onBoth (&&) crHasTarget (crStratConMatches (GetTo (V2 0 0)))) (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) where drawwp = DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) aiming = AimAtCloseSlow { _targetID = 0 - , _targetSeenAt = (0,0) -- hack + , _targetSeenAt = (V2 0 0) -- hack , _aimSpeed = 0.2 , _slowAimSpeed = 0.01 , _slowAimAngle = pi/8 @@ -89,7 +89,7 @@ sentinelExtraWatchUpdate xs = performActionsR >=> doStrategyActionsR -- >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (V2 0 0)))) (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) @@ -104,7 +104,7 @@ shootAtAdvance tcid = DoImpulses [ChangeStrategy WatchAndWait] , AimAtCloseSlow { _targetID = tcid - , _targetSeenAt = (0,0) -- hack + , _targetSeenAt = (V2 0 0) -- hack , _aimSpeed = 0.2 , _slowAimSpeed = 0.01 , _slowAimAngle = pi/8 @@ -125,7 +125,7 @@ shootAtWhileContinueTime tcid _ _ = StrategyActions (ShootAt tcid) DoImpulses [ChangeStrategy WatchAndWait] , AimAtCloseSlow { _targetID = tcid - , _targetSeenAt = (0,0) -- hack + , _targetSeenAt = (V2 0 0) -- hack , _aimSpeed = 0.2 , _slowAimSpeed = 0.01 , _slowAimAngle = pi/8 diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index 553534c5a..4597d0a7a 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -44,7 +44,7 @@ spreadGunCrit = defaultCreature >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (V2 0 0)))) (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) , _crActionPlan = ActionPlan { _crImpulse = [] diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 7b8842e3b..4421448dd 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -58,7 +58,7 @@ stateUpdate u w (f,g) cr = . dropByState cr --crBeforeDeath = colCrWall w cr addCorpse = IM.insertNewKey - $ uncurry translate (_crOldPos cr) + $ uncurryV translate (_crOldPos cr) $ rotate (_crDir cr) (_crCorpse cr) -- | Drop items according to the creature state. @@ -78,7 +78,7 @@ Given a creature and a velocity, applies friction to that creature and evaluates velocity to carry across frames. -} crFriction :: Creature -> Point2 -> Point2 -crFriction _ _ = (0,0) +crFriction _ _ = (V2 0 0) doDamage :: Creature -> Creature doDamage cr = set (crState . crDamage) [] diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 2ce08e3d4..518c80122 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -37,7 +37,7 @@ wasdWithAiming w speed i cr | otherwise = theTurn $ theMovement cr where theMovement - | movDir == (0,0) = id + | movDir == (V2 0 0) = id | otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir theTurn cr' = creatureTurnTowardDir (_crMvDir cr') 0.2 cr' movDir = wasdDir w @@ -53,19 +53,19 @@ wasdWithAiming w speed i cr wasdM :: World -> SDL.Scancode -> Point2 wasdM w scancode - | scancode == moveUpKey (_keyConfig w) = ( 0, 1) - | scancode == moveDownKey (_keyConfig w) = ( 0,-1) - | scancode == moveRightKey (_keyConfig w) = ( 1, 0) - | scancode == moveLeftKey (_keyConfig w) = (-1, 0) -wasdM _ _ = (0,0) + | scancode == moveUpKey (_keyConfig w) = ( V2 (0) ( 1)) + | scancode == moveDownKey (_keyConfig w) = (V2 ( 0) (-1)) + | scancode == moveRightKey (_keyConfig w) = (V2 ( 1) ( 0)) + | scancode == moveLeftKey (_keyConfig w) = (V2 (-1) ( 0)) +wasdM _ _ = (V2 0 0) wasdDir :: World -> Point2 -wasdDir w = foldr ((+.+) . wasdM w) (0,0) $ _keys w +wasdDir w = foldr ((+.+) . wasdM w) (V2 0 0) $ _keys w wasdComp :: S.Set SDL.Scancode -> World -> (Point2,Maybe Float) -wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks +wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (V2 0 0) ks where - f (0,0) = ((0,0), Nothing) + f (V2 0 0) = ((V2 0 0), Nothing) f p = (errorNormalizeV 46 p, Just $ argV p) {- | Set posture according to mouse presses. -} diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index a2e8406be..e68038bc8 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -22,9 +22,9 @@ import Data.List defaultCreature :: Creature defaultCreature = Creature - { _crPos = (0,0) - , _crOldPos = (0,0) - , _crVel = (0,0) + { _crPos = (V2 0 0) + , _crOldPos = (V2 0 0) + , _crVel = (V2 0 0) , _crDir = 0 , _crMvDir = 0 , _crID = 1 @@ -67,7 +67,7 @@ defaultEquipment = Equipment , _itName = "genericEquipment" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = setLayer 0 $ onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = setLayer 0 $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> blank , _itEffect = NoItEffect , _itHammer = HammerUp @@ -127,7 +127,7 @@ applyIndividualDamage (PushDam amount pback) cr applyIndividualDamage dt cr = ( id , over crHP (\hp -> hp - _dmAmount dt) cr ) defaultFlIt :: FloorItem -defaultFlIt = FlIt {_flItRot=0,_flIt = defaultIt, _flItPos = (0,0), _flItID = 0} +defaultFlIt = FlIt {_flItRot=0,_flIt = defaultIt, _flItPos = (V2 0 0), _flItID = 0} defaultIt :: Item defaultIt = Consumable { _itIdentity = Medkit25 @@ -135,7 +135,7 @@ defaultIt = Consumable , _itMaxStack = 3 , _itAmount = 2 , _cnEffect = const return - , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> blank , _itID = Nothing , _itInvDisplay = _itName @@ -147,7 +147,7 @@ defaultIt = Consumable defaultButton :: Button defaultButton = Button { _btPict = onLayer WlLayer $ color red $ polygon $ rectNSEW 5 (-5) 10 (-10) - , _btPos = (0,0) + , _btPos = (V2 0 0) , _btRot = 0 , _btEvent = \b w -> set (buttons . ix (_btID b) . btPict) (onLayer WlLayer $ color red $ polygon $ rectNSEW (-4) (-5) 10 (-10)) @@ -159,9 +159,9 @@ defaultButton = Button } defaultPT :: Projectile defaultPT = Projectile - { _pjPos = (0,0) - , _pjStartPos = (0,0) - , _pjVel = (0,0) + { _pjPos = (V2 0 0) + , _pjStartPos = (V2 0 0) + , _pjVel = (V2 0 0) , _pjDraw = const blank , _pjID = 0 , _pjUpdate = const id @@ -169,7 +169,7 @@ defaultPT = Projectile defaultPP :: PressPlate defaultPP = PressPlate { _ppPict = onLayer PressPlateLayer $ color (dim $ dim $ bright blue) $ circleSolid 5 - , _ppPos = (0,0) + , _ppPos = (V2 0 0) , _ppRot = 0 , _ppEvent = const id , _ppID = -1 diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index 78257c76e..d5ddecd8a 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -6,6 +6,7 @@ import Dodge.Item.Data import Dodge.Default import Dodge.Picture import Picture +import Geometry.Data keyToken :: Int -> Item keyToken n = defaultEquipment @@ -27,8 +28,8 @@ keyToken n = defaultEquipment keyPic :: Picture keyPic = color green $ pictures [translate (-4) 0 $ thickCircle 4 2 - ,lineOfThickness 2 [(0,0),(8,0),(8,-4)] - ,lineOfThickness 2 [(4,0),(4,-4)] + ,lineOfThickness 2 $ map toV2 [(0,0),(8,0),(8,-4)] + ,lineOfThickness 2 $ map toV2 [(4,0),(4,-4)] ] latchkey :: Int -> Item @@ -51,6 +52,6 @@ latchkey n = defaultEquipment latchkeyPic :: Picture latchkeyPic = color yellow $ pictures [translate (-4) 0 $ thickCircle 4 2 - ,lineOfThickness 2 [(0,0),(8,0),(8,-4)] - ,lineOfThickness 2 [(4,0),(4,-4)] + ,lineOfThickness 2 $ map toV2 [(0,0),(8,0),(8,-4)] + ,lineOfThickness 2 $ map toV2 [(4,0),(4,-4)] ] diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 27fe05e62..479e7d915 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -13,7 +13,7 @@ magShield = defaultEquipment , _itName = "MAGSHIELD" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> blank , _itID = Nothing } @@ -23,7 +23,7 @@ flameShield = defaultEquipment , _itName = "FLAMESHIELD" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \cr _ -> onLayer CrLayer $ pictures [color cyan $ circle (_crRad cr+2)] , _itID = Nothing } @@ -52,7 +52,7 @@ jetPack = defaultEquipment , _itName = "JETPACK" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> onLayer CrLayer $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ] , _itEffect = NoItEffect diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index b8c8aeb28..34c039fa0 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -188,7 +188,7 @@ forceFieldGun = defaultGun , _itUse = undefined , _wpSpread = 0.02 , _wpRange = 20 - , _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] + , _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] , _itAimingSpeed = 0.4 , _itAimingRange = 0.5 } @@ -253,7 +253,7 @@ remoteLauncher = defaultGun , _itAimingSpeed = 0.2 , _itAimingRange = 0.5 , _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) - , _itAttachment = Just $ ItScope (0,0) 0 1 True + , _itAttachment = Just $ ItScope (V2 0 0) 0 1 True } hvAutoGun :: Item hvAutoGun = defaultAutoGun @@ -292,7 +292,7 @@ ltAutoGun = defaultAutoGun , _itUseRate = 3 , _itUseTime = 0 , _itUse = \_ -> shootWithSound 0 . withRandomDir 0.3 . withSidePush 50 - . withMuzFlare $ withVelWthHiteff (30,0) 2 basicBulletEffect + . withMuzFlare $ withVelWthHiteff (V2 30 0) 2 basicBulletEffect , _wpSpread = 0.5 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer ltAutoGunPic @@ -321,7 +321,7 @@ miniGun = defaultAutoGun . withRandomDir 0.1 . withRandomOffset 9 . withMuzFlare - . withVelWthHiteff (30,0) 2 + . withVelWthHiteff (V2 30 0) 2 $ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF' , _wpRange = 20 , _itFloorPict = onLayer FlItLayer miniGunPict @@ -348,13 +348,13 @@ spreadGun = defaultGun , _itUse = \_ -> shootWithSound (fromIntegral shotgunSound) . withRecoil 100 . withMuzFlare - $ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 basicBulletEffect + $ spreadNumVelWthHiteff spreadGunSpread 9 (V2 30 0) 2 basicBulletEffect , _wpSpread = spreadGunSpread , _wpRange = 20 - , _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ] + , _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon $ map toV2[(-3,0),(3,6),(3,-6)] ] , _itAimingSpeed = 1 , _itAimingRange = 0 - , _itEquipPict = pictureWeaponOnAim $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ] + , _itEquipPict = pictureWeaponOnAim $ color green $ pictures [ polygon $ map toV2[(-3,0),(3,6),(3,-6)] ] } multGun :: Item multGun = defaultGun @@ -369,7 +369,7 @@ multGun = defaultGun , _itUse = \_ -> shootWithSound (fromIntegral shotgunSound) . withRecoil 200 . withMuzFlare - $ numVelWthHitEff 5 (50,0) 5 basicBulletEffect + $ numVelWthHitEff 5 (V2 50 0) 5 basicBulletEffect , _wpSpread = spreadGunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer multGunPic @@ -388,7 +388,7 @@ multGunPic = color red $ pictures , polygon $ rectNSEW 2 (-2) 2 (-2) , polygon $ rectNSEW (-3) (-7) 2 (-2) , polygon $ rectNSEW (-8) (-12) 2 (-2) - , polygon [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)] + , polygon $ map toV2 [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)] ] ] longGun :: Item @@ -414,7 +414,7 @@ longGun = defaultGun , _itZoom = defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5} , _itEquipPict = pictureWeaponOnAim longGunPic , _itScroll = zoomLongGun - , _itAttachment = Just $ ItScope (0,0) 0 1 False + , _itAttachment = Just $ ItScope (V2 0 0) 0 1 False , _itEffect = itemLaserScopeEffect , _wpAmmo = hvBullet , _itAimStance = TwoHandTwist @@ -492,7 +492,7 @@ blinkGun = defaultGun , _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL , _wpSpread = 0.05 , _wpRange = 20 - , _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] + , _itFloorPict = onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] , _itAimingSpeed = 1 , _itAimingRange = 0 } @@ -510,7 +510,7 @@ boosterGun = defaultGun , _itLeftClickUse = Just $ boostSelfL 10 , _wpSpread = 0.05 , _wpRange = 20 - , _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] + , _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] , _itAimingSpeed = 1 , _itAimingRange = 0 , _itEffect = resetAttachmentID @@ -536,8 +536,8 @@ aTeslaArc' cr w remoteShellPic' :: Projectile -> Picture remoteShellPic' pj | t > 40 = onLayerL [levLayer CrLayer - 2] - $ uncurry translate pos $ rotate dir $ remoteShellPic t - | otherwise = uncurry translate pos $ rotate dir $ remoteShellPic t + $ uncurryV translate pos $ rotate dir $ remoteShellPic t + | otherwise = uncurryV translate pos $ rotate dir $ remoteShellPic t where t = _pjTimer pj pos = _pjPos pj @@ -547,9 +547,9 @@ remoteShellPic :: Int -- ^ Timer -> Picture remoteShellPic t - | rem (t+200) 20 < 9 = setDepth 20 $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] + | rem (t+200) 20 < 9 = setDepth 20 $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] | otherwise = pictures - [ setDepth 20 $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] + [ setDepth 20 $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] , setLayer 1 . setDepth 20.5 . color col $ circleSolid 3 ] where @@ -594,7 +594,7 @@ pointToItem (OnFloor flid) = floorItems . ix flid . flIt retireRemoteRocket :: Int -> Int -> Int -> World -> World retireRemoteRocket itid 0 pjid w = - set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0) + set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (V2 0 0) $ set (pointToItem (_itemPositions w IM.! itid) . itUse) (\_ -> hammerCheck fireRemoteLauncher) (w & projectiles %~ IM.delete pjid) retireRemoteRocket itid t pjid w = setScope w @@ -605,12 +605,12 @@ retireRemoteRocket itid t pjid w = setScope w & creatures . ix cid . crInv . ix invid . itAttachment . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) _ -> w' - pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos + pos = fromMaybe (V2 0 0) $ w ^? projectiles . ix pjid . pjPos retireRemoteBomb :: Int -> Int -> Int -> World -> World retireRemoteBomb itid 0 pjid w = w & pointToItem (_itemPositions w IM.! itid) %~ - ( (itAttachment . _Just . scopePos .~ (0,0)) + ( (itAttachment . _Just . scopePos .~ (V2 0 0)) . (itZoom .~ defaultItZoom) . (itUse .~ (\_ -> hammerCheck throwRemoteBomb)) ) @@ -623,7 +623,7 @@ retireRemoteBomb itid t pjid w = setScope w & creatures . ix cid . crInv . ix invid . itAttachment . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) _ -> w' - pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos + pos = fromMaybe (V2 0 0) $ w ^? projectiles . ix pjid . pjPos moveRemoteBomb :: Int -> Int -> Int -> World -> World moveRemoteBomb itid time pID w @@ -657,7 +657,7 @@ moveRemoteBomb itid time pID w | otherwise = x - 1 updatePicture = set (projectiles . ix pID . pjDraw) - (\_ -> onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time) + (\_ -> onLayer PtLayer $ uncurryV translate newPos $ remoteBombPic time) . lowLightDirected (withAlpha 0.1 red) newPos @@ -686,7 +686,7 @@ grenade = Throwable , _itIdentity = Grenade , _itMaxStack = 8 , _itAmount = 1 - , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 , _itUse = \_ -> useTimeCheck $ throwGrenade makeExplosionAt @@ -736,11 +736,11 @@ remoteBomb = defaultThrowable , _itIdentity = RemoteBomb , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 , _itUse = \_ -> hammerCheck throwRemoteBomb - , _itAttachment = Just $ ItScope (0,0) 0 1 True + , _itAttachment = Just $ ItScope (V2 0 0) 0 1 True , _itEquipPict = pictureWeaponOnAim remoteBombUnarmedPic } @@ -754,15 +754,15 @@ fireRemoteLauncher cr w = setLocation i = IM.newKey $ _projectiles w cid = _crID cr dir = _crDir cr - pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) + pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) (0)) remRocket = IM.insert i $ Shell { _pjPos = pos , _pjStartPos = pos - , _pjVel = rotateV dir (1,0) + , _pjVel = rotateV dir (V2 1 0) , _pjDraw = remoteShellPic' , _pjID = i , _pjUpdate = \pj -> decTimMvVel pj . setRemoteScope itid pj . moveRemoteShell cid itid pj - , _pjAcc = (0,0) + , _pjAcc = (V2 0 0) , _pjDir = dir , _pjSpin = 0 , _pjPayload = makeExplosionAt @@ -814,7 +814,7 @@ moveRemoteShell cid itid pj w && w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId = _cameraRot w + argV (_mousePos w) | otherwise = _pjDir pj - accel = rotateV newdir (2,0) + accel = rotateV newdir (V2 2 0) (frict,g) = randomR (0.6,0.9) $ _randGen w (sparkD,_) = randomR (-0.5,0.5) $ _randGen w hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w @@ -864,8 +864,8 @@ throwRemoteBomb cr w = setLocation removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> blank resetFire = set (creatures . ix cid . crInv . ix j . itUse) $ \_ -> hammerCheck $ explodeRemoteBomb itid i - p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) - p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) + p' = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr) (0)) + p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr-4) (0)) | otherwise = p' maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just setLocation :: World -> World @@ -912,7 +912,7 @@ pipe = Craftable , _itName = "PIPE" , _itMaxStack = 3 , _itAmount = 3 - , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> blank , _itID = Nothing , _itInvDisplay = _itName @@ -972,7 +972,7 @@ autoSonar = defaultEquipment , _itName = "AUTOSONAR" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> blank , _itEffect = autoSonarEffect , _itID = Nothing @@ -988,7 +988,7 @@ autoRadar = defaultEquipment , _itName = "AUTORADAR" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> blank , _itEffect = autoRadarEffect , _itID = Nothing diff --git a/src/Dodge/Item/Weapon/AutoGun.hs b/src/Dodge/Item/Weapon/AutoGun.hs index 09967f922..8e5c37e06 100644 --- a/src/Dodge/Item/Weapon/AutoGun.hs +++ b/src/Dodge/Item/Weapon/AutoGun.hs @@ -56,7 +56,7 @@ singleFireMode = hammerCheck $ shootWithSound (fromIntegral autoGunSound) autoGu autoGunNonTwistEff = withRecoil 40 . withRandomDir (autogunSpread/2) . withMuzFlare - . withVelWthHiteff (50,0) 3 + . withVelWthHiteff (V2 50 0) 3 $ destroyOnImpact bulHitCr bulHitWall' bulHitFF' autoGunPic :: Picture diff --git a/src/Dodge/Item/Weapon/Bezier.hs b/src/Dodge/Item/Weapon/Bezier.hs index 709a756ed..e858ad306 100644 --- a/src/Dodge/Item/Weapon/Bezier.hs +++ b/src/Dodge/Item/Weapon/Bezier.hs @@ -59,7 +59,7 @@ shootBezier targetp cr w = w & particles %~ (theBullet :) controlp = mouseWorldPos w cid = _crID cr dir = _crDir cr - startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) + startp = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) (0)) (randPos,randPos') = flip evalState (_randGen w) $ do a <- randInCirc 10 b <- randInCirc 20 diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 589793351..c19c5b83e 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -3,17 +3,19 @@ module Dodge.Item.Weapon.Bullet import Dodge.Data import Dodge.WorldEvent.HitEffect import Dodge.Particle.Bullet.HitEffect + +import Geometry.Data basicBullet :: Ammo basicBullet = BulletAmmo { _amString = "BULLET" , _amBulEff = destroyOnImpact bulHitCr bulHitWall' bulHitFF' , _amBulWth = 2 - , _amBulVel = (30,0) + , _amBulVel = (V2 30 0) } hvBullet :: Ammo hvBullet = BulletAmmo { _amString = "HVBULLET" , _amBulEff = penWalls hvBulHitCr hvBulHitWall' bulHitFF' , _amBulWth = 6 - , _amBulVel = (80,0) + , _amBulVel = (V2 80 0) } diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 938785053..b0d7a5f82 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -16,6 +16,7 @@ import Dodge.Picture.Layer import Dodge.Creature.Test import Picture import Geometry.Vector +import Geometry.Data import Data.Maybe import Control.Lens @@ -123,11 +124,11 @@ targetRBMousePos w = (f, \_ _ _ w' -> cursorPic w') where f _ = Just mwp mwp = mouseWorldPos w - cursorPic w' = setLayer 1 $ onLayer InvLayer $ uncurry translate mwp + cursorPic w' = setLayer 1 $ onLayer InvLayer $ uncurryV translate mwp $ rotate (_cameraRot w') $ pictures - [line [( x,x), (-x,-x)] - ,line [(-x,x), ( x,-x)] + [line [( V2 (x) (x)), (V2 (-x) (-x))] + ,line [(V2 (-x) (x)), (V2 ( x) (-x))] ] where x = 5 / _cameraZoom w' diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 858dccf97..ccd1fcef9 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -134,8 +134,8 @@ aRocketWithItemParams it cr w = over projectiles (IM.insert i theShell) w theShell = defaultShell { _pjPos = pos , _pjStartPos = pos - , _pjVel = rotateV dir (1,0) - , _pjAcc = rotateV dir (3,0) + , _pjVel = rotateV dir (V2 1 0) + , _pjAcc = rotateV dir (V2 3 0) , _pjDraw = _amPjDraw am , _pjID = i , _pjUpdate = \pj -> ammoMvs pj . decTimMvVel pj . moveShell pj @@ -173,9 +173,9 @@ reduceSpinBy :: Float -> Projectile -> World -> World reduceSpinBy x pj = projectiles . ix (_pjID pj) . pjSpin *~ x shellPic :: Projectile -> Picture -shellPic pj = setDepth 20 . uncurry translate pos $ rotate (argV accel) basePic +shellPic pj = setDepth 20 . uncurryV translate pos $ rotate (argV accel) basePic where - basePic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] + basePic = color black $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] accel = _pjAcc pj pos = _pjPos pj diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 30a13222c..4fc7653a0 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -128,7 +128,7 @@ withRecoil withRecoil recoilAmount eff cr = eff cr . over (creatures . ix cid) pushback where cid = _crID cr - pushback = over crPos (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0)) + pushback = over crPos (+.+ rotateV (_crDir cr) (V2 ((-recoilAmount) / _crMass cr ) (0))) {- | Pushes a creature sideways by a random amount. Applied before the underlying effect. -} withSidePush @@ -140,8 +140,9 @@ withSidePush withSidePush maxSide eff cr w = eff cr . over (creatures . ix cid) push $ w where cid = _crID cr - push = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) + push = over crPos (+.+ rotateV (_crDir cr) (V2 (0) (pushAmount / _crMass cr))) (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w +-- consider unifying the pushes using a direction vector {- | Pushes a creature sideways by a random amount. Applied after the underlying effect. -} withSidePushAfter @@ -153,7 +154,7 @@ withSidePushAfter withSidePushAfter maxSide eff cr w = over (creatures . ix cid) push . eff cr $ w where cid = _crID cr - push = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) + push = over crPos (+.+ rotateV (_crDir cr) (V2 (0) (pushAmount / _crMass cr))) (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w {- | Applies a world effect and sound effect after an ammo check. -} shootWithSound @@ -369,7 +370,7 @@ withRandomOffset withRandomOffset offsetAmount f cr w = f (cr & crPos %~ (+.+ offV)) $ set randGen g w where (offsetVal , g) = randomR (-offsetAmount,offsetAmount) $ _randGen w - offV = rotateV (_crDir cr) (0,offsetVal) + offV = rotateV (_crDir cr) (V2 0 offsetVal) -- | Rotates a creature with minimum rotation at least 0.1. -- Rotates the player creature before applying the effect, other creatures after. torqueBeforeForced @@ -461,7 +462,7 @@ numVelWthHitEff num vel wth eff cr = over particles (newbuls ++) d = _crDir cr poss = map (+.+ pos) $ take num offsets maxOffset = fromIntegral num * 2.5 - 2.5 - offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..] + offsets = map (\y -> rotateV d (V2 0 y)) [-maxOffset,5-maxOffset..] pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d {- | Uses '_wpSpread' as a parameter for the current offset angle. -} randWalkAngle diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs index d208f0a88..ad3b6149f 100644 --- a/src/Dodge/Item/Weapon/UseEffect.hs +++ b/src/Dodge/Item/Weapon/UseEffect.hs @@ -42,7 +42,7 @@ mvBlip p col maxt t w pt = & ptDraw .~ ( const . setDepth (-0.5) . setLayer 1 - . uncurry translate p + . uncurryV translate p . color (withAlpha (fromIntegral t / fromIntegral maxt) col) $ circleSolid 2 ) ) @@ -64,7 +64,7 @@ mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic crBlips = mapMaybe crBlip $ IM.elems $ _creatures w crBlip cr | dist cpos p < r + crad && dist cpos p > r - (crad + 100) = Just $ colHelper (0.5 * (1 - (r - dist cpos p) /100)) - $ uncurry translate cpos $ circleSolid crad + $ uncurryV translate cpos $ circleSolid crad | otherwise = Nothing where crad = _crRad cr cpos = _crPos cr diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 23e58b05a..2ef57ac96 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -33,6 +33,7 @@ import Dodge.Room.Door import Dodge.Room.Airlock import Dodge.Room.LongDoor import Geometry +import Geometry.Data import Picture import Tile @@ -41,6 +42,7 @@ import Control.Monad.State import Control.Monad.Loops import System.Random import Data.Tree +import Data.Bifunctor --import qualified Data.Map as M --import qualified Data.IntMap.Strict as IM @@ -49,12 +51,12 @@ roomC x y = defaultRoom { _rmPolys = [rectNSWE y 0 0 x] , _rmLinks = lnks , _rmPath = [] - , _rmPS = [windowLine (x/2,0) (x/2,y-60) + , _rmPS = [windowLine (V2 (x/2) (0)) (V2 (x/2) (y-60)) ] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] } where - lnks = + lnks = map (first toV2) [( (x-20, 0),pi) ,( ( 20, 0),pi) ,( ( 0, 20),pi/2) @@ -63,17 +65,17 @@ roomC x y = defaultRoom roomPadCut :: [Point2] -> Point2 -> Room roomPadCut ps p = defaultRoom { _rmPolys = [ps] - , _rmLinks = [(p,0),((0,0),pi)] - , _rmPath = [((0,0),p)] + , _rmLinks = [(p,0),((V2 0 0),pi)] + , _rmPath = [((V2 0 0),p)] , _rmPS = [] , _rmBound = [] } roomPillars :: Room roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2 where - plmnts = sPS (120,120) 0 putLamp - : sPS (12,12) 0 putLamp - : sPS (228,228) 0 putLamp + plmnts = sPS (V2 120 120) 0 putLamp + : sPS (V2 12 12) 0 putLamp + : sPS (V2 228 228) 0 putLamp : g 180 150 90 60 f a x b y = putBlockRect a x b y g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d @@ -88,15 +90,15 @@ glassSwitchBack = do wllen <- state $ randomR (60,wth/2-40) let hf = hgt/5 let plmnts = - [windowLine (wth-60, hf) (wllen,hf) - ,windowLine (wth-wllen,2*hf) (60, 2*hf) - ,windowLine (wth-60, 3*hf) (wllen,3*hf) - ,windowLine (wth-wllen,4*hf) (60, 4*hf) - ,blockLine ( 0, 1*hf) (wllen,1*hf) - ,blockLine (wth-wllen, 2*hf) ( wth,2*hf) - ,blockLine ( 0, 3*hf) (wllen,3*hf) - ,blockLine (wth-wllen, 4*hf) ( wth,4*hf) - , sPS (wth/2,hgt/2) 0 putLamp + [windowLine (V2 (wth-60 ) ( hf)) (V2 (wllen) (hf) ) + ,windowLine (V2 (wth-wllen) (2*hf)) (V2 (60 ) (2*hf)) + ,windowLine (V2 (wth-60 ) (3*hf)) (V2 (wllen) (3*hf)) + ,windowLine (V2 (wth-wllen) (4*hf)) (V2 (60 ) (4*hf)) + ,blockLine (V2 ( 0) (1*hf)) (V2 (wllen) (1*hf)) + ,blockLine (V2 (wth-wllen) (2*hf)) (V2 ( wth) (2*hf)) + ,blockLine (V2 ( 0) (3*hf)) (V2 (wllen) (3*hf)) + ,blockLine (V2 (wth-wllen) (4*hf)) (V2 ( wth) (4*hf)) + , sPS (V2 (wth/2) (hgt/2)) 0 putLamp ] return $ set rmPS plmnts $ roomRect wth hgt 2 6 @@ -112,14 +114,14 @@ glassLesson = do botRoom = set rmPS botplmnts $ roomRect 200 200 1 1 topRoom = set rmPS topplmnts $ roomRect 200 200 1 1 botplmnts = - [sPS (0,0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall - ,sPS (50,100) 0 $ PutCrit miniGunCrit - ,sPS (50,50) 0 putLamp + [sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall + ,sPS (V2 50 100) 0 $ PutCrit miniGunCrit + ,sPS (V2 50 50) 0 putLamp ] topplmnts = - [windowLine (100,200) (100,0) - ,sPS (50,100) 0 $ PutCrit miniGunCrit - ,sPS (50,50) 0 putLamp + [windowLine (V2 100 200) (V2 100 0) + ,sPS (V2 50 100) 0 $ PutCrit miniGunCrit + ,sPS (V2 50 50) 0 putLamp ] miniRoom1 :: RandomGen g => State g Room @@ -133,45 +135,45 @@ miniRoom1 = do ,50+4*hf,30+5*hf ] crx <- state $ randomR (wllen,wth-(wllen+40)) - let plmnts = [windowLine (wth-60, 40+hf) (wllen,40+hf) - ,windowLine (wth-wllen,40+2*hf) (60,40+2*hf) - ,windowLine (wth-60, 40+3*hf) (wllen,40+3*hf) - ,windowLine (wth-wllen,40+4*hf) (60,40+4*hf) - ,sPS (crx,cry) 0 $ PutCrit miniGunCrit - ,sPS (wth-20,hgt/2+40) 0 randC1 - ,sPS (wth/2,hgt/2) 0 putLamp - ,blockLine ( 0, 40+1*hf) (wllen,40+1*hf) - ,blockLine (wth-wllen, 40+2*hf) ( wth,40+2*hf) - ,blockLine ( 0, 40+3*hf) (wllen,40+3*hf) - ,blockLine (wth-wllen, 40+4*hf) ( wth,40+4*hf) + let plmnts = [windowLine (V2 (wth-60) ( 40+hf)) (V2 (wllen) (40+hf)) + ,windowLine (V2 (wth-wllen) (40+2*hf)) (V2 (60) (40+2*hf)) + ,windowLine (V2 (wth-60) ( 40+3*hf)) (V2 (wllen) (40+3*hf)) + ,windowLine (V2 (wth-wllen) (40+4*hf)) (V2 (60) (40+4*hf)) + ,sPS (V2 crx cry) 0 $ PutCrit miniGunCrit + ,sPS (V2 (wth-20) (hgt/2+40)) 0 randC1 + ,sPS (V2 (wth/2) (hgt/2)) 0 putLamp + ,blockLine (V2 ( 0) ( 40+1*hf)) (V2 (wllen) (40+1*hf)) + ,blockLine (V2 (wth-wllen) ( 40+2*hf)) (V2 ( wth) (40+2*hf)) + ,blockLine (V2 ( 0) ( 40+3*hf)) (V2 (wllen) (40+3*hf)) + ,blockLine (V2 (wth-wllen) ( 40+4*hf)) (V2 ( wth) (40+4*hf)) ] - return $ set rmPS plmnts $ shiftRoomBy ((0,40),0) $ roomRect wth hgt 2 4 + return $ set rmPS plmnts $ shiftRoomBy ((V2 0 40),0) $ roomRect wth hgt 2 4 miniTree2 :: RandomGen g => State g (Tree (Either Room Room)) miniTree2 = miniRoom1 >>= randomiseOutLinks - >>= changeLinkTo (\p -> (snd . fst) p < 70) + >>= changeLinkTo (\p -> (sndV2 . fst) p < 70) <&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd) miniRoom3 :: RandomGen g => State g (Tree (Either Room Room)) miniRoom3 = do w <- state $ randomR (300,400) h <- state $ randomR (300,400) - let cp = (0,h/2+40) - let b = PutBlock [5,20,20] (greyN 0.5) [(-10,-60) + let cp = (V2 (0) (h/2+40)) + let b = PutBlock [5,20,20] (greyN 0.5) $ map toV2 [(-10,-60) ,( 10,-60) ,( 10,-80) ,(-10,-80) ] let plmnts = [sPS cp 0 $ PutCrit miniGunCrit - ,sPS cp 0 $ windowLineType (0,-40) (0,-80) - ,sPS cp (1*pi/4) $ windowLineType (0,-40) (0,-80) - ,sPS cp (2*pi/4) $ windowLineType (0,-40) (0,-80) - ,sPS cp (3*pi/4) $ windowLineType (0,-40) (0,-80) - ,sPS cp (4*pi/4) $ windowLineType (0,-40) (0,-80) - ,sPS cp (5*pi/4) $ windowLineType (0,-40) (0,-80) - ,sPS cp (6*pi/4) $ windowLineType (0,-40) (0,-80) - ,sPS cp (7*pi/4) $ windowLineType (0,-40) (0,-80) + ,sPS cp 0 $ windowLineType (V2 0 (-40)) (V2 0 (-80)) + ,sPS cp (1*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) + ,sPS cp (2*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) + ,sPS cp (3*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) + ,sPS cp (4*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) + ,sPS cp (5*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) + ,sPS cp (6*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) + ,sPS cp (7*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) ,sPS cp (pi/8) b ,sPS cp (pi/8+1*pi/4) b ,sPS cp (pi/8+2*pi/4) b @@ -180,7 +182,7 @@ miniRoom3 = do ,sPS cp (pi/8+5*pi/4) b ,sPS cp (pi/8+6*pi/4) b ,sPS cp (pi/8+7*pi/4) b - ,sPS (w/2,h/2) 0 putLamp + ,sPS (V2 (w/2) (h/2)) 0 putLamp ] fmap connectRoom $ randomiseOutLinks $ set rmPS plmnts $ roomRectAutoLinks w h @@ -203,14 +205,14 @@ roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost g (Node y ys) = Node y $ map g ys roomCenterPillar :: RandomGen g => State g Room -roomCenterPillar = changeLinkTo ((\p -> dist p (120,0) < 10) . fst) +roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst) $ set rmPS plmnts $ roomRect 240 240 2 2 where plmnts = - [ blockLine (115,115) (115,125) - , blockLine (125,115) (125,125) - , sPS (40,120) 0 putLamp - , sPS (200,120) 0 putLamp + [ blockLine (V2 115 115) (V2 115 125) + , blockLine (V2 125 115) (V2 125 125) + , sPS (V2 40 120) 0 putLamp + , sPS (V2 200 120) 0 putLamp ] roomOctogon :: Room @@ -219,12 +221,12 @@ roomOctogon = defaultRoom , _rmLinks = lnks , _rmPath = allPairs $ map fst lnks , _rmPS = [] - , _rmBound = [[(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ] + , _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ] , _rmFloor = [oTile poly 7] } where - poly = [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)] - lnks = + poly = map toV2 [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)] + lnks = map (first toV2) [((0,140),0) ,((35,125),negate $ pi/4) ,((-35,125),pi/4) @@ -259,26 +261,26 @@ weaponEmptyRoom = do w <- state $ randomR (220,300) h <- state $ randomR (220,300) let plmnts = - [sPS (w/2,h-40) 0 $ RandPS randFirstWeapon - ,sPS (20,20) (pi/2) randC1 - ,sPS (w-20,20) (pi/2) randC1 - ,sPS (w/2,h/2) 0 putLamp + [sPS (V2 (w/2) (h-40)) 0 $ RandPS randFirstWeapon + ,sPS (V2 20 20) (pi/2) randC1 + ,sPS (V2 (w-20) (20)) (pi/2) randC1 + ,sPS (V2 (w/2) (h/2)) 0 putLamp ] (fmap connectRoom . randomiseOutLinks) =<< - changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst) (set rmPS plmnts $ roomRect w h 2 2) + changeLinkTo ((\p -> dist p (V2 (w/2) (0)) < 10) . fst) (set rmPS plmnts $ roomRect w h 2 2) weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room)) weaponUnderCrits = do let plmnts = - [sPS (20,0) 0 $ RandPS randFirstWeapon - ,sPS (20,0) (negate $ pi/2) randC1 - ,sPS (20,20) (negate $ pi/2) randC1 + [sPS (V2 20 0) 0 $ RandPS randFirstWeapon + ,sPS (V2 20 0) (negate $ pi/2) randC1 + ,sPS (V2 20 20) (negate $ pi/2) randC1 ] let continuationRoom = treeFromTrunk [Left corridorN,Left corridorN] (connectRoom (set rmPS plmnts corridorN)) rcp' <- roomCenterPillar - let rcp = over rmPS ( sPS (120,80) 0 putLamp : ) rcp' + let rcp = over rmPS ( sPS (V2 120 80) 0 putLamp : ) rcp' deadEndRoom' <- takeOne [roomPillars,rcp] junctionRoom <- takeOne [Left tEast,Left tWest] return $ treeFromTrunk [Left corridorN,Left corridorN] @@ -289,10 +291,10 @@ weaponUnderCrits = do weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room)) weaponBehindPillar = do - cpos <- takeOne $ [(x,y) | x <- [20,220], y <- [20,220]] ++ [(120,160),(120,200)] - let d p = argV $ (120,80) -.- p + cpos <- takeOne $ [(V2 x y) | x <- [20,220], y <- [20,220]] ++ [(V2 120 160),(V2 120 200)] + let d p = argV $ (V2 120 80) -.- p let plmnts1 = - [sPS (120,160) 0 $ RandPS randFirstWeapon + [sPS (V2 120 160) 0 $ RandPS randFirstWeapon ,sPS cpos (d cpos) randC1 ] rcp <- roomCenterPillar @@ -300,15 +302,15 @@ weaponBehindPillar = do [Left door ,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp ] - (connectRoom $ set rmPS [sPS (20,60) (negate $ pi/2) randC1] corridorN) + (connectRoom $ set rmPS [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN) weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room)) weaponBetweenPillars = do - wpPos <- takeOne [(x,y) | x <- [20,120,220], y <- [20,120,220]] - (ps,_) <- takeNMore 2 ([], [(x,y) | x <- [20,220], y <- [20,120,220]]) + wpPos <- takeOne [(V2 x y) | x <- [20,120,220], y <- [20,120,220]] + (ps,_) <- takeNMore 2 ([], [(V2 x y) | x <- [20,220], y <- [20,120,220]]) let crPos1 = ps !! 0 crPos2 = ps !! 1 - d p = argV $ (120,120) -.- p + d p = argV $ (V2 120 120) -.- p plmnts = [sPS wpPos 0 $ RandPS randFirstWeapon ,sPS crPos1 (d crPos1) randC1 @@ -325,8 +327,8 @@ weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room)) weaponLongCorridor = do root <- takeOne [tEast, tWest] connectingRoom <- takeOne - [tEast & rmPS .~ [sPS (-40,60) 0 putLamp] - ,tWest & rmPS .~ [sPS ( 40,60) 0 putLamp] + [tEast & rmPS .~ [sPS (V2 (-40) (60)) 0 putLamp] + ,tWest & rmPS .~ [sPS (V2 40 60) 0 putLamp] ] i1 <- state $ randomR (2,5) i2 <- state $ randomR (2,5) @@ -334,11 +336,11 @@ weaponLongCorridor = do let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor) return $ Node (Left root) [branch1,branch2] where - putCrs = over rmPS (++ [sPS (10,40) (-pi/2) randC1 ,sPS (-10,40) (-pi/2) randC1 ]) - putWp = set rmPS [sPS (20,40) 0 $ RandPS randFirstWeapon ,sPS (20,60) 0 putLamp ] + putCrs = over rmPS (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) (40)) (-pi/2) randC1 ]) + putWp = set rmPS [sPS (V2 20 40) 0 $ RandPS randFirstWeapon ,sPS (V2 20 60) 0 putLamp ] critInDeadEnd :: Room -critInDeadEnd = set rmPS [sPS (0,0) 0 randC1] deadEndRoom +critInDeadEnd = set rmPS [sPS (V2 0 0) 0 randC1] deadEndRoom deadEndRoom :: Room deadEndRoom = defaultRoom @@ -346,11 +348,11 @@ deadEndRoom = defaultRoom ] , _rmLinks = lnks , _rmPath = [] - , _rmPS = [sPS (0,-10) 0 putLamp] + , _rmPS = [sPS (V2 (0) (-10)) 0 putLamp] , _rmBound = [rectNSWE 20 (-20) (-30) 30] } where - lnks = [((0,30) ,0) ] + lnks = [((V2 0 30) ,0) ] {- A random Either tree with a weapon and melee monster challenge. -} weaponRoom :: RandomGen g => State g (Tree (Either Room Room)) weaponRoom = join $ takeOne @@ -365,8 +367,8 @@ roomCCrits :: RandomGen g => State g (Tree (Either Room Room)) roomCCrits = do ps <- replicateM 20 $ randInCirc 9 let plmnts = map (\p -> sPS p 0 randC1) - $ zipWith (+.+) [(x,y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps - lamps = [sPS (50,100) 0 putLamp , sPS (175,100) 0 putLamp] + $ zipWith (+.+) [(V2 x y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps + lamps = [sPS (V2 50 100) 0 putLamp , sPS (V2 175 100) 0 putLamp] return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200 @@ -374,40 +376,40 @@ longRoom :: RandomGen g => State g Room longRoom = do h <- state $ randomR (1500,1500) let w = 75 - let cond x = (snd . fst) x < h - 40 - let ws = map (\ps -> sPS (0,0) 0 $ PutWall ps defaultCrystalWall) + let cond x = (sndV2 . fst) x < h - 40 + let ws = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall) [rectNSWE (h-35) (h-135) (-10) 10 ,rectNSWE (h-35) (h-135) 15 35 ,rectNSWE (h-35) (h-135) 40 60 ,rectNSWE (h-35) (h-135) 65 85 ] - let wsDefense = map (\ps -> sPS (0,0) 0 $ PutWall ps defaultCrystalWall) + let wsDefense = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall) [rectNSWE 95 70 0 25 ,rectNSWE 95 70 50 75 ] - brls <- fmap (map (\p -> sPS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) ) + brls <- fmap (map (\p -> sPS (p +.+ (V2 10 200)) 0 $ PutCrit explosiveBarrel) ) $ replicateM 5 $ randInRect (w-20) 900 let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++) changeLinkTo cond $ rm & rmPS .~ ws ++ brls ++ wsDefense ++ - [sPS ( 12.5,h-25) 0 $ PutCrit longCrit - ,sPS ( 37.5,h-25) 0 $ PutCrit longCrit - ,sPS ( 62.5,h-25) 0 $ PutCrit longCrit - ,sPS ( 25, 20) 0 putLamp - ,sPS ( 25,h-10) 0 putLamp + [sPS (V2 12.5 (h-25)) 0 $ PutCrit longCrit + ,sPS (V2 37.5 (h-25)) 0 $ PutCrit longCrit + ,sPS (V2 62.5 (h-25)) 0 $ PutCrit longCrit + ,sPS (V2 25 ( 20)) 0 putLamp + ,sPS (V2 25 (h-10)) 0 putLamp ] shooterRoom :: RandomGen g => State g Room shooterRoom = do h <- state $ randomR (200,300) - let cond x = (snd . fst) x < h - 40 + let cond x = (sndV2 . fst) x < h - 40 changeLinkTo cond $ roomRect 100 h 1 1 & rmPS .~ - [blockLine (50,50) (50,h) - ,sPS ( 25,h-25) 0 $ PutCrit $ addArmour autoCrit - ,sPS ( 75,h-30) 0 $ PutCrit explosiveBarrel - ,sPS ( 75,h-60) 0 $ PutCrit explosiveBarrel - ,sPS ( 85,h-10) 0 $ PutCrit explosiveBarrel - ,sPS ( 85,h-45) 0 $ PutCrit explosiveBarrel - ,sPS ( 75,h-80) 0 putLamp + [blockLine (V2 50 50) (V2 50 h) + ,sPS (V2 25 (h-25)) 0 $ PutCrit $ addArmour autoCrit + ,sPS (V2 75 (h-30)) 0 $ PutCrit explosiveBarrel + ,sPS (V2 75 (h-60)) 0 $ PutCrit explosiveBarrel + ,sPS (V2 85 (h-10)) 0 $ PutCrit explosiveBarrel + ,sPS (V2 85 (h-45)) 0 $ PutCrit explosiveBarrel + ,sPS (V2 75 (h-80)) 0 putLamp ] shootersRoom1 :: RandomGen g => State g Room @@ -426,7 +428,7 @@ shootersRoom1 = do let blv x y = putBlockV (x+25) (x-25) (y+10) y let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4 ++ [sPS p (-pi/2) $ PutCrit autoCrit - ,sPS (w/2,200) 0 putLamp + ,sPS (V2 (w/2) (200)) 0 putLamp ] return $ set rmPS plmnts $ roomRectAutoLinks w 600 @@ -444,16 +446,16 @@ shootersRoom = do let bln x y = putBlockN (x+25) (x-25) (y+10) y let blv x y = putBlockV (x+25) (x-25) (y+10) y let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4 - ++ [sPS (x1,y1-10) (-pi/2) $ PutCrit autoCrit - ,sPS (x2,y2-10) (-pi/2) $ PutCrit autoCrit - ,sPS (x3,y3-10) (-pi/2) $ PutCrit autoCrit - ,sPS (w/2,200) 0 putLamp + ++ [sPS (V2 (x1) (y1-10)) (-pi/2) $ PutCrit autoCrit + ,sPS (V2 (x2) (y2-10)) (-pi/2) $ PutCrit autoCrit + ,sPS (V2 (x3) (y3-10)) (-pi/2) $ PutCrit autoCrit + ,sPS (V2 (w/2) (200)) 0 putLamp ] return $ set rmPS plmnts $ roomRectAutoLinks w 600 pistolerRoom :: RandomGen g => State g Room pistolerRoom = do - let f2 x y = singleBlock (x,y) + let f2 x y = singleBlock (V2 x y) --f3 x y = [blockLine (x-20,y) (x+20,y) -- ,blockLine (x,y-20) (x,y+20) ] --f4 x y = [blockLine (x-20,y-20) (x+20,y+20) @@ -469,20 +471,20 @@ pistolerRoom = do xs = take i [20+0.5*(w-40)/(j-1),20+1.5*(w-40)/(j-1)..] ys = take i [20+0.5*(h-40)/(j-1),20+1.5*(h-40)/(j-1)..] gap = 0.5 * h / j - ps <- takeN 3 $ zip (map (+gap) xs) ys + ps <- takeN 3 $ zipWith V2 (map (+gap) xs) ys aa <- state $ randomR (0,2*pi) ab <- state $ randomR (0,2*pi) ac <- state $ randomR (0,2*pi) let plmnts = [sPS (ps !! 0) aa $ PutCrit pistolCrit ,sPS (ps !! 1) ab $ PutCrit pistolCrit ,sPS (ps !! 2) ac $ PutCrit pistolCrit - ,sPS (w/2,h-50) 0 putLamp - ,sPS (w/2,50) 0 putLamp - ,sPS (w-5,h-5) 0 putLamp - ,sPS (5,h-5) 0 putLamp - ,sPS (w-5,5) 0 putLamp - ,sPS (5,5) 0 putLamp - ,sPS (w/2,h/2) 0 putLamp + ,sPS (V2 (w/2) (h-50)) 0 putLamp + ,sPS (V2 (w/2) (50) ) 0 putLamp + ,sPS (V2 (w-5) (h-5) ) 0 putLamp + ,sPS (V2 ( 5) (h-5) ) 0 putLamp + ,sPS (V2 (w-5) (5) ) 0 putLamp + ,sPS (V2 ( 5) (5) ) 0 putLamp + ,sPS (V2 (w/2) (h/2) ) 0 putLamp ] ++ concat [f x y | x<-xs,y<-ys] @@ -491,16 +493,16 @@ pistolerRoom = do shootingRange :: RandomGen g => State g (Tree (Either Room Room)) shootingRange = do - rm1 <- shootersRoom1 >>= changeLinkTo (\((_,y),_) -> y < 40) - >>= filterLinks (\((_,y),r) -> y > 200 && r /= 0) - rm2 <- shootersRoom >>= changeLinkTo (\((x,y),_) -> y < 10 && x > 20 && x < 180) - >>= filterLinks (\((_,y),r) -> y > 200 && r /= 0) - rm3 <- shootersRoom >>= changeLinkTo (\((x,y),_) -> y < 10 && x > 20 && x < 180) + rm1 <- shootersRoom1 >>= changeLinkTo (\((V2 _ y),_) -> y < 40) + >>= filterLinks (\((V2 _ y),r) -> y > 200 && r /= 0) + rm2 <- shootersRoom >>= changeLinkTo (\((V2 x y),_) -> y < 10 && x > 20 && x < 180) + >>= filterLinks (\((V2 _ y),r) -> y > 200 && r /= 0) + rm3 <- shootersRoom >>= changeLinkTo (\((V2 x y),_) -> y < 10 && x > 20 && x < 180) >>= filterLinks (\(_,r) -> r == 0) return $ treeFromPost [Left rm1 - ,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (0,20) + ,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (V2 0 20) ,Left rm2 - ,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (0,20) + ,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (V2 0 20) ] (Right rm3) @@ -508,13 +510,13 @@ spawnerRoom :: RandomGen g => State g (Tree (Either Room Room)) spawnerRoom = do x <- state $ randomR (250,300) y <- state $ randomR (300,400) - wl <- takeOne [sPS (0,0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10)) + wl <- takeOne [sPS (V2 0 0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10)) defaultCrystalWall - ,windowLine (x/2,0) (x/2,y-60) + ,windowLine (V2 (x/2) (0)) (V2 (x/2) (y-60)) ] - let plmnts = [sPS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit + let plmnts = [sPS (V2 (x/4) ( y/4)) (pi/2) $ PutCrit spawnerCrit ,wl - ,sPS (x/2, y-10) 0 putLamp + ,sPS (V2 (x/2) ( y-10)) 0 putLamp ] let f ((lx,_),_) = lx < x/2-5 roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2) diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index 84e3e0a32..00e5c6ca4 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -23,16 +23,16 @@ airlockOneWay n = defaultRoom { _rmPolys = [rectNSWE 90 0 0 40] , _rmLinks = lnks , _rmPath = [] - , _rmPS = [sPS (0,15) 0 $ PutDoubleDoor col (not . cond) (0,0) (0,40) - ,sPS (0,75) 0 $ PutDoubleDoor col cond (0,0) (0,40) - ,sPS (35,45) (pi/2) $ PutButton $ makeButton col (over worldState + , _rmPS = [sPS (V2 0 15) 0 $ PutDoubleDoor col (not . cond) (V2 0 0) (V2 0 40) + ,sPS (V2 0 75) 0 $ PutDoubleDoor col cond (V2 0 0) (V2 0 40) + ,sPS (V2 35 45) (pi/2) $ PutButton $ makeButton col (over worldState (M.insert (DoorNumOpen n) True)) ] --, _rmBound = rectNSWE 90 30 (-30) 30 , _rmBound = [rectNSWE 75 15 0 40] } - where lnks = [((0,85),0) - ,((0, 5),pi) + where lnks = [((V2 0 85),0) + ,((V2 0 5),pi) ] cond w = or $ M.lookup (DoorNumOpen n) (_worldState w) col = dim $ dim $ bright red @@ -56,22 +56,22 @@ airlock0 n = defaultRoom , rectNSWE 65 35 (-40) 20 ] , _rmLinks = lnks - , _rmPath = [((20,95),(20,45)) - ,((20,45),(20, 5)) + , _rmPath = [((V2 20 95),(V2 20 45)) + ,((V2 20 45),(V2 20 5)) ] , _rmPS = - [sPS (0,20) 0 $ PutDoubleDoor col (not . cond) (1,0) (39,0) - ,sPS (0,80) 0 $ PutDoubleDoor col cond (1,0) (39,0) - ,sPS (35,50) (pi/2) $ PutButton $ makeSwitch col + [sPS (V2 0 20) 0 $ PutDoubleDoor col (not . cond) (V2 1 0) (V2 39 0) + ,sPS (V2 0 80) 0 $ PutDoubleDoor col cond (V2 1 0) (V2 39 0) + ,sPS (V2 35 50) (pi/2) $ PutButton $ makeSwitch col (over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) False)) - ,sPS (-25, 50) 0 putLamp + ,sPS (V2 (-25) ( 50)) 0 putLamp ] , _rmBound = [rectNSWE 75 15 0 40] } where - lnks = [((20,95),0) - ,((20, 5),pi) + lnks = [((V2 20 95),0) + ,((V2 20 5),pi) ] cond w = or $ M.lookup (DoorNumOpen n) (_worldState w) col = dim $ dim $ bright red @@ -84,29 +84,29 @@ airlock90 n = defaultRoom [ rectNSWE 100 10 10 100 , rectNSWE 20 0 20 60 , rectNSWE 20 60 20 0 - , [ (10,100) + , map toV2 [ (10,100) , (100,150) , (150,100) , (100,10) ] ] , _rmLinks = - [((0,40),pi/2) - ,((40, 0),pi) + [((V2 0 40),pi/2) + ,((V2 40 0),pi) ] , _rmPath = - [((0,40),(40,0)) - ,((40,0),(0,40)) + [((V2 0 40),(V2 40 0)) + ,((V2 40 0),(V2 0 40)) ] , _rmPS = - [sPS (5,5) 0 $ PutDoor col (not . cond) pss - ,sPS (120,120) (3* pi/4) $ PutButton $ makeSwitch col + [sPS (V2 5 5) 0 $ PutDoor col (not . cond) pss + ,sPS (V2 120 120) (3* pi/4) $ PutButton $ makeSwitch col (over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) False)) - ,sPS (60, 60) 0 putLamp + ,sPS (V2 60 60) 0 putLamp ] , _rmBound = - [[ (10,10) + [map toV2 [ (10,10) , (10,100) , (100,150) , (150,100) @@ -116,7 +116,7 @@ airlock90 n = defaultRoom where cond w = or $ M.lookup (DoorNumOpen n) (_worldState w) col = dim $ dim $ bright red - pss = ((0,0) ,) <$> arcStepwise 3 (negate $ pi/2) (0,0) (0,55) + pss = ((V2 0 0) ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 0 55) airlockCrystal :: Int -- ^ Door id @@ -124,7 +124,7 @@ airlockCrystal airlockCrystal n = defaultRoom { _rmPolys = [ rectNSWE 140 0 0 40 - , orderPolygon + , orderPolygon $ map toV2 [(39,20) ,(150,60) ,(150,80) @@ -132,20 +132,20 @@ airlockCrystal n = defaultRoom ] ] , _rmLinks = - [((20,130),0) - ,((20, 0),pi) + [((V2 20 130),0) + ,((V2 20 0),pi) ] , _rmPath = [ ] , _rmPS = - [sPS (0,0) 0 $ PutDoor col (not . cond) pss - ,sPS (145,70) (pi/2) $ PutButton $ makeSwitch col + [sPS (V2 0 0) 0 $ PutDoor col (not . cond) pss + ,sPS (V2 145 70) (pi/2) $ PutButton $ makeSwitch col (over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) False)) - ,crystalLine (0,70) (40,70) - ,sPS (20, 40) 0 putLamp - ,sPS (20, 100) 0 putLamp + ,crystalLine (V2 0 70) (V2 40 70) + ,sPS (V2 20 40) 0 putLamp + ,sPS (V2 20 100) 0 putLamp ] , _rmBound = [ ] @@ -154,5 +154,5 @@ airlockCrystal n = defaultRoom cond w = or $ M.lookup (DoorNumOpen n) (_worldState w) col = dim $ dim $ bright red pss :: [(Point2,Point2)] - pss = reverse $ fmap ( (\x -> ((50,x),(50,x+50)) ) . fromIntegral) + pss = reverse $ fmap ( (\x -> ((V2 50 x),(V2 (50) (x+50))) ) . fromIntegral) [20::Int,22..70] diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs index 43b253647..0142b17df 100644 --- a/src/Dodge/Room/Boss.hs +++ b/src/Dodge/Room/Boss.hs @@ -29,21 +29,21 @@ roomGlassOctogon x = defaultRoom ,rectNSWE 0 (-(x + 40)) (-20) 20 ] , _rmLinks = - [((0,x),0) - ,((0,-(x+40)),pi) + [((V2 0 x),0) + ,((V2 (0) (-(x+40))),pi) ] - , _rmPath = [((0,x),(0,-(x+40))) - ,((0,-(x+40)),(0,x))] + , _rmPath = [((V2 (0) (x)),(V2 (0) (-(x+40)))) + ,((V2 (0) (-(x+40))),(V2 (0) (x)))] , _rmPS = - [sPS (fx,fx) 0 putLamp - ,sPS (-fx,fx) 0 putLamp - ,sPS (fx,-fx) 0 putLamp - ,sPS (-fx,-fx) 0 putLamp - ,crystalLine (-x,x/2) (negate (x/2), x) - ,crystalLine (x,x/2) (x/2, x) - ,crystalLine (x/2,-x) (x,negate (x/2)) - ,crystalLine (negate $ x/2,-x) (-x,negate (x/2)) - ,blockLine (-40,40-x) (40,40-x) + [sPS (V2 fx fx) 0 putLamp + ,sPS (V2 (-fx) (fx)) 0 putLamp + ,sPS (V2 (fx) (-fx)) 0 putLamp + ,sPS (V2 (-fx) (-fx)) 0 putLamp + ,crystalLine (V2 (-x) (x/2)) (V2 (negate (x/2)) ( x)) + ,crystalLine (V2 (x) (x/2)) (V2 (x/2) ( x)) + ,crystalLine (V2 (x/2) (-x)) (V2 (x) (negate (x/2))) + ,crystalLine (V2 (negate $ x/2) (-x)) (V2 (-x) (negate (x/2))) + ,blockLine (V2 (-40) (40-x)) (V2 (40) (40-x)) ] , _rmBound = [rectNSWE x (-x) (-x) x] } @@ -51,11 +51,11 @@ roomGlassOctogon x = defaultRoom fx = 4 * x / 5 bossRoom :: RandomGen g => Creature -> State g Room -bossRoom cr = randomMediumRoom <&> rmPS %~ ( sPS (0,100) (negate $ pi/2) (PutCrit cr) :) +bossRoom cr = randomMediumRoom <&> rmPS %~ ( sPS (V2 0 100) (negate $ pi/2) (PutCrit cr) :) armouredChasers :: RandomGen g => State g (Tree Room) armouredChasers = do - ps <- takeN 5 [(x,y) | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ] + ps <- takeN 5 [(V2 x y) | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ] as <- replicateM 5 . state $ randomR (0,2*pi) let theCrits = zipWith3 (\p a c -> sPS p a (PutCrit c)) ps as cs treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPS %~ (++ theCrits)) @@ -80,21 +80,21 @@ roomCross x y = defaultRoom ,rectNSWE (-x) x y (-y) ] , _rmLinks = - [((x,y-20),negate $ pi/2) - ,((x,20-y),negate $ pi/2) - ,((20-y,x),0) - ,((y-20,x),0) - ,((-x,y-20),pi/2) - ,((-x,20-y),pi/2) - ,((20-y,-x),pi) - ,((y-20,-x),pi) + [((V2 (x) (y-20)),negate $ pi/2) + ,((V2 (x) (20-y)),negate $ pi/2) + ,((V2 (20-y) (x)),0) + ,((V2 (y-20) (x)),0) + ,((V2 (-x) (y-20)),pi/2) + ,((V2 (-x) (20-y)),pi/2) + ,((V2 (20-y) (-x)),pi) + ,((V2 (y-20) (-x)),pi) ] , _rmPath = [] , _rmPS = - [sPS ( x, 0) 0 putLamp - ,sPS (-x, 0) 0 putLamp - ,sPS ( 0, x) 0 putLamp - ,sPS ( 0,-x) 0 putLamp + [sPS (V2 ( x) ( 0)) 0 putLamp + ,sPS (-V2 (x) ( 0)) 0 putLamp + ,sPS (V2 ( 0) ( x)) 0 putLamp + ,sPS (V2 ( 0) (-x)) 0 putLamp ] , _rmBound = [rectNSWE y (-y) (-x) x @@ -107,7 +107,7 @@ roomShuriken -> Float -- ^ Second width/2 -> Room roomShuriken x y = - let ps = [ + let ps = [ map toV2 [ (0,-20) , (x,-20) , (x,y) @@ -115,12 +115,12 @@ roomShuriken x y = ] ] corner = defaultRoom { _rmPolys = ps - , _rmLinks = [((x-1,y-20),negate $ pi/2)] + , _rmLinks = [((V2 (x-1) (y-20)),negate $ pi/2)] , _rmPath = [] - , _rmPS = [sPS (x/2,x/2) 0 putLamp] + , _rmPS = [sPS (V2 (x/2) (x/2)) 0 putLamp] , _rmBound = ps } - in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2] + in foldr1 combineRooms $ map (\r -> shiftRoomBy ((V2 0 0), r) corner) [0,pi/2,pi,3*pi/2] {- | TODO: pathing Precondition: first float is less than the second by at least 40. -} roomTwistCross @@ -129,7 +129,7 @@ roomTwistCross -> Float -- ^ Third width, should be smallest, possibly negative -> Room roomTwistCross x y z = - let ps = [ [ (x,negate $ z+20) + let ps = [ map toV2 [ (x,negate $ z+20) , (x,x) , (z,y) , (z-20,x) @@ -139,9 +139,9 @@ roomTwistCross x y z = ] corner = defaultRoom { _rmPolys = ps - , _rmLinks = [((z,y-20), pi/2)] + , _rmLinks = [((V2 (z) (y-20)), pi/2)] , _rmPath = [] - , _rmPS = [sPS (x/2,x/2) 0 putLamp] + , _rmPS = [sPS (V2 (x/2) (x/2)) 0 putLamp] , _rmBound = ps } - in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2] + in foldr1 combineRooms $ map (\r -> shiftRoomBy ((V2 0 0), r) corner) [0,pi/2,pi,3*pi/2] diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 1862c7858..e1b31ab99 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -33,18 +33,18 @@ twinSlowDoorRoom twinSlowDoorRoom drID w h x = defaultRoom { _rmPolys = ps , _rmLinks = - [ ((w,h/2) , negate $ pi/2) - , ((-w,h/2) , pi/2) - , ((0,-h), pi) + [ ((V2 (w) (h/2)) , negate $ pi/2) + , ((V2 (-w) (h/2)) , pi/2) + , ((V2 (0) (-h)), pi) ] , _rmPath = [] , _rmPS = - [ sPS (0,h/2) 0 putLamp - , sPS (25,5) 0 putLamp - , sPS (negate 25,5) 0 putLamp - , sPS (0,0) 0 $ PutDoor col (not . cond) drL - , sPS (0,0) 0 $ PutDoor col (not . cond) drR - , sPS (0,h-5) pi $ PutButton $ makeButton col + [ sPS (V2 (0) (h/2)) 0 putLamp + , sPS (V2 (25) (5)) 0 putLamp + , sPS (V2 (negate 25) (5)) 0 putLamp + , sPS (V2 0 0) 0 $ PutDoor col (not . cond) drL + , sPS (V2 0 0) 0 $ PutDoor col (not . cond) drR + , sPS (V2 (0) (h-5)) pi $ PutButton $ makeButton col (over worldState (M.insert (DoorNumOpen drID) True)) ] , _rmBound = ps @@ -54,9 +54,9 @@ twinSlowDoorRoom drID w h x = defaultRoom [rectNSWE h (-2) (-w) w ,rectNSWE 20 (-h) (negate x) x ] - drL = fmap ((\h' -> ((x,-h'),(x,h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral) + drL = fmap ((\h' -> ((V2 (x) (-h')),(V2 (x) (h-h')))) . (* h) . (/ fromIntegral nDrp) . fromIntegral) [0..nDrp] - drR = fmap ((\h' -> ((-x,-h'),(-x,h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral) + drR = fmap ((\h' -> ((V2 (-x) (-h')),(V2 (-x) (h-h')))) . (* h) . (/ fromIntegral nDrp) . fromIntegral) [0..nDrp] nDrp = ceiling h :: Int cond w' = or $ M.lookup (DoorNumOpen drID) (_worldState w') @@ -67,8 +67,8 @@ twinSlowDoorChasers => Int -- ^ Door id -> State g Room twinSlowDoorChasers drid = do - let lps = (-65 ,) <$> [20,40 .. 180] - rps = (65 ,) <$> [20,40 .. 180] + let lps = (V2 (-65)) <$> [20,40 .. 180] + rps = (V2 65) <$> [20,40 .. 180] ps <- takeN 4 $ lps ++ rps let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps return $ twinSlowDoorRoom drid 80 200 40 & rmPS %~ (plmnts ++) @@ -79,19 +79,19 @@ slowDoorRoom = do y <- state $ randomR (400,800) h <- state $ randomR (200,min (y-100) 500) (butPos,butRot) <- takeOne - [( (x/2-50,5),0) - ,( (x/2+50,5),0) + [( (V2 (x/2-50) (5)),0) + ,( (V2 (x/2+50) (5)),0) ] let n = 25 xs <- replicateM n $ state $ randomR (10,x-10) ys <- replicateM n $ state $ randomR (h+20,y) rs <- replicateM n $ state $ randomR (0,2*pi) - let ps = zip xs ys + let ps = zipWith V2 xs ys xs' <- replicateM 5 $ state $ randomR (10,x-10) ys' <- replicateM 5 $ state $ randomR (h+20,y) let crits = zipWith (\p r -> sPS p r randC1) ps rs - lsources = [sPS (x/2,30) 0 putLamp, sPS (x/2,y-30) 0 putLamp] - barrels = zipWith (\x' y' -> sPS (x',y') 0 $ PutCrit explosiveBarrel) xs' ys' + lsources = [sPS (V2 (x/2) (30)) 0 putLamp, sPS (V2 (x/2) (y-30)) 0 putLamp] + barrels = zipWith (\x' y' -> sPS (V2 x' y') 0 $ PutCrit explosiveBarrel) xs' ys' pillarsa = [] pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20) ++ putBlockRect (2*x/5-20) (2*x/5+20) (h/2-20) (h/2+20) @@ -100,15 +100,15 @@ slowDoorRoom = do pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20) ++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20) pillars <- takeOne [pillarsa, pillarsb, pillarsc] - let cond x' = (snd . fst) x' > h + 40 - cond2 x' = (snd . fst) x' < h - 40 - but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (0,h) (x,h) + let cond x' = (sndV2 . fst) x' > h + 40 + cond2 x' = (sndV2 . fst) x' < h - 40 + but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (V2 0 h) (V2 x h) -- ,PutSwitchDoor (dim $ light red) butPos butRot (0,h) (x,h) ] fmap connectRoom (filterLinks cond =<< changeLinkTo cond2 - (set rmPS ([sPS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources) + (set rmPS ([sPS (V2 0 0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources) $ roomRectAutoLinks x y ) ) diff --git a/src/Dodge/Room/NoNeedWeapon.hs b/src/Dodge/Room/NoNeedWeapon.hs index dbbf31fde..ede5ac3e5 100644 --- a/src/Dodge/Room/NoNeedWeapon.hs +++ b/src/Dodge/Room/NoNeedWeapon.hs @@ -11,6 +11,7 @@ import Dodge.Room.Procedural import Dodge.Room.Link import Dodge.RandomHelp import Dodge.LevelGen.Data +import Geometry.Data import Control.Lens --import Control.Monad @@ -29,11 +30,11 @@ centerVaultExplosiveExit centerVaultExplosiveExit drID = do cr <- takeOne [miniGunCrit, autoCrit] let extraPS = - [sPS (0,175) 0 $ PutCrit explosiveBarrel - ,sPS (5,195) 0 $ PutCrit explosiveBarrel - ,sPS (0,200) 0 $ PutCrit explosiveBarrel - ,sPS (-4,195) 0 $ PutCrit explosiveBarrel - ,sPS (0,0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll) + [sPS (V2 0 175) 0 $ PutCrit explosiveBarrel + ,sPS (V2 5 195) 0 $ PutCrit explosiveBarrel + ,sPS (V2 0 200) 0 $ PutCrit explosiveBarrel + ,sPS (V2 (-4) (195)) 0 $ PutCrit explosiveBarrel + ,sPS (V2 0 0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll) ] r <- centerVaultRoom drID 200 200 50 <&> rmPS %~ (extraPS ++) randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2 diff --git a/src/Dodge/Room/Placement.hs b/src/Dodge/Room/Placement.hs index 7cc9ed361..0a6c2568e 100644 --- a/src/Dodge/Room/Placement.hs +++ b/src/Dodge/Room/Placement.hs @@ -28,7 +28,7 @@ Width 9, also extends out from each point by 9. -} blockLine :: Point2 -> Point2 -> Placement blockLine a b = SinglePlacement $ PS - { _psPos = (0,0) + { _psPos = (V2 0 0) , _psRot = 0 , _psType = PutLineBlock baseBlockPane 9 9 a b } @@ -39,7 +39,7 @@ Width 8, also extends out from each point by 8. -} windowLine :: Point2 -> Point2 -> Placement windowLine a b = SinglePlacement $ PS - { _psPos = (0,0) + { _psPos = (V2 0 0) , _psRot = 0 , _psType = PutLineBlock baseWindowPane 8 8 a b } @@ -50,7 +50,7 @@ Width 7, also extends out from each point by 7. -} crystalLine :: Point2 -> Point2 -> Placement crystalLine a b = SinglePlacement $ PS - { _psPos = (0,0) + { _psPos = (V2 0 0) , _psRot = 0 , _psType = PutWall ps defaultCrystalWall } @@ -68,7 +68,7 @@ Depth 15, does not extend wider than points. -} wallLine :: Point2 -> Point2 -> Placement wallLine a b = SinglePlacement $ PS - { _psPos = (0,0) + { _psPos = (V2 0 0) , _psRot = 0 , _psType = PutWall ps defaultWall } @@ -87,7 +87,7 @@ windowLineType = PutLineBlock baseWindowPane 8 8 baseBlockPane :: Wall baseBlockPane = Block - { _wlLine = ((0,0),(50,0)) + { _wlLine = ((V2 0 0),(V2 50 0)) , _wlID = 0 , _wlColor = greyN 0.5 , _wlSeen = False @@ -100,7 +100,7 @@ baseBlockPane = Block } baseWindowPane :: Wall baseWindowPane = Block - { _wlLine = ((0,0),(50,0)) + { _wlLine = ((V2 0 0),(V2 50 0)) , _wlID = 0 , _wlColor = withAlpha 0.2 cyan , _wlSeen = False @@ -141,10 +141,10 @@ putBlockRect -> Float -> Float -> [Placement] -putBlockRect a x b y = [ blockLine (a,b) (a,y) - , blockLine (a,y) (x,y) - , blockLine (x,y) (x,b) - , blockLine (x,b) (a,b) +putBlockRect a x b y = [ blockLine (V2 a b) (V2 a y) + , blockLine (V2 a y) (V2 x y) + , blockLine (V2 x y) (V2 x b) + , blockLine (V2 x b) (V2 a b) ] putBlockV :: Float @@ -152,8 +152,8 @@ putBlockV -> Float -> Float -> [Placement] -putBlockV a x b y = [ blockLine (a,b) (a,y) - , blockLine (x,b) (a,b) +putBlockV a x b y = [ blockLine (V2 a b) (V2 a y) + , blockLine (V2 x b) (V2 a b) ] putBlockC :: Float @@ -161,9 +161,9 @@ putBlockC -> Float -> Float -> [Placement] -putBlockC a x b y = [ blockLine (a,b) (a,y) - , blockLine (x,b) (a,b) - , blockLine (a,y) (x,y) +putBlockC a x b y = [ blockLine (V2 a b) (V2 a y) + , blockLine (V2 x b) (V2 a b) + , blockLine (V2 a y) (V2 x y) ] putBlockN :: Float @@ -171,7 +171,7 @@ putBlockN -> Float -> Float -> [Placement] -putBlockN a x b y = [ blockLine (a,b) (a,y) - , blockLine (x,b) (a,b) - , blockLine (x,y) (x,b) +putBlockN a x b y = [ blockLine (V2 a b) (V2 a y) + , blockLine (V2 x b) (V2 a b) + , blockLine (V2 x y) (V2 x b) ] diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index b813fa2b5..d8b795c75 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -46,25 +46,25 @@ roomRect x y xn yn = defaultRoom { _rmPolys = [rectNSWE y 0 0 x ] , _rmLinks = lnks , _rmPath = concatMap doublePair pth - , _rmPS = [sPS (x/2,y/2) 0 putLamp] + , _rmPS = [sPS (V2 (x/2) (y/2)) 0 putLamp] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] , _rmFloor = [Tile { _tilePoly = rectNSWE y 0 0 x - , _tileCenter = (0,0) - , _tileX = (50,0) - , _tileY = (0,50) + , _tileCenter = (V2 0 0) + , _tileX = (V2 50 0) + , _tileY = (V2 0 50) , _tileZ = 16 } ] } where yd = (y - 40) / fromIntegral yn xd = (x - 40) / fromIntegral xn - elnks = zip (translateS (0,20) $ gridPoints 0 1 yd (yn+1)) (repeat ( pi/2)) - wlnks = zip (translateS (x,20) $ gridPoints 0 1 yd (yn+1)) (repeat (-pi/2)) - nlnks = zip (translateS (20,y) $ gridPoints xd (xn+1) 0 1 ) (repeat 0 ) - slnks = zip (translateS (20,0) $ gridPoints xd (xn+1) 0 1 ) (repeat pi ) + elnks = zip (translateS (V2 0 20) $ gridPoints 0 1 yd (yn+1)) (repeat ( pi/2)) + wlnks = zip (translateS (V2 x 20) $ gridPoints 0 1 yd (yn+1)) (repeat (-pi/2)) + nlnks = zip (translateS (V2 20 y) $ gridPoints xd (xn+1) 0 1 ) (repeat 0 ) + slnks = zip (translateS (V2 20 0) $ gridPoints xd (xn+1) 0 1 ) (repeat pi ) lnks = nlnks ++ elnks ++ wlnks ++ slnks - pth = linksAndPath lnks $ translateS (20,20) (makeGrid xd xn yd yn) + pth = linksAndPath lnks $ translateS (V2 20 20) (makeGrid xd xn yd yn) {- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -} @@ -79,12 +79,12 @@ makeGrid x nx y ny $ gridPoints x nx y ny gridPoints :: Float -> Int -> Float -> Int -> [Point2] -gridPoints x nx y ny = [(a,b) | a <- take nx $ scanl (+) 0 $ repeat x +gridPoints x nx y ny = [(V2 a b) | a <- take nx $ scanl (+) 0 $ repeat x , b <- take ny $ scanl (+) 0 $ repeat y ] makeRect :: Float -> Float -> [(Point2,Point2)] -makeRect x y = [((0,0),(x,0)) +makeRect x y = map (bimap toV2 toV2) [((0,0),(x,0)) ,((0,0),(0,y)) ,((x,y),(x,0)) ,((x,y),(0,y)) @@ -123,29 +123,29 @@ Add a light and a 'PutNothing' placement. -} fourthWall :: RandomGen g => Float -> State g Room fourthWall w = do b <- takeOne - [ [ sPS (20-w,w-40) 0 putLamp - , sPS (0,40) 0 putLamp - , sPS (w-20,w-20) pi PutNothing - , blockLine (w/2,w/2) (w/2,w) + [ [ sPS (V2 (20-w) (w-40)) 0 putLamp + , sPS (V2 (0) (40)) 0 putLamp + , sPS (V2 (w-20) (w-20)) pi PutNothing + , blockLine (V2 (w/2) (w/2)) (V2 (w/2) (w)) ] - , [ sPS (20-w,w-40) 0 putLamp - , sPS (0,40) 0 putLamp - , sPS (w-20,w-20) pi PutNothing - , blockLine (w/2,w/2) (negate $ w/2,w/2) + , [ sPS (V2 (20-w) (w-40)) 0 putLamp + , sPS (V2 0 40) 0 putLamp + , sPS (V2 (w-20) (w-20)) pi PutNothing + , blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2)) ] - , [ sPS (20-w,w-40) 0 putLamp - , sPS (0,20) 0 putLamp - , sPS (w-20,w-20) pi PutNothing - , blockLine (w/2,w/2) (0,w/2) - , blockLine (-29,w) (0,w/2) + , [ sPS (V2 (20-w) (w-40)) 0 putLamp + , sPS (V2 0 20) 0 putLamp + , sPS (V2 (w-20) (w-20)) pi PutNothing + , blockLine (V2 (w/2) (w/2)) (V2 (0) (w/2)) + , blockLine (V2 (-29) (w)) (V2 (0) (w/2)) ] ] pure $ defaultRoom - { _rmPolys = [ [(0,0),(w,w),(-w,w)] ] - , _rmLinks = [((0,w), 0)] - , _rmPath = [((0,w),(0,0)),((0,0),(0,w))] + { _rmPolys = [ map toV2 [(0,0),(w,w),(-w,w)] ] + , _rmLinks = [((V2 0 w), 0)] + , _rmPath = [((V2 0 w),(V2 0 0)),((V2 0 0),(V2 0 w))] , _rmPS = b - , _rmBound = [[(0,0),(w,w),(-w,w)]] + , _rmBound = [[(V2 0 0),(V2 w w),(V2 (-w) (w))]] } --fourthCorner :: Float -> Room --fourthCorner w = Room @@ -162,38 +162,38 @@ fourthWall w = do fourthCornerWall :: RandomGen g => Float -> State g Room fourthCornerWall w = do b <- takeOne - [ [ sPS (10-w,w) 0 putLamp - , sPS (w-10,w) 0 putLamp - , sPS (0,10) 0 putLamp - , sPS (0,2*w-20) pi PutNothing - , blockLine (w/2,w/2) (0,w) - , blockLine (negate $ w/2,w/2) (0,w) + [ [ sPS (V2 (10-w) (w)) 0 putLamp + , sPS (V2 (w-10) (w)) 0 putLamp + , sPS (V2 0 10) 0 putLamp + , sPS (V2 (0) (2*w-20)) pi PutNothing + , blockLine (V2 (w/2) (w/2)) (V2 0 w) + , blockLine (V2 (negate $ w/2) (w/2)) (V2 0 w) ] - , [ sPS (0,3*w/2) 0 putLamp - , sPS (w-10,w) 0 putLamp - , sPS (10-w,w-20) 0 putLamp - , sPS (0,10) 0 putLamp - , sPS (0,2*w-20) pi PutNothing - , blockLine (w/2,w/2) (0,w) - , blockLine (negate w,w) (0,w) + , [ sPS (V2 (0) (3*w/2)) 0 putLamp + , sPS (V2 (w-10) (w)) 0 putLamp + , sPS (V2 (10-w) (w-20)) 0 putLamp + , sPS (V2 0 10) 0 putLamp + , sPS (V2 (0) (2*w-20)) pi PutNothing + , blockLine (V2 (w/2) (w/2)) (V2 0 w) + , blockLine (V2 (negate w) (w)) (V2 0 w) ] - , [ sPS (10-w,w) 0 putLamp - , sPS (w-10,w) 0 putLamp - , sPS (0,10) 0 putLamp - , sPS (20,2*w-40) pi PutNothing - , blockLine (w/2,w/2) (0,w) - , blockLine (0,w) (0,w*2) + , [ sPS (V2 (10-w) (w)) 0 putLamp + , sPS (V2 (w-10) (w)) 0 putLamp + , sPS (V2 0 10) 0 putLamp + , sPS (V2 (20) (2*w-40)) pi PutNothing + , blockLine (V2 (w/2) (w/2)) (V2 0 w) + , blockLine (V2 0 w) (V2 (0) (w*2)) ] ] pure $ defaultRoom - { _rmPolys = [ [(0,0),(w,w),(0,2*w),(-w,w)] ] + { _rmPolys = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ] , _rmLinks = - [((w/2,3*w/2), negate $ pi/4) - ,((negate $ w/2,3*w/2), pi/4) + [((V2 (w/2) (3*w/2)), negate $ pi/4) + ,((V2 (negate $ w/2) (3*w/2)), pi/4) ] - , _rmPath = [((0,w),(0,0)),((0,0),(0,w))] + , _rmPath = [((V2 0 w),(V2 0 0)),((V2 0 0),(V2 0 w))] , _rmPS = b - , _rmBound = [[(w,w),(0,2*w),(-w,w)]] + , _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]] } {- | Replace the first 'PutNothing' with a given 'PSType'. -} fillNothingPlacement :: PSType -> Room -> Room @@ -226,7 +226,7 @@ randomFourCornerRoom = do randomiseAllLinks . fillNothingPlacements (crits ++ itms) =<< ( shufflePlacements . foldr1 combineRooms - $ zipWith (\r a -> shiftRoomBy ((0,0),a) r) corners [0,pi/2,pi,3*pi/2] + $ zipWith (\r a -> shiftRoomBy ((V2 0 0),a) r) corners [0,pi/2,pi,3*pi/2] ) {- | Creates room with a central vault with doors around it. -} @@ -246,28 +246,28 @@ centerVaultRoom n w h d = do return $ defaultRoom { _rmPolys = polys , _rmLinks = - [((0,h),0) - ,((w,0),-pi/2) - ,((-w,0),pi/2) - ,((0,-h),pi) + [((V2 0 h),0) + ,((V2 w 0),-pi/2) + ,((V2 (-w) (0)),pi/2) + ,((V2 (0) (-h)),pi) ] , _rmPath = [] , _rmPS = - [sPS (d-25,d-25) 0 putLamp - ,sPS (w-5,h-5) 0 putLamp - ,sPS (w-5,5-h) 0 putLamp - ,sPS (5-w,h-5) 0 putLamp - ,sPS (5-w,5-h) 0 putLamp + [sPS (V2 (d-25) (d-25)) 0 putLamp + ,sPS (V2 (w-5) (h-5)) 0 putLamp + ,sPS (V2 (w-5) (5-h)) 0 putLamp + ,sPS (V2 (5-w) (h-5)) 0 putLamp + ,sPS (V2 (5-w) (5-h)) 0 putLamp ] - ++ concat (zipWith (\i r -> map (shiftPSBy ((0,0),r)) $ theDoor i) + ++ concat (zipWith (\i r -> map (shiftPSBy ((V2 0 0),r)) $ theDoor i) [n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2]) , _rmBound = [rectNSWE h (-h) (-w) w] } where col = dim $ dim $ bright red theDoor i = - [ sPS (0,d-10) 0 $ PutDoubleDoor col (cond i) (-19,0) (19,0) - , sPS (35,d+4) 0 $ PutButton $ makeSwitch col + [ sPS (V2 (0) (d-10)) 0 $ PutDoubleDoor col (cond i) (V2 (-19) (0)) (V2 19 0) + , sPS (V2 (35) (d+4)) 0 $ PutButton $ makeSwitch col (over worldState (M.insert (DoorNumOpen i) True)) (over worldState (M.insert (DoorNumOpen i) False)) ] diff --git a/src/Dodge/Room/RoadBlock.hs b/src/Dodge/Room/RoadBlock.hs index 7f9872ceb..c54e8356c 100644 --- a/src/Dodge/Room/RoadBlock.hs +++ b/src/Dodge/Room/RoadBlock.hs @@ -32,21 +32,21 @@ litCorridor90 = do poly2 = rectNSWE (h-60) (h-100) (-60) 5 pure $ defaultRoom { _rmPolys = [poly,poly2] - , _rmLinks = [ ((40,h - 80), -pi/2) - , ((20, 0), pi) + , _rmLinks = [ ((V2 (40) (h - 80)), -pi/2) + , ((V2 (20) ( 0)), pi) ] , _rmPath = concatMap doublePair - [((20,0),(20,h-40)) - ,(( 0,h-40),(20,h-40)) - ,((40,h-40),(20,h-40)) + [((V2 20 0),(V2 (20) (h-40))) + ,((V2 ( 0) (h-40)),(V2 (20) (h-40))) + ,((V2 (40) (h-40)),(V2 (20) (h-40))) ] , _rmPS = - [ sPS (20,h-5) 0 putLamp - , windowLine (0,h-20) (40,h-20) - , sPS (-50,h-85) 0 putLamp - , windowLine (-40,h-60) (-40,h-100) - , sPS ( 20,h-40) 0 $ PutID 0 - , sPS (-20,h-80) 0 $ PutID 2 + [ sPS (V2 (20) (h-5)) 0 putLamp + , windowLine (V2 (0) (h-20)) (V2 (40) (h-20)) + , sPS (V2 (-50) (h-85)) 0 putLamp + , windowLine (V2 (-40) (h-60)) (V2 (-40) (h-100)) + , sPS (V2 ( 20) (h-40)) 0 $ PutID 0 + , sPS (V2 (-20) (h-80)) 0 $ PutID 2 ] , _rmBound = [poly] } @@ -60,9 +60,9 @@ longBlockedCorridor :: RandomGen g => State g (Tree (Either Room Room)) longBlockedCorridor = do r <- state $ randomR (0,pi) n <- state $ randomR (0,3) - let plmnts = [sPS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256) + let plmnts = [sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) (75/256) (0) (250/256)) $ reverse $ rectNSWE 10 (-10) (-10) 10 - ,sPS (20,15) 0 putLamp + ,sPS (V2 20 15) 0 putLamp ] sequence $ treeFromPost (replicate n $ Left <$> randomiseOutLinks corridor) $ return $ Right $ set rmPS plmnts corridor @@ -71,8 +71,8 @@ longBlockedCorridor = do blockedCorridor :: RandomGen g => State g (Tree (Either Room Room)) blockedCorridor = do r <- state $ randomR (0,pi) - let plmnts = [sPS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256) + let plmnts = [sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) ( 75/256) ( 0) ( 250/256)) $ reverse $ rectNSWE 10 (-10) (-10) 10 - ,sPS (20,15) 0 putLamp + ,sPS (V2 20 15) 0 putLamp ] sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index d4452869b..62b842a21 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -8,7 +8,7 @@ import Dodge.Room.Foreground import Dodge.Layout.Tree.Polymorphic import Dodge.LevelGen.Data --import Picture ---import Geometry +import Geometry.Data import Data.Tree import Control.Monad.State @@ -16,20 +16,20 @@ import Control.Lens import System.Random rezBox :: Room -rezBox = shiftRoomBy ((-20,-10),0) $ roomRect 40 20 1 1 & rmPS .~ [] +rezBox = shiftRoomBy ((V2 (-20) (-10)),0) $ roomRect 40 20 1 1 & rmPS .~ [] startRoom :: RandomGen g => State g (Tree (Either Room Room)) startRoom = do w <- state $ randomR (100,400) h <- state $ randomR (200,400) - let fground = sPS (0,0) 0 $ PutForeground $ - highPipe 80 (0,h/3) (w, h/2) - ++ highPipe 40 (0,h/2) (w, h/3) - ++ highPipe 60 (w/3,0) (w/3, h) + let fground = sPS (V2 0 0) 0 $ PutForeground $ + highPipe 80 (V2 (0) (h/3)) (V2 (w) ( h/2)) + ++ highPipe 40 (V2 (0) (h/2)) (V2 (w) ( h/3)) + ++ highPipe 60 (V2 (w/3) (0)) (V2 (w/3) ( h)) -- ++ highPipe 20 (0,2*h/3) (w, h/3) -- , girderV cola 10 (0,3*h/4) (w, 3*h/4) -- , girder colb 5 (0,5*h/8) (w, 5*h/8) - treeFromPost [Left rezBox, Left door] . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h & rmPS %~ (fground :)) + treeFromPost [Left rezBox, Left door] . Right <$> randomiseOutLinks (shiftRoomBy ((V2 (-20) (-20)),0) $ roomRectAutoLinks w h & rmPS %~ (fground :)) -- where -- cola = dark . dark . light . light $ light red -- colb = dark . dark . light . light $ light blue diff --git a/src/Dodge/Room/Teleport.hs b/src/Dodge/Room/Teleport.hs index 6b7a40893..0af3f37e2 100644 --- a/src/Dodge/Room/Teleport.hs +++ b/src/Dodge/Room/Teleport.hs @@ -28,13 +28,13 @@ telRoomLev i = do w <- state $ randomR (200,300) h <- state $ randomR (200,300) return $ roomRectAutoLinks w h & rmPS .~ - [ sPS (w/2,h/2) 0 $ PutPressPlate telPP - , sPS (w/2,h/2+ 30) 0 putLamp + [ sPS (V2 (w/2) (h/2)) 0 $ PutPressPlate telPP + , sPS (V2 (w/2) (h/2+ 30)) 0 putLamp ] where telPP = PressPlate { _ppPict = setDepth 0.5 . color red $ polygon ppFootprint - , _ppPos = (0,0) + , _ppPos = (V2 0 0) , _ppRot = 0 , _ppEvent = levelReset , _ppID = 0 diff --git a/src/Dodge/Room/Treasure.hs b/src/Dodge/Room/Treasure.hs index b73e79231..40d1ea925 100644 --- a/src/Dodge/Room/Treasure.hs +++ b/src/Dodge/Room/Treasure.hs @@ -26,21 +26,21 @@ triLootRoom w h = pure $ defaultRoom { _rmPolys = [ tri , base ] - , _rmLinks = [((0,-80),pi)] - , _rmPath = doublePair ((0,-80),(0,h/2)) + , _rmLinks = [((V2 (0) (-80)),pi)] + , _rmPath = doublePair ((V2 (0) (-80)),(V2 (0) (h/2))) , _rmPS = - [sPS (15-w, 15) 0 $ PutID 0 - ,sPS (w-15, 15) pi $ PutID 0 - ,sPS ( 0,h-35) 0 $ PutID 2 - ,sPS ( -5,h-10) 0 putLamp - ,sPS ( 5,h-10) 0 putLamp - ,sPS ( 0,h-15) 0 putLamp - ,sPS ( 0, -60) 0 putLamp + [sPS (V2 (15-w) ( 15)) 0 $ PutID 0 + ,sPS (V2 (w-15) ( 15)) pi $ PutID 0 + ,sPS (V2 ( 0) (h-35)) 0 $ PutID 2 + ,sPS (V2 ( -5) (h-10)) 0 putLamp + ,sPS (V2 ( 5) (h-10)) 0 putLamp + ,sPS (V2 ( 0) (h-15)) 0 putLamp + ,sPS (V2 ( 0) ( -60)) 0 putLamp ] , _rmBound = [tri , base] } where - tri = + tri = map toV2 [ ( -w,30) , ( -w, 0) , ( w, 0) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index dcce8a63d..2031ec256 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -110,7 +110,7 @@ updateTriggers w & creatures . ix 0 .~ cr | otherwise = w where - cr = _creatures w IM.! 0 & crPos .~ (0,0) + cr = _creatures w IM.! 0 & crPos .~ (V2 0 0) updateSoundQueue :: World -> World updateSoundQueue = set soundQueue [] . set sounds M.empty diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index b42c3e6b7..02de45f59 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -36,7 +36,7 @@ createBarrelSpark pos dir maycid time colid w spark = Bul' { _ptDraw = drawBul , _ptUpdate' = mvGenBullet - , _btVel' = rotateV dir (5,0) + , _btVel' = rotateV dir (V2 5 0) , _btColor' = numColor colid , _btTrail' = [pos] , _btPassThrough' = maycid @@ -45,7 +45,7 @@ createBarrelSpark pos dir maycid time colid w , _btHitEffect' = destroyOnImpact sparkEff noEff noEff } x = fst $ randomR (0,20) $ _randGen w - pos' = pos +.+ rotateV dir (x,0) + pos' = pos +.+ rotateV dir (V2 x 0) sparkEff bt p cr = over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ SparkDam 1 sp p ep) where sp = head (_btTrail' bt) diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index c50848bf3..36c2c493a 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -74,8 +74,8 @@ makeExplosionAt p w where fVs = replicateM 75 (randInCirc 1) & evalState $ _randGen w fPs'' = replicateM 75 (fmap (15 *.*.*) randInHemisphere) & evalState $ _randGen w - (fPs',zs) = let (a,b,c) = unzip3 fPs'' - in (zip a b, c) + (fPs',zs) = let (a,b,c) = unzip3 $ map fromV3 fPs'' + in (zipWith V2 a b, c) fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5) fPs' inversePushOut v = (15 - magV v) * 0.01 *.* v fVs' = zipWith (+.+) fVs $ map inversePushOut fPs' diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index 2c5a85336..cff3fa437 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -50,7 +50,7 @@ Shockwave picture. drawShockwave :: Particle -> Picture drawShockwave pt = pic where - pic = setDepth 20 . uncurry translate p + pic = setDepth 20 . uncurryV translate p $ color (_btColor' pt) $ thickCircle rad thickness p = _btPos' pt r = _btRad' pt @@ -116,7 +116,7 @@ moveInverseShockWave t p r push pushexp w pt = (dams w, Just $ newupdate $ newpic pt ) where newupdate = set ptUpdate' $ moveInverseShockWave (t-1) p r push pushexp - newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p + newpic = set ptDraw (const $ onLayer PtLayer $ uncurryV translate p $ color cyan $ thickCircle rad thickness) rad = r - (4/40) * r * fromIntegral (10 - t) thickness = fromIntegral (10 - t) **2 * rad / 40 diff --git a/src/Geometry/Data.hs b/src/Geometry/Data.hs index fdd36fabb..45e5acf32 100644 --- a/src/Geometry/Data.hs +++ b/src/Geometry/Data.hs @@ -8,6 +8,7 @@ module Geometry.Data , toV2 , toV3 , toV4 + , fromV3 , uncurryV , fstV2 , sndV2 @@ -24,6 +25,8 @@ toV2 (a,b) = V2 a b toV3 (a,b,c) = V3 a b c toV4 (a,b,c,d) = V4 a b c d +fromV3 (V3 a b c) = (a,b,c) + uncurryV :: (a -> a -> b) -> V2 a -> b uncurryV f (V2 x y) = f x y