+ do (write-4-byte
+ (dpb (if entry
+ (aref *misc-mapping* (ucd-misc entry))
+ ;; the last entry in *MISC-TABLE* (see
+ ;; BUILD-MISC-TABLE) is special,
+ ;; reserved for the information for
+ ;; characters unallocated by Unicode.
+ (1- (length *misc-table*)))
+ (byte 11 21)
+ (if entry (ucd-transform entry) 0))
+ stream)))))))
+
+;;; KLUDGE: this code, to write out decomposition information, is a
+;;; little bit very similar to the ucd entries above. Try factoring
+;;; out the common stuff?
+(defun output-decomposition-data ()
+ (let ((hash (make-hash-table :test #'equalp))
+ (index 0))
+ (loop for page across *decomposition-base*
+ do (when page
+ (unless (gethash page hash)
+ (setf (gethash page hash)
+ (prog1 index (incf index))))))
+ (let ((array (make-array index)))
+ (maphash #'(lambda (key value)
+ (setf (aref array value) key))
+ hash)
+ (with-open-file (stream (make-pathname :name "decomp" :type "dat"
+ :defaults *output-directory*)
+ :direction :output
+ :element-type '(unsigned-byte 8)
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ (loop for page across *decomposition-base*
+ do (write-byte (if page (gethash page hash) 0) stream))
+ (loop for page across array
+ do (loop for entry across page
+ do (write-4-byte
+ (dpb (if entry (car entry) 0)
+ (byte 11 21)
+ (if entry (cdr entry) 0))
+ stream))))
+ (with-open-file (stream (make-pathname :name "ldecomp" :type "dat"
+ :defaults *output-directory*)
+ :direction :output
+ :element-type '(unsigned-byte 8)
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ (loop for code across (copy-seq *long-decompositions*)
+ do (write-4-byte code stream))))))
+
+(defun output-composition-data ()
+ #+nil ; later
+ (let (firsts seconds)
+ (flet ((frob (k v)
+ (declare (ignore v))
+ (pushnew (car k) firsts)
+ (pushnew (cdr k) seconds)))
+ (maphash #'frob *comp-table*)))
+ (with-open-file (stream (make-pathname :name "comp" :type "dat"
+ :defaults *output-directory*)
+ :direction :output
+ :element-type '(unsigned-byte 8)
+ :if-exists :supersede :if-does-not-exist :create)
+ (maphash (lambda (k v)
+ (write-4-byte (car k) stream)
+ (write-4-byte (cdr k) stream)
+ (write-4-byte v stream))
+ *comp-table*)))
+
+(defun output ()
+ (output-ucd-data)
+ (output-decomposition-data)
+ (output-composition-data)