;; tile-two-images.scm -*-scheme-*-
;; "Tile Two Images..."  Script-Fu, a.k.a. Tile and Stitch.  

;; Primarily inspired by Ulead Morph Studio, Image Editor, Version 2 1992-94.  
;; "Edit, Tile Two Images..."  Created a new image.  Tiled the two images, 
;; allowed you to specify the transparency as well as the distance/offset (in pixels).  
;; "Edit, Stitch Ctrl+T..."  Created a new image with an oversized canvas, 
;; the first image was fixed, the second was a floating selection to allow 
;; the user to place it manuallly.  When it was placed the canvas was 
;; automatically cropped/trimmed to fit.  This script combines parts of both ideas.  
  
;; unusual to ignore current image but it works ;)
(define (script-fu-tile-two-images image drawable image1 image2 layout)  
  (let* (
	;; lazy fix(es) for version 2, still many using version 1.2 
      (RGBA_IMAGE RGBA-IMAGE) ; old new 

      ;; get flat copies of images.  simpler than dealing with layers
      (drawable1 (car (gimp-image-flatten (car (gimp-image-duplicate image1))))) 
      (drawable2 (car (gimp-image-flatten (car (gimp-image-duplicate image2))))) 

      ;; get heights and widths (in this case dimensions of drawable == image)
      (width2 (car (gimp-drawable-width drawable2)))
      (height2 (car (gimp-drawable-height drawable2)))

      (width1 (car (gimp-drawable-width drawable1)))
      (height1 (car (gimp-drawable-height drawable1)))
  
      ;; get the file name to use as the layer name 
      ;(name1 (car (gimp-image-get-filename image1))) ; file name and full path
      ;(name2 (car (gimp-image-get-filename image2))) ; file name and full path 
      (name1 (car (gimp-image-get-name image1))) ; file name only 
      (name2 (car (gimp-image-get-name image2))) ; file name only

      (opacity 100) ;; opacity/transparency
      )

  ;; This took some careful thought and I am pleased with the results.  
  (cond 
    ((= layout 0) 
    ;; Layout, None, manual, leaves selection allowing user to place image.  
        (set! height-new (+ height1 height2)) 
        (set! width-new (+ width1 width2)) 
        ; these offsets are the same as Layout: Right.   
        (set! x-offset 0) (set! y-offset 0)
        (set! i-offset width1) (set! j-offset 0)
    ) 
    ((= layout 1) ;; Layout: up/above
        (set! height-new (+ height1 height2)) 
        ; use whichever width is is greater
        (if (> width1 width2)
            (set! width-new width1) ; if it is not the first one
            (set! width-new width2) ; else it must be the other.  simple binary logic!
        ) 
        (set! x-offset 0) (set! y-offset 0)
        (set! i-offset 0) (set! j-offset height1)  
    )
    ((= layout 2) ;; Layout: down/below 
        (set! height-new (+ height1 height2)) 
        (if (> width1 width2)
            (set! width-new width1) 
            (set! width-new width2)
        )
        (set! x-offset 0) (set! y-offset height1)
        (set! i-offset 0) (set! j-offset 0)  
    )
    ((= layout 3) ;; Layout: left
        (if (> height1 height2)
            (set! height-new height1) 
            (set! height-new height2)
        ) 
        (set! width-new (+ width1 width2))
        (set! x-offset width1) (set! y-offset 0)
        (set! i-offset 0) (set! j-offset 0) 
    )
    ((= layout 4) ;; Layout: right
        (if (> height1 height2)
            (set! height-new height1) 
            (set! height-new height2)
        )
        (set! width-new (+ width1 width2)) 
        (set! x-offset 0) (set! y-offset 0)
        (set! i-offset width1) (set! j-offset 0)
    )
  ) ; end cond


  ;; create the new image! safer to work-on-copy for now.  
  (set! image-new (car (gimp-image-new width-new height-new RGB)))
  (set! back-layer (car (gimp-layer-new image-new width-new height-new RGBA_IMAGE "Background" 100 NORMAL)))
  (gimp-image-add-layer image-new back-layer 0) 
  (set! drawable-new (car (gimp-image-get-active-layer image-new)))  ; v 2.0

  ;; give it a name, based on the source images 
  (set! filename (string-append "Panorama-" name1 "-" name2))
  (gimp-image-set-filename image-new filename)

  ;; create and add the new layers to the new image 
  (set! layer1 (car (gimp-layer-new image-new width-new height-new RGBA_IMAGE name1 opacity NORMAL)))
  (set! layer2 (car (gimp-layer-new image-new width-new height-new RGBA_IMAGE name2 opacity NORMAL)))
  (gimp-image-add-layer image-new layer1 -1)
  (gimp-image-add-layer image-new layer2 -1)

  ;; make copies and paste onto the new layers.  input images automatically become RGBA
  (gimp-edit-copy drawable1) 
  (set! floating-selection (car (gimp-edit-paste layer1 FALSE)))
  (gimp-layer-set-offsets floating-selection x-offset y-offset)
  (gimp-floating-sel-anchor floating-selection)

  (gimp-edit-copy drawable2) 
  (set! floating-selection (car (gimp-edit-paste layer2 FALSE)))
  (gimp-layer-set-offsets floating-selection i-offset j-offset)
  ; if layout None keep selection for manual placement of the image 
  (if (not (= layout 0)) 
        (gimp-floating-sel-anchor floating-selection)
  )

    ;; new image, nothing to undo so the image must be clean
    (gimp-image-clean-all image-new)
    (gimp-display-new image-new)
    (gimp-displays-flush) ; 

    ;; automatically saves a copy to local harddisk
    ;(save-a-copy image-new drawable-new)

    ) ; close the let statement
)

