Paste number 50668: automat

Paste number 50668: automat
Pasted by: topo
8 months, 3 weeks ago
#lispcafe | Context in IRC logs
Paste contents:
Raw Source | XML | Display As
(require 'asdf)
(require 'asdf-install)
(asdf:oos 'asdf:load-op :cl-opengl)
(asdf:oos 'asdf:load-op :cl-glu)
(load "maths.lisp")
(load "glut.lisp")

(load "/Users/topo/slime-2.0/swank-loader.lisp")

(defparameter *ground-size* 200)
(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)


(cffi:defcallback special-callback :void ((key :unsigned-int) (x :int) (y :int))
  "GLUT 'special' keys handler callback"
  (cond
    ((= key glut:+key-left+)      (rotate-camera -10 0))
    ((= key glut:+key-right+)      (rotate-camera 10 0))
    ;; ((= key glut:+key-right+)     (move-camera -10 0))
    ((= key glut:+key-up+)        (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))
    ;;((= key glut:+key-f1+) (gl-toggle gl:+lighting+))
    ;;((= key glut:+key-f2+) (gl-toggle gl:+depth-test+))
    ;;((= key glut:+key-f3+) (rotate-shade-model))
    ;;((= key glut:+key-f4+) (rotate-polygon-mode gl:+front+ 0))
    ;;((= key glut:+key-f5+) (rotate-polygon-mode gl:+back+ 1))
    ;;((= key glut:+key-f6+) (gl-toggle gl:+fog+))
    ;;((= key glut:+key-f7+) (gl-toggle gl:+blend+))
    ;;((= key glut:+key-f8+) (gl-toggle gl:+cull-face+))
    (t (format t "special callback: key ~a x ~a y ~a~%" key x y))
)
)


(defvar *moco* 10.0)

(defun rotate-camera (xrel yrel)
  (setf *rotate-x* (mod (+ *rotate-x* (/ (* xrel 360) *window-width*)) 360.0))
  (incf *rotate-y* (/ (* yrel 180) *window-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)
  (format t "muevecamara")
  (decf *position-x* (/ (* (cos (- (* maths:+pi/180+ *rotate-x*))) xrel *ground-size*) *window-width*))
  (decf *position-y* (/ (* (sin (- (* maths:+pi/180+ *rotate-x*))) xrel *ground-size*) *window-width*))
  (incf *position-x* (/ (* (sin (* maths:+pi/180+ *rotate-x*)) yrel *ground-size*) *window-width*))
  (incf *position-y* (/ (* (cos (* maths:+pi/180+ *rotate-x*)) yrel *ground-size*) *window-width*))
)


(defun zoom-camera (zrel)
  (format t "Asdds")
  (incf *distance* (/ (* zrel *window-width*) *window-height*))
  ;;  (when (< *distance* (car *view-depth*))
  ;;   (setf *distance* (car *view-depth*)))
  
)



(defun scene-draw (&optional (i 1))
  (gl:load-identity)
  (gl:translate 0.0 0.0 (- *distance*))
  (let ((rotate-diff (floor (/ 360.0 *viewports*))))
    (if *rotation-drift*
        (let ((x-drift (* 5.0 (sin (* 0.05 vt0))))
              (y-drift (* 3.0 (sin (* 0.07 vt0))))
)

          (gl:rotate (+ *rotate-y* y-drift) -1.0 0.0 0.0)
          (gl:rotate (+ *rotate-x* x-drift (* i rotate-diff))  0.0 0.0 1.0)
)

        (progn
          (gl:rotate *rotate-y* -1.0 0.0 0.0)
          (gl:rotate (+ *rotate-x* (* i rotate-diff))  0.0 0.0 1.0)
)
)
)

  (gl:translate (coerce (- *position-x*) 'single-float)
                (coerce (- *position-y*) 'single-float)
                0.0
)
)


(defun hola ()
  (setf *moco* (+ *moco* 1))
  (format t "asds")
)


(defparameter *ground-size* 200)
(defparameter *distance* (* *ground-size* 0.5))
(defparameter *view-depth* 16)
(defparameter *window-width* 640)
(defparameter *window-height* 480)
(defparameter *time* 0)
(defparameter *vel-render* 0.1)

(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)
)
)


;;*************************************************************************
;;*************************************************************************
;;boton, prendido-apagado
;;el metodo mio permite manipular la estructura del cubo aprovechandome de opengl y explorar nuevas formas.
;;el automata no tiene que verse sino controla otra cosa(automata como controlador)
;;como calculo colision , generar un agente que se mueva y su velocidad.
;;seguir iteracion .deterner -con key
;;la estructura hace que los agentes interactuen de una manera.
;;pensar criterios de calidad, y nuevos estados, estudiar automatas multiestados.
;;navegar con las flechas.
;;ver la manera de crear generativamente las reglas de interaccion.
;;como medir la eficacia de una estructura?
;; que no se cubo (las pared) sino nuevas formas, aplicar crecimeinto a csas.
;;como optimizar el codigo?

(defstruct patch (c) (t) (x))

(defun draw-patch (patch)
  (gl:push-matrix)
  ;;  (gl:translate (patch-x patch) (patch-y patch) 0)
  ;;  (gl:translate (patch-y patch) 1 1)
  ;;  (gl:color (nth (patch-r patch) e) (nth (patch-r patch) e) (nth (patch-r patch) e))
  ;;  (gl:color (patch-c patch) (patch-c patch) (patch-c patch))
  (glut:solid-cube 2.d0)
  (gl:pop-matrix)
  
)



(defun draw ()
  
  ;;(glut:keyboard-func (cffi:callback keyboard-callback))
  (glut:special-func (cffi:callback special-callback))
  ;;(glut:mouse-func (cffi:callback mouse-callback))
  ;;(glut:motion-func (cffi:callback motion-callback))
  (glut:display-func (safe-cffi-callback draw))
  
  (gl:clear-color 0.8 0.9 0.9 0)
  (gl:clear :color-buffer-bit :depth-buffer-bit)
  (gl:matrix-mode :projection)
  (gl:load-identity)
  (glu:perspective 700 (/ 990 800) 1 6900)
  (gl:matrix-mode :modelview)
  (gl:load-identity)
  (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 #(0.2 0.01 0.5 0))
  ;;(gl:enable :blend)
  ;;(gl:blend-func :GL_SRC_ALPHA :GL_ONE_MINUS_SRC_ALPHA)
  ;;The value NIL is not of type (UNSIGNED-BYTE 32).
  ;;(gl:shade-model :GL_FLAT)
  (gl:rotate *moco* 2.0 4.0 0)
  ;; (gl:translate *position-x* *position-y* 0 )
  (gl:translate *position-x*  *position-y* (- *distance*))
  ;;rotar mundo
  (gl:rotate *rotate-x* *rotate-y* 9 0)
  (gl:color 0.9 1.0 0.4 )
  ;;(gl:begin :quads)
  ;;(gl:vertex -200 -200)
  ;;(gl:vertex  300 -200)
  ;;(gl:vertex  300  300)
  ;;(gl:vertex -200  300)
  ;;(gl:end)
  (gl:translate 0 0 -300)
  
  ;; los 3 primeros iteracion son para el cubo y las vienen son para los vecinos.
  ;; en el primero le resto - 2  (el primero no tienen vecino anterior , y el ultimo no tiene vecino ultimo)
  
 (dotimes (i (- *n* 2))
   (dotimes (j (- *n* 2))
     (dotimes (k (- *n* 2))
       ;;  (draw-patch (nth i p))
       (setf xx 0)
       (dotimes (ii 3)
         (dotimes (jj 3)
           (dotimes (kk 3)
             ;; aca barro los 3 vecinos
             ;; los vecinos forman un cubo de 3 por 3 menos yo mismo                
             ;;        (when (and (not(= ii 1))(not (= jj 1))(not (= kk 1) )))
             ;; este if hace que yo no sea vecino
             (incf xx (patch-c (nth (+ i ii )(nth (+ j jj )(nth (+ k kk ) l)))))
)
)
)
   
;;incf *position-y*  
       ;; aca uso una variable acumuladora , la suma de los vecinos
       
       
       (if (> xx 25.8)
           (setf (patch-c (nth i (nth j (nth k l))))(random 1.0) (patch-x (nth i (nth j (nth k l)))) 7000)
           (setf (patch-c (nth i (nth j (nth k l)))) 1 (patch-x (nth i (nth j (nth k l)))) 100)
)

       ;; aca comparo el resultado final de xx (si es mayor que 5 le pongo aleatorio ... esto lo modifico.
       
       (gl:push-matrix)
       (gl:translate (* i 10) (* j 10) (* k 10))
    
       (gl:color
        (patch-c (nth i (nth j (nth k l))))
        (patch-c (nth i (nth j (nth k l))))
        (patch-c (nth i (nth j (nth k l))))
)

       ;;(patch-t (nth i (nth j (nth k l))))
        
       (gl:translate (- (patch-x (nth i (nth j (nth k l)))) 120) 0 0)
       (glut:solid-cube 9.d0)
       (gl:pop-matrix)
)
)
)



 (glut:swap-buffers)
)



;; **********************************************************************************
;; *********************************************************************************



(defun animate (dt))

(defun init ()

  (defvar *n* 35)

  (setf l (loop repeat *n* collecting (loop repeat *n* collecting (loop repeat *n* collecting (make-patch :c (random 1.0) :t 1 :x 0)))))
  ;; creo 35 objetos patch y los metos en  mi lista l (listas anidadas)
  
  (setf e (loop repeat 2000 collecting (random 1.0)))
  ;; porque esto de arriba es siempre igual? el seed? y porque es diferente si lo cargo en el repl?
  (setf o (loop repeat 40 collecting (random 1.0)))
  ;;  (setf y (loop repeat 6 collecting (random 10.0)))
  (glut:init-posix-argv sb-ext:*posix-argv*)
  (glut:init-window-size *window-width* *window-height*)
  ;;(glut:init-display-mode :GLUT_SINGLE :GLUT_RGB :GLUT_DEPTH )
  (glut:init-display-string "rgb double depth>=16 samples=8")
  (glut:create-window "Auto-mata")
  
  
  (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 *vel-render*)
             (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)))
)

  
  (swank:create-server)
  (glut:main-loop)
)


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

This paste has no annotations.

Colorize as:
Show Line Numbers

Ads absolutely not by Google

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