Image convolution: Difference between revisions
Content added Content deleted
(added Perl 6) |
|||
Line 278: | Line 278: | ||
} else { fprintf(stderr, "err reading %s\n", input); } |
} else { fprintf(stderr, "err reading %s\n", input); } |
||
}</lang> |
}</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}}== |
=={{header|D}}== |