Index: main/output.lisp
===================================================================
--- main/output.lisp	(revision main,28)
+++ main/output.lisp	(revision main,28)
@@ -0,0 +1,131 @@
+(defpackage #:tui-output
+  (:use #:cl #:cffi #:tui-cursor #:tui-window)
+  (:export #:add-string #:move-and-add-string #:add-clipped-string))
+
+(in-package #:tui-output)
+
+
+
+(defctype wchar :int32)                 ; On my 64-bit laptop.
+(defctype chtype :uint64)
+
+(defcstruct cchar_t
+  (attr chtype)
+  (char wchar :count 5))
+
+
+
+(defcfun "waddnwstr" :int
+  (window :pointer)
+  (wstr :pointer)
+  (n :int))
+
+(defun add-string (window s)
+  (let ((ptr (window-pointer window))
+        (n (length s)))
+    (with-foreign-object (a 'wchar n)
+      (dotimes (i n)
+        (setf (mem-aref a 'wchar i) (char-code (aref s i))))
+      (waddnwstr ptr a n))))
+
+(defun move-and-add-string (window y x s)
+  (setf (cursor-position window) (list y x))
+  (add-string window s))
+
+(defun add-clipped-string (window y x s)
+  (multiple-value-bind (maxy maxx) (size window)
+    (unless (<= 0 y maxy) (return-from add-clipped-string))
+    (when (< x 0)
+      (setf s (subseq s (- x))
+            x 0))
+    (let ((over (- (+ x (length s)) maxx)))
+      (when (> over 0)
+        (setf s (subseq s 0 (- (length s) over)))))
+    (move-and-add-string window y x s)))
+
+
+
+
+
+(defcvar ("_nc_wacs" nc-wacs) :pointer :read-only t)
+
+(defun wacs-char (ch)
+  (let ((code (char-code (ecase ch
+                           (:ul-corner #\l)
+                           (:ll-corner #\m)
+                           (:ur-corner #\k)
+                           (:lr-corner #\j)
+                           (:r-tee #\u)
+                           (:l-tee #\t)
+                           (:b-tee #\v)
+                           (:t-tee #\w)
+                           (:h-line #\q)
+                           (:v-line #\x)
+                           (:plus #\n)
+                           (:solid #\0)))))
+    (inc-pointer nc-wacs (* (foreign-type-size 'cchar_t) code))))
+
+(defcfun "wadd_wchnstr" :int
+  (window :pointer)
+  (cchstr :pointer)
+  (n :int))
+
+(defun clear-complex-char (cc)
+  (with-foreign-slots ((attr char) cc cchar_t)
+    (setf attr 0)
+    (dotimes (i 5 cc)
+      (setf (mem-aref char :uint32 i) 0))))
+
+(defun extract-complex-char (cc)
+  (let ((x (make-sequence '(vector integer) 5 :initial-element 0)))
+    (with-foreign-slots ((char) cc cchar_t)
+      (dotimes (i 5 x)
+        (setf (aref x i) (mem-aref char :uint32 i))))))
+
+(defun copy-complex-char (dst src-vector)
+  (with-foreign-slots ((char) dst cchar_t)
+    (dotimes (i 5 dst)
+      (setf (mem-aref char :uint32 i) (aref src-vector i)))))
+
+(defun set-complex-char (cc ch)
+  (with-foreign-slots ((char) cc cchar_t)
+    (etypecase ch
+      (character
+       (setf (mem-aref char :uint32) (char-code ch)))
+      (symbol
+       (copy-complex-char cc (extract-complex-char (wacs-char ch)))))))
+
+(defun add-complex-string (window s)
+  (let ((n (length s)))
+    (with-foreign-object (a 'cchar_t n)
+      (dotimes (i n)
+        (let ((cc (mem-aref a 'cchar_t i)))
+          (clear-complex-char cc)
+          (set-complex-char cc (aref s i))))
+      (wadd-wchnstr window a n))))
+
+
+
+(defcfun ("box" c-box) :int
+  (window :pointer)
+  (vertical-ch chtype)
+  (horizontal-ch chtype))
+
+(defcfun ("wborder" c-window-border) :int
+  (window :pointer)
+  (ls chtype)
+  (rs chtype)
+  (ts chtype)
+  (bs chtype)
+  (tl chtype)
+  (tr chtype)
+  (bl chtype)
+  (br chtype))
+
+(defcfun ("wbkgd" c-set-window-background) :int
+  (window :pointer)
+  (ch chtype))
+
+(defcfun "wbkgrnd" :int
+  (window :pointer)
+  (wch :pointer))