ybot_osc.xtm

;; lib-loading config
(if *impc:compiler:with-cache* (sys:load "libs/aot-cache/ybot_osc.xtm" 'quiet))
(sys:load-preload-check 'ybot_osc)
(define *xtmlib-ybot_osc-loaded* #t)

(impc:aot:suppress-aot-do (sys:load "libs/contrib/ybot/ybot_adt.xtm"))
(impc:aot:insert-forms (sys:load "libs/contrib/ybot/ybot_adt.xtm" 'quiet))

(impc:aot:insert-header "xtmybot_osc")
(impc:aot:import-ll "xtmybot_osc")



;; OSCAddress is just the address string part i.e. /analogue/accX
(bind-alias OSCAddress String)

;; OSCHost: network hostname (or IP address), port
(bind-type OSCHost <String*,i64>)

(bind-func OSCHost_h:[OSCHost*,i8*,i64]*
  (lambda (ip port)
    (cond
     ((non-null ip)
      (let* ((hip (String_h ip))
             (output:OSCHost* (halloc)))
        (tfill! output hip port)
        output))
     (else null))))

(bind-func ip:[String*,OSCHost*]* (lambda (host) (tref host 0)))
(bind-func ip:[String*,OSCHost*,String*]* (lambda (host value) (tset! host 0 value)))
(bind-func port:[i64,OSCHost*]* (lambda (host) (tref host 1)))
(bind-func port:[i64,OSCHost*,i64]* (lambda (host value) (tset! host 1 value)))

;; (bind-func print:[void,OSCHost*]*
;;   (lambda (host)
;;     (printf "%s:%lld" (safe_cstr (ip host)) (port host))
;;     void))

(bind-func equal:[bool,OSCHost*,OSCHost*]*
  (lambda (host1 host2)
    (let ((ip1:String* (ip host1)) (port1:i64 (port host1))
          (ip2:String* (ip host2)) (port2:i64 (port host2)))
      (and (equal:[bool,String*,String*]* ip1 ip2) (= port1 port2)))))

(bind-func matching_host:[bool,OSCHost*,String*,i64]*
  (lambda (host test_ip test_port)
    (and (equal (ip host) test_ip) (= (port host) test_port))))
    

      
;; OSCTypeString, i.e. ",fiffs"
(bind-alias OSCTypeString String)

;; OSCMessage
(bind-type OSCMessage <OSCAddress*,OSCTypeString*,List{Variant*}*>)
(bind-func address:[OSCAddress*,OSCMessage*]* (lambda (msg) (tref msg 0)))
(bind-func address:[OSCAddress*,OSCMessage*,OSCAddress*]* (lambda (msg a) (tset! msg 0 a)))
(bind-func typestring:[OSCTypeString*,OSCMessage*]* (lambda (msg) (tref msg 1)))
(bind-func typestring:[OSCTypeString*,OSCMessage*,OSCTypeString*]* (lambda (msg t) (tset! msg 1 t)))
(bind-func arglist:[List{Variant*}*,OSCMessage*]* (lambda (msg) (tref msg 2)))
(bind-func arglist:[List{Variant*}*,OSCMessage*,List{Variant*}*]* (lambda (msg a) (tset! msg 2 a)))

  
;; OSCTimeTag
(bind-alias OSCTimeTag i64)

;; OSCBundleElement:
;; size (in bytes) of contents,
;; pointer to contents (if content is a message) or null (if contents is nested bundle),
;; pointer to nested bundle (if contents is a nested bundle) or null (if contents is a message)
(bind-type OSCBundleElement <i32,OSCMessage*,i8*>)
(bind-type OSCBundle <OSCTimeTag,List{OSCBundleElement*}*>)


;; ------ Sending OSC ------ ;;

(bind-func send:[void,OSCHost*,OSCMessage*]*
  (let* ((data:i8* (alloc 8192)) (sz:i64 0) (tapehead:i8* data)
         (pad32:[i64,i8*,i64]*
          (lambda (ptr sizeIn)
            (let ((r:i64 (modulo sizeIn 4))
                  (t:i64 (modulo (- 4 r) 4))
                  (p:i8* (pref-ptr ptr sizeIn)))
              (memset p 0 t)
              (+ sizeIn t))))
         (processPadded:[void,i8*,i64]*
          (lambda (token sizeIn)
            (memcpy tapehead token sizeIn)
            (let ((paddedSize (pad32 tapehead sizeIn)))
              (set! tapehead (pref-ptr tapehead paddedSize))
              (set! sz (+ sz paddedSize))
              void)))
         (processUnpadded:[void,i8*,i64]*
          (lambda (token sizeIn)
            (memcpy tapehead token sizeIn)
            (set! tapehead (pref-ptr tapehead sizeIn))
            (set! sz (+ sz sizeIn))
            void)))
    (lambda (host msg)
      (memset data 0 8192) (set! tapehead data) (set! sz 0)
      (let ((address_length:i64 (+ 1 (length (tref msg 0))))
            (typestring_length:i64 (+ 1 (length (tref msg 1)))))
        (processPadded (cstring (tref msg 0)) address_length)
        (processPadded (cstring (tref msg 1)) typestring_length)
        (let* ((hostname:i8* (cstring (tref host 0)))
               (port:i64 (tref host 1))
               (loop:[void,List{Variant*}*]*
                (lambda (tmp)
                  (cond
                   ((non-empty tmp)
                    (let* ((var:Variant* (car tmp))
                           (p:i8* (tref var 0))
                           (s:i64 (tref var 1))
                           (type:i8* (tref var 2)))
                      (cond
                       ((= 0:i32 (strcmp type "i32"))
                        (let ((q:i32* (salloc)))
                          (pset! q 0 (swap32i (pref (cast p i32*) 0)))
                          (processUnpadded (cast q i8*) s)))
                       ((= 0:i32 (strcmp type "float"))
                        (let ((q:i32* (salloc)))
                          (pset! q 0 (swap32f (pref (cast p float*) 0)))
                          (processPadded (cast q i8*) s)))
                       ((= 0:i32 (strcmp type "blob"))
                        (let ((blobSize:i32 (convert s))
                              (bsz:i32* (salloc)))
                          (pset! bsz 0 (swap32i blobSize))
                          (processUnpadded (cast bsz i8*) 4)
                          (processPadded p s)))
                       ((= 0:i32 (strcmp type "cstr"))
                        (processPadded p s))
                       (else
                        (println "OSC ERROR: argument has unexpected variant type " type)
                        (processPadded p s)))
                      (loop (cdr tmp))))
                   (else void)))))
          (loop (tref msg 2))
          ;(print_data data sz)
          ;(print_hex data sz) (println "")
          (llvm_send_udp hostname (i64toi32 port) data (i64toi32 sz)))))))


(bind-func osc_typestring:[OSCTypeString*,List{Variant*}*]*
  (let ((buffer:i8* (alloc 8192)) 
        (osc_type_i32:OSCTypeString* (String "i32"))
        (osc_type_float:OSCTypeString* (String "float"))
        (osc_type_string:OSCTypeString* (String "cstr"))
        (osc_type_blob:OSCTypeString* (String "blob")))
    (lambda (args:List{Variant*}*)
      (memset buffer 0 8192)
      (pset! buffer 0 44:i8)
      (let ((loop:[void,List{Variant*}*,i64]*
             (lambda (tmp cc)
               (cond
                ((non-empty tmp)
                 (let ((var:Variant* (car tmp)))
                   (cond
                    ((equal (String (tref var 2)) osc_type_i32)
                     (pset! buffer cc 105:i8))
                    ((equal (String (tref var 2)) osc_type_float)
                     (pset! buffer cc 102:i8))
                    ((equal (String (tref var 2)) osc_type_string)
                     (pset! buffer cc 115:i8))
                    ((equal (String (tref var 2)) osc_type_blob)
                     (pset! buffer cc 98:i8))
                    (else
                     (pset! buffer cc 120:i8)))
                   (loop (cdr tmp) (+ cc 1))))
                (else
                 void)))))
        (loop args 1)
        (String buffer)))))
                    

(bind-func osc_send:[void,i8*,i64,i8*,List{Variant*}*]*
  (lambda (host port address args)
    (let* ((h:OSCHost* (OSCHost (String host) port))
           (a:OSCAddress* (String address))
           (t:OSCTypeString* (osc_typestring args))
           (m:OSCMessage* (OSCMessage a t args)))
      (send h m))))


;; ------- Plotting via OSC -------- ;;
(bind-func random_string:[i8*,i64]*
  (lambda (n)
    (let* ((output:i8* (alloc n))
           (loop:[void,i64]*
            (lambda (i:i64)
              (cond 
               ((< i n)
                (let* ((r:double (* 25.0 (random)))
                       (e:i8 (convert r))
                       (c:i8 (+ e 97)))
                    (pset! output i c)
                    (loop (+ i 1))))
               (else void)))))
          (loop 0)
          output)))
                    

(bind-func osc_plotter_c:[[void,float*,i64,i64,i8*,i64]*,i8*,i64]*
  (lambda (ip port)
    (lambda (data rows cols type pane)
      (let* ((N:i64 (* rows cols))
             (dataByteSz (* 4 N))
             (blockFrames:i64 (/ 4096 (* 4 cols)))
             (id:i8* (random_string 12))
             (loop
              (lambda (n:i64)
                (beginz
                  (let* ((p (pref-ptr data (* n cols)))
                         (r (- rows n))
                         (w (if (< blockFrames r) blockFrames r))
                         (q:i8* (cast p))
                         (blockBytes:i64 (* w 4 cols))
                         (blob:Blob* (Blob q blockBytes))
                         (var:Variant* (Variant blob))
                         (desc:i8* (alloc 256)))
                    (cond
                      ((= r rows)
                       ;; send a start message, with the total number of rows and cols
                       (sprintf desc "{ 'storageType' : 'ByteArray', 'class' : 'matrix', 'dataType' : 'f32', 'rows' : %ld, 'cols' : %ld, 'indexIsFirstCol' : true, 'endian' : 'little' }" (i64toi32 rows) (i64toi32 cols))
                       (osc_send ip port "/plot/start" 
                                 (list (Variant (String id)) 
                                       (Variant (String desc))
                                       (Variant (String type)) 
                                       (Variant (i64toi32 pane))))
                    
                       ;; send the first block of rows
                       (sprintf desc "{ 'storageType' : 'ByteArray', 'class' : 'matrix', 'dataType' : 'f32', 'startRow' : 0, 'rows' : %ld, 'cols' : %ld, 'indexIsFirstCol' : true, 'endian' : 'little' }" 
                                (i64toi32 w) (i64toi32 cols))
                       (osc_send ip port "/plot/continue" 
                          (list (Variant (String id))
                          (Variant (String desc))
                          var))
                       (loop (+ n w)))
                      ((< 0 r)
                       ;; send the next block of rows
                       (sprintf desc "{ 'storageType' : 'ByteArray', 'class' : 'matrix', 'dataType' : 'f32', 'startRow' : %ld, 'rows' : %ld, 'cols' : %ld, 'indexIsFirstCol' : true, 'endian' : 'little' }" 
                                (i64toi32 n) (i64toi32 w) (i64toi32 cols))
                       (osc_send ip port "/plot/continue" 
                         (list (Variant (String id))
                         (Variant (String desc))
                         var))
                    (loop (+ n w)))
                   (else 
                    ;; send the stop message
                    (osc_send ip port "/plot/stop" (list (Variant (String id))))))
                        void)))))
            (loop 0)
            void))))



;; ------ Receiving OSC ------ ;;

(bind-func strtoi64:[i64,String*]*
  (lambda (str)
    (let ((sz:i64 (length str)) (i:i64 0)
          (tmp:i8* (cstring str))
          (output:i64 0))
      (cond
       ((< 0 sz)
        (dotimes (i sz)
          (set! output (+ output (* (ftoi64 (pow 10.0 (i64tof i))) (i8toi64 (- (pref tmp (- sz (+ i 1))) 48:i8))))))
        output)
       (else output)))))


(bind-func parse_ip_address:[|4,i64|*,String*]*
  (lambda (ipstring)
    (let* ((tokens (regex_split "\\." ipstring))
           (output:|4,i64|* (alloc)))
      (println tokens)
      (cond
       ((= (length tokens) 4)
        (aset! output 0 (strtoi64 (car tokens)))
        (aset! output 1 (strtoi64 (cadr tokens)))
        (aset! output 2 (strtoi64 (caddr tokens)))
        (aset! output 3 (strtoi64 (cadddr tokens)))
        void)
       (else void))
      output)))


;; (bind-func osc_broadcast:[void,i8*,i64,i8*,List{Variant*}*]*
;;   (lambda (host port address args)
;;     (let* ((i:i64 0) (hh:|4,i64|* (parse_ip_address (String host)))
;;            (a:OSCAddress* (String address))
;;            (t:OSCTypeString* (osc_typestring args))
;;            (m:OSCMessage* (OSCMessage a t args)))
;;       (dotimes (i 255)
;;         (let ((h:OSCHost* (OSCHost (cat (format (aref hh 0)) (format (aref hh 1)) (format (aref hh 2)) (format i)) port)))
;;           (send h m))))))


(bind-func osc_parse_args:[List{Variant*}*,String*,i32*]*
  (lambda (typestring:String* data:i32*)
    (cond
     ((= (top typestring) 44:i8)
      (let ((loop:[List{Variant*}*,String*,i32*,List{Variant*}*]*
             (lambda (str ptr lst)
               (let ((c:i8 (top str)))
                 (cond
                  ((= 0:i8 c) lst)
                  ((= 105:i8 c) (loop (tail str) (pref-ptr ptr 1) (cons (Variant (unswap32i (pref ptr 0))) lst)))
                  ((= 102:i8 c) (loop (tail str) (pref-ptr ptr 1) (cons (Variant (unswap32f (pref ptr 0))) lst)))
                  ((= 115:i8 c)
                   (let* ((strArg (String (cast ptr i8*)))
                          (unpaddedBytes:i64 (+ 1 (length strArg)))
                          (num_32bit_slots:i64 (/ unpaddedBytes 4))
                          (r:i64 (- unpaddedBytes (* num_32bit_slots 4)))
                          (padded_slots:i64 (if (= r 0) num_32bit_slots (+ 1 num_32bit_slots))))
                     (loop (tail str) (pref-ptr ptr padded_slots) (cons (Variant strArg) lst))))
                  (else (printf "Unexpected type tag %c\n" c) lst))))))
        (reverse (loop (tail typestring) data null))))
     (else (printf "Badly formed typestring: %s\tTypestrings should start with a comma\n" (cstring typestring))
           null))))




(bind-func osc_parse_address:[List{String*}*,i8*]*
  (lambda (address:i8*)
    (cond
     ((non-null address)
      (let ((tokens (regex_split "/" (String address))))
        (cond
         ((non-empty tokens)
          (cond
           ((< 1 (length tokens)) (cdr tokens))
           (else tokens)))
         (else null))))
     (else null))))


;(bind-alias osc_delegate_t [i32,List{String*}*,List{Variant*}*]*)
(bind-alias osc_receiver_t [i32,i8*,i8*,i8*]*)
(bind-func osc_echo:[osc_receiver_t]*
  (lambda ()
    (lambda (address:i8* types:i8* args:i8*)
      (cond
       ((or (null? address) (null? types) (null? args))
        (println "Invalid OSC message received")
        -1:i32)
       (else
        ;;(printf "%s\t%s\t%p\n" address types args)
        (println
         "OSC received: "
         (osc_parse_address address)
         (osc_parse_args (String types) (bitcast args i32*)))
        0:i32)
        ))))

;; (bind-func osc_receive:[i32,i8*,i8*,i8*]*
;;   (let ((delegate:[i32,List{String*}*,List{Variant*}*]*
;;          (lambda (address_tokens args)
;;            (println address_tokens args)
;;            0:i32)))
;;     (lambda (address:i8* types:i8* args:i8*)
;;       (cond
;;        ((or (null? address) (null? types) (null? args))
;;         (println "Invalid OSC message received")
;;         -1:i32)
;;        (else
;;         ;;(printf "%s\t%s\t%p\n" address types args)
;;         (delegate
;;          (osc_parse_address address)
;;          (osc_parse_args (String types) (bitcast args i32*)))
;;         0:i32)
;;         ))))


;; ;;;;;;;;;;;;;;; Example Usage ;;;;;;;;;;;;;;;
;; (io:osc:start-server 8000
;;                      (impc:ti:get-mono-name osc_receive)
;;                      (llvm:get-function-pointer
;;                       (impc:ti:get-native-name osc_receive)))


(impc:aot:insert-footer "xtmybot_osc")