game_of_life.lsp

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;
;;                                                                            ;;
;;                                                        :::      ::::::::   ;;
;;   test.c                                             :+:      :+:    :+:   ;;
;;                                                    +:+ +:+         +:+     ;;
;;   By: pgritsen <pgritsen@student.42.fr>          +#+  +:+       +#+        ;;
;;                                                +#+#+#+#+#+   +#+           ;;
;;   Created: 2018/02/03 15:02:10 by pgritsen          #+#    #+#             ;;
;;   Updated: 2018/02/03 15:02:10 by pgritsen         ###   ########.fr       ;;
;;                                                                            ;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;

(load "~/quicklisp/setup.lisp")

(let* ((*standard-output* (make-broadcast-stream)) (*error-output* *standard-output*))
    (ql:quickload "lispbuilder-sdl")
)

;; --== Global Variables ==--

(defvar *ASCII-NUM-START* 48)
(defvar *ASCII-NUM-END* 57)

(setq *print-case* :capitalize)

;; color 1 = dead == blue
;; color 2 = new born = white
;; color 3 = survived = red

(defvar *color* nil)

(defvar *map* nil)
(defvar *tmp_map* nil)

(defvar *w_width* 1680)
(defvar *w_height* 1300)

(defvar *t_width* nil)
(defvar *t_height* nil)

(defvar *zoom* 25)

(defvar *ox* 0)
(defvar *oy* 0)

(defvar *pause* 1)
(defvar *speed* 0)
(defvar *grid_switcher* 0)

(defvar *interactive-mode* 0)

(defvar *drag-position* nil)

;; --== Functions ==--

(defun show-help()
	(format t "~a~%"	"Usage: sbcl --load game_of_life.lsp [-h] width height")
	(format t "~%~a~%"	"Positional arguments:")
	(format t "~a~%"	"  width                     width of the grid")
	(format t "~a~%"	"  height                    height of the grid")
	(format t "~a~%"	"Optional arguments:")
	(format t "~a~%"	"-h, --help                  show this help message and exit")
	(sb-ext:exit)
)

(defun center()
	(setq *ox* (floor (/ (- *w_width* (* *zoom* *t_height*)) 2.0)))
	(setq *oy* (floor (/ (- *w_height* (* *zoom* *t_width*)) 2.0)))
)

(defun init-color()
	(let ((ret (make-array *t_height* :initial-element 2)))
		(dotimes (x *t_height*)
			(setf (aref ret x) (make-array *t_width* :initial-element 2)))
		(return-from init-color ret)
	)
)

(defun init-array()
	(center)
	(let ((ret (make-array *t_height* :initial-element 0)))
		(dotimes (x *t_height*)
			(setf (aref ret x) (make-array *t_width* :initial-element 0)))
		(return-from init-array ret) 
	)
)

(defun copy-array(dst src)
	(dotimes (x *t_height*)
		(dotimes (y *t_width*)
			(setf (aref (aref dst x) y) (aref (aref src x) y)))
	)
)

(defun convert(coord shift)
	(+ (* coord *zoom*) shift)
)

(defun unconvert(coord shift)
	(floor (/ (- coord shift) *zoom*))
)

(defun make-alive(x y)
	(setf (aref (aref *map* x) y) 1)
	(setf (aref (aref *color* x) y) 2)
)

(defun draw-big-explosion()
	(if (or (< *t_width* 5) (< *t_height* 5))
		(return-from draw-big-explosion NIL))
	(let ((of-x (- (floor (/ *t_height* 2.0)) 2))(of-y (- (floor (/ *t_width* 2.0)) 2)))
		(make-alive of-x of-y)
		(make-alive of-x (+ 1 of-y))
		(make-alive of-x (+ 2 of-y))
		(make-alive of-x (+ 3 of-y))
		(make-alive of-x (+ 4 of-y))
		(make-alive (+ 4 of-x) of-y)
		(make-alive (+ 4 of-x) (+ 1 of-y))
		(make-alive (+ 4 of-x) (+ 2 of-y))
		(make-alive (+ 4 of-x) (+ 3 of-y))
		(make-alive (+ 4 of-x) (+ 4 of-y))
		(make-alive (+ 2 of-x) of-y)
		(make-alive (+ 2 of-x) (+ 4 of-y))
	)
)

(defun draw-small-explosion()
	(if (or (< *t_width* 4) (< *t_height* 3))
		(return-from draw-small-explosion NIL))
	(let ((of-x (- (floor (/ *t_height* 2.0)) 1))(of-y (- (floor (/ *t_width* 2.0)) 2)))
		(make-alive (+ of-x 1) of-y)
		(make-alive (+ of-x 1) (+ 1 of-y))
		(make-alive (+ of-x 1) (+ 3 of-y))
		(make-alive of-x (+ 1 of-y))
		(make-alive of-x (+ 2 of-y))
		(make-alive (+ 2 of-x) (+ 1 of-y))
		(make-alive (+ 2 of-x) (+ 2 of-y))
	)
)

