day22.ps (10016B)
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- day22.ps <day22.txt | display 19 20 /datafile (%stdin) (r) file def 21 /stderr (%stderr) (w) file def 22 23 /raw-map [ 24 { 25 datafile 200 string readline 26 not { 1.125 pstack quit } if 27 % line 28 dup length 0 eq { exit } if 29 } loop 30 ] def 31 32 /raw-path datafile 6000 string readline not { 2.125 pstack quit } if def 33 34 /turn-left-mark -1 def 35 /turn-right-mark -2 def 36 37 /path [ 38 0 raw-path { 39 % length-acc char 40 dup dup 48 ge exch 57 le and 41 { % length-acc digit-char 42 48 sub 43 % length-acc digit 44 exch 10 mul add 45 % next-length-acc 46 -10 47 } if 48 % length-acc char 49 dup 76 eq 50 { % length-acc 'L' 51 pop turn-left-mark 0 52 % length turn next-lenght-acc 53 -10 54 } if 55 % length-acc char 56 dup 82 eq 57 { % length-acc 'R' 58 pop turn-right-mark 0 59 % length turn next-lenght-acc 60 -10 61 } if 62 % length-acc char 63 0 ge { 3.125 pstack quit } if 64 % length-acc 65 } forall 66 % length-acc 67 dup 0 eq { pop } if 68 ] def 69 70 % x y -> char 71 /getxy { 72 { %%% 1-iteration loop to use `exit` as a short circuit 73 % x y 74 2 copy 0 lt exch 0 lt or { pop pop 32 exit } if 75 % x y 76 dup raw-map length ge { pop pop 32 exit } if 77 % x y 78 raw-map exch get 79 % x line 80 2 copy length ge { pop pop 32 exit } if 81 % x line 82 exch get 83 exit 84 } loop 85 } bind def 86 87 /dir-vect << 88 0 [ 1 0] 89 1 [ 0 1] 90 2 [-1 0] 91 3 [ 0 -1] 92 >> def 93 94 /origxy-proc << 95 0 { exch pop 0 exch } 96 1 { pop 0 } 97 2 { exch pop raw-map 1 index get length 1 sub exch } 98 3 { pop raw-map length 1 sub } 99 >> def 100 101 % x y dir -> x y 102 /origxy { 103 % x y dir 104 dup 4 1 roll 105 % dir x y dir 106 origxy-proc exch get exec 107 % dir start-x start-y 108 3 2 roll dir-vect exch get aload pop 4 2 roll 109 % dx dy start-x start-y 110 { 111 % dx dy cur-x cur-y 112 2 copy getxy 113 % dx dy cur-x cur-y cur-char 114 32 eq not { exit } if 115 % dx dy cur-x cur-y 116 exch 3 index add exch 2 index add 117 % dx dy next-x next-y 118 } loop 119 % dx dy x y 120 4 2 roll pop pop 121 % x y 122 } bind def 123 124 % prev-x prev-y dir -> x y dir 125 /one-step-1 { 126 % prev-x prev-y dir 127 dir-vect 1 index get aload pop 128 % prev-x prev-y dir dx dy 129 exch 4 index add exch 3 index add 130 % prev-x prev-y dir new-x new-y 131 2 copy getxy 132 % prev-x prev-y dir new-x new-y new-char 133 dup 32 eq 134 { % prev-x prev-y dir invalid-new-x invalid-new-y new-char 135 pop 2 index 136 % prev-x prev-y dir invalid-new-x invalid-new-y dir 137 origxy 138 % prev-x prev-y dir new-x new-y 139 2 copy getxy 140 % prev-x prev-y dir new-x new-y new-char 141 dup 32 eq { 4.125 pstack quit } if 142 % prev-x prev-y dir new-x new-y new-char 143 } if 144 % prev-x prev-y dir new-x new-y new-char 145 dup 46 eq 146 { % prev-x prev-y dir new-x new-y '.' 147 pop 5 3 roll pop pop 3 2 roll 148 % new-x new-y dir 149 } 150 { % prev-x prev-y dir new-x new-y new-char 151 dup 35 eq 152 { % prev-x prev-y dir new-x new-y '#' 153 pop pop pop 154 % prev-x prev-y dir 155 } 156 { 5.125 pstack quit } 157 ifelse 158 % x y dir 159 } 160 ifelse 161 % x y dir 162 } bind def 163 164 /cube-size raw-map length 3 idiv def 165 166 % invalid-x invalid-y old-dir -> x y dir 167 %%% edges: A 1 B y directions: 3 168 %%% ...# 0 2 . 0 169 %%% -7 .#.. 2 1 170 %%% #... 171 %%% B -1A 7C....D 172 %%% ...#.......# 4 173 %%%-4 ........#... 3 174 %%% ..#....#.... 175 %%% ..........#.F-3 D 176 %%% H -6G-5 E...#.... 8 177 %%% 5 .....#.. -2 178 %%% .#...... 179 %%% ......#. 180 %%% G 6 H4 B 12 181 %%% x 0 4 8 12 16 ^ 182 %%% 183 %%% warp items: 184 %%% - trigger-min-x 185 %%% - trigger-min-y 186 %%% - trigger-max-x 187 %%% - trigger-max-y 188 %%% - trigger-direction 189 %%% - image-of-min-x 190 %%% - image-of-min-y 191 %%% - image-dx 192 %%% - image-dy 193 %%% - image-direction 194 195 /warp-data [ 196 % tx-ty-tx+ty+td x y dx dy d 197 [ 8 0 11 0 3 3 4 -1 0 1] % edge 1 198 [11 0 11 3 0 15 11 0 -1 2] % edge 2 199 [11 4 11 7 0 15 8 -1 0 1] % edge 3 200 [12 11 15 11 1 0 7 0 -1 0] % edge 4 201 [ 8 8 8 11 2 7 7 -1 0 3] % edge 5 202 [ 8 11 11 11 1 3 7 -1 0 3] % edge 6 203 [ 4 4 7 4 3 8 0 0 1 0] % edge 7 204 [ 0 4 3 4 3 11 0 -1 0 1] % edge -1 205 [15 8 15 11 0 11 3 0 -1 2] % edge -2 206 [12 8 15 8 3 11 7 0 -1 2] % edge -3 207 [ 0 4 0 7 2 15 11 -1 0 3] % edge -4 208 [ 4 7 7 7 1 8 11 0 -1 0] % edge -5 209 [ 0 7 3 7 1 11 11 -1 0 3] % edge -6 210 [ 8 0 8 3 2 4 4 1 0 1] % edge -7 211 ] def 212 213 %%% my data: 214 %%% 1 2 215 %%% B B B A A A 216 %%% -6 B B B A A A 3 217 %%% B B B A A A 218 %%% C C C 4 219 %%% -7 C C C -4 220 %%% 7 C C C 221 %%% E E E D D D 222 %%% 6 E E E D D D -3 223 %%% E E E D D D 224 %%% F F F 5 225 %%% -1 F F F-5 226 %%% F F F 227 %%% -2 228 229 /my-warp-data [ 230 % tx- ty- tx+ ty+d x y dx dy d 231 [ 50 0 99 0 3 0 150 0 1 0] % edge 1 232 [100 0 149 0 3 0 199 1 0 3] % edge 2 233 [149 0 149 49 0 99 149 0 -1 2] % edge 3 234 [100 49 149 49 1 99 50 0 1 2] % edge 4 235 [ 99 50 99 99 0 100 49 1 0 3] % edge -4 236 [ 99 100 99 149 0 149 49 0 -1 2] % edge -3 237 [ 50 149 99 149 1 49 150 0 1 2] % edge 5 238 [ 49 150 49 199 0 50 149 1 0 3] % edge -5 239 [ 0 199 49 199 1 100 0 1 0 1] % edge -2 240 [ 0 150 0 199 2 50 0 1 0 1] % edge -1 241 [ 0 100 0 149 2 50 49 0 -1 0] % edge 6 242 [ 0 100 49 100 3 50 50 0 1 0] % edge 7 243 [ 50 50 50 99 2 0 100 1 0 1] % edge -7 244 [ 50 0 50 49 2 0 149 0 -1 0] % edge -6 245 ] def 246 247 % prev-x prev-y prev-dir -> x y dir 248 /warpxy { 249 false 250 % prev-x prev-y prev-dir found? 251 warp-data { 252 true 253 % prev-x prev-y prev-dir prev-found? warpdata match? 254 5 index 2 index 0 get ge and % prev-x ≥ tx- 255 4 index 2 index 1 get ge and % prev-x ≤ tx+ 256 5 index 2 index 2 get le and % prev-y ≥ ty- 257 4 index 2 index 3 get le and % prev-y ≤ ty+ 258 3 index 2 index 4 get eq and % prev-dir = td 259 % prev-x prev-y prev-dir prev-found? warpdata match? 260 { % prev-x prev-y prev-dir prev-found? warpdata 261 exch pop true exch 262 % prev-x prev-y prev-dir found? warpdata 263 3 2 roll pop 264 % prev-x prev-y found? warpdata 265 4 3 roll 266 % prev-y found? warpdata prev-x 267 1 index 0 get sub 268 % prev-y found? warpdata delta-x 269 4 3 roll 2 index 1 get sub 270 % found? warpdata delta-x delta-y 271 add 272 % found? warpdata delta 273 1 index 7 get 1 index mul 274 % found? warpdata delta dx 275 exch 2 index 8 get mul 276 % found? warpdata dx dy 277 exch 2 index 5 get add exch 2 index 6 get add 278 % found? warpdata x y 279 3 2 roll 9 get 280 % found? x y dir 281 4 3 roll 282 % x y dir found? 283 exit 284 } if 285 pop 286 } forall 287 % x y dir found? 288 not { 8.125 pstack quit } if 289 } bind def 290 291 /dump-char [ 62 118 60 94 ] def 292 /dump-2 [ raw-map { dup length string copy } forall ] def 293 294 % prev-x prev-y dir -> x y dir 295 /one-step-2 { 296 % prev-x prev-y dir 297 dir-vect 1 index get aload pop 298 % prev-x prev-y dir dx dy 299 exch 4 index add exch 3 index add 300 % prev-x prev-y dir new-x new-y 301 2 copy getxy 302 % prev-x prev-y dir new-x new-y new-char 303 dup 32 eq 304 { % prev-x prev-y dir invalid-new-x invalid-new-y new-char 305 pop pop pop 3 copy 306 % prev-x prev-y dir prev-x prev-y prev-dir 307 warpxy 308 % prev-x prev-y dir new-x new-y new-dir 309 3 copy pop getxy 310 % prev-x prev-y dir new-x new-y new-dir new-char 311 dup 32 eq { 6.125 pstack quit } if 312 % prev-x prev-y dir new-x new-y new-dir new-char 313 } 314 { 3 index exch } 315 ifelse 316 % prev-x prev-y dir new-x new-y new-dir new-char 317 dup 46 eq 318 { % prev-x prev-y dir new-x new-y new-dir '.' 319 pop 6 3 roll pop pop pop 320 % new-x new-y new-dir 321 } 322 { % prev-x prev-y dir new-x new-y new-dir new-char 323 dup 35 eq 324 { % prev-x prev-y dir new-x new-y new-dir '#' 325 pop pop pop pop 326 % prev-x prev-y dir 327 } 328 { 7.125 pstack quit } 329 ifelse 330 % x y dir 331 } 332 ifelse 333 % x y dir 334 dump-2 2 index get 335 % x y dir dump-line 336 3 index 337 % x y dir dump-line x 338 dump-char 3 index get 339 % x y dir dump-line x dump-char 340 put 341 % x y dir 342 } bind def 343 344 345 346 /Helvetica 20 selectfont 347 348 349 (First Puzzle: ) 350 72 700 moveto show 351 352 0 0 { 353 % x y 354 2 copy getxy 355 % x y char 356 46 eq { exit } if 357 % x y 358 exch 1 add exch 359 % next-x y 360 } loop 361 % start-x start-y 362 0 363 % start-x start-y start-dir 364 path { 365 % x y dir instruction 366 dup turn-left-mark eq { exch 3 add 4 mod exch } if 367 dup turn-right-mark eq { exch 1 add 4 mod exch } if 368 % x y dir instruction 369 dup 0 gt { { one-step-1 } repeat } { pop } ifelse 370 % x y dir 371 } forall 372 % x y dir 373 exch 1000 mul add exch 4 mul add 1004 add 374 % result 375 15 string cvs show 376 377 378 (Second Puzzle: ) 379 72 664 moveto show 380 381 0 0 { 382 % x y 383 2 copy getxy 384 % x y char 385 46 eq { exit } if 386 % x y 387 exch 1 add exch 388 % next-x y 389 } loop 390 % start-x start-y 391 0 392 % start-x start-y start-dir 393 path { 394 % x y dir instruction 395 dup turn-left-mark eq { exch 3 add 4 mod exch } if 396 dup turn-right-mark eq { exch 1 add 4 mod exch } if 397 % x y dir instruction 398 dup 0 gt { { one-step-2 } repeat } { pop } ifelse 399 % x y dir 400 } forall 401 % x y dir 402 exch 1000 mul add exch 4 mul add 1004 add 403 % result 404 15 string cvs show 405 406 %%% dump-2 { 407 %%% stderr exch writestring 408 %%% stderr 10 write 409 %%% } forall 410 411 412 showpage 413 quit 414