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(a)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)))