Changeset main,31 for main/output.lisp

Timestamp:

11/05/2007 08:06:48 PM (19 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

tui-new

revision id:

dsowen@fugue88.ws-20071105200648-7juihmioe0ruvmln

Message:

A window's background is now SETF-able.

File:

• main/output.lisp (modified) (5 diffs)

main/output.lisp

@@ -1 +1 @@
 (defpackage #:tui-output
   (:use #:cl #:cffi #:tui-cursor #:tui-window)
-  (:export #:add-string #:move-and-add-string #:add-clipped-string))
+  (:export #:background #:add-string #:move-and-add-string
+           #:add-clipped-string))
 
 (in-package #:tui-output)
@@ -13 +14 @@
   (attr chtype)
   (char wchar :count 5))
+
+
+
+(defcfun "wgetbkgrnd" :int
+  (window :pointer)
+  (wch :pointer))
+
+(defcfun "wbkgrnd" :void
+  (window :pointer)
+  (wch :pointer))
+
+;;(defgeneric background (window))
+
+(defgeneric (setf background) (pair window)
+  (:method (pair (window window))
+    (destructuring-bind (ch color) pair
+      (with-foreign-object (wch 'cchar_t)
+        (with-foreign-slots ((attr char) wch cchar_t)
+          (dotimes (i 5)
+            (setf (mem-aref char 'wchar i) 0))
+          (setf attr (cdk::color-pair color)
+                (mem-aref char 'wchar) (char-code ch)))
+        (wbkgrnd (window-pointer window) wch)))))
 
 
@@ -34 +58 @@
 
 (defun add-clipped-string (window y x s)
+  ;; TODO: double check for ob1 in OVER.
   (multiple-value-bind (maxy maxx) (size window)
     (unless (<= 0 y maxy) (return-from add-clipped-string))
@@ -103 +128 @@
           (clear-complex-char cc)
           (set-complex-char cc (aref s i))))
-      (wadd-wchnstr window a n))))
+      (wadd-wchnstr (window-pointer window) a n))))
 
 
@@ -122 +147 @@
   (bl chtype)
   (br chtype))
-
-(defcfun ("wbkgd" c-set-window-background) :int
-  (window :pointer)
-  (ch chtype))
-
-(defcfun "wbkgrnd" :int
-  (window :pointer)
-  (wch :pointer))