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

Clean up existing parts of map parser.

parent 55f103e4
Branches
Tags
No related merge requests found
......@@ -3,7 +3,9 @@
(ice-9 iconv)
(rnrs bytevectors)
(srfi srfi-1)
(srfi srfi-4)
(srfi srfi-9)
(srfi srfi-9 gnu)
)
......@@ -11,40 +13,46 @@
;;; long => 4
;;; int => 2
(begin
(define long int32)
(define unsigned uint16)
(define int int16)
(define char uint8)
(define NUMMAPS 60)
(define MAPPLANES 2)
(define MAPPLANES 2))
(chdir "/home/hugo/wolf/WOLF3D/")
(chdir "/home/hugo/wolf3d/WOLF3D-D/")
(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-record-type <maphead>
(make-maphead rlew headeroffsets)
maphead?
(rlew get-rlew)
(headeroffsets get-offsets))
(set-record-type-printer!
<maphead>
(lambda (r p)
(format p "#<<maphead> RLEW: #x~:@(~x~), offsets: (~{#x~:@(~4,'0x~)~^ ~})>"
(get-rlew r)
(take-while (negate zero?) (get-offsets r)))))
(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)))
(make-maphead (u16vector-ref (get-bytevector-n port 2) 0)
(u32vector->list (get-bytevector-all port))))
#:binary #t))
(= #xABCD (get-rlew maphead))
(define maptype
(list (make-list 3 long) ; planestart
(make-list 3 unsigned) ; planelength
......@@ -66,25 +74,23 @@
(call-with-input-file "GAMEMAPS.WL1"
(lambda (port)
(filter-map
(lambda (pos i)
(lambda (pos)
(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)))))
(u32vector->list ; planestart
(get-bytevector-n port (* 3 (sizeof long))))
(u16vector->list ; planelength
(get-bytevector-n port (* 3 (sizeof unsigned))))
(u16vector-ref (get-bytevector-n port (sizeof unsigned)) 0) ; width
(u16vector-ref (get-bytevector-n port (sizeof unsigned)) 0) ; height
(string-filter ; name
(bytevector->string (get-bytevector-n port 16) "ASCII")
(lambda (c) (not (eq? c #\nul))))
;; (bytevector->string (get-bytevector-n port 4) "ASCII") ; "!ID!"
))))
(cadr maphead)
(iota NUMMAPS)))
(get-offsets maphead)))
#:binary #t))
(let ((m (car maps)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment