AoC2022 Elisp 14 draw walls

1 files changed, 113 insertions, 0 deletions

diff --git a/AoC2022/14/solver.el b/AoC2022/14/solver.el
new file mode 100644
index 0000000..bd0464f
--- /dev/null
+++ b/AoC2022/14/solver.el
@@ -0,0 +1,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)))