module Game.Antisplice.Prototypes where
import Text.Chatty.Printer
import Text.Chatty.Expansion
import Text.Chatty.Extended.Printer
import Control.Monad
import Control.Monad.Error.Class
import Data.Chatty.Atoms
import Data.Chatty.Fail
import Data.Chatty.AVL
import Data.Chatty.Graph
import Game.Antisplice.Monad
import Game.Antisplice.Monad.Dungeon
import Game.Antisplice.Monad.Vocab
import Game.Antisplice.Rooms
import Game.Antisplice.Events
import Game.Antisplice.Errors
import Text.Printf
import Data.Char
import Data.Text (pack,unpack)
import Data.List
ctorRoom :: ChAtoms m => String -> String -> RoomT m ()
ctorRoom t d = do
setRoomTitle t
addRoomDesc d
onAnnounce $ enomaskLn (Dull Magenta) =<< expand =<< drunken =<< getRoomTitle
onLook $ do
rs <- getRoomState
mnomaskLn =<< expand =<< drunken =<< liftM (("%{D2;"++).(++"}")) getRoomDesc
sequence_ $ avlInorder $ flip fmap (roomObjectsOf rs) $ \os -> objectTriggerOnAnnounceOf os
ctorSign :: (ChAtoms m,MonadVocab m,MonadError SplErr m) => String -> [String] -> ObjectT m ()
ctorSign t as = do
onRead $ enomaskLn (Vivid White) =<< expand =<< drunken t
lookCountA <- newAtom
putAtom lookCountA 0
onLook $ do
c <- getAtom lookCountA
mprintLn =<< drunken (case c :: Int of
0 -> "This is just a regular sign. There is nothing special about this one in particular."
1 -> "This REALLY is just a regular sign."
2 -> "Stop looking at me!"
3 -> "I'll call the police if you don't stop!"
_ -> "You hear the sounds of an arriving police car. This is your end :P")
when (c==4) $ throwError QuitError
putAtom lookCountA (c+1)
setObjectTitle "a sign"
setObjectDesc "This is a sign with a text written on it."
addObjectName "sign"
addObjectName "caption"
mapM_ (uncurry insertVocab) [("sign",Noun),("caption",Noun)]
forM_ as addObjectAttr
forM_ as $ uncurry insertVocab . (,Adj)
ctorMob :: MonadVocab m => String -> [String] -> String -> [String] -> ObjectT m ()
ctorMob t ns d as = do
let cap (c:cx) = toUpper c : cx
cap [] = []
onLook $ mnomaskLn =<< expand =<< drunken d
onRoomEnter $ mnomaskLn =<< expand =<< drunken (printf "%s has entered the room." $ cap t)
onRoomLeave $ mnomaskLn =<< expand =<< drunken (printf "%s has left the room." $ cap t)
onAnnounce $ mnomaskLn =<< expand =<< drunken (printf " %%{D6;%s is here.}" $ cap t)
onDie $ do
mnomaskLn =<< expand =<< drunken (printf "%s dies." t)
void $ addRoomObject $ do
setObjectTitle $ pack $ printf "corpse of %s" t
setObjectDesc $ pack $ printf "Looks like %s is dead." t
addDescSeg $ printf "The corpse of %s lies here." t
insertVocab "corpse" Noun
insertVocab "dead" Adj
forM_ ("corpse":ns) addObjectName
forM_ ("dead":as) addObjectAttr
forM_ [Damagable, Mobile] addFeature
setObjectTitle t
setObjectDesc d
forM_ ns addObjectName
forM_ ns $ uncurry insertVocab . (,Noun)
forM_ as addObjectAttr
forM_ as $ uncurry insertVocab . (,Adj)
ctorRoute :: (Monad m,Functor m) => [NodeId] -> Integer -> ObjectT m ()
ctorRoute rs d = do
i <- fmap objectIdOf getObjectState
setMobRoute rs
let cmr :: Handler
cmr = continueMobRoute i >> schedule d cmr
onFirstSight $ schedule d cmr
ctorRoomNesting :: MonadVocab m => String -> String -> [String] -> [String] -> NodeId -> ObjectT m ()
ctorRoomNesting t d ns as r = do
setObjectTitle t
setObjectDesc d
forM_ ns addObjectName
forM_ ns $ uncurry insertVocab . (,Noun)
forM_ as addObjectAttr
forM_ as $ uncurry insertVocab . (,Adj)
onEnter $ enterAndAnnounce r
ctorAcq :: MonadVocab m => String -> String -> [String] -> [String] -> ObjectT m ()
ctorAcq t d ns as = do
setObjectTitle t
setObjectDesc d
forM_ ns addObjectName
forM_ as addObjectAttr
forM_ ns $ uncurry insertVocab . (,Noun)
forM_ as $ uncurry insertVocab . (,Adj)
onLook $ mprintLn d
setObjectIsAcquirable True
addRoomDesc :: ChAtoms m => String -> RoomT m ObjectId
addRoomDesc = addRoomObject . addDescSeg