Add cyborg stargate.

parent 0f4b3f5d
.vim.makehere.sh
.dist-scion
.hsproject
.project
dist
......@@ -23,16 +23,7 @@ executable roguestar-engine
mtl >=1.1.0.2, random >=1.0.0.2 && <1.1,
old-time >=1.0.0.3 && <1.1, array >=0.3.0.0 && <0.3.1,
containers >=0.3.0.0, base >=4 && <5
other-modules: TravelData VisibilityData Stats FactionData Behavior
Alignment PlaneData Grids Perception PlaneVisibility Turns Plane
CreatureData StatsData Protocol Character Tool Substances
HierarchicalDatabase Travel ToolData CharacterData Creature Facing
DBPrivate RNG Species Position TerrainData Combat Tests DBData
GridRayCaster BeginGame SpeciesData TimeCoordinate DB
AttributeGeneration CreatureAttribute Building BuildingData Town
Random PlayerState MakeData DBErrorFlag Construction Make Activate
Contact DeviceActivation WorkCluster Planet PlanetData Logging
NodeData CharacterAdvancement
other-modules: TravelData, VisibilityData, FactionData, Behavior, Alignment, PlaneData, Grids, Perception, PlaneVisibility, Turns, Plane, CreatureData, Protocol, Character, Tool, Substances, HierarchicalDatabase, Travel, ToolData, CharacterData, Creature, Facing, DBPrivate, RNG, Species, Position, TerrainData, Combat, Tests, DBData, GridRayCaster, BeginGame, SpeciesData, TimeCoordinate, DB, AttributeGeneration, CreatureAttribute, Building, BuildingData, Town, Random, PlayerState, MakeData, DBErrorFlag, Construction, Make, Activate, Contact, DeviceActivation, WorkCluster, Planet, PlanetData, Logging, NodeData, CharacterAdvancement
ghc-prof-options: -prof -auto-all
ghc-shared-options: -prof -auto-all
if impl(ghc >= 7.0)
......
......@@ -86,7 +86,7 @@ portalCreatureTo :: BuildingType -> Integer -> CreatureRef -> PlaneRef -> DB (Lo
portalCreatureTo building_type offset creature_ref plane_ref =
do portals <- filterM (liftM (== building_type) . buildingType) =<< dbGetContents plane_ref
ideal_position <- if null portals
then liftM2 (\x y -> Position (x,y)) (getRandomR (-100,100)) (getRandomR (-100,100))
then liftM2 (\x y -> Position (x,y)) (getRandomR (-40,40)) (getRandomR (-40,40))
else do portal <- pickM portals
m_position <- liftM (fmap (offsetPosition (0,offset)) . extractParent) $ dbWhere portal
return $ fromMaybe (Position (0,0)) m_position
......
module Stats (generateStats)
where
import Dice
import StatsData
import DB
--
-- Randomly generate 1 statistic.
--
generate1Stat :: Integer -> Integer -> DB Integer
generate1Stat minimal range = roll $ concat [[minimal..minimal+i] | i <- [0..range]]
--
-- Randomly generate statistics.
--
generateStats :: Stats -> Stats -> DB Stats
generateStats minimums ranges =
do new_str <- generate1Stat (str minimums) (str ranges)
new_dex <- generate1Stat (dex minimums) (dex ranges)
new_con <- generate1Stat (con minimums) (con ranges)
new_int <- generate1Stat (int minimums) (int ranges)
new_per <- generate1Stat (per minimums) (per ranges)
new_cha <- generate1Stat (cha minimums) (cha ranges)
new_mind <- generate1Stat (mind minimums) (mind ranges)
return Stats { strength = new_str,
dexterity = new_dex,
constitution = new_con,
intelligence = new_int,
perception = new_per,
charisma = new_cha,
mindfulness = new_mind }
module StatsData
(Stats(..),
StatisticsBlock(..),
Statistic(..),
stats,
getStatistic,
setStatistic)
where
class StatisticsBlock a where
str :: a -> Integer
dex :: a -> Integer
con :: a -> Integer
int :: a -> Integer
per :: a -> Integer
cha :: a -> Integer
mind :: a -> Integer
-- |
-- Represents the seven roguestar creature statistics:
-- Strength (str)
-- Dexterity (dex)
-- Constitution (con)
-- Intelligence (int)
-- Perception (per)
-- Charisma (cha)
-- Mindfulness (min)
--
data Stats = Stats {strength, dexterity, constitution, intelligence, perception, charisma, mindfulness :: Integer} deriving (Show, Read)
instance StatisticsBlock Stats where
str = strength
dex = dexterity
con = constitution
int = intelligence
per = perception
cha = charisma
mind = mindfulness
data Statistic = Strength
| Dexterity
| Constitution
| Intelligence
| Perception
| Charisma
| Mindfulness
deriving (Eq,Read,Show)
getStatistic :: StatisticsBlock a => Statistic -> a -> Integer
getStatistic Strength = str
getStatistic Dexterity = dex
getStatistic Constitution = con
getStatistic Intelligence = int
getStatistic Perception = per
getStatistic Charisma = cha
getStatistic Mindfulness = mind
setStatistic :: Statistic -> Integer -> Stats -> Stats
setStatistic Strength = setStr
setStatistic Dexterity = setDex
setStatistic Constitution = setCon
setStatistic Intelligence = setInt
setStatistic Perception = setPer
setStatistic Charisma = setCha
setStatistic Mindfulness = setMind
-- |
-- Used to generate a Stats object with all the same stats (i.e. stats 1 => Stats 1 1 1 1 1 1 1)
--
stats :: Integer -> Stats
stats x = (Stats {strength=x, dexterity=x, constitution=x, intelligence=x, perception=x, charisma=x, mindfulness=x})
-- |
-- Functions to modify a single stat in a Stats block.
--
setStr :: Integer -> Stats -> Stats
setStr x st = st { strength = x }
setDex :: Integer -> Stats -> Stats
setDex x st = st { dexterity = x }
setCon :: Integer -> Stats -> Stats
setCon x st = st { constitution = x }
setInt :: Integer -> Stats -> Stats
setInt x st = st { intelligence = x }
setPer :: Integer -> Stats -> Stats
setPer x st = st { perception = x }
setCha :: Integer -> Stats -> Stats
setCha x st = st { charisma = x }
setMind :: Integer -> Stats -> Stats
setMind x st = st { mindfulness = x }
......@@ -174,11 +174,11 @@ suspendedSTMAction action = proc i ->
animstate_suspended_stm_action s >> action i }
-- | Print a line of text to the game console. This will print exactly once.
-- Accepts 'Nothing' and prints once immediately when a value is supplied.
printTextOnce :: (FRPModel m, StateOf m ~ AnimationState) =>
FRP e m (Maybe (TextType,B.ByteString)) ()
printTextOnce = onceA printTextA
-- | Print a line of text to the game console on every frame of animation.
printTextA :: (FRPModel m, StateOf m ~ AnimationState) =>
FRP e m (Maybe (TextType,B.ByteString)) ()
printTextA = proc pt_data ->
......@@ -189,6 +189,7 @@ printTextA = proc pt_data ->
printText print_text_object pt_type pt_string)
-< (print_text_object,pt_data)
-- | Print a line of text to the status window (e.g. current hit points, compass).
statusA :: (FRPModel m, StateOf m ~ AnimationState) =>
FRP e m (Maybe (StatusField,B.ByteString)) ()
statusA = proc status_data ->
......
......@@ -30,6 +30,7 @@ buildingAvatar = proc () ->
where switchTo "monolith" = simpleBuildingAvatar Monolith
switchTo "anchor" = planetaryAnchorAvatar
switchTo "portal" = simpleBuildingAvatar Portal
switchTo "cybergate" = cybergateBuildingAvatar
switchTo _ = questionMarkAvatar >>> arr (const ())
simpleBuildingAvatar :: (FRPModel m, LibraryModelSource lm) =>
......@@ -48,8 +49,65 @@ genericBuildingAvatar actionA = proc () ->
(\o -> (o,())) m_orientation
returnA -< ()
cybergateBuildingAvatar :: (FRPModel m) =>
BuildingAvatar e m
cybergateBuildingAvatar = genericBuildingAvatar $ proc () ->
do transformA libraryA -< (affineOf $ translate (Vector3D 0 (-0.5) 0),
(scene_layer_local,SimpleModel Cybergate))
transformA libraryA -< (affineOf $ translate (Vector3D (-1) (-1) 0) . scale (Vector3D 1 1 1.5),
(scene_layer_local,SimpleModel Cyberpylon))
transformA libraryA -< (affineOf $ translate (Vector3D (-2) (-2) 0) . scale (Vector3D 1 1 1),
(scene_layer_local,SimpleModel Cyberpylon))
transformA libraryA -< (affineOf $ translate (Vector3D (-3) (-3) 0) . scale (Vector3D 1 1 0.5),
(scene_layer_local,SimpleModel Cyberpylon))
transformA libraryA -< (affineOf $ translate (Vector3D 1 (-1) 0) . scale (Vector3D 1 1 1.5),
(scene_layer_local,SimpleModel Cyberpylon))
transformA libraryA -< (affineOf $ translate (Vector3D 2 (-2) 0) . scale (Vector3D 1 1 1),
(scene_layer_local,SimpleModel Cyberpylon))
transformA libraryA -< (affineOf $ translate (Vector3D 3 (-3) 0) . scale (Vector3D 1 1 0.5),
(scene_layer_local,SimpleModel Cyberpylon))
lightningBolt -< (Green, Point3D (-3) (-3) 0.5,Point3D (-2) (-2) 1.0)
lightningBolt -< (Green, Point3D (-2) (-2) 1.0,Point3D (-1) (-1) 1.5)
lightningBolt -< (Green, Point3D (3) (-3) 0.5,Point3D (2) (-2) 1.0)
lightningBolt -< (Green, Point3D (2) (-2) 0.5,Point3D (1) (-1) 1.5)
random_height <- randomA -< (-0.5,0.99 :: RSdouble)
let width = sqrt $ 1.0 - random_height^2
lightningBolt -< (Green, Point3D (-1) (-1) 0.5,Point3D (-width) (-0.5) (random_height*1.5+1.5))
lightningBolt -< (Green, Point3D (1) (-1) 0.5, Point3D width (-0.5) (random_height*1.5+1.5))
lightningBolt :: (FRPModel m, StateOf m ~ AnimationState, InputOutputOf m ~ Enabled) =>
FRP e m (EnergyColor, Point3D, Point3D) ()
lightningBolt = proc (e,p1,p5) ->
do let radius = 0.01
p2 <- randomLightningPoint -< (0.25,1,p1,p5)
p3 <- randomLightningPoint -< (0.25,2,p1,p5)
p4 <- randomLightningPoint -< (0.25,3,p1,p5)
lightningBoltSegment -< (e,radius,p1,p2)
lightningBoltSegment -< (e,radius,p2,p3)
lightningBoltSegment -< (e,radius,p3,p4)
lightningBoltSegment -< (e,radius,p4,p5)
randomLightningPoint :: (FRPModel m, StateOf m ~ AnimationState) => FRP e m (RSdouble,Integer,Point3D,Point3D) Point3D
randomLightningPoint = proc (interval,u,a,b) ->
do let p_base = lerp (max 0 $ min 1 $ fromInteger u*interval) (a,b)
let scale_factor = interval * (distanceBetween a b)
x <- randomA -< (-1,1)
y <- randomA -< (-1,1)
z <- randomA -< (-1,1)
returnA -< translate (vectorScaleTo scale_factor $ Vector3D x y z) p_base
lightningBoltSegment :: (FRPModel m, StateOf m ~ AnimationState, InputOutputOf m ~ Enabled) =>
FRP e m (EnergyColor,RSdouble,Point3D,Point3D) ()
lightningBoltSegment = proc (e,radius,a,b) ->
do transformA libraryA -< (affineOf $ translate (vectorToFrom b origin_point_3d) .
rotateToFrom (vectorToFrom a b) (Vector3D 0 1 0) .
scale (Vector3D radius (distanceBetween a b) radius),
(scene_layer_local,EnergyThing EnergyCylinder e))
planetaryAnchorAvatar :: (FRPModel m) => BuildingAvatar e m
planetaryAnchorAvatar = genericBuildingAvatar $ translate (Vector3D 0 1.0 0) $ proc () ->
planetaryAnchorAvatar = genericBuildingAvatar $ translate (Vector3D 0 0.0 1.0) $ proc () ->
do libraryA -< (scene_layer_local,PlanetaryAnchorCore)
planetaryAnchorFlange (1.1^1) (fromDegrees 25) (fromDegrees 30) 10.0 -< ()
planetaryAnchorFlange (1.1^2) (fromDegrees 50) (fromDegrees 60) 9.0 -< ()
......@@ -57,8 +115,8 @@ planetaryAnchorAvatar = genericBuildingAvatar $ translate (Vector3D 0 1.0 0) $ p
planetaryAnchorFlange (1.1^4) (fromDegrees 100) (fromDegrees 120) 4.0 -< ()
planetaryAnchorFlange (1.1^5) (fromDegrees 125) (fromDegrees 150) 1.0 -< ()
accumulateSceneA -< (scene_layer_local,
lightSource $ PointLight (Point3D 0 1.0 0)
(measure (Point3D 0 1.0 0) (Point3D 1 0 1))
lightSource $ PointLight (Point3D 0 0.0 1.0)
(measure (Point3D 0 0.0 1.0) (Point3D 0 0 0))
white
violet)
......
......@@ -17,6 +17,7 @@ import Scene
import AnimationExtras
import AnimationVortex
import CreatureData
import qualified Data.ByteString.Char8 as B
-- | Avatar for any creature that automatically switches to the appropriate species-specific avatar thread.
creatureAvatar :: (FRPModel m) => CreatureAvatar e m
......@@ -36,30 +37,30 @@ creatureAvatar = proc () ->
switchTo _ = questionMarkAvatar
encephalonAvatar :: (FRPModel m) => CreatureAvatar e m
encephalonAvatar = genericCreatureAvatar $ proc () ->
encephalonAvatar = genericCreatureAvatar normal $ proc () ->
do faction <- objectFaction ThisObject -< ()
libraryA -< (scene_layer_local,FactionedModel faction Encephalon)
wield_point <- exportCoordinateSystem <<< arr (joint_arm_hand . snd) <<<
bothArms (Vector3D 0.66 0.66 0) (Point3D 0.145 0.145 0) 0.33 (Point3D 0.35 0.066 0.133) -< (FactionedModel faction MachineArmUpper,FactionedModel faction MachineArmLower)
bothArms (Vector3D 0.66 0 0.66) (Point3D 0.145 0 0.145) 0.33 (Point3D 0.35 0.133 0.0666) -< (FactionedModel faction MachineArmUpper,FactionedModel faction MachineArmLower)
returnA -< CreatureThreadOutput {
cto_wield_point = wield_point }
recreantAvatar :: (FRPModel m) => CreatureAvatar e m
recreantAvatar = genericCreatureAvatar $ floatBobbing 0.25 0.4 $ proc () ->
recreantAvatar = genericCreatureAvatar normal $ floatBobbing 0.25 0.4 $ proc () ->
do faction <- objectFaction ThisObject -< ()
libraryA -< (scene_layer_local,FactionedModel faction Recreant)
wield_point <- exportCoordinateSystem <<< arr (joint_arm_hand . snd) <<<
bothArms (Vector3D 0 (-1.0) 0) (Point3D 0.3 0.075 0) 0.5 (Point3D 0.5 0.075 0.2) -< (FactionedModel faction MachineArmUpper,FactionedModel faction MachineArmLower)
bothArms (Vector3D 0 0 (-1.0)) (Point3D 0.3 0 0.075) 0.5 (Point3D 0.5 0.2 0.075) -< (FactionedModel faction MachineArmUpper,FactionedModel faction MachineArmLower)
returnA -< CreatureThreadOutput {
cto_wield_point = wield_point }
androsynthAvatar :: (FRPModel m) => CreatureAvatar e m
androsynthAvatar = genericCreatureAvatar $ proc () ->
androsynthAvatar = genericCreatureAvatar normal $ proc () ->
do faction <- objectFaction ThisObject -< ()
libraryA -< (scene_layer_local,FactionedModel faction Androsynth)
bothLegs Upright (Vector3D 0 0 1) (Point3D (0.07) 0.5 (-0.08)) 0.55 (Point3D 0.07 0 0.0) -< (FactionedModel faction ThinLimb, FactionedModel faction ThinLimb)
bothLegs Upright (Vector3D 0 1 0) (Point3D 0.07 0 0.5) 0.54 (Point3D 0.07 0 0) -< (FactionedModel faction ThinLimb, FactionedModel faction ThinLimb)
wield_point <- exportCoordinateSystem <<< arr (joint_arm_hand . snd) <<<
bothArms (Vector3D (1.0) (-1.0) (-1.0)) (Point3D 0.05 0.65 0.0) 0.45 (Point3D 0.15 0.34 0.1) -< (FactionedModel faction ThinLimb,FactionedModel faction ThinLimb)
bothArms (Vector3D (1.0) (-1.0) (-1.0)) (Point3D 0.05 0.0 0.65) 0.45 (Point3D 0.15 0.1 0.34) -< (FactionedModel faction ThinLimb,FactionedModel faction ThinLimb)
returnA -< CreatureThreadOutput {
cto_wield_point = wield_point }
......@@ -81,37 +82,37 @@ dustVortexAvatar :: (FRPModel m) => CreatureAvatar e m
dustVortexAvatar = particleAvatar dust_vortex 12 (SimpleModel DustPuff) Nothing
caduceatorAvatar :: (FRPModel m) => CreatureAvatar e m
caduceatorAvatar = genericCreatureAvatar $ proc () ->
caduceatorAvatar = genericCreatureAvatar normal $ proc () ->
do faction <- objectFaction ThisObject -< ()
libraryA -< (scene_layer_local,FactionedModel faction Caduceator)
wield_point <- exportCoordinateSystem <<< arr (joint_arm_hand . snd) <<<
bothArms (Vector3D 1.0 (-1.0) 1.0) (Point3D 0.1 0.15 0.257) 0.34 (Point3D 0.02 0.17 0.4) -< (FactionedModel faction CaduceatorArmUpper, FactionedModel faction CaduceatorArmLower)
bothArms (Vector3D 1.0 1.0 (-1.0)) (Point3D 0.1 0.257 0.15) 0.34 (Point3D 0.02 0.4 0.17) -< (FactionedModel faction CaduceatorArmUpper, FactionedModel faction CaduceatorArmLower)
returnA -< CreatureThreadOutput {
cto_wield_point = wield_point }
reptilianAvatar :: (FRPModel m) => CreatureAvatar e m
reptilianAvatar = genericCreatureAvatar $ proc () ->
reptilianAvatar = genericCreatureAvatar normal $ proc () ->
do faction <- objectFaction ThisObject -< ()
libraryA -< (scene_layer_local,FactionedModel faction Reptilian)
bothLegs Upright (Vector3D 0 0 1) (Point3D (0.05) 0.25 (-0.1)) 0.29 (Point3D 0.07 0 0.0) -< (FactionedModel faction ReptilianLegUpper,FactionedModel faction ReptilianLegLower)
bothLegs Upright (Vector3D 0 1 0) (Point3D (0.05) (-0.1) 0.25) 0.29 (Point3D 0.07 0 0) -< (FactionedModel faction ReptilianLegUpper,FactionedModel faction ReptilianLegLower)
wield_point <- exportCoordinateSystem <<< arr (joint_arm_hand . snd) <<<
bothArms (Vector3D 1.0 0.0 1.0) (Point3D (0.05) 0.35 (-0.1)) 0.25 (Point3D 0.07 0.25 0.12) -< (FactionedModel faction ReptilianArmUpper, FactionedModel faction ReptilianArmLower)
bothArms (Vector3D 1.0 1.0 0.0) (Point3D (0.05) (-0.1) 0.35) 0.25 (Point3D 0.07 0.12 0.25) -< (FactionedModel faction ReptilianArmUpper, FactionedModel faction ReptilianArmLower)
returnA -< CreatureThreadOutput {
cto_wield_point = wield_point }
hellionAvatar :: (FRPModel m) => CreatureAvatar e m
hellionAvatar = genericCreatureAvatar $ proc () ->
hellionAvatar = genericCreatureAvatar normal $ proc () ->
do faction <- objectFaction ThisObject -< ()
libraryA -< (scene_layer_local,FactionedModel faction Hellion)
bothEyeStalks (Vector3D (0.1) 0 (-1))
(Point3D 0.06 0.55 0)
bothEyeStalks (Vector3D (0.1) (-1) 0)
(Point3D 0.06 0 0.55)
1.2
(Point3D 0.2 0.8 0.05) -< (FactionedModel faction HellionAppendage,
(Point3D 0.2 0.05 0.8) -< (FactionedModel faction HellionAppendage,
FactionedModel faction HellionAppendage,
FactionedModel faction HellionEye)
bothLegs Upright (Vector3D 0.5 0 (-1)) (Point3D 0.05 0.55 0) 0.8 (Point3D 0.05 0 0) -< (FactionedModel faction HellionAppendage,FactionedModel faction HellionAppendage)
bothLegs Upright (Vector3D 0.5 (-1) 0) (Point3D 0.05 0 0.55) 0.8 (Point3D 0.05 0 0) -< (FactionedModel faction HellionAppendage,FactionedModel faction HellionAppendage)
wield_point <- exportCoordinateSystem <<< arr (joint_arm_hand . snd) <<<
bothArms (Vector3D 1.0 0.0 (-0.5)) (Point3D 0.1 0.6 0) 0.4 (Point3D 0.3 0.25 0.3) -< (FactionedModel faction HellionAppendage,FactionedModel faction HellionAppendage)
bothArms (Vector3D 1.0 (-0.5) 0) (Point3D 0.1 0 0.6) 0.4 (Point3D 0.3 0.3 0.25) -< (FactionedModel faction HellionAppendage,FactionedModel faction HellionAppendage)
returnA -< CreatureThreadOutput {
cto_wield_point = wield_point }
......
......@@ -34,8 +34,8 @@ genericStateHeader switchTo f = proc i ->
floatBobbing :: (FRPModel m,StateOf m ~ AnimationState) => RSdouble -> RSdouble -> FRP e m j p -> FRP e m j p
floatBobbing ay by animationA = proc j ->
do t <- threadTime -< ()
let float_y = lerpBetween (-1,sine $ fromRotations $ t `cyclical'` (fromSeconds 5),1) (ay,by)
transformA animationA -< (Affine $ translate (Vector3D 0 float_y 0),j)
let float_z = lerpBetween (-1,sine $ fromRotations $ t `cyclical'` (fromSeconds 5),1) (ay,by)
transformA animationA -< (Affine $ translate (Vector3D 0 0 float_z),j)
-- | Get new elements in a list on a frame-by-frame basis.
newListElements :: (FRPModel m,Eq a) => FRP e m [a] [a]
......@@ -47,7 +47,7 @@ newListElements = proc as ->
basic_camera :: Camera
basic_camera = PerspectiveCamera {
camera_position = Point3D 0 0 0,
camera_lookat = Point3D 0 0 1,
camera_up = Vector3D 0 1 0,
camera_lookat = Point3D 0 1 0,
camera_up = Vector3D 0 0 1,
camera_fov = fromDegrees 45 }
......@@ -18,6 +18,9 @@ import Models.LibraryData
import ProtocolTypes
import Scene
import AnimationExtras
import qualified Data.ByteString.Char8 as B
import RSAGL.Scene
import Control.Arrow.Operations
type TerrainThreadSwitch m = RSwitch Enabled (Maybe ProtocolTypes.TerrainTile) () () m
......@@ -38,7 +41,7 @@ terrainTile (tid@(ProtocolTypes.TerrainTile terrain_type (x,y))) = proc () ->
killThreadIf -< actual_size <= 0.0 && not still_here
transformA (libraryA >>> terrainDecoration tid) -<
(Affine $ translate
(Vector3D (fromInteger x) 0 (negate $ fromInteger y)) .
(Vector3D (fromInteger x) (fromInteger y) 0) .
scale' actual_size,
(scene_layer_local,Models.LibraryData.TerrainTile terrain_type))
returnA -< ()
......@@ -68,8 +71,8 @@ leafyTree recursion has_leaves =
0.04*realToFrac recursion)
push_up <- getRandomR (1.5/realToFrac recursion,
3.0/realToFrac recursion)
leafyTreeBranch (Point3D x 0 y)
(Vector3D 0 push_up 0)
leafyTreeBranch (Point3D x y 0)
(Vector3D 0 0 push_up)
thickness
recursion
(has_leaves && not dead_tree)
......@@ -93,9 +96,9 @@ leafyTreeBranch point vector thickness recursion has_leaves =
us <- liftM (take takes) $ getRandomRs (2*branch_inset,1.0-branch_inset)
other_branches <- mapM (leafyTreeBranchFrom $ b && has_leaves) us
continue_trunk <- leafyTreeBranchFrom has_leaves $ 1.0 - branch_inset
let this_branch = translateToFrom point (Point3D 0 0 0) $
rotateToFrom vector (Vector3D 0 1 0) $
scale (Vector3D thickness (vectorLength vector) thickness) $
let this_branch = translateToFrom point origin_point_3d $
rotateToFrom vector (Vector3D 0 0 1) $
scale (Vector3D thickness thickness (vectorLength vector)) $
proc () -> libraryA -< (scene_layer_local,TreeBranch)
return $ this_branch >>> continue_trunk >>> foldr1 (>>>) other_branches
where leafyTreeBranchFrom :: (FRPModel m, FRPModes m ~ RoguestarModes) =>
......@@ -106,7 +109,7 @@ leafyTreeBranch point vector thickness recursion has_leaves =
new_vector_constraint)
t <- getRandomR (thickness/3,thickness/2)
leafyTreeBranch
(lerp u (point,translate vector point))
(lerp u (point,translate (scale' 0.66 vector) point))
(vectorScaleTo new_vector_constraint $
vector `add` (Vector3D x y z))
t
......
......@@ -65,8 +65,8 @@ phaseWeaponAvatar phase_weapon_model weapon_size = proc tti ->
do libraryA -< (scene_layer_local,phase_weapon_model)
accumulateSceneA -< (scene_layer_local,lightSource $ case fmap (toSeconds . (t_now `sub`)) m_atk_time of
Just t | t < 1.0 -> PointLight {
lightsource_position = Point3D 0 0 $ 0.15 + t*t*realToFrac weapon_size,
lightsource_radius = measure (Point3D 0 0 $ 0.5*realToFrac weapon_size) (Point3D 0 0 0),
lightsource_position = Point3D 0 0 (0.15 + t*t*realToFrac weapon_size),
lightsource_radius = measure (Point3D 0 (0.5*realToFrac weapon_size) 0) (Point3D 0 0 0),
lightsource_color = grayscale $ 1.0 - t,
lightsource_ambient = grayscale $ (1.0 - t)^2 }
_ | otherwise -> NoLight)
......@@ -97,7 +97,7 @@ energySwordAvatar energy_color sword_size = proc tti ->
libraryA -< (scene_layer_local,
EnergyThing EnergySword energy_color)
transformA libraryA -<
(Affine $ translate (Vector3D 0 2.9 0) .
(Affine $ translate (Vector3D 0 0 2.9) .
scale (Vector3D 1 blade_length 1),
(scene_layer_local,
EnergyThing EnergyCylinder energy_color))
......
......@@ -47,10 +47,10 @@ data Vortex = Vortex {
vortex :: Vortex
vortex = Vortex {
vortex_height = 0.5,
vortex_containment = 100,
vortex_containment = 20,
vortex_drag = 1.0,
vortex_binding = 0,
vortex_repulsion = 1.0,
vortex_repulsion = 0.25,
vortex_rotation = const 1.0,
vortex_base_angle = fromDegrees 0,
vortex_base_force = 10,
......@@ -60,7 +60,7 @@ 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),
quadraticTrap (vortex_containment v) (Point3D 0 0 (vortex_height v)),
-- Damp down runaway behavior.
drag (vortex_drag v),
-- Repulse points that get too close.
......@@ -70,20 +70,20 @@ vortexForceFunction v particles =
(map fst particles),
-- Attract points that wonder too far away.
concatForces $ map (quadraticTrap (vortex_binding v) . fst) particles,
-- Swirl points around the y axis.
-- Swirl points around the z axis.
\_ p _ -> perSecond $ perSecond $
(vectorNormalize $ vectorToFrom origin_point_3d p) `crossProduct`
(Vector3D 0 (vortex_rotation v $ distanceBetween origin_point_3d p) 0),
(Vector3D 0 0 (vortex_rotation v $ distanceBetween origin_point_3d p)),
-- 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)
(Vector3D 0 0 1)
< 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
\_ (Point3D x y _) _ -> perSecond $ perSecond $ vectorScaleTo (vortex_base_force v) $
vectorScaleTo (sine $ vortex_base_angle v) (Vector3D (-x) (-y) 0) `add`
(Vector3D 0 0 (cosine $ vortex_base_angle v)),
\_ _ _ -> perSecond $ perSecond $ Vector3D 0 0 (negate $ vortex_gravity v)
]
glower :: (FRPModel m, FRPModes m ~ RoguestarModes,
......@@ -100,33 +100,29 @@ glower library_model = proc (p,_,_) ->
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
where makeAParticle (a:b:c:d:e:f:xs) = (Point3D a b (c+0.5),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 () ->
particleAvatar vortex_spec num_particles library_model m_color = genericCreatureAvatar nonrotating $ 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
(foldr1 (<<<) $ flip map [1..num_particles] $
\_ -> proc particles ->
do glower library_model -< head particles
returnA -< tail particles) -< particles
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))
Just color -> PointLight (abstractAverage $ map (\(p,_,_) -> p) particles)
(measure (Point3D 0 0 0.5) (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)
wield_point <- exportCoordinateSystem -< translate (rotateY (fromRotations $ t `cyclical'` (fromSeconds 3)) $ Vector3D 0.25 0.0 0.5)
returnA -< (CreatureThreadOutput {
cto_wield_point = wield_point })
......
......@@ -3,11 +3,15 @@
module CreatureData
(CreatureAvatarSwitch,
CreatureAvatar,
CreatureAvatarConfiguration,
normal,
nonrotating,
genericCreatureAvatar)
where
import RSAGL.FRP
import RSAGL.Scene
import RSAGL.Math
import VisibleObject
import Data.Maybe
import Control.Arrow
......@@ -15,10 +19,26 @@ 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 () ->
data CreatureAvatarConfiguration = CreatureAvatarConfiguration {
should_rotate :: Bool }
normal :: CreatureAvatarConfiguration
normal = CreatureAvatarConfiguration {
should_rotate = True }
nonrotating :: CreatureAvatarConfiguration
nonrotating = CreatureAvatarConfiguration {
should_rotate = False }
genericCreatureAvatar :: (FRPModel m) =>
CreatureAvatarConfiguration ->
FRP e (CreatureAvatarSwitch m) () CreatureThreadOutput -> CreatureAvatar e m
genericCreatureAvatar config creatureA = proc () ->
do visibleObjectHeader -< ()
m_position_info <- objectIdealPosition ThisObject -< ()
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,())
let m_coordinate_system = if (should_rotate config) then m_orientation else
fmap (\position -> translate (vectorToFrom position origin_point_3d) root_coordinate_system) m_position_info
switchTerminate -< if isNothing m_orientation then (Just $ genericCreatureAvatar config creatureA,Nothing) else (Nothing,Nothing)
arr Just <<< transformA creatureA -< (fromMaybe (error "genericCreatureAvatar: fromMaybe") m_coordinate_system,())
......@@ -75,9 +75,9 @@ rightArm bend_vector shoulder_anchor maximum_length hand_rest = proc (arm_upper,
is_wielding <- isWielding ThisObject -< ()
hand_point <- approachA 0.1 (perSecond 1.0) -< case m_time_recent_attack of
Just t | t_now < t `add` fromSeconds 0.5 && m_tool_type == Just "sword" -> translate (Vector3D maximum_length 0 0) shoulder_anchor
Just t | t_now < t `add` fromSeconds 0.3 && m_tool_type == Nothing -> translate (Vector3D 0 0 $ maximum_length / 4) shoulder_anchor
Just t | t_now < t `add` fromSeconds 1.0 && m_tool_type == Nothing -> translate (Vector3D 0 0 maximum_length) shoulder_anchor
_ | is_wielding -> translate (Vector3D 0 0 maximum_length) shoulder_anchor
Just t | t_now < t `add` fromSeconds 0.3 && m_tool_type == Nothing -> translate (Vector3D 0 (maximum_length / 4) 0) shoulder_anchor
Just t | t_now < t `add` fromSeconds 1.0 && m_tool_type == Nothing -> translate (Vector3D 0 maximum_length 0) shoulder_anchor
_ | is_wielding -> translate (Vector3D 0 maximum_length 0) shoulder_anchor
_ | otherwise -> hand_rest
arm bend_vector maximum_length -< (shoulder_anchor,hand_point,arm_upper,arm_lower)
......@@ -147,3 +147,4 @@ bothLegs style
swapX :: (AffineTransformable a) => a -> a
swapX = scale (Vector3D (-1.0) 1.0 1.0)
......@@ -10,7 +10,8 @@ import Models.Factions
import Models.FactionData
androsynth_head :: Faction -> Quality -> Modeling
androsynth_head f _ = model $
androsynth_head f _ = rotate (Vector3D 0 0 1) (fromDegrees 180) $
rotateToFrom (Vector3D 0 0 1) (Vector3D 0 1 0) $ model $
do model $
do smoothbox 0.2 (Point3D (-2) 0 (-2)) (Point3D (-3) 10 (-5)) -- side panels/"ears"
smoothbox 0.2 (Point3D 2 0 (-2)) (Point3D 3 10 (-5))
......@@ -35,7 +36,8 @@ androsynth_head f _ = model $
concordance_dark_glass
androsynth_body :: Faction -> Quality -> Modeling
androsynth_body f _ = model $
androsynth_body f _ = rotate (Vector3D 0 0 1) (fromDegrees 180) $
rotateToFrom (Vector3D 0 0 1) (Vector3D 0 1 0) $ model $
do model $
do smoothbox 0.2 (Point3D (-2) 7 (-2.5)) (Point3D 2 8 2.5)
smoothbox 0.2 (Point3D (-3) 0 (-3.5)) (Point3D 3 1 3.5)
......@@ -46,8 +48,8 @@ androsynth :: Faction -> Quality -> Modeling
androsynth f q = model $
do model $
do androsynth_head f q
affine $ translate (Vector3D 0 30 0)
affine $ translate (Vector3D 0 0 30)
model $