advent-of-code-2022/day-10/part-02.scm

(import
 (except (rnrs base) let-values map error)
 (only (guile)
       lambda* λ
       current-output-port)
 (fileio)
 (math)
 (list-helpers)
 (array-helpers)
 ;; lists
 (srfi srfi-1)
 ;; let-values
 (srfi srfi-11)
 ;; hash tables
 (srfi srfi-69)
 ;; functional records
 (srfi srfi-9 gnu)
 (ice-9 pretty-print))


(define lines (get-lines-from-file "input"))


(define noop?
  (λ (line)
    (string=? line "noop")))


(define addx?
  (λ (line)
    (string-prefix? "addx" line)))


(define addx-get-number
  (λ (line)
    (string->number
     (second (string-split line #\space)))))


(define signal-strength
  (λ (cycle register)
    (* cycle register)))


(define-immutable-record-type <state>
  (make-state cycle register)
  state?
  (cycle state-cycle set-state-cycle)
  (register state-register set-state-register))


(set-record-type-printer!
 <state>
 (lambda (record port)
   (simple-format port "<state: cycle:~a register:~a>"
                  (state-cycle record)
                  (state-register record))))


(define initial-state (make-state 0 1))


(define run-instruction
  (λ (state instruction)
    (cond
     [(noop? instruction)
      (set-state-cycle state (+ (state-cycle state) 1))]
     [(addx? instruction)
      (let ([register-increment (addx-get-number instruction)])
        (set-fields state
                    ((state-cycle) (+ (state-cycle state) 1))
                    ((state-register) (+ (state-register state) register-increment))))]
     [else
      (error "unrecognized instruction" instruction)])))


;; Idea: Translate addx <number> to 2 instructions, a noop
;; instruction and the actual adding instruction, both
;; taking 1 cycle. This should make it easier to write the
;; rest of the logic, because one does not have to consider
;; addx <number> taking 2 cycles.
(define instructions
  (let iter-lines ([lines° lines])
    (cond
     [(null? lines°) '()]
     [else
      (let ([line (car lines°)])
        (cond
         [(noop? line)
          (cons line (iter-lines (cdr lines°)))]
         [(addx? line)
          (cons "noop"
                (cons line
                      (iter-lines (cdr lines°))))]
         [else
          (error "unrecognized input line" line)]))])))


(define display-crt-screen
  (λ (crt-screen)
    (let ([rows (array-len-in-dim crt-screen 0)]
          [cols (array-len-in-dim crt-screen 1)])
      (let iter-rows ([row-ind 0])
        (cond
         [(< row-ind rows)
          (let iter-cols ([col-ind 0])
            (cond
             [(< col-ind cols)
              (display (if (= (array-cell-ref crt-screen row-ind col-ind) 1) "#" ".")
                       (current-output-port))
              (iter-cols (+ col-ind 1))]
             [else
              (display "\n" (current-output-port))
              (iter-rows (+ row-ind 1))]))]
         [else 'done])))))


(define crt-pixel-lit?
  (λ (state)
    (let ([cycle-in-row (remainder (state-cycle state) 40)]
          [register (state-register state)])
      (and (>= cycle-in-row (- register 1))
           (<= cycle-in-row (+ register 1))))))


;; Now we can act, as if every instruction merely takes 1
;; cycle.
(define crt-screen
  (let* ([rows 6]
         [cols 40]
         [screen (make-array 0 rows cols)])
    (let iter ([state initial-state]
               [instructions° instructions])
      (simple-format (current-output-port) "~a\n" state)
      (cond
       [(null? instructions°) screen]
       [else
        (let ([instruction (car instructions°)])
          (when (crt-pixel-lit? state)
            (let ([row-ind (inexact->exact (floor (/ (state-cycle state) cols)))]
                  [col-ind (remainder (state-cycle state) cols)])
              (array-set! screen 1 row-ind col-ind)))
          (iter (run-instruction state instruction)
                (cdr instructions°)))]))))


(display-crt-screen crt-screen)