Skip to content

Instantly share code, notes, and snippets.

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)
(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"" 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"" 4096)))))
(setf (at (memory p) 0) 2)
(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)
(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)
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)
(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))
(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)
(defun play (&optional (w 600) (h 300))
(: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"" 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))
(sdl2:gl-swap-window win)))
(setf target (estimate))
(gl:clear-color .1 .1 .1 1)
(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))
win (format nil "Score: ~d" (setf score (score game))))))
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.