day14.ps (7306B)
1 %!PS 2 % 3 % Copyright (c) 2022, Natacha Porté 4 % 5 % Permission to use, copy, modify, and distribute this software for any 6 % purpose with or without fee is hereby granted, provided that the above 7 % copyright notice and this permission notice appear in all copies. 8 % 9 % THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 % WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 % MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 % ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 % WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 % ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 % OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 % 17 % Usage: 18 % gs -q- -sDEVICE=png16m -o- day14.ps <day14.txt | display 19 20 /apop { 21 aload length 1 sub array astore exch 22 } bind def 23 24 % x y -> valid? 25 /xy-valid? { 26 % x y 27 1 index min-x ge 28 % x y x≥min-x 29 2 index max-x le and 30 % x y x-valid? 31 1 index min-y ge 32 % x y x-valid? y≥min-y 33 2 index max-y le and 34 % x y x-valid? y-valid? 35 and 36 % x y valid? 37 3 1 roll pop pop 38 % valid? 39 } bind def 40 41 % composite x y -> element 42 /getxy { 43 2 copy xy-valid? not { min-x min-y max-x max-y 1.125 pstack quit } if 44 % composite x y 45 min-y sub width mul add min-x sub 46 % composite offset 47 get 48 } bind def 49 50 % composite x y element -> 51 /putxy { 52 3 copy pop xy-valid? not { min-x min-y max-x max-y 2.125 pstack quit } if 53 % compose x y element 54 3 1 roll 55 % compose element x y 56 min-y sub width mul add min-x sub 57 % compose element offset 58 exch put 59 } bind def 60 61 % source dest -> delta 62 /get-delta { 63 2 copy eq 64 { pop pop 0 } 65 { lt { 1 } { -1 } ifelse } 66 ifelse 67 } bind def 68 69 /datafile (%stdin) (r) file def 70 /stderr (%stderr) (w) file def 71 72 % (X,Y) -> [X Y] 73 /parse-point { 74 % (X,Y) 75 (,) search 76 not { 3.125 pstack quit } if 77 % (Y) (,) (X) 78 exch pop 79 % (Y) (X) 80 cvi exch cvi 81 % X Y 82 2 array astore 83 % [X Y] 84 } bind def 85 86 /data [ 87 { 88 datafile 300 string readline 89 not { pop exit } if 90 % line 91 [ exch { 92 % mark prev-points (suffix) 93 ( -> ) search 94 { % mark prev-points (next-suffix) ( -> ) (point) 95 exch pop 96 % mark prev-points (next-suffix) (point) 97 parse-point 98 % mark prev-points (next-suffix) point 99 exch 100 % mark prev-points point (next-suffix) 101 } 102 { % mark prev-points (point) 103 parse-point exit 104 } 105 ifelse 106 % mark prev-points point (next-suffix) 107 } loop ] 108 % point-array 109 } loop 110 ] def 111 112 /source-x 500 def 113 /source-y 0 def 114 115 source-x source-y 2 copy 116 % source-X source-Y source-X source-Y 117 data { 118 % prev-min-X prev-min-Y prev-max-X prev-max-Y points 119 { 120 % prev-min-X prev-min-Y prev-max-X prev-max-Y point 121 aload pop 122 % prev-min-X prev-min-Y prev-max-X prev-max-Y X Y 123 6 5 roll 124 % prev-min-Y prev-max-X prev-max-Y X Y prev-min-X 125 2 index 1 index lt 126 { pop 1 index } if 127 % prev-min-Y prev-max-X prev-max-Y X Y min-X 128 6 5 roll 129 % prev-max-X prev-max-Y X Y min-X prev-min-Y 130 2 index 1 index lt 131 { pop 1 index } if 132 % prev-max-X prev-max-Y X Y min-X min-Y 133 6 5 roll 134 % prev-max-Y X Y min-X min-Y prev-max-X 135 4 index 1 index gt 136 { pop 3 index } if 137 % prev-max-Y X Y min-X min-Y max-X 138 6 5 roll 139 % X Y min-X min-Y max-X prev-max-Y 140 4 index 1 index gt 141 { pop 3 index } if 142 % X Y min-X min-Y max-X max-Y 143 6 4 roll pop pop 144 % min-X min-Y max-X max-Y 145 } forall 146 } forall 147 % min-X min-Y max-X max-Y 148 /max-y exch def 149 /max-x exch def 150 /min-y exch def 151 /min-x exch def 152 /width max-x min-x sub 1 add def 153 /height max-y min-y sub 1 add def 154 155 % (map) -> 156 /dump-map { 157 % (map) 158 0 1 height 1 sub { 159 % (map) y 160 width mul 161 % (map) offset 162 1 index exch width getinterval 163 % (map) (line) 164 stderr exch writestring 165 stderr 10 write 166 % (map) 167 } for 168 } bind def 169 170 /init-map width height mul string def 171 0 1 width height mul 1 sub { 172 init-map exch 46 put % `.` 173 } for 174 data { 175 % point-list 176 apop 177 % other-points first-point 178 aload pop 3 2 roll 179 % first-X first-Y other-points 180 { 181 % prev-X prev-Y cur-point 182 aload pop 183 % prev-X prev-Y cur-X cur-Y 184 3 index 2 index get-delta 185 % prev-X prev-Y cur-X cur-Y dX 186 3 index 2 index get-delta 187 % prev-X prev-Y cur-X cur-Y dX dY 188 6 4 roll { 189 % cur-X cur-Y dX dY X Y 190 2 copy init-map 3 1 roll 191 % cur-X cur-Y dX dY X Y init-map X Y 192 35 putxy % `#` 193 % cur-X cur-Y dX dY X Y 194 5 index 2 index eq 195 % cur-X cur-Y dX dY X Y X-done? 196 5 index 2 index eq and 197 % cur-X cur-Y dX dY X Y done? 198 { exit } if 199 % cur-X cur-Y dX dY X Y 200 exch 3 index add exch 2 index add 201 % cur-X cur-Y dX dY next-X next-Y 202 } loop 203 % cur-X cur-Y dX dY cur-X cur-Y 204 pop pop pop pop 205 % cur-X cur-Y 206 } forall 207 % final-X final-Y 208 pop pop 209 } forall 210 211 /end-map init-map dup length string copy def 212 213 % init-map -> final-map cycle-count 214 /run-map { 215 % init-map 216 dup length string copy 217 % map 218 0 exch 219 % cycle-count map 220 { 221 dup source-x source-y getxy 46 eq not { exit } if 222 % cycle-count map 223 source-x source-y { 224 % cycle-count map X Y 225 dup 1 add max-y gt { true exit } if 226 % cycle-count map X Y 227 3 copy 1 add getxy 46 eq 228 % cycle-count map X Y below-free? 229 { 1 add 230 % cycle-count map next-X next-Y 231 } 232 { % cycle-count map X Y 233 1 index 1 sub min-x lt { true exit } if 234 % cycle-count map X Y 235 3 copy exch 1 sub exch 1 add getxy 46 eq 236 % cycle-count map X Y below-left-free? 237 { exch 1 sub exch 1 add 238 % cycle-count map next-X next-Y 239 } 240 { % cycle-count map X Y 241 1 index 1 add max-x gt { true exit } if 242 % cycle-count map X Y 243 3 copy exch 1 add exch 1 add getxy 46 eq 244 % cycle-count map X Y below-right-free? 245 { exch 1 add exch 1 add 246 % cycle-count map next-X next-Y 247 } 248 { false exit } 249 ifelse 250 } 251 ifelse 252 % cycle-count map next-X next-Y 253 } 254 ifelse 255 % cycle-count map next-X next-Y 256 } loop 257 % cycle-count map final-X final-Y dropped-out? 258 { pop pop exit } if 259 % cycle-count map final-X final-Y 260 2 index 3 1 roll 111 putxy % `o` 261 % cycle-count updated-map 262 exch 1 add exch 263 % updated-cycle-count updated-map 264 } loop 265 % cycle-count map 266 exch 267 } bind def 268 269 /Helvetica 20 selectfont 270 271 272 (First Puzzle: ) 273 72 700 moveto show 274 init-map run-map 275 15 string cvs show 276 pop 277 278 (Second Puzzle: ) 279 72 664 moveto show 280 %%% add height columns left and right, and two lines below 281 /init-map2 width height dup add add height 2 add mul string def 282 0 1 init-map2 length 1 sub { 283 init-map2 exch 46 put 284 } for 285 width height dup add add height 1 add mul 286 1 287 init-map2 length 1 sub { 288 init-map2 exch 35 put % `#` 289 } for 290 0 1 height 1 sub { 291 % y 292 dup width mul 293 % y orig-offset 294 init-map exch width getinterval 295 % y orig-line 296 exch width height dup add add mul height add 297 % orig-line new-offset 298 exch init-map2 3 1 roll putinterval 299 % 300 } for 301 /min-x min-x height sub def 302 /max-x max-x height add def 303 /max-y max-y 2 add def 304 /width max-x min-x sub 1 add def 305 /height max-y min-y sub 1 add def 306 init-map2 run-map 307 15 string cvs show 308 pop 309 310 showpage 311 quit