Changeset main,25 for main

Timestamp:

11/03/2007 03:55:10 PM (19 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

tui

revision id:

dsowen@fugue88.ws-20071103155510-r69yh2jkr423i49e

Message:

Display-strings now clip to the window.

Location:

main

Files:

• display-string.lisp (modified) (3 diffs)
• tui.asd (modified) (1 diff)

main/display-string.lisp

@@ -30 +30 @@
     (f 0)))
 
+
+
 (defun renderlen-part (part)
   (destructuring-bind (class image) part
-    (if (eq class 'literal)
-        (length image)
-        0)))
+    (ecase class
+      (literal (length image))
+      (escape 0))))
 
 (defun renderlen (parts)
   (let ((lens (mapcar 'renderlen-part parts)))
     (reduce '+ lens)))
+
+
 
 (defconstant +attributes+ '(#\s #.(expt 2 16)
@@ -49 +53 @@
                             #\p #.(expt 2 24)))
 
+(defun fmt-part (part)
+  (destructuring-bind (class image) part
+    (ecase class
+      (literal (enquote image))
+      (escape (format nil "`~A" image)))))
+
+(defun fmt (parts)
+  (let ((s (mapcar 'fmt-part parts)))
+    (apply 'concatenate 'string s)))
+
+
+
 (defun render (dstr window y x)
-  (let ((parts (scan-dstring dstr)))
-    (cdk:wmove window y x)
+  (let ((parts (scan-dstring dstr))
+        (printed 0))
     (dolist (p parts)
       (destructuring-bind (class image) p
         (if (eq class 'literal)
-            (add-string window image)
+            (let ((n (length image)))
+              (add-clipped-string window y (+ x printed) image)
+              (incf printed n))
             (let ((on (upper-case-p image))
                   (attr (getf +attributes+ (char-downcase image))))
@@ -63 +81 @@
 
 (defun test ()
-  (with-screen (s)
-    (render "Now `B`Ris `bthe`r ``time.'" s 10 10)
-    (input:%wget-wch s)))
+  (let ((m "`UNow `B`Ris `bthe`r ``time.'`u"))
+    (with-screen (s)
+      (cdk::c-erase-window s)
+      (cdk::c-refresh-window s)
+      (with-der-window (w s 3 10 5 5)
+        (wmove w 0 0)
+        (add-string w (make-sequence 'string 15 :initial-element #\.))
+        (render m w 1 -2)
+        (input:%wget-wch w)))))

main/tui.asd

@@ -6 +6 @@
                (:file "cdk")
                (:file "display-string"
-                      :depends-on ("cdk"))
+                      ;; "input" only for testing
+                      :depends-on ("cdk" "input"))
                (:module "grid"
-                        :depends-on ("cdk")
+                        :depends-on ("cdk" "display-string")
                         :components ((:file "package")
                                      (:file "model")