(in-package :common-lisp-user)

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

(in-package :my-test)


(defvar *window* nil)
(defvar *debug* t)

(defvar *object* nil)
(defvar *object2* nil)
(defvar *object3* nil)

(defvar *rot* 0.0)
(defvar *count* 0)
(defvar *animate?* t)




(defun make-object ()
 (let ((list (glgenlists 1)))
  (glnewlist list GL_COMPILE)

  (glBegin GL_LINE_LOOP)
  (glVertex3f 1.0 0.5 -0.4)
  (glVertex3f 1.0 -0.5 -0.4)
  (glVertex3f -1.0 -0.5 -0.4)
  (glVertex3f -1.0 0.5 -0.4)
  (glEnd)

  (glBegin GL_LINE_LOOP)
  (glVertex3f 1.0 0.5 0.4)
  (glVertex3f 1.0 -0.5 0.4)
  (glVertex3f -1.0 -0.5 0.4)
  (glVertex3f -1.0 0.5 0.4)
  (glEnd)

  (glBegin GL_LINES)
  (glVertex3f 1.0 0.5 -0.4)   (glVertex3f 1.0 0.5 0.4)
  (glVertex3f 1.0 -0.5 -0.4)  (glVertex3f 1.0 -0.5 0.4)
  (glVertex3f -1.0 -0.5 -0.4) (glVertex3f -1.0 -0.5 0.4)
  (glVertex3f -1.0 0.5 -0.4)  (glVertex3f -1.0 0.5 0.4)
  (glEnd)

  (glEndList)

  list))


(defun make-object2 ()
  (let ((list (glgenlists 1)))
    (glnewlist list GL_COMPILE)
    (glColor3f 1.0 0.0 1.0)
    ;; Draw the sides of the three-sided pyramid
    (glBegin GL_TRIANGLE_FAN)
    (glVertex3f 0.0 1.0 0.0)
    (glVertex3f 0.0 -1.0 -1.0)
    (glVertex3f -1.0 -1.0 1.0)
    (glVertex3f 1.0 -1.0 1.0)
    (glVertex3f 0.0 -1.0 -1.0)
    (glEnd)

    (glColor3f 0.0 1.0 1.0)
    ;; Draw the base of the pyramid
    (glBegin GL_TRIANGLES)
    (glVertex3f 1.0 -1.0 1.0)
    (glVertex3f -1.0 -1.0 1.0)
    (glVertex3f 0.0 -1.0 -1.0)
    (glEnd)
    (glEndList)
    list))


(defun make-object3 ()
  (let ((list (glgenlists 1)))
    (glnewlist list GL_COMPILE)
    (glColor3f 0.0 1.0 0.0)

    ;; Draw the sides of the cube
    (glBegin GL_QUAD_STRIP)
    (glVertex3f 1.0 1.0 -1.0)
    (glVertex3f 1.0 -1.0 -1.0)
    (glVertex3f -1.0 1.0 -1.0)
    (glVertex3f -1.0 -1.0 -1.0)
    (glVertex3f -1.0 1.0 1.0)
    (glVertex3f -1.0 -1.0 1.0)
    (glVertex3f 1.0 1.0 1.0)
    (glVertex3f 1.0 -1.0 1.0)
    (glVertex3f 1.0 1.0 -1.0)
    (glVertex3f 1.0 -1.0 -1.0)
    (glEnd)

    (glColor3f 0.0 0.0 1.0)

    ;; Draw the top and bottom of the cube
    (glBegin GL_QUADS)
    (glVertex3f -1.0 -1.0 -1.0)
    (glVertex3f 1.0 -1.0 -1.0)
    (glVertex3f 1.0 -1.0 1.0)
    (glVertex3f -1.0 -1.0 1.0)

    (glVertex3f -1.0 1.0 1.0)
    (glVertex3f 1.0 1.0 1.0)
    (glVertex3f 1.0 1.0 -1.0)
    (glVertex3f -1.0 1.0 -1.0)
    (glEnd)
    (glEndList)
    list))


