Prepended all namespaces with 'cc.journeyman'; tests run, 4 don't pass.
This commit is contained in:
parent
37dbb767ac
commit
310896cc95
34 changed files with 107 additions and 81 deletions
44
src/cc/journeyman/the_great_game/agent/agent.clj
Normal file
44
src/cc/journeyman/the_great_game/agent/agent.clj
Normal file
|
|
@ -0,0 +1,44 @@
|
|||
(ns cc.journeyman.the-great-game.agent.agent
|
||||
"Anything in the game world with agency"
|
||||
(:require [the-great-game.objects.game-object :refer [ProtoObject]]
|
||||
[the-great-game.objects.container :refer [ProtoContainer]]))
|
||||
|
||||
;; hierarchy of needs probably gets implemented here
|
||||
;; I'm probably going to want to defprotocol stuff, to define the hierarchy
|
||||
;; of things in the gameworld; either that or drop to Java, wich I'd rather not do.
|
||||
|
||||
(defprotocol ProtoAgent
|
||||
"An object which can act in the world"
|
||||
(act
|
||||
[actor world circle]
|
||||
"Allow `actor` to do something in this `world`, in the context of this
|
||||
`circle`; return the new state of the actor if something was done, `nil`
|
||||
if nothing was done. Circle is expected to be one of
|
||||
|
||||
* `:active` - actors within visual/audible range of the player
|
||||
character;
|
||||
* `:pending` - actors not in the active circle, but sufficiently close
|
||||
to it that they may enter the active circle within a short period;
|
||||
* `:background` - actors who are active in the background in order to
|
||||
handle trade, news, et cetera;
|
||||
* `other` - actors who are not members of any other circle, although
|
||||
I'm not clear whether it would ever be appropriate to invoke an
|
||||
`act` method on them.
|
||||
|
||||
The `act` method *must not* have side effects; it must *only* return a
|
||||
new state. If the actor's intention is to seek to change the state of
|
||||
something else in the game world, it must add a representation of that
|
||||
intention to the sequence which will be returned by its
|
||||
`pending-intentions` method.")
|
||||
(pending-intentions
|
||||
[actor]
|
||||
"Returns a sequence of effects an actor intends, as a consequence of
|
||||
acting. The encoding of these is not yet defined."))
|
||||
|
||||
(defrecord Agent
|
||||
;; "A default agent."
|
||||
[name home tribe]
|
||||
ProtoObject
|
||||
ProtoContainer
|
||||
ProtoAgent
|
||||
)
|
||||
66
src/cc/journeyman/the_great_game/gossip/gossip.clj
Normal file
66
src/cc/journeyman/the_great_game/gossip/gossip.clj
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
(ns cc.journeyman.the-great-game.gossip.gossip
|
||||
"Interchange of news events between gossip agents"
|
||||
(:require [cc.journeyman.the-great-game.utils :refer [deep-merge]]
|
||||
[cc.journeyman.the-great-game.gossip.news-items :refer [learn-news-item]]))
|
||||
|
||||
;; Note that habitual travellers are all gossip agents; specifically, at this
|
||||
;; stage, that means merchants. When merchants are moved we also need to
|
||||
;; update the location of the gossip with the same key.
|
||||
|
||||
(defn dialogue
|
||||
"Dialogue between an `enquirer` and an `agent` in this `world`; returns a
|
||||
map identical to `enquirer` except that its `:gossip` collection may have
|
||||
additional entries."
|
||||
;; TODO: not yet written, this is a stub.
|
||||
[enquirer respondent world]
|
||||
enquirer)
|
||||
|
||||
(defn gather-news
|
||||
([world]
|
||||
(reduce
|
||||
deep-merge
|
||||
world
|
||||
(map
|
||||
#(gather-news world %)
|
||||
(keys (:gossips world)))))
|
||||
([world gossip]
|
||||
(let [g (cond (keyword? gossip)
|
||||
(-> world :gossips gossip)
|
||||
(map? gossip)
|
||||
gossip)]
|
||||
{:gossips
|
||||
{(:id g)
|
||||
(reduce
|
||||
deep-merge
|
||||
{}
|
||||
(map
|
||||
#(dialogue g % world)
|
||||
(remove
|
||||
#( = g %)
|
||||
(filter
|
||||
#(= (:location %) (:location g))
|
||||
(vals (:gossips world))))))}})))
|
||||
|
||||
(defn move-gossip
|
||||
"Return a world like this `world` but with this `gossip` moved to this
|
||||
`new-location`. Many gossips are essentially shadow-records of agents of
|
||||
other types, and the movement of the gossip should be controlled by the
|
||||
run function of the type of the record they shadow. The [[#run]] function
|
||||
below does NOT call this function."
|
||||
[gossip world new-location]
|
||||
(let [id (cond
|
||||
(map? gossip)
|
||||
(-> world :gossips gossip :id)
|
||||
(keyword? gossip)
|
||||
gossip)]
|
||||
(deep-merge
|
||||
world
|
||||
{:gossips
|
||||
{id
|
||||
{:location new-location}}})))
|
||||
|
||||
(defn run
|
||||
"Return a world like this `world`, with news items exchanged between gossip
|
||||
agents."
|
||||
[world]
|
||||
(gather-news world))
|
||||
256
src/cc/journeyman/the_great_game/gossip/news_items.clj
Normal file
256
src/cc/journeyman/the_great_game/gossip/news_items.clj
Normal file
|
|
@ -0,0 +1,256 @@
|
|||
(ns cc.journeyman.the-great-game.gossip.news-items
|
||||
"Categories of news events interesting to gossip agents"
|
||||
(:require [cc.journeyman.the-great-game.world.location :refer [distance-between]]
|
||||
[cc.journeyman.the-great-game.time :refer [game-time]]))
|
||||
|
||||
;; The ideas here are based on the essay 'The spread of knowledge in a large
|
||||
;; game world', q.v.; they've advanced a little beyond that and will doubtless
|
||||
;; advance further in the course of writing and debugging this namespace.
|
||||
|
||||
;; A news item is a map with the keys:
|
||||
;;
|
||||
;; * `date` - the date on which the reported event happened;
|
||||
;; * `nth-hand` - the number of agents the news item has passed through;
|
||||
;; * `verb` - what it is that happened (key into `news-topics`);
|
||||
;;
|
||||
;; plus other keys taken from the `keys` value associated with the verb in
|
||||
;; `news-topics`
|
||||
|
||||
(def news-topics
|
||||
"Topics of interest to gossip agents. Topics are keyed in this map by
|
||||
their `verbs`. The `keys` associated with each topic are the extra pieces
|
||||
of information required to give context to a gossip item. Generally:
|
||||
|
||||
* `actor` is the id of the character who it is reported performed the
|
||||
action;
|
||||
* `other` is the id of the character on whom it is reported the action
|
||||
was performed;
|
||||
* `location` is the place at which the action was performed;
|
||||
* `object` is an object (or possibly list of objects?) relevant to the
|
||||
action;
|
||||
* `price` is special to buy/sell, but of significant interest to merchants.
|
||||
|
||||
#### Notes:
|
||||
|
||||
##### Characters:
|
||||
|
||||
*TODO* but note that at most all the receiver can learn about a character
|
||||
from a news item is what the giver knows about that character, degraded by
|
||||
what the receiver finds interesting about them. If we just pass the id here,
|
||||
then either the receiver knows everything in the database about the
|
||||
character, or else the receiver knows nothing at all about the character.
|
||||
Neither is desirable. Further thought needed.
|
||||
|
||||
By implication, the character values passed should include *all* the
|
||||
information the giver knows about the character; that can then be degraded
|
||||
as the receiver stores only that segment which the receiver finds
|
||||
interesting.
|
||||
|
||||
##### Locations:
|
||||
|
||||
A 'location' value is a list comprising at most the x/y coordinate location
|
||||
and the ids of the settlement and region (possibly hierarchically) that contain
|
||||
the location. If the x/y is not local to the home of the receiving agent, they
|
||||
won't remember it and won't pass it on; if any of the ids are not interesting
|
||||
So location information will degrade progressively as the item is passed along.
|
||||
|
||||
It is assumed that the `:home` of a character is a location in this sense.
|
||||
|
||||
##### Inferences:
|
||||
|
||||
If an agent learns that Adam has married Betty, they can infer that Betty has
|
||||
married Adam; if they learn that Charles killed Dorothy, that Dorothy has died.
|
||||
I'm not convinced that my representation of inferences here is ideal.
|
||||
"
|
||||
{ ;; A significant attack is interesting whether or not it leads to deaths
|
||||
:attack {:verb :attack :keys [:actor :other :location]}
|
||||
;; Deaths of characters may be interesting
|
||||
:die {:verb :die :keys [:actor :location]}
|
||||
;; Deliberate killings are interesting.
|
||||
:kill {:verb :kill :keys [:actor :other :location]
|
||||
:inferences [{:verb :die :actor :other :other :nil}]}
|
||||
;; Marriages may be interesting
|
||||
:marry {:verb :marry :keys [:actor :other :location]
|
||||
:inferences [{:verb :marry :actor :other :other :actor}]}
|
||||
;; The end of ongoing open conflict between to characters may be interesting
|
||||
:peace {:verb :peace :keys [:actor :other :location]
|
||||
:inferences [{:verb :peace :actor :other :other :actor}]}
|
||||
;; Things related to the plot are interesting, but will require special
|
||||
;; handling. Extra keys may be required by particular plot events.
|
||||
:plot {:verb :plot :keys [:actor :other :object :location]}
|
||||
;; Rapes are interesting.
|
||||
:rape {:verb :rape :keys [:actor :other :location]
|
||||
;; Should you also infer from rape that actor is male and adult?
|
||||
:inferences [{:verb :attack}
|
||||
{:verb :sex}
|
||||
{:verb :sex :actor :other :other :actor}]}
|
||||
;; Merchants, especially, are interested in prices in other markets
|
||||
:sell {:verb :sell :keys [:actor :other :object :location :price]}
|
||||
;; Sex can juicy gossip, although not normally if the participants are in an
|
||||
;; established sexual relationship.
|
||||
:sex {:verb :sex :keys [:actor :other :location]
|
||||
:inferences [{:verb :sex :actor :other :other :actor}]}
|
||||
;; Thefts are interesting
|
||||
:steal {:verb :steal :keys [:actor :other :object :location]}
|
||||
;; The succession of rulers is interesting; of respected craftsmen,
|
||||
;; potentially also interesting.
|
||||
:succession {:verb :succession :keys [:actor :other :location :rank]}
|
||||
;; The start of ongoing open conflict between to characters may be interesting
|
||||
:war {:verb :war :keys [:actor :other :location]
|
||||
:inferences [{:verb :war :actor :other :other :actor}]}
|
||||
})
|
||||
|
||||
|
||||
(defn interest-in-character
|
||||
"Integer representation of how interesting this `character` is to this
|
||||
`gossip`.
|
||||
*TODO:* this assumes that characters are passed as keywords, but, as
|
||||
documented above, they probably have to be maps, to allow for degradation."
|
||||
[gossip character]
|
||||
(count
|
||||
(concat
|
||||
(filter #(= (:actor % character)) (:knowledge gossip))
|
||||
(filter #(= (:other % character)) (:knowledge gossip)))))
|
||||
|
||||
(defn interesting-character?
|
||||
"Boolean representation of whether this `character` is interesting to this
|
||||
`gossip`."
|
||||
[gossip character]
|
||||
(> (interest-in-character gossip character) 0))
|
||||
|
||||
(defn interest-in-location
|
||||
"Integer representation of how interesting this `location` is to this
|
||||
`gossip`."
|
||||
[gossip location]
|
||||
(cond
|
||||
(and (map? location) (number? (:x location)) (number? (:y location)))
|
||||
(if-let [home (:home gossip)]
|
||||
(let [d (distance-between location home)
|
||||
i (/ 10000 d) ;; 10000 at metre scale is 10km; interest should
|
||||
;;fall off with distance from home, but possibly on a log scale
|
||||
]
|
||||
(if (> i 1) i 0))
|
||||
0)
|
||||
(coll? location)
|
||||
(reduce
|
||||
+
|
||||
(map
|
||||
#(interest-in-location gossip %)
|
||||
location))
|
||||
:else
|
||||
(count
|
||||
(filter
|
||||
#(some (fn [x] (= x location)) (:location %))
|
||||
(cons {:location (:home gossip)} (:knowledge gossip))))))
|
||||
|
||||
;; (interest-in-location {:home [{0, 0} :test-home] :knowledge []} [:test-home])
|
||||
|
||||
(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))
|
||||
|
||||
(defn interesting-object?
|
||||
[gossip object]
|
||||
;; TODO: Not yet (really) implemented
|
||||
true)
|
||||
|
||||
(defn interesting-topic?
|
||||
[gossip topic]
|
||||
;; TODO: Not yet (really) implemented
|
||||
true)
|
||||
|
||||
(defn interesting-item?
|
||||
"True if anything about this news `item` is interesting to this `gossip`."
|
||||
[gossip item]
|
||||
(or
|
||||
(interesting-character? gossip (:actor item))
|
||||
(interesting-character? gossip (:other item))
|
||||
(interesting-location? gossip (:location item))
|
||||
(interesting-object? gossip (:object item))
|
||||
(interesting-topic? gossip (:verb item))))
|
||||
|
||||
(defn infer
|
||||
"Infer a new knowledge item from this `item`, following this `rule`"
|
||||
[item rule]
|
||||
(reduce merge
|
||||
item
|
||||
(cons
|
||||
{:verb (:verb rule)}
|
||||
(map (fn [k] {k (apply (k rule) (list item))})
|
||||
(remove
|
||||
#(= % :verb)
|
||||
(keys rule))))))
|
||||
|
||||
(declare learn-news-item)
|
||||
|
||||
(defn make-all-inferences
|
||||
"Return a list 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)))))))
|
||||
|
||||
(defn degrade-character
|
||||
"Return a character specification like this `character`, but comprising
|
||||
only those properties this `gossip` is interested in."
|
||||
[gossip character]
|
||||
;; TODO: Not yet (really) implemented
|
||||
character)
|
||||
|
||||
(defn degrade-location
|
||||
"Return a location specification like this `location`, but comprising
|
||||
only those elements this `gossip` is interested in. If none, return
|
||||
`nil`."
|
||||
[gossip location]
|
||||
(let [l (if
|
||||
(coll? location)
|
||||
(filter
|
||||
#(when (interesting-location? gossip %) %)
|
||||
location))]
|
||||
(when-not (empty? l) l)))
|
||||
|
||||
(defn learn-news-item
|
||||
"Return a gossip like this `gossip`, which has learned this news `item` if
|
||||
it is of interest to them."
|
||||
;; TODO: Not yet implemented
|
||||
([gossip item]
|
||||
(learn-news-item gossip item true))
|
||||
([gossip item follow-inferences?]
|
||||
(if
|
||||
(interesting-item? gossip item)
|
||||
(let
|
||||
[g (assoc
|
||||
gossip
|
||||
:knowledge
|
||||
(cons
|
||||
(assoc
|
||||
item
|
||||
:nth-hand (if
|
||||
(number? (:nth-hand item))
|
||||
(inc (:nth-hand item))
|
||||
1)
|
||||
:time-stamp (if
|
||||
(number? (:time-stamp item))
|
||||
(:time-stamp item)
|
||||
(game-time))
|
||||
:location (degrade-location gossip (:location item))
|
||||
;; TODO: ought to maybe-degrade characters we're not yet interested in
|
||||
)
|
||||
;; TODO: ought not to add knowledge items we already have, except
|
||||
;; to replace if new item is of increased specificity
|
||||
(:knowledge gossip)))]
|
||||
(if follow-inferences?
|
||||
(assoc
|
||||
g
|
||||
:knowledge
|
||||
(concat (:knowledge g) (make-all-inferences item)))
|
||||
g))
|
||||
gossip)))
|
||||
|
||||
|
||||
|
||||
84
src/cc/journeyman/the_great_game/merchants/markets.clj
Normal file
84
src/cc/journeyman/the_great_game/merchants/markets.clj
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
(ns cc.journeyman.the-great-game.merchants.markets
|
||||
"Adjusting quantities and prices in markets."
|
||||
(:require [taoensso.timbre :as l :refer [info error]]
|
||||
[cc.journeyman.the-great-game.utils :refer [deep-merge]]))
|
||||
|
||||
(defn new-price
|
||||
"If `stock` is greater than the maximum of `supply` and `demand`, then
|
||||
there is surplus and `old` price is too high, so shold be reduced. If
|
||||
lower, then it is too low and should be increased."
|
||||
[old stock supply demand]
|
||||
(let
|
||||
[delta (dec' (/ (max supply demand 1) (max stock 1)))
|
||||
scaled (/ delta 100)]
|
||||
(+ old scaled)))
|
||||
|
||||
|
||||
(defn adjust-quantity-and-price
|
||||
"Adjust the quantity of this `commodity` currently in stock in this `city`
|
||||
of this `world`. Return a fragmentary world which can be deep-merged into
|
||||
this world."
|
||||
[world city commodity]
|
||||
(let [c (cond
|
||||
(keyword? city) (-> world :cities city)
|
||||
(map? city) city)
|
||||
id (:id c)
|
||||
p (or (-> c :prices commodity) 0)
|
||||
d (or (-> c :demands commodity) 0)
|
||||
st (or (-> c :stock commodity) 0)
|
||||
su (or (-> c :supplies commodity) 0)
|
||||
decrement (min st d)
|
||||
increment (cond
|
||||
;; if we've two turns' production of this commodity in
|
||||
;; stock, halt production
|
||||
(> st (* su 2))
|
||||
0
|
||||
;; if it is profitable to produce this commodity, the
|
||||
;; craftspeople of the city will do so.
|
||||
(> p 1) su
|
||||
;; otherwise, if there isn't a turn's production in
|
||||
;; stock, top up the stock, so that there's something for
|
||||
;; incoming merchants to buy
|
||||
(> su st)
|
||||
(- su st)
|
||||
:else
|
||||
0)
|
||||
n (new-price p st su d)]
|
||||
(if
|
||||
(not= p n)
|
||||
(l/info "Price of" commodity "at" id "has changed from" (float p) "to" (float n)))
|
||||
{:cities {id
|
||||
{:stock
|
||||
{commodity (+ (- st decrement) increment)}
|
||||
:prices
|
||||
{commodity n}}}}))
|
||||
|
||||
|
||||
(defn update-markets
|
||||
"Return a world like this `world`, with quantities and prices in markets
|
||||
updated to reflect supply and demand. If `city` or `city` and `commodity`
|
||||
are specified, return a fragmentary world with only the changes for that
|
||||
`city` (and `commodity` if specified) populated."
|
||||
([world]
|
||||
(reduce
|
||||
deep-merge
|
||||
world
|
||||
(map
|
||||
#(update-markets world %)
|
||||
(keys (:cities world)))))
|
||||
([world city]
|
||||
(reduce
|
||||
deep-merge
|
||||
{}
|
||||
(map #(update-markets world city %)
|
||||
(keys (:commodities world)))))
|
||||
([world city commodity]
|
||||
(adjust-quantity-and-price world city commodity)))
|
||||
|
||||
|
||||
(defn run
|
||||
"Return a world like this `world`, with quantities and prices in markets
|
||||
updated to reflect supply and demand."
|
||||
[world]
|
||||
(update-markets world))
|
||||
|
||||
106
src/cc/journeyman/the_great_game/merchants/merchant_utils.clj
Normal file
106
src/cc/journeyman/the_great_game/merchants/merchant_utils.clj
Normal file
|
|
@ -0,0 +1,106 @@
|
|||
(ns cc.journeyman.the-great-game.merchants.merchant-utils
|
||||
"Useful functions for doing low-level things with merchants.")
|
||||
|
||||
(defn expected-price
|
||||
"Find the price anticipated, given this `world`, by this `merchant` for
|
||||
this `commodity` in this `city`. If no information, assume 1.
|
||||
`merchant` should be passed as a map, `commodity` and `city` should be passed as keywords."
|
||||
[merchant commodity city]
|
||||
(or
|
||||
(:price
|
||||
(last
|
||||
(sort-by
|
||||
:date
|
||||
(-> merchant :known-prices city commodity))))
|
||||
1))
|
||||
|
||||
(defn burden
|
||||
"The total weight of the current cargo carried by this `merchant` in this
|
||||
`world`."
|
||||
[merchant world]
|
||||
(let [m (cond
|
||||
(keyword? merchant)
|
||||
(-> world :merchants merchant)
|
||||
(map? merchant)
|
||||
merchant)
|
||||
cargo (or (:stock m) {})]
|
||||
(reduce
|
||||
+
|
||||
0
|
||||
(map
|
||||
#(* (cargo %) (-> world :commodities % :weight))
|
||||
(keys cargo)))))
|
||||
|
||||
|
||||
(defn can-carry
|
||||
"Return the number of units of this `commodity` which this `merchant`
|
||||
can carry in this `world`, given their current burden."
|
||||
[merchant world commodity]
|
||||
(let [m (cond
|
||||
(keyword? merchant)
|
||||
(-> world :merchants merchant)
|
||||
(map? merchant)
|
||||
merchant)]
|
||||
(max
|
||||
0
|
||||
(quot
|
||||
(- (or (:capacity m) 0) (burden m world))
|
||||
(-> world :commodities commodity :weight)))))
|
||||
|
||||
(defn can-afford
|
||||
"Return the number of units of this `commodity` which this `merchant`
|
||||
can afford to buy in this `world`."
|
||||
[merchant world commodity]
|
||||
(let [m (cond
|
||||
(keyword? merchant)
|
||||
(-> world :merchants merchant)
|
||||
(map? merchant)
|
||||
merchant)
|
||||
l (:location m)]
|
||||
(cond
|
||||
(nil? m)
|
||||
(throw (Exception. "No merchant?"))
|
||||
(or (nil? l) (nil? (-> world :cities l)))
|
||||
(throw (Exception. (str "No known location for merchant " m)))
|
||||
:else
|
||||
(quot
|
||||
(:cash m)
|
||||
(-> world :cities l :prices commodity)))))
|
||||
|
||||
(defn add-stock
|
||||
"Where `a` and `b` are both maps all of whose values are numbers, return
|
||||
a map whose keys are a union of the keys of `a` and `b` and whose values
|
||||
are the sums of their respective values."
|
||||
[a b]
|
||||
(reduce
|
||||
merge
|
||||
a
|
||||
(map
|
||||
#(hash-map % (+ (or (a %) 0) (or (b %) 0)))
|
||||
(keys b))))
|
||||
|
||||
(defn add-known-prices
|
||||
"Add the current prices at this `merchant`'s location in the `world`
|
||||
to a new cache of known prices, and return it."
|
||||
[merchant world]
|
||||
(let [m (cond
|
||||
(keyword? merchant)
|
||||
(-> world :merchants merchant)
|
||||
(map? merchant)
|
||||
merchant)
|
||||
k (or (:known-prices m) {})
|
||||
l (:location m)
|
||||
d (or (:date world) 0)
|
||||
p (-> world :cities l :prices)]
|
||||
(cond
|
||||
(nil? m)
|
||||
(throw (Exception. "No merchant?"))
|
||||
(or (nil? l) (nil? (-> world :cities l)))
|
||||
(throw (Exception. (str "No known location for merchant " m)))
|
||||
:else
|
||||
(reduce
|
||||
merge
|
||||
k
|
||||
(map
|
||||
#(hash-map % (apply vector cons {:price (p %) :date d} (k %)))
|
||||
(-> world :commodities keys))))))
|
||||
28
src/cc/journeyman/the_great_game/merchants/merchants.clj
Normal file
28
src/cc/journeyman/the_great_game/merchants/merchants.clj
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
(ns cc.journeyman.the-great-game.merchants.merchants
|
||||
"Trade planning for merchants, primarily."
|
||||
(:require [taoensso.timbre :as l :refer [info error spy]]
|
||||
[the-great-game.utils :refer [deep-merge]]
|
||||
[the-great-game.merchants.strategies.simple :refer [move-merchant]]))
|
||||
|
||||
|
||||
(defn run
|
||||
"Return a partial world based on this `world`, but with each merchant moved."
|
||||
[world]
|
||||
(try
|
||||
(reduce
|
||||
deep-merge
|
||||
world
|
||||
(map
|
||||
#(try
|
||||
(let [move-fn (or
|
||||
(-> world :merchants % :move-fn)
|
||||
move-merchant)]
|
||||
(apply move-fn (list % world)))
|
||||
(catch Exception any
|
||||
(l/error any "Failure while moving merchant " %)
|
||||
{}))
|
||||
(keys (:merchants world))))
|
||||
(catch Exception any
|
||||
(l/error any "Failure while moving merchants")
|
||||
world)))
|
||||
|
||||
159
src/cc/journeyman/the_great_game/merchants/planning.clj
Normal file
159
src/cc/journeyman/the_great_game/merchants/planning.clj
Normal file
|
|
@ -0,0 +1,159 @@
|
|||
(ns cc.journeyman.the-great-game.merchants.planning
|
||||
"Trade planning for merchants, primarily. This follows a simple-minded
|
||||
generate-and-test strategy and currently generates plans for all possible
|
||||
routes from the current location. This may not scale. Also, routes do not
|
||||
currently have cost or risk associated with them."
|
||||
(:require [cc.journeyman.the-great-game.utils :refer [deep-merge make-target-filter]]
|
||||
[cc.journeyman.the-great-game.merchants.merchant-utils :refer [can-afford can-carry expected-price]]
|
||||
[cc.journeyman.the-great-game.world.routes :refer [find-route]]
|
||||
[cc.journeyman.the-great-game.world.world :refer [actual-price default-world]]))
|
||||
|
||||
(defn generate-trade-plans
|
||||
"Generate all possible trade plans for this `merchant` and this `commodity`
|
||||
in this `world`.
|
||||
|
||||
Returned plans are maps with keys:
|
||||
|
||||
* :merchant - the id of the `merchant` for whom the plan was created;
|
||||
* :origin - the city from which the trade starts;
|
||||
* :destination - the city to which the trade is planned;
|
||||
* :commodity - the `commodity` to be carried;
|
||||
* :buy-price - the price at which that `commodity` can be bought;
|
||||
* :expected-price - the price at which the `merchant` anticipates
|
||||
that `commodity` can be sold;
|
||||
* :distance - the number of stages in the planned journey
|
||||
* :dist-to-home - the distance from `destination` to the `merchant`'s
|
||||
home city."
|
||||
[merchant world commodity]
|
||||
(let [m (cond
|
||||
(keyword? merchant)
|
||||
(-> world :merchants merchant)
|
||||
(map? merchant)
|
||||
merchant)
|
||||
origin (:location m)]
|
||||
(map
|
||||
#(hash-map
|
||||
:merchant (:id m)
|
||||
:origin origin
|
||||
:destination %
|
||||
:commodity commodity
|
||||
:buy-price (actual-price world commodity origin)
|
||||
:expected-price (expected-price
|
||||
m
|
||||
commodity
|
||||
%)
|
||||
:distance (count
|
||||
(find-route world origin %))
|
||||
:dist-to-home (count
|
||||
(find-route
|
||||
world
|
||||
(:home m)
|
||||
%)))
|
||||
(remove #(= % origin) (-> world :cities keys)))))
|
||||
|
||||
(defn nearest-with-targets
|
||||
"Return the distance to the nearest destination among those of these
|
||||
`plans` which match these `targets`. Plans are expected to be plans
|
||||
as returned by `generate-trade-plans`, q.v.; `targets` are expected to be
|
||||
as accepted by `make-target-filter`, q.v."
|
||||
[plans targets]
|
||||
(apply
|
||||
min
|
||||
(map
|
||||
:distance
|
||||
(filter
|
||||
(make-target-filter targets)
|
||||
plans))))
|
||||
|
||||
(defn plan-trade
|
||||
"Find the best destination in this `world` for this `commodity` given this
|
||||
`merchant` and this `origin`. If two cities are anticipated to offer the
|
||||
same price, the nearer should be preferred; if two are equally distant, the
|
||||
ones nearer to the merchant's home should be preferred.
|
||||
`merchant` may be passed as a map or a keyword; `commodity` should be
|
||||
passed as a keyword.
|
||||
|
||||
The returned plan is a map with keys:
|
||||
|
||||
* :merchant - the id of the `merchant` for whom the plan was created;
|
||||
* :origin - the city from which the trade starts;
|
||||
* :destination - the city to which the trade is planned;
|
||||
* :commodity - the `commodity` to be carried;
|
||||
* :buy-price - the price at which that `commodity` can be bought;
|
||||
* :expected-price - the price at which the `merchant` anticipates
|
||||
that `commodity` can be sold;
|
||||
* :distance - the number of stages in the planned journey
|
||||
* :dist-to-home - the distance from `destination` to the `merchant`'s
|
||||
home city."
|
||||
[merchant world commodity]
|
||||
(let [plans (generate-trade-plans merchant world commodity)
|
||||
best-prices (filter
|
||||
(make-target-filter
|
||||
[[:expected-price
|
||||
(apply
|
||||
max
|
||||
(filter number? (map :expected-price plans)))]])
|
||||
plans)]
|
||||
(first
|
||||
(sort-by
|
||||
;; all other things being equal, a merchant would prefer to end closer
|
||||
;; to home.
|
||||
#(- 0 (:dist-to-home %))
|
||||
;; a merchant will seek the best price, but won't go further than
|
||||
;; needed to get it.
|
||||
(filter
|
||||
(make-target-filter
|
||||
[[:distance
|
||||
(apply min (filter number? (map :distance best-prices)))]])
|
||||
best-prices)))))
|
||||
|
||||
(defn augment-plan
|
||||
"Augment this `plan` constructed in this `world` for this `merchant` with
|
||||
the `:quantity` of goods which should be bought and the `:expected-profit`
|
||||
of the trade.
|
||||
|
||||
Returns the augmented plan."
|
||||
[merchant world plan]
|
||||
(let [c (:commodity plan)
|
||||
o (:origin plan)
|
||||
q (min
|
||||
(or
|
||||
(-> world :cities o :stock c)
|
||||
0)
|
||||
(can-carry merchant world c)
|
||||
(can-afford merchant world c))
|
||||
p (* q (- (:expected-price plan) (:buy-price plan)))]
|
||||
(assoc plan :quantity q :expected-profit p)))
|
||||
|
||||
(defn select-cargo
|
||||
"A `merchant`, in a given location in a `world`, will choose to buy a cargo
|
||||
within the limit they are capable of carrying, which they can anticipate
|
||||
selling for a profit at a destination."
|
||||
[merchant world]
|
||||
(let [m (cond
|
||||
(keyword? merchant)
|
||||
(-> world :merchants merchant)
|
||||
(map? merchant)
|
||||
merchant)
|
||||
origin (:location m)
|
||||
available (-> world :cities origin :stock)
|
||||
plans (map
|
||||
#(augment-plan
|
||||
m
|
||||
world
|
||||
(plan-trade m world %))
|
||||
(filter
|
||||
#(let [q (-> world :cities origin :stock %)]
|
||||
(and (number? q) (pos? q)))
|
||||
(keys available)))]
|
||||
(if
|
||||
(not (empty? plans))
|
||||
(first
|
||||
(sort-by
|
||||
#(- 0 (:dist-to-home %))
|
||||
(filter
|
||||
(make-target-filter
|
||||
[[:expected-profit
|
||||
(apply max (filter number? (map :expected-profit plans)))]])
|
||||
plans))))))
|
||||
|
||||
173
src/cc/journeyman/the_great_game/merchants/strategies/simple.clj
Normal file
173
src/cc/journeyman/the_great_game/merchants/strategies/simple.clj
Normal file
|
|
@ -0,0 +1,173 @@
|
|||
(ns cc.journeyman.the-great-game.merchants.strategies.simple
|
||||
"Default trading strategy for merchants.
|
||||
|
||||
The simple strategy buys a single product in the local market if there is
|
||||
one which can be traded profitably, trades it to the chosen target market,
|
||||
and sells it there. If there is no commodity locally which can be traded
|
||||
profitably, moves towards home with no cargo. If at home and no commodity
|
||||
can be traded profitably, does not move."
|
||||
(:require [taoensso.timbre :as l :refer [info error spy]]
|
||||
[cc.journeyman.the-great-game.utils :refer [deep-merge]]
|
||||
[cc.journeyman.the-great-game.gossip.gossip :refer [move-gossip]]
|
||||
[cc.journeyman.the-great-game.merchants.planning :refer [augment-plan plan-trade select-cargo]]
|
||||
[cc.journeyman.the-great-game.merchants.merchant-utils :refer
|
||||
[add-stock add-known-prices]]
|
||||
[cc.journeyman.the-great-game.world.routes :refer [find-route]]))
|
||||
|
||||
(defn plan-and-buy
|
||||
"Return a world like this `world`, in which this `merchant` has planned
|
||||
a new trade, and bought appropriate stock for it. If no profitable trade
|
||||
can be planned, the merchant is simply moved towards their home."
|
||||
[merchant world]
|
||||
(let [m (cond
|
||||
(keyword? merchant)
|
||||
(-> world :merchants merchant)
|
||||
(map? merchant)
|
||||
merchant)
|
||||
id (:id m)
|
||||
location (:location m)
|
||||
market (-> world :cities location)
|
||||
plan (select-cargo merchant world)]
|
||||
(l/debug "plan-and-buy: merchant" id)
|
||||
(cond
|
||||
(not (empty? plan))
|
||||
(let
|
||||
[c (:commodity plan)
|
||||
p (* (:quantity plan) (:buy-price plan))
|
||||
q (:quantity plan)]
|
||||
(l/info "Merchant" id "bought" q "units of" c "at" location "for" p plan)
|
||||
{:merchants
|
||||
{id
|
||||
{:stock (add-stock (:stock m) {c q})
|
||||
:cash (- (:cash m) p)
|
||||
:known-prices (add-known-prices m world)
|
||||
:plan plan}}
|
||||
:cities
|
||||
{location
|
||||
{:stock (assoc (:stock market) c (- (-> market :stock c) q))
|
||||
:cash (+ (:cash market) p)}}})
|
||||
;; if no plan, then if at home stay put
|
||||
(= (:location m) (:home m))
|
||||
(do
|
||||
(l/info "Merchant" id "remains at home in" location)
|
||||
{})
|
||||
;; else move towards home
|
||||
:else
|
||||
(let [route (find-route world location (:home m))
|
||||
next-location (nth route 1)]
|
||||
(l/info "No trade possible at" location "; merchant" id "moves to" next-location)
|
||||
(merge
|
||||
{:merchants
|
||||
{id
|
||||
{:location next-location}}}
|
||||
(move-gossip id world next-location))))))
|
||||
|
||||
(defn re-plan
|
||||
"Having failed to sell a cargo at current location, re-plan a route to
|
||||
sell the current cargo. Returns a revised world."
|
||||
[merchant world]
|
||||
(let [m (cond
|
||||
(keyword? merchant)
|
||||
(-> world :merchants merchant)
|
||||
(map? merchant)
|
||||
merchant)
|
||||
id (:id m)
|
||||
location (:location m)
|
||||
plan (augment-plan m world (plan-trade m world (-> m :plan :commodity)))]
|
||||
(l/debug "re-plan: merchant" id)
|
||||
(deep-merge
|
||||
world
|
||||
{:merchants
|
||||
{id
|
||||
{:plan plan}}})))
|
||||
|
||||
(defn sell-and-buy
|
||||
"Return a new world like this `world`, in which this `merchant` has sold
|
||||
their current stock in their current location, and planned a new trade, and
|
||||
bought appropriate stock for it."
|
||||
;; TODO: this either sells the entire cargo, or, if the market can't afford
|
||||
;; it, none of it. And it does not cope with selling different commodities
|
||||
;; in different markets.
|
||||
[merchant world]
|
||||
(let [m (cond
|
||||
(keyword? merchant)
|
||||
(-> world :merchants merchant)
|
||||
(map? merchant)
|
||||
merchant)
|
||||
id (:id m)
|
||||
location (:location m)
|
||||
market (-> world :cities location)
|
||||
stock-value (reduce
|
||||
+
|
||||
(map
|
||||
#(* (-> m :stock %) (-> market :prices m))
|
||||
(keys (:stock m))))]
|
||||
(l/debug "sell-and-buy: merchant" id)
|
||||
(if
|
||||
(>= (:cash market) stock-value)
|
||||
(do
|
||||
(l/info "Merchant" id "sells" (:stock m) "at" location "for" stock-value)
|
||||
(plan-and-buy
|
||||
merchant
|
||||
(deep-merge
|
||||
world
|
||||
{:merchants
|
||||
{id
|
||||
{:stock {}
|
||||
:cash (+ (:cash m) stock-value)
|
||||
:known-prices (add-known-prices m world)}}
|
||||
:cities
|
||||
{location
|
||||
{:stock (add-stock (:stock m) (:stock market))
|
||||
:cash (- (:cash market) stock-value)}}})))
|
||||
;; else
|
||||
(re-plan merchant world))))
|
||||
|
||||
(defn move-merchant
|
||||
"Handle general en route movement of this `merchant` in this `world`;
|
||||
return a (partial or full) world like this `world` but in which the
|
||||
merchant may have been moved ot updated."
|
||||
[merchant world]
|
||||
(let [m (cond
|
||||
(keyword? merchant)
|
||||
(-> world :merchants merchant)
|
||||
(map? merchant)
|
||||
merchant)
|
||||
id (:id m)
|
||||
at-destination? (and (:plan m) (= (:location m) (-> m :plan :destination)))
|
||||
plan (:plan m)
|
||||
next-location (if plan
|
||||
(nth
|
||||
(find-route
|
||||
world
|
||||
(:location m)
|
||||
(:destination plan))
|
||||
1)
|
||||
(:location m))]
|
||||
(l/debug "move-merchant: merchant" id "at" (:location m)
|
||||
"destination" (-> m :plan :destination) "next" next-location
|
||||
"at destination" at-destination?)
|
||||
(cond
|
||||
;; if the merchant is at the destination of their current plan
|
||||
;; sell all cargo and repurchase.
|
||||
at-destination?
|
||||
(sell-and-buy merchant world)
|
||||
;; if they don't have a plan, seek to create one
|
||||
(nil? plan)
|
||||
(plan-and-buy merchant world)
|
||||
;; otherwise, move one step towards their destination
|
||||
(and next-location (not= next-location (:location m)))
|
||||
(do
|
||||
(l/info "Merchant " id " moving from " (:location m) " to " next-location)
|
||||
(deep-merge
|
||||
{:merchants
|
||||
{id
|
||||
{:location next-location
|
||||
:known-prices (add-known-prices m world)}}}
|
||||
(move-gossip id world next-location)))
|
||||
:else
|
||||
(do
|
||||
(l/info "Merchant" id "has plan but no next-location; currently at"
|
||||
(:location m) ", destination is" (:destination plan))
|
||||
world))))
|
||||
|
||||
11
src/cc/journeyman/the_great_game/objects/container.clj
Normal file
11
src/cc/journeyman/the_great_game/objects/container.clj
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
(ns cc.journeyman.the-great-game.objects.container
|
||||
(:require
|
||||
[cc.journeyman.the-great-game.objects.game-object :refer :all]))
|
||||
|
||||
(defprotocol ProtoContainer
|
||||
(contents
|
||||
[container]
|
||||
"Return a sequence of the contents of this `container`, or `nil` if empty.")
|
||||
(is-empty?
|
||||
[container]
|
||||
"Return `true` if this `container` is empty, else `false`."))
|
||||
19
src/cc/journeyman/the_great_game/objects/game_object.clj
Normal file
19
src/cc/journeyman/the_great_game/objects/game_object.clj
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
(ns cc.journeyman.the-great-game.objects.game-object
|
||||
"Anything at all in the game world")
|
||||
|
||||
(defprotocol ProtoObject
|
||||
"An object in the world"
|
||||
(id [object] "Returns the unique id of this object.")
|
||||
(reify-object
|
||||
[object]
|
||||
"Adds this `object` to the global object list. If the `object` has a
|
||||
non-nil value for its `id` method, keys it to that id - **but** if the
|
||||
id value is already in use, throws a hard exception. Returns the id to
|
||||
which the object is keyed in the global object list."))
|
||||
|
||||
(defrecord GameObject
|
||||
[id]
|
||||
;; "An object in the world"
|
||||
ProtoObject
|
||||
(id [_] id)
|
||||
(reify-object [object] "TODO: doesn't work yet"))
|
||||
144
src/cc/journeyman/the_great_game/time.clj
Normal file
144
src/cc/journeyman/the_great_game/time.clj
Normal file
|
|
@ -0,0 +1,144 @@
|
|||
(ns cc.journeyman.the-great-game.time
|
||||
(:require [clojure.string :as s]))
|
||||
|
||||
(def game-start-time
|
||||
"The start time of this run."
|
||||
(System/currentTimeMillis))
|
||||
|
||||
(def ^:const game-day-length
|
||||
"The Java clock advances in milliseconds, which is fine.
|
||||
But we need game-days to be shorter than real world days.
|
||||
A Witcher 3 game day is 1 hour 36 minutes, or 96 minutes, which is
|
||||
presumably researched. Round it up to 100 minutes for easier
|
||||
calculation."
|
||||
(* 100 ;; minutes per game day
|
||||
60 ;; seconds per minute
|
||||
1000)) ;; milliseconds per second
|
||||
|
||||
(defn now
|
||||
"For now, we'll use Java timestamp for time; ultimately, we need a
|
||||
concept of game-time which allows us to drive day/night cycle, seasons,
|
||||
et cetera, but what matters about time is that it is a value which
|
||||
increases."
|
||||
[]
|
||||
(System/currentTimeMillis))
|
||||
|
||||
(def ^:const canonical-ordering-of-houses
|
||||
"The canonical ordering of religious houses."
|
||||
[:eye
|
||||
:foot
|
||||
:nose
|
||||
:hand
|
||||
:ear
|
||||
:mouth
|
||||
:stomach
|
||||
:furrow
|
||||
:plough])
|
||||
|
||||
(def ^:const days-of-week
|
||||
"The eight-day week of the game world. This differs from the canonical
|
||||
ordering of houses in that it omits the eye."
|
||||
(rest canonical-ordering-of-houses))
|
||||
|
||||
(def ^:const days-in-week
|
||||
"This world has an eight day week."
|
||||
(count days-of-week))
|
||||
|
||||
(def ^:const seasons-of-year
|
||||
"The ordering of seasons in the year is different from the canonical
|
||||
ordering of the houses, for reasons of the agricultural cycle."
|
||||
[:foot
|
||||
:nose
|
||||
:hand
|
||||
:ear
|
||||
:mouth
|
||||
:stomach
|
||||
:plough
|
||||
:furrow
|
||||
:eye])
|
||||
|
||||
(def ^:const seasons-in-year
|
||||
"Nine seasons in a year, one for each house (although the order is
|
||||
different."
|
||||
(count seasons-of-year))
|
||||
|
||||
(def ^:const weeks-of-season
|
||||
"To fit nine seasons of eight day weeks into 365 days, each must be of
|
||||
five weeks."
|
||||
[:first :second :third :fourth :fifth])
|
||||
|
||||
(def ^:const weeks-in-season
|
||||
"To fit nine seasons of eight day weeks into 365 days, each must be of
|
||||
five weeks."
|
||||
(count weeks-of-season))
|
||||
|
||||
(def ^:const days-in-season
|
||||
(* weeks-in-season days-in-week))
|
||||
|
||||
(defn game-time
|
||||
"With no arguments, the current game time. If a Java `timestamp` value is
|
||||
passed (as a `long`), the game time represented by that value."
|
||||
([] (game-time (now)))
|
||||
([timestamp]
|
||||
(- timestamp game-start-time)))
|
||||
|
||||
(defmacro day-of-year
|
||||
"The day of the year represented by this `game-time`, ignoring leap years."
|
||||
[game-time]
|
||||
`(mod (long (/ ~game-time game-day-length)) 365))
|
||||
|
||||
(def waiting-day?
|
||||
"Does this `game-time` represent a waiting day?"
|
||||
(memoize
|
||||
;; we're likely to call this several times in quick succession on the
|
||||
;; same timestamp
|
||||
(fn [game-time]
|
||||
(>=
|
||||
(day-of-year game-time)
|
||||
(* seasons-in-year weeks-in-season days-in-week)))))
|
||||
|
||||
(defn day
|
||||
"Day of the eight-day week represented by this `game-time`."
|
||||
[game-time]
|
||||
(let [day-of-week (mod (day-of-year game-time) days-in-week)]
|
||||
(if (waiting-day? game-time)
|
||||
(nth weeks-of-season day-of-week)
|
||||
(nth days-of-week day-of-week))))
|
||||
|
||||
(defn week
|
||||
"Week of season represented by this `game-time`."
|
||||
[game-time]
|
||||
(let [day-of-season (mod (day-of-year game-time) days-in-season)
|
||||
week (/ day-of-season days-in-week)]
|
||||
(if (waiting-day? game-time)
|
||||
:waiting
|
||||
(nth weeks-of-season week))))
|
||||
|
||||
(defn season
|
||||
[game-time]
|
||||
(let [season (int (/ (day-of-year game-time) days-in-season))]
|
||||
(if (waiting-day? game-time)
|
||||
:waiting
|
||||
(nth seasons-of-year season))))
|
||||
|
||||
(defn date-string
|
||||
"Return a correctly formatted date for this `game-time` in the calendar of
|
||||
the Great Place."
|
||||
[game-time]
|
||||
(s/join
|
||||
" "
|
||||
(if
|
||||
(waiting-day? game-time)
|
||||
[(s/capitalize
|
||||
(name
|
||||
(nth
|
||||
weeks-of-season
|
||||
(mod (day-of-year game-time) days-in-week))))
|
||||
"waiting day"]
|
||||
[(s/capitalize (name (week game-time)))
|
||||
(s/capitalize (name (day game-time)))
|
||||
"of the"
|
||||
(s/capitalize (name (season game-time)))])))
|
||||
|
||||
|
||||
|
||||
45
src/cc/journeyman/the_great_game/utils.clj
Normal file
45
src/cc/journeyman/the_great_game/utils.clj
Normal file
|
|
@ -0,0 +1,45 @@
|
|||
(ns cc.journeyman.the-great-game.utils)
|
||||
|
||||
(defn cyclic?
|
||||
"True if two or more elements of `route` are identical"
|
||||
[route]
|
||||
(not= (count route)(count (set route))))
|
||||
|
||||
(defn deep-merge
|
||||
"Recursively merges maps. Stolen from
|
||||
https://dnaeon.github.io/recursively-merging-maps-in-clojure/"
|
||||
[& maps]
|
||||
(letfn [(m [& xs]
|
||||
(if (some #(and (map? %) (not (record? %))) xs)
|
||||
(apply merge-with m xs)
|
||||
(last xs)))]
|
||||
(reduce m maps)))
|
||||
|
||||
(defn make-target-filter
|
||||
"Construct a filter which, when applied to a list of maps,
|
||||
will pass those which match these `targets`, where each target
|
||||
is a tuple [key value]."
|
||||
;; TODO: this would probably be more elegant as a macro
|
||||
[targets]
|
||||
(eval
|
||||
(list
|
||||
'fn
|
||||
(vector 'm)
|
||||
(cons
|
||||
'and
|
||||
(map
|
||||
#(list
|
||||
'=
|
||||
(list (first %) 'm)
|
||||
(nth % 1))
|
||||
targets)))))
|
||||
|
||||
(defn value-or-default
|
||||
"Return the value of this key `k` in this map `m`, or this `dflt` value if
|
||||
there is none."
|
||||
[m k dflt]
|
||||
(or (when (map? m) (m k)) dflt))
|
||||
|
||||
;; (value-or-default {:x 0 :y 0 :altitude 7} :altitude 8)
|
||||
;; (value-or-default {:x 0 :y 0 :altitude 7} :alt 8)
|
||||
;; (value-or-default nil :altitude 8)
|
||||
159
src/cc/journeyman/the_great_game/world/heightmap.clj
Normal file
159
src/cc/journeyman/the_great_game/world/heightmap.clj
Normal file
|
|
@ -0,0 +1,159 @@
|
|||
(ns cc.journeyman.the-great-game.world.heightmap
|
||||
"Functions dealing with the tessellated multi-layer heightmap."
|
||||
(:require [clojure.math.numeric-tower :refer [expt sqrt]]
|
||||
[mw-engine.core :refer []]
|
||||
[mw-engine.heightmap :refer [apply-heightmap]]
|
||||
[mw-engine.utils :refer [get-cell in-bounds? map-world scale-world]]
|
||||
[cc.journeyman.the-great-game.utils :refer [value-or-default]]))
|
||||
|
||||
;; 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.
|
||||
|
||||
;; It's utterly impossible to hold a whole continent at one metre scale in
|
||||
;; memory at one time. So we have to be able to regenerate high resolution
|
||||
;; surfaces from much lower resolution heightmaps.
|
||||
;;
|
||||
;; Thus to reproduce a segment of surface at a particular level of detail,
|
||||
;; we:
|
||||
;; 1. load the base heightmap into a grid (see
|
||||
;; `mw-engine.heightmap/apply-heightmap`);
|
||||
;; 2. scale the base hightmap to kilometre scale (see `scale-grid`);
|
||||
;; 3. exerpt the portion of that that we want to reproduce (see `exerpt-grid`);
|
||||
;; 4. interpolate that grid to get the resolution we require (see
|
||||
;; `interpolate-grid`);
|
||||
;; 5. create an appropriate purturbation grid from the noise map(s) for the
|
||||
;; same coordinates to break up the smooth interpolation;
|
||||
;; 6. sum the altitudes of the two grids.
|
||||
;;
|
||||
;; In production this will have to be done **very** fast!
|
||||
|
||||
(def ^:dynamic *base-map* "resources/maps/heightmap.png")
|
||||
(def ^:dynamic *noise-map* "resources/maps/noise.png")
|
||||
|
||||
(defn scale-grid
|
||||
"multiply all `:x` and `:y` values in this `grid` by this `n`."
|
||||
[grid n]
|
||||
(map-world grid (fn [w c x] (assoc c :x (* (:x c) n) :y (* (:y c) n)))))
|
||||
|
||||
|
||||
|
||||
;; Each of the east-west curve and the north-south curve are of course two
|
||||
;; dimensional curves; the east-west curve is in the :x/:z plane and the
|
||||
;; north-south curve is in the :y/:z plane (except, perhaps unwisely,
|
||||
;; we've been using :altitude to label the :z plane). We have a library
|
||||
;; function `walkmap.edge/intersection2d`, but as currently written it
|
||||
;; can only find intersections in :x/:y plane.
|
||||
;;
|
||||
;; TODO: rewrite the function so that it can use arbitrary coordinates.
|
||||
;; AFTER TRYING: OK, there are too many assumptions about the way that
|
||||
;; function is written to allow for easy rotation. TODO: think!
|
||||
|
||||
(defn interpolate-altitude
|
||||
"Return the altitude of the point at `x-offset`, `y-offset` within this
|
||||
`cell` having this `src-width`, taken from this `grid`."
|
||||
[cell grid src-width x-offset y-offset ]
|
||||
(let [c-alt (:altitude cell)
|
||||
n-alt (or (:altitude (get-cell grid (:x cell) (dec (:y cell)))) c-alt)
|
||||
w-alt (or (:altitude (get-cell grid (inc (:x cell)) (:y cell))) c-alt)
|
||||
s-alt (or (:altitude (get-cell grid (:x cell) (inc (:y cell)))) c-alt)
|
||||
e-alt (or (:altitude (get-cell grid (dec (:x cell)) (:y cell))) c-alt)]
|
||||
;; TODO: construct two curves (arcs of circles good enough for now)
|
||||
;; n-alt...c-alt...s-alt and e-alt...c-alt...w-alt;
|
||||
;; then interpolate x-offset along e-alt...c-alt...w-alt and y-offset
|
||||
;; along n-alt...c-alt...s-alt;
|
||||
;; then return the average of the two
|
||||
|
||||
0))
|
||||
|
||||
(defn interpolate-cell
|
||||
"Construct a grid (array of arrays) of cells each of width `target-width`
|
||||
from this `cell`, of width `src-width`, taken from this `grid`"
|
||||
[cell grid src-width target-width]
|
||||
(let [offsets (map #(* target-width %) (range (/ src-width target-width)))]
|
||||
(into
|
||||
[]
|
||||
(map
|
||||
(fn [r]
|
||||
(into
|
||||
[]
|
||||
(map
|
||||
(fn [c]
|
||||
(assoc cell
|
||||
:x (+ (:x cell) c)
|
||||
:y (+ (:y cell) r)
|
||||
:altitude (interpolate-altitude cell grid src-width c r)))
|
||||
offsets)))
|
||||
offsets))))
|
||||
|
||||
(defn interpolate-grid
|
||||
"Return a grid interpolated from this `grid` of rows, cols given scaling
|
||||
from this `src-width` to this `target-width`"
|
||||
[grid src-width target-width]
|
||||
(reduce
|
||||
concat
|
||||
(into
|
||||
[]
|
||||
(map
|
||||
(fn [row]
|
||||
(reduce
|
||||
(fn [g1 g2]
|
||||
(into [] (map #(into [] (concat %1 %2)) g1 g2)))
|
||||
(into [] (map #(interpolate-cell % grid src-width target-width) row))))
|
||||
grid))))
|
||||
|
||||
(defn excerpt-grid
|
||||
"Return that section of this `grid` where the `:x` co-ordinate of each cell
|
||||
is greater than or equal to this `x-offset`, the `:y` co-ordinate is greater
|
||||
than or equal to this `y-offset`, whose width is not greater than this
|
||||
`width`, and whose height is not greater than this `height`."
|
||||
[grid x-offset y-offset width height]
|
||||
(into
|
||||
[]
|
||||
(remove
|
||||
nil?
|
||||
(map
|
||||
(fn [row]
|
||||
(when
|
||||
(and
|
||||
(>= (:y (first row)) y-offset)
|
||||
(< (:y (first row)) (+ y-offset height)))
|
||||
(into
|
||||
[]
|
||||
(remove
|
||||
nil?
|
||||
(map
|
||||
(fn [cell]
|
||||
(when
|
||||
(and
|
||||
(>= (:x cell) x-offset)
|
||||
(< (:x cell) (+ x-offset width)))
|
||||
cell))
|
||||
row)))))
|
||||
grid))))
|
||||
|
||||
(defn get-surface
|
||||
"Return, as a vector of vectors of cells represented as Clojure maps, a
|
||||
segment of surface from this `base-map` as modified by this
|
||||
`noise-map` at this `cell-size` starting at this `x-offset` and `y-offset`
|
||||
and having this `width` and `height`.
|
||||
|
||||
If `base-map` and `noise-map` are not supplied, the bindings of `*base-map*`
|
||||
and `*noise-map*` will be used, respectively.
|
||||
|
||||
`base-map` and `noise-map` may be passed either as strings, assumed to be
|
||||
file paths of PNG files, or as MicroWorld style world arrays. It is assumed
|
||||
that one pixel in `base-map` represents one square kilometre in the game
|
||||
world. It is assumed that `cell-size`, `x-offset`, `y-offset`, `width` and
|
||||
`height` are integer numbers of metres."
|
||||
([cell-size x-offset y-offset width height]
|
||||
(get-surface *base-map* *noise-map* cell-size x-offset y-offset width height))
|
||||
([base-map noise-map cell-size x-offset y-offset width height]
|
||||
(let [b (if (seq? base-map) base-map (scale-world (apply-heightmap base-map) 1000))
|
||||
n (if (seq? noise-map) noise-map (apply-heightmap noise-map))]
|
||||
(if (and (in-bounds? b x-offset y-offset)
|
||||
(in-bounds? b (+ x-offset width) (+ y-offset height)))
|
||||
b ;; actually do stuff
|
||||
(throw (Exception. "Surface out of bounds for map.")))
|
||||
)))
|
||||
|
||||
37
src/cc/journeyman/the_great_game/world/location.clj
Normal file
37
src/cc/journeyman/the_great_game/world/location.clj
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
(ns cc.journeyman.the-great-game.world.location
|
||||
"Functions dealing with location in the world."
|
||||
(:require [clojure.math.numeric-tower :refer [expt sqrt]]))
|
||||
|
||||
;; A 'location' value is a list comprising at most the x/y coordinate location
|
||||
;; and the ids of the settlement and region (possibly hierarchically) that contain
|
||||
;; the location. If the x/y is not local to the home of the receiving agent, they
|
||||
;; won't remember it and won't pass it on; if any of the ids are not interesting
|
||||
;; So location information will degrade progressively as the item is passed along.
|
||||
|
||||
;; It is assumed that the `:home` of a character is a location in this sense.
|
||||
|
||||
(defn get-coords
|
||||
"Return the coordinates in the game world of `location`, which may be
|
||||
1. A coordinate pair in the format {:x 5 :y 32};
|
||||
2. A location, as discussed above;
|
||||
3. Any other gameworld object, having a `:location` property whose value
|
||||
is one of the above."
|
||||
[location]
|
||||
(cond
|
||||
(empty? location) nil
|
||||
(map? location)
|
||||
(cond
|
||||
(and (number? (:x location)) (number? (:y location)))
|
||||
location
|
||||
(:location location)
|
||||
(:location location))
|
||||
:else
|
||||
(get-coords (first (remove keyword? location)))))
|
||||
|
||||
(defn distance-between
|
||||
[location-1 location-2]
|
||||
(let [c1 (get-coords location-1)
|
||||
c2 (get-coords location-2)]
|
||||
(when
|
||||
(and c1 c2)
|
||||
(sqrt (+ (expt (- (:x c1) (:x c2)) 2) (expt (- (:y c1) (:y c2)) 2))))))
|
||||
7
src/cc/journeyman/the_great_game/world/mw.clj
Normal file
7
src/cc/journeyman/the_great_game/world/mw.clj
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
(ns cc.journeyman.the-great-game.world.mw
|
||||
"Functions dealing with building a great game world from a MicroWorld world."
|
||||
(:require [clojure.math.numeric-tower :refer [expt sqrt]]
|
||||
[mw-engine.core :refer []]
|
||||
[mw-engine.world :refer []]))
|
||||
|
||||
;; 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.
|
||||
55
src/cc/journeyman/the_great_game/world/routes.clj
Normal file
55
src/cc/journeyman/the_great_game/world/routes.clj
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
(ns cc.journeyman.the-great-game.world.routes
|
||||
"Conceptual (plan level) routes, represented as tuples of location ids."
|
||||
(:require [cc.journeyman.the-great-game.utils :refer [cyclic?]]))
|
||||
|
||||
(defn find-routes
|
||||
"Find routes from among these `routes` from `from`; if `to` is supplied,
|
||||
to `to`, by breadth-first search."
|
||||
([routes from]
|
||||
(map
|
||||
(fn [to] (cons from to))
|
||||
(remove
|
||||
empty?
|
||||
(map
|
||||
(fn [route]
|
||||
(remove
|
||||
#(= from %)
|
||||
(if (some #(= % from) route) route)))
|
||||
routes))))
|
||||
([routes from to]
|
||||
(let [steps (find-routes routes from)
|
||||
found (filter
|
||||
(fn [step] (if (some #(= to %) step) step))
|
||||
steps)]
|
||||
(if
|
||||
(empty? found)
|
||||
(find-routes routes from to steps)
|
||||
found)))
|
||||
([routes from to steps]
|
||||
(if
|
||||
(not (empty? steps))
|
||||
(let [paths (remove
|
||||
cyclic?
|
||||
(mapcat
|
||||
(fn [path]
|
||||
(map
|
||||
(fn [x] (concat path (rest x)))
|
||||
(find-routes routes (last path))))
|
||||
steps))
|
||||
found (filter
|
||||
#(= (last %) to) paths)]
|
||||
(if
|
||||
(empty? found)
|
||||
(find-routes routes from to paths)
|
||||
found)))))
|
||||
|
||||
(defn find-route
|
||||
"Find a single route from `from` to `to` in this `world-or-routes`, which
|
||||
may be either a world as defined in [[the-great-game.world.world]] or else
|
||||
a sequence of tuples of keywords."
|
||||
[world-or-routes from to]
|
||||
(first
|
||||
(find-routes
|
||||
(or (:routes world-or-routes) world-or-routes)
|
||||
from
|
||||
to)))
|
||||
39
src/cc/journeyman/the_great_game/world/run.clj
Normal file
39
src/cc/journeyman/the_great_game/world/run.clj
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
(ns cc.journeyman.the-great-game.world.run
|
||||
"Run the whole simulation"
|
||||
(:require [environ.core :refer [env]]
|
||||
[taoensso.timbre :as timbre]
|
||||
[taoensso.timbre.appenders.3rd-party.rotor :as rotor]
|
||||
[cc.journeyman.the-great-game.gossip.gossip :as g]
|
||||
[cc.journeyman.the-great-game.merchants.merchants :as m]
|
||||
[cc.journeyman.the-great-game.merchants.markets :as k]
|
||||
[cc.journeyman.the-great-game.world.world :as w]))
|
||||
|
||||
(defn init
|
||||
([]
|
||||
(init {}))
|
||||
([config]
|
||||
(timbre/merge-config!
|
||||
{:appenders
|
||||
{:rotor (rotor/rotor-appender
|
||||
{:path "the-great-game.log"
|
||||
:max-size (* 512 1024)
|
||||
:backlog 10})}
|
||||
:level (or
|
||||
(:log-level config)
|
||||
(if (env :dev) :debug)
|
||||
:info)})))
|
||||
|
||||
(defn run
|
||||
"The pipeline to run the simulation each game day. Returns a world like
|
||||
this world, with all the various active elements updated. The optional
|
||||
`date` argument, if supplied, is set as the `:date` of the returned world."
|
||||
([world]
|
||||
(g/run
|
||||
(m/run
|
||||
(k/run
|
||||
(w/run world)))))
|
||||
([world date]
|
||||
(g/run
|
||||
(m/run
|
||||
(k/run
|
||||
(w/run world date))))))
|
||||
192
src/cc/journeyman/the_great_game/world/world.clj
Normal file
192
src/cc/journeyman/the_great_game/world/world.clj
Normal file
|
|
@ -0,0 +1,192 @@
|
|||
(ns cc.journeyman.the-great-game.world.world
|
||||
"Access to data about the world")
|
||||
|
||||
;;; The world has to work either as map or a database. Initially, and for
|
||||
;;; unit tests, I'll use a map; later, there will be a database. But the
|
||||
;;; API needs to be agnostic, so that heirarchies which interact with
|
||||
;;; `world` don't have to know which they've got - as far as they're concerned
|
||||
;;; it's just a handle.
|
||||
|
||||
(def default-world
|
||||
"A basic world for testing concepts"
|
||||
{:date 0 ;; the age of this world in game days
|
||||
:cities
|
||||
{:aberdeen
|
||||
{:id :aberdeen
|
||||
:supplies
|
||||
;; `supplies` is the quantity of each commodity added to the stock
|
||||
;; each game day. If the price in the market is lower than 1 (the
|
||||
;; cost of production of a unit) no goods will be added.
|
||||
{:fish 10
|
||||
:leather 5}
|
||||
:demands
|
||||
;; `stock` is the quantity of each commodity in the market at any
|
||||
;; given time. It is adjusted for production and consumption at
|
||||
;; the end of each game day.
|
||||
{:iron 1
|
||||
:cloth 10
|
||||
:whisky 10}
|
||||
:port true
|
||||
:prices
|
||||
;; `prices`: the current price (both buying and selling, for simplicity)
|
||||
;; of each commodity in the market. Updated each game day based on current
|
||||
;; stock.
|
||||
{:cloth 1
|
||||
:fish 1
|
||||
:leather 1
|
||||
:iron 1
|
||||
:whisky 1}
|
||||
:stock
|
||||
;; `stock` is the quantity of each commodity in the market at any
|
||||
;; given time. It is adjusted for production and consumption at
|
||||
;; the end of each game day.
|
||||
{:cloth 0
|
||||
:fish 0
|
||||
:leather 0
|
||||
:iron 0
|
||||
:whisky 0}
|
||||
:cash 100}
|
||||
:buckie
|
||||
{:id :buckie
|
||||
:supplies
|
||||
{:fish 20}
|
||||
:demands
|
||||
{:cloth 5
|
||||
:leather 3
|
||||
:whisky 5
|
||||
:iron 1}
|
||||
:port true
|
||||
:prices {:cloth 1
|
||||
:fish 1
|
||||
:leather 1
|
||||
:iron 1
|
||||
:whisky 1}
|
||||
:stock {:cloth 0
|
||||
:fish 0
|
||||
:leather 0
|
||||
:iron 0
|
||||
:whisky 0}
|
||||
:cash 100}
|
||||
:callander
|
||||
{:id :callander
|
||||
:supplies {:leather 20}
|
||||
:demands
|
||||
{:cloth 5
|
||||
:fish 3
|
||||
:whisky 5
|
||||
:iron 1}
|
||||
:prices {:cloth 1
|
||||
:fish 1
|
||||
:leather 1
|
||||
:iron 1
|
||||
:whisky 1}
|
||||
:stock {:cloth 0
|
||||
:fish 0
|
||||
:leather 0
|
||||
:iron 0
|
||||
:whisky 0}
|
||||
:cash 100}
|
||||
:dundee {:id :dundee}
|
||||
:edinburgh {:id :dundee}
|
||||
:falkirk
|
||||
{:id :falkirk
|
||||
:supplies {:iron 10}
|
||||
:demands
|
||||
{:cloth 5
|
||||
:leather 3
|
||||
:whisky 5
|
||||
:fish 10}
|
||||
:port true
|
||||
:prices {:cloth 1
|
||||
:fish 1
|
||||
:leather 1
|
||||
:iron 1
|
||||
:whisky 1}
|
||||
:stock {:cloth 0
|
||||
:fish 0
|
||||
:leather 0
|
||||
:iron 0
|
||||
:whisky 0}
|
||||
:cash 100}
|
||||
:glasgow
|
||||
{:id :glasgow
|
||||
:supplies {:whisky 10}
|
||||
:demands
|
||||
{:cloth 5
|
||||
:leather 3
|
||||
:iron 5
|
||||
:fish 10}
|
||||
:port true
|
||||
:prices {:cloth 1
|
||||
:fish 1
|
||||
:leather 1
|
||||
:iron 1
|
||||
:whisky 1}
|
||||
:stock {:cloth 0
|
||||
:fish 0
|
||||
:leather 0
|
||||
:iron 0
|
||||
:whisky 0}
|
||||
:cash 100}}
|
||||
:merchants
|
||||
{:archie {:id :archie
|
||||
:home :aberdeen :location :aberdeen :cash 100 :capacity 10
|
||||
:known-prices {}
|
||||
:stock {}}
|
||||
:belinda {:id :belinda
|
||||
:home :buckie :location :buckie :cash 100 :capacity 10
|
||||
:known-prices {}
|
||||
:stock {}}
|
||||
:callum {:id :callum
|
||||
:home :callander :location :calander :cash 100 :capacity 10
|
||||
:known-prices {}
|
||||
:stock {}}
|
||||
:deirdre {:id :deidre
|
||||
:home :dundee :location :dundee :cash 100 :capacity 10
|
||||
:known-prices {}
|
||||
:stock {}}
|
||||
:euan {:id :euan
|
||||
:home :edinbirgh :location :edinburgh :cash 100 :capacity 10
|
||||
:known-prices {}
|
||||
:stock {}}
|
||||
:fiona {:id :fiona
|
||||
:home :falkirk :location :falkirk :cash 100 :capacity 10
|
||||
:known-prices {}
|
||||
:stock {}}}
|
||||
:routes
|
||||
;; all routes can be traversed in either direction and are assumed to
|
||||
;; take the same amount of time.
|
||||
[[:aberdeen :buckie]
|
||||
[:aberdeen :dundee]
|
||||
[:callander :glasgow]
|
||||
[:dundee :callander]
|
||||
[:dundee :edinburgh]
|
||||
[:dundee :falkirk]
|
||||
[:edinburgh :falkirk]
|
||||
[:falkirk :glasgow]]
|
||||
:commodities
|
||||
;; cost of commodities is expressed in person/days;
|
||||
;; weight in packhorse loads. Transport in this model
|
||||
;; is all overland; you don't take bulk cargoes overland
|
||||
;; in this period, it's too expensive.
|
||||
{:cloth {:id :cloth :cost 1 :weight 0.25}
|
||||
:fish {:id :fish :cost 1 :weight 1}
|
||||
:leather {:id :leather :cost 1 :weight 0.5}
|
||||
:whisky {:id :whisky :cost 1 :weight 0.1}
|
||||
:iron {:id :iron :cost 1 :weight 10}}})
|
||||
|
||||
(defn actual-price
|
||||
"Find the actual current price of this `commodity` in this `city` given
|
||||
this `world`. **NOTE** that merchants can only know the actual prices in
|
||||
the city in which they are currently located."
|
||||
[world commodity city]
|
||||
(-> world :cities city :prices commodity))
|
||||
|
||||
(defn run
|
||||
"Return a world like this `world` with only the `:date` to this `date`
|
||||
(or id `date` not supplied, the current value incremented by one). For
|
||||
running other aspects of the simulation, see [[the-great-game.world.run]]."
|
||||
([world]
|
||||
(run world (inc (or (:date world) 0))))
|
||||
([world date]
|
||||
(assoc world :date date)))
|
||||
Loading…
Add table
Add a link
Reference in a new issue