[GLUTによる「手抜き」OpenGL入門]をcommon lispで

hello_glut.lisp

(ql:quickload :cl-glut)

(defclass main-window (glut:window)
  ()
  (:default-initargs :pos-x 100 :pos-y 100 :width 320 :height 240 :title "hello opengl"
                     :mode '(:single :rgba)))

(defmethod glut:display-window :before ((w main-window))
  (gl:clear-color 1 1 1 1))

(defparameter *points* nil)

(defmethod glut:display ((w main-window))
  (gl:clear :color-buffer-bit)
  (gl:color 0 0 0)
  (gl:begin :lines)
  (mapc (lambda (p) (gl:vertex (car p) (cdr p)))
        *points*)
  (gl:end)
  (gl:flush))

(defmethod glut:reshape ((w main-window) width height)
  (gl:viewport 0 0 width height)
  (gl:load-identity)
  (gl:ortho -0.5 (- width 0.5) (- height 0.5) -0.5 -1.0 1.0))

(defmethod glut:mouse ((w main-window) button state x y)
  (case button
    (:left-button
     (setf *points* (cons (cons x y) *points*))
     (when (eq state :up)
       (gl:color 0 0 0)
       (gl:begin :lines)
       (gl:vertex (car (second *points*)) (cdr (second *points*)))
       (gl:vertex x y)
       (gl:end)
       (gl:flush)))
    (t nil)))

(defmethod glut:keyboard ((w main-window) key x y)
  (declare (ignore x y))
  (when (eql key #\Esc)
    (glut:destroy-current-window)))

(defun main ()
  (glut:display-window (make-instance 'main-window)))

;; reload and run
(defun -main ()
  (load "painter.lisp")
  (main))