-
Notifications
You must be signed in to change notification settings - Fork 0
/
map.lisp
96 lines (92 loc) · 4.14 KB
/
map.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
(defpackage :terraria-map-dump.map
(:nicknames :tmapdump.map)
(:use :common-lisp :deflate :flex :tmapdump.binary-reader :tmapdump.tile)
(:export :minimap :minimap-data :minimap-elevation-profile
:minimap-file-revision :minimap-game-release :minimap-world-name
:minimap-world-id :read-map))
(in-package :terraria-map-dump.map)
(defstruct minimap
"Minimap information"
(game-release 0 :type (unsigned-byte 32) :read-only t)
(file-revision 0 :type (unsigned-byte 32) :read-only t)
(world-name "" :type string :read-only t)
(world-id 0 :type (unsigned-byte 32) :read-only t)
(elevation-profile nil :type elevation-profile)
(data #2A() :type (array tile 2) :read-only t))
(defmacro with-inflated-stream ((inflated deflated) &body body)
"Execute BODY with decompressed data from DEFLATED available from INFLATED"
(let ((intermediate-stream-name (gensym)))
`(with-input-from-sequence
(,inflated
(with-output-to-sequence
(,intermediate-stream-name)
(inflate-stream ,deflated ,intermediate-stream-name)))
,@body)))
(defun read-map-data (stream h w)
(let ((result (make-array (list h w)
:initial-element (make-empty-tile)
:element-type 'tile)))
(with-inflated-stream
(data stream)
(dotimes (y h)
(let ((x 0))
(loop
(loop for tile in (read-tiles data)
do (setf (aref result y x) tile) (incf x))
(assert (<= x w))
(when (= x w) (return)))))
(assert (null (read-byte data nil))))
result))
(defun read-map (stream-or-filename &optional (read-game-info-p t))
"Read a MINIMAP from STREAM-OR-FILENAME"
(etypecase stream-or-filename
(pathname (with-open-file (in stream-or-filename
:if-does-not-exist :error
:element-type '(unsigned-byte 8))
(read-map in read-game-info-p)))
(stream
(let* ((stream stream-or-filename)
(game-release (read-le stream 4))
(magic-code (read-le stream 8))
(file-revision (read-le stream 4))
(file-favorite-p (plusp (read-le stream 8)))
(world-name (read-string stream))
(world-id (read-le stream 4))
(height (read-le stream 4))
(width (read-le stream 4))
(tile-tc (read-le stream 2))
(wall-tc (read-le stream 2))
(fluid-tc (read-le stream 2))
(sky-tc (read-le stream 2))
(dirt-tc (read-le stream 2))
(rock-tc (read-le stream 2))
(not-one-tile-oc-p (read-bit-vector stream tile-tc))
(not-one-wall-oc-p (read-bit-vector stream wall-tc))
(tile-oc (make-array (list tile-tc)
:element-type '(unsigned-byte 8)
:initial-element 1))
(wall-oc (make-array (list wall-tc)
:element-type '(unsigned-byte 8)
:initial-element 1)))
; TODO Validate header
(declare (ignore magic-code file-favorite-p fluid-tc sky-tc dirt-tc rock-tc))
(loop for i upfrom 0
for not-one-p across not-one-tile-oc-p
when (plusp not-one-p) do (setf (elt tile-oc i)
(read-le stream 1)))
(loop for i upfrom 0
for not-one-p across not-one-wall-oc-p
when (plusp not-one-p) do (setf (elt wall-oc i)
(read-le stream 1)))
(when read-game-info-p
(set-game-info game-release))
(make-minimap
:game-release game-release
:file-revision file-revision
:world-name world-name
:world-id world-id
:elevation-profile (let ((surface (* height 0.3)))
(make-elevation-profile
:world-surface (round surface)
:rock-layer (round (+ surface (* height 0.2)))))
:data (read-map-data stream height width))))))