[bknr-cvs] hans changed trunk/projects/quickhoney/
BKNR Commits
bknr at bknr.net
Sat Jul 19 06:08:15 UTC 2008
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;
More information about the Bknr-cvs
mailing list