(ffi:clines "
#include <SDL2/SDL.h>

SDL_Renderer *renderer;
SDL_Window *window;
SDL_Event e;

const Uint8 *state;

int mx, my; Uint32 mdown;
int quitted;

int up_arrow, down_arrow, left_arrow, right_arrow;
")


(Defpackage "jam-no-theme" (:use cl) (:nicknames :ja))

(in-package :ja)

;;;Underlying sdl2 mechanism
(defmacro game ((&rest shared-vars) 
                (&rest shared-declares) 
                update-closures)
 `(let ,shared-vars
   ,(append '(declare) shared-declares)

   (multiple-value-setq (*up* *down* *left* *right*) 
                        (values 82 81 80 79))
  (unwind-protect
   (ffi:c-progn ,(mapcar 'car shared-vars)
    "

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;

	mdown = SDL_GetMouseState(&mx, &my);
	"
	"
	SDL_SetRenderDrawColor(renderer, 0, 10, 20, 255);
	SDL_RenderClear(renderer);"

        (mapcar 'funcall ,update-closures)

	"
	SDL_RenderPresent(renderer);
	SDL_Delay(250);
	"
"}

SDL_DestroyRenderer(renderer);
SDL_DestroyWindow(window);
SDL_Quit();")
(ffi:c-inline () () nil "SDL_Quit();"))))

;;; 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))))

;;; SDL_RenderFillRect as a lisp function.
(defun fill-rectangle (x y w h)
 (ffi:c-inline ((* *scale* x) 
                (* *scale* y) 
                (* *scale* w)
                (* *scale* h))
  (:int :int :int :int) nil
  "
   SDL_RenderFillRect(renderer, 
       &(struct SDL_Rect){.x = #0, .y = #1, 
                          .w = #2, .h = #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))))))))))

;; You/likely controlled by arrowkeys.
(defvar *player* nil)
(defun ensure-player ()
 (or *player* 
  (setf *player* 
   (let ((xy-position '(0 0))
         (color '(255 255 0))
         (jam-energy 100))
    (lambda (&key get-position move paint die)
     (cond (get-position (values xy-position))
           (die (zerop (decf jam-energy)))
           (move (case move
                  (e (incf (car xy-position))) 
                  (n (decf (cadr xy-position))) 
                  (w (decf (car xy-position))) 
                  (s (incf (cadr xy-position)))))
           (paint (apply #'set-color color)
            (apply #'fill-rectangle 
             `(,@*orig-player-position* 1 1)))))))))

;;I guess we're after treasure?
(defparameter *treasures* (list))

;;Robot stuff
(defvar *default-program*
 '(lambda (self) (declare (ignore self))
   (nth (random 4) '(e n w s))))
(defparameter *programming* (eval *default-program*))
(defvar *bots* (list))   
(defun spawn-bot ())

(defun get-key-state (scancode)
 (let ((state (ffi:c-inline (scancode) (:int) :int
               "state = SDL_GetKeyboardState(NULL);
                @(return) = (state[#0]) ? 1 : 0;")))
  (values state)))

(defun check-arrow-scancodes ()
 (values
 (ffi:c-inline () () :int "@(return) = SDL_SCANCODE_UP;")
 (ffi:c-inline () () :int "@(return) = SDL_SCANCODE_DOWN;")
 (ffi:c-inline () () :int "@(return) = SDL_SCANCODE_LEFT;")
 (ffi:c-inline () () :int "@(return) =  SDL_SCANCODE_RIGHT;")))

(defparameter *funs* (list))
(defun play-game () (game () () *funs*))

(defun make-game () "
Little-by-little game creation
"
 ;; New game
 (defparameter *funs* (list))
 (play-game)

 ;; Add lines in either direction
 (push (draw-lines-from (coord-liner 0 (+ 2 (truncate 640 *scale*)) 1
                         0 (+ 1 (truncate 480 *scale*)) 1
                         :transpose nil)
        '(255 0 0))
  *funs*)
 (play-game)
 
 (push
  (draw-lines-from 
   (coord-liner 0 (+ 2 (truncate 480 *scale*)) 1
                0 (+ 1 (truncate 640 *scale*)) 1
                :transpose t)
   '(255 255 0))
  *funs*)
 (play-game)

 ;; Add player and base
 (push (lambda () (Funcall (ensure-player) :paint t))
  *funs*)
 (push (lambda () (Funcall (ensure-base) :paint t))
  *funs*)
 (play-game)
 (push
  (lambda () 
   (funcall (ensure-player) :move
    (cond ((not (zerop (get-key-state *down*)))  's)
          ((not (zerop (get-key-state *up*)))    'n)
          ((not (zerop (get-key-state *left*)))  'w)
          ((not (zerop (get-key-state *right*))) 'e))))
  *funs*)
 (play-game)
 ;; Add plants
 (loop repeat 6 do (spawn-plant-in -5 -5 15 15))
 ;;(print *plants*)
 (advance-some-plants '(leaves flower 7/10))
 ;;(print *plants*)
 (nconc *funs* (list (lambda () (paint-plants))))
 (play-game))