;; -*- scheme -*-

;; this is invoked by the guile-fu extension at startup
(define gf-init
  (lambda ()
    (gf-init-vars)
    (gf-init-autoloads)
    (gf-load "macro.scm")
    (gf-load "chalice.scm")
    (gf-load "test.scm"))) 

;; this is invoked for every line we get from the driver
(define gf-eval
  (lambda (c)
    (catch
     #t
     (lambda () (eval-string c))
     (lambda args (cons 'PROBLEM: args)))))

(define gf-eval-2
  (lambda (c)
    (catch
     #t
     (lambda ()
       (let* ((res #f)
              (out (with-output-to-string
                     (lambda ()
                       (set! res (eval-string c))))))
         (cons out (list res))))
     (lambda args (cons 'PROBLEM: args)))))

;; this is invoked in the (unimplemented) standalone mode
(define gf-repl top-repl)






;; the home dir for guile-fu development
(define projdir "/home/gnome/src/gimp-macro/plug-ins/guile-fu/scripts/")

;; should we reload from the development tree?
(define use-latest #t)

;; load a component of guile-fu
(define gf-load
  (lambda (f)
    (if use-latest
        (load (string-append projdir f))
        (primitive-load-path f))))






;; the various symbols to make scripts pretty
(define gf-init-vars
  (lambda ()
    (map
     (lambda (z)
       (module-define! (current-module) (car z) (cdr z)))
     '((NORMAL . 0)
       (DISSOLVE . 1)
       (BEHIND . 2)
       (MULTIPLY . 3)
       (SCREEN . 4)
       (OVERLAY . 5)
       (DIFFERENCE . 6)
       (ADDITION . 7)
       (SUBTRACT . 8)
       (DARKEN-ONLY . 9)
       (LIGHTEN-ONLY . 10)
       (HUE . 11)
       (SATURATION . 12)
       (COLOR . 13)
       (VALUE . 14)
       (DIVIDE . 15)
       (FG-BG-RGB . 0)
       (FG-BG-HSV . 1)
       (FG-TRANS . 2)
       (CUSTOM . 3)
       (LINEAR . 0)
       (BILINEAR . 1)
       (RADIAL . 2)
       (SQUARE . 3)
       (CONICAL-SYMMETRIC . 4)
       (CONICAL-ASYMMETRIC . 5)
       (SHAPEBURST-ANGULAR . 6)
       (SHAPEBURST-SPHERICAL . 7)
       (SHAPEBURST-DIMPLED . 8)
       (SPIRAL-CLOCKWISE . 9)
       (SPRIAL-ANTICLOCKWISE . 10)
       (REPEAT-NONE . 0)
       (REPEAT-SAWTOOTH . 1)
       (REPEAT-TRIANGULAR . 2)
       (FG-BUCKET-FILL . 0)
       (BG-BUCKET-FILL . 1)
       (PATTERN-BUCKET-FILL . 2)
       (FG-IMAGE-FILL . 0)
       (BG-IMAGE-FILL . 1)
       (WHITE-IMAGE-FILL . 2)
       (TRANS-IMAGE-FILL . 3)
       (NO-IMAGE-FILL . 4)
       (RGB . 0)
       (GRAY . 1)
       (INDEXED . 2)
       (RGB_IMAGE . 0)
       (RGBA_IMAGE . 1)
       (GRAY_IMAGE . 2)
       (GRAYA_IMAGE . 3)
       (INDEXED_IMAGE . 4)
       (INDEXEDA_IMAGE . 5)
       (RED-CHANNEL . 0)
       (GREEN-CHANNEL . 1)
       (BLUE-CHANNEL . 2)
       (GRAY-CHANNEL . 3)
       (INDEXED-CHANNEL . 4)
       (WHITE-MASK . 0)
       (BLACK-MASK . 1)
       (ALPHA-MASK . 2)
       (APPLY . 0)
       (DISCARD . 1)
       (EXPAND-AS-NECESSARY . 0)
       (CLIP-TO-IMAGE . 1)
       (CLIP-TO-BOTTOM-LAYER . 2)
       (ADD . 0)
       (SUB . 1)
       (REPLACE . 2)
       (INTERSECT . 3)
       (PIXELS . 0)
       (POINTS . 1)
       (IMAGE-CLONE . 0)
       (PATTERN-CLONE . 1)
       (BLUR . 0)
       (SHARPEN . 1)
       (TRUE . 1)
       (FALSE . 0)
       (SF-IMAGE . 0)
       (SF-DRAWABLE . 1)
       (SF-LAYER . 2)
       (SF-CHANNEL . 3)
       (SF-COLOR . 4)
       (SF-TOGGLE . 5)
       (SF-VALUE . 6)
       (SF-STRING . 7)
       (SF-ADJUSTMENT . 8)
       (SF-FONT . 9)
       (SF-PATTERN . 10)
       (SF-BRUSH . 11)
       (SF-GRADIENT . 12)
       (SF-FILENAME . 13)
       (SF-SLIDER . 0)
       (SF-SPINNER . 1)))))
 






;; get a list of all the exported PDB routines and bind an autoloader
;; to each one
(define gf-init-autoloads
  (lambda ()
    (let ((funcs (gf-run "gimp_procedural_db_query"
                         (cons 4 "")
                         (cons 4 "")
                         (cons 4 "")
                         (cons 4 "")
                         (cons 4 "")
                         (cons 4 "")
                         (cons 4 ""))))
      (if (eq? (car funcs) 3)
          (map gf-make-pdb (caddr funcs))
          (throw 'autoload-setup-failed)))))


;; this routine accepts a PDB name and binds an autoloader for the
;; name to the corresponding symbol.  the autoloader will query gimp
;; about the proc and create the real invoker when it is first run.
(define gf-make-pdb
  (lambda (name)
    (let ((func (gf-make-symbol name))
          (types ())
          (vals ()))

      ;; formats the PDB return values according to spec
      (define format-return-vals
        (lambda (values spec)
          (let ((v (map cons vals values)))
            (cond
             ((list? spec) (map (lambda (x) (assq-ref v x)) spec))
             (spec         (assq-ref v spec))
             (#t           values)))))

      ;; invoke the PDB routine on the args.  if there are too many
      ;; args, the first is assumed to be a spec for
      ;; format-return-vals
      (define invoke-pdb
        (lambda args
          (let* ((z (> (length args) (length types)))
                 (a (if z (cdr args) args))
                 (x (cons name (map cons types a)))
                 (v (apply gf-run x)))
            (or (memq (car v) '(2 3))
                (throw 'pdb-failure func))
            (if z
                (format-return-vals (cdr v) (car args))
                (cdr v)))))

      ;; the autoloader stub
      (define stub
        (lambda args
          (let ((nums (gf-get-nums name)))
            (set! types
                  (gf-get-signature name (car nums)))
            (set! vals
                  (gf-get-vals name (cadr nums)))
            (module-define! (current-module) func invoke-pdb)
            (apply invoke-pdb args))))

      ;; bind the autoloader stub to the symbol
      (module-define! (current-module) func stub))))


;; convert a PDB name to a scheme symbol
(define gf-make-symbol
  (lambda (s)
    (set! s (string-copy s))
    (while (string-index s #\_)
           (string-set! s
                        (string-index s #\_)
                        #\-))
    (string->symbol s)))


;; get the number of args and return vals
(define gf-get-nums
  (lambda (s)
    (let ((info (gf-run "gimp_procedural_db_proc_info"
                        (cons 4 s))))
      (if (not (eq? (car info) 3))
          (throw 'proc-info-failed s))
      (list 
       (cadr (cdddr (cdddr info)))
       (caddr (cdddr (cdddr info)))))))


;; get the argument signature for the named PDB routine
(define gf-get-signature
  (lambda (s n)
    (let ((types ()))
      (while (> n 0)
             (set! n (- n 1))
             (let ((arg (gf-run "gimp_procedural_db_proc_arg"
                                (cons 4 s)
                                (cons 0 n))))
               (if (not (eq? (car arg) 3))
                   (throw 'proc-arg-failed n))
               (set! types (cons (cadr arg)
                                 types))))
      types)))


;; get the return value names for the PDB routine
(define gf-get-vals
  (lambda (s n)
    (let ((vals ()))
      (while (> n 0)
             (set! n (- n 1))
             (let ((arg (gf-run "gimp_procedural_db_proc_val"
                                (cons 4 s)
                                (cons 0 n))))
               (if (not (eq? (car arg) 3))
                   (throw 'proc-val-failed n))
               (set! vals (cons (gf-make-symbol (caddr arg))
                                vals))))
      vals)))


