<commit_before>;; Utility functions and functions for manipulating state
(ns robinson.worldgen
  (:require 
            [robinson.common :as rc]
            [taoensso.timbre :as log]
            [robinson.random :as rr]
            [robinson.math :as rmath]
            [robinson.noise :as rn]
            [robinson.prism :as rprism]
            [robinson.itemgen :as ig]
            [robinson.viewport :as rv]
            [robinson.world :as rw]
            [robinson.player :as rp]
            [robinson.lineofsight :as rlos]
            [robinson.npc :as rnpc]
            #?@(:clj (
                [robinson.macros :as rm]
                [taoensso.nippy :as nippy]
                [quil.core :as q]
                quil.applet
                [clojure.core.async :as async :refer [go go-loop]]
                [clojure.java.io :as io])
                :cljs (
                [cljs.core.async :as async])))
  #?(:clj
     (:import [java.io DataInputStream DataOutputStream]
              [robinson.player Player])
     :cljs
     (:require-macros [robinson.macros :as rm]
                      [cljs.core.async.macros :refer [go go-loop]])))


(defn rand-xy-in-circle
  [x y max-r]
  (let [theta (rand-nth (range (* 2 Math/PI)))
        r     (rand-nth (range max-r))]
    [(int (+ x (* r (rmath/cos theta)))) (int (+ y (* r (rmath/sin theta))))]))

(defn line-segments [x1 y1 x2 y2]
  #_(println "line-segments" x1 y1 x2 y2)
  (if (not (rc/farther-than? (rc/xy->pos x1 y1) (rc/xy->pos x2 y2) 5))
    ;; too short to split, return direct line betweem two points.
    [[x1 y1] [x2 y2]]
    ;; subdivide
    (let [mx       (/ (+ x1 x2) 2)
          my       (/ (+ y1 y2) 2)
          r        (min 20 (rc/distance (rc/xy->pos x1 y1) (rc/xy->pos mx my)))
          [rmx rmy] (rand-xy-in-circle mx my (dec r))]
      (concat (line-segments x1 y1 rmx rmy)
              (line-segments rmx rmy x2 y2)))))

(defn add-extras
  "Adds extras to a place like items, and special cell types
   extras are in the format of `[[[x y] object] [[x y] object] &]`
   objects are cells with a type and maybe items `{:type :floor :items []}`"
  [place extras]
  ;; create a list of functions that can be applied to assoc extras, then create a composition of
  ;; so that setting can pass through each fn in turn.
  #_(log/debug "add-extras" place extras)
  (reduce (fn [place [[x y] & r]]
           (let [args (concat [[y x]] r)]
             #_(log/debug "assoc-in place" args)
             (apply assoc-in place args))) place extras))


(defn init-ocean
  []
  (let [max-x 80
        max-y 22]
    (add-extras
      (vec
        (map vec
          (partition max-x
            (for [y (range max-y)
                  x (range max-x)]
                {:type :water}))))
      [])))

(defn sample-tree [n x y]
  ((rprism/coerce (rprism/offset [-0.5 -0.5] (rprism/scale 0.1 (rprism/noise n)))) x y))

(defn sample-island
  [n x y]
  (let [c  ((rprism/coerce (rprism/scale 333.0 (rprism/offset (rprism/vnoise n) (rprism/radius)))) x y)
        c  ((rprism/coerce (rprism/offset (rprism/v+ (rprism/v* 15.0 (rprism/scale 15.0 (rprism/vnoise n)))
                                                     (rprism/v+ (rprism/v* 75.0 (rprism/scale 75.0 (rprism/vnoise n)))
                                                                (rprism/v* 150.0 (rprism/scale 150.0 (rprism/vnoise n)))))
                                          (rprism/scale 333.0 (rprism/radius)))) x y)
        ;c  ((rprism/coerce (rprism/scale 333.0 (rprism/radius))) x y)
        c1 ((rprism/coerce (rprism/offset [0.5 0.5] (rprism/scale 22 (rprism/snoise n)))) x y)
        c2 ((rprism/coerce (rprism/offset [-110.5 -640.5] (rprism/scale 26 (rprism/snoise n)))) x y)
        cgt #?(:clj  (> (Math/abs c1) (Math/abs c2))
               :cljs (> (.abs js/Math c1) (.abs js/Math c2)))]
    (cond
      ;; interior biomes
      (> 0.55  c)
        (cond
          (and (pos? c1) (pos? c2) cgt)
          :jungle
          (and (pos? c1) (pos? c2))
          :heavy-forest
          (and (pos? c1) (neg? c2) cgt)
          :light-forest
          (and (pos? c1) (neg? c2))
          :bamboo-grove
          (and (neg? c1) (pos? c2) cgt)
          :meadow
          (and (neg? c1) (pos? c2))
          :rocky
          (and (neg? c1) (neg? c2) cgt)
          :swamp
          :else
          :dirt)
      ;; shore/yellow
      (> 0.6  c)
          :sand
      ;; surf/light blue
      (> 0.68 c)
        :surf
      ;; else ocean
      :else
        :ocean)))

