Blame


1 4384f8ca 2022-01-14 op (defpackage #:phos/ui
2 4384f8ca 2022-01-14 op (:documentation "User Interface for phos")
3 4384f8ca 2022-01-14 op (:use #:cl #:nodgui))
4 4384f8ca 2022-01-14 op
5 6b4d9ef2 2020-11-09 op (in-package #:phos/ui)
6 6b4d9ef2 2020-11-09 op
7 073b25eb 2020-11-09 op (defparameter *title-1-font* "serif 22"
8 073b25eb 2020-11-09 op "Font for the level 1 title.")
9 073b25eb 2020-11-09 op
10 073b25eb 2020-11-09 op (defparameter *title-2-font* "serif 19"
11 073b25eb 2020-11-09 op "Font for the level 2 title.")
12 073b25eb 2020-11-09 op
13 073b25eb 2020-11-09 op (defparameter *title-3-font* "serif 16"
14 073b25eb 2020-11-09 op "Font for the level 3 title.")
15 073b25eb 2020-11-09 op
16 073b25eb 2020-11-09 op (defparameter *verbatim-font* "monospace 12"
17 073b25eb 2020-11-09 op "Font for the verbatim element.")
18 073b25eb 2020-11-09 op
19 073b25eb 2020-11-09 op (defparameter *item-font* "serif 12"
20 073b25eb 2020-11-09 op "Font for the item.")
21 073b25eb 2020-11-09 op
22 073b25eb 2020-11-09 op (defparameter *link-font* "serif 12"
23 073b25eb 2020-11-09 op "Font for the links.")
24 073b25eb 2020-11-09 op
25 5d775344 2022-01-13 op (defparameter *blockquote-font* "serif 12 italic"
26 5d775344 2022-01-13 op "Font for the quotations.")
27 5d775344 2022-01-13 op
28 073b25eb 2020-11-09 op (defparameter *paragraph-font* "serif 12"
29 073b25eb 2020-11-09 op "Font for the normal text")
30 073b25eb 2020-11-09 op
31 59eabf3e 2020-11-11 op (defparameter *url-bar* nil)
32 073b25eb 2020-11-09 op (defparameter *window-content* nil)
33 073b25eb 2020-11-09 op
34 073b25eb 2020-11-09 op (defparameter *current-url* nil)
35 073b25eb 2020-11-09 op
36 59eabf3e 2020-11-11 op (defun join-paths (url path query)
37 59eabf3e 2020-11-11 op (setf (quri:uri-query url) query)
38 59eabf3e 2020-11-11 op (if (uiop:string-prefix-p "/" path)
39 59eabf3e 2020-11-11 op (setf (quri:uri-path url) path)
40 59eabf3e 2020-11-11 op (let ((p (quri:uri-path url)))
41 59eabf3e 2020-11-11 op (setf (quri:uri-path url)
42 59eabf3e 2020-11-11 op (format nil "~a~a"
43 59eabf3e 2020-11-11 op (if (uiop:string-suffix-p "/" p)
44 59eabf3e 2020-11-11 op p
45 59eabf3e 2020-11-11 op (directory-namestring p))
46 59eabf3e 2020-11-11 op path))))
47 59eabf3e 2020-11-11 op url)
48 59eabf3e 2020-11-11 op
49 59eabf3e 2020-11-11 op (defun navigate-to (uri)
50 59eabf3e 2020-11-11 op (let ((hostname (quri:uri-host uri))
51 59eabf3e 2020-11-11 op (path (quri:uri-path uri))
52 59eabf3e 2020-11-11 op (query (quri:uri-query uri)))
53 59eabf3e 2020-11-11 op (if hostname
54 59eabf3e 2020-11-11 op (do-render uri)
55 59eabf3e 2020-11-11 op (do-render (join-paths (quri:copy-uri *current-url*)
56 59eabf3e 2020-11-11 op path
57 59eabf3e 2020-11-11 op query)))))
58 59eabf3e 2020-11-11 op
59 6b4d9ef2 2020-11-09 op (defgeneric render (obj frame)
60 073b25eb 2020-11-09 op (:documentation "Render OBJ in the nodgui FRAME"))
61 6b4d9ef2 2020-11-09 op
62 6b4d9ef2 2020-11-09 op (defmethod render ((l list) f)
63 6b4d9ef2 2020-11-09 op (dolist (el l)
64 6b4d9ef2 2020-11-09 op (render el f)))
65 6b4d9ef2 2020-11-09 op
66 6b4d9ef2 2020-11-09 op (defmethod render ((title gemtext:title) f)
67 073b25eb 2020-11-09 op (with-slots ((text phos/gemtext:text)
68 6b4d9ef2 2020-11-09 op (level phos/gemtext:level))
69 6b4d9ef2 2020-11-09 op title
70 6b4d9ef2 2020-11-09 op (let ((w (make-instance 'label
71 6b4d9ef2 2020-11-09 op :master f
72 073b25eb 2020-11-09 op :font (case level
73 073b25eb 2020-11-09 op (1 *title-1-font*)
74 073b25eb 2020-11-09 op (2 *title-2-font*)
75 073b25eb 2020-11-09 op (3 *title-3-font*))
76 54fe3a5e 2022-01-14 op :text (format nil "~v{~A~:*~} ~a"
77 54fe3a5e 2022-01-14 op level '("#") text))))
78 59eabf3e 2020-11-11 op (pack w :side :top :fill :both :expand t))))
79 6b4d9ef2 2020-11-09 op
80 6b4d9ef2 2020-11-09 op (defmethod render ((link gemtext:link) f)
81 6b4d9ef2 2020-11-09 op (with-slots ((text phos/gemtext:text)
82 6b4d9ef2 2020-11-09 op (url phos/gemtext:url))
83 6b4d9ef2 2020-11-09 op link
84 6b4d9ef2 2020-11-09 op (let ((w (make-instance 'button
85 6b4d9ef2 2020-11-09 op :master f
86 073b25eb 2020-11-09 op ;; :font *link-font*
87 073b25eb 2020-11-09 op :text (format nil "~a" (or text url))
88 073b25eb 2020-11-09 op :command (lambda ()
89 59eabf3e 2020-11-11 op (navigate-to url)))))
90 59eabf3e 2020-11-11 op (pack w :side :top :fill :both :expand t))))
91 6b4d9ef2 2020-11-09 op
92 6b4d9ef2 2020-11-09 op (defmethod render ((item gemtext:item) f)
93 6b4d9ef2 2020-11-09 op (with-slots ((text phos/gemtext:text)) item
94 6b4d9ef2 2020-11-09 op (let ((w (make-instance 'label
95 6b4d9ef2 2020-11-09 op :master f
96 073b25eb 2020-11-09 op :font *item-font*
97 6b4d9ef2 2020-11-09 op :text (format nil "* ~a" text))))
98 59eabf3e 2020-11-11 op (pack w :side :top :fill :both :expand t))))
99 6b4d9ef2 2020-11-09 op
100 5d775344 2022-01-13 op (defmethod render ((q gemtext:blockquote) f)
101 5d775344 2022-01-13 op (with-slots ((text gemtext:text)) q
102 5d775344 2022-01-13 op (let ((w (make-instance 'message
103 5d775344 2022-01-13 op :master f
104 5d775344 2022-01-13 op :font *blockquote-font*
105 5d775344 2022-01-13 op :justify :left
106 5d775344 2022-01-13 op :text text
107 5d775344 2022-01-13 op :width 600)))
108 5d775344 2022-01-13 op (pack w :side :top :fill :both :expand t))))
109 5d775344 2022-01-13 op
110 6b4d9ef2 2020-11-09 op (defmethod render ((par gemtext:paragraph) f)
111 6b4d9ef2 2020-11-09 op (with-slots ((text phos/gemtext:text)) par
112 59eabf3e 2020-11-11 op (let ((w (make-instance 'message
113 6b4d9ef2 2020-11-09 op :master f
114 073b25eb 2020-11-09 op :font *paragraph-font*
115 59eabf3e 2020-11-11 op :justify "left"
116 59eabf3e 2020-11-11 op :text text
117 59eabf3e 2020-11-11 op :width 600)))
118 59eabf3e 2020-11-11 op ;; (setf (text w) text)
119 59eabf3e 2020-11-11 op ;; (configure w :state "disabled")
120 59eabf3e 2020-11-11 op (pack w :side :top :expand t :anchor "w"))))
121 6b4d9ef2 2020-11-09 op
122 6b4d9ef2 2020-11-09 op (defmethod render ((v gemtext:verbatim) f)
123 6b4d9ef2 2020-11-09 op (with-slots ((text phos/gemtext:text)
124 6b4d9ef2 2020-11-09 op (alt phos/gemtext:alt))
125 6b4d9ef2 2020-11-09 op v
126 6b4d9ef2 2020-11-09 op (let ((w (make-instance 'label
127 6b4d9ef2 2020-11-09 op :master f
128 073b25eb 2020-11-09 op :font *verbatim-font*
129 073b25eb 2020-11-09 op :text text)))
130 59eabf3e 2020-11-11 op (pack w :side :top :fill :both :expand t)
131 073b25eb 2020-11-09 op (when alt
132 073b25eb 2020-11-09 op (pack (make-instance 'label
133 073b25eb 2020-11-09 op :master f
134 073b25eb 2020-11-09 op :text alt)
135 59eabf3e 2020-11-11 op :side :top
136 59eabf3e 2020-11-11 op :fill :both
137 59eabf3e 2020-11-11 op :expand t)))))
138 6b4d9ef2 2020-11-09 op
139 073b25eb 2020-11-09 op (defun clear-window ()
140 073b25eb 2020-11-09 op (pack-forget-all *window-content*))
141 6b4d9ef2 2020-11-09 op
142 073b25eb 2020-11-09 op (defun do-render (url)
143 59eabf3e 2020-11-11 op (let* ((uri (quri:uri url)))
144 59eabf3e 2020-11-11 op (setf *current-url* uri)
145 59eabf3e 2020-11-11 op (setf (text *url-bar*) url)
146 073b25eb 2020-11-09 op (clear-window)
147 073b25eb 2020-11-09 op (render (gemtext:parse-string "# loading...")
148 073b25eb 2020-11-09 op *window-content*)
149 073b25eb 2020-11-09 op (multiple-value-bind (status body) (gemini:request url)
150 073b25eb 2020-11-09 op (declare (ignore status))
151 59eabf3e 2020-11-11 op (clear-window)
152 59eabf3e 2020-11-11 op (render (gemtext:parse-string body)
153 073b25eb 2020-11-09 op *window-content*))))
154 6b4d9ef2 2020-11-09 op
155 59eabf3e 2020-11-11 op (defun navigate-button-cb ()
156 54fe3a5e 2022-01-14 op (navigate-to (quri:uri (string-trim '(#\newline #\space)
157 54fe3a5e 2022-01-14 op (text *url-bar*)))))
158 59eabf3e 2020-11-11 op
159 073b25eb 2020-11-09 op (defun main (url)
160 073b25eb 2020-11-09 op (with-nodgui (:title "phos")
161 59eabf3e 2020-11-11 op (set-geometry *tk* 800 600 0 0)
162 59eabf3e 2020-11-11 op (let* ((nav (make-instance 'frame))
163 59eabf3e 2020-11-11 op (back-btn (make-instance 'button :text "←" :master nav))
164 59eabf3e 2020-11-11 op (forw-btn (make-instance 'button :text "→" :master nav))
165 54fe3a5e 2022-01-14 op (go-btn (make-instance 'button :text "GO!" :master nav
166 54fe3a5e 2022-01-14 op :command #'navigate-button-cb))
167 59eabf3e 2020-11-11 op (url-bar (make-instance 'text :height 1 :master nav))
168 54fe3a5e 2022-01-14 op (sf (make-instance 'scrolled-frame :padding 10
169 54fe3a5e 2022-01-14 op :takefocus nil)))
170 59eabf3e 2020-11-11 op (setf *url-bar* url-bar)
171 073b25eb 2020-11-09 op (setf *window-content* (interior sf))
172 59eabf3e 2020-11-11 op (setf (text url-bar) "about:phos")
173 59eabf3e 2020-11-11 op (pack nav :fill :both)
174 59eabf3e 2020-11-11 op (pack back-btn :side :left)
175 59eabf3e 2020-11-11 op (pack forw-btn :side :left)
176 59eabf3e 2020-11-11 op (pack url-bar :side :left :expand t :fill :both)
177 59eabf3e 2020-11-11 op (pack go-btn :side :left)
178 073b25eb 2020-11-09 op (pack sf :side :top :fill :both :expand t)
179 073b25eb 2020-11-09 op (do-render url))))
180 073b25eb 2020-11-09 op
181 073b25eb 2020-11-09 op ;; (nodgui.demo:demo)
182 073b25eb 2020-11-09 op
183 073b25eb 2020-11-09 op ;; (main "gemini://gemini.omarpolo.com/")