- bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] hans changed trunk/projects/rekonstrukt/
by BKNR Commits 19 Jan '09

19 Jan '09

Revision: 4156 Author: hans URL: http://bknr.net/trac/changeset/4156 Ignore ISE's files _U trunk/projects/rekonstrukt/ U trunk/projects/rekonstrukt/rekonstrukt.ise Property changes on: trunk/projects/rekonstrukt ___________________________________________________________________ Name: svn:ignore + clocks_alone.ngr clocks_alone.ut clocks_alone_map.xrpt clocks_alone_map.mrp clocks_alone_xst.xrpt clocks_alone.lso rekonstrukt_xdb clocks_alone_map.ncd clocks_alone.bld clocks_alone_pad.txt clocks_alone_prev_built.ngd clocks_alone.cmd_log rekonstrukt.ntrc_log clocks_alone.drc clocks_alone_vhdl.prj clocks_alone_map.map clocks_alone.twr clocks_alone.syr clocks_alone_summary.xml clocks_alone_map.ngm clocks_alone.xst clocks_alone_pad.csv clocks_alone_guide.ncd clocks_alone.twx rekonstrukt.restore clocks_alone.unroutes clocks_alone_usage.xml _ngo clocks_alone.prj clocks_alone_par.xrpt clocks_alone.xpi clocks_alone.ptwx clocks_alone.ncd clocks_alone.pad clocks_alone_ngdbuild.xrpt _xmsgs clocks_alone.bgn clocks_alone.ngc clocks_alone.ngd clocks_alone.pcf clocks_alone.stx clocks_alone.bit clocks_alone_summary.html clocks_alone.par xst Modified: trunk/projects/rekonstrukt/rekonstrukt.ise =================================================================== (Binary files differ)

1 0

[bknr-cvs] hans changed trunk/projects/rekonstrukt/rekonstrukt.
by BKNR Commits 19 Jan '09

19 Jan '09

Revision: 4155 Author: hans URL: http://bknr.net/trac/changeset/4155 checkpoint project files A trunk/projects/rekonstrukt/rekonstrukt.adf A trunk/projects/rekonstrukt/rekonstrukt.aws A trunk/projects/rekonstrukt/rekonstrukt.ise A trunk/projects/rekonstrukt/rekonstrukt.wsp A trunk/projects/rekonstrukt/rekonstrukt.wsw Change set too large, please see URL above

1 0

[bknr-cvs] hans changed trunk/projects/rekonstrukt/src/
by BKNR Commits 19 Jan '09

19 Jan '09

Revision: 4154 Author: hans URL: http://bknr.net/trac/changeset/4154 checkpoint A trunk/projects/rekonstrukt/src/Avnet_Sp3A_Eval_081201.ucf A trunk/projects/rekonstrukt/src/clkdiv.vhd A trunk/projects/rekonstrukt/src/clocks.vhd A trunk/projects/rekonstrukt/src/clocks_alone.vhd Change set too large, please see URL above

1 0

[bknr-cvs] hans changed trunk/projects/rekonstrukt/src/
by BKNR Commits 19 Jan '09

19 Jan '09

Revision: 4153 Author: hans URL: http://bknr.net/trac/changeset/4153 Source directory A trunk/projects/rekonstrukt/src/

1 0

[bknr-cvs] hans changed trunk/projects/rekonstrukt/
by BKNR Commits 19 Jan '09

19 Jan '09

Revision: 4152 Author: hans URL: http://bknr.net/trac/changeset/4152 New directory for Rekonstrukt VHDL synthesizer/sequencer project A trunk/projects/rekonstrukt/

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/load.lisp
by BKNR Commits 08 Jan '09

08 Jan '09

Revision: 4151 Author: hans URL: http://bknr.net/trac/changeset/4151 Disable LDB in SBCL, thanks to Zach Beane! U trunk/projects/quickhoney/src/load.lisp Modified: trunk/projects/quickhoney/src/load.lisp =================================================================== --- trunk/projects/quickhoney/src/load.lisp 2008-12-21 22:03:07 UTC (rev 4150) +++ trunk/projects/quickhoney/src/load.lisp 2009-01-08 13:14:26 UTC (rev 4151) @@ -5,5 +5,11 @@ (swank::create-server :port 4085) +;; disable ldb +#+sbcl +(sb-alien:define-alien-routine ("disable_lossage_handler" disable-sbcl-ldb) sb-alien:void) +#+sbcl +(disable-sbcl-ldb) + #+cmu (mp::startup-idle-and-top-level-loops)

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/pixel-pdf.lisp
by BKNR Commits 21 Dec '08

21 Dec '08

Revision: 4150 Author: hans URL: http://bknr.net/trac/changeset/4150 Remove functions that are called only once. U trunk/projects/quickhoney/src/pixel-pdf.lisp Modified: trunk/projects/quickhoney/src/pixel-pdf.lisp =================================================================== --- trunk/projects/quickhoney/src/pixel-pdf.lisp 2008-12-21 21:04:33 UTC (rev 4149) +++ trunk/projects/quickhoney/src/pixel-pdf.lisp 2008-12-21 22:03:07 UTC (rev 4150) @@ -104,12 +104,6 @@ (:right (funcall fn (1+ x) (1+ y)))))))) -(defun can-turn-right () - (look :right #'same-color)) - -(defun can-go-forward () - (look :forward #'same-color)) - (defun turn (direction) (turtle:turn direction) (setf (looking-in-direction *converter*) @@ -171,9 +165,9 @@ ((and (eql from-x (turtle:x)) (eql from-y (turtle:y)))) (cond - ((can-go-forward) + ((look :forward #'same-color) (cond - ((can-turn-right) + ((look :right #'same-color) (look :right #'move-to-pixel) (turn :right) (turtle:forward))

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/
by BKNR Commits 21 Dec '08

21 Dec '08

Revision: 4149 Author: hans URL: http://bknr.net/trac/changeset/4149 Interface to store images, add function to convert all pixel images. U trunk/projects/quickhoney/src/image.lisp U trunk/projects/quickhoney/src/packages.lisp U trunk/projects/quickhoney/src/pixel-pdf.lisp Modified: trunk/projects/quickhoney/src/image.lisp =================================================================== --- trunk/projects/quickhoney/src/image.lisp 2008-12-21 14:07:37 UTC (rev 4148) +++ trunk/projects/quickhoney/src/image.lisp 2008-12-21 21:04:33 UTC (rev 4149) @@ -57,3 +57,14 @@ (defmethod destroy-object :before ((image quickhoney-animation-image)) (delete-object (quickhoney-animation-image-animation image))) +(defun convert-all-pixel-images (directory) + (dolist (category (remove :pixel (quickhoney::all-categories) :test-not #'eql :key #'car)) + (dolist (image (quickhoney:images-in-category category)) + (format t "; image ~A~%" image) + (handler-case + (pixel-pdf:convert-store-image-to-pdf image + (make-pathname :name (store-image-name image) + :type "pdf" + :defaults directory)) + (error (e) + (format t "; error ~A~%" e)))))) \ No newline at end of file Modified: trunk/projects/quickhoney/src/packages.lisp =================================================================== --- trunk/projects/quickhoney/src/packages.lisp 2008-12-21 14:07:37 UTC (rev 4148) +++ trunk/projects/quickhoney/src/packages.lisp 2008-12-21 21:04:33 UTC (rev 4149) @@ -91,7 +91,8 @@ (defpackage :pixel-pdf (:use :cl) - (:export #:convert)) + (:export #:convert-image-file-to-pdf + #:convert-store-image-to-pdf)) (defpackage :turtle (:use :cl) Modified: trunk/projects/quickhoney/src/pixel-pdf.lisp =================================================================== --- trunk/projects/quickhoney/src/pixel-pdf.lisp 2008-12-21 14:07:37 UTC (rev 4148) +++ trunk/projects/quickhoney/src/pixel-pdf.lisp 2008-12-21 21:04:33 UTC (rev 4149) @@ -17,6 +17,10 @@ (looking-in-direction :initform :east :accessor looking-in-direction))) +(defmacro with-converter ((&rest args) &body body) + `(let ((*converter* (apply #'make-instance 'converter ,args))) + ,@body)) + (defun width (converter) (array-dimension (pixels converter) 0)) @@ -43,17 +47,17 @@ (ldb (byte 8 0) retval) (cl-gd::gd-image-get-blue img raw-pixel)) retval)))))) -(defmethod initialize-instance :after ((converter converter) &key image-pathname) - (cl-gd:with-image-from-file* (image-pathname) - (let ((width (cl-gd:image-width)) - (height (cl-gd:image-height))) - (with-slots (seen pixels) converter - (setf seen (make-array (list width height) - :element-type 'boolean :initial-element nil) - pixels (make-array (list width height))) - (cl-gd:do-rows (y) - (cl-gd:do-pixels-in-row (x) - (setf (aref pixels x y) (convert-color converter (cl-gd:raw-pixel))))))))) +(defmethod initialize-instance :after ((converter converter) &key) + (let ((width (cl-gd:image-width)) + (height (cl-gd:image-height))) + (with-slots (seen pixels) converter + (setf seen (make-array (list width height) + :element-type 'boolean :initial-element nil) + pixels (make-array (list width height))) + (cl-gd:do-rows (y) + (cl-gd:do-pixels-in-row (x) + (setf (aref pixels x y) (convert-color converter (cl-gd:raw-pixel))))))) + (turtle:reset)) (defun in-range (x y) (and (< -1 x (width *converter*)) @@ -135,6 +139,8 @@ (y *converter*) y)) (defun flood-fill () + ;; This function certainly is stack hungry. If needed, increase the + ;; stack size of the Lisp runtime (SBCL: --control-stack-size 64) (labels ((maybe-descend (x y) (when (and (same-color x y) @@ -179,9 +185,8 @@ (turtle:forward)))) (turtle:pen-up)) -(defun pixels-pdf (image-pathname) - (let ((*converter* (make-instance 'converter :image-pathname image-pathname))) - (turtle:reset) +(defun convert-pixels-to-pdf (pdf-pathname) + (with-converter () (pdf:with-document () (let ((bounds (if (> (width *converter*) (height *converter*)) @@ -209,15 +214,25 @@ (pdf:set-font (pdf:get-font "Helvetica") 7.0) (pdf:set-rgb-fill 0.5 0.5 0.5) (pdf:translate (+ border x-offset 3 (* scale (width *converter*))) - 125.5) + (+ y-offset 125.5)) (pdf:rotate -90.0) - (pdf:show-text (format nil "~C Nana Rausch QuickHoney" #\Copyright_Sign))))))) - (pdf:write-document (make-pathname :type "pdf" :defaults image-pathname))))) + (pdf:show-text (format nil "~C Nana Rausch QuickHoney" #\Copyright_Sign)))))) + (pdf:write-document pdf-pathname))))) +(defun convert-image-file-to-pdf (image-pathname + &optional (pdf-pathname (make-pathname :type "pdf" :defaults image-pathname))) + (cl-gd:with-image-from-file* (image-pathname) + (convert-pixels-to-pdf pdf-pathname))) + +(defun convert-store-image-to-pdf (store-image pdf-pathname) + (bknr.images:with-store-image* (store-image) + (convert-pixels-to-pdf pdf-pathname))) + (defun print-seen () (dotimes (y (height *converter*)) (dotimes (x (width *converter*)) (write-char (if (seen x (- (height *converter*) y 1)) #\* #\.) *error-output*)) - (terpri *error-output*))) \ No newline at end of file + (terpri *error-output*))) +

1 0

[bknr-cvs] hans changed trunk/thirdparty/cl-pdf/pdf
by BKNR Commits 21 Dec '08

21 Dec '08

Revision: 4148 Author: hans URL: http://bknr.net/trac/changeset/4148 Fix some small bugs. U trunk/thirdparty/cl-pdf/pdf-base.lisp U trunk/thirdparty/cl-pdf/pdf-parser.lisp U trunk/thirdparty/cl-pdf/pdf.lisp Modified: trunk/thirdparty/cl-pdf/pdf-base.lisp =================================================================== --- trunk/thirdparty/cl-pdf/pdf-base.lisp 2008-12-21 11:21:37 UTC (rev 4147) +++ trunk/thirdparty/cl-pdf/pdf-base.lisp 2008-12-21 14:07:37 UTC (rev 4148) @@ -155,6 +155,7 @@ (write-char #\) *page-stream*)) (defmethod write-to-page ((char character) (encoding unicode-encoding) &optional escape) + (declare (ignore escape)) (write-char #\< *page-stream*) (format *page-stream* "~4,'0x" (char-code char)) (write-char #\> *page-stream*)) Modified: trunk/thirdparty/cl-pdf/pdf-parser.lisp =================================================================== --- trunk/thirdparty/cl-pdf/pdf-parser.lisp 2008-12-21 11:21:37 UTC (rev 4147) +++ trunk/thirdparty/cl-pdf/pdf-parser.lisp 2008-12-21 14:07:37 UTC (rev 4148) @@ -495,8 +495,7 @@ (*root-page* (root-page *document*)) (*outlines-stack* (list (outline-root *document*))) (*page* nil) - (*page-number* 0) - (*name-counter* 100)) + (*page-number* 0)) (add-doc-info *document* :creator ,creator :author ,author :title ,title :subject ,subject :keywords ,keywords) ,@body)) Modified: trunk/thirdparty/cl-pdf/pdf.lisp =================================================================== --- trunk/thirdparty/cl-pdf/pdf.lisp 2008-12-21 11:21:37 UTC (rev 4147) +++ trunk/thirdparty/cl-pdf/pdf.lisp 2008-12-21 14:07:37 UTC (rev 4148) @@ -16,7 +16,7 @@ (defvar *page-stream*) (defvar *pdf-stream*) (defvar *xrefs*) -(defvar *name-counter*) +(defvar *name-counter* 100) (defun gen-name (prefix) (format nil "~a~d" prefix (incf *name-counter*)))

1 0

[bknr-cvs] hans changed trunk/thirdparty/cl-pdf/
by BKNR Commits 21 Dec '08

21 Dec '08

Revision: 4147 Author: hans URL: http://bknr.net/trac/changeset/4147 use babel for string-octet conversion, specify latin-1 character set explicitly U trunk/thirdparty/cl-pdf/cl-pdf.asd U trunk/thirdparty/cl-pdf/zlib.lisp Modified: trunk/thirdparty/cl-pdf/cl-pdf.asd =================================================================== --- trunk/thirdparty/cl-pdf/cl-pdf.asd 2008-12-21 11:09:32 UTC (rev 4146) +++ trunk/thirdparty/cl-pdf/cl-pdf.asd 2008-12-21 11:21:37 UTC (rev 4147) @@ -60,4 +60,4 @@ (:file "text" :depends-on ("pdf-base")) (:file "bar-codes" :depends-on ("pdf-geom")) (:file "chart" :depends-on ("text" "pdf-geom"))) - :depends-on (:iterate #+use-salza-zlib :salza)) + :depends-on (:iterate #+use-salza-zlib :salza #+use-salza-zlib :babel)) Modified: trunk/thirdparty/cl-pdf/zlib.lisp =================================================================== --- trunk/thirdparty/cl-pdf/zlib.lisp 2008-12-21 11:09:32 UTC (rev 4146) +++ trunk/thirdparty/cl-pdf/zlib.lisp 2008-12-21 11:21:37 UTC (rev 4147) @@ -88,7 +88,7 @@ #+use-salza-zlib (defun compress-string (string) (let* ((input (if (stringp string) - (deflate::string-to-octets string 0 (length string)) + (babel::string-to-octets string :encoding :iso-8859-1) string)) (buffer-size (min 8192 (* 2 (length string)))) (zlib-buffer (make-array buffer-size :element-type 'salza::octet))

1 0