;;; 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)
(require 'subr-x)

(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-vector (* stride y-len) 0))))
                    (: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) 1))
            (cl-loop for x from (min startx fx) to (max startx fx)
                     do (aset (grid-grid grid) (solver-point x starty grid) 1))))
        (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)))
    (create-image array
                  'xbm t
                  :scale 20
                  :stride stride
                  :width (grid-x-len grid)
                  :height (grid-y-len grid)
                  :foreground "#ffffff"
                  :background "#000000")))

(defun solver-draw-grid (grid)
  (let ((stride (grid-stride grid)))
    (seq-do-indexed
     (lambda (elt idx)
       (let ((slot (mod idx stride)))
         (when (= 0 slot)
           (insert "\n"))
         (insert (cl-case elt
                   (0 ".")
                   (1 "#")
                   (2 "o")))))
     (grid-grid grid))))


(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)))

(defun solver-simulate (grid)
  (let ((x 500) (y 0) (drops 0))
    (while
        (ignore-error 'wrong-type-argument ;; went out of grid
          (cond
           ((= 0 (aref (grid-grid grid) (solver-point x (1+ y) grid)))
            (cl-incf y)) ;; check next
           ((= 0 (aref (grid-grid grid) (solver-point (1- x) (1+ y) grid)))
            (cl-incf y)
            (cl-decf x)) ;; check left
           ((= 0 (aref (grid-grid grid) (solver-point (1+ x) (1+ y) grid)))
            (cl-incf y)
            (cl-incf x)) ;; check right
           (t (aset (grid-grid grid) (solver-point x y grid) 2)
              (cl-incf drops)
              (setq x 500 y 0)))))
    drops))

(let* ((instr   "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9")
       (instr (find-file-noselect "input"))
       (bounds (solver-bounds instr))
       (grid (solver-grid-create bounds))
       )
  (solver-walls instr grid)
  ;; sim
  (solver-simulate grid)

  ;; (solver-draw-grid grid)
  )