guile-termenv/termenv/screen.scm

196 lines
6.9 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
scroll-up
scroll-down
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 #:optional (port #t))
"Reset the terminal to its default style, removing any active styles"
(format port (string-append %CSI "0m")))
(define* (set-foreground-color hex #:optional (port #t))
"Sets the default foreground color"
(format port (string-append %OSC %SET-FOREGROUND-COLOR) (color-styled (make-foreground hex))))
(define* (set-background-color hex #:optional (port #t))
"Sets the default background color"
(format port (string-append %OSC %SET-BACKGROUND-COLOR) (color-styled (make-background hex))))
(define* (set-cursor-color hex #:optional (port #t))
"Sets the cursor color"
(format port (string-append %OSC %SET-CURSOR-COLOR) (color-styled (make-foreground hex))))
(define* (restore-screen #:optional (port #t))
"Restores a previously saved screen state"
(format port (string-append %CSI %RESTORE-SCREEN)))
(define* (save-screen #:optional (port #t))
"Saves the screen state"
(format port (string-append %CSI %SAVE-SCREEN)))
(define* (alt-screen #:optional (port #t))
"Switches to the alternate screen buffer. The former view can be restored with exit-alt-screen"
(format port (string-append %CSI %ALT-SCREEN)))
(define* (exit-alt-screen #:optional (port #t))
"Exits the alternate screen buffer and returns to the former terminal window"
(format port (string-append %CSI %EXIT-ALT-SCREEN)))
(define* (clear-screen #:optional (port #t))
"Clears the visible portion of the terminal"
(format port (string-append %CSI %ERASE-DISPLAY) 2)
(move-cursor port 1 1))
(define* (scroll-up #:optional (amount 1) (port #t))
(format port (string-append %CSI %SCROLL-UP) amount))
(define* (scroll-down #:optional (amount 1) (port #t))
(format port (string-append %CSI %SCROLL-DOWN) amount))
(define* (move-cursor y x #:optional (port #t))
"Moves the cursor to a given position"
(format port (string-append %CSI %CURSOR-POSITION) y x))
(define* (hide-cursor #:optional (port #t))
"Hides the cursor"
(format port (string-append %CSI %HIDE-CURSOR)))
(define* (show-cursor #:optional (port #t))
"Shows the cursor"
(format port (string-append %CSI %SHOW-CURSOR)))
(define* (save-cursor-position #:optional (port #t))
"Saves the cursor position"
(format port (string-append %CSI %SAVE-CURSOR-POSITION)))
(define* (restore-cursor-position #:optional (port #t))
"Restores a saved cursor position"
(format port (string-append %CSI %RESTORE-CURSOR-POSITION)))
(define* (cursor-up #:optional (distance 1) (port #t))
"Moves the cursor up a given number of lines"
(format port (string-append %CSI %CURSOR-UP) distance))
(define* (cursor-down #:optional (distance 1) (port #t))
"Moves the cursor down a given number of lines"
(format port (string-append %CSI %CURSOR-DOWN) distance))
(define* (cursor-forward #:optional (distance 1) (port #t))
"Moves the cursor forward a given number of lines"
(format port (string-append %CSI %CURSOR-FORWARD) distance))
(define* (cursor-back #:optional (distance 1) (port #t))
"Moves the cursor backwards a given number of lines"
(format port (string-append %CSI %CURSOR-BACK) distance))
(define* (cursor-next-line #:optional (distance 1) (port #t))
"Moves the cursor down a given number of lines and places it at the beginning of the line"
(format port (string-append %CSI %CURSOR-NEXT-LINE) distance))
(define* (cursor-prev-line #:optional (distance 1) (port #t))
"Moves the cursor up a given number of lines and places it at the beginning of the line"
(format port (string-append %CSI %CURSOR-PREV-LINE) distance))
(define* (clear-line #:optional (port #t))
"Clears the current line"
(format port (string-append %CSI %ERASE-ENTIRE-LINE)))
(define* (clear-line-left #:optional (port #t))
"Clears the line to the left of the cursor"
(format port (string-append %CSI %ERASE-LINE-LEFT)))
(define* (clear-line-right #:optional (port #t))
"Clears the line to the right of the cursor"
(format port (string-append %CSI %ERASE-LINE-RIGHT)))
(define* (clear-lines n #:optional (port #t))
"Clears a given number of lines"
(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 top bottom #:optional (port #t))
"Sets the scrolling region of the terminal"
(format port (string-append %CSI %CHANGE-SCROLLING-REGION) top bottom))
(define* (insert-lines n #:optional (port #t))
"Inserts the given number of lines at the top of the scrollable region, pushing lines below down"
(format port (string-append %CSI %INSERT-LINE) n))
(define* (delete-lines n #:optional (port #t))
"Deletes the given number of lines, pulling any lines in the scrollable region below up"
(format port (string-append %CSI %DELETE-LINE) n))
(define* (set-window-title title #:optional (port #t))
"Sets the terminal window title"
(format port (string-append %OSC %SET-WINDOW-TITLE) title))