module Game.Antisplice.Dungeon.Ironforge.Cambridge where
import Text.Chatty.Printer
import Text.Chatty.Scanner
import Text.Chatty.Expansion
import Text.Chatty.Expansion.Vars
import System.Chatty.Misc
import Text.Chatty.Extended.Printer
import Game.Antisplice
import Game.Antisplice.Dungeon.Ironforge.Kinds
import Data.Chatty.Graph
import Control.Monad
import Control.Monad.Error.Class
import Data.Monoid
import Text.Printf
cambridge :: Kinds -> Currencies -> Methods -> Atoms -> Constructor NodeId
cambridge Kinds{..} Currencies{..} Methods{..} Atoms{..} = do
stationC <- constructRoom $ do
ctorRoom "Cambridge Deeprun Tram Station" "This is the tram station of Cambridge, Massachusetts."
addRoomObject $ addDescSeg "On the right there are stairs."
addRoomObject $ do
ctorMob "the station overseer" ["overseer","murderer"]
"This one is a very special case. The company didn't check his background, so they hired a recorded murderer. I'd better keep in distance."
["recorded"]
murdererA <- newAtom
putAtom murdererA 0
onLook $ do
a <- getAtom murdererA
case a :: Int of
0 -> mprintLn =<< drunken "This one is a very special case. The company didn't check his background, so they hired a recorded murderer. I'd better keep in distance."
1 -> mprintLn =<< drunken "He comes somewhat nearer."
2 -> mprintLn =<< drunken "He stands just three meters away from you."
3 -> do mprintLn =<< drunken "The murderer finally arrives at you."; schedule 2000 (do eprintLn (Vivid Red) =<< drunken "The murderer takes his knife and kills you."; throwError QuitError)
_ -> noneM
putAtom murdererA (a+1)
broeleC <- constructRoom $ ctorRoom "Gert's Avenue" "This is a long street to the east and to the west. You see the entrance to the Deeprun Tram."
bipath stationC broeleC Up
let broeleAv = constructRoom $ ctorRoom "Gert's Avenue" "This is a long street to the east and to the west."
broele1WC <- broeleAv
bipath broeleC broele1WC West
broele2WC <- broeleAv
let officerGuard :: Prerequisite
officerGuard = do
rs <- getRoomState
return $ null $ filter ((==kOfficer).objectKindOf) $ anyBstInorder $ roomObjectsOf rs
unipath broele1WC broele2WC West
guardedPath broele2WC broele1WC East officerGuard
broele3WC <- broeleAv
guardedPath broele2WC broele3WC West officerGuard
unipath broele3WC broele2WC East
unipath broele3WC broele3WC West
broele1EC <- broeleAv
bipath broeleC broele1EC East
unipath broele1EC broele1EC East
withRoom broeleC $ do
addRoomObject $ do
ctorMob "Karl-Heinz" ["kalle","karl-heinz","teacher"] "Karl-Heinz is an old maths teacher. Strange, but harmless." ["strange","harmless","old"]
ctorRoute [stationC,broeleC,broele1EC,broeleC,broele1WC,broele2WC,broele1WC,broeleC] 10000
cellJ <- constructRoom $ ctorRoom "Your Cell" "This is the cell they assigned to you. Pretty small, but it will suffice."
cartA <- newAtom
putAtom cartA 0
superMarket <- constructRoom $ do
ctorRoom "Cambridge Supermarket" "This is the supermarket of Cambridge. To the west there is the produce section and to the north you can see the beverages section. To the south there is the street."
cashier <- addRoomObject $ do
ctorMob "the cashier" ["cashier"] "The cashier looks very bored." ["bored"]
onSight $ schedule 0 $ getAtom cartA >>= \a -> case a :: Int of
0 -> mprintLn =<< drunken "Cashier: \"Welcome!\""
n -> mprintLn =<< drunken (printf "Cashier: \"That's $%i.%02i.\"" (n `div` 100) (n `mod` 100))
cashierSte <- registerStereoM $ do
mergeSkill $ skill "pay" !+ validCondition Nil (\_ -> do c <- getCurrency money; a <- getAtom cartA; return (if c>=a then Nothing else Just $ Uncon "You don't have enough money."))
!+ validConsumer Nil (\_ -> do a <- getAtom cartA; modifyCurrency money (subtract a))
!+ validConsumer Nil (\_ -> mprintLn =<< drunken "Cashier: \"Thank you for choosing our market!\"")
!+ validConsumer Nil (\_ -> putAtom cartA 0)
addFeature $ Stereo Near cashierSte
return ()
withRoom broele2WC $ addRoomDesc "To the north there is the supermarket."
guardedPath broele2WC superMarket North officerGuard
officerSte <- registerStereoM $ do
mergeSkill $ skill "pay" !+ consumeCurrencyA money 300000
mergeSkill $ skill "jail" !+ validConsumer Nil (\_ -> do
rs <- getRoomState
let os = filter ((==kOfficer).objectKindOf) $ anyBstInorder $ roomObjectsOf rs
forM_ os $ removeRoomObject . objectIdOf
enterAndAnnounce cellJ)
gatedPath superMarket broele2WC South $ ActionBefore $
let pq :: Predicate
pq = return Nothing
h :: Handler
h = getAtom cartA >>= \a -> when (a>0) $ withRoom broele2WC $ do
officer <- addRoomObject $ do
ctorMob "the police officer" ["officer"] "This is the police officer. He is very angry at you. You really should pay - otherwise you'll end up in jail..." ["angry"]
setObjectKind kOfficer
onSight $ schedule 0 $ do
mprintLn =<< drunken "Officer: \"Stop! I think you didn't pay for that!\""
mprintLn =<< drunken "The officer points at your shopping basket."
mprintLn =<< drunken "Officer: \"Pay a fee of $3000 or go to jail.\""
m <- getCurrency money
when (m<300000) $ mprintLn =<< drunken "Hint: You don't have $3000."
addFeature $ Stereo Near officerSte
return ()
in Action pq h
let regGood :: (ChAtoms m,MonadVocab m) => [Feature] -> KindId -> NodeId -> String -> String -> [String] -> [String] -> Int -> ObjectT m () -> m (Atom ObjectState)
regGood f k r t d ns as p m = do
a <- newAtom
o <- constructObject (do
ctorAcq t d ns as
mapM addFeature f
m
onAcquire $ guardRoom r $ do
guardKindNotInRoom k r $ void $ instanciateForm a
void $ mapAtom (+p) cartA) Nothing k
putAtom a o
return a
produceM <- constructRoom $ do
ctorRoom "Produce Section" "Fruits and vegetables all around you. There are cabbage, carrots, cereliac, leek, beetroots, potatos, apples, bananas... To the north you see the baking section."
fCabbage <- regGood [Eatable] kCabbage produceM "a cabbage" "This is a very delicious-looking cabbage."
["cabbage","vegetable"] ["delicious","delicious-looking"] 140 noneM
fCarrot <- regGood [Eatable] kCarrot produceM "a carrot" "This is a thick and long carrot, going to taste great!"
["carrot","vegetable"] ["delicious","delicious-looking","thick","long"] 5 noneM
fCereliac <- regGood [Eatable] kCereliac produceM "a cereliac" "This is a thick and delicious-looking cereliac. Yumm!"
["cereliac","vegetable"] ["thick","delicious","delicious-looking"] 90 noneM
fLeek <- regGood [Eatable] kLeek produceM "a stick of leek" "This is a long and delicious stick of leek."
["leek","stick","vegetable"] ["long","delicious","delicious-looking"] 30 noneM
fBeetroot <- regGood [Eatable] kBeetroot produceM "a beetroot" "This is a thick red beetroot."
["beetroot","beet","vegetable"] ["thick","red","delicious","delicious-looking"] 15 noneM
fPotato <- regGood [Eatable] kPotato produceM "a potato" "This is a thick potato. Imagine they could end up as crisps..."
["potato","vegetable"] ["thick"] 10 noneM
fApple <- regGood [Eatable] kApple produceM "an apple" "This is a thick and delicious-looking apple."
["apple","fruit"] ["thick","delicious","delicious-looking"] 50 noneM
fBanana <- regGood [Eatable] kBanana produceM "a banana" "This is a banana. Imagine you were a GDR citizen :o"
["banana","fruit"] ["delicious","delicious-looking"] 80 noneM
withRoom produceM $ mapM_ instanciateForm [fCabbage, fCarrot, fCereliac, fLeek, fBeetroot, fPotato, fApple, fBanana]
bipath superMarket produceM West
beveragesM <- constructRoom $ do
ctorRoom "Beverages Section" "The variety of beverages here is not that large. They offer water, apple juice, orange lemonade, beer and vodka."
fWater <- regGood [Drinkable] kWater beveragesM "a bottle of water" "This water is clear and non-sparkling."
["water","bottle"] ["clear","non-sparkling"] 30 noneM
fBeer <- regGood [Drinkable] kBeer beveragesM "a bottle of beer" "A bottle of dutch Heineken Pils."
["beer","heineken","pils","bottle"] ["dutch"] 110 $ onDrink $ consumeAlcohol 5
fAppleJuice <- regGood [Drinkable] kAppleJuice beveragesM "a bottle of apple juice" "A small bottle of apple juice."
["apple","juice","bottle"] ["small"] 60 noneM
fVodka <- regGood [Drinkable] kVodka beveragesM "a bottle of vodka" "This is cheap polish vodka, made from potatos."
["vodka","bottle"] ["cheap","polish"] 900 $ onDrink $ consumeAlcohol 40
fOrangeLemonade <- regGood [Drinkable] kOrangeLemonade beveragesM "a bottle of orange lemonade" "A small bottle of orange lemonade."
["orange","lemonade","bottle"] ["small"] 60 noneM
withRoom beveragesM $ mapM_ instanciateForm [fWater,fBeer,fAppleJuice,fVodka,fOrangeLemonade]
bipath superMarket beveragesM North
bakingM <- constructRoom $ do
ctorRoom "Baking Section" "Here you will find everything you need for baking. There is flour, eggs, milk, soda and sugar."
fFlour <- regGood [Eatable] kFlour bakingM "some flour" "A little packet of flour."
["flour","packet"] ["little"] 70 $ onEat $ mprintLn "Omfg, you won't make friends!"
fEgg <- regGood [Eatable] kEgg bakingM "an egg" "A medium-size egg from a free range hen."
["egg"] ["free-range","medium-size"] 20 $ onEat $ mprintLn "Yuck! You could at least have cooked it!"
fMilk <- regGood [Drinkable] kMilk bakingM "1/2 litre of milk" "Half a litre of milk. There's nothing special about this."
["milk","litre"] ["half"] 20 noneM
fSoda <- regGood [] kSoda bakingM "20g baking soda" "A tiny packet of baking soda."
["soda","baking-soda"] ["baking"] 70 noneM
fSugar <- regGood [Eatable] kSugar bakingM "some sugar" "A little packet of sugar."
["sugar","packet"] ["little"] 70 $ onEat $ mprintLn "Yummie!"
withRoom bakingM $ mapM_ instanciateForm [fFlour, fEgg, fMilk, fSoda, fSugar]
bipath produceM bakingM North
janA <- newAtom
putAtom janA True
entranceL <- constructRoom $ do
ctorRoom "Entrance" "This is the entrance to the MIT's AI Lab. To the south there is the main room."
addRoomObject $ do
ctorMob "Jan" ["jan","geek","enthusiast"] "This is Jan, an enthusiastic - but sometimes a little clumsy - computer geek. And he loooves pancakes." ["enthusiastic","clumsy"]
onSight $ schedule 0 $ getAtom janA >>= \a -> when a $ do
mprintLn =<< drunken "Jan: \"Bring me pancakes!\"\nJan: \"A lot of them!\"\nJan: \"And don't forget the apple sauce!\""
withRoom broele1WC $ addRoomDesc "To the south you see the MIT's AI Lab."
bipath broele1WC entranceL South
mainRoomL <- constructRoom $ do
ctorRoom "Main Room" "This is the AI Lab's main room."
guardedPath entranceL mainRoomL South $ liftM not $ getAtom janA
unipath mainRoomL entranceL North
return stationC