optionally add texture layer first

unhammer · Feb 22, 2014 · 69d5eab · 69d5eab
1 parent dc9a449
commit 69d5eab
Show file tree

Hide file tree

Showing 2 changed files with 63 additions and 11 deletions.
diff --git a/satsvis-curves.scm b/satsvis-curves.scm
@@ -125,3 +125,56 @@ of this file."
              (gimp-image-delete image)))
          filelist))
   (gimp-message "Ferdig med alle bileta!"))
+
+
+(define (kbu-layer-cover-image1 image drawable)
+  ;; no undo group or display flush
+  (let* ((width (car (gimp-image-width image)))
+         (height (car (gimp-image-height image))))
+    (gimp-layer-scale
+     drawable
+     width
+     height
+     1))
+  (gimp-layer-set-offsets drawable
+			  0
+			  0))
+(define (kbu-layer-load-add-cover image filename mode-symbol opacity)
+  (gimp-message (string-append "Prøver å leggja til " filename
+			       " med modus " (symbol->string mode-symbol)
+			       " og dekkevne " (number->string opacity)))
+  (let* ((newlayer (car (gimp-file-load-layer RUN-NONINTERACTIVE image filename))))
+    (gimp-image-insert-layer image newlayer 0 -1)
+    (kbu-layer-cover-image1 image newlayer)
+    (gimp-layer-set-mode newlayer (eval mode-symbol))
+    (gimp-layer-set-opacity newlayer opacity)))
+
+(define (kbu-satsvis-textures-curves textures opacity-curves globs)
+  "globs is a list of file-globs, e.g. '(\"*.jpg\" \"*.[xX][cC][fF]\"),
+
+opacity-curves is a list of lists of layer-name, opacity-values and curve specs,
+e.g. '((\"velvia\" 40 (…)) (\"portra\" 60 (…))) where the … is as described in the top
+of this file.
+
+textures er ei liste der kvart element er ei liste
+med (filnamn modus-symbol dekkevne), modus må vera sitert
+sidan me skriv det ut."
+  (let* ((filelist (apply append (map (lambda (glob)
+                                        (cadr (file-glob glob 1)))
+                                      globs))))
+    (map (lambda (filename)
+           (gimp-message (string-append "Innbilete: " filename))
+           (let ((image (car (gimp-file-load RUN-NONINTERACTIVE
+                                             filename filename))))
+
+             (kbu-curve-an-image opacity-curves image filename)
+
+	     (map (lambda (l)
+		    (kbu-layer-load-add-cover image (car l) (cadr l) (caddr l)))
+		  textures)
+	     (gimp-message "Alle lag er lagt til!")
+
+             (kbu-save-export image filename)
+             (gimp-image-delete image)))
+         filelist))
+  (gimp-message "Ferdig med alle bileta!"))
diff --git a/satsvis-lag-mw.scm b/satsvis-lag-mw.scm
@@ -20,14 +20,14 @@
     (gimp-layer-scale
      drawable
      width
-     height   
-     1))    
-  (gimp-layer-set-offsets drawable 
+     height
+     1))
+  (gimp-layer-set-offsets drawable
 			  0
 			  0))
 
 (define (layer-load-add-cover image filename mode-symbol opacity)
-  (gimp-message (string-append "Prøver å leggje til " filename
+  (gimp-message (string-append "Prøver å leggja til " filename
 			       " med modus " (symbol->string mode-symbol)
 			       " og dekkevne " (number->string opacity)))
   (let* ((newlayer (car (gimp-file-load-layer RUN-NONINTERACTIVE image filename))))
@@ -58,10 +58,10 @@
 (define (satsvis-lag-mw fpattern
 			blurfactor brightness contrast
 			layers)
-  "fpattern er ein file-glob, t.d. \"*.jpg\". 
+  "fpattern er ein file-glob, t.d. \"*.jpg\".
 Dei tri neste argumenta går til make-wonderful.
-layers er ei liste der kvart element er ei liste 
-med (filnamn modus-symbol dekkevne), modus må vere sitert 
+layers er ei liste der kvart element er ei liste
+med (filnamn modus-symbol dekkevne), modus må vera sitert
 sidan me skriv det ut."
   (let* ((filelist (cadr (file-glob fpattern 1))))
     (while (not (null? filelist))
@@ -71,12 +71,12 @@ sidan me skriv det ut."
              (drawable (car (gimp-image-get-active-layer image))))
 	(gimp-message (string-append "Innbilete: " filename))
         (gimp-item-set-name drawable (basename filename)) ; alltid nyttig
-	
+
 	(map (lambda (l)
 	       (layer-load-add-cover image (first l) (second l) (third l)))
 	     layers)
 	(gimp-message "Alle lag er lagt til!")
-	
+
 	(gimp-message (string-append "Prøver å gjere " filename " vedunderleg..."))
 	(make-wonderful image drawable
 			blurfactor brightness contrast
@@ -113,6 +113,5 @@ sidan me skriv det ut."
 
         (gimp-image-delete image))
       (set! filelist (cdr filelist))))
-
-  (gimp-message "Ferdig med alle bilete!"))
 
+  (gimp-message "Ferdig med alle bilete!"))