[movitz-cvs] CVS movitz/losp/x86-pc
ffjeld
ffjeld at common-lisp.net
Mon Mar 26 18:04:04 UTC 2007
Update of /project/movitz/cvsroot/movitz/losp/x86-pc
In directory clnet:/tmp/cvs-serv17914
Modified Files:
vga.lisp
Log Message:
Patch from M. Bealby.
--- /project/movitz/cvsroot/movitz/losp/x86-pc/vga.lisp 2007/03/21 21:49:11 1.11
+++ /project/movitz/cvsroot/movitz/losp/x86-pc/vga.lisp 2007/03/26 18:04:04 1.12
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Created at: Tue Sep 25 14:08:20 2001
;;;;
-;;;; $Id: vga.lisp,v 1.11 2007/03/21 21:49:11 ffjeld Exp $
+;;;; $Id: vga.lisp,v 1.12 2007/03/26 18:04:04 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -237,6 +237,7 @@
(defvar *vga-page-count* 0)
(defvar *vga-width* 0)
(defvar *vga-height* 0)
+(defvar *vga-viewport* '(0 0 0 0))
(defconstant +vga-misc-read+ #x0c)
(defconstant +vga-misc-write+ #x02)
@@ -1117,18 +1118,45 @@
(g-clear))
(values))
+;; read a pixel from the DISPLAYED page
+(defun pixel (x y)
+ (memref-int (vga-memory-map)
+ :index (+ (* (truncate *vga-width* 4) y)
+ (truncate x y)
+ (* (truncate *vga-width* 2)
+ *vga-height*
+ (mod (1+ *vga-current-page*)
+ *vga-page-count*)))
+ :type :unsigned-byte8))
+
;; set a pixel to a colour of our choice
-;; always writing to the next page
+;; write to the NEXT page
(defun (setf pixel) (col x y)
- (set-plane (logand x 3))
- (setf (memref-int (vga-memory-map)
- :index (+ (* (truncate *vga-width* 4) y) ; pixel
- (truncate x 4)
- (* (truncate *vga-width* 2) ; page
- *vga-height*
- *vga-current-page*))
- :type :unsigned-byte8)
- col))
+ (cond ((< x (nth 0 (viewport))) (return-from pixel nil))
+ ((> x (nth 1 (viewport))) (return-from pixel nil))
+ ((< y (nth 2 (viewport))) (return-from pixel nil))
+ ((> y (nth 3 (viewport))) (return-from pixel nil))
+ (t (set-plane (logand x 3))
+ (setf (memref-int (vga-memory-map)
+ :index (+ (* (truncate *vga-width* 4) y) ; pixel
+ (truncate x 4)
+ (* (truncate *vga-width* 2) ; page
+ *vga-height*
+ *vga-current-page*))
+ :type :unsigned-byte8)
+ col))))
+
+
+; return the current viewport as a list
+(defun viewport ()
+ *vga-viewport*)
+
+
+; sets the viewport
+; rectangle is a list of left-bound, right-bound, top-bound, bottom-bound
+(defun (setf viewport) (rectangle)
+ (setf *vga-viewport* rectangle))
+
;; clear the screen
(defun g-clear ()
@@ -1176,6 +1204,7 @@
(mod (1+ *vga-current-page*)
*vga-page-count*)))
+
;; easy way to get into graphics mode
(defun g-start ()
(setf (vga-state) +vga-state-320x200x256-modex+)
@@ -1183,6 +1212,7 @@
(setf *vga-height* 200)
(setf *vga-page-count* 2)
(setf *vga-current-page* 0) ; writing page
+ (setf (viewport) `(0 ,(1- *vga-width*) 0 ,(1- *vga-height*)))
(unchain-video-mode)
(g-clear)
(page-flip))
More information about the Movitz-cvs
mailing list