;;/*
;;	multiview.c
;;	Nate Robins, 1997
;;	
;;	Program that shows how to use multiple viewports in a single
;;	context (using scissoring).
;; */
;;
(in-package :common-lisp-user)

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

(in-package :multiview)


(defvar *window* nil)

(defparameter torus_list 0)
(defparameter spin_x 0.0)
(defparameter spin_y 0.0)




(defun text (string)
  (dolist (c (coerce string 'list))
    (glutBitmapCharacter GLUT_BITMAP_HELVETICA_18 (char-code c))))


(defun lists ()
  (setq torus_list (glGenLists 1))
  (glNewList torus_list GL_COMPILE)
  (glMaterialfv GL_FRONT  GL_AMBIENT (convert-array-to-pointer 'single-float #(0.24725 0.1995  0.0745  1.0)))
  (glMaterialfv GL_FRONT  GL_DIFFUSE  (convert-array-to-pointer 'single-float #(0.75164  0.60648  0.22648  1.0)))
  (glMaterialfv GL_FRONT  GL_SPECULAR (convert-array-to-pointer 'single-float #(0.628281  0.555802  0.366065  1.0)))
  (glMaterialf GL_FRONT  GL_SHININESS 41.2)
  (glMaterialfv GL_BACK  GL_AMBIENT (convert-array-to-pointer 'single-float #(0.05  0.05  0.05  1.0)))
  (glMaterialfv GL_BACK  GL_DIFFUSE (convert-array-to-pointer 'single-float #(0.4  0.4  0.4  1.0)))
  (glMaterialfv GL_BACK  GL_SPECULAR (convert-array-to-pointer 'single-float #(0.7  0.7  0.7  1.0)))
  (glMaterialf GL_BACK  GL_SHININESS  12.0)
  (glutWireTorus 0.3d0  0.5d0  16  32)
  (glEndList))


(defun init ()
  (glLightModeli GL_LIGHT_MODEL_TWO_SIDE  GL_TRUE)
  (glLightfv GL_LIGHT0 GL_POSITION (convert-array-to-pointer 'single-float #(1.0 1.0 1.0 1.0)))
  (glEnable GL_LIGHTING)
  (glEnable GL_LIGHT0)
  (glEnable GL_DEPTH_TEST)
  (glDisable GL_CULL_FACE))


(def-callback  reshape (void (width int) (height int))
  (declare (ignorable width height))
  (glClearColor 0.0 0.0 0.0 0.0))


(defun projection (width height perspective)
  (let ((ratio (coerce (/ width height) 'double-float)))
    (glMatrixMode GL_PROJECTION)
    (glLoadIdentity)
    (if perspective
	(gluPerspective 60d0 ratio 1d0 256d0)
      (glOrtho (- ratio)  ratio  (- ratio)  ratio  1.0d0  256d0))
    (glMatrixMode GL_MODELVIEW)
    (glLoadIdentity)
    (gluLookAt 0.0d0  0.0d0  2.0d0  0.0d0  0.0d0  0.0d0  0.0d0  1.0d0  0.0d0)))


(def-callback display (void)
  (let* ((width (glutGet GLUT_WINDOW_WIDTH))
	 (height (glutGet GLUT_WINDOW_HEIGHT))
	 (widthf (coerce width 'double-float))
	 (heightf (coerce height 'double-float)))
    (glViewport 0 0 width height)
    (glMatrixMode GL_PROJECTION)
    (glLoadIdentity)
    (gluOrtho2D 0.0d0 widthf 0.0d0 heightf)
    (glMatrixMode GL_MODELVIEW)
    (glLoadIdentity)
    (glClear (+ GL_COLOR_BUFFER_BIT  GL_DEPTH_BUFFER_BIT))

    (glDisable GL_LIGHTING)
    (glColor3ub 255 255 255)
    (glBegin GL_LINES)
    (glVertex2i (floor (/ width 2)) 0)
    (glVertex2i (floor (/ width 2)) height)
    (glVertex2i 0 (floor (/ height 2)))
    (glVertex2i width (floor (/ height 2)))
    (glEnd)

    (glRasterPos2i 5 5)
    (text "Front")
    (glRasterPos2i (+ (floor (/ width 2)) 5) 5)
    (text "Right")
    (glRasterPos2i 5 (+ (floor (/ height 2)) 5))
    (text "Top")
    (glRasterPos2i (+ (floor (/ width 2)) 5) (+ (floor (/ height 2)) 5))
    (text "Perspective")
    
    (glEnable GL_LIGHTING)

    (let ((width (1+ (/ width 2)))
	  (height (1+ (/ height 2))))
      (glEnable GL_SCISSOR_TEST)

      ;;    bottom_left
      (glViewport 0  0  width  height)
      (glScissor 0  0  width  height)
      ;;    front
      (projection width  height  nil)
      (glRotatef spin_y  1.0  0.0  0.0)
      (glRotatef spin_x  0.0  1.0  0.0)
     
      (glCallList torus_list)

      ;;    bottom_right
      (glViewport width  0  width  height)
      (glScissor width  0  width  height)
      ;;    right
      (projection width  height  nil)
      (glRotatef 90.0  0.0  1.0  0.0)
      (glRotatef spin_y  1.0  0.0  0.0)
      (glRotatef spin_x  0.0  1.0  0.0)
					
      (glCallList torus_list)

      ;;    top_left
      (glViewport 0  height  width  height)
      (glScissor 0  height  width  height)
      ;;    top
      (projection width  height nil)
      (glRotatef 90.0  1.0  0.0  0.0)
      (glRotatef spin_y  1.0  0.0  0.0)
      (glRotatef spin_x  0.0  1.0  0.0)
      (glCallList torus_list)
      ;;
      ;;    top_right
      (glViewport width  height  width  height)
      (glScissor width  height  width  height)
      ;;    perspective
      (projection width  height  t)
      (glRotatef 30.0  0.0  1.0  0.0)
      (glRotatef 20.0  1.0  0.0  0.0)
      (glRotatef spin_y  1.0  0.0  0.0)
      (glRotatef spin_x  0.0  1.0  0.0)
      (glCallList torus_list))
      
    (glDisable GL_SCISSOR_TEST)

    (glutSwapBuffers)))


(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-multiview nil)))
  (glutPostRedisplay))


(let ((old-x 0)
      (old-y 0))
  (def-callback mouse (void (button int) (state int) (x int) (y int))
    (declare (ignorable button state x y))
    (setq old-x x
	  old-y y)
    (glutPostRedisplay))

  (def-callback motion (void (x int) (y int))
    (setq spin_x (float (- x old-x))
	  spin_y (float (- y old-y)))
    (glutPostRedisplay)))


(defun start ()
  (glutInitDisplayMode (+ GLUT_RGB  GLUT_DEPTH  GLUT_DOUBLE))
  (glutInitWindowPosition 300 50)
  (glutInitWindowSize 512 512)

  (setq *window* (glutCreateWindow "Multiple Viewports"))
  (glutKeyboardFunc (callback keyboard))
  (glutReshapeFunc (callback reshape))
  (glutDisplayFunc (callback display))
  (glutMotionFunc (callback motion))
  (glutMouseFunc (callback mouse))
  
  (init)
  (lists)

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