125 lines
3.6 KiB
Scheme
125 lines
3.6 KiB
Scheme
(import (srfi :43)) ; vector extensions
|
|
(load "../common.scm")
|
|
|
|
; reads pairs of coordinates
|
|
; returns a list of the form (((x1 y1) (x2 y2))...)
|
|
(define (read-lines file)
|
|
(let loop [(lines '())]
|
|
(if (eof-object? (peek-char file))
|
|
lines
|
|
[loop
|
|
(cons
|
|
(list
|
|
(list
|
|
(get-number file) ; x1
|
|
(get-number file)) ; y1
|
|
(list
|
|
(begin
|
|
(get-char file) ; consume -
|
|
(get-char file) ; consume >
|
|
(get-char file) ; consume space
|
|
(get-number file)) ; x2
|
|
(get-number file))) ; y2
|
|
lines)])))
|
|
|
|
; coordinate getters
|
|
(define (get-x1 coords) (car (car coords)))
|
|
(define (get-x2 coords) (car (cadr coords)))
|
|
(define (get-y1 coords) (cadr (car coords)))
|
|
(define (get-y2 coords) (cadr (cadr coords)))
|
|
(define (get-max-x coords) (max (get-x1 coords) (get-x2 coords)))
|
|
(define (get-max-y coords) (max (get-y1 coords) (get-y2 coords)))
|
|
|
|
; returns the largest value obtained while applying pick to each element of lst
|
|
(define (get-max lst pick)
|
|
(apply max (map pick lst)))
|
|
|
|
(define (sign value)
|
|
(cond
|
|
[(= 0 value) 0]
|
|
[(< 0 value) 1]
|
|
[else -1]))
|
|
|
|
; image get/setters
|
|
(define (make-image width height)
|
|
(list width
|
|
height
|
|
(make-vector (* width height) 0)))
|
|
(define (get-width image) (car image))
|
|
(define (get-height image) (cadr image))
|
|
(define (get-pixels image) (caddr image))
|
|
(define (get-offset image x y) (+ x (* y (get-width image))))
|
|
(define (get-pixel image x y)
|
|
(vector-ref (get-pixels image) (get-offset image x y)))
|
|
(define (set-pixel! image x y value)
|
|
(vector-set! (get-pixels image) (get-offset image x y) value))
|
|
|
|
; rasterize a line from given coordinates
|
|
(define (additively-rasterize-line! image coords allow-diagonal)
|
|
(let* [(x1 (get-x1 coords))
|
|
(y1 (get-y1 coords))
|
|
(x2 (get-x2 coords))
|
|
(y2 (get-y2 coords))
|
|
(dx (sign (- x2 x1)))
|
|
(dy (sign (- y2 y1)))]
|
|
(when (or allow-diagonal
|
|
(and (= dx 0) (not (= dy 0)))
|
|
(and (= dy 0) (not (= dx 0))))
|
|
[let loop! [(x x1) (y y1)]
|
|
(set-pixel! image x y (+ 1 (get-pixel image x y)))
|
|
(unless (and (= x x2) (= y y2))
|
|
[loop! (+ x dx) (+ y dy)])])))
|
|
|
|
; rasterize all given lines to an image
|
|
; each pixel represents the number of lines touching it
|
|
; diagonals must be 45° if allowed
|
|
(define (additively-rasterize lines allow-diagonals)
|
|
(let* [(width (+ 1 (get-max lines get-max-x)))
|
|
(height (+ 1 (get-max lines get-max-y)))
|
|
(image (make-image width height))]
|
|
(for-each
|
|
(lambda (line)
|
|
(additively-rasterize-line! image line allow-diagonals))
|
|
lines)
|
|
image))
|
|
|
|
; count pixels with value strictly higher than 1
|
|
(define (count-crossings image)
|
|
(vector-fold
|
|
(lambda (index state pixel)
|
|
(if (> pixel 1)
|
|
[+ state 1]
|
|
state))
|
|
0
|
|
(get-pixels image)))
|
|
|
|
; output ASCII pgm formatted image with max 3 shades of gray to given file
|
|
(define (output-pgm image filename)
|
|
(when (file-exists? filename)
|
|
(delete-file filename))
|
|
(call-with-output-file
|
|
filename
|
|
(lambda (file)
|
|
(fprintf file "P2~%#~%~a ~a~%3~%"
|
|
(get-width image)
|
|
(get-height image))
|
|
(vector-for-each
|
|
(lambda (index pixel)
|
|
(fprintf file "~a " pixel)
|
|
(when (= 0 (modulo index (get-width image)))
|
|
(newline file)))
|
|
(get-pixels image)))))
|
|
|
|
(call-with-input-file
|
|
"input"
|
|
(lambda (file)
|
|
(let [(lines (read-lines file))]
|
|
(let [(image (additively-rasterize lines #f))]
|
|
(output-pgm image "part1.pgm")
|
|
(printf "part 1:~% dangerous areas = ~a~%"
|
|
(count-crossings image)))
|
|
(let [(image (additively-rasterize lines #t))]
|
|
(output-pgm image "part2.pgm")
|
|
(printf "part 2:~% dangerous areas = ~a~%"
|
|
(count-crossings image))))))
|