cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit fd5b26f367ffc566100218a2e065b5408c9e8d61
parent 3fa532f2a7325f94a5798f86d77e8964df6e3434
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun, 20 Sep 2015 18:16:35 +0200

added reader for linux console font file format psf2

Diffstat:
Apsf.lisp | 87+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 87 insertions(+), 0 deletions(-)

diff --git a/psf.lisp b/psf.lisp @@ -0,0 +1,87 @@ +;;; Copyright (C) 2015 Tomas Hlavaty <tom@logand.com> +;;; +;;; Permission is hereby granted, free of charge, to any person +;;; obtaining a copy of this software and associated documentation +;;; files (the "Software"), to deal in the Software without +;;; restriction, including without limitation the rights to use, copy, +;;; modify, merge, publish, distribute, sublicense, and/or sell copies +;;; of the Software, and to permit persons to whom the Software is +;;; furnished to do so, subject to the following conditions: +;;; +;;; The above copyright notice and this permission notice shall be +;;; included in all copies or substantial portions of the Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +;;; DEALINGS IN THE SOFTWARE. + +(defpackage :rw.psf + (:use :cl)) + +(in-package :rw.psf) + +;; https://www.win.tue.nl/~aeb/linux/kbd/font-formats-1.html + +(defun next-bitmap (reader height width) + (let ((z (make-array height))) + (dotimes (j height z) + (let ((v (make-array width :element-type 'bit)) + (r (rw:bit-reader reader))) + (dotimes (i width) + (setf (bit v i) (rw:next r))) + (setf (aref z j) v))))) + +(defun next-bitmaps (reader length height width) + (let ((z (make-array length))) + (dotimes (i length z) + (setf (aref z i) (next-bitmap reader height width))))) + +(defun next-unicode (reader) + (loop + ;; sep #xff start #xfe + while (rw:peek reader) + collect (prog1 (rw:till reader '(#xff)) + (assert (eql #xff (rw:next reader)))))) + +(rw.wire:defstruc header () + (rw:u32le magic) + (rw:u32le version) + (rw:u32le headersize) + (rw:u32le flags) + (rw:u32le length) + (rw:u32le charsize) + (rw:u32le height) + (rw:u32le width)) + +(defstruct psf2 header bitmaps unicode) + +(defun next-psf2 (octet-reader) + (let* ((h (next-header octet-reader)) + (height (header-height h)) + (width (header-width h))) + (assert (eql #x864ab572 (header-magic h))) + (assert (eql 0 (header-version h))) + (assert (eql 32 (header-headersize h))) + (assert (eql (header-charsize h) (* height (floor (+ width 7) 8)))) + (make-psf2 :header h + :bitmaps (next-bitmaps octet-reader (header-length h) height width) + :unicode (ecase (header-flags h) + ;;(0) + (1 ;; unicode + (next-unicode octet-reader)))))) + +(defun load-font (pathname) + (rw.os:with-program-output (s "zcat" (list pathname)) + (let ((r (rw:peek-reader (rw:byte-reader s)))) + (prog1 (next-psf2 r) + (assert (not (rw:till r))))))) + +;;setfont -v +;;(print (load-font "/nix/store/sxrgxk6bw27c516zdvjh2mr6nk4hl9ni-terminus-font-4.39/share/consolefonts/ter-g28n.psf.gz")) +;;(print (load-font "/nix/store/3jzf1724gfkg942i8dbg0ixdncsv0qhf-kbd-2.0.3/share/consolefonts/default8x16.psfu.gz")) +;;(print (load-font "/nix/store/3jzf1724gfkg942i8dbg0ixdncsv0qhf-kbd-2.0.3/share/consolefonts/Lat2-Terminus16.psfu.gz"))