diff --git a/.gitignore b/.gitignore
index a991fd2..9adaaa3 100644
--- a/.gitignore
+++ b/.gitignore
@@ -15,3 +15,5 @@ pom.xml.asc
/.calva/
.hgignore
.hg/
+
+*.so
diff --git a/project.clj b/project.clj
index db417cc..82d7d52 100644
--- a/project.clj
+++ b/project.clj
@@ -5,10 +5,12 @@
:url "https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html"}
:dependencies [[cnuernber/libpython-clj "1.33"]
[com.taoensso/telemere "1.0.0-beta3"] ;; Peter Taoussanis' new replacement for Timbre
+ [jme-clj "0.1.13"]
[org.clojure/clojure "1.11.1"]
+ [org.clojure/tools.cli "1.1.230"]
[org.jmonkeyengine/jme3-core "3.6.1-stable"]
[cnuernber/libpython-clj "1.36"]]
- :main ^:skip-aot cc.journeyman.simulated-genetics.core
+ :main ^:skip-aot cc.journeyman.simulated-genetics.launcher
:target-path "target/%s"
:profiles {:uberjar {:aot :all
:jvm-opts ["-Dclojure.compiler.direct-linking=true"]}})
diff --git a/src/cc/journeyman/simulated_genetics/core.clj b/src/cc/journeyman/simulated_genetics/core.clj
deleted file mode 100644
index 67f314e..0000000
--- a/src/cc/journeyman/simulated_genetics/core.clj
+++ /dev/null
@@ -1,7 +0,0 @@
-(ns cc.journeyman.simulated-genetics.core
- (:gen-class))
-
-(defn -main
- "I don't do a whole lot ... yet."
- [& args]
- (println "Hello, World!"))
diff --git a/src/cc/journeyman/simulated_genetics/genome.clj b/src/cc/journeyman/simulated_genetics/genome.clj
index fe63f87..38c52af 100644
--- a/src/cc/journeyman/simulated_genetics/genome.clj
+++ b/src/cc/journeyman/simulated_genetics/genome.clj
@@ -1,7 +1,7 @@
(ns cc.journeyman.simulated-genetics.genome
"lightweight simulation of a genome."
(:require [cc.journeyman.simulated-genetics.utils :refer [bits-in-genome create-mask long-from-binary-string]]
- [clojure.math :refer [pow]]
+ [clojure.math :refer [pow]]
[taoensso.telemere :refer [error! trace!]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -27,52 +27,71 @@
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def genome-mask
+ "A mask which selects just the bits we're interested in from a long."
+ (long (dec (pow 2 bits-in-genome))))
-(defmacro rand-genome
+(def gender-bit
+ "The bit that encodes for gender"
+ 25)
+
+(defmacro rand-genome
"Create a random genome."
[]
- `(long (rand (dec (pow 2 bits-in-genome))))) ;;Long/MAX_VALUE))) ;;
+ `(long (rand (dec (pow 2 bits-in-genome)))))
-(defn create-genome
+(defn create-genome
"Create a new genome; if `father` and `mother` are passed, the result will
comprise bits taken randomly from those genomes."
([]
(create-genome (rand-genome) (rand-genome)))
([^Long father ^Long mother]
(let [mask (rand-genome)]
- (trace! (format "Parents are %s, %s; mask is %s"
- (Long/toBinaryString father)
- (Long/toBinaryString mother)
+ (trace! (format "Parents are %s, %s; mask is %s"
+ (Long/toBinaryString father)
+ (Long/toBinaryString mother)
(Long/toBinaryString mask)))
- (bit-or (bit-and father mask) (bit-and (bit-not mother) mask)))))
+ ;; TODO: cycling through a string is inefficient
+ (long-from-binary-string
+ (apply str
+ (map #(if (bit-test (if (bit-test mask %) mother father) %) "1" "0")
+ (reverse (range bits-in-genome))))))))
(defn extract-bits
"Extract, as an integer left-shifted by `start`, those bits from `g` indexed
from `start` (inclusive) to `end` (exclusive)."
[^Long g ^Long start ^Long end]
(let [mask (trace! (create-mask start end))]
- (bit-shift-right (bit-and g mask) (- bits-in-genome end))))
+ (long (bit-shift-right (bit-and g mask) (- bits-in-genome end)))))
(defmacro ethnically-biased-feature-index
+ "Some feature values are associated with particular ethnicities."
[genome start end]
`(+ (extract-bits ~genome ~start ~end)
- (if (bit-test ~genome 3)
- (int (pow (- ~end ~start) 2))
+ (if (bit-test ~genome 3)
+ (int (pow (- ~end ~start) 2))
0)))
+(defn male?
+ "`true` if this genome is male."
+ [genome]
+ (bit-test genome gender-bit))
(defn expand-genome
- [^Long genome]
- {:ethnic-type (extract-bits genome 0 4)
- :skin-tone (+ (extract-bits genome 4 7) (if (bit-test genome 3) 4 0) 2)
- :freckles? (= (extract-bits genome 8 10) 3)
- :hair-colour (nth [:blonde :red :russet :cognac :chestnut :coffee :dark-brown :black]
- (ethnically-biased-feature-index genome 11 13))
- :eye-colour (nth [:blue :hazel :russet :cognac :chestnut :coffee :dark-brown :black]
- (ethnically-biased-feature-index genome 14 16))
- :height (+ 150 (* (extract-bits genome 17 20) 6))
- :robustness (extract-bits genome 21 23)
- :aging (extract-bits genome 24 27)
- :gender (if (bit-test genome 27) :male :female)
- ;; face stuff
- })
\ No newline at end of file
+ [^Long genome]
+ (let [skin-tone (ethnically-biased-feature-index genome 4 8)]
+ {:ethnic-type (extract-bits genome 0 4)
+ :skin-tone (ethnically-biased-feature-index genome 4 8)
+ :freckles? (= skin-tone 1)
+ :hair-colour (nth [:blonde :red :russet :cognac :chestnut
+ :coffee :dark-brown :black]
+ (ethnically-biased-feature-index genome 9 11))
+ :eye-colour (nth [:blue :hazel :russet :cognac :chestnut
+ :coffee :dark-brown :black]
+ (ethnically-biased-feature-index genome 12 14))
+ :height (+ 150 (* (extract-bits genome 15 18) (if (male? genome) 6 4))) ;; men are taller
+ :robustness (extract-bits genome 19 21)
+ :aging (extract-bits genome 22 25)
+ :gender (if (male? genome) :male :female)
+ ;; TODO: face stuff
+ }))
\ No newline at end of file
diff --git a/src/cc/journeyman/simulated_genetics/launcher.clj b/src/cc/journeyman/simulated_genetics/launcher.clj
new file mode 100644
index 0000000..962ce17
--- /dev/null
+++ b/src/cc/journeyman/simulated_genetics/launcher.clj
@@ -0,0 +1,90 @@
+(ns cc.journeyman.simulated-genetics.launcher
+ (: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]]
+ [taoensso.telemere :refer [set-min-level! trace!]])
+ (:import (com.jme3.texture Texture$WrapMode))
+ (:gen-class))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; Launcher: parses any command line options, and launches the test app.
+;;;;
+;;;; 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
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare app)
+
+(def cli-options
+ "I haven't yet thought out what command line arguments (if any) I need.
+ This is a placeholder."
+ [["-v" nil "Verbosity level"
+ :id :verbosity
+ :default 0
+ :update-fn inc]
+ ["-h" "--help"]])
+
+(defn init
+ "Again, placeholder. This initialises a bit of standard jMonkeyEngine
+ terrain, just to check I have things wired up correctly."
+ []
+ (set* (fly-cam) :move-speed 50)
+ (let [grass (set* (load-texture "jme3/textures/terrain/splat/grass.jpg")
+ :wrap Texture$WrapMode/Repeat)
+ dirt (set* (load-texture "jme3/textures/terrain/splat/dirt.jpg")
+ :wrap Texture$WrapMode/Repeat)
+ rock (set* (load-texture "jme3/textures/terrain/splat/road.jpg")
+ :wrap Texture$WrapMode/Repeat)
+ mat (material "Common/MatDefs/Terrain/Terrain.j3md")
+ height-map-tex (load-texture
+ "jme3/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 "jme3/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
+ "Start an app into which generated characters can ultimately be rendered."
+ [& args]
+ (let [options (parse-opts args cli-options)]
+ (set-min-level!
+ (nth [:error :warn :debug :trace] (:verbosity (:options options)))))
+
+ (trace! (start app)))
diff --git a/test/simulated_genetics/core_test.clj b/test/simulated_genetics/core_test.clj
new file mode 100644
index 0000000..3ed8fe3
--- /dev/null
+++ b/test/simulated_genetics/core_test.clj
@@ -0,0 +1,10 @@
+(ns simulated-genetics.core-test
+ (:require [clojure.test :refer :all]
+ [cc.journeyman.simulated-genetics.genome :refer :all]))
+
+(deftest clone-test
+ (testing "All bits should come from one or other parent. If parent genomes
+ are identical, the offspring is a clone."
+ (let [g (rand-genome)
+ c (create-genome g g)]
+ (is (= c g)))))