simon/the-great-game
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

More documentation; code organisation; started work on launcher.

Browse source
This commit is contained in:
Simon Brooke 2024-04-22 21:53:21 +01:00
parent 9490c9fd3e
commit 96d61e7116
75 changed files with 540 additions and 80 deletions
Download patch file Download diff file Expand all files Collapse all files

131
src/clj/cc/journeyman/the_great_game/agent/agent.clj Normal file
View file

@ -0,0 +1,131 @@
(ns cc.journeyman.the-great-game.agent.agent
"Anything in the game world with agency; primarily but not exclusively
characters."
(:require [cc.journeyman.the-great-game.objects.game-object :refer [ProtoObject]]
[cc.journeyman.the-great-game.objects.container :refer [ProtoContainer contents is-empty?]]))
;;; 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.
;;; attitudes - liking/disliking, attraction/repulsion, amity/hostility, trust/fear
;;; also need to live at this layer, even though dynamic change in attitudes belongs
;;; in the character layer.
(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.
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.")
(hungry? [actor world circle] "True if this actor is hungry and has no
immediate access to food.")
(pending-intentions
[actor]
"Returns a sequence of effects an actor intends, as a consequence of
acting.")
(pending-scheduled-action? [actor world circle]
"True if there is a plan in this `actor`'s
schedule which should be activated now.
NOTE THAT plans in the `daily` schedule are
NOT activated when in circles `:background`
or `:other`")
(plan-fight-or-flight [actor world circle]
"Return a plan to resolve any active threat to this
`actor` in this `world`.")
(plan-find-food [actor workd circle]
"Return a plan to find this `actor` food in this `world`.")
(plan-find-rest [actor workd circle]
"Return a plan to find this `actor` a safe place to rest, or
if in one, to actually rest, in this `world`.")
(plan-goal [actor world circle] "Return a plan to advance this `actor`
towards their personal objective, in this
world, or `nil` for default actors with no
objective.")
(plan-scheduled-action [actor workd circle]
"Return a plan taken from the schedule of this actor
for the current date and time, if any, else `nil`.")
(schedule [actor] "Return a map of scheduled actions for this `actor`.
TODO: work out the detailed format!")
(threatened? [actor world circle] "True if this `actor` is threatened in this
`world`.")
(tired? [actor world circle] "True if this `actor` needs rest."))
(defrecord Agent
;; "A default agent."
[name craft home culture]
;; ProtoObject
;; ProtoContainer
;; (contents
;; "The `contents` of an actor are the contents of their pack(s) (if any), where
;; a pack may be any sort of bag or container which the actor could reasonably
;; be carrying."
;; [actor]
;; (flatten
;; (map contents (filter #(satisfies? ProtoContainer %)
;; (:burden actor)))))
;; (is-empty?
;; [actor]
;; (empty? (:burden actor)))
;; ProtoAgent
;; (act
;; “Return a map in which :world is bound to a world like this `world `except that this `actor `has acted in it; and `:actor` is bound to an
;; actor like this `actor `except modified by the consequences of the action.
;; ‘Circle’ indicates which activation circle the actor is in.
;; Note that this implies that a `plan `is a function of three arguments, an
;; actor, a world. and a circle, and returns exactly the sort of map this
;; function returns.”
;; [actor world circle]
;; (let [urgent (case circle
;; :other (cond
;; (pending-scheduled-action? actor world circle)
;; (plan-scheduled-action actor world circle))
;; :background (cond
;; (threatened? actor world circle)
;; (plan-fight-or-flight actor world circle)
;; (pending-scheduled-action? actor world circle)
;; (plan-scheduled-action actor world circle))
;; ;; else
;; (cond
;; (threatened? actor world circle)
;; (plan-fight-or-flight actor world circle)
;; (hungry? actor world circle)
;; (plan-find-food actor world circle)
;; (tired? actor world circle)
;; (plan-find-rest actor world circle)
;; (pending-scheduled-action? actor world circle)
;; (plan-scheduled-action actor world circle)))
;; next-action (cond urgent urgent
;; (empty? (:plans actor))
;; (plan-goal actor world circle)
;; :else (first (:plans actor)))
;; consequences (apply next-action (list actor world circle))]
;; ;; we return consequences of the action, except that, if the action
;; ;; was on the plans of the actor, we remove it.
;; (if-not (= next-action (first (:plans actor)))
;; consequences
;; (assoc consequences :actor
;; (assoc (:actor consequences) :plans
;; (rest (-> consequences :actor :plans)))))))
)

55
src/clj/cc/journeyman/the_great_game/agent/schedule.clj Normal file
View file

@ -0,0 +1,55 @@
(ns cc.journeyman.the-great-game.agent.schedule
"Schedules of plans for actors in the game, in order that they may have
daily and seasonal patterns of behaviour.")
;; TODO: I don't have a good handle yet on when a new scheduled task can
;; interrupt an existing scheduled task. It's highly undesirable that
;; uncompleted scheduled tasks should be left on the queue. The simplest
;; solution is to arrange the schedule such that, under notmal circumstances,
;; no scheduled task will interrupt another. But if a scheduled task is
;; interrupted by an attack, say, or a conversation, and then continued,
;; there's a chance of overrunning the start of the next.
;;
;; Perhaps I need to give scheduled tasks the equivalent of a watchdog timer,
;; but that makes them much more sophisticated objects than I wanted them to
;; be.
;; NOTE: this assumes that a world contains a key `:time` whose values are
;; a map with at least the keys
;; 1. `:day`, whose value is an integer representing the current day of the
;; year, and
;; 2. `minute`, whose value is an integer representing the current minute of
;; the day.
;; it probably also includes a `:year`, but that isn't needed here.
;; (def default-human-schedule
;; "A sample schedule for a human actor. This assumes that each of:
;; 1. `find-food`;
;; 2. `goto-market`;
;; 3. `help-with-harvest`;
;; 3. `perform-craft`
;; 4. `sleep-until-dawn`
;; Are plans, which is to say, functions of three arguments, an `actor`,
;; a `world` and a `circle`."
;; {:annual {32 {:daily {1020 (fn [a w c] (attend-festival a w c :imbolc))}}
;; 122 {:daily {1020 (fn [a w c] (attend-festival a w c :bealtaine))}}
;; 210 {:daily {480 help-with-harvest}}
;; 211 {:daily {480 help-with-harvest}}
;; 212 {:daily {480 help-with-harvest}}
;; 213 {:daily {480 help-with-harvest}}
;; 214 {:daily {480 help-with-harvest
;; 1020 (fn [a w c](attend-festival a w c :lughnasadh))}}
;; 306 {:daily {1020 (fn [a w c] (attend-festival a w c :samhain))}}}
;; :daily {420 find-food
;; 720 find-food
;; 1020 find-food
;; 1320 sleep-until-dawn}})
(defn plan-scheduled-action [actor world circle]
"Return the scheduled plan for the current time in this `world` from the
schedule of this `actor`, provided the `actor is in an appropriate `circle`"
(case circle
(:active :pending) (let [s (:schedule actor)
d (or (:daily (-> s :annual (-> world :time :day)))
(:daily s))]
(when d (d (-> world :time :minute))))))

81
src/clj/cc/journeyman/the_great_game/buildings/module.clj Normal file
View file

@ -0,0 +1,81 @@
(ns cc.journeyman.the-great-game.buildings.module
"A module of a building; essentially something like a portacabin, which can be
assembled together with other modules to make a complete building.
Modules need to include
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
**Role** must be one of:
1. `:primary` a ground floor main entrance module
2. `:secondary` a module which can be upper or ground floor
3. `:upper` a module which can only be on an upper floor, for example one
with a projecting gallery, balcony or overhang.
Other values for `role` will emerge.
**Exits** must be a sequence of keywords taken from the following list:
1. `:left` an exit in the centre of the left wall
2. `:left-front` an exit in the centre of the left half of the front wall
3. `:front` an exit in the centre of the front wall
4. `:right-front` an exit in the centre of the right half of the front wall
5. `:right` an exit in the centre of the right wall
6. `:right-back` an exit in the centre of the right half of the back wall
7. `:left-back` an exit in the centre of the back wall
A module placed on an upper floor must have no exit which opens beyond the
footprint of the floor below - no doors into mid air! However, it is allowable
(and indeed is necessary) to allow doors into roof spaces if the adjacent
module on the same floor does not yet exist, since otherwise it would be
impossible to access a new room which might later be built there.
**Load** must be a small integer indicating both the weight of the module and
the total amount of weight it can support. So for example a stone-built module
might have a `load` value of 4, a brick built one of 3, and a half-timbered one
of 2, and a tent of 0. This means a stone ground floor module could support one
further floor of stone or brick, or two further floors of half timbered
construction; while a brick built ground floor could support a single brick or
half-timbered upper floor but not a stone one, and a half-timbered ground floor
could only support a half timbered upper floor.
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.")
(defrecord BuildingModule
[model
^Double length
^Double width
^Double height
^Integer load
^clojure.lang.Keyword role
^clojure.lang.IPersistentCollection textures
^clojure.lang.IPersistentCollection exits
]
)

150
src/clj/cc/journeyman/the_great_game/buildings/rectangular.clj Normal file
View file

@ -0,0 +1,150 @@
(ns cc.journeyman.the-great-game.buildings.rectangular
"Build buildings with a generally rectangular floow plan.
## Motivations
Right, the idea behind this namespace is many fold.
1. To establish the broad principle of genetic buildings, by creating a
function which reproducibly creates reproducible buildings at specified
locations, such that different buildings are credibly varied but a
building at a specified location is always (modulo economic change) the
same.
2. Create good rectangular buildings, and investigate whether a single
function can be used to create buildings of more than one family (e.g.
can it produce flat roofed, north African style, mud brick houses as
well as pitch roofed, half timbered northern European houses?)
3. Establish whether, in my current state of fairly severe mental illness,
I can actually produce any usable code at all.
## Key factors in the creation of a building
### Holding
Every building is on a holding, and, indeed, what I mean by 'building' here
may well turn out to be 'the collection of all the permanent structures on
a holding. A holding is a polygonal area of the map which does not
intersect with any other holding, but for the time being we'll make the
simplifying assumption that every holding is a rectangular strip, and that
'urban' holdings are of a reasonably standard width (see Viking-period
York) and length. Rural holdings (farms, ?wood lots) may be much larger.
### Terrain
A building is made of the stuff of the place. In a forest, buildings will
tend to be wooden; in a terrain with rocky outcrops -- normally found on
steep slopes -- stone. On the flat lands where there's river mud, of brick,
cob, or wattle and daub. So to build a building we need to know the
terrain. Terrain can be inferred from location but in practice this will
be computationally expensive, so we'll pass terrain in as an argument to
the build function.
For the time being we'll pass it in simply as a keyword from a defined set
of keywords; later it may be a more sophisticated data structure.
### Culture
People of different cultures build distinctively different buildings, even
when using the same materials. So, in our world, a Japanese wooden house
looks quite different from an Anglo Saxon stave house which looks quite
different from a Canadian log cabin, even though the materials are much the
same and the tools available to build with are not much different.
Culture can affect not just the overall shape of a building but also its
finish and surface detail. For example, in many places in England, stone
buildings are typically left bare; in rural Scotland, typically painted
white or in pastel shades; in Ireland, often quite vivid colours.
People may also show religious or cultural symbols on their buildings.
For all these reasons, we need to know the culture of the occupant when
creating a building. Again, this will initially be passed in as a keyword.
### Craft
People in the game world have a craft, and some crafts will require
different features in the building. In the broadly late-bronze-age-to
medieval period within which the game is set, residence and workplace
are for most people pretty much the same.
So a baker needs an oven, a smith a forge, and so on. All crafts who do
some degree retail trade will want a shop front as part of the ground
floor of their dwelling. Merchants and bankers will probably have houses
that are a bit more showy than others.
Whether the 'genetic buildings' idea will ever really produce suitable
buildings for aristons I don't know; it seems more likely that significant
strongholds (of which there will be relatively few) should all be hand
modelled rather than procedurally generated."
(:require [cc.journeyman.the-great-game.holdings.holding :refer [ProtoHolding]]
[cc.journeyman.the-great-game.location.location :refer [ProtoLocation]])
(:import [org.apache.commons.math3.random MersenneTwister]))
(def ^:dynamic *terrain-types*
"Types of terrain which affect building families. TODO: This is a placeholder;
a more sophisticated model will be needed."
#{:arable :arid :forest :plateau :upland})
(def ^:dynamic *cultures*
"Cultures which affect building families. TODO: placeholder"
#{:ariston :coastal :steppe-clans :western-clans :wild-herd})
(def ^:dynamic *crafts*
"Crafts which affect building types in the game. See
`Populating a game world`. TODO: placeholder"
#{:baker :banker :butcher :chancellor :innkeeper :lawyer :magus :merchant :miller :priest :scholar :smith :weaver})
(def ^:dynamic *building-families*
"Families of buildings.
Each family has
* terrain types to which it is appropriate;
* crafts to which it is appropriate;
* cultures to which it is appropriate.
Each generated building will be of one family, and will comprise modules
taken only from that family."
{:pitched-rectangular {:terrains #{:arable :forest :upland}
:crafts *crafts*
:cultures #{:coastal :western-clans}
:modules []}
:flatroof-rectangular {:terrains #{:arid :plateau}
:crafts *crafts*
:cultures #{:coastal}
:modules []}})
(defn building-family
"A building family is essentially a collection of models of building modules
which can be assembled to create buildings of a particular structural and
architectural style."
[terrain culture craft gene]
(let [candidates (filter #(and
((:terrains %) terrain)
((:crafts %) craft)
((:cultures %) culture))
(vals *building-families*))]
(nth candidates (mod (Math/abs (.nextInt gene)) (count candidates)))))
(building-family :arable :coastal :baker (MersenneTwister. 5))
(defn build!
"Builds a building, and returns a data structure which represents it. In
building the building, it adds a model of the building to the representation
of the world, so it does have a side effect."
[holding terrain culture craft size]
(if (satisfies? ProtoHolding holding)
(let [location (.building-origin holding)
gene (MersenneTwister. (int (+ (* (.easting location) 1000000) (.northing location))))
family (building-family terrain culture craft gene)]
(if
(and (instance? ProtoLocation location) (:orientation location))
:stuff
:nonsense
))
:froboz))
;; (def ol (cc.journeyman.the-great-game.location.location/OrientedLocation. 123.45 543.76 12.34 0.00 {}))

114
src/clj/cc/journeyman/the_great_game/character/character.clj Normal file
View file

@ -0,0 +1,114 @@
(ns cc.journeyman.the-great-game.character.character
"A character that can talk; either human or dragon (although very probably
we won't do talking dragons until really well into this process). All
characters have the news-passing abilities of a gossip, but we use `gossip`
to mean a special character who is part of the news-passing network."
(:require [cc.journeyman.the-great-game.gossip.gossip :refer [dialogue]]
[cc.journeyman.the-great-game.agent.agent :refer [ProtoAgent]]
[cc.journeyman.the-great-game.character.container :refer [ProtoContainer]]
[clojure.string :as cs :only [join]])
(:import [clojure.lang IPersistentMap]))
(defn honorific
"Placeholder. If a character is a teir one craftsman, they get called 'Master';
if a teir two ariston, they get called 'Ariston' and if a teir one ariston,
'Tyrranos'. But the logic of this is about occupations, which probably isn't
this namespace."
[_character]
nil)
(defn place-name
"Placeholder. We're going to have to have names of villages, towns, regions
and so on, and we're going to have to be able to retrieve those efficiently,
but I don't yet know how this is going to work. Definitely doesn't belong
in this namespace."
[_cell]
nil)
(defn match-on?
"Placeholder, utility function. Do all these `objects` have the same values for
these `keys`?"
[keys & objects]
(reduce = (map #(select-keys % keys) objects)))
(defprotocol ProtoCharacter
(full-name [character]
"Return the full name of this `character`, constructed according
to the default construction sequence")
(relative-name [character other]
"Return the name that `other` would naturally use in an
informal context to describe `character`")
(personal-name [character]
"Return the personal name of this `character`."))
(defrecord Character [object
agent
family-name
personal-name
occupation
rank
epithet
knowledge
wallet]
;; A character; obviously, normally, a non-player character, although the
;; player character is one of these. Essentially, an Agent which can speak,
;; which has knowledge, which has a set of affective relationships with other
;; characters.
;; ProtoContainer
ProtoAgent
ProtoCharacter
(personal-name [character] (:personal-name character))
(full-name [character]
(let [e (:epithet character)
h (honorific character)
f (:family-name character)
p (:personal-name character)
o (:occupation character)
l (place-name (:cell character))]
(cs/join " "
(remove nil?
(flatten
[e
h
f
p
(when o ["the" o])
(when l ["of" l])])))))
(relative-name [character other]
(let [e (:epithet character)
h (honorific character)
f (:family-name character)
p (:personal-name character)
o (:occupation character)
h (place-name (:cell character))
same-family? (= f (:family-name other))]
(cs/join " "
(remove nil?
(flatten
[(when-not (match-on?
[:family-name :cell] character other)
e)
(when-not same-family? h)
(when-not same-family? h)
p
(when (and o (not (match-on? :occupation))) ["the" o])
(when (and h
(not (match-on? [:cell] character other))) ["of" h])]))))))
(defn make-character
"Construct a Character record from this `seed` map"
[^IPersistentMap seed]
(let [object (make-object seed)
agent (make-actor seed)]
(apply Character.
(list (map seed [:agent
:family-name
:personal-name
:occupation
:rank
:epithet
:knowledge
:wallet])))))

1
src/clj/cc/journeyman/the_great_game/character/sex.clj Normal file
View file

@ -0,0 +1 @@
(ns cc.journeyman.the-great-game.character.sex)

73
src/clj/cc/journeyman/the_great_game/gossip/gossip.clj Normal file
View file

@ -0,0 +1,73 @@
(ns cc.journeyman.the-great-game.gossip.gossip
"Interchange of news events between gossip agents.
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.
Innkeepers are also gossip agents but do not typically move."
(:require [cc.journeyman.the-great-game.utils :refer [deep-merge]]
[cc.journeyman.the-great-game.gossip.news-items :refer [learn-news-item]]
))
(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
"Gather news for the specified `gossip` in this `world`."
[world gossip]
(let [g (cond (keyword? gossip)
(-> world :gossips gossip)
(map? gossip)
gossip)]
(if g
{: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]
(reduce
deep-merge
world
(map
#(gather-news world %)
(keys (:gossips world)))))

341
src/clj/cc/journeyman/the_great_game/gossip/news_items.clj Normal file
View file

@ -0,0 +1,341 @@
(ns cc.journeyman.the-great-game.gossip.news-items
"Using news items (propositions) to transfer knowledge between gossip agents.
## Status
What is here is essentially working. It's not, however, working with the
rich data objects which will be needed, and it's not yet nearly efficient
enough, but it allows knowledge to propagate through the world procedurally,
at a rate limited by the speed of movement of the gossip agents.
## Discussion
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.;
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 is claimed to have 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`.
## Notes:
*TODO*
This namespace at present considers the `:knowledge` of a gossip to be a flat
list of propositions, each of which must be checked every time any new
proposition is offered. This is woefully inefficient. "
(:require [clojure.set :refer [union]]
[cc.journeyman.the-great-game.world.location :refer [distance-between]]
[cc.journeyman.the-great-game.time :refer [game-time]]
[cc.journeyman.the-great-game.utils :refer [inc-or-one truthy?]]
[taoensso.timbre :as l]))
(declare interesting-location?)
(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.
## 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 :quantity :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 two characters may be interesting.
:war {:verb :war :keys [:actor :other :location]
:inferences [{:verb :war :actor :other :other :actor}]}})
(def all-known-verbs
"All verbs currently known to the gossip system."
(set (keys news-topics)))
(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
;; TODO: we ought also check the relationships of the gossip.
;; Are relationships just propositions in the knowledge base?
(filter #(= (:actor %) character) (:knowledge gossip))
(filter #(= (:other %) character) (:knowledge gossip))
(when (interesting-location? gossip (:home character))
(list true)))))
(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 (if
(zero? d) 1
(/ 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))))))
;; (distance-between {:x 25 :y 37} {:x 25 :y 37})
;; (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 location]
(> (interest-in-location gossip location) 0))
(defn interesting-object?
[gossip object]
;; TODO: Not yet (really) implemented
true)
(defn interesting-verb?
"Is this `verb` interesting to this `gossip`?"
[gossip verb]
(let [vs (:interesting-verbs gossip)]
(truthy?
(when (set? vs)
(vs verb)))))
;; (interesting-verb? {:interesting-verbs #{:kill :sell}} :sell)
(defn compatible-value?
"True if `known-value` is the same as `new-value`, or, for each key present
in `new-value`, has the same value for that key.
The rationale here is that if `new-value` contains new or different
information, it's worth learning; otherwise, not."
[new-value known-value]
(or
(= new-value known-value)
;; TODO: some handwaving here about being a slightly better descriptor --
;; having more keys than might
(when (and (map? new-value) (map? known-value))
(every? true? (map #(= (new-value %) (known-value %))
(keys new-value))))))
(defn compatible-item?
"True if `new-item` is identical with, or less specific than, `known-item`.
If we already know 'Bad Joe killed Sweet Daisy', there's no point in
learning that 'someone killed Sweet Daisy', but there is point in learning
'someone killed Sweet Daisy _with poison_'."
[new-item known-item]
(truthy?
(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))))))
(defn known-item?
"True if this news `item` is already known to this `gossip`.
This means that the `gossip` already knows an item which identifiably has
the same _or more specific_ values for all the keys of this `item` except
`:nth-hand`, `:confidence` and `:learned-from`."
[gossip item]
(truthy?
(reduce
#(or %1 %2)
false
(filter true? (map #(compatible-item? item %) (:knowledge gossip))))))
(defn interesting-item?
"True if anything about this news `item` is interesting to this `gossip`."
[gossip item]
(and (not (known-item? gossip item))
(interesting-verb? gossip (:verb item)) ;; news is only interesting if the topic is.
(or
(interesting-character? gossip (:actor item))
(interesting-character? gossip (:other item))
(interesting-location? gossip (:location item))
(interesting-object? gossip (:object item)))))
(defn infer
"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)
:nth-hand (inc-or-one (:nth-hand item))}
(map (fn [k] {k (item (rule k))})
(remove
#{:verb :nth-hand}
(keys rule))))))
(declare learn-news-item)
(defn make-all-inferences
"Return a set of knowledge entries that can be inferred from this news
`item`."
[item]
(set
(map
#(infer item %)
(: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 (when
(coll? location)
(filter
#(when (interesting-location? gossip %) %)
location))]
(when-not (empty? l) l)))
(defn degrade-news-item
[gossip item]
(assoc
item
:nth-hand (inc-or-one (:nth-hand item))
:time-stamp (if
(number? (:time-stamp item))
(:time-stamp item)
(game-time))
:location (degrade-location gossip (:location item))
:actor (degrade-character gossip (:actor item))
:other (degrade-character gossip (:other item))
;; TODO: do something to degrade confidence in the item,
;; probably as a function of the provider's confidence in
;; the item and the gossip's trust in the provider
))
;; (degrade-news-item {:home [{:x 25 :y 37} :auchencairn :scotland]}
;; {:verb :marry :actor :adam :other :belinda :location [{:x 25 :y 37} :auchencairn :scotland]})
(defn learn-news-item
"Return a gossip like this `gossip`, which has learned this news `item` if
it is of interest to them."
([gossip item]
(learn-news-item gossip item true))
([gossip item follow-inferences?]
(if
(interesting-item? gossip item)
(let [item' (degrade-news-item gossip item)
g (assoc
gossip
:knowledge
(set
(cons
item'
(:knowledge gossip))))]
(if follow-inferences?
(assoc
g
:knowledge
(union (:knowledge g) (make-all-inferences item')))
g))
gossip)))

46
src/clj/cc/journeyman/the_great_game/holdings/holding.clj Normal file
View file

@ -0,0 +1,46 @@
(ns cc.journeyman.the-great-game.holdings.holding
(:require [cc.journeyman.the-great-game.agent.agent :refer [ProtoAgent]]
[cc.journeyman.the-great-game.objects.container :refer [ProtoContainer]]
[cc.journeyman.the-great-game.objects.game-object :refer [ProtoObject]]
;; [cc.journeyman.the-great-game.location.location :refer [OrientedLocation]]
[cc.journeyman.the-great-game.world.routes :refer []]))
;;; A holding is a polygonal area of the map which does not
;;; intersect with any other holding, or with any road or water feature. For
;;; the time being we'll make the
;;; simplifying assumption that every holding is a rectangular strip, and that
;;; 'urban' holdings are of a reasonably standard width (see Viking-period
;;; York) and length. Rural holdings (farms, ?wood lots) may be much larger.
(defprotocol ProtoHolding
(frontage
[holding]
"Returns a sequence of two locations representing the edge of the polygon
which defines this holding which is considered to be the front.")
(building-origin
[holding]
"Returns an oriented location - normally the right hand end of the
frontage, for an urban holding - from which buildings on the holding
should be built."))
(defrecord Holding [perimeter holder]
;; Perimeter should be a list of locations in exactly the same sense as a
;; route in `cc.journeyman.the-great-game.world.routes`. Some sanity checking
;; is needed to ensure this!
ProtoContainer
ProtoHolding
(frontage
[holding]
"TODO: this is WRONG, but will work for now. The frontage should
be the side of the perimeter nearest to the nearest existing
route."
[(first (perimeter holding)) (nth (perimeter holding) 1)])
(building-origin
[holding]
"TODO: again this is WRONG. The default building origin for rectangular
buildings should be the right hand end of the frontage when viewed
from outside the holding. But that's not general; celtic-style circular
buildings should normally be in the centre of their holdings. So probably
building-origin becomes a method of building-family rather than of holding."
(first (frontage holding)))
ProtoObject)

87
src/clj/cc/journeyman/the_great_game/launcher.clj Normal file
View file

@ -0,0 +1,87 @@
(ns cc.journeyman.the-great-game.launcher
"Launcher for the game"
(:require [clojure.tools.cli :refer [parse-opts]]
[jme-clj.core :refer [add-control add-to-root app-settings cam
defsimpleapp fly-cam get-height-map image
image-based-height-map load-height-map
load-texture material set* start
terrain-lod-control terrain-quad]])
(:import (com.jme3.texture Texture$WrapMode))
(:gen-class))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Launcher: parses any command line options, and launches the game.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2024 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def cli-options
;; An option with a required argument
[["-p" "--port PORT" "Port number"
:default 80
:parse-fn #(Integer/parseInt %)
:validate [#(< 0 % 0x10000) "Must be a number between 0 and 65536"]]
;; A non-idempotent option (:default is applied first)
["-v" nil "Verbosity level"
:id :verbosity
:default 0
:update-fn inc] ; Prior to 0.4.1, you would have to use:
;; :assoc-fn (fn [m k _] (update-in m [k] inc))
;; A boolean option defaulting to nil
["-h" "--help"]])
(defn init []
(set* (fly-cam) :move-speed 50)
(let [grass (set* (load-texture "textures/terrain/splat/grass.jpg") :wrap Texture$WrapMode/Repeat)
dirt (set* (load-texture "textures/terrain/splat/dirt.jpg") :wrap Texture$WrapMode/Repeat)
rock (set* (load-texture "textures/terrain/splat/road.jpg") :wrap Texture$WrapMode/Repeat)
mat (material "Common/MatDefs/Terrain/Terrain.j3md")
height-map-tex (load-texture "textures/terrain/splat/mountains512.png")
height-map (->> height-map-tex image image-based-height-map load-height-map)
patch-size 65
terrain (terrain-quad "my terrain" patch-size 513 (get-height-map height-map))]
(-> mat
(set* :texture "Alpha" (load-texture "textures/terrain/splat/alphamap.png"))
(set* :texture "Tex1" grass)
(set* :float "Tex1Scale" (float 64))
(set* :texture "Tex2" dirt)
(set* :float "Tex2Scale" (float 32))
(set* :texture "Tex3" rock)
(set* :float "Tex3Scale" (float 128)))
(-> terrain
(set* :material mat)
(set* :local-translation 0 -100 0)
(set* :local-scale 2 1 2)
(add-to-root)
(add-control (terrain-lod-control terrain (cam))))))
(defsimpleapp app :init init)
(defn -main
"Launch the game."
[& args]
(parse-opts args cli-options)
;; this isn't working, not sure why not.
;; (.setSettings app (app-settings false :dialog-image "images/splash.png"))
(start app))

45
src/clj/cc/journeyman/the_great_game/location/location.clj Normal file
View file

@ -0,0 +1,45 @@
(ns cc.journeyman.the-great-game.location.location)
;;; There's probably conflict between this sense of a reified location and
;;; the simpler sense of a location described in
;;; `cc.journeyman.the-great-game.world.location`, q.v. This needs to
;;; be resolved!
(defprotocol ProtoLocation
(easting [location]
"Return the easting of this location")
(northing [location] "Return the northing of this location")
(altitude [location]
"Return the absolute altitude of this location, which may be
different from the terrain height at this location, if, for
example, the location is underground or on an upper floor.")
(terrain-altitude [location]
"Return the 'ground level' (altitude of the terrain)
at this location given this world. TODO: possibly
terrain-altitude should be a method of the world.")
(settlement [location]
"Return the settlement record of the settlement in this world
within whose parish polygon this location exists, or if none
whose centre (inn location) is closest to this location"))
(defrecord Location [^Double easting ^Double northing ^Double altitude world]
ProtoLocation
(easting [l] (:easting l))
(northing [l] (:northing l))
(altitude [l] (:altitude l))
(terrain-altitude [l] 0.0) ;; TODO
(settlement [l] :tchahua))
(defrecord OrientedLocation
;; "Identical to a Location except having, additionally, an orientation"
[^Double easting ^Double northing ^Double altitude ^Double orientation world]
ProtoLocation
(easting [l] (:easting l))
(northing [l] (:northing l))
(altitude [l] (:altitude l))
(terrain-altitude [l] 0.0) ;; TODO
(settlement [l] :tchahua)) ;; TODO
;; (.settlement (OrientedLocation. 123.45 543.76 12.34 0.00 {}))

5
src/clj/cc/journeyman/the_great_game/lore/digester.clj Normal file
View file

@ -0,0 +1,5 @@
(ns cc.journeyman.the-great-game.lore.digester
;; (:require [org.clojurenlp.core :refer [pos-tag sentenize split-sentences
;; tag-ner tokenize word
;; ]])
)

84
src/clj/cc/journeyman/the_great_game/merchants/markets.clj Normal file
View 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/clj/cc/journeyman/the_great_game/merchants/merchant_utils.clj Normal file
View 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/clj/cc/journeyman/the_great_game/merchants/merchants.clj Normal file
View file

@ -0,0 +1,28 @@
(ns cc.journeyman.the-great-game.merchants.merchants
"Trade planning for merchants, primarily."
(:require [cc.journeyman.the-great-game.utils :refer [deep-merge]]
[cc.journeyman.the-great-game.merchants.strategies.simple :refer [move-merchant]]
[taoensso.timbre :as l]))
(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)))

158
src/clj/cc/journeyman/the_great_game/merchants/planning.clj Normal file
View file

@ -0,0 +1,158 @@
(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)))]
(when-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/clj/cc/journeyman/the_great_game/merchants/strategies/simple.clj Normal file
View 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
(seq? 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))))

2
src/clj/cc/journeyman/the_great_game/objects/character.clj Normal file
View file

@ -0,0 +1,2 @@
(ns cc.journeyman.the-great-game.objects.character
(:require [cc.journeyman.the-great-game.objects.game-object :as obj]))

9
src/clj/cc/journeyman/the_great_game/objects/container.clj Normal file
View file

@ -0,0 +1,9 @@
(ns cc.journeyman.the-great-game.objects.container)
(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`."))

21
src/clj/cc/journeyman/the_great_game/objects/game_object.clj Normal file
View file

@ -0,0 +1,21 @@
(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"
object))

72
src/clj/cc/journeyman/the_great_game/playroom.clj Normal file
View file

@ -0,0 +1,72 @@
(ns cc.journeyman.the-great-game.playroom
(:require [jme-clj.core :refer [add add-to-root box defsimpleapp fly-cam geo
get* get-state load-texture rotate run set*
setc set-state start unshaded-mat]])
(:import [com.jme3.math ColorRGBA]))
;; At present this file is just somewhere to play around with jme-clj examples
(declare app)
(defn init []
(let [cube (geo "jMonkey cube" (box 1 1 1))
mat (unshaded-mat)]
(set* mat :texture "ColorMap" (load-texture "textures/Monkey.jpg"))
(set* cube :material mat)
(add-to-root cube)
{:cube cube}))
;; Let's create simple-update fn with no body for now.
(defn simple-update [tpf]
(let [{:keys [cube]} (get-state)]
(rotate cube 0 (* 2 tpf) 0)))
;; Kills the running app var and closes its window.
;; (unbind-app #'app)
;; We define the `app` var.
(defsimpleapp app
:opts {:show-settings? false
:pause-on-lost-focus? false
:settings {:title "My JME Game"
:load-defaults? true
:frame-rate 60
:width 800
:height 600}}
:init init
:update simple-update)
;; (start app)
;; Reinitialises the running app
;;(run app
;; (re-init init))
;; By default, there is a Fly Camera attached to the app that you can control with W, A, S and D keys.
;; Let's increase its movement speed. Now, you fly faster :)
;; (run app
;; (set* (fly-cam) :move-speed 15))
;; Updates the app
;; (run app
;; (let [{:keys [cube]} (get-state)]
;; (set* cube :local-translation (add (get* cube :local-translation) 1 1 1))))
;; Updates the app adding a second cube
;; (run app
;; (let [cube (geo "jMonkey cube" (box 1 1 1))
;; mat (unshaded-mat)]
;; (set* mat :texture "ColorMap" (load-texture "textures/Monkey.jpg"))
;; (setc cube
;; :material mat
;; :local-translation [-3 0 0])
;; (add-to-root cube)
;; (set-state :cube2 cube)))
;; We added the new cube, but it's not rotating. We need to update the simple-update fn.
;; (defn simple-update [tpf]
;; (let [{:keys [cube cube2]} (get-state)]
;; (rotate cube 0 (* 2 tpf) 0)
;; (rotate cube2 0 (* 2 tpf) 0)))

118
src/clj/cc/journeyman/the_great_game/proving/core.clj Normal file
View file

@ -0,0 +1,118 @@
(ns cc.journeyman.the-great-game.proving.core
"Phase one of '[Baking the World](Bakine-the-world.html#phase-one-proving-the-procedural-world)'"
(:require [mw-engine.core :refer [run-world]]
[mw-engine.drainage :refer [run-drainage]]
;;[mw-engine.flow :refer []]
[mw-engine.heightmap :refer [apply-heightmap]]
[mw-engine.utils :refer [map-world]]
[mw-parser.declarative :refer [compile]]
[taoensso.timbre :refer [info]]
[wherefore-art-thou.core :refer [*genders* generate]]))
(defn get-drainage-map
"Given this `height-map` (a monochrome raster) and optionally this
`rainfall-map` (also a monochrome raster), return a drainage map
(a microworld style world tagged with drainage data)."
([height-map]
(run-drainage (apply-heightmap height-map)))
([height-map _rainfall-map]
;; TODO: currently I'm ignoring the rainfall map and relying on
;; `rain-world` in `mw-engine.drainage`, but I should not do so.
(get-drainage-map height-map)))
(defn get-biome-map
"Given this `height-map` (a monochrome raster) and optionally this
`rainfall-map` (also a monochrome raster), return a biome map (a
microworld style world tagged with vegetation, etc, data). "
([height-map]
(let [drained-world (get-drainage-map height-map)]
(run-world drained-world (compile (slurp "resources/data/baking/biome-rules.txt")) (count drained-world))))
([height-map _rainfall-map]
(get-biome-map height-map)))
(def ^:dynamic *life-goals*
"TODO: This definitely doesn't belong here, and will be moved."
(into []
(flatten
(map #(repeat %2 %1)
;; goals
[:ancestor :citizen :climber :conqueror :explorer :hoarder :master]
;; relative frequency of these goals
[10 10 8 5 3 5 8]))))
(defn- create-npc
;; TODO: this function needs not only to create a fully formed NPC, but
;; persist them in the database being built. This is just a sketch.
[prototype]
(let [g (or (:gender prototype) (rand-nth (keys *genders*)))
p (generate g)]
(dissoc (merge {:age (+ 18 (rand-int 18))
:disposition (- (rand-int 9) 4) ;; -4: surly to +4 sunny
:gender g
:goal (rand-nth *life-goals*)
:family-name (generate)
:occupation :vagrant
:personal-name p} prototype)
;; it's useful to have the world available to the create function,
;; but we don't want to return it in the results because clutter.
:world)))
(defn- populate-npcs
[prototype]
(let [family (generate)]
(into [] (map #(create-npc (assoc prototype :family-name family :occupation %))
(concat [:settler] (repeat 3 (:occupation prototype)))))))
(defn populate-cell
[world cell]
;; (info (format "populate-cell: w is %s; cell is %s" (type world) cell))
(let [npcs (case (:state cell)
:camp (populate-npcs {:world world :cell cell :occupation :nomad})
:house (populate-npcs {:world world :cell cell :occupation :peasant})
:inn (populate-npcs {:world world :cell cell :occupation :innkeeper})
:market (populate-npcs {:world world :cell cell :occupation :merchant})
;; else
nil)]
(if npcs (assoc cell :npcs npcs)
cell)))
(defn populate-world
"Given this `biome-map` (as returned by `get-biome-map`), populate a world
(probably some form of database) and return a structure which allows that
database o be interrogated."
[biome-map]
(let [world (run-world biome-map (compile (slurp "resources/data/baking/settlement-rules.txt")) (count biome-map))
with-npcs (map-world world (vary-meta (fn [w c] (populate-cell w c)) assoc :rule-type :ad-hoc))]
;; right, with that settled world, I'm going to put one herdsman with
;; five animals (either all sheep, all cattle, all goats, all horses or
;; all camels on each cell with state camp, and one settler; one farmer
;; on each cell with state farm, and one settler; one innkeeper on each
;; cell with state inn. Given that our cells are currently one kilometer
;; squares (i.e. 100 hectares) the 'inn' cell will be sufficient to
;; start a village, and the 'farm' cells will ultimately support about
;; five farming households.
;; Settlers should move around, forming roads
;; what I return at the end of this is a structure which contains keys
;; to a database I've stored all the NPCs in, and a (vector) roadmap of
;; all the roads that have been created, and a (vector) drainage map.
{:world with-npcs
:roadmap []}))
(defn get-road-map
[_populated-world])
(defn prove
"Given this `height-map` (a monochrome raster) and optionally this
`rainfall-map` (also a monochrome raster), return a populated world."
([height-map rainfall-map]
(let [drainage-map (get-drainage-map height-map)
biome-map (get-biome-map height-map rainfall-map)
populated-world (populate-world biome-map)]
{:height-map height-map
:drainage-map drainage-map
:populated-world populated-world
:road-map (get-road-map populated-world)})))

24
src/clj/cc/journeyman/the_great_game/proving/sketches.clj Normal file
View file

@ -0,0 +1,24 @@
(ns cc.journeyman.the-great-game.proving.sketches
"Code that's useful for exploring, but probably not part of the final
product, and if it is, will end up somewhere else."
(:require [wherefore-art-thou.core :refer [*genders*]]))
(defn happy-cell?
"True if all NPCs at `c` (assumed to be a MicroWorld-style cell) are of
a happy disposition."
[c]
(when (:npcs c)
(every? #(> (:disposition %) 2) (:npcs c))))
(defn couple-cell?
[c]
(let [npcs (:npcs c)]
(when
(every? pos?
(map (fn [g]
(count (filter #(and (= g (:gender %))
(#{:ancestor :citizen} (:goal %))
(pos? (:disposition %))) npcs)))
(keys *genders*)))
c)))

144
src/clj/cc/journeyman/the_great_game/time.clj Normal file
View 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)))])))

61
src/clj/cc/journeyman/the_great_game/utils.clj Normal file
View file

@ -0,0 +1,61 @@
(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)
(defn truthy?
"Returns `true` unless `val` is `nil`, `false` or an empty sequence.
Otherwise always 'false'; never any other value."
[val]
(and (or val false) true))
(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))

159
src/clj/cc/journeyman/the_great_game/world/heightmap.clj Normal file
View 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]]
[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-grid (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/clj/cc/journeyman/the_great_game/world/location.clj Normal file
View 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/clj/cc/journeyman/the_great_game/world/mw.clj Normal file
View 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/clj/cc/journeyman/the_great_game/world/routes.clj Normal file
View 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/clj/cc/journeyman/the_great_game/world/run.clj Normal file
View 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/clj/cc/journeyman/the_great_game/world/world.clj Normal file
View 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)))