-
Notifications
You must be signed in to change notification settings - Fork 0
/
render-png.lisp
89 lines (84 loc) · 4.11 KB
/
render-png.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
(defpackage :terraria-map-dump.render-png
(:nicknames :tmapdump.render-png)
(:use :common-lisp :tmapdump.color :tmapdump.map :tmapdump.tile :zpng)
(:export :biome-spread-rgba :dull-tile-rgba :render-png :treasure-rgba))
(in-package :terraria-map-dump.render-png)
(defun dull-tile-rgba (tile y profile)
"Renders tiles grayscale at 50% normal transparency"
(let ((color (grayscale-color
(tile-rgba tile y profile))))
(%rgba (color-r color) (color-g color) (color-b color)
(round (color-a color) 2))))
(defun biome-spread-rgba (tile y profile)
(let ((sets (when (or (typep tile 'block-tile)
(typep tile 'wall-tile))
(tile-sets tile))))
(if (or (find :corrupt sets)
(find :crimson sets)
(find :hallow sets))
(tile-raw-rgba tile y profile)
(dull-tile-rgba tile y profile))))
(defun treasure-rgba (tile y profile)
(if (and (typep tile 'block-tile)
(find (tile-id tile) (list 6 ; Iron Ore
7 ; Copper Ore
8 ; Gold Ore
9 ; Silver Ore
12 ; Crystal Heart
21 ; Chest
22 ; Demonite Ore
28 ; Pot
37 ; Meteorite
58 ; Hellstone
63 ; Sapphire
64 ; Ruby
65 ; Emerald
66 ; Topaz
67 ; Amethyst
68 ; Diamond
107 ; Cobalt Ore
108 ; Mythril Ore
111 ; Adamantite Ore
166 ; Tin Ore
167 ; Lead Ore
168 ; Tungsten Ore
169 ; Platinum Ore
178 ; Gems?
185 ; Small Pile
186 ; Large Pile
187 ; Large Pile
204 ; Crimtane Ore
211 ; Chlorophyte Ore
221 ; Palladium Ore
222 ; Orichalcum Ore
223 ; Titanium Ore
236 ; Life Fruit
239 ; Bars
330 ; Copper Coin Pile
331 ; Silver Coin Pile
332 ; Gold Coin Pile
333))); Platinum Coin Pile
(tile-raw-rgba tile y profile)
(dull-tile-rgba tile y profile)))
(defun render-png (map file-or-stream &optional (color-fn #'tile-rgba))
"Render MAP to FILE-OR-STREAM"
(etypecase file-or-stream
(pathname (with-open-file (out file-or-stream
:direction :output
:if-exists :supersede
:element-type '(unsigned-byte 8))
(render-png map out color-fn)))
(stream
(let* ((stream file-or-stream)
(data (minimap-data map))
(image (make-instance 'pixel-streamed-png
:color-type :truecolor-alpha
:width (array-dimension data 1)
:height (array-dimension data 0))))
(zpng:start-png image stream)
(dotimes (y (array-dimension data 0))
(dotimes (x (array-dimension data 1))
(let ((color (funcall color-fn (aref data y x) y (minimap-elevation-profile map))))
(write-pixel (coerce color 'list) image))))
(zpng:finish-png image))))
file-or-stream)