;; NOTE saves a copy, the file saved is seperate from the one displayed 
(define (save-a-copy image drawable)
    (set! directory (car (gimp-gimprc-query "gimp_dir")))

    ;; works but no control over the generated name 
;    (set! filepath (car (gimp-temp-name "psd")) ) 

    ;; more control of the file name but is it random enough, will names clash?
    (set! filepath (string-append directory "/tmp/" "Panorama-" (number->string image) ".psd"))

    ;; need a layered file format, PSD is the only format widely supported   
    (file-psd-save 1 image drawable filepath "" 0 0)
    ;; MNG would be good too though, if it had more and wider support
    ;; (file-mng-save 1 image drawable filepath "" 0 0)
)


(script-fu-register "script-fu-tile-two-images"
    _"<Image>/Image/Tile Two Images..." 

    ;;  About Dialog, Script Information and Description.  
    "Tiles Two Images to create a new image (RGB).  The layout specifies how the second image is placed relative to the first.  Images are always top aligned and seperate layers are used for each image so that more changes can be easily made later.  
Choose Layout 'None' if you want to keep selection and manually place the second image.  
Note, for more precise placement the arrow keys can be used to Nudge the current selection.  
After placing the image you can use the Crop tools to Trim any excess at the edges.  
This script is designed to be portable, simple and easy to use.  

KNOWN ISSUES:
Random dirt sometimes appears on the transparency due to bugs in the program.  
It sucks.  Seriously affects version 1.2.  Only mildly effects version 2.0 but it is still a problem.  This script will not be modified to compensate for or work around the flaw.  The cause of the problem should be fixed, not the symptoms.  

SEE ALSO: 
'Pandora' or 'Hugin' which provide more advanced functionality and complicated manipulation (such as transformations or working with many images) and are specifically designed for creating Panoramas.  
I was already aware of these tools before I wrote this but Scripts are more portable, platform independant, do not need to be compiled, can more easily be changed and customised.  Most importantly I wanted to learn and improve programming skills and have something that I had writen entirely myself.  " 

    "Alan Horkan.  " ; author(s)
    "Alan Horkan, 2004.  
Dedicated to the Public Domain.  " ; rights
    "2004 04 02 UTC" ; date, please use UTC standard yyyy mm dd
    "" ; supported image types 
    SF-IMAGE "Image" 0
    SF-DRAWABLE "Drawable" 0

    SF-IMAGE _"Image 1" 0
    SF-IMAGE _"Image 2" 0 

;; 50 character label, force widget to be wider because it looks ugly otherwise
    SF-OPTION _"Layout  " '(
            _"None                                              "   
            _"Up                                                " ; up/above  
            _"Down                                              " ; down/below
            _"Left                                              " ; beside left 
            _"Right                                             ") ; beside right
)

;; Information in case of backporting 
;; Version (V) 
;; essential changes:
;; V 1.2 (gimp-channel-ops-duplicate image)
;; V 2.0 (gimp-image-duplicate image)
;; non-essential changes:
;; undo-group ...
;; V 1.2 (gimp-image-get-filename image) gets full path, also in V 2.0
;; V 2.0 (gimp-image-get-name image) gets file name only, better
;; (gimp-image-active-drawable image-new) ; v1
;; (gimp-image-get-active-layer image-new) ; v 2.0

;; DEVELOPMENT NOTES
;;
;; KISS, Keep It Simple Stupid!  Deliberately did not implement more options.  
;; More complexity, means more problems.
;; Tried Transparency/Opacity option.  
;; It was of limited use, already have layers to allow for later adjustment.  
;; Considered advanced offsets/position/overlap.  too complicated, 
;; minus values (overlap) could exceed image size would need lots of error checking.  

;; As a rule scripts should work on the current image, I'm making an exception here.  
;; TODO wrap this and provide a Toolbox version with file choosers.  see old version.  

;; Damn, return of the ugly pixel dirt, not as bad as gimp 1.2 but still there
;; I hate this program so much.  
;; creating layers only as big as necessary or doing extra 'clear' might help, 
;; but unfortunately Layout None requires full size layers for the manual placement.  
;; the fucking software needs to be fixed and users need to recognise it sucks
;; it is not my problem, at least it shouldn't be.   

;; ;; offsetting the floating layer
;; why not add the layers instead of copy and pasting them?  non-RGB issues
;; needed so that "Layout None" can allow manual placement (?)
;; damn this also requires full size layers (layers are all == imagesize)
;; if the layer was only the size of the content we'd be offsetting the actual layer
;; there is some potential for abstraction here

;; abstract some of the code?
;; create add paste offset
;;        add offset (type problems)