Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Adds reasonably good dust vortex monster.

  • Loading branch information...
commit 31f0516031db9bda27b0a467857ad2629bbacf9a 1 parent 29906f0
@clanehin authored
View
3  roguestar-gl/roguestar-gl.cabal
@@ -35,7 +35,8 @@ Library
Models.EnergySwords, Models.EnergyThings, Models.CyborgType4,
AnimationEvents, AnimationMenus, AnimationTerrain, AnimationTools,
AnimationExtras, AnimationCreatures, AnimationBuildings, MaybeArrow,
- EventUtils, Sky, Paths_roguestar_gl
+ EventUtils, Sky, CreatureData, AnimationVortex,
+ Paths_roguestar_gl
build-depends: base>=4&&<5,
GLUT>=2.2 && < 2.3,
rsagl==0.5,
View
101 roguestar-gl/src/AnimationCreatures.hs
@@ -8,18 +8,15 @@ import RSAGL.FRP
import RSAGL.Math
import RSAGL.Animation
import RSAGL.Color.RSAGLColors
-import RSAGL.Color
import Animation
import Control.Arrow
-import Data.Maybe
import Models.LibraryData
import VisibleObject
import Limbs
import Scene
import AnimationExtras
-
-type CreatureAvatarSwitch m = AvatarSwitch () (Maybe CreatureThreadOutput) m
-type CreatureAvatar e m = FRP e (AvatarSwitch () (Maybe CreatureThreadOutput) m) () (Maybe CreatureThreadOutput)
+import AnimationVortex
+import CreatureData
-- | Avatar for any creature that automatically switches to the appropriate species-specific avatar thread.
creatureAvatar :: (FRPModel m) => CreatureAvatar e m
@@ -37,17 +34,10 @@ creatureAvatar = proc () ->
switchTo "dustvortex" = dustVortexAvatar
switchTo _ = questionMarkAvatar
-genericCreatureAvatar :: (FRPModel m) => FRP e (CreatureAvatarSwitch m) () CreatureThreadOutput -> CreatureAvatar e m
-genericCreatureAvatar creatureA = proc () ->
- do visibleObjectHeader -< ()
- m_orientation <- objectIdealOrientation ThisObject -< ()
- switchTerminate -< if isNothing m_orientation then (Just $ genericCreatureAvatar creatureA,Nothing) else (Nothing,Nothing)
- arr Just <<< transformA creatureA -< (fromMaybe (error "genericCreatureAvatar: fromMaybe") m_orientation,())
-
encephalonAvatar :: (FRPModel m) => CreatureAvatar e m
encephalonAvatar = genericCreatureAvatar $ proc () ->
do libraryA -< (scene_layer_local,Encephalon)
- wield_point <- exportCoordinateSystem <<< arr (joint_arm_hand . snd) <<<
+ wield_point <- exportCoordinateSystem <<< arr (joint_arm_hand . snd) <<<
bothArms MachineArmUpper MachineArmLower (Vector3D 0.66 0.66 0) (Point3D 0.145 0.145 0) 0.33 (Point3D 0.35 0.066 0.133) -< ()
returnA -< CreatureThreadOutput {
cto_wield_point = wield_point }
@@ -69,81 +59,22 @@ androsynthAvatar = genericCreatureAvatar $ proc () ->
returnA -< CreatureThreadOutput {
cto_wield_point = wield_point }
-glower :: (FRPModel m, FRPModes m ~ RoguestarModes,
- ThreadIDOf m ~ Maybe Integer) =>
- LibraryModel -> FRP e m (Point3D, Rate Vector3D, Acceleration Vector3D) ()
-glower library_model = proc (p,_,_) ->
- do local_origin <- exportToA root_coordinate_system -< origin_point_3d
- transformA libraryPointAtCamera -<
- (translateToFrom p origin_point_3d $ -- use absolute positioning
- translateToFrom local_origin origin_point_3d $
- root_coordinate_system,
- (scene_layer_local,library_model))
- returnA -< ()
-
-starting_particles :: [(Point3D,Rate Vector3D)]
-starting_particles = [
- (Point3D 0 0.8 0.8,zero),
- (Point3D 0 0.15 (-0.15),zero),
- (Point3D 0.21 0.21 0,zero),
- (Point3D (-0.26) 0.26 0,zero),
- (Point3D 0 0.3 0.3,zero),
- (Point3D 0 0.33 (-0.33),zero),
- (Point3D 0.35 0.35 0,zero),
- (Point3D (-0.36) 0.36 0,zero)]
-
-particleAvatar :: (FRPModel m) => LibraryModel -> (Maybe RGB) -> CreatureAvatar e m
-particleAvatar library_model m_color = genericCreatureAvatar $ proc () ->
- do a <- inertia root_coordinate_system origin_point_3d -< ()
- particles <- particleSystem fps120 starting_particles -<
- \particles ->
- concatForces
- -- Bind the entire system to the origin of the local coordinate system.
- [quadraticTrap 10 origin_point_3d,
- -- Damp down runaway behavior.
- drag 1.0,
- -- apply inertia.
- \_ _ _ -> a,
- -- Repulse points that get too close.
- concatForces $ map (\cloud_point ->
- constrainForce (\_ p _ -> distanceBetween p cloud_point > 0.001)
- (scalarMultiply (-1) $ inverseSquareLaw 0.5 cloud_point))
- (map fst particles),
- -- Attract points that wonder too far away.
- concatForces $ map (quadraticTrap 10 . fst) particles,
- -- Swirl points around the y axis.
- \_ p _ -> perSecond $ perSecond $ vectorNormalize $
- vectorToFrom origin_point_3d p `crossProduct` (Vector3D 0 1 0),
- -- Bounce off the ground.
- constrainForce (\ _ (Point3D _ y _) _ -> y <= 0) $
- \_ (Point3D _ y _) _ -> perSecond $ perSecond $ Vector3D 0 (-100*y) 0
- ]
- glower library_model -< particles !! 0
- glower library_model -< particles !! 1
- glower library_model -< particles !! 2
- glower library_model -< particles !! 3
- glower library_model -< particles !! 4
- glower library_model -< particles !! 5
- glower library_model -< particles !! 6
- glower library_model -< particles !! 7
- accumulateSceneA -< (scene_layer_local,
- lightSource $
- case m_color of
- Just color -> PointLight (Point3D 0 0.5 0)
- (measure (Point3D 0 0.5 0) (Point3D 0 0 0))
- color
- color
- Nothing -> NoLight)
- t <- threadTime -< ()
- wield_point <- exportCoordinateSystem -< translate (rotateY (fromRotations $ t `cyclical'` (fromSeconds 3)) $ Vector3D 0.25 0.5 0)
- returnA -< (CreatureThreadOutput {
- cto_wield_point = wield_point })
-
ascendantAvatar :: (FRPModel m) => CreatureAvatar e m
-ascendantAvatar = particleAvatar (SimpleModel AscendantGlow) $ Just light_blue
+ascendantAvatar = particleAvatar vortex 12 (SimpleModel AscendantGlow) $ Just light_blue
+
+dust_vortex :: Vortex
+dust_vortex = vortex {
+ vortex_rotation = \x -> if x > 0.001 then recip x else 0,
+ vortex_binding = 0,
+ vortex_containment = 0.0,
+ vortex_base_angle = fromDegrees 45,
+ vortex_repulsion = 0.4,
+ vortex_height = -0.1,
+ vortex_gravity = 15,
+ vortex_base_force = 120 }
dustVortexAvatar :: (FRPModel m) => CreatureAvatar e m
-dustVortexAvatar = particleAvatar (SimpleModel DustPuff) Nothing
+dustVortexAvatar = particleAvatar dust_vortex 12 (SimpleModel DustPuff) Nothing
caduceatorAvatar :: (FRPModel m) => CreatureAvatar e m
caduceatorAvatar = genericCreatureAvatar $ proc () ->
View
133 roguestar-gl/src/AnimationVortex.hs
@@ -0,0 +1,133 @@
+{-# LANGUAGE Arrows, TypeFamilies #-}
+
+module AnimationVortex
+ (Vortex(..),
+ vortex,
+ particleAvatar)
+ where
+
+import RSAGL.FRP
+import RSAGL.Animation
+import RSAGL.Math
+import RSAGL.Scene
+import RSAGL.Color
+import Animation
+import Models.LibraryData
+import Scene
+import Control.Arrow
+import CreatureData
+import VisibleObject
+import System.Random
+import Data.List (genericTake)
+
+-- | A type to represent various vortex-like monsters.
+data Vortex = Vortex {
+ -- | The height of the center of containment sphere of the vortex.
+ vortex_height :: RSdouble,
+ -- | The strength of the containment sphere of the vortex.
+ vortex_containment :: RSdouble,
+ -- | Atmospheric drag.
+ vortex_drag :: RSdouble,
+ -- | Mutual n-to-n attraction of the particles. (can be used at the same time as repulsion)
+ vortex_binding :: RSdouble,
+ -- | Mutual n-to-n repulsion of the particles.
+ vortex_repulsion :: RSdouble,
+ -- | Enforced rotation of the particles. This can vary as a function of distance
+ -- from the central axis.
+ vortex_rotation :: RSdouble -> RSdouble,
+ -- | The amount of force applied to a particle that violates
+ -- the base angle.
+ vortex_base_force :: RSdouble,
+ -- | A base. At 0 degrees, this simulates the ground, but
+ -- but at other angles it can enforce a funnel shape.
+ vortex_base_angle :: Angle,
+ -- | Gravitational force.
+ vortex_gravity :: RSdouble }
+
+vortex :: Vortex
+vortex = Vortex {
+ vortex_height = 0.5,
+ vortex_containment = 100,
+ vortex_drag = 1.0,
+ vortex_binding = 0,
+ vortex_repulsion = 1.0,
+ vortex_rotation = const 1.0,
+ vortex_base_angle = fromDegrees 0,
+ vortex_base_force = 10,
+ vortex_gravity = 1.0 }
+
+vortexForceFunction :: Vortex -> [(Point3D,Rate Vector3D)] -> ForceFunction
+vortexForceFunction v particles =
+ concatForces [
+ -- Bind the entire system to the origin of the local coordinate system.
+ quadraticTrap (vortex_containment v) (Point3D 0 (vortex_height v) 0),
+ -- Damp down runaway behavior.
+ drag (vortex_drag v),
+ -- Repulse points that get too close.
+ concatForces $ map (\cloud_point ->
+ constrainForce (\_ p _ -> distanceBetween p cloud_point > 0.001)
+ (scalarMultiply (-1) $ inverseSquareLaw (vortex_repulsion v) cloud_point))
+ (map fst particles),
+ -- Attract points that wonder too far away.
+ concatForces $ map (quadraticTrap (vortex_binding v) . fst) particles,
+ -- Swirl points around the y axis.
+ \_ p _ -> perSecond $ perSecond $
+ (vectorNormalize $ vectorToFrom origin_point_3d p) `crossProduct`
+ (Vector3D 0 (vortex_rotation v $ distanceBetween origin_point_3d p) 0),
+ -- Bounce off the ground.
+ constrainForce (\ _ (Point3D x y z) _ ->
+ fromDegrees 90 `sub`
+ angleBetween (vectorToFrom (Point3D x y z) origin_point_3d)
+ (Vector3D 0 1 0)
+ < vortex_base_angle v) $
+ \_ (Point3D x _ z) _ -> perSecond $ perSecond $ vectorScaleTo (vortex_base_force v) $
+ vectorScaleTo (sine $ vortex_base_angle v) (Vector3D (-x) 0 (-z)) `add`
+ (Vector3D 0 (cosine $ vortex_base_angle v) 0),
+ \_ _ _ -> perSecond $ perSecond $ Vector3D 0 (negate $ vortex_gravity v) 0
+ ]
+
+glower :: (FRPModel m, FRPModes m ~ RoguestarModes,
+ ThreadIDOf m ~ Maybe Integer) =>
+ LibraryModel -> FRP e m (Point3D, Rate Vector3D, Acceleration Vector3D) ()
+glower library_model = proc (p,_,_) ->
+ do local_origin <- exportToA root_coordinate_system -< origin_point_3d
+ transformA libraryPointAtCamera -<
+ (translateToFrom p origin_point_3d $ -- use absolute positioning
+ translateToFrom local_origin origin_point_3d $
+ root_coordinate_system,
+ (scene_layer_local,library_model))
+ returnA -< ()
+
+random_particles :: [(Point3D,Rate Vector3D)]
+random_particles = makeAParticle vs
+ where makeAParticle (a:b:c:d:e:f:xs) = (Point3D a (b+0.5) c,perSecond $ Vector3D d e f) : makeAParticle xs
+ makeAParticle _ = error "Debauchery is perhaps an act of despair in the face of infinity."
+ vs = randomRs (-0.5,0.5) $ mkStdGen 5
+
+particleAvatar :: (FRPModel m) => Vortex -> Integer -> LibraryModel -> (Maybe RGB) -> CreatureAvatar e m
+particleAvatar vortex_spec num_particles library_model m_color = genericCreatureAvatar $ proc () ->
+ do a <- inertia root_coordinate_system origin_point_3d -< ()
+ particles <- particleSystem fps120 (genericTake num_particles random_particles) -<
+ \particles -> concatForces [vortexForceFunction vortex_spec particles, \_ _ _ -> a]
+ glower library_model -< particles !! 0
+ glower library_model -< particles !! 1
+ glower library_model -< particles !! 2
+ glower library_model -< particles !! 3
+ glower library_model -< particles !! 4
+ glower library_model -< particles !! 5
+ glower library_model -< particles !! 6
+ glower library_model -< particles !! 7
+ accumulateSceneA -< (scene_layer_local,
+ lightSource $
+ case m_color of
+ Just color -> PointLight (Point3D 0 0.5 0)
+ (measure (Point3D 0 0.5 0) (Point3D 0 0 0))
+ color
+ color
+ Nothing -> NoLight)
+ t <- threadTime -< ()
+ wield_point <- exportCoordinateSystem -< translate (rotateY (fromRotations $ t `cyclical'` (fromSeconds 3)) $ Vector3D 0.25 0.5 0)
+ returnA -< (CreatureThreadOutput {
+ cto_wield_point = wield_point })
+
+
View
24 roguestar-gl/src/CreatureData.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE Arrows #-}
+
+module CreatureData
+ (CreatureAvatarSwitch,
+ CreatureAvatar,
+ genericCreatureAvatar)
+ where
+
+import RSAGL.FRP
+import RSAGL.Scene
+import VisibleObject
+import Data.Maybe
+import Control.Arrow
+
+type CreatureAvatarSwitch m = AvatarSwitch () (Maybe CreatureThreadOutput) m
+type CreatureAvatar e m = FRP e (AvatarSwitch () (Maybe CreatureThreadOutput) m) () (Maybe CreatureThreadOutput)
+
+genericCreatureAvatar :: (FRPModel m) => FRP e (CreatureAvatarSwitch m) () CreatureThreadOutput -> CreatureAvatar e m
+genericCreatureAvatar creatureA = proc () ->
+ do visibleObjectHeader -< ()
+ m_orientation <- objectIdealOrientation ThisObject -< ()
+ switchTerminate -< if isNothing m_orientation then (Just $ genericCreatureAvatar creatureA,Nothing) else (Nothing,Nothing)
+ arr Just <<< transformA creatureA -< (fromMaybe (error "genericCreatureAvatar: fromMaybe") m_orientation,())
+
View
14 roguestar-gl/src/Models/Glows.hs
@@ -11,19 +11,19 @@ import Quality
ascendant_glow :: Quality -> Modeling ()
ascendant_glow _ = model $
- do closedDisc (Point3D 0 0 0) (Vector3D 0 1 0) 0.25
- material $ emissive $ scalarMultiply (1/3) <$> pattern (spherical (Point3D 0 0 0) 0.25 )
- [(0.0,pure white),(0.25,pure light_blue),(1.0,pure blackbody)]
+ do closedDisc (Point3D 0 0 0) (Vector3D 0 1 0) 0.5
+ material $ emissive $ scalarMultiply (1/2) <$> pattern (spherical (Point3D 0 0 0) 0.5 )
+ [(0.0,pure white),(0.1,pure light_blue),(1.0,pure blackbody)]
affine $ translate (Vector3D 0 0.25 0)
dust_puff :: Quality -> Modeling ()
dust_puff _ = model $
- do closedDisc (Point3D 0 0 0) (Vector3D 0 1 0) 0.25
+ do let radius = 0.5
+ hemisphere (Point3D 0 0 0) (Vector3D 0 1 0) radius
material $
- do emissive $ scalarMultiply (1/5) <$> pattern (spherical (Point3D 0 0 0) 0.25 )
+ do emissive $ scalarMultiply (2/10) <$> pattern (spherical (Point3D 0 (2*radius/3) 0) radius )
[(0.0,pure light_pink),(0.25,pure light_brown),(1.0,pure blackbody)]
- transparent $ pattern (spherical (Point3D 0 0 0) 0.25)
+ transparent $ pattern (spherical (Point3D 0 (2*radius/3) 0) radius)
[(0.0,pure $ alpha 1.0 $ transformColor light_brown),
(1.0,pure $ alpha 0.0 $ transformColor light_brown)]
- affine $ translate (Vector3D 0 0.25 0)
View
5 rsagl/RSAGL/Animation/AnimationExtras.hs
@@ -11,7 +11,10 @@ module RSAGL.Animation.AnimationExtras
concatForces,
constrainForce,
singleParticle,
- particleSystem)
+ particleSystem,
+ PV,
+ PVA,
+ ForceFunction)
where
import RSAGL.Math.Vector
Please sign in to comment.
Something went wrong with that request. Please try again.