(defun draw-microb-left()
	(if (and (<= *t_height* 5) (<= *t_width* 4))
		(return-from draw-microb-left nil))
	(make-alive 1 (- *t_width* 2))
	(make-alive 1 (- *t_width* 4))
	(make-alive 4 (- *t_width* 2))
	(make-alive 5 (- *t_width* 3))
	(make-alive 5 (- *t_width* 4))
	(make-alive 5 (- *t_width* 5))
	(make-alive 4 (- *t_width* 5))
	(make-alive 3 (- *t_width* 5))
	(make-alive 2 (- *t_width* 5))
)

(defun draw-microb-right()
	(if (and (<= *t_height* 5) (<= *t_width* 4))
		(return-from draw-microb-right nil))
	(make-alive (- *t_height* 1) 2)
	(make-alive (- *t_height* 1) 4)
	(make-alive (- *t_height* 2) 1)
	(make-alive (- *t_height* 3) 1)
	(make-alive (- *t_height* 4) 1)
	(make-alive (- *t_height* 5) 1)
	(make-alive (- *t_height* 5) 2)
	(make-alive (- *t_height* 5) 3)
	(make-alive (- *t_height* 4) 4)
)

(defun draw-glider-right()
	(if (and (<= *t_height* 3) (<= *t_width* 3))
		(return-from draw-glider-right nil))
	(make-alive (- *t_height* 1) (- *t_width* 1))
	(make-alive (- *t_height* 2) (- *t_width* 2))
	(make-alive (- *t_height* 3) (- *t_width* 2))
	(make-alive (- *t_height* 1) (- *t_width* 3))
	(make-alive (- *t_height* 2) (- *t_width* 3))
)

(defun draw-glider-left()
	(if (and (<= *t_height* 3) (<= *t_width* 3))
		(return-from draw-glider-left nil))
	(make-alive 0 0)
	(make-alive 1 1)
	(make-alive 2 1)
	(make-alive 0 2)
	(make-alive 1 2)
)

(defun draw(hp)
	(sdl:clear-display sdl:*black*)
	(dotimes (x *t_height*)
		(dotimes (y *t_width*)
			(if (eq hp 1)
				(setf (aref (aref *map* x) y) (aref (aref *tmp_map* x) y)))
			(if (= (aref (aref *color* x) y) 1)
				(sdl:draw-box-* (convert x *ox*) (convert y *oy*) (- (convert 1 0) 1) (- (convert 1 0) 1) :color sdl:*blue*))
			(if (= (aref (aref *map* x) y) 1)
				(if (eq (aref (aref *color* x) y) 2)
					(sdl:draw-box-* (convert x *ox*) (convert y *oy*) (- (convert 1 0) 1) (- (convert 1 0) 1) :color sdl:*white*)
					(if (eq (aref (aref *color* x) y) 3)
						(sdl:draw-box-* (convert x *ox*) (convert y *oy*) (- (convert 1 0) 1) (- (convert 1 0) 1) :color sdl:*red*))
				)
			)
			(if (= *grid_switcher* 1)
				(let ((dx (convert x *ox*))(dy (convert y *oy*)))
					(sdl:draw-line-* dx dy (+ (convert 1 0) dx) dy :color sdl:*white*)
					(sdl:draw-line-* dx dy dx (+ (convert 1 0) dy) :color sdl:*white*)
					(if (= x (- *t_height* 1))
						(sdl:draw-line-* (+ (convert 1 0) dx) dy (+ (convert 1 0) dx) (+ (convert 1 0) dy) :color sdl:*white*))
					(if (= y (- *t_width* 1))
						(sdl:draw-line-* dx (+ (convert 1 0) dy) (+ (convert 1 0) dx) (+ (convert 1 0) dy) :color sdl:*white*))						
				))
		)
	)	
	(sdl:update-display)
)

(defun count-colisions(x y)
	(let ((times 0))
		(do ((dx (- x 1) (+ dx 1)))
			((= dx (+ x 2)))
			(do ((dy (- y 1) (+ dy 1)))
				((= dy (+ y 2)))
				(if (AND (>= dx 0) (>= dy 0) (< dx *t_height*) (< dy *t_width*) (= (aref (aref *map* dx) dy) 1))
					(if (not (AND (= dx x) (= dy y)))
						(setq times (+ times 1)))
				)
			)
		)
		(return-from count-colisions times)
	)
)

(defun game()
	(if (= *pause* 0)
		(progn
			(copy-array *tmp_map* *map*)
			(dotimes (x *t_height*)
				(dotimes (y *t_width*)
					(let ((c_c (count-colisions x y)))
						(if (AND (= (aref (aref *map* x) y) 1) (or (< c_c 2) (> c_c 3))) ; dead
							(progn
								(setf (aref (aref *tmp_map* x) y) 0)
								(setf (aref (aref *color* x) y) 1)
							)
							(if (AND (= (aref (aref *map* x) y) 0) (= c_c 3)) ;new
								(progn
									(setf (aref (aref *tmp_map* x) y) 1)
									(setf (aref (aref *color* x) y) 2)
								)
								(progn
									(setf (aref (aref *tmp_map* x) y) (aref (aref *map* x) y)) ;old
									(if (not (= (aref (aref *color* x) y) 1))
										(setf (aref (aref *color* x) y) 3))
								)
							)
						)
					)
				)
			)
			(draw 1)
			(sleep (/ *speed* 50.0))
		)
	)
)

