#!/usr/local/bin/chicken-csi -ss
(import srfi-69
	(chicken string)
	(chicken io))

;; parse a line into a list of all points covered by rocks
(define (parse-line line)
  (let ((pairs (map (lambda (p) (map string->number (string-split p ",")))
		     (string-split line " ->"))))
    (let loop ((points '()) (ps pairs))
      (if (null? (cdr ps))
	  points
	  (let ((x1 (car (car ps))) (y1 (cadr (car ps)))
		(x2 (car (cadr ps))) (y2 (cadr (cadr ps))))
	    (cond ((and (= x1 x2) (not (= y1 y2)))
		   (loop (append points
				 (zip (n-of-v (add1 (abs (- y1 y2))) x1)
				      (range y1 y2)))
			 (cdr ps)))
		  ((and (= y1 y2) (not (= x1 x2)))
		   (loop (append points
				 (zip (range x1 x2)
				      (n-of-v (add1 (abs (- x1 x2))) y1)))
			 (cdr ps)))
		  (else "More than one dim changed")))))))

; [s, ..., f] inclusive
(define (range s f)
  (let ((next (if (<= s f) add1 sub1)))
    (if (equal? s f)
	(list f)
	(cons s (range (next s) f)))))

(define (n-of-v n v)
  (if (= n 0)
      '()
      (cons v (n-of-v (sub1 n) v))))

(define (zip l1 l2)
  (if (not (= (length l1) (length l2)))
      (error "Bad zip: lengths not equal"))
  (if (null? l1)
      '()
      (cons (list (car l1) (car l2)) (zip (cdr l1) (cdr l2)))))

(define (print-grid G)
  (let* ((keys (hash-table-keys G))
	 (max-x (apply max (map (lambda (pt) (car pt)) keys)))
	 (min-x (apply min (map (lambda (pt) (car pt)) keys)))
	 (max-y (apply max (map (lambda (pt) (cadr pt)) keys)))
	 (min-y 0))
    (let yloop ((y min-y))
      (newline)
      (if (> y max-y)
	  'done
	  (let xloop ((x min-x))
	    (if (> x max-x)
		(yloop (add1 y))
		(cond ((hash-table-exists? G (list x y))
		       (display (hash-table-ref G (list x y)))
		       (xloop (add1 x)))
		      (else (display ".")
			    (xloop (add1 x))))))))))
		    
; just for brevity
(define (empty? G x y) (not (hash-table-exists? G (list x y))))

(define (drop-sand G x y cliff)
  (cond ((> y cliff)  ; fell off the map -> we're done
	 #f)
	((empty? G x (add1 y))
	 (drop-sand G x (add1 y) cliff))
	; we're blocked at this point, try left/right
	((empty? G (sub1 x) (add1 y))
	 (drop-sand G (sub1 x) (add1 y) cliff))
	((empty? G (add1 x) (add1 y))
	 (drop-sand G (add1 x) (add1 y) cliff))
	(else
	 (hash-table-set! G (list x y) 'o))))

(define (empty-incl-floor? G x y floor)
  (not (or (hash-table-exists? G (list x y))
	   (= y floor))))

(define (drop-sand-floor G x y floor)
  (cond ((empty-incl-floor? G x (add1 y) floor)
	 (drop-sand-floor G x (add1 y) floor))
	; we're blocked at this point, try left/right
	((empty-incl-floor? G (sub1 x) (add1 y) floor)
	 (drop-sand-floor G (sub1 x) (add1 y) floor))
	((empty-incl-floor? G (add1 x) (add1 y) floor)
	 (drop-sand-floor G (add1 x) (add1 y) floor))
	(else
	 (if (and (= x 500) (= y 0))
	     #f  ; plugged the start -> done
	     (hash-table-set! G (list x y) 'o)))))

;; We map the world state as a hash table (effectively a sparse matrix)
;; so that we don't have to guess the vector dimensions first
(define (main args)
  (let ((G (make-hash-table)) (lines (read-lines)))
    (hash-table-set! G '(500 0) 'V)
    (for-each (lambda (l)
		(for-each (lambda (pt)
			    (hash-table-set! G pt 'R)) (parse-line l)))
	      lines)
    (let* ((cliff (apply max (map (lambda (pt) (cadr pt)) (hash-table-keys G))))
	   (floor (+ 2 cliff)))
      ;; note: could also just count the number of 'o values instead of i
      (let loop ((i 0))
	; (print "------" i "-------")
	; (print-grid G)
	(if (drop-sand G 500 0 cliff)
	    (loop (add1 i))
	    ;; HACK: we can keep the same grid, since we stopped RIGHT at the point
	    ;; we'd hit the floor anyways--just make sure to sum your numbers together!
	    (let floop ((j 0))
	      ;; (print "------" j "-------")
	      ;; (print-grid G)
	      (if (drop-sand-floor G 500 0 floor)
		  (floop (add1 j))
		  (begin
		    (print i)
		    (print (+ i (add1 j)))))))))
      (print-grid G)))

; For repl
(define ls '("498,4 -> 498,6 -> 496,6"
	     "503,4 -> 502,4 -> 502,9 -> 494,9"))