1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
{-# LANGUAGE DeriveGeneric #-}
-- | Basic types for content definitions.
module Game.LambdaHack.Definition.Defs
( GroupName, displayGroupName
, ContentId, contentIdIndex
, ContentSymbol, displayContentSymbol
, X, Y
, Freqs, renameFreqs
, Rarity, linearInterpolation
, CStore(..), ppCStore, ppCStoreIn, verbCStore
, SLore(..), ItemDialogMode(..), ppSLore, headingSLore
, ppItemDialogMode, ppItemDialogModeIn, ppItemDialogModeFrom, loreFromMode
, Direction(..)
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Control.DeepSeq
import Data.Binary
import GHC.Generics (Generic)
import Game.LambdaHack.Definition.DefsInternal
-- | X spacial dimension for points and vectors.
type X = Int
-- | Y xpacial dimension for points and vectors.
type Y = Int
-- | For each group that the kind belongs to, denoted by a @GroupName@
-- in the first component of a pair, the second component of a pair shows
-- how common the kind is within the group.
type Freqs c = [(GroupName c, Int)]
renameFreqs :: (Text -> Text) -> Freqs c -> Freqs c
renameFreqs f = map (first (GroupName . f . fromGroupName))
-- | Rarity on given depths. The first element of the pair is normally
-- in (0, 10] interval and, e.g., if there are 20 levels, 0.5 represents
-- the first level and 10 the last. Exceptionally, it may be larger than 10,
-- meaning appearance in the dungeon is not possible under normal circumstances
-- and the value remains constant above the interval bound.
type Rarity = [(Double, Int)]
-- We assume depths are greater or equal to one and the rarity @dataset@
-- is non-empty, sorted and the first elements of the pairs are positive.
-- The convention for adding implicit outer intervals is that
-- the value increases linearly, starting from 0 at 0. Similarly,
-- if the last interval ends before 10, the value drops linearly,
-- in a way that would reach 0 a step after 10, but staying constant
-- from 10 onward. If the last interval ends after 10, the value stays constant
-- after the interval's upper bound.
--
-- Note that rarity [(1, 1)] means constant value 1 only thanks to @ceiling@.
-- OTOH, [(1, 10)] is not equivalent to [(10/150, 10)] in a 150-deep dungeon,
-- since its value at the first level is drastically lower. This only
-- matters if content creators mix the two notations, so care must be taken
-- in such cases. Otherwise, for any given level, all kinds scale consistently
-- and the simpler notation just paintes the dungeon in larger strokes.
linearInterpolation :: Int -> Int -> Rarity -> Int
linearInterpolation !levelDepthInt !totalDepthInt !dataset =
let levelDepth10 = intToDouble $ levelDepthInt * 10
totalDepth = intToDouble totalDepthInt
findInterval :: (Double, Int) -> Rarity -> ((Double, Int), (Double, Int))
findInterval x1y1@(x1Last, y1Last) [] = -- we are past the last interval
let stepLevel = 10 / totalDepth
-- this is the distance representing one level, the same
-- as the distance from 0 to the representation of level 1
yConstant = if x1Last >= 10
then y1Last
else ceiling (intToDouble y1Last * stepLevel
/ (10 + stepLevel - x1Last))
-- this is the value of the interpolation formula at the end
-- with y2 == 0, levelDepth10 == totalDepth * 10,
-- and x2 == 10 + stepLevel
in if levelDepthInt > totalDepthInt -- value stays constant
then ((x1Last, yConstant), (x1Last + 1, yConstant))
-- this artificial interval is enough to emulate
-- the value staying constant indefinitely
else (x1y1, (10 + stepLevel, 0))
findInterval !x1y1 ((!x, !y) : rest) =
if levelDepth10 <= x * totalDepth
then (x1y1, (x, y))
else findInterval (x, y) rest
((x1, y1), (x2, y2)) = findInterval (0, 0) dataset
in y1 + ceiling
(intToDouble (y2 - y1) * (levelDepth10 - x1 * totalDepth)
/ ((x2 - x1) * totalDepth))
-- | Actor's item stores.
data CStore =
CGround
| COrgan
| CEqp
| CStash
deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)
instance Binary CStore
instance NFData CStore
ppCStore :: CStore -> (Text, Text)
ppCStore CGround = ("on", "the ground")
ppCStore COrgan = ("in", "body")
ppCStore CEqp = ("in", "equipment outfit")
ppCStore CStash = ("in", "shared inventory stash")
ppCStoreIn :: CStore -> Text
ppCStoreIn c = let (tIn, t) = ppCStore c in tIn <+> t
verbCStore :: CStore -> Text
verbCStore CGround = "remove"
verbCStore COrgan = "implant"
verbCStore CEqp = "equip"
verbCStore CStash = "stash"
-- | Item slot and lore categories.
data SLore =
SItem
| SOrgan
| STrunk
| SCondition
| SBlast
| SEmbed
| SBody -- contains the sum of @SOrgan@, @STrunk@ and @SCondition@
-- but only present in the current pointman's body
deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)
instance Binary SLore
instance NFData SLore
data ItemDialogMode =
MStore CStore -- ^ a leader's store
| MOwned -- ^ all party's items
| MSkills -- ^ not items, but determined by leader's items
| MLore SLore -- ^ not party's items, but all known generalized items
| MPlaces -- ^ places; not items at all, but definitely a lore
| MFactions -- ^ factions in this game, with some data from previous
| MModes -- ^ scenarios; not items at all, but definitely a lore
deriving (Show, Read, Eq, Ord, Generic)
instance NFData ItemDialogMode
instance Binary ItemDialogMode
ppSLore :: SLore -> Text
ppSLore SItem = "item"
ppSLore SOrgan = "organ"
ppSLore STrunk = "creature"
ppSLore SCondition = "condition"
ppSLore SBlast = "blast"
ppSLore SEmbed = "terrain"
ppSLore SBody = "body"
headingSLore :: SLore -> Text
headingSLore SItem = "miscellaneous item"
headingSLore SOrgan = "vital anatomic organ"
headingSLore STrunk = "autonomous entity"
headingSLore SCondition = "momentary bodily condition"
headingSLore SBlast = "explosion blast particle"
headingSLore SEmbed = "landmark feature"
headingSLore SBody = "body part"
ppItemDialogMode :: ItemDialogMode -> (Text, Text)
ppItemDialogMode (MStore cstore) = ppCStore cstore
ppItemDialogMode MOwned = ("among", "our total team belongings")
ppItemDialogMode MSkills = ("among", "skills")
ppItemDialogMode (MLore SBody) = ("in", "body")
ppItemDialogMode (MLore slore) = ("among", ppSLore slore <+> "lore")
ppItemDialogMode MPlaces = ("among", "place lore")
ppItemDialogMode MFactions = ("among", "faction lore")
ppItemDialogMode MModes = ("among", "adventure lore")
ppItemDialogModeIn :: ItemDialogMode -> Text
ppItemDialogModeIn c = let (tIn, t) = ppItemDialogMode c in tIn <+> t
ppItemDialogModeFrom :: ItemDialogMode -> Text
ppItemDialogModeFrom c = let (_tIn, t) = ppItemDialogMode c in "from" <+> t
loreFromMode :: ItemDialogMode -> SLore
loreFromMode c = case c of
MStore COrgan -> SOrgan
MStore _ -> SItem
MOwned -> SItem
MSkills -> undefined -- artificial slots
MLore slore -> slore
MPlaces -> undefined -- artificial slots
MFactions -> undefined -- artificial slots
MModes -> undefined -- artificial slots
data Direction = Forward | Backward
deriving (Show, Read, Eq, Ord, Generic)
instance NFData Direction
instance Binary Direction
|