(defn find-starting-pos [seed max-x max-y]
  {:pre [(integer? seed)
         (integer? max-x)
         (integer? max-y)]}
  (loop [pos nil]
    (if (and (get pos :x)
             (get pos :y))
      (do
        (log/info "found starting position" pos)
        pos)
      (let [angle (rr/uniform-double (* 2 Math/PI))
            radius (min max-x max-y)
            [x y]   [(* radius (Math/cos angle))
                     (* radius (Math/sin angle))]
            points  (rlos/line-segment [x y] [0 0])
            samples (take-nth 2 points)
            n       (rn/create-noise (rr/create-random seed))
            #_#__ (log/info "find-starting-pos samples" (vec samples))]
        (if (= :ocean (apply sample-island n (first samples)))
          (let [non-water-samples (filter
                                    (fn [[x y]]
                                      (let [s (sample-island n x y)
                                            adj-types (map (fn [[x y]] (sample-island n x y))
                                                           (rw/adjacent-xys x y))]
                                        (log/info "sample" x y s (vec adj-types))
                                        (or
                                          (contains? #{:sand :dirt} s)
                                          (every? (partial contains? #{:sand :dirt :surf}) adj-types))))
                                    samples)
                [sx sy] (first non-water-samples)]
            (if (and sx sy)
              (recur (rc/xy->pos sx sy))
              (recur nil)))<commit_msg>Try to find start position from inside out rather than outside in so that the player doesn't end up on an island unconntected to the mainland<commit_after>;; Utility functions and functions for manipulating state
(ns robinson.worldgen
  (:require 
            [robinson.common :as rc]
            [taoensso.timbre :as log]
            [robinson.random :as rr]
            [robinson.math :as rmath]
            [robinson.noise :as rn]
            [robinson.prism :as rprism]
            [robinson.itemgen :as ig]
            [robinson.viewport :as rv]
            [robinson.world :as rw]
            [robinson.player :as rp]
            [robinson.lineofsight :as rlos]
            [robinson.npc :as rnpc]
            #?@(:clj (
                [robinson.macros :as rm]
                [taoensso.nippy :as nippy]
                [quil.core :as q]
                quil.applet
                [clojure.core.async :as async :refer [go go-loop]]
                [clojure.java.io :as io])
                :cljs (
                [cljs.core.async :as async])))
  #?(:clj
     (:import [java.io DataInputStream DataOutputStream]
              [robinson.player Player])
     :cljs
     (:require-macros [robinson.macros :as rm]
                      [cljs.core.async.macros :refer [go go-loop]])))


(defn rand-xy-in-circle
  [x y max-r]
  (let [theta (rand-nth (range (* 2 Math/PI)))
        r     (rand-nth (range max-r))]
    [(int (+ x (* r (rmath/cos theta)))) (int (+ y (* r (rmath/sin theta))))]))

(defn line-segments [x1 y1 x2 y2]
  #_(println "line-segments" x1 y1 x2 y2)
  (if (not (rc/farther-than? (rc/xy->pos x1 y1) (rc/xy->pos x2 y2) 5))
    ;; too short to split, return direct line betweem two points.
    [[x1 y1] [x2 y2]]
    ;; subdivide
    (let [mx       (/ (+ x1 x2) 2)
          my       (/ (+ y1 y2) 2)
          r        (min 20 (rc/distance (rc/xy->pos x1 y1) (rc/xy->pos mx my)))
          [rmx rmy] (rand-xy-in-circle mx my (dec r))]
      (concat (line-segments x1 y1 rmx rmy)
              (line-segments rmx rmy x2 y2)))))

(defn add-extras
  "Adds extras to a place like items, and special cell types
   extras are in the format of `[[[x y] object] [[x y] object] &]`
   objects are cells with a type and maybe items `{:type :floor :items []}`"
  [place extras]
  ;; create a list of functions that can be applied to assoc extras, then create a composition of
  ;; so that setting can pass through each fn in turn.
  #_(log/debug "add-extras" place extras)
  (reduce (fn [place [[x y] & r]]
           (let [args (concat [[y x]] r)]
             #_(log/debug "assoc-in place" args)
             (apply assoc-in place args))) place extras))


(defn init-ocean
  []
  (let [max-x 80
        max-y 22]
    (add-extras
      (vec
        (map vec
          (partition max-x
            (for [y (range max-y)
                  x (range max-x)]
                {:type :water}))))
      [])))

(defn sample-tree [n x y]
  ((rprism/coerce (rprism/offset [-0.5 -0.5] (rprism/scale 0.1 (rprism/noise n)))) x y))

(defn sample-island
  [n x y]
  (let [c  ((rprism/coerce (rprism/scale 333.0 (rprism/offset (rprism/vnoise n) (rprism/radius)))) x y)
        c  ((rprism/coerce (rprism/offset (rprism/v+ (rprism/v* 15.0 (rprism/scale 15.0 (rprism/vnoise n)))
                                                     (rprism/v+ (rprism/v* 75.0 (rprism/scale 75.0 (rprism/vnoise n)))
                                                                (rprism/v* 150.0 (rprism/scale 150.0 (rprism/vnoise n)))))
                                          (rprism/scale 333.0 (rprism/radius)))) x y)
        ;c  ((rprism/coerce (rprism/scale 333.0 (rprism/radius))) x y)
        c1 ((rprism/coerce (rprism/offset [0.5 0.5] (rprism/scale 22 (rprism/snoise n)))) x y)
        c2 ((rprism/coerce (rprism/offset [-110.5 -640.5] (rprism/scale 26 (rprism/snoise n)))) x y)
        cgt #?(:clj  (> (Math/abs c1) (Math/abs c2))
               :cljs (> (.abs js/Math c1) (.abs js/Math c2)))]
    (cond
      ;; interior biomes
      (> 0.55  c)
        (cond
          (and (pos? c1) (pos? c2) cgt)
          :jungle
          (and (pos? c1) (pos? c2))
          :heavy-forest
          (and (pos? c1) (neg? c2) cgt)
          :light-forest
          (and (pos? c1) (neg? c2))
          :bamboo-grove
          (and (neg? c1) (pos? c2) cgt)
          :meadow
          (and (neg? c1) (pos? c2))
          :rocky
          (and (neg? c1) (neg? c2) cgt)
          :swamp
          :else
          :dirt)
      ;; shore/yellow
      (> 0.6  c)
          :sand
      ;; surf/light blue
      (> 0.68 c)
        :surf
      ;; else ocean
      :else
        :ocean)))

(defn find-starting-pos [seed max-x max-y]
  {:pre [(integer? seed)
         (integer? max-x)
         (integer? max-y)]}
  (loop [pos nil]
    (if (and (get pos :x)
             (get pos :y))
      (do
        (log/info "found starting position" pos)
        pos)
      (let [angle (rr/uniform-double (* 2 Math/PI))
            radius (min max-x max-y)
            [x y]   [(* radius (Math/cos angle))
                     (* radius (Math/sin angle))]
            points  (rlos/line-segment [0 0] [x y])
            samples points #_(take-nth 2 points)
            n       (rn/create-noise (rr/create-random seed))
            _ (log/info "find-starting-pos samples" (vec samples))]
        (if (= :ocean (apply sample-island n (last samples)))
          (let [spans (partition-by (fn [[x y]]
                                      (let [s (sample-island n x y)
                                            adj-types (map (fn [[x y]] (sample-island n x y))
                                                           (rw/adjacent-xys x y))]
                                        (log/info "sample" x y s (vec adj-types))
                                        (every? (partial contains? #{:surf}) adj-types)))
                                    samples)
                [sx sy] (-> spans first last)]
            (if (and sx sy)
              (recur (rc/xy->pos sx sy))
              (recur nil)))
{'fraction_non_alphanumeric': 0.14270421607378128, 'fraction_numerical': 0.020092226613965744, 'mean_word_length': 1.4624898621248987, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 24, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 35, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6488985', 'n_tokens_mistral': 4366, 'n_tokens_neox': 4121, 'n_words': 1217}