Commit 6422fc42 authored by Hugo Hörnquist's avatar Hugo Hörnquist

Clean up existing parts of map parser.

parent 55f103e4
......@@ -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
(define long int32)
(define unsigned uint16)
(define int int16)
(define char uint8)
(begin
(define long int32)
(define unsigned uint16)
(define int int16)
(define char uint8)
(define NUMMAPS 60)
(define MAPPLANES 2)
(define NUMMAPS 60)
(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)))
......
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