S9fES Curses interface

Location: curses, 52 Lines

; Scheme 9 from Empty Space, Curses Function Library
; By Nils M Holm, 2010,2012
; Placed in the Public Domain
;
; (curs:attron integer)   ==>  unspecific
; (curs:attroff integer)  ==>  unspecific
; (curs:standout)         ==>  unspecific
; (curs:standend)         ==>  unspecific
;
; An interface to some curses routines.

(require-extension curses)

(load-from-library "bitops.scm")

(define curs:attr-normal    (curs:get-magic-value "A_NORMAL"))
(define curs:attr-standout  (curs:get-magic-value "A_STANDOUT"))
(define curs:attr-underline (curs:get-magic-value "A_UNDERLINE"))
(define curs:attr-bold      (curs:get-magic-value "A_BOLD"))

(define curs:key-backspace (curs:get-magic-value "KEY_BACKSPACE"))
(define curs:key-dc        (curs:get-magic-value "KEY_DC"))
(define curs:key-ic        (curs:get-magic-value "KEY_IC"))
(define curs:key-up        (curs:get-magic-value "KEY_UP"))
(define curs:key-down      (curs:get-magic-value "KEY_DOWN"))
(define curs:key-left      (curs:get-magic-value "KEY_LEFT"))
(define curs:key-right     (curs:get-magic-value "KEY_RIGHT"))
(define curs:key-home      (curs:get-magic-value "KEY_HOME"))
(define curs:key-end       (curs:get-magic-value "KEY_END"))
(define curs:key-ppage     (curs:get-magic-value "KEY_PPAGE"))
(define curs:key-npage     (curs:get-magic-value "KEY_NPAGE"))

(define curs:color-black   0)
(define curs:color-blue    1)
(define curs:color-green   2)
(define curs:color-cyan    3)
(define curs:color-red     4)
(define curs:color-magenta 5)
(define curs:color-yellow  6)
(define curs:color-gray    7)

(define old-attrset curs:attrset)
(define curs:attributes 0)

(define curs:attrset
  (let ((old-attrset old-attrset))
    (lambda (attr)
      (old-attrset attr)
      (set! curs:attributes attr))))

(define (curs:attron attr)
  (curs:attrset (bit+ attr curs:attributes)))

(define (curs:attroff attr)
  (curs:attrset (bit*c curs:attributes attr)))

(define (curs:standout)
  (curs:attrset curs:attr-standout))

(define (curs:standend)
  (curs:attrset curs:attr-normal))

(define (curses:curses) #t)