;;; gen-unifont-glyphs.el --- Font generation script -*- lexical-binding: t; -*-

;; Copyright (C) 2023 Vasilij Schneidermann <mail@vasilij.de>
;; SPDX-License-Identifier: GPL-3.0-or-later

;; Author: Vasilij Schneidermann <mail@vasilij.de>
;; URL: https://depp.brause.cc/xcb-boomshine
;; Version: 0.0.1
;; Package-Requires: ((emacs "28.1"))
;; Keywords: games

;; This file is NOT part of GNU Emacs.

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; GNU Unifont is a bitmap font providing its glyphs in hexadecimal
;; format. Given a .hex file, the below code expands into a character
;; table containing each ASCII glyph in the A8 format required by X11.

;;; Code:

(require 'hex-util)
(require 'rx)

(defun gen-unifont-glyphs (path)
  (with-temp-buffer
    (let* ((table (make-char-table 'unifont))
           (hex-line-rx (rx bol
                            (group (= 4 (any hex)))
                            ":"
                            (group (= 32 (any hex)))
                            eol))
           (max-hex-line-length (+ 4   ; address in hex
                                   1   ; colon
                                   64  ; contents for full glyph
                                   1   ; newline
                                   ))
           (chunk-size (* 128 max-hex-line-length)))
      (insert-file-contents-literally path nil 0 chunk-size)
      (goto-char (point-min))
      (when (re-search-forward "^0080:" nil t)
        (delete-region (line-beginning-position) (point-max)))
      (goto-char (point-min))
      (while (not (eobp))
        (when (looking-at hex-line-rx)
          (let ((addr (match-string 1))
                (content (match-string 2)))
            (let* ((addr (decode-hex-string addr))
                   (char (logior (ash (aref addr 0) 8) (aref addr 1)))
                   (bytes (decode-hex-string content))
                   (expanded (mapconcat
                              (lambda (byte)
                                (unibyte-string
                                 (if (zerop (logand (ash byte -7) 1)) #x00 #xFF)
                                 (if (zerop (logand (ash byte -6) 1)) #x00 #xFF)
                                 (if (zerop (logand (ash byte -5) 1)) #x00 #xFF)
                                 (if (zerop (logand (ash byte -4) 1)) #x00 #xFF)
                                 (if (zerop (logand (ash byte -3) 1)) #x00 #xFF)
                                 (if (zerop (logand (ash byte -2) 1)) #x00 #xFF)
                                 (if (zerop (logand (ash byte -1) 1)) #x00 #xFF)
                                 (if (zerop (logand byte 1)) #x00 #xFF)))
                              bytes
                              "")))
              (message "Setting %c (%d)" char (length expanded))
              (aset table char expanded))))
        (forward-line 1))
      (let ((print-escape-nonascii t)
            (print-escape-control-characters t)
            print-length
            print-level)
        (princ ";; auto-generated unifont glyphs file\n\n")
        ;; HACK: `reuse lint` considers the file dubious due to
        ;; license blurb ending in \n\n, so obfuscate it a bit
        (princ ";;\sSPDX-License-Identifier:\sGPL-2.0-or-later\n\n")
        (pp `(defconst unifont-glyph-width 8))
        (pp `(defconst unifont-glyph-height 16))
        (terpri)
        (pp `(defconst unifont-glyphs ,table))
        (terpri)
        (pp `(provide 'unifont-glyphs))
        (princ ";;; unifont-glyphs.el ends here")))))

(defun gen-unifont-glyphs-cli ()
  (when (and argv (equal (car argv) "--"))
    (pop argv))
  (when (null argv)
    (message "usage: emacs --batch -L . -l gen-unifont-glyphs \
-f gen-unifont-glyphs-cli <unifont.hex> > unifont-glyphs.el")
    (kill-emacs 1))
  (gen-unifont-glyphs (pop argv)))

(provide 'gen-unifont-glyphs)
;;; gen-unifont-glyphs.el ends here