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