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

Hlinting

Browse Source
This commit is contained in:
jgk
2021-04-27 11:45:43 +02:00
parent f8351fb150
commit 64b5b9e2a5
34 changed files with 974 additions and 761 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Boss.hs
+4 -4
View File
@@ -25,10 +25,10 @@ roomOctogon x = Room
, _rmPath = [((0,x),(0,-(x+40)))
,((0,-(x+40)),(0,x))]
, _rmPS =
[PS (fx,fx) 0 $ putLamp
,PS (-fx,fx) 0 $ putLamp
,PS (fx,-fx) 0 $ putLamp
,PS (-fx,-fx) 0 $ putLamp
[PS (fx,fx) 0 putLamp
,PS (-fx,fx) 0 putLamp
,PS (fx,-fx) 0 putLamp
,PS (-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))
src/Dodge/Room/Branch.hs
+5 -4
View File
@@ -21,7 +21,8 @@ branchRectWith t = do
y <- state $ randomR (100,200)
b <- t
root <- randomiseOutLinks $ roomRectAutoLinks x y
return $ Node (Left root) [Node (Right door) [], fmap rToL $ treeFromTrunk [Left door] b]
where rToL :: Either a a -> Either a a
rToL (Right r) = Left r
rToL (Left r) = Left r
return $ Node (Left root) [Node (Right door) [], rToL <$> treeFromTrunk [Left door] b]
where
rToL :: Either a a -> Either a a
rToL (Right r) = Left r
rToL (Left r) = Left r
src/Dodge/Room/CheckConsistency.hs
+2 -2
View File
@@ -13,5 +13,5 @@ linksOnPath r = all pointOnPath linkPoints
pathConnected :: Room -> Bool
pathConnected = isSingleton . pairsToSCC . _rmPath
where
isSingleton (_:[]) = True
isSingleton _ = False
isSingleton [] = True
isSingleton _ = False
src/Dodge/Room/Corridor.hs
+8 -7
View File
@@ -3,6 +3,9 @@ module Dodge.Room.Corridor
import Dodge.Room.Data
import Geometry
{- First exit due north, two other exits at angles next to this.
Entrance from south.
-}
corridor :: Room
corridor = Room
{ _rmPolys = [rectNSWE 80 0 0 40
@@ -10,15 +13,13 @@ corridor = Room
-- ,[(40,0), (0,0) +.+ rotateV (0-pi/3) (40,0),( 0, 0)]
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (20,60)) $ map fst lnks
, _rmPath = concatMap (doublePair . (,) (20,60) . fst) lnks
, _rmPS = []
, _rmBound = rectNSWE 50 30 0 40
}
where
lnks =
[((20,70) ,0)
-- ,((20,80) +.+ rotateV (0-pi/3) (-10,0), pi/6)
-- ,((20,80) +.+ rotateV ( pi/3) ( 10,0),0-pi/6)
,((20,70), pi/6)
,((20,70), 0-pi/6)
,((20,10) ,pi)
@@ -39,11 +40,11 @@ corridorN = Room
tEast :: Room
tEast = Room
{ _rmPolys = [rectNSWE 80 0 (-20) (20)
{ _rmPolys = [rectNSWE 80 0 (-20) 20
,rectNSWE 80 40 (-40) 40
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (0,60)) $ map fst lnks
, _rmPath = concatMap (doublePair . (,) (0,60) . fst) lnks
, _rmPS = []
, _rmBound = rectNSWE 70 10 0 40
}
@@ -53,11 +54,11 @@ tEast = Room
]
tWest :: Room
tWest = Room
{ _rmPolys = [rectNSWE 80 0 (-20) (20)
{ _rmPolys = [rectNSWE 80 0 (-20) 20
,rectNSWE 80 40 (-40) 40
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (0,60)) $ map fst lnks
, _rmPath = concatMap (doublePair . (,) (0,60) . fst) lnks
, _rmPS = []
, _rmBound = rectNSWE 70 10 0 40
}
src/Dodge/Room/Link.hs
+3 -2
View File
@@ -48,8 +48,9 @@ This is intended to work when the external point is an outgoing link from anothe
shiftRoomToLink :: (Point2,Float) -> Room -> Room
shiftRoomToLink l r
= shiftRoomBy l
. shiftRoomBy ((0,0) -.- (rotateV (pi-a) p),0)
$ shiftRoomBy ((0,0),pi-a) r
. shiftRoomBy ((0,0) -.- rotateV (pi-a) p , 0)
$ shiftRoomBy ((0,0) ,pi-a)
r
where
(p,a) = last $ _rmLinks r
src/Dodge/Room/Placement.hs
+1 -1
View File
@@ -60,7 +60,7 @@ crystalLine a b = PS
up = vNormal left
windowLineType :: Point2 -> Point2 -> PSType
windowLineType a b = PutLineBlock baseWindowPane 8 8 a b
windowLineType = PutLineBlock baseWindowPane 8 8
baseBlockPane :: Wall
baseBlockPane = Block
src/Dodge/Room/Procedural.hs
+8 -11
View File
@@ -19,7 +19,7 @@ import Dodge.Creature
import Dodge.Default
import Geometry
import Data.List (nub,nubBy,sortBy)
import Data.List (nub,nubBy,sortBy,minimumBy)
import Data.Function (on)
import Control.Lens
import Control.Monad
@@ -39,7 +39,7 @@ roomRect x y xn yn = Room
{ _rmPolys = [rectNSWE y 0 0 x ]
, _rmLinks = lnks
, _rmPath = concatMap doublePair pth
, _rmPS = [PS (x/2,y/2) 0 $ putLamp]
, _rmPS = [PS (x/2,y/2) 0 putLamp]
, _rmBound = rectNSWE (y+5) (-5) (-5) (x+5)
}
where
@@ -76,7 +76,8 @@ makeRect x y = [((0,0),(x,0))
linksAndPath :: [(Point2,Float)] -> [(Point2,Point2)] -> [(Point2,Point2)]
linksAndPath lnks subpth = subpth ++ concatMap linkClosest lnks
where linkClosest (p,_) = doublePair (p, head $ sortBy (compare `on` dist p) $ map fst subpth)
where
linkClosest (p,_) = doublePair (p, minimumBy (compare `on` dist p) $ map fst subpth)
{- Combines two rooms into one room.
Combines into one big bound, concatenates the rest.
@@ -174,7 +175,7 @@ fourthCornerWall w = do
, PS (0,10) 0 putLamp
, PS (0,2*w-20) pi PutNothing
, blockLine (w/2,w/2) (0,w)
, blockLine (negate $ w,w) (0,w)
, blockLine (negate w,w) (0,w)
]
, [ PS (10-w,w) 0 putLamp
, PS (w-10,w) 0 putLamp
@@ -211,20 +212,16 @@ shufflePlacements r = do
newPSs <- shuffle $ _rmPS r
return $ r & rmPS .~ newPSs
putDefaultFlIt :: Item -> PSType
putDefaultFlIt itm = PutFlIt itm
testRoom :: RandomGen g => State g Room
testRoom = do
corners <- replicateM 4 . join $ takeOne [fourthWall 100, fourthCornerWall 100]
nItms <- state $ randomR (1,2)
itms <- takeN nItms $ fmap putDefaultFlIt $ [autoRadar,autoSonar,remoteLauncher,jetPack,blinkGun] ++ replicate 5 (medkit 500)
itms <- takeN nItms $ fmap PutFlIt $ [autoRadar,autoSonar,remoteLauncher,jetPack,blinkGun] ++ replicate 5 (medkit 500)
nCrits <- state $ randomR (1,3)
crits <- takeN nCrits $ fmap PutCrit $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit]
++ replicate 20 chaseCrit
randomiseAllLinks =<<
( fmap (fillNothingPlacements $ crits ++ itms)
. shufflePlacements
randomiseAllLinks . (fillNothingPlacements $ crits ++ itms) =<<
( shufflePlacements
. foldr1 combineRooms
$ zipWith (\r a -> shiftRoomBy ((0,0),a) r) corners [0,pi/2,pi,3*pi/2]
)
src/Dodge/Room/RoadBlock.hs
+4 -4
View File
@@ -37,12 +37,12 @@ litCorridor90 = do
,((40,h-40),(20,h-40))
]
, _rmPS =
[ PS (20,h-5) 0 $ putLamp
[ PS (20,h-5) 0 putLamp
, windowLine (0,h-20) (40,h-20)
, PS (-50,h-85) 0 $ putLamp
, PS (-50,h-85) 0 putLamp
, windowLine (0-40,h-60) (0-40,h-100)
, PS ( 20,h-40) 0 $ PutID 0
, PS (-20,h-80) 0 $ PutID 2
, PS ( 20,h-40) 0 $ PutID 0
, PS (-20,h-80) 0 $ PutID 2
]
, _rmBound = poly
}
src/Dodge/Room/Teleport.hs
+5 -2
View File
@@ -19,7 +19,10 @@ import Control.Monad.State
import System.Random
import qualified Data.Set as S
telRoomLev :: RandomGen g => Int -> State g Room
telRoomLev
:: RandomGen g
=> Int -- ^ Level number to teleport to
-> State g Room
telRoomLev i = do
w <- state $ randomR (200,300)
h <- state $ randomR (200,300)
@@ -40,5 +43,5 @@ telRoomLev i = do
levelReset pp w
| dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) $ startNewGame w
| otherwise = w
ppPoly pp = map (+.+ (_ppPos pp)) ppFootprint
ppPoly pp = map (+.+ _ppPos pp) ppFootprint
startNewGame w = w & worldTriggers %~ S.insert (ResetLevel i)
src/Dodge/Room/Treasure.hs
+3 -1
View File
@@ -52,8 +52,10 @@ triLootRoom w h = pure $ Room
]
base = rectNSWE 20 (-80) (-20) 20
{- Create a random room with one entrance containing given creatures and items.
-}
lootRoom :: RandomGen g => [Creature] -> [Item] -> State g Room
lootRoom crs itms = do
let w = 300
h = 700
fmap (replacePutID 0 (map PutCrit crs) . replacePutID 2 (map PutFlIt itms)) $ triLootRoom w h
replacePutID 0 (map PutCrit crs) . replacePutID 2 (map PutFlIt itms) <$> triLootRoom w h