Skip to content
Snippets Groups Projects
Commit 3a59f6a3 authored by Hugo Hörnquist's avatar Hugo Hörnquist
Browse files

Introduce threading macro.

parent a1e5f5c4
No related branches found
No related tags found
No related merge requests found
......@@ -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))))
(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))))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment