Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv26225
Modified Files: keyboard.lisp Log Message: Make poll-key similar to poll-char. A key is a character or a symbolic key name.
Date: Wed Nov 24 17:20:15 2004 Author: ffjeld
Index: movitz/losp/x86-pc/keyboard.lisp diff -u movitz/losp/x86-pc/keyboard.lisp:1.3 movitz/losp/x86-pc/keyboard.lisp:1.4 --- movitz/losp/x86-pc/keyboard.lisp:1.3 Thu Oct 7 14:45:07 2004 +++ movitz/losp/x86-pc/keyboard.lisp Wed Nov 24 17:20:14 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Mon Sep 24 16:04:12 2001 ;;;; -;;;; $Id: keyboard.lisp,v 1.3 2004/10/07 12:45:07 ffjeld Exp $ +;;;; $Id: keyboard.lisp,v 1.4 2004/11/24 16:20:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -23,6 +23,7 @@ ;; read-char poll-keypress read-keypress + poll-key set-leds cpu-reset))
@@ -155,7 +156,7 @@ (aref *scan-codes* key-code)))) ;;; (< -1 key-code (length *scan-codes*)))
-(defun read-key () +(defun get-key () (when (lowlevel-event-p) (multiple-value-bind (key-code release-p) (lowlevel-read) @@ -175,7 +176,7 @@
(defun poll-keypress () (multiple-value-bind (key release-p) - (read-key) + (get-key) (unless release-p (values key *qualifier-state*))))
@@ -189,6 +190,7 @@ (multiple-value-bind (key qualifiers) (poll-keypress) (cond + ((not key) nil) ((symbolp key) (case key (:up #^p) @@ -204,8 +206,16 @@ (- (char-code #\a))))) (t key))))
-;;;(defun read-char () -;;; (loop when (poll-char) return it)) +(defun poll-key () + (multiple-value-bind (key qualifiers) + (poll-keypress) + (if (and (characterp key) + (qualifier-p :ctrl qualifiers) + (char<= #\a (char-downcase key) #\z)) + (code-char (+ (char-code #^a) + (char-code (char-downcase key)) + (- (char-code #\a)))) + key)))
(defun set-leds (led0 led1 led2) (loop while (logbitp 1 (io-port #x64 :unsigned-byte8)))