-- License: GPL v2 or later
module Sim (simulate, World(..), Machine(..), Particle(..), ParticleType(..), Creature(..), Dir(..), MirrorDir(..), dirAngle, WorldHour(..){-hmm-}, hourFraction, dayLength) where
-- Generators emit pollution, as well as bolts of energy that
-- bounce off mirrors and can energize other generators.
--
-- Mountains get in the way.
--
-- Trees absorb pollution.
--
-- Chaos-storms emit chaos, which changes these "machines" randomly
-- into other types of "machines", and water, which for some odd
-- reason is attracted to pollution yet destroyed by bolts of energy.
--
-- (The reason is obviously that I wanted to see what it would be like
-- if I had something be affected by pollution in some nontrivial way.
-- Or that I wanted flowing rivers that go in a direction!)
-- The guy wanders around mostly randomly and usually dies pretty soon.
-- Pay him/her no mind. (constructor "Creature")
import Data.Array.Unboxed
import Data.List (genericLength, unzip4, maximumBy)
import Data.Ord (comparing)
import Data.Maybe (isJust)
import System.Random
-- (TODO: Maybe use DiffArray or some modern data structure?)
type WholeMap = Array Loc
type SparseMultiMap a = [(Loc,a)]
type Loc = (Int,Int)
type Offset = (Int,Int) -- (not) aka dir
type WorldMap = WholeMap (Maybe Machine)
type WorldMovers = SparseMultiMap Particle
type WorldCreatures = SparseMultiMap Creature
type Pollution = Double
type WorldPollution = UArray Loc Pollution
newtype WorldHour = WorldHour Int
data World = World
{ worldMap :: WorldMap
, worldParticles :: WorldMovers
, worldCreatures :: WorldCreatures
, worldPollution :: WorldPollution
, worldHour :: WorldHour
}
data Dir = North | East | South | West
deriving (Enum,Bounded,Show)
data MirrorDir = NW_SE | SW_NE
deriving (Enum,Show)
-- member names:
-- `m'nName where n is the initial of the constructor,
-- or `_' if it may be applicable to multiple constructors
data Machine
= Generator { m_Dir :: Dir, m_Energy :: Int }
| Mirror { mMDir :: MirrorDir, mMLeftSilvered, mMRightSilvered :: Bool }
| Greenery { }
| Storm { mSEnergy :: Double, m_RNG :: StdGen }
| Mountain { }
| Riverbed { mRDepth :: Int }
deriving (Show)
{-instance Show Machine where
show (Generator{}) = "G"
show (Mirror{}) = "M"-}
data Particle = Particle Dir ParticleType
data ParticleType
= Energy Int -- where Int strength > 0
| Chaos StdGen
data Creature
-- Energy system like Angband; only normally move every 10 energy,
-- but may communicate quicker.
= Creature { creatureEnergy :: Double, creatureRNG :: StdGen }
| Water { creatureRNG :: StdGen }
-- OpenGL uses degrees, and that's what this is used for, so use degrees.
dirAngle :: Num{-Floating-} a => Dir -> a
dirAngle East = 0 --0
dirAngle North = 90 --pi * 0.5
dirAngle West = 180 --pi
dirAngle South = 270 --pi * 1.5
dirOffset :: Dir -> Offset
dirOffset North = (0,1)
dirOffset South = (0,-1)
dirOffset East = (1,0)
dirOffset West = (-1,0)
shiftByOffset :: Offset -> Loc -> Loc
shiftByOffset (dx,dy) (x,y) = (x+dx,y+dy)
shift :: Dir -> Loc -> Loc
shift = shiftByOffset . dirOffset
particleMove :: (Loc,Particle) -> (Loc,Particle)
particleMove (loc,p@(Particle dir _)) = (shift dir loc,p)
mirrorSilveredWhenGoingDirection :: Machine{-Mirror-} -> Dir -> Bool
mirrorSilveredWhenGoingDirection mir@(Mirror {}) dir =
(case mMDir mir of
NW_SE -> case dir of
North -> mMLeftSilvered
East -> mMLeftSilvered
South -> mMRightSilvered
West -> mMRightSilvered
SW_NE -> case dir of
South -> mMLeftSilvered
East -> mMLeftSilvered
North -> mMRightSilvered
West -> mMRightSilvered
) mir
mirrorSilveredWhenGoingDirection machine dir =
error ( "BUG! mirrorSilveredWhenGoingDirection should not be" ++
" called with a non-mirror, namely " ++ show machine ++
" (with dir = " ++ show dir ++ ")" )
mirror :: MirrorDir -> Dir -> Dir
mirror NW_SE North = West
mirror NW_SE West = North
mirror NW_SE South = East
mirror NW_SE East = South
mirror SW_NE North = East
mirror SW_NE East = North
mirror SW_NE South = West
mirror SW_NE West = South
orthogonalNeighborLocsWithin :: (Loc,Loc) -> Loc -> [Loc]
orthogonalNeighborLocsWithin bound center =
filter (inRange bound) $ map (flip shift center) [North,East,South,West]
-- don't yet use a monad; see how this goes
-- hmm, randomness can wait too
simMachine ::
WorldMap -> Array Loc [Particle] -> Array Loc [Creature] -> WorldPollution
-> Loc -> Maybe Machine
-> (Maybe Machine, [Particle], [Creature], Pollution)
simMachine terrainMap particleMap creatureMap pollutionMap loc maybeMachine =
case maybeMachine of
Nothing -> (Nothing, pHere, cHere, defaultNewPollution)
(Just m) ->
-- If a chaos particle hits a machine, that mutates the machine
-- rather than the machine here doing anything this turn.
let
chaosRNGs = [rng | Particle _ (Chaos rng) <- pHere]
chaoslyRandomMachine :: StdGen -> Machine
-- could also return next g
chaoslyRandomMachine rng = let (r,rng') = randomR (0,28) rng in
if r < 4 then Generator (toEnum r) 5
else if r < 16 then Mirror (toEnum (r `mod` 2)) (r<12) (r>=8)
else if r < 20 then Storm (fromIntegral r - 16) rng'
else if r < 25 then Greenery
else Mountain -- should chaos create/destroy MOUNTAINS???
in if not (null chaosRNGs) then
(Just $ chaoslyRandomMachine $ head chaosRNGs,
[], cHere, defaultNewPollution + 3)
else
case m of
-- Generators generate energy over time (and when an energy particle
-- hits them), and every time they have enough energy stored,
-- they emit an energy particle using that energy.
-- It's a pretty efficient generator: 80% efficiency.
Generator dir energy -> if energy >= 5
then (Just $ m {m_Energy = energy - 5 + particleEnergyHere},
[Particle dir (Energy 4)], cHere, defaultNewPollution + 1)
else (Just $ m {m_Energy = energy + 1 + particleEnergyHere },
[], cHere, defaultNewPollution)
Mirror mdir _ _ -> (Just m,
map (\p@(Particle pdir ptype) ->
if mirrorSilveredWhenGoingDirection m pdir
then Particle (mirror mdir pdir) (ptype)
else p)
pHere,
cHere,
defaultNewPollution)
-- Greenery absorbs pollution by letting pollution diffuse into it
-- and then remaining unpolluted.
-- It's a bit powerful pollution remover at the moment,
-- but non-invasive; seems nice in practice.
Greenery -> (Just m, pHere, cHere, 0)
-- Storms are strange.
-- They randomly absorb or emit pollution.
-- Absorbing pollution decreases their energy,
-- and emitting increases their energy.
-- Storms emit "chaos", which travels in a direction
-- until it hits something and mutates it, and "water",
-- which is a Creature that follows pollution. These
-- emissions depend on the storm's energy and on chance.
Storm energy rng ->
if newEnergy > today'sChaosParticleThreshold
then (Just $ Storm 0 rng_storm,
[newChaos], newWater:cHere, newPollution)
else if newEnergy < 16
then (Just $ Storm newEnergy rng_storm,
[], newWater:cHere, newPollution)
else (Nothing,
[newChaos], cHere, newPollution + 3)
where
(rng_storm, rng2) = split rng
(today'sChaosParticleThreshold, rng3) = randomR (5,17) rng2
(rawPollutionEffect, rng4) = randomR (-0.4,0.4) rng3
(newChaos'sDirection,rng5) = randomDir rng4
newChaos'sRNG = rng5
randomDir :: (RandomGen g) => g -> (Dir, g)
randomDir rng_1 = let (dirN, rng_2) = randomR (0,3) rng_1 in (toEnum dirN, rng_2)
newEnergy = energy + fromIntegral particleEnergyHere + pollutionEffect
pollutionEffect = max (-defaultNewPollution) rawPollutionEffect
newPollution = pollutionEffect + defaultNewPollution
newChaos = Particle newChaos'sDirection (Chaos newChaos'sRNG)
newWater = (Water newChaos'sRNG)--hack: sharing RNG?
-- Mountains just sit there and get in the way of everything.
-- (Perhaps they could occasionally produce rain?)
Mountain -> (Just m, [], cHere, 0)
-- (Riverbeds are an unused constructor currently.)
Riverbed {} -> (Just m, [], cHere, 0)
where
pHere = particleMap ! loc
cHere = creatureMap ! loc
particleEnergyHere = sum [e | Particle _ (Energy e) <- pHere]
-- Pollution diffusion:
-- should edges of the map be dissipated off of?
-- should there be any decrease in total?
-- wind?! diagonals?
pollutionHere = pollutionMap ! loc
defaultNewPollution = let
neighborLocs = orthogonalNeighborLocsWithin (bounds pollutionMap) loc
significantNeighborLocs = filter (\l -> case terrainMap!l of
Just Mountain -> False; _ -> True) neighborLocs
neighborPollutions = map (pollutionMap !) significantNeighborLocs
pollutionKept = pollutionHere *
(1 - transferFraction*genericLength significantNeighborLocs)
pollutionTaken = sum $ map (* transferFraction) neighborPollutions
transferFraction = 1/16
in pollutionKept + pollutionTaken
simMachine' ::
WorldMap -> Array Loc [Particle] -> Array Loc [Creature] -> WorldPollution
-> Loc -> Maybe Machine
-> (Maybe Machine, [(Loc,Particle)], [(Loc,Creature)], Pollution)
simMachine' wm pm cm polluMap loc mm =
let (res1,res2,res3,res4) = simMachine wm pm cm polluMap loc mm
in (res1, map ((,) loc) res2, map ((,) loc) res3, res4)
creatureMove :: WorldMap -> Array Loc [Particle] -> Array Loc [Creature] -> WorldPollution -> Loc -> Creature -> (Loc,Creature)
creatureMove machineMap particleMap _creatureMap pollutionMap loc creature =
let
(rng_pollutionEntropy, rng_creature) = split (creatureRNG creature)
movetoAble l = inRange (bounds machineMap) l &&
case machineMap ! l of
Nothing -> True
Just (Generator{}) -> True
_ -> False
choices = filter movetoAble $
orthogonalNeighborLocsWithin (bounds machineMap) loc
rawDraws = map (\l -> (pollutionMap ! l, l)) choices
pollutionTweaks = randomRs (0, 0.1) rng_pollutionEntropy
perceivedDraws = zipWith (\ (p,l) t -> (p+t, l)) rawDraws pollutionTweaks
--tie? arbitrary winner! more pollution is better for water!
best = maximumBy (comparing fst) perceivedDraws
loc' = snd best
newCreature = (loc', creature {creatureRNG = rng_creature})
--water is killed by all particles!!!!(so is GUY.)
die = null choices ||
not (null (particleMap ! loc)) ||
not (null (particleMap ! loc')) ||
isJust (machineMap ! loc')
-- HACK method to delete the creature:
nobody = ((-100000,-100000),
creature {creatureRNG = rng_creature})
in if die then nobody else newCreature
simulate :: World -> World
simulate (World oldMap oldParticles oldCreatures oldPollution oldHour) = let
worldBounds = bounds oldMap
particleArray = accumArray (flip (:)) [] worldBounds
$ filter (inRange worldBounds . fst)
$ map (particleMove) oldParticles
oldCreatureArray = accumArray (flip (:)) [] worldBounds oldCreatures
newCreatureArray = accumArray (flip (:)) [] worldBounds
$ filter (inRange worldBounds . fst)
$ map (uncurry (creatureMove oldMap particleArray
oldCreatureArray oldPollution)) oldCreatures
results = map (uncurry (simMachine' oldMap particleArray
newCreatureArray oldPollution)) (assocs oldMap)
--mapArrayWithIndices (simMachine w particleArray) w
(machines,newParticle'ss,newCreature'ss,pollutions) = unzip4 results
newParticles = concat newParticle'ss
newCreatures = concat newCreature'ss
newMap = listArray worldBounds machines
newPollutions = listArray worldBounds pollutions -- this assumes pollution and map have same bounds
newHour = hourMove oldHour
in World newMap newParticles newCreatures newPollutions newHour
-- | in range [0,1)
hourFraction :: WorldHour -> Rational
hourFraction (WorldHour n) = realToFrac n / realToFrac dayLength
hourMove :: WorldHour -> WorldHour
hourMove (WorldHour oldN) =
let newN = oldN + 1 in
if newN < dayLength
then WorldHour newN
else WorldHour (newN - dayLength)
dayLength :: Int
dayLength = 50
-- not as generic (in Array) as it could be
--zipArray :: Ix i => Array i e1 -> Array i e2 -> Array i (e1,e2)
--zipArray a1 a2
--mapArrayWithIndices :: (Loc -> a -> b) -> MapType Loc a -> MapType Loc b
--mapArrayWithIndices f a = array (bounds a) (map (uncurry f) (assocs a))