gistfile1.lisp

(defun blend (pane target-file source-file mask-file)
  (let* ((source (gp:load-image pane source-file :cache t))
         (target (gp:load-image pane target-file :cache t))
         (mask (gp:load-image pane mask-file :cache t))
         (source-access (gp:make-image-access pane source))
         (target-access (gp:make-image-access pane target))
         (mask-access (gp:make-image-access pane mask)))

    (unwind-protect
         (progn
           (gp:image-access-transfer-from-image source-access)
           (gp:image-access-transfer-from-image target-access)
           (gp:image-access-transfer-from-image mask-access)

           (dotimes (y (gp:image-access-height target-access))
             (dotimes (x (gp:image-access-width target-access))
               (let* ((scolor (color:unconvert-color 
                               pane 
                               (gp:image-access-pixel source-access x y)))
                      (tcolor (color:unconvert-color 
                               pane
                               (gp:image-access-pixel target-access x y)))
                      (mcolor (color:unconvert-color 
                               pane
                               (gp:image-access-pixel mask-access x y))))

                 (setf (gp:image-access-pixel target-access x y)
                       (color:convert-color 
                        pane 
                        (color:make-rgb 
                         ;; red
                         (+ 
                          (* (color:color-red scolor) 
                             (color:color-red mcolor))
                          (* (color:color-red tcolor) 
                             (- 1 (color:color-red mcolor))))
                         ;; green
                         (+ 
                          (* (color:color-green scolor) 
                             (color:color-green mcolor))
                          (* (color:color-green tcolor) 
                             (- 1 (color:color-green mcolor))))
                         ;; blue
                         (+ 
                          (* (color:color-blue scolor) 
                             (color:color-blue mcolor))
                          (* (color:color-blue tcolor) 
                             (- 1 (color:color-blue mcolor))))
                         ))))))
       
           (gp:image-access-transfer-to-image target-access))
      (progn
        (gp:free-image-access source-access)
        (gp:free-image-access target-access)
        (gp:free-image-access mask-access)))

    target))