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