Move to building roguestar-engine only.

parent 2a60c36a
CONFIG_OPTS=--ghc-option=-Wall
warning:
@echo "See README."
clean:
(cd rsagl-math && cabal clean ${OPTS})
(cd rsagl-frp && cabal clean ${OPTS})
(cd rsagl && cabal clean ${OPTS})
(cd rsagl-demos && cabal clean ${OPTS})
(cd roguestar-engine && cabal clean ${OPTS})
(cd roguestar-gl && cabal clean ${OPTS})
(cd roguestar-glut && cabal clean ${OPTS})
#(cd roguestar-gtk && cabal clean ${OPTS})
(cd roguestar && cabal clean ${OPTS})
rm -rf roguestar-sdist
config:
(cd rsagl-math && cabal configure ${OPTS})
(cd rsagl-frp && cabal configure ${OPTS})
(cd rsagl && cabal configure ${OPTS})
(cd rsagl-demos && cabal configure ${OPTS})
(cd roguestar-engine && cabal configure ${OPTS})
(cd roguestar-gl && cabal configure ${OPTS})
(cd roguestar-glut && cabal configure ${OPTS})
#(cd roguestar-gtk && cabal configure ${OPTS})
(cd roguestar && cabal configure ${OPTS})
install: roguestar roguestar-glut roguestar-engine rsagl-demos
rsagl-math:
(cd rsagl-math && cabal install --reinstall ${OPTS})
rsagl-frp: rsagl-math
(cd rsagl-frp && cabal install --reinstall ${OPTS})
rsagl: rsagl-frp rsagl-math
(cd rsagl && cabal install --reinstall ${OPTS})
rsagl-demos: rsagl
(cd rsagl-demos && cabal install --reinstall ${OPTS})
roguestar-engine:
(cd roguestar-engine && cabal install --reinstall ${OPTS})
roguestar-gl: rsagl
(cd roguestar-gl && cabal install --reinstall ${OPTS})
roguestar-glut: roguestar-gl
(cd roguestar-glut && cabal install --reinstall ${OPTS})
roguestar-gtk: roguestar-gl
(cd roguestar-gtk && cabal install --reinstall ${OPTS})
roguestar:
(cd roguestar && cabal install --reinstall ${OPTS})
dev:
${MAKE} install -e "OPTS=${CONFIG_OPTS}"
prof:
${MAKE} install -e "OPTS=${CONFIG_OPTS} --enable-library-profiling --enable-executable-profiling"
sdist:
(cd rsagl-math && cabal check && cabal sdist ${OPTS})
(cd rsagl-frp && cabal check && cabal sdist ${OPTS})
(cd rsagl && cabal check && cabal sdist ${OPTS})
(cd rsagl-demos && cabal check && cabal sdist ${OPTS})
(cd roguestar-engine && cabal check && cabal sdist ${OPTS})
(cd roguestar-gl && cabal check && cabal sdist ${OPTS})
(cd roguestar-glut && cabal check && cabal sdist ${OPTS})
#(cd roguestar-gtk && cabal check && cabal sdist ${OPTS})
(cd roguestar && cabal check && cabal sdist ${OPTS})
mkdir -p ./roguestar-sdist
cp rsagl-math/dist/*.tar.gz ./roguestar-sdist
cp rsagl-frp/dist/*.tar.gz ./roguestar-sdist
cp rsagl/dist/*.tar.gz ./roguestar-sdist
cp rsagl-demos/dist/*.tar.gz ./roguestar-sdist
cp roguestar-engine/dist/*.tar.gz ./roguestar-sdist
cp roguestar-gl/dist/*.tar.gz ./roguestar-sdist
cp roguestar-glut/dist/*.tar.gz ./roguestar-sdist
#cp roguestar-gtk/dist/*.tar.gz ./roguestar-sdist
cp roguestar/dist/*.tar.gz ./roguestar-sdist
(cd roguestar-sdist && tar xzf roguestar-engine-${VERSION}.tar.gz)
(cd roguestar-sdist && tar xzf roguestar-gl-${VERSION}.tar.gz)
(cd roguestar-sdist && tar xzf roguestar-glut-${VERSION}.tar.gz)
#(cd roguestar-sdist && tar xzf roguestar-gtk-${VERSION}.tar.gz)
(cd roguestar-sdist && tar xzf roguestar-${VERSION}.tar.gz)
(cd roguestar-sdist && tar xzf rsagl-math-${VERSION}.tar.gz)
(cd roguestar-sdist && tar xzf rsagl-frp-${VERSION}.tar.gz)
(cd roguestar-sdist && tar xzf rsagl-${VERSION}.tar.gz)
(cd roguestar-sdist && tar xzf rsagl-demos-${VERSION}.tar.gz)
(cd roguestar-sdist/roguestar-engine-${VERSION} && cabal configure && cabal install)
(cd roguestar-sdist/rsagl-math-${VERSION} && cabal configure && cabal install)
(cd roguestar-sdist/rsagl-frp-${VERSION} && cabal configure && cabal install)
(cd roguestar-sdist/rsagl-${VERSION} && cabal configure && cabal install)
(cd roguestar-sdist/rsagl-demos-${VERSION} && cabal configure && cabal install)
(cd roguestar-sdist/roguestar-gl-${VERSION} && cabal configure && cabal install)
(cd roguestar-sdist/roguestar-glut-${VERSION} && cabal configure && cabal install)
#(cd roguestar-sdist/roguestar-gtk-${VERSION} && cabal configure && cabal install)
(cd roguestar-sdist/roguestar-${VERSION} && cabal configure && cabal install)
ls roguestar-sdist
.PHONY: rsagl-math rsagl-frp rsagl rsagl-demos roguestar-engine roguestar-gl roguestar-glut roguestar-gtk roguestar config
# Boring file regexps:
(^|/)haddock($|/)
(^|/)products($|/)
\.hi$
\.o$
\.o\.cmd$
# *.ko files aren't boring by default because they might
# be Korean translations rather than kernel modules.
# \.ko$
\.ko\.cmd$
\.mod\.c$
(^|/)\.tmp_versions($|/)
(^|/)CVS($|/)
(^|/)RCS($|/)
~$
#(^|/)\.[^/]
(^|/)_darcs($|/)
\.bak$
\.BAK$
\.orig$
(^|/)vssver\.scc$
\.swp$
(^|/)MT($|/)
(^|/)\{arch\}($|/)
(^|/).arch-ids($|/)
(^|/),
\.class$
\.prof$
(^|/)\.DS_Store$
(^|/)BitKeeper($|/)
(^|/)ChangeSet($|/)
(^|/)\.svn($|/)
\.py[co]$
\#
\.cvsignore$
(^|/)Thumbs\.db$
(^|/)autom4te\.cache($|/)
This diff is collapsed.
#!/usr/bin/runhaskell
import Distribution.Simple
main = defaultMainWithHooks simpleUserHooks
name: roguestar-gl
version: 0.7.0.0
cabal-version: >=1.2
license: OtherLicense
license-file: LICENSE
author: Christopher Lane Hinson <lane@downstairspeople.org>
maintainer: Christopher Lane Hinson <lane@downstairspeople.org>
category: Game
synopsis: Sci-fi roguelike game. Client library.
description: Roguestar-glut and roguestar-gtk depend on this library for the bulk of their functionality.
homepage: http://roguestar.downstairspeople.org/
build-type: Simple
tested-with: GHC==6.12.1
Library
hs-source-dirs: src
exposed-modules: Processes, Initialization, DrawString, Config, KeyStroke, PrintText, Globals
other-modules: Quality, ProtocolTypes, VisibleObject,
Strings, WordGenerator, Driver,
PrintTextData, Animation,
Actions, Limbs, Tables, CommandLine,
Models.Androsynth, Models.QuestionMark, Models.Terrain, Models.RecreantFactory,
Models.Recreant, Models.Glows, Models.Materials, Models.Reptilian,
Models.Hellion,
Models.Library, Models.MachineParts, Models.LibraryData, Models.Caduceator,
Models.Tree, Models.Encephalon, Models.PhaseWeapons, RenderingControl,
Keymaps.BuiltinKeymaps, Keymaps.CommonKeymap, Keymaps.NumpadKeymap,
Keymaps.Keymaps, Keymaps.VIKeymap, AnimationBuildings, Models.Node,
Models.Stargate, Statistics, Models.Sky, Scene, Models.Spheres,
Models.EnergySwords, Models.EnergyThings, Models.CyborgType4,
AnimationEvents, AnimationMenus, AnimationTerrain, AnimationTools,
AnimationExtras, AnimationCreatures, AnimationBuildings, MaybeArrow,
EventUtils, Sky, CreatureData, AnimationVortex, Models.Factions, Models.FactionData,
Paths_roguestar_gl
build-depends: base>=4&&<5,
GLUT>=2.2 && < 2.3,
rsagl==0.7.0.0,
rsagl-math==0.7.0.0,
rsagl-frp==0.7.0.0,
containers>=0.3.0.0,
arrows>=0.4.1.2 && < 0.5,
mtl>=1.1.0.2,
MonadRandom>=0.1.4 && < 1.2,
OpenGL>=2.4.0.1 && < 2.5,
filepath>=1.1.0.3,
random>=1.0.0.2 && < 1.1,
bytestring>=0.9.1.5 && < 0.10,
stm>=2.1.1.2,
priority-sync>=0.2.1.1 && < 0.3
ghc-options: -fno-warn-type-defaults -fexcess-precision
ghc-prof-options: -prof -auto-all
This diff is collapsed.
This diff is collapsed.
{-# LANGUAGE Arrows, OverloadedStrings, TypeFamilies, FlexibleContexts, RankNTypes #-}
module AnimationBuildings
(buildingAvatar)
where
import RSAGL.FRP
import RSAGL.Math
import RSAGL.Animation
import RSAGL.Color.RSAGLColors
import Animation
import VisibleObject
import Models.LibraryData
import Control.Arrow
import Scene
type BuildingAvatarSwitch m = AvatarSwitch () () m
type BuildingAvatar e m = FRP e (BuildingAvatarSwitch m) () ()
-- | An avatar for a building. This function
-- detects the type of a building based on the
-- FRP Thread ID, and switches to the appropriate
-- type of building avatar.
buildingAvatar :: (FRPModel m) => BuildingAvatar e m
buildingAvatar = proc () ->
do objectTypeGuard (== "building") -< ()
m_building_type <- objectDetailsLookup ThisObject "building-shape" -< ()
switchContinue -< (fmap switchTo m_building_type,())
returnA -< ()
where switchTo "monolith" = simpleBuildingAvatar Monolith
switchTo "anchor" = planetaryAnchorAvatar
switchTo "portal" = simpleBuildingAvatar Portal
switchTo "cybergate" = cybergateBuildingAvatar
switchTo _ = questionMarkAvatar >>> arr (const ())
simpleBuildingAvatar :: (FRPModel m, LibraryModelSource lm) =>
lm -> BuildingAvatar e m
simpleBuildingAvatar building_model = genericBuildingAvatar $ proc () ->
do libraryA -< (scene_layer_local,building_model)
returnA -< ()
genericBuildingAvatar :: (FRPModel m) =>
(forall x y. FRP e (FRP1Context x y (BuildingAvatarSwitch m)) () ()) ->
BuildingAvatar e m
genericBuildingAvatar actionA = proc () ->
do visibleObjectHeader -< ()
m_orientation <- objectIdealOrientation ThisObject -< ()
whenJust (transformA actionA) -< fmap
(\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 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 -< ()
planetaryAnchorFlange (1.1^3) (fromDegrees 75) (fromDegrees 90) 7.0 -< ()
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 0.0 1.0)
(measure (Point3D 0 0.0 1.0) (Point3D 0 0 0))
white
violet)
planetaryAnchorFlange :: (FRPModel m, StateOf m ~ AnimationState, InputOutputOf m ~ Enabled) =>
RSdouble -> Angle -> Angle -> RSdouble -> FRP e m () ()
planetaryAnchorFlange s rx rz x = scale' s $ proc () ->
do rotateA (Vector3D 0 1 0) (perSecond $ fromDegrees $ x*3.0) (rotate (Vector3D 0 0 1) rz $
rotateA (Vector3D 0 0 1) (perSecond $ fromDegrees $ x*7.0) (rotate (Vector3D 1 0 0) rx $
rotateA (Vector3D 1 0 0) (perSecond $ fromDegrees $ x*2.0) libraryA)) -<
(scene_layer_local,PlanetaryAnchorFlange)
{-# LANGUAGE Arrows, OverloadedStrings, TypeFamilies #-}
module AnimationCreatures
(creatureAvatar)
where
import RSAGL.FRP
import RSAGL.Math
import RSAGL.Animation
import RSAGL.Color.RSAGLColors
import Animation
import Control.Arrow
import Models.LibraryData
import VisibleObject
import Limbs
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
creatureAvatar = proc () ->
do objectTypeGuard (== "creature") -< ()
m_species <- objectDetailsLookup ThisObject "species" -< ()
switchContinue -< (fmap switchTo m_species,())
returnA -< Nothing
where switchTo "encephalon" = encephalonAvatar
switchTo "recreant" = recreantAvatar
switchTo "androsynth" = androsynthAvatar
switchTo "ascendant" = ascendantAvatar
switchTo "caduceator" = caduceatorAvatar
switchTo "reptilian" = reptilianAvatar
switchTo "hellion" = hellionAvatar
switchTo "dustvortex" = dustVortexAvatar
switchTo _ = questionMarkAvatar
encephalonAvatar :: (FRPModel m) => CreatureAvatar e m
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 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 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 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 normal $ proc () ->
do faction <- objectFaction ThisObject -< ()
libraryA -< (scene_layer_local,FactionedModel faction Androsynth)
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.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 }
ascendantAvatar :: (FRPModel m) => CreatureAvatar e m
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 dust_vortex 12 (SimpleModel DustPuff) Nothing
caduceatorAvatar :: (FRPModel m) => CreatureAvatar e m
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.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 normal $ proc () ->
do faction <- objectFaction ThisObject -< ()
libraryA -< (scene_layer_local,FactionedModel faction Reptilian)
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 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 normal $ proc () ->
do faction <- objectFaction ThisObject -< ()
libraryA -< (scene_layer_local,FactionedModel faction Hellion)
bothEyeStalks (Vector3D (0.1) (-1) 0)
(Point3D 0.06 0 0.55)
1.2
(Point3D 0.2 0.05 0.8) -< (FactionedModel faction HellionAppendage,
FactionedModel faction HellionAppendage,
FactionedModel faction HellionEye)
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.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 }
This diff is collapsed.
{-# LANGUAGE Arrows,
OverloadedStrings,
TypeFamilies,
Rank2Types,
FlexibleContexts #-}
module AnimationExtras
(genericStateHeader,
floatBobbing,
newListElements,
basic_camera)
where
import Animation
import RSAGL.Math
import RSAGL.FRP
import RSAGL.Scene
import Control.Arrow
import Data.List ((\\))
import qualified Data.ByteString.Char8 as B
-- | Switch out if the driver \"state\" does match the specified predicate.
genericStateHeader :: (FRPModel m, StateOf m ~ AnimationState,
InputOutputOf m ~ Enabled) =>
(B.ByteString -> FRP e m (SwitchInputOf m) (SwitchOutputOf m)) ->
(B.ByteString -> Bool) ->
FRP e m (SwitchInputOf m) ()
genericStateHeader switchTo f = proc i ->
do m_state <- driverGetAnswerA -< "state"
switchContinue -< (if fmap f m_state == Just True then Nothing else fmap switchTo m_state,i)
returnA -< ()
-- | Animate something bobbing up and down.
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_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]
newListElements = proc as ->
do olds_as <- delay [] -< as
returnA -< as \\ olds_as
-- | A simple default forward-looking camera.
basic_camera :: Camera
basic_camera = PerspectiveCamera {
camera_position = Point3D 0 0 0,
camera_lookat = Point3D 0 1 0,
camera_up = Vector3D 0 0 1,
camera_fov = fromDegrees 45 }
{-# LANGUAGE Arrows, OverloadedStrings, TypeFamilies #-}
module AnimationMenus
(menu_states,
menuDispatch)
where
import AnimationExtras
import Animation
import PrintText
import RSAGL.FRP
import Control.Arrow
import Strings
import Tables
import Data.Monoid
import Data.Maybe
import Actions
import Scene
import qualified Data.ByteString.Char8 as B
type MenuSwitch m = RSwitch Disabled () () SceneLayerInfo m
type MenuHandler e m = FRP e (MenuSwitch m) () SceneLayerInfo
-- Header for menu states. This will automatically switch away to an approprate menu if the provided state predicate does not match.
menuStateHeader :: (FRPModel m) => (B.ByteString -> Bool) -> MenuHandler e m
menuStateHeader f = genericStateHeader switchTo f >>> arr (const $ roguestarSceneLayerInfo mempty basic_camera)
where switchTo "species-selection" = menuSpeciesSelection
switchTo "class-selection" = menuClassSelection
switchTo "pickup" = toolMenuSelection
switchTo "drop" = toolMenuSelection
switchTo "wield" = toolMenuSelection
switchTo "make" = toolMenuSelection
switchTo "make-what" = makeWhatMenuSelection
switchTo "make-finished" = makeFinishedMenuSelection
switchTo unknown_state = menuStateHeader (== unknown_state)
menuDispatch :: (FRPModel m) => MenuHandler e m
menuDispatch = menuStateHeader (const False) >>> arr (const $ roguestarSceneLayerInfo mempty basic_camera)
menuSpeciesSelection :: (FRPModel m) => MenuHandler e m
menuSpeciesSelection = proc s ->
do result <- menuStateHeader (== "species-selection") -< s
requestPrintTextMode -< Unlimited
clearPrintTextA -< Just ()
printMenuA select_species_action_names -< ()
printTextA -< Just (Query,"Select a Species:")
returnA -< result
menuClassSelection :: (FRPModel m) => MenuHandler e m
menuClassSelection = proc () ->
do result <- menuStateHeader (== "class-selection") -< ()
stats <- sticky isJust Nothing <<< arr (fmap table_created) <<< driverGetTableA -< ("player-stats","0")
initial_stats <- initial -< stats
let change = stats /= initial_stats
switchContinue -< (if change then Just menuClassSelection else Nothing,())
requestPrintTextMode -< Unlimited
clearPrintTextA -< Just ()
printCharacterStats 0 -< ()
printMenuA select_base_class_action_names -< ()
printMenuItemA "reroll" -< ()
printTextA -< Just (Query,"Select a Class:")
returnA -< result
printCharacterStats :: (FRPModel m, FRPModes m ~ RoguestarModes) =>
Integer -> FRP e m () ()
printCharacterStats unique_id = proc () ->
do m_player_stats <- driverGetTableA -< ("player-stats",B.pack $ show unique_id)
print1CharacterStat -< (m_player_stats,"str")
print1CharacterStat -< (m_player_stats,"spd")
print1CharacterStat -< (m_player_stats,"con")
printTextA -< Just (Event,"-")
print1CharacterStat -< (m_player_stats,"per")
printTextA -< Just (Event,"-")
print1CharacterStat -< (m_player_stats,"int")
print1CharacterStat -< (m_player_stats,"cha")
print1CharacterStat -< (m_player_stats,"mind")
printTextA -< Just (Event,"-")