Changeset main,27 for main/cdk.lisp

Timestamp:

11/03/2007 07:04:41 PM (19 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

tui

revision id:

dsowen@fugue88.ws-20071103190441-ayq57wi7c3bm360r

Message:

New complex-character handling.

File:

• main/cdk.lisp (modified) (1 diff)

main/cdk.lisp

@@ -157 +157 @@
     (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 ("wmove" c-wmove) :int
   (window :pointer)