venzone-1.0.0.0: test/GymnasiumSpec.hs
{-# Language RankNTypes #-}
module GymnasiumSpec where
import Gymnasium
import Meeple.Operate
import Room
import Story
import Screen
import Lens.Micro.Platform
import Test.Hspec
ng :: (Eq a, Show a) => FilePath -> (Story -> a) -> a -> Expectation
ng fp a o = (a <$> testGymnasium fp) `shouldReturn` o
ngFalse :: (Eq a, Show a) => FilePath -> (Story -> a) -> a -> Expectation
ngFalse fp a o = (a <$> testGymnasium fp) `shouldNotReturn` o
vmap :: Functor f => SimpleGetter b c -> SimpleGetter (f b) (f c)
vmap lf = to (\a -> a ^. to (fmap (view lf)))
spec :: Spec
spec = do
-- To replay these:
-- `cabal new-repl test` and then
-- λ> :m +Gymnasium
-- λ> narrateGymnasium "test/records/ladder-exit.vr"
describe "gymnasium tests" $ do
-- COLLISION --
it "does not collide with similar meeple" $
ng "test/records/solid-similar.vr"
(\s -> let ms = s ^.. screen . meeples
. each . filtered (not . isPlayer)
in map (view position) ms)
[(7,14), (7, 15)]
it "collides diagonally" $
ng "test/records/diagonal-collision.vr"
(^. screen . player . vmap position) (Just (23, 15))
it "baddies eat star" $
ng "test/records/eat-star.vr"
(^. screen . meeples . to length) 4
-- HAZARDS --
it "dies in the water" $
ng "test/records/water.vr"
(^. screen . player . vmap position) (Just (23, 15))
it "baddies die in the water" $
ng "test/records/baddies-die.vr"
(^. screen . meeples . to length) 4
-- JUMP --
it "does not skip cells while jumping" $
ng "test/records/jump-tick.vr" (^. stars) 2
it "jumps at 2 height" $
ng "test/records/jump-2.vr" (^. stars) 1
it "jumps at 3 height" $
ng "test/records/jump-2.vr" (^. stars) 1
it "jumps on top of rope" $
ng "test/records/jump-after-rope.vr" (^. stars) 1
it "resets direction when hitting obstacle (fall)" $
ng "test/records/reset-direction.vr"
(^. screen . player . vmap position) (Just (23, 50))
-- LADDER --
it "climbs a ladder" $
ng "test/records/ladder.vr"
(^. screen . player . vmap position) (Just (12, 65))
it "climbs a ladder connecting two rooms" $
ng "test/records/ladder-exit.vr"
(^. screen . room . title) "Gymnasium tre"
it "descends a ladder" $
ng "test/records/down-ladder.vr"
(^. screen . player . vmap position) (Just (23, 65))
it "falls off a ladder" $
ng "test/records/falls-off-ladder.vr" (^. stars) 0
-- MOVEMENT --
it "stands doing nothing" $
ng "test/records/stand.vr"
(^. screen . player . vmap position) (Just (23, 15))
it "space to stop" $
ng "test/records/space-stop.vr"
(^. screen . player . vmap position) (Just (23, 30))
it "does not fall through diagonal holes" $
ng "test/records/diagonal-hole.vr"
(^. screen . player . vmap position) (Just (12, 70))
it "does not fall through floow in switching rooms" $
ng "test/records/room-switch-ground.vr"
(^. screen . room . title) "Gymnasium due"
it "allows different-direction meeples" $
ng "test/records/dumb-direction.vr"
(^. screen . meeples . to length) 9
it "resets SCI on obstacle" $
ng "test/records/sci-stop.vr"
(^. screen . player . vmap position) (Just (20, 30))
it "get stopped by a wall in the next room" $
ng "test/records/stop-next-room.vr"
(^. screen . room . title) "Gymnasium tre"
it "jumps full height between rooms" $
ng "test/records/jump-between.vr" (^. stars) 2
it "is slow" $
ng "test/records/slow.vr" (^. stars) 0
it "is slow when changing rooms too" $
ng "test/records/slow-rooms.vr"
(^. screen . room . title) "Gymnasium tre"
-- SPAWNS --
it "respawns in new spawn-point if dead" $
ng "test/records/respawn.vr"
(\s -> (s ^. screen . player . vmap position,
s ^. screen . room . title))
(Just (23, 41), "Gymnasium due")
it "respawns in new old spawn-point if new one not touched" $
ng "test/records/no-touch-spawn.vr"
(^. screen . room . title) "Gymnasium uno"
it "restarts from last-savepoint" $
ng "test/records/restarts.vr"
(\s -> (s ^. screen . player . vmap position,
s ^. screen . room . title))
(Just (23, 41), "Gymnasium due")
-- BEASTS --
it "smart d walks on rope" $
ng "test/records/smart-rope.vr"
(^. screen . player . vmap position) (Just (23, 15))
let isB :: Meeple -> Bool
isB (MBird _) = True
isB _ = False
bird :: HasScreen s => SimpleGetter s Bird
bird = meeples . to (filter isB) . to head . to (\(MBird b) -> b)
it "bird does not start stuck" $
ngFalse "test/records/bird-start-stuck.vr"
(^. screen . bird . position) (12, 18)
it "bird does not get stuck" $
ngFalse "test/records/bird-get-stuck.vr"
(^. screen . bird . position) (13, 11)
it "gets killed by stone" $
ng "test/records/stone-kill.vr"
(^. screen . player . vmap position) (Just (23, 4))
it "stone gets destroyes on ground" $
ng "test/records/stone-safe.vr"
(^. screen . player . vmap position) (Just (23, 71))
-- krampus
it "blades get destroyed on screen exit" $
ng "test/records/blades-destroyed.vr"
(^. screen . meeples . to length) 8
it "blades kill player" $
ng "test/records/blades-kill.vr"
(^. screen . room . title) "Gymnasium uno"
it "blades kill meeple" $
ng "test/records/blades-kill-meeple.vr"
(^. screen . room . title) "Gymnasium sei"
-- locks
it "lock is ground" $
ng "test/records/lock-ground.vr"
(^. screen . room . title) "Gymnasium due"
it "lock is ground for meeples" $
ng "test/records/lock-ground-meeples.vr"
(^. screen . room . title) "Gymnasium uno"
it "lock is ground after 1 star" $
ng "test/records/lock-ground-1-star.vr"
(^. screen . room . title) "Gymnasium due"
it "lock dissipates" $
ng "test/records/lock-away.vr"
(^. screen . room . title) "Gymnasium uno"
-- star/lock interaction
it "Can open lock from another room" $
ng "test/records/star-lock-away.vr"
(^. screen . room . title) "Gymnasium uno"
it "stars are collectible only once" $
ng "test/records/star-collect.vr"
(^. screen . room . title) "Gymnasium due"
it "stars are collectible only once (meeple)" $
ng "test/records/star-collect-meeple.vr"
(^. stars) 0
-- nettle
it "Nettle kills you" $
ng "test/records/nettle-kills.vr"
(^. screen . room . title) "Gymnasium uno"
it "Nettle kills you not when sleeping" $
ng "test/records/nettle-kills-not.vr"
(^. screen . room . title) "Gymnasium sei"
-- witch
it "kills player" $
ng "test/records/witch-kill.vr"
(^. screen . room . title) "Gymnasium uno"
it "floats through obstacles" $
ng "test/records/witch-spirit.vr"
(^. screen . room . title) "Gymnasium uno"