Skip to content

Instantly share code, notes, and snippets.

@joelreymont
Created December 31, 2009 16:33
Show Gist options
  • Save joelreymont/266787 to your computer and use it in GitHub Desktop.
Save joelreymont/266787 to your computer and use it in GitHub Desktop.
(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))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment