[lisplab-cvs] r102 - in src: core io

[Jørn Inge Vestgården]

Author: jivestgarden
Date: Fri Oct 16 14:44:23 2009
New Revision: 102

Log:
moved things round

Modified:
   src/core/level0-basic.lisp
   src/io/level3-io.lisp

Modified: src/core/level0-basic.lisp
==============================================================================
--- src/core/level0-basic.lisp	(original)
+++ src/core/level0-basic.lisp	Fri Oct 16 14:44:23 2009
@@ -48,25 +48,6 @@
           ,value)
       ,@(when doc (list doc)))))
 
-(defun strcat (&rest args)
-  ;; TODO move to the part dealing with files
-  (apply #'concatenate (append (list 'string) args)))
-
-(defmacro in-dir (dir &body body)
-  ;; TODO move to the part dealing with files
-  (let ((path (gensym))
-        (dir2 (gensym)))
-    `(let* ((,dir2 ,dir)
-            (,path (merge-pathnames (if (pathnamep ,dir2) 
-					,dir2 
-					(pathname (strcat ,dir2 "/")))
-				    *default-pathname-defaults*)))
-       (ensure-directories-exist ,path)
-       (unless (probe-file ,path)
-	 (error "<~S> is no directory" ,path ))
-       (let ((*default-pathname-defaults* ,path))
-	 , at body))))
-
 (defun to-df (x)
   "Coerce x to double float."
   (coerce x 'double-float))

Modified: src/io/level3-io.lisp
==============================================================================
--- src/io/level3-io.lisp	(original)
+++ src/io/level3-io.lisp	Fri Oct 16 14:44:23 2009
@@ -18,13 +18,34 @@
 ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
 
-;;; TODO: some more system on io. Make methods, but then I need 
-;;;       more control on the parameters. Maybee need some layers. 
-;;;       one generic stream layer and then one for opening and 
-;;;       closing files?
+;;; TODO: make a generic function for bitmap export 
+;;;       (mexport 'eps "filname.eps" m :keys ...)
+;;;       Leave dlmread and dlmwrite as they are.
+
 
 (in-package :lisplab)
 
+(defun strcat (&rest args)
+  "Concatenates the strings." 
+  (apply #'concatenate (append (list 'string) args)))
+
+(defmacro in-dir (dir &body body)
+  "Temperarily binds *default-pathname-defaults* to dir. When directory
+does not exists, it is created."
+  ;; TODO move to the part dealing with files
+  (let ((path (gensym))
+        (dir2 (gensym)))
+    `(let* ((,dir2 ,dir)
+            (,path (merge-pathnames (if (pathnamep ,dir2) 
+					,dir2 
+					(pathname (strcat ,dir2 "/")))
+				    *default-pathname-defaults*)))
+       (ensure-directories-exist ,path)
+       (unless (probe-file ,path)
+	 (error "<~S> is no directory" ,path ))
+       (let ((*default-pathname-defaults* ,path))
+	 , at body))))
+
 (defmethod dlmwrite ((x number) out &key (printer #'prin1) dlm)
   (declare (ignore dlm))
   (dlmwrite (dcol x) out :printer printer))
@@ -119,7 +140,6 @@
 
 (defun pswrite (m filename 
 		&key 
-		(verbose nil)
 		(max (mmax m))
 		(min (mmin m)))
   "Writes matrix as postscript bitmap. Port of a2ps.c by Eric Weeks."
@@ -130,16 +150,16 @@
     (setf max 1.0 min 0.0 ))
   (let* ((DTXSCALE 1.0787)
 	 (DTYSCALE 1.0)
-	 (DTHRES 513)
-	 (DTVRES 481)
+	 #+nil (DTHRES 513)
+	 #+nil (DTVRES 481)
 	 (XOFFSET 54) ; 3/4 inch.  72 units = 1 inch.  
 	 (YOFFSET 288) ; /* 4 inches.  */
 
 	 (nbits 8)
 	 (scale 1)
-	 (invert 0)
-	 (count 0)
-	 (title nil)
+	 #+nil (invert 0)
+	 #+nil (count 0)
+	 #+nil (title nil)
 	 (xsc 1.0)
 	 ; (ysc 1.0 )
 	 (ysc (/ (cols m) (rows m) 1.0))
@@ -156,7 +176,7 @@
       (format out "\%!PS-Adobe-3.0 EPSF-3.0~%")  ;; Identifies job as Postscript.
       (format out "\%\%BoundingBox: ~A ~A ~A ~A~%" xof yof (+ xscale xof) (+ yscale yof))
       (format out "gsave~%")
-      (when title
+      #+nil (when title
 	(format out "/Times-Roman findfont 30 scalefont setfont~%")
 	(format out "50.0 50.0 moveto~%")
 	(format out "(~A) show~%" filename))