Commit 9f4135a8 authored by Hugo Hörnquist's avatar Hugo Hörnquist

Finnally fixed carmack-expand.

parent 47536147
......@@ -7,30 +7,26 @@
(srfi srfi-4)
(srfi srfi-9)
(srfi srfi-9 gnu)
(srfi srfi-26)
(srfi srfi-71)
)
;;; sizeof:
;;; long => 4
;;; int => 2
(begin
(define long int32)
(define unsigned uint16)
(define int int16)
(define char uint8)
(define MAPPLANES 2)
(define NUMMAPS 60)
(define MAPPLANES 2))
(define (hex a)
(format #f "~:@(~4,'0x~)" a))
(chdir "/home/hugo/wolf3d/WOLF3D-D/")
(define mapfiletype
(list unsigned ; RLEWtag
(make-list 100 long) ; headeroffsets
))
(chdir "/home/hugo/wolf/full/")
;; @example
;; struct mapfiletype {
;; uint16_t RLEWtag;
;; uint32_t headeroffsets[100];
;; }
;; @end example
(define-record-type <maphead>
(make-maphead rlew headeroffsets)
maphead?
......@@ -44,9 +40,8 @@
(get-rlew r)
(take-while (negate zero?) (get-offsets r)))))
(define maphead
(call-with-input-file "MAPHEAD.WL1"
(call-with-input-file "MAPHEAD.WL6"
(lambda (port)
(make-maphead (u16vector-ref (get-bytevector-n port 2) 0)
(u32vector->list (get-bytevector-all port))))
......@@ -54,13 +49,14 @@
(assert (= #xABCD (get-rlew maphead)))
(define maptype
(list (make-list 3 long) ; planestart
(make-list 3 unsigned) ; planelength
unsigned unsigned ; width, height
(make-list 16 char))) ; name
;; @example
;; struct maptype {
;; uint32_t planestart[3];
;; uint32_t planelength[3];
;; uint16_t width, height;
;; char name[16];
;; }
;; @end example
(define-record-type <maptype>
(make-maptype planestart planelength width height name)
maptype?
......@@ -72,7 +68,7 @@
;;; ID_CA.C, 1000
(define maps
(call-with-input-file "GAMEMAPS.WL1"
(call-with-input-file "GAMEMAPS.WL6"
(lambda (port)
(filter-map
(lambda (pos)
......@@ -101,105 +97,114 @@
(assert (= 64 (get-width m) (get-height m))))
maps)
(define neartag #xa7)
(define fartag #xa8)
(define end (endianness little))
;; ID_CA.C, 609
;; bytevector x int -> bytevector
;; bytevector, int -> bytevector
(define (carmak-expand source expanded-length)
(define neartag #xa7)
(define fartag #xa8)
(let ((dest (make-bytevector expanded-length)))
(let loop ((length (floor/ expanded-length 2))
(iidx 0)
(oidx 0))
(unless (zero? length)
;; bytevector-{}-ref takes bytes from start, NOT word with
(format #t "A iidx = ~s length = ~s, bvlen = ~s~%" iidx length (bytevector-length source))
(let* ((ch (bytevector-u16-ref source iidx (endianness little)))
(ch-high (ash ch -8))
(count (logand ch #xFF)))
(if (zero? count)
;; special case for literal a7 and a8
(begin (u16vector-set! dest oidx
(logior ch (bytevector-u8-ref source (+ 2 iidx))))
(loop (1- length)
(+ iidx 3)
(1+ oidx)))
(cond
[(= ch-high neartag)
(bytevector-copy! dest (- oidx (bytevector-u8-ref source (+ 2 iidx)))
dest (* 2 oidx)
(* 2 count))
(loop (- length count)
(+ iidx 3)
(+ oidx count))]
[(= ch-high fartag)
(format #t "B ~s~%" iidx)
(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))])))))
(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))]))))
dest))
;; ID_CA.C, 734
(define (rlew-expand source expanded-length rlew-tag)
(let ((dest (make-bytevector expanded-length)))
))
(call-with-input-file "GAMEMAPS.WL1"
(lambda (port)
(let ((m (car maps)))
(map (lambda (pos compressed)
(seek port pos SEEK_SET) ; ID_CA.C, 1454
(let ((expanded (u16vector-ref (get-bytevector-n port 2) 0)))
;; CAL_CarmakExpand, 1464
(carmak-expand (get-bytevector-n port (- compressed 0)) ;
expanded)
;; CA_RLEWexpand
))
(list-head (get-planestart m) 1)
(list-head (get-planelength m) 1))))
#:binary #t)
;; => (3190 1128)
;; ID_CA.C, 734
;; uint16-list [, uint16] -> uint16-list
(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)
(len 0))
(cond [(null? rem)
(concatenate (reverse done))]
[(= rlew-tag (car rem))
(apply (lambda (count value . rest)
(loop (cons (make-list count value) done)
rest
(+ len count)))
(cdr rem))]
[else (loop (cons (list (car rem)) done)
(cdr rem)
(+ len 1))])))
(define read-mapdata
(call-with-input-file "GAMEMAPS.WL6"
(lambda (port)
(map (lambda (m)
(map (lambda (pos compressed)
(seek port pos SEEK_SET) ; ID_CA.C, 1454
(let ((len (u16vector-ref (get-bytevector-n port 2) 0)))
(list len (get-bytevector-n port (- compressed -2)))))
(get-planestart m)
(get-planelength m)))
maps))
#:binary #t))
(map hex (get-planestart (car maps)))
;; => ("b" "5a5")
;; => ("b" "5a5" "8c0")
(define expanded
(let ((bv (apply carmak-expand (reverse (caar read-mapdata)))))
(rlew-expand (cdr (bytevector->uint-list bv (endianness little) 2)))))
(get-planelength (car maps))
;; => (1434 795)
(define (cross-product l1 l2)
(concatenate
(map (lambda (a)
(map (lambda (b) (list a b))
l2))
l1)))
(map hex (get-planelength (car maps)))
;; => ("59a" "31b")
;; => ("59a" "31b" "a")
(define AREATILE 107)
(define expanded '(3190 1128 8))
expanded ; => (3190 1128 8)
(map hex expanded)
;; => ("c76" "468" "8")
;; WL_GAME.C, 663
(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))))
tile-list
(cross-product (iota 64) (iota 64)))
tilemap))
;; => (3190 1128 8)
e ; => (536874102 536872040 536870920)
(map hex e) ; => ("200|00c76" "200|00468" "2000|0008")
(define (display-tilemap tilemap)
(format #t "~{|~{~[ ~:;#~]~}|~%~}"
(array->list tilemap)))
;; => (536874102 536872040 536870920)
;; => (("2000|0c76") ("20000468") ("20000008"))
;;(map hex )
;; => ("59a" "31b" "a")
(car maps)
;; => #<<maptype> planestart: (11 1445 2240) planelength: (1434 795 10) width: 64 height: 64 name: "Wolf1 Map1">
maphead ; => #<<maphead> RLEW: #xABCD, offsets: (#x08CA #x169F #x23CB #x3140 #x3E2C #x47C8 #x514A #x5B86 #x5E38 #x6AF7)>
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