blob: 5ddea738a430c45c6eac5f3ce316081e299e94fc (
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
|
;;; 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 (with-vulgar))
(define-public (cls)
;; [H]ome, [J]: clear everything after
(display "\x1b[H\x1b[J"))
(define-public (set-cursor-pos x y)
(format #t "\x1b[~a;~aH"
(1+ y) (1+ x)))
(define-syntax with-vulgar
(syntax-rules ()
((_ 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* oattr*)
(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)
(system "tput civis"))
thunk
(lambda ()
(tcsetattr! iattr* ifd)
(tcsetattr! oattr* ofd)
(system "tput cnorm")
))))))
|
