{-# LANGUAGE FlexibleContexts, RankNTypes, RecordWildCards, ConstraintKinds #-} {- This module is part of Ironforge. Copyfree (f) 2014 Marvin Cohrs All wrongs revoked. Sharing is an act of love, not crime. Please share Ironforge with everyone you like. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Marvin Cohrs nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} 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 -- CAMBRIDGE : DEEPRUN TRAM STATION stationC <- constructRoom $ do ctorRoom "Cambridge Deeprun Tram Station" "This is the tram station of Cambridge, Massachusetts." addRoomObject $ addDescSeg "On the right there are stairs." -- TODO: Introduce OnUse 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) -- CAMBRIDGE : GERT's AVENUE 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 -- Kalle 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 -- CAMBRIDGE : JAIL : YOUR CELL cellJ <- constructRoom $ ctorRoom "Your Cell" "This is the cell they assigned to you. Pretty small, but it will suffice." -- CAMBRIDGE : SUPERMARKET 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 -- CAMBRIDGE : SUPERMARKET : PRODUCE SECTION 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 -- CAMBRIDGE : SUPERMARKET : BEVERAGES SECTION 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 -- CAMBRIDGE : SUPERMARKET : BAKING SECTION 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 -- CAMBRIDGE : AI LAB : ENTRANCE 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 -- CAMBRIDGE : AI LAB : MAIN ROOM 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