Commit 9e7e57ae authored by Hugo Hörnquist's avatar Hugo Hörnquist

Further work on map parsing.

parent 6422fc42
(use-modules (system foreign)
(ice-9 binary-ports)
(ice-9 iconv)
(rnrs base)
(rnrs bytevectors)
(srfi srfi-1)
(srfi srfi-4)
......@@ -47,11 +48,11 @@
(define maphead
(call-with-input-file "MAPHEAD.WL1"
(lambda (port)
(make-maphead (u16vector-ref (get-bytevector-n port 2) 0)
(make-maphead (u16vector-ref (get-bytevector-n port 2) 0)
(u32vector->list (get-bytevector-all port))))
#:binary #t))
(= #xABCD (get-rlew maphead))
(assert (= #xABCD (get-rlew maphead)))
(define maptype
(list (make-list 3 long) ; planestart
......@@ -79,10 +80,14 @@
(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))))
(list-head ; planestart
(u32vector->list
(get-bytevector-n port (* 3 (sizeof long))))
MAPPLANES)
(list-head ; planelength
(u16vector->list
(get-bytevector-n port (* 3 (sizeof unsigned))))
MAPPLANES)
(u16vector-ref (get-bytevector-n port (sizeof unsigned)) 0) ; width
(u16vector-ref (get-bytevector-n port (sizeof unsigned)) 0) ; height
(string-filter ; name
......@@ -93,18 +98,109 @@
(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)))
(for-each (lambda (m)
(assert (= 64 (get-width m) (get-height m))))
maps)
(define neartag #xa7)
(define fartag #xa8)
(define end (endianness little))
;; ID_CA.C, 609
;; bytevector x int -> bytevector
(define (carmak-expand source expanded-length)
(let ((dest (make-bytevector expanded-length)))
(let loop ((length (floor/ expanded-length 2))
(iidx 0)
(oidx 0))
(unless (zero? length)
;; bytevector-{}-ref takes bytes from start, NOT word with
(format #t "A iidx = ~s length = ~s, bvlen = ~s~%" iidx length (bytevector-length source))
(let* ((ch (bytevector-u16-ref source iidx (endianness little)))
(ch-high (ash ch -8))
(count (logand ch #xFF)))
(if (zero? count)
;; special case for literal a7 and a8
(begin (u16vector-set! dest oidx
(logior ch (bytevector-u8-ref source (+ 2 iidx))))
(loop (1- length)
(+ iidx 3)
(1+ oidx)))
(cond
[(= ch-high neartag)
(bytevector-copy! dest (- oidx (bytevector-u8-ref source (+ 2 iidx)))
dest (* 2 oidx)
(* 2 count))
(loop (- length count)
(+ iidx 3)
(+ oidx count))]
[(= ch-high fartag)
(format #t "B ~s~%" iidx)
(let ((offset (bytevector-u16-ref source (+ 2 iidx) (endianness little))))
(bytevector-copy! dest (* 2 offset) dest (* 2 oidx) (* 2 count))
(loop (- length count)
(+ iidx 4)
(+ oidx count)))]
[else
(u16vector-set! dest oidx ch)
(loop (1- length)
(+ iidx 2)
(1+ oidx))])))))
dest))
;; ID_CA.C, 734
(define (rlew-expand source expanded-length rlew-tag)
(let ((dest (make-bytevector expanded-length)))
))
(call-with-input-file "GAMEMAPS.WL1"
(lambda (port)
(let ((m (car maps)))
(map (lambda (pos compressed)
(seek port pos SEEK_SET) ; ID_CA.C, 1454
(let ((expanded (u16vector-ref (get-bytevector-n port 2) 0)))
;; CAL_CarmakExpand, 1464
(carmak-expand (get-bytevector-n port (- compressed 0)) ;
expanded)
;; CA_RLEWexpand
))
(list-head (get-planestart m) 1)
(list-head (get-planelength m) 1))))
#:binary #t)
;; => (3190 1128)
(map hex (get-planestart (car maps)))
;; => ("b" "5a5")
;; => ("b" "5a5" "8c0")
(get-planelength (car maps))
;; => (1434 795)
(map hex (get-planelength (car maps)))
;; => ("59a" "31b")
;; => ("59a" "31b" "a")
(define expanded '(3190 1128 8))
expanded ; => (3190 1128 8)
(map hex expanded)
;; => ("c76" "468" "8")
;; => (3190 1128 8)
e ; => (536874102 536872040 536870920)
(map hex e) ; => ("200|00c76" "200|00468" "2000|0008")
;; => (536874102 536872040 536870920)
;; => (("2000|0c76") ("20000468") ("20000008"))
;;(map hex )
;; => ("59a" "31b" "a")
(car maps)
;; => #<<maptype> planestart: (11 1445 2240) planelength: (1434 795 10) width: 64 height: 64 name: "Wolf1 Map1">
maphead ; => #<<maphead> RLEW: #xABCD, offsets: (#x08CA #x169F #x23CB #x3140 #x3E2C #x47C8 #x514A #x5B86 #x5E38 #x6AF7)>
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment