1611 lines
35 KiB
Scheme
Executable File
1611 lines
35 KiB
Scheme
Executable File
|
|
;;record-types:
|
|
;;dienen dazu, C-Pointer zu verpacken.
|
|
|
|
;;window
|
|
(define-record-type :window window
|
|
(make-window c-pointer)
|
|
window?
|
|
(c-pointer window-c-pointer))
|
|
|
|
;; screen
|
|
(define-record-type :screen screen
|
|
(make-screen c-pointer)
|
|
screen?
|
|
(c-pointer screen-c-pointer))
|
|
|
|
;;*************************************************************************
|
|
|
|
;;Konstanten:
|
|
|
|
|
|
(define err -1)
|
|
|
|
|
|
|
|
|
|
;;Fehlerbehandlung:
|
|
;;Es kommt bei Funktionen mit Integer als Rückgabe im Fehlerfall
|
|
;;ERR zurück. Dann wird ein Fehler ausgelöst. Gleiches gilt, wenn
|
|
;;ein NULL-Pointer zurückkommt.
|
|
|
|
(define-condition-type 'curses-error '(error))
|
|
|
|
(define curses-error?
|
|
(condition-predicate 'curses-error))
|
|
|
|
|
|
;;OK ist 0
|
|
;;Funktionen, die int nur zur Fehlerbehandlung zurueckgeben
|
|
(define (return-curses-code-int function-name code)
|
|
(if (zero? code)
|
|
(values)
|
|
(signal 'curses-error function-name)))
|
|
|
|
(define (raise-curses-error function-name)
|
|
(signal 'curses-error function-name))
|
|
|
|
(define (raise-curses-noinit-error)
|
|
(signal 'curses-error "use init-screen first"))
|
|
|
|
|
|
(define standard-screen)
|
|
|
|
(import-lambda-definition set-stdscr-internal
|
|
()
|
|
"scsh_stdscr")
|
|
|
|
(define set-standard-screen
|
|
(lambda ()
|
|
(set! standard-screen (make-window (set-stdscr-internal)))))
|
|
|
|
;;*********************************************************************
|
|
;;Bibliotheks-Funktionen
|
|
;;*********************************************************************
|
|
|
|
;; ALLGEMEINE
|
|
;;Initialisierung
|
|
;;initscr liefert einen Zeiger auf stdscr
|
|
(import-lambda-definition init-screen-internal
|
|
()
|
|
"scsh_initscr")
|
|
(define init-screen
|
|
(lambda ()
|
|
(define res (init-screen-internal))
|
|
(begin (set-standard-screen)
|
|
(make-window (or res
|
|
(raise-curses-error "init-screen"))))))
|
|
;; (if )))
|
|
;; (make-window
|
|
;; (or (init-screen-internal)
|
|
;; (raise-curses-error "init-screen")))))
|
|
|
|
(import-lambda-definition newterm-internal
|
|
(type outfd infd)
|
|
"scsh-newterm")
|
|
(define (newterm type outfd infd)
|
|
(make-screen (or (newterm-internal type
|
|
(port->fdes outfd)
|
|
(port->fdes infd))
|
|
(raise-curses-error "newterm"))))
|
|
|
|
|
|
;;Beenden
|
|
(import-lambda-definition endwin
|
|
()
|
|
"scsh_endwin")
|
|
|
|
(import-lambda-definition isendwin
|
|
()
|
|
"scsh_isendwin")
|
|
|
|
(import-lambda-definition delscreen
|
|
()
|
|
"scsh_delscreen")
|
|
|
|
;;Hilfsfunktionen
|
|
(import-lambda-definition unctrl-internal
|
|
(c)
|
|
"scsh_unctrl")
|
|
(define (unctrl c)
|
|
(or (unctrl-internal c)
|
|
(raise-curses-error "unctrl")))
|
|
|
|
(import-lambda-definition keyname-internal
|
|
(c)
|
|
"scsh_keyname")
|
|
(define (keyname c)
|
|
(or (keyname-internal c)
|
|
(raise-curses-error "keyname")))
|
|
|
|
(import-lambda-definition filter
|
|
()
|
|
"scsh_filter")
|
|
|
|
(import-lambda-definition use_env
|
|
(f)
|
|
"scsh_use_env")
|
|
|
|
(import-lambda-definition putwin-internal
|
|
(win file)
|
|
"scsh_putwin")
|
|
(define (putwin win file)
|
|
(return-curses-code-int "putwin"
|
|
(putwin-internal (window-c-pointer win)
|
|
(port->fdes file))))
|
|
|
|
(import-lambda-definition getwin-internal
|
|
(file)
|
|
"scsh_getwin")
|
|
(define (getwin file)
|
|
(make-window (or (getwin-internal (port->fdes file))
|
|
(raise-curses-error "getwin"))))
|
|
|
|
(import-lambda-definition delay-output-internal
|
|
(ms)
|
|
"scsh_delay_output")
|
|
(define (delay-output ms)
|
|
(return-curses-code-int "delay-output"
|
|
(delay-output-internal ms)))
|
|
|
|
(import-lambda-definition flushinp-internal
|
|
()
|
|
"scsh_flushinp")
|
|
(define (flushinp)
|
|
(return-curses-code-int "flushinp"
|
|
(flushinp-internal)))
|
|
|
|
(import-lambda-definition curses-version-internal
|
|
()
|
|
"scsh_curses_version")
|
|
(define (curses-version)
|
|
(or (curses-version-internal)
|
|
(raise-curses-error "curses-version")))
|
|
|
|
;;Einstellungen
|
|
(import-lambda-definition use-default-colors-internal
|
|
()
|
|
"scsh_use_default_colors")
|
|
(define (use-default-colors)
|
|
(return-curses-code-int "use-default-colors"
|
|
(use-default-colors-internal)))
|
|
|
|
(import-lambda-definition assume-default-colors-internal
|
|
(fg bg)
|
|
"scsh_assume_default_colors")
|
|
(define (assume-default-colors fg bg)
|
|
(return-curses-code-int "assume-default-colors"
|
|
(assume-default-colors-internal fg bg)))
|
|
|
|
(import-lambda-definition define-key-internal
|
|
(def keyc)
|
|
"scsh_define_key")
|
|
(define (define-key def keyc)
|
|
(return-curses-code-int "define-key"
|
|
(define-key-internal def keyc)))
|
|
;;*************************************************************************
|
|
|
|
;;TERMINAL
|
|
;;Eigenschaften
|
|
(import-lambda-definition baudrate-internal
|
|
()
|
|
"scsh_baudrate")
|
|
(define (baudrate)
|
|
(or (baudrate-internal)
|
|
(raise-curses-error "bauderate")))
|
|
|
|
(import-lambda-definition erasechar
|
|
()
|
|
"scsh_erasechar")
|
|
|
|
(import-lambda-definition has_ic
|
|
()
|
|
"scsh_has_ic")
|
|
|
|
(import-lambda-definition has_il
|
|
()
|
|
"scsh_has_il")
|
|
|
|
(import-lambda-definition killchar
|
|
()
|
|
"scsh_killchar")
|
|
|
|
(import-lambda-definition longname-internal
|
|
()
|
|
"scsh_longname")
|
|
(define (longname)
|
|
(or (longname-internal)
|
|
(raise-curses-error "longname")))
|
|
|
|
(import-lambda-definition termname-internal
|
|
()
|
|
"scsh_termname")
|
|
(define (termname)
|
|
(or (termname-internal)
|
|
(raise-curses-error "termname")))
|
|
|
|
(import-lambda-definition has-key-internal
|
|
(ch)
|
|
"scsh_has_key")
|
|
(define (has-key ch)
|
|
(or (has-key-internal ch)
|
|
(raise-curses-error "has-key")))
|
|
|
|
;;Farbe
|
|
(import-lambda-definition start-color-internal
|
|
()
|
|
"scsh_start_color")
|
|
(define (start-color)
|
|
(return-curses-code-int "start-color"
|
|
(start-color-internal)))
|
|
|
|
(import-lambda-definition init-pair-internal
|
|
(pair f b)
|
|
"scsh_init_pair")
|
|
(define (init-pair pair f b)
|
|
(return-curses-code-int "init-pair"
|
|
(init-pair-internal pair f b)))
|
|
|
|
|
|
(import-lambda-definition init-color-internal
|
|
(color r g b)
|
|
"scsh_init_color")
|
|
(define (init-color color r g b)
|
|
(return-curses-code-int "init-color"
|
|
(init-color-internal color r g b)))
|
|
|
|
(import-lambda-definition has-colors
|
|
()
|
|
"scsh_has_colors")
|
|
|
|
(import-lambda-definition can-change-colors
|
|
()
|
|
"scsh_can_change_colors")
|
|
|
|
(import-lambda-definition color-pair
|
|
(num)
|
|
"scsh_color_pair")
|
|
|
|
|
|
;;Eingabe:
|
|
(import-lambda-definition cbreak-internal
|
|
()
|
|
"scsh_cbreak")
|
|
(define (cbreak)
|
|
(return-curses-code-int "cbreak"
|
|
(cbreak-internal)))
|
|
|
|
(import-lambda-definition nocbreak-internal
|
|
()
|
|
"scsh_no_cbreak")
|
|
(define (nocbreak)
|
|
(return-curses-code-int "nocbreak"
|
|
(nocbreak-internal)))
|
|
|
|
(import-lambda-definition echo-internal
|
|
()
|
|
"scsh_echo")
|
|
(define (echo)
|
|
(return-curses-code-int "echo"
|
|
(echo-internal)))
|
|
|
|
(import-lambda-definition noecho-internal
|
|
()
|
|
"scsh_noecho")
|
|
(define (noecho)
|
|
(return-curses-code-int "noecho"
|
|
(noecho-internal)))
|
|
|
|
|
|
(import-lambda-definition halfdelay-internal
|
|
(tenth)
|
|
"scsh_halfdelay")
|
|
(define (halfdelay tenth)
|
|
(return-curses-code-int "halfdelay"
|
|
(halfdelay-internal tenth)))
|
|
|
|
(import-lambda-definition intrflush-internal
|
|
(win bf)
|
|
"scsh_intrflush")
|
|
(define (intrflush win bf)
|
|
(return-curses-code-int "intrflush"
|
|
(intrflush-internal (window-c-pointer win)
|
|
bf)))
|
|
|
|
(import-lambda-definition keypad-internal
|
|
(win bf)
|
|
"scsh_keypad")
|
|
(define (keypad win bf)
|
|
(return-curses-code-int "keypad"
|
|
(keypad-internal (window-c-pointer win)
|
|
bf)))
|
|
|
|
(import-lambda-definition meta-internal
|
|
(win bf)
|
|
"scsh_meta")
|
|
(define (meta win bf)
|
|
(return-curses-code-int "meta"
|
|
(meta-internal (window-c-pointer win)
|
|
bf)))
|
|
|
|
(import-lambda-definition nodelay-internal
|
|
(win bf)
|
|
"scsh_nodelay")
|
|
(define (nodelay win bf)
|
|
(return-curses-code-int "nodelay"
|
|
(nodelay-internal (window-c-pointer win)
|
|
bf)))
|
|
|
|
(import-lambda-definition raw-internal
|
|
()
|
|
"scsh_raw")
|
|
(define (raw)
|
|
(return-curses-code-int "raw"
|
|
(raw-internal)))
|
|
|
|
(import-lambda-definition noraw-internal
|
|
()
|
|
"scsh_noraw")
|
|
(define (noraw)
|
|
(return-curses-code-int "noraw"
|
|
(noraw-internal)))
|
|
|
|
(import-lambda-definition qiflush
|
|
()
|
|
"scsh_qiflush")
|
|
|
|
(import-lambda-definition noqiflush
|
|
()
|
|
"scsh_noqiflush")
|
|
|
|
;;Terminalfunktionen
|
|
(import-lambda-definition beep-internal
|
|
()
|
|
"scsh_beep")
|
|
(define (beep)
|
|
(return-curses-code-int "beep"
|
|
(beep-internal)))
|
|
|
|
(import-lambda-definition flash-internal
|
|
()
|
|
"scsh_flash")
|
|
(define (flash)
|
|
(return-curses-code-int "flash"
|
|
(flash-internal)))
|
|
|
|
(import-lambda-definition def-prog-mode-internal
|
|
()
|
|
"scsh_def_prog_mode")
|
|
(define (def-prog-mode)
|
|
(return-curses-code-int "def-prog-mode"
|
|
(def-prog-mode-internal)))
|
|
|
|
(import-lambda-definition def-shell-mode-internal
|
|
()
|
|
"scsh_def_shell_mode")
|
|
(define (def-shell-mode)
|
|
(return-curses-code-int "def-shell-mode"
|
|
(def-shell-mode-internal)))
|
|
|
|
|
|
(import-lambda-definition reset-prog-mode-internal
|
|
()
|
|
"scsh_reset_prog_mode")
|
|
(define (reset-prog-mode)
|
|
(return-curses-code-int "reset-prog-mode"
|
|
(reset-prog-mode-internal)))
|
|
|
|
(import-lambda-definition reset-shell-mode-internal
|
|
()
|
|
"scsh_reset_shell_mode")
|
|
(define (reset-shell-mode)
|
|
(return-curses-code-int "reset-shell-mode"
|
|
(reset-shell-mode-internal)))
|
|
|
|
(import-lambda-definition resetty-internal
|
|
()
|
|
"scsh_resetty")
|
|
(define (resetty)
|
|
(return-curses-code-int "resetty"
|
|
(resetty-internal)))
|
|
|
|
(import-lambda-definition savetty-internal
|
|
()
|
|
"scsh_savetty")
|
|
|
|
(define (savetty)
|
|
(return-curses-code-int "savetty"
|
|
(savetty-internal)))
|
|
|
|
(import-lambda-definition curs-set-internal
|
|
(visibility)
|
|
"scsh_curs_set")
|
|
(define (curs-set visibility)
|
|
(or (curs-set-internal visibility)
|
|
(raise-curses-error "curs_set")))
|
|
|
|
|
|
(import-lambda-definition napms-internal
|
|
(ms)
|
|
"scsh_napms")
|
|
(define (napms ms)
|
|
(return-curses-code-int "napms"
|
|
(napms-internal ms)))
|
|
|
|
(import-lambda-definition mcprint-internal
|
|
(data len)
|
|
"scsh_mcprint")
|
|
(define (mcprint data len)
|
|
(return-curses-code-int "mcprint"
|
|
(mcprint-internal data len)))
|
|
|
|
(import-lambda-definition is-term-resized
|
|
(lines columns)
|
|
"scsh_is_term_resized")
|
|
|
|
(import-lambda-definition resize-term-internal
|
|
(lines columns)
|
|
"scsh_resize_term")
|
|
(define (resize-term lines columns)
|
|
(return-curses-code-int "resize-term"
|
|
(resize-term-internal lines columns)))
|
|
|
|
(import-lambda-definition resizeterm-internal
|
|
(lines columns)
|
|
"scsh_resizeterm")
|
|
(define (resizeterm lines columns)
|
|
(return-curses-code-int "resizeterm"
|
|
(resizeterm-internal lines columns)))
|
|
|
|
(import-lambda-definition scr-dump-internal
|
|
(filename)
|
|
"scsh_scr_dump")
|
|
(define (scr-dump filename)
|
|
(return-curses-code-int "scr-dump"
|
|
(scr-dump-internal filename)))
|
|
|
|
(import-lambda-definition scr-restore-internal
|
|
(filename)
|
|
"scsh_scr_restore")
|
|
(define (scr-restore filename)
|
|
(return-curses-code-int "scr-restore"
|
|
(scr-restore-internal filename)))
|
|
|
|
(import-lambda-definition scr-init-internal
|
|
(filename)
|
|
"scsh_scr_init")
|
|
(define (scr-init filename)
|
|
(return-curses-code-int "scr-init"
|
|
(scr-init-internal filename)))
|
|
|
|
(import-lambda-definition scr-set-internal
|
|
(filename)
|
|
"scsh_scr_set")
|
|
(define (scr-set filename)
|
|
(return-curses-code-int "scr-set"
|
|
(scr-set-internal filename)))
|
|
|
|
|
|
|
|
;;mehrere Terminals:
|
|
(import-lambda-definition set-term-internal
|
|
(new)
|
|
"scsh_set_term")
|
|
(define (set-term new)
|
|
(make-screen (or (set-term-internal (screen-c-pointer new))
|
|
(raise-curses-error "set-term"))))
|
|
|
|
;;*************************************************************************
|
|
|
|
;;FENSTER
|
|
|
|
;;Allgemeine
|
|
(import-lambda-definition newwin-internal
|
|
(height width starty startx)
|
|
"scsh_newwin")
|
|
(define (newwin h w x y)
|
|
(make-window (or (newwin-internal h w x y)
|
|
(raise-curses-error "newwin"))))
|
|
|
|
|
|
(import-lambda-definition delwin-internal
|
|
(win)
|
|
"scsh_delwin")
|
|
(define (delwin win)
|
|
(return-curses-code-int "delwin"
|
|
(delwin-internal (window-c-pointer win))))
|
|
|
|
(import-lambda-definition mvwin-internal
|
|
(win y x)
|
|
"scsh_mvwin")
|
|
(define (mvwin win y x)
|
|
(return-curses-code-int "mvwin"
|
|
(mvwin-internal (window-c-pointer win) y x)))
|
|
|
|
(import-lambda-definition subwin-internal
|
|
(orig nlines ncols begin_y begin_x)
|
|
"scsh_subwin")
|
|
(define (subwin orig nlines ncols begin_y begin_x)
|
|
(make-window (or (subwin-internal (window-c-pointer orig)
|
|
nlines ncols begin_y begin_x)
|
|
(raise-curses-error "subwin"))))
|
|
|
|
(import-lambda-definition derwin-internal
|
|
(orig nlines ncols begin_y begin_x)
|
|
"scsh_derwin")
|
|
(define (derwin orig nlines ncols begin_y begin_x)
|
|
(make-window (or (derwin-internal (window-c-pointer orig)
|
|
nlines ncols begin_y begin_x)
|
|
(raise-curses-error "derwin"))))
|
|
|
|
(import-lambda-definition mvderwin-internal
|
|
(win par_y par_x)
|
|
"scsh_mvderwin")
|
|
(define (mvderwin win par_y par_x)
|
|
(return-curses-code-int
|
|
"mvderwin"
|
|
(mvderwin-internal (window-c-pointer win) par_y par_x)))
|
|
|
|
(import-lambda-definition dupwin-internal
|
|
(win)
|
|
"scsh_dupwin")
|
|
(define (dupwin win)
|
|
(make-window (or (dupwin-internal (window-c-pointer win))
|
|
(raise-curses-error "dupwin"))))
|
|
|
|
(import-lambda-definition wsyncup-internal
|
|
(win)
|
|
"scsh_wsyncup")
|
|
(define (wsyncup win)
|
|
(or (wsyncup-internal (window-c-pointer win))
|
|
(raise-curses-error "wsyncup")))
|
|
|
|
(import-lambda-definition wcursyncup-internal
|
|
(win)
|
|
"scsh_wcursyncup")
|
|
(define (wcursyncup win)
|
|
(or (wcursyncup-internal (window-c-pointer win))
|
|
(raise-curses-error "wcursyncup")))
|
|
|
|
(import-lambda-definition wsyncdown-internal
|
|
(win)
|
|
"scsh_wsyncdown")
|
|
(define (wsyncdown win)
|
|
(or (wsyncdown-internal (window-c-pointer win))
|
|
(raise-curses-error "wsyncdown")))
|
|
|
|
(import-lambda-definition syncok-internal
|
|
(win bf)
|
|
"scsh_syncok")
|
|
(define (syncok win bf)
|
|
(return-curses-code-int
|
|
"syncok"
|
|
(syncok-internal (window-c-pointer win) bf)))
|
|
|
|
(import-lambda-definition wrefresh-internal
|
|
(win)
|
|
"scsh_wrefresh")
|
|
(define (wrefresh win)
|
|
(return-curses-code-int
|
|
"wrefresh"
|
|
(wrefresh-internal (window-c-pointer win))))
|
|
|
|
(import-lambda-definition wnoutrefresh-internal
|
|
(win)
|
|
"scsh_wnoutrefresh")
|
|
(define (wnoutrefresh win)
|
|
(return-curses-code-int
|
|
"wnoutrefresh"
|
|
(wnoutrefresh-internal (window-c-pointer win))))
|
|
|
|
(import-lambda-definition redrawwin-internal
|
|
(win)
|
|
"scsh_redrawwin")
|
|
(define (redrawwin win)
|
|
(return-curses-code-int
|
|
"redrawwin"
|
|
(redrawwin-internal (window-c-pointer win))))
|
|
|
|
(import-lambda-definition doupdate-internal
|
|
()
|
|
"scsh_doupdate")
|
|
(define (doupdate)
|
|
(return-curses-code-int
|
|
"doupdate"
|
|
(doupdate-internal )))
|
|
|
|
(import-lambda-definition wredrawln-internal
|
|
(win beg_line num_lines)
|
|
"scsh_wredrawln")
|
|
(define (wredrawln win beg_line num_lines)
|
|
(return-curses-code-int
|
|
"wredrawln"
|
|
(wredrawln-internal (window-c-pointer win) beg_line num_lines)))
|
|
|
|
;;(import-lambda-definition getyx-internal
|
|
;; (win)
|
|
;; "scsh_getyx")
|
|
;;(define (getyx win)
|
|
;; (getyx_internal (window-c-pointer win)))
|
|
|
|
;;(import-lambda-definition getparyx-internal
|
|
;; (win y x)
|
|
;; "scsh_getparyx")
|
|
;;(define (getparyx win y x)
|
|
;; (getparyx_internal (window-c-pointer win) y x))
|
|
|
|
;;(import-lambda-definition getbegyx-internal
|
|
;; (win y x)
|
|
;; "scsh_getbegyx")
|
|
;;(define (getbegyx win y x)
|
|
;; (getbegyx_internal (window-c-pointer win) y x))
|
|
|
|
;;(import-lambda-definition getmaxyx-internal
|
|
;; (win y x)
|
|
;; "scsh_getmaxyx")
|
|
;;(define (getmaxyx win y x)
|
|
;; (getmaxyx_internal (window-c-pointer win) y x))
|
|
|
|
(import-lambda-definition wresize-internal
|
|
(win lines columns)
|
|
"scsh_wresize")
|
|
(define (wresize win lines columns)
|
|
(return-curses-code-int
|
|
"wresize"
|
|
(wresize-internal (window-c-pointer win) lines columns)))
|
|
|
|
|
|
;;Ausgabe-Einstellungen
|
|
|
|
(import-lambda-definition idlok-internal
|
|
(win bf)
|
|
"scsh_idlok")
|
|
(define (idlok win bf)
|
|
(return-curses-code-int
|
|
"idlok"
|
|
(idlok-internal (window-c-pointer win) bf)))
|
|
|
|
(import-lambda-definition leaveok-internal
|
|
(win bf)
|
|
"scsh_leaveok")
|
|
(define (leaveok win bf)
|
|
(return-curses-code-int
|
|
"leaveok"
|
|
(leaveok-internal (window-c-pointer win) bf)))
|
|
|
|
(import-lambda-definition scrollok-internal
|
|
(win bf)
|
|
"scsh_scrollok")
|
|
(define (scrollok win bf)
|
|
(return-curses-code-int
|
|
"scrollok"
|
|
(scrollok-internal (window-c-pointer win) bf)))
|
|
|
|
(import-lambda-definition idcok-internal
|
|
(win bf)
|
|
"scsh_idcok")
|
|
(define (idcok win bf)
|
|
(idcok-internal (window-c-pointer win) bf))
|
|
|
|
(import-lambda-definition immedok-internal
|
|
(win bf)
|
|
"scsh_immedok")
|
|
(define (immedok win bf)
|
|
(immedok-internal (window-c-pointer win) bf))
|
|
|
|
(import-lambda-definition wsetscrreg-internal
|
|
(win top bot)
|
|
"scsh_wsetscrreg")
|
|
(define (wsetscrreg win top bot)
|
|
(return-curses-code-int
|
|
"wsetscrreg"
|
|
(wsetscrreg-internal (window-c-pointer win) top bot)))
|
|
|
|
(import-lambda-definition nl-internal
|
|
()
|
|
"scsh_nl")
|
|
(define (nl)
|
|
(return-curses-code-int
|
|
"nl"
|
|
(nl-internal)))
|
|
|
|
(import-lambda-definition nonl-internal
|
|
()
|
|
"scsh_nonl")
|
|
(define (nonl)
|
|
(return-curses-code-int
|
|
"nonl"
|
|
(nonl-internal)))
|
|
|
|
;;Text anzeigen
|
|
|
|
(import-lambda-definition waddch-internal
|
|
(win ch)
|
|
"scsh_waddch")
|
|
(define (waddch win ch)
|
|
(return-curses-code-int
|
|
"waddch"
|
|
(waddch-internal (window-c-pointer win) ch)))
|
|
|
|
(import-lambda-definition wechochar-internal
|
|
(win ch)
|
|
"scsh_wechochar")
|
|
(define (wechochar win ch)
|
|
(return-curses-code-int
|
|
"wechochar"
|
|
(wechochar-internal (window-c-pointer win) ch)))
|
|
|
|
(import-lambda-definition waddstr-internal
|
|
(win str)
|
|
"scsh_waddstr")
|
|
(define (waddstr win str)
|
|
(return-curses-code-int
|
|
"waddstr"
|
|
(waddstr-internal (window-c-pointer win) str)))
|
|
|
|
(import-lambda-definition waddnstr-internal
|
|
(win str n)
|
|
"scsh_waddnstr")
|
|
(define (waddnstr win str n)
|
|
(return-curses-code-int
|
|
"waddnstr"
|
|
(waddnstr-internal (window-c-pointer win) str n)))
|
|
|
|
(import-lambda-definition winsch-internal
|
|
(win ch)
|
|
"scsh_winsch")
|
|
(define (winsch win ch)
|
|
(return-curses-code-int
|
|
"winsch"
|
|
(winsch-internal (window-c-pointer win) ch)))
|
|
|
|
(import-lambda-definition winsstr-internal
|
|
(win str)
|
|
"scsh_winsstr")
|
|
(define (winsstr win str)
|
|
(return-curses-code-int
|
|
"winsstr"
|
|
(winsstr-internal (window-c-pointer win) str)))
|
|
|
|
(import-lambda-definition winsnstr-internal
|
|
(win str n)
|
|
"scsh_winsnstr")
|
|
(define (winsnstr win str n)
|
|
(return-curses-code-int
|
|
"winsnstr"
|
|
(winsnstr-internal (window-c-pointer win) str n)))
|
|
|
|
|
|
;;Attribute
|
|
(import-lambda-definition wattroff-internal
|
|
(win attrs)
|
|
"scsh_wattroff")
|
|
(define (wattroff win attrs)
|
|
(return-curses-code-int
|
|
"wattroff"
|
|
(wattroff-internal (window-c-pointer win) attrs)))
|
|
|
|
(import-lambda-definition wattron-internal
|
|
(win attrs)
|
|
"scsh_wattron")
|
|
(define (wattron win attrs)
|
|
(return-curses-code-int
|
|
"wattron"
|
|
(wattron-internal (window-c-pointer win) attrs)))
|
|
|
|
(import-lambda-definition wattrset-internal
|
|
(win attrs)
|
|
"scsh_wattrset")
|
|
(define (wattrset win attrs)
|
|
(return-curses-code-int
|
|
"wattrset"
|
|
(wattrset-internal (window-c-pointer win) attrs)))
|
|
|
|
(import-lambda-definition wstandend-internal
|
|
(win)
|
|
"scsh_wstandend")
|
|
(define (wstandend win)
|
|
(return-curses-code-int
|
|
"wstandend"
|
|
(wstandend-internal (window-c-pointer win))))
|
|
|
|
(import-lambda-definition wstandout-internal
|
|
(win)
|
|
"scsh_wstandout")
|
|
(define (wstandout win)
|
|
(return-curses-code-int
|
|
"wstandout"
|
|
(wstandout-internal (window-c-pointer win))))
|
|
|
|
|
|
;;Background:
|
|
|
|
(import-lambda-definition wbkgdset-internal
|
|
(win ch)
|
|
"scsh_wbkgdset")
|
|
(define (wbkgdset win ch)
|
|
(wbkgdset-internal (window-c-pointer win) ch))
|
|
|
|
(import-lambda-definition wbkgd-internal
|
|
(win ch)
|
|
"scsh_wbkgd")
|
|
(define (wbkgd win ch)
|
|
(return-curses-code-int
|
|
"wbkgd"
|
|
(wbkgd-internal (window-c-pointer win) ch)))
|
|
|
|
(import-lambda-definition getbkgd-internal
|
|
(win)
|
|
"scsh_getbkgd")
|
|
(define (getbkgd win)
|
|
(getbkgd-internal (window-c-pointer win)))
|
|
|
|
|
|
;;Umrandung des Fensters:
|
|
|
|
(import-lambda-definition wborder-internal
|
|
(win ls rs ts bs tl tr bl br)
|
|
"scsh_wborder")
|
|
(define (wborder win ls rs ts bs tl tr bl br)
|
|
(return-curses-code-int
|
|
"wboredr"
|
|
(wborder-internal (window-c-pointer win) ls rs ts bs tl tr bl br)))
|
|
|
|
(import-lambda-definition box-internal
|
|
(win verch horch)
|
|
"scsh_box")
|
|
(define (box win verch horch)
|
|
(return-curses-code-int
|
|
"box"
|
|
(box-internal
|
|
(window-c-pointer win) verch horch)))
|
|
|
|
(import-lambda-definition whline-internal
|
|
(win ch n)
|
|
"scsh_whline")
|
|
(define (whline win ch n)
|
|
(return-curses-code-int
|
|
"whline"
|
|
(whline-internal
|
|
(window-c-pointer win) ch n)))
|
|
|
|
(import-lambda-definition wvline-internal
|
|
(win ch n)
|
|
"scsh_wvline")
|
|
(define (wvline win ch n)
|
|
(return-curses-code-int
|
|
"wvline"
|
|
(wvline-internal
|
|
(window-c-pointer win) ch n)))
|
|
|
|
|
|
;;Cursor
|
|
|
|
(import-lambda-definition scroll-internal
|
|
(win)
|
|
"scsh_scroll")
|
|
(define (scroll win)
|
|
(return-curses-code-int
|
|
"scroll"
|
|
(scroll-internal
|
|
(window-c-pointer win))))
|
|
|
|
(import-lambda-definition wscl-internal
|
|
(win n)
|
|
"scsh_wscrl")
|
|
(define (wscrl win n)
|
|
(return-curses-code-int
|
|
"wscrl"
|
|
(wscl-internal
|
|
(window-c-pointer win) n)))
|
|
|
|
(import-lambda-definition wmove-internal
|
|
(win y x)
|
|
"scsh_wmove")
|
|
(define (wmove win y x)
|
|
(return-curses-code-int
|
|
"wmove"
|
|
(wmove-internal
|
|
(window-c-pointer win) y x)))
|
|
|
|
|
|
;;Eingabe
|
|
|
|
(import-lambda-definition wgetch-internal
|
|
(win)
|
|
"scsh_wgetch")
|
|
(define (wgetch win)
|
|
(nodelay win #t)
|
|
(let ((ch (wgetch-internal (window-c-pointer win))))
|
|
(if (not (= err ch))
|
|
ch
|
|
(begin
|
|
(select-port-channels #f (current-input-port))
|
|
(nodelay win #f)
|
|
(wgetch-internal (window-c-pointer win))))))
|
|
|
|
|
|
(define (wgetstr win)
|
|
(let loop ((str ""))
|
|
(keypad win #t)
|
|
(let ((ch (wgetch win)))
|
|
(cond
|
|
;;newline
|
|
((= ch 10)(begin
|
|
(keypad win #f)
|
|
str))
|
|
;;backspace
|
|
((= ch key-backspace)
|
|
(if (= (string-length str) 0)
|
|
(loop str)
|
|
(begin
|
|
;;letztes Zeichen löschen
|
|
(backspace win)
|
|
(loop (substring str 0 (- (string-length str) 1))))))
|
|
;;sonst
|
|
(else
|
|
(if (> ch 255)
|
|
(loop str)
|
|
(loop (string-append str (string (ascii->char ch))))))))))
|
|
|
|
(define (wgetnstr win n)
|
|
(let loop ((str "") (count 0))
|
|
(keypad win #t)
|
|
(if (<= n 0)
|
|
;;Spezialfall n<=0 -> nur echo ausschalten und "" zurueckgeben
|
|
(begin (noecho)
|
|
(let ((ch (ascii->char(wgetch win))))
|
|
(if (equal? #\newline ch)
|
|
;;Rückkehr
|
|
(begin (echo)
|
|
(keypad win #f)
|
|
str)
|
|
;;warten auf newline
|
|
(loop str count))))
|
|
;;n>0 -> n Zeichen lesen (oder newline), dann noecho
|
|
(let ((ch (wgetch win)))
|
|
(cond
|
|
;;newline -> Rückkehr
|
|
((= ch 10) (begin (echo)
|
|
(keypad win #f)
|
|
str))
|
|
;;backspace
|
|
((= ch key-backspace)
|
|
(if (= count 0)
|
|
(loop "" count)
|
|
(if (= count n )
|
|
(begin
|
|
(echo)
|
|
(back win)
|
|
(wdelch win)
|
|
(wrefresh win)
|
|
(loop (substring str 0 (- count 1)) (- count 1 )))
|
|
(begin
|
|
(backspace win)
|
|
(loop (substring str 0 (- count 1)) (- count 1))))))
|
|
;;sonst
|
|
(else (if (or (>= count n) (> ch 255))
|
|
(loop str count)
|
|
(let ((newstr (string-append str
|
|
(string (ascii->char ch)))))
|
|
(if (= count (- n 1))
|
|
(begin
|
|
(noecho) (loop newstr (+ count 1)))
|
|
(loop newstr (+ count 1)))))))))))
|
|
|
|
|
|
;; (if (>= count n )
|
|
;; ;; wenn newline kommt->fertig, sonst ignorieren
|
|
;; (if (equal? #\newline ch)
|
|
;; (begin
|
|
;; (echo)
|
|
;; str)
|
|
;; (loop str count))
|
|
;; ;; wenn newline kommt->fertig, sonst anhaengen
|
|
;; (let ((newstr (string-append str (string ch))))
|
|
;; (if (equal? #\newline ch)
|
|
;; str
|
|
;; ab dem n-ten Zeichen wird die Eingabe nicht "geechot"
|
|
;; (if (= count (- n 1))
|
|
;; (begin
|
|
;; (noecho)
|
|
;; (loop newstr (+ count 1)))
|
|
;; (loop newstr (+ count 1))))))))))
|
|
|
|
|
|
|
|
(import-lambda-definition winch-internal
|
|
(win)
|
|
"scsh_winch")
|
|
(define (winch win)
|
|
(winch-internal (window-c-pointer win)))
|
|
|
|
(import-lambda-definition winstr-internal
|
|
(win)
|
|
"scsh_winstr")
|
|
(define (winstr win)
|
|
(or (winstr-internal (window-c-pointer win))
|
|
(raise-curses-error "winstr")))
|
|
|
|
(import-lambda-definition winnstr-internal
|
|
(win)
|
|
"scsh_winnstr")
|
|
(define (winnstr win n)
|
|
(or (winnstr-internal (window-c-pointer win) n)
|
|
(raise-curses-error "winnstr")))
|
|
|
|
|
|
|
|
|
|
;;Loeschen
|
|
|
|
(import-lambda-definition werase-internal
|
|
(win)
|
|
"scsh_werase")
|
|
(define (werase win)
|
|
(return-curses-code-int
|
|
"werase"
|
|
(werase-internal
|
|
(window-c-pointer win))))
|
|
|
|
(import-lambda-definition wclear-internal
|
|
(win)
|
|
"scsh_wclear")
|
|
(define (wclear win)
|
|
(return-curses-code-int
|
|
"wclear"
|
|
(wclear-internal
|
|
(window-c-pointer win))))
|
|
|
|
(import-lambda-definition wclrtobot-internal
|
|
(win)
|
|
"scsh_wclrtobot")
|
|
(define (wclrtobot win)
|
|
(return-curses-code-int
|
|
"wclrtobot"
|
|
(wclrtobot-internal
|
|
(window-c-pointer win))))
|
|
|
|
(import-lambda-definition wclrtoeol-internal
|
|
(win)
|
|
"scsh_wclrtoeol")
|
|
(define (wclrtoeol win)
|
|
(return-curses-code-int
|
|
"wclrtoeol"
|
|
(wclrtoeol-internal
|
|
(window-c-pointer win))))
|
|
|
|
(import-lambda-definition clearok-internal
|
|
(win bf)
|
|
"scsh_clearok")
|
|
(define (clearok win bf)
|
|
(return-curses-code-int
|
|
"clearok"
|
|
(clearok-internal
|
|
(window-c-pointer win) bf)))
|
|
|
|
(import-lambda-definition wdelch-internal
|
|
(win)
|
|
"scsh_wdelch")
|
|
(define (wdelch win)
|
|
(return-curses-code-int
|
|
"wdelch"
|
|
(wdelch-internal
|
|
(window-c-pointer win))))
|
|
|
|
|
|
(import-lambda-definition wdeleteln-internal
|
|
(win)
|
|
"scsh_wdeleteln")
|
|
(define (wdeleteln win)
|
|
(return-curses-code-int
|
|
"wdeleteln"
|
|
(wdeleteln-internal
|
|
(window-c-pointer win))))
|
|
|
|
|
|
(import-lambda-definition winsertln-internal
|
|
(win)
|
|
"scsh_winsertln")
|
|
(define (winsertln win)
|
|
(return-curses-code-int
|
|
"winsertln"
|
|
(winsertln-internal
|
|
(window-c-pointer win))))
|
|
|
|
(import-lambda-definition winsdelln-internal
|
|
(win n)
|
|
"scsh_winsdelln")
|
|
(define (winsdelln win n)
|
|
(return-curses-code-int
|
|
"winsdelln"
|
|
(winsdelln-internal
|
|
(window-c-pointer win) n)))
|
|
|
|
|
|
;;mehrere Fenster
|
|
|
|
(import-lambda-definition overlay-internal
|
|
(srcwin dstwin)
|
|
"scsh_overlay")
|
|
(define (overlay srcwin dstwin)
|
|
(return-curses-code-int
|
|
"overlay"
|
|
(overlay-internal
|
|
(window-c-pointer srcwin) (window-c-pointer dstwin))))
|
|
|
|
(import-lambda-definition overwrite-internal
|
|
(srcwin dstwin)
|
|
"scsh_overwrite")
|
|
(define (overwrite srcwin dstwin)
|
|
(return-curses-code-int
|
|
"overwrite"
|
|
(overwrite-internal
|
|
(window-c-pointer srcwin) (window-c-pointer dstwin))))
|
|
|
|
|
|
(import-lambda-definition copywin-internal
|
|
(srcwin dstwin sminrow smincol dminrow dmincol dmaxrow dmaxcol overlay)
|
|
"scsh_copywin")
|
|
(define (copywin srcwin dstwin sminrow smincol dminrow dmincol dmaxrow
|
|
dmaxcol overlay)
|
|
(return-curses-code-int
|
|
"copywin"
|
|
(copywin-internal
|
|
(window-c-pointer srcwin) (window-c-pointer dstwin)
|
|
sminrow smincol dminrow dmincol dmaxrow dmaxcol overlay)))
|
|
|
|
|
|
;;Eigenschaften
|
|
|
|
(import-lambda-definition touchline-internal
|
|
(win start count)
|
|
"scsh_touchline")
|
|
(define (touchline win start count)
|
|
(return-curses-code-int
|
|
"touchline"
|
|
(touchline-internal (window-c-pointer win) start count)))
|
|
|
|
(import-lambda-definition touchwin-internal
|
|
(win)
|
|
"scsh_touchwin")
|
|
(define (touchwin win)
|
|
(return-curses-code-int
|
|
"touchwin"
|
|
(touchwin-internal (window-c-pointer win))))
|
|
|
|
(import-lambda-definition untouchwin-internal
|
|
(win)
|
|
"scsh_untouchwin")
|
|
(define (untouchwin win)
|
|
(return-curses-code-int
|
|
"untouchwin"
|
|
(untouchwin-internal (window-c-pointer win))))
|
|
|
|
(import-lambda-definition wtouchln-internal
|
|
(win y n changed)
|
|
"scsh_wtouchln")
|
|
(define (wtouchln win y n changed)
|
|
(return-curses-code-int
|
|
"wtouchln"
|
|
(wtouchln-internal (window-c-pointer win) y n changed)))
|
|
|
|
(import-lambda-definition is-linetouched-internal
|
|
(win line)
|
|
"scsh_is_linetouched")
|
|
(define (is-linetouched win line)
|
|
(is-linetouched-internal (window-c-pointer win) line))
|
|
|
|
(import-lambda-definition is-wintouched-internal
|
|
(win)
|
|
"scsh_is_wintouched")
|
|
(define (is-wintouched win)
|
|
(is-wintouched-internal (window-c-pointer win)))
|
|
|
|
;;*************************************************************************
|
|
|
|
;;PADS
|
|
|
|
(import-lambda-definition newpad-internal
|
|
(nlines ncols)
|
|
"scsh_newpad")
|
|
(define (newpad nlines ncols)
|
|
(make-window (or (newpad-internal nlines ncols)
|
|
(raise-curses-error "newpad"))))
|
|
|
|
(import-lambda-definition subpad-internal
|
|
(orig nlines ncols begin_y begin_x)
|
|
"scsh_subpad")
|
|
(define (subpad orig nlines ncols begin_y begin_x)
|
|
(make-window (or (subpad-internal
|
|
(window-c-pointer orig)
|
|
nlines ncols begin_y begin_x)
|
|
(raise-curses-error "newpad"))))
|
|
|
|
(import-lambda-definition prefresh-internal
|
|
(pad pminrow pmincol sminrow smincol smaxrow smaxcol)
|
|
"scsh_prefresh")
|
|
(define (prefresh pad pminrow pmincol sminrow smincol smaxrow smaxcol )
|
|
(return-curses-code-int
|
|
"prefresh"
|
|
(prefresh-internal
|
|
(window-c-pointer pad) pminrow pmincol sminrow smincol smaxrow smaxcol)))
|
|
|
|
(import-lambda-definition pnoutrefresh-internal
|
|
(pad pminrow pmincol sminrow smincol smaxrow smaxcol)
|
|
"scsh_pnoutrefresh")
|
|
(define (pnoutrefresh pad pminrow pmincol sminrow smincol smaxrow smaxcol )
|
|
(return-curses-code-int
|
|
"pnoutrefresh"
|
|
(pnoutrefresh-internal
|
|
(window-c-pointer pad) pminrow pmincol sminrow smincol smaxrow smaxcol)))
|
|
|
|
(import-lambda-definition pechochar-internal
|
|
(pad ch)
|
|
"scsh_pechochar")
|
|
(define (pechochar pad ch)
|
|
(return-curses-code-int
|
|
"pechochar"
|
|
(pechochar-internal (window-c-pointer pad) ch)))
|
|
|
|
;;*************************************************************************
|
|
|
|
;;KONSTANTEN
|
|
|
|
;;Standardscreen (s.o.)
|
|
|
|
;;Lines/Cols
|
|
(import-lambda-definition COLS
|
|
()
|
|
"scsh_COLS")
|
|
|
|
(import-lambda-definition LINES
|
|
()
|
|
"scsh_LINES")
|
|
|
|
|
|
;;Attribute
|
|
(import-lambda-definition A-NORMAL
|
|
()
|
|
"scsh_A_NORMAL")
|
|
|
|
(import-lambda-definition A-STANDOUT
|
|
()
|
|
"scsh_A_STANDOUT")
|
|
|
|
(import-lambda-definition A-UNDERLINE
|
|
()
|
|
"scsh_A_UNDERLINE")
|
|
|
|
(import-lambda-definition A-REVERSE
|
|
()
|
|
"scsh_A_REVERSE")
|
|
|
|
(import-lambda-definition A-BLINK
|
|
()
|
|
"scsh_A_BLINK")
|
|
|
|
(import-lambda-definition A-DIM
|
|
()
|
|
"scsh_A_DIM")
|
|
|
|
(import-lambda-definition A-BOLD
|
|
()
|
|
"scsh_A_BOLD")
|
|
|
|
(import-lambda-definition A-PROTECT
|
|
()
|
|
"scsh_A_PROTECT")
|
|
|
|
(import-lambda-definition A-INVIS
|
|
()
|
|
"scsh_A_INVIS")
|
|
|
|
(import-lambda-definition A-ALTCHARSET
|
|
()
|
|
"scsh_A_ALTCHARSET")
|
|
|
|
(import-lambda-definition COLOR-BLACK
|
|
()
|
|
"scsh_COLOR_BLACK")
|
|
|
|
(import-lambda-definition COLOR-RED
|
|
()
|
|
"scsh_COLOR_RED")
|
|
|
|
(import-lambda-definition COLOR-GREEN
|
|
()
|
|
"scsh_COLOR_GREEN")
|
|
|
|
(import-lambda-definition COLOR-YELLOW
|
|
()
|
|
"scsh_COLOR_YELLOW")
|
|
|
|
(import-lambda-definition COLOR-BLUE
|
|
()
|
|
"scsh_COLOR_BLUE")
|
|
|
|
(import-lambda-definition COLOR-MAGENTA
|
|
()
|
|
"scsh_COLOR_MAGENTA")
|
|
|
|
(import-lambda-definition COLOR-CYAN
|
|
()
|
|
"scsh_COLOR_CYAN")
|
|
|
|
(import-lambda-definition COLOR-WHITE
|
|
()
|
|
"scsh_COLOR_WHITE")
|
|
|
|
(import-lambda-definition wprintw-internal
|
|
(win str)
|
|
"scsh_wprintw")
|
|
(define (wprintw win str)
|
|
(return-curses-code-int
|
|
"wprintw"
|
|
(wprintw-internal (window-c-pointer win) str)))
|
|
|
|
|
|
|
|
;;*************************************************************************
|
|
|
|
;;STDSCR-FUNKTIONEN
|
|
;;diese werden auf scheme-seite neu definiert, um moeglichst viel
|
|
;;komplexitaet auf dieser seite zu halten.
|
|
|
|
(define (refresh)
|
|
(wrefresh standard-screen))
|
|
|
|
(define (move y x)
|
|
(wmove standard-screen y x))
|
|
|
|
(define (setscrreg top bot)
|
|
(wsetscrreg standard-screen top bot))
|
|
|
|
(define (scrl n)
|
|
(wscrl standard-screen n))
|
|
|
|
(define (addch ch)
|
|
(waddch standard-screen ch))
|
|
|
|
(define (echochar ch)
|
|
(wechochar standard-screen ch))
|
|
|
|
(define (addstr str)
|
|
(waddstr standard-screen str))
|
|
|
|
(define (addnstr str n)
|
|
(waddnstr standard-screen str n))
|
|
|
|
(define (insch ch)
|
|
(winsch standard-screen ch))
|
|
|
|
(define (insstr str)
|
|
(winsstr standard-screen str))
|
|
|
|
(define (insnstr str n)
|
|
(winsnstr standard-screen str n))
|
|
|
|
(define (printw str)
|
|
(wprintw standard-screen str))
|
|
|
|
|
|
(define (attroff attrs)
|
|
(wattroff standard-screen attrs))
|
|
|
|
(define (attron attrs)
|
|
(wattron standard-screen attrs))
|
|
|
|
(define (attrset attrs)
|
|
(wattrset standard-screen attrs))
|
|
|
|
(define (standend)
|
|
(wstandend standard-screen))
|
|
|
|
(define (standout)
|
|
(wstandout standard-screen))
|
|
|
|
(define (bkgdset ch)
|
|
(wbkgdset standard-screen ch))
|
|
|
|
(define (bkgd ch)
|
|
(wbkgd standard-screen ch))
|
|
|
|
(define (border ls rs ts bs tl tr bl br)
|
|
(wborder standard-screen ls rs ts bs tl tr bl br))
|
|
|
|
(define (hline ch n)
|
|
(whline standard-screen ch n))
|
|
|
|
(define (vline ch n)
|
|
(wvline standard-screen ch n))
|
|
|
|
(define (getch)
|
|
(wgetch standard-screen))
|
|
|
|
(define (getstr)
|
|
(wgetstr standard-screen))
|
|
|
|
(define (getnstr n)
|
|
(wgetnstr standard-screen n))
|
|
|
|
|
|
(define (erase)
|
|
(werase standard-screen ))
|
|
|
|
(define (clear)
|
|
(wclear standard-screen))
|
|
|
|
(define (clrtobot)
|
|
(wclrtobot standard-screen))
|
|
|
|
(define (clrtoeol)
|
|
(wclrtoeol standard-screen))
|
|
|
|
(define (delch)
|
|
(wdelch standard-screen))
|
|
|
|
(define (deleteln)
|
|
(wdeleteln standard-screen))
|
|
|
|
(define (insdelln n)
|
|
(winsdelln standard-screen n))
|
|
|
|
(define (insertln)
|
|
(winsertln standard-screen))
|
|
|
|
|
|
;;*************************************************************************
|
|
|
|
;;"MVW"-Funktionen.
|
|
;;bewegen den Cursor im uebergebenen Fenster und fuehren die entsprechende
|
|
;;Aktion aus. Auch sie sind nur in scheme implementiert.
|
|
|
|
(define (mvwaddch win y x ch)
|
|
(begin (wmove win y x)
|
|
(waddch win ch)))
|
|
|
|
(define (mvwaddstr win y x str)
|
|
(begin (wmove win y x)
|
|
(waddstr win str)))
|
|
|
|
(define (mvwaddnstr win y x str n)
|
|
(begin (wmove win y x)
|
|
(waddnstr win str n)))
|
|
|
|
(define (mvwinsch win y x ch)
|
|
(begin (wmove win y x)
|
|
(winsch win ch)))
|
|
|
|
(define (mvwinsstr win y x str)
|
|
(begin (wmove win y x)
|
|
(winsstr win str)))
|
|
|
|
(define (mvwinsnstr win y x str n)
|
|
(begin (wmove win y x)
|
|
(winsnstr win str n)))
|
|
|
|
(define (mvwprintw win y x str)
|
|
(begin (wmove win y x)
|
|
(wprintw win str)))
|
|
|
|
|
|
(define (mvwhline win y x ch n)
|
|
(begin (wmove win y x)
|
|
(whline win ch n)))
|
|
|
|
(define (mvwvline win y x ch n)
|
|
(begin (wmove win y x)
|
|
(wvline win ch n)))
|
|
|
|
(define (mvwgetch win y x)
|
|
(begin (wmove win y x)
|
|
(wgetch win )))
|
|
|
|
(define (mvwgetstr win y x)
|
|
(begin (wmove win y x)
|
|
(wgetstr win )))
|
|
|
|
(define (mvwgetnstr win y x n)
|
|
(begin (wmove win y x)
|
|
(wgetnstr win n)))
|
|
|
|
|
|
(define (mvwdelch win y x)
|
|
(begin (wmove win y x)
|
|
(wdelch win)))
|
|
|
|
;;*********************************************************************
|
|
|
|
;;zusätzliche Funktionen
|
|
|
|
|
|
;;Cursor-Positionen
|
|
(import-lambda-definition gety-internal
|
|
(win)
|
|
"scsh_gety")
|
|
(define gety
|
|
(lambda(win)
|
|
(gety-internal (window-c-pointer win))))
|
|
|
|
(import-lambda-definition getx-internal
|
|
(win)
|
|
"scsh_getx")
|
|
(define getx
|
|
(lambda (win)
|
|
(getx-internal (window-c-pointer win))))
|
|
|
|
;;Fenstergröße
|
|
(import-lambda-definition getmaxy-internal
|
|
(win)
|
|
"scsh_getmaxy")
|
|
(define getmaxy
|
|
(lambda (win)
|
|
(getmaxy-internal (window-c-pointer win))))
|
|
|
|
(import-lambda-definition getmaxx-internal
|
|
(win)
|
|
"scsh_getmaxx")
|
|
(define getmaxx
|
|
(lambda (win)
|
|
(getmaxx-internal (window-c-pointer win))))
|
|
|
|
|
|
;;eine Position zurueck
|
|
|
|
(define backspace
|
|
(lambda (win)
|
|
(let ((y (gety win))
|
|
(x (getx win))
|
|
(cols (getmaxx win)))
|
|
(if (and (= 0 y) (= 0 x))
|
|
(if (equal? #\space (winch win))
|
|
(values)
|
|
(begin
|
|
(wdelch win)
|
|
(wrefresh win)))
|
|
(if (= 0 x)
|
|
(begin
|
|
(wmove win y 0)
|
|
(wrefresh win)
|
|
(if (equal? #\space (winch win))
|
|
(begin
|
|
(wmove win (- y 1) (- cols 1))
|
|
(wdelch win)
|
|
(wrefresh win))
|
|
(begin
|
|
(wdelch win)
|
|
(wrefresh win))))
|
|
(begin
|
|
(wdelch win)
|
|
(wrefresh win)))))))
|
|
|
|
(define back
|
|
(lambda (win)
|
|
(let ((y (gety win))
|
|
(x (getx win))
|
|
(cols (getmaxx win)))
|
|
(if (and (= 0 y) (= 0 x))
|
|
(values)
|
|
(if (= 0 x)
|
|
(begin
|
|
(wmove win (- y 1) (- cols 1))
|
|
(wrefresh win))
|
|
(begin
|
|
(wmove win y (- x 1))
|
|
(wrefresh win)))))))
|
|
|
|
(import-lambda-definition get-terminal-window-size/internal
|
|
(file-descriptor)
|
|
"scsh_get_term_window_size")
|
|
|
|
(define (get-terminal-window-size file-descriptor)
|
|
(apply values
|
|
(get-terminal-window-size/internal file-descriptor)))
|
|
|
|
(import-lambda-definition set-terminal-window-size!
|
|
(file-descriptor rows columns x-pixels y-pixels)
|
|
"scsh_set_term_window_size")
|
|
|
|
|