Cambridge.hs

{-# LANGUAGE FlexibleContexts, RankNTypes #-}

{-
  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.Utils.Graph
import Control.Monad
import Control.Monad.Error.Class
import Data.Monoid
import Text.Printf

cambridge :: CurrencyId -> Constructor NodeId
cambridge money = 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 "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 "He comes somewhat nearer."
          2 -> mprintLn "He stands just three meters away from you."
          3 -> mprintLn "The murderer finally arrives at you." >> schedule 2000 (eprintLn (Vivid Red) "The murderer takes his knife and kills you." >> throwError QuitError)
          _ -> noneM
        putAtom murdererA (a+1)

  -- CAMBRIDGE : GERT BROELEMANN AVENUE
  broeleC <- constructRoom $ ctorRoom "Gert Broelemann 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 Broelemann Avenue" "This is a long street to the east and to the west."
  broele1WC <- broeleAv
  bipath broeleC broele1WC West
  broele2WC <- broeleAv
  bipath broele1WC broele2WC West
  broele3WC <- broeleAv
  bipath broele2WC broele3WC West
  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 : 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 "Cashier: \"Welcome!\""
        n -> mprintLn $ printf "Cashier: \"That's $%i.%02i.\"" (n `div` 100) (n `mod` 100)
      cashierSte <- registerStereoM $ do
        a <- getAtom cartA
        mergeSkill $ skill "pay" !+ consumeCurrencyA money a
                                 !+ bareAction (\_ -> mprintLn "Cashier: \"Thank you for choosing our market!\"")
                                 !+ bareAction (\_ -> putAtom cartA 0)
      addFeature $ Stereo Near cashierSte
    return ()
  withRoom broele2WC $ addRoomDesc "To the north there is the supermarket."
  bipath superMarket broele2WC South

  -- CAMBRIDGE : SUPERMARKET PRODUCE SECTION
  let regGood :: (MonadAtoms m,MonadVocab m) => KindId -> NodeId -> String -> String -> [String] -> [String] -> Int -> m (Atom ObjectState)
      regGood k r t d ns as p = do
        a <- newAtom
        o <- constructObject (do
          ctorAcq t d ns as
          onAcquire $ guardKindNotInRoom k r $ do
            instanciateForm a
            void $ mapAtom (+p) cartA) Nothing k
        putAtom a o
        return a
  [kCabbage,kCarrot,kCereliac,kLeek,kBeetroot,kPotato,kApple,kBanana] <- forM [1..8] $ const registerKind
  produceM <- constructRoom $ do
    ctorRoom "Produce Section" "Fruits and vegetables all around you. There are cabbage, carrots, cereliac, leek, beetroots, potatos, apples, bananas..."
  fCabbage <- regGood kCabbage produceM "a cabbage" "This is a very delicious-looking cabbage."
              ["cabbage","vegetable"] ["delicious","delicious-looking"] 140
  fCarrot <- regGood kCarrot produceM "a carrot" "This is a thick and long carrot, going to taste great!"
             ["carrot","vegetable"] ["delicious","delicious-looking","thick","long"] 5
  fCereliac <- regGood kCereliac produceM "a cereliac" "This is a thick and delicious-looking cereliac. Yumm!"
               ["cereliac","vegetable"] ["thick","delicious","delicious-looking"] 90
  fLeek <- regGood kLeek produceM "a stick of leek" "This is a long and delicious stick of leek."
           ["leek","stick","vegetable"] ["long","delicious","delicious-looking"] 30
  fBeetroot <- regGood kBeetroot produceM "a beetroot" "This is a thick red beetroot."
               ["beetroot","beet","vegetable"] ["thick","red","delicious","delicious-looking"] 15
  fPotato <- regGood kPotato produceM "a potato" "This is a thick potato. Imagine they could end up as crisps..."
             ["potato","vegetable"] ["thick"] 10
  fApple <- regGood kApple produceM "an apple" "This is a thick and delicious-looking apple."
            ["apple","fruit"] ["thick","delicious","delicious-looking"] 50
  fBanana <- regGood kBanana produceM "a banana" "This is a banana. Imagine you were a GDR citizen :o"
             ["banana","fruit"] ["delicious","delicious-looking"] 80
  withRoom produceM $ mapM_ instanciateForm [fCabbage, fCarrot, fCereliac, fLeek, fBeetroot, fPotato, fApple, fBanana]
  bipath superMarket produceM West
    
  -- 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.x"
    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 "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