Inheritance of features is now working

.gitignore

@@ -15,3 +15,5 @@ pom.xml.asc
 /.calva/
 .hgignore
 .hg/
+
+*.so

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"]}})

src/cc/journeyman/simulated_genetics/core.clj

@@ -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!"))

src/cc/journeyman/simulated_genetics/genome.clj

@@ -27,11 +27,18 @@
 ;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(def genome-mask
+  "A mask which selects just the bits we're interested in from a long."
+  (long (dec (pow 2 bits-in-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
   "Create a new genome; if `father` and `mother` are passed, the result will 
@@ -44,35 +51,47 @@
                      (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))
         0)))
 
+(defn male?
+  "`true` if this genome is male."
+  [genome]
+  (bit-test genome gender-bit))
 
 (defn expand-genome
-   [^Long genome]
+  [^Long genome]
-  {:ethnic-type (extract-bits genome 0 4)
+  (let [skin-tone (ethnically-biased-feature-index genome 4 8)]
-   :skin-tone (+ (extract-bits genome 4 7) (if (bit-test genome 3) 4 0) 2)
+    {:ethnic-type (extract-bits genome 0 4)
-   :freckles? (= (extract-bits genome 8 10) 3)
+     :skin-tone (ethnically-biased-feature-index genome 4 8)
-   :hair-colour (nth [:blonde :red :russet :cognac :chestnut :coffee :dark-brown :black]
+     :freckles? (= skin-tone 1)
-                     (ethnically-biased-feature-index genome 11 13))
+     :hair-colour (nth [:blonde :red :russet :cognac :chestnut
-   :eye-colour (nth [:blue :hazel :russet :cognac :chestnut :coffee :dark-brown :black]
+                        :coffee :dark-brown :black]
-                    (ethnically-biased-feature-index genome 14 16))
+                       (ethnically-biased-feature-index genome 9 11))
-   :height (+ 150 (* (extract-bits genome 17 20) 6))
+     :eye-colour (nth [:blue :hazel :russet :cognac :chestnut
-   :robustness (extract-bits genome 21 23)
+                       :coffee :dark-brown :black]
-   :aging (extract-bits genome 24 27)
+                      (ethnically-biased-feature-index genome 12 14))
-   :gender (if (bit-test genome 27) :male :female)
+     :height (+ 150 (* (extract-bits genome 15 18) (if (male? genome) 6 4))) ;; men are taller
-   ;; face stuff
+     :robustness (extract-bits genome 19 21)
-   })
+     :aging (extract-bits genome 22 25)
+     :gender (if (male? genome) :male :female)
+   ;; TODO: face stuff
+     }))

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)))

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)))))