116 lines
4.5 KiB
Common Lisp
116 lines
4.5 KiB
Common Lisp
(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)))
|