[bknr-cvs] ksprotte changed trunk/projects/bos/web/

[BKNR Commits]

Revision: 3667
Author: ksprotte
URL: http://bknr.net/trac/changeset/3667

removed allocation-area-gfx-handler (not needed anymore and causing a warning due to undefined function make-vga-colors)
U   trunk/projects/bos/web/allocation-area-handlers.lisp
U   trunk/projects/bos/web/webserver.lisp

Modified: trunk/projects/bos/web/allocation-area-handlers.lisp
===================================================================
--- trunk/projects/bos/web/allocation-area-handlers.lisp	2008-07-28 18:33:35 UTC (rev 3666)
+++ trunk/projects/bos/web/allocation-area-handlers.lisp	2008-07-28 19:09:03 UTC (rev 3667)
@@ -95,51 +95,6 @@
   (with-bos-cms-page (:title "Allocation area has been deactivated")
     (:h2 "The allocation area has been deactivated")))
 
-(defclass allocation-area-gfx-handler (editor-only-handler object-handler)
-  ())
-
-(defmethod handle-object ((handler allocation-area-gfx-handler) allocation-area)
-  (cl-gd:with-image* ((allocation-area-width allocation-area)
-		      (allocation-area-height allocation-area) t)
-    (with-slots (left top width height) allocation-area
-      (let ((colors (make-vga-colors))
-	    (vertices (mapcan #'(lambda (point) (list (- (car point) left)
-						      (- (cdr point) top)))
-			      (coerce (allocation-area-vertices allocation-area) 'list))))
-	(loop with dest-y = 0
-           for y = (+ top dest-y)
-           for tile-y = (* 90 (floor y 90))
-           until (> tile-y (+ top height))
-           for copy-height = (cond
-                               ((< tile-y top)
-                                (+ 90 (- tile-y top)))
-                               ((> (+ tile-y 90) (+ top height))
-                                (- (+ tile-y 90) (+ top height)))
-                               (t
-                                90))
-           for source-y = (if (< tile-y top) (- 90 copy-height) 0)
-           do (loop with dest-x = 0
-                 for x = (+ left dest-x)
-                 for tile-x = (* 90 (floor x 90))
-                 until (> tile-x (+ left width))
-                 for copy-width = (cond
-                                    ((< tile-x left)
-                                     (+ 90 (- tile-x left)))
-                                    ((> (+ tile-x 90) (+ left width))
-                                     (- (+ tile-x 90) (+ left width)))
-                                    (t
-                                     90))
-                 for source-x = (if (< tile-x left) (- 90 copy-width) 0)
-                 do (cl-gd:copy-image (image-tile-image (get-map-tile x y))
-                                      cl-gd:*default-image*
-                                      source-x source-y
-                                      dest-x dest-y
-                                      copy-width copy-height)
-                 do (incf dest-x copy-width))
-           do (incf dest-y copy-height))
-	(cl-gd:draw-polygon vertices :color (elt colors 1))
-	(emit-image-to-browser cl-gd:*default-image* :png)))))
-
 (defclass create-allocation-area-handler (admin-only-handler form-handler)
   ())
 

Modified: trunk/projects/bos/web/webserver.lisp
===================================================================
--- trunk/projects/bos/web/webserver.lisp	2008-07-28 18:33:35 UTC (rev 3666)
+++ trunk/projects/bos/web/webserver.lisp	2008-07-28 19:09:03 UTC (rev 3667)
@@ -184,7 +184,6 @@
 					("/m2-javascript" m2-javascript-handler)
 					("/sponsor-login" sponsor-login-handler)
 					("/create-allocation-area" create-allocation-area-handler)
-					("/allocation-area-gfx" allocation-area-gfx-handler)
                                         ("/allocation-area" allocation-area-handler)
 					("/allocation-cache" allocation-cache-handler)
 					("/certificate" certificate-handler)