ian/dotfiles
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Tmux etc

Browse source
This commit is contained in:
Ian Keane 2020-02-18 14:21:14 -05:00
parent 276853ba84
commit 1cb167b597
361 changed files with 77302 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

22
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/LICENSE Normal file
View file

@ -0,0 +1,22 @@
Copyright (c) 2012-2018,2019 Anton Vidovic <anton.vidovic@gmx.de>
Portions Copyright (c) 2018 Daniel Vedder <d.vedder@web.de>
Portions Copyright (c) 2019 D4ryus <d4ryus@teknik.io>
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.

40
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/README Normal file
View file

@ -0,0 +1,40 @@
croatoan is a set of bindings to the ncurses terminal library for
Common Lisp.
It is inspired by, but not derived from, cl-ncurses and cl-charms.
Its main goal is to provide a higher-level, lispy/CLOSy interface,
whereas the existing bindings clone the cryptic C API.
As of now, the library is in an early, but hopefully usable stage.
Ncurses is old and huge and it will take a while to cover completely.
The API is not yet stable.
It is developed and tested on Ubuntu 16.04 x86_64 and SBCL 1.5.7.
The only supported ncurses version is 6.x --with-abi-version=6.
Version 5.9 mostly works, but I will focus new efforts on 6.x.
Since many popular distributions ship ncurses --with-abi-version=5,
for full compatibility (wide characters, 256 colors and extended
mouse support), you will have to manually build ncurses 6.x.
The documentation is currently provided by the commented examples.
You are welcome to contribute and any form of help would be greatly
appreciated.
--
Since ncurses is not thread-safe, all IO has to occur in the main
thread of the REPL running in a terminal.
This makes it difficult to interact with ncurses from the Emacs SLIME
REPL which runs in its own thread.
A workaround is to pass all ncurses IO to the main thread via a
thread-safe queue. Basic support for this has been implemented.
A tutorial on interacting with ncurses from swank/slime is available
in docs/slime.md

19
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/croatoan-test.asd Normal file
View file

@ -0,0 +1,19 @@
(asdf:defsystem :croatoan-test
:description "Tests and examples for the croatoan CLOS API and the low-level ncurses CFFI bindings."
:author "Anton Vidovic <anton.vidovic@gmx.de>"
:licence "MIT"
:version "0.0.1"
:depends-on (:croatoan)
:components
((:module "test"
:serial t
:components ((:file "package")
;; base %ncurses tests
(:file "ncurses")
(:file "unicode")
;; high-level clos api
(:file "clos")
(:file "tetris")
(:file "evolution")))))

116
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/croatoan.asd Normal file
View file

@ -0,0 +1,116 @@
(asdf:defsystem :croatoan
:description "Common Lisp bindings for the ncurses terminal library."
:author "Anton Vidovic <anton.vidovic@gmx.de>"
:licence "MIT"
:version "0.0.1"
:depends-on (:cffi :trivial-gray-streams :bordeaux-threads)
:components
;; Basic CFFI wrapper for libncursesw and libncurses
((:module "ncurses"
:components
((:file "package")
(:file "ncurses")
;; complete
(:file "addch") ; add a character (with attributes) to a curses window, then advance the cursor
(:file "add_wch") ; add a complex character and rendition to a curses window, then advance the cursor
(:file "addstr") ; add a string of characters to a curses window and advance cursor
(:file "attr") ; curses character and window attribute control routines
(:file "beep") ; curses bell and screen flash routines
(:file "bkgd") ; curses window background manipulation routines
(:file "bkgrnd") ; window complex background manipulation routines
(:file "border") ; create curses borders, horizontal and vertical lines
(:file "border_set") ; create curses borders or lines using complex characters and renditions
(:file "clear") ; clear all or part of a curses window
(:file "color") ; curses color manipulation routines
(:file "default_colors") ; use terminal's default colors
(:file "define_key") ; define a keycode
(:file "delch") ; delete character under the cursor in a curses window
(:file "deleteln") ; delete and insert lines in a curses window
(:file "extend") ; curses window properties
(:file "getch") ; get (or push back) characters from curses terminal keyboard
(:file "get_wch") ; get (or push back) a wide (multi-byte) character from curses terminal keyboard
(:file "getcchar") ; Get a wide character string and rendition from a cchar_t or set a cchar_t from a wide-character string
(:file "getstr") ; accept character strings from curses terminal keyboard
(:file "getyx") ; get curses cursor and window coordinates
(:file "inch") ; get a character and attributes from a curses window
(:file "in_wch") ; extract a wide (multi-byte) character and rendition from a window
(:file "insch") ; insert a character before cursor in a curses window
(:file "ins_wch") ; insert a complex character and rendition into a window
(:file "instr") ; get a string of characters from a curses window
(:file "inwstr") ; extract a string of wchar_t characters from a curses window
(:file "inchstr") ; get a string of characters (and attributes) from a curses window
(:file "insstr") ; insert string before cursor in a curses window
(:file "initscr") ; screen initialization and manipulation routines
(:file "inopts") ; curses input options
(:file "kernel") ; low-level curses routines
(:file "keybound") ; return definition of keycode
(:file "key_defined") ; check if a keycode is defined
(:file "legacy") ; get curses cursor and window coordinates, attributes
(:file "legacy_coding") ; legacy coding
(:file "mouse") ; mouse interface through curses
(:file "move") ; move curses window cursor
(:file "opaque") ; curses window properties
(:file "outopts") ; curses output options
(:file "pad") ; create and display curses pads
(:file "refresh") ; refresh curses windows and lines
(:file "resizeterm") ; change the curses terminal size
(:file "scroll") ; scroll a curses window
(:file "slk") ; curses soft label routines
(:file "termattrs") ; environment query routines
(:file "touch") ; curses refresh control routines
(:file "util") ; miscellaneous curses utility routines
(:file "variables") ; curses global variables
(:file "window") ; create curses windows
(:file "wresize"))) ; resize a curses window
;; CLOS api on top of CFFI ncurses.
(:module "src"
:depends-on ("ncurses")
:components
((:file "package")
(:file "classes")
(:file "queue")
(:file "croatoan")
(:file "gray_streams")
(:file "utf8")
(:file "addch")
(:file "add_wch")
(:file "addstr")
(:file "attr")
(:file "beep")
(:file "bkgd")
(:file "bkgrnd") ; window complex background manipulation routines
(:file "border")
(:file "border_set") ; create curses borders or lines using complex characters and renditions
(:file "clear")
(:file "color")
(:file "delch")
(:file "deleteln")
(:file "getch")
(:file "get_wch")
(:file "getstr")
(:file "initscr")
(:file "inopts")
(:file "inch")
(:file "in_wch")
(:file "inwstr") ; get a string of wide (multi-byte) characters from a curses window
(:file "inchstr")
(:file "insch")
(:file "ins_wch") ; insert a complex character and rendition into a window
(:file "insstr")
(:file "instr")
(:file "kernel")
(:file "mouse")
(:file "move")
(:file "panel")
(:file "refresh")
(:file "touch")
(:file "wresize")
;; Extension libraries
(:file "form") ; curses extension for programming forms
(:file "menu") ; curses extension for programming menus
(:file "shape"))))) ; curses extension for plotting shapes

137
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/doc/slime.md Normal file
View file

@ -0,0 +1,137 @@
# Working with swank/slime
Since ncurses is single threaded, it is only ever allowed to call
ncurses functions from the thread that initialized the screen. As this
thread must be the one controlling the terminal, ncurses must only
be called from the REPL prompt directly. With a recent enough croatoan
version, slime/swank does work though, but it requires a bit of extra
work. The following is an example of how one would work with croatoan
using slime/swank. First, a bit of boiler plate:
```
;; load croatoan and swank
(eval-when (:compile-toplevel :execute :load-toplevel)
(ql:quickload '(:croatoan :swank)))
;; Defining a package is always a good idea
(defpackage #:scratch
(:use #:cl)
(:export #:main))
(in-package #:scratch)
;; The main screen, we need a global so that we can access it from
;; slime
(defparameter *scr* nil)
;; Main entry point, to be called from the terminal thread, it will
;; initialize the screen and enter the event loop
(defun main ()
(croatoan:with-screen (scr
;; Set input blocking to 100 ms. This _must_
;; be set for swank to work, otherwise
;; get-event will block and croatoan only
;; polls the job queue when a key is pressed.
:input-blocking 100
;; Do not override the swank debugger hook,
;; as we want to enter the slime debugger in
;; emacs when a error occurs.
:bind-debugger-hook nil)
;; Set *scr* to the initilized scr so that we can access it form
;; the swank thread and then enter the event-loop.
(croatoan:run-event-loop (setf *scr* scr))))
;; Initialize swank, setting dont-close will prevent the server from
;; shutting down in case slime disconnects. The default port is 4005,
;; one can specify a different one with :port.
(swank:create-server :dont-close t)
;; Initialize screen and enter the event loop
(main)
```
This should be saved in a file and then loaded directly from sbcl (or
any other CL Implementation known to work with croatoan). For sbcl
this would be (when saved to `scratch.lisp`):
```
sbcl --load scratch.lisp
```
The user should now see a blank terminal window with the cursor placed
at the top left corner. Time to connect to it from slime, form within
emacs run:
```
M-x slime-connect
```
Once started, we need to change into the right package, do this by
entering (inside the SLIME repl):
```
CL-USER> (in-package :scratch)
```
To now run something inside the terminal thread one must use
`CROATOAN:SUBMIT`:
```
SCRATCH> (croatoan:submit (croatoan:add-string *scr* "Hey!"))
```
And voila, thats the basics of working with croatoan from slime!
The next thing one might want to do is set some keybindings, for
example, bind `c` to clear the screen:
```
SCRATCH> (croatoan:submit
(croatoan:bind *scr* #\c (lambda (win event)
(croatoan:clear *scr*))))
```
And `q` to quit the event loop:
```
SCRATCH> (croatoan:submit
(croatoan:bind *scr* #\q 'croatoan:exit-event-loop))
```
There is one caveat though, `*STANDARD-OUTPUT*` differs between the
swank and the terminal thread. It is set to the swank output stream
(which prints everything to the slime repl) inside the swank thread,
and bound to the terminal stdin/stdout inside the terminal
thread. Hence doing the following, would mess up the terminal screen
instead of printing to the slime repl:
```
SCRATCH> (croatoan:submit (format t "Hellou!~%"))
```
What we need is a way to refer to the swank stream, which can be easily
achieved by setting another global to whatever stream
`*STANDARD-OUTPUT*` points to inside the slime repl:
```
SCRATCH> (defparameter *swank-output* *standard-output*)
```
If we now run:
```
SCRATCH> (croatoan:submit (format *swank-output* "Hellou!~%"))
```
We should see `Hellou!` printed in the slime repl.
This is quite helpful, especially when debugging something within the
terminal thread:
```
SCRATCH> (croatoan:submit
(croatoan:bind *scr* :resize
(lambda (win event)
(format *swank-output* "Terminal resized to width: ~a, height: ~a~%"
(croatoan:width win)
(croatoan:height win)))))
```

24
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/add_wch.lisp Normal file
View file

@ -0,0 +1,24 @@
(in-package :de.anvi.ncurses)
;;; add_wch
;;; add a complex character and rendition to a curses window, then advance the cursor
;;; http://invisible-island.net/ncurses/man/curs_add_wch.3x.html
;;; C prototypes
;;; int add_wch(const cchar_t *wch);
;;; int wadd_wch(WINDOW *win, const cchar_t *wch);
;;; int mvadd_wch(int y, int x, const cchar_t *wch);
;;; int mvwadd_wch( WINDOW *win, int y, int x, const cchar_t *wch);
;;; int echo_wchar(const cchar_t *wch);
;;; int wecho_wchar(WINDOW *win, const cchar_t *wch);
;;; Low-level CFFI wrappers
(defcfun ("add_wch" %add-wch) :int (wch (:pointer (:struct cchar_t))))
(defcfun ("wadd_wch" %wadd-wch) :int (win window) (wch (:pointer (:struct cchar_t))))
(defcfun ("mvadd_wch" %mvadd-wch) :int (y :int) (x :int) (wch (:pointer (:struct cchar_t))))
(defcfun ("mvwadd_wch" %mvwadd-wch) :int (win window) (y :int) (x :int) (wch (:pointer (:struct cchar_t))))
(defcfun ("echo_wchar" %echo-wchar) :int (wch (:pointer (:struct cchar_t))))
(defcfun ("wecho_wchar" %wecho-wchar) :int (win window) (wch (:pointer (:struct cchar_t))))

25
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/addch.lisp Normal file
View file

@ -0,0 +1,25 @@
(in-package :de.anvi.ncurses)
;;; addch
;;; add a character (with attributes) to a curses window, then advance the cursor
;;; http://invisible-island.net/ncurses/man/curs_addch.3x.html
;;; C prototypes
;; int addch(const chtype ch);
;; int waddch(WINDOW *win, const chtype ch);
;; int mvaddch(int y, int x, const chtype ch);
;; int mvwaddch(WINDOW *win, int y, int x, const chtype ch);
;; int echochar(const chtype ch);
;; int wechochar(WINDOW *win, const chtype ch);
;;; Low-level CFFI wrappers
(defcfun ("addch" %addch) :int (ch chtype))
(defcfun ("waddch" %waddch) :int (win window) (ch chtype))
(defcfun ("mvaddch" %mvaddch) :int (y :int) (x :int) (ch chtype))
(defcfun ("mvwaddch" %mvwaddch) :int (win window) (y :int) (x :int) (ch chtype))
(defcfun ("echochar" %echochar) :int (ch chtype))
(defcfun ("wechochar" %wechochar) :int (win window) (ch chtype))

31
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/addstr.lisp Normal file
View file

@ -0,0 +1,31 @@
(in-package :de.anvi.ncurses)
;;; addstr
;;; add a string of characters to a curses window and advance cursor
;;; http://invisible-island.net/ncurses/man/curs_addstr.3x.html
;;; http://www.manpagez.com/man/3/curs_addstr/
;;; C prototypes
;; int addstr(const char *str);
;; int addnstr(const char *str, int n);
;; int waddstr(WINDOW *win, const char *str);
;; int waddnstr(WINDOW *win, const char *str, int n);
;; int mvaddstr(int y, int x, const char *str);
;; int mvaddnstr(int y, int x, const char *str, int n);
;; int mvwaddstr(WINDOW *win, int y, int x, const char *str);
;; int mvwaddnstr(WINDOW *win, int y, int x, const char *str, int n);
;;; Low-level CFFI wrappers
(defcfun ("addstr" %addstr) :int (str :string))
(defcfun ("addnstr" %addnstr) :int (str :string) (n :int))
(defcfun ("waddstr" %waddstr) :int (win window) (str :string))
(defcfun ("waddnstr" %waddnstr) :int (win window) (str :string) (n :int))
(defcfun ("mvaddstr" %mvaddstr) :int (y :int) (x :int) (str :string))
(defcfun ("mvaddnstr" %mvaddnstr) :int (y :int) (x :int) (str :string) (n :int))
(defcfun ("mvwaddstr" %mvwaddstr) :int (win window) (y :int) (x :int) (str :string))
(defcfun ("mvwaddnstr" %mvwaddnstr) :int (win window) (y :int) (x :int) (str :string) (n :int))

72
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/attr.lisp Normal file
View file

@ -0,0 +1,72 @@
(in-package :de.anvi.ncurses)
;;; attr
;;; curses character and window attribute control routines
;;; http://invisible-island.net/ncurses/man/curs_attr.3x.html
;;; http://publib.boulder.ibm.com/infocenter/pseries/v5r3/topic/com.ibm.aix.genprogc/doc/genprogc/manip_video_attrs.htm
;;; C prototypes
;; int attroff(int attrs);
;; int wattroff(WINDOW *win, int attrs);
;; int attron(int attrs);
;; int wattron(WINDOW *win, int attrs);
;; int attrset(int attrs);
;; int wattrset(WINDOW *win, int attrs);
;; int color_set(short color_pair_number, void* opts);
;; int wcolor_set(WINDOW *win, short color_pair_number, void* opts);
;; int standend(void);
;; int wstandend(WINDOW *win);
;; int standout(void);
;; int wstandout(WINDOW *win);
;; int attr_get(attr_t *attrs, short *pair, void *opts);
;; int wattr_get(WINDOW *win, attr_t *attrs, short *pair, void *opts);
;; int attr_off(attr_t attrs, void *opts);
;; int wattr_off(WINDOW *win, attr_t attrs, void *opts);
;; int attr_on(attr_t attrs, void *opts);
;; int wattr_on(WINDOW *win, attr_t attrs, void *opts);
;; int attr_set(attr_t attrs, short pair, void *opts);
;; int wattr_set(WINDOW *win, attr_t attrs, short pair, void *opts);
;; int chgat(int n, attr_t attr, short color, const void *opts)
;; int wchgat(WINDOW *win, int n, attr_t attr, short color, const void *opts)
;; int mvchgat(int y, int x, int n, attr_t attr, short color, const void *opts)
;; int mvwchgat(WINDOW *win, int y, int x, int n, attr_t attr, short color, const void *opts)
;;; Low-level CFFI wrappers
;; :unsigned-int should be the same size as :uint32, 4 bytes, the size of a chtype.
(defcfun ("attroff" %attroff) :int (attrs :unsigned-int))
(defcfun ("wattroff" %wattroff) :int (win window) (attrs :unsigned-int))
(defcfun ("attron" %attron) :int (attrs :unsigned-int))
(defcfun ("wattron" %wattron) :int (win window) (attrs :unsigned-int))
(defcfun ("attrset" %attrset) :int (attrs :unsigned-int))
(defcfun ("wattrset" %wattrset) :int (win window) (attrs :unsigned-int))
(defcfun ("color_set" %color-set) :int (color-pair-number :short) (opts (:pointer :void)))
(defcfun ("wcolor_set" %wcolor-set) :int (win window) (color-pair-number :short) (opts (:pointer :void)))
(defcfun ("standend" %standend) :int)
(defcfun ("wstandend" %wstandend) :int (win window))
(defcfun ("standout" %standout) :int)
(defcfun ("wstandout" %wstandout) :int (win window))
(defcfun ("attr_get" %attr-get) :int (attrs (:pointer attr)) (pair (:pointer :short)) (opts (:pointer :void)))
(defcfun ("wattr_get" %wattr-get) :int (win window) (attrs (:pointer attr)) (pair (:pointer :short)) (opts (:pointer :void)))
(defcfun ("attr_off" %attr-off) :int (attrs attr) (opts (:pointer :void)))
(defcfun ("wattr_off" %wattr-off) :int (win window) (attrs attr) (opts (:pointer :void)))
(defcfun ("attr_on" %attr-on) :int (attrs attr) (opts (:pointer :void)))
(defcfun ("wattr_on" %wattr-on) :int (win window) (attrs attr) (opts (:pointer :void)))
(defcfun ("attr_set" %attr-set) :int (attrs attr) (pair :short) (opts (:pointer :void)))
(defcfun ("wattr_set" %wattr-set) :int (win window) (attrs attr) (pair :short) (opts (:pointer :void)))
(defcfun ("chgat" %chgat) :int (n :int) (attr attr) (color :short) (opts (:pointer :void)))
(defcfun ("wchgat" %wchgat) :int (win window) (n :int) (attr attr) (color :short) (opts (:pointer :void)))
(defcfun ("mvchgat" %mvchgat) :int (y :int) (x :int) (n :int) (attr attr) (color :short) (opts (:pointer :void)))
(defcfun ("mvwchgat" %mvwchgat) :int (win window) (y :int) (x :int) (n :int) (attr attr) (color :short) (opts (:pointer :void)))

15
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/beep.lisp Normal file
View file

@ -0,0 +1,15 @@
(in-package :de.anvi.ncurses)
;;; beep
;;; curses bell and screen flash routines
;;; http://invisible-island.net/ncurses/man/curs_beep.3x.html
;;; C prototypes
;; int beep(void);
;; int flash(void);
;;; Low-level CFFI wrappers
(defcfun ("beep" %beep) :int)
(defcfun ("flash" %flash) :int)

21
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/bkgd.lisp Normal file
View file

@ -0,0 +1,21 @@
(in-package :de.anvi.ncurses)
;;; bkgd
;;; curses window background manipulation routines
;;; http://invisible-island.net/ncurses/man/curs_bkgd.3x.html
;;; C prototypes
;; void bkgdset(chtype ch);
;; void wbkgdset(WINDOW *win, chtype ch);
;; int bkgd(chtype ch);
;; int wbkgd(WINDOW *win, chtype ch);
;; chtype getbkgd(WINDOW *win);
;;; Low-level CFFI wrappers
(defcfun ("bkgdset" %bkgdset) :void (ch chtype))
(defcfun ("wbkgdset" %wbkgdset) :void (win window) (ch chtype))
(defcfun ("bkgd" %bkgd) :int (ch chtype))
(defcfun ("wbkgd" %wbkgd) :int (win window) (ch chtype))
(defcfun ("getbkgd" %getbkgd) chtype (win window))

23
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/bkgrnd.lisp Normal file
View file

@ -0,0 +1,23 @@
(in-package :de.anvi.ncurses)
;;; bkgrnd
;;; window complex background manipulation routines
;;; http://invisible-island.net/ncurses/man/curs_bkgrnd.3x.html
;;; C prototypes
;; int bkgrnd( const cchar_t *wch);
;; int wbkgrnd( WINDOW *win, const cchar_t *wch);
;; void bkgrndset(const cchar_t *wch );
;; void wbkgrndset(WINDOW *win, const cchar_t *wch);
;; int getbkgrnd(cchar_t *wch);
;; int wgetbkgrnd(WINDOW *win, cchar_t *wch);
;;; Low-level CFFI wrappers
(defcfun ("bkgrnd" %bkgrnd) :int (wch (:pointer (:struct cchar_t))))
(defcfun ("wbkgrnd" %wbkgrnd) :int (win window) (wch (:pointer (:struct cchar_t))))
(defcfun ("bkgrndset" %bkgrndset) :void (wch (:pointer (:struct cchar_t))))
(defcfun ("wbkgrndset" %wbkgrndset) :void (win window) (wch (:pointer (:struct cchar_t))))
(defcfun ("getbkgrnd" %getbkgrnd) :int (wch (:pointer (:struct cchar_t))))
(defcfun ("wgetbkgrnd" %wgetbkgrnd) :int (win window) (wch (:pointer (:struct cchar_t))))

57
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/border.lisp Normal file
View file

@ -0,0 +1,57 @@
(in-package :de.anvi.ncurses)
;;; border
;;; create curses borders, horizontal and vertical lines
;;; http://invisible-island.net/ncurses/man/curs_border.3x.html
;;; http://linux.die.net/man/3/box
;;; C prototypes
;; int border(chtype ls, chtype rs, chtype ts, chtype bs, chtype tl, chtype tr, chtype bl, chtype br);
;; int wborder(WINDOW *win, chtype ls, chtype rs, chtype ts, chtype bs, chtype tl, chtype tr, chtype bl, chtype br);
;; int box(WINDOW *win, chtype verch, chtype horch);
;; int hline(chtype ch, int n);
;; int whline(WINDOW *win, chtype ch, int n);
;; int vline(chtype ch, int n);
;; int wvline(WINDOW *win, chtype ch, int n);
;; int mvhline(int y, int x, chtype ch, int n);
;; int mvwhline(WINDOW *, int y, int x, chtype ch, int n);
;; int mvvline(int y, int x, chtype ch, int n);
;; int mvwvline(WINDOW *, int y, int x, chtype ch, int n);
;;; Low-level CFFI wrappers
(defcfun ("border" %border) :int
(ls chtype)
(rs chtype)
(ts chtype)
(bs chtype)
(tl chtype)
(tr chtype)
(bl chtype)
(br chtype))
(defcfun ("wborder" %wborder) :int
(win window)
(ls chtype)
(rs chtype)
(ts chtype)
(bs chtype)
(tl chtype)
(tr chtype)
(bl chtype)
(br chtype))
(defcfun ("box" %box) :int (win window) (verch chtype) (horch chtype))
(defcfun ("hline" %hline) :int (ch chtype) (n :int))
(defcfun ("whline" %whline) :int (win window) (ch chtype) (n :int))
(defcfun ("vline" %vline) :int (ch chtype) (n :int))
(defcfun ("wvline" %wvline) :int (win window) (ch chtype) (n :int))
(defcfun ("mvhline" %mvhline) :int (y :int) (x :int) (ch chtype) (n :int))
(defcfun ("mvwhline" %mvwhline) :int (win window) (y :int) (x :int) (ch chtype) (n :int))
(defcfun ("mvvline" %mvvline) :int (y :int) (x :int) (ch chtype) (n :int))
(defcfun ("mvwvline" %mvwvline) :int (win window) (y :int) (x :int) (ch chtype) (n :int))

60
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/border_set.lisp Normal file
View file

@ -0,0 +1,60 @@
(in-package :de.anvi.ncurses)
;;; border_set
;;; create curses borders or lines using complex characters and renditions
;;; http://invisible-island.net/ncurses/man/curs_border_set.3x.html
;;; C prototypes
;; int border_set(const cchar_t *ls, const cchar_t *rs, const cchar_t *ts, const cchar_t *bs, const cchar_t *tl, const cchar_t *tr, const cchar_t *bl, const cchar_t *br);
;; int wborder_set(WINDOW *win, const cchar_t *ls, const cchar_t *rs, const cchar_t *ts, const cchar_t *bs, const cchar_t *tl, const cchar_t *tr, const cchar_t *bl, const cchar_t *br);
;; int box_set(WINDOW *win, const cchar_t *verch, const cchar_t *horch);
;; int hline_set(const cchar_t *wch, int n);
;; int whline_set(WINDOW *win, const cchar_t *wch, int n);
;; int mvhline_set(int y, int x, const cchar_t *wch, int n);
;; int mvwhline_set(WINDOW *win, int y, int x, const cchar_t *wch, int n);
;; int vline_set(const cchar_t *wch, int n);
;; int wvline_set(WINDOW *win, const cchar_t *wch, int n);
;; int mvvline_set(int y, int x, const cchar_t *wch, int n);
;; int mvwvline_set(WINDOW *win, int y, int x, const cchar_t *wch, int n);
;;; Low-level CFFI wrappers
(defcfun ("border_set" %border-set) :int
(ls (:pointer (:struct cchar_t)))
(rs (:pointer (:struct cchar_t)))
(ts (:pointer (:struct cchar_t)))
(bs (:pointer (:struct cchar_t)))
(tl (:pointer (:struct cchar_t)))
(tr (:pointer (:struct cchar_t)))
(bl (:pointer (:struct cchar_t)))
(br (:pointer (:struct cchar_t))))
(defcfun ("wborder_set" %wborder-set) :int
(win window)
(ls (:pointer (:struct cchar_t)))
(rs (:pointer (:struct cchar_t)))
(ts (:pointer (:struct cchar_t)))
(bs (:pointer (:struct cchar_t)))
(tl (:pointer (:struct cchar_t)))
(tr (:pointer (:struct cchar_t)))
(bl (:pointer (:struct cchar_t)))
(br (:pointer (:struct cchar_t))))
(defcfun ("box_set" %box-set) :int
(win window)
(verch (:pointer (:struct cchar_t)))
(horch (:pointer (:struct cchar_t))))
(defcfun ("hline_set" %hline-set) :int (wch (:pointer (:struct cchar_t))) (n :int))
(defcfun ("whline_set" %whline-set) :int (win window) (wch (:pointer (:struct cchar_t))) (n :int))
(defcfun ("mvhline_set" %mvhline-set) :int (y :int) (x :int) (wch (:pointer (:struct cchar_t))) (n :int))
(defcfun ("mvwhline_set" %mvwhline-set) :int (win window) (y :int) (x :int) (wch (:pointer (:struct cchar_t))) (n :int))
(defcfun ("vline_set" %vline-set) :int (wch (:pointer (:struct cchar_t))) (n :int))
(defcfun ("wvline_set" %wvline-set) :int (win window) (wch (:pointer (:struct cchar_t))) (n :int))
(defcfun ("mvvline_set" %mvvline-set) :int (y :int) (x :int) (wch (:pointer (:struct cchar_t))) (n :int))
(defcfun ("mvwvline_set" %mvwvline-set) :int (win window) (y :int) (x :int) (wch (:pointer (:struct cchar_t))) (n :int))

29
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/clear.lisp Normal file
View file

@ -0,0 +1,29 @@
(in-package :de.anvi.ncurses)
;;; clear
;;; clear all or part of a curses window
;;; http://invisible-island.net/ncurses/man/curs_clear.3x.html
;;; http://linux.die.net/man/3/erase
;;; C prototypes
;; int erase(void);
;; int werase(WINDOW *win);
;; int clear(void);
;; int wclear(WINDOW *win);
;; int clrtobot(void);
;; int wclrtobot(WINDOW *win);
;; int clrtoeol(void);
;; int wclrtoeol(WINDOW *win);
;;; Low-level CFFI wrappers
(defcfun ("erase" %erase) :int)
(defcfun ("werase" %werase) :int (win window))
(defcfun ("clear" %clear) :int)
(defcfun ("wclear" %wclear) :int (win window))
(defcfun ("clrtobot" %clrtobot) :int)
(defcfun ("wclrtobot" %wclrtobot) :int (win window))
(defcfun ("clrtoeol" %clrtoeol) :int)
(defcfun ("wclrtoeol" %wclrtoeol) :int (win window))

56
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/color.lisp Normal file
View file

