diff --git a/docs/cloverage/cc/journeyman/the_great_game/agent/agent.clj.html b/docs/cloverage/cc/journeyman/the_great_game/agent/agent.clj.html
new file mode 100644
index 0000000..cafc39e
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/agent/agent.clj.html
@@ -0,0 +1,143 @@
+
+
+
+ cc/journeyman/the_great_game/agent/agent.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.agent.agent
+
+
+ 002 "Anything in the game world with agency; primarily but not exclusively
+
+
+ 003 characters."
+
+
+ 004 (:require [cc.journeyman.the-great-game.objects.game-object :refer [ProtoObject]]
+
+
+ 005 [cc.journeyman.the-great-game.objects.container :refer [ProtoContainer]]))
+
+
+ 006
+
+
+ 007 ;;; hierarchy of needs probably gets implemented here
+
+
+ 008 ;;; I'm probably going to want to defprotocol stuff, to define the hierarchy
+
+
+ 009 ;;; of things in the gameworld; either that or drop to Java, wich I'd rather not do.
+
+
+ 010
+
+
+ 011 (defprotocol ProtoAgent
+
+
+ 012 "An object which can act in the world"
+
+
+ 013 (act
+
+
+ 014 [actor world circle]
+
+
+ 015 "Allow `actor` to do something in this `world`, in the context of this
+
+
+ 016 `circle`; return the new state of the actor if something was done, `nil`
+
+
+ 017 if nothing was done. Circle is expected to be one of
+
+
+ 018
+
+
+ 019 * `:active` - actors within visual/audible range of the player
+
+
+ 020 character;
+
+
+ 021 * `:pending` - actors not in the active circle, but sufficiently close
+
+
+ 022 to it that they may enter the active circle within a short period;
+
+
+ 023 * `:background` - actors who are active in the background in order to
+
+
+ 024 handle trade, news, et cetera;
+
+
+ 025 * `other` - actors who are not members of any other circle, although
+
+
+ 026 I'm not clear whether it would ever be appropriate to invoke an
+
+
+ 027 `act` method on them.
+
+
+ 028
+
+
+ 029 The `act` method *must not* have side effects; it must *only* return a
+
+
+ 030 new state. If the actor's intention is to seek to change the state of
+
+
+ 031 something else in the game world, it must add a representation of that
+
+
+ 032 intention to the sequence which will be returned by its
+
+
+ 033 `pending-intentions` method.")
+
+
+ 034 (pending-intentions
+
+
+ 035 [actor]
+
+
+ 036 "Returns a sequence of effects an actor intends, as a consequence of
+
+
+ 037 acting. The encoding of these is not yet defined."))
+
+
+ 038
+
+
+ 039 (defrecord Agent
+
+
+ 040 ;; "A default agent."
+
+
+ 041 [name craft home culture]
+
+
+ 042 ProtoObject
+
+
+ 043 ProtoContainer
+
+
+ 044 ProtoAgent
+
+
+ 045 )
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/buildings/rectangular.clj.html b/docs/cloverage/cc/journeyman/the_great_game/buildings/rectangular.clj.html
new file mode 100644
index 0000000..f276d7b
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/buildings/rectangular.clj.html
@@ -0,0 +1,548 @@
+
+
+
+ cc/journeyman/the_great_game/buildings/rectangular.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.buildings.rectangular
+
+
+ 002 "Build buildings with a generally rectangular floow plan.
+
+
+ 003
+
+
+ 004 ## Motivations
+
+
+ 005
+
+
+ 006 Right, the idea behind this namespace is many fold.
+
+
+ 007
+
+
+ 008 1. To establish the broad principle of genetic buildings, by creating a
+
+
+ 009 function which reproducibly creates reproducible buildings at specified
+
+
+ 010 locations, such that different buildings are credibly varied but a
+
+
+ 011 building at a specified location is always (modulo economic change) the
+
+
+ 012 same.
+
+
+ 013 2. Create good rectangular buildings, and investigate whether a single
+
+
+ 014 function can be used to create buildings of more than one family (e.g.
+
+
+ 015 can it produce flat roofed, north African style, mud brick houses as
+
+
+ 016 well as pitch roofed, half timbered northern European houses?)
+
+
+ 017 3. Establish whether, in my current state of fairly severe mental illness,
+
+
+ 018 I can actually produce any usable code at all.
+
+
+ 019
+
+
+ 020 ## Key factors in the creation of a building
+
+
+ 021
+
+
+ 022 ### Holding
+
+
+ 023
+
+
+ 024 Every building is on a holding, and, indeed, what I mean by 'building' here
+
+
+ 025 may well turn out to be 'the collection of all the permanent structures on
+
+
+ 026 a holding. A holding is a polygonal area of the map which does not
+
+
+ 027 intersect with any other holding, but for the time being we'll make the
+
+
+ 028 simplifying assumption that every holding is a rectangular strip, and that
+
+
+ 029 'urban' holdings are of a reasonably standard width (see Viking-period
+
+
+ 030 York) and length. Rural holdings (farms, ?wood lots) may be much larger.
+
+
+ 031
+
+
+ 032 ### Terrain
+
+
+ 033
+
+
+ 034 A building is made of the stuff of the place. In a forest, buildings will
+
+
+ 035 tend to be wooden; in a terrain with rocky outcrops -- normally found on
+
+
+ 036 steep slopes -- stone. On the flat lands where there's river mud, of brick,
+
+
+ 037 cob, or wattle and daub. So to build a building we need to know the
+
+
+ 038 terrain. Terrain can be inferred from location but in practice this will
+
+
+ 039 be computationally expensive, so we'll pass terrain in as an argument to
+
+
+ 040 the build function.
+
+
+ 041
+
+
+ 042 For the time being we'll pass it in simply as a keyword from a defined set
+
+
+ 043 of keywords; later it may be a more sophisticated data structure.
+
+
+ 044
+
+
+ 045 ### Culture
+
+
+ 046
+
+
+ 047 People of different cultures build distinctively different buildings, even
+
+
+ 048 when using the same materials. So, in our world, a Japanese wooden house
+
+
+ 049 looks quite different from an Anglo Saxon stave house which looks quite
+
+
+ 050 different from a Canadian log cabin, even though the materials are much the
+
+
+ 051 same and the tools available to build with are not much different.
+
+
+ 052
+
+
+ 053 Culture can affect not just the overall shape of a building but also its
+
+
+ 054 finish and surface detail. For example, in many places in England, stone
+
+
+ 055 buildings are typically left bare; in rural Scotland, typically painted
+
+
+ 056 white or in pastel shades; in Ireland, often quite vivid colours.
+
+
+ 057
+
+
+ 058 People may also show religious or cultural symbols on their buildings.
+
+
+ 059
+
+
+ 060 For all these reasons, we need to know the culture of the occupant when
+
+
+ 061 creating a building. Again, this will initially be passed in as a keyword.
+
+
+ 062
+
+
+ 063 ### Craft
+
+
+ 064
+
+
+ 065 People in the game world have a craft, and some crafts will require
+
+
+ 066 different features in the building. In the broadly late-bronze-age-to
+
+
+ 067 medieval period within which the game is set, residence and workplace
+
+
+ 068 are for most people pretty much the same.
+
+
+ 069
+
+
+ 070 So a baker needs an oven, a smith a forge, and so on. All crafts who do
+
+
+ 071 some degree retail trade will want a shop front as part of the ground
+
+
+ 072 floor of their dwelling. Merchants and bankers will probably have houses
+
+
+ 073 that are a bit more showy than others.
+
+
+ 074
+
+
+ 075 Whether the 'genetic buildings' idea will ever really produce suitable
+
+
+ 076 buildings for aristons I don't know; it seems more likely that significant
+
+
+ 077 strongholds (of which there will be relatively few) should all be hand
+
+
+ 078 modelled rather than procedurally generated."
+
+
+ 079 (:require [cc.journeyman.the-great-game.holdings.holding :refer [ProtoHolding]]
+
+
+ 080 [cc.journeyman.the-great-game.location.location :refer [ProtoLocation]])
+
+
+ 081 (:import [org.apache.commons.math3.random MersenneTwister]))
+
+
+ 082
+
+
+ 083
+
+
+ 084 (def ^:dynamic *terrain-types*
+
+
+ 085 "Types of terrain which affect building families. TODO: This is a placeholder;
+
+
+ 086 a more sophisticated model will be needed."
+
+
+ 087 #{:arable :arid :forest :plateau :upland})
+
+
+ 088
+
+
+ 089 (def ^:dynamic *cultures*
+
+
+ 090 "Cultures which affect building families. TODO: placeholder"
+
+
+ 091 #{:ariston :coastal :steppe-clans :western-clans :wild-herd})
+
+
+ 092
+
+
+ 093 (def ^:dynamic *crafts*
+
+
+ 094 "Crafts which affect building types in the game. See
+
+
+ 095 `Populating a game world`. TODO: placeholder"
+
+
+ 096 #{:baker :banker :butcher :chancellor :innkeeper :lawyer :magus :merchant :miller :priest :scholar :smith :weaver})
+
+
+ 097
+
+
+ 098 (def ^:dynamic *building-families*
+
+
+ 099 "Families of buildings.
+
+
+ 100
+
+
+ 101 Each family has
+
+
+ 102
+
+
+ 103 * terrain types to which it is appropriate;
+
+
+ 104 * crafts to which it is appropriate;
+
+
+ 105 * cultures to which it is appropriate.
+
+
+ 106
+
+
+ 107 Each generated building will be of one family, and will comprise modules
+
+
+ 108 taken only from that family."
+
+
+ 109 {:pitched-rectangular {:terrains #{:arable :forest :upland}
+
+
+ 110 :crafts *crafts*
+
+
+ 111 :cultures #{:coastal :western-clans}
+
+
+ 112 :modules []}
+
+
+ 113 :flatroof-rectangular {:terrains #{:arid :plateau}
+
+
+ 114 :crafts *crafts*
+
+
+ 115 :cultures #{:coastal}
+
+
+ 116 :modules []}})
+
+
+ 117
+
+
+ 118 ;; TODO: So, modules need to contain
+
+
+ 119 ;;
+
+
+ 120 ;; 1. Ground floor modules, having external doors;
+
+
+ 121 ;; 2. Craft modules -- workshops -- which will normally be ground floor (except
+
+
+ 122 ;; weavers) and may have the constraint that no upper floor module can cover them;
+
+
+ 123 ;; 3. Upper floor modules, having NO external doors (but linking internal doors);
+
+
+ 124 ;; 4. Roof modules
+
+
+ 125 ;;
+
+
+ 126 ;; There also needs to be an undercroft or platform module, such that the area of
+
+
+ 127 ;; the top of the platform is identical with the footprint of the building, and
+
+
+ 128 ;; the altitude of the top of the platform is equal to the altitude of the
+
+
+ 129 ;; terrain at the heighest corner of the building; so that the actual
+
+
+ 130 ;; building doesn't float in the air, and also so that none of the doors or windows
+
+
+ 131 ;; are partly underground.
+
+
+ 132 ;;
+
+
+ 133 ;; Each module needs to wrap an actual 3d model created in Blender or whatever,
+
+
+ 134 ;; and have a list of optional textures with which that model can be rendered.
+
+
+ 135 ;; So an upper floor bedroom module might have the following renders:
+
+
+ 136 ;;
+
+
+ 137 ;; 1. Bare masonry - constrained to upland or plateau terrain, and to coastal culture
+
+
+ 138 ;; 2. Painted masonry - constrained to upland or plateau terrain, and to coastal culture
+
+
+ 139 ;; 3. Half-timbered - not available on plateau terrain
+
+
+ 140 ;; 4. Weatherboarded - constrained to forest terrain
+
+
+ 141 ;; 5. Brick - constrained to arable or arid terrain
+
+
+ 142 ;;
+
+
+ 143 ;; of course these are only examples, and also, it's entirely possible to have
+
+
+ 144 ;; for example multiple different weatherboard renders for the same module.
+
+
+ 145 ;; There needs to be a way of rendering what can be built above what: for
+
+
+ 146 ;; example, you can't have a masonry clad module over a half timbered one,
+
+
+ 147 ;; but you can have a half-timbered one over a masonry one
+
+
+ 148
+
+
+ 149 (defn building-family
+
+
+ 150 "A building family is essentially a collection of models of building modules
+
+
+ 151 which can be assembled to create buildings of a particular structural and
+
+
+ 152 architectural style."
+
+
+ 153 [terrain culture craft gene]
+
+
+ 154 (let [candidates (filter #(and
+
+
+ 155 ((:terrains %) terrain)
+
+
+ 156 ((:crafts %) craft)
+
+
+ 157 ((:cultures %) culture))
+
+
+ 158 (vals *building-families*))]
+
+
+ 159 (nth candidates (mod (Math/abs (.nextInt gene)) (count candidates)))))
+
+
+ 160
+
+
+ 161 (building-family :arable :coastal :baker (MersenneTwister. 5))
+
+
+ 162
+
+
+ 163 (defn build!
+
+
+ 164 "Builds a building, and returns a data structure which represents it. In
+
+
+ 165 building the building, it adds a model of the building to the representation
+
+
+ 166 of the world, so it does have a side effect."
+
+
+ 167 [holding terrain culture craft size]
+
+
+ 168 (if (satisfies? ProtoHolding holding)
+
+
+ 169 (let [location (.building-origin holding)
+
+
+ 170 gene (MersenneTwister. (int (+ (* (.easting location) 1000000) (.northing location))))
+
+
+ 171 family (building-family terrain culture craft gene)]
+
+
+ 172 (if
+
+
+ 173 (and (instance? ProtoLocation location) (:orientation location))
+
+
+ 174 :stuff
+
+
+ 175 :nonsense
+
+
+ 176 ))
+
+
+ 177 :froboz))
+
+
+ 178
+
+
+ 179 ;; (def ol (cc.journeyman.the-great-game.location.location/OrientedLocation. 123.45 543.76 12.34 0.00 {}))
+
+
+ 180
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/gossip/gossip.clj.html b/docs/cloverage/cc/journeyman/the_great_game/gossip/gossip.clj.html
new file mode 100644
index 0000000..cf48455
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/gossip/gossip.clj.html
@@ -0,0 +1,227 @@
+
+
+
+ cc/journeyman/the_great_game/gossip/gossip.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.gossip.gossip
+
+
+ 002 "Interchange of news events between gossip agents.
+
+
+ 003
+
+
+ 004 Note that habitual travellers are all gossip agents; specifically, at this
+
+
+ 005 stage, that means merchants. When merchants are moved we also need to
+
+
+ 006 update the location of the gossip with the same key.
+
+
+ 007
+
+
+ 008 Innkeepers are also gossip agents but do not typically move."
+
+
+ 009 (:require [cc.journeyman.the-great-game.utils :refer [deep-merge]]
+
+
+ 010 [cc.journeyman.the-great-game.gossip.news-items :refer [learn-news-item]]
+
+
+ 011 ))
+
+
+ 012
+
+
+ 013
+
+
+ 014 (defn dialogue
+
+
+ 015 "Dialogue between an `enquirer` and an `agent` in this `world`; returns a
+
+
+ 016 map identical to `enquirer` except that its `:gossip` collection may have
+
+
+ 017 additional entries."
+
+
+ 018 ;; TODO: not yet written, this is a stub.
+
+
+ 019 [enquirer respondent world]
+
+
+ 020 enquirer)
+
+
+ 021
+
+
+ 022 (defn gather-news
+
+
+ 023 "Gather news for the specified `gossip` in this `world`."
+
+
+ 024 [world gossip]
+
+
+ 025 (let [g (cond (keyword? gossip)
+
+
+ 026 (-> world :gossips gossip)
+
+
+ 027 (map? gossip)
+
+
+ 028 gossip)]
+
+
+ 029 (if g
+
+
+ 030 {:gossips
+
+
+ 031 {(:id g)
+
+
+ 032 (reduce
+
+
+ 033 deep-merge
+
+
+ 034 {}
+
+
+ 035 (map
+
+
+ 036 #(dialogue g % world)
+
+
+ 037 (remove
+
+
+ 038 #(= g %)
+
+
+ 039 (filter
+
+
+ 040 #(= (:location %) (:location g))
+
+
+ 041 (vals (:gossips world))))))}}
+
+
+ 042 {})))
+
+
+ 043
+
+
+ 044 (defn move-gossip
+
+
+ 045 "Return a world like this `world` but with this `gossip` moved to this
+
+
+ 046 `new-location`. Many gossips are essentially shadow-records of agents of
+
+
+ 047 other types, and the movement of the gossip should be controlled by the
+
+
+ 048 run function of the type of the record they shadow. The [[#run]] function
+
+
+ 049 below does NOT call this function."
+
+
+ 050 [gossip world new-location]
+
+
+ 051 (let [id (cond
+
+
+ 052 (map? gossip)
+
+
+ 053 (-> world :gossips gossip :id)
+
+
+ 054 (keyword? gossip)
+
+
+ 055 gossip)]
+
+
+ 056 (deep-merge
+
+
+ 057 world
+
+
+ 058 {:gossips
+
+
+ 059 {id
+
+
+ 060 {:location new-location}}})))
+
+
+ 061
+
+
+ 062 (defn run
+
+
+ 063 "Return a world like this `world`, with news items exchanged between gossip
+
+
+ 064 agents."
+
+
+ 065 [world]
+
+
+ 066 (reduce
+
+
+ 067 deep-merge
+
+
+ 068 world
+
+
+ 069 (map
+
+
+ 070 #(gather-news world %)
+
+
+ 071 (keys (:gossips world)))))
+
+
+ 072
+
+
+ 073
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/gossip/news_items.clj.html b/docs/cloverage/cc/journeyman/the_great_game/gossip/news_items.clj.html
new file mode 100644
index 0000000..3a27e1d
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/gossip/news_items.clj.html
@@ -0,0 +1,947 @@
+
+
+
+ cc/journeyman/the_great_game/gossip/news_items.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.gossip.news-items
+
+
+ 002 "Categories of news events interesting to gossip agents.
+
+
+ 003
+
+
+ 004 The ideas here are based on the essay [The spread of knowledge in a large
+
+
+ 005 game world](The-spread-of-knowledge-in-a-large-game-world.html), q.v.;
+
+
+ 006 they've advanced a little beyond that and will doubtless
+
+
+ 007 advance further in the course of writing and debugging this namespace.
+
+
+ 008
+
+
+ 009 A news item is a map with the keys:
+
+
+ 010
+
+
+ 011 * `date` - the date on which the reported event happened;
+
+
+ 012 * `nth-hand` - the number of agents the news item has passed through;
+
+
+ 013 * `verb` - what it is that happened (key into `news-topics`);
+
+
+ 014
+
+
+ 015 plus other keys taken from the `keys` value associated with the verb in
+
+
+ 016 `news-topics`.
+
+
+ 017
+
+
+ 018 ## Notes:
+
+
+ 019
+
+
+ 020 *TODO*
+
+
+ 021 This namespace at present considers the `:knowledge` of a gossip to be a flat
+
+
+ 022 list of propositions, each of which must be checked every time any new
+
+
+ 023 proposition is offered. This is woefully inefficient. "
+
+
+ 024 (:require [cc.journeyman.the-great-game.world.location :refer [distance-between]]
+
+
+ 025 [cc.journeyman.the-great-game.time :refer [game-time]]))
+
+
+ 026
+
+
+ 027
+
+
+ 028 (def news-topics
+
+
+ 029 "Topics of interest to gossip agents. Topics are keyed in this map by
+
+
+ 030 their `verbs`. The `keys` associated with each topic are the extra pieces
+
+
+ 031 of information required to give context to a gossip item. Generally:
+
+
+ 032
+
+
+ 033 * `actor` is the id of the character who it is reported performed the
+
+
+ 034 action;
+
+
+ 035 * `other` is the id of the character on whom it is reported the action
+
+
+ 036 was performed;
+
+
+ 037 * `location` is the place at which the action was performed;
+
+
+ 038 * `object` is an object (or possibly list of objects?) relevant to the
+
+
+ 039 action;
+
+
+ 040 * `price` is special to buy/sell, but of significant interest to merchants.
+
+
+ 041
+
+
+ 042 ## Notes
+
+
+ 043
+
+
+ 044 ### Characters
+
+
+ 045
+
+
+ 046 *TODO* but note that at most all the receiver can learn about a character
+
+
+ 047 from a news item is what the giver knows about that character, degraded by
+
+
+ 048 what the receiver finds interesting about them. If we just pass the id here,
+
+
+ 049 then either the receiver knows everything in the database about the
+
+
+ 050 character, or else the receiver knows nothing at all about the character.
+
+
+ 051 Neither is desirable. Further thought needed.
+
+
+ 052
+
+
+ 053 By implication, the character values passed should include *all* the
+
+
+ 054 information the giver knows about the character; that can then be degraded
+
+
+ 055 as the receiver stores only that segment which the receiver finds
+
+
+ 056 interesting.
+
+
+ 057
+
+
+ 058 ### Locations
+
+
+ 059
+
+
+ 060 A 'location' value is a list comprising at most the x/y coordinate location
+
+
+ 061 and the ids of the settlement and region (possibly hierarchically) that contain
+
+
+ 062 the location. If the x/y is not local to the home of the receiving agent, they
+
+
+ 063 won't remember it and won't pass it on; if any of the ids are not interesting
+
+
+ 064 So location information will degrade progressively as the item is passed along.
+
+
+ 065
+
+
+ 066 It is assumed that the `:home` of a character is a location in this sense.
+
+
+ 067
+
+
+ 068 ### Inferences
+
+
+ 069
+
+
+ 070 If an agent learns that Adam has married Betty, they can infer that Betty has
+
+
+ 071 married Adam; if they learn that Charles killed Dorothy, that Dorothy has died.
+
+
+ 072 I'm not convinced that my representation of inferences here is ideal.
+
+
+ 073 "
+
+
+ 074 {;; A significant attack is interesting whether or not it leads to deaths
+
+
+ 075 :attack {:verb :attack :keys [:actor :other :location]}
+
+
+ 076 ;; Deaths of characters may be interesting
+
+
+ 077 :die {:verb :die :keys [:actor :location]}
+
+
+ 078 ;; Deliberate killings are interesting.
+
+
+ 079 :kill {:verb :kill :keys [:actor :other :location]
+
+
+ 080 :inferences [{:verb :die :actor :other :other :nil}]}
+
+
+ 081 ;; Marriages may be interesting
+
+
+ 082 :marry {:verb :marry :keys [:actor :other :location]
+
+
+ 083 :inferences [{:verb :marry :actor :other :other :actor}]}
+
+
+ 084 ;; The end of ongoing open conflict between to characters may be interesting
+
+
+ 085 :peace {:verb :peace :keys [:actor :other :location]
+
+
+ 086 :inferences [{:verb :peace :actor :other :other :actor}]}
+
+
+ 087 ;; Things related to the plot are interesting, but will require special
+
+
+ 088 ;; handling. Extra keys may be required by particular plot events.
+
+
+ 089 :plot {:verb :plot :keys [:actor :other :object :location]}
+
+
+ 090 ;; Rapes are interesting.
+
+
+ 091 :rape {:verb :rape :keys [:actor :other :location]
+
+
+ 092 ;; Should you also infer from rape that actor is male and adult?
+
+
+ 093 :inferences [{:verb :attack}
+
+
+ 094 {:verb :sex}
+
+
+ 095 {:verb :sex :actor :other :other :actor}]}
+
+
+ 096 ;; Merchants, especially, are interested in prices in other markets
+
+
+ 097 :sell {:verb :sell :keys [:actor :other :object :location :price]}
+
+
+ 098 ;; Sex can juicy gossip, although not normally if the participants are in an
+
+
+ 099 ;; established sexual relationship.
+
+
+ 100 :sex {:verb :sex :keys [:actor :other :location]
+
+
+ 101 :inferences [{:verb :sex :actor :other :other :actor}]}
+
+
+ 102 ;; Thefts are interesting.
+
+
+ 103 :steal {:verb :steal :keys [:actor :other :object :location]}
+
+
+ 104 ;; The succession of rulers is interesting; of respected craftsmen,
+
+
+ 105 ;; potentially also interesting.
+
+
+ 106 :succession {:verb :succession :keys [:actor :other :location :rank]}
+
+
+ 107 ;; The start of ongoing open conflict between two characters may be interesting.
+
+
+ 108 :war {:verb :war :keys [:actor :other :location]
+
+
+ 109 :inferences [{:verb :war :actor :other :other :actor}]}})
+
+
+ 110
+
+
+ 111
+
+
+ 112 (defn interest-in-character
+
+
+ 113 "Integer representation of how interesting this `character` is to this
+
+
+ 114 `gossip`.
+
+
+ 115 *TODO:* this assumes that characters are passed as keywords, but, as
+
+
+ 116 documented above, they probably have to be maps, to allow for degradation."
+
+
+ 117 [gossip character]
+
+
+ 118 (count
+
+
+ 119 (concat
+
+
+ 120 (filter #(= (:actor % character)) (:knowledge gossip))
+
+
+ 121 (filter #(= (:other % character)) (:knowledge gossip)))))
+
+
+ 122
+
+
+ 123 (defn interesting-character?
+
+
+ 124 "Boolean representation of whether this `character` is interesting to this
+
+
+ 125 `gossip`."
+
+
+ 126 [gossip character]
+
+
+ 127 (> (interest-in-character gossip character) 0))
+
+
+ 128
+
+
+ 129 (defn interest-in-location
+
+
+ 130 "Integer representation of how interesting this `location` is to this
+
+
+ 131 `gossip`."
+
+
+ 132 [gossip location]
+
+
+ 133 (cond
+
+
+ 134 (and (map? location) (number? (:x location)) (number? (:y location)))
+
+
+ 135 (if-let [home (:home gossip)]
+
+
+ 136 (let [d (distance-between location home)
+
+
+ 137 i (/ 10000 d) ;; 10000 at metre scale is 10km; interest should
+
+
+ 138 ;;fall off with distance from home, but possibly on a log scale
+
+
+ 139 ]
+
+
+ 140 (if (> i 1) i 0))
+
+
+ 141 0)
+
+
+ 142 (coll? location)
+
+
+ 143 (reduce
+
+
+ 144 +
+
+
+ 145 (map
+
+
+ 146 #(interest-in-location gossip %)
+
+
+ 147 location))
+
+
+ 148 :else
+
+
+ 149 (count
+
+
+ 150 (filter
+
+
+ 151 #(some (fn [x] (= x location)) (:location %))
+
+
+ 152 (cons {:location (:home gossip)} (:knowledge gossip))))))
+
+
+ 153
+
+
+ 154 ;; (interest-in-location {:home [{0, 0} :test-home] :knowledge []} [:test-home])
+
+
+ 155
+
+
+ 156 (defn interesting-location?
+
+
+ 157 "True if the location of this news `item` is interesting to this `gossip`."
+
+
+ 158 [gossip item]
+
+
+ 159 (> (interest-in-location gossip (:location item)) 0))
+
+
+ 160
+
+
+ 161 (defn interesting-object?
+
+
+ 162 [gossip object]
+
+
+ 163 ;; TODO: Not yet (really) implemented
+
+
+ 164 true)
+
+
+ 165
+
+
+ 166 (defn interesting-topic?
+
+
+ 167 [gossip topic]
+
+
+ 168 ;; TODO: Not yet (really) implemented
+
+
+ 169 true)
+
+
+ 170
+
+
+ 171 (defn compatible-value?
+
+
+ 172 "True if `known-value` is the same as `new-value`, or, for each key present
+
+
+ 173 in `new-value`, has the same value for that key.
+
+
+ 174
+
+
+ 175 The rationale here is that if `new-value` contains new or different
+
+
+ 176 information, it's worth learning; otherwise, not."
+
+
+ 177 [new-value known-value]
+
+
+ 178 (or
+
+
+ 179 (= new-value known-value)
+
+
+ 180 ;; TODO: some handwaving here about being a slightly better descriptor --
+
+
+ 181 ;; having more keys than might
+
+
+ 182 (when (and (map? new-value) (map? known-value))
+
+
+ 183 (every? true? (map #(= (new-value %) (known-value %))
+
+
+ 184 (keys new-value))))))
+
+
+ 185
+
+
+ 186 (defn compatible-item?
+
+
+ 187 "True if `new-item` is identical with, or less specific than, `known-item`.
+
+
+ 188
+
+
+ 189 If we already know 'Bad Joe killed Sweet Daisy', there's no point in
+
+
+ 190 learning that 'someone killed Sweet Daisy', but there is point in learning
+
+
+ 191 'someone killed Sweet Daisy _with poison_'."
+
+
+ 192 [new-item known-item]
+
+
+ 193 (reduce
+
+
+ 194 #(and %1 %2)
+
+
+ 195 (map #(if
+
+
+ 196 (known-item %) ;; if known-item has this key
+
+
+ 197 (compatible-value? (new-item %) (known-item %))
+
+
+ 198 true)
+
+
+ 199 (remove #{:nth-hand :confidence :learned-from} (keys new-item)))))
+
+
+ 200
+
+
+ 201 (defn known-item?
+
+
+ 202 "True if this news `item` is already known to this `gossip`.
+
+
+ 203
+
+
+ 204 This means that the `gossip` already knows an item which identifiably has
+
+
+ 205 the same _or more specific_ values for all the keys of this `item` except
+
+
+ 206 `:nth-hand`, `:confidence` and `:learned-from`."
+
+
+ 207 [gossip item]
+
+
+ 208 (reduce
+
+
+ 209 #(or %1 %2)
+
+
+ 210 (filter true? (map #(compatible-item? item %) (:knowledge gossip)))))
+
+
+ 211
+
+
+ 212 (defn interesting-item?
+
+
+ 213 "True if anything about this news `item` is interesting to this `gossip`."
+
+
+ 214 [gossip item]
+
+
+ 215 (and (not (known-item? gossip item))
+
+
+ 216 (or
+
+
+ 217 (interesting-character? gossip (:actor item))
+
+
+ 218 (interesting-character? gossip (:other item))
+
+
+ 219 (interesting-location? gossip (:location item))
+
+
+ 220 (interesting-object? gossip (:object item))
+
+
+ 221 (interesting-topic? gossip (:verb item)))))
+
+
+ 222
+
+
+ 223 (defn infer
+
+
+ 224 "Infer a new knowledge item from this `item`, following this `rule`"
+
+
+ 225 [item rule]
+
+
+ 226 (reduce merge
+
+
+ 227 item
+
+
+ 228 (cons
+
+
+ 229 {:verb (:verb rule)}
+
+
+ 230 (map (fn [k] {k (apply (k rule) (list item))})
+
+
+ 231 (remove
+
+
+ 232 #{:verb}
+
+
+ 233 (keys rule))))))
+
+
+ 234
+
+
+ 235 (declare learn-news-item)
+
+
+ 236
+
+
+ 237 (defn make-all-inferences
+
+
+ 238 "Return a list of knowledge entries that can be inferred from this news
+
+
+ 239 `item`."
+
+
+ 240 [item]
+
+
+ 241 (set
+
+
+ 242 (reduce
+
+
+ 243 concat
+
+
+ 244 (map
+
+
+ 245 #(:knowledge (learn-news-item {} (infer item %) false))
+
+
+ 246 (:inferences (news-topics (:verb item)))))))
+
+
+ 247
+
+
+ 248 (defn degrade-character
+
+
+ 249 "Return a character specification like this `character`, but comprising
+
+
+ 250 only those properties this `gossip` is interested in."
+
+
+ 251 [gossip character]
+
+
+ 252 ;; TODO: Not yet (really) implemented
+
+
+ 253 character)
+
+
+ 254
+
+
+ 255 (defn degrade-location
+
+
+ 256 "Return a location specification like this `location`, but comprising
+
+
+ 257 only those elements this `gossip` is interested in. If none, return
+
+
+ 258 `nil`."
+
+
+ 259 [gossip location]
+
+
+ 260 (let [l (when
+
+
+ 261 (coll? location)
+
+
+ 262 (filter
+
+
+ 263 #(when (interesting-location? gossip %) %)
+
+
+ 264 location))]
+
+
+ 265 (when-not (empty? l) l)))
+
+
+ 266
+
+
+ 267 (defn inc-or-one
+
+
+ 268 "If this `val` is a number, return that number incremented by one; otherwise,
+
+
+ 269 return 1. TODO: should probably be in `utils`."
+
+
+ 270 [val]
+
+
+ 271 (if
+
+
+ 272 (number? val)
+
+
+ 273 (inc val)
+
+
+ 274 1))
+
+
+ 275
+
+
+ 276 (defn learn-news-item
+
+
+ 277 "Return a gossip like this `gossip`, which has learned this news `item` if
+
+
+ 278 it is of interest to them."
+
+
+ 279 ([gossip item]
+
+
+ 280 (learn-news-item gossip item true))
+
+
+ 281 ([gossip item follow-inferences?]
+
+
+ 282 (if
+
+
+ 283 (interesting-item? gossip item)
+
+
+ 284 (let [item' (assoc
+
+
+ 285 item
+
+
+ 286 :nth-hand (inc-or-one (:nth-hand item))
+
+
+ 287 :time-stamp (if
+
+
+ 288 (number? (:time-stamp item))
+
+
+ 289 (:time-stamp item)
+
+
+ 290 (game-time))
+
+
+ 291 :location (degrade-location gossip (:location item))
+
+
+ 292 :actor (degrade-character gossip (:actor item))
+
+
+ 293 :other (degrade-character gossip (:other item))
+
+
+ 294 ;; TODO: do something to degrade confidence in the item,
+
+
+ 295 ;; probably as a function of the provider's confidence in
+
+
+ 296 ;; the item and the gossip's trust in the provider
+
+
+ 297 )
+
+
+ 298 g (assoc
+
+
+ 299 gossip
+
+
+ 300 :knowledge
+
+
+ 301 (cons
+
+
+ 302 item'
+
+
+ 303 (:knowledge gossip)))]
+
+
+ 304 (if follow-inferences?
+
+
+ 305 (assoc
+
+
+ 306 g
+
+
+ 307 :knowledge
+
+
+ 308 (concat (:knowledge g) (make-all-inferences item)))
+
+
+ 309 g)))
+
+
+ 310 gossip))
+
+
+ 311
+
+
+ 312
+
+
+ 313
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/holdings/holding.clj.html b/docs/cloverage/cc/journeyman/the_great_game/holdings/holding.clj.html
new file mode 100644
index 0000000..1ed2918
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/holdings/holding.clj.html
@@ -0,0 +1,146 @@
+
+
+
+ cc/journeyman/the_great_game/holdings/holding.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.holdings.holding
+
+
+ 002 (:require [cc.journeyman.the-great-game.agent.agent :refer [ProtoAgent]]
+
+
+ 003 [cc.journeyman.the-great-game.objects.container :refer [ProtoContainer]]
+
+
+ 004 [cc.journeyman.the-great-game.objects.game-object :refer [ProtoObject]]
+
+
+ 005 ;; [cc.journeyman.the-great-game.location.location :refer [OrientedLocation]]
+
+
+ 006 [cc.journeyman.the-great-game.world.routes :refer []]))
+
+
+ 007
+
+
+ 008 ;;; A holding is a polygonal area of the map which does not
+
+
+ 009 ;;; intersect with any other holding, or with any road or water feature. For
+
+
+ 010 ;;; the time being we'll make the
+
+
+ 011 ;;; simplifying assumption that every holding is a rectangular strip, and that
+
+
+ 012 ;;; 'urban' holdings are of a reasonably standard width (see Viking-period
+
+
+ 013 ;;; York) and length. Rural holdings (farms, ?wood lots) may be much larger.
+
+
+ 014
+
+
+ 015 (defprotocol ProtoHolding
+
+
+ 016 (frontage
+
+
+ 017 [holding]
+
+
+ 018 "Returns a sequence of two locations representing the edge of the polygon
+
+
+ 019 which defines this holding which is considered to be the front.")
+
+
+ 020 (building-origin
+
+
+ 021 [holding]
+
+
+ 022 "Returns an oriented location - normally the right hand end of the
+
+
+ 023 frontage, for an urban holding - from which buildings on the holding
+
+
+ 024 should be built."))
+
+
+ 025
+
+
+ 026 (defrecord Holding [perimeter holder]
+
+
+ 027 ;; Perimeter should be a list of locations in exactly the same sense as a
+
+
+ 028 ;; route in `cc.journeyman.the-great-game.world.routes`. Some sanity checking
+
+
+ 029 ;; is needed to ensure this!
+
+
+ 030 ProtoContainer
+
+
+ 031 ProtoHolding
+
+
+ 032 (frontage
+
+
+ 033 [holding]
+
+
+ 034 "TODO: this is WRONG, but will work for now. The frontage should
+
+
+ 035 be the side of the perimeter nearest to the nearest existing
+
+
+ 036 route."
+
+
+ 037 [(first (perimeter holding)) (nth (perimeter holding) 1)])
+
+
+ 038 (building-origin
+
+
+ 039 [holding]
+
+
+ 040 "TODO: again this is WRONG. The default building origin for rectangular
+
+
+ 041 buildings should be the right hand end of the frontage when viewed
+
+
+ 042 from outside the holding. But that's not general; celtic-style circular
+
+
+ 043 buildings should normally be in the centre of their holdings. So probably
+
+
+ 044 building-origin becomes a method of building-family rather than of holding."
+
+
+ 045 (first (frontage holding)))
+
+
+ 046 ProtoObject)
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/location/location.clj.html b/docs/cloverage/cc/journeyman/the_great_game/location/location.clj.html
new file mode 100644
index 0000000..a27e3bf
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/location/location.clj.html
@@ -0,0 +1,149 @@
+
+
+
+ cc/journeyman/the_great_game/location/location.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.location.location)
+
+
+ 002
+
+
+ 003 ;;; There's probably conflict between this sense of a reified location and
+
+
+ 004 ;;; the simpler sense of a location described in
+
+
+ 005 ;;; `cc.journeyman.the-great-game.world.location`, q.v. This needs to
+
+
+ 006 ;;; be resolved!
+
+
+ 007
+
+
+ 008 (defprotocol ProtoLocation
+
+
+ 009 (easting [location]
+
+
+ 010 "Return the easting of this location")
+
+
+ 011 (northing [location] "Return the northing of this location")
+
+
+ 012 (altitude [location]
+
+
+ 013 "Return the absolute altitude of this location, which may be
+
+
+ 014 different from the terrain height at this location, if, for
+
+
+ 015 example, the location is underground or on an upper floor.")
+
+
+ 016 (terrain-altitude [location]
+
+
+ 017 "Return the 'ground level' (altitude of the terrain)
+
+
+ 018 at this location given this world. TODO: possibly
+
+
+ 019 terrain-altitude should be a method of the world.")
+
+
+ 020 (settlement [location]
+
+
+ 021 "Return the settlement record of the settlement in this world
+
+
+ 022 within whose parish polygon this location exists, or if none
+
+
+ 023 whose centre (inn location) is closest to this location"))
+
+
+ 024
+
+
+ 025
+
+
+ 026 (defrecord Location [^Double easting ^Double northing ^Double altitude world]
+
+
+ 027 ProtoLocation
+
+
+ 028 (easting [l] (:easting l))
+
+
+ 029 (northing [l] (:northing l))
+
+
+ 030 (altitude [l] (:altitude l))
+
+
+ 031 (terrain-altitude [l] 0.0) ;; TODO
+
+
+ 032 (settlement [l] :tchahua))
+
+
+ 033
+
+
+ 034 (defrecord OrientedLocation
+
+
+ 035 ;; "Identical to a Location except having, additionally, an orientation"
+
+
+ 036 [^Double easting ^Double northing ^Double altitude ^Double orientation world]
+
+
+ 037 ProtoLocation
+
+
+ 038 (easting [l] (:easting l))
+
+
+ 039 (northing [l] (:northing l))
+
+
+ 040 (altitude [l] (:altitude l))
+
+
+ 041 (terrain-altitude [l] 0.0) ;; TODO
+
+
+ 042 (settlement [l] :tchahua)) ;; TODO
+
+
+ 043
+
+
+ 044 ;; (.settlement (OrientedLocation. 123.45 543.76 12.34 0.00 {}))
+
+
+ 045
+
+
+ 046
+
+
+ 047 ;; (OrientedLocation. 123.45 543.76 12.34 0.00 {})
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/merchants/markets.clj.html b/docs/cloverage/cc/journeyman/the_great_game/merchants/markets.clj.html
new file mode 100644
index 0000000..ad08ec1
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/merchants/markets.clj.html
@@ -0,0 +1,260 @@
+
+
+
+ cc/journeyman/the_great_game/merchants/markets.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.merchants.markets
+
+
+ 002 "Adjusting quantities and prices in markets."
+
+
+ 003 (:require [taoensso.timbre :as l :refer [info error]]
+
+
+ 004 [cc.journeyman.the-great-game.utils :refer [deep-merge]]))
+
+
+ 005
+
+
+ 006 (defn new-price
+
+
+ 007 "If `stock` is greater than the maximum of `supply` and `demand`, then
+
+
+ 008 there is surplus and `old` price is too high, so shold be reduced. If
+
+
+ 009 lower, then it is too low and should be increased."
+
+
+ 010 [old stock supply demand]
+
+
+ 011 (let
+
+
+ 012 [delta (dec' (/ (max supply demand 1) (max stock 1)))
+
+
+ 013 scaled (/ delta 100)]
+
+
+ 014 (+ old scaled)))
+
+
+ 015
+
+
+ 016
+
+
+ 017 (defn adjust-quantity-and-price
+
+
+ 018 "Adjust the quantity of this `commodity` currently in stock in this `city`
+
+
+ 019 of this `world`. Return a fragmentary world which can be deep-merged into
+
+
+ 020 this world."
+
+
+ 021 [world city commodity]
+
+
+ 022 (let [c (cond
+
+
+ 023 (keyword? city) (-> world :cities city)
+
+
+ 024 (map? city) city)
+
+
+ 025 id (:id c)
+
+
+ 026 p (or (-> c :prices commodity) 0)
+
+
+ 027 d (or (-> c :demands commodity) 0)
+
+
+ 028 st (or (-> c :stock commodity) 0)
+
+
+ 029 su (or (-> c :supplies commodity) 0)
+
+
+ 030 decrement (min st d)
+
+
+ 031 increment (cond
+
+
+ 032 ;; if we've two turns' production of this commodity in
+
+
+ 033 ;; stock, halt production
+
+
+ 034 (> st (* su 2))
+
+
+ 035 0
+
+
+ 036 ;; if it is profitable to produce this commodity, the
+
+
+ 037 ;; craftspeople of the city will do so.
+
+
+ 038 (> p 1) su
+
+
+ 039 ;; otherwise, if there isn't a turn's production in
+
+
+ 040 ;; stock, top up the stock, so that there's something for
+
+
+ 041 ;; incoming merchants to buy
+
+
+ 042 (> su st)
+
+
+ 043 (- su st)
+
+
+ 044 :else
+
+
+ 045 0)
+
+
+ 046 n (new-price p st su d)]
+
+
+ 047 (if
+
+
+ 048 (not= p n)
+
+
+ 049 (l/info "Price of" commodity "at" id "has changed from" (float p) "to" (float n)))
+
+
+ 050 {:cities {id
+
+
+ 051 {:stock
+
+
+ 052 {commodity (+ (- st decrement) increment)}
+
+
+ 053 :prices
+
+
+ 054 {commodity n}}}}))
+
+
+ 055
+
+
+ 056
+
+
+ 057 (defn update-markets
+
+
+ 058 "Return a world like this `world`, with quantities and prices in markets
+
+
+ 059 updated to reflect supply and demand. If `city` or `city` and `commodity`
+
+
+ 060 are specified, return a fragmentary world with only the changes for that
+
+
+ 061 `city` (and `commodity` if specified) populated."
+
+
+ 062 ([world]
+
+
+ 063 (reduce
+
+
+ 064 deep-merge
+
+
+ 065 world
+
+
+ 066 (map
+
+
+ 067 #(update-markets world %)
+
+
+ 068 (keys (:cities world)))))
+
+
+ 069 ([world city]
+
+
+ 070 (reduce
+
+
+ 071 deep-merge
+
+
+ 072 {}
+
+
+ 073 (map #(update-markets world city %)
+
+
+ 074 (keys (:commodities world)))))
+
+
+ 075 ([world city commodity]
+
+
+ 076 (adjust-quantity-and-price world city commodity)))
+
+
+ 077
+
+
+ 078
+
+
+ 079 (defn run
+
+
+ 080 "Return a world like this `world`, with quantities and prices in markets
+
+
+ 081 updated to reflect supply and demand."
+
+
+ 082 [world]
+
+
+ 083 (update-markets world))
+
+
+ 084
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/merchants/merchant_utils.clj.html b/docs/cloverage/cc/journeyman/the_great_game/merchants/merchant_utils.clj.html
new file mode 100644
index 0000000..377f27a
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/merchants/merchant_utils.clj.html
@@ -0,0 +1,326 @@
+
+
+
+ cc/journeyman/the_great_game/merchants/merchant_utils.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.merchants.merchant-utils
+
+
+ 002 "Useful functions for doing low-level things with merchants.")
+
+
+ 003
+
+
+ 004 (defn expected-price
+
+
+ 005 "Find the price anticipated, given this `world`, by this `merchant` for
+
+
+ 006 this `commodity` in this `city`. If no information, assume 1.
+
+
+ 007 `merchant` should be passed as a map, `commodity` and `city` should be passed as keywords."
+
+
+ 008 [merchant commodity city]
+
+
+ 009 (or
+
+
+ 010 (:price
+
+
+ 011 (last
+
+
+ 012 (sort-by
+
+
+ 013 :date
+
+
+ 014 (-> merchant :known-prices city commodity))))
+
+
+ 015 1))
+
+
+ 016
+
+
+ 017 (defn burden
+
+
+ 018 "The total weight of the current cargo carried by this `merchant` in this
+
+
+ 019 `world`."
+
+
+ 020 [merchant world]
+
+
+ 021 (let [m (cond
+
+
+ 022 (keyword? merchant)
+
+
+ 023 (-> world :merchants merchant)
+
+
+ 024 (map? merchant)
+
+
+ 025 merchant)
+
+
+ 026 cargo (or (:stock m) {})]
+
+
+ 027 (reduce
+
+
+ 028 +
+
+
+ 029 0
+
+
+ 030 (map
+
+
+ 031 #(* (cargo %) (-> world :commodities % :weight))
+
+
+ 032 (keys cargo)))))
+
+
+ 033
+
+
+ 034
+
+
+ 035 (defn can-carry
+
+
+ 036 "Return the number of units of this `commodity` which this `merchant`
+
+
+ 037 can carry in this `world`, given their current burden."
+
+
+ 038 [merchant world commodity]
+
+
+ 039 (let [m (cond
+
+
+ 040 (keyword? merchant)
+
+
+ 041 (-> world :merchants merchant)
+
+
+ 042 (map? merchant)
+
+
+ 043 merchant)]
+
+
+ 044 (max
+
+
+ 045 0
+
+
+ 046 (quot
+
+
+ 047 (- (or (:capacity m) 0) (burden m world))
+
+
+ 048 (-> world :commodities commodity :weight)))))
+
+
+ 049
+
+
+ 050 (defn can-afford
+
+
+ 051 "Return the number of units of this `commodity` which this `merchant`
+
+
+ 052 can afford to buy in this `world`."
+
+
+ 053 [merchant world commodity]
+
+
+ 054 (let [m (cond
+
+
+ 055 (keyword? merchant)
+
+
+ 056 (-> world :merchants merchant)
+
+
+ 057 (map? merchant)
+
+
+ 058 merchant)
+
+
+ 059 l (:location m)]
+
+
+ 060 (cond
+
+
+ 061 (nil? m)
+
+
+ 062 (throw (Exception. "No merchant?"))
+
+
+ 063 (or (nil? l) (nil? (-> world :cities l)))
+
+
+ 064 (throw (Exception. (str "No known location for merchant " m)))
+
+
+ 065 :else
+
+
+ 066 (quot
+
+
+ 067 (:cash m)
+
+
+ 068 (-> world :cities l :prices commodity)))))
+
+
+ 069
+
+
+ 070 (defn add-stock
+
+
+ 071 "Where `a` and `b` are both maps all of whose values are numbers, return
+
+
+ 072 a map whose keys are a union of the keys of `a` and `b` and whose values
+
+
+ 073 are the sums of their respective values."
+
+
+ 074 [a b]
+
+
+ 075 (reduce
+
+
+ 076 merge
+
+
+ 077 a
+
+
+ 078 (map
+
+
+ 079 #(hash-map % (+ (or (a %) 0) (or (b %) 0)))
+
+
+ 080 (keys b))))
+
+
+ 081
+
+
+ 082 (defn add-known-prices
+
+
+ 083 "Add the current prices at this `merchant`'s location in the `world`
+
+
+ 084 to a new cache of known prices, and return it."
+
+
+ 085 [merchant world]
+
+
+ 086 (let [m (cond
+
+
+ 087 (keyword? merchant)
+
+
+ 088 (-> world :merchants merchant)
+
+
+ 089 (map? merchant)
+
+
+ 090 merchant)
+
+
+ 091 k (or (:known-prices m) {})
+
+
+ 092 l (:location m)
+
+
+ 093 d (or (:date world) 0)
+
+
+ 094 p (-> world :cities l :prices)]
+
+
+ 095 (cond
+
+
+ 096 (nil? m)
+
+
+ 097 (throw (Exception. "No merchant?"))
+
+
+ 098 (or (nil? l) (nil? (-> world :cities l)))
+
+
+ 099 (throw (Exception. (str "No known location for merchant " m)))
+
+
+ 100 :else
+
+
+ 101 (reduce
+
+
+ 102 merge
+
+
+ 103 k
+
+
+ 104 (map
+
+
+ 105 #(hash-map % (apply vector cons {:price (p %) :date d} (k %)))
+
+
+ 106 (-> world :commodities keys))))))
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/merchants/merchants.clj.html b/docs/cloverage/cc/journeyman/the_great_game/merchants/merchants.clj.html
new file mode 100644
index 0000000..94daa96
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/merchants/merchants.clj.html
@@ -0,0 +1,92 @@
+
+
+
+ cc/journeyman/the_great_game/merchants/merchants.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.merchants.merchants
+
+
+ 002 "Trade planning for merchants, primarily."
+
+
+ 003 (:require [cc.journeyman.the-great-game.utils :refer [deep-merge]]
+
+
+ 004 [cc.journeyman.the-great-game.merchants.strategies.simple :refer [move-merchant]]
+
+
+ 005 [taoensso.timbre :as l]))
+
+
+ 006
+
+
+ 007
+
+
+ 008 (defn run
+
+
+ 009 "Return a partial world based on this `world`, but with each merchant moved."
+
+
+ 010 [world]
+
+
+ 011 (try
+
+
+ 012 (reduce
+
+
+ 013 deep-merge
+
+
+ 014 world
+
+
+ 015 (map
+
+
+ 016 #(try
+
+
+ 017 (let [move-fn (or
+
+
+ 018 (-> world :merchants % :move-fn)
+
+
+ 019 move-merchant)]
+
+
+ 020 (apply move-fn (list % world)))
+
+
+ 021 (catch Exception any
+
+
+ 022 (l/error any "Failure while moving merchant " %)
+
+
+ 023 {}))
+
+
+ 024 (keys (:merchants world))))
+
+
+ 025 (catch Exception any
+
+
+ 026 (l/error any "Failure while moving merchants")
+
+
+ 027 world)))
+
+
+ 028
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/merchants/planning.clj.html b/docs/cloverage/cc/journeyman/the_great_game/merchants/planning.clj.html
new file mode 100644
index 0000000..ee3243d
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/merchants/planning.clj.html
@@ -0,0 +1,485 @@
+
+
+
+ cc/journeyman/the_great_game/merchants/planning.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.merchants.planning
+
+
+ 002 "Trade planning for merchants, primarily. This follows a simple-minded
+
+
+ 003 generate-and-test strategy and currently generates plans for all possible
+
+
+ 004 routes from the current location. This may not scale. Also, routes do not
+
+
+ 005 currently have cost or risk associated with them."
+
+
+ 006 (:require [cc.journeyman.the-great-game.utils :refer [deep-merge make-target-filter]]
+
+
+ 007 [cc.journeyman.the-great-game.merchants.merchant-utils :refer [can-afford can-carry expected-price]]
+
+
+ 008 [cc.journeyman.the-great-game.world.routes :refer [find-route]]
+
+
+ 009 [cc.journeyman.the-great-game.world.world :refer [actual-price default-world]]))
+
+
+ 010
+
+
+ 011 (defn generate-trade-plans
+
+
+ 012 "Generate all possible trade plans for this `merchant` and this `commodity`
+
+
+ 013 in this `world`.
+
+
+ 014
+
+
+ 015 Returned plans are maps with keys:
+
+
+ 016
+
+
+ 017 * :merchant - the id of the `merchant` for whom the plan was created;
+
+
+ 018 * :origin - the city from which the trade starts;
+
+
+ 019 * :destination - the city to which the trade is planned;
+
+
+ 020 * :commodity - the `commodity` to be carried;
+
+
+ 021 * :buy-price - the price at which that `commodity` can be bought;
+
+
+ 022 * :expected-price - the price at which the `merchant` anticipates
+
+
+ 023 that `commodity` can be sold;
+
+
+ 024 * :distance - the number of stages in the planned journey
+
+
+ 025 * :dist-to-home - the distance from `destination` to the `merchant`'s
+
+
+ 026 home city."
+
+
+ 027 [merchant world commodity]
+
+
+ 028 (let [m (cond
+
+
+ 029 (keyword? merchant)
+
+
+ 030 (-> world :merchants merchant)
+
+
+ 031 (map? merchant)
+
+
+ 032 merchant)
+
+
+ 033 origin (:location m)]
+
+
+ 034 (map
+
+
+ 035 #(hash-map
+
+
+ 036 :merchant (:id m)
+
+
+ 037 :origin origin
+
+
+ 038 :destination %
+
+
+ 039 :commodity commodity
+
+
+ 040 :buy-price (actual-price world commodity origin)
+
+
+ 041 :expected-price (expected-price
+
+
+ 042 m
+
+
+ 043 commodity
+
+
+ 044 %)
+
+
+ 045 :distance (count
+
+
+ 046 (find-route world origin %))
+
+
+ 047 :dist-to-home (count
+
+
+ 048 (find-route
+
+
+ 049 world
+
+
+ 050 (:home m)
+
+
+ 051 %)))
+
+
+ 052 (remove #(= % origin) (-> world :cities keys)))))
+
+
+ 053
+
+
+ 054 (defn nearest-with-targets
+
+
+ 055 "Return the distance to the nearest destination among those of these
+
+
+ 056 `plans` which match these `targets`. Plans are expected to be plans
+
+
+ 057 as returned by `generate-trade-plans`, q.v.; `targets` are expected to be
+
+
+ 058 as accepted by `make-target-filter`, q.v."
+
+
+ 059 [plans targets]
+
+
+ 060 (apply
+
+
+ 061 min
+
+
+ 062 (map
+
+
+ 063 :distance
+
+
+ 064 (filter
+
+
+ 065 (make-target-filter targets)
+
+
+ 066 plans))))
+
+
+ 067
+
+
+ 068 (defn plan-trade
+
+
+ 069 "Find the best destination in this `world` for this `commodity` given this
+
+
+ 070 `merchant` and this `origin`. If two cities are anticipated to offer the
+
+
+ 071 same price, the nearer should be preferred; if two are equally distant, the
+
+
+ 072 ones nearer to the merchant's home should be preferred.
+
+
+ 073 `merchant` may be passed as a map or a keyword; `commodity` should be
+
+
+ 074 passed as a keyword.
+
+
+ 075
+
+
+ 076 The returned plan is a map with keys:
+
+
+ 077
+
+
+ 078 * :merchant - the id of the `merchant` for whom the plan was created;
+
+
+ 079 * :origin - the city from which the trade starts;
+
+
+ 080 * :destination - the city to which the trade is planned;
+
+
+ 081 * :commodity - the `commodity` to be carried;
+
+
+ 082 * :buy-price - the price at which that `commodity` can be bought;
+
+
+ 083 * :expected-price - the price at which the `merchant` anticipates
+
+
+ 084 that `commodity` can be sold;
+
+
+ 085 * :distance - the number of stages in the planned journey
+
+
+ 086 * :dist-to-home - the distance from `destination` to the `merchant`'s
+
+
+ 087 home city."
+
+
+ 088 [merchant world commodity]
+
+
+ 089 (let [plans (generate-trade-plans merchant world commodity)
+
+
+ 090 best-prices (filter
+
+
+ 091 (make-target-filter
+
+
+ 092 [[:expected-price
+
+
+ 093 (apply
+
+
+ 094 max
+
+
+ 095 (filter number? (map :expected-price plans)))]])
+
+
+ 096 plans)]
+
+
+ 097 (first
+
+
+ 098 (sort-by
+
+
+ 099 ;; all other things being equal, a merchant would prefer to end closer
+
+
+ 100 ;; to home.
+
+
+ 101 #(- 0 (:dist-to-home %))
+
+
+ 102 ;; a merchant will seek the best price, but won't go further than
+
+
+ 103 ;; needed to get it.
+
+
+ 104 (filter
+
+
+ 105 (make-target-filter
+
+
+ 106 [[:distance
+
+
+ 107 (apply min (filter number? (map :distance best-prices)))]])
+
+
+ 108 best-prices)))))
+
+
+ 109
+
+
+ 110 (defn augment-plan
+
+
+ 111 "Augment this `plan` constructed in this `world` for this `merchant` with
+
+
+ 112 the `:quantity` of goods which should be bought and the `:expected-profit`
+
+
+ 113 of the trade.
+
+
+ 114
+
+
+ 115 Returns the augmented plan."
+
+
+ 116 [merchant world plan]
+
+
+ 117 (let [c (:commodity plan)
+
+
+ 118 o (:origin plan)
+
+
+ 119 q (min
+
+
+ 120 (or
+
+
+ 121 (-> world :cities o :stock c)
+
+
+ 122 0)
+
+
+ 123 (can-carry merchant world c)
+
+
+ 124 (can-afford merchant world c))
+
+
+ 125 p (* q (- (:expected-price plan) (:buy-price plan)))]
+
+
+ 126 (assoc plan :quantity q :expected-profit p)))
+
+
+ 127
+
+
+ 128 (defn select-cargo
+
+
+ 129 "A `merchant`, in a given location in a `world`, will choose to buy a cargo
+
+
+ 130 within the limit they are capable of carrying, which they can anticipate
+
+
+ 131 selling for a profit at a destination."
+
+
+ 132 [merchant world]
+
+
+ 133 (let [m (cond
+
+
+ 134 (keyword? merchant)
+
+
+ 135 (-> world :merchants merchant)
+
+
+ 136 (map? merchant)
+
+
+ 137 merchant)
+
+
+ 138 origin (:location m)
+
+
+ 139 available (-> world :cities origin :stock)
+
+
+ 140 plans (map
+
+
+ 141 #(augment-plan
+
+
+ 142 m
+
+
+ 143 world
+
+
+ 144 (plan-trade m world %))
+
+
+ 145 (filter
+
+
+ 146 #(let [q (-> world :cities origin :stock %)]
+
+
+ 147 (and (number? q) (pos? q)))
+
+
+ 148 (keys available)))]
+
+
+ 149 (if
+
+
+ 150 (not (empty? plans))
+
+
+ 151 (first
+
+
+ 152 (sort-by
+
+
+ 153 #(- 0 (:dist-to-home %))
+
+
+ 154 (filter
+
+
+ 155 (make-target-filter
+
+
+ 156 [[:expected-profit
+
+
+ 157 (apply max (filter number? (map :expected-profit plans)))]])
+
+
+ 158 plans))))))
+
+
+ 159
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/merchants/strategies/simple.clj.html b/docs/cloverage/cc/journeyman/the_great_game/merchants/strategies/simple.clj.html
new file mode 100644
index 0000000..48b73c0
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/merchants/strategies/simple.clj.html
@@ -0,0 +1,527 @@
+
+
+
+ cc/journeyman/the_great_game/merchants/strategies/simple.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.merchants.strategies.simple
+
+
+ 002 "Default trading strategy for merchants.
+
+
+ 003
+
+
+ 004 The simple strategy buys a single product in the local market if there is
+
+
+ 005 one which can be traded profitably, trades it to the chosen target market,
+
+
+ 006 and sells it there. If there is no commodity locally which can be traded
+
+
+ 007 profitably, moves towards home with no cargo. If at home and no commodity
+
+
+ 008 can be traded profitably, does not move."
+
+
+ 009 (:require [taoensso.timbre :as l :refer [info error spy]]
+
+
+ 010 [cc.journeyman.the-great-game.utils :refer [deep-merge]]
+
+
+ 011 [cc.journeyman.the-great-game.gossip.gossip :refer [move-gossip]]
+
+
+ 012 [cc.journeyman.the-great-game.merchants.planning :refer [augment-plan plan-trade select-cargo]]
+
+
+ 013 [cc.journeyman.the-great-game.merchants.merchant-utils :refer
+
+
+ 014 [add-stock add-known-prices]]
+
+
+ 015 [cc.journeyman.the-great-game.world.routes :refer [find-route]]))
+
+
+ 016
+
+
+ 017 (defn plan-and-buy
+
+
+ 018 "Return a world like this `world`, in which this `merchant` has planned
+
+
+ 019 a new trade, and bought appropriate stock for it. If no profitable trade
+
+
+ 020 can be planned, the merchant is simply moved towards their home."
+
+
+ 021 [merchant world]
+
+
+ 022 (let [m (cond
+
+
+ 023 (keyword? merchant)
+
+
+ 024 (-> world :merchants merchant)
+
+
+ 025 (map? merchant)
+
+
+ 026 merchant)
+
+
+ 027 id (:id m)
+
+
+ 028 location (:location m)
+
+
+ 029 market (-> world :cities location)
+
+
+ 030 plan (select-cargo merchant world)]
+
+
+ 031 (l/debug "plan-and-buy: merchant" id)
+
+
+ 032 (cond
+
+
+ 033 (seq? plan)
+
+
+ 034 (let
+
+
+ 035 [c (:commodity plan)
+
+
+ 036 p (* (:quantity plan) (:buy-price plan))
+
+
+ 037 q (:quantity plan)]
+
+
+ 038 (l/info "Merchant" id "bought" q "units of" c "at" location "for" p plan)
+
+
+ 039 {:merchants
+
+
+ 040 {id
+
+
+ 041 {:stock (add-stock (:stock m) {c q})
+
+
+ 042 :cash (- (:cash m) p)
+
+
+ 043 :known-prices (add-known-prices m world)
+
+
+ 044 :plan plan}}
+
+
+ 045 :cities
+
+
+ 046 {location
+
+
+ 047 {:stock (assoc (:stock market) c (- (-> market :stock c) q))
+
+
+ 048 :cash (+ (:cash market) p)}}})
+
+
+ 049 ;; if no plan, then if at home stay put
+
+
+ 050 (= (:location m) (:home m))
+
+
+ 051 (do
+
+
+ 052 (l/info "Merchant" id "remains at home in" location)
+
+
+ 053 {})
+
+
+ 054 ;; else move towards home
+
+
+ 055 :else
+
+
+ 056 (let [route (find-route world location (:home m))
+
+
+ 057 next-location (nth route 1)]
+
+
+ 058 (l/info "No trade possible at" location "; merchant" id "moves to" next-location)
+
+
+ 059 (merge
+
+
+ 060 {:merchants
+
+
+ 061 {id
+
+
+ 062 {:location next-location}}}
+
+
+ 063 (move-gossip id world next-location))))))
+
+
+ 064
+
+
+ 065 (defn re-plan
+
+
+ 066 "Having failed to sell a cargo at current location, re-plan a route to
+
+
+ 067 sell the current cargo. Returns a revised world."
+
+
+ 068 [merchant world]
+
+
+ 069 (let [m (cond
+
+
+ 070 (keyword? merchant)
+
+
+ 071 (-> world :merchants merchant)
+
+
+ 072 (map? merchant)
+
+
+ 073 merchant)
+
+
+ 074 id (:id m)
+
+
+ 075 location (:location m)
+
+
+ 076 plan (augment-plan m world (plan-trade m world (-> m :plan :commodity)))]
+
+
+ 077 (l/debug "re-plan: merchant" id)
+
+
+ 078 (deep-merge
+
+
+ 079 world
+
+
+ 080 {:merchants
+
+
+ 081 {id
+
+
+ 082 {:plan plan}}})))
+
+
+ 083
+
+
+ 084 (defn sell-and-buy
+
+
+ 085 "Return a new world like this `world`, in which this `merchant` has sold
+
+
+ 086 their current stock in their current location, and planned a new trade, and
+
+
+ 087 bought appropriate stock for it."
+
+
+ 088 ;; TODO: this either sells the entire cargo, or, if the market can't afford
+
+
+ 089 ;; it, none of it. And it does not cope with selling different commodities
+
+
+ 090 ;; in different markets.
+
+
+ 091 [merchant world]
+
+
+ 092 (let [m (cond
+
+
+ 093 (keyword? merchant)
+
+
+ 094 (-> world :merchants merchant)
+
+
+ 095 (map? merchant)
+
+
+ 096 merchant)
+
+
+ 097 id (:id m)
+
+
+ 098 location (:location m)
+
+
+ 099 market (-> world :cities location)
+
+
+ 100 stock-value (reduce
+
+
+ 101 +
+
+
+ 102 (map
+
+
+ 103 #(* (-> m :stock %) (-> market :prices m))
+
+
+ 104 (keys (:stock m))))]
+
+
+ 105 (l/debug "sell-and-buy: merchant" id)
+
+
+ 106 (if
+
+
+ 107 (>= (:cash market) stock-value)
+
+
+ 108 (do
+
+
+ 109 (l/info "Merchant" id "sells" (:stock m) "at" location "for" stock-value)
+
+
+ 110 (plan-and-buy
+
+
+ 111 merchant
+
+
+ 112 (deep-merge
+
+
+ 113 world
+
+
+ 114 {:merchants
+
+
+ 115 {id
+
+
+ 116 {:stock {}
+
+
+ 117 :cash (+ (:cash m) stock-value)
+
+
+ 118 :known-prices (add-known-prices m world)}}
+
+
+ 119 :cities
+
+
+ 120 {location
+
+
+ 121 {:stock (add-stock (:stock m) (:stock market))
+
+
+ 122 :cash (- (:cash market) stock-value)}}})))
+
+
+ 123 ;; else
+
+
+ 124 (re-plan merchant world))))
+
+
+ 125
+
+
+ 126 (defn move-merchant
+
+
+ 127 "Handle general en route movement of this `merchant` in this `world`;
+
+
+ 128 return a (partial or full) world like this `world` but in which the
+
+
+ 129 merchant may have been moved ot updated."
+
+
+ 130 [merchant world]
+
+
+ 131 (let [m (cond
+
+
+ 132 (keyword? merchant)
+
+
+ 133 (-> world :merchants merchant)
+
+
+ 134 (map? merchant)
+
+
+ 135 merchant)
+
+
+ 136 id (:id m)
+
+
+ 137 at-destination? (and (:plan m) (= (:location m) (-> m :plan :destination)))
+
+
+ 138 plan (:plan m)
+
+
+ 139 next-location (if plan
+
+
+ 140 (nth
+
+
+ 141 (find-route
+
+
+ 142 world
+
+
+ 143 (:location m)
+
+
+ 144 (:destination plan))
+
+
+ 145 1)
+
+
+ 146 (:location m))]
+
+
+ 147 (l/debug "move-merchant: merchant" id "at" (:location m)
+
+
+ 148 "destination" (-> m :plan :destination) "next" next-location
+
+
+ 149 "at destination" at-destination?)
+
+
+ 150 (cond
+
+
+ 151 ;; if the merchant is at the destination of their current plan
+
+
+ 152 ;; sell all cargo and repurchase.
+
+
+ 153 at-destination?
+
+
+ 154 (sell-and-buy merchant world)
+
+
+ 155 ;; if they don't have a plan, seek to create one
+
+
+ 156 (nil? plan)
+
+
+ 157 (plan-and-buy merchant world)
+
+
+ 158 ;; otherwise, move one step towards their destination
+
+
+ 159 (and next-location (not= next-location (:location m)))
+
+
+ 160 (do
+
+
+ 161 (l/info "Merchant " id " moving from " (:location m) " to " next-location)
+
+
+ 162 (deep-merge
+
+
+ 163 {:merchants
+
+
+ 164 {id
+
+
+ 165 {:location next-location
+
+
+ 166 :known-prices (add-known-prices m world)}}}
+
+
+ 167 (move-gossip id world next-location)))
+
+
+ 168 :else
+
+
+ 169 (do
+
+
+ 170 (l/info "Merchant" id "has plan but no next-location; currently at"
+
+
+ 171 (:location m) ", destination is" (:destination plan))
+
+
+ 172 world))))
+
+
+ 173
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/objects/container.clj.html b/docs/cloverage/cc/journeyman/the_great_game/objects/container.clj.html
new file mode 100644
index 0000000..0140330
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/objects/container.clj.html
@@ -0,0 +1,41 @@
+
+
+
+ cc/journeyman/the_great_game/objects/container.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.objects.container
+
+
+ 002 (:require
+
+
+ 003 [cc.journeyman.the-great-game.objects.game-object :refer :all]))
+
+
+ 004
+
+
+ 005 (defprotocol ProtoContainer
+
+
+ 006 (contents
+
+
+ 007 [container]
+
+
+ 008 "Return a sequence of the contents of this `container`, or `nil` if empty.")
+
+
+ 009 (is-empty?
+
+
+ 010 [container]
+
+
+ 011 "Return `true` if this `container` is empty, else `false`."))
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/objects/game_object.clj.html b/docs/cloverage/cc/journeyman/the_great_game/objects/game_object.clj.html
new file mode 100644
index 0000000..32e0483
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/objects/game_object.clj.html
@@ -0,0 +1,71 @@
+
+
+
+ cc/journeyman/the_great_game/objects/game_object.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.objects.game-object
+
+
+ 002 "Anything at all in the game world")
+
+
+ 003
+
+
+ 004 (defprotocol ProtoObject
+
+
+ 005 "An object in the world"
+
+
+ 006 (id [object] "Returns the unique id of this object.")
+
+
+ 007 (reify-object
+
+
+ 008 [object]
+
+
+ 009 "Adds this `object` to the global object list. If the `object` has a
+
+
+ 010 non-nil value for its `id` method, keys it to that id - **but** if the
+
+
+ 011 id value is already in use, throws a hard exception. Returns the id to
+
+
+ 012 which the object is keyed in the global object list."))
+
+
+ 013
+
+
+ 014 (defrecord GameObject
+
+
+ 015 [id]
+
+
+ 016 ;; "An object in the world"
+
+
+ 017 ProtoObject
+
+
+ 018 (id [_] id)
+
+
+ 019 (reify-object [object]
+
+
+ 020 "TODO: doesn't work yet"
+
+
+ 021 object))
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/playroom.clj.html b/docs/cloverage/cc/journeyman/the_great_game/playroom.clj.html
new file mode 100644
index 0000000..a2574c4
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/playroom.clj.html
@@ -0,0 +1,224 @@
+
+
+
+ cc/journeyman/the_great_game/playroom.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.playroom
+
+
+ 002 (:require [jme-clj.core :refer [add add-to-root box defsimpleapp fly-cam geo
+
+
+ 003 get* get-state load-texture rotate run set*
+
+
+ 004 setc set-state start unshaded-mat]])
+
+
+ 005 (:import [com.jme3.math ColorRGBA]))
+
+
+ 006
+
+
+ 007 ;; At present this file is just somewhere to play around with jme-clj examples
+
+
+ 008
+
+
+ 009 (declare app)
+
+
+ 010
+
+
+ 011 (defn init []
+
+
+ 012 (let [cube (geo "jMonkey cube" (box 1 1 1))
+
+
+ 013 mat (unshaded-mat)]
+
+
+ 014 (set* mat :texture "ColorMap" (load-texture "textures/Monkey.jpg"))
+
+
+ 015 (set* cube :material mat)
+
+
+ 016 (add-to-root cube)
+
+
+ 017 {:cube cube}))
+
+
+ 018
+
+
+ 019 ;; Let's create simple-update fn with no body for now.
+
+
+ 020 (defn simple-update [tpf]
+
+
+ 021 (let [{:keys [cube]} (get-state)]
+
+
+ 022 (rotate cube 0 (* 2 tpf) 0)))
+
+
+ 023
+
+
+ 024
+
+
+ 025 ;; Kills the running app var and closes its window.
+
+
+ 026 ;; (unbind-app #'app)
+
+
+ 027
+
+
+ 028 ;; We define the `app` var.
+
+
+ 029 (defsimpleapp app
+
+
+ 030 :opts {:show-settings? false
+
+
+ 031 :pause-on-lost-focus? false
+
+
+ 032 :settings {:title "My JME Game"
+
+
+ 033 :load-defaults? true
+
+
+ 034 :frame-rate 60
+
+
+ 035 :width 800
+
+
+ 036 :height 600}}
+
+
+ 037 :init init
+
+
+ 038 :update simple-update)
+
+
+ 039
+
+
+ 040 (start app)
+
+
+ 041
+
+
+ 042 ;; Reinitialises the running app
+
+
+ 043 ;;(run app
+
+
+ 044 ;; (re-init init))
+
+
+ 045
+
+
+ 046 ;; By default, there is a Fly Camera attached to the app that you can control with W, A, S and D keys.
+
+
+ 047 ;; Let's increase its movement speed. Now, you fly faster :)
+
+
+ 048 (run app
+
+
+ 049 (set* (fly-cam) :move-speed 15))
+
+
+ 050
+
+
+ 051
+
+
+ 052 ;; Updates the app
+
+
+ 053 (run app
+
+
+ 054 (let [{:keys [cube]} (get-state)]
+
+
+ 055 (set* cube :local-translation (add (get* cube :local-translation) 1 1 1))))
+
+
+ 056
+
+
+ 057 ;; Updates the app adding a second cube
+
+
+ 058 (run app
+
+
+ 059 (let [cube (geo "jMonkey cube" (box 1 1 1))
+
+
+ 060 mat (unshaded-mat)]
+
+
+ 061 (set* mat :texture "ColorMap" (load-texture "textures/Monkey.jpg"))
+
+
+ 062 (setc cube
+
+
+ 063 :material mat
+
+
+ 064 :local-translation [-3 0 0])
+
+
+ 065 (add-to-root cube)
+
+
+ 066 (set-state :cube2 cube)))
+
+
+ 067
+
+
+ 068 ;; We added the new cube, but it's not rotating. We need to update the simple-update fn.
+
+
+ 069 (defn simple-update [tpf]
+
+
+ 070 (let [{:keys [cube cube2]} (get-state)]
+
+
+ 071 (rotate cube 0 (* 2 tpf) 0)
+
+
+ 072 (rotate cube2 0 (* 2 tpf) 0)))
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/time.clj.html b/docs/cloverage/cc/journeyman/the_great_game/time.clj.html
new file mode 100644
index 0000000..f869045
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/time.clj.html
@@ -0,0 +1,440 @@
+
+
+
+ cc/journeyman/the_great_game/time.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.time
+
+
+ 002 (:require [clojure.string :as s]))
+
+
+ 003
+
+
+ 004 (def game-start-time
+
+
+ 005 "The start time of this run."
+
+
+ 006 (System/currentTimeMillis))
+
+
+ 007
+
+
+ 008 (def ^:const game-day-length
+
+
+ 009 "The Java clock advances in milliseconds, which is fine.
+
+
+ 010 But we need game-days to be shorter than real world days.
+
+
+ 011 A Witcher 3 game day is 1 hour 36 minutes, or 96 minutes, which is
+
+
+ 012 presumably researched. Round it up to 100 minutes for easier
+
+
+ 013 calculation."
+
+
+ 014 (* 100 ;; minutes per game day
+
+
+ 015 60 ;; seconds per minute
+
+
+ 016 1000)) ;; milliseconds per second
+
+
+ 017
+
+
+ 018 (defn now
+
+
+ 019 "For now, we'll use Java timestamp for time; ultimately, we need a
+
+
+ 020 concept of game-time which allows us to drive day/night cycle, seasons,
+
+
+ 021 et cetera, but what matters about time is that it is a value which
+
+
+ 022 increases."
+
+
+ 023 []
+
+
+ 024 (System/currentTimeMillis))
+
+
+ 025
+
+
+ 026 (def ^:const canonical-ordering-of-houses
+
+
+ 027 "The canonical ordering of religious houses."
+
+
+ 028 [:eye
+
+
+ 029 :foot
+
+
+ 030 :nose
+
+
+ 031 :hand
+
+
+ 032 :ear
+
+
+ 033 :mouth
+
+
+ 034 :stomach
+
+
+ 035 :furrow
+
+
+ 036 :plough])
+
+
+ 037
+
+
+ 038 (def ^:const days-of-week
+
+
+ 039 "The eight-day week of the game world. This differs from the canonical
+
+
+ 040 ordering of houses in that it omits the eye."
+
+
+ 041 (rest canonical-ordering-of-houses))
+
+
+ 042
+
+
+ 043 (def ^:const days-in-week
+
+
+ 044 "This world has an eight day week."
+
+
+ 045 (count days-of-week))
+
+
+ 046
+
+
+ 047 (def ^:const seasons-of-year
+
+
+ 048 "The ordering of seasons in the year is different from the canonical
+
+
+ 049 ordering of the houses, for reasons of the agricultural cycle."
+
+
+ 050 [:foot
+
+
+ 051 :nose
+
+
+ 052 :hand
+
+
+ 053 :ear
+
+
+ 054 :mouth
+
+
+ 055 :stomach
+
+
+ 056 :plough
+
+
+ 057 :furrow
+
+
+ 058 :eye])
+
+
+ 059
+
+
+ 060 (def ^:const seasons-in-year
+
+
+ 061 "Nine seasons in a year, one for each house (although the order is
+
+
+ 062 different."
+
+
+ 063 (count seasons-of-year))
+
+
+ 064
+
+
+ 065 (def ^:const weeks-of-season
+
+
+ 066 "To fit nine seasons of eight day weeks into 365 days, each must be of
+
+
+ 067 five weeks."
+
+
+ 068 [:first :second :third :fourth :fifth])
+
+
+ 069
+
+
+ 070 (def ^:const weeks-in-season
+
+
+ 071 "To fit nine seasons of eight day weeks into 365 days, each must be of
+
+
+ 072 five weeks."
+
+
+ 073 (count weeks-of-season))
+
+
+ 074
+
+
+ 075 (def ^:const days-in-season
+
+
+ 076 (* weeks-in-season days-in-week))
+
+
+ 077
+
+
+ 078 (defn game-time
+
+
+ 079 "With no arguments, the current game time. If a Java `timestamp` value is
+
+
+ 080 passed (as a `long`), the game time represented by that value."
+
+
+ 081 ([] (game-time (now)))
+
+
+ 082 ([timestamp]
+
+
+ 083 (- timestamp game-start-time)))
+
+
+ 084
+
+
+ 085 (defmacro day-of-year
+
+
+ 086 "The day of the year represented by this `game-time`, ignoring leap years."
+
+
+ 087 [game-time]
+
+
+ 088 `(mod (long (/ ~game-time game-day-length)) 365))
+
+
+ 089
+
+
+ 090 (def waiting-day?
+
+
+ 091 "Does this `game-time` represent a waiting day?"
+
+
+ 092 (memoize
+
+
+ 093 ;; we're likely to call this several times in quick succession on the
+
+
+ 094 ;; same timestamp
+
+
+ 095 (fn [game-time]
+
+
+ 096 (>=
+
+
+ 097 (day-of-year game-time)
+
+
+ 098 (* seasons-in-year weeks-in-season days-in-week)))))
+
+
+ 099
+
+
+ 100 (defn day
+
+
+ 101 "Day of the eight-day week represented by this `game-time`."
+
+
+ 102 [game-time]
+
+
+ 103 (let [day-of-week (mod (day-of-year game-time) days-in-week)]
+
+
+ 104 (if (waiting-day? game-time)
+
+
+ 105 (nth weeks-of-season day-of-week)
+
+
+ 106 (nth days-of-week day-of-week))))
+
+
+ 107
+
+
+ 108 (defn week
+
+
+ 109 "Week of season represented by this `game-time`."
+
+
+ 110 [game-time]
+
+
+ 111 (let [day-of-season (mod (day-of-year game-time) days-in-season)
+
+
+ 112 week (/ day-of-season days-in-week)]
+
+
+ 113 (if (waiting-day? game-time)
+
+
+ 114 :waiting
+
+
+ 115 (nth weeks-of-season week))))
+
+
+ 116
+
+
+ 117 (defn season
+
+
+ 118 [game-time]
+
+
+ 119 (let [season (int (/ (day-of-year game-time) days-in-season))]
+
+
+ 120 (if (waiting-day? game-time)
+
+
+ 121 :waiting
+
+
+ 122 (nth seasons-of-year season))))
+
+
+ 123
+
+
+ 124 (defn date-string
+
+
+ 125 "Return a correctly formatted date for this `game-time` in the calendar of
+
+
+ 126 the Great Place."
+
+
+ 127 [game-time]
+
+
+ 128 (s/join
+
+
+ 129 " "
+
+
+ 130 (if
+
+
+ 131 (waiting-day? game-time)
+
+
+ 132 [(s/capitalize
+
+
+ 133 (name
+
+
+ 134 (nth
+
+
+ 135 weeks-of-season
+
+
+ 136 (mod (day-of-year game-time) days-in-week))))
+
+
+ 137 "waiting day"]
+
+
+ 138 [(s/capitalize (name (week game-time)))
+
+
+ 139 (s/capitalize (name (day game-time)))
+
+
+ 140 "of the"
+
+
+ 141 (s/capitalize (name (season game-time)))])))
+
+
+ 142
+
+
+ 143
+
+
+ 144
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/utils.clj.html b/docs/cloverage/cc/journeyman/the_great_game/utils.clj.html
new file mode 100644
index 0000000..640231f
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/utils.clj.html
@@ -0,0 +1,143 @@
+
+
+
+ cc/journeyman/the_great_game/utils.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.utils)
+
+
+ 002
+
+
+ 003 (defn cyclic?
+
+
+ 004 "True if two or more elements of `route` are identical"
+
+
+ 005 [route]
+
+
+ 006 (not= (count route)(count (set route))))
+
+
+ 007
+
+
+ 008 (defn deep-merge
+
+
+ 009 "Recursively merges maps. Stolen from
+
+
+ 010 https://dnaeon.github.io/recursively-merging-maps-in-clojure/"
+
+
+ 011 [& maps]
+
+
+ 012 (letfn [(m [& xs]
+
+
+ 013 (if (some #(and (map? %) (not (record? %))) xs)
+
+
+ 014 (apply merge-with m xs)
+
+
+ 015 (last xs)))]
+
+
+ 016 (reduce m maps)))
+
+
+ 017
+
+
+ 018 (defn make-target-filter
+
+
+ 019 "Construct a filter which, when applied to a list of maps,
+
+
+ 020 will pass those which match these `targets`, where each target
+
+
+ 021 is a tuple [key value]."
+
+
+ 022 ;; TODO: this would probably be more elegant as a macro
+
+
+ 023 [targets]
+
+
+ 024 (eval
+
+
+ 025 (list
+
+
+ 026 'fn
+
+
+ 027 (vector 'm)
+
+
+ 028 (cons
+
+
+ 029 'and
+
+
+ 030 (map
+
+
+ 031 #(list
+
+
+ 032 '=
+
+
+ 033 (list (first %) 'm)
+
+
+ 034 (nth % 1))
+
+
+ 035 targets)))))
+
+
+ 036
+
+
+ 037 (defn value-or-default
+
+
+ 038 "Return the value of this key `k` in this map `m`, or this `dflt` value if
+
+
+ 039 there is none."
+
+
+ 040 [m k dflt]
+
+
+ 041 (or (when (map? m) (m k)) dflt))
+
+
+ 042
+
+
+ 043 ;; (value-or-default {:x 0 :y 0 :altitude 7} :altitude 8)
+
+
+ 044 ;; (value-or-default {:x 0 :y 0 :altitude 7} :alt 8)
+
+
+ 045 ;; (value-or-default nil :altitude 8)
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/world/heightmap.clj.html b/docs/cloverage/cc/journeyman/the_great_game/world/heightmap.clj.html
new file mode 100644
index 0000000..4ca6508
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/world/heightmap.clj.html
@@ -0,0 +1,485 @@
+
+
+
+ cc/journeyman/the_great_game/world/heightmap.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.world.heightmap
+
+
+ 002 "Functions dealing with the tessellated multi-layer heightmap."
+
+
+ 003 (:require [clojure.math.numeric-tower :refer [expt sqrt]]
+
+
+ 004 [mw-engine.core :refer []]
+
+
+ 005 [mw-engine.heightmap :refer [apply-heightmap]]
+
+
+ 006 [mw-engine.utils :refer [get-cell in-bounds? map-world]]
+
+
+ 007 [cc.journeyman.the-great-game.utils :refer [value-or-default]]))
+
+
+ 008
+
+
+ 009 ;; It's not at all clear to me yet what the workflow for getting a MicroWorld
+
+
+ 010 ;; map into The Great Game, and whether it passes through Walkmap to get here.
+
+
+ 011 ;; This file as currently written assumes it doesn't.
+
+
+ 012
+
+
+ 013 ;; It's utterly impossible to hold a whole continent at one metre scale in
+
+
+ 014 ;; memory at one time. So we have to be able to regenerate high resolution
+
+
+ 015 ;; surfaces from much lower resolution heightmaps.
+
+
+ 016 ;;
+
+
+ 017 ;; Thus to reproduce a segment of surface at a particular level of detail,
+
+
+ 018 ;; we:
+
+
+ 019 ;; 1. load the base heightmap into a grid (see
+
+
+ 020 ;; `mw-engine.heightmap/apply-heightmap`);
+
+
+ 021 ;; 2. scale the base hightmap to kilometre scale (see `scale-grid`);
+
+
+ 022 ;; 3. exerpt the portion of that that we want to reproduce (see `exerpt-grid`);
+
+
+ 023 ;; 4. interpolate that grid to get the resolution we require (see
+
+
+ 024 ;; `interpolate-grid`);
+
+
+ 025 ;; 5. create an appropriate purturbation grid from the noise map(s) for the
+
+
+ 026 ;; same coordinates to break up the smooth interpolation;
+
+
+ 027 ;; 6. sum the altitudes of the two grids.
+
+
+ 028 ;;
+
+
+ 029 ;; In production this will have to be done **very** fast!
+
+
+ 030
+
+
+ 031 (def ^:dynamic *base-map* "resources/maps/heightmap.png")
+
+
+ 032 (def ^:dynamic *noise-map* "resources/maps/noise.png")
+
+
+ 033
+
+
+ 034 (defn scale-grid
+
+
+ 035 "multiply all `:x` and `:y` values in this `grid` by this `n`."
+
+
+ 036 [grid n]
+
+
+ 037 (map-world grid (fn [w c x] (assoc c :x (* (:x c) n) :y (* (:y c) n)))))
+
+
+ 038
+
+
+ 039
+
+
+ 040
+
+
+ 041 ;; Each of the east-west curve and the north-south curve are of course two
+
+
+ 042 ;; dimensional curves; the east-west curve is in the :x/:z plane and the
+
+
+ 043 ;; north-south curve is in the :y/:z plane (except, perhaps unwisely,
+
+
+ 044 ;; we've been using :altitude to label the :z plane). We have a library
+
+
+ 045 ;; function `walkmap.edge/intersection2d`, but as currently written it
+
+
+ 046 ;; can only find intersections in :x/:y plane.
+
+
+ 047 ;;
+
+
+ 048 ;; TODO: rewrite the function so that it can use arbitrary coordinates.
+
+
+ 049 ;; AFTER TRYING: OK, there are too many assumptions about the way that
+
+
+ 050 ;; function is written to allow for easy rotation. TODO: think!
+
+
+ 051
+
+
+ 052 (defn interpolate-altitude
+
+
+ 053 "Return the altitude of the point at `x-offset`, `y-offset` within this
+
+
+ 054 `cell` having this `src-width`, taken from this `grid`."
+
+
+ 055 [cell grid src-width x-offset y-offset ]
+
+
+ 056 (let [c-alt (:altitude cell)
+
+
+ 057 n-alt (or (:altitude (get-cell grid (:x cell) (dec (:y cell)))) c-alt)
+
+
+ 058 w-alt (or (:altitude (get-cell grid (inc (:x cell)) (:y cell))) c-alt)
+
+
+ 059 s-alt (or (:altitude (get-cell grid (:x cell) (inc (:y cell)))) c-alt)
+
+
+ 060 e-alt (or (:altitude (get-cell grid (dec (:x cell)) (:y cell))) c-alt)]
+
+
+ 061 ;; TODO: construct two curves (arcs of circles good enough for now)
+
+
+ 062 ;; n-alt...c-alt...s-alt and e-alt...c-alt...w-alt;
+
+
+ 063 ;; then interpolate x-offset along e-alt...c-alt...w-alt and y-offset
+
+
+ 064 ;; along n-alt...c-alt...s-alt;
+
+
+ 065 ;; then return the average of the two
+
+
+ 066
+
+
+ 067 0))
+
+
+ 068
+
+
+ 069 (defn interpolate-cell
+
+
+ 070 "Construct a grid (array of arrays) of cells each of width `target-width`
+
+
+ 071 from this `cell`, of width `src-width`, taken from this `grid`"
+
+
+ 072 [cell grid src-width target-width]
+
+
+ 073 (let [offsets (map #(* target-width %) (range (/ src-width target-width)))]
+
+
+ 074 (into
+
+
+ 075 []
+
+
+ 076 (map
+
+
+ 077 (fn [r]
+
+
+ 078 (into
+
+
+ 079 []
+
+
+ 080 (map
+
+
+ 081 (fn [c]
+
+
+ 082 (assoc cell
+
+
+ 083 :x (+ (:x cell) c)
+
+
+ 084 :y (+ (:y cell) r)
+
+
+ 085 :altitude (interpolate-altitude cell grid src-width c r)))
+
+
+ 086 offsets)))
+
+
+ 087 offsets))))
+
+
+ 088
+
+
+ 089 (defn interpolate-grid
+
+
+ 090 "Return a grid interpolated from this `grid` of rows, cols given scaling
+
+
+ 091 from this `src-width` to this `target-width`"
+
+
+ 092 [grid src-width target-width]
+
+
+ 093 (reduce
+
+
+ 094 concat
+
+
+ 095 (into
+
+
+ 096 []
+
+
+ 097 (map
+
+
+ 098 (fn [row]
+
+
+ 099 (reduce
+
+
+ 100 (fn [g1 g2]
+
+
+ 101 (into [] (map #(into [] (concat %1 %2)) g1 g2)))
+
+
+ 102 (into [] (map #(interpolate-cell % grid src-width target-width) row))))
+
+
+ 103 grid))))
+
+
+ 104
+
+
+ 105 (defn excerpt-grid
+
+
+ 106 "Return that section of this `grid` where the `:x` co-ordinate of each cell
+
+
+ 107 is greater than or equal to this `x-offset`, the `:y` co-ordinate is greater
+
+
+ 108 than or equal to this `y-offset`, whose width is not greater than this
+
+
+ 109 `width`, and whose height is not greater than this `height`."
+
+
+ 110 [grid x-offset y-offset width height]
+
+
+ 111 (into
+
+
+ 112 []
+
+
+ 113 (remove
+
+
+ 114 nil?
+
+
+ 115 (map
+
+
+ 116 (fn [row]
+
+
+ 117 (when
+
+
+ 118 (and
+
+
+ 119 (>= (:y (first row)) y-offset)
+
+
+ 120 (< (:y (first row)) (+ y-offset height)))
+
+
+ 121 (into
+
+
+ 122 []
+
+
+ 123 (remove
+
+
+ 124 nil?
+
+
+ 125 (map
+
+
+ 126 (fn [cell]
+
+
+ 127 (when
+
+
+ 128 (and
+
+
+ 129 (>= (:x cell) x-offset)
+
+
+ 130 (< (:x cell) (+ x-offset width)))
+
+
+ 131 cell))
+
+
+ 132 row)))))
+
+
+ 133 grid))))
+
+
+ 134
+
+
+ 135 (defn get-surface
+
+
+ 136 "Return, as a vector of vectors of cells represented as Clojure maps, a
+
+
+ 137 segment of surface from this `base-map` as modified by this
+
+
+ 138 `noise-map` at this `cell-size` starting at this `x-offset` and `y-offset`
+
+
+ 139 and having this `width` and `height`.
+
+
+ 140
+
+
+ 141 If `base-map` and `noise-map` are not supplied, the bindings of `*base-map*`
+
+
+ 142 and `*noise-map*` will be used, respectively.
+
+
+ 143
+
+
+ 144 `base-map` and `noise-map` may be passed either as strings, assumed to be
+
+
+ 145 file paths of PNG files, or as MicroWorld style world arrays. It is assumed
+
+
+ 146 that one pixel in `base-map` represents one square kilometre in the game
+
+
+ 147 world. It is assumed that `cell-size`, `x-offset`, `y-offset`, `width` and
+
+
+ 148 `height` are integer numbers of metres."
+
+
+ 149 ([cell-size x-offset y-offset width height]
+
+
+ 150 (get-surface *base-map* *noise-map* cell-size x-offset y-offset width height))
+
+
+ 151 ([base-map noise-map cell-size x-offset y-offset width height]
+
+
+ 152 (let [b (if (seq? base-map) base-map (scale-grid (apply-heightmap base-map) 1000))
+
+
+ 153 n (if (seq? noise-map) noise-map (apply-heightmap noise-map))]
+
+
+ 154 (if (and (in-bounds? b x-offset y-offset)
+
+
+ 155 (in-bounds? b (+ x-offset width) (+ y-offset height)))
+
+
+ 156 b ;; actually do stuff
+
+
+ 157 (throw (Exception. "Surface out of bounds for map.")))
+
+
+ 158 )))
+
+
+ 159
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/world/location.clj.html b/docs/cloverage/cc/journeyman/the_great_game/world/location.clj.html
new file mode 100644
index 0000000..d8fdc31
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/world/location.clj.html
@@ -0,0 +1,119 @@
+
+
+
+ cc/journeyman/the_great_game/world/location.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.world.location
+
+
+ 002 "Functions dealing with location in the world."
+
+
+ 003 (:require [clojure.math.numeric-tower :refer [expt sqrt]]))
+
+
+ 004
+
+
+ 005 ;; A 'location' value is a list comprising at most the x/y coordinate location
+
+
+ 006 ;; and the ids of the settlement and region (possibly hierarchically) that contain
+
+
+ 007 ;; the location. If the x/y is not local to the home of the receiving agent, they
+
+
+ 008 ;; won't remember it and won't pass it on; if any of the ids are not interesting
+
+
+ 009 ;; So location information will degrade progressively as the item is passed along.
+
+
+ 010
+
+
+ 011 ;; It is assumed that the `:home` of a character is a location in this sense.
+
+
+ 012
+
+
+ 013 (defn get-coords
+
+
+ 014 "Return the coordinates in the game world of `location`, which may be
+
+
+ 015 1. A coordinate pair in the format {:x 5 :y 32};
+
+
+ 016 2. A location, as discussed above;
+
+
+ 017 3. Any other gameworld object, having a `:location` property whose value
+
+
+ 018 is one of the above."
+
+
+ 019 [location]
+
+
+ 020 (cond
+
+
+ 021 (empty? location) nil
+
+
+ 022 (map? location)
+
+
+ 023 (cond
+
+
+ 024 (and (number? (:x location)) (number? (:y location)))
+
+
+ 025 location
+
+
+ 026 (:location location)
+
+
+ 027 (:location location))
+
+
+ 028 :else
+
+
+ 029 (get-coords (first (remove keyword? location)))))
+
+
+ 030
+
+
+ 031 (defn distance-between
+
+
+ 032 [location-1 location-2]
+
+
+ 033 (let [c1 (get-coords location-1)
+
+
+ 034 c2 (get-coords location-2)]
+
+
+ 035 (when
+
+
+ 036 (and c1 c2)
+
+
+ 037 (sqrt (+ (expt (- (:x c1) (:x c2)) 2) (expt (- (:y c1) (:y c2)) 2))))))
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/world/mw.clj.html b/docs/cloverage/cc/journeyman/the_great_game/world/mw.clj.html
new file mode 100644
index 0000000..80194bc
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/world/mw.clj.html
@@ -0,0 +1,29 @@
+
+
+
+ cc/journeyman/the_great_game/world/mw.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.world.mw
+
+
+ 002 "Functions dealing with building a great game world from a MicroWorld world."
+
+
+ 003 (:require [clojure.math.numeric-tower :refer [expt sqrt]]
+
+
+ 004 [mw-engine.core :refer []]
+
+
+ 005 [mw-engine.world :refer []]))
+
+
+ 006
+
+
+ 007 ;; It's not at all clear to me yet what the workflow for getting a MicroWorld map into The Great Game, and whether it passes through Walkmap to get here. This file as currently written assumes it doesn't.
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/world/routes.clj.html b/docs/cloverage/cc/journeyman/the_great_game/world/routes.clj.html
new file mode 100644
index 0000000..5d5ee4e
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/world/routes.clj.html
@@ -0,0 +1,173 @@
+
+
+
+ cc/journeyman/the_great_game/world/routes.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.world.routes
+
+
+ 002 "Conceptual (plan level) routes, represented as tuples of location ids."
+
+
+ 003 (:require [cc.journeyman.the-great-game.utils :refer [cyclic?]]))
+
+
+ 004
+
+
+ 005 (defn find-routes
+
+
+ 006 "Find routes from among these `routes` from `from`; if `to` is supplied,
+
+
+ 007 to `to`, by breadth-first search."
+
+
+ 008 ([routes from]
+
+
+ 009 (map
+
+
+ 010 (fn [to] (cons from to))
+
+
+ 011 (remove
+
+
+ 012 empty?
+
+
+ 013 (map
+
+
+ 014 (fn [route]
+
+
+ 015 (remove
+
+
+ 016 #(= from %)
+
+
+ 017 (if (some #(= % from) route) route)))
+
+
+ 018 routes))))
+
+
+ 019 ([routes from to]
+
+
+ 020 (let [steps (find-routes routes from)
+
+
+ 021 found (filter
+
+
+ 022 (fn [step] (if (some #(= to %) step) step))
+
+
+ 023 steps)]
+
+
+ 024 (if
+
+
+ 025 (empty? found)
+
+
+ 026 (find-routes routes from to steps)
+
+
+ 027 found)))
+
+
+ 028 ([routes from to steps]
+
+
+ 029 (if
+
+
+ 030 (not (empty? steps))
+
+
+ 031 (let [paths (remove
+
+
+ 032 cyclic?
+
+
+ 033 (mapcat
+
+
+ 034 (fn [path]
+
+
+ 035 (map
+
+
+ 036 (fn [x] (concat path (rest x)))
+
+
+ 037 (find-routes routes (last path))))
+
+
+ 038 steps))
+
+
+ 039 found (filter
+
+
+ 040 #(= (last %) to) paths)]
+
+
+ 041 (if
+
+
+ 042 (empty? found)
+
+
+ 043 (find-routes routes from to paths)
+
+
+ 044 found)))))
+
+
+ 045
+
+
+ 046 (defn find-route
+
+
+ 047 "Find a single route from `from` to `to` in this `world-or-routes`, which
+
+
+ 048 may be either a world as defined in [[the-great-game.world.world]] or else
+
+
+ 049 a sequence of tuples of keywords."
+
+
+ 050 [world-or-routes from to]
+
+
+ 051 (first
+
+
+ 052 (find-routes
+
+
+ 053 (or (:routes world-or-routes) world-or-routes)
+
+
+ 054 from
+
+
+ 055 to)))
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/world/run.clj.html b/docs/cloverage/cc/journeyman/the_great_game/world/run.clj.html
new file mode 100644
index 0000000..f161313
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/world/run.clj.html
@@ -0,0 +1,125 @@
+
+
+
+ cc/journeyman/the_great_game/world/run.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.world.run
+
+
+ 002 "Run the whole simulation"
+
+
+ 003 (:require [environ.core :refer [env]]
+
+
+ 004 [taoensso.timbre :as timbre]
+
+
+ 005 [taoensso.timbre.appenders.3rd-party.rotor :as rotor]
+
+
+ 006 [cc.journeyman.the-great-game.gossip.gossip :as g]
+
+
+ 007 [cc.journeyman.the-great-game.merchants.merchants :as m]
+
+
+ 008 [cc.journeyman.the-great-game.merchants.markets :as k]
+
+
+ 009 [cc.journeyman.the-great-game.world.world :as w]))
+
+
+ 010
+
+
+ 011 (defn init
+
+
+ 012 ([]
+
+
+ 013 (init {}))
+
+
+ 014 ([config]
+
+
+ 015 (timbre/merge-config!
+
+
+ 016 {:appenders
+
+
+ 017 {:rotor (rotor/rotor-appender
+
+
+ 018 {:path "the-great-game.log"
+
+
+ 019 :max-size (* 512 1024)
+
+
+ 020 :backlog 10})}
+
+
+ 021 :level (or
+
+
+ 022 (:log-level config)
+
+
+ 023 (if (env :dev) :debug)
+
+
+ 024 :info)})))
+
+
+ 025
+
+
+ 026 (defn run
+
+
+ 027 "The pipeline to run the simulation each game day. Returns a world like
+
+
+ 028 this world, with all the various active elements updated. The optional
+
+
+ 029 `date` argument, if supplied, is set as the `:date` of the returned world."
+
+
+ 030 ([world]
+
+
+ 031 (g/run
+
+
+ 032 (m/run
+
+
+ 033 (k/run
+
+
+ 034 (w/run world)))))
+
+
+ 035 ([world date]
+
+
+ 036 (g/run
+
+
+ 037 (m/run
+
+
+ 038 (k/run
+
+
+ 039 (w/run world date))))))
+
+
+
diff --git a/docs/cloverage/cc/journeyman/the_great_game/world/world.clj.html b/docs/cloverage/cc/journeyman/the_great_game/world/world.clj.html
new file mode 100644
index 0000000..7170770
--- /dev/null
+++ b/docs/cloverage/cc/journeyman/the_great_game/world/world.clj.html
@@ -0,0 +1,584 @@
+
+
+
+ cc/journeyman/the_great_game/world/world.clj
+
+
+
+ 001 (ns cc.journeyman.the-great-game.world.world
+
+
+ 002 "Access to data about the world")
+
+
+ 003
+
+
+ 004 ;;; The world has to work either as map or a database. Initially, and for
+
+
+ 005 ;;; unit tests, I'll use a map; later, there will be a database. But the
+
+
+ 006 ;;; API needs to be agnostic, so that heirarchies which interact with
+
+
+ 007 ;;; `world` don't have to know which they've got - as far as they're concerned
+
+
+ 008 ;;; it's just a handle.
+
+
+ 009
+
+
+ 010 (def default-world
+
+
+ 011 "A basic world for testing concepts"
+
+
+ 012 {:date 0 ;; the age of this world in game days
+
+
+ 013 :cities
+
+
+ 014 {:aberdeen
+
+
+ 015 {:id :aberdeen
+
+
+ 016 :supplies
+
+
+ 017 ;; `supplies` is the quantity of each commodity added to the stock
+
+
+ 018 ;; each game day. If the price in the market is lower than 1 (the
+
+
+ 019 ;; cost of production of a unit) no goods will be added.
+
+
+ 020 {:fish 10
+
+
+ 021 :leather 5}
+
+
+ 022 :demands
+
+
+ 023 ;; `stock` is the quantity of each commodity in the market at any
+
+
+ 024 ;; given time. It is adjusted for production and consumption at
+
+
+ 025 ;; the end of each game day.
+
+
+ 026 {:iron 1
+
+
+ 027 :cloth 10
+
+
+ 028 :whisky 10}
+
+
+ 029 :port true
+
+
+ 030 :prices
+
+
+ 031 ;; `prices`: the current price (both buying and selling, for simplicity)
+
+
+ 032 ;; of each commodity in the market. Updated each game day based on current
+
+
+ 033 ;; stock.
+
+
+ 034 {:cloth 1
+
+
+ 035 :fish 1
+
+
+ 036 :leather 1
+
+
+ 037 :iron 1
+
+
+ 038 :whisky 1}
+
+
+ 039 :stock
+
+
+ 040 ;; `stock` is the quantity of each commodity in the market at any
+
+
+ 041 ;; given time. It is adjusted for production and consumption at
+
+
+ 042 ;; the end of each game day.
+
+
+ 043 {:cloth 0
+
+
+ 044 :fish 0
+
+
+ 045 :leather 0
+
+
+ 046 :iron 0
+
+
+ 047 :whisky 0}
+
+
+ 048 :cash 100}
+
+
+ 049 :buckie
+
+
+ 050 {:id :buckie
+
+
+ 051 :supplies
+
+
+ 052 {:fish 20}
+
+
+ 053 :demands
+
+
+ 054 {:cloth 5
+
+
+ 055 :leather 3
+
+
+ 056 :whisky 5
+
+
+ 057 :iron 1}
+
+
+ 058 :port true
+
+
+ 059 :prices {:cloth 1
+
+
+ 060 :fish 1
+
+
+ 061 :leather 1
+
+
+ 062 :iron 1
+
+
+ 063 :whisky 1}
+
+
+ 064 :stock {:cloth 0
+
+
+ 065 :fish 0
+
+
+ 066 :leather 0
+
+
+ 067 :iron 0
+
+
+ 068 :whisky 0}
+
+
+ 069 :cash 100}
+
+
+ 070 :callander
+
+
+ 071 {:id :callander
+
+
+ 072 :supplies {:leather 20}
+
+
+ 073 :demands
+
+
+ 074 {:cloth 5
+
+
+ 075 :fish 3
+
+
+ 076 :whisky 5
+
+
+ 077 :iron 1}
+
+
+ 078 :prices {:cloth 1
+
+
+ 079 :fish 1
+
+
+ 080 :leather 1
+
+
+ 081 :iron 1
+
+
+ 082 :whisky 1}
+
+
+ 083 :stock {:cloth 0
+
+
+ 084 :fish 0
+
+
+ 085 :leather 0
+
+
+ 086 :iron 0
+
+
+ 087 :whisky 0}
+
+
+ 088 :cash 100}
+
+
+ 089 :dundee {:id :dundee}
+
+
+ 090 :edinburgh {:id :dundee}
+
+
+ 091 :falkirk
+
+
+ 092 {:id :falkirk
+
+
+ 093 :supplies {:iron 10}
+
+
+ 094 :demands
+
+
+ 095 {:cloth 5
+
+
+ 096 :leather 3
+
+
+ 097 :whisky 5
+
+
+ 098 :fish 10}
+
+
+ 099 :port true
+
+
+ 100 :prices {:cloth 1
+
+
+ 101 :fish 1
+
+
+ 102 :leather 1
+
+
+ 103 :iron 1
+
+
+ 104 :whisky 1}
+
+
+ 105 :stock {:cloth 0
+
+
+ 106 :fish 0
+
+
+ 107 :leather 0
+
+
+ 108 :iron 0
+
+
+ 109 :whisky 0}
+
+
+ 110 :cash 100}
+
+
+ 111 :glasgow
+
+
+ 112 {:id :glasgow
+
+
+ 113 :supplies {:whisky 10}
+
+
+ 114 :demands
+
+
+ 115 {:cloth 5
+
+
+ 116 :leather 3
+
+
+ 117 :iron 5
+
+
+ 118 :fish 10}
+
+
+ 119 :port true
+
+
+ 120 :prices {:cloth 1
+
+
+ 121 :fish 1
+
+
+ 122 :leather 1
+
+
+ 123 :iron 1
+
+
+ 124 :whisky 1}
+
+
+ 125 :stock {:cloth 0
+
+
+ 126 :fish 0
+
+
+ 127 :leather 0
+
+
+ 128 :iron 0
+
+
+ 129 :whisky 0}
+
+
+ 130 :cash 100}}
+
+
+ 131 :merchants
+
+
+ 132 {:archie {:id :archie
+
+
+ 133 :home :aberdeen :location :aberdeen :cash 100 :capacity 10
+
+
+ 134 :known-prices {}
+
+
+ 135 :stock {}}
+
+
+ 136 :belinda {:id :belinda
+
+
+ 137 :home :buckie :location :buckie :cash 100 :capacity 10
+
+
+ 138 :known-prices {}
+
+
+ 139 :stock {}}
+
+
+ 140 :callum {:id :callum
+
+
+ 141 :home :callander :location :calander :cash 100 :capacity 10
+
+
+ 142 :known-prices {}
+
+
+ 143 :stock {}}
+
+
+ 144 :deirdre {:id :deidre
+
+
+ 145 :home :dundee :location :dundee :cash 100 :capacity 10
+
+
+ 146 :known-prices {}
+
+
+ 147 :stock {}}
+
+
+ 148 :euan {:id :euan
+
+
+ 149 :home :edinbirgh :location :edinburgh :cash 100 :capacity 10
+
+
+ 150 :known-prices {}
+
+
+ 151 :stock {}}
+
+
+ 152 :fiona {:id :fiona
+
+
+ 153 :home :falkirk :location :falkirk :cash 100 :capacity 10
+
+
+ 154 :known-prices {}
+
+
+ 155 :stock {}}}
+
+
+ 156 :routes
+
+
+ 157 ;; all routes can be traversed in either direction and are assumed to
+
+
+ 158 ;; take the same amount of time.
+
+
+ 159 [[:aberdeen :buckie]
+
+
+ 160 [:aberdeen :dundee]
+
+
+ 161 [:callander :glasgow]
+
+
+ 162 [:dundee :callander]
+
+
+ 163 [:dundee :edinburgh]
+
+
+ 164 [:dundee :falkirk]
+
+
+ 165 [:edinburgh :falkirk]
+
+
+ 166 [:falkirk :glasgow]]
+
+
+ 167 :commodities
+
+
+ 168 ;; cost of commodities is expressed in person/days;
+
+
+ 169 ;; weight in packhorse loads. Transport in this model
+
+
+ 170 ;; is all overland; you don't take bulk cargoes overland
+
+
+ 171 ;; in this period, it's too expensive.
+
+
+ 172 {:cloth {:id :cloth :cost 1 :weight 0.25}
+
+
+ 173 :fish {:id :fish :cost 1 :weight 1}
+
+
+ 174 :leather {:id :leather :cost 1 :weight 0.5}
+
+
+ 175 :whisky {:id :whisky :cost 1 :weight 0.1}
+
+
+ 176 :iron {:id :iron :cost 1 :weight 10}}})
+
+
+ 177
+
+
+ 178 (defn actual-price
+
+
+ 179 "Find the actual current price of this `commodity` in this `city` given
+
+
+ 180 this `world`. **NOTE** that merchants can only know the actual prices in
+
+
+ 181 the city in which they are currently located."
+
+
+ 182 [world commodity city]
+
+
+ 183 (-> world :cities city :prices commodity))
+
+
+ 184
+
+
+ 185 (defn run
+
+
+ 186 "Return a world like this `world` with only the `:date` to this `date`
+
+
+ 187 (or id `date` not supplied, the current value incremented by one). For
+
+
+ 188 running other aspects of the simulation, see [[the-great-game.world.run]]."
+
+
+ 189 ([world]
+
+
+ 190 (run world (inc (or (:date world) 0))))
+
+
+ 191 ([world date]
+
+
+ 192 (assoc world :date date)))
+
+
+
diff --git a/docs/cloverage/index.html b/docs/cloverage/index.html
index 6901d4d..724b600 100644
--- a/docs/cloverage/index.html
+++ b/docs/cloverage/index.html
@@ -15,44 +15,102 @@
Total | Blank | Instrumented |
- | the-great-game.gossip.gossip | | 3 |
+100.00 % |
+ 3 |
+100.00 % |
+45 | 5 | 3 |
+
+
+ | cc.journeyman.the-great-game.buildings.rectangular | 106 36 |
+74.65 % |
+ 24 1 6 |
+80.65 % |
+180 | 25 | 31 |
+
+
+ | cc.journeyman.the-great-game.gossip.gossip | 5 103 |
4.63 % |
5 34 |
-12.82 % |
-66 | 5 | 39 |
+ style="width:87.5%;
+ float:left;"> 35
+12.50 % |
+73 | 7 | 40 |
- | the-great-game.gossip.news-items | 477 37 |
-92.80 % |
+ cc.journeyman.the-great-game.gossip.news-items | 437 197 |
+68.93 % |
96 8 5 |
-95.41 % |
-256 | 31 | 109 |
+ style="width:63.07692307692308%;
+ float:left;"> 82 10
38
+70.77 % |
+313 | 36 | 130 |
- | the-great-game.merchants.markets | 191 cc.journeyman.the-great-game.holdings.holding | 3 18 |
+14.29 % |
+ 3 4 |
+42.86 % |
+46 | 3 | 7 |
+
+
+ | cc.journeyman.the-great-game.location.location | 4 22 |
+15.38 % |
+ 4 10 |
+28.57 % |
+47 | 8 | 14 |
+
+
+ | cc.journeyman.the-great-game.merchants.markets | 192 7 |
-96.46 % |
+96.48 % |
41 84 | 8 | 44 |
- | the-great-game.merchants.merchant-utils | | 197 106 | 7 | 72 |
- | the-great-game.merchants.merchants | cc.journeyman.the-great-game.merchants.merchants | 2 69 |
-2.82 % |
+ style="width:97.26027397260275%;
+ float:left;"> 71
+2.74 % |
2 28 | 3 | 16 |
- | the-great-game.merchants.planning | | 258 159 | 11 | 85 |
- | the-great-game.merchants.strategies.simple | cc.journeyman.the-great-game.merchants.strategies.simple | 5 600 |
-0.83 % |
+ style="width:99.18433931484502%;
+ float:left;"> 608
+0.82 % |
5 173 | 6 | 124 |
- | the-great-game.objects.container | | 2 |
100.00 % |
@@ -139,48 +197,86 @@
11 | 1 | 2 |
- | the-great-game.objects.game-object | cc.journeyman.the-great-game.objects.game-object | 3 2 |
-60.00 % |
+ style="width:50.0%;
+ float:left;"> 3
+50.00 % |
3 2 |
-60.00 % |
-19 | 2 | 5 |
+ style="width:50.0%;
+ float:left;"> 3
+50.00 % |
+21 | 2 | 6 |
- | the-great-game.time | 240 1 |
-99.59 % |
+ cc.journeyman.the-great-game.playroom | 463 75 |
+86.06 % |
59 28 5 2 |
+94.29 % |
+72 | 12 | 35 |
+
+
+ | cc.journeyman.the-great-game.time | 236 5 |
+97.93 % |
+ 58 1 1 |
-100.00 % |
+98.33 % |
144 | 21 | 60 |
- | the-great-game.utils | 69 |
-100.00 % |
+ cc.journeyman.the-great-game.utils | 70 13 |
+84.34 % |
19 |
-100.00 % |
-35 | 3 | 19 |
+ style="width:95.23809523809524%;
+ float:left;"> 20 1
+95.24 % |
+45 | 5 | 21 |
- | the-great-game.world.location | | 11 295 |
+3.59 % |
+ 9 62 |
+12.68 % |
+159 | 16 | 71 |
+
+
+ | cc.journeyman.the-great-game.world.location | 73 37 | 4 | 17 |
- | the-great-game.world.routes | | 1 |
+100.00 % |
+ 1 |
+100.00 % |
+7 | 1 | 1 |
+
+
+ | cc.journeyman.the-great-game.world.routes | 123 55 | 2 | 42 |
- | the-great-game.world.run | | 3 39 | 2 | 20 |
- | the-great-game.world.world | | 420 |
-66.55 % |
+61.00 % |
|
-68.63 % |
+61.78 % |
diff --git a/src/the_great_game/architecture.md b/src/cc/journeyman/architecture.md
similarity index 100%
rename from src/the_great_game/architecture.md
rename to src/cc/journeyman/architecture.md
diff --git a/src/cc/journeyman/the_great_game/buildings/rectangular.clj b/src/cc/journeyman/the_great_game/buildings/rectangular.clj
index a58a4d7..1000a6d 100644
--- a/src/cc/journeyman/the_great_game/buildings/rectangular.clj
+++ b/src/cc/journeyman/the_great_game/buildings/rectangular.clj
@@ -115,36 +115,6 @@
:cultures #{:coastal}
:modules []}})
-;; TODO: So, modules need to contain
-;;
-;; 1. Ground floor modules, having external doors;
-;; 2. Craft modules -- workshops -- which will normally be ground floor (except
-;; weavers) and may have the constraint that no upper floor module can cover them;
-;; 3. Upper floor modules, having NO external doors (but linking internal doors);
-;; 4. Roof modules
-;;
-;; There also needs to be an undercroft or platform module, such that the area of
-;; the top of the platform is identical with the footprint of the building, and
-;; the altitude of the top of the platform is equal to the altitude of the
-;; terrain at the heighest corner of the building; so that the actual
-;; building doesn't float in the air, and also so that none of the doors or windows
-;; are partly underground.
-;;
-;; Each module needs to wrap an actual 3d model created in Blender or whatever,
-;; and have a list of optional textures with which that model can be rendered.
-;; So an upper floor bedroom module might have the following renders:
-;;
-;; 1. Bare masonry - constrained to upland or plateau terrain, and to coastal culture
-;; 2. Painted masonry - constrained to upland or plateau terrain, and to coastal culture
-;; 3. Half-timbered - not available on plateau terrain
-;; 4. Weatherboarded - constrained to forest terrain
-;; 5. Brick - constrained to arable or arid terrain
-;;
-;; of course these are only examples, and also, it's entirely possible to have
-;; for example multiple different weatherboard renders for the same module.
-;; There needs to be a way of rendering what can be built above what: for
-;; example, you can't have a masonry clad module over a half timbered one,
-;; but you can have a half-timbered one over a masonry one
(defn building-family
"A building family is essentially a collection of models of building modules
diff --git a/src/cc/journeyman/the_great_game/gossip/news_items.clj b/src/cc/journeyman/the_great_game/gossip/news_items.clj
index 10e4883..18600de 100644
--- a/src/cc/journeyman/the_great_game/gossip/news_items.clj
+++ b/src/cc/journeyman/the_great_game/gossip/news_items.clj
@@ -1,5 +1,5 @@
(ns cc.journeyman.the-great-game.gossip.news-items
- "Categories of news events interesting to gossip agents.
+ "Using news items (propositions) to transfer knowledge between gossip agents.
The ideas here are based on the essay [The spread of knowledge in a large
game world](The-spread-of-knowledge-in-a-large-game-world.html), q.v.;
@@ -22,7 +22,8 @@
list of propositions, each of which must be checked every time any new
proposition is offered. This is woefully inefficient. "
(:require [cc.journeyman.the-great-game.world.location :refer [distance-between]]
- [cc.journeyman.the-great-game.time :refer [game-time]]))
+ [cc.journeyman.the-great-game.time :refer [game-time]]
+ [taoensso.timbre :as l]))
(def news-topics
@@ -155,8 +156,8 @@
(defn interesting-location?
"True if the location of this news `item` is interesting to this `gossip`."
- [gossip item]
- (> (interest-in-location gossip (:location item)) 0))
+ [gossip location]
+ (> (interest-in-location gossip location) 0))
(defn interesting-object?
[gossip object]
@@ -190,13 +191,16 @@
learning that 'someone killed Sweet Daisy', but there is point in learning
'someone killed Sweet Daisy _with poison_'."
[new-item known-item]
- (reduce
- #(and %1 %2)
- (map #(if
- (known-item %) ;; if known-item has this key
- (compatible-value? (new-item %) (known-item %))
- true)
- (remove #{:nth-hand :confidence :learned-from} (keys new-item)))))
+ (if
+ (reduce
+ #(and %1 %2)
+ (map #(if
+ (known-item %) ;; if known-item has this key
+ (compatible-value? (new-item %) (known-item %))
+ true)
+ (remove #{:nth-hand :confidence :learned-from} (keys new-item))))
+ true
+ false))
(defn known-item?
"True if this news `item` is already known to this `gossip`.
@@ -205,9 +209,13 @@
the same _or more specific_ values for all the keys of this `item` except
`:nth-hand`, `:confidence` and `:learned-from`."
[gossip item]
- (reduce
- #(or %1 %2)
- (filter true? (map #(compatible-item? item %) (:knowledge gossip)))))
+ (if
+ (reduce
+ #(or %1 %2)
+ false
+ (filter true? (map #(compatible-item? item %) (:knowledge gossip))))
+ true
+ false))
(defn interesting-item?
"True if anything about this news `item` is interesting to this `gossip`."
@@ -220,30 +228,39 @@
(interesting-object? gossip (:object item))
(interesting-topic? gossip (:verb item)))))
+(defn inc-or-one
+ "If this `val` is a number, return that number incremented by one; otherwise,
+ return 1. TODO: should probably be in `utils`."
+ [val]
+ (if
+ (number? val)
+ (inc val)
+ 1))
+
(defn infer
- "Infer a new knowledge item from this `item`, following this `rule`"
+ "Infer a new knowledge item from this `item`, following this `rule`."
[item rule]
+;; (l/info "Applying rule '" rule "' to item '" item "'")
(reduce merge
item
(cons
- {:verb (:verb rule)}
- (map (fn [k] {k (apply (k rule) (list item))})
+ {:verb (:verb rule)
+ :nth-hand (inc-or-one (:nth-hand item))}
+ (map (fn [k] {k (item (rule k))})
(remove
- #{:verb}
+ #{:verb :nth-hand}
(keys rule))))))
(declare learn-news-item)
(defn make-all-inferences
- "Return a list of knowledge entries that can be inferred from this news
+ "Return a set of knowledge entries that can be inferred from this news
`item`."
[item]
(set
- (reduce
- concat
(map
- #(:knowledge (learn-news-item {} (infer item %) false))
- (:inferences (news-topics (:verb item)))))))
+ #(infer item %)
+ (:inferences (news-topics (:verb item))))))
(defn degrade-character
"Return a character specification like this `character`, but comprising
@@ -264,15 +281,6 @@
location))]
(when-not (empty? l) l)))
-(defn inc-or-one
- "If this `val` is a number, return that number incremented by one; otherwise,
- return 1. TODO: should probably be in `utils`."
- [val]
- (if
- (number? val)
- (inc val)
- 1))
-
(defn learn-news-item
"Return a gossip like this `gossip`, which has learned this news `item` if
it is of interest to them."
diff --git a/src/cc/journeyman/the_great_game/location/location.clj b/src/cc/journeyman/the_great_game/location/location.clj
index 4b5895f..1fdc3b9 100644
--- a/src/cc/journeyman/the_great_game/location/location.clj
+++ b/src/cc/journeyman/the_great_game/location/location.clj
@@ -43,5 +43,3 @@
;; (.settlement (OrientedLocation. 123.45 543.76 12.34 0.00 {}))
-
-;; (OrientedLocation. 123.45 543.76 12.34 0.00 {})
\ No newline at end of file
diff --git a/test/cc/journeyman/the_great_game/gossip/news_items_test.clj b/test/cc/journeyman/the_great_game/gossip/news_items_test.clj
index ef3abfc..50f062a 100644
--- a/test/cc/journeyman/the_great_game/gossip/news_items_test.clj
+++ b/test/cc/journeyman/the_great_game/gossip/news_items_test.clj
@@ -1,135 +1,163 @@
(ns cc.journeyman.the-great-game.gossip.news-items-test
(:require [clojure.test :refer [deftest is testing]]
- [cc.journeyman.the-great-game.gossip.news-items :refer
- [degrade-location infer interest-in-location interesting-location?
+ [cc.journeyman.the-great-game.gossip.news-items :refer
+ [compatible-item? degrade-location infer interest-in-location interesting-location?
learn-news-item make-all-inferences]]))
+(deftest compatible-item-test
+ (testing "Compatible item: items are identical"
+ (let [expected true
+ new-item {:verb :kills :location :tchahua :actor :fierce-fred :other :dainty-daisy}
+ known-item {:verb :kills :location :tchahua :actor :fierce-fred :other :dainty-daisy}
+ actual (compatible-item? new-item known-item)]
+ (is (= actual expected) "Items which are identical are compatible.")))
+ (testing "Compatible item: new item is less specific"
+ (let [expected true
+ new-item {:verb :kills :location :tchahua :other :dainty-daisy}
+ known-item {:verb :kills :location :tchahua :actor :fierce-fred :other :dainty-daisy}
+ actual (compatible-item? new-item known-item)]
+ (is (= actual expected)
+ "An item which is less specific is compatible with existing knowledge.")))
+ (testing "Compatible item: new item is more specific"
+ (let [expected true
+ new-item {:verb :kills :location :tchahua :actor :fierce-fred :other :dainty-daisy :date 20210609}
+ known-item {:verb :kills :location :tchahua :actor :fierce-fred :other :dainty-daisy}
+ actual (compatible-item? new-item known-item)]
+ (is (= actual expected) "A new item which is more specific adds knowledge and is not compatible")))
+ (testing "Compatible item: new item conflicts with existing knowledge."
+ (let [expected false
+ new-item {:verb :kills :location :tchahua :actor :jealous-joe :other :dainty-daisy}
+ known-item {:verb :kills :location :tchahua :actor :fierce-fred :other :dainty-daisy}
+ actual (compatible-item? new-item known-item)]
+ (is (= actual expected) "A new item which we don't yet intelligently handle but is not compatible"))))
+
(deftest location-test
(testing "Interest in locations"
(let [expected 1
actual (interest-in-location
- {:knowledge [{:verb :steal
- :actor :albert
- :other :belinda
- :object :foo
- :location [{:x 35 :y 23} :auchencairn :galloway]}]}
- :galloway)]
+ {:knowledge [{:verb :steal
+ :actor :albert
+ :other :belinda
+ :object :foo
+ :location [{:x 35 :y 23} :auchencairn :galloway]}]}
+ :galloway)]
(is (= actual expected)))
(let [expected 2
actual (interest-in-location
- {:knowledge [{:verb :steal
- :actor :albert
- :other :belinda
- :object :foo
- :location [{:x 35 :y 23} :auchencairn :galloway :scotland]}]}
- [:galloway :scotland])]
+ {:knowledge [{:verb :steal
+ :actor :albert
+ :other :belinda
+ :object :foo
+ :location [{:x 35 :y 23} :auchencairn :galloway :scotland]}]}
+ [:galloway :scotland])]
(is (= actual expected)))
(let [expected 2
actual (interest-in-location
- {:home [{:x 35 :y 23} :auchencairn :galloway :scotland]}
- [:galloway :scotland])]
+ {:home [{:x 35 :y 23} :auchencairn :galloway :scotland]}
+ [:galloway :scotland])]
(is (= actual expected)))
(let [expected 0
actual (interest-in-location
- {:knowledge [{:verb :steal
- :actor :albert
- :other :belinda
- :object :foo
- :location [{:x 35 :y 23} :auchencairn :galloway]}]}
- [:dumfries])]
+ {:knowledge [{:verb :steal
+ :actor :albert
+ :other :belinda
+ :object :foo
+ :location [{:x 35 :y 23} :auchencairn :galloway]}]}
+ [:dumfries])]
(is (= actual expected)))
(let [expected 7071.067811865475
actual (interest-in-location
- {:home [{:x 35 :y 23}]}
- [{:x 34 :y 24}])]
+ {:home [{:x 35 :y 23}]}
+ [{:x 34 :y 24}])]
(is (= actual expected)
"TODO: 7071.067811865475 is actually a bad answer."))
(let [expected 0
actual (interest-in-location
- {:home [{:x 35 :y 23}]}
- [{:x 34 :y 24000}])]
+ {:home [{:x 35 :y 23}]}
+ [{:x 34 :y 24000}])]
(is (= actual expected)
"Too far apart (> 10000)."))
(let [expected true
actual (interesting-location?
- {:knowledge [{:verb :steal
- :actor :albert
- :other :belinda
- :object :foo
- :location [{:x 35 :y 23} :auchencairn :galloway]}]}
- :galloway)]
+ {:knowledge [{:verb :steal
+ :actor :albert
+ :other :belinda
+ :object :foo
+ :location [{:x 35 :y 23} :auchencairn :galloway]}]}
+ :galloway)]
(is (= actual expected)))
(let [expected true
actual (interesting-location?
- {:knowledge [{:verb :steal
- :actor :albert
- :other :belinda
- :object :foo
- :location [{:x 35 :y 23} :auchencairn :galloway]}]}
- [:galloway :scotland])]
+ {:knowledge [{:verb :steal
+ :actor :albert
+ :other :belinda
+ :object :foo
+ :location [{:x 35 :y 23} :auchencairn :galloway]}]}
+ [:galloway :scotland])]
(is (= actual expected)))
(let [expected false
actual (interesting-location?
- {:knowledge [{:verb :steal
- :actor :albert
- :other :belinda
- :object :foo
- :location [{:x 35 :y 23} :auchencairn :galloway]}]}
- [:dumfries])]
+ {:knowledge [{:verb :steal
+ :actor :albert
+ :other :belinda
+ :object :foo
+ :location [{:x 35 :y 23} :auchencairn :galloway]}]}
+ [:dumfries])]
(is (= actual expected)))
(let [expected true
actual (interesting-location?
- {:home [{:x 35 :y 23}]}
- [{:x 34 :y 24}])]
+ {:home [{:x 35 :y 23}]}
+ [{:x 34 :y 24}])]
(is (= actual expected)))
(let [expected false
actual (interesting-location?
- {:home [{:x 35 :y 23}]}
- [{:x 34 :y 240000}])]
+ {:home [{:x 35 :y 23}]}
+ [{:x 34 :y 240000}])]
(is (= actual expected))))
(testing "Degrading locations"
(let [expected [:galloway]
actual (degrade-location
- {:home [{0 0} :test-home :galloway]}
- [{-4 55} :auchencairn :galloway])]
+ {:home [{0 0} :test-home :galloway]}
+ [{-4 55} :auchencairn :galloway])]
(is (= actual expected)))
(let [expected nil
actual (degrade-location
- {:home [{0 0} :test-home :galloway]}
- [:froboz])]
+ {:home [{0 0} :test-home :galloway]}
+ [:froboz])]
(is (= actual expected)))))
(deftest inference-tests
(testing "Ability to infer new knowledge from news items: single rule tests"
(let [expected {:verb :marry, :actor :belinda, :other :adam}
- actual (infer {:verb :marry :actor :adam :other :belinda}
- {:verb :marry :actor :other :other :actor})]
+ item {:verb :marry :actor :adam :other :belinda}
+ rule {:verb :marry :actor :other :other :actor}
+ actual (infer item rule)]
(is (= actual expected)))
(let [expected {:verb :attack, :actor :adam, :other :belinda}
- actual (infer {:verb :rape :actor :adam :other :belinda}
- {:verb :attack})]
+ item {:verb :rape :actor :adam :other :belinda}
+ rule {:verb :attack}
+ actual (infer item rule)]
(is (= actual expected)))
(let [expected {:verb :sex, :actor :belinda, :other :adam}
- actual (infer {:verb :rape :actor :adam :other :belinda}
- {:verb :sex :actor :other :other :actor})]
+ item {:verb :rape :actor :adam :other :belinda}
+ rule {:verb :sex :actor :other :other :actor}
+ actual (infer item rule)]
(is (= actual expected))))
(testing "Ability to infer new knowledge from news items: all applicable rules"
- (let [expected #{{:verb :sex, :actor :belinda, :other :adam, :location nil, :nth-hand 1}
- {:verb :sex, :actor :adam, :other :belinda, :location nil, :nth-hand 1}
- {:verb :attack, :actor :adam, :other :belinda, :location nil, :nth-hand 1}}
+ (let [expected #{{:verb :sex, :actor :belinda, :other :adam, :location :test-home, :nth-hand 1}
+ {:verb :sex, :actor :adam, :other :belinda, :location :test-home, :nth-hand 1}
+ {:verb :attack, :actor :adam, :other :belinda, :location :test-home, :nth-hand 1}}
;; dates will not be and cannot be expected to be equal
- actual (make-all-inferences
- {:verb :rape :actor :adam :other :belinda :location :test-home})
- actual' (set (map #(dissoc % :time-stamp) actual))]
- (is (= actual' expected)))))
+ actual (set (make-all-inferences
+ {:verb :rape :actor :adam :other :belinda :location :test-home :nth-hand 1}))]
+ (is (= actual expected)))))
(deftest learn-tests
(testing "Learning from an interesting news item."
- (let [expected {:home [{0 0} :test-home],
- :knowledge [{:verb :sex, :actor :adam, :other :belinda, :location nil, :nth-hand 1}
- {:verb :sex, :actor :belinda, :other :adam, :location nil, :nth-hand 1}]}
+ (let [expected {:home [{0 0} :test-home]
+ :knowledge [{:verb :sex, :actor :adam, :other :belinda, :location [:test-home], :nth-hand 1}
+ {:verb :sex, :actor :belinda, :other :adam, :location [:test-home], :nth-hand 1}]}
actual (learn-news-item
- {:home [{0, 0} :test-home] :knowledge []}
- {:verb :sex :actor :adam :other :belinda :location [:test-home]})
- actual' (assoc actual :knowledge (vec (map #(dissoc % :time-stamp) (:knowledge actual))))]
- (is (= actual' expected)))))
+ {:home [{0, 0} :test-home] :knowledge []}
+ {:verb :sex :actor :adam :other :belinda :location [:test-home]})]
+ (is (= actual expected)))))