if (SDL_Init(SDL_INIT_VIDEO) < 0) {
SDL_LogError(SDL_LOG_CATEGORY_APPLICATION,
\"Failed to init %s\",
SDL_GetError());
" (error "failed to SDL_Init(video)") "
}
if (SDL_CreateWindowAndRenderer(640,480,SDL_WINDOW_RESIZABLE,
&window, &renderer)) {
SDL_LogError(SDL_LOG_CATEGORY_APPLICATION,
\"Failed to create w & r%s\",
SDL_GetError());
" (error "failed to create window and renderer") "
}
quitted = 0;
for (;;) {"
"
while(SDL_PollEvent(&e))
if (e.type == SDL_QUIT) quitted = 1;
else if (e.type == SDL_KEYDOWN)
switch (e.key.keysym.sym) {
case SDLK_q:
quitted = 1;
break;
}
if (quitted) break;
;;; Makes a line spec generator (x1 x2 y1 y2 or finished-once->nil)
(defun coord-liner (start-x below-x x-space
y-start y-stop y-space &key (transpose nil)
&aux (cur-x start-x)) "
(coord-liner (start-x below-x x-space
y-start y-stop y-space
&key (transpose nil)))
Return a closure that returns
(x1 y1 x2 y2) or nil when it loops,
or if transpose (y1 x1 y2 x2)
"
(lambda ()
(reduce 'append
(mapcar (if transpose 'reverse 'identity)
(if (< cur-x below-x)
(prog1 (list (list (* cur-x x-space) (* y-start y-space))
(list (* cur-x x-space) (* y-stop y-space)))
(incf cur-x))
(prog1 nil (setf cur-x start-x)))))))
;;; SDL_SetRenderDrawColor in lisp.
(defun set-color (r g b &optional (a 255))
(ffi:c-inline (r g b a) (:int :int :int :int) nil
"SDL_SetRenderDrawColor(renderer, #0, #1, #2, #3)"
:one-liner t))
;;; Hacky utility that paints a list of lines from a generator
;;; a color.
(defun draw-lines-from (fun rgb) "
Calls SDL_SetRenderDrawColor and
SDL_RenderDrawLine
with rgb and on a list from fun.
"
(lambda ()
(loop initially (apply #'set-color rgb)
for (x1 y1 x2 y2) = (funcall fun)
for (px py) = (funcall (ensure-player) :get-position t)
while x1
do (ffi:c-inline ((* (- x1 px) *scale*)
(* (- y1 py) *scale*)
(* (- x2 px) *scale*)
(* (- y2 py) *scale*))
(:int :int :int :int) nil
"SDL_RenderDrawLine(renderer, #0, #1, #2, #3)"
:one-liner t))))
;; Add plants.
(defvar *plants* (list))
(defun spawn-plant-in (x y w h)
(push (list 'leaves (+ x (random w)) (+ y (random h)))
*plants*))
;; leaves->flowers ->berries?
(defun advance-some-plants (&rest from-to-frac/tions)
(loop for plant in *plants*
do (loop for (from to frac/tion) in from-to-frac/tions
when (> (random (denominator frac/tion))
(1- (numerator frac/tion)))
do (cond ((eq (car plant) from) (rplaca plant to))))))
;; Painting the lilly
(defun paint-plants ()
(loop for plant in *plants*
for xy-position = (cdr plant)
for color = (case (car plant)
(leaves '(0 255 0))
(flower '(255 0 255)))
when color
do (apply 'set-color color)
(apply 'fill-rectangle
(append (mapcar '- xy-position
(funcall (ensure-player) :get-position t)
(mapcar '- *orig-player-position*))
'(1 1)))))
;;ie size of a grid cell.
(defparameter *scale* '25)
;;once the player/robots need to spawn, they should spawn from the base.
(defvar *base* nil)
(defvar *orig-player-position* '(13 11))
(defun ensure-base ()
(or *base*
(setf *base*
(let ((xy-position '(1 2)) (color '(255 255 255)))
(lambda (&key get-position move paint seed-plant)
(cond (seed-plant
)
(get-position (values xy-position))
(move (case move
(e (decf (car xy-position)))
(n (incf (cadr xy-position)))
(w (incf (car xy-position)))
(s (decf (cadr xy-position)))))
(paint
(apply 'set-color color)
(apply 'fill-rectangle
(append (mapcar '- xy-position
(funcall (ensure-player) :get-position t)
(mapcar '- *orig-player-position*))
'(1 1))))))))))
