Anonymous user
Image convolution: Difference between revisions
→{{header|C}}
(added Perl 6) |
|||
Line 278:
} else { fprintf(stderr, "err reading %s\n", input); }
}</lang>
=={{header|Common Lisp}}==
Uses the RGB pixel buffer package defined here [[Basic bitmap storage#Common Lisp]]. Also the PPM file IO functions defined in
[[Bitmap/Read a PPM file#Common_Lisp]] and [[Bitmap/Write a PPM file#Common_Lisp]] merged into one package.
<lang lisp>(load "rgb-pixel-buffer")
(load "ppm-file-io")
(defpackage #:convolve
(:use #:common-lisp #:rgb-pixel-buffer #:ppm-file-io))
(in-package #:convolve)
(defconstant +row-offsets+ '(-1 -1 -1 0 0 0 1 1 1))
(defconstant +col-offsets+ '(-1 0 1 -1 0 1 -1 0 1))
(defstruct cnv-record descr width kernel divisor offset)
(defparameter *cnv-lib* (make-hash-table))
(setf (gethash 'emboss *cnv-lib*)
(make-cnv-record :descr "emboss-filter" :width 3
:kernel '(-2.0 -1.0 0.0 -1.0 1.0 1.0 0.0 1.0 2.0) :divisor 1.0))
(setf (gethash 'sharpen *cnv-lib*)
(make-cnv-record :descr "sharpen-filter" :width 3
:kernel '(-1.0 -1.0 -1.0 -1.0 9.0 -1.0 -1.0 -1.0 -1.0) :divisor 1.0))
(setf (gethash 'sobel-emboss *cnv-lib*)
(make-cnv-record :descr "sobel-emboss-filter" :width 3
:kernel '(-1.0 -2.0 -1.0 0.0 0.0 0.0 1.0 2.0 1.0 :divisor 1.0 :offset 0.5)))
(setf (gethash 'box-blur *cnv-lib*)
(make-cnv-record :descr "box-blur-filter" :width 3
:kernel '(1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0) :divisor 9.0))
(defun convolve (filename params)
(let* ((buf (read-ppm-file-to-rgb-pixel-buffer filename))
(width (first (array-dimensions buf)))
(height (second (array-dimensions buf)))
(obuf (make-rgb-pixel-buffer width height)))
;;; constrain a value to some range
;;; (int,int,int)->int
(defun constrain (val minv maxv)
(declare (type integer val minv maxv))
(min maxv (max minv val)))
;;; convolve a single channel
;;; list ubyte8->ubyte8
(defun convolve-channel (band)
(constrain (round (apply #'+ (mapcar #'* band (cnv-record-kernel params)))) 0 255))
;;; return the rgb convolution of a list of pixels
;;; list uint24->uint24
(defun convolve-pixels (pixels)
(let ((reds (list)) (greens (list)) (blues (list)))
(dolist (pel (reverse pixels))
(push (rgb-pixel-red pel) reds)
(push (rgb-pixel-green pel) greens)
(push (rgb-pixel-blue pel) blues))
(make-rgb-pixel (convolve-channel reds) (convolve-channel greens) (convolve-channel blues))))
;;; return the list of pixels to which the kernel will be applied
;;; (int,int)->list uint24
(defun kernel-pixels (c r)
(mapcar (lambda (coff roff) (rgb-pixel buf (constrain (+ c coff) 0 (1- width)) (constrain (+ r roff) 0 (1- height))))
+col-offsets+ +row-offsets+))
;;; body of function
(dotimes (r height)
(dotimes (c width)
(setf (rgb-pixel obuf c r) (convolve-pixels (kernel-pixels c r)))))
(write-rgb-pixel-buffer-to-ppm-file (concatenate 'string (format nil "convolve-~A-" (cnv-record-descr params)) filename) obuf)))
(in-package #:cl-user)
(defun main ()
(loop for pars being the hash-values of convolve::*cnv-lib*
do (princ (convolve::convolve "lena_color.ppm" pars)) (terpri)))
</lang>
=={{header|D}}==
| |||