Start work on parsing graphics.

parse-graphics.scm

+;;; Commentary:
+
+;; setup-gr-file
+;; ID_CA.C, 859
+
+;; GRHEADERLINKED assumed undefined
+
+;; GFXV_WL6.H is special constant for Wolf3d full version.
+;; GFXV_*.H is available for Wold3d shareware, as well as
+;; Spear of Destiny
+
+;;; Code:
+
+(use-modules (ice-9 format)
+
+             ((rnrs base) #:select (assert))
+             (rnrs io ports)
+             (rnrs bytevectors)
+
+             (srfi srfi-1)
+             (srfi srfi-4)              ; u16vector-ref
+             ((srfi srfi-9) #:select (define-record-type))
+             ((srfi srfi-9 gnu) #:select (set-record-type-printer!))
+             )
+
+
+(use-modules (system foreign))
+
+(define (bytevector-drop! bv count)
+  (pointer->bytevector (bytevector->pointer bv count)
+                       (- (bytevector-length bv)
+                          count)))
+
+(define-syntax-rule (begin1 first rest ...)
+  (let ((return first))
+    rest ...
+    return))
+
+
+
+
+;; @example
+;; struct huffnode {
+;;     uint16 bit0, bit1;
+;; }
+;; @end example
+;; 0-#xFF char, > ptr to node
+
+;; ID_CA.C, 387
+;; optimize-nodes not applicable,
+;; this is a "replacement"
+(define (bytevector->huff-tree bv)
+  ;; root always here, ID_CA.C, 427
+  (let loop ((idx 254))
+    ;; Doubling since we are looking at number pairs
+    (let ((idx (* idx 2)))
+      (let ((left  (u16vector-ref bv idx))
+            (right (u16vector-ref bv (1+ idx))))
+        (cons
+         (if (< left  #x100) left  (loop (- left #x100)))
+         (if (< right #x100) right (loop (- right #x100))))))))
+
+;; ID_CA.C, 418
+;; bytevector -> bytevector -> huffman-tree
+(define (huffman-expand source dest tree)
+
+  ;; Returns the next bit in from the source vector.
+  (define next-bit!
+    (let ((idx-major 0)                 ; which byte we are on
+          (idx-minor 0))                ; which bit in the byte
+      (lambda ()
+        (when (= 8 idx-minor)
+          (set! idx-minor 0)
+          (set! idx-major (1+ idx-major)))
+        (if (= idx-major (bytevector-length source))
+            #f (begin1 (logand 1 (ash (bytevector-u8-ref source idx-major)
+                                      (- idx-minor)))
+                       (set! idx-minor (1+ idx-minor)))))))
+
+  ;; Sets the next byte in the destination.
+  (define set-byte!
+    (let ((oidx 0))
+      (lambda (b)
+        (bytevector-u8-set! dest oidx b)
+        (set! oidx (1+ oidx)))))
+
+  ;; 1 => left
+  ;; 0 => right
+  (let ((subtree tree)
+        (bit #f))
+    (while (begin (set! bit (next-bit!)) bit)
+      (let ((node ((if (= 1 bit) car cdr) subtree)))
+        (if (pair? node)
+            ;; continue down
+            (set! subtree node)
+            (begin                      ; restart from top
+              (set-byte! node)
+              (set! subtree tree)))))))
+
+
+
+
+
+;; 255 huffnodes, total size 1024 bytes
+;; ID_CA.C, 888
+(define (read-huff-file file)
+  (bytevector->huff-tree
+   (call-with-input-file file
+     get-bytevector-all #:binary #t)))
+
+
+
+;; #ifdef THREE_BYTE_GR_STARTS
+(define FILEPOSSIZE 3)
+
+;; verkar även finnas speciella för Spear of Destiny
+
+(define NUMCHUNKS 149)                  ; GFXV_WL6.H, 183
+(define NUMPICS 132)                    ; GFXV_WL6.H
+(define STRUCTPIC 0)                    ; GFXV_WL6.H, 199
+(define STARTTILE8 135)                 ; GFXV_WL6.H, 206
+(define STARTEXTERNS 136)               ; GFXV_WL6.H, 212
+
+
+
+
+;; ID_CA.C, 132
+(define (3-byte-word-ref bv idx)
+  "(gr-file-pos gr-starts)"
+  (let ((mask #x00FFFFFF))
+   (cond [(logand mask
+                  (bytevector-u32-ref
+                   bv (* 3 idx)
+                   (endianness little)))
+          (lambda (v) (not (= v mask))) => identity]
+         [else -1])))
+
+
+;; ID_CA.C, 195
+;; set-up-gr-handle removed
+(define (chunk-start table idx)
+  (3-byte-word-ref table idx))
+
+(define (chunk-length table idx)
+  (- (chunk-start table (1+ idx))
+     (chunk-start table idx)))
+
+#;
+(define (set-up-gr-handle gr-starts)
+  (define start      (3-byte-word-ref gr-starts STRUCTPIC))
+  (define next-start (3-byte-word-ref gr-starts (1+ STRUCTPIC)))
+  (let ((chunk-explicit-len (-> port (get-bytevector-n 4) (s32-vector-ref 0)))
+        (chunk-comp-len (- next-start start 4)))
+
+    ;; (values chunk-explicit-len chunk-comp-len)
+    ))
+
+
+
+(define (get-gr-chunk-expanded-size chunk source)
+  (if (<= STARTTILE8 chunk (1- STARTEXTERNS))
+      (let ((BLOCK 64)
+            (MASKBLOCK 128))
+        (cond [(< chunk STARTTILE8M)  (* BLOCK NUMTILES)]
+              [(< chunk STARTTILE16)  (* MASKBLOCK NUMTILES)]
+              [(< chunk STARTTILE16M) (* BLOCK 4)]
+              [(< chunk STIRTTILE32)  (* MASKBLOCK 4)]
+              [[< chunk STARTTILE32M] (* BLOCK 16)]
+              [else (* MASKBLOCK 16)]))
+      (begin1
+       (bytevector-u32-ref source 0 (endianness little))
+       (bytevector-drop! source 4))))
+
+;; ID_CA.C, 1261
+;; int, bytevector ->
+(define (expand-gr-chunk chunk source)
+  (let ((expanded-size (get-gr-chunk-expanded-size chunk source)))
+    (let ((dest (make-bytevector expanded-size)))
+      (huffman-expand source dest huff-tree)
+      dest)))
+
+;; ID_CA.C, 1318
+;; TODO rework this into being sencible, it's mostly a loading routine
+;; since caching is done in a completely different way
+(define (cache-gr-chunk idx)
+
+  ;; TODO skip sparse tiles, ID_CA.C, 1341
+  (define compressed-size (- (gr-file-pos gr-starts (1+ idx))
+                             (gr-file-pos gr-starts idx)))
+
+  (seek gr-handle (gr-file-pos gr-starts idx) SEEK_SET)
+  (expand-gr-chunk idx (get-bytevector-n gr-handle compressed-size)))
+
+
+
+;;; main
+
+(chdir "/home/hugo/wolf/full/")
+
+;; read and build the huffman tree
+(define huff-tree (read-huff-file "VGADICT.WL6"))
+
+
+;; uint24 list
+;; offsets into ega-graph for where images are?
+;; gr-starts
+
+;; read the table off offsets into the data
+(define chunk-table
+  (call-with-input-file "VGAHEAD.WL6"
+    get-bytevector-all #:binary #t))
+
+;; Size depends on version of game?
+;; should in this case be
+(* FILEPOSSIZE (1+ NUMCHUNKS))
+;; => 450
+
+;; open the actual input file
+(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))
+
+;; @example
+;; struct pictabletype {
+;;     sint16 width, height;
+;; }
+;; @end example
+
+;; ID_CA.C, 928
+(define pictable
+  (let* ((size (* NUMPICS 2 2))
+         (dest (make-bytevector size)))
+    (assert (= structpic-size size))
+    (huffman-expand (get-bytevector-n gr-handle (- (chunk-length chunk-table STRUCTPIC) 4))
+                    dest huff-tree)
+    dest))
+
+(define piclist
+ (bytevector->sint-list pictable (endianness little) 2))
+;; 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)