(defun make-object4 ()
  (let ((list (glgenlists 1))
	(qobj (gluNewQuadric)))
    (gluQuadricDrawStyle qobj GLU_FILL)
    (glNewList list GL_COMPILE)
    (gluSphere qobj 0.7d0 20 20)		; qobj, radius, slices, stacks
    (glEndList)
    list))


(def-callback reshape-callback (void (width int) (height int))
  (when *debug* (format t "RESHAPE. width:~a, height:~a~%" width height))
  (glViewport 0 0 width height)
  (glMatrixMode GL_PROJECTION)
  (glLoadIdentity)
  (glFrustum -1d0 1d0 -1d0 1d0 5d0 15d0)
  (glulookat 0.0d0 -5.0d0 0.0d0
	     0.0d0 0.0d0 -10.0d0
	     0.0d0 1.0d0 0.0d0)
  (glMatrixMode GL_MODELVIEW)
  (glLoadIdentity))



(def-callback draw-callback (void)
;;  (when *debug* (format t "DRAW.~%"))
  (glClear GL_COLOR_BUFFER_BIT)
  (glClear GL_DEPTH_BUFFER_BIT)
  (glPushMatrix)
  (glLoadIdentity)
  (glTranslatef 0.0 0.0 -10.0)
  (glScalef 1.0 1.0 1.0)
  (glrotatef *rot* 1.0 1.0 0.0)

  (glcalllist *object2*)

  (glLoadIdentity)
  (glTranslatef (sin (* (/ *rot* 180) 3.1415)) 0.0 -10.0)
  (glScalef 0.5 0.5 0.5)
  (glrotatef *rot* 1.0 -1.0 0.0)
  
  (glcalllist *object*)

  (glLoadIdentity)
  (glTranslatef (cos (* (/ *rot* 180) 3.1415)) -1.0 -10.0)
  (glScalef 1.0 1.0 1.0)
  (glColor3f 0.7 0.0 0.1)

  (glcalllist *object3*)  

  (glpopmatrix)

  (sleep 0.0001)
  (glutSwapBuffers))



(def-callback idle-callback (void)
  (setf *rot* (coerce (mod (incf *rot*) 360) 'single-float))
  (glutPostRedisplay))

(def-callback visible-callback (void (vis int))
  (when *debug* (format t "VISIBLE. vis:~a~%" vis))
  (cond ((= vis GLUT_VISIBLE)
	 (glutIdleFunc (callback idle-callback)))
	(t
	 (glutIdleFunc (constantly nil)))))


(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 key-callback (void (k int) (x int) (y int))
  (when *debug* (format t "KEY. k:~s, x:~s, y:~s~%" k x y))
  (case (code-char k)
    (#\Tab (swap-fullscreen))
    (#\Return
     (setf *animate?* (not *animate?*))
     (if *animate?*
	 (glutIdleFunc #'idle-callback)
       (glutIdleFunc nil)))
    (#\Escape
     (glutDestroyWindow *window*)
     (throw :exit-my-test nil))))



(defun start ()
  (glutInitDisplayMode (+ GLUT_RGB GLUT_DOUBLE))
  (glutInitWindowPosition 0 0)
  (glutInitWindowSize 500 500)
  (setq *window* (glutCreateWindow "My Test"))

  (setf *object* (make-object3))
  (setf *object2* (make-object2))
  (setf *object3* (make-object4))

  (glcullface GL_BACK)
  (glenable GL_CULL_FACE)
  (gldisable GL_DITHER)
  (glshademodel GL_FLAT)
  (glPolygonMode GL_FRONT_AND_BACK GL_FILL)
  (glEnable GL_DEPTH_TEST)
  (glcolor3f 1.0 1.0 1.0)

  (glutDisplayFunc (callback draw-callback))
  (glutReshapeFunc (callback reshape-callback))
  (glutIdleFunc (callback idle-callback))
  (glutKeyboardFunc (callback key-callback))
  (glutVisibilityFunc (callback visible-callback))

  (catch :exit-my-test
    (glutMainLoop))
  (ignore-errors (glutMainLoopEvent))
  (format t "Done~%"))