honeylisp/link/udpdebug.fnl

(local core (require :core))
(local socket (require :socket))
(local {: int16-to-bytes : int32-to-bytes : lo : in-coro} (require :lib.util))

(local config {
  :host "172.24.1.6"
  :port 6502
})

{:cmd {
   :write 0
   :read 1
   :jmp 2
   :pause 3
   :ping 4
 }
 :response {
   :ack 0
   :data 1
 }
 :pending {}
 :msgid 0
 :waiting false
 :queue []
 :connect
 (fn [self ?port ?host]
   (when (not self.connection)
     (local [port host] [(or ?port config.port) (or ?host config.host)])
     (set self.connection (assert (socket.udp)))
     (assert (self.connection:setpeername host port))
     (self.connection:settimeout 0)
     (core.add_thread #(while (self:connected?) (self:receive) (coroutine.yield)) self.connection)))
 :connected? (fn [self] (not= self.connection nil))
 :disconnect
 (fn [self]
   (when self.connection
     (self.connection:close)
     (set self.connection nil)
     (set self.pending {})))
 :next-msgid
 (fn [self]
   (set self.msgid (lo (+ self.msgid 1)))
   self.msgid)
 :send
 (fn [self cmd ?data ?callback]
   (self:enqueue
     #(let [msgid (self:next-msgid)
            msg (.. (string.char msgid cmd) (or ?data ""))]
        (print "sending" msgid cmd (length msg))
        (when ?callback
          (tset self.pending msgid ?callback)
          (set self.waiting true))
        (self.connection:send msg))))
 :receive
 (fn [self]
   (when self.connection
     (let [data (self.connection:receive)]
       (when data
         (let [msgid (string.byte (data:sub 1 1))
               cmd   (string.byte (data:sub 2 2))
               pendingfn (. self.pending msgid)]
           (print "recieved" msgid cmd)
           (when pendingfn
             (tset self.pending msgid nil)
             (pendingfn self cmd (data:sub 3)))
           (set self.waiting false)))
       (when (and (not self.waiting) (> (length self.queue) 0))
         (let [f (. self.queue 1)]
           (table.remove self.queue 1)
           (f))))))
 :enqueue (fn [self f] (table.insert self.queue f))
 :jump (fn [self addr] (self:send self.cmd.jmp (int32-to-bytes addr)))
 :coro-send
 (fn [self cmd ?data]
   (let [coro (coroutine.running)]
     (self:send cmd ?data #(coroutine.resume coro $2 $3))
     (coroutine.yield)))
 :read
 (fn [self addr len]
   (if (> len 1450)
       (let [first (self:read addr 1450)
             rest (self:read (+ addr 1450) (- len 1450))]
         (.. first rest))

     (let [(cmd data) (self:coro-send self.cmd.read (.. (int32-to-bytes addr)
                                                        (int16-to-bytes len)))] data)))
 :write
 (fn [self addr data]
   (if (> (length data) 1450) (do (self:write addr (data:sub 1 1400)) (self:write (+ addr 1400) (data:sub 1401)))
     (self:send self.cmd.write (.. (int32-to-bytes addr)
                                   (int16-to-bytes (length data))
                                   data) #nil)))
 :launch (fn [self prg] (self:jump (prg:lookup-addr prg.start-symbol)))
}