parse-map.scm

(use-modules (system foreign)
             (ice-9 binary-ports)
             (ice-9 iconv)
             (rnrs bytevectors)
             (srfi srfi-1)
             (srfi srfi-4)
             (srfi srfi-9)
             (srfi srfi-9 gnu)
             )


;;; sizeof:
;;; long => 4
;;; int  => 2

(begin
  (define long int32)
  (define unsigned uint16)
  (define int int16)
  (define char uint8)

  (define NUMMAPS 60)
  (define MAPPLANES 2))


(chdir "/home/hugo/wolf3d/WOLF3D-D/")

(define mapfiletype
  (list unsigned      ; RLEWtag
        (make-list 100 long)  ; headeroffsets
        ))

(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 maphead
  (call-with-input-file "MAPHEAD.WL1"
    (lambda (port)
      (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
        unsigned unsigned               ; width, height
        (make-list 16 char)))           ; name


(define-record-type <maptype>
  (make-maptype planestart planelength width height name)
  maptype?
  (planestart  get-planestart)
  (planelength get-planelength)
  (width       get-width)
  (height      get-height)
  (name        get-name))

;;; ID_CA.C, 1000
(define maps
 (call-with-input-file "GAMEMAPS.WL1"
   (lambda (port)
     (filter-map
      (lambda (pos)
        (if (= pos 0) #f
            (begin
              (seek port pos SEEK_SET)
              (make-maptype
               (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!"
               ))))
      (get-offsets maphead)))
   #:binary #t))

(let ((m (car maps)))
 (map (lambda (plane)
        (let ((pos (list-ref (get-planestart m) plane))
              (compressed (list-ref (get-planelength m) plane)))
          (call-with-input-file "GAMEMAPS.WL1"
            (lambda (port)
              (seek port pos SEEK_SET)
              (let ((source (get-bytevector-n port compressed)))
                (let ((expanded (bytevector->int source)))
                  ;; ID_CA.C, 1474
                  ;; aaaaahhhhhh
                  )
                ))
            #:binary #t)))
      (iota MAPPLANES)))