Changeset main,24

Timestamp:

11/03/2007 03:54:31 PM (19 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

tui

revision id:

dsowen@fugue88.ws-20071103155431-vqezrka9oztick7q

Message:

Added routine to add strings but clip to the window.

File:

• main/cdk.lisp (modified) (3 diffs)

main/cdk.lisp

@@ -1 +1 @@
 (defpackage #:cdk
   (:use #:cl #:cffi)
-  (:export #:with-screen #:with-der-window #:add-ch #:add-string #:wmove))
+  (:export #:with-screen #:with-der-window #:add-string #:add-clipped-string
+           #:wmove))
 
 (in-package #:cdk)
@@ -17 +18 @@
 
 (defctype chtype :uint64)
+(defctype wchar :int32)                 ; On my 64-bit laptop.
 
 (defcvar ("cdk_exit_early" +cdk-exit-early+) :int :read-only t)
@@ -160 +162 @@
   (x :int))
 
-(defun add-char (window ch)
-  (with-foreign-object (s 'cchar_t)
-    (with-foreign-slots ((attr char) s cchar_t)
-      (setf attr 0)
-      (dotimes (i 5)
-        (setf (mem-aref char :uint32 i) 0))
-      (setf (mem-aref char :uint32) (char-code ch)))
-    (wadd-wch window s)))
+(defcfun "waddnwstr" :int
+  (window :pointer)
+  (wstr :pointer)
+  (n :int))
 
 (defun add-string (window s)
-  (dotimes (i (length s))
-    (add-char window (aref s i))))
-
-(defun move-and-add-char (window y x ch)
-  (wmove window y x)
-  (add-char window ch))
+  (let ((n (length s)))
+    (with-foreign-object (a 'wchar n)
+      (dotimes (i n)
+        (setf (mem-aref a 'wchar i) (char-code (aref s i))))
+      (waddnwstr window a n))))
 
 (defun move-and-add-string (window y x s)
   (wmove window y x)
   (add-string window s))
+
+(defun add-clipped-string (window y x s)
+  (let ((maxy (getmaxy window)))
+    (unless (<= 0 y maxy) (return-from add-clipped-string)))
+  (let ((maxx (getmaxx window)))
+    (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)))
 
 (defcfun ("wrefresh" c-refresh-window) :int