160 lines
4.8 KiB
Scheme
160 lines
4.8 KiB
Scheme
(define-module (termenv screen)
|
|
#:use-module (termenv)
|
|
#:use-module (termenv color)
|
|
#:export (reset
|
|
set-foreground-color
|
|
set-background-color
|
|
set-cursor-color
|
|
restore-screen
|
|
save-screen
|
|
alt-screen
|
|
exit-alt-screen
|
|
clear-screen
|
|
move-cursor
|
|
hide-cursor
|
|
show-cursor
|
|
save-cursor-position
|
|
restore-cursor-position
|
|
cursor-up
|
|
cursor-down
|
|
cursor-forward
|
|
cursor-back
|
|
cursor-next-line
|
|
cursor-prev-line
|
|
clear-line
|
|
clear-line-left
|
|
clear-line-right
|
|
clear-lines
|
|
change-scrolling-region
|
|
insert-lines
|
|
delete-lines
|
|
set-window-title))
|
|
|
|
(define %CURSOR-UP "~dA")
|
|
(define %CURSOR-DOWN "~dB")
|
|
(define %CURSOR-FORWARD "~dC")
|
|
(define %CURSOR-BACK "~dD")
|
|
(define %CURSOR-NEXT-LINE "~dE")
|
|
(define %CURSOR-PREV-LINE "~dF")
|
|
(define %HORIZONTAL "~dG")
|
|
(define %CURSOR-POSITION "~d;~dH")
|
|
(define %ERASE-DISPLAY "~dJ")
|
|
(define %ERASE-LINE "~dK")
|
|
(define %SCROLL-UP "~dS")
|
|
(define %SCROLL-DOWN "~dT")
|
|
(define %SAVE-CURSOR-POSITION "s")
|
|
(define %RESTORE-CURSOR-POSITION "u")
|
|
(define %CHANGE-SCROLLING-REGION "~d;~dr")
|
|
(define %INSERT-LINE "~dL")
|
|
(define %DELETE-LINE "~dM")
|
|
|
|
(define %ERASE-LINE-RIGHT "0K")
|
|
(define %ERASE-LINE-LEFT "1K")
|
|
(define %ERASE-ENTIRE-LINE "2K")
|
|
|
|
;; TODO mouse?
|
|
|
|
(define %RESTORE-SCREEN "?47l")
|
|
(define %SAVE-SCREEN "?47h")
|
|
(define %ALT-SCREEN "?1049h")
|
|
(define %EXIT-ALT-SCREEN "?1049l")
|
|
|
|
;; TODO bracketed paste?
|
|
|
|
(define %SET-WINDOW-TITLE (string-append "2;~a" %BEL))
|
|
(define %SET-FOREGROUND-COLOR (string-append "10;~a" %BEL))
|
|
(define %SET-BACKGROUND-COLOR (string-append "11;~a" %BEL))
|
|
(define %SET-CURSOR-COLOR (string-append "12;~a" %BEL))
|
|
(define %SHOW-CURSOR "?25h")
|
|
(define %HIDE-CURSOR "?25l")
|
|
|
|
(define (reset port)
|
|
(format port (string-append %CSI "0m")))
|
|
|
|
(define (set-foreground-color port r g b)
|
|
(format port (string-append %OSC %SET-FOREGROUND-COLOR) (make-color r g b)))
|
|
|
|
(define (set-background-color port r g b)
|
|
(format port (string-append %OSC %SET-BACKGROUND-COLOR) (make-color r g b)))
|
|
|
|
(define (set-cursor-color port r g b)
|
|
(format port (string-append %OSC %SET-CURSOR-COLOR) (make-color r g b)))
|
|
|
|
(define (restore-screen port)
|
|
(format port (string-append %CSI %RESTORE-SCREEN)))
|
|
|
|
(define (save-screen port)
|
|
(format port (string-append %CSI %SAVE-SCREEN)))
|
|
|
|
(define (alt-screen port)
|
|
(format port (string-append %CSI %ALT-SCREEN)))
|
|
|
|
(define (exit-alt-screen port)
|
|
(format port (string-append %CSI %EXIT-ALT-SCREEN)))
|
|
|
|
(define (clear-screen port)
|
|
(format port (string-append %CSI %ERASE-DISPLAY) 2)
|
|
(move-cursor port 1 1))
|
|
|
|
(define (move-cursor port y x)
|
|
(format port (string-append %CSI %CURSOR-POSITION) y x))
|
|
|
|
(define (hide-cursor port)
|
|
(format port (string-append %CSI %HIDE-CURSOR)))
|
|
|
|
(define (show-cursor port)
|
|
(format port (string-append %CSI %SHOW-CURSOR)))
|
|
|
|
(define (save-cursor-position port)
|
|
(format port (string-append %CSI %SAVE-CURSOR-POSITION)))
|
|
|
|
(define (restore-cursor-position port)
|
|
(format port (string-append %CSI %RESTORE-CURSOR-POSITION)))
|
|
|
|
(define* (cursor-up port #:optional (distance 1))
|
|
(format port (string-append %CSI %CURSOR-UP) distance))
|
|
|
|
(define* (cursor-down port #:optional (distance 1))
|
|
(format port (string-append %CSI %CURSOR-DOWN) distance))
|
|
|
|
(define* (cursor-forward port #:optional (distance 1))
|
|
(format port (string-append %CSI %CURSOR-FORWARD) distance))
|
|
|
|
(define* (cursor-back port #:optional (distance 1))
|
|
(format port (string-append %CSI %CURSOR-BACK) distance))
|
|
|
|
(define* (cursor-next-line port #:optional (distance 1))
|
|
(format port (string-append %CSI %CURSOR-NEXT-LINE) distance))
|
|
|
|
(define* (cursor-prev-line port #:optional (distance 1))
|
|
(format port (string-append %CSI %CURSOR-PREV-LINE) distance))
|
|
|
|
(define (clear-line port)
|
|
(format port (string-append %CSI %ERASE-ENTIRE-LINE)))
|
|
|
|
(define (clear-line-left port)
|
|
(format port (string-append %CSI %ERASE-LINE-LEFT)))
|
|
|
|
(define (clear-line-right port)
|
|
(format port (string-append %CSI %ERASE-LINE-RIGHT)))
|
|
|
|
(define (clear-lines port n)
|
|
(define clear (format #f (string-append %CSI %ERASE-LINE) 2))
|
|
(define up (format #f (string-append %CSI %CURSOR-UP) 1))
|
|
(define l (make-list n (string-append up clear)))
|
|
(format port (string-append clear (string-join l ""))))
|
|
|
|
(define (change-scrolling-region port top bottom)
|
|
(format port (string-append %CSI %CHANGE-SCROLLING-REGION) top bottom))
|
|
|
|
(define (insert-lines port n)
|
|
(format port (string-append %CSI %INSERT-LINE) n))
|
|
|
|
(define (delete-lines port n)
|
|
(format port (string-append %CSI %DELETE-LINE) n))
|
|
|
|
(define (set-window-title port title)
|
|
(format port (string-append %OSC %SET-WINDOW-TITLE) title))
|
|
|
|
;; TODO: use parameters like (with-position) and (with-color)
|