Tmux etc

sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/test/unicode.lisp

@@ -0,0 +1,116 @@
+(in-package :de.anvi.croatoan.test)
+
+;; Tested in xterm and Gnome Terminal.
+;; Doesn't work in the Linux console and aterm.
+
+;; Unicode strings are supported by the default non-unicode ncurses API (addstr) as long as libncursesw is used.
+;; Special wide-char string functions (addwstr, add_wchstr) do not have to be used.
+(defun ut01 ()
+  (%initscr)
+
+  (%mvaddstr 2 2 "ččććššđđžž")
+  (%mvaddstr 4 6 "öäüüüßß")
+  (%mvaddstr 6 8 "Без муки нет науки - no pain, no gain")
+  (%mvaddstr 8 10 "指鹿為馬 - point deer, make horse")
+  (%mvaddstr 10 12 "μολὼν λαβέ / ΜΟΛΩΝ ΛΑΒΕ - come and get it")
+  
+  (%refresh)
+  (%getch)
+  (%endwin))
+
+;; For displaying single unicode chars, addch functions do not work, and we have to use add_wch explicitly.
+;; The data type also changes, from the integral chtype for addch, to the cchar_t struct for add_wch.
+;; Use the cchar type for convert-to-foreign via a plist.
+;; cchar-chars isnt a pointer to an integer array here, but an integer.
+(defun ut02 ()
+  (let ((scr (%initscr)))
+
+    ;; %add-wch
+    ;; Add #\CYRILLIC_SMALL_LETTER_SHA = #\ш to the stdscr.
+    (with-foreign-object (ptr '(:struct cchar))
+      (setf ptr (convert-to-foreign (list 'cchar-attr 0 'cchar-chars (char-code #\ш))
+                                    '(:struct cchar)))
+      (%add-wch ptr))
+
+    ;; %wadd-wch
+    ;; #\CYRILLIC_CAPITAL_LETTER_LJE = #\Љ
+    (with-foreign-object (ptr '(:struct cchar))
+      (setf ptr (convert-to-foreign (list 'cchar-attr #x00020000 'cchar-chars (char-code #\Љ))
+                                    '(:struct cchar)))
+      (%wadd-wch scr ptr))
+
+    (%wrefresh scr)
+    (%wgetch scr)
+    (%endwin)))
+
+(defun ut02b ()
+  (let ((scr (%initscr)))
+    (%start-color)
+    (%init-pair 1 1 3) ; red(1) on yellow(3)
+
+    ;; %wadd-wch
+    ;; #\CYRILLIC_CAPITAL_LETTER_LJE = #\Љ
+    (with-foreign-object (ptr '(:struct cchar_t))
+      ;; 2 is the attribute, 1 is the color pair, the color doesnt work with convert-to-foreign
+      ;;(setf ptr (convert-to-foreign (list 'cchar-attr #x00020100 'cchar-chars (char-code #\Љ) 'cchar-colors 1)
+      ;;                              '(:struct cchar_t)))
+
+      ;; we have to set each slot manually in order to make the extended colors work.
+      (setf (foreign-slot-value ptr '(:struct cchar_t) 'cchar-attr) #x00020100)
+      (setf (foreign-slot-value ptr '(:struct cchar_t) 'cchar-colors) 1)
+      ;; also with cchar_t, we can not use convert to foreign at all, but have to manually add the char
+      ;; at the first place in the char array.
+      (setf (mem-aref
+             (foreign-slot-pointer ptr '(:struct cchar_t) 'cchar-chars)
+             'wchar_t
+             0)
+            (char-code #\Љ))
+      (%wadd-wch scr ptr))
+
+    (%wrefresh scr)
+    (%wgetch scr)
+    (%endwin)))
+
+;; We do not need special "wide character" functions for displaying single UTF-8 characters.
+;; We can just use the string output function %waddstr.
+;; Here, the underlying %waddstr powers the gray stream interface displaying UTF-8.
+(defun ut03 ()
+  (with-screen (scr)
+    ;; Even though we have a control STRING, format still writes the char
+    ;; arguments char by char with write-char.
+    (format scr "~C ~A" #\Љ #\ш)
+    (terpri scr)
+    (format scr "Без муки нет науки")
+    (terpri scr)
+    (format scr "指鹿為馬")
+    (terpri scr)
+    (format scr "μολὼν λαβέ / ΜΟΛΩΝ ΛΑΒΕ")
+    (terpri scr)
+    (refresh scr)
+    (get-char scr)))
+
+;; Use the cchar_t type for setcchar.
+;; cchar-chars is a pointer to an integer array here, like the C prototype requires.
+(defun ut04 ()
+  (let ((scr (%initscr)))
+    (%start-color)
+    ;; Initialize color pair 1, yellow 3 on red 1.
+    (%init-pair 1 3 1)
+
+    (with-foreign-objects ((ptr '(:struct cchar_t))
+                           (wch 'wchar_t 5))
+      ;; Reset the wch array to zero.
+      (dotimes (i 5) (setf (mem-aref wch 'wchar_t i) 0))
+      (setf (mem-aref wch 'wchar_t) (char-code #\ш))
+      ;; Create a cchar_t containing #\ш, attribute underline, color pair yellow on red.
+      (%setcchar ptr wch #x00020000 1 (null-pointer))
+      (%wadd-wch scr ptr)
+      (%waddch scr (char-code #\newline))
+      ;; Take a look at the plist convert-from-foreign returns from cchar_t.
+      ;; Sadly that plist cant be read back because it contains a pointer.
+      ;; As of now, the convert-to-foreign function requires foreign values, not pointers.
+      (%waddstr scr (princ-to-string (convert-from-foreign ptr '(:struct cchar)))))
+
+    (%wrefresh scr)
+    (%wgetch scr)
+    (%endwin)))