<commit_before>(in-package #:mapgen)
(in-readtable :qtools)

(defvar *octave* 5)
(defvar *mode* NIL)

(defparameter *small-blend* 16)
(defparameter *medium-blend* 8)
(defparameter *big-blend* 4)

(defclass generated-map ()
  ((noise-map :initform NIL :accessor noise-map)
   (map-image :initform NIL :accessor map-image)
   (lightness :initform 0 :accessor lightness)
   (tile-size :initform 1 :accessor tile-size)
   (redraw :initform T :accessor redraw)))

(defmethod paint ((genmap generated-map) target)
  (when (redraw genmap)
    (draw-map genmap))
  (let ((image (map-image genmap)))
    (when image
      (let ((rect (q+:rect image)))
        (q+:draw-image target rect image rect)))))

(defmethod draw-map ((genmap generated-map))
  (let ((map (noise-map genmap)))
    (when map
      (let* ((start (internal-time-millis))
             (width (first (array-dimensions map)))
             (height (second (array-dimensions map)))
             (image (q+:make-qimage width height (q+:qimage.format_argb32))))
        (dotimes (x width)
          (dotimes (y height)
            (let ((value (aref map x y))
                  (light (* 10 (lightness genmap))))
              (set-pixel image x y (elt *grays*
                                        (if (= 0 light)
                                            value
                                            (if (< 0 light)
                                                (if (< value light) 0 value)
                                                (let ((light (+ 255 light)))
                                                  (if (< light value) 255 value)))))))))
        (v:log :info :mapgen "Redrawing the map of size (~a x ~a) took ~a ms."
               width height (- (internal-time-millis) start))
        (when (map-image genmap)
          (finalize (map-image genmap))
          (setf (map-image genmap) NIL))
        (setf (map-image genmap) image
              (redraw genmap) NIL)))))

(defmethod scroll ((genmap generated-map) delta)
  (case *mode*
    (T (lighten genmap delta))))

(defmethod lighten ((genmap generated-map) delta)
  (when (/= 0 delta)
    (let ((light (min 25 (max -25 (+ (lightness genmap) delta)))))
      (unless (= (lightness genmap) light)
        (setf (lightness genmap) light
              (redraw genmap) T)
        (v:log :info :mapgen "Lightness is now ~a." (lightness genmap))))))

(defmethod set-tile-size ((genmap generated-map) size)
  (unless (= size (tile-size genmap))
    (setf (tile-size genmap) size
          (redraw genmap) T)))

(defmethod set-size ((genmap generated-map) width height)
  (let ((old-map (noise-map genmap))
        (width (/ width (tile-size genmap)))
        (height (/ height (tile-size genmap))))
    (unless (and (not *debug*)
                 old-map
                 (= width (first (array-dimensions old-map)))
                 (= height (second (array-dimensions old-map))))
      (let ((start (internal-time-millis)))
        (let ((map (gen-noise-map width height)))
          (setf (noise-map genmap) map
                (redraw genmap) T))
        (v:log :info :mapgen "Generation of the map with octave (~a), and size (~a x ~a) took ~a ms."
               *octave* width height (- (internal-time-millis) start))))))

;; Generators

(defun blend-maps (&rest maps)
  (let ((width 0) (height 0))
    (for:for ((map in maps))
          (let ((dimensions (array-dimensions map)))
            (when (< width (first dimensions))
              (setf width (first dimensions)))
            (when (< height (second dimensions))
              (setf height (second dimensions)))))
    (let ((new-map (make-array (list width height) :initial-element 0)))
      (dotimes (x width)
        (dotimes (y height)
          (let ((counter 0))
            (for:for ((map over maps))
              (unless (for:for ((a in (array-dimensions map))
                                (b in (list x y)))
                        (thereis (< a b)))
                (incf (aref new-map x y) (aref map x y))
                (incf counter)))
            (setf (aref new-map x y) (floor (/ (aref new-map x y) counter))))))
      new-map)))

(defun interpolate (x0 x1 alpha)
  (+ (* x0 (- 1.0 alpha)) (* alpha x1)))

(defun gen-noise-map (width height)
  (let ((small (gen-perlin-noise (gen-whitenoise (ceiling (/ width *small-blend*)) (ceiling (/ height *small-blend*))) *octave*))
        (medium (gen-perlin-noise (gen-whitenoise (ceiling (/ width *medium-blend*)) (ceiling (/ height *medium-blend*))) *octave*))
        (big (gen-perlin-noise (gen-whitenoise (ceiling (/ width *big-blend*)) (ceiling (/ height *big-blend*))) *octave*)))
    (setf small (resize-map small width height))
    (setf medium (resize-map small width height))
    (setf big (resize-map small width height))
    (blend-maps small medium big)))

(defun resize-map (map dest-width dest-height)
  (let ((src-width (first (array-dimensions map)))
        (src-height (second (array-dimensions map))))
    (if (and (= src-width dest-width) (= src-height dest-height))
        map
        (let ((diff-x (/ dest-width src-width))
              (diff-y (/ dest-height src-height))
              (dest-map (make-array (list dest-width dest-height) :initial-element -1)))
          (dotimes (x0 src-width)
            (dotimes (y0 src-height)
              (let* ((x1 (mod (1+ x0) src-width))
                     (y1 (mod (1+ y0) src-height))
                     (dest-x (mod (ceiling (* x0 diff-x)) dest-width))
                     (dest-y (mod (ceiling (* y0 diff-y)) dest-height))
                     (current (aref map x0 y0))
                     (far-x (aref map x1 y0))
                     (far-y (aref map x0 y1))
                     (far-xy (aref map x1 y1)))
                (dotimes (i (ceiling diff-x))
                  (let ((mid-x (mod (+ dest-x i) dest-width))
                        (near (interpolate current far-x (/ i diff-x)))
                        (far (interpolate far-y far-xy (/ i diff-x))))
                    ;; wherever you are...
                    (dotimes (j (ceiling diff-y))
                      (let ((mid-y (mod (+ dest-y j) dest-height)))
                        (setf (aref dest-map mid-x mid-y) (interpolate near far (/ j diff-y))))))))))
          dest-map))))

(defun gen-whitenoise (width height)
  (let ((noise (make-array (list width height) :initial-element 0)))
    (dotimes (x width)
      (dotimes (y height)
        (setf (aref noise x y) (random 256))))
    noise))

(defun gen-smooth-noise (base-noise octave)
  (let* ((dimensions (array-dimensions base-noise))
         (width (first dimensions))<commit_msg>Fixed the edges<commit_after>(in-package #:mapgen)
(in-readtable :qtools)

(defvar *octave* 5)
(defvar *mode* NIL)

(defparameter *small-blend* 16)
(defparameter *medium-blend* 8)
(defparameter *big-blend* 4)

(defclass generated-map ()
  ((noise-map :initform NIL :accessor noise-map)
   (map-image :initform NIL :accessor map-image)
   (lightness :initform 0 :accessor lightness)
   (tile-size :initform 1 :accessor tile-size)
   (redraw :initform T :accessor redraw)))

(defmethod paint ((genmap generated-map) target)
  (when (redraw genmap)
    (draw-map genmap))
  (let ((image (map-image genmap)))
    (when image
      (let ((rect (q+:rect image)))
        (q+:draw-image target rect image rect)))))

(defmethod draw-map ((genmap generated-map))
  (let ((map (noise-map genmap)))
    (when map
      (let* ((start (internal-time-millis))
             (width (first (array-dimensions map)))
             (height (second (array-dimensions map)))
             (image (q+:make-qimage width height (q+:qimage.format_argb32))))
        (dotimes (x width)
          (dotimes (y height)
            (let ((value (aref map x y))
                  (light (* 10 (lightness genmap))))
              (set-pixel image x y (elt *grays*
                                        (if (= 0 light)
                                            value
                                            (if (< 0 light)
                                                (if (< value light) 0 value)
                                                (let ((light (+ 255 light)))
                                                  (if (< light value) 255 value)))))))))
        (v:log :info :mapgen "Redrawing the map of size (~a x ~a) took ~a ms."
               width height (- (internal-time-millis) start))
        (when (map-image genmap)
          (finalize (map-image genmap))
          (setf (map-image genmap) NIL))
        (setf (map-image genmap) image
              (redraw genmap) NIL)))))

(defmethod scroll ((genmap generated-map) delta)
  (case *mode*
    (T (lighten genmap delta))))

(defmethod lighten ((genmap generated-map) delta)
  (when (/= 0 delta)
    (let ((light (min 25 (max -25 (+ (lightness genmap) delta)))))
      (unless (= (lightness genmap) light)
        (setf (lightness genmap) light
              (redraw genmap) T)
        (v:log :info :mapgen "Lightness is now ~a." (lightness genmap))))))

(defmethod set-tile-size ((genmap generated-map) size)
  (unless (= size (tile-size genmap))
    (setf (tile-size genmap) size
          (redraw genmap) T)))

(defmethod set-size ((genmap generated-map) width height)
  (let ((old-map (noise-map genmap))
        (width (/ width (tile-size genmap)))
        (height (/ height (tile-size genmap))))
    (unless (and (not *debug*)
                 old-map
                 (= width (first (array-dimensions old-map)))
                 (= height (second (array-dimensions old-map))))
      (let ((start (internal-time-millis)))
        (let ((map (gen-noise-map width height)))
          (setf (noise-map genmap) map
                (redraw genmap) T))
        (v:log :info :mapgen "Generation of the map with octave (~a), and size (~a x ~a) took ~a ms."
               *octave* width height (- (internal-time-millis) start))))))

;; Generators

(defun blend-maps (&rest maps)
  (let ((width 0) (height 0))
    (for:for ((map in maps))
          (let ((dimensions (array-dimensions map)))
            (when (< width (first dimensions))
              (setf width (first dimensions)))
            (when (< height (second dimensions))
              (setf height (second dimensions)))))
    (let ((new-map (make-array (list width height) :initial-element 0)))
      (dotimes (x width)
        (dotimes (y height)
          (let ((counter 0))
            (for:for ((map over maps))
              (unless (for:for ((a in (array-dimensions map))
                                (b in (list x y)))
                        (thereis (< a b)))
                (incf (aref new-map x y) (aref map x y))
                (incf counter)))
            (setf (aref new-map x y) (floor (/ (aref new-map x y) counter))))))
      new-map)))

(defun interpolate (x0 x1 alpha)
  (+ (* x0 (- 1.0 alpha)) (* alpha x1)))

(defun gen-noise-map (width height)
  (let ((small (gen-perlin-noise (gen-whitenoise (ceiling (/ width *small-blend*)) (ceiling (/ height *small-blend*))) *octave*))
        (medium (gen-perlin-noise (gen-whitenoise (ceiling (/ width *medium-blend*)) (ceiling (/ height *medium-blend*))) *octave*))
        (big (gen-perlin-noise (gen-whitenoise (ceiling (/ width *big-blend*)) (ceiling (/ height *big-blend*))) *octave*)))
    (setf small (resize-map small width height))
    (setf medium (resize-map small width height))
    (setf big (resize-map small width height))
    (blend-maps small medium big)))

(defun resize-map (map dest-width dest-height)
  (let ((src-width (1- (first (array-dimensions map))))
        (src-height (1- (second (array-dimensions map)))))
    (if (and (= src-width dest-width) (= src-height dest-height))
        map
        (let ((diff-x (/ dest-width src-width))
              (diff-y (/ dest-height src-height))
              (dest-map (make-array (list dest-width dest-height) :initial-element -1)))
          (dotimes (x0 src-width)
            (dotimes (y0 src-height)
              (let* ((x1 (mod (1+ x0) (1+ src-width)))
                     (y1 (mod (1+ y0) (1+ src-height)))
                     (dest-x (mod (ceiling (* x0 diff-x)) dest-width))
                     (dest-y (mod (ceiling (* y0 diff-y)) dest-height))
                     (current (aref map x0 y0))
                     (far-x (aref map x1 y0))
                     (far-y (aref map x0 y1))
                     (far-xy (aref map x1 y1)))
                (dotimes (i (ceiling diff-x))
                  (let ((mid-x (mod (+ dest-x i) dest-width))
                        (near (interpolate current far-x (/ i diff-x)))
                        (far (interpolate far-y far-xy (/ i diff-x))))
                    ;; wherever you are...
                    (dotimes (j (ceiling diff-y))
                      (let ((mid-y (mod (+ dest-y j) dest-height)))
                        (setf (aref dest-map mid-x mid-y) (interpolate near far (/ j diff-y))))))))))
          dest-map))))

(defun gen-whitenoise (width height)
  (let ((width (1+ width))
        (height (1+ height)))
    (let ((noise (make-array (list width height) :initial-element 0)))
      (dotimes (x width)
        (dotimes (y height)
          (setf (aref noise x y) (random 256))))
      noise)))

(defun gen-smooth-noise (base-noise octave)
  (let* ((dimensions (array-dimensions base-noise))
         (width (first dimensions))
{'fraction_non_alphanumeric': 0.1526284348864994, 'fraction_numerical': 0.009109916367980884, 'mean_word_length': 1.9052060737527114, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 26, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5468015', 'n_tokens_mistral': 4312, 'n_tokens_neox': 4117, 'n_words': 1280}