;;; A minimal OpenGL Application
;;;
;;; Philippe Brochard <hocwp@free.fr>
;;;
;;; #date#: Sat Feb  5 15:11:15 2005
;;;
;;; The authors grant you the rights to distribute
;;; and use this software as governed by the terms
;;; of the Lisp Lesser GNU Public License
;;; (http://opensource.franz.com/preamble.html),
;;; known as the LLGPL.

(in-package :common-lisp-user)

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

(in-package :min-app)

(defvar *window* nil)

(def-callback reshape (void (width int) (height int))
  (glViewport 0  0  width  height)
  (glMatrixMode GL_PROJECTION)
  (glLoadIdentity))



(def-callback display (void)
  (glutSwapBuffers))



(def-callback mouse (void (button int) (state int) (x int) (y int))
  (format t "Mouse: button=~A  state=~A  x=~A  y=~A~%" button state x y))


(def-callback motion (void (x int) (y int))
  (format t "Mouse motion: x=~A  y=~A~%" x y))


(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))
  (format t "Key: ~C [~A]  x=~A  y=~A~%" (code-char key) key x y)
  (case (code-char key)
    (#\Tab (swap-fullscreen))
    (#\Escape
     (glutDestroyWindow *window*)
     (throw :exit-null nil))))


(def-callback special-key (void (key int) (x int) (y int))
  (format t "Special Key: ~A  x=~A  y=~A~%" key x y))



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

  ;;(glutInit 0 "")

  (setq *window* (glutCreateWindow "Min App"))
  (glutKeyboardFunc (callback keyboard))
  (glutSpecialUpFunc (callback special-key))
  (glutDisplayFunc (callback display))
  (glutReshapeFunc (callback reshape))
  (glutMotionFunc (callback motion))
  (glutMouseFunc (callback mouse))

  (catch :exit-null
    (glutMainLoop))

  (ignore-errors (glutMainLoopEvent))
  (format t "Done~%"))