(setf *special-ascii-list* '(("ESC" "1b") ("TAB" "09") ("ENTER" "0d"))) (setf *decode-list-no-modifier* '(("L_CTRL" "14") ("L_ALT" "11") (" " "29") ("R_ALT" "e011") ("R_CTRL" "e014") ("L_SHFT" "12") ("<" "61") ("y" "1a") ("x" "22") ("c" "21") ("v" "2a") ("b" "32") ("n" "31") ("m" "3a") ("," "41") ("." "49") ("-" "4a") ("R_SHFT" "59") ("CAPS" "58") ("a" "1c") ("s" "1b") ("d" "23") ("f" "2b") ("g" "34") ("h" "33") ("j" "3b") ("k" "42") ("l" "4b") ("ö" "4c") ("ä" "52") ("#" "5d") ("ENTER" "5a") ("TAB" "0D") ("q" "15") ("w" "1d") ("e" "24") ("r" "2d") ("t" "2c") ("z" "35") ("u" "3c") ("i" "43") ("o" "44") ("p" "4d") ("ü" "54") ("+" "5b") ("^" "0e") ("1" "16") ("2" "1e") ("3" "26") ("4" "25") ("5" "2e") ("6" "36") ("7" "3d") ("8" "3e") ("9" "46") ("0" "45") ("ß" "4e") ("´" "55") ("BKSP" "66") ("ESC" "76") ("F1" "05") ("F2" "06") ("F3" "04") ("F4" "0c") ("F5" "03") ("F6" "0b") ("F7" "83") ("F8" "0a") ("F9" "01") ("F10" "09") ("F11" "78") ("F12" "07") ("INSERT" "e070") ("HOME" "e06c") ("PG_UP" "e07d") ("DELETE" "e071") ("END" "e069") ("PG_DN" "e07a") ("U_ARROW" "e075") ("L_ARROW" "e06b") ("D_ARROW" "e072") ("R_ARROW" "e074"))) (setf *decode-list-shift* '(("L_CTRL" "14") ("L_ALT" "11") (" " "29") ("R_ALT" "e011") ("R_CTRL" "e014") ("L_SHFT" "12") (">" "61") ("Y" "1a") ("X" "22") ("C" "21") ("V" "2a") ("B" "32") ("N" "31") ("M" "3a") (";" "41") (":" "49") ("_" "4a") ("R_SHFT" "59") ("CAPS" "58") ("A" "1c") ("S" "1b") ("D" "23") ("F" "2b") ("G" "34") ("H" "33") ("J" "3b") ("K" "42") ("L" "4b") ("Ö" "4c") ("Ä" "52") ("'" "5d") ("ENTER" "5a") ("TAB" "0D") ("Q" "15") ("W" "1d") ("E" "24") ("R" "2d") ("T" "2c") ("Z" "35") ("U" "3c") ("I" "43") ("O" "44") ("P" "4d") ("Ü" "54") ("*" "5b") ("°" "0e") ("!" "16") ("\"" "1e") ("§" "26") ("$" "25") ("%" "2e") ("&" "36") ("/" "3d") ("(" "3e") (")" "46") ("=" "45") ("?" "4e") ("`" "55") ("DEL" "66") ("ESC" "76") ("F1" "05") ("F2" "06") ("F3" "04") ("F4" "0c") ("F5" "03") ("F6" "0b") ("F7" "83") ("F8" "0a") ("F9" "01") ("F10" "09") ("F11" "78") ("F12" "07") ("INSERT" "e070") ("HOME" "e06c") ("PG_UP" "e07d") ("DELETE" "e071") ("END" "e069") ("PG_DN" "e07a") ("U_ARROW" "e075") ("L_ARROW" "e06b") ("D_ARROW" "e072") ("R_ARROW" "e074"))) (setf *decode-list-alt-gr* '(("L_CTRL" "14") ("L_ALT" "11") (" " "29") ("R_ALT" "e011") ("R_CTRL" "e014") ("L_SHFT" "12") ("|" "61") ("Y" "1a") ("X" "22") ("C" "21") ("V" "2a") ("B" "32") ("N" "31") ("M" "3a") (";" "41") (":" "49") ("_" "4a") ("R_SHFT" "59") ("CAPS" "58") ("A" "1c") ("S" "1b") ("D" "23") ("F" "2b") ("G" "34") ("H" "33") ("J" "3b") ("K" "42") ("L" "4b") ("Ö" "4c") ("Ä" "52") ("'" "5d") ("ENTER" "5a") ("TAB" "0D") ("Q" "15") ("W" "1d") ("E" "24") ("R" "2d") ("T" "2c") ("Z" "35") ("U" "3c") ("I" "43") ("O" "44") ("P" "4d") ("Ü" "54") ("~" "5b") ("°" "0e") ("!" "16") ("\"" "1e") ("§" "26") ("$" "25") ("%" "2e") ("&" "36") ("{" "3d") ("[" "3e") ("]" "46") ("}" "45") ("\\" "4e") ("`" "55") ("DEL" "66") ("ESC" "76") ("F1" "05") ("F2" "06") ("F3" "04") ("F4" "0c") ("F5" "03") ("F6" "0b") ("F7" "83") ("F8" "0a") ("F9" "01") ("F10" "09") ("F11" "78") ("F12" "07") ("INSERT" "e070") ("HOME" "e06c") ("PG_UP" "e07d") ("DELETE" "e071") ("END" "e069") ("PG_DN" "e07a") ("U_ARROW" "e075") ("L_ARROW" "e06b") ("D_ARROW" "e072") ("R_ARROW" "e074"))) (setf *tv-arr-len* 144) (defun generate-code-file (fname) (with-open-file (fo fname :direction :output :if-exists :supersede :if-does-not-exist :create) (generate-key-syms fo *decode-list-no-modifier*) (generate-vector fo "*unmodif-table*" *decode-list-no-modifier*) (generate-vector fo "*altgr-table*" *decode-list-alt-gr*) (generate-vector fo "*shft-table*" *decode-list-shift*))) (defun get-ascii (str) (if (= (length str) 1) (char-code (char str 0)) (loop with res = 256 for e in *special-ascii-list* do (if (string= (car e) str) (setf res (parse-integer (cadr e) :radix 16))) finally return res))) (defun prepare-key-sym-val (str) (let ((val (* (expt 2 16) (parse-integer str :radix 16)))) (if (>= val (expt 2 31)) (setf val (- val (expt 2 32)))) (/ val 4))) (defun generate-key-syms (ostr decode-list) (loop for el in decode-list do (if (> (length (car el)) 1) (let () (format ostr "(defconstant VK_~a ~a)~%" (car el) (prepare-key-sym-val (cadr el)))))) (format ostr "~%~%~%")) (defun generate-vector (ostr vecname decode-list) (let ((tvec (make-array *tv-arr-len* :initial-element 256))) (loop for el in decode-list do (let ((ii (parse-integer (cadr el) :radix 16))) (if (and (<= 0 ii) (<= ii (- *tv-arr-len* 1))) (setf (aref tvec ii) (get-ascii (car el)))))) (format ostr "(setq ~a (vector" vecname) (loop for i from 0 to (- *tv-arr-len* 1) do (if (and (> i 0) (= (mod i 16) 0)) (format ostr "~%")) (format ostr " ~a" (aref tvec i))) (format ostr "))~%~%")))