parse-map.scm 3.06 KB
Newer Older
Hugo Hörnquist's avatar
Hugo Hörnquist committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
(use-modules (system foreign)
             (ice-9 binary-ports)
             (ice-9 iconv)
             (rnrs bytevectors)
             (srfi srfi-1)
             (srfi srfi-9)
             )


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

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

(define NUMMAPS 60)
(define MAPPLANES 2)


(chdir "/home/hugo/wolf/WOLF3D/")

(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* (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)))
    #:binary #t))

(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 i)
        (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)))))
               ))))
      (cadr maphead)
      (iota NUMMAPS)))
   #: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)))