;;;
;;;  Copyright (C) 2002-2022  The FreeCol Team
;;;
;;;  This file is part of FreeCol.
;;;
;;;  FreeCol 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.
;;;
;;;  FreeCol 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 FreeCol.  If not, see <http://www.gnu.org/licenses/>.
;;;

;;; On a Unix-like operating system, change to your main freecol
;;; directory, and call this gimp script like this:
;;;
;;; gimp --no-data --no-fonts --no-interface -b - < rivers.scm

;;; the freecol image directory
(define images "data/rules/classic/resources/images/")

;;; Increment a base-n number represented as a list of digits,
;;; starting with the least significant digit. Return #f if the number
;;; can not be incremented without adding another digit.
(define increment
  (lambda (base lst)
    (let ((max-digit (- base 1)))
      (let loop ((remaining lst)
                 (result '()))
        (if (null? remaining)
            #f
            (if (< (car remaining) max-digit)
                (append (reverse (cons (+ 1 (car remaining)) result))
                        (cdr remaining))
                (loop (cdr remaining)
                      (cons 0 result))))))))

(let* ((north-east
        #(#f
          #((94 15) (98 17) (66 32) (62 32))
          #((92 14) (100 18) (67 32) (61 32))))
       (south-east
        #(#f
          #((98 47) (94 49) (64 34) (64 30))
          #((100 46) (92 50) (64 35) (64 29))))
       (south-west
        #(#f
          #((34 49) (30 47) (62 32) (66 32))
          #((36 50) (28 46) (61 32) (67 32))))
       (north-west
        #(#f
          #((30 17) (34 15) (64 30) (64 34))
          #((28 18) (36 14) (64 29) (64 35))))
       (centre '(64 32))
       (points
        (list north-east south-east south-west north-west))
       (ocean (car (file-png-load 1 (string-append images "terrain/ocean/center0.png") ""))))

  (let loop ((xcount '(1 0 0 0)))
    (if xcount
        (let* ((image (car (gimp-image-duplicate ocean)))
               (pic-layer (car (gimp-image-get-active-drawable image)))
               (vec (car (gimp-vectors-new image "points"))))

          (gimp-image-undo-disable image)
          (gimp-image-undo-group-start image)
          (gimp-selection-none image)
          (gimp-image-add-vectors image vec -1)

          (let branch-loop ((count xcount)
                            (look-ahead (append xcount xcount))
                            (points (append points points))
                            (result '()))
            (if (null? count)
                (let ((points (apply append result)))
                  (gimp-vectors-stroke-new-from-points
                   vec 0 (length points) (list->vector points) FALSE)
                  (gimp-vectors-to-selection
                   vec
                   CHANNEL-OP-ADD
                   TRUE FALSE 0 0)
                  (gimp-selection-invert image)
                  (gimp-edit-clear pic-layer)
                  (file-png-save-defaults
                   1 image pic-layer
                   (string-append
                    images
                    "river/river"
                    (apply string-append (map number->string xcount))
                    ".png") "")
                  (loop (increment 3 xcount)))
                (let* ((size (car count))
                       (coordinates (vector-ref (car points) size)))
                  (if (= 0 size)
                      (branch-loop (cdr count)
                                   (cdr look-ahead)
                                   (cdr points)
                                   result)
                      (let ((next-branch
                             (let loop ((branches (cdr look-ahead))
                                        (index 1))
                               (if (or (null? branches)
                                       (= 4 index))
                                   #f
                                   (let ((next-size (car branches)))
                                     (if (= 0 next-size)
                                         (loop (cdr branches)
                                               (+ index 1))
                                         (cons index next-size)))))))
                        (if next-branch
                            (let* ((index (car next-branch))
                                   (next-size (cdr next-branch))
                                   (next-coordinates
                                    (vector-ref (list-ref points index) next-size))
                                   (p (vector-ref coordinates 1))
                                   (a (vector-ref next-coordinates 0)))
                              (branch-loop (cdr count)
                                           (cdr look-ahead)
                                           (cdr points)
                                           (append result
                                                   (case index
                                                     ((1) ;; quarter turn
                                                      (let ((c (vector-ref coordinates 2)))
                                                        (list p p p c a c a a a)))
                                                     ((2) ;; straight line
                                                      (list p p p a a a))
                                                     ((3) ;; three-quarter turn
                                                      (let ((c (vector-ref coordinates 3)))
                                                        (list p p p c a c a a a)))))))
                            ;; single branch
                            (let ((p (vector-ref coordinates 0))
                                  (a (vector-ref coordinates 1))
                                  (c centre))
                              (branch-loop
                               '() '() '()
                               (list p p p c c c a a a)))))))))))))

(gimp-quit 0)