Commit aed5a2fe authored by Hugo Hörnquist's avatar Hugo Hörnquist

Made parse-map nicer to read.

parent 3a59f6a3
......@@ -26,9 +26,6 @@
;; Util
(define (hex a)
(format #f "~:@(~4,'0x~)" a))
(define (cross-product l1 l2)
(concatenate
(map (lambda (a)
......@@ -83,8 +80,7 @@
<maphead>
(lambda (r p)
(format p "#<<maphead> RLEW: #x~:@(~x~), offsets: (~{#x~:@(~4,'0x~)~^ ~})>"
(get-rlew r)
(take-while (negate zero?) (get-offsets r)))))
(get-rlew r) (get-offsets r))))
;; @example
;; struct maptype {
......@@ -120,35 +116,36 @@
(unless (zero? length)
;; bytevector-{}-ref takes bytes from start, NOT word with
(let* ((ch (bytevector-u16-ref source iidx (endianness little)))
(ch-high (ash ch -8))
(count (logand ch #xFF)))
(cond [(memv ch-high (list neartag fartag))
(cond [(zero? count)
;; special case for literal a7 and a8
(u16vector-set! dest oidx
(logior ch (bytevector-u8-ref source (+ 2 iidx))))
(loop (1- length)
(+ iidx 3)
(1+ oidx))]
[(= ch-high neartag)
(bytevector-copy! dest (* 2 (- oidx (bytevector-u8-ref source (+ 2 iidx))))
dest (* 2 oidx)
(* 2 count))
(loop (- length count)
(+ iidx 3)
(+ oidx count))]
[(= ch-high fartag)
;; bytevector-copy! :: source source-start target target-start len
(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))]))))
(ch-high (ash ch -8)))
(if (memv ch-high (list neartag fartag))
(let ((count (logand ch #xFF)))
(if (zero? count)
(let ((ch (logior ch (bytevector-u8-ref source (+ 2 iidx)))))
;; special case for literal a7 and a8
(u16vector-set! dest oidx ch)
(loop (1- length) (+ iidx 3) (1+ oidx)))
;; else
(let* ((l (if (= ch-high neartag) 1 2))
(offset-base (bytevector-uint-ref source (+ 2 iidx)
(endianness little)
l))
(offset (if (= ch-high neartag)
(- oidx offset-base)
offset-base)))
(bytevector-copy! dest (* 2 offset)
dest (* 2 oidx) (* 2 count))
(loop (- length count)
(+ iidx 2 l)
(+ oidx count)))))
;; else
(begin
(u16vector-set! dest oidx ch)
(loop (1- length) (+ iidx 2) (1+ oidx)))))))
;; return
dest))
......@@ -157,20 +154,16 @@
(define* (rlew-expand source #:optional (rlew-tag #xABCD))
"If car = #xABCD, repeat the next next value next number times.
else insert the value as given"
(let loop ((done '())
(rem source))
(cond [(null? rem)
(concatenate (reverse done))]
(let loop ((rem source))
(cond [(null? rem) '()]
[(= rlew-tag (car rem))
(let ((count (cadr rem))
(value (caddr rem))
(rest (cdddr rem)))
(loop (cons (make-list count value) done)
rest))]
[else (loop (cons (list (car rem)) done)
(cdr rem))])))
(append! (make-list count value)
(loop rest)))]
[else (cons (car rem)
(loop (cdr rem)))])))
;; WL_GAME.C, 663
......@@ -215,7 +208,6 @@ else insert the value as given"
(-> port (get-bytevector-n 2) (u16vector-ref 0)) ; width
(-> port (get-bytevector-n 2) (u16vector-ref 0)) ; height
(-> port (get-bytevector-n 16) bytevector->c-string) ; name
;; (bytevector->string (get-bytevector-n port 4) "ASCII") ; "!ID!"
))))
(get-offsets maphead)))
......@@ -253,9 +245,9 @@ else insert the value as given"
#t map-metadata))
(map (lambda (m) (parse-map-data m port))
map-metadata)))
(list (car map-metadata)))))
#:binary #t)))
(assert (= #xABCD (get-rlew maphead)))
(display-tilemap (tile-list->tilemap (car (caddr mapdata))))))
(display-tilemap (tile-list->tilemap (car (car mapdata))))))
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