Commit 3a59f6a3 authored by Hugo Hörnquist's avatar Hugo Hörnquist

Introduce threading macro.

parent a1e5f5c4
......@@ -42,6 +42,14 @@
(format #t "~{|~{~[ ~:;#~]~}|~%~}"
(array->list tilemap)))
(define-syntax ->
(syntax-rules ()
((-> obj)
obj)
((-> obj (func args ...) rest ...)
(-> (func obj args ...) rest ...))
((-> obj func rest ...)
(-> (func obj) rest ...))))
(define* (bytevector->c-string
bv #:key (transcoder (make-transcoder "ASCII")))
......@@ -170,9 +178,8 @@ else insert the value as given"
(define (tile-list->tilemap tile-list)
(let ((tilemap (make-array 0 64 64)))
(for-each (lambda (tile coord)
(let ((tile (logand tile #xFF)))
(when (< tile AREATILE)
(apply array-set! tilemap tile coord))))
(when (< tile AREATILE)
(apply array-set! tilemap tile coord)))
tile-list
(cross-product (iota 64) (iota 64)))
tilemap))
......@@ -197,18 +204,17 @@ else insert the value as given"
(begin
(seek port pos SEEK_SET)
(make-maptype
(list-head ; planestart
(u32vector->list
(get-bytevector-n port (* 3 4)))
MAPPLANES)
(list-head ; planelength
(u16vector->list
(get-bytevector-n port (* 3 2)))
MAPPLANES)
(u16vector-ref (get-bytevector-n port 2) 0) ; width
(u16vector-ref (get-bytevector-n port 2) 0) ; height
(bytevector->c-string (get-bytevector-n port 16))
(-> port ; planestart
(get-bytevector-n (* 3 4))
u32vector->list
(list-head MAPPLANES))
(-> port ; planelength
(get-bytevector-n (* 3 2))
u16vector->list
(list-head MAPPLANES))
(-> 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)))
......@@ -218,12 +224,13 @@ else insert the value as given"
(define (parse-map-data map-metadata port)
(map (lambda (pos compressed)
(seek port pos SEEK_SET) ; ID_CA.C, 1454
(let* ((len (u16vector-ref (get-bytevector-n port 2) 0))
(raw-bytes (get-bytevector-n port (- compressed 2))))
(let* ((cexpanded (carmack-expand raw-bytes len))
(uint-list (bytevector->uint-list cexpanded (endianness little) 2)))
(assert (= (* 2 64 64) (car uint-list)))
(rlew-expand (cdr uint-list)))))
(let ((len (u16vector-ref (get-bytevector-n port 2) 0)))
(-> port
(get-bytevector-n (- compressed 2))
(carmack-expand len)
(bytevector->uint-list (endianness little) 2)
cdr ; car contains expected size
rlew-expand)))
(get-planestart map-metadata)
(get-planelength map-metadata)))
......@@ -251,5 +258,4 @@ else insert the value as given"
(assert (= #xABCD (get-rlew maphead)))
(display-tilemap (tile-list->tilemap (car (caddr 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