Further work on parsing graphics. Add huff->dot.

parse-graphics.scm

@@ -31,6 +31,7 @@
                        (- (bytevector-length bv)
                           count)))
 
+;; taken from Common Lisp
 (define-syntax-rule (begin1 first rest ...)
   (let ((return first))
     rest ...
@@ -109,6 +110,22 @@
      get-bytevector-all #:binary #t)))
 
 
+(define (huff-tree->graphviz huff-tree port)
+  (format port "digraph {~%")
+  (let loop ((tree huff-tree)
+             (path ""))
+    (let ((name (gensym)))
+      (if (pair? tree)
+          (let ((child-0 (loop (car tree) (string-append path "0")))
+                (child-1 (loop (cdr tree) (string-append path "1"))))
+            (format port "\"~a\" [label=\"\", color=gray];~%" name)
+            (format port "\"~a\" -> \"~a\" [label=~a0];~%" name child-0 path)
+            (format port "\"~a\" -> \"~a\" [color=red, label=~a1];~%" name child-1 path)
+            )
+          (format port "\"~a\" [label=~a];" name tree))
+      name))
+  (format port "}~%"))
+
 
 ;; #ifdef THREE_BYTE_GR_STARTS
 (define FILEPOSSIZE 3)
@@ -223,6 +240,7 @@
 (chdir "/home/hugo/wolf/full/")
 
 ;; read and build the huffman tree
+;; ID_CA.C, 887
 (define huff-tree (read-huff-file "VGADICT.WL6"))
 
 
@@ -232,7 +250,9 @@
 
 ;; read the table off offsets into the data
 ;; in VGAGRAPH.
-(define chunk-table
+;; TODO why not gr-starts?
+;; ID_CA.C, 893
+(define gr-starts
   (call-with-input-file "VGAHEAD.WL6"
     get-bytevector-all #:binary #t))
 
@@ -241,11 +261,31 @@
 (* FILEPOSSIZE (1+ NUMCHUNKS))
 ;; => 450
 
+(define gr-file-pos
+ (map (lambda (i)
+        (chunk-start gr-starts i))
+      (iota (- (/ (bytevector-length gr-starts) 3)
+               2))))
+
 ;; open the actual graphics file
+;; ID_CA.C, 915
 (define gr-handle (open-input-file "VGAGRAPH.WL6" #:binary #t))
 ;; seek to start of STRUCTPIC (usually 0)
-(seek gr-handle (chunk-start chunk-table STRUCTPIC) SEEK_SET)
-(define structpic-size (u32vector-ref (get-bytevector-n gr-handle 4) 0))
+;; (seek gr-handle (chunk-start chunk-table STRUCTPIC) SEEK_SET)
+(seek gr-handle (list-ref gr-file-pos STRUCTPIC) SEEK_SET)
+(define structpic-size (s32vector-ref (get-bytevector-n gr-handle 4) 0))
+(define chunk-compressed-length
+  (- (list-ref gr-file-pos (1+ STRUCTPIC))
+     (list-ref gr-file-pos STRUCTPIC)
+     4))
+
+(define compressed-data (get-bytevector-n gr-handle chunk-compressed-length))
+
+(define dest-bv (make-bytevector structpic-size))
+;; Huff-expand fails, it REALLY shouldn't
+(huffman-expand compressed-data dest-bv huff-tree)
+
+
 
 ;; @example
 ;; struct pictabletype {
@@ -296,26 +336,3 @@
 
 ;; this looks far from good
 ;; => (41 7192 -26214 7453 7709 4608 19753 7453 13086 2048 25856 23016 23016 11234 -8919 13056 11550 10537 28416 -26643 200 11752 41 -5502 5916 7453 0 12288 -7168 5916 7453 12303 19 41 10541 4937 10496 11520 18729 18761 18761 18761 -25088 0 6626 13056 2078 18729 2078 18729 -7650 10541 -13056 10541 -13056 10541 -13056 10541 -13056 10541 -13056 10541 -26861 10623 32617 41 24296 15 41 21992 21986 6626 1821 -26214 15 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 16279 5916 32663 48 -25639 25615 25615 18703 9472 -8960 10745 2048 7680 7704 18703 22016 37 6174 6400 7465 205 10649 11550 41 11725 41 11725 41 11725 41 -26879 7231 -26857 12415 256 16279 5916 32663 48 -26879 7231 -26857 12415 256 16279 5916 32663 48 -26879 7231 23 -18135 19 41 10541 4937 10496 11520 18729 19 41 10541 4937 10496 11520 18729 19 41 10541 4937 10496 11520 18729 19 41 10541 4937 10496 11520 18729 19 41 10541 4937 10496 11520 18729 19 41 10541 4937 10496 16384 10623 24832 7465 31458 -5888 107 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
-
-(define-syntax-rule (comment c ...) #f)
-
-(comment
- (begin
-   (sdl-init)
-   (define w (make-window))
-   (define r (make-renderer w))
-
-   (let ((x 0)
-         (y 0))
-     (for-each (lambda (c)
-                 (apply set-render-draw-color r c)
-                 (render-draw-point r x y)
-                 (set! x (1+ x))
-                 (when (= x 48)
-                   (set! x 0)
-                   (set! y (1+ y))))
-               colors)
-     (format #t "~ax~a~%" x y))
-   (present-renderer)
-   ))
-;; => #t