1 | ;;;; ncurses.scm |
---|
2 | |
---|
3 | (declare |
---|
4 | (fixnum) |
---|
5 | (disable-interrupts) |
---|
6 | (hide check to-chtype) |
---|
7 | (foreign-declare "#include <ncurses.h>") ) |
---|
8 | |
---|
9 | (require-library easyffi) |
---|
10 | (require-library extras) |
---|
11 | |
---|
12 | (module |
---|
13 | ncurses |
---|
14 | |
---|
15 | (endwin |
---|
16 | initscr |
---|
17 | box |
---|
18 | copywin |
---|
19 | delwin |
---|
20 | addstr |
---|
21 | getbegyx |
---|
22 | getmaxyx |
---|
23 | getparyx |
---|
24 | getyx |
---|
25 | getsyx |
---|
26 | isendwin |
---|
27 | mvwin |
---|
28 | newpad |
---|
29 | pnoutrefresh |
---|
30 | prefresh |
---|
31 | subpad |
---|
32 | derwin |
---|
33 | newwin |
---|
34 | subwin |
---|
35 | overwrite |
---|
36 | overlay |
---|
37 | refresh |
---|
38 | wrefresh |
---|
39 | scr_dump |
---|
40 | scr_init |
---|
41 | scr_restore |
---|
42 | scr_set |
---|
43 | setsyx |
---|
44 | is_linetouched |
---|
45 | is_wintouched |
---|
46 | touchline |
---|
47 | touchwin |
---|
48 | untouchwin |
---|
49 | wtouchln |
---|
50 | leaveok |
---|
51 | move |
---|
52 | wmove |
---|
53 | mvcur |
---|
54 | doupdate |
---|
55 | refresh |
---|
56 | wnoutrefresh |
---|
57 | wrefresh |
---|
58 | addch |
---|
59 | mvaddch |
---|
60 | mvwaddch |
---|
61 | waddch |
---|
62 | addnstr |
---|
63 | addstr |
---|
64 | mvaddstr |
---|
65 | mvaddnstr |
---|
66 | mvwaddstr |
---|
67 | mvwaddnstr |
---|
68 | waddnstr |
---|
69 | waddstr |
---|
70 | clear |
---|
71 | erase |
---|
72 | wclear |
---|
73 | werase |
---|
74 | clearok |
---|
75 | idlok |
---|
76 | scrollok |
---|
77 | setscrreg |
---|
78 | wsetscrreg |
---|
79 | clrtobot |
---|
80 | wclrtobot |
---|
81 | clrtoeol |
---|
82 | wclrtoeol |
---|
83 | delch |
---|
84 | mvdelch |
---|
85 | mvwdelch |
---|
86 | wdelch |
---|
87 | getstr |
---|
88 | getnstr |
---|
89 | mvgetnstr |
---|
90 | mvgetstr |
---|
91 | wgetnstr |
---|
92 | mvwgetnstr |
---|
93 | mvwgetstr |
---|
94 | inch |
---|
95 | mvinch |
---|
96 | winch |
---|
97 | mvwinch |
---|
98 | insch |
---|
99 | mvinsch |
---|
100 | winsch |
---|
101 | mvwinsch |
---|
102 | deleteln |
---|
103 | wdeleteln |
---|
104 | echochar |
---|
105 | wechochar |
---|
106 | flushinp |
---|
107 | insertln |
---|
108 | winsertln |
---|
109 | keyname |
---|
110 | meta |
---|
111 | nodelay |
---|
112 | scrl |
---|
113 | scroll |
---|
114 | wscrl |
---|
115 | unctrl |
---|
116 | ungetch |
---|
117 | wgetch |
---|
118 | getch |
---|
119 | cbreak |
---|
120 | raw |
---|
121 | nocbreak |
---|
122 | noraw |
---|
123 | def_prog_mode |
---|
124 | def_shell_mode |
---|
125 | reset_prog_mode |
---|
126 | reset_shell_mode |
---|
127 | delay_output |
---|
128 | echo |
---|
129 | noecho |
---|
130 | halfdelay |
---|
131 | has_ic |
---|
132 | has_il |
---|
133 | longname |
---|
134 | nl |
---|
135 | nonl |
---|
136 | notimeout |
---|
137 | timeout |
---|
138 | wtimeout |
---|
139 | resetty |
---|
140 | savetty |
---|
141 | can_change_color |
---|
142 | COLOR_PAIR |
---|
143 | has_colors |
---|
144 | init_color |
---|
145 | init_pair |
---|
146 | pair_content |
---|
147 | PAIR_NUMBER |
---|
148 | start_color |
---|
149 | COLORS |
---|
150 | COLOR_PAIRS |
---|
151 | attron |
---|
152 | attroff |
---|
153 | attrset |
---|
154 | wattron |
---|
155 | wattroff |
---|
156 | wattrset |
---|
157 | beep |
---|
158 | curs_set |
---|
159 | flash |
---|
160 | intrflush |
---|
161 | keypad |
---|
162 | standout |
---|
163 | standend |
---|
164 | wstandout |
---|
165 | wstandend |
---|
166 | erasechar |
---|
167 | killchar |
---|
168 | stdscr |
---|
169 | curscr |
---|
170 | LINES |
---|
171 | COLS |
---|
172 | COLOR_BLACK |
---|
173 | COLOR_RED |
---|
174 | COLOR_GREEN |
---|
175 | COLOR_MAGENTA |
---|
176 | COLOR_YELLOW |
---|
177 | COLOR_BLUE |
---|
178 | COLOR_CYAN |
---|
179 | COLOR_WHITE |
---|
180 | A_NORMAL |
---|
181 | A_UNDERLINE |
---|
182 | A_REVERSE |
---|
183 | A_BLINK |
---|
184 | A_BOLD |
---|
185 | A_DIM |
---|
186 | A_ALTCHARSET |
---|
187 | A_INVIS |
---|
188 | A_ATTRIBUTES |
---|
189 | A_CHARTEXT |
---|
190 | A_COLOR |
---|
191 | A_STANDOUT |
---|
192 | A_PROTECT |
---|
193 | A_LEFT |
---|
194 | A_RIGHT |
---|
195 | A_LOW |
---|
196 | A_TOP |
---|
197 | A_VERTICAL |
---|
198 | ACS_ULCORNER |
---|
199 | ACS_LLCORNER |
---|
200 | ACS_URCORNER |
---|
201 | ACS_LRCORNER |
---|
202 | ACS_RTEE |
---|
203 | ACS_LTEE |
---|
204 | ACS_BTEE |
---|
205 | ACS_TTEE |
---|
206 | ACS_HLINE |
---|
207 | ACS_VLINE |
---|
208 | ACS_PLUS |
---|
209 | ACS_S1 |
---|
210 | ACS_S9 |
---|
211 | ACS_CKBOARD |
---|
212 | ACS_DEGREE |
---|
213 | ACS_DIAMOND |
---|
214 | ACS_PLMINUS |
---|
215 | ACS_BULLET |
---|
216 | ACS_LARROW |
---|
217 | ACS_RARROW |
---|
218 | ACS_DARROW |
---|
219 | ACS_UARROW |
---|
220 | ACS_LANTERN |
---|
221 | ACS_BLOCK |
---|
222 | KEY_CODE_YES |
---|
223 | KEY_MIN |
---|
224 | KEY_BREAK |
---|
225 | KEY_SRESET |
---|
226 | KEY_RESET |
---|
227 | KEY_DOWN |
---|
228 | KEY_UP |
---|
229 | KEY_LEFT |
---|
230 | KEY_RIGHT |
---|
231 | KEY_HOME |
---|
232 | KEY_BACKSPACE |
---|
233 | KEY_F0 |
---|
234 | KEY_DL |
---|
235 | KEY_IL |
---|
236 | KEY_DC |
---|
237 | KEY_IC |
---|
238 | KEY_EIC |
---|
239 | KEY_CLEAR |
---|
240 | KEY_EOS |
---|
241 | KEY_EOL |
---|
242 | KEY_SF |
---|
243 | KEY_SR |
---|
244 | KEY_NPAGE |
---|
245 | KEY_PPAGE |
---|
246 | KEY_STAB |
---|
247 | KEY_CTAB |
---|
248 | KEY_CATAB |
---|
249 | KEY_ENTER |
---|
250 | KEY_PRINT |
---|
251 | KEY_LL |
---|
252 | KEY_A1 |
---|
253 | KEY_A3 |
---|
254 | KEY_B2 |
---|
255 | KEY_C1 |
---|
256 | KEY_C3 |
---|
257 | KEY_BTAB |
---|
258 | KEY_BEG |
---|
259 | KEY_CANCEL |
---|
260 | KEY_CLOSE |
---|
261 | KEY_COMMAND |
---|
262 | KEY_COPY |
---|
263 | KEY_CREATE |
---|
264 | KEY_END |
---|
265 | KEY_EXIT |
---|
266 | KEY_FIND |
---|
267 | KEY_HELP |
---|
268 | KEY_MARK |
---|
269 | KEY_MESSAGE |
---|
270 | KEY_MOVE |
---|
271 | KEY_NEXT |
---|
272 | KEY_OPEN |
---|
273 | KEY_OPTIONS |
---|
274 | KEY_PREVIOUS |
---|
275 | KEY_REDO |
---|
276 | KEY_REFERENCE |
---|
277 | KEY_REFRESH |
---|
278 | KEY_REPLACE |
---|
279 | KEY_RESTART |
---|
280 | KEY_RESUME |
---|
281 | KEY_SAVE |
---|
282 | KEY_SBEG |
---|
283 | KEY_SCANCEL |
---|
284 | KEY_SCOMMAND |
---|
285 | KEY_SCOPY |
---|
286 | KEY_SCREATE |
---|
287 | KEY_SDC |
---|
288 | KEY_SDL |
---|
289 | KEY_SELECT |
---|
290 | KEY_SEND |
---|
291 | KEY_SEOL |
---|
292 | KEY_SEXIT |
---|
293 | KEY_SFIND |
---|
294 | KEY_SHELP |
---|
295 | KEY_SHOME |
---|
296 | KEY_SIC |
---|
297 | KEY_SLEFT |
---|
298 | KEY_SMESSAGE |
---|
299 | KEY_SMOVE |
---|
300 | KEY_SNEXT |
---|
301 | KEY_SOPTIONS |
---|
302 | KEY_SPREVIOUS |
---|
303 | KEY_SPRINT |
---|
304 | KEY_SREDO |
---|
305 | KEY_SREPLACE |
---|
306 | KEY_SRIGHT |
---|
307 | KEY_SRSUME |
---|
308 | KEY_SSAVE |
---|
309 | KEY_SSUSPEND |
---|
310 | KEY_SUNDO |
---|
311 | KEY_SUSPEND |
---|
312 | KEY_UNDO |
---|
313 | KEY_MOUSE |
---|
314 | KEY_RESIZE |
---|
315 | KEY_F |
---|
316 | printw |
---|
317 | wprintw |
---|
318 | mvprintw |
---|
319 | mvwprintw |
---|
320 | border |
---|
321 | wborder |
---|
322 | hline |
---|
323 | whline |
---|
324 | vline |
---|
325 | wvline |
---|
326 | mvhline |
---|
327 | mvwhline |
---|
328 | mvvline |
---|
329 | mvwvline) |
---|
330 | |
---|
331 | (import scheme) |
---|
332 | (import chicken) |
---|
333 | (import foreign) |
---|
334 | (import extras) |
---|
335 | (import easyffi) |
---|
336 | |
---|
337 | (define-foreign-variable OK int) |
---|
338 | (define-foreign-variable ERR int) |
---|
339 | |
---|
340 | (define (check code) |
---|
341 | (when (eq? code ERR) |
---|
342 | (signal |
---|
343 | (make-composite-condition |
---|
344 | (make-property-condition 'exn 'message "curses error") |
---|
345 | (make-property-condition 'curses) ) ) ) ) |
---|
346 | |
---|
347 | (define (to-chtype x) |
---|
348 | (if (char? x) |
---|
349 | (char->integer x) |
---|
350 | x) ) |
---|
351 | |
---|
352 | (define-foreign-type ptr c-pointer) |
---|
353 | (define-foreign-type err int #f check) |
---|
354 | (define-foreign-type chtype int to-chtype integer->char) |
---|
355 | (define-foreign-type rchtype int to-chtype) |
---|
356 | (define-foreign-type win (pointer "WINDOW")) |
---|
357 | |
---|
358 | (define-syntax def |
---|
359 | (lambda (sexp r c) |
---|
360 | (let* ((rt-sexp (cadr sexp)) |
---|
361 | (name-sexp (caddr sexp)) |
---|
362 | (name-string (->string (strip-syntax name-sexp))) |
---|
363 | (ats-sexp (cdddr sexp)) |
---|
364 | (%define (r 'define)) |
---|
365 | (%foreign-lambda (r 'foreign-lambda))) |
---|
366 | `(,%define ,name-sexp |
---|
367 | (,%foreign-lambda ,rt-sexp ,name-string ,@ats-sexp))))) |
---|
368 | |
---|
369 | (define-syntax defv |
---|
370 | (lambda (sexp r c) |
---|
371 | (let* ((rt-sexp (cadr sexp)) |
---|
372 | (name-sexp (caddr sexp)) |
---|
373 | (name-string (->string (strip-syntax name-sexp))) |
---|
374 | (%tmp (r 'tmp)) |
---|
375 | (%begin (r 'begin)) |
---|
376 | (%define-foreign-variable (r 'define-foreign-variable)) |
---|
377 | (%define (r 'define))) |
---|
378 | `(,%begin |
---|
379 | (,%define-foreign-variable ,%tmp ,rt-sexp ,name-string) |
---|
380 | (,%define (,name-sexp) ,%tmp))))) |
---|
381 | |
---|
382 | (define-syntax defc |
---|
383 | (lambda (sexp r c) |
---|
384 | (let* ((rt-sexp (cadr sexp)) |
---|
385 | (name-sexp (caddr sexp)) |
---|
386 | (name-string (->string (strip-syntax name-sexp))) |
---|
387 | (%tmp (r 'tmp)) |
---|
388 | (%begin (r 'begin)) |
---|
389 | (%define-foreign-variable (r 'define-foreign-variable)) |
---|
390 | (%define (r 'define))) |
---|
391 | `(,%begin |
---|
392 | (,%define-foreign-variable ,%tmp ,rt-sexp ,name-string) |
---|
393 | (,%define ,name-sexp ,%tmp))))) |
---|
394 | |
---|
395 | (def err endwin) |
---|
396 | (def ptr initscr) |
---|
397 | ; newterm |
---|
398 | (def err box ptr chtype chtype) |
---|
399 | (def err copywin ptr ptr int int int int int int bool) |
---|
400 | (def err delwin ptr) |
---|
401 | |
---|
402 | (define-syntax getpos |
---|
403 | (lambda (sexp r c) |
---|
404 | (let ((m-sexp (cadr sexp)) |
---|
405 | (%define (r 'define)) |
---|
406 | (%lambda (r 'lambda)) |
---|
407 | (%let (r 'let)) |
---|
408 | (%get (r 'get)) |
---|
409 | (%foreign-lambda* (r 'foreign-lambda*)) |
---|
410 | (%void (r 'void)) |
---|
411 | (%pointer (r 'pointer)) |
---|
412 | (%int (r 'int)) |
---|
413 | (%sprintf (r 'sprintf)) |
---|
414 | (%let-location (r 'let-location)) |
---|
415 | (%location (r 'location)) |
---|
416 | (%values (r 'values))) |
---|
417 | `(,%define ,m-sexp |
---|
418 | (,%let ([,%get (,%foreign-lambda* |
---|
419 | ;; ISSUE: renaming the void return type doesn't seem to work. |
---|
420 | ;; ,%void |
---|
421 | void |
---|
422 | ([(,%pointer ,%int) yp] [(,%pointer ,%int) xp]) |
---|
423 | ,(sprintf "int y, x; ~A(y, x); *yp = y; *xp = x;" (strip-syntax m-sexp)))]) |
---|
424 | (,%lambda () |
---|
425 | (,%let-location ([y ,%int] [x ,%int]) |
---|
426 | (,%get (,%location y) (,%location x)) |
---|
427 | (,%values y x)))))))) |
---|
428 | |
---|
429 | (define-syntax wgetpos |
---|
430 | (lambda (sexp r c) |
---|
431 | (let ((m-sexp (cadr sexp)) |
---|
432 | (%define (r 'define)) |
---|
433 | (%get (r 'get)) |
---|
434 | (%void (r 'void)) |
---|
435 | (%win (r 'win)) |
---|
436 | (%pointer (r 'pointer)) |
---|
437 | (%int (r 'int)) |
---|
438 | (%lambda (r 'lambda)) |
---|
439 | (%let-location (r 'let-location)) |
---|
440 | (%location (r 'location)) |
---|
441 | (%values (r 'values)) |
---|
442 | (%foreign-lambda* (r 'foreign-lambda*)) |
---|
443 | (%let (r 'let))) |
---|
444 | `(,%define ,m-sexp |
---|
445 | ;; ISSUE: renaming the void return type doesn't seem to work. |
---|
446 | ;; (,%let ([,%get (,%foreign-lambda* ,%void ([,%win w] [(,%pointer ,%int) yp] [(,%pointer ,%int) xp]) |
---|
447 | (,%let ([,%get (,%foreign-lambda* void ([,%win w] [(,%pointer ,%int) yp] [(,%pointer ,%int) xp]) |
---|
448 | ,(sprintf "int y, x; ~A(w, y, x); *yp = y; *xp = x;" (strip-syntax m-sexp)))]) |
---|
449 | (,%lambda (w) |
---|
450 | (,%let-location ([y ,%int] [x ,%int]) |
---|
451 | (,%get w (,%location y) (,%location x)) |
---|
452 | (,%values y x)))))))) |
---|
453 | |
---|
454 | (wgetpos getbegyx) |
---|
455 | (wgetpos getmaxyx) |
---|
456 | (wgetpos getparyx) |
---|
457 | (wgetpos getyx) |
---|
458 | |
---|
459 | (getpos getsyx) |
---|
460 | |
---|
461 | (def bool isendwin) |
---|
462 | (def err mvwin win int int) |
---|
463 | (def ptr newpad int int) |
---|
464 | (def err pnoutrefresh win int int int int int int) |
---|
465 | (def err prefresh win int int int int int int) |
---|
466 | (def ptr subpad ptr int int int int) |
---|
467 | (def win derwin win int int int int) |
---|
468 | (def win newwin int int int int) |
---|
469 | (def win subwin win int int int int) |
---|
470 | (def err overwrite win win) |
---|
471 | (def err overlay win win) |
---|
472 | (def void refresh) |
---|
473 | (def void wrefresh win) |
---|
474 | (def err scr_dump c-string) |
---|
475 | (def err scr_init c-string) |
---|
476 | (def err scr_restore c-string) |
---|
477 | (def err scr_set c-string) |
---|
478 | (def void setsyx int int) |
---|
479 | (def bool is_linetouched win int) |
---|
480 | (def bool is_wintouched win) |
---|
481 | (def err touchline win int int) |
---|
482 | (def err touchwin win) |
---|
483 | (def err untouchwin win) |
---|
484 | (def err wtouchln win int int bool) |
---|
485 | (def void leaveok win bool) |
---|
486 | (def err move int int) |
---|
487 | (def err wmove win int int) |
---|
488 | (def err mvcur int int int int) |
---|
489 | (def err doupdate) |
---|
490 | (def err refresh) |
---|
491 | (def err wnoutrefresh win) |
---|
492 | (def err wrefresh win) |
---|
493 | (def err addch chtype) |
---|
494 | (def err mvaddch int int chtype) |
---|
495 | (def err mvwaddch win int int chtype) |
---|
496 | (def err waddch win chtype) |
---|
497 | (def err addnstr c-string int) |
---|
498 | (def err addstr c-string) |
---|
499 | (def err mvaddstr int int c-string) |
---|
500 | (def err mvaddnstr int int c-string int) |
---|
501 | (def err mvwaddstr win int int c-string) |
---|
502 | (def err mvwaddnstr win int int c-string int) |
---|
503 | (def err waddnstr win c-string int) |
---|
504 | (def err waddstr win c-string) |
---|
505 | (def err clear) |
---|
506 | (def err erase) |
---|
507 | (def err wclear win) |
---|
508 | (def err werase win) |
---|
509 | (def err clearok win bool) |
---|
510 | (def err idlok win bool) |
---|
511 | (def err scrollok win bool) |
---|
512 | (def err setscrreg int int) |
---|
513 | (def err wsetscrreg win int int) |
---|
514 | (def err clrtobot) |
---|
515 | (def err wclrtobot win) |
---|
516 | (def err clrtoeol) |
---|
517 | (def err wclrtoeol win) |
---|
518 | (def err delch) |
---|
519 | (def err mvdelch int int) |
---|
520 | (def void mvwdelch win int int) |
---|
521 | (def void wdelch win) |
---|
522 | (def err getstr pointer) |
---|
523 | (def err getnstr pointer int) |
---|
524 | (def err mvgetnstr int int pointer int) |
---|
525 | (def err mvgetstr int int pointer) |
---|
526 | (def err wgetnstr win pointer int) |
---|
527 | (def err mvwgetnstr win int int pointer int) |
---|
528 | (def err mvwgetstr win int int pointer) |
---|
529 | (def chtype inch) |
---|
530 | (def chtype mvinch int int) |
---|
531 | (def chtype winch win) |
---|
532 | (def chtype mvwinch win int int) |
---|
533 | (def chtype insch chtype) |
---|
534 | (def chtype mvinsch int int chtype) |
---|
535 | (def chtype winsch win chtype) |
---|
536 | (def chtype mvwinsch win int int chtype) |
---|
537 | (def err deleteln) |
---|
538 | (def err wdeleteln win) |
---|
539 | (def err echochar chtype) |
---|
540 | (def err wechochar win chtype) |
---|
541 | (def void flushinp) |
---|
542 | (def err insertln) |
---|
543 | (def err winsertln win) |
---|
544 | (def c-string keyname int) |
---|
545 | (def err meta win bool) |
---|
546 | (def err nodelay win bool) |
---|
547 | ; scanw, wscanw, mvscanw, mvwscanw |
---|
548 | (def err scrl int) |
---|
549 | (def err scroll win) |
---|
550 | (def err wscrl win int) |
---|
551 | (def c-string unctrl chtype) |
---|
552 | (def void ungetch int) |
---|
553 | (def chtype wgetch win) |
---|
554 | (define (getch) (wgetch (stdscr))) |
---|
555 | (def err cbreak) |
---|
556 | (def err raw) |
---|
557 | (def err nocbreak) |
---|
558 | (def err noraw) |
---|
559 | (def err def_prog_mode) |
---|
560 | (def err def_shell_mode) |
---|
561 | (def err reset_prog_mode) |
---|
562 | (def err reset_shell_mode) |
---|
563 | ; del_curterm, restartterm, set_curterm, setupterm |
---|
564 | (def err delay_output int) |
---|
565 | (def err echo) |
---|
566 | (def err noecho) |
---|
567 | ; garbagedlines |
---|
568 | (def err halfdelay int) |
---|
569 | (def bool has_ic) |
---|
570 | (def bool has_il) |
---|
571 | (def c-string longname) |
---|
572 | (def err nl) |
---|
573 | (def err nonl) |
---|
574 | (def err notimeout win bool) |
---|
575 | (def void timeout int) |
---|
576 | (def void wtimeout win int) |
---|
577 | ; tputs |
---|
578 | (def err resetty) |
---|
579 | (def err savetty) |
---|
580 | ; ripoffline |
---|
581 | ; tgetent, tgetflag, tgetnum, tgetstr, tgoto, tigetflag, tigetnum, tigetstr, tparm |
---|
582 | (def bool can_change_color) |
---|
583 | ; color_content |
---|
584 | (def int COLOR_PAIR int) |
---|
585 | (def bool has_colors) |
---|
586 | (def err init_color short short short short) |
---|
587 | (def err init_pair short short short) |
---|
588 | |
---|
589 | (define pair_content |
---|
590 | (let ([content (foreign-lambda err "pair_content" short (pointer short) (pointer short))]) |
---|
591 | (lambda (c) |
---|
592 | (let-location ([f short] [b short]) |
---|
593 | (content c (location f) (location b)) |
---|
594 | (values f b) ) ) ) ) |
---|
595 | |
---|
596 | (def int PAIR_NUMBER int) |
---|
597 | (def err start_color) |
---|
598 | |
---|
599 | (defv int COLORS) |
---|
600 | (defv int COLOR_PAIRS) |
---|
601 | |
---|
602 | (def err attron int) |
---|
603 | (def err attroff int) |
---|
604 | (def err attrset int) |
---|
605 | (def err wattron win int) |
---|
606 | (def err wattroff win int) |
---|
607 | (def err wattrset win int) |
---|
608 | (def void beep) |
---|
609 | (def err curs_set int) |
---|
610 | (def void flash) |
---|
611 | (def err intrflush win bool) |
---|
612 | (def err keypad win bool) |
---|
613 | (def void standout) |
---|
614 | (def void standend) |
---|
615 | (def void wstandout win) |
---|
616 | (def void wstandend win) |
---|
617 | ; typeahead |
---|
618 | ; vidattr, vid_attr, vidputs, vid_puts |
---|
619 | ; slk_attroff, slk_attr_off, slk_attron, slk_attr_on, slk_attrset, slk_attr_set, slk_clear,, slk_color, slk_init, slk_label |
---|
620 | ; slk_noutrefresh, slk_refresh, slk_restore, slk_set, slk_touch, slk_wset |
---|
621 | ; baudrate |
---|
622 | (def char erasechar) |
---|
623 | (def char killchar) |
---|
624 | ; erasewchar, killwchar |
---|
625 | ; filter |
---|
626 | (defv win stdscr) |
---|
627 | (defv win curscr) |
---|
628 | (defv int LINES) |
---|
629 | (defv int COLS) |
---|
630 | |
---|
631 | (defc int COLOR_BLACK) |
---|
632 | (defc int COLOR_RED) |
---|
633 | (defc int COLOR_GREEN) |
---|
634 | (defc int COLOR_MAGENTA) |
---|
635 | (defc int COLOR_YELLOW) |
---|
636 | (defc int COLOR_BLUE) |
---|
637 | (defc int COLOR_CYAN) |
---|
638 | (defc int COLOR_WHITE) |
---|
639 | |
---|
640 | (defc int A_NORMAL) |
---|
641 | (defc int A_UNDERLINE) |
---|
642 | (defc int A_REVERSE) |
---|
643 | (defc int A_BLINK) |
---|
644 | (defc int A_BOLD) |
---|
645 | (defc int A_DIM) |
---|
646 | (defc int A_ALTCHARSET) |
---|
647 | (defc int A_INVIS) |
---|
648 | (defc int A_ATTRIBUTES) |
---|
649 | (defc int A_CHARTEXT) |
---|
650 | (defc int A_COLOR) |
---|
651 | (defc int A_STANDOUT) |
---|
652 | (defc int A_PROTECT) |
---|
653 | (defc int A_LEFT) |
---|
654 | (defc int A_RIGHT) |
---|
655 | (defc int A_LOW) |
---|
656 | (defc int A_TOP) |
---|
657 | (defc int A_VERTICAL) |
---|
658 | |
---|
659 | (defv rchtype ACS_ULCORNER) |
---|
660 | (defv rchtype ACS_LLCORNER) |
---|
661 | (defv rchtype ACS_URCORNER) |
---|
662 | (defv rchtype ACS_LRCORNER) |
---|
663 | (defv rchtype ACS_RTEE) |
---|
664 | (defv rchtype ACS_LTEE) |
---|
665 | (defv rchtype ACS_BTEE) |
---|
666 | (defv rchtype ACS_TTEE) |
---|
667 | (defv rchtype ACS_HLINE) |
---|
668 | (defv rchtype ACS_VLINE) |
---|
669 | (defv rchtype ACS_PLUS) |
---|
670 | |
---|
671 | (defv rchtype ACS_S1) |
---|
672 | (defv rchtype ACS_S9) |
---|
673 | (defv rchtype ACS_CKBOARD) |
---|
674 | (defv rchtype ACS_DEGREE) |
---|
675 | (defv rchtype ACS_DIAMOND) |
---|
676 | (defv rchtype ACS_PLMINUS) |
---|
677 | (defv rchtype ACS_BULLET) |
---|
678 | (defv rchtype ACS_LARROW) |
---|
679 | (defv rchtype ACS_RARROW) |
---|
680 | (defv rchtype ACS_DARROW) |
---|
681 | (defv rchtype ACS_UARROW) |
---|
682 | (defv rchtype ACS_LANTERN) |
---|
683 | (defv rchtype ACS_BLOCK) |
---|
684 | |
---|
685 | (foreign-parse #<<EOF |
---|
686 | ___declare(export_constants, yes) |
---|
687 | #define KEY_CODE_YES 0400 /* A wchar_t contains a key code */ |
---|
688 | #define KEY_MIN 0401 /* Minimum curses key */ |
---|
689 | #define KEY_BREAK 0401 /* Break key (unreliable) */ |
---|
690 | #define KEY_SRESET 0530 /* Soft (partial) reset (unreliable) */ |
---|
691 | #define KEY_RESET 0531 /* Reset or hard reset (unreliable) */ |
---|
692 | /* |
---|
693 | * These definitions were generated by ./MKkey_defs.sh ./Caps |
---|
694 | */ |
---|
695 | #define KEY_DOWN 0402 /* down-arrow key */ |
---|
696 | #define KEY_UP 0403 /* up-arrow key */ |
---|
697 | #define KEY_LEFT 0404 /* left-arrow key */ |
---|
698 | #define KEY_RIGHT 0405 /* right-arrow key */ |
---|
699 | #define KEY_HOME 0406 /* home key */ |
---|
700 | #define KEY_BACKSPACE 0407 /* backspace key */ |
---|
701 | #define KEY_F0 0410 /* Function keys. Space for 64 */ |
---|
702 | #define KEY_DL 0510 /* delete-line key */ |
---|
703 | #define KEY_IL 0511 /* insert-line key */ |
---|
704 | #define KEY_DC 0512 /* delete-character key */ |
---|
705 | #define KEY_IC 0513 /* insert-character key */ |
---|
706 | #define KEY_EIC 0514 /* sent by rmir or smir in insert mode */ |
---|
707 | #define KEY_CLEAR 0515 /* clear-screen or erase key */ |
---|
708 | #define KEY_EOS 0516 /* clear-to-end-of-screen key */ |
---|
709 | #define KEY_EOL 0517 /* clear-to-end-of-line key */ |
---|
710 | #define KEY_SF 0520 /* scroll-forward key */ |
---|
711 | #define KEY_SR 0521 /* scroll-backward key */ |
---|
712 | #define KEY_NPAGE 0522 /* next-page key */ |
---|
713 | #define KEY_PPAGE 0523 /* previous-page key */ |
---|
714 | #define KEY_STAB 0524 /* set-tab key */ |
---|
715 | #define KEY_CTAB 0525 /* clear-tab key */ |
---|
716 | #define KEY_CATAB 0526 /* clear-all-tabs key */ |
---|
717 | #define KEY_ENTER 0527 /* enter/send key */ |
---|
718 | #define KEY_PRINT 0532 /* print key */ |
---|
719 | #define KEY_LL 0533 /* lower-left key (home down) */ |
---|
720 | #define KEY_A1 0534 /* upper left of keypad */ |
---|
721 | #define KEY_A3 0535 /* upper right of keypad */ |
---|
722 | #define KEY_B2 0536 /* center of keypad */ |
---|
723 | #define KEY_C1 0537 /* lower left of keypad */ |
---|
724 | #define KEY_C3 0540 /* lower right of keypad */ |
---|
725 | #define KEY_BTAB 0541 /* back-tab key */ |
---|
726 | #define KEY_BEG 0542 /* begin key */ |
---|
727 | #define KEY_CANCEL 0543 /* cancel key */ |
---|
728 | #define KEY_CLOSE 0544 /* close key */ |
---|
729 | #define KEY_COMMAND 0545 /* command key */ |
---|
730 | #define KEY_COPY 0546 /* copy key */ |
---|
731 | #define KEY_CREATE 0547 /* create key */ |
---|
732 | #define KEY_END 0550 /* end key */ |
---|
733 | #define KEY_EXIT 0551 /* exit key */ |
---|
734 | #define KEY_FIND 0552 /* find key */ |
---|
735 | #define KEY_HELP 0553 /* help key */ |
---|
736 | #define KEY_MARK 0554 /* mark key */ |
---|
737 | #define KEY_MESSAGE 0555 /* message key */ |
---|
738 | #define KEY_MOVE 0556 /* move key */ |
---|
739 | #define KEY_NEXT 0557 /* next key */ |
---|
740 | #define KEY_OPEN 0560 /* open key */ |
---|
741 | #define KEY_OPTIONS 0561 /* options key */ |
---|
742 | #define KEY_PREVIOUS 0562 /* previous key */ |
---|
743 | #define KEY_REDO 0563 /* redo key */ |
---|
744 | #define KEY_REFERENCE 0564 /* reference key */ |
---|
745 | #define KEY_REFRESH 0565 /* refresh key */ |
---|
746 | #define KEY_REPLACE 0566 /* replace key */ |
---|
747 | #define KEY_RESTART 0567 /* restart key */ |
---|
748 | #define KEY_RESUME 0570 /* resume key */ |
---|
749 | #define KEY_SAVE 0571 /* save key */ |
---|
750 | #define KEY_SBEG 0572 /* shifted begin key */ |
---|
751 | #define KEY_SCANCEL 0573 /* shifted cancel key */ |
---|
752 | #define KEY_SCOMMAND 0574 /* shifted command key */ |
---|
753 | #define KEY_SCOPY 0575 /* shifted copy key */ |
---|
754 | #define KEY_SCREATE 0576 /* shifted create key */ |
---|
755 | #define KEY_SDC 0577 /* shifted delete-character key */ |
---|
756 | #define KEY_SDL 0600 /* shifted delete-line key */ |
---|
757 | #define KEY_SELECT 0601 /* select key */ |
---|
758 | #define KEY_SEND 0602 /* shifted end key */ |
---|
759 | #define KEY_SEOL 0603 /* shifted clear-to-end-of-line key */ |
---|
760 | #define KEY_SEXIT 0604 /* shifted exit key */ |
---|
761 | #define KEY_SFIND 0605 /* shifted find key */ |
---|
762 | #define KEY_SHELP 0606 /* shifted help key */ |
---|
763 | #define KEY_SHOME 0607 /* shifted home key */ |
---|
764 | #define KEY_SIC 0610 /* shifted insert-character key */ |
---|
765 | #define KEY_SLEFT 0611 /* shifted left-arrow key */ |
---|
766 | #define KEY_SMESSAGE 0612 /* shifted message key */ |
---|
767 | #define KEY_SMOVE 0613 /* shifted move key */ |
---|
768 | #define KEY_SNEXT 0614 /* shifted next key */ |
---|
769 | #define KEY_SOPTIONS 0615 /* shifted options key */ |
---|
770 | #define KEY_SPREVIOUS 0616 /* shifted previous key */ |
---|
771 | #define KEY_SPRINT 0617 /* shifted print key */ |
---|
772 | #define KEY_SREDO 0620 /* shifted redo key */ |
---|
773 | #define KEY_SREPLACE 0621 /* shifted replace key */ |
---|
774 | #define KEY_SRIGHT 0622 /* shifted right-arrow key */ |
---|
775 | #define KEY_SRSUME 0623 /* shifted resume key */ |
---|
776 | #define KEY_SSAVE 0624 /* shifted save key */ |
---|
777 | #define KEY_SSUSPEND 0625 /* shifted suspend key */ |
---|
778 | #define KEY_SUNDO 0626 /* shifted undo key */ |
---|
779 | #define KEY_SUSPEND 0627 /* suspend key */ |
---|
780 | #define KEY_UNDO 0630 /* undo key */ |
---|
781 | #define KEY_MOUSE 0631 /* Mouse event has occurred */ |
---|
782 | #define KEY_RESIZE 0632 /* Terminal resize event */ |
---|
783 | EOF |
---|
784 | ) |
---|
785 | |
---|
786 | (define (KEY_F n) (+ KEY_F0 n)) |
---|
787 | |
---|
788 | (define (printw . args) (addstr (apply sprintf args))) |
---|
789 | (define (wprintw w . args) (waddstr w (apply sprintf args))) |
---|
790 | (define (mvprintw y x . args) (mvaddstr y x (apply sprintf args))) |
---|
791 | (define (mvwprintw w y x . args) (mvwaddstr w y x (apply sprintf args))) |
---|
792 | |
---|
793 | ;;; Suggested by anonymous contributor: |
---|
794 | |
---|
795 | (def err border chtype chtype chtype chtype chtype chtype chtype chtype) |
---|
796 | (def err wborder win chtype chtype chtype chtype chtype chtype chtype chtype) |
---|
797 | (def err hline chtype int) |
---|
798 | (def err whline win chtype int) |
---|
799 | (def err vline chtype int) |
---|
800 | (def err wvline win chtype int) |
---|
801 | (def err mvhline int int chtype int) |
---|
802 | (def err mvwhline win int int chtype int) |
---|
803 | (def err mvvline int int chtype int) |
---|
804 | (def err mvwvline win int int chtype int) |
---|
805 | ) |
---|