@ -0,0 +1,56 @@
(in-package :de.anvi.ncurses)
;;; color
;;; curses color manipulation routines
;;; http://invisible-island.net/ncurses/man/curs_color.3x.html
;;; http://linux.die.net/man/3/init_color
;;; C prototypes
;; int start_color(void);
;; bool has_colors(void);
;; bool can_change_color(void);
;; int init_pair(short pair, short f, short b);
;; int init_color(short color, short r, short g, short b);
;; int pair_content(short pair, short *f, short *b);
;; int color_content(short color, short *r, short *g, short *b);
;; int init_extended_pair(int pair, int f, int b);
;; int init_extended_color(int color, int r, int g, int b);
;; int extended_pair_content(int pair, int *f, int *b);
;; int extended_color_content(int color, int *r, int *g, int *b);
;;; C macros
;; COLOR_PAIR(int n)
;; PAIR_NUMBER(attrs);
;;; Low-level CFFI wrappers
(defcfun ("start_color" %start-color) :int)
(defcfun ("has_colors" %has-colors) :boolean)
(defcfun ("can_change_color" %can-change-color) :boolean)
(defcfun ("init_pair" %init-pair) :int (pair :short) (f :short) (b :short))
(defcfun ("init_color" %init-color) :int (color :short) (r :short) (g :short) (b :short))
(defcfun ("pair_content" %pair-content) :int (pair :short) (f (:pointer :short)) (b (:pointer :short)))
(defcfun ("color_content" %color-content) :int (color :short) (r (:pointer :short)) (g (:pointer :short)) (b (:pointer :short)))
(defcfun ("init_extended_pair" %init-extended-pair) :int (pair :int) (f :int) (b :int))
(defcfun ("init_extended_color" %init-extended-color) :int (color :int) (r :int) (g :int) (b :int))
(defcfun ("extended_pair_content" %pair-extended-content) :int (pair :int) (f (:pointer :int)) (b (:pointer :int)))
(defcfun ("extended_color_content" %color-extended-content) :int (color :int) (r (:pointer :int)) (g (:pointer :int)) (b (:pointer :int)))
(defcfun ("COLOR_PAIR" %color-pair) :int (n :int))
(defcfun ("PAIR_NUMBER" %pair-number) :int (attrs :int))
(defconstant %COLOR-BLACK 0)
(defconstant %COLOR-RED 1)
(defconstant %COLOR-GREEN 2)
(defconstant %COLOR-YELLOW 3)
(defconstant %COLOR-BLUE 4)
(defconstant %COLOR-MAGENTA 5)
(defconstant %COLOR-CYAN 6)
(defconstant %COLOR-WHITE 7)

15
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/default_colors.lisp Normal file
View file

@ -0,0 +1,15 @@
(in-package :de.anvi.ncurses)
;; default_colors
;; use terminal's default colors
;; http://invisible-island.net/ncurses/man/default_colors.3x.html
;;; C prototypes
;; int use_default_colors(void);
;; int assume_default_colors(int fg, int bg);
;;; Low-level CFFI wrappers
(defcfun ("use_default_colors" %use-default-colors) :int)
(defcfun ("assume_default_colors" %assume-default-colors) :int (fg :int) (bg :int))

13
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/define_key.lisp Normal file
View file

@ -0,0 +1,13 @@
(in-package :de.anvi.ncurses)
;; define_key
;; define a keycode
;; http://invisible-island.net/ncurses/man/define_key.3x.html
;;; C prototypes
;; int define_key(const char *definition, int keycode);
;;; Low-level CFFI wrappers
(defcfun ("define_key" %define-key) :int (definition :string) (keycode :int))

19
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/delch.lisp Normal file
View file

@ -0,0 +1,19 @@
(in-package :de.anvi.ncurses)
;;; delch
;;; delete character under the cursor in a curses window
;;; http://invisible-island.net/ncurses/man/curs_delch.3x.html
;;; C prototypes
;; int delch(void);
;; int wdelch(WINDOW *win);
;; int mvdelch(int y, int x);
;; int mvwdelch(WINDOW *win, int y, int x);
;;; Low-level CFFI wrappers
(defcfun ("delch" %delch) :int)
(defcfun ("wdelch" %wdelch) :int (win window))
(defcfun ("mvdelch" %mvdelch) :int (y :int) (x :int))
(defcfun ("mvwdelch" %mvwdelch) :int (win window) (y :int) (x :int))

23
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/deleteln.lisp Normal file
View file

@ -0,0 +1,23 @@
(in-package :de.anvi.ncurses)
;;; deleteln
;;; delete and insert lines in a curses window
;;; http://invisible-island.net/ncurses/man/curs_deleteln.3x.html
;;; C prototypes
;; int deleteln(void);
;; int wdeleteln(WINDOW *win);
;; int insdelln(int n);
;; int winsdelln(WINDOW *win, int n);
;; int insertln(void);
;; int winsertln(WINDOW *win);
;;; Low-level CFFI wrappers
(defcfun ("deleteln" %deleteln) :int)
(defcfun ("wdeleteln" %wdeleteln) :int (win window))
(defcfun ("insdelln" %insdelln) :int (n :int))
(defcfun ("winsdelln" %winsdelln) :int (win window) (n :int))
(defcfun ("insertln" %insertln) :int)
(defcfun ("winsertln" %winsertln) :int (win window))

15
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/extend.lisp Normal file
View file

@ -0,0 +1,15 @@
(in-package :de.anvi.ncurses)
;;; extend
;;; miscellaneous curses extensions
;;; http://invisible-island.net/ncurses/man/curs_extend.3x.html
;;; C prototypes
;; const char * curses_version(void);
;; int use_extended_names(bool enable);
;;; Low-level CFFI wrappers
(defcfun ("curses_version" %curses-version) :string)
(defcfun ("use_extended_names" %use-extended-names) :int (enable :boolean))

21
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/get_wch.lisp Normal file
View file

@ -0,0 +1,21 @@
(in-package :de.anvi.ncurses)
;;; get_wch
;;; get (or push back) a wide (multi-byte) character from curses terminal keyboard
;;; http://invisible-island.net/ncurses/man/curs_get_wch.3x.html
;;; C prototypes
;; int get_wch(wint_t *wch);
;; int wget_wch(WINDOW *win, wint_t *wch);
;; int mvget_wch(int y, int x, wint_t *wch);
;; int mvwget_wch(WINDOW *win, int y, int x, wint_t *wch);
;; int unget_wch(const wchar_t wch);
;;; Low-level CFFI wrappers
(defcfun ("get_wch" %get-wch) :int (wch (:pointer wint_t)))
(defcfun ("wget_wch" %wget-wch) :int (win window) (wch (:pointer wint_t)))
(defcfun ("mvget_wch" %mvget-wch) :int (y :int) (x :int) (wch (:pointer wint_t)))
(defcfun ("mvwget_wch" %mvwget-wch) :int (win window) (y :int) (x :int) (wch (:pointer wint_t)))
(defcfun ("unget_wch" %unget-wch) :int (wch wchar_t))

26
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/getcchar.lisp Normal file
View file

@ -0,0 +1,26 @@
(in-package :de.anvi.ncurses)
;;; getcchar
;;; Get a wide character string and rendition from a cchar_t or set a cchar_t from a wide-character string
;;; http://invisible-island.net/ncurses/man/curs_getcchar.3x.html
;;; C prototypes
;; int getcchar(const cchar_t *wcval, wchar_t *wch, attr_t *attrs, short *color_pair, void *opts);
;; int setcchar(cchar_t *wcval, const wchar_t *wch, const attr_t attrs, short color_pair, void *opts);
;;; Low-level CFFI wrappers
(defcfun ("getcchar" %getcchar) :int
(wcval (:pointer (:struct cchar_t)))
(wch (:pointer wchar_t))
(attrs (:pointer attr))
(color_pair (:pointer :short))
(opts (:pointer :void)))
(defcfun ("setcchar" %setcchar) :int
(wcval (:pointer (:struct cchar_t)))
(wch (:pointer wchar_t))
(attrs attr)
(color_pair :short)
(opts (:pointer :void)))

25
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/getch.lisp Normal file
View file

@ -0,0 +1,25 @@
(in-package :de.anvi.ncurses)
;;; getch
;;; get (or push back) characters from curses terminal keyboard
;;; http://invisible-island.net/ncurses/man/curs_getch.3x.html
;;; http://www.manpagez.com/man/3/curs_getch/
;;; C prototypes
;; int getch(void);
;; int wgetch(WINDOW *win);
;; int mvgetch(int y, int x);
;; int mvwgetch(WINDOW *win, int y, int x);
;; int ungetch(int ch);
;; int has_key(int ch);
;;; Low-level CFFI wrappers
(defcfun ("getch" %getch) :int)
(defcfun ("wgetch" %wgetch) :int (win window))
(defcfun ("mvgetch" %mvgetch) :int (y :int) (x :int))
(defcfun ("mvwgetch" %mvwgetch) :int (win window) (y :int) (x :int))
(defcfun ("ungetch" %ungetch) :int (ch :int))
(defcfun ("has_key" %has-key) :int (ch :int))

27
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/getstr.lisp Normal file
View file

@ -0,0 +1,27 @@
(in-package :de.anvi.ncurses)
;;; getstr
;;; accept character strings from curses terminal keyboard
;;; http://invisible-island.net/ncurses/man/curs_getstr.3x.html
;;; C prototypes
;; int getstr(char *str);
;; int getnstr(char *str, int n);
;; int wgetstr(WINDOW *win, char *str);
;; int wgetnstr(WINDOW *win, char *str, int n);
;; int mvgetstr(int y, int x, char *str);
;; int mvgetnstr(int y, int x, char *str, int n);
;; int mvwgetstr(WINDOW *win, int y, int x, char *str);
;; int mvwgetnstr(WINDOW *, int y, int x, char *str, int n);
;;; Low-level CFFI wrappers
(defcfun ("getstr" %getstr) :int (str :string))
(defcfun ("getnstr" %getnstr) :int (str :string) (n :int))
(defcfun ("wgetstr" %wgetstr) :int (win window) (str :string))
(defcfun ("wgetnstr" %wgetnstr) :int (win window) (str :string) (n :int))
(defcfun ("mvgetstr" %mvgetstr) :int (y :int) (x :int) (str :string))
(defcfun ("mvgetnstr" %mvgetnstr) :int (y :int) (x :int) (str :string) (n :int))
(defcfun ("mvwgetstr" %mvwgetstr) :int (win window) (y :int) (x :int) (str :string))
(defcfun ("mvwgetnstr" %mvwgetnstr) :int (win window) (y :int) (x :int) (str :string) (n :int))

42
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/getyx.lisp Normal file
View file

@ -0,0 +1,42 @@
;; (in-package :de.anvi.ncurses)
;;; getyx
;;; get curses cursor and window coordinates
;;; http://invisible-island.net/ncurses/man/curs_getyx.3x.html
;;; C prototypes
;; void getyx(WINDOW *win, int y, int x);
;; void getparyx(WINDOW *win, int y, int x);
;; void getbegyx(WINDOW *win, int y, int x);
;; void getmaxyx(WINDOW *win, int y, int x);
;;; Low-level CFFI wrappers
;; see legacy.lisp
;;; NOTES
#|
These four C macros are defined in terms of other, simpler macros:
#define getyx(win,y,x) (y = getcury(win), x = getcurx(win))
#define getbegyx(win,y,x) (y = getbegy(win), x = getbegx(win))
#define getmaxyx(win,y,x) (y = getmaxy(win), x = getmaxx(win))
#define getparyx(win,y,x) (y = getpary(win), x = getparx(win))
And those simpler macros are just accessing the window struct.
#define getcurx(win) ((win) ? (win)->_curx : ERR)
#define getcury(win) ((win) ? (win)->_cury : ERR)
#define getbegx(win) ((win) ? (win)->_begx : ERR)
#define getbegy(win) ((win) ? (win)->_begy : ERR)
#define getmaxx(win) ((win) ? ((win)->_maxx + 1) : ERR)
#define getmaxy(win) ((win) ? ((win)->_maxy + 1) : ERR)
#define getparx(win) ((win) ? (win)->_parx : ERR)
#define getpary(win) ((win) ? (win)->_pary : ERR)
Those are defined as low-level functions in legacy.lisp.
|#

19
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/in_wch.lisp Normal file
View file

@ -0,0 +1,19 @@
(in-package :de.anvi.ncurses)
;;; in_wch
;;; extract a wide (multi-byte) character and rendition from a window
;;; http://invisible-island.net/ncurses/man/curs_in_wch.3x.html
;;; C prototypes
;; int in_wch(cchar_t *wcval);
;; int mvin_wch(int y, int x, cchar_t *wcval);
;; int win_wch(WINDOW *win, cchar_t *wcval);
;; int mvwin_wch(WINDOW *win, int y, int x, cchar_t *wcval);
;;; Low-level CFFI wrappers
(defcfun ("in_wch" %in-wch) :int (wcval (:pointer (:struct cchar_t))))
(defcfun ("mvin_wch" %mvin-wch) :int (y :int) (x :int) (wcval (:pointer (:struct cchar_t))))
(defcfun ("win_wch" %win-wch) :int (win window) (wcval (:pointer (:struct cchar_t))))
(defcfun ("mvwin_wch" %mvwin-wch) :int (win window) (y :int) (x :int) (wcval (:pointer (:struct cchar_t))))

19
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/inch.lisp Normal file
View file

@ -0,0 +1,19 @@
(in-package :de.anvi.ncurses)
;;; inch
;;; get a character and attributes from a curses window
;;; http://invisible-island.net/ncurses/man/curs_inch.3x.html
;;; C prototypes
;; chtype inch(void);
;; chtype winch(WINDOW *win);
;; chtype mvinch(int y, int x);
;; chtype mvwinch(WINDOW *win, int y, int x);
;;; Low-level CFFI wrappers
(defcfun ("inch" %inch) chtype)
(defcfun ("winch" %winch) chtype (win window))
(defcfun ("mvinch" %mvinch) chtype (y :int) (x :int))
(defcfun ("mvwinch" %mvwinch) chtype (win window) (y :int) (x :int))

27
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/inchstr.lisp Normal file
View file

@ -0,0 +1,27 @@
(in-package :de.anvi.ncurses)
;;; inchstr
;;; get a string of characters (and attributes) from a curses window
;;; http://invisible-island.net/ncurses/man/curs_inchstr.3x.html
;;; C prototypes
;; int inchstr(chtype *chstr);
;; int inchnstr(chtype *chstr, int n);
;; int winchstr(WINDOW *win, chtype *chstr);
;; int winchnstr(WINDOW *win, chtype *chstr, int n);
;; int mvinchstr(int y, int x, chtype *chstr);
;; int mvinchnstr(int y, int x, chtype *chstr, int n);
;; int mvwinchstr(WINDOW *win, int y, int x, chtype *chstr);
;; int mvwinchnstr(WINDOW *win, int y, int x, chtype *chstr, int n);
;;; Low-level CFFI wrappers
(defcfun ("inchstr" %inchstr) :int (chstr (:pointer chtype)))
(defcfun ("inchnstr" %inchnstr) :int (chstr (:pointer chtype)) (n :int))
(defcfun ("winchstr" %winchstr) :int (win window) (chstr (:pointer chtype)))
(defcfun ("winchnstr" %winchnstr) :int (win window) (chstr (:pointer chtype)) (n :int))
(defcfun ("mvinchstr" %mvinchstr) :int (y :int) (x :int) (chstr (:pointer chtype)))
(defcfun ("mvinchnstr" %mvinchnstr) :int (y :int) (x :int) (chstr (:pointer chtype)) (n :int))
(defcfun ("mvwinchstr" %mvwinchstr) :int (win window) (y :int) (x :int) (chstr (:pointer chtype)))
(defcfun ("mvwinchnstr" %mvwinchnstr) :int (win window) (y :int) (x :int) (chstr (:pointer chtype)) (n :int))

24
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/initscr.lisp Normal file
View file

@ -0,0 +1,24 @@
(in-package :de.anvi.ncurses)
;;; initscr
;;; screen initialization and manipulation routines
;;; http://invisible-island.net/ncurses/man/curs_initscr.3x.html
;;; http://www.manpagez.com/man/3/curs_initscr/
;;; C prototypes
;; WINDOW *initscr(void);
;; int endwin(void);
;; bool isendwin(void);
;; SCREEN *newterm(char *type, FILE *outfd, FILE *infd);
;; SCREEN *set_term(SCREEN *new);
;; void delscreen(SCREEN *sp);
;;; Low-level CFFI wrappers
(defcfun ("initscr" %initscr) window)
(defcfun ("endwin" %endwin) :int)
(defcfun ("isendwin" %isendwin) :boolean)
(defcfun ("newterm" %newterm) screen (type :string) (outfd file) (infd file))
(defcfun ("set_term" %set-term) screen (new screen))
(defcfun ("delscreen" %delscreen) :void (sp screen))

45
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/inopts.lisp Normal file
View file

@ -0,0 +1,45 @@
(in-package :de.anvi.ncurses)
;;; inopts
;;; curses input options
;;; http://invisible-island.net/ncurses/man/curs_inopts.3x.html
;;; C prototypes
;; int cbreak(void);
;; int nocbreak(void);
;; int echo(void);
;; int noecho(void);
;; int halfdelay(int tenths);
;; int intrflush(WINDOW *win, bool bf);
;; int keypad(WINDOW *win, bool bf);
;; int meta(WINDOW *win, bool bf);
;; int nodelay(WINDOW *win, bool bf);
;; int raw(void);
;; int noraw(void);
;; void noqiflush(void);
;; void qiflush(void);
;; int notimeout(WINDOW *win, bool bf);
;; void timeout(int delay);
;; void wtimeout(WINDOW *win, int delay);
;; int typeahead(int fd);
;;; Low-level CFFI wrappers
(defcfun ("cbreak" %cbreak) :int)
(defcfun ("nocbreak" %nocbreak) :int)
(defcfun ("echo" %echo) :int)
(defcfun ("noecho" %noecho) :int)
(defcfun ("halfdelay" %halfdelay) :int (tenths :int))
(defcfun ("intrflush" %intrflush) :int (win window) (bf :boolean))
(defcfun ("keypad" %keypad) :int (win window) (bf :boolean))
(defcfun ("meta" %meta) :int (win window) (bf :boolean))
(defcfun ("nodelay" %nodelay) :int (win window) (bf :boolean))
(defcfun ("raw" %raw) :int)
(defcfun ("noraw" %noraw) :int)
(defcfun ("noqiflush" %noqiflush) :void)
(defcfun ("qiflush" %qiflush) :void)
(defcfun ("notimeout" %notimeout) :int (win window) (bf :boolean))
(defcfun ("timeout" %timeout) :void (delay :int))
(defcfun ("wtimeout" %wtimeout) :void (win window) (delay :int))
(defcfun ("typeahead" %typeahead) :int (fd :int))

19
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/ins_wch.lisp Normal file
View file

@ -0,0 +1,19 @@
(in-package :de.anvi.ncurses)
;;; ins_wch
;;; insert a complex character and rendition into a window
;;; http://invisible-island.net/ncurses/man/curs_ins_wch.3x.html
;;; C prototypes
;; int ins_wch(const cchar_t *wch);
;; int wins_wch(WINDOW *win, const cchar_t *wch);
;; int mvins_wch(int y, int x, const cchar_t *wch);
;; int mvwins_wch(WINDOW *win, int y, int x, const cchar_t *wch);
;;; Low-level CFFI wrappers
(defcfun ("ins_wch" %ins-wch) :int (wch (:pointer (:struct cchar_t))))
(defcfun ("wins_wch" %wins-wch) :int (win window) (wch (:pointer (:struct cchar_t))))
(defcfun ("mvins_wch" %mvins-wch) :int (y :int) (x :int) (wch (:pointer (:struct cchar_t))))
(defcfun ("mvwins_wch" %mvwins-wch) :int (win window) (y :int) (x :int) (wch (:pointer (:struct cchar_t))))

19
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/insch.lisp Normal file
View file

@ -0,0 +1,19 @@
(in-package :de.anvi.ncurses)
;;; insch
;;; insert a character before cursor in a curses window
;;; http://invisible-island.net/ncurses/man/curs_insch.3x.html
;;; C prototypes
;; int insch(chtype ch);
;; int winsch(WINDOW *win, chtype ch);
;; int mvinsch(int y, int x, chtype ch);
;; int mvwinsch(WINDOW *win, int y, int x, chtype ch);
;;; Low-level CFFI wrappers
(defcfun ("insch" %insch) :int (ch chtype))
(defcfun ("winsch" %winsch) :int (win window) (ch chtype))
(defcfun ("mvinsch" %mvinsch) :int (y :int) (x :int) (ch chtype))
(defcfun ("mvwinsch" %mvwinsch) :int (win window) (y :int) (x :int) (ch chtype))

27
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/insstr.lisp Normal file
View file

@ -0,0 +1,27 @@
(in-package :de.anvi.ncurses)
;;; insstr
;;; insert string before cursor in a curses window
;;; http://invisible-island.net/ncurses/man/curs_insstr.3x.html
;;; C prototypes
;; int insstr(const char *str);
;; int insnstr(const char *str, int n);
;; int winsstr(WINDOW *win, const char *str);
;; int winsnstr(WINDOW *win, const char *str, int n);
;; int mvinsstr(int y, int x, const char *str);
;; int mvinsnstr(int y, int x, const char *str, int n);
;; int mvwinsstr(WINDOW *win, int y, int x, const char *str);
;; int mvwinsnstr(WINDOW *win, int y, int x, const char *str, int n);
;;; Low-level CFFI wrappers
(defcfun ("insstr" %insstr) :int (str :string))
(defcfun ("insnstr" %insnstr) :int (str :string) (n :int))
(defcfun ("winsstr" %winsstr) :int (win window) (str :string))
(defcfun ("winsnstr" %winsnstr) :int (win window) (str :string) (n :int))
(defcfun ("mvinsstr" %mvinsstr) :int (y :int) (x :int) (str :string))
(defcfun ("mvinsnstr" %mvinsnstr) :int (y :int) (x :int) (str :string) (n :int))
(defcfun ("mvwinsstr" %mvwinsstr) :int (win window) (y :int) (x :int) (str :string))
(defcfun ("mvwinsnstr" %mvwinsnstr) :int (win window) (y :int) (x :int) (str :string) (n :int))

27
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/instr.lisp Normal file
View file

@ -0,0 +1,27 @@
(in-package :de.anvi.ncurses)
;;; instr
;;; get a string of characters from a curses window
;;; http://invisible-island.net/ncurses/man/curs_instr.3x.html
;;; C prototypes
;; int instr(char *str);
;; int innstr(char *str, int n);
;; int winstr(WINDOW *win, char *str);
;; int winnstr(WINDOW *win, char *str, int n);
;; int mvinstr(int y, int x, char *str);
;; int mvinnstr(int y, int x, char *str, int n);
;; int mvwinstr(WINDOW *win, int y, int x, char *str);
;; int mvwinnstr(WINDOW *win, int y, int x, char *str, int n);
;;; Low-level CFFI wrappers
(defcfun ("instr" %instr) :int (str :string))
(defcfun ("innstr" %innstr) :int (str :string) (n :int))
(defcfun ("winstr" %winstr) :int (win window) (str :string))
(defcfun ("winnstr" %winnstr) :int (win window) (str :string) (n :int))
(defcfun ("mvinstr" %mvinstr) :int (y :int) (x :int) (str :string))
(defcfun ("mvinnstr" %mvinnstr) :int (y :int) (x :int) (str :string) (n :int))
(defcfun ("mvwinstr" %mvwinstr) :int (win window) (y :int) (x :int) (str :string))
(defcfun ("mvwinnstr" %mvwinnstr) :int (win window) (y :int) (x :int) (str :string) (n :int))

27
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/inwstr.lisp Normal file
View file

@ -0,0 +1,27 @@
(in-package :de.anvi.ncurses)
;;; inwstr
;;; extract a string of wchar_t characters from a curses window
;;; http://invisible-island.net/ncurses/man/curs_inwstr.3x.html
;;; C prototypes
;; int inwstr(wchar_t *str);
;; int innwstr(wchar_t *str, int n);
;; int winwstr(WINDOW *win, wchar_t *str);
;; int winnwstr(WINDOW *win, wchar_t *str, int n);
;; int mvinwstr(int y, int x, wchar_t *str);
;; int mvinnwstr(int y, int x, wchar_t *str, int n);
;; int mvwinwstr(WINDOW *win, int y, int x, wchar_t *str);
;; int mvwinnwstr(WINDOW *win, int y, int x, wchar_t *str, int n);
;;; Low-level CFFI wrappers
(defcfun ("inwstr" %inwstr) :int (str (:pointer wchar_t)))
(defcfun ("innwstr" %innwstr) :int (str (:pointer wchar_t)) (n :int))
(defcfun ("winwstr" %winwstr) :int (win window) (str (:pointer wchar_t)))
(defcfun ("winnwstr" %winnwstr) :int (win window) (str (:pointer wchar_t)) (n :int))
(defcfun ("mvinwstr" %mvinwstr) :int (y :int) (x :int) (str (:pointer wchar_t)))
(defcfun ("mvinnwstr" %mvinnwstr) :int (y :int) (x :int) (str (:pointer wchar_t)) (n :int))
(defcfun ("mvwinwstr" %mvwinwstr) :int (win window) (y :int) (x :int) (str (:pointer wchar_t)))
(defcfun ("mvwinnwstr" %mvwinnwstr) :int (win window) (y :int) (x :int) (str (:pointer wchar_t)) (n :int))

33
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/kernel.lisp Normal file
View file

@ -0,0 +1,33 @@
(in-package :de.anvi.ncurses)
;;; kernel
;;; low-level curses routines
;;; http://invisible-island.net/ncurses/man/curs_kernel.3x.html
;;; C prototypes
;; int def_prog_mode(void);
;; int def_shell_mode(void);
;; int reset_prog_mode(void);
;; int reset_shell_mode(void);
;; int resetty(void);
;; int savetty(void);
;; void getsyx(int y, int x);
;; void setsyx(int y, int x);
;; int ripoffline(int line, int (*init)(WINDOW *, int));
;; int curs_set(int visibility);
;; int napms(int ms);
;;; Low-level CFFI wrappers
(defcfun ("def_prog_mode" %def-prog-mode) :int)
(defcfun ("def_shell_mode" %def-shell-mode) :int)
(defcfun ("reset_prog_mode" %reset-prog-mode) :int)
(defcfun ("reset_shell_mode" %reset-shell-mode) :int)
(defcfun ("resetty" %resetty) :int)
(defcfun ("savetty" %savetty) :int)
(defcfun ("getsyx" %getsyx) :void (y :int) (x :int))
(defcfun ("setsyx" %setsyx) :void (y :int) (x :int))
(defcfun ("ripoffline" %ripoffline) :int (line :int) (init :pointer))
(defcfun ("curs_set" %curs-set) :int (visibility :int))
(defcfun ("napms" %napms) :int (ms :int))

13
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/key_defined.lisp Normal file
View file

@ -0,0 +1,13 @@
(in-package :de.anvi.ncurses)
;; key_defined
;; check if a keycode is defined
;; http://invisible-island.net/ncurses/man/key_defined.3x.html
;;; C prototypes
;; int key_defined(const char *definition);
;;; Low-level CFFI wrappers
(defcfun ("key_defined" %key-defined) :int (definition :string))

13
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/keybound.lisp Normal file
View file

@ -0,0 +1,13 @@
(in-package :de.anvi.ncurses)
;; keybound
;; return definition of keycode
;; http://invisible-island.net/ncurses/man/keybound.3x.html
;;; C prototypes
;; char *keybound(int keycode, int count);
;;; Low-level CFFI wrappers
(defcfun ("keybound" %keybound) :string (keycode :int) (count :int))

28
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/legacy.lisp Normal file
View file

@ -0,0 +1,28 @@
(in-package :de.anvi.ncurses)
;;; legacy
;;; get curses cursor and window coordinates, attributes
;;; http://invisible-island.net/ncurses/man/curs_legacy.3x.html
;;; C prototypes
;; int getattrs(WINDOW *win);
;; int getbegx(WINDOW *win);
;; int getbegy(WINDOW *win);
;; int getcurx(WINDOW *win);
;; int getcury(WINDOW *win);
;; int getmaxx(WINDOW *win);
;; int getmaxy(WINDOW *win);
;; int getparx(WINDOW *win);
;; int getpary(WINDOW *win);
;;; Low-level CFFI wrappers
(defcfun ("getbegx" %getbegx) :int (win window))
(defcfun ("getbegy" %getbegy) :int (win window))
(defcfun ("getcurx" %getcurx) :int (win window))
(defcfun ("getcury" %getcury) :int (win window))
(defcfun ("getmaxx" %getmaxx) :int (win window))
(defcfun ("getmaxy" %getmaxy) :int (win window))
(defcfun ("getparx" %getparx) :int (win window))
(defcfun ("getpary" %getpary) :int (win window))

12
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/legacy_coding.lisp Normal file
View file

@ -0,0 +1,12 @@
(in-package :de.anvi.ncurses)
;;; legacy coding
;;; http://invisible-island.net/ncurses/man/legacy_coding.3x.html
;;; C prototypes
;; int use_legacy_coding(int level);
;;; Low-level CFFI wrappers
(defcfun ("use_legacy_coding" %use-legacy-coding) :int (level :int))

24
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/mouse.lisp Normal file
View file

