;;;
;;;  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/>.
;;;

(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")
