[movitz-cvs] CVS update: movitz/losp/x86-pc/textmode.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Wed Apr 21 16:24:10 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/x86-pc
In directory common-lisp.net:/tmp/cvs-serv14722
Modified Files:
textmode.lisp
Log Message:
Added some more VGA interfacing. Try e.g. (set-textmode +vga-state-80x50+).
Date: Wed Apr 21 12:24:10 2004
Author: ffjeld
Index: movitz/losp/x86-pc/textmode.lisp
diff -u movitz/losp/x86-pc/textmode.lisp:1.5 movitz/losp/x86-pc/textmode.lisp:1.6
--- movitz/losp/x86-pc/textmode.lisp:1.5 Fri Apr 16 15:17:22 2004
+++ movitz/losp/x86-pc/textmode.lisp Wed Apr 21 12:24:10 2004
@@ -4,12 +4,12 @@
;;;; Department of Computer Science, University of Tromso, Norway
;;;;
;;;; Filename: textmode.lisp
-;;;; Description: A primitive 80x25 text-mode console driver.
+;;;; Description: A primitive VGA text-mode console driver.
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Created at: Thu Nov 9 15:38:56 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: textmode.lisp,v 1.5 2004/04/16 19:17:22 ffjeld Exp $
+;;;; $Id: textmode.lisp,v 1.6 2004/04/21 16:24:10 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -26,22 +26,22 @@
(define-global-variable *screen*
(vga-memory-map))
+(define-global-variable *screen-width*
+ (vga-horizontal-display-end))
+
+(define-global-variable *screen-stride*
+ (vga-horizontal-display-end))
+
(define-global-variable *cursor-x*
- (rem (vga-cursor-location) 80))
+ (rem (vga-cursor-location) *screen-stride*))
(define-global-variable *cursor-y*
- (truncate (vga-cursor-location) 80))
-
-(define-global-variable *screen-width*
- (vga-horizontal-display-end))
+ (truncate (vga-cursor-location) *screen-stride*))
(define-global-variable *screen-height*
(truncate (vga-vertical-display-end)
(vga-character-height)))
-(define-global-variable *screen-stride*
- (vga-horizontal-display-end))
-
(defun move-vga-cursor (x y)
(let ((dest (+ x (* y *screen-stride*))))
(setf (vga-cursor-location) dest)))
@@ -102,26 +102,26 @@
nil)
(defun textmode-copy-line (destination source count)
- (check-type count (integer 0 511))
+ (check-type count (and (integer 0 511) (satisfies evenp)))
(check-type source (unsigned-byte 20))
(check-type destination (unsigned-byte 20))
(with-inline-assembly (:returns :nothing)
(:compile-form (:result-mode :eax) source)
- (:compile-form (:result-mode :ebx) destination)
- (:compile-form (:result-mode :edx) count)
- (:andl #x-16 :eax)
- (:andl #x-16 :ebx)
- (:andl #x-8 :edx)
+ (:compile-form (:result-mode :edx) destination)
+ (:compile-form (:result-mode :ebx) count)
+ (:std) ; Only EBX is now (potential) GC root
+ (:andl #x-8 :ebx) ; ..so make sure EBX is a fixnum
(:shrl 2 :eax)
- (:shrl 2 :ebx)
- (:shrl 1 :edx)
+ (:shrl 2 :edx)
+ (:shrl 1 :ebx)
(:jz 'end-copy-loop)
copy-loop
- ((:gs-override) :movl (:eax :edx -4) :ecx)
- ((:gs-override) :movl :ecx (:ebx :edx -4))
- (:subl 4 :edx)
+ ((:gs-override) :movl (:eax :ebx -4) :ecx)
+ ((:gs-override) :movl :ecx (:edx :ebx -4))
+ (:subl 4 :ebx)
(:ja 'copy-loop)
- end-copy-loop))
+ end-copy-loop
+ (:cld)))
(defun textmode-scroll-down ()
(declare (special muerte.lib::*scroll-offset*))
@@ -133,12 +133,12 @@
do (textmode-copy-line dst src *screen-width*)))
(defun textmode-clear-line (from-column line)
- (let ((dest (+ *screen* (* line 80 2) (* from-column 2))))
- (dotimes (i (- 80 from-column))
+ (let ((dest (+ *screen* (* line *screen-width* 2) (* from-column 2))))
+ (dotimes (i (- *screen-width* from-column))
(setf (memref-int dest 0 i :unsigned-byte16 t) #x0720))))
(defun write-word (word)
- (let ((dest (+ *screen* (* *cursor-x* 2) (* *cursor-y* 160))))
+ (let ((dest (+ *screen* (* *cursor-x* 2) (* *cursor-y* *screen-width* 2))))
(setf (memref-int dest 0 0 :unsigned-byte16 t) #x0723
(memref-int dest 0 1 :unsigned-byte16 t) #x0778)
(write-word-lowlevel word (+ dest 4))
@@ -238,3 +238,22 @@
(cursor-x (setf (cursor-column) (car args)))
(cursor-y (setf (cursor-row) (car args)))))
(t (error "Unknown op: ~S" op))))))
+
+
+(defun set-textmode (mode-state)
+ (setf (vga-state) mode-state)
+ (ecase (vga-character-height)
+ (8 (write-font +vga-font-8x8+ 8))
+ (16 (write-font +vga-font-8x16+ 16)))
+ (setf *screen-width*
+ (vga-horizontal-display-end))
+ (setf *screen-height*
+ (truncate (vga-vertical-display-end)
+ (vga-character-height)))
+ (setf *screen-stride*
+ (vga-horizontal-display-end))
+ (setf *cursor-x*
+ (min (1- *screen-width*) *cursor-x*))
+ (setf *cursor-y*
+ (min (1- *screen-height*) *cursor-y*))
+ (values))
More information about the Movitz-cvs
mailing list