mirror of https://github.com/FreeCol/freecol.git
145 lines
6.4 KiB
Scheme
145 lines
6.4 KiB
Scheme
;;;
|
|
;;; 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)
|