mirrors
/
freecol
mirror of https://github.com/FreeCol/freecol.git
2
0
Fork 0
Code Issues Projects Releases Wiki Activity

Copy the gimp scripts for creating tile images from old SVN, as they may be needed again

This commit is contained in:
Sebastian Zhorel 2015-11-07 13:56:12 +01:00
parent 3a135176ac
commit 8e27f99077
4 changed files with 592 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

211
bin/beaches.scm Normal file
View File

@ -0,0 +1,211 @@
;;;
;;; Copyright (C) 2002-2007 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/>.
;;;
(define edge-width 24)
(define edge-height 12)
(define directions
'((north . 1)
(north-east . 2)
(east . 4)
(south-east . 8)
(south . 16)
(south-west . 32)
(west . 64)
(north-west . 128)))
(define corners
'((north 64 . 0)
(east 128 . 32)
(south 64 . 64)
(west 0 . 32)))
(define control-points
'((north 64 . 12)
(east 104 . 32)
(south 64 . 52)
(west 24 . 32)))
(define small-points
'((north-west 36 . 26)
(north 56 . 16)
(north-east 72 . 16)
(east 92 . 26)
(south-east 92 . 38)
(south 72 . 48)
(south-west 56 . 48)
(west 36 . 38)))
(define external-points
'((north-west 0 . 20)
(north 40 . 0)
(north-east 88 . 0)
(east 128 . 20)
(south-east 128 . 44)
(south 88 . 64)
(south-west 40 . 64)
(west 0 . 44)))
(define intersections
'((north-west 12 . 26)
(north 52 . 6)
(north-east 78 . 6)
(east 116 . 26)
(south-east 116 . 38)
(south 78 . 58)
(south-west 52 . 58)
(west 12 . 38)))
(define decode-style
(lambda (style)
(let loop ((remaining-directions (reverse directions))
(next-style style)
(result '()))
(if (or (= 0 next-style)
(null? remaining-directions))
result
(let ((new-style (- next-style (cdr (car remaining-directions)))))
(loop (cdr remaining-directions)
(if (>= new-style 0) new-style next-style)
(if (>= new-style 0)
(cons (car (car remaining-directions)) result)
result)))))))
(define has-edge?
(lambda (style edge)
(memq edge style)))
(define get-x
(lambda (points direction)
(car (cdr (assq direction points)))))
(define get-y
(lambda (points direction)
(cdr (cdr (assq direction points)))))
(define script-fu-make-beaches
(lambda (img drawable)
(let* ((width (car (gimp-image-width img)))
(height (car (gimp-image-height img)))
(half-width (/ width 2))
(half-height (/ height 2)))
(let loop ((count 1))
(if (< count 256)
(let* ((image (car (gimp-image-duplicate img)))
(pic-layer (car (gimp-image-get-active-drawable image)))
(style (decode-style count))
(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* ((points (if (has-edge? style 'north-west)
small-points
external-points))
(stroke-id (car (gimp-vectors-bezier-stroke-new-moveto
vec
(get-x points 'north-west)
(get-y points 'north-west)))))
(let edge-loop ((edges '(north-west north-east south-east south-west))
(corners '(north east south west)))
(if (null? edges)
#t
(let ((current-edge (car edges))
(next-edge (if (null? (cdr edges))
'north-west
(car (cdr edges))))
(current-corner (car corners)))
(if (has-edge? style current-edge)
(if (has-edge? style next-edge)
;; internal corner
(begin
(gimp-vectors-bezier-stroke-lineto
vec stroke-id
(get-x small-points current-corner)
(get-y small-points current-corner))
(gimp-vectors-bezier-stroke-conicto
vec stroke-id
(get-x control-points current-corner)
(get-y control-points current-corner)
(get-x small-points next-edge)
(get-y small-points next-edge)))
;; straight line to external edge
(gimp-vectors-bezier-stroke-lineto
vec stroke-id
(get-x external-points next-edge)
(get-y external-points next-edge)))
(begin
;; move forward
(gimp-vectors-bezier-stroke-lineto
vec stroke-id
(get-x external-points current-corner)
(get-y external-points current-corner))
(if (not (has-edge? style next-edge))
;; external corner
(begin
(if (has-edge? style current-corner)
(begin
(gimp-vectors-bezier-stroke-lineto
vec stroke-id
(get-x intersections current-corner)
(get-y intersections current-corner))
(gimp-vectors-bezier-stroke-conicto
vec stroke-id
(get-x control-points current-corner)
(get-y control-points current-corner)
(get-x intersections next-edge)
(get-y intersections next-edge))))
(gimp-vectors-bezier-stroke-lineto
vec stroke-id
(get-x external-points next-edge)
(get-y external-points next-edge))))))
(edge-loop (cdr edges)
(cdr corners)))))
(gimp-vectors-to-selection
vec
CHANNEL-OP-ADD
TRUE FALSE 0 0)
(gimp-edit-clear pic-layer)
(file-png-save-defaults
1 image pic-layer
(string-append "beach" (number->string count) ".png") "")
(loop (+ count 1))
)))))))
(script-fu-register "script-fu-make-beaches"
_"Make beaches"
_"Make beaches"
"Michael Burschik <Michael.Burschik@gmx.de>"
"Michael Burschik"
"2009-08-09"
"RGB GRAY"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0)
(script-fu-menu-register "script-fu-make-beaches"
"<Image>/Filters")

104
bin/borders.scm Normal file
View File

@ -0,0 +1,104 @@
;;;
;;; Copyright (C) 2002-2013 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 - < borders.scm
(let* ((N '(64 0))
(NE '((0 0) (128 0) (128 64)))
(E '(128 32))
(SE '((128 0) (128 64) (0 64)))
(S '(64 64))
(SW '((128 64) (0 64) (0 0)))
(W '(0 32))
(NW '((0 64) (0 0) (128 0)))
(directions (list N NE E SE S SW W NW))
(names (map symbol->string '(N NE E SE S SW W NW)))
(radius 10)
;; the freecol image directory
(directory "data/rules/classic/resources/images/terrain/"))
(let terrain-loop ((terrains '("arctic" "desert" "grassland" "highSeas"
"marsh" "ocean" "plains" "prairie"
"savannah" "swamp" "tundra" "unexplored")))
(if (null? terrains)
(gimp-quit 0)
(let centre-loop ((centres '("0" "1"))
(borders '("_even" "_odd")))
(if (null? centres)
(terrain-loop (cdr terrains))
(let* ((tile (car (file-png-load 1 (string-append directory (car terrains)
"/center" (car centres) ".png") "")))
(drawable (car (gimp-image-get-active-drawable tile))))
(if (= (car (gimp-drawable-is-rgb drawable)) 0)
(gimp-image-convert-rgb tile))
(let direction-loop ((directions directions)
(names names))
(if (null? directions)
(centre-loop (cdr centres)
(cdr borders))
(let* ((image (car (gimp-image-duplicate tile)))
(pic-layer (car (gimp-image-get-active-drawable image)))
(direction (car directions)))
(gimp-image-undo-disable image)
(gimp-image-undo-group-start image)
(gimp-selection-none image)
(if (number? (car direction))
(begin
(gimp-ellipse-select
image
(- (list-ref direction 0) radius)
(- (list-ref direction 1) radius)
(* 2 radius)
(* 2 radius)
CHANNEL-OP-ADD TRUE TRUE 10)
(gimp-selection-invert image))
;; first, create an unfeathered triangular
;; selection, so that the clear will
;; properly pick up areas near the image
;; borders
(let ((points (apply append direction)))
(gimp-free-select
image
(length points)
(list->vector points)
CHANNEL-OP-ADD
TRUE FALSE 0)
(gimp-selection-invert image)
(gimp-edit-clear pic-layer)
;; now, grow and feather the selection for a gradient effect
(gimp-selection-grow image 20)
(gimp-selection-feather image 10)))
(gimp-edit-clear pic-layer)
(file-png-save-defaults
1 image pic-layer
(string-append directory (car terrains)
"/border_" (car names)
(car borders) ".png")
"")
(direction-loop (cdr directions)
(cdr names)))))))))))

133
bin/forests.scm Normal file
View File

@ -0,0 +1,133 @@
;;;
;;; Copyright (C) 2002-2012 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/>.
;;;
(define half-x 64)
(define half-y 32)
(define half-width 20)
(define half-height 10)
;;; Increment a binary number represented as a list of ones and zeros,
;;; starting with the least significant bit. Return #f if the number
;;; can not be incremented without adding another bit.
(define increment
(lambda (lst)
(let loop ((remaining lst)
(result '()))
(if (null? remaining)
#f
(if (= 0 (car remaining))
(append (reverse (cons 1 result))
(cdr remaining))
(loop (cdr remaining)
(cons 0 result)))))))
;;; Calculate the point on the line defined by the given point and
;;; slope, at x0.
(define calculate-point
(lambda (point slope x0)
(let* ((x (car point))
(y (cadr point))
(b (- y (* slope x))))
(list x0 (+ (* slope x0) b)))))
(define script-fu-cut-forests
(lambda (img drawable)
(let* ((height (car (gimp-image-height img)))
(offset (- height 64))
(north
(list half-x (+ offset (- half-y half-height))))
(east
(list (+ half-x half-width) (+ offset half-y)))
(south
(list half-x (+ offset half-y half-height)))
(west
(list (- half-x half-width) (+ offset half-y)))
(north-east
(list north (calculate-point north -0.5 128)
(calculate-point east -0.5 128)))
(south-east
(list east (calculate-point east 0.5 128)
(calculate-point south 0.5 128)))
(south-west
(list south (calculate-point south -0.5 0)
(calculate-point west -0.5 0)))
(north-west
(list west (calculate-point west 0.5 0)
(calculate-point north 0.5 0) north))
(rectangles
(list north-east south-east south-west north-west)))
(let loop ((count '(1 0 0 0)))
(if count
(let* ((image (car (gimp-image-duplicate img)))
(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 ((branches count)
(rectangles rectangles)
(result '()))
(if (null? branches)
(let ((points
(apply append (map (lambda (n) (append n n n)) result))))
(gimp-vectors-stroke-new-from-points
vec 0 (length points) (list->vector points) TRUE))
(let ((branch (car branches))
(rectangle (car rectangles)))
(branch-loop (cdr branches)
(cdr rectangles)
(append result
(if (= 1 branch)
rectangle
(list (car rectangle))))))))
(let* ((current-name (car (gimp-image-get-filename img)))
(name (substring current-name 0 (- (string-length current-name) 4))))
(gimp-vectors-to-selection
vec
CHANNEL-OP-ADD
TRUE FALSE 0 0)
(gimp-edit-clear pic-layer)
(file-png-save-defaults
1 image pic-layer
(string-append
name
(apply string-append (map number->string count))
".png") "")
(loop (increment count)))))))))
(script-fu-register "script-fu-cut-forests"
_"Cut forests"
_"Cut forests"
"Michael Vehrs <Michael.Burschik@gmx.de>"
"Michael Vehrs"
"2012-10-27"
"RGB GRAY"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0)
(script-fu-menu-register "script-fu-cut-forests"
"<Image>/Filters")

144
bin/rivers.scm Normal file
View File

@ -0,0 +1,144 @@
;;;
;;; Copyright (C) 2002-2012 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)