Ben / Nujel

;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; The port system for Nujel which provides an object oriented abstraction over
;;; low-level file streams

(defn cat l
      "ConCATenates all arguments into a single string"
      (def p (:new StringOutputPort))
      (doseq (c l (:return-string p))
             (:block-write p (string/display c))))


(defmacro with-string-port (name . body)
          `(let ((~name (:new StringOutputPort)))
                ~@body
                (:return-string ~name)))

(defn print (v port)
      "Display V on the standard output port"
      (display v (or port stdout)))

(defn error (v)
      "Prints v on the standard error port"
      (display v stderr))

(defn newline (port)
      "Print a single line feed character"
      (print "\r\n" port))

(defn read-line/raw (port buf)
      "Reads in a line of user input and returns it"
      (def i 0)
      (def c 0)
      (def view (:u8 buf))
      (while #t
             (while (>= i (:length buf))
                    (:length! (+ 128 (:length buf))))
             (set! c (:char-read port))
             (when (= c :end-of-file)
                   (return (if (zero? i) #nil i)))
             (when (= c #\lf)
                   (return i))
             (set! view i c)
             (set! i (inc i))))

(defn read-line ()
      "Reads in a line of user input and returns it"
      (def buf (buffer/allocate 128))
      (def len (read-line/raw stdin buf))
      (and len (buffer->string buf len)))
(def input read-line)

(defn readline (prompt)
      "Read a line of input in a user friendly way after writing PROMPT"
      (print (or prompt ""))
      (:flush-output stdout)
      (read-line))

(defn string/write (v)
      (def p (:new StringOutputPort))
      (write/raw v p #f)
      (:return-string p))

(defn string/display (v)
      (def p (:new StringOutputPort))
      (write/raw v p #t)
      (:return-string p))

(defn write (v port)
      (write/raw v (or port stdout) #f)
      #nil)

(defn display (v port)
      (write/raw v (or port stdout) #t)
      #nil)

(defclass OutputPort
  "OutputPort"

  (defn new (self handle)
        "Create a new OutputPort from a handle"
        { :prototype* self
          :handle handle
          :temp-buffer (buffer/allocate 16) })

  (defn flush-output (self)
        (file/flush* self.handle))

  (defn block-write (self buffer size)
        (file/write* self.handle buffer size))

  (defn write (self . buffers)
        (doseq (buf buffers self)
               (:block-write self buf)))

  (defn char-write (self char)
        (set! self.temp-buffer 0 char)
        (file/write* self.handle self.temp-buffer 1))

  (defn close! (self)
        (file/close* self.handle))

  (defn length (self) 0)

  (defn position (self)
        (file/tell* self.handle))

  (defn position! (self new-position)
        (file/seek* self.handle new-position 0))

  (defn file-handle (self)
        self.handle))

(defclass StringOutputPort
  "StringOutputPort"

  (defn new (self handle)
        "Create a new OutputPort from a handle"
        { :prototype* self
          :buffer-pos 0
          :buffer (buffer/allocate 16) })

  (defn flush-output (self) #t)

  (defn block-write (self buffer size)
        (def buf self.buffer)
        (when-not size (set! size (:length buffer)))
        (when (> size (- (:length buf) self.buffer-pos))
          (:length! buf (+ #x80 (bit-and (+ (:length buf) size) (bit-not #x7F)))))
        (buffer/copy buf buffer self.buffer-pos size)
        (set! self.buffer-pos (+ self.buffer-pos size)))

  (defn char-write (self char)
        (def buf self.buffer)
        (when (< (- (:length buf) self.buffer-pos) 1)
          (:length! buf (+ #x80 (:length buf))))
        (set! buf self.buffer-pos char)
        (set! self.buffer-pos (+ self.buffer-pos 1)))

  (defn write (self . buffers)
        (doseq (buf buffers self)
               (:block-write self buf)))

  (defn close! (self) self)

  (defn return-string (self)
        (buffer->string self.buffer self.buffer-pos))

  (defn length (self) 0)

  (defn position (self)
        self.buffer-pos)

  (defn position! (self pos)
        (set! self.buffer-pos (max 0 (min (:length self.buffer) pos)))))

(defclass InputPort
  "InputPort"

  (defn new (self handle)
        "Create a new OutputPort from a handle"
        { :prototype* self
          :handle handle
          :temp-buffer (buffer/allocate 16) })

  (defn block-read (self buffer size)
        (if (file/eof*? self.handle)
            :end-of-file
            (file/read* self.handle buffer size)))

  (defn length (self)
        (or (file/bytes-available* self.handle) 0))

  (defn char-read (self char)
        (when (file/eof*? self.handle)
          (return :end-of-file))
        (when-not (file/read* self.handle self.temp-buffer 1)
                  (return :end-of-file))
        (ref self.temp-buffer 0))

  (defn raw! (self)
        (file/raw* self.handle #t))

  (defn close! (self)
        (file/close* self.handle))

  (defn position (self)
        (file/tell* self.handle))

  (defn position! (self new-position)
        (file/seek* self.handle new-position 0))

  (defn file-handle (self)
        self.handle))

(def stdin (:new InputPort stdin*))
(def stdout (:new OutputPort stdout*))
(def stderr (:new OutputPort stderr*))