Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
(in-package :advent.2019.intcode)
;; utils
(defun make-command-queue (size)
(assert (plusp size))
(let* ((commands (make-list size))
(head commands))
(lambda (value callback)
(setf (car head) value)
(setf head
(or (cdr head)
(prog1 commands
(apply callback commands)))))))
;; day 13 - part 1
(defproc v4/d13 (v4)
((in-queue :initform (make-command-queue 3) :reader in-queue)
(game :reader game :initarg :game)))
(defclass game-part-1 ()
((counter :initform 0 :accessor counter)))
(defgeneric update-game (game x y tile)
(:method ((game game-part-1) x y tile)
(case tile
(2 (incf (counter game))))))
(define-primitive .print ((p v4/d13) value)
(funcall (in-queue p)
value
(lambda (x y tile)
(update-game (game p) x y tile))))
(let ((game (make-instance 'game-part-1)))
(run-program (make-instance 'v4/d13
:game game
:memory (make-memory '(#P"13.in" 4096))))
(counter game))
;; day 13 - part 2
(defclass game-part-2 ()
((grid :accessor grid :initform (make-hash-table))
(paddle :accessor paddle :initform 0)
(ball :accessor ball :initform 0)
(bounding-box :accessor bounding-box)))
(defgeneric joystick (game))
(define-primitive .read ((p v4/d13))
(joystick (game p)))
(defmethod update-game ((game game-part-2) x y third)
(if (and (= -1 x) (= 0 y))
(print `(:score ,third))
(let ((coord (complex x y))
(grid (grid game))
(tile (aref #(:empty :wall :block :paddle :ball) third)))
(ecase tile
(:empty (remhash coord grid))
((:wall :block) (setf (gethash coord grid) tile))
(:paddle (setf (paddle game) coord))
(:ball (setf (ball game) coord))))))
(defmethod joystick ((game game-part-2))
;; basic strategy
(realpart (- (ball game) (paddle game))))
(defun d13-p2 (&optional (class 'v4/d13))
(let ((p (make-instance class
:game (make-instance 'game-part-2)
:memory (make-memory '(#P"13.in" 4096)))))
(setf (at (memory p) 0) 2)
p))
(run-program (d13-p2))
;; day-13 - part 3
(ql:quickload :sdl2)
(ql:quickload :cl-opengl)
(ql:quickload :bricabrac)
(use-package :bricabrac.sdl2.event-loop)
(defvar *win*)
(defvar *gl*)
;; estimate next position of ball
(defproc v4/d13-p3-estimate (v4/d13)
((estimate :accessor estimate)
(memory :accessor memory)
(in-queue :accessor in-queue)
(ty :accessor ty)))
(define-primitive .read ((p v4/d13-p3-estimate)) 0)
(define-primitive .print ((p v4/d13-p3-estimate) value)
(funcall (in-queue p)
value
(lambda (x y u)
(when (= u 4 #| ball |#)
(when (= y (ty p))
(setf (estimate p) x)
(.halt p))))))
;; interact with game loop
(defproc v4/d13-2 (v4/d13)
((to-read :accessor to-read :initform nil)))
(define-primitive .read ((p v4/d13-2))
(let ((value (to-read p)))
(unless value (.halt p))
(setf (to-read p) nil) value))
(defun bounding-box% (game)
(loop
for p in (list* (paddle game) (ball game) (hash-table-keys (grid game)))
minimize (realpart p) into lo-x minimize (imagpart p) into lo-y
maximize (realpart p) into hi-x maximize (imagpart p) into hi-y
finally (return (list lo-x lo-y (1+ hi-x) (1+ hi-y)))))
(defun set-size (game width height)
(gl:viewport 0 0 width height)
(gl:matrix-mode :projection)
(gl:load-identity)
(destructuring-bind (lox loy hix hiy) (bounding-box game)
(gl:ortho lox hix hiy loy 0 1)))
(defun quad (p &optional (margin 0))
(with-accessors ((x realpart) (y imagpart)) p
(gl:rect (+ x margin)
(+ y margin)
(1+ (- x margin))
(1+ (- y margin)))))
(defvar *colorblock*)
(defgeneric display (p shape)
(:method (p (shape (eql :paddle)))
(gl:color 1 1 1 1)
(quad p -0.1))
(:method (p (shape (eql :block)))
(funcall *colorblock* p)
(quad p 0.1))
(:method (p (shape (eql :wall)))
(gl:color 0.3 0.3 0.3 1)
(quad p))
(:method (p (shape (eql :ball)))
(gl:color 1 1 0 1)
(quad p 0.1)))
(defun colorblock (bbox)
(destructuring-bind (lx ly hx hy) bbox
(let ((dx (- hx lx)) (dy (- hy ly)))
(lambda (p)
(with-accessors ((x realpart) (y imagpart)) p
(let ((xr (/ (- x lx) dx))
(yr (/ (- y ly) dy)))
(gl:color (float (lerp xr 0 1))
(float (lerp yr 1 0))
(float (lerp (* xr yr) 1 0))
1)))))))
(defclass game-part-3 (game-part-2)
((score :accessor score :initform 0)))
(defmethod update-game ((g game-part-3) x y arg)
(if (and (= x -1) (= y 0))
(setf (score g) arg)
(call-next-method)))
(defun play (&optional (w 600) (h 300))
(sdl2:with-everything
(:window (win :w w :h h :flags '(:opengl :resizable :shown)) :gl gl)
(let* ((game (make-instance 'game-part-3))
(p (make-instance 'v4/d13-2
:game game
:memory (make-memory '(#P"13.in" 4096))))
(e (make-instance 'v4/d13-p3-estimate
:memory (make-memory (memory p))))
(active nil)
(score nil)
(old-ball nil)
(target nil))
;; insert coins
(setf (at (memory p) 0) 2)
;; init
(run-program p)
(setf (ty e) (1- (imagpart (paddle game))))
(setf old-ball (ball game))
(setf (bounding-box game) (bounding-box% game))
(set-size game w h)
(let ((*colorblock* (colorblock (bounding-box game))))
(flet ((estimate ()
(setf (estimate e) 0)
(setf (in-queue e) (make-command-queue 3))
(setf (pc e) (pc p))
(setf (relative-base e) (relative-base p))
(replace (buffer (memory e)) (buffer (memory p)))
(run-program e)
(estimate e))
(refresh ()
(gl:clear :color-buffer)
(display (paddle game) :paddle)
(display (ball game) :ball)
(maphash #'display (grid game))
(gl:flush)
(sdl2:gl-swap-window win)))
(setf target (estimate))
(gl:clear-color .1 .1 .1 1)
(refresh)
(do-match-events (:method :wait :timeout 30 :rebind (*standard-output*))
(with-window-event-resized (_ :width w :height h)
(set-size game w h))
(with-key-down-event (_)
(setf active t))
(:quit (return))
(:idle (when active
(run-program p)
(when (and (< (imagpart (ball game)) (imagpart old-ball))
(= (imagpart old-ball) (ty e)))
(setf target (estimate)))
(setf (to-read p)
(signum (- target (realpart (paddle game)))))
(setf old-ball (ball game))
(unless (eql score (score game))
(sdl2:set-window-title
win (format nil "Score: ~d" (setf score (score game))))))
(refresh))))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.