ybot_dipole.xtm

(sys:load-preload-check 'ybot_dipole)
(define *xtmlib-ybot_dipole-loaded* #f)

(impc:aot:suppress-aot-do
 (sys:load "libs/external/gl/gl-objects.xtm")
 (sys:load "libs/external/glfw3.xtm"))
(impc:aot:insert-forms
 (sys:load "libs/external/gl/gl-objects.xtm")
 (sys:load "libs/external/glfw3.xtm"))


;;;;;;;;;;;;;;; Overrides of library functions ;;;;;;;;;;;
;; this function from gl-objects is over-ridden here to suppress logging output
(bind-func VBO_create
  (lambda (buf:float* buflen)
    (let ((vbo:VBO* (halloc))
          (id:GLuint* (salloc)))
      (glGenBuffers 1 id)
      (gl_print_error "Error creating VBO")
      (tfill! vbo
              (pref id 0)
              GL_FLOAT
              (* buflen 4) ;; sizeof(float)
              (cast buf GLvoid*))
      (glBindBuffer GL_ARRAY_BUFFER (VBO_id vbo))
      (glBufferData GL_ARRAY_BUFFER (VBO_size vbo) (VBO_data vbo) GL_STREAM_DRAW)
      (gl_print_error "Error setting VBO data")
      vbo)))

;; we want different window settings to the default glfw3.xtm
(bind-func glfw_create_fullscreen_interaction_window
  "creates a windowed fullscreen window (i.e. doesn't change video mode)"
  (let ((window_title:i8* (zalloc 128)))
    (lambda (mon)
      (sprintf window_title "Extempore OpenGL Window")
      (let ((monitor mon) ;;(glfwGetPrimaryMonitor))
            (vidmode (glfwGetVideoMode monitor))
            (width (tref vidmode 0))
            (height (tref vidmode 1))
            (res:GLFWwindow* null))
        (glfwWindowHint GLFW_DECORATED 0)
        (glfwWindowHint GLFW_AUTO_ICONIFY 0)
        (register_for_window_events)
        (set! res (glfwCreateWindow width height window_title monitor null))
        (glfwSetWindowPos res 0 0)
        res))))

(bind-func glfw_create_fullscreen_interaction_window
  (lambda ()
    (glfw_create_fullscreen_interaction_window:[i8*,i8*]* (glfwGetPrimaryMonitor))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; this actually creates the window
(bind-val window GLFWwindow*
  (begin
    (glfwSetErrorCallback (convert (get_native_fptr glfw_error_callback)))
    (glfw_init_and_create_fullscreen_interaction_window)))
;; (bind-val window GLFWwindow*
;;   (begin
;;     (glfwSetErrorCallback (convert (get_native_fptr glfw_error_callback)))
;;     (glfw_init_and_create_interaction_window SL SL)))


;; Once the window is created we can query its properties
(bind-val pixel_ratio float (glfw_get_pixel_ratio window))
(bind-val width float (glfw_get_window_width window))
(bind-val height float (glfw_get_window_height window))
(bind-val w GLuint (ftoi32 width))
(bind-val h GLuint (ftoi32 height))
(bind-val ar float (/ height width))
(bind-val cx float (/ width 2.0:float))
(bind-val cy float (/ height 2.0:float))


;; this is the video frame-rate
(bind-val FRAMERATE float 60.)
(bind-val FRAMEDURATION float (/ 1. FRAMERATE))
(bind-val FRAMEDELTA float (* SAMPLERATE (/ 1. FRAMERATE)))
(bind-func frame_rate:[float,float]*
  (lambda (rate)
    (set! FRAMERATE rate)
    (set! FRAMEDURATION (/ 1. FRAMERATE))
    (set! FRAMEDELTA (* SAMPLERATE (/ 1. FRAMERATE)))
    rate))


;;;;;;;;; Texture management ;;;;;;;;
(bind-func texture1D_bind_data
  (lambda (tex:Texture data:float* loop:bool size:i32 slot:i32)
    (let ((slot_id:GLenum (+ slot GL_TEXTURE0)))
      (glActiveTexture slot_id)
      (glBindTexture GL_TEXTURE_1D tex)
      (glTexImage1D GL_TEXTURE_1D 0 GL_RGBA32F size 0 GL_RGBA GL_FLOAT (convert data))
      (if loop
        (glTexParameteri GL_TEXTURE_1D GL_TEXTURE_WRAP_S GL_REPEAT)
        (glTexParameteri GL_TEXTURE_1D GL_TEXTURE_WRAP_S GL_CLAMP_TO_BORDER))
      (glTexParameteri GL_TEXTURE_1D GL_TEXTURE_MIN_FILTER GL_LINEAR)
      (glTexParameteri GL_TEXTURE_1D GL_TEXTURE_MAG_FILTER GL_LINEAR)
      (gl_print_error "error in texture1D_bind_data")
      #t)))


(bind-func texture1D_update_data
  (lambda (tex:Texture data:float* loop:bool size:i32 slot:i32)
    (let ((slot_id:GLenum (+ slot GL_TEXTURE0)))
      (glActiveTexture slot_id)
      (glBindTexture GL_TEXTURE_1D tex)
      (glTexSubImage1D GL_TEXTURE_1D 0 0 size GL_RGBA GL_FLOAT (convert data))
      (if loop
        (glTexParameteri GL_TEXTURE_1D GL_TEXTURE_WRAP_S GL_REPEAT)
        (glTexParameteri GL_TEXTURE_1D GL_TEXTURE_WRAP_S GL_CLAMP_TO_BORDER))
      (gl_print_error "error in texture1D_bind_data")
      #t)))


(bind-func texture2D_bind_data_using_slot
  (lambda (tex:Texture data:float* width height chan:i32 slot:i32)
    (let ((slot_id:GLenum (+ slot GL_TEXTURE0))
           (format (cond ((= chan 1) GL_R32F)
                        ((= chan 3) GL_RGB32F)
                        ((= chan 4) GL_RGBA32F)
                        (else 0:i32))))
          (cond
           ((= format 0) (println "Error: only chan must be 1, 3 or 4.") #f)
           (else
            (glActiveTexture slot_id)
            (glBindTexture GL_TEXTURE_2D tex)
            (glTexImage2D GL_TEXTURE_2D 0 GL_RGBA32F width height 0 GL_RGBA GL_FLOAT (convert data))
            ;; set some parameters
            (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP_TO_EDGE)
            (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP_TO_EDGE)
            (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR)
            (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR)
            (gl_print_error "error in texture_bind_image_to_slot")
            #t)))))


(bind-func FBO_load_texture_to_colour_attachment_using_slot:[i32,FBO*,Texture,i32,i32]*
  (lambda (fbo:FBO* tex:Texture attachment:i32 slot:i32)
    (let ((attachment_id:GLenum (+ attachment GL_COLOR_ATTACHMENT0))
          (slot_id:GLenum (+ slot GL_TEXTURE0)))
      (cond
       ((= (glIsTexture tex) GL_TRUE)
        (glActiveTexture slot_id)
        (glBindTexture GL_TEXTURE_2D tex)
        (glBindFramebuffer GL_FRAMEBUFFER (FBO_id fbo))
        (glFramebufferTexture2D GL_FRAMEBUFFER attachment_id GL_TEXTURE_2D tex 0)
        (cond
         ((= (glCheckFramebufferStatus GL_FRAMEBUFFER) GL_FRAMEBUFFER_COMPLETE)
          ;; query the texture for its width and height
          (let ((tw:i32* (salloc)) (th:i32* (salloc)))
            (glGetTexLevelParameteriv GL_TEXTURE_2D 0 GL_TEXTURE_WIDTH tw)
            (glGetTexLevelParameteriv GL_TEXTURE_2D 0 GL_TEXTURE_HEIGHT th)
            ;; fill the FBO tuple with metadata
            (tfill! fbo (FBO_id fbo) tex -1 (pref tw 0) (pref th 0)))
            ;; unbind the frame buffer
            (glBindFramebuffer GL_FRAMEBUFFER 0)
            0:i32)
         (else
          (println "Error loading texture at slot " slot " into framebuffer attachment " attachment)
          (gl_print_error "Error loading texture into framebuffer")
          -2:i32)))
       (else
        (println "Error loading texture into framebuffer: texture " tex " needs to be initialised first")
        (gl_print_error "Error loading texture into framebuffer")
        -1:i32)))))


(bind-val velocity_potential_slot i32 0)
(bind-val velocity_potential_attachment i32 0)
(bind-val velocity_potential_tex Texture (Texture_create))
($ (texture2D_bind_data_using_slot velocity_potential_tex null w h 4 velocity_potential_slot))

(bind-val last_velocity_potential_slot i32 1)
(bind-val last_velocity_potential_attachment i32 1)
(bind-val last_velocity_potential_tex Texture (Texture_create))
($ (texture2D_bind_data_using_slot last_velocity_potential_tex null w h 4 last_velocity_potential_slot))

(bind-val soundfield_slot i32 2)
(bind-val soundfield_attachment i32 2)
(bind-val soundfield_tex Texture (Texture_create))
($ (texture2D_bind_data_using_slot soundfield_tex null w h 4 soundfield_slot))





;;;;;;;;;;;;; Each quad is a soundsphere ;;;;;;;;;
(bind-val acoustics_vert_data float*)
(bind-val acoustics_vao VAO*)
(bind-val acoustics_vbo VBO*)
(bind-val acoustics_prog ShaderProgram)
(bind-val acoustics_fbo FBO* (FBO_create))
(bind-val c float 343.0)
(bind-val mm_per_pixel float 1.0)
(bind-val room_half_length float (* mm_per_pixel cx))
(bind-val room_half_breadth float (* mm_per_pixel cy))

(bind-func fnow:[float]*
  (lambda ()
    (/ (i64tof (now)) (/ SRf 1.0:float))))





;;;;; Wave Table data type - basically a fixed size wavetable, of arbitrary duration, in a particular slot
;; the texture is a 1D texture containing audio sample values (all four components rgba are equal)
(bind-val wavetable_length i64 1024)
(bind-type Wavetable <Texture,float,i64> (constructor? . #f) (printer? . #f))
(bind-func Wavetable:[Wavetable*,Texture,float,i64]*
  (lambda (tex:Texture duration:float slot:i64)
    (let ((output:Wavetable* (alloc)))
      (tfill! output tex duration slot)
      output)))
(bind-func Wavetable_h:[Wavetable*,Texture,float,i64]*
  (lambda (tex:Texture duration:float slot:i64)
    (let ((output:Wavetable* (halloc)))
      (tfill! output tex duration slot)
      output)))
(bind-func Wavetable_create:[Wavetable*,bool,i64,i64]*
  (lambda (loop size slot)
    (let ((tex:Texture (Texture_create))
          (data:float* (halloc (* 4 size)))
          (i:i64 0) (j:i64 0) (cc:i64 0))
      (dotimes (i size)
        (dotimes (j 4)
          (pset! data cc 0.0:float) (set! cc (+ cc 1))))
      (texture1D_bind_data tex data loop (i64toi32 size) (i64toi32 slot))
      (Wavetable_h tex 1.0:float slot))))

(bind-func tex:[Texture,Wavetable*]* (lambda (sig) (tref sig 0)))
(bind-func tex:[Texture,Wavetable*,Texture]* (lambda (sig value) (tset! sig 0 value)))
(bind-func duration:[float,Wavetable*]* (lambda (sig) (tref sig 1)))
(bind-func duration:[float,Wavetable*,float]* (lambda (sig value) (tset! sig 1 value)))
(bind-func slot:[i64,Wavetable*]* (lambda (sig) (tref sig 2)))
(bind-func slot:[i64,Wavetable*,i64]* (lambda (sig value) (tset! sig 2 value)))


;;;;; We only need a limited number of signal generators (they can be shared by many point sources)
(bind-val wavetables Wavetable** 8)
(bind-val num_wavetables i64 0)
(bind-func create_wavetables
  (lambda ()
    (let ((i:i64 0))
      (dotimes (i 8)
        (pset! wavetables i (Wavetable_create #t wavetable_length (+ i 1))))
      void)))
(create_wavetables)


(bind-val pi float 3.14159)
(bind-val twopi float 6.283185)
(bind-func sinewave_in_wavetable:[bool,i64,float,float,float]*
  (lambda (m:i64 freq:float amp:float phase:float)
    (cond
     ((< m 8)
      (let* ((n:i64 wavetable_length)
             (sig:Wavetable* (pref wavetables m))
             (audio_tex:Texture (tex sig))
             (sl:i64 (slot sig))
             (data:float* (alloc (* 4 n)))
             (i:i64 0) (cc:i64 0)
             (d:float (/ 1.0:float (i64tof n))))
        (dotimes (i n)
          (pset! data cc (* amp (sin (* twopi (+ phase (* (/ (i64tof i) (i64tof n)) freq)))))) (set! cc (+ cc 1))
          (pset! data cc (* amp (sin (* twopi (+ phase (* (/ (i64tof i) (i64tof n)) freq)))))) (set! cc (+ cc 1))
          (pset! data cc (* amp (sin (* twopi (+ phase (* (/ (i64tof i) (i64tof n)) freq)))))) (set! cc (+ cc 1))
          (pset! data cc (* amp (sin (* twopi (+ phase (* (/ (i64tof i) (i64tof n)) freq)))))) (set! cc (+ cc 1)))
        (texture1D_update_data audio_tex data #t (i64toi32 n) (i64toi32 sl))
        #t))
     (else
      (println "Cannot use signal slot" m "as there are only 8 slots")
      #f))))



(bind-func pulse_in_wavetable:[bool,i64,float,float,float]*
  (lambda (m:i64 freq:float amp:float phase:float)
    (cond
     ((< m 8)
      (let* ((n:i64 wavetable_length)
             (sig:Wavetable* (pref wavetables m))
             (audio_tex:Texture (tex sig))
             (sl:i64 (slot sig))
             (data:float* (alloc (* 4 n)))
             (i:i64 0) (cc:i64 0)
             (e:i64 (ftoi64 (round (* (i64tof n) phase)))))
        (dotimes (i n)
          (let* ((g:i64 (i32toi64 (min (abs (i64toi32 (- i e))) (abs (i64toi32 (- (+ e n) i))) (abs (i64toi32 (- (- e n) i)))))))
            (cond
             ((< g 1000)
              (let ((val:float (* amp (exp (* -1.0:float (/ (* (i64tof g) (i64tof g)) 500.0:float))))))
                (pset! data cc val) (set! cc (+ cc 1))
                (pset! data cc val) (set! cc (+ cc 1))
                (pset! data cc val) (set! cc (+ cc 1))
                (pset! data cc val) (set! cc (+ cc 1))))
             (else
              (pset! data cc 0.0:float) (set! cc (+ cc 1))
              (pset! data cc 0.0:float) (set! cc (+ cc 1))
              (pset! data cc 0.0:float) (set! cc (+ cc 1))
              (pset! data cc 0.0:float) (set! cc (+ cc 1))))))
        (texture1D_update_data audio_tex data #t (i64toi32 n) (i64toi32 sl))
        #t))
     (else
      (println "Cannot use wavetable slot" m "as there are only 8 slots")
      #f))))
        


;; SignalSource type:  Wavetable, phase (0.0 -- 1.0), invert?, starttime (ms), loop?, x, y, radius
(bind-type SignalSource <Wavetable*,float,bool,float,bool,float,float,float,float> (constructor? . #f) (printer? . #f))
(bind-func SignalSource:[SignalSource*,Wavetable*,float,bool,float,bool,float,float,float]*
  (lambda (sig phase invert starttime loop x y r)
    (let ((source:SignalSource* (alloc)))
      (tfill! source sig phase invert starttime loop x y r)
      source)))

(bind-func SignalSource_h:[SignalSource*,Wavetable*,float,bool,float,bool,float,float,float]*
  (lambda (sig phase invert starttime loop x y r)
    (let ((source:SignalSource* (halloc)))
      (tfill! source sig phase invert starttime loop x y r)
      source)))


(bind-func  wavetable:[Wavetable*,SignalSource*]* (lambda (source) (tref source 0)))
(bind-func  wavetable:[Wavetable**,SignalSource*,Wavetable*]* (lambda (source value) (tset! source 0 value)))
(bind-func  phase:[float,SignalSource*]* (lambda (source) (tref source 1)))
(bind-func  phase:[float,SignalSource*,float]* (lambda (source value) (tset! source 1 value)))
(bind-func  invert:[bool,SignalSource*]* (lambda (source) (tref source 2)))
(bind-func  invert:[bool,SignalSource*,bool]* (lambda (source value) (tset! source 2 value)))
(bind-func  starttime:[float,SignalSource*]* (lambda (source) (tref source 3)))
(bind-func  starttime:[float,SignalSource*,float]* (lambda (source value) (tset! source 3 value)))
(bind-func  loop:[bool,SignalSource*]* (lambda (source) (tref source 4)))
(bind-func  loop:[bool,SignalSource*,bool]* (lambda (source value) (tset! source 4 value)))
(bind-func  position_x:[float,SignalSource*]* (lambda (source) (tref source 5)))
(bind-func  position_x:[float,SignalSource*,float]* (lambda (source value) (tset! source 5 value)))
(bind-func  position_y:[float,SignalSource*]* (lambda (source) (tref source 6)))
(bind-func  position_y:[float,SignalSource*,float]* (lambda (source value) (tset! source 6 value)))
(bind-func  radius:[float,SignalSource*]* (lambda (source) (tref source 7)))
(bind-func  radius:[float,SignalSource*,float]* (lambda (source value) (tset! source 7 value)))

(bind-func restart:[float,SignalSource*]*
  (lambda (src)
    (starttime src (fnow))))


(bind-func print:[void,SignalSource*]*
  (lambda (src:SignalSource*)
    (printf "Wavetable: %lld  phase: %f  invert: %s  start:  %f  x:  %f  y: %f  r: %f"
            (slot (wavetable src))
            (ftod (phase src)) (if (invert src) "yes" "no") (ftod (starttime src))
            (ftod (position_x src)) (ftod (position_y src))
            (ftod (radius src)))
    void))
            


;;;;;; Now we set up our signal sources
(bind-val sources SignalSource** 2048)
(bind-val num_sources i64 0)

(bind-func add_sinewave:[i64,float,float,float]*
  (lambda (freq amp phase)
    (let ((dur:float (/ 1.0:float freq)))
      (sinewave_in_wavetable num_wavetables freq amp phase)
      (duration (pref wavetables num_wavetables) dur)
      (set! num_wavetables (+ num_wavetables 1))
      num_wavetables)))


(bind-func add_pulse:[i64,float,float,float]*
  (lambda (freq amp phase)
    (let ((dur:float (/ 1.0:float freq)))
      (pulse_in_wavetable num_wavetables freq amp phase)
      (duration (pref wavetables num_wavetables) dur)
      (set! num_wavetables (+ num_wavetables 1))
      num_wavetables)))


(bind-func remove_all_sources
  (lambda ()
    (set! num_sources 0)
    void))

;(remove_all_sources)

(bind-func remove_all_signals
  (lambda ()
    (remove_all_sources)
    (set! num_wavetables 0)
    void))

;(remove_all_signals)


;;;;;;;;;;;;; main acoustics simulation program ;;;;;;;;;;;
(bind-func initialise_acoustics_shaders:[void]*
  (lambda ()
    (set! acoustics_prog
         (ShaderProgram_create
          (sys_slurp_file "/Users/ybot/Documents/code/ybot/ybot_extempore_library/shaders/dipole.vert")
          (sys_slurp_file "/Users/ybot/Documents/code/ybot/ybot_extempore_library/shaders/dipole.frag")))
    (let* ((N:i64 13) (data:float* (alloc (* N 6 num_sources))) (tmp:float* data) (i:i64 0) (cc:i64 0))
      (dotimes (i num_sources)
        (let* ((source:SignalSource* (pref sources i))
               (sig:Wavetable* (wavetable source))
               (sl:i32 (i64toi32 (slot sig)))
               (stt:float (starttime source))
               (dur:float (duration sig))
               (rad:float (radius source))
               (phi:float (phase source))
               (inv:float (if (invert source) -1.0 1.0))
               (px:float (position_x source))
               (py:float (position_y source))
               (pz:float 0.0))
                (pfill! tmp
                ;; x     y                               location in room (in millimetres)                            px  py  pz  slot          start  dur  rad  phase  invert?
                -1.     -1.     (* -1.0:float room_half_length) (* -1.0:float room_half_breadth)     px  py  pz  (i32tof sl)  stt   dur   rad   phi      inv
                -1.      1.     (* -1.0:float room_half_length) (* 1.0:float room_half_breadth)      px  py  pz  (i32tof sl)  stt   dur   rad   phi      inv
                 1.      1.     (* 1.0:float room_half_length)  (* 1.0:float room_half_breadth)      px  py  pz  (i32tof sl)  stt   dur   rad   phi      inv
                 1.      1.     (* 1.0:float room_half_length)  (* 1.0:float room_half_breadth)      px  py  pz  (i32tof sl)  stt   dur   rad   phi      inv
                 1.     -1.     (* 1.0:float room_half_length) (* -1.0:float room_half_breadth)      px  py  pz  (i32tof sl)  stt   dur   rad   phi      inv
                -1.    -1.     (* -1.0:float room_half_length) (* -1.0:float room_half_breadth)     px  py  pz  (i32tof sl)  stt   dur   rad   phi       inv
                )
                (set! tmp (pref-ptr tmp (* N 6)))
                ))
      (set! acoustics_vbo (VBO_create data (* N 6 num_sources)))
      (set! acoustics_vao (VAO_create))
      (VAO_bind_attribute acoustics_vao acoustics_vbo 0 2 (i64toi32 N) 0)
      (VAO_bind_attribute acoustics_vao acoustics_vbo 1 2 (i64toi32 N) 2)
      (VAO_bind_attribute acoustics_vao acoustics_vbo 2 3 (i64toi32 N) 4)
      (VAO_bind_attribute acoustics_vao acoustics_vbo 3 4 (i64toi32 N) 7)
      (VAO_bind_attribute acoustics_vao acoustics_vbo 4 2 (i64toi32 N) 11)
      ;(texture_bind_data_using_slot read_tex null L L 4 read_slot)
      ;(texture_bind_data_using_slot render_tex null w h 4 render_slot)
      (FBO_load_texture_to_colour_attachment_using_slot acoustics_fbo velocity_potential_tex velocity_potential_attachment velocity_potential_slot)
      (FBO_load_texture_to_colour_attachment_using_slot acoustics_fbo last_velocity_potential_tex last_velocity_potential_attachment last_velocity_potential_slot)
      (FBO_load_texture_to_colour_attachment_using_slot acoustics_fbo soundfield_tex soundfield_attachment soundfield_slot)
        ;(println (set! acoustics_fbo (FBO_create_with_textures w h #f)))
    void)))

(initialise_acoustics_shaders)


;; this needs to come after the initialise_acoustics_shaders definition because it calls it.
(bind-func add_point_source:[void,i64,float,bool,float,float,float,float]*
  (lambda (m:i64 phase:float invert:bool starttime:float x:float y:float r:float)
    (pset! sources num_sources (SignalSource_h (pref wavetables m) phase invert starttime #t x y r))
    (set! num_sources (+ num_sources 1))
    ;(initialise_acoustics_shaders)
    void))


;; (bind-func add_point_sources:[void,i64,i64,float*,float*,float*,float*,bool*]*
;;   (lambda (m:i64 num:i64 xs:float* ys:float* rs:float* phases:float* inverts:bool*)
;;     (let ((i:i64 0) (st:float (fnow)) (sig:Wavetable* (pref wavetables m)) (d:float (duration sig)))
;;       (dotimes (i num) 
;;         (pset! sources num_sources (SignalSource_h (pref wavetables m) (pref phases i) (pref inverts i) st  #t (pref xs i) (pref ys i) (pref rs i)))
;;         (set! num_sources (+ num_sources 1)))
;;       (initialise_acoustics_shaders)
;;       void)))


(bind-func add_horizontal_dipole:[void,i64,float,float,float,float]*
  (lambda (m:i64 x:float y:float d:float r:float)
    (let* ((h:float (/ d 2.0:float))
           (x1:float (+ x h)) (x2:float (- x h))
           (st1:float (fnow))
           (tau:float (/ d c))
           (st2 (+ st1 tau)))
      (add_point_source m 0.0 #f st1 x1 y r)
      (add_point_source m 0.0 #t st2 x2 y r)
      (initialise_acoustics_shaders))))


(bind-func add_vertical_dipole:[void,i64,float,float,float,float]*
  (lambda (m:i64 x:float y:float d:float r:float)
    (let* ((h:float (/ d 2.0:float))
           (y1:float (+ y h)) (y2:float (- y h))
           (st1:float (fnow))
           (tau:float (/ d c))
           (st2 (+ st1 tau)))
      (add_point_source m 0.0 #f st1 x y1 r)
      (add_point_source m 0.0 #t st2 x y2 r)
      (initialise_acoustics_shaders))))
      

(bind-func add_double_pole:[void,i64,float,float,float,float,float,float,bool]*
  (lambda (m:i64 x1:float y1:float x2:float y2:float r:float delay_distance:float invert:bool)
    (let* ((tau:float (/ delay_distance c))
           (st1:float (fnow))
           (st2 (+ st1 tau)))
      (add_point_source m 0.0 #f st1 x1 y1 r)
      (add_point_source m 0.0 invert st2 x2 y2 r)
      (initialise_acoustics_shaders))))


;; (bind-func line_array:[i64,i64,float]*
;;   (lambda (n delta)
;;     (let ((i:i64 0))
;;       (dotimes (i n)
;;         (add_point_source 0 0.0 (+ 200.0 (* (i64tof i) delta)) 200.0 10.0))
;;       (initialise_acoustics_shaders)
;;       n)))

;(line_array 20 5.0)


;;;;;;;;;; Soundfield calculation (from velocity potential) ;;;;;;;;;
(bind-val soundfield_vert_data float*)
(bind-val soundfield_vao VAO* (VAO_create_ss_quad))
(bind-val soundfield_vbo VBO*)
(bind-val soundfield_prog ShaderProgram)

(bind-func initialise_soundfield_shaders
  (lambda ()
    (set! soundfield_prog
         (ShaderProgram_create
          (sys_slurp_file "/Users/ybot/Documents/code/ybot/ybot_extempore_library/shaders/calculate_soundfield.vert")
          (sys_slurp_file "/Users/ybot/Documents/code/ybot/ybot_extempore_library/shaders/calculate_soundfield.frag")))
    (let ((tmp:float* (salloc 16)))
      (pfill! tmp
              ;; x     y               tex_coord
              -1.0   -1.              0.     0.
              -1.0    1.              0.     1.
               1.0   -1.              1.     0.
               1.0    1.              1.     1.
               )
    (set! soundfield_vbo (VBO_create tmp 16))
    (set! soundfield_vao (VAO_create))
    (VAO_bind_attribute soundfield_vao soundfield_vbo 0 2 4 0) ;; normalised device coordinates (x,y) origin at centre
    (VAO_bind_attribute soundfield_vao soundfield_vbo 1 2 4 2) ;; texture coordinate (x,y) origin at bottom-left
    void)))


(initialise_soundfield_shaders)




;;;;;;;;;; Preview Shaders ;;;;;;;;;
(bind-val screen_vert_data float*)
(bind-val screen_vao VAO* (VAO_create_ss_quad))
(bind-val screen_vbo VBO*)
(bind-val screen_prog ShaderProgram)

(bind-func initialise_screen_shaders
  (lambda ()
    (set! screen_prog
         (ShaderProgram_create
          (sys_slurp_file "/Users/ybot/Documents/code/ybot/ybot_extempore_library/shaders/visualise_soundfield.vert")
          (sys_slurp_file "/Users/ybot/Documents/code/ybot/ybot_extempore_library/shaders/visualise_soundfield.frag")))
    (let ((tmp:float* (salloc 16)))
      (pfill! tmp
              ;; x     y               tex_coord
              -1.0   -1.              0.     0.
              -1.0    1.              0.     1.
               1.0   -1.              1.     0.
               1.0    1.              1.     1.
               )
    (set! screen_vbo (VBO_create tmp 16))
    (set! screen_vao (VAO_create))
    (VAO_bind_attribute screen_vao screen_vbo 0 2 4 0) ;; normalised device coordinates (x,y) origin at centre
    (VAO_bind_attribute screen_vao screen_vbo 1 2 4 2) ;; texture coordinate (x,y) origin at bottom-left
    void)))


(initialise_screen_shaders)

;; (bind-func preview_texture2D:[void,Texture]*
;;   (lambda (tex:Texture)
;;     (glClampColor GL_CLAMP_READ_COLOR 0:i32)
;;     (glClearColor 0.0 0.0 0.0 1.0)
;;     (glBindFramebuffer GL_DRAW_FRAMEBUFFER 0)
;;     (glClear (bor GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
;;     (glUseProgram screen_prog)
;;     (glActiveTexture GL_TEXTURE0)
;;     (glBindVertexArray (VAO_id screen_vao))
;;     (glBindTexture GL_TEXTURE_2D tex)
;;     (glDrawArrays GL_TRIANGLE_STRIP 0 4)
;;     (glfwPollEvents)
;;     (glfwSwapBuffers window)
;;     void))


;;;;;;;;;; animation ;;;;;;;;;;
(bind-func draw_frame:[void]*
  (let ((vp_attachment_index:GLenum* (alloc))
        (lvp_attachment_index:GLenum* (alloc))
        (sf_attachment_index:GLenum* (alloc))
        (i:i64 0)
        (timeLoc (glGetUniformLocation acoustics_prog "time"))
                ;(mmppLoc (glGetUniformLocation acoustics_prog "mmpp"))
        (wavetable0Loc (glGetUniformLocation acoustics_prog "wavetable0"))
        (wavetable1Loc (glGetUniformLocation acoustics_prog "wavetable1"))
        (wavetable2Loc (glGetUniformLocation acoustics_prog "wavetable2"))
        (wavetable3Loc (glGetUniformLocation acoustics_prog "wavetable3"))
        (wavetable4Loc (glGetUniformLocation acoustics_prog "wavetable4"))
        (wavetable5Loc (glGetUniformLocation acoustics_prog "wavetable5"))
        (wavetable6Loc (glGetUniformLocation acoustics_prog "wavetable6"))
        (wavetable7Loc (glGetUniformLocation acoustics_prog "wavetable7"))
        (lastPotentialLoc (glGetUniformLocation soundfield_prog "last_potential_tex"))
        (potentialLoc (glGetUniformLocation soundfield_prog "potential_tex"))
        (dtLoc (glGetUniformLocation soundfield_prog "dt"))
        (screenTexLoc (glGetUniformLocation screen_prog "tex")))
    (pset! vp_attachment_index 0 (+ GL_COLOR_ATTACHMENT0 velocity_potential_attachment))
    (pset! lvp_attachment_index 0 (+ GL_COLOR_ATTACHMENT0 last_velocity_potential_attachment))
    (pset! sf_attachment_index 0 (+ GL_COLOR_ATTACHMENT0 soundfield_attachment))
    (glClampColor GL_CLAMP_READ_COLOR 0:i32)
    (lambda ()

      ;; TODO - read in the velocity potential and store as last velocity potential
      ;; ;; Copy the rendered texture (render_tex) into the read texture (read_tex)
      (glBindFramebuffer GL_READ_FRAMEBUFFER (FBO_id acoustics_fbo))
      (glBindTexture GL_TEXTURE_2D potential_tex)
      (glActiveTexture (+ GL_TEXTURE0 last_velocity_potential_slot))
      (glClampColor GL_CLAMP_READ_COLOR 0:i32)
      (glCopyTexImage2D GL_TEXTURE_2D 0 GL_RGBA32F 0 0 w h 0)
      
      ;; We will render into the first colour attachment of our acoustics framebuffer
      (glBindFramebuffer GL_DRAW_FRAMEBUFFER (FBO_id acoustics_fbo))
      (glDrawBuffers 1 vp_attachment_index)
      (glEnable GL_BLEND)
      (glBlendEquation GL_FUNC_ADD)
      (glBlendFunc GL_ONE GL_ONE)
      (glDisable GL_DEPTH_TEST)
      (glDisable GL_CULL_FACE)
      (glDisable GL_STENCIL_TEST)
      
      (glClampColor GL_CLAMP_READ_COLOR 0:i32)
      (glClearColor 0.0 0.0 0.0 1.0)
      (glClear (bor GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
      ;; and this rendering will sample from our signal texture
      (glUseProgram acoustics_prog)
      (dotimes (i num_wavetables)
        (let* ((sig:Wavetable* (pref wavetables i))
               (sl:i32 (i64toi32 (slot sig)))
               (tx:Texture (tex sig)))
          (glActiveTexture (+ GL_TEXTURE0 sl))
          (glBindTexture GL_TEXTURE_1D tx)))
      (glUniform1f timeLoc (fnow))
      ;;(glUniform1f mmppLoc (fnow))
      (glUniform1i wavetable0Loc 3:i32)
      (glUniform1i wavetable1Loc 4:i32)
      (glUniform1i wavetable2Loc 5:i32)
      (glUniform1i wavetable3Loc 6:i32)
      (glUniform1i wavetable4Loc 7:i32)
      (glUniform1i wavetable5Loc 8:i32)
      (glUniform1i wavetable6Loc 9:i32)
      (glUniform1i wavetable7Loc 10:i32)
      (glBindVertexArray (VAO_id acoustics_vao))
      (glClampColor GL_CLAMP_READ_COLOR 0:i32)
      (glDrawArrays GL_TRIANGLES 0 (i64toi32 (* 6 num_sources)))

      ;; calculate the soundfield from the velocity potential
      (glDrawBuffers 1 sf_attachment_index)
      


      
        ;; ;; Rebind the default buffer, which also unbinds the compute framebuffer
      (glBindFramebuffer GL_DRAW_FRAMEBUFFER 0)

      ;; ;; Copy the rendered texture (render_tex) into the read texture (read_tex)
      ;(glBindFramebuffer GL_READ_FRAMEBUFFER (FBO_id acoustics_fbo))
      ;(glBindTexture GL_TEXTURE_2D accumulator_tex)
      ;(glActiveTexture GL_TEXTURE6)
      ;(glClampColor GL_CLAMP_READ_COLOR 0:i32)
      ;(glCopyTexImage2D GL_TEXTURE_2D 0 GL_RGBA32F 0 0 L L 0)
      
    ;;;;;;; Preview the computed texture on screen ;;;;;;;
      ;; clear the default framebuffer's colour and depth buffers
      (glClearColor 0.0 0.0 0.0 1.0)
      (glClear (bor GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
    ;; our post-processing shader for the screen-space quad
      (glUseProgram screen_prog)
    ;; bind the screen quad's VAO
      (glBindVertexArray (VAO_id screen_vao))
    ;; bind the chosen texture to display
      ;;(glBindTexture GL_TEXTURE_2D (FBO_color_texture acoustics_fbo))
      (glClampColor GL_CLAMP_READ_COLOR 0:i32)
      (glActiveTexture (+ GL_TEXTURE0 render_slot))
      (glBindTexture GL_TEXTURE_2D render_tex)
      (glUniform1i screenTexLoc render_slot)
      ;(glPointSize (i32tof L))
    ;; draw the quad
      (glDrawArrays GL_TRIANGLE_STRIP 0 4)
      void)))



(bind-func poll_keyboard
  (lambda (window)
    (if (= GLFW_PRESS (glfwGetKey window GLFW_KEY_ENTER))
        (begin
          (println "ENTER pressed")
          (restart (pref sources 0))))
      void))


(bind-func draw_loop
  (let ((go:bool #t) (initialised:bool #f))
    (lambda (time:i64)
      (cond
       (go
        (draw_frame)
        (glfwPollEvents)
        (glfwSwapBuffers window)
        (poll_keyboard window)
        (let ((next_time (+ time (convert FRAMEDELTA))))
          (callback next_time draw_loop next_time)
          void))
       (else void)))))


(bind-func run_graphics:[void,bool]*
  (lambda (flag:bool)
    (cond
     (flag
      (cond
       ((draw_loop.go:bool)
        (cond
         ((draw_loop.initialised:bool)
          void)
         (else
          (draw_loop.initialised:bool #t)
          (draw_loop (now)))))
       (else
        (draw_loop.go:bool #t)
        (draw_loop (now))
        void)))
     (else
      (draw_loop.go:bool #f)
      void))))

(initialise_screen_shaders)
(initialise_acoustics_shaders)
(frame_rate 100.0)
($ (run_graphics #f))
(remove_all_signals)
(remove_all_sources)
(add_sinewave 2.0 5.0 0.0)
(add_pulse 2.0 10.0 0.0)
(add_point_source 0 0.0 0 (fnow) 0.0 0.0 10.0)
(add_horizontal_dipole 0 0.0 0.0 250.0 10.0)
(add_double_pole 0 -125.0 0.0 125.0 0.0 10.0 0.0 0)


(define *xtmlib-ybot_dipole-loaded* #t)