Blob


1 (defpackage #:phos/ui
2 (:documentation "User Interface for phos")
3 (:use #:cl #:nodgui))
5 (in-package #:phos/ui)
7 (defparameter *title-1-font* "serif 22"
8 "Font for the level 1 title.")
10 (defparameter *title-2-font* "serif 19"
11 "Font for the level 2 title.")
13 (defparameter *title-3-font* "serif 16"
14 "Font for the level 3 title.")
16 (defparameter *verbatim-font* "monospace 12"
17 "Font for the verbatim element.")
19 (defparameter *item-font* "serif 12"
20 "Font for the item.")
22 (defparameter *link-font* "serif 12"
23 "Font for the links.")
25 (defparameter *blockquote-font* "serif 12 italic"
26 "Font for the quotations.")
28 (defparameter *paragraph-font* "serif 12"
29 "Font for the normal text")
31 (defparameter *url-bar* nil)
32 (defparameter *window-content* nil)
34 (defparameter *current-url* nil)
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)
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)))))
59 (defgeneric render (obj frame)
60 (:documentation "Render OBJ in the nodgui FRAME"))
62 (defmethod render ((l list) f)
63 (dolist (el l)
64 (render el f)))
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))))
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))))
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))))
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))))
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"))))
122 (defmethod render ((v gemtext:verbatim) f)
123 (with-slots ((text phos/gemtext:text)
124 (alt phos/gemtext:alt))
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)))))
139 (defun clear-window ()
140 (pack-forget-all *window-content*))
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 body) (gemini:request url)
150 (declare (ignore status))
151 (clear-window)
152 (render (gemtext:parse-string body)
153 *window-content*))))
155 (defun navigate-button-cb ()
156 (navigate-to (quri:uri (string-trim '(#\newline #\space)
157 (text *url-bar*)))))
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))))
181 ;; (nodgui.demo:demo)
183 ;; (main "gemini://gemini.omarpolo.com/")