;;;/* 
;;;    starfield.c
;;;    Nate Robins  1997
;;;
;;;    An example of starfields in OpenGL.
;;;
;;; */
;;;
(in-package :common-lisp-user)

(defpackage :starfield
  (:use :common-lisp #-SBCL :ext #+SBCL :sb-ext :gl :ffi-glue)
  (:export :start))
	

(in-package :starfield)


(defvar *window* nil)

(defparameter SCREEN_SAVER_MODE nil)


(defstruct star x y vx vy)


(defparameter num-stars 150)


(defparameter stars (make-array num-stars))


(def-callback reshape (void (width int) (height int))
  (glViewport 0  0  width  height)
  (glMatrixMode GL_PROJECTION)
  (glLoadIdentity)
  (glOrtho 0d0  (coerce width 'double-float)  0d0  (coerce height 'double-float)  -1d0  1d0)
  (glMatrixMode GL_MODELVIEW)
  (glLoadIdentity)
  (glColor3ub 255  255  255)

  (dotimes (i num-stars)
    (setf (aref stars i)
	  (make-star :x (random width)
		     :y (random height)
		     :vx (+ (random 5) 2)
		     :vy 0))))


(def-callback display (void)
  (glClear GL_COLOR_BUFFER_BIT)

  (dotimes (i num-stars)
    (let ((star (aref stars i)))
      (incf (star-x star) (star-vx star))
      (if (< (star-x star) (glutGet GLUT_WINDOW_WIDTH))
	  (progn
	    (glBegin GL_LINE_STRIP)
	    (glColor3ub 0  0  0)
	    (glVertex2i (- (star-x star) (* (star-vx star) 4))  (star-y star))
	    (glColor3ub 255  255  255)
	    (glVertex2i (star-x star) (star-y star))
	    (glEnd))
	(setf (star-x star) 0))))
  (glutSwapBuffers))


(def-callback idle (void)
  (glutPostRedisplay))


(let ((old_x 50)
      (old_y 50)
      (old_width 320)
      (old_height 320))
  (defun swap-fullscreen ()
    (if (< (glutGet GLUT_WINDOW_WIDTH)  (glutGet GLUT_SCREEN_WIDTH))
	(progn
	  (setq old_x (glutGet GLUT_WINDOW_X)
		old_y (glutGet GLUT_WINDOW_Y)
		old_width (glutGet GLUT_WINDOW_WIDTH)
		old_height (glutGet GLUT_WINDOW_HEIGHT))
	  (glutFullScreen))
      (progn
	(glutPositionWindow old_x  old_y)
	(glutReshapeWindow old_width  old_height)))
    (glutPostRedisplay)))


(def-callback keyboard (void (key int) (x int) (y int))
  (declare (ignorable key x y))
  (case (code-char key)
    (#\Tab (swap-fullscreen))
    (#\Escape
     (glutDestroyWindow *window*)
     (throw :exit-starfield nil))))


(defun start ()
  (glutInitDisplayMode (+ GLUT_DOUBLE  GLUT_RGBA))
  (glutInitWindowPosition 50  50)
  (glutInitWindowSize 320  320)

  (setq *window* (glutCreateWindow "Starfield"))
  (glutDisplayFunc (callback display))
  (glutReshapeFunc (callback reshape))
  (if SCREEN_SAVER_MODE
      (progn
	(glutKeyboardFunc (callback keyboard))
	(glutSetCursor GLUT_CURSOR_NONE)
	(glutFullScreen))
    (glutKeyboardFunc (callback keyboard)))

  (glutIdleFunc (callback idle))

  (funcall-callback reshape (function void int int) 320 320)
  
  (catch :exit-starfield
    (glutMainLoop))
  (ignore-errors (glutMainLoopEvent))
  (format t "Done~%"))