diff --git a/Game/Antisplice/Dungeon/Ironforge.hs b/Game/Antisplice/Dungeon/Ironforge.hs --- a/Game/Antisplice/Dungeon/Ironforge.hs +++ b/Game/Antisplice/Dungeon/Ironforge.hs @@ -51,10 +51,12 @@ ironforge :: Constructor () ironforge = do - kinds <- getKinds + kinds@Kinds{..} <- getKinds currencies@Currencies{..} <- getCurrencies - (greatForge, stationW, commonsW) <- ironforgeCity kinds currencies - stationC <- cambridge kinds currencies + methods@Methods{..} <- getMethods + atoms@Atoms{..} <- getAtoms + (greatForge, stationW, commonsW) <- ironforgeCity kinds currencies methods atoms + stationC <- cambridge kinds currencies methods atoms -- Tram insertVocab "tram" Noun @@ -90,7 +92,8 @@ mergeStereoM visualStereo mergeStereoM manualStereo mergeStereoM consumeStereo - mergeSkillM $ skill "oink" !+ bareAction (\_ -> mprintLn "Oink!") !+ implyGlobalCooldownA !+> implyCooldownA 5000 + mergeSkillM $ skill "oink" !+ validConsumer EnsureLineEnd (\_ -> mprintLn "Oink!") !+ implyGlobalCooldownA !+> implyCooldownA 5000 + mergeSkill $ skill "bake" !+ callRecipe byCooking subscribePlayer $ do setPlayerRoom greatForge setStatM Strength 6 @@ -104,4 +107,4 @@ setStatM CooldownDuration 1000 addStereo steDef modifyCurrency money (+2000) - mputv "prompt" $ Literal "${user} #{health}H \\$#{money/100}.#{money%100}#?{ #{otitle} #{ohealth}H}" + mputv "prompt" $ Literal "${user} #{health}H \\$#{money.100}#?{ #{capital!otitle} #{ohealth}H}" diff --git a/Game/Antisplice/Dungeon/Ironforge/Cambridge.hs b/Game/Antisplice/Dungeon/Ironforge/Cambridge.hs --- a/Game/Antisplice/Dungeon/Ironforge/Cambridge.hs +++ b/Game/Antisplice/Dungeon/Ironforge/Cambridge.hs @@ -48,8 +48,8 @@ import Data.Monoid import Text.Printf -cambridge :: Kinds -> Currencies -> Constructor NodeId -cambridge kinds@Kinds{..} currencies@Currencies{..} = do +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." @@ -112,18 +112,17 @@ 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 =<< 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) + mergeSkill $ skill "pay" !+ validCondition Nil (\_ -> do c <- getCurrency money; a <- getAtom cartA; return (c>=a)) + !+ 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" !+ bareAction (\_ -> do + mergeSkill $ skill "jail" !+ validConsumer Nil (\_ -> do rs <- getRoomState let os = filter ((==kOfficer).objectKindOf) $ anyBstInorder $ roomObjectsOf rs forM_ os $ removeRoomObject . objectIdOf @@ -160,7 +159,7 @@ 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..." + 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!" @@ -195,6 +194,22 @@ ["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 diff --git a/Game/Antisplice/Dungeon/Ironforge/IronforgeCity.hs b/Game/Antisplice/Dungeon/Ironforge/IronforgeCity.hs --- a/Game/Antisplice/Dungeon/Ironforge/IronforgeCity.hs +++ b/Game/Antisplice/Dungeon/Ironforge/IronforgeCity.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, RankNTypes, RecordWildCards #-} +{-# LANGUAGE FlexibleContexts, RankNTypes, RecordWildCards, TupleSections #-} {- This module is part of Ironforge. @@ -48,8 +48,8 @@ import Data.Monoid import Text.Printf -ironforgeCity :: Kinds -> Currencies -> Constructor (NodeId,NodeId,NodeId) -ironforgeCity kinds@Kinds{..} currencies@Currencies{..} = do +ironforgeCity :: Kinds -> Currencies -> Methods -> Atoms -> Constructor (NodeId,NodeId,NodeId) +ironforgeCity Kinds{..} Currencies{..} Methods{..} Atoms{..} = do -- IRONFORGE : THE GREAT FORGE greatForge <- constructRoom $ do ctorRoom "The Great Forge" "This is the Great Forge." @@ -117,9 +117,7 @@ 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 + mergeSkill $ skill "order" !+ validConsumer (Noun "beer") (\_ -> 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)) @@ -127,12 +125,10 @@ 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) + acquireObject beer) + mergeSkill $ skill "pay" !+ validCondition Nil (\_ -> do c <- getCurrency money; a <- getAtom billA; return (c>=a)) + !+ validConsumer Nil (\_ -> do a <- getAtom billA; modifyCurrency money (subtract a)) + !+ validConsumer Nil (\_ -> putAtom billA 0) addFeature $ Stereo Near barKeeperSte addRoomObject $ do ctorAcq "a rusty dagger" "This is a rusty old dagger, probably lost by a rouge." ["dagger"] ["rusty","old"] @@ -177,7 +173,7 @@ \get k -> case k of Intelligence -> get Intelligence * 99 _ -> 0 - mergeSkill $ skill "pray" !+ implyGlobalCooldownA !+ bareAction (\_ -> mprintLn "You're falling to your knees praying.\nYou stand up again.") + mergeSkill $ skill "pray" !+ implyGlobalCooldownA !+ validConsumer Nil (\_ -> mprintLn "You're falling to your knees praying.\nYou stand up again.") mysticW <- constructRoom $ do ctorRoom "The Mystic Ward" "Here you will find a lot of mages." addRoomObject $ do @@ -193,16 +189,57 @@ -- IRONFORGE : HOME homeW <- constructRoom $ do ctorRoom "Home" "Home, sweet home." - addRoomObject $ ctorMob "mom" ["mom"] "This is your mom. She knows really %{V7;everything} about cooking." ["beloved"] + recipeSte <- registerStereoM $ do + mergeRecipe $ recipe byCooking "pancake" + !+ consumeKindA kMilk 1 + !+ consumeKindA kEgg 1 + !+ consumeKindA kFlour 1 + !+ Nil #->> (do + i <- liftM ObjectId countOn + o <- constructObject (do + ctorAcq "a pancake" "Bring some of these to Jan and he will let you pass." ["pancake"] [] + addFeature Eatable + onEat $ mprintLn "Yummie, that's really delicious!") (Just i) kPancake + modifyPlayerState $ \p -> p{playerInventoryOf= anyBstInsert o $ playerInventoryOf p}) + momSte <- registerStereoM $ do + mergeSkill $ skill "ask" !+ Prep "for" :-: "pancake" :-: "recipe" #->> do + mprintLn "Mom: \"Yes, of course I got one!\"\nMom gives you the recipe." + i <- liftM ObjectId countOn + k <- liftM KindId countOn + o <- constructObject (do + ctorAcq "a pancake recipe" "Use this to bake pancakes." ["recipe"] [] + addFeature $ Stereo Carried recipeSte) (Just i) k + modifyPlayerState $ \p -> p{playerInventoryOf= anyBstInsert o $ playerInventoryOf p} + addRoomObject $ do + ctorMob "mom" ["mom"] "This is your mom. She knows really %{V7;everything} about cooking." ["beloved"] + addFeature $ Stereo Near momSte bipath cavernW homeW North -- IRONFORGE : HALL OF EXPLORERS halloeW <- constructRoom $ ctorRoom "Hall of Explorers" "Here you can be rewarded." bipath cavernW halloeW East bipath greatForge halloeW NorthEast + + -- IRONFORGE : ECUADORIAN EMBASSY + embassyW <- constructRoom $ do + ctorRoom "Ecuadorian Embassy" "This is the Ecuadorian Embassy in Ironforge. The exit is to the south." + addRoomObject $ do + setObjectTitle "ambassador's desk" + setObjectDesc "This is the Ecuadorian ambassadors desk." + let ns = ["desk"] + as = ["ecuadorian","large"] + forM_ ns addObjectName + forM_ ns $ uncurry insertVocab . (,Noun) + forM_ as addObjectAttr + forM_ as $ uncurry insertVocab . (,Adj) + addDescSeg "On the other side of the room there is a large desk." + withRoom halloeW $ do + addRoomObject $ ctorRoomNesting "the Ecuadorian Embassy" "This is the Ecuadorian Embassy in Ironforge." ["embassy","ecuador"] ["ecuadorian"] embassyW + unipath embassyW halloeW South -- IRONFORGE : TINKER TOWN - tinkerW <- constructRoom $ ctorRoom "Tinker Town" "Engineers all around you." + tinkerW <- constructRoom $ do + ctorRoom "Tinker Town" "Engineers all around you." bipath halloeW tinkerW South bipath tinkerW militaryW South diff --git a/Game/Antisplice/Dungeon/Ironforge/Kinds.hs b/Game/Antisplice/Dungeon/Ironforge/Kinds.hs --- a/Game/Antisplice/Dungeon/Ironforge/Kinds.hs +++ b/Game/Antisplice/Dungeon/Ironforge/Kinds.hs @@ -62,27 +62,62 @@ kStrongBeer :: KindId, kAppleJuice :: KindId, kVodka :: KindId, - kOrangeLemonade :: KindId + kOrangeLemonade :: KindId, + kPancake :: KindId, + kAppleSauce :: KindId, + kFire :: KindId, + kFlour :: KindId, + kEgg :: KindId, + kMilk :: KindId, + kSoda :: KindId, + kSugar :: KindId } data Currencies = Currencies { - money :: CurrencyId + money :: CurrencyId, + mana :: CurrencyId } +data Methods = Methods { + byCooking :: RecipeMethod, + byBuilding :: RecipeMethod + } + +data Atoms = Atoms { + washed :: Atom Bool + } + 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 + kOrangeLemonade, kPancake, kAppleSauce, + kFire, kFlour, kEgg, kMilk, kSoda, + kSugar] <- forM [1..23] $ const registerKind return $ Kinds kOfficer kCabbage kCarrot kCereliac kLeek kBeetroot kPotato kApple kBanana kWater kBeer kStrongBeer kAppleJuice kVodka - kOrangeLemonade + kOrangeLemonade kPancake kAppleSauce + kFire kFlour kEgg kMilk kSoda kSugar getCurrencies :: Constructor Currencies getCurrencies = do money <- registerCurrency "money" "Money is measured in Iron Dollars. You can pay with this." + mana <- registerCurrency "mana" "Mana is used to cast spells." return $ Currencies - money + money mana + +getMethods :: Constructor Methods +getMethods = do + byCooking <- liftM RecipeMethod countOn + byBuilding <- liftM RecipeMethod countOn + return $ Methods + byCooking byBuilding + +getAtoms :: Constructor Atoms +getAtoms = do + washed <- newAtom + return $ Atoms + washed diff --git a/ironforge.cabal b/ironforge.cabal --- a/ironforge.cabal +++ b/ironforge.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.28 +version: 0.1.0.29 -- A short (one-line) description of the package. synopsis: A technical demo for Antisplice. @@ -48,7 +48,7 @@ library 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.14 && <0.15, 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.15 && <0.16, 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.14 && <0.15, mtl >= 2.1 && < 2.2, transformers >= 0.3 && < 0.4 + build-depends: base >=4.6 && <4.7, chatty >=0.5.4 && <0.6, antisplice >=0.15 && <0.16, mtl >= 2.1 && < 2.2, transformers >= 0.3 && < 0.4 -- Directories containing source files. -- hs-source-dirs: @@ -72,4 +72,4 @@ -- Base language which the package is written in. default-language: Haskell2010 - ghc-options: -threaded + ghc-options: -threaded -fprof-auto