Clean up existing parts of map parser.

parse-map.scm

@@ -3,7 +3,9 @@
              (ice-9 iconv)
              (rnrs bytevectors)
              (srfi srfi-1)
+             (srfi srfi-4)
              (srfi srfi-9)
+             (srfi srfi-9 gnu)
              )
 
 
@@ -11,40 +13,46 @@
 ;;; long => 4
 ;;; int  => 2
 
-(define long int32)
-(define unsigned uint16)
-(define int int16)
-(define char uint8)
+(begin
+  (define long int32)
+  (define unsigned uint16)
+  (define int int16)
+  (define char uint8)
 
-(define NUMMAPS 60)
-(define MAPPLANES 2)
+  (define NUMMAPS 60)
+  (define MAPPLANES 2))
 
 
-(chdir "/home/hugo/wolf/WOLF3D/")
+(chdir "/home/hugo/wolf3d/WOLF3D-D/")
 
 (define mapfiletype
   (list unsigned      ; RLEWtag
         (make-list 100 long)  ; headeroffsets
-        '()
         ))
 
-;;; ID_CA.C, 960
-(define* (bytevector->int bv #:key (offset 0) (width 4))
-  (reduce logior 0
-          (map (lambda (i) (ash (bytevector-u8-ref bv (+ offset i)) (* i 8)))
-               (iota width))))
+(define-record-type <maphead>
+  (make-maphead rlew headeroffsets)
+  maphead?
+  (rlew get-rlew)
+  (headeroffsets get-offsets))
+
+(set-record-type-printer!
+ <maphead>
+ (lambda (r p)
+   (format p "#<<maphead> RLEW: #x~:@(~x~), offsets: (~{#x~:@(~4,'0x~)~^ ~})>"
+           (get-rlew r)
+           (take-while (negate zero?) (get-offsets r)))))
 
-(define* (bytevector->int-list bv #:key (intwidth 4) veclen)
-  (map (lambda (i) (bytevector->int bv #:offset i #:width intwidth))
-       (iota veclen 0 intwidth)))
 
 (define maphead
   (call-with-input-file "MAPHEAD.WL1"
     (lambda (port)
-      (list (bytevector->int (get-bytevector-n port 2) #:width 2)
-            (bytevector->int-list (get-bytevector-all port) #:veclen 100)))
+      (make-maphead (u16vector-ref (get-bytevector-n port 2) 0)
+                    (u32vector->list (get-bytevector-all port))))
     #:binary #t))
 
+(= #xABCD (get-rlew maphead))
+
 (define maptype
   (list (make-list 3 long)              ; planestart
         (make-list 3 unsigned)          ; planelength
@@ -66,25 +74,23 @@
  (call-with-input-file "GAMEMAPS.WL1"
    (lambda (port)
      (filter-map
-      (lambda (pos i)
+      (lambda (pos)
         (if (= pos 0) #f
             (begin
               (seek port pos SEEK_SET)
-              ;; planestart
               (make-maptype
-               (bytevector->int-list (get-bytevector-n port (* 3 (sizeof long)))
-                                     #:veclen 3)
-               (bytevector->int-list (get-bytevector-n port (* 3 (sizeof unsigned)))
-                                     #:veclen 3 #:intwidth 2)
-               (bytevector->int (get-bytevector-n port (sizeof unsigned))
-                                #:width 2)
-               (bytevector->int (get-bytevector-n port (sizeof unsigned))
-                                #:width 2)
-               (map integer->char
-                    (bytevector->u8-list (get-bytevector-n port (* 16 (sizeof char)))))
+               (u32vector->list         ; planestart
+                (get-bytevector-n port (* 3 (sizeof long))))
+               (u16vector->list         ; planelength
+                (get-bytevector-n port (* 3 (sizeof unsigned))))
+               (u16vector-ref (get-bytevector-n port (sizeof unsigned)) 0) ; width
+               (u16vector-ref (get-bytevector-n port (sizeof unsigned)) 0) ; height
+               (string-filter           ; name
+                (bytevector->string (get-bytevector-n port 16) "ASCII")
+                (lambda (c) (not (eq? c #\nul))))
+               ;; (bytevector->string (get-bytevector-n port  4) "ASCII") ; "!ID!"
                ))))
-      (cadr maphead)
-      (iota NUMMAPS)))
+      (get-offsets maphead)))
    #:binary #t))
 
 (let ((m (car maps)))