;;; 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
(def make-output-port #nil)
(def make-string-output-port #nil)
(def make-input-port #nil)
(let*
(def temporary-buffer (buffer/allocate 1))
(def temporary-buffer-view (buffer/u8* temporary-buffer))
(def output-port-method-table {:flush-output (fn (handle)
(file/flush* handle))
:block-write (fn (handle buffer size)
(file/write* handle buffer size))
:char-write (fn (handle char)
(buffer/set! temporary-buffer-view 0 char)
(file/write* handle temporary-buffer-view))
:close! (fn (handle)
(file/close* handle))
:position (fn (handle)
(file/tell* handle))
:position! (fn (handle new-position)
(file/seek* handle new-position 0))
:file-handle (fn (handle) handle)
:methods (fn (handle) output-port-method-table)})
(def string-out-methods {:block-write (fn (self buffer size)
(def buf (meta self :buffer))
(when-not size (set! size (buffer/length buffer)))
(when (> size
(- (buffer/length buf)
(meta self :position)))
(buffer/length! buf
(+ #x80 (bit-and (+ (buffer/length buf) size) (bit-not #x7F)))))
(buffer/copy buf buffer (meta self :position) size)
(meta! self :position (+ (meta self :position) size)))
:char-write (fn (self char)
(def buf (meta self :buffer))
(when (< (- (buffer/length buf)
(meta self :position))
1)
(buffer/length! buf
(+ #x80 (buffer/length buf))))
(buffer/set! buf (meta self :position) char)
(meta! self :position (+ (meta self :position) 1)))
:write (fn (self . buffers)
(doseq (buf buffers self)
(self :block-write buf)))
:close! (fn (self) self)
:return-string (fn (self)
(buffer->string (meta self :buffer)
(meta self :position)))
:methods (fn (self) string-out-methods)})
(def input-port-method-table {:block-read (fn (handle buffer size)
(when (file/eof*? handle)
(return :end-of-file))
(file/read* handle buffer size))
:char-read (fn (handle char)
(when (file/eof*? handle)
(return :end-of-file))
(when-not (file/read* handle temporary-buffer-view 1)
(return :end-of-file))
(ref temporary-buffer-view 0))
:raw! (fn (handle)
(file/raw* handle #t))
:close! (ref output-port-method-table :close!)
:position (ref output-port-method-table :position)
:position! (ref output-port-method-table :position!)
:file-handle (ref output-port-method-table :file-handle)
:methods (fn (handle) input-port-method-table)})
(set! make-output-port (fn (handle)
"Create a new output port for HANDLE"
(fn (method . args)
(apply (ref output-port-method-table method) (cons handle args)))))
(set! make-string-output-port (fn ()
"Create a new string output port"
(def self #nil)
(set! self (fn (method . args)
(apply (ref string-out-methods method)
(cons self args))))
(meta! self :buffer (buffer/allocate #x80))
(meta! self :position 0)))
(set! make-input-port (fn (handle)
"Create a new input port for HANDLE"
(fn (method . args)
(apply (ref input-port-method-table method) (cons handle args))))))
(defmacro with-string-port (name . body)
`(let ((~name (make-string-output-port)))
~@body
(~name 'return-string)))
(defn cat l
"ConCATenates all arguments into a single string"
(def p (make-string-output-port))
(doseq (c l (p 'return-string))
(p 'block-write (string/display c))))
