no title added by anonymous on Thu Oct 26 09:11:48 2017

csi: runtime.c:2797: C_save_and_reclaim: Assertion `av > C_temporary_stack_bottom || av < C_temporary_stack_limit' failed.
rlwrap: warning: csi crashed, killed by SIGABRT.
rlwrap itself has not crashed, but for transparency,
it will now kill itself (without dumping core) with the same signal

=====================

(use srfi-1)
(use qt-light)
(use utils)
(use byte-blob)
(use lolevel)
(use (prefix opengl-glew gl:) gl-utils srfi-4)
(require "simu.s")
;;;;;;;;;;;;;;;;;;;;;;;;;
;opengl
    
(define a 0)
(define b 0)
(define c 0)
(define d 0)

(define xr 0)
(define yr 0)
(define zr 0)

(define tex 0)
(define data (make-bytevector 1 0))
(define datapointer (->pointer data))

(define simustate (expand-simu 4))
(define simuwidth 0)
(define simuheight 0)


(define vert-source (read-all "s.vert"))
(define frag-source (read-all "s.frag"))

(define rect (make-mesh
              vertices: '(attributes: ((position #:float 2) )
                          initial-elements: ((position . (-1 -1
                                                           1 -1
                                                           1  1
                                                           -1  1)) ))
              indices: '(type: #:ushort
                         initial-elements: (0 1 2
                                            0 2 3))))
(define program (make-parameter #f))

(define (render)
  (check-gl
   (gl:active-texture gl:+texture1+)
   (with-vertex-array (mesh-vao rect)
     (with-texture gl:+texture-2d+ tex
       (print simuwidth " " simuheight)
       (array-print simustate)
       (gl:tex-image-2d gl:+texture-2d+ 0 gl:+red+ simuwidth simuheight 0 gl:+red+ gl:+unsigned-byte+ datapointer)
       (gl:tex-parameteri gl:+texture-2d+ gl:+texture-wrap-s+ gl:+clamp-to-edge+)
       (gl:tex-parameteri gl:+texture-2d+ gl:+texture-wrap-t+ gl:+clamp-to-edge+)
       (gl:tex-parameteri gl:+texture-2d+ gl:+texture-min-filter+ gl:+nearest+)
       (gl:tex-parameteri gl:+texture-2d+ gl:+texture-mag-filter+ gl:+nearest+)
       (gl:draw-elements-base-vertex (mode->gl (mesh-mode rect))                                                                                                                                                                                                                    
                                     (mesh-n-indices rect)
                                     (type->gl (mesh-index-type rect))
                                     #f 0) ) )
   (gl:active-texture gl:+texture0+) ))

(define gl-init
  (lambda()
    (check-gl
     (gl:init)
     
     (set! vert-shader (make-shader gl:+vertex-shader+ vert-source))
     (set! frag-shader (make-shader gl:+fragment-shader+ frag-source))
     (program (make-program (list vert-shader frag-shader)))
     (gl:use-program (program))
     (gl:program-uniform1i (program) 1 1) ; set location 1 to use tex unit 1
     (mesh-make-vao! rect `((position . ,(gl:get-attrib-location
                                          (program) "position")) ))
     
     (set! tex (gen-texture))
     )))

(define gl-resize
  (lambda (w h)
    (when (zero? h) (set! h 1));whats this for
    (gl:viewport 0 0 w h)
    ))

(define gl-paint
  (lambda()
    (render)
    ))

(define (gui)
  ;;;;;;;;;;;;;;;;;;;;;;;;;
  ;gui def

  (let* ((app (qt:init))
         (mainwindow (qt:widget (read-all "gui.ui")))
         (glparent (qt:find mainwindow "f"))
         )
    (define gl-widget (qt:gl "glwidget" glparent gl-init gl-resize gl-paint 4 3 "core"))
    (qt:layout-add-widget (qt:find mainwindow "vl") gl-widget)

    ;;;;;;;;;;;;;;;;;;;;;;;;;
    ;gui interactive
  
    (define (update-state)
      (define w (dim-size simustate 0))
      (define h (dim-size simustate 1))
      
      (set! simustate (step simustate))
      
      (set! data (array->bytevector simustate))
      
      (set! datapointer (bytevector->pointer data))
      (set! simuwidth w)
      (set! simuheight h)
      
      (set! xr (+ xr a))
      (set! yr (+ yr b))
      (set! zr (+ zr c)) )
  
    (define t (qt:timer 1/2))
    (qt:connect t "timeout()" (qt:receiver (lambda () (update-state) (qt:update gl-widget) )))
  
    (let ((sliders (map (cut qt:find mainwindow <>) '("sl1" "sl2" "sl3" "sl4")))
          (signals '("valueChanged(int)" "valueChanged(int)" "valueChanged(int)" "valueChanged(int)"))
          (fns (list (qt:receiver (lambda(val)(set! a val)))
                     (qt:receiver (lambda(val)(set! b val)))
                     (qt:receiver (lambda(val)(set! c val)))
                     (qt:receiver (lambda(val)(set! d val))) ))
          (slots '("slot(int)" "slot(int)" "slot(int)" "slot(int)")) )
      (map qt:connect sliders signals fns slots) )

    (qt:start t)

    (qt:show mainwindow)
    (qt:run) ))
;;;;;;;;;;;;;;;;;;;;;;;;;

(define (main)
  (gui))

(print (main))