[movitz-cvs] CVS update: movitz/losp/los0.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp
In directory common-lisp.net:/tmp/cvs-serv26533

Modified Files:
	los0.lisp 
Log Message:
Added a dump-screen-to-tftp button, f12.

Date: Wed Nov 24 17:24:17 2004
Author: ffjeld

Index: movitz/losp/los0.lisp
diff -u movitz/losp/los0.lisp:1.31 movitz/losp/los0.lisp:1.32
--- movitz/losp/los0.lisp:1.31	Tue Nov 23 20:03:15 2004
+++ movitz/losp/los0.lisp	Wed Nov 24 17:24:16 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Fri Dec  1 18:08:32 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: los0.lisp,v 1.31 2004/11/23 19:03:15 ffjeld Exp $
+;;;; $Id: los0.lisp,v 1.32 2004/11/24 16:24:16 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -1262,6 +1262,27 @@
 		       (incf (memref-int muerte.x86-pc::*screen* :index 80 :type :unsigned-byte16)))))
 	(incf (memref-int muerte.x86-pc::*screen* :index 160 :type :unsigned-byte16))))))
 
+(defun fvf-textmode-screendump ()
+  (muerte.ip4::ip4-init)
+  (let* ((w muerte.x86-pc::*screen-width*)
+	 (h muerte.x86-pc::*screen-height*)
+	 (data (make-array (* w h)
+			   :element-type 'character
+			   :fill-pointer 0)))
+    (loop for y below h
+	do (loop for x below w
+	       do (vector-push (code-char
+				(ldb (byte 8 0)
+				     (memref-int muerte.x86-pc::*screen*
+						 :index (+ x (* y muerte.x86-pc::*screen-stride*))
+						 :type :unsigned-byte16)))
+			       data)))
+    (muerte.ip4:tftp/ethernet-write :129.242.16.151 "movitz-screendump.txt" data
+				    :quiet t
+				    :mac (muerte.ip4::polling-arp :129.242.16.1
+								  (lambda ()
+								    (eql #\esc (muerte.x86-pc.keyboard:poll-char)))))))
+
 (defun mumbojumbo (x)
   (with-inline-assembly (:returns :eax)
     (:compile-form (:result-mode :untagged-fixnum-ecx) x)
@@ -1319,13 +1340,21 @@
 		       *debug-io* s)))
     (let ((* nil) (** nil) (*** nil)
 	  (/ nil) (// nil) (/// nil)
-	  (+ nil) (++ nil) (+++ nil))
+	  (+ nil) (++ nil) (+++ nil)
+	  (*readline-signal-keypresses* t))
       (format t "~&Movitz image Los0 build ~D." *build-number*)
-      (loop
-	(catch :top-level-repl		; If restarts don't work, you can throw this..
-	  (with-simple-restart (abort "Abort to the top command level.")
-	    (read-eval-print))))))
-  
+      (handler-bind 
+	  ((readline-keypress
+	    (lambda (c)
+	      (let ((key (readline-keypress-key c)))
+		(when (eq :f12 key)
+		  (fvf-textmode-screendump)
+		  (format *query-io* "~&Dumped console contents by TFTP."))))))
+	(loop
+	  (catch :top-level-repl	; If restarts don't work, you can throw this..
+	    (with-simple-restart (abort "Abort to the top command level.")
+	      (read-eval-print)))))))
+
   (error "What's up? [~S]" 'hey))
 
 (defun read (&optional input-stream eof-error-p eof-value recursive-p)