Paste number 69056: spheres

Paste number 69056: spheres
Pasted by: asd
When:3 years, 3 months ago
Share:Tweet this! | http://paste.lisp.org/+1HA8
Channel:#lispcafe
Paste contents:
Raw Source | XML | Display As
(asdf:oos 'asdf:load-op :cl-opengl)
(asdf:oos 'asdf:load-op :cl-glu)
;;(asdf:oos 'asdf:load-op :curry)
(load "glut.lisp")
(load "/users/topo/slime-2.0/swank-loader.lisp")




(defparameter *window-width* 640)
(defparameter *window-height* 480)

(defstruct sphero (x) (y) (r))
(defparameter *time* 0)

(defun time-in-seconds ()
  (float (/ (get-internal-real-time) internal-time-units-per-second)))

(defmacro safe-cffi-callback (lisp-function &rest parameter-list &aux (callback-tmpname (gensym)))
  `(prog2
         (cffi:defcallback ,callback-tmpname :void ,parameter-list
           (handler-case (,lisp-function ,@(mapcar #'car parameter-list))
             (error (condition)
               (setf (symbol-function ',lisp-function) (constantly nil))
               (format t "Error in ~a: ~a~%" ',lisp-function condition))))
         (cffi:callback ,callback-tmpname)))

;;(nth i l)


(defun draw-sphere (sphero) 
  (gl:push-matrix)
  (gl:translate (sphero-x sphero)   (sphero-y sphero)  -2.2)
  ;;(setf d (random 3) ) 
  ;;(setf (sphero-x sphero)  (+ (sphero-x sphero) (- (random 3 ) 1 )))
  
  ;;acaba abajo se mueven muy rapido los agenets
  ;;el problema esta en que se  le suma uno o menos uno , la cosa seria 0.4 o -0.4
  
  
  ;;d = sqrt(((sphero-x - xran)*((sphero-x-xran) +((sphero-y-yran) * ((sphero-y-yran))
  ;;como hacer un acumulador que suba o baje 0.4
  (gl:color (sphero-r sphero) 1 0)
  (setf (sphero-x sphero)  (+ (sphero-x sphero) (/ (- (random 3 ) 1 ) 12)))
  (setf (sphero-y sphero)  (+ (sphero-y sphero) (/ (- (random 3 ) 1 ) 12)))
  (glut:solid-sphere 2.0099d0 24 32)
  (gl:pop-matrix)
  ;;aca abajo se calcula para que los agentes no salgan de los 4 bordes.
  (if (> (sphero-x sphero) 12)
      (setf (sphero-x sphero) ( - (sphero-x sphero) 1))
      )
  (if (> (sphero-y sphero) 12)
      (setf (sphero-y sphero)  ( - (sphero-y sphero) 1) )
      )
  (if (< (sphero-x sphero) -12)
      (setf (sphero-x sphero) ( + (sphero-x sphero) 1))
      )
  (if (< (sphero-y sphero) -12)
      (setf (sphero-y sphero)  ( + (sphero-y sphero) 1) )
      )
  
  
  )
;;(glut:solid-cube 1.d0))
;; (glut:solid-sphere (sphere-x sphere) (sphere-y sphere) (sphere-r sphere)))

(defun draw ()
  (gl:clear-color 1 0 0 1)
  (gl:clear :color-buffer-bit :depth-buffer-bit)
  
  (gl:matrix-mode :projection)
  (gl:load-identity)
  ;;(glu:ortho-2d -1 1 -1 1)
  (glu:perspective 1180 (/ 860 820) 1 65)
  (gl:matrix-mode :modelview)
  (gl:load-identity)
  (gl:color 1 1 0)
  (gl:enable :lighting)
  (gl:enable :light0)
  (gl:enable :depth-test)
  (gl:enable :color-material)
  (gl:enable :auto-normal)
  (gl:enable :normalize)
  (gl:light :light0 :position #(2.2 9.001 0.2 0))
  ;; (draw-sphere (l))
  ;; (gl:rotate 1 17 977 880)
  (gl:translate -2 -3 -22)
  (gl:rotate 119 997 27 8)
  (dotimes (i 49)
    (draw-sphere (nth i l))
    (dotimes (k 49)
      (setf di (sqrt (* (- (sphero-x (nth i l)) (sphero-x (nth k l)) )    (- (sphero-y (nth i l)) (sphero-y (nth k l)) )    ) ))
      ;;(draw-sphere ())
      (if (<  di 2)
	  ;;me dice que di es : Argument X is not a REAL: #C(0.0 8.827042)
	  ;;(nth di 1)
	  ;; (setf d 2)
	  (setf (sphero-r (nth k l))  1 )
	  )
      ))
  
  (gl:color 1 1 1)
  
  ;;  (gl:rotate 22 2 30 0)
  ;; (gl:rotate (* *time* 1) 0 1 0)
  (gl:translate -2 -3 -1.5)
  (gl:color 1 0 1)
  (gl:push-matrix)
  (gl:translate 3 6 -1.5)
  (gl:begin :quads)
  (gl:vertex -12.0 -12.0)
  (gl:vertex 12.0 -12.0)
  (gl:vertex 12.0 12.0)
  (gl:vertex -12.0 12.0)
  (gl:end)
  (gl:pop-matrix)
  (gl:color 0 0 1)
  ;;  (draw-sphere (make-sphero :x 19.0d0 :y 12 :r 10))
  (gl:color 1 0 0)
  ;; (gl:translate 2 -1 1.5)
  ;; (glut:solid-cube 2.7d0)
  (glut:swap-buffers))

(defun animate (dt))

;;d = sqrt((x-xran)*(x-xran) +(y-yran) * (y-yran))


(defun init ()

  (defvar *n* 50)
  ;;(setf l (make-sphero :x 2 :y 3 :r 0))
  (setf l (loop repeat *n* collecting (make-sphero :x (random 12) :y  (random 12) :r 0)))



  ;;(draw-sphere (make-sphere :x 400.0d0 :y 4 :r 10))
  (glut:init-posix-argv sb-ext:*posix-argv*)
  (glut:init-window-size *window-width* *window-height*)
  (glut:init-display-string "rgb double depth>=16 samples=8")
  (glut:create-window "GLUT - <Untitled>")
  
  (glut:display-func (safe-cffi-callback draw))
  (let ((last-time))
    (flet ((aux-animate (&aux (current-time (time-in-seconds))
                              (dt (- current-time
                                     (if last-time last-time current-time))))
             (setq *time* (+ *time* dt)
                   last-time current-time)
             (animate dt)
             (sb-sys:serve-all-events 0.01)
             (glut:post-redisplay)))
      (glut:idle-func (safe-cffi-callback aux-animate))))
  
  (flet ((window-resize (width height)
           (setq *window-width* width
                 *window-height* height)
           (gl:viewport 0 0 *window-width* *window-height*)))
    (glut:reshape-func (safe-cffi-callback window-resize (width :int) (height :int))))
  ;; (draw-sphere (make-sphere :x 400.0d0 :y 4 :r 10))
  (swank:create-server)
  (glut:main-loop))

(unless (boundp 'inited)
  (defparameter inited nil)
  (init))

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.