@ -0,0 +1,24 @@
(in-package :de.anvi.ncurses)
;;; mouse
;;; mouse interface through curses
;;; http://invisible-island.net/ncurses/man/curs_mouse.3x.html
;;; C prototypes
;;; bool has_mouse(void);
;;; int getmouse(MEVENT *event);
;;; int ungetmouse(MEVENT *event);
;;; mmask_t mousemask(mmask_t newmask, mmask_t *oldmask);
;;; bool wenclose(const WINDOW *win, int y, int x);
;;; bool mouse_trafo(int* pY, int* pX, bool to_screen);
;;; bool wmouse_trafo(const WINDOW* win, int* pY, int* pX, bool to_screen);
;;; int mouseinterval(int erval);
;;; Low-level CFFI wrappers
(defcfun ("getmouse" %getmouse) :int (event (:pointer (:struct mevent))))
(defcfun ("mousemask" %mousemask) mmask_t (newmask mmask_t) (oldmask (:pointer mmask_t)))
(defcfun ("has_mouse" %has-mouse) :boolean)
(defcfun ("ungetmouse" %ungetmouse) :int (event (:pointer (:struct mevent))))

16
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/move.lisp Normal file
View file

@ -0,0 +1,16 @@
(in-package :de.anvi.ncurses)
;;; move
;;; move curses window cursor
;;; http://invisible-island.net/ncurses/man/curs_move.3x.html
;;; http://www.manpagez.com/man/3/curs_move/
;;; C prototypes
;; int move(int y, int x);
;; int wmove(WINDOW *win, int y, int x);
;;; Low-level CFFI wrappers
(defcfun ("move" %move) :int (y :int) (x :int))
(defcfun ("wmove" %wmove) :int (win window) (y :int) (x :int))

213
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/ncurses.lisp Normal file
View file

@ -0,0 +1,213 @@
(in-package :de.anvi.ncurses)
;;; ncurses
;;; CRT screen handling and optimization package
;;; http://invisible-island.net/ncurses/man/ncurses.3x.html
;; The wide multi-byte library is preferred and will be loaded when the underlying lisp system supports unicode.
#+(or sb-unicode unicode openmcl-unicode-strings)
(define-foreign-library libncursesw
(:darwin (:or "libncursesw.6.dylib" "libncursesw.5.dylib" "libncursesw.dylib" "libcurses.dylib"))
(:unix (:or "libncursesw.so.6.1" "libncursesw.so.6.0" "libncursesw.so.6" "libncursesw.so.5.9" "libncursesw.so.5" "libncursesw.so"))
(t (:default "libncursesw")))
#+(or sb-unicode unicode openmcl-unicode-strings)
(use-foreign-library libncursesw)
;; Attempt to use the legacy single-byte library only when the lisp implementation doesnt support unicode.
#-(or sb-unicode unicode openmcl-unicode-strings)
(define-foreign-library libncurses
(:darwin (:or "libncurses.6.dylib" "libncurses.5.dylib" "libncurses.dylib" "libcurses.dylib"))
(:unix (:or "libncurses.so.6.1" "libncurses.so.6.0" "libncurses.so.6" "libncurses.so.5.9" "libncurses.so.5" "libncurses.so"))
(t (:default "libncurses")))
#-(or sb-unicode unicode openmcl-unicode-strings)
(use-foreign-library libncurses)
;;; ------------------------------------------------------------------
;; Every function that can take a win, should take a win.
;; We dont want functions that implicitly operate on a global stdscr.
;; Function should return lisp-style bools, not C type int 0 or 1.
;; cffi automatically does this conversion.
;;; ------------------------------------------------------------------
;; General ncurses library implementation info:
;; data types:
;; http://pubs.opengroup.org/onlinepubs/7908799/xcurses/curses.h.html
;; http://pubs.opengroup.org/onlinepubs/7908799/xcurses/implement.html
;; http://pubs.opengroup.org/onlinepubs/7908799/cursesix.html
;; http://refspecs.linuxbase.org/LSB_3.0.0/LSB-Core-generic/LSB-Core-generic/libncurses.html
;; http://refspecs.linuxbase.org/LSB_3.0.0/LSB-Core-generic/LSB-Core-generic/libncurses-ddefs.html
;; http://h71000.www7.hp.com/doc/83final/5763/5763pro_016.html
;; http://docs.python.org/release/2.4.3/lib/curses-window-objects.html
;; http://web.ist.utl.pt/tiago.dionizio/lua/lcurses.html
;;; ------------------------------------------------------------------
;;; Types
;; Basic types as seen in the ncurses function prototypes.
;; These will only be used inside cffi wrappers.
;; not used, cffi automatically translates a boolean type
;; typedef unsigned char bool;
(defctype bool :unsigned-char)
#|
--enable-lp64
Allows an application to define _LP64 to declare chtype and mmask_t as
simply unsigned rather than the configured types
using the --with-chtype and --with-mmask_t options.
#if 1 && defined(_LP64)
typedef unsigned chtype;
typedef unsigned mmask_t;
#else
typedef uint32_t chtype;
typedef uint32_t mmask_t;
#endif
|#
;; default ubuntu build options, they build for API5.
;; --disable-lp64 --with-chtype='long' --with-mmask-t='long'
;; the default type on ubuntu isnt "unsigned int" but "long", which means signed long.
;; We will use the ABI6 default uint32_t instead of long.
;; TODO: use ABI6 values for chtype, cchar_t and mmask: --with-chtype=uint32_t
;;(defctype chtype :unsigned-int)
(defctype chtype :uint32)
;; wide character type, defined in:
;; /usr/lib/gcc/x86_64-linux-gnu/5/include/stddef.h
;; it has to be able to contain the 21-bit 10FFFF, which is the max allowed unicode point.
(defctype wchar_t :int32)
;; typedef unsigned int wint_t;
;; used in get_wch.lisp
;; wint_t needs to be a signed int to represent a negative WEOF value.
(defctype wint_t :int32)
;; typedef chtype attr_t;
;; TODO: rename this to attr_t
(defctype attr :uint32
"The 32 bit integral type attr_t holds an OR-ed set of attributes.")
(defctype attr_t :uint32
"The 32 bit integral type attr_t holds an OR-ed set of attributes.")
;; winptr = *WINDOW
;; TODO: define window struct
;; (defctype ptr-window (:pointer (:struct window)))
(defctype window :pointer)
;; scrptr = *SCREEN
(defctype screen :pointer)
;; fileptr = *FILE
(defctype file :pointer)
;;; C structures
#|
Excerpt from /usr/include/ncurses.h
/*
* cchar_t stores an array of CCHARW_MAX wide characters. The first is
* normally a spacing character. The others are non-spacing. If those
* (spacing and nonspacing) do not fill the array, a null L'\0' follows.
* Otherwise, a null is assumed to follow when extracting via getcchar().
*/
#define CCHARW_MAX 5
typedef struct
{
attr_t attr;
wchar_t chars[CCHARW_MAX];
#if 0
#undef NCURSES_EXT_COLORS
#define NCURSES_EXT_COLORS 20110404
int ext_color; /* color pair, must be more than 16-bits */
#endif
}
cchar_t;
|#
;; For non-extended colors, the color pair is OR-ed into the attr value, like it has been done
;; with color pairs in chtypes. This is ABI5.
;;(defcstruct cchar_t
;; "A C struct containing contains a wide char and an integer containing the color pair and attributes."
;; (cchar-attr attr)
;; (cchar-chars wchar_t :count 5))
;; For extended colors, we get a new struct slot. This is ABI6, which is the default since ncurses 6.0, 20150808.
;; Intended to be used with setcchar.
;; TODO: write meaningsful docstrings here.
(defcstruct cchar_t
"C struct containing a wide char, a color pair and attributes."
(cchar-attr attr_t)
(cchar-chars wchar_t :count 5)
(cchar-colors :int))
(defctype ptr-cchar_t (:pointer (:struct cchar_t)))
;; Intended to be used with convert-to-foreign plist translation.
;; For some reasons, plists with pointers dont work, so we have to pass by value.
;; TODO: we dont need this any more, everything works now with the cchar_t struct.
(defcstruct cchar
"C struct containing a wide char, a color pair and attributes."
(cchar-attr attr_t)
(cchar-chars wchar_t)
(cchar-colors :int))
;; the default on ubuntu 12.04, 16.04 is --enable-ext-colors,
;; so is probably on debian, so we need to include "int ext_color" by default in
;; the cchar struct.
;; convert-to-foreign and convert-from-foreign do not return structs,
;; but pointers to structs.
;;; mouse.lisp
;; typedef unsigned long mmask_t;
;;
;; typedef struct {
;; short id; /* ID to distinguish multiple devices */
;; int x, y, z; /* event coordinates */
;; mmask_t bstate; /* button state bits */
;; } MEVENT;
;; TODO: ABI6: --with-mmask_t=uint32_t
;;(defctype mmask_t :unsigned-int)
(defctype mmask_t :uint32)
(defcstruct mevent
"C struct containing mouse coordinates and button state."
(id :short)
(x :int)
(y :int)
(z :int)
(bstate mmask_t))
;;; ------------------------------------------------------------------
;;; Constants
;; #defines taken from ncurses.h, should not be user visible.
;; wherever cffi defines a boolean, we can use t and nil instead of TRUE and FALSE.
;;(defconstant TRUE 1)
;;(defconstant FALSE 0)
;;(defconstant ERROR -1)
;;(defconstant OK 0)

40
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/opaque.lisp Normal file
View file

@ -0,0 +1,40 @@
(in-package :de.anvi.ncurses)
;;; opaque
;;; curses window properties
;;; http://invisible-island.net/ncurses/man/curs_opaque.3x.html
;;; C prototypes
;; bool is_cleared(const WINDOW *win);
;; bool is_idcok(const WINDOW *win);
;; bool is_idlok(const WINDOW *win);
;; bool is_immedok(const WINDOW *win);
;; bool is_keypad(const WINDOW *win);
;; bool is_leaveok(const WINDOW *win);
;; bool is_nodelay(const WINDOW *win);
;; bool is_notimeout(const WINDOW *win);
;; bool is_pad(const WINDOW *win);
;; bool is_scrollok(const WINDOW *win);
;; bool is_subwin(const WINDOW *win);
;; bool is_syncok(const WINDOW *win);
;; WINDOW *wgetparent(const WINDOW *win);
;; int wgetscrreg(const WINDOW *win, int *top, int *bottom);
;;; Low-level CFFI wrappers
(defcfun ("is_cleared" %is-cleared) :boolean (win window))
(defcfun ("is_idcok" %is-idcok) :boolean (win window))
(defcfun ("is_idlok" %is-idlok) :boolean (win window))
(defcfun ("is_immedok" %is-immedok) :boolean (win window))
(defcfun ("is_keypad" %is-keypad) :boolean (win window))
(defcfun ("is_leaveok" %is-leaveok) :boolean (win window))
(defcfun ("is_nodelay" %is-nodelay) :boolean (win window))
(defcfun ("is_notimeout" %is-notimeout) :boolean (win window))
(defcfun ("is_pad" %is-pad) :boolean (win window))
(defcfun ("is_scrollok" %is-scrollok) :boolean (win window))
(defcfun ("is_subwin" %is-subwin) :boolean (win window))
(defcfun ("is_syncok" %is-syncok) :boolean (win window))
(defcfun ("wgetparent" %wgetparent) window (win window))
(defcfun ("wgetscrreg" %wgetscrreg) :int (win window) (top (:pointer :int)) (bottom (:pointer :int)))

35
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/outopts.lisp Normal file
View file

@ -0,0 +1,35 @@
(in-package :de.anvi.ncurses)
;;; outopts
;;; curses output options
;;; http://invisible-island.net/ncurses/man/curs_outopts.3x.html
;;; C prototypes
;; int clearok(WINDOW *win, bool bf);
;; int idlok(WINDOW *win, bool bf);
;; void idcok(WINDOW *win, bool bf);
;; void immedok(WINDOW *win, bool bf);
;; int leaveok(WINDOW *win, bool bf);
;; int scrollok(WINDOW *win, bool bf);
;; int setscrreg(int top, int bot);
;; int wsetscrreg(WINDOW *win, int top, int bot);
;; int nl(void);
;; int nonl(void);
;;; Low-level CFFI wrappers
(defcfun ("clearok" %clearok) :int (win window) (bf :boolean))
(defcfun ("idlok" %idlok) :int (win window) (bf :boolean))
(defcfun ("idcok" %idcok) :void (win window) (bf :boolean))
(defcfun ("immedok" %immedok) :void (win window) (bf :boolean))
(defcfun ("leaveok" %leaveok) :int (win window) (bf :boolean))
(defcfun ("scrollok" %scrollok) :int (win window) (bf :boolean))
(defcfun ("setscrreg" %setscrreg) :int (top :int) (bot :int))
(defcfun ("wsetscrreg" %wsetscrreg) :int (win window) (top :int) (bot :int))
(defcfun ("nl" %nl) :void)
(defcfun ("nonl" %nonl) :void)

467
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/package.lisp Normal file
View file

