/
ncurses.lisp
240 lines (215 loc) · 7.19 KB
/
ncurses.lisp
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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
(declaim #+sbcl(sb-ext:muffle-conditions style-warning))
(in-package :cl-ncurses)
;; load other files
(load "user-settings.lisp")
(load "utilities.lisp")
(load "hn.lisp")
;; initialize ncurses
(initscr)
(start-color)
(assume-default-colors color_white color_black) ;;these two lines set the background black
(cbreak)
(noecho)
;; colors
(defparameter *banner-color-number* 1)
(init-pair *banner-color-number* color_black color_white)
(defparameter *highlight-color-number* 2)
(init-pair *highlight-color-number* color_cyan color_black)
(defparameter *error-color-number* 3)
(init-pair *error-color-number* color_white color_red)
;; windows and pads
(defparameter bannerwin nil)
(defparameter mypad nil) ;;scrolling area where the data goes
(defparameter instrwin nil)
(defparameter cmdwin nil)
(defparameter hndlwin nil)
;; other globals
(defparameter curmaxx 0)
(defparameter curmaxy 0)
;; helper functions
(defun pad-visible-lines ()
(- (getmaxy *stdscr*) 8))
(defun instrwiny ()
(- (getmaxy *stdscr*) 5))
(defun cmdwiny ()
(- (getmaxy *stdscr*) 2))
(defun hndlwiny ()
(- (getmaxy *stdscr*) 1))
(defun lines-needed (char-count max-width)
(if (zerop char-count)
1
(multiple-value-bind (q r) (truncate char-count max-width)
(if (zerop r)
q
(1+ q)))))
(defun pad-lines-needed (items max-width)
(reduce #'+
(mapcar (lambda (item)
(reduce #'+
(mapcar (lambda (str) (lines-needed (length str) max-width)) item)))
items)))
(defun build-screen (page &optional (text nil))
(clear)
(refresh)
(erase) ;; start by blanking out the screen
;; set current screen values
(setf curmaxy (getmaxy *stdscr*))
(setf curmaxx (getmaxx *stdscr*))
;; print banner and subtitle
(setf bannerwin (newwin 4 curmaxx 0 0))
(wattron bannerwin (color-pair *banner-color-number*))
(mvwprintw bannerwin 1 0 (format nil "Hacker news - ~a" (title-str page)))
(wattroff bannerwin (color-pair *banner-color-number*))
(mvwprintw bannerwin 2 0 (subtitle-str page))
;; build pad
(let* ((items (printable-items page curmaxx))
(total-lines-needed (pad-lines-needed items curmaxx)))
(setf (hn-page-total-lines-needed page) total-lines-needed)
(setf mypad (newpad total-lines-needed curmaxx))
(wattron mypad (color-pair *highlight-color-number*))
(loop for item in items
do
(loop for line in item
do
(loop for char across line
do
(waddch mypad (char-code char)))
(waddch mypad (char-code #\newline))
))
(wattroff mypad (color-pair *highlight-color-number*)))
;; print instructions
(setf instrwin (newwin 2 curmaxx (instrwiny) 0))
(wprintw instrwin (instructions-str page))
;; command window
(mvprintw (cmdwiny) 0 ">")
(setf cmdwin (newwin 1 curmaxx (cmdwiny) 2))
(when text
(wprintw cmdwin (text-to-str text))) ;; reposition the text back into the command bar
;; handle command window
(setf hndlwin (newwin 1 curmaxx (hndlwiny) 0))
;; refresh all windows and pads
(refresh)
(wrefresh bannerwin)
(prefresh mypad (hn-page-scroll-pos page) 0 4 0 (pad-visible-lines) curmaxx)
(wrefresh instrwin)
(wrefresh cmdwin)
(wrefresh hndlwin)
;; position the cursor
(wmove cmdwin (getcury cmdwin) (getcurx cmdwin)))
(defun print-error (text)
(wclear hndlwin)
(wattron hndlwin (color-pair *error-color-number*))
(wprintw hndlwin text)
(wattroff hndlwin (color-pair *error-color-number*))
(wrefresh hndlwin))
(defun get-scroll-dir ()
(let ((ch (wgetch cmdwin)))
(cond
((eq ch (char-code #\O)) ;; home and end keys
(let ((ch (wgetch cmdwin)))
(cond((eq ch (char-code #\H)) 'home)
((eq ch (char-code #\F)) 'end))))
((eq ch (char-code #\[)) ;; arrow keys and whatnot
(let ((ch (wgetch cmdwin)))
(cond ((eq ch (char-code #\B)) 'down)
((eq ch (char-code #\A)) 'up)
((eq ch (char-code #\6))
(wgetch cmdwin) ;; clean off trailing ~
'page-down)
((eq ch (char-code #\5))
(wgetch cmdwin) ;; clean off trailing ~
'page-up)))))))
(defun pad-scroll (page dir text)
(let* ((total-lines-needed (hn-page-total-lines-needed page))
(scroll-pos (hn-page-scroll-pos page))
(end-position (- total-lines-needed
(- (pad-visible-lines)
(length (car (reverse (printable-items page curmaxx))))))))
(when (or (eq dir 'home)
(eq dir 'end)
(and (< scroll-pos end-position)
(or (eq dir 'down)
(eq dir 'page-down)))
(and (> scroll-pos 0)
(or (eq dir 'up)
(eq dir 'page-up))))
(let ((dir-func (cond ((eq dir 'down) (lambda () (1+ scroll-pos)))
((eq dir 'page-down) (lambda ()
(let ((new-pos (+ scroll-pos (pad-visible-lines))))
(if (>= new-pos end-position)
end-position
new-pos))))
((eq dir 'up) (lambda () (1- scroll-pos)))
((eq dir 'page-up) (lambda ()
(let ((new-pos (- scroll-pos (pad-visible-lines))))
(if (< new-pos 0)
0
new-pos))))
((eq dir 'home) (lambda () 0))
((eq dir 'end) (lambda () end-position))
(t #'identity)
)))
(setf (hn-page-scroll-pos page) (funcall dir-func)))
;; erase cruft at end of window by rebuilding the screen
(let ((scroll-pos (hn-page-scroll-pos page)))
(when (> (pad-visible-lines) (- total-lines-needed scroll-pos))
(build-screen page text))
(prefresh mypad scroll-pos 0 4 0 (pad-visible-lines) curmaxx)))))
(defun main (page &optional (text nil))
(if (not (and (eq curmaxx (getmaxx *stdscr*))
(eq curmaxy (getmaxy *stdscr*))))
(progn
(build-screen page text)
(main page text)) ;; rebuild the screen if the terminal width or height changed
(let ((ch (wgetch cmdwin)))
(cond ((eq ch 27) ;; 27 is the escape code for arrow keys, home, end, and page keys
(let ((y (getcury cmdwin))
(x (getcurx cmdwin))
(dir (get-scroll-dir)))
(when dir
(progn
(funcall #'pad-scroll page dir text)
(wmove cmdwin y x))))
(main page text)) ;; scrolling / paging
((eq ch (char-code #\newline))
(wclear cmdwin)
(wclear hndlwin)
(let ((cmd (text-to-str text)))
(if (equal cmd "q")
(endwin) ;; end the program
(handler-case
(progn
(wclear cmdwin)
(wclear hndlwin)
(wprintw hndlwin "Loading...")
(wrefresh hndlwin)
(let* ((new-page (handle-cmd cmd page))
(message (hn-page-message page)))
(build-screen new-page)
(when message
(print-error message)
(setf (hn-page-message page) nil))
(main new-page)))
(error (e)
(progn
(print-error (format nil "~S" e))
(main page))
))))) ;; <enter> was clicked
((or (eq ch (char-code #\delete))
(eq ch (char-code #\backspace)))
(let ((y (getcury cmdwin))
(x (getcurx cmdwin)))
(mvwdelch cmdwin y (1- x)))
(wrefresh cmdwin)
(main page (cdr text))) ;; <backspace> was clicked
((and (>= ch 32)
(<= ch 126))
(waddch cmdwin ch)
(wrefresh cmdwin)
(main page (cons ch text))) ;; printable characters
(t (main page text)) ;; anything else was clicked
))))
;; launch the application here
(let ((page (build-home-page #'hn-news-url)))
(build-screen page)
(main page))