ironforge 0.1.0.23 → 0.1.0.25
raw patch · 5 files changed
+194/−52 lines, 5 filesdep ~antisplice
Dependency ranges changed: antisplice
Files
- Game/Antisplice/Dungeon/Ironforge.hs +8/−5
- Game/Antisplice/Dungeon/Ironforge/Cambridge.hs +55/−37
- Game/Antisplice/Dungeon/Ironforge/IronforgeCity.hs +39/−6
- Game/Antisplice/Dungeon/Ironforge/Kinds.hs +88/−0
- ironforge.cabal +4/−4
Game/Antisplice/Dungeon/Ironforge.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, RecordWildCards #-} {- This module is part of Ironforge.@@ -43,6 +43,7 @@ import Game.Antisplice import Game.Antisplice.Dungeon.Ironforge.Cambridge import Game.Antisplice.Dungeon.Ironforge.IronforgeCity+import Game.Antisplice.Dungeon.Ironforge.Kinds import Game.Antisplice.Dungeon.Ironforge.School import Control.Monad import Control.Monad.Error.Class@@ -50,9 +51,10 @@ ironforge :: Constructor () ironforge = do- money <- registerCurrency "Money" "Money is measured in Iron Dollars."- (greatForge, stationW, commonsW) <- ironforgeCity- stationC <- cambridge money+ kinds <- getKinds+ currencies@Currencies{..} <- getCurrencies+ (greatForge, stationW, commonsW) <- ironforgeCity kinds currencies+ stationC <- cambridge kinds currencies -- Tram insertVocab "tram" Noun@@ -84,9 +86,10 @@ -- Player steDef <- registerStereoM $ do- mergeStereo defaultStereo+ mergeStereoM defaultStereo mergeStereoM visualStereo mergeStereoM manualStereo+ mergeStereoM consumeStereo mergeSkillM $ skill "oink" !+ bareAction (\_ -> mprintLn "Oink!") !+ implyGlobalCooldownA !+> implyCooldownA 5000 subscribePlayer $ do setPlayerRoom greatForge
Game/Antisplice/Dungeon/Ironforge/Cambridge.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, RankNTypes #-}+{-# LANGUAGE FlexibleContexts, RankNTypes, RecordWildCards #-} {- This module is part of Ironforge.@@ -41,14 +41,15 @@ import System.Chatty.Misc import Text.Chatty.Extended.Printer import Game.Antisplice+import Game.Antisplice.Dungeon.Ironforge.Kinds 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 :: Kinds -> Currencies -> Constructor NodeId+cambridge kinds@Kinds{..} currencies@Currencies{..} = do -- CAMBRIDGE : DEEPRUN TRAM STATION stationC <- constructRoom $ do ctorRoom "Cambridge Deeprun Tram Station" "This is the tram station of Cambridge, Massachusetts."@@ -62,10 +63,10 @@ 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)+ 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) @@ -76,7 +77,6 @@ broele1WC <- broeleAv bipath broeleC broele1WC West broele2WC <- broeleAv- kOfficer <- registerKind let officerGuard :: Prerequisite officerGuard = do rs <- getRoomState@@ -108,13 +108,14 @@ 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)+ 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" !+ bareCondition (\_ -> do c <- getCurrency money; a <- getAtom cartA; return (c>=a)) !+ bareAction (\_ -> do a <- getAtom cartA; modifyCurrency money (subtract a))- !+ bareAction (\_ -> mprintLn "Cashier: \"Thank you for choosing our market!\"")+ !+ bareAction (\_ -> mprintLn =<< drunken "Cashier: \"Thank you for choosing our market!\"") !+ bareAction (\_ -> putAtom cartA 0)+ !+ bareCondition (\p -> case p of SkillParam _ Nothing Nothing Nothing -> return True; _ -> return False) addFeature $ Stereo Near cashierSte return () withRoom broele2WC $ addRoomDesc "To the north there is the supermarket."@@ -135,47 +136,64 @@ 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 "Officer: \"Stop! I think you didn't pay for that!\""- mprintLn "The officer points at your shopping basket."- mprintLn "Officer: \"Pay a fee of $3000 or go to jail.\""+ 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 "Hint: You don't have $3000."+ 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 :: (MonadAtoms m,MonadVocab m) => KindId -> NodeId -> String -> String -> [String] -> [String] -> Int -> m (Atom ObjectState)- regGood k r t d ns as p = do+ let regGood :: (MonadAtoms 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- onAcquire $ guardKindNotInRoom k r $ do- instanciateForm a+ 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- [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+ 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 : AI LAB ENTRANCE janA <- newAtom@@ -185,7 +203,7 @@ 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!\""+ 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
Game/Antisplice/Dungeon/Ironforge/IronforgeCity.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, RankNTypes, RecordWildCards #-} {- This module is part of Ironforge.@@ -41,13 +41,15 @@ import System.Chatty.Misc import Text.Chatty.Extended.Printer import Game.Antisplice+import Game.Antisplice.Dungeon.Ironforge.Kinds import Game.Antisplice.Utils.Graph import Control.Monad import Control.Monad.Error.Class import Data.Monoid+import Text.Printf -ironforgeCity :: Constructor (NodeId,NodeId,NodeId)-ironforgeCity = do+ironforgeCity :: Kinds -> Currencies -> Constructor (NodeId,NodeId,NodeId)+ironforgeCity kinds@Kinds{..} currencies@Currencies{..} = do -- IRONFORGE : THE GREAT FORGE greatForge <- constructRoom $ do ctorRoom "The Great Forge" "This is the Great Forge."@@ -96,19 +98,43 @@ bipath commonsW militaryW East -- IRONFORGE : THE BANK- bankW <- constructRoom $ ctorRoom "The Bank" "This is the bank of Ironforge."+ bankW <- constructRoom $ ctorRoom "The Bank" "This is the bank of Ironforge. The exit is to the west." withRoom commonsW $ do addRoomObject $ ctorRoomNesting "the bank" "This is the Ironforge bank." ["bank"] [] bankW+ unipath bankW commonsW West -- IRONFORGE : THE AUCTION HOUSE- auctionW <- constructRoom $ ctorRoom "The Auction House" "This is the auction house of Ironforge."+ auctionW <- constructRoom $ ctorRoom "The Auction House" "This is the auction house of Ironforge. The exit is to the east." withRoom commonsW $ do addRoomObject $ ctorRoomNesting "the auction house" "This is the Ironforge auction house." ["house"] ["auction"] auctionW -- TODO!+ unipath auctionW commonsW East -- IRONFORGE : THE TAVERN+ billA <- newAtom+ putAtom billA (0 :: Int) tavernW <- constructRoom $ do- ctorRoom "The Tavern" "This is the tavern of Ironforge. It is known for its strong beer, so you might want to try one. To the west there is the toilet. The exit is to the east."+ ctorRoom "The Tavern" "This is the tavern of Ironforge. It is known for its strong beer, so you might want to try one. To the west there is the toilet and the kitchen is to the south. The exit is to the east." addRoomObject $ do+ ctorMob "the barkeeper" ["barkeeper"] "This is the old and friendly barkeeper." ["old","friendly"]+ barKeeperSte <- registerStereoM $ do+ mergeSkill $ skill "order" !+ bareAction (\p ->+ case p of+ SkillParam _ (Just (Nounc [] Nothing "beer")) Nothing Nothing -> do+ mapAtom (+250) billA+ b <- getAtom billA+ mprintLn =<< drunken (printf "The barkeeper brings you a beer.\nBarkeeper: \"That's $%i.%02i.\"" (b `div` 100) (b `mod` 100))+ beer <- addRoomObject $ do+ ctorAcq "a huge glass of strong beer" "This is a huge glass of dwarven strong beer." ["beer","glass"] ["huge","strong","dwarven"]+ addFeature Drinkable+ onDrink $ consumeAlcohol 12+ acquireObject beer+ _ -> throwError UnintellegibleError)+ mergeSkill $ skill "pay" !+ bareCondition (\_ -> do c <- getCurrency money; a <- getAtom billA; return (c>=a))+ !+ bareAction (\_ -> do a <- getAtom billA; modifyCurrency money (subtract a))+ !+ bareAction (\_ -> putAtom billA 0)+ !+ bareCondition (\p -> case p of SkillParam _ Nothing Nothing Nothing -> return True; _ -> return False)+ addFeature $ Stereo Near barKeeperSte+ addRoomObject $ do ctorAcq "a rusty dagger" "This is a rusty old dagger, probably lost by a rouge." ["dagger"] ["rusty","old"] addDescSeg "A rusty old dagger lies on the ground." addEquipSlot MainHand@@ -137,6 +163,13 @@ enterAndAnnounce tavernW schedule 3000 $ continueMobRoute $ objectIdOf o bipath toiletW tavernW East++ -- IRONFORGE : THE TAVERN'S KITCHEN+ kitchenW <- constructRoom $ do+ ctorRoom "The Kitchen" "This is the tavern's kitchen."+ addRoomObject $ do+ ctorMob "the cook" ["cook","chef"] "This is the experienced cook. He's unfriendly and rude, but his meals are the best ones of Azeroth." ["experienced","unfriendly","rude"]+ bipath tavernW kitchenW South -- IRONFORGE : THE MYSTIC WARD mysticSte <- registerStereoM $ do
+ Game/Antisplice/Dungeon/Ironforge/Kinds.hs view
@@ -0,0 +1,88 @@+{-# 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.Kinds 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++data Kinds = Kinds {+ kOfficer :: KindId,+ kCabbage :: KindId,+ kCarrot :: KindId,+ kCereliac :: KindId,+ kLeek :: KindId,+ kBeetroot :: KindId,+ kPotato :: KindId,+ kApple :: KindId,+ kBanana :: KindId,+ kWater :: KindId,+ kBeer :: KindId,+ kStrongBeer :: KindId,+ kAppleJuice :: KindId,+ kVodka :: KindId,+ kOrangeLemonade :: KindId+ }++data Currencies = Currencies {+ money :: CurrencyId+ }++getKinds :: Constructor Kinds+getKinds = do+ [kOfficer, kCabbage, kCarrot, kCereliac, kLeek,+ kBeetroot, kPotato, kApple, kBanana, kWater,+ kBeer, kStrongBeer, kAppleJuice, kVodka,+ kOrangeLemonade] <- forM [1..15] $ const registerKind+ return $ Kinds+ kOfficer kCabbage kCarrot kCereliac kLeek+ kBeetroot kPotato kApple kBanana kWater+ kBeer kStrongBeer kAppleJuice kVodka+ kOrangeLemonade++getCurrencies :: Constructor Currencies+getCurrencies = do+ money <- registerCurrency "Money" "Money is measured in Iron Dollars. You can pay with this."+ return $ Currencies+ money
ironforge.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.1.0.23+version: 0.1.0.25 -- A short (one-line) description of the package. synopsis: A technical demo for Antisplice.@@ -46,9 +46,9 @@ cabal-version: >=1.10 library- exposed-modules: Game.Antisplice.Dungeon.Ironforge, Game.Antisplice.Dungeon.Ironforge.School, Game.Antisplice.Dungeon.Ironforge.IronforgeCity, Game.Antisplice.Dungeon.Ironforge.Cambridge+ exposed-modules: Game.Antisplice.Dungeon.Ironforge, Game.Antisplice.Dungeon.Ironforge.School, Game.Antisplice.Dungeon.Ironforge.IronforgeCity, Game.Antisplice.Dungeon.Ironforge.Cambridge, Game.Antisplice.Dungeon.Ironforge.Kinds - build-depends: base >=4.6 && <4.7, chatty >=0.5.2 && <0.6, antisplice >=0.13.2 && <0.14, mtl >= 2.1 && < 2.2, transformers >= 0.3 && < 0.4+ build-depends: base >=4.6 && <4.7, chatty >=0.5.2 && <0.6, antisplice >=0.14 && <0.15, mtl >= 2.1 && < 2.2, transformers >= 0.3 && < 0.4 default-language: Haskell2010 @@ -64,7 +64,7 @@ other-extensions: FlexibleContexts -- Other library packages from which modules are imported.- build-depends: base >=4.6 && <4.7, chatty >=0.5.2 && <0.6, antisplice >=0.13.2 && <0.14, mtl >= 2.1 && < 2.2, transformers >= 0.3 && < 0.4+ build-depends: base >=4.6 && <4.7, chatty >=0.5.2 && <0.6, antisplice >=0.14 && <0.15, mtl >= 2.1 && < 2.2, transformers >= 0.3 && < 0.4 -- Directories containing source files. -- hs-source-dirs: