Revision: 3512 Author: hans URL: http://bknr.net/trac/changeset/3512
Cut corners transparently instead of requiring a background color.
U trunk/projects/quickhoney/src/imageproc.lisp U trunk/projects/quickhoney/website/static/javascript.js
Modified: trunk/projects/quickhoney/src/imageproc.lisp =================================================================== --- trunk/projects/quickhoney/src/imageproc.lisp 2008-07-19 06:05:56 UTC (rev 3511) +++ trunk/projects/quickhoney/src/imageproc.lisp 2008-07-19 06:08:15 UTC (rev 3512) @@ -3,26 +3,55 @@ (defparameter *button-size* 208) (defparameter *big-button-size* 318)
-(defun corner-image (color &key (image *default-image*) - (radius (/ (max (image-width image) (image-height image)) 40))) - (let* ((radius (floor radius)) - (diameter (+ 1 radius radius)) - (other-color (destructuring-bind (red green blue alpha) (color-components color :image image) - (declare (ignore alpha)) - (logxor #xffffff (+ red (ash green 8) (ash blue 16)))))) - (assert (and (>= (image-width image) diameter) - (>= (image-height image) diameter))) - (with-image (circle diameter diameter t) - (fill-image 0 0 :color color :image circle) - (draw-filled-circle radius radius radius :color other-color :image circle) - (do-rows (y circle) - (do-pixels-in-row (x) - (when (eql (raw-pixel) color) - (set-pixel (if (< x radius) x (+ (- (image-width image) diameter) x)) - (if (< y radius) y (+ (- (image-height image) diameter) y)) - :image image :color color))))))) +(defun corner-cutout-coords (image-width image-height radius) + "Return a list of coordinates that need to be made transparent or + colored in background color to get a rounded corner effect. + IMAGE-WIDTH and IMAGE-HEIGHT are the dimensions of the image, RADIUS + is the desired corner rounding radius. The list of coordinates that + is returned is ordered by row and column so that DO-ROWS and + DO-PIXELS-IN-ROW can be used to iterate over the image and pop + coordinate pairs off the front of the list at the same time." + (let ((radius (floor radius)) + (diameter (+ 1 radius radius)) + coords) + (assert (and (>= image-width diameter) + (>= image-height diameter))) + (with-image (circle diameter diameter) + (let ((white (allocate-color 255 255 255 :image circle)) + (black (allocate-color 0 0 0 :image circle))) + (fill-image 0 0 :color white :image circle) + (draw-filled-circle radius radius radius :color black :image circle) + (do-rows (y circle) + (do-pixels-in-row (x) + (when (eql (raw-pixel) white) + (push (list (if (< x radius) x (+ (- image-width diameter) x)) + (if (< y radius) y (+ (- image-height diameter) y))) + coords)))))) + (nreverse coords)))
+(defun corner-image (&key (image *default-image*) + (radius (/ (max (image-width image) (image-height image)) 40))) + (with-default-image (image) + (setf (save-alpha-p) t) + (let ((transparent-color (if (true-color-p) #x7f000000 + (or (transparent-color) + (allocate-color 255 255 255 :alpha 127) + (error "can't allocate transparent color for button"))))) + (setf (transparent-color) transparent-color) + (let ((coords (corner-cutout-coords (image-width) (image-height) radius))) + (destructuring-bind (x-tx y-tx) (car coords) + (do-rows (y) + (do-pixels-in-row (x) + (when (and (eql x x-tx) + (eql y y-tx)) + (setf (raw-pixel) transparent-color) + (when (cdr coords) + (setf coords (cdr coords) + x-tx (caar coords) + y-tx (cadar coords))))))))))) + (define-imageproc-handler cutout-button (input-image &optional keyword (background-color "ffffff") (button-size "208") (radius "8")) + (declare (ignore background-color)) (let* ((button-size (parse-integer button-size)) (button-image (create-image button-size button-size t)) (square-size (min (image-width input-image) (image-height input-image))) @@ -44,7 +73,7 @@ 0 0 0 0 (image-width type-image) (image-height type-image))))) - (corner-image (parse-color background-color :image button-image) :image button-image :radius (parse-integer radius)) + (corner-image :image button-image :radius (parse-integer radius)) button-image))
(define-imageproc-handler center-thumbnail (input-image width height)
Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-07-19 06:05:56 UTC (rev 3511) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-07-19 06:08:15 UTC (rev 3512) @@ -207,6 +207,47 @@ $("edit_client_select").innerHTML = make_clients_selector('edit_client'); }
+/* news */ + +function loadXMLDoc(fname) +{ + var xmlDoc; + + // code for IE + if (window.ActiveXObject) { + xmlDoc = new ActiveXObject("Microsoft.XMLDOM"); + } + else if (document.implementation + && document.implementation.createDocument) { + // code for Mozilla, Firefox, Opera, etc. + xmlDoc = document.implementation.createDocument("","",null); + } else { + alert('Your browser cannot handle this script'); + } + xmlDoc.async = false; + xmlDoc.load(fname); + + return xmlDoc; +} + +function xstlTransformDocumentToElement(document, stylesheet, elementId) +{ + xml = loadXMLDoc(document); + xsl = loadXMLDoc(stylesheet); + if (window.ActiveXObject) { + // code for IE + ex = xml.transformNode(xsl); + document.getElementById(elementId).innerHTML = ex; + } else if (document.implementation + && document.implementation.createDocument) { + // code for Mozilla, Firefox, Opera, etc. + xsltProcessor = new XSLTProcessor(); + xsltProcessor.importStylesheet(xsl); + resultDocument = xsltProcessor.transformToFragment(xml,document); + document.getElementById(elementId).appendChild(resultDocument); + } +} + /* image database */
var current_directory;