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

Add no weapon start

Browse Source
This commit is contained in:
jgk
2021-04-27 19:26:35 +02:00
parent 64b5b9e2a5
commit 6d229f8de2
20 changed files with 448 additions and 313 deletions
Download Patch File Download Diff File Expand all files Collapse all files
package.yaml
+1 -1
View File
@@ -28,7 +28,6 @@ dependencies:
- sdl2-mixer
- text
- OpenGL
#- OpenGLRaw
- raw-strings-qq
- bytestring
- lens
@@ -47,6 +46,7 @@ dependencies:
- aeson
- directory
- QuickCheck
- utility-ht
library:
source-dirs: src
src/Dodge/Base.hs
+12 -9
View File
@@ -195,9 +195,11 @@ wallsNearPoint p w = IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1] , b<-
wallsAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Wall
{-# INLINE wallsAlongLine #-}
wallsAlongLine a b w = IM.foldrWithKey' g IM.empty kps
where g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _wallsZone w) s))
kps = zoneOfLine' a b
f i m = case IM.lookup i m of Just val -> val
where
g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _wallsZone w) s))
kps = zoneOfLineIntMap a b
f i m = case IM.lookup i m of
Just val -> val
_ -> IM.empty
wallsNearZone' :: IM.IntMap IS.IntSet -> World -> IM.IntMap Wall
@@ -235,7 +237,7 @@ creaturesAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
-- _ -> IM.empty
creaturesAlongLine a b w = IM.foldrWithKey' g IM.empty kps
where g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _creaturesZone w) s))
kps = zoneOfLine' a b
kps = zoneOfLineIntMap a b
f i m = case IM.lookup i m of Just val -> val
_ -> IM.empty
@@ -281,9 +283,9 @@ zoneOfLine (aa,ab) (ba,bb) = nub $ concatMap f
$ digitalLine (zoneOfPoint (aa,ab)) (zoneOfPoint (ba,bb))
where f (x,y) = [(p,r) | p <-[x-1,x,x+1] , r<-[y-1,y,y+1]]
zoneOfLine' :: Point2 -> Point2 -> IM.IntMap IS.IntSet
{-# INLINE zoneOfLine' #-}
zoneOfLine' a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
zoneOfLineIntMap :: Point2 -> Point2 -> IM.IntMap IS.IntSet
{-# INLINE zoneOfLineIntMap #-}
zoneOfLineIntMap a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
where (x,y) = zoneOfPoint a
(x',y') = zoneOfPoint b
--zoneOfLine (aa,ab) (ba,bb) = nub $ concatMap f
@@ -391,11 +393,12 @@ furthestPointWalkable p1 p2 ws = head $ (sortBy (compare `on` dist p1) $ IM.elem
) ++ [p2]
collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
collidePointIndirect p1 p2 ws = listToMaybe $ sortBy (compare `on` dist p1) $ IM.elems
collidePointIndirect p1 p2 ws = listToMaybe $ sortOn (dist p1) $ IM.elems
$ IM.mapMaybe ( ( \(x:y:_) -> intersectSegSeg' p1 p2 x y)
. _wlLine
) notWindows
where notWindows = IM.filter (not . _wlIsSeeThrough) ws
where
notWindows = IM.filter (not . _wlIsSeeThrough) ws
collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
collidePointFire p1 p2 ws = listToMaybe $ sortBy (compare `on` dist p1) $ IM.elems
src/Dodge/Creature/Action.hs
+181 -109
View File
@@ -1,4 +1,4 @@
{- Actions performed by creatures within the world
{- | Actions performed by creatures within the world
-}
{-# LANGUAGE BangPatterns #-}
module Dodge.Creature.Action
@@ -27,94 +27,139 @@ import System.Random
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
moveForwardSpeed :: Float -> Int -> World -> World
moveForwardSpeed
:: Float -- ^ Speed
-> Int -- ^ Creature id
-> World
-> World
moveForwardSpeed x n w = over (creatures . ix n . crPos) (+.+ p) w
where p = (*.*) x $ unitVectorAtAngle $ _crDir $ _creatures w IM.! n
where
p = (*.*) x $ unitVectorAtAngle $ _crDir $ _creatures w IM.! n
mvForward :: Float -> Int -> World -> World
mvForward speed cid w = stepForward cid speed $ over (creatures . ix cid . crPos) (+.+ p) w
where p = (*.*) (speed * equipFactor) $ unitVectorAtAngle $ _crDir $ _creatures w IM.! cid
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! cid
crStrafeLeft :: Float -> Creature -> Creature
crStrafeLeft speed cr = stepForward' s2 $ over crPos (+.+ p) cr
where p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr + pi/2)
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
s2 = (speed * equipFactor)
crStrafeRight :: Float -> Creature -> Creature
crStrafeRight speed cr = stepForward' s2 $ over crPos (+.+ p) cr
where p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr - pi/2)
crStrafeLeft
:: Float -- ^ Speed
-> Creature
-> Creature
crStrafeLeft speed cr = stepForward s2 $ over crPos (+.+ p) cr
where
p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr + pi/2)
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
s2 = (speed * equipFactor)
crMvForward :: Float -> Creature -> Creature
crStrafeRight
:: Float -- ^ Speed
-> Creature
-> Creature
crStrafeRight speed cr = stepForward s2 $ over crPos (+.+ p) cr
where
p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr - pi/2)
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
s2 = (speed * equipFactor)
crMvForward
:: Float -- ^ Speed
-> Creature
-> Creature
crMvForward speed cr = over crPos (+.+ p) cr
where p = (*.*) (speed * equipFactor) $ unitVectorAtAngle $ _crDir cr
where
p = (*.*) (speed * equipFactor) $ unitVectorAtAngle $ _crDir cr
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
crMvBy :: Point2 -> Creature -> Creature
crMvBy p' cr = stepForward' (magV p) $ over crPos (+.+ p) cr
where p = (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
crMvBy
:: Point2 -- ^ Movement translation vector
-> Creature
-> Creature
crMvBy p' cr = stepForward (magV p) $ over crPos (+.+ p) cr
where
p = (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
aimingFactor | (_posture $ _stance $ _crState cr) == Aiming
= fromMaybe 1 $ it ^? itAimingSpeed
| otherwise = 1
it = _crInv cr IM.! _crInvSel cr
stepForward :: Int -> Float -> World -> World
stepForward cid speed = over (creatures . ix cid . crState . stance . carriage) f
where f (w@Walking {}) = w {_stepToAdd = ceiling speed}
f s = s
stepForward' :: Float -> Creature -> Creature
stepForward' speed cr = over (crState . stance . carriage) f cr
where f (w@Walking {}) = w {_stepToAdd = ceiling speed}
stepForward
:: Float -- ^ Speed
-> Creature
-> Creature
stepForward speed cr = over (crState . stance . carriage) f cr
where
f (w@Walking {}) = w {_stepToAdd = ceiling speed}
f s = s
{- Determine the speed modifier of an item. -}
equipSpeed :: Item -> Float
equipSpeed NoItem = 1
equipSpeed it | _itIdentity it == FrontArmour = 0.75
| _itIdentity it == FlameShield = 0.75
| otherwise = 1
turnTo :: Point2 -> Int -> World -> World
turnTo
:: Point2 -- ^ Target point
-> Int -- ^ Creature id
-> World
-> World
turnTo p n w = set (creatures . ix n . crDir) dirToTarget w
where cr = _creatures w IM.! n
where
cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr)
turnToward :: Point2 -> Int -> World -> World
turnToward p n w | isLeftOfA dirToTarget (_crDir cr)
turnTowardRandomise
:: Point2 -- ^ Target point
-> Int -- ^ Creature id
-> World
-> World
turnTowardRandomise p n w
| isLeftOfA dirToTarget (_crDir cr)
= f $ over (creatures . ix n . crDir)
(normalizeAngle . (+ (0.03 + r*m))) w
| otherwise = f $ over (creatures . ix n . crDir)
(\x->normalizeAngle (x - (0.03 + r*m))) w
where cr = _creatures w IM.! n
where
cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr)
(r,g) = randomR (-0.1,0.1) (_randGen w)
m = diffAngles dirToTarget (_crDir cr)
f = set randGen g
turnTowardAngle :: Float -> Int -> World -> World
turnTowardAngle
:: Float -- ^ Angle
-> Int -- ^ Creature id
-> World
-> World
turnTowardAngle a n w
| isLeftOfA a (_crDir cr) = f $ over (creatures . ix n . crDir)
(normalizeAngle . (+ (0.03 + r*m))) w
| otherwise = f $ over (creatures . ix n . crDir)
(\x->normalizeAngle (x - (0.03 + r*m))) w
where cr = _creatures w IM.! n
where
cr = _creatures w IM.! n
(r,g) = randomR (-0.1,0.1) (_randGen w)
m = diffAngles a (_crDir cr)
f = set randGen g
turnToward'' :: Float -> Point2 -> Int -> World -> World
turnToward'' turnSpeed p n w
turnTowardWithSpeed
:: Float -- ^ Turn speed
-> Point2 -- ^ Target point
-> Int -- ^ Creature id
-> World
-> World
turnTowardWithSpeed turnSpeed p n w
| isLeftOfA dirToTarget (_crDir cr)
= f $ over (creatures . ix n . crDir) (normalizeAngle. (+ (turnSpeed + r))) w
| otherwise = f $ over (creatures . ix n . crDir) (\x->normalizeAngle (x - (turnSpeed + r))) w
where cr = _creatures w IM.! n
where
cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr)
(r,g) = randomR (-0.1,0.1) (_randGen w)
f = set randGen g
crTurnAndStrafeIn :: Float -> Float -> Point2 -> Creature -> Creature
crTurnAndStrafeIn
:: Float -- ^ Strafe speed
-> Float -- ^ Turn speed
-> Point2 -- ^ Target position
-> Creature
-> Creature
crTurnAndStrafeIn strafeSpeed turnSpeed p cr
| vToTarg == (0,0) = cr -- this should deal with the angleVV error
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
@@ -124,15 +169,23 @@ crTurnAndStrafeIn strafeSpeed turnSpeed p cr
$ crStrafeLeft strafeSpeed cr
| otherwise = over crDir (\x->normalizeAngle (x - turnAmount))
$ crStrafeRight strafeSpeed cr
where vToTarg = p -.- _crPos cr
where
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
turnAmount = turnSpeed
crTurnTo :: Point2 -> Creature -> Creature
crTurnTo
:: Point2 -- ^ Target position
-> Creature
-> Creature
crTurnTo p cr = set crDir dirToTarget cr
where dirToTarget = argV (p -.- _crPos cr)
crTurnTowardSpeed :: Float -> Point2 -> Creature -> Creature
crTurnTowardSpeed
:: Float -- ^ Turn speed
-> Point2 -- ^ Target position
-> Creature
-> Creature
crTurnTowardSpeed turnSpeed p cr
| vToTarg == (0,0) = cr -- this should deal with the angleVV error
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
@@ -144,7 +197,12 @@ crTurnTowardSpeed turnSpeed p cr
dirToTarget = argV vToTarg
turnAmount = turnSpeed
turnTowardSpeed :: Float -> Point2 -> Int -> World -> World
turnTowardSpeed
:: Float -- ^ Turn speed
-> Point2 -- ^ Target position
-> Int -- ^ Creature id
-> World
-> World
turnTowardSpeed turnSpeed p n w
| vToTarg == (0,0) = w -- this should deal with the angleVV error
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
@@ -157,43 +215,54 @@ turnTowardSpeed turnSpeed p n w
dirToTarget = argV vToTarg
turnAmount = turnSpeed
turnLRS :: Int -> World -> World
turnLRS n w = f $ over (creatures . ix n . crDir) (+ (fromIntegral r * pi / 2)) w
where (r,g) = randomR (negate 1::Int,1) (_randGen w)
f = set randGen g
turnToward' :: Point2 -> Int -> World -> World
turnToward' p n w | isLeftOfA dirToTarget (_crDir cr)
= over (creatures . ix n . crDir) (+ 0.03) w
turnToward
:: Point2 -- ^ Target position
-> Int -- ^ Creature id
-> World
-> World
turnToward p n w
| isLeftOfA dirToTarget (_crDir cr) = over (creatures . ix n . crDir) (+ 0.03) w
| otherwise = over (creatures . ix n . crDir) (\x-> x - 0.03) w
where cr = _creatures w IM.! n
where
cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr)
overturnToward :: Point2 -> Int -> World -> World
overturnToward p n w
| isLeftOfA dirToTarget (_crDir cr)
= over (creatures . ix n . crDir) (normalizeAngle. (+ 0.03 )) w
| otherwise = over (creatures . ix n . crDir) (\x->normalizeAngle (x - 0.03 )) w
where cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr)
moveForward :: Int -> World -> World
{- Move a creature forward in the direction it is facing. -}
moveForward
:: Int -- ^ Creature id
-> World
-> World
moveForward n w = over (creatures . ix n . crPos) (+.+ p) w
where p = unitVectorAtAngle $ _crDir $ _creatures w IM.! n
where
p = unitVectorAtAngle $ _crDir $ _creatures w IM.! n
moveToward :: Point2 -> Int -> World -> World
{- Move a creature forward, faster if it is facing a target point -}
moveToward
:: Point2 -- ^ Target point
-> Int -- ^ Creature id
-> World
-> World
moveToward p n w
| angle < 10 = moveForwardSpeed 0.1 n w
| angle < 20 = moveForwardSpeed 0.02 n w
| angle < 40 = moveForwardSpeed 0.01 n w
| otherwise = w
where angle = errorAngleVV 5 (p -.- curPos) (unitVectorAtAngle (_crDir (_creatures w IM.! n)))
where
angle = errorAngleVV 5 (p -.- curPos) (unitVectorAtAngle (_crDir (_creatures w IM.! n)))
curPos = _crPos (_creatures w IM.! n)
moveBy :: Int -> Point2 -> World -> World
{- Translate a creature. -}
moveBy
:: Int -- ^ Creature id
-> Point2 -- ^ Translation
-> World
-> World
moveBy n v = over (creatures . ix n . crPos) (+.+ v)
reloadWeapon :: Int -> World -> Maybe World
reloadWeapon
:: Int -- ^ Creature id
-> World
-> Maybe World
reloadWeapon cid w =
let cr = _creatures w IM.! cid
it = _crInv cr IM.! _crInvSel cr
@@ -204,20 +273,28 @@ reloadWeapon cid w =
$ set ( itRef . wpReloadState) rT w
_ -> Nothing
{- Start reloading if clip is empty. -}
crAutoReload :: Creature -> Creature
crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT)
& crInv . ix (_crInvSel cr) . wpLoadedAmmo %~ (`fromMaybe` maxA)
_ -> cr
where reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
where
reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo
blinkAction :: Int -> World -> World
blinkAction n w = soundOnce teleSound $ set (creatures . ix n . crPos) p3
{- Teleport a creature to the mouse position -}
blinkAction
:: Int -- ^ Creature id
-> World
-> World
blinkAction n w = soundOnce teleSound
$ set (creatures . ix n . crPos) p3
$ blinkShockwave n p3
$ inverseShockwaveAt cp 40 2 2 2
w
where p1 = _cameraCenter w +.+ (1 / _cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
where
p1 = _cameraCenter w +.+ (1 / _cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
cp = _crPos $ _creatures w IM.! n
p2 = collidePointWalls cp p1 $ wallsAlongLine cp p1 w
r = 1.5 * _crRad (_creatures w IM.! n)
@@ -230,19 +307,25 @@ blinkShockwave
-> World
blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan
moveAmountToward :: Point2 -> Float -> Point2 -> Point2
moveAmountToward
:: Point2 -- ^ Start point
-> Float -- ^ Fraction to move along
-> Point2 -- ^ End point
-> Point2
moveAmountToward p1 am p2
= p1 +.+ am *.* errorNormalizeV 44 (p2 -.- p1)
facePointAI :: Point2 -> Int -> World -> World
facePointAI p n w = set (creatures . ix n . crDir)
(argV (p -.- _crPos (_creatures w IM.! n)) )
w
reverseDir :: Int -> World -> World
reverseDir
:: Int -- ^ Creature id
-> World
-> World
reverseDir n = over (creatures . ix n . crDir) (+ pi)
turnBy :: Float -> Int -> World -> World
turnBy
:: Float -- ^ Angle change
-> Int -- ^ Creature id
-> World
-> World
turnBy a n = over (creatures . ix n . crDir) (+ a)
{-
@@ -251,60 +334,49 @@ Get your creature to drop the item under the cursor.
youDropItem :: World -> World
youDropItem w = case yourItem w of
NoItem -> w
it -> rmSelectedInvItem (_yourID w) $ over floorItems (IM.insert flid theflit)
$ updateLocation
it -> rmSelectedInvItem (_yourID w)
. copyItemToFloor (you w) (_crInvSel $ you w)
$ soundOnce putDownSound
$ set randGen g w
where (rot, g) = randomR (-pi,pi) $ _randGen w
offset = _crRad (you w) *.* unitVectorAtAngle rot
updateLocation w = case it ^? itID of
Just (Just i) -> w & itemPositions . ix i .~ OnFloor flid
_ -> w
flid = newKey $ _floorItems w
theflit = FlIt {_flIt = set itAmount 1 it
,_flItPos = offset +.+ _crPos (you w)
,_flItRot = rot
,_flItID = flid}
w
{- Drop an item silently. -}
dropItem
:: Int -- ^ Creature id
{- Copy an inventory item to the floor. -}
copyItemToFloor
:: Creature
-> Int -- ^ Inventory position
-> World
-> World
dropItem cid i w = case _crInv cr IM.! i of
copyItemToFloor cr i w = case _crInv cr IM.! i of
NoItem -> w
it -> rmInvItem cid i
. over floorItems (IM.insert flid theflit)
it -> over floorItems (IM.insert flid theflit)
. updateLocation
$ set randGen g w
where
(rot, g) = randomR (-pi,pi) $ _randGen w
offset = _crRad cr *.* unitVectorAtAngle rot
offset = (_crRad cr + 2) *.* unitVectorAtAngle rot
updateLocation w = case it ^? itID of
Just (Just i) -> w & itemPositions . ix i .~ OnFloor flid
_ -> w
flid = newKey $ _floorItems w
theflit = FlIt
{_flIt = set itAmount 1 it
{_flIt = it
,_flItPos = offset +.+ _crPos cr
,_flItRot = rot
,_flItID = flid
}
where
cr = _creatures w IM.! cid
pickUpItem' :: FloorItem -> World -> World
pickUpItem' flit w = case maybeInvSlot of
{- Pick up a specific item. -}
pickUpItem :: FloorItem -> World -> World
pickUpItem flit w = case maybeInvSlot of
Nothing -> w
Just i -> soundOnce pickUpSound
$ updateItLocation i
$ w & floorItems %~ IM.delete (_flItID flit)
Just i -> w
& soundOnce pickUpSound
& updateItLocation i
& floorItems %~ IM.delete (_flItID flit)
& creatures . ix 0 . crInv . ix i %~ addItem it
where
it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w
updateItLocation invid w'
= case _itID it of Nothing -> w'
updateItLocation invid w' = case _itID it of
Nothing -> w'
Just j -> w' & itemPositions . ix j .~ InInv 0 invid
src/Dodge/Creature/Inanimate.hs
+2 -2
View File
@@ -22,8 +22,8 @@ lamp :: Creature
lamp = defaultInanimate
{ _crUpdate = initialiseLamp
, _crHP = 500
, _crPict = \ _ -> onLayer CrLayer $ color white $ circleSolid 5
, _crRad = 5
, _crPict = \ _ -> onLayer CrLayer $ color white $ circleSolid 3
, _crRad = 3
}
initialiseLamp :: CRUpdate
src/Dodge/Creature/State.hs
-25
View File
@@ -67,31 +67,6 @@ dropByState cr w = foldr (copyItemToFloor cr) w is
DropSpecific xs -> xs
DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
{- Copy an inventory item to the floor. -}
copyItemToFloor
:: Creature
-> Int -- ^ Inventory position
-> World
-> World
copyItemToFloor cr i w = case _crInv cr IM.! i of
NoItem -> w
it -> over floorItems (IM.insert flid theflit)
. updateLocation
$ set randGen g w
where
(rot, g) = randomR (-pi,pi) $ _randGen w
offset = _crRad cr *.* unitVectorAtAngle rot
updateLocation w = case it ^? itID of
Just (Just i) -> w & itemPositions . ix i .~ OnFloor flid
_ -> w
flid = newKey $ _floorItems w
theflit = FlIt
{_flIt = it
,_flItPos = offset +.+ _crPos cr
,_flItRot = rot
,_flItID = flid
}
setOldPos :: Creature -> Creature
setOldPos cr = set crOldPos (_crPos cr) cr
src/Dodge/Creature/YourControl.hs
+2 -2
View File
@@ -57,13 +57,13 @@ wasdWithAiming w speed aimSpeed i cr
= set (crState . stance . carriage) Floating
cr
| isAiming
= stepForward' aimSpeed
= stepForward aimSpeed
$ over crPos (+.+ (aimSpeed *.* mov))
$ set crDir mouseDir
$ set (crState . stance . carriage) (Walking 0 0)
cr
| isMoving
= stepForward' speed
= stepForward speed
$ over ( crPos) (+.+ (speed *.* mov))
$ over ( crDir) (flip fromMaybe dir)
$ set (crState . stance . carriage) (Walking 0 0)
src/Dodge/Event/Keyboard.hs
+2 -10
View File
@@ -76,7 +76,7 @@ spaceAction w = if _carteDisplay w
w & carteCenter .~ theLoc
else
case listToMaybe $ _closeActiveObjects w of
Just (Left flit) -> pickUpItem' flit w
Just (Left flit) -> pickUpItem flit w
Just (Right but) -> updateTopCloseObject (_btID but) $ _btEvent but but w
Nothing -> w
where
@@ -90,15 +90,7 @@ toggleMap w = w & carteDisplay %~ not
escapeMap w = w & carteDisplay .~ False
dropLight :: World -> World
dropLight w = placeLS ls dec pos 0
-- $ over creatures IM.insert i (lamp)
$ w
--case yourItem w of
--NoItem -> w
--it -> rmInvItem (_yourID w) $ over floorItems (IM.insert flid theflit)
-- gg $ updateLocation
-- $ soundOnce putDownSound
-- $ set randGen g w
dropLight w = placeLS ls dec pos 0 w
where --(rot, g) = randomR (-pi,pi) $ _randGen w
i = newCrKey w -- to give different lights different keys
pos = _crPos(you w)
src/Dodge/Floor.hs
+3 -1
View File
@@ -42,6 +42,8 @@ roomTreex = do
t = treeFromTrunk
[[StartRoom]
,[Corridor]
,[SpecificRoom $ fmap (pure . Right) $ randomiseAllLinks =<< centerVaultRoom 1 200 200 50]
,[SpecificRoom blockedCorridor]
,[OrAno [[DoorAno]
,[Corridor]
,[DoorNumAno 0,AirlockAno]]
@@ -68,7 +70,7 @@ levx = untilJust roomTreex
lev1' :: RandomGen g => State g (Tree Room)
lev1' = do
firstWeapon <- takeOne $ [[branchRectWith weaponRoom,blockedCorridor]] ++ replicate 5 [weaponRoom]
firstWeapon <- takeOne $ [[branchRectWith weaponRoom,longBlockedCorridor]] ++ replicate 5 [weaponRoom]
iterateWhile boundClip $ fmap (shiftRoomTree . expandTreeBy id)
$ sequence $ treeFromPost
(
src/Dodge/Layout/Tree/Annotate.hs
+2 -1
View File
@@ -9,6 +9,7 @@ import Dodge.Layout.Tree.Polymorphic
import Dodge.Layout.Tree.Either
import Dodge.Room.Procedural
import Dodge.Room.Branch
import Dodge.Room.RoadBlock
import Dodge.Room.Door
import Dodge.Room.Boss
import Dodge.Room.Treasure
@@ -66,7 +67,7 @@ annoToRoomTree [DoorAno] = roomThenCorridor door
annoToRoomTree [DoorNumAno i,AirlockAno] = roomThenCorridor (airlock i)
annoToRoomTree [FirstWeapon] = do
branchWP <- branchRectWith weaponRoom
blockedC <- blockedCorridor
blockedC <- longBlockedCorridor
firstWeapon <- takeOne $ [return $ appendEitherTree branchWP [blockedC]] ++ replicate 5 weaponRoom
firstWeapon
annoToRoomTree [EndRoom] = fmap (pure . Right) (telRoomLev 1)
src/Dodge/LevelGen/Pathing.hs
+2 -2
View File
@@ -23,7 +23,7 @@ removePathsCrossing :: Point2 -> Point2 -> World -> World
removePathsCrossing a b w = set pathGraph newGraph $ set pathGraph' pg'
$ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
w
where pg' = filter (not . isJust . uncurry (intersectSegSeg' a b)) $ _pathGraph' w
where
pg' = filter (isNothing . uncurry (intersectSegSeg' a b)) $ _pathGraph' w
insertPoint pp@(_,(x,y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
newGraph = pairsToGraph dist pg'
src/Dodge/LevelGen/StaticWalls.hs
+11 -17
View File
@@ -35,26 +35,26 @@ nearCollinear (a,b) (x,y)
-- | Remove inverse walls.
removeInverseWalls :: [WallP] -> [WallP]
removeInverseWalls ((a,b):ps)
| elem (b,a) ps = removeInverseWalls $ delete (b,a) ps
| otherwise = (a,b) : (removeInverseWalls ps)
| (b,a) `elem` ps = removeInverseWalls $ delete (b,a) ps
| otherwise = (a,b) : removeInverseWalls ps
removeInverseWalls ps = ps
-- | Cut out a polygon from a set of walls, and check for errors in the
-- created walls.
-- If created walls are not consistent, expand poly and retry.
cutWalls :: [Point2] -> [WallP] -> [WallP]
cutWalls ps wls = case mapMaybe (flip checkWallRight newWalls) newWalls of
cutWalls ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
[] -> newWalls
_ -> cutWalls (expandPolyBy 0.01 ps) wls
where
newWalls = cutWalls' ps wls
errsL = mapMaybe (flip checkWallLeft newWalls) newWalls
errsL = mapMaybe (`checkWallLeft` newWalls) newWalls
-- | Cut out a polygon from a set of walls, and check for errors in the
-- created walls.
-- Give error if created walls are not consistent.
cutWalls'' :: [Point2] -> [WallP] -> [WallP]
cutWalls'' ps wls = case mapMaybe (flip checkWallRight newWalls) newWalls of
cutWalls'' ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
[] -> newWalls
errs -> error $ "during level generation function cutWalls: when cutting poly:\n" ++ show ps
++ "\nRight corner errors:\n"
@@ -67,7 +67,7 @@ cutWalls'' ps wls = case mapMaybe (flip checkWallRight newWalls) newWalls of
++ unlines (map show newWalls)
where
newWalls = cutWalls' ps wls
errsL = mapMaybe (flip checkWallLeft newWalls) newWalls
errsL = mapMaybe (`checkWallLeft` newWalls) newWalls
-- | Given a specific wall and list of walls, checks that the number of walls leaving the
-- second point is the same as the number of walls entering the second point of
@@ -126,7 +126,7 @@ cutWalls' qs walls =
expandPolyBy :: Float -> [Point2] -> [Point2]
expandPolyBy x ps = map f ps
where
cp = (1/(fromIntegral (length ps))) *.* (foldr (+.+) (0,0) ps)
cp = 1/(fromIntegral (length ps)) *.* foldr (+.+) (0,0) ps
f p = p +.+ x *.* (p -.- cp)
-- | Given a polygon expressed as a list of points and a collection of walls,
@@ -144,7 +144,7 @@ cutWallsWithPoints (p:ps) ws = foldr f ([],ws) (zip (p:ps) (ps++[p]))
-- | List the points of intersection between a segment and collection of walls.
cutWallsPoints :: Point2 -> Point2 -> [WallP] -> [Point2]
--cutWallsPoints p1 p2 ws = mapMaybe (\(x:y:_) -> intersectExtendedSegSeg p1 p2 x y)
cutWallsPoints p1 p2 ws = mapMaybe (uncurry $ myIntersectSegSeg p1 p2) ws
cutWallsPoints p1 p2 = mapMaybe (uncurry $ myIntersectSegSeg p1 p2)
-- | Given a segment and a wall, split the wall into two if it crosses the segment.
cutWall :: Point2 -> Point2 -> WallP -> [WallP]
@@ -171,9 +171,7 @@ addPolyWall (p1,p2) walls =
where
p3 = 0.5 *.* (p1 +.+ p2)
p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
maybeWs = -- listToMaybe .
fmap (fst . unzip)
-- . fmap unzip
maybeWs = fmap (map fst)
. listToMaybe
$ groupBy ((==) `on` (dist p3 . snd))
wlsP
@@ -224,10 +222,6 @@ wallIsZeroLength (x,y) = x == y
-- | Given a polygon and list of walls, removes walls inside the polygon.
removeWallsInPolygon :: [Point2] -> [WallP] -> [WallP]
removeWallsInPolygon ps walls = filter (not . cond) walls
removeWallsInPolygon ps = filter (not . cond)
where
cond wall =
pointInOrOnPolygon (0.5 *.* (fst wall +.+ snd wall)) ps
-- pointInOrOnPolygon (fst wall) ps
-- && pointInOrOnPolygon (snd wall) ps
cond wall = pointInOrOnPolygon (0.5 *.* uncurry (+.+) wall) ps
src/Dodge/LevelGen/Switch.hs
+8 -4
View File
@@ -29,10 +29,14 @@ makeButton c eff = Button
, _btState = BtOff
}
where
turnOn bt = bt {_btState = BtNoLabel, _btPict = onPict, _btEvent = (\_ -> id)}
turnOn bt = bt {_btState = BtNoLabel, _btPict = onPict, _btEvent = const id}
onPict = onLayer WlLayer (color c $ polygon $ rectNSEW (-3) (-5) 10 (-10))
makeSwitch :: Color -> (World -> World) -> (World -> World) -> Button
makeSwitch
:: Color
-> (World -> World) -- ^ Switch on effect
-> (World -> World) -- ^ Switch off effect
-> Button
makeSwitch c effOn effOff = Button
{ _btPict = offPict
, _btPos = (0,0)
@@ -48,11 +52,11 @@ makeSwitch c effOn effOff = Button
BtOff -> effOn . over buttons (IM.adjust turnOn (_btID b))
BtOn -> effOff . over buttons (IM.adjust turnOff (_btID b))
offPict = onLayer WlLayer $ color c $ pictures [--translate (-8) 4 $ circleSolid 5
polygon $ rectNSEW (-2) (-5) (-10) (10)
polygon $ rectNSEW (-2) (-5) (-10) 10
,polygon [(-2,-5),(-10,4),(-6,4),(2,-5)]
]
onPict = onLayer WlLayer $ color c $ pictures [--translate (8) 4 $ circleSolid 5
polygon $ rectNSEW (-2) (-5) (-10) (10)
polygon $ rectNSEW (-2) (-5) (-10) 10
,polygon [(-2,-5), (6,4),( 10,4),(2,-5)]
]
turnOn :: Button -> Button
src/Dodge/LevelGen/TriggerDoor.hs
+5 -5
View File
@@ -88,7 +88,7 @@ mkTriggerDoor c cond pl pr xs = addSound $ zipWith3 (triggerDoorPane c cond)
]
shiftRight = map (+.+ (0.5 *.* (pr -.- pl)))
shiftLeft = map (+.+ (0.5 *.* (pl -.- pr)))
norm = 14 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
norm = 9 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
hw = 0.5 *.* (pl +.+ pr)
perp = 5 *.* normalizeV (pl -.- pr)
plu = pl +.+ norm
@@ -99,12 +99,12 @@ mkTriggerDoor c cond pl pr xs = addSound $ zipWith3 (triggerDoorPane c cond)
hwd = hw -.- norm
addSound (x:xs) = f x : xs
f wl = over doorMech g wl
g dm w | dist wp pld > 2 && dist wp hwd > 2
= soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0
$ dm w
g dm w
| dist wp pld > 2 && dist wp hwd > 2
= soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0 $ dm w
| otherwise = dm w
where
wp = _wlLine (_walls w IM.! (head xs)) !! 1
wp = _wlLine (_walls w IM.! head xs) !! 1
triggerDoorPane :: Color -> (World -> Bool) -> Int -> [Point2] -> [Point2] -> Wall
triggerDoorPane c cond n closedPos openPos = Door
src/Dodge/Render/Picture.hs
+1 -1
View File
@@ -210,7 +210,7 @@ wallsForShadows w = map (linePairs . _wlLine)
. IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
where linePairs (x:y:_) = (x,y)
lightsForGloom' :: World -> [(Point4)]
lightsForGloom' :: World -> [Point4]
lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
where getLS ls = ( fst $ _lsPos ls, snd $ _lsPos ls, _lsRad ls , _lsIntensity ls)
getTLS ls = ( fst $ _tlsPos ls,snd $ _tlsPos ls, _tlsRad ls, _tlsIntensity ls)
src/Dodge/Room.hs
+9 -15
View File
@@ -65,7 +65,10 @@ airlockOneWay n = Room
]
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
col = dim $ dim $ bright red
airlock :: Int -> Room
airlock
:: Int -- ^ Door id
-> Room
airlock n = Room
{ _rmPolys =
[ rectNSWE 100 0 0 40
@@ -85,11 +88,13 @@ airlock n = Room
]
, _rmBound = rectNSWE 75 15 0 40
}
where lnks = [((20,85),0)
where
lnks = [((20,85),0)
,((20, 5),pi)
]
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
col = dim $ dim $ bright red
roomC :: Float -> Float -> Room
roomC x y = Room
{ _rmPolys = [rectNSWE y 0 0 x]
@@ -312,8 +317,8 @@ randFirstWeapon = do
++ replicate 5 multGun
++ replicate 2 autoGun
++ [launcher]
++ [lasGun]
++ [flamer]
-- ++ [lasGun]
-- ++ [flamer]
--randC1 :: State StdGen PSType
randC1 = RandPS $ takeOne $ map PutCrit $ (armourChaseCrit : replicate 50 chaseCrit)
@@ -381,17 +386,6 @@ weaponBetweenPillars = do
(fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars)
where f (_,a) = a == 0
blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
blockedCorridor = do
r <- state $ randomR (0,pi)
n <- state $ randomR (0,3)
let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
$ reverse $ rectNSWE 10 (-10) (-10) 10
,PS (20,15) 0 $ putLamp
]
sequence $ treeFromPost (replicate n $ fmap Left $ randomiseOutLinks corridor)
$ fmap Right $ return $ set rmPS plmnts corridor
weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
weaponLongCorridor = do
root <- takeOne $ [tEast, tWest]
src/Dodge/Room/Procedural.hs
+51 -2
View File
@@ -1,10 +1,11 @@
{-
Procedural creation of rooms.
Procedural creation of rooms and subroom parts.
-}
module Dodge.Room.Procedural
( roomRect
, roomRectAutoLinks
, testRoom
, centerVaultRoom
) where
import Dodge.Data
import Dodge.Room.Data
@@ -18,9 +19,11 @@ import Dodge.LevelGen.Data
import Dodge.Creature
import Dodge.Default
import Geometry
import Picture
import Data.List (nub,nubBy,sortBy,minimumBy)
import Data.Function (on)
import qualified Data.Map as M
import Control.Lens
import Control.Monad
import Control.Monad.State
@@ -220,9 +223,55 @@ testRoom = do
nCrits <- state $ randomR (1,3)
crits <- takeN nCrits $ fmap PutCrit $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit]
++ replicate 20 chaseCrit
randomiseAllLinks . (fillNothingPlacements $ crits ++ itms) =<<
randomiseAllLinks . fillNothingPlacements (crits ++ itms) =<<
( shufflePlacements
. foldr1 combineRooms
$ zipWith (\r a -> shiftRoomBy ((0,0),a) r) corners [0,pi/2,pi,3*pi/2]
)
{- | Creates room with a central vault with doors around it.
-}
centerVaultRoom
:: RandomGen g
=> Int -- ^ Door id
-> Float -- ^ Width
-> Float -- ^ Height
-> Float -- ^ Vault dimensions
-> State g Room
centerVaultRoom n w h d = do
let northPoly = rectNSWE h d (-w) w
nsDoors = rectNSWE (d + 20) (negate (d +20)) (-20) 20
weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20))
centerPoly = rectWdthHght (d - 20) (d - 20)
polys = centerPoly : nsDoors : weDoors : (take 4 $ iterate (map vNormal) northPoly)
cr <- takeOne [miniGunCrit, autoCrit]
return $ Room
{ _rmPolys = polys
, _rmLinks =
[((0,h),0)
,((w,0),-pi/2)
,((-w,0),pi/2)
,((0,-h),pi)
]
, _rmPath = []
, _rmPS =
[PS (d-25,d-25) 0 putLamp
,PS (w-5,h-5) 0 putLamp
,PS (w-5,5-h) 0 putLamp
,PS (5-w,h-5) 0 putLamp
,PS (5-w,5-h) 0 putLamp
,PS (0,0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
]
++ concat (zipWith (\i r -> map (shiftPSBy ((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 =
[ PS (0,d-10) 0 $ PutTriggerDoor col (cond i) (-19,0) (19,0)
, PS (35,d+4) 0 $ PutButton $ makeSwitch col
(over worldState (M.insert (DoorNumOpen i) True))
(over worldState (M.insert (DoorNumOpen i) False))
]
cond i w = or $ M.lookup (DoorNumOpen i) (_worldState w)
src/Dodge/Room/RoadBlock.hs
+30
View File
@@ -7,12 +7,15 @@ import Geometry
import Dodge.Room.Data
import Dodge.Room.Link
import Dodge.Room.Placement
import Dodge.Room.Corridor
import Dodge.LevelGen.Data
import Dodge.RandomHelp
import Dodge.Creature
import Dodge.Layout.Tree.Polymorphic
import Data.Tree
import Control.Monad.State
import Control.Lens
import System.Random
armouredCorridor :: RandomGen g => State g Room
@@ -46,3 +49,30 @@ litCorridor90 = do
]
, _rmBound = poly
}
noWeaponTest :: RandomGen g => State g (Tree (Either Room Room))
noWeaponTest = do
undefined
-- | A random length corridor with a descrutible block blocking it.
longBlockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
longBlockedCorridor = do
r <- state $ randomR (0,pi)
n <- state $ randomR (0,3)
let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
$ reverse $ rectNSWE 10 (-10) (-10) 10
,PS (20,15) 0 $ putLamp
]
sequence $ treeFromPost (replicate n $ fmap Left $ randomiseOutLinks corridor)
$ fmap Right $ return $ set rmPS plmnts corridor
-- | A single corridor with a descrutible block blocking it.
blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
blockedCorridor = do
r <- state $ randomR (0,pi)
let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
$ reverse $ rectNSWE 10 (-10) (-10) 10
,PS (20,15) 0 $ putLamp
]
sequence $ treeFromPost []
$ fmap Right $ return $ set rmPS plmnts corridor
src/Dodge/Room/Teleport.hs
+1 -1
View File
@@ -28,7 +28,7 @@ telRoomLev i = do
h <- state $ randomR (200,300)
return $ roomRectAutoLinks w h & rmPS .~
[ PS (w/2,h/2) 0 $ PutPressPlate telPP
, PS (w/2,h/2+ 30) 0 $ putLamp
, PS (w/2,h/2+ 30) 0 putLamp
]
where
telPP = PressPlate
src/Dodge/Update.hs
+19 -17
View File
@@ -118,10 +118,10 @@ ppEvents w = IM.foldr (\pp w -> _ppEvent pp pp w) w $ _pressPlates w
updateSeenWalls :: World -> World
updateSeenWalls w = foldr markSeen w wallsToUpdate
where yPos = _crPos $ _creatures w IM.! 0
-- wallsToUpdate = map _wlID $ IM.elems $ wallsNearPoint yPos w
wallsToUpdate = concatMap (\p -> collidePointFindWalls yPos (yPos +.+p) $ wallsAlongLine yPos (yPos +.+ p) w)
$ nRays 60
where
vPos = _cameraViewFrom w
wallsToUpdate = concatMap (\p -> visibleWalls vPos (vPos +.+p) $ wallsAlongLine vPos (vPos +.+ p) w)
$ nRays 20
markSeen i = set (walls . ix i . wlSeen) True
setTestStringIO :: IO World -> IO World
@@ -186,19 +186,21 @@ crCrSpring c1 c2 w
overlap2 = ((comRad - diff) * _crMass c1 * 0.5 / massT) *.* errorNormalizeV 56 vec
massT = _crMass c1 + _crMass c2
collidePointFindWall :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Int
collidePointFindWall p1 p2 ws = fmap fst $ listToMaybe $ sortBy f
$ IM.toList
$ IM.mapMaybe ((\(x:y:_) -> intersectSegSeg' p1 p2 x y) . _wlLine) ws
where f (_,a) (_,b) = compare (magV (p1 -.- a)) (magV (p1 -.- b))
collidePointFindWalls :: Point2 -> Point2 -> IM.IntMap Wall -> [Int]
collidePointFindWalls p1 p2 ws
-- = map fst . takeWhileAnd g . map snd . sortBy (compare `on` (dist p1 . fst . fromJust)) . filter ((/=) Nothing . fst) . map f $ IM.toList ws
= map fst . takeWhileAnd g . map snd . sortBy (compare `on` (dist p1 . fromJust . fst)) . filter ((/=) Nothing . fst) . map f $ IM.toList ws
where f (i,wl) = (intersectSegSeg' (_wlLine wl !! 0) (_wlLine wl !! 1) p1 p2, (i,wl))
g (_,wl) = _wlIsSeeThrough wl
takeWhileAnd h xs = let (ys,zs) = span h xs
{-
Finds the IDs of visible walls from a point to another point.
-}
visibleWalls :: Point2 -> Point2 -> IM.IntMap Wall -> [Int]
visibleWalls p1 p2 ws
= map fst
. takeUntil (_wlIsSeeThrough . snd)
. map snd
. sortOn (dist p1 . fromJust . fst)
. filter ((/=) Nothing . fst)
. map f
$ IM.toList ws
where
f (i,wl) = (intersectSegSeg' (_wlLine wl !! 0) (_wlLine wl !! 1) p1 p2, (i,wl))
takeUntil h xs = let (ys,zs) = span h xs
in ys ++ tf zs
where tf (x:_) = [x]
tf _ = []
src/Geometry.hs
+17
View File
@@ -68,6 +68,11 @@ rectNSEW !n !s !e !w = rectNESW n e s w
rectNSWE :: Float -> Float -> Float -> Float -> [Point2]
rectNSWE !n !s !w !e = [ (w,n), (w,s), (e,s), (e,n)]
rectWdthHght :: Float -> Float -> [Point2]
rectWdthHght w h = rectNSWE h (-h) (-w) w
-- | Draw a rectangle around the origin with given height and width
-- | Test whether a point is in a polygon or on the polygon border.
-- Supposes the points in the
-- polygon are listed in anticlockwise order.
@@ -423,6 +428,7 @@ divideLineOddNumPoints x a b = take 5000
-- | Given two pairs of Ints, returns a list of pairs of Ints that form
-- a digital line between them.
digitalLine :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
{-# INLINE digitalLine #-}
digitalLine (x1,y1) (x2,y2)
| abs (x1-x2) > abs (y1-y2) = [ (x,( (y1-y2) * x + x1*y2 - x2*y1) `rdiv` (x1-x2) )
| x <- intervalList x1 x2 ]
@@ -431,6 +437,17 @@ digitalLine (x1,y1) (x2,y2)
where
rdiv a b = round $ fromIntegral a / fromIntegral b
-- | Given two pairs of 'Int's, create a list of pairs of 'Int's that form a
-- rectangle between them.
digitalRect :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
{-# INLINE digitalRect #-}
digitalRect (a,b) (c,d) = [(s,t) | s <- [minx .. maxx] , t <- [miny .. maxy]]
where
maxx = max a c
minx = min a c
maxy = max b d
miny = min b d
-- | Given two Ints, creates the list of Ints between these.
intervalList :: Int -> Int -> [Int]
intervalList x y