blob: bbb030e5f454e88e64facae6fc4f2c456148e149 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
;;; Commentary:
;; I don't curse, I'm just vulgar.
;;; Code:
(define-module (vulgar)
:use-module (srfi srfi-60)
:use-module (vulgar termios)
:use-module (hnh util)
:export (cls set-cursor-pos with-vulgar))
(define (cls)
;; [H]ome, [J]: clear everything after
(display "\x1b[H\x1b[J"))
(define (set-cursor-pos x y)
(format #t "\x1b[~a;~aH"
(1+ y) (1+ x)))
(define (with-vulgar . args)
(apply
(case-lambda
((thunk)
(with-vulgar (bitwise-not (bitwise-ior ECHO ICANON))
thunk))
((bits thunk)
(let ((ifd (current-input-port))
(ofd (current-output-port))
(iattr (make-termios))
(oattr (make-termios))
(iattr* #f)
(oattr* #f))
(dynamic-wind
(lambda ()
(tcgetattr! iattr ifd)
(tcgetattr! oattr ofd)
;; Store current settings to enable resetting the terminal later
(set! iattr* (copy-termios iattr)
oattr* (copy-termios oattr)
(lflag iattr) (bitwise-and bits (lflag iattr))
(lflag oattr) (bitwise-and bits (lflag oattr)))
(tcsetattr! iattr ifd)
(tcsetattr! oattr ofd)
(format #t "\x1b[?1049h")
(system "tput civis"))
thunk
(lambda ()
(tcsetattr! iattr* ifd)
(tcsetattr! oattr* ofd)
(format #t "\x1b[?1049l")
(system "tput cnorm")
)))))
args))
|
