feat(gs/xanthous): Allow throwing rocks
Implement a first pass at a "fire" command, which allows throwing rocks, the max distance and the damage of which is based on the weight of the item and the strength of the player. Currently the actual numbers here likely need some tweaking, as the rocks are easily throwable at good distances but don't really deal any damage. Change-Id: Ic6ad0599444af44d8438b834237a1997b67f220f Reviewed-on: https://cl.tvl.fyi/c/depot/+/3764 Reviewed-by: grfn <grfn@gws.fyi> Tested-by: BuildkiteCI
This commit is contained in:
Griffin Smith
grfn
parent
352c75630d
commit
61802fe106
15 changed files with 450 additions and 87 deletions
|
|
@ -34,7 +34,7 @@ import Xanthous.Data
|
|||
, position
|
||||
, Position
|
||||
, (|*|)
|
||||
, Tiles(..)
|
||||
, Tiles(..), Hitpoints, fromScalar
|
||||
)
|
||||
import Xanthous.Data.App (ResourceName, Panel(..), AppEvent(..))
|
||||
import qualified Xanthous.Data.EntityMap as EntityMap
|
||||
|
|
@ -45,15 +45,18 @@ import Xanthous.Game
|
|||
import Xanthous.Game.State
|
||||
import Xanthous.Game.Env
|
||||
import Xanthous.Game.Draw (drawGame)
|
||||
import Xanthous.Game.Prompt
|
||||
import Xanthous.Game.Prompt hiding (Fire)
|
||||
import qualified Xanthous.Messages as Messages
|
||||
import Xanthous.Random
|
||||
import Xanthous.Util (removeVectorIndex)
|
||||
import Xanthous.Util.Inflection (toSentence)
|
||||
import Xanthous.Physics (throwDistance, bluntThrowDamage)
|
||||
import Xanthous.Data.EntityMap.Graphics (lineOfSight)
|
||||
import Xanthous.Data.EntityMap (EntityID)
|
||||
--------------------------------------------------------------------------------
|
||||
import qualified Xanthous.Entities.Character as Character
|
||||
import Xanthous.Entities.Character hiding (pickUpItem)
|
||||
import Xanthous.Entities.Item (Item)
|
||||
import Xanthous.Entities.Item (Item, weight)
|
||||
import qualified Xanthous.Entities.Item as Item
|
||||
import Xanthous.Entities.Creature (Creature)
|
||||
import qualified Xanthous.Entities.Creature as Creature
|
||||
|
|
@ -292,6 +295,43 @@ handleCommand Wield = do
|
|||
say ["wield", "wielded"] item
|
||||
continue
|
||||
|
||||
handleCommand Fire = do
|
||||
selectItemFromInventory_ ["fire", "menu"] Cancellable id
|
||||
(say_ ["fire", "nothing"])
|
||||
$ \(MenuResult (invPos, item)) ->
|
||||
let wt = weight item
|
||||
dist = throwDistance wt
|
||||
dam = bluntThrowDamage wt
|
||||
in if dist < fromScalar 1
|
||||
then say_ ["fire", "zeroRange"]
|
||||
else firePrompt_ ["fire", "target"] Cancellable dist $
|
||||
\(FireResult targetPos) -> do
|
||||
charPos <- use characterPosition
|
||||
mTarget <- uses entities $ firstEnemy . lineOfSight charPos targetPos
|
||||
case mTarget of
|
||||
Just target -> do
|
||||
creature' <- damageCreature target dam
|
||||
unless (Creature.isDead creature') $
|
||||
let msgPath = ["fire", "fired"] <> [if dam == 0
|
||||
then "noDamage"
|
||||
else "someDamage"]
|
||||
in say msgPath $ object [ "item" A..= item
|
||||
, "creature" A..= creature'
|
||||
]
|
||||
Nothing ->
|
||||
say ["fire", "fired", "noTarget"] $ object [ "item" A..= item ]
|
||||
character . inventory %= removeItemFromPosition invPos item
|
||||
entities . EntityMap.atPosition targetPos %= (SomeEntity item <|)
|
||||
stepGame -- TODO(grfn): should this be based on distance?
|
||||
continue
|
||||
where
|
||||
firstEnemy
|
||||
:: [(Position, Vector (EntityID, SomeEntity))]
|
||||
-> Maybe (EntityID, Creature)
|
||||
firstEnemy los =
|
||||
let enemies = los >>= \(_, es) -> toList $ headMay es
|
||||
in enemies ^? folded . below _SomeEntity
|
||||
|
||||
handleCommand Save = do
|
||||
-- TODO default save locations / config file?
|
||||
prompt_ @'StringPrompt ["save", "location"] Cancellable
|
||||
|
|
@ -364,22 +404,14 @@ attackAt pos =
|
|||
menu_ ["combat", "menu"] Cancellable (entityMenu_ creatures)
|
||||
$ \(MenuResult creature) -> attackCreature creature
|
||||
where
|
||||
attackCreature (creatureID, creature) = do
|
||||
attackCreature creature = do
|
||||
charDamage <- uses character characterDamage
|
||||
let creature' = Creature.damage charDamage creature
|
||||
msgParams = object ["creature" A..= creature']
|
||||
if Creature.isDead creature'
|
||||
then do
|
||||
say ["combat", "killed"] msgParams
|
||||
entities . at creatureID .= Nothing
|
||||
else do
|
||||
msg <- uses character getAttackMessage
|
||||
message msg msgParams
|
||||
entities . ix creatureID . positioned .= SomeEntity creature'
|
||||
|
||||
creature' <- damageCreature creature charDamage
|
||||
msg <- uses character getAttackMessage
|
||||
unless (Creature.isDead creature')
|
||||
. message msg $ object ["creature" A..= creature']
|
||||
whenM (uses character $ isNothing . weapon) handleFists
|
||||
|
||||
stepGame -- TODO
|
||||
stepGame
|
||||
weapon chr = chr ^? inventory . wielded . wieldedItems . wieldableItem
|
||||
getAttackMessage chr =
|
||||
case weapon chr of
|
||||
|
|
@ -399,6 +431,18 @@ attackAt pos =
|
|||
character %= Character.damage damageAmount
|
||||
character . body . knuckles %= damageKnuckles
|
||||
|
||||
damageCreature :: (EntityID, Creature) -> Hitpoints -> AppM Creature
|
||||
damageCreature (creatureID, creature) dam = do
|
||||
let creature' = Creature.damage dam creature
|
||||
msgParams = object ["creature" A..= creature']
|
||||
if Creature.isDead creature'
|
||||
then do
|
||||
say ["combat", "killed"] msgParams
|
||||
entities . at creatureID .= Nothing
|
||||
else entities . ix creatureID . positioned .= SomeEntity creature'
|
||||
pure creature'
|
||||
|
||||
|
||||
entityMenu_
|
||||
:: (Comonad w, Entity entity)
|
||||
=> [w entity]
|
||||
|
|
|
|||
|
|
@ -9,6 +9,7 @@ module Xanthous.App.Prompt
|
|||
, confirm
|
||||
, menu
|
||||
, menu_
|
||||
, firePrompt_
|
||||
) where
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Prelude
|
||||
|
|
@ -17,15 +18,19 @@ import Brick (BrickEvent(..), Next)
|
|||
import Brick.Widgets.Edit (handleEditorEvent)
|
||||
import Data.Aeson (ToJSON, object)
|
||||
import Graphics.Vty.Input.Events (Event(EvKey), Key(..))
|
||||
import GHC.TypeLits (ErrorMessage(..))
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.App.Common
|
||||
import Xanthous.Data (move)
|
||||
import Xanthous.Data (move, Tiles, Position, positioned, _Position)
|
||||
import qualified Xanthous.Data as Data
|
||||
import Xanthous.Command (directionFromChar)
|
||||
import Xanthous.Data.App (ResourceName, AppEvent)
|
||||
import Xanthous.Game.Prompt
|
||||
import Xanthous.Game.State
|
||||
import qualified Xanthous.Messages as Messages
|
||||
import qualified Xanthous.Data.EntityMap as EntityMap
|
||||
import Xanthous.Entities.Creature (creatureType)
|
||||
import Xanthous.Entities.RawTypes (hostile)
|
||||
import qualified Linear.Metric as Metric
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
handlePromptEvent
|
||||
|
|
@ -76,6 +81,17 @@ handlePromptEvent
|
|||
>> continue
|
||||
handlePromptEvent _ (Prompt _ SPointOnMap _ _ _) _ = continue
|
||||
|
||||
handlePromptEvent
|
||||
msg
|
||||
(Prompt c SFire (FirePromptState pos) pri@(origin, range) cb)
|
||||
(VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) []))
|
||||
= do
|
||||
let pos' = move dir pos
|
||||
prompt' = Prompt c SFire (FirePromptState pos') pri cb
|
||||
when (Data.distance origin pos' <= range) $
|
||||
promptState .= WaitingPrompt msg prompt'
|
||||
continue
|
||||
|
||||
handlePromptEvent
|
||||
_
|
||||
(Prompt Cancellable _ _ _ _)
|
||||
|
|
@ -86,19 +102,15 @@ handlePromptEvent _ _ _ = continue
|
|||
clearPrompt :: AppM ()
|
||||
clearPrompt = promptState .= NoPrompt
|
||||
|
||||
class NotMenu (pt :: PromptType)
|
||||
instance NotMenu 'StringPrompt
|
||||
instance NotMenu 'Confirm
|
||||
instance NotMenu 'DirectionPrompt
|
||||
instance NotMenu 'PointOnMap
|
||||
instance NotMenu 'Continue
|
||||
instance TypeError ('Text "Cannot use `prompt` or `prompt_` for menu prompts"
|
||||
':$$: 'Text "Use `menu` or `menu_` instead")
|
||||
=> NotMenu ('Menu a)
|
||||
type PromptParams :: PromptType -> Type
|
||||
type family PromptParams pt where
|
||||
PromptParams ('Menu a) = Map Char (MenuOption a) -- Menu items
|
||||
PromptParams 'Fire = Tiles -- Range
|
||||
PromptParams _ = ()
|
||||
|
||||
prompt
|
||||
:: forall (pt :: PromptType) (params :: Type).
|
||||
(ToJSON params, SingPromptType pt, NotMenu pt)
|
||||
(ToJSON params, SingPromptType pt, PromptParams pt ~ ())
|
||||
=> [Text] -- ^ Message key
|
||||
-> params -- ^ Message params
|
||||
-> PromptCancellable
|
||||
|
|
@ -107,20 +119,19 @@ prompt
|
|||
prompt msgPath params cancellable cb = do
|
||||
let pt = singPromptType @pt
|
||||
msg <- Messages.message msgPath params
|
||||
p <- case pt of
|
||||
mp :: Maybe (Prompt AppM) <- case pt of
|
||||
SPointOnMap -> do
|
||||
charPos <- use characterPosition
|
||||
pure $ mkPointOnMapPrompt cancellable charPos cb
|
||||
SStringPrompt -> pure $ mkPrompt cancellable pt cb
|
||||
SConfirm -> pure $ mkPrompt cancellable pt cb
|
||||
SDirectionPrompt -> pure $ mkPrompt cancellable pt cb
|
||||
SContinue -> pure $ mkPrompt cancellable pt cb
|
||||
SMenu -> error "unreachable"
|
||||
promptState .= WaitingPrompt msg p
|
||||
pure . Just $ mkPointOnMapPrompt cancellable charPos cb
|
||||
SStringPrompt -> pure . Just $ mkPrompt cancellable pt cb
|
||||
SConfirm -> pure . Just $ mkPrompt cancellable pt cb
|
||||
SDirectionPrompt -> pure . Just $ mkPrompt cancellable pt cb
|
||||
SContinue -> pure . Just $ mkPrompt cancellable pt cb
|
||||
for_ mp $ \p -> promptState .= WaitingPrompt msg p
|
||||
|
||||
prompt_
|
||||
:: forall (pt :: PromptType).
|
||||
(SingPromptType pt, NotMenu pt)
|
||||
(SingPromptType pt, PromptParams pt ~ ())
|
||||
=> [Text] -- ^ Message key
|
||||
-> PromptCancellable
|
||||
-> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler
|
||||
|
|
@ -159,3 +170,36 @@ menu_ :: forall (a :: Type).
|
|||
-> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler
|
||||
-> AppM ()
|
||||
menu_ msgPath = menu msgPath $ object []
|
||||
|
||||
firePrompt_
|
||||
:: [Text] -- ^ Message key
|
||||
-> PromptCancellable
|
||||
-> Tiles -- ^ Range
|
||||
-> (PromptResult 'Fire -> AppM ()) -- ^ Promise handler
|
||||
-> AppM ()
|
||||
firePrompt_ msgPath cancellable range cb = do
|
||||
msg <- Messages.message msgPath $ object []
|
||||
initialPos <- maybe (use characterPosition) pure =<< nearestEnemyPosition
|
||||
let p = mkFirePrompt cancellable initialPos range cb
|
||||
promptState .= WaitingPrompt msg p
|
||||
|
||||
-- | Returns the position of the nearest visible hostile creature, if any
|
||||
nearestEnemyPosition :: AppM (Maybe Position)
|
||||
nearestEnemyPosition = do
|
||||
charPos <- use characterPosition
|
||||
em <- use entities
|
||||
ps <- characterVisiblePositions
|
||||
let candidates = toList ps >>= \p ->
|
||||
let ents = EntityMap.atPositionWithIDs p em
|
||||
in ents
|
||||
^.. folded
|
||||
. _2
|
||||
. positioned
|
||||
. _SomeEntity
|
||||
. creatureType
|
||||
. filtered (view hostile)
|
||||
. to (const (distance charPos p, p))
|
||||
pure . headMay . fmap snd $ sortOn fst candidates
|
||||
where
|
||||
distance :: Position -> Position -> Double
|
||||
distance = Metric.distance `on` (fmap fromIntegral . view _Position)
|
||||
|
|
|
|||
|
|
@ -26,6 +26,7 @@ data Command
|
|||
| ShowInventory
|
||||
| DescribeInventory
|
||||
| Wield
|
||||
| Fire
|
||||
| GoUp
|
||||
| GoDown
|
||||
| Rest
|
||||
|
|
@ -53,6 +54,7 @@ commandFromKey (KChar 'r') [] = Just Read
|
|||
commandFromKey (KChar 'i') [] = Just ShowInventory
|
||||
commandFromKey (KChar 'I') [] = Just DescribeInventory
|
||||
commandFromKey (KChar 'w') [] = Just Wield
|
||||
commandFromKey (KChar 'f') [] = Just Fire
|
||||
commandFromKey (KChar '<') [] = Just GoUp
|
||||
commandFromKey (KChar '>') [] = Just GoDown
|
||||
commandFromKey (KChar 'R') [] = Just Rest
|
||||
|
|
|
|||
|
|
@ -8,10 +8,9 @@
|
|||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE QuantifiedConstraints #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Common data types for Xanthous
|
||||
--------------------------------------------------------------------------------
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
-- | Common data types for Xanthous ------------------------------------------------------------------------------
|
||||
module Xanthous.Data
|
||||
( Opposite(..)
|
||||
|
||||
|
|
@ -34,6 +33,7 @@ module Xanthous.Data
|
|||
, diffPositions
|
||||
, stepTowards
|
||||
, isUnit
|
||||
, distance
|
||||
|
||||
-- * Boxes
|
||||
, Box(..)
|
||||
|
|
@ -47,20 +47,29 @@ module Xanthous.Data
|
|||
, boxEdge
|
||||
, module Linear.V2
|
||||
|
||||
-- *
|
||||
-- * Unit math
|
||||
, Scalar(..)
|
||||
, Per(..)
|
||||
, invertRate
|
||||
, invertedRate
|
||||
, (|+|)
|
||||
, (|*|)
|
||||
, (|/|)
|
||||
, (:+:)
|
||||
, (:*:)
|
||||
, (:/:)
|
||||
, (:**:)(..)
|
||||
, Ticks(..)
|
||||
, Tiles(..)
|
||||
, TicksPerTile
|
||||
, TilesPerTick
|
||||
, timesTiles
|
||||
, Square(..)
|
||||
, squared
|
||||
, Cubic(..)
|
||||
, Grams
|
||||
, Meters
|
||||
, Uno(..)
|
||||
, Unit(..)
|
||||
, UnitSymbol(..)
|
||||
|
||||
|
|
@ -125,6 +134,7 @@ import Xanthous.Util (EqEqProp(..), EqProp, between)
|
|||
import Xanthous.Util.QuickCheck (GenericArbitrary(..))
|
||||
import Xanthous.Orphans ()
|
||||
import Xanthous.Util.Graphics
|
||||
import qualified Linear.Metric as Metric
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | opposite ∘ opposite ≡ id
|
||||
|
|
@ -246,7 +256,7 @@ loc = iso hither yon
|
|||
_Position :: Iso' (Position' a) (V2 a)
|
||||
_Position = iso hither yon
|
||||
where
|
||||
hither (Position px py) = (V2 px py)
|
||||
hither (Position px py) = V2 px py
|
||||
yon (V2 lx ly) = Position lx ly
|
||||
|
||||
positionFromPair :: (Num a, Integral i, Integral j) => (i, j) -> Position' a
|
||||
|
|
@ -531,11 +541,28 @@ invertRate (Rate p) = Rate $ 1 / p
|
|||
invertedRate :: Iso (a `Per` b) (b' `Per` a') (b `Per` a) (a' `Per` b')
|
||||
invertedRate = iso invertRate invertRate
|
||||
|
||||
type (:+:) :: Type -> Type -> Type
|
||||
type family (:+:) a b where
|
||||
a :+: a = a
|
||||
a :+: (Uno b) = a
|
||||
|
||||
infixl 6 |+|
|
||||
class AddUnit a b where
|
||||
(|+|) :: a -> b -> a :+: b
|
||||
|
||||
instance Scalar a => AddUnit a a where
|
||||
x' |+| y' = fromScalar $ scalar x' + scalar y'
|
||||
|
||||
instance (Scalar a, Scalar b) => AddUnit a (Uno b) where
|
||||
x' |+| y' = fromScalar $ scalar x' + scalar y'
|
||||
|
||||
type (:*:) :: Type -> Type -> Type
|
||||
type family (:*:) a b where
|
||||
(a `Per` b) :*: b = a
|
||||
(Square a) :*: a = Cubic a
|
||||
a :*: a = Square a
|
||||
(a `Per` b) :*: b = a
|
||||
(Square a) :*: a = Cubic a
|
||||
a :*: a = Square a
|
||||
a :*: Uno b = a
|
||||
a :*: b = a :**: b
|
||||
|
||||
infixl 7 |*|
|
||||
class MulUnit a b where
|
||||
|
|
@ -550,6 +577,58 @@ instance forall a. (Scalar a, a :*: a ~ Square a) => MulUnit a a where
|
|||
instance forall a. (Scalar a) => MulUnit (Square a) a where
|
||||
x' |*| y' = Cubic @a . fromScalar $ scalar x' * scalar y'
|
||||
|
||||
instance {-# INCOHERENT #-} forall a b.
|
||||
(Scalar a, Scalar b, Scalar (a :*: Uno b))
|
||||
=> MulUnit a (Uno b) where
|
||||
x' |*| y' = fromScalar $ scalar x' * scalar y'
|
||||
|
||||
type (:/:) :: Type -> Type -> Type
|
||||
type family (:/:) a b where
|
||||
(Square a) :/: a = a
|
||||
(Cubic a) :/: a = Square a
|
||||
(Cubic a) :/: (Square a) = a
|
||||
(a :**: b) :/: b = a
|
||||
(a :**: b) :/: a = b
|
||||
a :/: Uno b = a
|
||||
a :/: b = a `Per` b
|
||||
|
||||
infixl 7 |/|
|
||||
class DivUnit a b where
|
||||
(|/|) :: a -> b -> a :/: b
|
||||
|
||||
instance Scalar a => DivUnit (Square a) a where
|
||||
(Square a) |/| b = fromScalar $ scalar a / scalar b
|
||||
|
||||
instance Scalar a => DivUnit (Cubic a) a where
|
||||
(Cubic a) |/| b = fromScalar $ scalar a / scalar b
|
||||
|
||||
instance (Scalar a, Cubic a :/: Square a ~ a)
|
||||
=> DivUnit (Cubic a) (Square a) where
|
||||
(Cubic a) |/| (Square b) = fromScalar $ scalar a / scalar b
|
||||
|
||||
instance (Scalar a, Scalar b) => DivUnit (a :**: b) b where
|
||||
(Times a) |/| b = fromScalar $ scalar a / scalar b
|
||||
|
||||
instance (Scalar a, Scalar b) => DivUnit (a :**: b) a where
|
||||
(Times a) |/| b = fromScalar $ scalar a / scalar b
|
||||
|
||||
instance {-# INCOHERENT #-} forall a b.
|
||||
(Scalar a, Scalar b, Scalar (a :/: Uno b))
|
||||
=> DivUnit a (Uno b) where
|
||||
x' |/| y' = fromScalar $ scalar x' / scalar y'
|
||||
|
||||
-- | Dimensionless quantitites (mass per unit mass, radians, etc)
|
||||
--
|
||||
-- see <https://en.wikipedia.org/wiki/Parts-per_notation#Uno>
|
||||
newtype Uno a = Uno a
|
||||
deriving stock (Eq, Generic)
|
||||
deriving anyclass (NFData, CoArbitrary, Function)
|
||||
deriving ( Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON
|
||||
, Scalar, Show
|
||||
)
|
||||
via a
|
||||
deriving Unit via UnitSymbol "" (Uno a)
|
||||
|
||||
newtype Square a = Square a
|
||||
deriving stock (Eq, Generic)
|
||||
deriving anyclass (NFData, CoArbitrary, Function)
|
||||
|
|
@ -569,6 +648,9 @@ instance Unit a => Unit (Square a) where
|
|||
instance Show a => Show (Square a) where
|
||||
show (Square n) = show n <> "²"
|
||||
|
||||
squared :: (Scalar a, a :*: a ~ Square a) => a -> Square a
|
||||
squared v = v |*| v
|
||||
|
||||
newtype Cubic a = Cubic a
|
||||
deriving stock (Eq, Generic)
|
||||
deriving anyclass (NFData, CoArbitrary, Function)
|
||||
|
|
@ -588,6 +670,21 @@ instance Unit a => Unit (Cubic a) where
|
|||
instance Show a => Show (Cubic a) where
|
||||
show (Cubic n) = show n <> "³"
|
||||
|
||||
newtype (:**:) a b = Times Double
|
||||
deriving stock (Eq, Generic)
|
||||
deriving anyclass (NFData, CoArbitrary, Function)
|
||||
deriving (Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON)
|
||||
via Double
|
||||
deriving (Semigroup, Monoid) via Sum Double
|
||||
deriving Show via ShowUnitSuffix (a :**: b) Double
|
||||
deriving via Double
|
||||
instance ( Distribution d Double
|
||||
, forall xx yy. Coercible xx yy => Coercible (d xx) (d yy)
|
||||
)
|
||||
=> Distribution d (a :**: b)
|
||||
|
||||
instance (Unit a, Unit b) => Unit (a :**: b) where
|
||||
unitSuffix = unitSuffix @a <> " " <> unitSuffix @b
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -626,12 +723,23 @@ type TilesPerTick = Tiles `Per` Ticks
|
|||
timesTiles :: TicksPerTile -> Tiles -> Ticks
|
||||
timesTiles = (|*|)
|
||||
|
||||
-- | Calculate the (cartesian) distance between two 'Position's, floored and
|
||||
-- represented as a number of 'Tile's
|
||||
--
|
||||
-- Note that this is imprecise, and may be different than the length of a
|
||||
-- bresenham's line between the points
|
||||
distance :: Position -> Position -> Tiles
|
||||
distance
|
||||
= (fromScalar .) . (Metric.distance `on` (fmap fromIntegral . view _Position))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
newtype Hitpoints = Hitpoints Word
|
||||
deriving stock (Eq, Generic)
|
||||
deriving anyclass (NFData, CoArbitrary, Function)
|
||||
deriving (Arbitrary, Num, Ord, Bounded, Enum, Integral, Real, ToJSON, FromJSON)
|
||||
deriving ( Arbitrary, Num, Ord, Bounded, Enum, Integral, Real, Scalar
|
||||
, ToJSON, FromJSON
|
||||
)
|
||||
via Word
|
||||
deriving (Semigroup, Monoid) via Sum Word
|
||||
deriving Unit via UnitSymbol "hp" Hitpoints
|
||||
|
|
|
|||
|
|
@ -20,6 +20,7 @@ module Xanthous.Data.EntityMap
|
|||
, positions
|
||||
, lookup
|
||||
, lookupWithPosition
|
||||
, positionOf
|
||||
-- , positionedEntities
|
||||
, neighbors
|
||||
, Deduplicate(..)
|
||||
|
|
@ -37,7 +38,7 @@ import Xanthous.Data
|
|||
, Positioned(..)
|
||||
, positioned
|
||||
, Neighbors(..)
|
||||
, neighborPositions
|
||||
, neighborPositions, position
|
||||
)
|
||||
import Xanthous.Data.VectorBag
|
||||
import Xanthous.Orphans ()
|
||||
|
|
@ -268,5 +269,9 @@ lookup eid = fmap (view positioned) . lookupWithPosition eid
|
|||
neighbors :: (Ord a, Show a) => Position -> EntityMap a -> Neighbors (VectorBag a)
|
||||
neighbors pos em = (\p -> view (atPosition p) em) <$> neighborPositions pos
|
||||
|
||||
-- | Traversal to the position of the entity with the given ID
|
||||
positionOf :: EntityID -> Traversal' (EntityMap a) Position
|
||||
positionOf eid = ix eid . position
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
makeWrapped ''Deduplicate
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
module Xanthous.Data.EntityMap.Graphics
|
||||
( visiblePositions
|
||||
, visibleEntities
|
||||
, lineOfSight
|
||||
, linesOfSight
|
||||
, canSee
|
||||
) where
|
||||
|
|
@ -27,27 +28,34 @@ visiblePositions
|
|||
visiblePositions pos radius
|
||||
= setFromList . positions . visibleEntities pos radius
|
||||
|
||||
-- | Returns a list of entities on the *line of sight* from the first position
|
||||
-- to the second position
|
||||
lineOfSight
|
||||
:: forall e. Entity e
|
||||
=> Position -- ^ Origin
|
||||
-> Position -- ^ Destination
|
||||
-> EntityMap e
|
||||
-> [(Position, Vector (EntityID, e))]
|
||||
lineOfSight (view _Position -> origin) (view _Position -> destination) em =
|
||||
takeWhileInclusive (none (view blocksVision . entityAttributes . snd) . snd)
|
||||
$ getPositionedAt <$> line origin destination
|
||||
where
|
||||
getPositionedAt :: V2 Int -> (Position, Vector (EntityID, e))
|
||||
getPositionedAt (review _Position -> p) =
|
||||
(p, over _2 (view positioned) <$> atPositionWithIDs p em)
|
||||
|
||||
-- | Returns a list of individual lines of sight, each of which is a list of
|
||||
-- entities at positions on that line of sight
|
||||
linesOfSight
|
||||
:: forall e. Entity e
|
||||
=> Position
|
||||
-> Word
|
||||
=> Position -- ^ Centerpoint
|
||||
-> Word -- ^ Radius
|
||||
-> EntityMap e
|
||||
-> [[(Position, Vector (EntityID, e))]]
|
||||
linesOfSight (view _Position -> pos) visionRadius em
|
||||
= entitiesOnLines
|
||||
<&> takeWhileInclusive
|
||||
(none (view blocksVision . entityAttributes . snd) . snd)
|
||||
linesOfSight pos visionRadius em =
|
||||
radius <&> \edge -> lineOfSight pos (_Position # edge) em
|
||||
where
|
||||
radius = circle pos $ fromIntegral visionRadius
|
||||
lines = line pos <$> radius
|
||||
entitiesOnLines :: [[(Position, Vector (EntityID, e))]]
|
||||
entitiesOnLines = lines <&> map getPositionedAt
|
||||
getPositionedAt :: V2 Int -> (Position, Vector (EntityID, e))
|
||||
getPositionedAt p =
|
||||
let ppos = _Position # p
|
||||
in (ppos, over _2 (view positioned) <$> atPositionWithIDs ppos em)
|
||||
radius = circle (pos ^. _Position) $ fromIntegral visionRadius
|
||||
|
||||
-- | Given a point and a radius of vision, returns a list of all entities that
|
||||
-- are *visible* (eg, not blocked by an entity that obscures vision) from that
|
||||
|
|
|
|||
10
users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml
Normal file
10
users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
Item:
|
||||
name: rock
|
||||
description: a rock
|
||||
longDescription: a medium-sized rock made out of some unknown stone
|
||||
char: .
|
||||
wieldable:
|
||||
damage: 1
|
||||
attackMessage: you hit the {{creature.creatureType.name}} in the head with your rock.
|
||||
density: [ 1500000, 2500000 ]
|
||||
volume: [ 0.000125, 0.001 ]
|
||||
|
|
@ -4,10 +4,13 @@ module Xanthous.Game.Draw
|
|||
) where
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Prelude
|
||||
--------------------------------------------------------------------------------
|
||||
import Brick hiding (loc, on)
|
||||
import Brick.Widgets.Border
|
||||
import Brick.Widgets.Border.Style
|
||||
import Brick.Widgets.Edit
|
||||
import Control.Monad.State.Lazy (evalState)
|
||||
import Control.Monad.State.Class ( get, MonadState, gets )
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Data
|
||||
import Xanthous.Data.App (ResourceName, Panel(..))
|
||||
|
|
@ -23,13 +26,11 @@ import Xanthous.Game
|
|||
)
|
||||
import Xanthous.Game.Prompt
|
||||
import Xanthous.Orphans ()
|
||||
import Control.Monad.State.Lazy (evalState)
|
||||
import Control.Monad.State.Class ( get, MonadState, gets )
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
cursorPosition :: GameState -> Widget ResourceName -> Widget ResourceName
|
||||
cursorPosition game
|
||||
| WaitingPrompt _ (Prompt _ SPointOnMap (PointOnMapPromptState pos) _ _)
|
||||
| WaitingPrompt _ (Prompt _ _ (preview promptStatePosition -> Just pos) _ _)
|
||||
<- game ^. promptState
|
||||
= showCursor Resource.Prompt (pos ^. loc)
|
||||
| otherwise
|
||||
|
|
@ -45,7 +46,6 @@ drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) =
|
|||
(SStringPrompt, StringPromptState edit, _) ->
|
||||
txtWrap msg <+> txt " " <+> renderEditor (txt . fold) True edit
|
||||
(SDirectionPrompt, DirectionPromptState, _) -> txtWrap msg
|
||||
(SContinue, _, _) -> txtWrap msg
|
||||
(SMenu, _, menuItems) ->
|
||||
txtWrap msg
|
||||
<=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE QuantifiedConstraints #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Xanthous.Game.Lenses
|
||||
( clearMemo
|
||||
|
|
|
|||
|
|
@ -1,8 +1,7 @@
|
|||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Xanthous.Game.Prompt
|
||||
( PromptType(..)
|
||||
|
|
@ -11,6 +10,7 @@ module Xanthous.Game.Prompt
|
|||
, PromptCancellable(..)
|
||||
, PromptResult(..)
|
||||
, PromptState(..)
|
||||
, promptStatePosition
|
||||
, MenuOption(..)
|
||||
, mkMenuItems
|
||||
, PromptInput
|
||||
|
|
@ -18,19 +18,19 @@ module Xanthous.Game.Prompt
|
|||
, mkPrompt
|
||||
, mkMenu
|
||||
, mkPointOnMapPrompt
|
||||
, mkFirePrompt
|
||||
, isCancellable
|
||||
, submitPrompt
|
||||
) where
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Prelude
|
||||
import Xanthous.Prelude
|
||||
--------------------------------------------------------------------------------
|
||||
import Brick.Widgets.Edit (Editor, editorText, getEditContents)
|
||||
import Test.QuickCheck
|
||||
import Test.QuickCheck.Arbitrary.Generic
|
||||
--------------------------------------------------------------------------------
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Util (smallestNotIn, AlphaChar (..))
|
||||
import Xanthous.Data (Direction, Position)
|
||||
import Xanthous.Data (Direction, Position, Tiles)
|
||||
import Xanthous.Data.App (ResourceName)
|
||||
import qualified Xanthous.Data.App as Resource
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -41,6 +41,9 @@ data PromptType where
|
|||
Menu :: Type -> PromptType
|
||||
DirectionPrompt :: PromptType
|
||||
PointOnMap :: PromptType
|
||||
-- | Throw an item or fire a projectile weapon. Prompt is to select the
|
||||
-- direction
|
||||
Fire :: PromptType
|
||||
Continue :: PromptType
|
||||
deriving stock (Generic)
|
||||
|
||||
|
|
@ -51,14 +54,16 @@ instance Show PromptType where
|
|||
show DirectionPrompt = "DirectionPrompt"
|
||||
show PointOnMap = "PointOnMap"
|
||||
show Continue = "Continue"
|
||||
show Fire = "Fire"
|
||||
|
||||
data SPromptType :: PromptType -> Type where
|
||||
SStringPrompt :: SPromptType 'StringPrompt
|
||||
SConfirm :: SPromptType 'Confirm
|
||||
SMenu :: SPromptType ('Menu a)
|
||||
SDirectionPrompt :: SPromptType 'DirectionPrompt
|
||||
SPointOnMap :: SPromptType 'PointOnMap
|
||||
SContinue :: SPromptType 'Continue
|
||||
SStringPrompt :: SPromptType 'StringPrompt
|
||||
SConfirm :: SPromptType 'Confirm
|
||||
SMenu :: SPromptType ('Menu a)
|
||||
SDirectionPrompt :: SPromptType 'DirectionPrompt
|
||||
SPointOnMap :: SPromptType 'PointOnMap
|
||||
SContinue :: SPromptType 'Continue
|
||||
SFire :: SPromptType 'Fire
|
||||
|
||||
instance NFData (SPromptType pt) where
|
||||
rnf SStringPrompt = ()
|
||||
|
|
@ -67,6 +72,7 @@ instance NFData (SPromptType pt) where
|
|||
rnf SDirectionPrompt = ()
|
||||
rnf SPointOnMap = ()
|
||||
rnf SContinue = ()
|
||||
rnf SFire = ()
|
||||
|
||||
class SingPromptType pt where singPromptType :: SPromptType pt
|
||||
instance SingPromptType 'StringPrompt where singPromptType = SStringPrompt
|
||||
|
|
@ -74,6 +80,7 @@ instance SingPromptType 'Confirm where singPromptType = SConfirm
|
|||
instance SingPromptType 'DirectionPrompt where singPromptType = SDirectionPrompt
|
||||
instance SingPromptType 'PointOnMap where singPromptType = SPointOnMap
|
||||
instance SingPromptType 'Continue where singPromptType = SContinue
|
||||
instance SingPromptType 'Fire where singPromptType = SFire
|
||||
|
||||
instance Show (SPromptType pt) where
|
||||
show SStringPrompt = "SStringPrompt"
|
||||
|
|
@ -82,6 +89,7 @@ instance Show (SPromptType pt) where
|
|||
show SDirectionPrompt = "SDirectionPrompt"
|
||||
show SPointOnMap = "SPointOnMap"
|
||||
show SContinue = "SContinue"
|
||||
show SFire = "SFire"
|
||||
|
||||
data PromptCancellable
|
||||
= Cancellable
|
||||
|
|
@ -98,6 +106,7 @@ data PromptResult (pt :: PromptType) where
|
|||
MenuResult :: forall a. a -> PromptResult ('Menu a)
|
||||
DirectionResult :: Direction -> PromptResult 'DirectionPrompt
|
||||
PointOnMapResult :: Position -> PromptResult 'PointOnMap
|
||||
FireResult :: Position -> PromptResult 'Fire
|
||||
ContinueResult :: PromptResult 'Continue
|
||||
|
||||
instance Arbitrary (PromptResult 'StringPrompt) where
|
||||
|
|
@ -118,6 +127,9 @@ instance Arbitrary (PromptResult 'PointOnMap) where
|
|||
instance Arbitrary (PromptResult 'Continue) where
|
||||
arbitrary = pure ContinueResult
|
||||
|
||||
instance Arbitrary (PromptResult 'Fire) where
|
||||
arbitrary = FireResult <$> arbitrary
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data PromptState pt where
|
||||
|
|
@ -128,6 +140,7 @@ data PromptState pt where
|
|||
ConfirmPromptState :: PromptState 'Confirm
|
||||
MenuPromptState :: forall a. PromptState ('Menu a)
|
||||
PointOnMapPromptState :: Position -> PromptState 'PointOnMap
|
||||
FirePromptState :: Position -> PromptState 'Fire
|
||||
|
||||
instance NFData (PromptState pt) where
|
||||
rnf sps@(StringPromptState ed) = sps `deepseq` ed `deepseq` ()
|
||||
|
|
@ -136,6 +149,7 @@ instance NFData (PromptState pt) where
|
|||
rnf ConfirmPromptState = ()
|
||||
rnf MenuPromptState = ()
|
||||
rnf pomps@(PointOnMapPromptState pos) = pomps `deepseq` pos `deepseq` ()
|
||||
rnf fps@(FirePromptState pos) = fps `deepseq` pos `deepseq` ()
|
||||
|
||||
instance Arbitrary (PromptState 'StringPrompt) where
|
||||
arbitrary = StringPromptState <$> arbitrary
|
||||
|
|
@ -149,6 +163,9 @@ instance Arbitrary (PromptState 'Continue) where
|
|||
instance Arbitrary (PromptState ('Menu a)) where
|
||||
arbitrary = pure MenuPromptState
|
||||
|
||||
instance Arbitrary (PromptState 'Fire) where
|
||||
arbitrary = FirePromptState <$> arbitrary
|
||||
|
||||
instance CoArbitrary (PromptState 'StringPrompt) where
|
||||
coarbitrary (StringPromptState ed) = coarbitrary ed
|
||||
|
||||
|
|
@ -161,8 +178,22 @@ instance CoArbitrary (PromptState 'Continue) where
|
|||
instance CoArbitrary (PromptState ('Menu a)) where
|
||||
coarbitrary MenuPromptState = coarbitrary ()
|
||||
|
||||
instance CoArbitrary (PromptState 'Fire) where
|
||||
coarbitrary (FirePromptState pos) = coarbitrary pos
|
||||
|
||||
deriving stock instance Show (PromptState pt)
|
||||
|
||||
-- | Traversal over the position for the prompt types with positions in their
|
||||
-- prompt state (currently 'Fire' and 'PointOnMap')
|
||||
promptStatePosition :: forall pt. Traversal' (PromptState pt) Position
|
||||
promptStatePosition _ ps@(StringPromptState _) = pure ps
|
||||
promptStatePosition _ DirectionPromptState = pure DirectionPromptState
|
||||
promptStatePosition _ ContinuePromptState = pure ContinuePromptState
|
||||
promptStatePosition _ ConfirmPromptState = pure ConfirmPromptState
|
||||
promptStatePosition _ MenuPromptState = pure MenuPromptState
|
||||
promptStatePosition f (PointOnMapPromptState p) = PointOnMapPromptState <$> f p
|
||||
promptStatePosition f (FirePromptState p) = FirePromptState <$> f p
|
||||
|
||||
data MenuOption a = MenuOption Text a
|
||||
deriving stock (Eq, Generic, Functor)
|
||||
deriving anyclass (NFData, CoArbitrary, Function)
|
||||
|
|
@ -184,8 +215,9 @@ instance Show (MenuOption a) where
|
|||
show (MenuOption m _) = show m
|
||||
|
||||
type family PromptInput (pt :: PromptType) :: Type where
|
||||
PromptInput ('Menu a) = Map Char (MenuOption a)
|
||||
PromptInput ('Menu a) = Map Char (MenuOption a)
|
||||
PromptInput 'PointOnMap = Position -- Character pos
|
||||
PromptInput 'Fire = (Position, Tiles) -- Nearest enemy, range
|
||||
PromptInput _ = ()
|
||||
|
||||
data Prompt (m :: Type -> Type) where
|
||||
|
|
@ -239,6 +271,8 @@ instance CoArbitrary (m ()) => CoArbitrary (Prompt m) where
|
|||
variant @Int 5 . coarbitrary (c, pri, cb)
|
||||
coarbitrary (Prompt c SContinue ps pri cb) =
|
||||
variant @Int 6 . coarbitrary (c, ps, pri, cb)
|
||||
coarbitrary (Prompt c SFire ps pri cb) =
|
||||
variant @Int 7 . coarbitrary (c, ps, pri, cb)
|
||||
|
||||
-- instance Function (Prompt m) where
|
||||
-- function = functionMap toTuple _fromTuple
|
||||
|
|
@ -246,7 +280,12 @@ instance CoArbitrary (m ()) => CoArbitrary (Prompt m) where
|
|||
-- toTuple (Prompt c pt ps pri cb) = (c, pt, ps, pri, cb)
|
||||
|
||||
|
||||
mkPrompt :: (PromptInput pt ~ ()) => PromptCancellable -> SPromptType pt -> (PromptResult pt -> m ()) -> Prompt m
|
||||
mkPrompt
|
||||
:: (PromptInput pt ~ ())
|
||||
=> PromptCancellable -- ^ Is the prompt cancellable or not?
|
||||
-> SPromptType pt -- ^ The type of the prompt
|
||||
-> (PromptResult pt -> m ()) -- ^ Function to call when the prompt is complete
|
||||
-> Prompt m
|
||||
mkPrompt c pt@SStringPrompt cb =
|
||||
let ps = StringPromptState $ editorText Resource.Prompt (Just 1) ""
|
||||
in Prompt c pt ps () cb
|
||||
|
|
@ -269,6 +308,14 @@ mkPointOnMapPrompt
|
|||
-> Prompt m
|
||||
mkPointOnMapPrompt c pos = Prompt c SPointOnMap (PointOnMapPromptState pos) pos
|
||||
|
||||
mkFirePrompt
|
||||
:: PromptCancellable
|
||||
-> Position -- ^ Initial position
|
||||
-> Tiles -- ^ Range
|
||||
-> (PromptResult 'Fire -> m ())
|
||||
-> Prompt m
|
||||
mkFirePrompt c pos range = Prompt c SFire (FirePromptState pos) (pos, range)
|
||||
|
||||
isCancellable :: Prompt m -> Bool
|
||||
isCancellable (Prompt Cancellable _ _ _ _) = True
|
||||
isCancellable (Prompt Uncancellable _ _ _ _) = False
|
||||
|
|
@ -288,3 +335,5 @@ submitPrompt (Prompt _ pt ps _ cb) =
|
|||
cb $ PointOnMapResult pos
|
||||
(SConfirm, ConfirmPromptState) ->
|
||||
cb $ ConfirmResult True
|
||||
(SFire, FirePromptState pos) ->
|
||||
cb $ FireResult pos
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ import Linear.Metric
|
|||
import qualified Options.Applicative as Opt
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Random
|
||||
import Xanthous.Data hiding (x, y, _x, _y, edges)
|
||||
import Xanthous.Data hiding (x, y, _x, _y, edges, distance)
|
||||
import Xanthous.Generators.Level.Util
|
||||
import Xanthous.Util.Graphics (delaunay, straightLine)
|
||||
import Xanthous.Util.Graph (mstSubGraph)
|
||||
|
|
|
|||
71
users/grfn/xanthous/src/Xanthous/Physics.hs
Normal file
71
users/grfn/xanthous/src/Xanthous/Physics.hs
Normal file
|
|
@ -0,0 +1,71 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Xanthous.Physics
|
||||
( throwDistance
|
||||
, bluntThrowDamage
|
||||
) where
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Prelude
|
||||
import Xanthous.Data
|
||||
( Meters
|
||||
, (:**:)(..)
|
||||
, Square
|
||||
, Grams
|
||||
, (|*|)
|
||||
, (|/|)
|
||||
, Hitpoints
|
||||
, Per (..)
|
||||
, squared
|
||||
, Uno(..), (|+|)
|
||||
)
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- university shotputter can put a 16 lb shot about 14 meters
|
||||
-- ≈ 7.25 kg 14 meters
|
||||
-- 14m = x / (7.25kg × y + z)²
|
||||
-- 14m = x / (7250g × y + z)²
|
||||
--
|
||||
-- we don't want to scale down too much:
|
||||
--
|
||||
-- 10 kg 10 meters
|
||||
-- = 10000 g 10 meters
|
||||
--
|
||||
-- 15 kg w meters
|
||||
-- = 15000 g w meters
|
||||
--
|
||||
-- 14m = x / (7250g × y + z)²
|
||||
-- 10m = x / (10000g × y + z)²
|
||||
-- wm = x / (15000g × y + z)²
|
||||
--
|
||||
-- w≈0.527301 ∧ y≈0.000212178 sqrt(x) ∧ z≈1.80555 sqrt(x) ∧ 22824.1 sqrt(x)!=0
|
||||
--
|
||||
-- x = 101500
|
||||
-- y = 0.0675979
|
||||
-- z = 575.231
|
||||
--
|
||||
|
||||
-- TODO make this dynamic
|
||||
strength :: Meters :**: Square Grams
|
||||
strength = Times 10150000
|
||||
|
||||
yCoeff :: Uno Double
|
||||
yCoeff = Uno 0.0675979
|
||||
|
||||
zCoeff :: Uno Double
|
||||
zCoeff = Uno 575.231
|
||||
|
||||
-- | Calculate the maximum distance an object with the given weight can be
|
||||
-- thrown
|
||||
throwDistance
|
||||
:: Grams -- ^ Weight of the object
|
||||
-> Meters -- ^ Max distance thrown
|
||||
throwDistance weight = strength |/| squared (weight |*| yCoeff |+| zCoeff)
|
||||
|
||||
-- | Returns the damage dealt by a blunt object with the given weight when
|
||||
-- thrown
|
||||
bluntThrowDamage
|
||||
:: Grams
|
||||
-> Hitpoints
|
||||
bluntThrowDamage weight = throwDamageRatio |*| weight
|
||||
where
|
||||
throwDamageRatio :: Hitpoints `Per` Grams
|
||||
throwDamageRatio = Rate $ 1 / 5000
|
||||
|
|
@ -126,7 +126,7 @@ line pa@(V2 xa ya) pb@(V2 xb yb)
|
|||
ystep = if y₁ < y₂ then 1 else -1
|
||||
go (xTemp, yTemp, err)
|
||||
| xTemp > x₂ = Nothing
|
||||
| otherwise = Just ((V2 xTemp yTemp), (xTemp + 1, newY, newError))
|
||||
| otherwise = Just (V2 xTemp yTemp, (xTemp + 1, newY, newError))
|
||||
where
|
||||
tempError = err + δy
|
||||
(newY, newError) = if (2 * tempError) >= δx
|
||||
|
|
@ -139,7 +139,6 @@ straightLine :: (Num i, Ord i) => V2 i -> V2 i -> [V2 i]
|
|||
straightLine pa@(V2 xa _) pb@(V2 _ yb) = line pa midpoint ++ line midpoint pb
|
||||
where midpoint = V2 xa yb
|
||||
|
||||
|
||||
delaunay
|
||||
:: (Ord n, Fractional n)
|
||||
=> NonEmpty (V2 n, p)
|
||||
|
|
|
|||
|
|
@ -115,6 +115,28 @@ wield:
|
|||
# TODO: use actual hands
|
||||
wielded : You wield the {{wieldedItem.itemType.name}} in your right hand.
|
||||
|
||||
fire:
|
||||
nothing:
|
||||
- You don't currently have anything you can throw
|
||||
- You don't have anything to throw
|
||||
zeroRange:
|
||||
- That item is too heavy to throw!
|
||||
- That's too heavy to throw
|
||||
- You're not strong enough to throw that any meaningful distance
|
||||
menu: What would you like to throw?
|
||||
target: Choose a target
|
||||
atRange:
|
||||
- It's too heavy for you to throw any further than this
|
||||
fired:
|
||||
noTarget:
|
||||
- You throw the {{item.itemType.name}} at the ground
|
||||
noDamage:
|
||||
- You throw the {{item.itemType.name}} at the {{creature.creatureType.name}}. It doesn't seem to care.
|
||||
- You throw the {{item.itemType.name}} at the {{creature.creatureType.name}}. It doesn't seem to do anything.
|
||||
- You throw the {{item.itemType.name}} at the {{creature.creatureType.name}}. It doesn't seem to hurt it.
|
||||
someDamage:
|
||||
- You throw the {{item.itemType.name}} at the {{creature.creatureType.name}}. It hits it on the head!.
|
||||
|
||||
drop:
|
||||
nothing: You aren't carrying anything
|
||||
menu: What would you like to drop?
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: c12ae4038a2e1f287de557b72b8493da05ccbf428e7ac7862349c46d241f342f
|
||||
-- hash: 2db6cb1320baa23f71c24dff106bf682fb21e38c602d57e7e99297ae6abdc772
|
||||
|
||||
name: xanthous
|
||||
version: 0.1.0.0
|
||||
|
|
@ -75,6 +75,7 @@ library
|
|||
Xanthous.Messages.Template
|
||||
Xanthous.Monad
|
||||
Xanthous.Orphans
|
||||
Xanthous.Physics
|
||||
Xanthous.Prelude
|
||||
Xanthous.Random
|
||||
Xanthous.Util
|
||||
|
|
|
|||
Loading…
Reference in a new issue