92 lines
3.4 KiB
Common Lisp
92 lines
3.4 KiB
Common Lisp
(defstruct line points)
|
|
(defstruct circle radius centre)
|
|
(defstruct polygon points)
|
|
|
|
(defun line (start-x start-y end-x end-y)
|
|
(list (make-line :points (vector start-x start-y end-x end-y))))
|
|
|
|
(defun circle (radius centre-x centre-y)
|
|
(list (make-circle :radius radius :centre (vector centre-x centre-y))))
|
|
|
|
(defun rectangle (left-x bottom-y width height)
|
|
(let ((right-x (+ left-x width))
|
|
(top-y (+ bottom-y height)))
|
|
(list (make-polygon
|
|
:points (vector left-x bottom-y
|
|
left-x top-y
|
|
right-x top-y
|
|
right-x bottom-y)))))
|
|
|
|
(defun centre-rectangle (centre-x centre-y width height)
|
|
(let ((left-x (- centre-x (/ width 2)))
|
|
(bottom-y (- centre-y (/ height 2))))
|
|
(rectangle left-x bottom-y width height)))
|
|
|
|
(defmacro define-transform (name (&rest params)
|
|
&key x-transform y-transform scalar-transform)
|
|
`(defun ,name (,@params drawing)
|
|
(labels ((transform-points (points)
|
|
(let ((new-points (copy-seq points)))
|
|
(do ((i 0 (+ i 2)))
|
|
((>= i (length points)))
|
|
(let ((x (aref new-points i))
|
|
(y (aref new-points (1+ i))))
|
|
(setf (aref new-points i) ,x-transform)
|
|
(setf (aref new-points (1+ i)) ,y-transform)))
|
|
new-points))
|
|
(transform-primitive (primitive)
|
|
(typecase primitive
|
|
(line
|
|
(make-line
|
|
:points (transform-points (line-points primitive))))
|
|
(circle
|
|
(make-circle
|
|
:radius ,(if scalar-transform
|
|
`(let ((s (circle-radius primitive)))
|
|
,scalar-transform)
|
|
'(circle-radius primitive))
|
|
:centre (transform-points (circle-centre primitive))))
|
|
(polygon
|
|
(make-polygon
|
|
:points (transform-points
|
|
(polygon-points primitive)))))))
|
|
(mapcar #'transform-primitive drawing))))
|
|
|
|
(define-transform translate (delta-x delta-y)
|
|
:x-transform (+ delta-x x)
|
|
:y-transform (+ delta-y y))
|
|
|
|
(define-transform scale (scale-factor)
|
|
:x-transform (* scale-factor x)
|
|
:y-transform (* scale-factor y)
|
|
:scalar-transform (* scale-factor s))
|
|
|
|
(define-transform rotate (theta)
|
|
:x-transform (- (* x (cos theta)) (* y (sin theta)))
|
|
:y-transform (+ (* x (sin theta)) (* y (cos theta))))
|
|
|
|
(defun overlay (&rest drawings)
|
|
(apply #'append drawings))
|
|
|
|
(defclass graphics-context ()
|
|
(window
|
|
renderer
|
|
(width :initarg :width :initform 800)
|
|
(height :initarg :height :initform 600)))
|
|
|
|
(defmethod initialize-instance :after ((ctx graphics-context) &key)
|
|
(with-slots (window renderer width height) ctx
|
|
(sdl2:init)
|
|
(setf window
|
|
(sdl2:create-window :title "Simulation"
|
|
:w width :h height
|
|
:flags '(:shown)))
|
|
(setf renderer
|
|
(sdl2:create-renderer window -1 '(:accelerated :presentvsync)))))
|
|
|
|
(defmethod cleanup ((ctx graphics-context))
|
|
(with-slots (window renderer) ctx
|
|
(sdl2:destroy-renderer renderer)
|
|
(sdl2:destroy-window window)
|
|
(sdl2:quit)))
|