Date:

Mon Jan 17 11:25:33 2022 UTC

Message:

fix ui after api change see #7

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