(defun mkfont (fname ofname)
  
  (with-open-file (r fname :direction :input)

    (let ((lx nil)
          (width 0)
          (height 0)
          (nexpos 0)
          (iacc "")
          (widchr 0)
          (chrmat nil))

      (setf lx (read-line r nil 'eof))
      (setf lx (read-line r nil 'eof))

      (multiple-value-setq (width nexpos) (read-from-string lx nil 'eof :start 0))
      (multiple-value-setq (height nexpos) (read-from-string lx nil 'eof :start nexpos))

      (format t "~A ~A~%" width height)

      (loop
       with line = nil
     
       while (not (eq (setf line (read-line r nil 'eof)) 'eof)) do

       (setf iacc (concatenate 'string iacc line)))
      
      (setf widchr (/ width 8))
      (setf chrmat (make-array (list height widchr) :initial-element 0))

      (loop

       for i from 0 to (- height 1) do

       (loop
        with bytepos = 0

        for j from 0 to (- widchr 1) do

        (setf bytepos (+ (* j 8) (* i width)))

        (loop 
         for bitpos from 0 to 7 do

         (if (eq (elt iacc (+ bitpos bytepos)) #\1)

             (setf (aref chrmat i j) (+ (aref chrmat i j) (expt 2 (- 7 bitpos))))))))

      (with-open-file (p ofname :direction :output :if-exists :supersede)

        (loop
         with cntx = 0
         with cntl = 0
         with outstr = ""
         
         for j from 0 to (- widchr 1) do

         (loop
          with outval = 0

          for i from 0 to (- height 1) do

          (setf outval (aref chrmat i j))
          (setf cntx (1+ cntx))
          (setf outstr (concatenate 'string (format nil "~16R~16R" (floor (/ outval 16)) (mod outval 16)) outstr))
          (if (= 0 (mod cntx 32))
              (progn (format p "INIT_~16R~16R = ~A~%" (floor (/ cntl 16)) (mod cntl 16) outstr)
                (setf cntl (1+ cntl)) (setf outstr "")))))))))