(defun main(av)
	(if (AND	(not (or (< (length av) 2)
					(> (length av) 3)
					(eq (second av) "-h")
					(eq (second av) "--help")))
				(not (or (eq (second av) nil) (eq (third av) nil)))
				(not (equalp (parse-integer (second av) :junk-allowed t) nil))
				(not (equalp (parse-integer (third av) :junk-allowed t) nil)))
		(progn
			(setq *t_height* (parse-integer (second av) :junk-allowed t))
			(setq *t_width* (parse-integer (third av) :junk-allowed t))
		)
		(show-help)
	)
	(setq *map* (init-array))
	(setq *tmp_map* (init-array))
	(setq *color* (init-color))
	(sdl:with-init ()
		(sdl:window *w_width* *w_height* :title-caption "The Game of Life")
		(setf (sdl:frame-rate) 60)
		(draw nil)
		(sdl:enable-key-repeat 1 1)
		(sdl:with-events ()
			(:quit-event () (exit))
			(:key-down-event (:key key)
				(case key
					(:sdl-key-escape (exit))
					(:sdl-key-w (setq *oy* (- *oy* 10)))
					(:sdl-key-a (setq *ox* (- *ox* 10)))
					(:sdl-key-s (setq *oy* (+ *oy* 10)))
					(:sdl-key-d (setq *ox* (+ *ox* 10)))
					(:sdl-key-period (if (>= (- *speed* 2) 0) (setq *speed* (- *speed* 2))))
					(:sdl-key-comma (setq *speed* (+ *speed* 2)))
					(:sdl-key-kp-plus (setq *zoom* (+ *zoom* 2)))
					(:sdl-key-kp-minus (if (> (- *zoom* 2) 0) (setq *zoom* (- *zoom* 2))))
					(:sdl-key-c (center))
					(:sdl-key-r (progn 
									(setq *map* (init-array))
									(setq *color* (init-color))
									(setf *pause* 1)
									(setf *grid_switcher* 1)
								)
					)					
					(:sdl-key-p (setq *pause* (- 1 *pause*)))
					(:sdl-key-g (setq *grid_switcher* (- 1 *grid_switcher*)))
					(:sdl-key-lshift (setf *interactive-mode* 1))
					(:sdl-key-1 (draw-big-explosion))
					(:sdl-key-2 (draw-small-explosion))
					(:sdl-key-3 (draw-microb-right))
					(:sdl-key-4 (draw-microb-left))
					(:sdl-key-5 (draw-glider-left))
					(:sdl-key-6 (draw-glider-right))
				)
				(draw nil)
			)
			(:key-up-event (:key key)
				(case key
					(:sdl-key-lshift (progn (setf *drag-position* nil) (setf *interactive-mode* 0))))
			)
			(:mouse-button-down-event (:button button :x x :y y)
				(if (= button 4)
					(if (= *interactive-mode* 0)
						(setq *zoom* (+ *zoom* 2))
						(if (>= (- *speed* 2) 0) (setq *speed* (- *speed* 2)))
					)
				)
				(if (= button 5)
					(if (= *interactive-mode* 0)
						(setq *zoom* (- *zoom* 2))
						(setq *speed* (+ *speed* 2))
					)
				)
				(if (= button sdl:mouse-left)
					(let ((dx (unconvert x *ox*)) (dy (unconvert y *oy*)))
						(if (= *interactive-mode* 1)
							(setf *drag-position* (list (sdl:mouse-x) (sdl:mouse-y))))
						(if (AND (>= dx 0) (>= dy 0) (< dx *t_height*) (< dy *t_width*) (= *interactive-mode* 0))
							(if (= (aref (aref *map* dx) dy) 0)
								(make-alive dx dy)
								(setf (aref (aref *map* dx) dy) 0)
							)
						)
					)
				)
				(draw nil)
			)
			(:mouse-button-up-event (:button button)
				(if (= button sdl:mouse-left)
					(setf *drag-position* nil)
				)
			)
			(:idle ()
				(game)
				(if (not (eq *drag-position* nil))
					(let ((dx (sdl:mouse-x)) (dy (sdl:mouse-y)))
						(setf *ox* (+ (- dx (first *drag-position*)) *ox*))
						(setf *oy* (+ (- dy (second *drag-position*)) *oy*))
						(setf *drag-position* (list dx dy))
						(draw nil)
					)
				)
			)
		)
	)
)

(sb-int:with-float-traps-masked (:invalid :inexact :overflow)
	(main *posix-argv*))