| 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 | )
|
|---|