From e2330618f23952c4d3574f3f1ccfaa0d1319012d Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 22 Oct 2024 10:07:13 +0100 Subject: [PATCH] Update stack lts --- appDodge/Main.hs | 1 + ghcidOutput | 133 ++++++++++++++++++++++++++++ src/Dodge/Block.hs | 1 + src/Dodge/Creature/ReaderUpdate.hs | 2 +- src/Dodge/Creature/State.hs | 1 + src/Dodge/HeldUse.hs | 1 + src/Dodge/LockAndKey.hs | 1 + src/Dodge/Placement/PlaceSpot.hs | 2 +- src/Dodge/Projectile/Update.hs | 1 + src/Dodge/Prop/Gib.hs | 1 + src/Dodge/Room/Boss.hs | 1 + src/Dodge/Room/Containing.hs | 1 + src/Dodge/Room/GlassLesson.hs | 1 + src/Dodge/Room/LongDoor.hs | 1 + src/Dodge/Room/LongRoom.hs | 1 + src/Dodge/Room/Procedural.hs | 1 + src/Dodge/Room/RezBox.hs | 1 + src/Dodge/Room/Start.hs | 1 + src/Dodge/Room/Tanks.hs | 5 +- src/Dodge/Tree/GenerateStructure.hs | 1 + src/Dodge/WorldEvent/Explosion.hs | 1 + src/RandomHelp.hs | 113 +++++++++++------------ stack.yaml | 3 +- tags | 18 ++-- 24 files changed, 222 insertions(+), 71 deletions(-) diff --git a/appDodge/Main.hs b/appDodge/Main.hs index f0c73a348..aa04bbbf1 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -34,6 +34,7 @@ import qualified SDL import Sound import System.Directory + main :: IO () main = do -- load the config to get the window size and position diff --git a/ghcidOutput b/ghcidOutput index 6c267eaa6..4385d73da 100644 --- a/ghcidOutput +++ b/ghcidOutput @@ -1,3 +1,9 @@ +/home/justin/Haskell/loop/src/Dodge/Placement/PlaceSpot.hs:159:5-30: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: Patterns of type ‘[Point2]’ not matched: [] + | +159 | (p : ps) = orderPolygon qs + | ^^^^^^^^^^^^^^^^^^^^^^^^^^ /home/justin/Haskell/loop/src/Dodge/Update.hs:319:30-33: warning: [-Wunused-matches] Defined but not used: ‘ssel’ | @@ -18,3 +24,130 @@ | 351 | shiftInvItemsDown (_,i) (_,j) (Just (_,k)) w = w | ^ +/home/justin/Haskell/loop/src/Dodge/Room/RezBox.hs:54:22: warning: [GHC-47082] [-Woperator-whitespace-ext-conflict] + The prefix use of a ‘$’ would denote an untyped splice + were the TemplateHaskell extension enabled. + Suggested fix: Add whitespace after the ‘$’. + | +54 | shuffleLinks $(roomRectAutoLinks w h){_rmPmnts = []} + | ^ +/home/justin/Haskell/loop/src/Dodge/Room/RezBox.hs:120:44: warning: [GHC-47082] [-Woperator-whitespace-ext-conflict] + The prefix use of a ‘$’ would denote an untyped splice + were the TemplateHaskell extension enabled. + Suggested fix: Add whitespace after the ‘$’. + | +120 | let n = length $ filter bottomEdgeTest $_rmLinks centralRoom + | ^ +/home/justin/Haskell/loop/src/Dodge/Room/RezBox.hs:122:29: warning: [GHC-47082] [-Woperator-whitespace-ext-conflict] + The prefix use of a ‘$’ would denote an untyped splice + were the TemplateHaskell extension enabled. + Suggested fix: Add whitespace after the ‘$’. + | +122 | tToBTree "rezBoxes" $treeFromTrunk [rezBox thecol, door] $ + | ^ +/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:177:5-59: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: + Patterns of type ‘([Float], StdGen)’ not matched: + ([], _) + ([_], _) + ([_, _], _) + ([_, _, _], _) + | +177 | (a : b : c : d : _, g) = runState thestate $ _randGen w -- randomRs (2, 20) (_randGen w) + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +/home/justin/Haskell/loop/src/RandomHelp.hs:36:9-35: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: + Patterns of type ‘([a], [a])’ not matched: (_, []) + | +36 | let (zs, w : ws) = splitAt i ys + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^ +/home/justin/Haskell/loop/src/RandomHelp.hs:51:17-46: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: + Patterns of type ‘([b], [b])’ not matched: (_, []) + | +51 | let (as, b : bs) = splitAt rand ys + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +/home/justin/Haskell/loop/src/Multiset.hs:50:9: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: Patterns of type ‘[a]’ not matched: [] + | +50 | (q:qs) = take (n-k+1) ys + | ^^^^^^^^^^^^^^^^^^^^^^^^ +/home/justin/Haskell/loop/src/Dodge/Render/Connectors.hs:41:5: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: + Patterns of type ‘(Maybe Float, Maybe Float)’ not matched: + (Nothing, _) + ((Just _), Nothing) + | +41 | (Just ymin,Just ymax) = minAndMax $ y : map (^._y) sps + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +/home/justin/Haskell/loop/src/Dodge/Particle/Draw.hs:15:5: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: + Patterns of type ‘[Geometry.Data.Point2]’ not matched: [] + | +15 | (sp : ps) = _lzPoints pt + | ^^^^^^^^^^^^^^^^^^^^^^^^ +/home/justin/Haskell/loop/src/Polyhedra.hs:68:5: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: + Patterns of type ‘[Point3]’ not matched: + [] + [_] + [_, _] + | +68 | (a:b:c:_) = xs + | ^^^^^^^^^^^^^^ +/home/justin/Haskell/loop/src/Polyhedra/Geodesic.hs:59:5: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: + Patterns of type ‘[[a]]’ not matched: + [] + [_] + | +59 | (f0:f1:fs) = rotateTo ((== n) . head) vss + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +/home/justin/Haskell/loop/src/SimpleTrie.hs:36:13: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: Patterns of type ‘[a]’ not matched: [] + | +36 | let (z : zs) = xs + | ^^^^^^^^^^^^^ +/home/justin/Haskell/loop/src/SimpleTrie.hs:45:13: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: Patterns of type ‘[(a, c)]’ not matched: [] + | +45 | let ((z1, z2) : zs) = xs + | ^^^^^^^^^^^^^^^^^^^^ +/home/justin/Haskell/loop/src/Dodge/WdP2f.hs:12:13: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: + Patterns of type ‘Maybe (Point2, Point2)’ not matched: Nothing + | +12 | let Just (a, b) = w ^? cWorld . lWorld . doors . ix drid . drPos + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +/home/justin/Haskell/loop/src/Dodge/Debug/Picture.hs:118:5: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: Patterns of type ‘[Point2]’ not matched: [] + | +118 | (p : ps) = + | ^^^^^^^^^^... +/home/justin/Haskell/loop/src/Dodge/Debug/Picture.hs:302:5: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: Patterns of type ‘[Point2]’ not matched: [] + | +302 | (x : xs) = w ^. wCam . camBoundBox + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +/home/justin/Haskell/loop/src/Tile.hs:36:5: warning: [GHC-62161] [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: + Patterns of type ‘[Point2]’ not matched: + [] + [_] + | +36 | (c:d:_) = poly + | ^^^^^^^^^^^^^^ diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index d49c7ce48..c9e245d25 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -1,5 +1,6 @@ module Dodge.Block where +import Control.Monad import Data.Set (Set) import Dodge.Data.MountedObject import Control.Lens diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 5f106087a..3d254693e 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -19,7 +19,7 @@ import qualified IntMapHelp as IM import Data.List (sortOn) import Control.Applicative import LensHelp ---import Control.Monad +import Control.Monad import Data.Bifunctor import Data.Maybe import Dodge.Base diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index ece3a27bc..586505ed9 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -3,6 +3,7 @@ module Dodge.Creature.State ( doDamage, ) where +import Control.Monad import Dodge.Targeting.Draw import Dodge.Data.DoubleTree import qualified Data.Map.Strict as M diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index 515eeadd5..bdeab0aec 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -5,6 +5,7 @@ module Dodge.HeldUse ( mcUseHeld, ) where +import Control.Monad import Color import Data.Maybe import Dodge.Base.Collide diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index 17772d859..d7af666d2 100644 --- a/src/Dodge/LockAndKey.hs +++ b/src/Dodge/LockAndKey.hs @@ -7,6 +7,7 @@ import Dodge.Item import Dodge.Room import Dodge.Tree import RandomHelp +import Control.Monad bossKeyItems :: RandomGen g => [(State g (Tree Room), State g ItemType)] bossKeyItems = [(return . cleatOnward <$> bossRoom autoCrit, takeOne [HELD PISTOL])] diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index a6d64704a..e09529738 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -84,7 +84,7 @@ placeSpotRoomRand :: GenWorld -> ((GenWorld, Room), [Placement]) placeSpotRoomRand rm i f plmnt w = - let (ps, g) = runState (_rmRandPSs rm !! i) $_randGen (_gwWorld w) + let (ps, g) = runState (_rmRandPSs rm !! i) $ w ^. gwWorld . randGen in placeSpot (w & gwWorld . randGen .~ g, rm) (plmnt & plSpot .~ f ps) placeSpotID :: PlacementSpot -> PSType -> GenWorld -> (Int, GenWorld) diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index f251424ae..43580611b 100644 --- a/src/Dodge/Projectile/Update.hs +++ b/src/Dodge/Projectile/Update.hs @@ -3,6 +3,7 @@ module Dodge.Projectile.Update ( updateProjectile ) where +import Control.Monad import Dodge.Movement.Turn import NewInt import Dodge.Payload diff --git a/src/Dodge/Prop/Gib.hs b/src/Dodge/Prop/Gib.hs index 6d95e2daa..9e0d07610 100644 --- a/src/Dodge/Prop/Gib.hs +++ b/src/Dodge/Prop/Gib.hs @@ -1,5 +1,6 @@ module Dodge.Prop.Gib where +import Control.Monad import Color import Data.Foldable import Data.List (zip4) diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs index a7ed0a82b..03c791c38 100644 --- a/src/Dodge/Room/Boss.hs +++ b/src/Dodge/Room/Boss.hs @@ -16,6 +16,7 @@ import Dodge.Tree import Geometry import LensHelp import RandomHelp +import Control.Monad roomGlassOctogon :: -- | Size diff --git a/src/Dodge/Room/Containing.hs b/src/Dodge/Room/Containing.hs index 1a34ceaf6..d93ff70e9 100644 --- a/src/Dodge/Room/Containing.hs +++ b/src/Dodge/Room/Containing.hs @@ -15,6 +15,7 @@ import Dodge.Tree import Geometry import LensHelp import RandomHelp +import Control.Monad roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (MetaTree Room String) roomsContaining crs its = tToBTree str <$> roomsContaining' crs its diff --git a/src/Dodge/Room/GlassLesson.hs b/src/Dodge/Room/GlassLesson.hs index 9f2a9ca94..cad9a4a50 100644 --- a/src/Dodge/Room/GlassLesson.hs +++ b/src/Dodge/Room/GlassLesson.hs @@ -18,6 +18,7 @@ import Dodge.Tree import Geometry import LensHelp import RandomHelp +import Control.Monad glassLesson :: RandomGen g => State g (Tree Room) glassLesson = do diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 736faf956..8272dcfa1 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -1,6 +1,7 @@ -- | Rooms containing long doors, probably with a big reveal behind them. module Dodge.Room.LongDoor where +import Control.Monad import Dodge.LevelGen.Switch import Data.Maybe import qualified Data.Set as S diff --git a/src/Dodge/Room/LongRoom.hs b/src/Dodge/Room/LongRoom.hs index 5e1d99fdc..2784cbf68 100644 --- a/src/Dodge/Room/LongRoom.hs +++ b/src/Dodge/Room/LongRoom.hs @@ -1,5 +1,6 @@ module Dodge.Room.LongRoom where +import Control.Monad import qualified Data.Set as S import Data.Tile import Dodge.Cleat diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 4058e08c0..e616ee2b3 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -10,6 +10,7 @@ module Dodge.Room.Procedural ( makeGrid, ) where +import Control.Monad import Tile import qualified Data.Set as S import Data.Tile diff --git a/src/Dodge/Room/RezBox.hs b/src/Dodge/Room/RezBox.hs index 07609c944..b0acee5bd 100644 --- a/src/Dodge/Room/RezBox.hs +++ b/src/Dodge/Room/RezBox.hs @@ -18,6 +18,7 @@ import Geometry import LensHelp import Padding import RandomHelp +import Control.Monad rezBox :: LightSource -> Room rezBox ls = diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index e35de9db9..c49eee6d8 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -19,6 +19,7 @@ import Dodge.Room.Room import Dodge.Room.RunPast import Dodge.Tree import RandomHelp +import Control.Monad powerFakeout' :: RandomGen g => State g (MetaTree Room String) powerFakeout' = tToBTree "powerFakeout'" <$> powerFakeout diff --git a/src/Dodge/Room/Tanks.hs b/src/Dodge/Room/Tanks.hs index 615e24f91..92437d76a 100644 --- a/src/Dodge/Room/Tanks.hs +++ b/src/Dodge/Room/Tanks.hs @@ -14,10 +14,7 @@ import Geometry import LensHelp import RandomHelp import Shape - ---import Data.Maybe ---import Data.Tree ---import qualified Data.Set as S +import Control.Monad randomTank :: RandomGen g => State g Placement randomTank = diff --git a/src/Dodge/Tree/GenerateStructure.hs b/src/Dodge/Tree/GenerateStructure.hs index 91f200021..3e205dad7 100644 --- a/src/Dodge/Tree/GenerateStructure.hs +++ b/src/Dodge/Tree/GenerateStructure.hs @@ -6,6 +6,7 @@ A /trunk/ refers to the successive first nodes in lists of children. module Dodge.Tree.GenerateStructure where import RandomHelp +import Control.Monad import Data.Tree {- Single branched tree (a trunk). -} diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index c63080ba5..9d13bd0c6 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -12,6 +12,7 @@ module Dodge.WorldEvent.Explosion ( --import Geometry.Vector3D +import Control.Monad import Data.List import Dodge.Base.Collide import Dodge.Data.World diff --git a/src/RandomHelp.hs b/src/RandomHelp.hs index aa0c508c5..8ad1542ef 100644 --- a/src/RandomHelp.hs +++ b/src/RandomHelp.hs @@ -1,59 +1,61 @@ {- Helpers for random generation. -} -module RandomHelp - ( module System.Random - , module Control.Monad.State - , module RandomHelp - ) where -import Geometry -import StrictHelp +module RandomHelp ( + module System.Random, + module Control.Monad.State, + module RandomHelp, +) where -import System.Random +import Control.Monad import Control.Monad.State import Data.List +import Geometry +import StrictHelp +import System.Random -randomRanges :: (Random a,RandomGen g) => [a] -> State g a +randomRanges :: (Random a, RandomGen g) => [a] -> State g a randomRanges = join . takeOne . f - where - f (x:y:ys) = state (randomR (x,y)) : f ys - f _ = [] + where + f (x : y : ys) = state (randomR (x, y)) : f ys + f _ = [] takeOne :: RandomGen g => [a] -> State g a -takeOne xs = state (randomR (0,length xs - 1)) >>= (\i -> return (xs !! i)) +takeOne xs = state (randomR (0, length xs - 1)) >>= (\i -> return (xs !! i)) takeOneWeighted :: (RandomGen g, Random b, Ord b, Num b) => [b] -> [a] -> State g a takeOneWeighted ws xs = state (randomR (0, sum ws)) >>= (\w -> return (xs !! i w ws)) - where - i y (z:zs) + where + i y (z : zs) | y <= z = 0 - | otherwise = 1 + i (y-z) zs + | otherwise = 1 + i (y - z) zs i _ _ = 0 -takeOneMore :: RandomGen g => ([a],[a]) -> State g ([a],[a]) -takeOneMore ( _,[]) = error "trying to takeOneMore from empty list" -takeOneMore (xs,ys) = do - i <- state $ randomR (0,length ys - 1) - let (zs, w:ws) = splitAt i ys - return (w:xs, zs ++ ws) +takeOneMore :: RandomGen g => ([a], [a]) -> State g ([a], [a]) +takeOneMore (_, []) = error "trying to takeOneMore from empty list" +takeOneMore (xs, ys) = do + i <- state $ randomR (0, length ys - 1) + let (zs, w : ws) = splitAt i ys + return (w : xs, zs ++ ws) -takeNMore :: RandomGen g => Int -> ([a],[a]) -> State g ([a],[a]) -takeNMore n p = foldl' (flip $ const (>>= takeOneMore)) (return p) [1..n] +takeNMore :: RandomGen g => Int -> ([a], [a]) -> State g ([a], [a]) +takeNMore n p = foldl' (flip $ const (>>= takeOneMore)) (return p) [1 .. n] takeN :: RandomGen g => Int -> [a] -> State g [a] -takeN 0 _ = return [] -takeN i xs = fst <$> takeNMore i ([],xs) +takeN 0 _ = return [] +takeN i xs = fst <$> takeNMore i ([], xs) -- | Randomly shuffle a list. shuffle :: RandomGen g => [a] -> State g [a] -shuffle xs = do - rands <- forM [0..length xs-1] $ \i -> state $ randomR (0,i) - let f ys rand = let (as,b:bs) = splitAt rand ys - in (as ++ bs, b) - let (_,zs) = mapAccumR f xs rands +shuffle xs = do + rands <- forM [0 .. length xs -1] $ \i -> state $ randomR (0, i) + let f ys rand = + let (as, b : bs) = splitAt rand ys + in (as ++ bs, b) + let (_, zs) = mapAccumR f xs rands return $ forceElements zs `seq` zs -- | Randomly shuffle the tail of a list, not safe. shuffleTail :: RandomGen g => [a] -> State g [a] -shuffleTail (x:xs) = (x :) <$> shuffle xs +shuffleTail (x : xs) = (x :) <$> shuffle xs shuffleTail _ = undefined -- select elements from a list randomly @@ -62,61 +64,62 @@ randomSelectionFromList :: RandomGen g => Float -> [a] -> State g [a] randomSelectionFromList = filterM . const . randProb randProb :: RandomGen g => Float -> State g Bool -randProb p = do - p1 <- state $ randomR (0,1) +randProb p = do + p1 <- state $ randomR (0, 1) return (p1 < p) randInCirc :: RandomGen g => Float -> State g Point2 -randInCirc = flip randInArc (2*pi) +randInCirc = flip randInArc (2 * pi) randInArc :: RandomGen g => Float -> Float -> State g Point2 randInArc = randInArcStrip 0 randInArcStrip :: RandomGen g => Float -> Float -> Float -> State g Point2 -randInArcStrip minrad maxRad maxangle = do - rad <- state $ randomR (minrad,maxRad) - ang <- state $ randomR (0,maxangle) +randInArcStrip minrad maxRad maxangle = do + rad <- state $ randomR (minrad, maxRad) + ang <- state $ randomR (0, maxangle) return $ rad *.* unitVectorAtAngle ang randOnUnitSphere :: RandomGen g => State g Point3 randOnUnitSphere = do - z <- state $ randomR (negate 1,1) - longitude <- state $ randomR (0, 2*pi) - let (V2 x y) = sqrt (1 - z^(2::Int)) *.* unitVectorAtAngle longitude + z <- state $ randomR (negate 1, 1) + longitude <- state $ randomR (0, 2 * pi) + let (V2 x y) = sqrt (1 - z ^ (2 :: Int)) *.* unitVectorAtAngle longitude return (V3 x y z) randOnHemisphere :: RandomGen g => State g Point3 randOnHemisphere = do - z <- state $ randomR (0,1) - longitude <- state $ randomR (0, 2*pi) - let (V2 x y) = sqrt (1 - z^(2::Int)) *.* unitVectorAtAngle longitude + z <- state $ randomR (0, 1) + longitude <- state $ randomR (0, 2 * pi) + let (V2 x y) = sqrt (1 - z ^ (2 :: Int)) *.* unitVectorAtAngle longitude return (V3 x y z) randInHemisphere :: RandomGen g => State g Point3 randInHemisphere = do p <- randOnHemisphere - r <- state $ randomR (0,1) + r <- state $ randomR (0, 1) return $ r *.*.* p randInRect :: RandomGen g => Float -> Float -> State g Point2 -randInRect w h = do - x <- state $ randomR (0,w) - y <- state $ randomR (0,h) +randInRect w h = do + x <- state $ randomR (0, w) + y <- state $ randomR (0, h) return (V2 x y) maybeTakeOne :: RandomGen g => [a] -> State g (Maybe a) maybeTakeOne [] = return Nothing -maybeTakeOne xs = state (randomR (0,length xs - 1)) >>= (\i -> return (Just (xs !! i))) +maybeTakeOne xs = state (randomR (0, length xs - 1)) >>= (\i -> return (Just (xs !! i))) -randsSpread :: RandomGen g => (Float,Float) -> Int -> State g [Float] -randsSpread (a,b) i - | i <= 0 = error "tried to take <= 0 randsSpread" - | otherwise = zipWith (+) [a+x,a+2*x..] <$> replicateM i (state $ randomR (0,x)) +randsSpread :: RandomGen g => (Float, Float) -> Int -> State g [Float] +randsSpread (a, b) i + | i <= 0 = error "tried to take <= 0 randsSpread" + | otherwise = zipWith (+) [a + x, a + 2 * x ..] <$> replicateM i (state $ randomR (0, x)) where - x = (b-a)/fromIntegral i + x = (b - a) / fromIntegral i randsOnCirc :: RandomGen g => Int -> State g [Float] -randsOnCirc = randsSpread (0,2*pi) +randsOnCirc = randsSpread (0, 2 * pi) + --randsOnCirc i -- | i <= 0 = error "tried to take <= 0 randsOnCirc" -- | otherwise = zipWith (+) [x,2*x..] <$> replicateM i (state $ randomR (0,x)) diff --git a/stack.yaml b/stack.yaml index a3dce4d2c..d381e1f92 100644 --- a/stack.yaml +++ b/stack.yaml @@ -19,7 +19,8 @@ # resolver: https://example.com/snapshots/2018-01-01.yaml #resolver: lts-17.1 #resolver: lts-18.28 -resolver: lts-19.20 +#resolver: lts-19.20 +resolver: lts-22.38 #resolver: lts-22.25 #resolver: lts-19.3 diff --git a/tags b/tags index 9fbd7eb7b..5a63e9447 100644 --- a/tags +++ b/tags @@ -4015,7 +4015,7 @@ doOutPlacements src/Dodge/Layout.hs 102;" f doP2Ac src/Dodge/CreatureEffect.hs 69;" f doP2Imp src/Dodge/CreatureEffect.hs 33;" f doPrWdLsLs src/Dodge/PrWdLsLs.hs 8;" f -doPreload appDodge/Main.hs 130;" f +doPreload appDodge/Main.hs 131;" f doPressPlateEvent src/Dodge/PressPlate.hs 8;" f doPropUpdates src/Dodge/Prop/Update.hs 36;" f doQuickload src/Dodge/Save.hs 82;" f @@ -4027,7 +4027,7 @@ doRoomOutPlacements src/Dodge/Layout.hs 107;" f doRoomPlacements src/Dodge/Layout.hs 122;" f doRoomShift src/Dodge/Room/Link.hs 33;" f doScopeZoom src/Dodge/Update/Camera.hs 141;" f -doSideEffects appDodge/Main.hs 117;" f +doSideEffects appDodge/Main.hs 118;" f doStep src/Dodge/ArcStep.hs 9;" f doStrategyActions src/Dodge/Creature/ReaderUpdate.hs 164;" f doTerminalBootProgram src/Dodge/WorldEffect.hs 104;" f @@ -4257,7 +4257,7 @@ findWithIx src/ListHelp.hs 123;" f fireLoudS src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 504;" f fireS src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 332;" f firstBreather src/Dodge/Room/Breather.hs 9;" f -firstWorldLoad appDodge/Main.hs 77;" f +firstWorldLoad appDodge/Main.hs 78;" f fixedCoordPictures src/Dodge/Render/Picture.hs 17;" f fixedSizePicClampArrow src/Dodge/Picture/SizeInvariant.hs 57;" f flDamageInArea src/Dodge/Flame.hs 110;" f @@ -4780,7 +4780,7 @@ magV src/Geometry/Vector.hs 160;" f magV3 src/Geometry/Vector3D.hs 78;" f magazineCombinations src/Dodge/Combine/Combinations.hs 41;" f magenta src/Color.hs 19;" f -main appDodge/Main.hs 37;" f +main appDodge/Main.hs 38;" f main bench/Bench.hs 15;" f main test/Spec.hs 12;" f mainListCursor src/Dodge/Render/HUD/Carte.hs 51;" f @@ -5150,7 +5150,7 @@ playIfFree src/Sound.hs 136;" f playPositionalSoundQueue src/Sound.hs 144;" f playSoundAndUpdate src/Sound.hs 54;" f playSoundQueue src/Sound.hs 131;" f -playSoundUnlessRewinding appDodge/Main.hs 110;" f +playSoundUnlessRewinding appDodge/Main.hs 111;" f plusDecoration src/Dodge/Placement/TopDecoration.hs 35;" f pmLineLoop src/Shader/Data.hs 107;" f pmLineStrip src/Shader/Data.hs 107;" f @@ -5891,9 +5891,9 @@ textVMirror src/Picture/Base.hs 216;" f tflat2 src/Picture/Data.hs 60;" f tflat3 src/Picture/Data.hs 64;" f tflat4 src/Picture/Data.hs 68;" f -theCleanup appDodge/Main.hs 74;" f +theCleanup appDodge/Main.hs 75;" f theColumns src/Dodge/Tree/Shift.hs 139;" f -theUpdateStep appDodge/Main.hs 102;" f +theUpdateStep appDodge/Main.hs 103;" f thickArc src/Picture/Base.hs 298;" f thickCircle src/Picture/Base.hs 272;" f thickLine src/Picture/Base.hs 244;" f @@ -6125,7 +6125,7 @@ updateRadarBlips src/Dodge/Update.hs 498;" f updateRadarSweep src/Dodge/RadarSweep.hs 25;" f updateRadarSweeps src/Dodge/Update.hs 522;" f updateRandNode src/TreeHelp.hs 108;" f -updateRenderSplit appDodge/Main.hs 105;" f +updateRenderSplit appDodge/Main.hs 106;" f updateRootItemID src/Dodge/Inventory/Location.hs 37;" f updateScopeZoom src/Dodge/Update/Camera.hs 127;" f updateScopeZoom' src/Dodge/Update/Camera.hs 132;" f @@ -6264,7 +6264,7 @@ white src/Color.hs 26;" f whiteNoiseFadeInS src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 514;" f whiteNoiseFadeOutS src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 374;" f wiToFloat src/Dodge/Room/Modify/Girder.hs 168;" f -winConfig appDodge/Main.hs 56;" f +winConfig appDodge/Main.hs 57;" f windowLine src/Dodge/Placement/Instance/Wall.hs 48;" f windowLineType src/Dodge/Placement/Instance/Wall.hs 83;" f windowXFloat src/Dodge/Data/Config.hs 61;" f