50257 topo (load "maths.lisp") (defparameter *surface-height* 2000) (defparameter *surface-width* 2000) (defparameter *ground-size* 400) (defparameter *position-x* (/ *ground-size* 2.0)) (defparameter *position-y* (/ *ground-size* 2.0)) (defparameter *distance* (* *ground-size* 0.5)) (defparameter *rotate-x* 0.0) (defparameter *rotate-y* 45.0) (defparameter *viewports* 1) (defparameter *positioning* nil) (defparameter *zooming* nil) (defparameter *rotating* nil) (defparameter *tile-width* (/ 1772 4)) (defparameter *tile-height* (/ 1772 4)) (defparameter *tiles-wide* 4) ; for hires screenshots (defparameter *view-depth* (cons (/ *ground-size* 16) (* *ground-size* 4))) (defun rotate-camera (xrel yrel) (setf *rotate-x* (mod (+ *rotate-x* (/ (* xrel 360) *surface-width*)) 360.0)) (incf *rotate-y* (/ (* yrel 180) *surface-height*)) (when (< *rotate-y* 0.0) (setf *rotate-y* 0.0)) (when (> *rotate-y* 90.0) (setf *rotate-y* 90.0))) (defun move-camera (xrel yrel) (decf *position-x* (/ (* (cos (- (* maths:+pi/180+ *rotate-x*))) xrel *ground-size*) *surface-width*)) (decf *position-y* (/ (* (sin (- (* maths:+pi/180+ *rotate-x*))) xrel *ground-size*) *surface-width*)) (incf *position-x* (/ (* (sin (* maths:+pi/180+ *rotate-x*)) yrel *ground-size*) *surface-width*)) (incf *position-y* (/ (* (cos (* maths:+pi/180+ *rotate-x*)) yrel *ground-size*) *surface-width*))) (defun zoom-camera (zrel) (incf *distance* (/ (* zrel *surface-width*) *surface-height*)) (when (< *distance* (car *view-depth*)) (setf *distance* (car *view-depth*)))) (defparameter *last-x* 0) (defparameter *last-y* 0) (cffi:defcallback special-callback :void ((key :unsigned-int) (x :int) (y :int)) "GLUT 'special' keys handler callback" (cond ((= key glut:+key-left+) (format t "asdsd"));; (move-camera 0 10)) ((= key glut:+key-down+) (move-camera 0 -10)) ((= key glut:+key-page-up+) (zoom-camera -5)) ((= key glut:+key-page-down+) (zoom-camera 5)) (t (format t "special callback: key ~a x ~a y ~a~%" key x y)))) (cffi:defcallback motion-callback :void ((x :int) (y :int)) "GLUT mouse motion handler callback" (let ((xrel (- x *last-x*)) (yrel (- y *last-y*))) (cond (*rotating* (rotate-camera xrel yrel)) (*positioning* (move-camera xrel yrel)) (*zooming* (zoom-camera yrel)))) (setf *last-x* x *last-y* y)) (cffi:defcallback mouse-callback :void ((button :int) (state :int) (x :int) (y :int)) "GLUT mouse button callback" (setf *last-x* x *last-y* y) (cond ((= button glut:+right-button+) (setf *positioning* (= state glut:+down+))) ((= button glut:+middle-button+) (setf *zooming* (= state glut:+down+))) (t (setf *rotating* (= state glut:+down+))))) 3403171037 #lispcafe Common Lisp