@ -0,0 +1,467 @@
(defpackage #:de.anvi.ncurses
(:documentation "Low-level CFFI bindings to the Ncurses C API. Not meant to be used directly.")
(:use #:common-lisp #:cffi)
(:export
;; addch / add a character (with attributes) to a curses window, then advance the cursor
%addch
%waddch
%mvaddch
%mvwaddch
%echochar
%wechochar
;; add_wch / add a complex character and rendition to a curses window, then advance the cursor
%add-wch
%wadd-wch
%mvadd-wch
%mvwadd-wch
%echo-wchar
%wecho-wchar
;; addstr / add a string of characters to a curses window and advance cursor
%addstr
%addnstr
%waddstr
%waddnstr
%mvaddstr
%mvaddnstr
%mvwaddstr
%mvwaddnstr
;; attr / curses character and window attribute control routines
%attroff
%wattroff
%attron
%wattron
%attrset
%wattrset
%color-set
%wcolor-set
%standend
%wstandend
%standout
%wstandout
%attr-get
%wattr-get
%attr-off
%wattr-off
%attr-on
%wattr-on
%attr-set
%wattr-set
%chgat
%wchgat
%mvchgat
%mvwchgat
;; beep / curses bell and screen flash routines
%beep
%flash
;; bkgd / curses window background manipulation routines
%bkgdset
%wbkgdset
%bkgd
%wbkgd
%getbkgd
;; bkgrnd / window complex background manipulation routines
%bkgrnd
%wbkgrnd
%bkgrndset
%wbkgrndset
%getbkgrnd
%wgetbkgrnd
;; border / create curses borders, horizontal and vertical lines
%border
%wborder
%box
%hline
%whline
%vline
%wvline
%mvhline
%mvwhline
%mvvline
%mvwvline
;; border_set / create curses borders or lines using complex characters and renditions
%border-set
%wborder-set
%box-set
%hline-set
%whline-set
%mvhline-set
%mvwhline-set
%vline-set
%wvline-set
%mvvline-set
%mvwvline-set
;; clear / clear all or part of a curses window
%erase
%werase
%clear
%wclear
%clrtobot
%wclrtobot
%clrtoeol
%wclrtoeol
;; color / curses color manipulation routines
%start-color
%has-colors
%can-change-color
%init-pair
%init-color
%pair-content
%color-content
%init-extended-pair
%init-extended-color
%pair-extended-content
%color-extended-content
%color-pair
%pair-number
%COLOR-BLACK
%COLOR-RED
%COLOR-GREEN
%COLOR-YELLOW
%COLOR-BLUE
%COLOR-MAGENTA
%COLOR-CYAN
%COLOR-WHITE
;; default_colors / use terminal's default colors
%use-default-colors
%assume-default-colors
;; define_key / define a keycode
%define-key
;; delch / delete character under the cursor in a curses window
%delch
%wdelch
%mvdelch
%mvwdelch
;; deleteln / delete and insert lines in a curses window
%deleteln
%wdeleteln
%insdelln
%winsdelln
%insertln
%winsertln
;; extend / miscellaneous curses extensions
%curses-version
%use-extended-names
;; getcchar / Get a wide character string and rendition from a cchar_t or set a cchar_t from a wide-character string
%getcchar
%setcchar
;; getch / get (or push back) characters from curses terminal keyboard
%getch
%wgetch
%mvgetch
%mvwgetch
%ungetch
%has-key
;; get_wch / get (or push back) a wide (multi-byte) character from curses terminal keyboard
%get-wch
%wget-wch
%mvget-wch
%mvwget-wch
%unget-wch
wint_t
;; getstr / accept character strings from curses terminal keyboard
%getstr
%getnstr
%wgetstr
%wgetnstr
%mvgetstr
%mvgetnstr
%mvwgetstr
%mvwgetnstr
;; getyx / get curses cursor and window coordinates
;; --> legacy
;; inch / get a character and attributes from a curses window
%inch
%winch
%mvinch
%mvwinch
;; in_wch / extract a wide character and rendition from a window
%in-wch
%mvin-wch
%win-wch
%mvwin-wch
;; inchstr / get a string of characters (and attributes) from a curses window
%inchstr
%inchnstr
%winchstr
%winchnstr
%mvinchstr
%mvinchnstr
%mvwinchstr
%mvwinchnstr
;; initscr / Screen initialization and manipulation routines
%initscr
%endwin
%isendwin
%newterm
%set-term
%delscreen
;; inopts / Input options.
%cbreak
%nocbreak
%echo
%noecho
%halfdelay
%intrflush
%keypad
%meta
%nodelay
%raw
%noraw
%noqiflush
%qiflush
%notimeout
%timeout
%wtimeout
%typeahead
;; insch / insert a character before cursor in a curses window
%insch
%winsch
%mvinsch
%mvwinsch
;; ins_wch / insert a complex character and rendition into a window
%ins-wch
%wins-wch
%mvins-wch
%mvwins-wch
;; insstr / insert string before cursor in a curses window
%insstr
%insnstr
%winsstr
%winsnstr
%mvinsstr
%mvinsnstr
%mvwinsstr
%mvwinsnstr
;; instr / get a string of characters from a curses window
%instr
%innstr
%winstr
%winnstr
%mvinstr
%mvinnstr
%mvwinstr
%mvwinnstr
;; inwstr / extract a string of wchar_t characters from a curses window
%inwstr
%innwstr
%winwstr
%winnwstr
%mvinwstr
%mvinnwstr
%mvwinwstr
%mvwinnwstr
;; kernel / low-level curses routines
%def-prog-mode
%def-shell-mode
%reset-prog-mode
%reset-shell-mode
%resetty
%savetty
%getsyx
%setsyx
%ripoffline
%curs-set
%napms
;; keybound / return definition of keycode
%keybound
;; key_defined / check if a keycode is defined
%key-defined
;; legacy / get curses cursor and window coordinates, attributes
%getbegx
%getbegy
%getcurx
%getcury
%getmaxx
%getmaxy
%getparx
%getpary
;; legacy_coding
%use-legacy-coding
;; mouse interface through curses
%getmouse
%mousemask
;; move / move curses window cursor
%move
%wmove
;; ncurses / CRT screen handling and optimization package
chtype
wchar_t
wint_t
attr_t
cchar
cchar_t
ptr-cchar_t
cchar-attr
cchar-chars
cchar-colors
mmask_t
mevent
%ERROR
%OK
;; opaque / curses window properties
%is-cleared
%is-idcok
%is-idlok
%is-immedok
%is-keypad
%is-leaveok
%is-nodelay
%is-notimeout
%is-pad
%is-scrollok
%is-subwin
%is-syncok
%wgetparent
%wgetscrreg
;; outopts / curses output options
%clearok
%idlok
%idcok
%immedok
%leaveok
%scrollok
%setscrreg
%wsetscrreg
%nl
%nonl
;; pad / create and display curses pads
%newpad
%subpad
%prefresh
%pnoutrefresh
%pechochar
%pecho-wchar
;; refresh / refresh curses windows and lines
%refresh
%wrefresh
%wnoutrefresh
%doupdate
%redrawwin
%wredrawln
;; resizeterm / change the curses terminal size
%is-term-resized
%resize-term
%resizeterm
;; scroll / scroll a curses window
%scroll
%scrl
%wscrl
;; slk / curses soft label routines
%slk-init
%slk-set
%slk-refresh
%slk-noutrefresh
%slk-label
%slk-clear
%slk-restore
%slk-touch
%slk-attron
%slk-attroff
%slk-attrset
%slk-attr-on
%slk-attr-off
%slk-attr-set
%slk-attr
%slk-color
;; termattrs / environment query routines
%baudrate
%erasechar
%has-ic
%has-il
%killchar
%longname
%term-attrs
%termattrs
%termname
;; touch / curses refresh control routines
%touchwin
%touchline
%untouchwin
%wtouchln
%is-linetouched
%is-wintouched
;; util / miscellaneous curses utility routines
%unctrl
%keyname
%filter
%nofilter
%use-env
%putwin
%getwin
%delay-output
%flushinp
;; variables / curses global variables
%COLOR-PAIRS
%COLORS
%COLS
%ESCDELAY
%LINES
%TABSIZE
;; window / create curses windows
%newwin
%delwin
%mvwin
%subwin
%derwin
%mvderwin
%dupwin
%wsyncup
%syncok
%wcursyncup
%wsyncdown
;; wresize / resize a curses window
%wresize
))

45
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/pad.lisp Normal file
View file

@ -0,0 +1,45 @@
(in-package :de.anvi.ncurses)
;;; pad
;;; create and display curses pads
;;; http://invisible-island.net/ncurses/man/curs_pad.3x.html
;;; http://pic.dhe.ibm.com/infocenter/aix/v7r1/topic/com.ibm.aix.basetechref/doc/basetrf2/newpad.htm
;;; http://www.gnu.org/software/guile-ncurses/manual/html_node/Create-and-display-pads.html
;;; C prototypes
;; WINDOW *newpad(int nlines, int ncols);
;; WINDOW *subpad(WINDOW *orig, int nlines, int ncols, int begin_y, int begin_x);
;; int prefresh(WINDOW *pad, int pminrow, int pmincol, int sminrow, int smincol, int smaxrow, int smaxcol);
;; int pnoutrefresh(WINDOW *pad, int pminrow, int pmincol, int sminrow, int smincol, int smaxrow, int smaxcol);
;; int pechochar(WINDOW *pad, chtype ch);
;; int pecho_wchar(WINDOW *pad, const cchar_t *wch);
;;; Low-level CFFI wrappers
(defcfun ("newpad" %newpad) window (nlines :int) (ncols :int))
(defcfun ("subpad" %subpad) window (orig window) (nlines :int) (ncols :int) (begin_y :int) (begin_x :int))
(defcfun ("prefresh" %prefresh) :int
(pad window)
(pminrow :int)
(pmincol :int)
(sminrow :int)
(smincol :int)
(smaxrow :int)
(smaxcol :int))
(defcfun ("pnoutrefresh" %pnoutrefresh) :int
(pad window)
(pminrow :int)
(pmincol :int)
(sminrow :int)
(smincol :int)
(smaxrow :int)
(smaxcol :int))
(defcfun ("pechochar" %pechochar) :int (pad window) (ch chtype))
(defcfun ("pecho_wchar" %pecho-wchar) :int (pad window) (wch (:pointer (:struct cchar_t))))

23
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/refresh.lisp Normal file
View file

@ -0,0 +1,23 @@
(in-package :de.anvi.ncurses)
;;; refresh
;;; refresh curses windows and lines
;;; http://www.manpagez.com/man/3/curs_refresh/
;;; C prototypes
;; int refresh(void);
;; int wrefresh(WINDOW *win);
;; int wnoutrefresh(WINDOW *win);
;; int doupdate(void);
;; int redrawwin(WINDOW *win);
;; int wredrawln(WINDOW *win, int beg_line, int num_lines);
;;; Low-level CFFI wrappers
(defcfun ("refresh" %refresh) :int)
(defcfun ("wrefresh" %wrefresh) :int (win window))
(defcfun ("wnoutrefresh" %wnoutrefresh) :int (win window))
(defcfun ("doupdate" %doupdate) :int)
(defcfun ("redrawwin" %redrawwin) :int (win window))
(defcfun ("wredrawln" %wredrawln) :int (win window) (beg-line :int) (num-lines :int))

17
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/resizeterm.lisp Normal file
View file

@ -0,0 +1,17 @@
(in-package :de.anvi.ncurses)
;;; resizeterm
;;; change the curses terminal size
;;; http://invisible-island.net/ncurses/man/resizeterm.3x.html
;;; C prototypes
;; bool is_term_resized(int lines, int columns);
;; int resize_term(int lines, int columns);
;; int resizeterm(int lines, int columns);
;;; Low-level CFFI wrappers
(defcfun ("is_term_resized" %is-term-resized) :boolean (lines :int) (columns :int))
(defcfun ("resize_term" %resize-term) :int (lines :int) (columns :int))
(defcfun ("resizeterm" %resizeterm) :int (lines :int) (columns :int))

17
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/scroll.lisp Normal file
View file

@ -0,0 +1,17 @@
(in-package :de.anvi.ncurses)
;;; scroll
;;; scroll a curses window
;;; http://invisible-island.net/ncurses/man/curs_scroll.3x.html
;;; C prototypes
;; int scroll(WINDOW *win);
;; int scrl(int n);
;; int wscrl(WINDOW *win, int n);
;;; Low-level CFFI wrappers
(defcfun ("scroll" %scroll) :int (win window))
(defcfun ("scrl" %scrl) :int (n :int))
(defcfun ("wscrl" %wscrl) :int (win window) (n :int))

47
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/slk.lisp Normal file
View file

@ -0,0 +1,47 @@
(in-package :de.anvi.ncurses)
;;; slk
;;; curses soft label routines
;;; http://invisible-island.net/ncurses/man/curs_slk.3x.html
;;; C prototypes
;; int slk_init(int fmt);
;; int slk_set(int labnum, const char *label, int fmt);
;; int slk_refresh(void);
;; int slk_noutrefresh(void);
;; char *slk_label(int labnum);
;; int slk_clear(void);
;; int slk_restore(void);
;; int slk_touch(void);
;; int slk_attron(const chtype attrs);
;; int slk_attroff(const chtype attrs);
;; int slk_attrset(const chtype attrs);
;; int slk_attr_on(attr_t attrs, void *opts);
;; int slk_attr_off(const attr_t attrs, void *opts);
;; int slk_attr_set(const attr_t attrs, short color_pair, void *opts);
;; attr_t slk_attr(void);
;; int slk_color(short color_pair);
;; int slk_wset(int labnum, const wchar_t *label, int fmt);
;;; Low-level CFFI wrappers
(defcfun ("slk_init" %slk-init) :int (fmt :int))
(defcfun ("slk_set" %slk-set) :int (labnum :int) (label :string) (fmt :int))
(defcfun ("slk_refresh" %slk-refresh) :int)
(defcfun ("slk_noutrefresh" %slk-noutrefresh) :int)
(defcfun ("slk_label" %slk-label) :string (labnum :int))
(defcfun ("slk_clear" %slk-clear) :int)
(defcfun ("slk_restore" %slk-restore) :int)
(defcfun ("slk_touch" %slk-touch) :int)
(defcfun ("slk_attron" %slk-attron) :int (attrs chtype))
(defcfun ("slk_attroff" %slk-attroff) :int (attrs chtype))
(defcfun ("slk_attrset" %slk-attrset) :int (attrs chtype))
(defcfun ("slk_attr_on" %slk-attr-on) :int (attrs attr) (opts (:pointer :void)))
(defcfun ("slk_attr_off" %slk-attr-off) :int (attrs attr) (opts (:pointer :void)))
(defcfun ("slk_attr_set" %slk-attr-set) :int (attrs attr) (color-pair :short) (opts (:pointer :void)))
(defcfun ("slk_attr" %slk-attr) attr)
(defcfun ("slk_color" %slk-color) :int (color-pair :short))

31
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/termattrs.lisp Normal file
View file

@ -0,0 +1,31 @@
(in-package :de.anvi.ncurses)
;;; termattrs
;;; environment query routines
;;; http://invisible-island.net/ncurses/man/curs_termattrs.3x.html
;;; C prototypes
;; int baudrate(void);
;; char erasechar(void);
;; int erasewchar(wchar_t *ch);
;; bool has_ic(void);
;; bool has_il(void);
;; char killchar(void);
;; int killwchar(wchar_t *ch);
;; char *longname(void);
;; attr_t term_attrs(void);
;; chtype termattrs(void);
;; char *termname(void);
;;; Low-level CFFI wrappers
(defcfun ("baudrate" %baudrate) :int)
(defcfun ("erasechar" %erasechar) :char)
(defcfun ("has_ic" %has-ic) :boolean)
(defcfun ("has_il" %has-il) :boolean)
(defcfun ("killchar" %killchar) :char)
(defcfun ("longname" %longname) :string)
(defcfun ("term_attrs" %term-attrs) attr)
(defcfun ("termattrs" %termattrs) chtype)
(defcfun ("termname" %termname) :string)

25
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/touch.lisp Normal file
View file

@ -0,0 +1,25 @@
(in-package :de.anvi.ncurses)
;;; touch
;;; curses refresh control routines
;;; http://invisible-island.net/ncurses/man/curs_touch.3x.html
;;; http://www-01.ibm.com/support/knowledgecenter/ssw_aix_61/com.ibm.aix.basetrf2/touchwin.htm
;;; C prototypes
;; int touchwin(WINDOW *win);
;; int touchline(WINDOW *win, int start, int count);
;; int untouchwin(WINDOW *win);
;; int wtouchln(WINDOW *win, int y, int n, int changed);
;; bool is_linetouched(WINDOW *win, int line);
;; bool is_wintouched(WINDOW *win);
;;; Low-level CFFI wrappers
(defcfun ("touchwin" %touchwin) :int (win window))
(defcfun ("touchline" %touchline) :int (win window) (start :int) (count :int))
(defcfun ("untouchwin" %untouchwin) :int (win window))
(defcfun ("wtouchln" %wtouchln) :int (win window) (y :int) (n :int) (changed :int))
(defcfun ("is_linetouched" %is-linetouched) :boolean (win window) (line :int))
(defcfun ("is_wintouched" %is-wintouched) :boolean (win window))

33
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/util.lisp Normal file
View file

@ -0,0 +1,33 @@
(in-package :de.anvi.ncurses)
;;; util
;;; miscellaneous curses utility routines
;;; http://invisible-island.net/ncurses/man/curs_util.3x.html
;;; C prototypes
;; char *unctrl(chtype c);
;; wchar_t *wunctrl(cchar_t *c);
;; char *keyname(int c);
;; char *key_name(wchar_t w);
;; void filter(void);
;; void nofilter(void);
;; void use_env(bool f);
;; int putwin(WINDOW *win, FILE *filep);
;; WINDOW *getwin(FILE *filep);
;; int delay_output(int ms);
;; int flushinp(void);
;;; Low-level CFFI wrappers
(defcfun ("unctrl" %unctrl) :string (c chtype))
(defcfun ("wunctrl" %wunctrl) :string (c (:pointer (:struct cchar_t))))
(defcfun ("keyname" %keyname) :string (c :int))
(defcfun ("key_name" %key_name) :string (w wchar_t))
(defcfun ("filter" %filter) :void)
(defcfun ("nofilter" %nofilter) :void)
(defcfun ("use_env" %use-env) :void (f :boolean))
(defcfun ("putwin" %putwin) :int (win window) (filep :pointer))
(defcfun ("getwin" %getwin) window (filep :pointer))
(defcfun ("delay_output" %delay-output) :int (ms :int))
(defcfun ("flushinp" %flushinp) :int)

27
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/variables.lisp Normal file
View file

@ -0,0 +1,27 @@
(in-package :de.anvi.ncurses)
;;; variables
;;; curses global variables
;;; http://invisible-island.net/ncurses/man/curs_variables.3x.html
;;; http://h71000.www7.hp.com/doc/83final/5763/5763pro_016.html
;;; Low-level C global variables
;; int COLOR_PAIRS;
;; int COLORS;
;; int COLS;
;; int ESCDELAY;
;; int LINES;
;; int TABSIZE;
;; WINDOW * curscr;
;; WINDOW * newscr;
;; WINDOW * stdscr;
;;; Lisp read-only global constants.
(defcvar ("COLOR_PAIRS" %COLOR-PAIRS :read-only t) :int)
(defcvar ("COLORS" %COLORS :read-only t) :int)
(defcvar ("COLS" %COLS :read-only t) :int)
(defcvar ("ESCDELAY" %ESCDELAY :read-only t) :int)
(defcvar ("LINES" %LINES :read-only t) :int)
(defcvar ("TABSIZE" %TABSIZE :read-only t) :int)

36
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/window.lisp Normal file
View file

@ -0,0 +1,36 @@
(in-package :de.anvi.ncurses)
;;; window
;;; create curses windows
;;; http://invisible-island.net/ncurses/man/curs_window.3x.html
;;; http://www.manpagez.com/man/3/newwin/
;;; C prototypes
;; WINDOW *newwin(int nlines, int ncols, int begin_y, int begin_x);
;; int delwin(WINDOW *win);
;; int mvwin(WINDOW *win, int y, int x);
;; WINDOW *subwin(WINDOW *orig, int nlines, int ncols, int begin_y, int begin_x);
;; WINDOW *derwin(WINDOW *orig, int nlines, int ncols, int begin_y, int begin_x);
;; int mvderwin(WINDOW *win, int par_y, int par_x);
;; WINDOW *dupwin(WINDOW *win);
;; void wsyncup(WINDOW *win);
;; int syncok(WINDOW *win, bool bf);
;; void wcursyncup(WINDOW *win);
;; void wsyncdown(WINDOW *win);
;;; Low-level CFFI wrappers
(defcfun ("newwin" %newwin) window (nlines :int) (ncols :int) (begin_y :int) (begin_x :int))
(defcfun ("delwin" %delwin) :int (win window))
(defcfun ("mvwin" %mvwin) :int (win window) (y :int) (x :int))
(defcfun ("subwin" %subwin) window (orig window) (nlines :int) (ncols :int) (begin_y :int) (begin_x :int))
(defcfun ("derwin" %derwin) window (orig window) (nlines :int) (ncols :int) (begin_y :int) (begin_x :int))
(defcfun ("mvderwin" %mvderwin) :int (win window) (par_y :int) (par_x :int))
(defcfun ("dupwin" %dupwin) window (win window))
(defcfun ("wsyncup" %wsyncup) :void (win window))
(defcfun ("syncok" %syncok) :int (win window) (bf :boolean))
(defcfun ("wcursyncup" %wcursyncup) :void (win window))
(defcfun ("wsyncdown" %wsyncdown) :void (win window))

13
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/ncurses/wresize.lisp Normal file
View file

@ -0,0 +1,13 @@
(in-package :de.anvi.ncurses)
;;; wresize
;;; resize a curses window
;;; http://invisible-island.net/ncurses/man/wresize.3x.html
;;; C prototypes
;; int wresize(WINDOW *win, int lines, int columns);
;;; Low-level CFFI wrappers
(defcfun ("wresize" %wresize) :int (win window) (lines :int) (columns :int))

239
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/add_wch.lisp Normal file
View file

@ -0,0 +1,239 @@
(in-package :de.anvi.croatoan)
(defun add-wide-char-utf-8 (window char &key attributes color-pair y x position n)
"Add the wide (multi-byte) char to the window, then advance the cursor.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the character.
The position can also be passed in form of a two-element list.
If n is given, write n chars. If n is -1, as many chars will be added
as will fit on the line."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let ((count (if n
(if (= n -1)
(distance-to-eol window)
n)
1))
(code-point (typecase char
(integer char)
(character (char-code char)))))
(typecase char
(complex-char
;; if we have a complex char, use its own attributes and colors.
(loop repeat count do
(mapc #'(lambda (ch) (add-char window ch :attributes (attributes char) :color-pair (color-pair char)))
(unicode-to-utf-8 (char-code (simple-char char))))))
;; if we have a lisp char or an integer, use the attributes and colors passed as arguments.
(t
(loop repeat count do
(mapc #'(lambda (ch) (add-char window ch :attributes attributes :color-pair color-pair))
(unicode-to-utf-8 code-point)))))))
;; we can use this for add-wide-char, echo-wide-char, insert-wide-char, set-wide-background-char
(defun funcall-make-cchar_t-ptr (fn winptr char attr_t color-pair-number count)
"Create a cchar_t and apply function fn count times to winptr and cchar_t.
cchar_t is a C struct representing a wide complex-char in ncurses.
This function is a wrapper around %setcchar and should not be used elsewhere."
(with-foreign-objects ((ptr '(:struct cchar_t))
(wch 'wchar_t 5))
(dotimes (i 5) (setf (mem-aref wch 'wchar_t i) 0))
(setf (mem-aref wch 'wchar_t) char)
(%setcchar ptr wch attr_t color-pair-number (null-pointer))
(if (= count 1)
(funcall fn winptr ptr)
(dotimes (i count) (funcall fn winptr ptr)) )))
(defun funcall-make-cchar_t (fn window char attributes color-pair n)
"Assemble a cchar_t out of a char, attributes and a color-pair.
Then apply the fn to window and the assembled cchar_t.
char can be a lisp character, an ACS keyword, an integer code point or
a complex char.
attributes should be a list of valid attribute keywords.
color-pair should be a list of a foreground and background color keyword.
attributes and color-pair can be nil.
If char is a complex char, attributes and color-pair are ignored."
(let ((winptr (winptr window))
(ch
(typecase char
;; if we have a lisp char or an integer, use the attributes and colors passed as arguments.
(integer char)
(character (char-code char))
(keyword (wacs char))
;; if we have a complex char, use its own attributes and colors.
(complex-char (if (simple-char char)
(let ((sch (simple-char char)))
(typecase sch
(integer sch)
(character (char-code sch))
(keyword (wacs sch))
(otherwise (error "unknown character type"))))
;; this means that the default simple char is space, otherwise
;; we can not set complex background chars.
;; TODO: set this here or as initform for complex-char?
32))
(otherwise (error "unknown character type"))))
(attr_t
(typecase char
(complex-char (attrs2chtype (attributes char)))
(otherwise (attrs2chtype attributes))))
;; we just need the pair number here, NOT the bit-shifted color attribute.
;; we need the color attribute for chtypes.
(color-pair-number
(if (or (eq fn #'%wbkgrnd)
(eq fn #'%wbkgrndset))
;; when setting the background, do not complete using the windows color pair and background
;; just complete from the default pair
(pair-to-number (complete-default-pair (typecase char
(complex-char (color-pair char))
(otherwise color-pair))))
;; for every other function, complete from the full sequence
(pair-to-number (complete-pair window (typecase char
(complex-char (color-pair char))
(otherwise color-pair))))))
(count (if n
(if (= n -1)
(distance-to-eol window)
n)
1)))
;; After the parameters are assembled, call the lower-level function that actually
;; uses %setcchar to create a cchar_t pointer and passes it to fn.
(funcall-make-cchar_t-ptr fn winptr ch attr_t color-pair-number count)))
(defun add-wide-char (window char &key attributes fgcolor bgcolor color-pair style y x position n)
"Add the wide (multi-byte) char to the window, then advance the cursor.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the character.
The position can also be passed in form of a two-element list.
If n is given for a char, write n chars. If n is -1, add as many chars
as will fit on the line.
If char is a complex-char, its own style overrides any style parameters.
If a style is passed, it overrides attributes and color-pair."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let ((attributes (if style
(getf style :attributes)
attributes))
(color-pair (cond (style
(list (getf style :fgcolor) (getf style :bgcolor)))
((or fgcolor bgcolor)
(list fgcolor bgcolor))
(t color-pair))))
(funcall-make-cchar_t #'%wadd-wch window char attributes color-pair n)))
(defun echo-wide-char (window char &key attributes fgcolor bgcolor color-pair style y x position)
"Add one wide (multi-byte) character to the window, then refresh the window.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the character.
The position can also be passed in form of a two-element list.
The only difference to add-wide-char and a subsequent refresh is a
performance gain if we know that we only need to output a single
character."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let ((count 1)
;; for some reason, there is a special echo function for pads.
(fn (typecase window
(pad #'%pecho-wchar)
(window #'%wecho-wchar)))
(attributes (if style
(getf style :attributes)
attributes))
(color-pair (cond (style
(list (getf style :fgcolor) (getf style :bgcolor)))
((or fgcolor bgcolor)
(list fgcolor bgcolor))
(t color-pair))))
(funcall-make-cchar_t fn window char attributes color-pair count)))
;; wide-char equivalents of the ACS chars.
;; since reading _nc_wacs doesnt work like it worked with acs_map,
;; plan B is a direct translation from ACS names to unicode code points.
;; source for the codes is ncurses/widechar/lib_wacs.c
(defparameter wide-acs-alist
;; VT100 symbols
'(( :upper-left-corner . #x250C ) ; #\BOX_DRAWINGS_LIGHT_DOWN_AND_RIGHT / 0xE2 0x94 0x8C
( :lower-left-corner . #x2514 ) ; #\BOX_DRAWINGS_LIGHT_UP_AND_RIGHT / 0xE2 0x94 0x94
( :upper-right-corner . #x2510 ) ; #\BOX_DRAWINGS_LIGHT_DOWN_AND_LEFT / 0xE2 0x94 0x90
( :lower-right-corner . #x2518 ) ; #\BOX_DRAWINGS_LIGHT_UP_AND_LEFT / 0xE2 0x94 0x98
( :tee-pointing-left . #x2524 ) ; #\BOX_DRAWINGS_LIGHT_VERTICAL_AND_LEFT / 0xE2 0x94 0xA5
( :tee-pointing-right . #x251C ) ; #\BOX_DRAWINGS_LIGHT_VERTICAL_AND_RIGHT / 0xE2 0x94 0x9C
( :tee-pointing-up . #x2534 ) ; #\BOX_DRAWINGS_LIGHT_UP_AND_HORIZONTAL / 0xE2 0x94 0xB4
( :tee-pointing-down . #x252C ) ; #\BOX_DRAWINGS_LIGHT_DOWN_AND_HORIZONTAL / 0xE2 0x94 0xAC
( :horizontal-line . #x2500 ) ; #\BOX_DRAWINGS_LIGHT_HORIZONTAL / 0xE2 0x94 0x80
( :vertical-line . #x2502 ) ; #\BOX_DRAWINGS_LIGHT_VERTICAL / 0xE2 0x94 0x82
( :crossover-plus . #x253C ) ; #\BOX_DRAWINGS_LIGHT_VERTICAL_AND_HORIZONTAL / 0xE2 0x94 0xBC
( :scan-line-1 . #x23BA ) ; #\HORIZONTAL_SCAN_LINE-1 / 0xE2 0x8E 0xBA
( :scan-line-9 . #x23BD ) ; #\HORIZONTAL_SCAN_LINE-9 / 0xE2 0x8E 0xBD
( :diamond-symbol . #x25C6 ) ; #\BLACK_DIAMOND / 0xE2 0x97 0x86
( :checker-board . #x2592 ) ; #\MEDIUM_SHADE / 0xE2 0x96 0x92
( :degree-symbol . #x00B0 ) ; #\DEGREE_SIGN / 0xC2 0xB0
( :plus-minus . #x00B1 ) ; #\PLUS-MINUS_SIGN / 0xC2 0xB1
( :bullet-symbol . #x00B7 ) ; #\MIDDLE_DOT / 0xC2 0xB7
;; Teletype 5410v1 symbols
( :arrow-pointing-left . #x2190 ) ; #\LEFTWARDS_ARROW / 0xE2 0x86 0x90
( :arrow-pointing-right . #x2192 ) ; #\RIGHTWARDS_ARROW / 0xE2 0x86 0x92
( :arrow-pointing-down . #x2193 ) ; #\DOWNWARDS_ARROW / 0xE2 0x86 0x93
( :arrow-pointing-up . #x2191 ) ; #\UPWARDS_ARROW / 0xE2 0x86 0x91
( :board . #x2592 ) ; #\MEDIUM_SHADE / 0xE2 0x96 0x92
( :lantern-symbol . #x2603 ) ; #\SNOWMAN / 0xE2 0x98 0x83
( :solid-square-block . #x25AE ) ; #\BLACK_VERTICAL_RECTANGLE / 0xE2 0x96 0xAE
;; ncurses characters
( :scan-line-3 . #x23BB ) ; #\HORIZONTAL_SCAN_LINE-3 / 0xE2 0x8E 0xBB
( :scan-line-7 . #x23BC ) ; #\HORIZONTAL_SCAN_LINE-7 / 0xE2 0x8E 0xBC
( :less-than-or-equal . #x2264 ) ; #\LESS-THAN_OR_EQUAL_TO / 0xE2 0x89 0xA4
( :greater-than-or-equal . #x2265 ) ; #\GREATER-THAN_OR_EQUAL_TO / 0xE2 0x89 0xA5
( :pi . #x03C0 ) ; #\GREEK_SMALL_LETTER_PI / 0xCF 0x80
( :not-equal . #x2260 ) ; #\NOT_EQUAL_TO / 0xE2 0x89 0xA0
( :uk-pound-sterling . #x00A3 ) ; #\POUND_SIGN / 0xC2 0xA3
;; thick line drawing characters
( :thick-upper-left-corner . #x250F ) ; #\BOX_DRAWINGS_HEAVY_DOWN_AND_RIGHT / 0xE2 0x94 0x8F
( :thick-lower-left-corner . #x2517 ) ; #\BOX_DRAWINGS_HEAVY_UP_AND_RIGHT / 0xE2 0x94 0x97
( :thick-upper-right-corner . #x2513 ) ; #\BOX_DRAWINGS_HEAVY_DOWN_AND_LEFT / 0xE2 0x94 0x93
( :thick-lower-right-corner . #x251B ) ; #\BOX_DRAWINGS_HEAVY_UP_AND_LEFT / 0xE2 0x94 0x9B
( :thick-tee-pointing-left . #x2523 ) ; #\BOX_DRAWINGS_HEAVY_VERTICAL_AND_LEFT / 0xE2 0x94 0xA3
( :thick-tee-pointing-right . #x252B ) ; #\BOX_DRAWINGS_HEAVY_VERTICAL_AND_RIGHT / 0xE2 0x94 0xAB
( :thick-tee-pointing-up . #x253B ) ; #\BOX_DRAWINGS_HEAVY_UP_AND_HORIZONTAL / 0xE2 0x94 0xBB
( :thick-tee-pointing-down . #x2533 ) ; #\BOX_DRAWINGS_HEAVY_DOWN_AND_HORIZONTAL / 0xE2 0x94 0xB3
( :thick-horizontal-line . #x2501 ) ; #\BOX_DRAWINGS_HEAVY_HORIZONTAL / 0xE2 0x94 0x81
( :thick-vertical-line . #x2503 ) ; #\BOX_DRAWINGS_HEAVY_VERTICAL / 0xE2 0x94 0x83
( :thick-crossover-plus . #x254B ) ; #\BOX_DRAWINGS_HEAVY_VERTICAL_AND_HORIZONTAL / 0xE2 0x95 0x8B
;; double-line drawing characters
( :double-upper-left-corner . #x2554 ) ; #\BOX_DRAWINGS_DOUBLE_DOWN_AND_RIGHT / 0xE2 0x95 0x94
( :double-lower-left-corner . #x255A ) ; #\BOX_DRAWINGS_DOUBLE_UP_AND_RIGHT / 0xE2 0x95 0x9A
( :double-upper-right-corner . #x2557 ) ; #\BOX_DRAWINGS_DOUBLE_DOWN_AND_LEFT / 0xE2 0x95 0x97
( :double-lower-right-corner . #x255D ) ; #\BOX_DRAWINGS_DOUBLE_UP_AND_LEFT / 0xE2 0x95 0x9D
( :double-tee-pointing-left . #x2563 ) ; #\BOX_DRAWINGS_DOUBLE_VERTICAL_AND_LEFT / 0xE2 0x95 0xA3
( :double-tee-pointing-right . #x2560 ) ; #\BOX_DRAWINGS_DOUBLE_VERTICAL_AND_RIGHT / 0xE2 0x95 0xA0
( :double-tee-pointing-up . #x2569 ) ; #\BOX_DRAWINGS_DOUBLE_UP_AND_HORIZONTAL / 0xE2 0x95 0xA9
( :double-tee-pointing-down . #x2566 ) ; #\BOX_DRAWINGS_DOUBLE_DOWN_AND_HORIZONTAL / 0xE2 0x95 0xA6
( :double-horizontal-line . #x2550 ) ; #\BOX_DRAWINGS_DOUBLE_HORIZONTAL / 0xE2 0x95 0x90
( :double-vertical-line . #x2551 ) ; #\BOX_DRAWINGS_DOUBLE_VERTICAL / 0xE2 0x95 0x91
( :double-crossover-plus . #x256C ))) ; #\BOX_DRAWINGS_DOUBLE_VERTICAL_AND_HORIZONTAL / 0xE2 0x95 0xAC
(defun wacs (char-name)
"Take a keyword symbol, return the wide unicode integer representing the ACS char."
(cdr (assoc char-name wide-acs-alist)))

230
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/addch.lisp Normal file
View file

@ -0,0 +1,230 @@
(in-package :de.anvi.croatoan)
;; (add scr #\a :y 10 :x 10)
;; (add scr "b" :y 11 :x 10)
;; (add scr #\a :y 10 :x 10 :attributes '(:underline) :color-pair '(:yellow :red))
;; (add scr "bat" :y 11 :x 10 :attributes '(:underline :bold) :color-pair '(:black :green))
;; (add scr #\a :position (list 10 10))
(defun add (window object &rest keys &key &allow-other-keys)
"Add the text object to the window, then advance the cursor.
Currently supported text objects are characters (simple and complex),
characters given by integer codes or keywords, and strings
(simple and complex).
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the object.
The position can also be passed in form of a two-element list.
If n is given for a char, write n chars. If n is -1, add as many chars
as will fit on the line.
If n is given for a string, add at most n chars from the string.
If n is -1, add as many chars from the string as will fit on the line."
(let ((fn (typecase object
((or string complex-string)
#'add-string)
((or integer keyword character complex-char)
#'add-wide-char))))
(apply fn window object keys)))
(defun distance-to-eol (window)
"Return the number of columns from the cursor position to the end of the line in the window."
(- (width window) (cadr (cursor-position window))))
(defun distance-to-bottom (window)
"Return the number of lines from the cursor position to the bottom of the window."
(- (height window) (car (cursor-position window))))
(defun add-char (window char &key attributes fgcolor bgcolor color-pair style y x position n)
"Add the narrow (single-byte) char to the window, then advance the cursor.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the character.
The position can also be passed in form of a two-element list.
If n is given for a char, write n chars. If n is -1, add as many chars
as will fit on the line.
Example: (add-char scr #\a :attributes '(:bold) :color-pair '(:red :yellow))"
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let ((attributes (if style
(getf style :attributes)
attributes))
(color-pair (cond (style
(list (getf style :fgcolor) (getf style :bgcolor)))
((or fgcolor bgcolor)
(list fgcolor bgcolor))
(t color-pair))))
(funcall-make-chtype #'%waddch window char attributes color-pair n)))
;; At the moment, echo is just a wrapper for echo-wide-char.
(defun echo (window char &rest keys &key &allow-other-keys)
"Add one character to the window, then advance the cursor.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the character.
The position can also be passed in form of a two-element list.
If n is given for a char, write n chars. If n is -1, add as many chars
as will fit on the line.
If char is a complex-char, its own style overrides any style parameters.
If a style is passed, it overrides attributes and color-pair."
(apply #'echo-wide-char window char keys))
(defun echo-char (window char &key attributes fgcolor bgcolor color-pair style y x position)
"Add one narrow (single-byte) character to the window, then refresh the window.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then echo the character.
The position can also be passed in form of a two-element list.
The only difference to add-char and a subsequent refresh is a
performance gain if we know that we only need to output a single
character."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let ((count 1)
(fn (typecase window
;; a pad is a subclass of window, therefore we have to check pad first.
(pad #'%pechochar)
(window #'%wechochar)))
(attributes (if style
(getf style :attributes)
attributes))
(color-pair (cond (style
(list (getf style :fgcolor) (getf style :bgcolor)))
((or fgcolor bgcolor)
(list fgcolor bgcolor))
(t color-pair))))
(funcall-make-chtype fn window char attributes color-pair count)))
;; just an utility function if you dont want to use (format nil "bla
;; bla ~%") to insert newlines. in C you can simply insert \n.
(defun new-line (window &optional (count 1))
"Insert count newline characters into window."
(loop repeat count do (add-char window (char-code #\newline))))
;; pointer to the global/external c acs array, acs_map[].
;; also see defcvar + get-var-pointer
(defparameter acs-map-array (foreign-symbol-pointer "acs_map"))
;; ncurses maps those standard chars at runtime to the acs characters.
;; here we use it in the function acs.
(defparameter acs-alist
;; VT100 symbols
'(( :upper-left-corner . #\l )
( :lower-left-corner . #\m )
( :upper-right-corner . #\k )
( :lower-right-corner . #\j )
( :tee-pointing-left . #\u )
( :tee-pointing-right . #\t )
( :tee-pointing-up . #\v )
( :tee-pointing-down . #\w )
( :horizontal-line . #\q )
( :vertical-line . #\x )
( :crossover-plus . #\n )
( :scan-line-1 . #\o )
( :scan-line-9 . #\s )
( :diamond-symbol . #\` )
( :checker-board . #\a )
( :degree-symbol . #\f )
( :plus-minus . #\g )
( :bullet-symbol . #\~ )
;; Teletype 5410v1 symbols
( :arrow-pointing-left . #\, )
( :arrow-pointing-right . #\+ )
( :arrow-pointing-down . #\. )
( :arrow-pointing-up . #\- )
( :board . #\h )
( :lantern-symbol . #\i )
( :solid-square-block . #\0 )
;; ncurses characters
( :scan-line-3 . #\p )
( :scan-line-7 . #\r )
( :less-than-or-equal . #\y )
( :greater-than-or-equal . #\z )
( :pi . #\{ )
( :not-equal . #\| )
( :uk-pound-sterling . #\} )
;; thick line drawing characters
( :thick-upper-left-corner . #\L )
( :thick-lower-left-corner . #\M )
( :thick-upper-right-corner . #\K )
( :thick-lower-right-corner . #\J )
( :thick-tee-pointing-left . #\U )
( :thick-tee-pointing-right . #\T )
( :thick-tee-pointing-up . #\V )
( :thick-tee-pointing-down . #\W )
( :thick-horizontal-line . #\Q )
( :thick-vertical-line . #\X )
( :thick-crossover-plus . #\N )
;; double-line drawing characters
( :double-upper-left-corner . #\C )
( :double-lower-left-corner . #\D )
( :double-upper-right-corner . #\B )
( :double-lower-right-corner . #\A )
( :double-tee-pointing-left . #\G )
( :double-tee-pointing-right . #\F )
( :double-tee-pointing-up . #\H )
( :double-tee-pointing-down . #\I )
( :double-horizontal-line . #\R )
( :double-vertical-line . #\Y )
( :double-crossover-plus . #\E )))
#|
For 64bit builds of ncurses 6.0, chtype is an unsigned int:
#if 1 && defined(_LP64)
typedef unsigned chtype;
typedef unsigned mmask_t;
#else
typedef uint32_t chtype;
typedef uint32_t mmask_t;
#endif
For 64bit builds of ncurses 5.9, chtype is an unsigned long:
#if 0 && defined(_LP64)
typedef unsigned chtype;
typedef unsigned mmask_t;
#else
typedef unsigned long chtype;
typedef unsigned long mmask_t;
#endif
acs_map[] is an chtype array:
#if 0 || NCURSES_REENTRANT
NCURSES_WRAPPED_VAR(chtype*, acs_map);
#define acs_map NCURSES_PUBLIC_VAR(acs_map())
#else
extern NCURSES_EXPORT_VAR(chtype) acs_map[];
#endif
|#
;; ACS, the alternative/extended character set for line drawing.
;; Used by functions: add-char, box and border.
;;
;; * http://www.melvilletheatre.com/articles/ncurses-extended-characters/index.html
;; * http://tldp.org/HOWTO/NCURSES-Programming-HOWTO/misc.html
;;
;; Example: (acs 'ULCORNER)
(defun acs (char-name)
"Take a symbol, return the integer representing the acs char."
(mem-aref acs-map-array 'chtype (char-code (cdr (assoc char-name acs-alist)))))

42
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/addstr.lisp Normal file
View file

@ -0,0 +1,42 @@
(in-package :de.anvi.croatoan)
(defun add-string (window string &key attributes fgcolor bgcolor color-pair style y x position n)
"Add the unrendered string to the window.
If n is given, add at most n chars from the string. If n is -1, as
many chars will be added that will fit on the line.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the object.
The position can also be passed in form of a two-element list."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let ((count (if n
(if (= n -1)
(- (width window) (cadr (cursor-position window)))
n)
;; we cant use length to determine the length of a complex string
;; because it is not a sequence.
(typecase string
(string (length string))
(complex-string (length (complex-char-array string)))))))
(typecase string
(string
;;(if (or attributes fgcolor bgcolor color-pair style)
;; lisp string combined with attributes and colors
(loop
repeat count
for ch across string
do (add-wide-char window ch :attributes attributes :fgcolor fgcolor :bgcolor bgcolor
:color-pair color-pair :style style)) )
;; simple lisp string, no attributes or colors
;; TODO 190826 we dont want to use this because we want to force color-set and bkgd to use separate colors
;;(if n
;; (%waddnstr (winptr window) string n)
;; (%waddstr (winptr window) string))))
(complex-string
(loop
repeat count
for ch across (complex-char-array string)
do (add-wide-char window ch))))))

501
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/attr.lisp Normal file
View file

@ -0,0 +1,501 @@
(in-package :de.anvi.croatoan)
(defparameter *ansi-color-list*
'(:black :red :green :yellow :blue :magenta :cyan :white))
;; this list should be in color.lisp, not here.
;; but attr.lisp is loaded before color.lisp.
(defparameter *xterm-color-name-list*
'(:black :maroon :green :olive :navy :purple :teal :silver
:gray :red :lime :yellow :blue :magenta :cyan :white))
(defparameter *default-color-pair* nil)
;; do not use the color alist but the two color lists, for 8 and 256 colors
;; in the 256 colors mode, only the first 16 colors are named.
;; the terminal default colors are only available when
;; the screen is initialized with :use-terminal-colors t
;; the :terminal color number is -1.
(defun color-name-to-number (color-name)
"Take a keyword denoting a color name, return the color number."
(let* ((name (cond ((eq color-name :default-fg)
(car *default-color-pair*))
((eq color-name :default-bg)
(cadr *default-color-pair*))
(t color-name)))
;; generate an alist of colors in the form ((:terminal . -1) (:black . 0) ...)
;; depending on whether we use 8 or 256 colors, we have different names for the same color numbers.
(alist (if (<= %colors 8)
(loop
for i from -1 to 7
for j in (cons :terminal *ansi-color-list*)
collect (cons j i))
(loop
for i from -1 to 15
for j in (cons :terminal *xterm-color-name-list*)
collect (cons j i))))
(number (cdr (assoc name alist))))
(if number
number
(error "color-name-to-number: color name ~A does not exist." name))))
;; address a color by:
;; integer: color number 0-255, so we can cycle through all available colors
;; keyword: it doesnt exist for all 256 colors
;; string: "#ff00ff" hex triplet in web-notation. string-length = 7, first char = #
;; a color can also be given as a list, where the first element is a keyword
;; denoting the coding scheme.
;; (:number 255)
;; (:name :black)
;; (:hex #xff00ff)
;; TODO: (:hex "#ff00ff")
;; TODO: (:rgb 255 00 255)
;; TODO: (:hsv 10 15 245)
;; TODO: naming conflict with color->number
;; after we can convert everything to a color number, add this function to
;; pair-to-number, so we can generate a color pair out of every color notation.
(defun color-to-number (color)
"Takes a color in various notations, converts that notation to the exact or most appropriate color number."
(typecase color
;; hex rgb code
;; we cant use hex codes when in 8-color ansi mode, because the 8 ansi colors
;; are only defined by names, not by rgb color contents.
(integer (hex-to-sgr color))
;; color name, for now ONLY the first 8 ansi colors and 16 web colors
;; TODO: expand to all x11 color names
(keyword (color-name-to-number color))
;; a list in the form of (:type value).
(list
(let ((type (car color))
(val (cadr color)))
(case type
;; direct input of the color number, just return it.
(:number val)
;; keyword denoting the color name
(:name (color-name-to-number color))
(:hex
(typecase val
;; hex rgb notation, for example (:hex #x00ff00)
(integer (hex-to-sgr color)))))))))
;; keys are 2 element lists of the form: (:fgcolor :bgcolor)
;; fgcolor and bgcolor are keyword symbols
;; vals are integers that represent ncurses color pairs.
;; only one color pair, 0, is predefined: (:default :default),
;; which is identical to (:white :black) if use-terminal-colors is nil.
;; if use-terminal-colors is t, it is whatever color pair the terminal
;; used before the ncurses init.
;; TODO: this also could be a hashmap
;; TODO: move this to be a screen variable, so it gets reset on every screen init
;; for now it is reset to nil on evey screen init by set-default-color-pair
(defparameter *color-pair-alist* nil)
(defun use-terminal-colors-p (screen)
(slot-value screen 'use-terminal-colors-p))
(defun (setf use-terminal-colors-p) (flag screen)
(setf (slot-value screen 'use-terminal-colors-p) flag)
(if flag
(progn
(%use-default-colors)
(setf (default-color-pair screen) (list :terminal :terminal)))
(setf (default-color-pair screen) (list :white :black))))
(defun default-color-pair (screen)
(declare (ignore screen))
*default-color-pair*)
(defun (setf default-color-pair) (color-pair screen)
"Set the colors which will comprise the default color pair 0.
The default color pair is used when no other colors are specified.
The ncurses default color pair is white on black.
If the terminal can set its own colors, they are named :terminal."
(setf *default-color-pair* color-pair)
(%assume-default-colors (color-name-to-number (car color-pair))
(color-name-to-number (cadr color-pair))))
;; called from initialize-instance :after ((scr screen)
;; test with t09a
(defun set-default-color-pair (use-terminal-colors-p)
;; reset the color pair alist on every screen init
(setf *color-pair-alist* nil)
(if use-terminal-colors-p
(progn
(%use-default-colors)
(setf *default-color-pair* (list :terminal :terminal)))
(setf *default-color-pair* (list :white :black)))
;; we cant make :white :black be pair 0, because pair 0 is ignored on several occasions
;; Example: when color-pair of a window is set to pair 1
;; adding a char with 0 is ignored and the char is added with pair 1.
;; we have to add white on black as a number bigger than 0.
(setf *color-pair-alist* (acons '(:default-fg :default-bg) 0 *color-pair-alist*)))
(defun pair-to-number (pair)
"Take a two-element list of colors, return the ncurses pair number.
The colors can be keywords or numbers -1:255.
-1 is the :terminal default color when use-terminal-colors-p is t.
If it is a new color pair, add it to ncurses, then return the new pair number.
If the pair already exists, return its pair number.
If pair is nil, return the default color number, 0.
Example:
(pair-to-number '(:white :black)) => 0"
(if pair
(let ((result (assoc pair *color-pair-alist* :test #'equal)))
(if result
;; if the entry already exists, just return the pair number.
(cdr result)
;; if the pair doesnt exist, create a new pair number
(let ((new-pair-number (list-length *color-pair-alist*)))
;; add it to the alist first.
(setf *color-pair-alist* (acons pair new-pair-number *color-pair-alist*))
;; then add it to ncurses.
(let ((fg (car pair))
(bg (cadr pair)))
(%init-pair new-pair-number (color-to-number fg) (color-to-number bg)))
;; return the newly added pair number.
new-pair-number)))
;; If pair is nil, return the default color number, 0.
0))
;; TODO: cross check with the ncurses primitives that we get the same result.
;; TODO: number-to-pair
(defun number-to-pair (number)
"Take a pair number, return a color pair in a 2 element list of keywords."
(car (rassoc number *color-pair-alist*)))
;; We cant run complete-pair here, because we dont have the window.
;; we have to run complete-pair within add-char, add-wide-char, etc.
(defun complete-default-pair (color-pair)
"Take a color pair possibly containing nil, return a pair completed from the default color pair 0."
(let ((fg (car color-pair))
(bg (cadr color-pair))
(default-pair (number-to-pair 0)))
(cond
;; when both colors are given, just return the original pair
((and color-pair fg bg) color-pair)
;; when the pair is nil or when both colors are missing
((or (null color-pair)
(and (null fg) (null bg)))
;; just return the default pair
default-pair)
;; when only the bg is missing, complete the bg
((null bg)
(list fg (cadr default-pair)))
;; when only the fg is missing, complete the fg
((null fg)
(list (car default-pair) bg)))))
(defun complete-pair (window pair)
"If either the foreground or background color is nil, complete the pair for the given window.
Return the completed pair.
Try to complete the missing colors in the following order:
1. window color pair.
2. window background character color pair.
3. ncurses default color pair 0 (white on black or the terminal default color pair)."
(let ((fg (car pair))
(bg (cadr pair)))
(cond
;; when both colors are given, just return the original pair
((and pair fg bg) pair)
;; when the pair is nil or when both colors are missing
((or (null pair)
(and (null fg) (null bg)))
(cond
((color-pair window)
;; if color pair exists, but is not complete, complete it recursively in a second step.
;; if we have fg from color pair, and a bg from background, they will be combined.
(complete-pair window (color-pair window)))
((and (background window)
(color-pair (background window)))
(complete-pair window (color-pair (background window))))
(t (number-to-pair 0))))
;; when only the bg is missing, complete the bg
((null bg)
(cond
((cadr (color-pair window))
(list fg (cadr (color-pair window))))
((and (background window)
(cadr (color-pair (background window))))
(list fg (cadr (color-pair (background window)))))
(t
(list fg (cadr (number-to-pair 0))))))
;; when only the fg is missing, complete the fg
((null fg)
(cond
((car (color-pair window))
(list (car (color-pair window)) bg))
((and (background window)
(car (color-pair (background window))))
(list (car (color-pair (background window))) bg))
(t
(list (car (number-to-pair 0)) bg)))) )))
;; TODO: use %wattr_on instead of %wattron, also for get and set
(defun add-attributes (win attributes)
"Takes a list of keywords and turns the appropriate attributes on."
(dolist (i attributes)
(setf (attributes win) (adjoin i (attributes win)))
(%wattron (winptr win) (get-bitmask i))))
(defun remove-attributes (win attributes)
"Takes a list of keywords and turns the appropriate attributes off."
(dolist (i attributes)
(setf (attributes win) (remove i (attributes win)))
(%wattroff (winptr win) (get-bitmask i))))
;; (set-attributes scr '(:bold :underline))
;; set-attributes overwrites color settings because it treats color as an attribute.
;; thats why we wont use it directly.
(defun set-attributes (winptr attributes)
"Takes a list of keywords and sets the appropriate attributes.
Overwrites any previous attribute settings including the color."
(%wattrset winptr
(apply #'logior (loop for i in attributes collect (get-bitmask i)))))
;; (%wchgat (winptr win) 9 #x00040000 0 (null-pointer))
(defun change-attributes (win n attributes &key color-pair y x position)
"Change the attributes of n chars starting at the current cursor position.
If n is -1, as many chars will be added as will fit on the line.
If the destination coordinates y and x are given, the attributes are changed
from the given point without moving the cursor position."
(when (and y x) (move win y x))
(when position (apply #'move win position))
(let ((attrs (attrs2chtype attributes))
(pair-number (pair-to-number (complete-pair win color-pair))))
(%wchgat (winptr win) n attrs pair-number (null-pointer))))
(defun set-color-pair (winptr color-pair)
"Sets the color attribute of the window only."
(%wcolor-set winptr
(pair-to-number (complete-default-pair color-pair))
(null-pointer)))
(defparameter *bitmask-alist*
;; the first four are not attributes, but bitmasks used to extract parts of the chtype.
'((:normal . #x00000000)
(:attributes . #xffffff00)
(:chartext . #x000000ff)
(:color . #x0000ff00)
;; we have 16 attributes that can be set.
;; In general, only underline, bold and reverse are widely supported by terminals.
(:standout . #x00010000)
(:underline . #x00020000)
(:reverse . #x00040000)
(:blink . #x00080000)
(:dim . #x00100000)
(:bold . #x00200000)
(:altcharset . #x00400000)
(:invis . #x00800000)
(:protect . #x01000000)
(:horizontal . #x02000000)
(:left . #x04000000)
(:low . #x08000000)
(:right . #x10000000)
(:top . #x20000000)
(:vertical . #x40000000)
(:italic . #x80000000)))
;; TODO: signal an error if passed an invalid attribute.
(defun get-bitmask (attribute)
"Returns an ncurses attr/chtype representing the attribute keyword."
(cdr (assoc attribute *bitmask-alist*)))
(defparameter *valid-attributes*
'(:standout
:underline
:reverse
:blink
:dim
:bold
:altcharset
:invis
:protect
:horizontal
:left
:low
:right
:top
:vertical
:italic))
(defun chtype2attrs (ch)
"Take a chtype, return a list of used attribute keywords."
(loop
for i in *valid-attributes*
if (logtest ch (get-bitmask i)) collect i))
;; used in: make-chtype, change-attributes
(defun attrs2chtype (attrs)
"Take a list of attribute keywords, return a chtype with the attribute bits set."
(if attrs
;; the attribute bitmasks already are bit-shifted to the correct position in the chtype
;; we just need to OR them all together
(apply #'logior (mapcar #'get-bitmask attrs))
;; if the attribute list is nil, logior returns 0.
;; but to emphasize intent, we explicitely return 0 if the attribute list is nil.
0))
(defun colors2chtype (color-pair)
"Take a list of a color pair, return a chtype with the color attribute set."
(if color-pair
;; convert the pair to an integer, then bit shift it by 8
;; right shift by 8 to get the color bits at their proper place in a chtype.
;; you cannot simply logior the pair number because that would overwrite the char.
(ash (pair-to-number color-pair) 8)
0))
;; usage: c2x, extract wide char, everywhere where number-to-pair is used.
;; first get the color attribute bits by log-AND-ing them with the ch.
;; then right shift them by 8 to extract the color pair short int from them.
;; then get the color pair (:white :black) associated with that number.
(defun chtype2colors (ch)
"Take a chtype or attr_t integer, return a list of two keywords denoting a color pair."
(number-to-pair (ash (logand ch (get-bitmask :color)) -8)))
(defun char2chtype (char)
"Take a character in different forms, return a chtype containing that character."
(if char
(typecase char
;; if the char is already an integer from char-code.
(integer char)
;; alternative chars are given as keywords
;; we use acs only when we produce chtypes, for cchar_t, we need wacs.
(keyword (acs char))
;; if it is a lisp char, convert it to an integer first
(character (char-code char))
;; if char is any other type, we dont handle it for now.
(otherwise (error "char2chtype: char is not integer, keyword or character.")))
0))
;;; ------------------------------------------------------------------
(defun make-chtype (char attributes color-pair)
"Assemble a chtype out of a char, attributes and a color-pair.
char can be a lisp character, an ACS keyword, or an integer code point.
attributes should be a list of valid attribute keywords.
color-pair should be a list of a foreground and background color keyword.
attributes and color-pair can be nil.
If char is a complex char, and the attributes and color-pair are passed,
they override the attributes and the color-of the complex char."
(typecase char
;; x2c itself calls make-chtype
(complex-char (xchar2chtype char))
;; we first convert all three parameters to separate integers,
;; then OR them together to create the chtype.
(otherwise (logior (char2chtype char)
(attrs2chtype attributes)
(colors2chtype color-pair)))))
;; factor out count calculation and complete-pair
(defun funcall-make-chtype (fn window char attributes color-pair n)
"Assemble a chtype out of a char, attributes and a color-pair.
Apply low-level ncurses function fn count times to window and chtype.
chtype is a 32-bit integer representing a non-wide complex-char in ncurses.
char can be a lisp character, an ACS keyword, an integer code point or
a complex char.
attributes should be a list of valid attribute keywords.
color-pair should be a list of a foreground and background color keyword.
attributes and color-pair can be nil.
If char is a complex char, attributes and color-pair are ignored."
(let ((winptr (winptr window))
(count (if n
(if (= n -1)
(distance-to-eol window)
n)
1))
(chtype (make-chtype char attributes (complete-pair window color-pair))))
(case count
(0 nil)
(1 (funcall fn winptr chtype))
(otherwise (dotimes (i count)
(funcall fn winptr chtype))))))
;; Example: (xchar2chtype (chtype2xchar 2490466)) => 2490466
(defun xchar2chtype (ch)
"Convert a croatoan complex char to an integral ncurses chtype."
(make-chtype (simple-char ch)
(attributes ch)
(color-pair ch)))
(defun chtype2xchar (ch)
"Converts a ncurses chtype to croatoan complex-char."
(make-instance 'complex-char
:simple-char (code-char (logand ch (get-bitmask :chartext)))
:attributes (loop for i in *valid-attributes*
if (logtest ch (get-bitmask i)) collect i)
;; first get the color attribute bits by log-AND-ing them with ch.
;; then right shift them by 8 to extract the color int from them.
;; then get the color pair (:white :black) associated with that number.
:color-pair (number-to-pair (ash (logand ch (get-bitmask :color)) -8))))
(defgeneric convert-char (char result-type)
(:documentation "Take a char and convert it to a char of result-type."))
;; The lisp class representing chtype is complex-char.
(defmethod convert-char ((char complex-char) result-type)
(case result-type
(:simple-char (simple-char char))
(:chtype (xchar2chtype char))))
;; Lisps character object is here called "simple-char".
(defmethod convert-char ((char character) result-type)
(case result-type
(:complex-char (make-instance 'complex-char :simple-char char :attributes nil))
(:chtype (char-code char))))
;; chtype is a ncurses unsigned long, an integer.
(defmethod convert-char ((char integer) result-type)
(case result-type
(:simple-char (code-char (logand char (get-bitmask :chartext))))
(:complex-char (chtype2xchar char))))
;;; TODOs
;; todo: convert-char -> convert
;; [ ] add type asserts.
;; what is an attr_t? get all ncurses types definitions.
;; make it clear which routines use xchars and which use chtypes.
;; make all user visible apis use xchars and only internally convert to chtypes.
;; functions to manipulate attributes and colors of xchars.
;; the char part of an xchar should not be changeable.

11
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/beep.lisp Normal file
View file

@ -0,0 +1,11 @@
(in-package :de.anvi.croatoan)
(defun alert (&optional (type :beep))
(case type
(:beep (%beep))
(:flash (%flash))
(otherwise (error "Available alert types: :beep :flash"))))
;;; TODOs
;; [ ] Return values, errors.

32
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/bkgd.lisp Normal file
View file

@ -0,0 +1,32 @@
(in-package :de.anvi.croatoan)
;; bkgd applies to every cell in the window.
;; bkgdset applies only to new chars inserted after the call to bkgdset.
;; i.e. with bkgd we manipulate the existing text, with bkgdset the new text.
;; the attribute part of the background char is combined with any chars added.
;; because of that, we cant use alternate chars as background chars, since
;; :altcharset is an attribute.
(defun set-background-char (winptr xchar &optional (apply t))
"Set a complex single-byte character as the background of a window.
The attribute part of the background character is combined with
simple characters in the window.
If apply is t, the background setting is immediately applied to all cells
in the window.
Otherwise, it is applied only to newly added simple characters."
(let ((chtype (xchar2chtype xchar)))
(if apply
;; the background char is applied to every cell in the window by default.
(%wbkgd winptr chtype)
;; if apply is nil, the background is combined only with new characters.
(%wbkgdset winptr chtype))))
(defun get-background-char (window)
"Return the complex char that is the background character of the window."
(let* ((winptr (winptr window))
(chtype (%getbkgd winptr)))
(chtype2xchar chtype)))

51
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/bkgrnd.lisp Normal file
View file

@ -0,0 +1,51 @@
(in-package :de.anvi.croatoan)
;; bkgrnd applies to every char in the window.
;; bkgrndset applies only to new chars inserted after the call to bkgdset.
;; i.e. with bkgrnd we manipulate the existing text, with bkgrndset the new text.
;; the attribute part of the background char is combined with any chars added.
;; because of that, we cant use alternate chars as background chars, since
;; :altcharset is an attribute.
(defun set-background-cchar_t (window char &optional (apply t))
"Set a wide complex character as the background of a window.
The attribute part of the background character is combined with
simple characters added to the window.
If apply is t, the background setting is immediately applied to all cells
in the window.
Otherwise, it is applied only to newly added simple characters."
(let ((fn (if apply #'%wbkgrnd #'%wbkgrndset))
(count 1))
(if char
(funcall-make-cchar_t fn window char nil nil count)
;; setting char to nil means to unset the background
;; unset the background means set space as char and the default color pair 0
(funcall-make-cchar_t fn window #\space nil (number-to-pair 0) count))))
;; used in: get-background-cchar_t, extract-wide-char
(defun funcall-get-cchar_t (fn window)
"Call function fn to read a cchar_t from window and return it as a wide complex char."
(with-foreign-object (ptr '(:struct cchar_t))
;; read a struct cchar_t into the space allocated with ptr
(funcall fn (winptr window) ptr)
;; the slot cchar-chars is a a pointer to the wchar_t array.
(let* ((char (mem-aref (foreign-slot-pointer ptr '(:struct cchar_t) 'cchar-chars) 'wchar_t 0))
;; ABI6
(col (foreign-slot-value ptr '(:struct cchar_t) 'cchar-colors))
(attr (foreign-slot-value ptr '(:struct cchar_t) 'cchar-attr)))
(make-instance 'complex-char
:simple-char (code-char char)
:attributes (chtype2attrs attr)
;; ABI6
;;:color-pair (number->pair col)
;; ABI5
;; the color pair is not placed into the cchar_t slot, but ORed into the attribute int.
:color-pair (chtype2colors attr)))))
(defun get-background-cchar_t (window)
"Return the wide complex char that is the background character of the window."
(funcall-get-cchar_t #'%wgetbkgrnd window))

23
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/border.lisp Normal file
View file

@ -0,0 +1,23 @@
(in-package :de.anvi.croatoan)
;; (box win hline vline) = (draw-border win vline vline hline hline nil nil nil nil)
(defun box (window &optional (hline-char 0) (vline-char 0))
"Draw a border around the window.
If any parameter is nil or zero, the default ACS char will be used."
(let ((winptr (winptr window)))
(%box winptr hline-char vline-char)))
(defun draw-border (window &key left right top bottom ;; lines
top-left top-right bottom-left bottom-right) ;; corners
"Draw a border around the window using single-byte line-drawing characters.
If no border chars are given, the default ncurses ACS chars will be used."
(let ((winptr (winptr window)))
(apply #'%wborder
winptr
;; if the argument is not nil, convert it to chtype first, the pass it to wborder.
;; if the argument is nil, pass 0 to wborder, then the default ACS char will be used.
(mapcar #'(lambda (i) (if i (make-chtype i nil nil) 0))
(list left right top bottom ;; lines
top-left top-right bottom-left bottom-right))))) ;; corners

39
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/border_set.lisp Normal file
View file

@ -0,0 +1,39 @@
(in-package :de.anvi.croatoan)
(defun draw-wide-border (window &key left right top bottom
top-left top-right bottom-left bottom-right)
"Draw a border around the window using (wide) unicode line-drawing characters.
If no border chars are given, the default ncurses WACS chars will be used."
(with-foreign-objects ((ls '(:struct cchar_t))
(rs '(:struct cchar_t))
(ts '(:struct cchar_t))
(bs '(:struct cchar_t))
(tl '(:struct cchar_t))
(tr '(:struct cchar_t))
(bl '(:struct cchar_t))
(br '(:struct cchar_t))
(wch 'wchar_t 5))
(apply #'%wborder-set
(winptr window)
;; take a list of (wide) character codes and empty cchar_t pointers, return a list of cchar_t pointers or null pointers.
(mapcar #'(lambda (char ptr)
(if char
;; if nil, then null-pointer, then the default wacs will be used
;; if not nil, pointer to cchar_t
(progn
;; blank the wch array in the struct
(dotimes (ii 5) (setf (mem-aref wch 'wchar_t ii) 0))
;; copy the char code to the wch array
(setf (mem-aref wch 'wchar_t) char)
;; assemble the cchar_t using %setcchar
(%setcchar ptr wch 0 0 (null-pointer))
;; return the pointer to the cchar_t
ptr)
;; if the char is not passed, return a null-pointer.
(null-pointer)))
;; list of passed character codes
(list left right top bottom top-left top-right bottom-left bottom-right)
;; list of pointers to allocated cchar_t structs
(list ls rs ts bs tl tr bl br)))))

1564
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/classes.lisp Normal file
View file

File diff suppressed because it is too large Load diff

27
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/clear.lisp Normal file
View file

@ -0,0 +1,27 @@
(in-package :de.anvi.croatoan)
;; (clear scr :redraw t)
;; (clear scr :target :whole-screen :redraw t)
;; (clear scr :target :end-of-line)
;; (clear scr :target :bottom)
(defgeneric clear (object &key))
(defmethod clear ((window window) &key redraw (target :whole-window))
"Clear the window by overwriting it with blanks.
If the keyword redraw is t, first copy blanks to every position in the
window, then set the clear-redraw-flag to have the window redrawn from
scratch on the next refresh.
If target is :end-of-line, clear the window from the cursor to the end
of the current line.
If target is :bottom, clear the window from the cursor to the end of
the current line and all lines below."
(let ((winptr (winptr window)))
(case target
(:whole-window (if redraw (%wclear winptr) (%werase winptr)))
(:end-of-line (%wclrtoeol winptr))
(:bottom (%wclrtobot winptr)))))

160
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/color.lisp Normal file
View file

@ -0,0 +1,160 @@
(in-package :de.anvi.croatoan)
;; 1000 -> 255 (ff)
(defun color-1k-to-8bit (integer)
"Convert the ncurses color intensity 0-1000 to the 8bit range 0-255."
(values (round (* integer 0.255))))
;; 255 (ff) -> 1000
(defun color-8bit-to-1k (integer)
"Convert the 8bit range 0-255 to the ncurses color intensity 0-1000."
(values (round (* integer (/ 1 0.255)))))
;; https://www.w3schools.com/colors/colors_rgb.asp
;; 255 255 255 -> ffffff
;; the hex triplet is a 6 digit, 3 byte (24 bit) hexadecimal number
;; 255 192 203 :pink
(defun rgb-to-hex (rgb-list)
"Take a list of three 8bit (0-255) RGB values, return a 24bit integer (RGB hex triplet)."
(let ((r (nth 0 rgb-list))
(g (nth 1 rgb-list))
(b (nth 2 rgb-list)))
(logior (ash r 16)
(ash g 8)
(ash b 0))))
;; test: (format t "~x" (rgb-to-hex (list 255 255 0)))
;; (hex-to-rgb #xffffff) => (255 255 255)
(defun hex-to-rgb (hex)
"Take a 24bit integer (RGB hex triplet), return a list of three 8bit (0-255) RGB values."
(let ((r (ldb (byte 8 16) hex))
(g (ldb (byte 8 8) hex))
(b (ldb (byte 8 0) hex)))
(list r g b)))
;;(defun hex-to-string (hex)
;; (format nil "~6,'0x" hex))
;; SGR = select graphc rendition, vt100 attribute sequences
;; xterm sources:
;; https://github.com/joejulian/xterm/blob/master/256colres.pl
;; https://github.com/joejulian/xterm/blob/master/256colres.h
;; https://gist.github.com/clairvy/566623#file-256colors2-pl
;; scale rgb values from 0-255 down to 0-5, corresponding to colors in the xterm 6x6x6 RGB cube.
(defun rgb-to-rgb6 (rgb-list)
"Take a list of three RGB integers 0-255, return a list of three RGB integers 0-5."
(mapcar (lambda (x)
(if (< x 55)
0
(floor (/ (- x 55) 40))))
rgb-list))
;; scale rgb values from 0-5 to 0-255, from the xterm 6x6x6 RGB color cube to 3x8bit=24bit.
(defun rgb6-to-rgb (rgb6-list)
"Take a list of three RGB integers 0-5, return a list of three RGB integers 0-255 of the xterm color palette."
(mapcar (lambda (x) (if (> x 0)
(+ 55 (* 40 x))
0))
rgb6-list))
(defun rgb6-to-sgr (rgb6-list)
"Take a list of three RGB integers 0-5, return an 8bit SGR color code 16-231."
(let ((r (nth 0 rgb6-list))
(g (nth 1 rgb6-list))
(b (nth 2 rgb6-list)))
(+ (* r 36)
(* g 6)
(* b 1)
16)))
;; only returns values from the color cube, not from the grayscale ramp 232-255.
(defun sgr-to-rgb6 (sgr)
"Take a 8bit SGR color code 16-231, return a list of three RGB integers 0-5."
(let* ((rgb (- sgr 16))
(r (floor rgb 36))
(r-rem (- rgb (* 36 r)))
(g (floor r-rem 6))
(b (- r-rem (* 6 g))))
(list r g b)))
;; the rgb values of the first 8 ansi colors arent defined, they only have names.
;; the first 16 colors of the 256-color palette have names ("web colors") and rgb values.
;; https://en.wikipedia.org/wiki/Web_colors
;; TODO: this list is also defined in attr.lisp, but it should only be here
;;(defparameter *xterm-color-name-list*
;; '(:black :maroon :green :olive :navy :purple :teal :silver
;; :gray :red :lime :yellow :blue :magenta :cyan :white))
(defparameter *xterm-color-hex-list*
'(#x000000 ;black
#x800000 ;web maroon
#x008000 ;web green
#x808000 ;olive
#x000080 ;navy blue
#x800080 ;web purple
#x008080 ;teal
#xc0c0c0 ;silver
#x808080 ;web gray
#xff0000 ;red
#x00ff00 ;lime, x11: green
#xffff00 ;yellow
#x0000ff ;blue
#xff00ff ;magenta, x11: fuchsia
#x00ffff ;cyan, x11: aqua
#xffffff)) ;white
(defun gray-to-rgb (sgr)
"Take a sgr gray color number 232-255, return a list of three RGB integers 0-255."
(let ((val (+ 8 (* 10 (- sgr 232)))))
(list val val val)))
(defun closest-gray (rgb)
"Take an integer 0-255 denoting a gray color intensity, return the closest gray from the xterm palette."
(let* ((allowed-gray-values (loop for i from 0 to 23 collect (+ 8 (* 10 i))))
(delta-list (mapcar (lambda (x) (abs (- rgb x))) allowed-gray-values))
(delta-min (apply #'min delta-list))
(pos (position delta-min delta-list)))
(+ 232 pos)))
;;(nth pos allowed-gray-values)))
;; otherwise return the closest short-rgb color.
;; TODO: we do not want the approximated and the exact color returned by the same function.
;; we need to check whether the hex is in the palette and return that
;; and if it is NOT in the palette, then either init a new color or return the closest color
;; from the palette.
(defun hex-to-sgr (hex)
"Takes a RGB hex triplet, returns the exact or most appropriate SGR color code 0-255."
(let ((rgb-list (hex-to-rgb hex)))
;; TODO: check whether we use 8 or 256 colors, limit the hex codes to the first 8 if necessary.
(cond
;; is the hex value one of the 16 basic ansi colors?
((member hex *xterm-color-hex-list*)
(position hex *xterm-color-hex-list*))
;; if all three rgb values are equal, return the closest shade of gray.
;; TODO: what if they are almost equal, for example (243 242 244)?
((apply #'= rgb-list)
(closest-gray (car rgb-list)))
;; if they arent equal, return the closest value from the 6x6x6 rgb cube.
(t (rgb6-to-sgr (rgb-to-rgb6 rgb-list))))))
;; handles all three xterm-256color color spaces
;; we need this to list the rgb values of all 256 xterm colors to compare them to the x11 color list.
;; TODO: use this to make a list containing all 256 SGR hex codes.
(defun sgr-to-hex (sgr)
"Take a SGR color code 0-255, return a 24bit hex triplet."
(cond
;; 8 ansi colors (8 normal and 8 bright or bold) 0-15
;; just return the hex integer from the list
((< sgr 16)
;;(cdr (assoc sgr *ansi-color-sgr-hex-alist*)))
(nth sgr *xterm-color-hex-list*))
;; 216 colors from a 6x6x6 RGB color cube, 16-231
((< sgr 232)
(rgb-to-hex (rgb6-to-rgb (sgr-to-rgb6 sgr))))
;; 24 gray colors without black and white, which are contained in both 1. and 2.
((< sgr 256)
(rgb-to-hex (gray-to-rgb sgr)))))

297
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/croatoan.lisp Normal file
View file

@ -0,0 +1,297 @@
(in-package :de.anvi.croatoan)
;;; Define all macros here centrally.
(defmacro with-screen ((screen &key
(bind-debugger-hook t)
(input-buffering nil)
(process-control-chars t)
(enable-newline-translation t)
(input-blocking t)
(input-echoing t)
(enable-function-keys t)
(enable-scrolling nil)
(insert-mode nil)
(enable-colors t)
(use-terminal-colors nil)
(cursor-visible t)
(stacked nil)
(fgcolor nil)
(bgcolor nil)
(color-pair nil)
(background nil))
&body body)
"Create a screen, evaluate the forms in the body, then cleanly close the screen.
Pass any arguments besides BIND-DEBUGGER-HOOK to the initialisation of the
screen object. The screen is cleared immediately after initialisation.
This macro will bind *DEBUGGER-HOOK* so that END-SCREEN gets called before the
condition is printed. This will interfere with SWANK as it also binds *DEBUGGER-HOOK*.
To prevent WITH-SCREEN from binding *DEBUGGER-HOOK*, set BIND-DEBUGGER-HOOK to NIL.
This macro is the main entry point for writing ncurses programs with the croatoan
library. Do not run more than one screen at the same time."
`(unwind-protect
(let ((,screen (make-instance 'screen
:input-buffering ,input-buffering
:process-control-chars ,process-control-chars
:enable-newline-translation ,enable-newline-translation
:input-blocking ,input-blocking
:input-echoing ,input-echoing
:enable-function-keys ,enable-function-keys
:enable-scrolling ,enable-scrolling
:insert-mode ,insert-mode
:enable-colors ,enable-colors
:use-terminal-colors ,use-terminal-colors
:cursor-visible ,cursor-visible
:stacked ,stacked
:fgcolor ,fgcolor
:bgcolor ,bgcolor
:color-pair ,color-pair
:background ,background))
;; when an error is signaled and not handled, cleanly end ncurses, print the condition text
;; into the repl and get out of the debugger into the repl.
;; the debugger is annoying with ncurses apps.
;; add (abort) to automatically get out of the debugger.
;; this binding is added by default. call with-screen with :bind-debugger-hook nil to remove.
,@(if bind-debugger-hook
'((*debugger-hook* #'(lambda (c h)
(declare (ignore h))
(end-screen)
(print c))))
nil))
;; clear the display when starting up.
(clear ,screen)
,@body)
;; cleanly exit ncurses whatever happens.
(end-screen)))
(defmacro with-window ((win &rest options) &body body)
"Create a window, evaluate the forms in the body, then cleanly close the window.
Pass any arguments to the initialisation of the window object.
Example:
(with-window (win :input-echoing t
body)"
`(let ((,win (make-instance 'window ,@options)))
(unwind-protect
(progn
,@body)
(close ,win))))
;; see similar macro cffi:with-foreign-objects.
(defmacro with-windows (bindings &body body)
"Create one or more windows, evaluate the forms in the body, then cleanly close the windows.
Pass any arguments to the initialisation of the window objects.
Example:
(with-windows ((win1 :input-echoing t)
(win2 :input-echoing t))
body)"
(if bindings
;; execute the bindings recursively
`(with-window ,(car bindings)
;; the cdr is the body
(with-windows ,(cdr bindings)
,@body))
;; finally, execute the body.
`(progn
,@body)))
(defmacro event-case ((window event &optional mouse-y mouse-x) &body body)
"Window event loop, events are handled by an implicit case form.
For now, it is limited to events generated in a single window. So events
from multiple windows have to be handled separately.
In order for event handling to work, input-buffering has to be nil.
Several control character events can only be handled when
process-control-chars is also nil.
If input-blocking is nil, we can handle the (nil) event, i.e. what
happens between key presses.
If input-blocking is t, the (nil) event is never returned.
The main window event loop name is hard coded to event-case to be
used with return-from.
Instead of ((nil) nil), which eats 100% CPU, use input-blocking t."
(if (and mouse-y mouse-x)
`(loop :named event-case do
(multiple-value-bind (,event ,mouse-y ,mouse-x)
;; depending on which version of ncurses is loaded, decide which event reader to use.
#+(or sb-unicode unicode openmcl-unicode-strings) (get-wide-event ,window)
#-(or sb-unicode unicode openmcl-unicode-strings) (get-event ,window)
;;(print (list ,event mouse-y mouse-x) ,window)
(when (null ,event)
;; process the contents of the job queue (ncurses access from other threads)
(process))
(case ,event
,@body)))
`(loop :named event-case do
;; depending on which version of ncurses is loaded, decide which event reader to use.
(let ((,event #+(or sb-unicode unicode openmcl-unicode-strings) (get-wide-event ,window)
#-(or sb-unicode unicode openmcl-unicode-strings) (get-event ,window)))
(when (null ,event)
;; process the contents of the job queue (ncurses access from other threads)
(process))
(case ,event
,@body)))))
(defun bind (object event handler)
"Bind the handler function to the event in the bindings alist of the object.
The handlers will be called by the run-event-loop when keyboard or mouse events occur.
The handler functions have two mandatory arguments, window and event.
For every event-loop, at least an event to exit the event loop should be assigned,
by associating it with the predefined function exit-event-loop.
If a handler for the default event t is defined, it will handle all events for which
no specific event handler has been defined.
If input-blocking of the window is set to nil, a handler for the nil event
can be defined, which will be called at a specified frame-rate between keypresses.
Here the main application state can be updated.
Alternatively, to achieve the same effect, input-blocking can be set to a specific
delay in miliseconds.
Example use: (bind scr #\q (lambda (win event) (throw 'event-loop :quit)))"
(setf (bindings object)
(acons event handler (bindings object))))
(defun unbind (object event)
"Remove the event and the handler function from object's bindings alist."
(setf (slot-value object 'bindings)
(remove event (slot-value object 'bindings) :key #'car)))
(defparameter *keymaps* nil "An alist of available keymaps.")
(defun define-keymap (name plist)
"Register a keymap given by a name and a plist of keys and functions."
(let ((keymap (make-instance 'keymap :bindings-plist plist)))
(setf *keymaps* (acons name keymap *keymaps*))))
(defun find-keymap (keymap-name)
"Return a keymap given by its name from the global keymap alist."
(cdr (assoc keymap-name *keymaps*)))
;; source: alexandria
(defun plist2alist (plist)
"Take a plist in the form (k1 v1 k2 v2 ...), return an alist ((k1 . v1) (k2 . v2) ...)"
(let (alist)
(do ((lst plist (cddr lst)))
((endp lst) (nreverse alist))
(push (cons (car lst) (cadr lst)) alist))))
(defun get-event-handler (object event)
"Take an object and an event, return the object's handler for that event.
The key bindings alist is stored in the bindings slot of the object.
If no handler is defined for the event, the default event handler t is tried.
If not even a default handler is defined, the event is ignored.
If input-blocking is nil, we receive nil events in case no real events occur.
In that case, the handler for the nil event is returned, if defined.
The event pairs are added by the bind function as conses: (event . #'handler).
An event should be bound to the pre-defined function exit-event-loop."
(flet ((ev (event)
(let ((keymap (typecase (keymap object)
(keymap (keymap object))
(symbol (find-keymap (keymap object))))))
;; object-local bindings override the external keymap
;; an event is checked in the bindings first, then in the external keymap.
(if (bindings object)
(if (assoc event (bindings object))
(assoc event (bindings object))
(if (and keymap (bindings keymap))
(assoc event (bindings keymap))
nil))
;; if there are no local bindings, check the external keymap
(if (and keymap (bindings keymap))
(assoc event (bindings keymap))
nil)))))
(cond
;; Event occured and event handler is defined.
((and event (ev event)) (cdr (ev event)))
;; Event occured and a default event handler is defined.
;; If not even the default handler is defined, the event is ignored.
((and event (ev t)) (cdr (ev t)))
;; If no event occured and the idle handler is defined.
;; The event is only nil when input input-blocking is nil.
((and (null event) (ev nil)) (cdr (ev nil)))
;; If no event occured and the idle handler is not defined.
(t nil))))
(defun run-event-loop (object &rest args)
"Read events from the window, then call predefined event handler functions on the events.
The handlers can be added by the bind function, or by directly setting a predefined keymap
to the window's bindings slot.
Args is one or more additional arguments passed to the handlers.
Provide a non-local exit point so we can exit the loop from an event handler.
One of the events must provide a way to exit the event loop by throwing 'event-loop.
The function exit-event-loop is pre-defined to perform this non-local exit."
(catch object
(loop
(let* ((window (typecase object
(form-window (sub-window object))
;; if the object is a window
(window object)
;; if the object isnt a window, it should have an associated window.
(otherwise (window object))))
(event (get-wide-event window)))
(handle-event object event args)
;; process the contents of the job queue (ncurses access from other threads)
(process)
;; should a frame rate be a property of the window or of the object?
(when (and (null event) (frame-rate window))
(sleep (/ 1.0 (frame-rate window)))) ))))
(defgeneric handle-event (object event args)
;; the default method applies to window, field, button, menu.
(:method (object event args)
"Default method for all objects without a specialized method."
(let ((handler (get-event-handler object event)))
(when handler
;; if args is nil, apply will call the handler with just object and event
;; this means that if we dont need args, we can define most handlers as two-argument functions.
(apply handler object event args)))))
(defmethod handle-event ((form form) event args)
"If a form can't handle an event, let the current form element try to handle it."
(let ((handler (get-event-handler form event)))
(if handler
(apply handler form event args)
(handle-event (current-element form) event args))))
(defun exit-event-loop (object event &rest args)
"Associate this function with an event to exit the event loop."
(declare (ignore win event args))
(throw object :exit-event-loop))
(defmacro save-excursion (window &body body)
"After executing body, return the cursor in window to its initial position."
(let ((pos (gensym)))
`(let ((,pos (cursor-position ,window)))
,@body
(move ,window (car ,pos) (cadr ,pos)))))

30
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/default_colors.lisp Normal file
View file

@ -0,0 +1,30 @@
(in-package :croatoan)
;; default_colors
;; use terminal's default colors
;; http://invisible-island.net/ncurses/man/default_colors.3x.html
;;; C prototypes
;; int use_default_colors(void);
;; int assume_default_colors(int fg, int bg);
;;; Low-level C functions
(defcfun ("use_default_colors" %use-default-colors) :int)
(defcfun ("assume_default_colors" %assume-default-colors) :int (fg :int) (bg :int))
;;; High-level Lisp wrappers
(defun use-default-colors (flag)
"Assign the terminal default colors to the color number -1."
(when flag
(%use-default-colors)))
(defun assume-default-colors (fg bg)
"Modify the default color pair 0 to use the color numbers fg and bg.
Ncurses otherwise will use white on black."
(%assume-default-colors fg bg))
;;; NOTICE

24
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/define_key.lisp Normal file
View file

@ -0,0 +1,24 @@
(in-package :croatoan)
;; define_key
;; define a keycode
;; http://invisible-island.net/ncurses/man/define_key.3x.html
;;; C prototypes
;; int define_key(const char *definition, int keycode);
;;; Low-level C functions
(defcfun ("define_key" %define-key) :int (definition :string) (keycode :int))
;;; High-level Lisp wrappers
(defun define-key (definition code)
"Define a new keycode with its definition string.
If the string is empty, or the code zero or negative, the existing
definition is removed."
(%define-key definition code))
;;; TODOs

14
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/delch.lisp Normal file
View file

@ -0,0 +1,14 @@
(in-package :de.anvi.croatoan)
(defun delete-char (window &key y x)
"Delete the character under the cursor.
All characters to the right of the cursor on the same line are moved
to the left one position and the last character on the line is filled
with a blank. The cursor position does not change after moving
to (y,x), if specified."
(let ((winptr (winptr window)))
(cond ((and y x)
(%mvwdelch winptr y x))
(t
(%wdelch winptr)))))

18
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/deleteln.lisp Normal file
View file

@ -0,0 +1,18 @@
(in-package :de.anvi.croatoan)
(defun delete-line (window &key (n 1))
"Delete n lines starting with the one under the cursor.
The remaining lines are moved up. The bottom n lines are cleared.
The current cursor position does not change."
(%winsdelln (winptr window) (- n)))
(defun insert-line (window &key (n 1))
"Insert n lines above the current line.
The current line and the lines below are moved down. The n bottom
lines are lost.
The current cursor position does not change."
(%winsdelln (winptr window) n))

19
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/extend.lisp Normal file
View file

@ -0,0 +1,19 @@
(in-package :croatoan)
;;; extend
;;; miscellaneous curses extensions
;;; http://invisible-island.net/ncurses/man/curs_extend.3x.html
;;; C prototypes
;; const char * curses_version(void);
;; int use_extended_names(bool enable);
;;; Low-level C functions
(defcfun ("curses_version" %curses-version) :string)
(defcfun ("use_extended_names" %use-extended-names) :int (enable :boolean))
;;; High-level Lisp wrappers
;;; NOTES

484
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/form.lisp Normal file
View file

@ -0,0 +1,484 @@
(in-package :de.anvi.croatoan)
;; form
;; curses extension for programming forms
;; https://invisible-island.net/ncurses/man/form.3x.html
(defun remove-nth (n list)
"Remove element at nth place from the list, decreasing the length of the list.
Example: (remove-nth 3 '(a b c d e)) => (A B C E)"
(declare
(type (integer 0) n)
(type list list))
(assert (>= n 0))
(assert (> (length list) n))
(if (or (zerop n) (null list))
(cdr list)
(cons (car list) (remove-nth (1- n) (cdr list)))))
(defun insert-nth (n element list)
"Insert element into list at nth place, increasing the length of the list.
Example: (insert-nth 3 'x '(a b c d e)) => (A B C X D E)"
(declare
(type (integer 0) n)
(type list list))
(assert (>= n 0))
(assert (>= (length list) n))
(if (or (zerop n) (null list))
(cons element list)
(cons (car list) (insert-nth (1- n) element (cdr list)))))
(defun replace-nth (n element list)
"Replaces element of list at nth place, not increasing the length of the list.
Example: (replace-nth 3 'x '(a b c d e)) => (A B C X E)"
(declare
(type (integer 0) n)
(type list list))
(assert (>= n 0))
(assert (>= (length list) n))
(if (or (zerop n) (null list))
(cons element (cdr list))
(cons (car list) (replace-nth (1- n) element (cdr list)))))
(defun find-element (form element-name &key (test #'eql) (key #'name))
"Return from the given form the element given by its name.
The name should be a keyword, symbol or integer, the default test is eql.
If the name is a string, equal should be used as the test.
Instead of the name, another key can be provided to identify the element."
(find element-name (elements form) :test test :key key))
;; this is the only place we set the background style for the field
;; TODO: how to access the default fg and bg of a form,
;; if the field is not part of a form? by having a form slot in the field.
(defmethod clear ((field field) &key)
"Clear the field by overwriting it with the background char.
The default background char is #\space."
(with-accessors ((pos location) (width width) (selected selectedp) (win window) (style style)) field
(let* ((bg-style (if selected (getf style :selected-background) (getf style :background)))
(bg-char (if (getf bg-style :simple-char) (getf bg-style :simple-char) #\space)))
(setf (cursor-position win) pos)
(add win bg-char :style bg-style :n width)
(setf (cursor-position win) pos))))
(defgeneric update-cursor-position (object)
(:documentation "Update the cursor position of the element of a form.")
(:method (object)
"The default method puts the cursor at the start position of the element."
(setf (cursor-position (window object)) (location object))
(refresh (window object))))
;; when the form element is an embedded selection menu or checklist
;; will not work for menu-windows, which arent yet embedded in forms.
;; we need a separate update-cursor-position for menu-window.
;; used in menu.lisp/(draw menu)
(defmethod update-cursor-position ((object menu))
"Update the cursor position of a menu after it is drawn.
Place the cursor, when it is visible, on the first char of the current item."
(setf (cursor-position (window object)) (current-item-location object))
(refresh (window object)))
(defmethod update-cursor-position ((object checklist))
"Update the cursor position of a checklist after it is drawn.
Place the cursor between the brackets [_] of the current item."
(with-accessors ((pos current-item-location) (win window)) object
(move win
(car pos)
(1+ (cadr pos))) ;; put the cursor after the [
(refresh win)))
(defmethod update-cursor-position ((checkbox checkbox))
"Update the cursor position of a checkbox."
(with-accessors ((pos location) (win window)) checkbox
(move win
(car pos)
(1+ (cadr pos))) ;; put the cursor after the [
(refresh win) ))
(defmethod update-cursor-position ((field field))
"Update the cursor position of a field."
(with-accessors ((pos location) (inptr input-pointer) (dptr display-pointer) (win window)) field
(move win
;; TODO: assumes a single-line field.
(car pos)
(+ (cadr pos) ; beginning of the field
(- inptr dptr) )) ; position in the field starting with dptr
(refresh win)))
(defmethod update-cursor-position ((form form))
"Move the cursor to the correct position in current element of the form."
(update-cursor-position (current-element form)))
(defgeneric draw (object)
(:documentation "Draw objects (form, field, menu) to their associated window."))
(defmethod draw ((label label))
(with-accessors ((pos location) (win window) (name name) (title title) (width width) (style style) (reference reference)
(parent-form parent-form)) label
;; pick the string to write in the following order
;; title of the label
;; title of the referenced element
;; name of the referenced element
;; name of the label
(let* ((text (or title
(title (find-element parent-form reference))
(name (find-element parent-form reference))
name))
(string (when text (format nil "~A" text)))
(fg-style (getf style :foreground))
(bg-style (getf style :background))
(bg-char (if (getf bg-style :simple-char) (getf bg-style :simple-char) #\space)))
(when string
;; first draw the background, but only if width > string
(when width
(apply #'move win pos)
(add win bg-char :style bg-style :n width))
;; then the label over the background
(apply #'move win pos)
(add-string win string :style fg-style)))))
(defmethod draw ((button button))
(with-accessors ((pos location) (name name) (title title) (win window) (selected selectedp) (style style)) button
(apply #'move win pos)
(let* ((fg-style (if selected (getf style :selected-foreground) (getf style :foreground))))
(add-string win (format nil "<~A>" (if title title name)) :style fg-style))))
(defmethod draw ((checkbox checkbox))
(with-accessors ((pos location) (name name) (win window) (selected selectedp) (style style)
(checkedp checkedp)) checkbox
(apply #'move win pos)
(let* ((fg-style (if selected (getf style :selected-foreground) (getf style :foreground))))
(add-string win (format nil "[~A]" (if checkedp "X" "_")) :style fg-style)
(update-cursor-position checkbox))))
(defmethod draw ((field field))
"Clear and redraw the field and its contents and background."
(with-accessors ((pos location) (width width) (inbuf buffer) (inptr input-pointer) (dptr display-pointer)
(selected selectedp) (win window) (title title) (style style)) field
(let* ((fg-style (if selected (getf style :selected-foreground) (getf style :foreground)))
(len (length inbuf))
(val (value field))
(str (if (< len width)
;; if the buffer is shorter than the field, just display it.
val
;; otherwise display a substring starting with dptr.
;; display only max width chars starting from dptr
(subseq val dptr (if (< width (- len dptr))
;; if the remaining substring is longer than width, display just width chars.
(+ dptr width)
;; if the remaining substring is shorter than width, just display it.
len) ))))
(clear field)
(apply #'move win pos)
(add-string win str :style fg-style)
(update-cursor-position field))))
(defmethod draw ((form form))
"Draw the form by drawing the elements, then moving the cursor to the current element."
(with-accessors ((elements elements) (window window)) form
(loop for element in elements do
(draw element))
;; after drawing the elements, reposition the cursor to the current element
(update-cursor-position form)))
(defmethod draw ((form form-window))
"Draw the form by drawing the elements, then moving the cursor to the current element."
;; update cursor position only refreshes the window associated with the form, which is the sub-window
;; in order to see the border, we have to touch and refresh the parent border window.
;; refreshing the parent window has to be done before refreshing the cursor position in the sub
;; or the cursor will be moved to 0,0 of the parent window.
(touch form)
(refresh form)
;; draw the form contents, the superclass of form-window is form (and decorated-window).
(call-next-method))
;; previous-element and next-element are the only two elements where the current-element-number is changed.
;; here also current-element and selected has to be set.
(defun select-previous-element (form event &rest args)
"Select the previous element in a form's element list."
;;(declare (special form))
(with-accessors ((elements elements) (current-element-number current-element-number) (current-element current-element) (win window)) form
(setf (selectedp current-element) nil)
;; use mod to cycle the element list.
(setf current-element-number (mod (- current-element-number 1) (length elements)))
(setf current-element (nth current-element-number elements))
;; ignore inactive elements like labels.
(if (activep current-element)
(progn
(setf (selectedp current-element) t)
;; after we switched the element number, we also have to redraw the form.
(draw form))
(select-previous-element form event))))
(defun select-next-element (form event &rest args)
"Select the next element in a form's element list."
;;(declare (special form))
(with-accessors ((elements elements) (current-element-number current-element-number) (current-element current-element) (win window)) form
(setf (selectedp current-element) nil)
;; use mod to cycle the element list.
(setf current-element-number (mod (+ current-element-number 1) (length elements)))
(setf current-element (nth current-element-number elements))
;; ignore inactive elements like labels.
(if (activep current-element)
(progn
(setf (selectedp current-element) t)
;; after we switched the element number, we also have to redraw the form.
(draw form))
(select-next-element form event))))
(defun move-previous-char (field event &rest args)
"Move the cursor to the previous char in the field."
(with-accessors ((inptr input-pointer) (dptr display-pointer) (win window)) field
(when (> inptr 0)
(decf inptr))
;; when the inptr moves left past the dptr, simultaneously decf the dptr.
(when (< inptr dptr)
(decf dptr))
(draw field)))
(defun move-next-char (field event &rest args)
"Move the cursor to the next char in the field."
(with-accessors ((width width) (inbuf buffer) (inptr input-pointer) (dptr display-pointer) (mlen max-buffer-length)
(win window)) field
(when (and (< inptr (length inbuf))
(not (= (1+ inptr) mlen width)))
(incf inptr))
;; when the inptr moves right past the width, simultaneously incf the dptr.
(when (and (>= inptr (+ dptr width))
(not (= inptr mlen width)))
(incf dptr))
(draw field)))
(defun delete-previous-char (field event &rest args)
"Delete the previous char in the field, moving the cursor to the left."
(with-accessors ((inbuf buffer) (inptr input-pointer) (dptr display-pointer) (win window)) field
(when (> inptr 0)
(decf inptr)
(when (> dptr 0)
(decf dptr))
(setf inbuf (remove-nth (- (length inbuf) 1 inptr) inbuf)))
;; we dont have to redraw the complete form, just the changed field.
(draw field)))
(defun delete-next-char (field event &rest args)
"Delete the next char (char under the cursor) in the field, not moving the cursor."
(with-accessors ((inbuf buffer) (inptr input-pointer) (dptr display-pointer) (win window)) field
;; we can only delete to the right if the inptr is not at the end of the inbuf.
(when (> (length inbuf) inptr)
(when (> dptr 0)
;; when a part of the string is hidden on the left side, shift it to the right.
(decf dptr))
(setf inbuf (remove-nth (- (length inbuf) (1+ inptr)) inbuf)))
(draw field)))
(defun field-add-char (field char &rest args)
"Add char to the current cursor position in the field.
The buffer can be longer than the displayed field width, horizontal scrolling is enabled."
(if (and (characterp char) (graphic-char-p char))
(progn
(with-accessors ((width width) (inbuf buffer) (mlen max-buffer-length) (inptr input-pointer)
(dptr display-pointer) (win window)) field
(let ((len (length inbuf)))
(if (insert-mode-p win)
;; insert mode
(progn
;; only add new chars until we've reached the max-buffer-length
(unless (>= len mlen)
;; if we're at the end of the inbuf
(if (= inptr len)
;; just add another char to the inbuf
(setf inbuf (cons char inbuf))
;; if we're in the middle of the buffer, either insert or replace
(setf inbuf (insert-nth (- len inptr) char inbuf)) )
;; we need special cases when mlen is exactly equal to width.
(if (= mlen width)
;; advance the cursor if it is not already at the end
;; if scrolling is disabled, do not move past the last char in the field.
(unless (>= inptr (- mlen 1))
(incf inptr))
(unless (> inptr (- mlen 1))
(incf inptr))))
;; after updating the fill-pointer, update the display-pointer
(if (< inptr dptr) (decf dptr))
(if (> inptr (+ dptr (1- width))) (incf dptr)))
;; default overwrite mode
(progn
;; only add new chars until we've reached the max-buffer-length then only overwrite.
(if (>= len mlen)
(if (< inptr mlen)
;; even when the inbuf is full, when inptr is not at the end, overwrite.
(setf inbuf (replace-nth (- len (1+ inptr)) char inbuf))
nil)
;; if we're at the end of the inbuf
(if (= inptr len)
;; just add another char to the inbuf
(setf inbuf (cons char inbuf))
;; if we're in the middle of the buffer, either insert or replace
(setf inbuf (replace-nth (- len (1+ inptr)) char inbuf))))
;; we need special cases when mlen is exactly equal to width.
(if (= mlen width)
;; advance the cursor if it is not already at the end
;; if scrolling is disabled, do not move past the last char in the field.
(unless (>= inptr (- mlen 1))
(incf inptr))
(unless (> inptr (- mlen 1))
(incf inptr)))
;; after updating the fill-pointer, update the display-pointer
(when (< inptr dptr) (decf dptr))
(if (<= mlen width)
;; if scrolling is disabled, do not move past the last char in the field.
(when (> inptr (+ dptr width))
(incf dptr))
(when (> inptr (+ dptr (1- width)))
(incf dptr))) ))))
(draw field))
;; if the char isnt graphic, do nothing.
;; TODO: this doesnt work with acs chars, which are keywords.
nil))
(defun debug-print-field-buffer (object event &rest args)
(declare (ignore event))
(typecase object
(field
(with-accessors ((inbuf buffer) (inptr input-pointer) (dptr display-pointer) (win window)) object
(when (> (length inbuf) 0)
(clear win)
(format win "~A ~%" (value object))
(setf inbuf nil inptr 0 dptr 0))))
;; when we want to debug the whole form.
(form
(debug-print-field-buffer (current-element object) event)))
(draw object))
(defun cancel (object event &rest args)
"Associate this function with an event (key binding or button) to exit the event loop of a form or form element.
The first return value is nil, emphasizing that the user has canceled the form.
The second value is a list containing the object, the event that called the exit and the args passed.
This allows to specify why the form was canceled."
;; TODO: should this be done by the routine or explicitely by the user?
(when (eq (type-of object) 'form)
(reset-form object event))
(throw (if (eq (type-of object) 'form)
object
(if (parent-form object)
(parent-form object)
object))
(values nil (list object event args))))
(defun accept (object event &rest args)
"Associate this function with an event (key binding or button) to exit the event loop of a form or form element.
The first return value is t, emphasizing that the user has accepted the form.
The second value is a list containing the object, the event that called the exit and the args passed.
This allows to specify by which button or event the form was accepted."
;; if the object has a parent-form, do not throw the object, throw its parent form, otherwise throw the object.
(throw (if (eq (type-of object) 'form)
object
(if (parent-form object)
(parent-form object)
object))
(values t (list object event args))))
(defun reset-field (field event &rest args)
"Clear the field and reset its internal buffers and pointers."
(with-accessors ((inbuf buffer) (inptr input-pointer) (dptr display-pointer) (win window)) field
(clear field)
(setf inbuf nil inptr 0 dptr 0)))
(defun reset-form (object event &rest args)
(declare (ignore event))
(let ((form (typecase object
(form object)
(t (parent-form object)))))
(loop for element in (elements form)
do (when (and (typep element 'field) (activep element))
(with-accessors ((inbuf buffer) (inptr input-pointer) (dptr display-pointer) (win window)) element
(setf inbuf nil
inptr 0
dptr 0))))
(draw form)))
(define-keymap 'form-map
(list
;; C-a = ^A = #\soh = 1 = start of heading
;; exit the edit loop, return t
#\soh 'accept
;; C-x = cancel = CAN = #\can
;; exit the edit loop, return nil
#\can 'cancel
;; C-r = reset = DC2 = #\dc2
;; reset editable elements of the form (fields, checkboxes)
#\dc2 'reset-form
:btab 'select-previous-element
#\tab 'select-next-element))
(define-keymap 'field-map
(list
;; C-a = ^A = #\soh = 1 = start of heading
;; exit the edit loop, return t
#\soh 'accept
;; C-x = cancel = CAN = #\can
;; exit the edit loop, return nil
#\can 'cancel
;; C-r = reset = DC2 = #\dc2
;; reset the field
#\dc2 'reset-field
:left 'move-previous-char
:right 'move-next-char
:backspace 'delete-previous-char
:dc 'delete-next-char
:ic (lambda (field event &rest args)
(setf (insert-mode-p (window field)) (not (insert-mode-p (window field)))))
t 'field-add-char))
(defun call-button-function (button event &rest args)
(declare (ignore event))
(when (callback button)
(funcall (callback button) button event)))
(defun toggle-checkbox (checkbox event &rest args)
(declare (ignore event))
(setf (checkedp checkbox) (not (checkedp checkbox)))
(draw checkbox))
;; How to automatically bind a hotkey to every button?
;; that hotkey would have to be added to the form keymap, not to that of a button.
;; that would be like a global keymap, in contrast to an elements local keymap.
(define-keymap 'button-map
(list
#\space 'call-button-function
#\newline 'call-button-function))
(define-keymap 'checkbox-map
(list
#\space 'toggle-checkbox
#\x 'toggle-checkbox))
(defun edit (object &rest args)
(draw object)
;; since we have args passed to run-event-loop, all handler functions have to accept
;; a &rest args argument.
(apply #'run-event-loop object args))

36
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/get_wch.lisp Normal file
View file

@ -0,0 +1,36 @@
(in-package :de.anvi.croatoan)
(defun get-wide-char (window &key y x)
"Read in a wide C wchar_t (multi-byte) from the keyboard and return it.
If the destination coordinates y (row) and x (column) are given, move
the cursor to the destination first and then read a multi-byte char.
The window from which the char is read is automatically refreshed."
(when (and y x) (move window y x))
(with-foreign-object (ptr 'wint_t)
;; #define KEY_CODE_YES 0400 /* A wchar_t contains a key code */
;; if the char is a function key, return t as a second value, otherwise nil.
(if (= 256 (%wget-wch (winptr window) ptr))
(values (mem-ref ptr 'wint_t) t)
(values (mem-ref ptr 'wint_t) nil))))
(defun get-wide-event (window)
"Return a single user input event.
An event can be a lisp character or a keyword representing a function or mouse key.
If input-blocking is nil for the window, return nil if no key was typed."
(multiple-value-bind (ch function-key-p) (get-wide-char window)
(cond
;; for wide chars, if no input is waiting in non-blocking mode, ERR=0 is returned.
;; for normal chars, ERR=-1.
((= ch 0) nil)
(function-key-p
(let ((ev (function-key ch)))
(if (eq ev :mouse)
(multiple-value-bind (mev y x) (get-mouse-event)
(values mev y x)) ; returns 3 values, see mouse.lisp
ev)))
(t (code-char ch)))))

520
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/getch.lisp Normal file
View file

@ -0,0 +1,520 @@
(in-package :de.anvi.croatoan)
(defun get-char (window &key y x)
"Read in a C char (single byte) from the keyboard and return it.
If the destination coordinates y (row) and x (column) are given, move
the cursor to the destination first and then read a single byte.
The window from which the char is read is automatically refreshed."
(let ((winptr (winptr window)))
(cond ((and y x)
(%mvwgetch winptr y x))
(t
(%wgetch winptr)))))
;; takes a simple C chtype and puts it back into the read buffer.
;; it will be read with the next get-char.
(defun unget-char (chtype)
(%ungetch chtype))
;; takes an C int denoting a key. returns t or nil.
;; checks whether a function key is supported by the current terminal.
(defun key-supported-p (key-char)
(%has-key key-char))
;;; NOTES
;; All those return a simple C char (or int), not a rendered chtype (unsigned long int).
;; you can use code-char to convert this simple char/int to a lisp char.
;; but you cannot use this to convert a chtype to a lisp char.
;;; TODOs
;; [ ] Escape sequences. They are neither function keys nor chars.
;; keys above the first 0-255 chars. cannot fit in a char variable any more.
;; http://tldp.org/HOWTO/NCURSES-Programming-HOWTO/keys.html
(defparameter *key-alist*
'((:code_yes . 256)
(:min . 257)
(:break . 257)
(:down . 258)
(:up . 259)
(:left . 260)
(:right . 261)
(:home . 262) ; Pos1
(:backspace . 263)
(:f0 . 264)
(:f1 . 265)
(:f2 . 266)
(:f3 . 267)
(:f4 . 268)
(:f5 . 269)
(:f6 . 270)
(:f7 . 271)
(:f8 . 272)
(:f9 . 273)
(:f10 . 274)
(:f11 . 275)
(:f12 . 276)
(:f13 . 277)
(:f14 . 278)
(:f15 . 279)
(:f16 . 280)
(:f17 . 281)
(:f18 . 282)
(:f19 . 283)
(:f20 . 284)
(:f21 . 285)
(:f22 . 286)
(:f23 . 287)
(:f24 . 288)
(:f25 . 289)
(:f26 . 290)
(:f27 . 291)
(:f28 . 292)
(:f29 . 293)
(:f30 . 294)
(:f31 . 295)
(:f32 . 296)
(:f33 . 297)
(:f34 . 298)
(:f35 . 299)
(:f36 . 300)
(:f37 . 301)
(:f38 . 302)
(:f39 . 303)
(:f40 . 304)
(:f41 . 305)
(:f42 . 306)
(:f43 . 307)
(:f44 . 308)
(:f45 . 309)
(:f46 . 310)
(:f47 . 311)
(:f48 . 312)
(:f49 . 313)
(:f50 . 314)
(:f51 . 315)
(:f52 . 316)
(:f53 . 317)
(:f54 . 318)
(:f55 . 319)
(:f56 . 320)
(:f57 . 321)
(:f58 . 322)
(:f59 . 323)
(:f60 . 324)
(:f61 . 325)
(:f62 . 326)
(:f63 . 327)
(:dl . 328)
(:il . 329)
(:dc . 330)
(:ic . 331)
(:eic . 332)
(:clear . 333)
(:eos . 334)
(:eol . 335)
(:sf . 336) ; :shift-down
(:sr . 337) ; :shift-up
(:npage . 338)
(:ppage . 339)
(:stab . 340)
(:ctab . 341)
(:catab . 342)
(:enter . 343)
(:sreset . 344)
(:reset . 345)
(:print . 346)
(:ll . 347)
(:a1 . 348)
(:a3 . 349)
(:b2 . 350)
(:c1 . 351)
(:c3 . 352)
(:btab . 353) ; Shift + TAB = #\LATIN_SMALL_LETTER_S_WITH_CARON = sch
(:beg . 354)
(:cancel . 355)
(:close . 356)
(:command . 357)
(:copy . 358)
(:create . 359)
(:end . 360) ; Ende
(:exit . 361)
(:find . 362)
(:help . 363)
(:mark . 364)
(:message . 365)
(:move . 366)
(:next . 367)
(:open . 368)
(:options . 369)
(:previous . 370)
(:redo . 371)
(:reference . 372)
(:refresh . 373)
(:replace . 374)
(:restart . 375)
(:resume . 376)
(:save . 377)
(:sbeg . 378)
(:scancel . 379)
(:scommand . 380)
(:scopy . 381)
(:screate . 382)
(:sdc . 383)
(:sdl . 384)
(:select . 385)
(:send . 386) ; Shift-End
(:seol . 387)
(:sexit . 388)
(:sfind . 389)
(:shelp . 390)
(:shome . 391) ; Shift-Home, Shift-Pos1
(:sic . 392)
(:sleft . 393)
(:smessage . 394)
(:smove . 395)
(:snext . 396)
(:soptions . 397)
(:sprevious . 398)
(:sprint . 399)
(:sredo . 400)
(:sreplace . 401)
(:sright . 402)
(:srsume . 403)
(:ssave . 404)
(:ssuspend . 405)
(:sundo . 406)
(:suspend . 407)
(:undo . 408)
(:mouse . 409)
(:resize . 410)
(:event . 411)
(:max . 511) ; Alt-Delete
;; The following codes are not part of ncurses because they are not portable, i.e. they do not
;; exist on all terminals.
;; These are tested on xterm / gnome-terminal
;; :shift-delete = :sdc
(:shift-alt-delete . 512)
(:ctrl-delete . 513) ; Ctrl-Delete
(:shift-ctrl-delete . 514) ; Shift-Control-Delete
;; :shift-down = :sf = 336
(:alt-down . 517)
(:shift-alt-down . 518)
(:ctrl-down . 519)
(:shift-ctrl-down . 520)
;; (:shift-alt-ctrl-down . xxx) ;; hijacked by the ubuntu unity wm.
(:alt-end . 522)
(:shift-alt-end . 523)
(:ctrl-end . 524)
(:shift-ctrl-end . 525)
(:ctrl-alt-end . 526)
;; :shift-ctrl-alt-end . xxx
(:alt-home . 527)
(:shift-alt-home . 528)
(:ctrl-home . 529)
(:shift-ctrl-home . 530)
(:ctrl-alt-home . 531)
(:alt-insert . 532) ; Alt-Insert
;; :shift-insert = middle mouse button paste, probably 513, hijacked by xterm.
(:ctrl-insert . 534) ; Ctrl-Insert
(:ctrl-alt-insert . 536) ; Ctrl-Alt-Insert
;; Shift-Ctrl-Alt-Insert = ^[ [ 3 ; 8 ~
(:alt-left . 537)
(:shift-alt-right . 538)
(:ctrl-left . 539)
(:shift-ctrl-left . 540)
;; npage
;; :shift-npage
(:alt-npage . 542)
(:ctrl-npage . 544)
(:ctrl-alt-npage . 546)
;; :ppage
;; :shift-ppage activates an xterm ppage function
(:alt-ppage . 547)
(:ctrl-ppage . 549)
(:ctrl-alt-ppage . 551)
(:alt-right . 552)
(:shift-alt-right . 553)
(:ctrl-right . 554)
(:shift-ctrl-left . 555)
;; :shift-up = :sr = 337
(:alt-up . 558)
(:shift-alt-up . 559)
(:ctrl-up . 560)
(:shift-ctrl-up . 561)))
;; (:shift-alt-ctrl-up . xxx)
;; Takes a short int returned by get-char,
;; returns a keyword represeting the function key.
;; returns nil if number is not in the list.
(defun function-key (number)
(car (rassoc number *key-alist*)))
;; Returns t if the number is a key, nil if it is a char.
(defun function-key-p (number)
(if (and (> number 255)
(rassoc number *key-alist*))
t
nil))
;; http://rosettacode.org/wiki/Keyboard_input/Keypress_check
;; Returns t if a key has been pressed and a char can be read by get-char.
;; Requires input-blocking for window to be set to nil.
(defun key-pressed-p (window)
(let ((ch (get-char window)))
;; ncurses get-char returns -1 when no key was pressed.
(unless (= ch -1)
;; if a key was pressed, put it back into the input buffer so it can be rad by the next call to get-char.
(unget-char ch)
;; Return t.
t)))
;; works only when input-blocking is set to nil. enable-fkeys should also be t.
;; events can be handled with case.
;; events can be nil (no key pressed), characters #\a and function keys like :up, :down, etc.
;; todo: mouse, resizekey
(defun get-event (window)
;; doesnt really get a "char", but a single byte, which can be a char.
(let ((ch (get-char window)))
(cond
;; -1 means no key has been pressed.
((= ch -1) nil)
;; 0-255 are regular chars, whch can be converted to lisp chars with code-char.
((and (>= ch 0) (<= ch 255)) (code-char ch))
;; if the code belongs to a known function key, return a keyword symbol.
((function-key-p ch)
(let ((ev (function-key ch)))
(if (eq ev :mouse)
(multiple-value-bind (mev y x) (get-mouse-event)
(values mev y x)) ; returns 3 values, see mouse.lisp
ev)))
;; todo: unknown codes, like mouse, resize and unknown function keys.
(t
;;(error "invalid value of char received from ncurses.")
(princ ch window)))))
#|
;; I dont want them defined as octal literals.
'((:code_yes . #o400)
(:min . #o401)
(:break . #o401)
(:down . #o402)
(:up . #o403)
(:left . #o404)
(:right . #o405)
(:home . #o406)
(:backspace . #o407)
(:f0 . #o410)
;; how to handle this???
;; F(n) (KEY_F0+(n)) /* Value of function key n */
;; (loop for i from 1 to 63 do (format t "(:f~A . ~A)~%" i (+ F0 i)))
(:dl . #o510)
(:il . #o511)
(:dc . #o512)
(:ic . #o513)
(:eic . #o514)
(:clear . #o515)
(:eos . #o516)
(:eol . #o517)
(:sf . #o520)
(:sr . #o521)
(:npage . #o522)
(:ppage . #o523)
(:stab . #o524)
(:ctab . #o525)
(:catab . #o526)
(:enter . #o527)
(:sreset . #o530)
(:reset . #o531)
(:print . #o532)
(:ll . #o533)
(:a1 . #o534)
(:a3 . #o535)
(:b2 . #o536)
(:c1 . #o537)
(:c3 . #o540)
(:btab . #o541)
(:beg . #o542)
(:cancel . #o543)
(:close . #o544)
(:command . #o545)
(:copy . #o546)
(:create . #o547)
(:end . #o550)
(:exit . #o551)
(:find . #o552)
(:help . #o553)
(:mark . #o554)
(:message . #o555)
(:move . #o556)
(:next . #o557)
(:open . #o560)
(:options . #o561)
(:previous . #o562)
(:redo . #o563)
(:reference . #o564)
(:refresh . #o565)
(:replace . #o566)
(:restart . #o567)
(:resume . #o570)
(:save . #o571)
(:sbeg . #o572)
(:scancel . #o573)
(:scommand . #o574)
(:scopy . #o575)
(:screate . #o576)
(:sdc . #o577)
(:sdl . #o600)
(:select . #o601)
(:send . #o602)
(:seol . #o603)
(:sexit . #o604)
(:sfind . #o605)
(:shelp . #o606)
(:shome . #o607)
(:sic . #o610)
(:sleft . #o611)
(:smessage . #o612)
(:smove . #o613)
(:snext . #o614)
(:soptions . #o615)
(:sprevious . #o616)
(:sprint . #o617)
(:sredo . #o620)
(:sreplace . #o621)
(:sright . #o622)
(:srsume . #o623)
(:ssave . #o624)
(:ssuspend . #o625)
(:sundo . #o626)
(:suspend . #o627)
(:undo . #o630)
(:mouse . #o631)
(:resize . #o632)
(:event . #o633)
(:max . #o777)))
#define KEY_CODE_YES 0400 /* A wchar_t contains a key code */
#define KEY_MIN 0401 /* Minimum curses key */
#define KEY_BREAK 0401 /* Break key (unreliable) */
#define KEY_DOWN 0402 /* down-arrow key */
#define KEY_UP 0403 /* up-arrow key */
#define KEY_LEFT 0404 /* left-arrow key */
#define KEY_RIGHT 0405 /* right-arrow key */
#define KEY_HOME 0406 /* home key */
#define KEY_BACKSPACE 0407 /* backspace key */
#define KEY_F0 0410 /* Function keys. Space for 64 */
#define KEY_F(n) (KEY_F0+(n)) /* Value of function key n */
#define KEY_DL 0510 /* delete-line key */
#define KEY_IL 0511 /* insert-line key */
#define KEY_DC 0512 /* delete-character key */
#define KEY_IC 0513 /* insert-character key */
#define KEY_EIC 0514 /* sent by rmir or smir in insert mode */
#define KEY_CLEAR 0515 /* clear-screen or erase key */
#define KEY_EOS 0516 /* clear-to-end-of-screen key */
#define KEY_EOL 0517 /* clear-to-end-of-line key */
#define KEY_SF 0520 /* scroll-forward key */
#define KEY_SR 0521 /* scroll-backward key */
#define KEY_NPAGE 0522 /* next-page key */
#define KEY_PPAGE 0523 /* previous-page key */
#define KEY_STAB 0524 /* set-tab key */
#define KEY_CTAB 0525 /* clear-tab key */
#define KEY_CATAB 0526 /* clear-all-tabs key */
#define KEY_ENTER 0527 /* enter/send key */
#define KEY_SRESET 0530 /* Soft (partial) reset (unreliable) */
#define KEY_RESET 0531 /* Reset or hard reset (unreliable) */
#define KEY_PRINT 0532 /* print key */
#define KEY_LL 0533 /* lower-left key (home down) */
#define KEY_A1 0534 /* upper left of keypad */
#define KEY_A3 0535 /* upper right of keypad */
#define KEY_B2 0536 /* center of keypad */
#define KEY_C1 0537 /* lower left of keypad */
#define KEY_C3 0540 /* lower right of keypad */
#define KEY_BTAB 0541 /* back-tab key */
#define KEY_BEG 0542 /* begin key */
#define KEY_CANCEL 0543 /* cancel key */
#define KEY_CLOSE 0544 /* close key */
#define KEY_COMMAND 0545 /* command key */
#define KEY_COPY 0546 /* copy key */
#define KEY_CREATE 0547 /* create key */
#define KEY_END 0550 /* end key */
#define KEY_EXIT 0551 /* exit key */
#define KEY_FIND 0552 /* find key */
#define KEY_HELP 0553 /* help key */
#define KEY_MARK 0554 /* mark key */
#define KEY_MESSAGE 0555 /* message key */
#define KEY_MOVE 0556 /* move key */
#define KEY_NEXT 0557 /* next key */
#define KEY_OPEN 0560 /* open key */
#define KEY_OPTIONS 0561 /* options key */
#define KEY_PREVIOUS 0562 /* previous key */
#define KEY_REDO 0563 /* redo key */
#define KEY_REFERENCE 0564 /* reference key */
#define KEY_REFRESH 0565 /* refresh key */
#define KEY_REPLACE 0566 /* replace key */
#define KEY_RESTART 0567 /* restart key */
#define KEY_RESUME 0570 /* resume key */
#define KEY_SAVE 0571 /* save key */
#define KEY_SBEG 0572 /* shifted begin key */
#define KEY_SCANCEL 0573 /* shifted cancel key */
#define KEY_SCOMMAND 0574 /* shifted command key */
#define KEY_SCOPY 0575 /* shifted copy key */
#define KEY_SCREATE 0576 /* shifted create key */
#define KEY_SDC 0577 /* shifted delete-character key */
#define KEY_SDL 0600 /* shifted delete-line key */
#define KEY_SELECT 0601 /* select key */
#define KEY_SEND 0602 /* shifted end key */
#define KEY_SEOL 0603 /* shifted clear-to-end-of-line key */
#define KEY_SEXIT 0604 /* shifted exit key */
#define KEY_SFIND 0605 /* shifted find key */
#define KEY_SHELP 0606 /* shifted help key */
#define KEY_SHOME 0607 /* shifted home key */
#define KEY_SIC 0610 /* shifted insert-character key */
#define KEY_SLEFT 0611 /* shifted left-arrow key */
#define KEY_SMESSAGE 0612 /* shifted message key */
#define KEY_SMOVE 0613 /* shifted move key */
#define KEY_SNEXT 0614 /* shifted next key */
#define KEY_SOPTIONS 0615 /* shifted options key */
#define KEY_SPREVIOUS 0616 /* shifted previous key */
#define KEY_SPRINT 0617 /* shifted print key */
#define KEY_SREDO 0620 /* shifted redo key */
#define KEY_SREPLACE 0621 /* shifted replace key */
#define KEY_SRIGHT 0622 /* shifted right-arrow key */
#define KEY_SRSUME 0623 /* shifted resume key */
#define KEY_SSAVE 0624 /* shifted save key */
#define KEY_SSUSPEND 0625 /* shifted suspend key */
#define KEY_SUNDO 0626 /* shifted undo key */
#define KEY_SUSPEND 0627 /* suspend key */
#define KEY_UNDO 0630 /* undo key */
#define KEY_MOUSE 0631 /* Mouse event has occurred */
#define KEY_RESIZE 0632 /* Terminal resize event */
#define KEY_EVENT 0633 /* We were interrupted by an event */
#define KEY_MAX 0777 /* Maximum key value is 0633 */
|#

19
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/getstr.lisp Normal file
View file

@ -0,0 +1,19 @@
(in-package :de.anvi.croatoan)
(defun get-string (window n &key y x)
"Read a string from the keyboard and return it.
Reading is performed until a newline or carriage return is received.
The terminating character is not included in the returned string.
If n is given, read at most n chars, to prevent a possible input
buffer overflow.
If the destination coordinates y and x are given, move the cursor
there first."
(let ((winptr (winptr window)))
(with-foreign-pointer-as-string (string n)
(cond ((and y x)
(%mvwgetnstr winptr y x string n))
(t
(%wgetnstr winptr string n))))))

54
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/getyx.lisp Normal file
View file

@ -0,0 +1,54 @@
(in-package :de.anvi.croatoan)
;; TODO: window auf winpter umstellen.
(defun cursor-position (window)
"Returns a cons pair of the current cursor coordinates (line-y . column-x) in window."
(cons (%getcury window)
(%getcurx window)))
(defun window-begin (window)
"Returns a cons pair of the top left beginning coordinates (y . x) of window."
(cons (%getbegy window)
(%getbegx window)))
(defun subwindow-relative-begin (subwindow)
"Returns a cons pair (y . x) of beginning coordinates of a subwindow relative to the parent window."
(cons (%getpary subwindow)
(%getparx subwindow)))
(defun window-size (window)
"Returns window size as a cons pair (height . width)."
(cons (%getmaxy window)
(%getmaxx window)))
;;; NOTES
#|
Those 4 C macros are defined in terms of other, simpler macros:
#define getyx(win,y,x) (y = getcury(win), x = getcurx(win))
#define getbegyx(win,y,x) (y = getbegy(win), x = getbegx(win))
#define getmaxyx(win,y,x) (y = getmaxy(win), x = getmaxx(win))
#define getparyx(win,y,x) (y = getpary(win), x = getparx(win))
And those simpler macros are just accessing the window struct.
#define getcurx(win) ((win) ? (win)->_curx : ERR)
#define getcury(win) ((win) ? (win)->_cury : ERR)
#define getbegx(win) ((win) ? (win)->_begx : ERR)
#define getbegy(win) ((win) ? (win)->_begy : ERR)
#define getmaxx(win) ((win) ? ((win)->_maxx + 1) : ERR)
#define getmaxy(win) ((win) ? ((win)->_maxy + 1) : ERR)
#define getparx(win) ((win) ? (win)->_parx : ERR)
#define getpary(win) ((win) ? (win)->_pary : ERR)
Those are defined as low-level functions in legacy.lisp.
|#
;;; TODOs
;; combine the 2 win and subwin functions into one by using opaque/is_subwin.

162
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/gray_streams.lisp Normal file
View file

@ -0,0 +1,162 @@
(in-package :de.anvi.croatoan)
#|
classes and methods for the gray stream interface.
http://www.nhplace.com/kent/CL/Issues/stream-definition-by-user.html
http://www.gnu.org/software/clisp/impnotes/gray-gf-char-out.html
before including this, add trivial-gray-streams to asd or use the sb-gray stream package.
Up to now, window and screen had no superclasses, thus they were subclasses of standard-object.
Now, they will become bi-directional character streams.
That means that we dont need separate classes for defining streams, and that windows will have
a stream as a feature, windows now will _be_ specialized streams.
fundamental-character-output-stream
fundamental-character-input-stream
window
screen
subwin
For the existing code, nothing will change. we will still be able to use all ncurses and croatoan
functions.
Actually, we still _need_ those functions to define the gray stream functions. But once defined,
we will not need add-char and add-string any more, we will simply use Lisp's format, read, print, etc.
|#
;;;; libncursesw, wide IO
;;; Character Output stream
;;; Mandatory methods
;; write-char, format ~C
(defmethod stream-write-char ((stream window) (ch character))
(if (insert-mode-p stream)
(progn
(insert-wide-char stream ch)
;; move the cursor after the inserted character.
(move-direction stream :right))
(add-wide-char stream ch)))
;; 170830: #sbcl, according to stassats we can not specialize on the second argument,
;; so no complex chars or complex strings with the ~C directive.
;; use ~/xyz/ instead of ~C.
;; ~A uses print-object underneath, not gray streams, so it probably can be used.
#|
; SLIME 2.19
CL-USER> (defun xxx (&rest args)
(print (second args)))
XXX
CL-USER> xxx
; Evaluation aborted on #<UNBOUND-VARIABLE XXX {1002E0A433}>.
CL-USER> (xxx 1 2 3 4)
2
2
CL-USER> (format t "~/xxx/")
; Evaluation aborted on #<SB-FORMAT:FORMAT-ERROR {1003469493}>.
CL-USER> (format t "~/xxx/" 1)
1
NIL
CL-USER> (format t "~/xxx/" 11)
11
NIL
CL-USER>
|#
(defmethod stream-write-char ((stream window) (ch complex-char))
(add-wide-char stream ch))
;; Returns the column number where the next character would be written, i.e. the current x position
(defmethod stream-line-column ((stream window))
(%getcurx (winptr stream)))
;;; Non-mandatory methods
;; Default method uses repeated calls to stream-write-char
;; We can not specialize stream-write-string on complex-strings.
#|
(defmethod stream-write-string ((stream window) (str-orig string) &optional (start 0) (end nil))
;; TODO: either do something with start and end, or (declare (ignore start end))
(let ((str (subseq str-orig start end)))
;; TODO: we can not combine %wadd-wch and %waddstr
;; TODO: writing a normal string waddstr on a wide cchar background causes an SB-KERNEL::CONTROL-STACK-EXHAUSTED-ERROR
(%waddstr (winptr stream) str)))
|#
;;; Character Input Stream
;;; Mandatory methods: stream-read-char, stream-unread-char
(defmethod stream-read-char ((stream window))
(code-char (get-wide-char stream)))
(defmethod stream-unread-char ((stream window) (ch character))
(%unget-wch (char-code ch)))
;;;; libncurses, non-wide IO
;;; Character Output stream
;;; Mandatory methods: stream-write-char, stream-line-column
;; write-char, format ~C
;;(defmethod stream-write-char ((stream window) (ch character))
;; (let ((code (char-code ch))
;; (winptr (winptr stream)))
;; (if (insert-mode-p stream)
;; (progn
;; (%winsch winptr code)
;; ;; move the cursor after the inserted character.
;; (move-to stream :right))
;; (%waddch winptr code))))
;; write-char, format ~C
;;(defmethod stream-write-char ((stream window) (ch complex-char))
;; (%waddch (winptr stream) (x2c ch)))
;; print, prin1, princ, format ~A, ~S
;;(defmethod print-object ((ch complex-char) (stream window))
;; (%waddch (winptr stream) (x2c ch)))
;;
;;(defmethod print-object ((cstr complex-string) stream)
;; (loop for ch across (complex-char-array cstr)
;; do (princ (simple-char ch))))
;;
;;(defmethod print-object ((cstr complex-string) (stream window))
;; (loop for ch across (complex-char-array cstr)
;; do (add-char stream ch)))
;; Returns the column number where the next character would be written, i.e. the current y position
;;(defmethod stream-line-column ((stream window))
;; (%getcurx (winptr stream)))
;;; Non-mandatory methods
;; Default method uses repeated calls to stream-write-char
;;(defmethod stream-write-string ((stream window) (str string) &optional (start 0) (end nil))
;; ;; TODO: either do something with start and end, or (declare (ignore start end))
;; (%waddstr (winptr stream) str))
;;; Character Input Stream
;;(defmethod stream-read-char ((stream window))
;; (code-char (%wgetch (winptr stream))))
;;(defmethod stream-read-char-no-hang ((stream window))
;; %wgetch wie bei read-char, nur muss input-blocking nil sein.
;;(defmethod stream-unread-char ((stream window) (ch character))
;; (%ungetch (char-code ch)))
;; listen = read-char-no-hang + unread
;;(defmethod stream-listen ((stream window))

14
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/in_wch.lisp Normal file
View file

@ -0,0 +1,14 @@
(in-package :de.anvi.croatoan)
(defun extract-wide-char (window &key y x position)
"Extract and return a single wide (complex) character from the window.
This includes wide characters (code > 255), and requires the ncursesw library.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the character.
The position can also be passed in form of a two-element list."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(funcall-get-cchar_t #'%win-wch window))

14
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/inch.lisp Normal file
View file

@ -0,0 +1,14 @@
(in-package :de.anvi.croatoan)
(defun extract-char (window &key y x position)
"Extract and return the single-byte complex char from the window.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the character.
The position can also be passed in form of a two-element list."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let* ((winptr (winptr window))
(chtype (%winch winptr)))
(chtype2xchar chtype)))

21
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/inchstr.lisp Normal file
View file

@ -0,0 +1,21 @@
(in-package :de.anvi.croatoan)
(defun extract-complex-string (window &key y x position n)
"Extract and return a complex string from the window.
Start at the current cursor position and end at the right margin of window.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the character.
The position can also be passed in form of a two-element list.
If n is given, read at most n chars."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let* ((count (if n n (- (width window) (cadr (cursor-position window)))))
(complex-string (make-instance 'complex-string)))
(loop for i from 0 to (1- count) do
(vector-push-extend (extract-wide-char window) (complex-char-array complex-string))
(move-direction window :right))
complex-string))

31
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/initscr.lisp Normal file
View file

@ -0,0 +1,31 @@
(in-package :de.anvi.croatoan)
(defun init-screen ()
"Initializes the curses mode. Returns the main window."
(%initscr))
(defun end-screen ()
"Clean shutdown of the curses display."
(%endwin))
(defgeneric closed-p (s)
(:documentation "Check whether the screen has been closed without a subsequent call to refresh to reactivate it."))
(defmethod closed-p ((s screen))
(declare (ignore s))
(%isendwin))
(defun new-terminal (type out-fd in-fd)
"Use instead of init-screen when you want more than one terminal."
(%newterm type out-fd in-fd))
(defun set-current-terminal (new-screen)
"Sets new-screen as the current terminal. Returns the old screen."
(%set-term new-screen))
;;; TODOs
;; [ ] are files in lisp in newterm correctly represented by fd-s?
;; [ ] add type info either to the docs or in asserts.
;; [ ] document all possible return values and check for them.

82
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/inopts.lisp Normal file
View file

@ -0,0 +1,82 @@
(in-package :de.anvi.croatoan)
;; nodelay FALSE = getch blocking
;; nodelay TRUE = getch non-blocking.
;; halfdelay 5 = waits for 5/10 seconds.
;; halfdelay is turned off by nocbreak.
;; terminal input modes:
;;
;; canonical non canonical
;; line buffered character based
;; ctrl chars processed ^C,^S,^Q,^D processed no ctrl chars processed
;; cooked cbreak raw
;;
;; buffering t nil nil
;; control t t nil
;; | cooked | cbreak | raw
;; ----------+--------+--------+-----
;; buffering | t | nil | nil
;; ----------+--------+--------+-----
;; control | t | t | nil
;; The combination echo+getch should not be used during buffered input
(defun set-input-mode (input-buffering process-control-chars)
(if input-buffering
;; to turn on buffering, turn off cbreak or raw
(if process-control-chars (%nocbreak) (%noraw))
;; to turn off buffering, turn on cbreak or raw
(if process-control-chars (%cbreak) (%raw))))
;; Ported to clos, used in clos.
(defun set-input-blocking (window status)
"Set window input blocking behavior.
Possible values are t, nil and a blocking duration in (positive integer) miliseconds."
(cond ((eq status t) (%wtimeout window -1))
((eq status nil) (%wtimeout window 0))
((and (typep status 'integer) (plusp status))
(%wtimeout window status))
(t (error "possible blocking states: t, nil, delay in miliseconds"))))
;; Not used in clos because too simple. obsolete.
(defun set-input-echoing (flag)
"Set whether chars will be echoed on input."
(if flag
(%echo)
(%noecho)))
;; Not used in clos because too simple. obsolete.
(defun set-enable-fkeys (window flag)
"If flag is t, bind function keys to known codes when returned by get-char.
If flag is nil, F keys will be system-dependent multi-character escape codes."
(%keypad (winptr window) flag))
;; Obscure functions I never used before:
(defun flush-on-interrupt (window flag)
(%intrflush window flag))
(defun enable-8bit-char-input (window flag)
(%meta window flag))
(defun io-queue-flush (flag)
(if flag
(%qiflush)
(%noqiflush)))
;; if it would work at all, which it doesnt,
;; it would work only for (function-keys win t)
(defun escape-sequence-delay (window flag)
(%notimeout window flag))
(defun type-ahead-fd (fd)
(%typeahead fd))
;;; TODOs
;; [X] do not mix cbreak and raw. use either the one or the other.
;; [ ] for now, we consider only global optins. work in a window parameter as well.

56
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/ins_wch.lisp Normal file
View file

@ -0,0 +1,56 @@
(in-package :de.anvi.croatoan)
(defun insert-wide-char (window char &key attributes fgcolor bgcolor color-pair style y x position n)
"Insert char into window before the character currently under the cursor.
Chars right of the cursor are moved one position to the right.
The rightmost character on the line may be lost. The position of the
cursor is not changed.
char can be a simple character or a complex-char with attributes and colors.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the object.
The position can also be passed in form of a two-element list.
If n is given, insert n chars."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let ((attributes (if style
(getf style :attributes)
attributes))
(color-pair (cond (style
(list (getf style :fgcolor) (getf style :bgcolor)))
((or fgcolor bgcolor)
(list fgcolor bgcolor))
(t color-pair))))
(funcall-make-cchar_t #'%wins-wch window char attributes color-pair n)))
;; TODO: (defmethod insert (obj character))
;; (defmethod insert (obj string)) etc.
;; the same for echo (only chars) and add.
;; :x t :y t => keep the current row or column
(defun insert (window object &rest keys &key &allow-other-keys)
"Insert char or string into window before the char currently under the cursor.
Currently supported text objects are characters (simple and complex),
characters given by integer codes or keywords, and strings
(simple and complex).
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then insert the object.
The position can also be passed in form of a two-element list.
If n is given for a char, insert n chars.
If n is given for a string, add at most n chars from the string."
(let ((fn (typecase object
((or string complex-string)
#'insert-string)
((or integer keyword character complex-char)
#'insert-wide-char))))
(apply fn window object keys)))

28
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/insch.lisp Normal file
View file

@ -0,0 +1,28 @@
(in-package :de.anvi.croatoan)
(defun insert-char (window char &key attributes fgcolor bgcolor color-pair style y x position n)
"Insert char into window before the character currently under the cursor.
Chars right of the cursor are moved one position to the right.
The rightmost character on the line may be lost. The position of the
cursor is not changed.
char can be a simple character or a complex-char with attributes and colors.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the object.
The position can also be passed in form of a two-element list.
If n is given, insert n chars."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let ((attributes (if style
(getf style :attributes)
attributes))
(color-pair (cond (style
(list (getf style :fgcolor) (getf style :bgcolor)))
((or fgcolor bgcolor)
(list fgcolor bgcolor))
(t color-pair))))
(funcall-make-chtype #'%winsch window char attributes color-pair n)))

42
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/insstr.lisp Normal file
View file

@ -0,0 +1,42 @@
(in-package :de.anvi.croatoan)
(defun insert-string (window string &key attributes fgcolor bgcolor color-pair style y x position n)
"Insert string before the current position in window.
Chars right of the cursor are moved to the right. The rightmost chars
on the line may be lost. The cursor position is not changed.
If n is given, insert at most n chars from the string.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the object.
The position can also be passed in form of a two-element list."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let ((count (if n
n
;; we cant use length to determine the length of a complex string
;; because it is not a sequence.
(typecase string
(string (length string))
(complex-string (length (complex-char-array string)))))))
(typecase string
(string
;;(if (or attributes fgcolor bgcolor color-pair style)
;; lisp string combined with attributes and colors
(loop
repeat count
for ch across (reverse string)
do (insert-wide-char window ch :attributes attributes :fgcolor fgcolor :bgcolor bgcolor
:color-pair color-pair :style style)) )
;; simple lisp string, no attributes or colors
;; TODO 190826 we dont want to use this because we want to force color-set and bkgd to use separate colors
;;(if n
;; (%winsnstr (winptr window) string n)
;; (%winsstr (winptr window) string))))
(complex-string
(loop
repeat count
for ch across (reverse (complex-char-array string))
do (insert-wide-char window ch))))))

28
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/instr.lisp Normal file
View file

@ -0,0 +1,28 @@
(in-package :de.anvi.croatoan)
(defun extract-string (window &key y x position n)
"Extract and return a string from window.
Any attributes are stripped from the characters before the string is returned.
Start at the current cursor position and end at the right margin of window.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the character.
The position can also be passed in form of a two-element list.
If n is given, read at most n chars."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let ((len (if n n (distance-to-eol window))))
(with-foreign-pointer (string len)
;; zero the allocated foreign string first.
(setf (mem-ref string :char (1- len)) 0)
;; populate the foreign string with chars.
;; the c routines return ERR (-1) or the number of chars extracted.
(let ((retval (%winnstr (winptr window) string len)))
(if (= retval -1)
nil
;; convert the char pointer to a lisp string.
(foreign-string-to-lisp string))))))

25
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/inwstr.lisp Normal file
View file

@ -0,0 +1,25 @@
(in-package :de.anvi.croatoan)
(defun extract-wide-string (window &key y x position n)
"Extract and return a string from window.
Any attributes are stripped from the characters before the string is returned.
Start at the current cursor position and end at the right margin of window.
If the position coordinates y (row) and x (column) are given, move the
cursor to the position first and then add the character.
The position can also be passed in form of a two-element list.
If n is given, read at most n chars."
(when (and y x) (move window y x))
(when position (apply #'move window position))
(let ((count (if n n (distance-to-eol window)))
;; start with an empty string as buffer
(str (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t)))
(loop for i from 0 to (1- count) do
(vector-push-extend (simple-char (extract-wide-char window)) str)
(move-direction window :right))
;; return string buffer containing i chars
str))

9
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/kernel.lisp Normal file
View file

@ -0,0 +1,9 @@
(in-package :de.anvi.croatoan)
;; 0 invisible, 1 visible, 2 very visible.
(defun set-cursor-visibility (status)
(case status
((nil :invisible) (%curs-set 0))
((t :visible) (%curs-set 1))
(:very-visible (%curs-set 2))
(otherwise (error "Valid status arguments: nil, t, :very-visible"))))

27
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/key_defined.lisp Normal file
View file

@ -0,0 +1,27 @@
(in-package :croatoan)
;; key_defined
;; check if a keycode is defined
;; http://invisible-island.net/ncurses/man/key_defined.3x.html
;;; C prototypes
;; int key_defined(const char *definition);
;;; Low-level C functions
(defcfun ("key_defined" %key-defined) :int (definition :string))
;;; High-level Lisp wrappers
(defun key-defined-p (key-name)
"If keycode is defined, return the keycode."
(let ((retval (%key-defined key-name)))
(cond ((= retval 0) nil)
((= retval -1) nil)
(t retval))))
;;; TODOs
;; [ ] dont return any numeric codes, do something with keywords.
;; [ ] somehow handle the -1 error case.

24
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/keybound.lisp Normal file
View file

@ -0,0 +1,24 @@
(in-package :croatoan)
;; keybound
;; return definition of keycode
;; http://invisible-island.net/ncurses/man/keybound.3x.html
;;; C prototypes
;; char *keybound(int keycode, int count);
;;; Low-level C functions
(defcfun ("keybound" %keybound) :string (keycode :int) (count :int))
;;; High-level Lisp wrappers
(defun key-description (code n)
"Return the n-th description of key stored in the terminfo database."
(%keybound code n))
;;; TODOs
;; [ ] dont return any numeric codes, do something with keywords.
;; [ ] somehow handle the -1 error case.

39
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/legacy.lisp Normal file
View file

@ -0,0 +1,39 @@
(in-package :croatoan)
;;; legacy
;;; get curses cursor and window coordinates, attributes
;;; http://invisible-island.net/ncurses/man/curs_legacy.3x.html
;;; C prototypes
;; int getattrs(WINDOW *win);
;; int getbegx(WINDOW *win);
;; int getbegy(WINDOW *win);
;; int getcurx(WINDOW *win);
;; int getcury(WINDOW *win);
;; int getmaxx(WINDOW *win);
;; int getmaxy(WINDOW *win);
;; int getparx(WINDOW *win);
;; int getpary(WINDOW *win);
;;; Low-level C functions
(defcfun ("getbegx" %getbegx) :int (win window))
(defcfun ("getbegy" %getbegy) :int (win window))
(defcfun ("getcurx" %getcurx) :int (win window))
(defcfun ("getcury" %getcury) :int (win window))
(defcfun ("getmaxx" %getmaxx) :int (win window))
(defcfun ("getmaxy" %getmaxy) :int (win window))
(defcfun ("getparx" %getparx) :int (win window))
(defcfun ("getpary" %getpary) :int (win window))
;;; High-level Lisp wrappers
;; See getyx.lisp.
;;; NOTES
;;; TODOs
;; getattrs compare with attr_get

26
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/legacy_coding.lisp Normal file
View file

@ -0,0 +1,26 @@
(in-package :croatoan)
;;; legacy coding
;;; http://invisible-island.net/ncurses/man/legacy_coding.3x.html
;;; C prototypes
;; int use_legacy_coding(int level);
;;; Low-level C functions
(defcfun ("use_legacy_coding" %use-legacy-coding) :int (level :int))
;;; High-level Lisp wrappers
;; Possible values: 0 (default), 1 and 2.
(defun set-char-representation (level)
"Set how char-to-string will represent a char."
(%use-legacy-coding level))
;;; NOTES
;; This affects %unctrl/char-to-string. See util.lisp and the manpage.
;;; TODOs

344
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/menu.lisp Normal file
View file

@ -0,0 +1,344 @@
(in-package :de.anvi.croatoan)
;; menu
;; curses extension for programming menus
;; http://invisible-island.net/ncurses/man/menu.3x.html
(defun list2array (list dimensions)
"Example: (list2array '(a b c d e f) '(3 2)) => #2A((A B) (C D) (E F))"
(let ((m (car dimensions))
(n (cadr dimensions)))
(assert (= (length list) (* m n)))
(let ((array (make-array dimensions :initial-element nil)))
(loop for i from 0 to (- m 1)
do (loop for j from 0 to (- n 1)
do (setf (aref array i j) (nth (+ (* i n) j) list))))
array)))
;; TODO: see menu_format
(defun rmi2sub (layout rmi)
"Take array dimensions and an index in row-major order, return two subscripts.
Example: (rmi2sub '(2 3) 5) => (1 2)"
(let ((m (car layout))
(n (cadr layout)))
(assert (< rmi (* m n)))
(multiple-value-bind (q r) (floor rmi n)
(list q r))))
(defun sub2rmi (layout subs)
"Take array dimensions and two subscripts, return an index in row-major order.
Example: (sub2rmi '(2 3) '(1 2)) => 5"
(let ((m (car layout))
(n (cadr layout))
(i (car subs))
(j (cadr subs)))
(assert (and (< i m) (< j n)))
(+ (* i n) j)))
(defun update-menu (menu event)
"Take a menu and an event, update in-place the current item of the menu."
;; we need to make menu special in order to setf i in the passed menu object.
(declare (special menu))
(with-accessors ((current-item-number current-item-number) (current-item current-item) (items items)
(cyclic-selection cyclic-selection-p) (layout layout) (scrolled-layout scrolled-layout)
(scrolled-region-start scrolled-region-start)) menu
(let ((i (car (rmi2sub layout current-item-number)))
(j (cadr (rmi2sub layout current-item-number)))
(m (car layout))
(n (cadr layout))
(m0 (car scrolled-region-start))
(n0 (cadr scrolled-region-start))
(m1 (car scrolled-layout))
(n1 (cadr scrolled-layout)))
(if scrolled-layout
;; when scrolling is on, the menu is not cycled.
(progn
(case event
(:up (when (> i 0) (decf i)) ; when not in first row, move one row up
(when (< i m0) (decf m0))) ; when above region, move region one row up
(:down (when (< i (1- m)) (incf i)) ; when not in last row, move one row down
(when (>= i (+ m0 m1)) (incf m0))) ; when below region, move region one row down
(:left (when (> j 0) (decf j)) ; when not in first column, move one column left
(when (< j n0) (decf n0))) ; when left of region, move region one column left
(:right (when (< j (1- n)) (incf j)) ; when not in last column, move one column right
(when (>= j (+ n0 n1)) (incf n0)))) ; when right of region, move region one column right
;; set new scrolled-region coordinates
(setf scrolled-region-start (list m0 n0)))
;; when scrolling is off, the menu can be cycled.
(if cyclic-selection
;; do cycle through the items
(case event
(:up (setf i (mod (1- i) m)))
(:down (setf i (mod (1+ i) m)))
(:left (setf j (mod (1- j) n)))
(:right (setf j (mod (1+ j) n))))
;; dont cycle through the items
(case event
(:up (setf i (max (1- i) 0)))
(:down (setf i (min (1+ i) (1- m))))
(:left (setf j (max (1- j) 0)))
(:right (setf j (min (1+ j) (1- n)))))))
;; after updating i,j, update the current-item-number
(setf current-item-number (sub2rmi layout (list i j)))
;; after updating the current-item-number, update the pointer to the current-item.
(setf current-item (nth current-item-number items)) )))
(defun format-menu-item (menu item-number)
"Take a menu and return item item-number as a properly formatted string.
If the menu is a checklist, return [ ] or [X] at the first position.
If a mark is set for the current item, display the mark at the second position.
Display the same number of spaces for other items.
At the third position, display the item given by item-number."
(with-accessors ((items items)
(type menu-type)
(current-item-number current-item-number)
(current-item-mark current-item-mark)) menu
;; return as string
(format nil "~A~A~A"
;; two types of menus: :selection or :checklist
;; show the checkbox before the item in checklists
(if (eq type :checklist)
(if (checkedp (nth item-number items)) "[X] " "[ ] ")
"")
;; for the current item, draw the current-item-mark
;; for all other items, draw a space
(if (= current-item-number item-number)
current-item-mark
(make-string (length current-item-mark) :initial-element #\space))
;; then add the item name
(name (nth item-number items)) )))
(defun draw-menu-item (win menu item-number i j)
"Draw the item given by item-number at item position (i j) in the window."
(with-accessors ((current-item-number current-item-number)
(current-item-location current-item-location)
(max-item-length max-item-length)
(menu-location menu-location)) menu
(let (pos-y
pos-x)
(if menu-location
;; add an offset when menu-location is given
(setq pos-y (+ i (car menu-location))
pos-x (+ (* j max-item-length) (cadr menu-location)))
;; if a location is not given, display the menu starting at 0,0
(setq pos-y i
pos-x (* j max-item-length)))
(move win pos-y pos-x)
;; save the location of the current item, to be used in update-cursor-position.
(when (= item-number current-item-number)
(setf current-item-location (list pos-y pos-x))))
;; if the item is the current item, change its attributes
(let ((attr (if (= item-number current-item-number)
(list :reverse)
nil)))
;; delete the item by overwriting it with an empty string.
(save-excursion win (add win #\space :n max-item-length))
(change-attributes win max-item-length attr)
;; format the item text
;; display it in the window associated with the menu
(add win (format-menu-item menu item-number) :attributes attr))))
;; draws to any window, not just to a sub-window of a menu-window.
(defun draw-menu (window menu)
"Draw the menu to the window."
(with-accessors ((layout layout) (scrolled-layout scrolled-layout) (scrolled-region-start scrolled-region-start)) menu
(let ((m (car layout))
(n (cadr layout))
(m0 (car scrolled-region-start))
(n0 (cadr scrolled-region-start))
(m1 (car scrolled-layout))
(n1 (cadr scrolled-layout)))
(if scrolled-layout
;; when the menu is too big to be displayed at once, only a part
;; is displayed, and the menu can be scrolled
(loop for i from 0 to (1- m1)
do (loop for j from 0 to (1- n1)
do (let ((item-number (sub2rmi layout (list (+ m0 i) (+ n0 j)))))
;; the menu is given as a flat list, so we have to access it as a 2d array in row major order
(draw-menu-item window menu item-number i j))))
;; when there is no scrolling, and the whole menu is displayed at once
(loop for i from 0 to (1- m)
do (loop for j from 0 to (1- n)
do (let ((item-number (sub2rmi layout (list i j))))
(draw-menu-item window menu item-number i j)))) ))
(refresh window)))
(defmethod draw ((menu menu))
"Draw the menu to its associated window."
(draw-menu (window menu) menu)
;; when menu is a part of a form:
;; update-cursor-position = place the cursor on the current item
;; if the menu is a checklist, place the cursor inside the [_], like it is done with a single checkbox.
(update-cursor-position menu))
(defmethod draw ((menu menu-window))
"Draw the menu-window."
(with-accessors ((title title) (name name) (border draw-border-p) (sub-win sub-window)) menu
;; draw the menu to the sub-window
(draw-menu sub-win menu)
;; we have to explicitely touch the background win, because otherwise it wont get refreshed.
(touch menu)
;; draw the title only when we also have a border, because we draw the title on top of the border.
(when (and border title)
;; make a format template depending on the length of the title.
;; "|~12:@<~A~>|"
(flet ((make-title-string (len)
(concatenate 'string "|~" (write-to-string (+ len 2)) ":@<~A~>|")))
;; If there is a title string, take it, otherwise take the name.
;; The name is displayed only if title is t.
(let* ((str (if (typep title 'string) title name))
(n (length str)))
(add menu (format nil (make-title-string n) str) :y 0 :x 2))))
;; todo: when we refresh a window with a subwin, we shouldnt have to refresh the subwin separately.
;; make refresh specialize on menu and decorated window in a way to do both.
(refresh menu)))
(defmethod draw ((menu dialog-window))
;; first draw a menu
;; TODO: describe what exactly is drawn here and what in the parent method.
(call-next-method)
;; then draw the message in the reserved space above the menu.
(with-accessors ((message-text message-text) (message-height message-height)
(message-pad message-pad) (coords message-pad-coordinates)) menu
;; if there is text, and there is space reserved for the text, draw the text
(when (and message-text (> message-height 0))
(refresh message-pad
0 ;pad-min-y
0 ;pad-min-x
(first coords) ;screen-min-y
(second coords) ;screen-min-x
(third coords) ;screen-max-y
(fourth coords))))) ;screen-max-x
(defun reset-menu (menu)
"After the menu is closed reset it to its initial state."
(with-slots (items current-item-number current-item scrolled-region-start menu-type) menu
(setf current-item-number 0
current-item (car items)
scrolled-region-start (list 0 0))
(when (eq menu-type :checklist)
(loop for i in items if (checkedp i) do (setf (checkedp i) nil)))))
(defun return-from-menu (menu return-value)
"Set menu window to invisible, refresh the window stack, return the value from select."
(when *window-stack*
;; change visibility only when there is an active stack.
(typecase menu
(menu-window (setf (visiblep menu) nil))
(menu (setf (visiblep (window menu)) nil)))
(refresh-stack))
(reset-menu menu)
(throw menu return-value))
(defun exit-menu-event-loop (menu event)
"Associate this function with an event to exit the menu event loop."
(declare (ignore event))
(return-from-menu menu nil))
(defun checked-items (menu)
"Take a menu, return a list of checked menu items."
(loop for i in (items menu) if (checkedp i) collect i))
(defmethod value ((menu menu))
"Return the value of the selected item."
(value (current-item menu)))
(defmethod value ((checklist checklist))
"Return the list of values of the checked items."
(mapcar #'value (checked-items checklist)))
(defun accept-selection (menu event)
"Return the value of the currently selected item or all checked items."
(declare (ignore event))
(case (menu-type menu)
(:checklist
;; return all checked items (not their values) in the item list.
(return-from-menu menu (checked-items menu)))
(:selection
(let ((val (value (current-item menu))))
(cond
;; if the item is a string or symbol, just return it.
((or (typep val 'string)
(typep val 'symbol))
(return-from-menu menu val))
;; if the item is a function object, call it.
((typep val 'function)
(funcall val)
(return-from-menu menu (name (current-item menu))))
;; if the item is a menu (and thus also a menu-window), recursively select an item from that submenu
((or (typep val 'menu)
(typep val 'menu-window))
(let ((selected-item (select val)))
;; when we have more than menu in one window, redraw the parent menu when we return from the submenu.
(when (eq (type-of val) 'menu)
(draw menu))
(when selected-item
(return-from-menu menu selected-item)))) )))))
(defun update-redraw-menu (menu event)
"Update the menu after an event, the redraw the menu."
(update-menu menu event)
(draw menu))
(defun toggle-item-checkbox (menu event)
"Toggle the checked state of the current item, used in checkbox menus."
(declare (ignore event))
(setf (checkedp (current-item menu)) (not (checkedp (current-item menu))))
(draw menu))
;; all of these take two arguments: menu event
(define-keymap 'menu-map
(list
;; q doesnt return a value, just nil, i.e. in the case of a checklist, an empty list.
#\q 'exit-menu-event-loop
#\x 'toggle-item-checkbox
:up 'update-redraw-menu
:down 'update-redraw-menu
:left 'update-redraw-menu
:right 'update-redraw-menu
;; there is no :default action, all other events are ignored for menus.
;; return the selected item or all checked items, then exit the menu like q.
#\newline 'accept-selection))
(defun select (menu)
"Display the menu, let the user select an item, return the selected item.
If the item is a menu object, recursively display the sub menu."
(typecase menu
(menu-window
(when *window-stack*
(setf (visiblep menu) t)
(refresh-stack))
(draw menu)
;; here we can pass the menu to run-event-loop because it is a menu-window.
;; all handler functions have to accept window and event as arguments.
;; the return value of select is the return value of run-event-loop
;; is the value thrown to the catch tag 'event-loop.
(run-event-loop menu))
(menu
(draw menu)
(run-event-loop menu))))

89
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/mouse.lisp Normal file
View file

@ -0,0 +1,89 @@
(in-package :de.anvi.croatoan)
(defparameter *mouse-button-event-bitmask-alist*
'((:released . #o01)
(:pressed . #o02)
(:clicked . #o04)
(:double-clicked . #o10)
(:triple-clicked . #o20)
(:reserved-event . #o40)))
(defmacro mouse-bitmask (button event)
(let ((*mouse-button-event-bitmask-alist*
'((:released . #o01)
(:pressed . #o02)
(:clicked . #o04)
(:double-clicked . #o10)
(:triple-clicked . #o20)
(:reserved-event . #o40))))
(cond ((integerp event) `(ash ,event (* 6 (- ,button 1))))
((symbolp event)
(let ((mask (cdr (assoc event *mouse-button-event-bitmask-alist*))))
`(ash ,mask (* 6 (- ,button 1))))))))
(defparameter *mouse-event-bitmask-alist*
`((:button-1-released . ,(mouse-bitmask 1 :released))
(:button-1-pressed . ,(mouse-bitmask 1 :pressed))
(:button-1-clicked . ,(mouse-bitmask 1 :clicked))
(:button-1-double-clicked . ,(mouse-bitmask 1 :double-clicked))
(:button-1-triple-clicked . ,(mouse-bitmask 1 :triple-clicked))
(:button-1-reserved-event . ,(mouse-bitmask 1 :reserved-event))
(:button-2-released . ,(mouse-bitmask 2 :released))
(:button-2-pressed . ,(mouse-bitmask 2 :pressed))
(:button-2-clicked . ,(mouse-bitmask 2 :clicked))
(:button-2-double-clicked . ,(mouse-bitmask 2 :double-clicked))
(:button-2-triple-clicked . ,(mouse-bitmask 2 :triple-clicked))
(:button-2-reserved-event . ,(mouse-bitmask 2 :reserved-event))
(:button-3-released . ,(mouse-bitmask 3 :released))
(:button-3-pressed . ,(mouse-bitmask 3 :pressed))
(:button-3-clicked . ,(mouse-bitmask 3 :clicked))
(:button-3-double-clicked . ,(mouse-bitmask 3 :double-clicked))
(:button-3-triple-clicked . ,(mouse-bitmask 3 :triple-clicked))
(:button-3-reserved-event . ,(mouse-bitmask 3 :reserved-event))
(:button-4-released . ,(mouse-bitmask 4 :released))
(:button-4-pressed . ,(mouse-bitmask 4 :pressed))
(:button-4-clicked . ,(mouse-bitmask 4 :clicked))
(:button-4-double-clicked . ,(mouse-bitmask 4 :double-clicked))
(:button-4-triple-clicked . ,(mouse-bitmask 4 :triple-clicked))
(:button-4-reserved-event . ,(mouse-bitmask 4 :reserved-event))
(:button-ctrl . ,(mouse-bitmask 5 #o01))
(:button-shift . ,(mouse-bitmask 5 #o02))
(:button-alt . ,(mouse-bitmask 5 #o04))
(:report-mouse-position . ,(mouse-bitmask 5 #o10))))
;; (:all-mouse-events . ,(- (mouse-bitmask 5 #o10) 1)
;; take a unsigned long integer representing a bitmask of mouse events,
;; return a list of mouse event keywords.
(defun bitmask-to-keyword (bitmask)
(loop for i in (mapcar #'car *mouse-event-bitmask-alist*)
if (logtest bitmask (cdr (assoc i *mouse-event-bitmask-alist*))) return i))
;; use collect to catch more than 1 event at once.
;; (format scr "~32,'0b" bitmask)
(defun keyword-to-bitmask (keys)
"Take a list of mouse event keywords, return a logiored bitmask."
(apply #'logior (mapcar #'(lambda (x) (cdr (assoc x *mouse-event-bitmask-alist*)))
keys)))
(defun set-mouse-event (keyword-list)
"Take a list of mouse events, activate tracking of those events.
Returns an integer bitmask. An empty list turns off mouse tracking."
(%mousemask (keyword-to-bitmask keyword-list) (null-pointer)))
;; decode and return the mouse event struct as multiple values:
;; mouse event keyword, y coordinate integer, x coordinate integer
(defun get-mouse-event ()
(flet ((plist-symbols-to-keywords (plist)
;; mem-ref returns a struct as a symbol plist.
;; we have to convert the symbols to keywords to transport them across packages.
(loop for i in plist collect (if (symbolp i) (values (intern (symbol-name i) "KEYWORD")) i))))
(with-foreign-object (ptr '(:struct mevent))
(%getmouse ptr)
(let* ((struct (plist-symbols-to-keywords (mem-ref ptr '(:struct mevent))))
(x (getf struct :x))
(y (getf struct :y))
(b (getf struct :bstate))
(mouse-event (bitmask-to-keyword b)))
(values mouse-event y x)))))

32
sbcl/.quicklisp/dists/quicklisp/software/croatoan-20191227-git/src/move.lisp Normal file
View file

@ -0,0 +1,32 @@
(in-package :de.anvi.croatoan)
(defun move (window y x &key relative)
"Move cursor to the position given by row y and column x.
If relative is t, move the cursor by y rows and x columns."
(let ((winptr (winptr window)))
(if relative
(let ((pos-y (car (cursor-position window)))
(pos-x (cadr (cursor-position window))))
(%wmove winptr (+ pos-y y) (+ pos-x x)))
(%wmove winptr y x))))
(defun move-direction (window direction &optional (n 1))
"Move cursor in the given direction by n cells."
(case direction
(:left (move window 0 (* n -1) :relative t))
(:right (move window 0 (* n 1) :relative t))
(:up (move window (* n -1) 0 :relative t))
(:down (move window (* n 1) 0 :relative t))
(otherwise (error "Valid cursor movement directions: :left, :right, :up, :down"))))
(defun move-window (window y x &key relative)
"Move top left corner of the window to row y and column x.
If relative is t, move the window by y rows and x columns."
(let ((winptr (winptr window)))
(if relative
(let ((pos-y (car (location window)))
(pos-x (cadr (location window))))
(%mvwin winptr (+ pos-y y) (+ pos-x x)))
(%mvwin winptr y x))))

Some files were not shown because too many files have changed in this diff Show more