Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

124 lines (110 sloc) 5.589 kb
{-# 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,"-")
print1CharacterStat -< (m_player_stats,"maxhp")
print1CharacterStat :: (FRPModel m, StateOf m ~ AnimationState) => FRP e m (Maybe RoguestarTable,B.ByteString) ()
print1CharacterStat = proc (m_player_stats,stat_str) ->
do let m_stat_int = (\x -> tableLookupInteger x ("property","value") stat_str) =<< m_player_stats
printTextA -< fmap (\x -> (Event,hrstring stat_str `B.append` ": " `B.append` (B.pack $ show x))) m_stat_int
makeWhatMenuSelection :: (FRPModel m) => MenuHandler e m
makeWhatMenuSelection = proc () ->
do result <- menuStateHeader (== "make-what") -< ()
requestPrintTextMode -< Unlimited
clearPrintTextA -< Just ()
printMenuA make_what_action_names -< ()
printTextA -< Just (Query,"Build what?")
returnA -< result
makeFinishedMenuSelection :: (FRPModel m) => MenuHandler e m
makeFinishedMenuSelection = proc () ->
do result <- menuStateHeader (== "make-finished") -< ()
clearPrintTextA -< Just ()
printTextA -< Just (Query,"Confirm.")
returnA -< result
toolMenuSelection :: (FRPModel m) => MenuHandler e m
toolMenuSelection = proc () ->
do menuStateHeader (`elem` ["pickup","drop","wield","make"]) -< ()
state <- sticky isJust Nothing <<< driverGetAnswerA -< "menu-state"
m_menu_data <- sticky isJust Nothing <<< driverGetTableA -< ("menu","7")
menu_state <- sticky isJust Nothing <<< driverGetAnswerA -< "menu-state"
clearPrintTextA -< Just ()
requestPrintTextMode -< Unlimited
printTextA -< Just (Query, B.unlines $ flip (maybe []) m_menu_data $ \menu_data -> flip map (tableSelect menu_data ["n","name"]) $ \[n,name] ->
case Just n == menu_state of
True -> " ---> " `B.append` hrstring name
False -> " " `B.append` hrstring name)
printTextA -< Just (Query, case state of
Just "pickup" -> "Select an item to pick up: "
Just "drop" -> "Select an item to drop: "
Just "wield" -> "Select an item to wield: "
Just "make" -> "Select materials to craft an item: " -- FIXME should say what kind of item
_ -> "Select an item: ")
printMenuItemA "next" -< ()
printMenuItemA "prev" -< ()
printMenuItemA "escape" -< ()
returnA -< roguestarSceneLayerInfo mempty basic_camera
Jump to Line
Something went wrong with that request. Please try again.