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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
;;; solver.el --- Day 14 -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2022 Óscar Nájera
;;
;; Author: Óscar Nájera <hi@oscarnajera.com>
;; Maintainer: Óscar Nájera <hi@oscarnajera.com>
;; Created: December 16, 2022
;; Modified: December 16, 2022
;;
;;; Commentary:
;;
;; Day 14
;;
;;; Code:
(require 'seq)
(defun solver-bounds (str-or-buffer)
(with-temp-buffer
(if (stringp str-or-buffer)
(insert str-or-buffer)
(insert-buffer-substring str-or-buffer))
(goto-char (point-min))
(let ((xmax 0) (ymax 0)
(xmin 55550) (ymin 55550))
(while (re-search-forward (rx (group (+ digit)) "," (group (+ digit))) nil t)
(setq xmax (max xmax (string-to-number (match-string 1))))
(setq xmin (min xmin (string-to-number (match-string 1))))
(setq ymax (max ymax (string-to-number (match-string 2))))
(setq ymin (min ymin (string-to-number (match-string 2)))))
(list xmax xmin ymax ymin))))
(cl-defstruct (grid (:constructor solver-grid-create
(bounds
&aux
(x-len (1+ (- (car bounds) (cadr bounds))))
(y-len (1+ (elt bounds 2)))
(stride (* 8 (1+ (/ x-len 8))))
(grid (make-bool-vector (* stride y-len) nil))))
(:copier nil))
"Represents a snapshot of game of life."
bounds
x-len
y-len
stride
grid)
(defun solver-point (x y grid)
(let ((x (- x (cadr (grid-bounds grid)))))
(when (and (< -1 (grid-x-len grid))
(< -1 y (grid-y-len grid)))
(+ x (* y (grid-stride grid))))))
(defun solver--wall-line (grid)
(let (startx starty)
(while (re-search-forward (rx (group (+ digit)) "," (group (+ digit))) (line-end-position) t)
(let ((fx (string-to-number (match-string 1)))
(fy (string-to-number (match-string 2))))
(unless (null startx)
(if (= startx fx)
(cl-loop for y from (min starty fy) to (max starty fy)
do (aset (grid-grid grid) (solver-point startx y grid) t))
(cl-loop for x from (min startx fx) to (max startx fx)
do (aset (grid-grid grid) (solver-point x starty grid) t))))
(setq startx fx
starty fy)))))
(defun solver-walls (str-or-buffer grid)
(with-temp-buffer
(if (stringp str-or-buffer)
(insert str-or-buffer)
(insert-buffer-substring str-or-buffer))
(goto-char (point-min))
(while (not (eobp))
(solver--wall-line grid)
(forward-line)))
grid)
(defun solver-draw-wall (grid)
(let ((array (copy-sequence (grid-grid grid)))
(stride (grid-stride grid))
(y-len (grid-y-len grid)))
;; (cl-flet ((picture-coord
;; (idx)
;; (let ((x (mod idx stride))
;; (y (- y-len (/ idx stride) 1)))
;; (+ x (* y stride)))))
;; (seq-do-indexed (lambda (value idx) (aset array (picture-coord idx) value)) (grid-grid grid)))
(create-image array
'xbm t
:scale 20
:stride stride
:width (grid-x-len grid)
:height (grid-y-len grid)
:foreground "#ffffff"
:background "#000000"
)))
(solver-walls "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9"
(solver-grid-create '(503 494 9 4)))
(solver-point 496 3 (solver-grid-create '(503 494 9 4)))
(let* ((instr "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9")
(bounds (solver-bounds instr))
(grid (solver-grid-create bounds)))
(solver-walls instr grid)
(thread-first
(solver-draw-wall grid)
(insert-image)))
|
