cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-01-21 03:15:35 +01:00
Code Issues

- [GUI] optimized rendering of gemtext when scaling command is launched.

Browse Source 
Previously a  new RPC call was  performed to get the  gemtext lines,
  now the version cached by the client is used.
This commit is contained in:
cage 2023-06-02 09:58:18 +02:00
parent fa239261ca
commit 57130c6ae5
1 changed files with 108 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

185
src/gui/client/main-window.lisp
View File

@ -520,15 +520,33 @@
gemtext-font-scaling)) gemtext-font-scaling))
(gui:tag-raise gemtext-widget (gui:match-tag-name match))))))) (gui:tag-raise gemtext-widget (gui:match-tag-name match)))))))
(defun collect-ir-lines (request-iri main-window lines) (defun linkify (line)
(let* ((link-value (ir-href line))
(link-name (or (ir-line line)
link-value))
(prefix-gemini (gui-conf:gemini-link-prefix-to-gemini))
(prefix-www (gui-conf:gemini-link-prefix-to-http))
(prefix-other (gui-conf:gemini-link-prefix-to-other))
(link-rendered-label (if (text-utils:starting-emoji link-name)
(format nil
"~a~a"
(trim-blanks prefix-other)
link-name)
(cond
((gemini-parser::gemini-link-iri-p link-value)
(format nil "~a~a" prefix-gemini link-name))
((html-utils::http-link-iri-p link-value)
(format nil "~a~a" prefix-www link-name))
(t
(format nil "~a~a" prefix-other link-name))))))
(values link-rendered-label link-name link-value)))
(defun render-ir-lines (request-iri main-window)
(with-accessors ((ir-lines ir-lines) (with-accessors ((ir-lines ir-lines)
(ir-rendered-lines ir-rendered-lines) (ir-rendered-lines ir-rendered-lines)
(gemtext-font-scaling gemtext-font-scaling) (gemtext-font-scaling gemtext-font-scaling)
(gemtext-widget gemtext-widget)) main-window (gemtext-widget gemtext-widget)) main-window
(labels ((push-prefixed (prefix ir) (labels ((key->font (key)
(let ((raw-line (format nil "~a~a" prefix (ir-line ir))))
(vector-push-extend raw-line ir-rendered-lines)))
(key->font (key)
(let ((font (ecase key (let ((font (ecase key
((:vertical-space :text :li) ((:vertical-space :text :li)
(gui-conf:gemini-text-font-configuration)) (gui-conf:gemini-text-font-configuration))
@ -576,34 +594,18 @@
(gui-conf:gemini-quote-justification)) (gui-conf:gemini-quote-justification))
((:pre :pre-end :as-is) ((:pre :pre-end :as-is)
(gui-conf:gemini-preformatted-text-justification)))) (gui-conf:gemini-preformatted-text-justification))))
(linkify (line line-number) (render-link (line line-number)
(multiple-value-bind (link-bg link-fg) (multiple-value-bind (link-bg link-fg)
(gui-conf:gemini-link-colors) (gui-conf:gemini-link-colors)
(let* ((link-font (scale-font (gui-conf:gemini-link-font-configuration) (let ((link-font (scale-font (gui-conf:gemini-link-font-configuration)
gemtext-font-scaling)) gemtext-font-scaling)))
(link-value (ir-href line)) (multiple-value-bind (link-rendered-label link-name link-value)
(target-iri (absolutize-link request-iri link-value)) (linkify line)
(link-name (or (ir-line line) (let ((target-iri (absolutize-link request-iri link-value))
link-value)) (new-text-line-start `(:line ,line-number :char 0)))
(prefix-gemini (gui-conf:gemini-link-prefix-to-gemini)) (vector-push-extend link-rendered-label ir-rendered-lines)
(prefix-www (gui-conf:gemini-link-prefix-to-http)) (gui:append-text gemtext-widget (a:last-elt ir-rendered-lines))
(prefix-other (gui-conf:gemini-link-prefix-to-other)) (gui:make-link-button gemtext-widget
(link-text (if (text-utils:starting-emoji link-name)
(format nil
"~a~a"
(trim-blanks prefix-other)
link-name)
(cond
((gemini-parser::gemini-link-iri-p link-value)
(format nil "~a~a" prefix-gemini link-name))
((html-utils::http-link-iri-p link-value)
(format nil "~a~a" prefix-www link-name))
(t
(format nil "~a~a" prefix-other link-name))))))
(vector-push-extend link-text ir-rendered-lines)
(let ((new-text-line-start `(:line ,line-number :char 0)))
(gui:append-text gemtext-widget (a:last-elt ir-rendered-lines))
(gui:make-link-button gemtext-widget
new-text-line-start new-text-line-start
`(- :end 1 :chars) `(- :end 1 :chars)
link-font link-font
@ -620,7 +622,7 @@
(lambda () (print-info-message target-iri)) (lambda () (print-info-message target-iri))
:leave-callback :leave-callback
(lambda () (print-info-message ""))) (lambda () (print-info-message "")))
(gui:append-line gemtext-widget ""))))) (gui:append-line gemtext-widget ""))))))
(render-line (key text line-number &key (wrap :word)) (render-line (key text line-number &key (wrap :word))
(let ((font (key->font key)) (let ((font (key->font key))
(justification (key->justification key)) (justification (key->justification key))
@ -645,68 +647,97 @@
with starting-pre-block-line = -1 with starting-pre-block-line = -1
with ending-pre-block-line = -1 with ending-pre-block-line = -1
with current-pre-block-alt-text = nil with current-pre-block-alt-text = nil
for line in lines do for rendered-line across ir-rendered-lines
(vector-push-extend line ir-lines) for ir-line across ir-lines
(let ((type (ir-type line))) do
(ecase (format-keyword type) (let ((type (ir-type ir-line)))
(:vertical-space (ecase (format-keyword type)
(vector-push-extend (format nil "") ir-rendered-lines) (:vertical-space
(incf render-line-count) (incf render-line-count)
(render-line :vertical-space (a:last-elt ir-rendered-lines) render-line-count)) (render-line :vertical-space rendered-line render-line-count))
(:as-is (:as-is
(vector-push-extend (ir-line line) ir-rendered-lines) (incf render-line-count)
(incf render-line-count) (render-line :as-is
(render-line :as-is rendered-line
(a:last-elt ir-rendered-lines) render-line-count
render-line-count :wrap :none))
:wrap :none)) (:text
(:text (incf render-line-count)
(vector-push-extend (ir-line line) ir-rendered-lines) (render-line :text rendered-line render-line-count)
(incf render-line-count) (maybe-re-emphatize-lines main-window
(render-line :text (a:last-elt ir-rendered-lines) render-line-count) `(:line ,render-line-count :char 0)
(maybe-re-emphatize-lines main-window `(:line ,render-line-count :char :end)))
`(:line ,render-line-count :char 0) (:h1
`(:line ,render-line-count :char :end))) (incf render-line-count)
(:h1 (render-line :h1 rendered-line render-line-count))
(push-prefixed (gui-conf:gemini-h1-prefix) line) (:h2
(incf render-line-count) (incf render-line-count)
(render-line :h1 (a:last-elt ir-rendered-lines) render-line-count)) (render-line :h2 rendered-line render-line-count))
(:h2 (:h3
(push-prefixed (gui-conf:gemini-h1-prefix) line) (incf render-line-count)
(incf render-line-count) (render-line :h3 rendered-line render-line-count))
(render-line :h2 (a:last-elt ir-rendered-lines) render-line-count))
(:h3
(push-prefixed (gui-conf:gemini-h1-prefix) line)
(incf render-line-count)
(render-line :h3 (a:last-elt ir-rendered-lines) render-line-count))
(:li (:li
(push-prefixed (gui-conf:gemini-bullet-prefix) line)
(incf render-line-count) (incf render-line-count)
(render-line :li (a:last-elt ir-rendered-lines) render-line-count) (render-line :li rendered-line render-line-count)
(maybe-re-emphatize-lines main-window (maybe-re-emphatize-lines main-window
`(:line ,render-line-count :char 0) `(:line ,render-line-count :char 0)
`(:line ,render-line-count :char :end))) `(:line ,render-line-count :char :end)))
(:quote (:quote
(push-prefixed (gui-conf:gemini-quote-prefix) line)
(incf render-line-count) (incf render-line-count)
(render-line :quote (a:last-elt ir-rendered-lines) render-line-count)) (render-line :quote rendered-line render-line-count))
(:pre (:pre
(vector-push-extend (format nil "") ir-rendered-lines)
(incf render-line-count) (incf render-line-count)
(setf starting-pre-block-line (1+ render-line-count)) (setf starting-pre-block-line (1+ render-line-count))
(setf current-pre-block-alt-text (ir-pre-alt-text line)) (setf current-pre-block-alt-text (ir-pre-alt-text ir-line))
(render-line :pre (render-line :pre
(a:last-elt ir-rendered-lines) rendered-line
render-line-count render-line-count
:wrap :none)) :wrap :none))
(:pre-end (:pre-end
(vector-push-extend (format nil "") ir-rendered-lines)
(setf ending-pre-block-line (1+ render-line-count)) (setf ending-pre-block-line (1+ render-line-count))
(incf render-line-count) (incf render-line-count)
(render-line :pre-end (a:last-elt ir-rendered-lines) render-line-count)) (render-line :pre-end rendered-line render-line-count))
(:a (:a
(incf render-line-count) (incf render-line-count)
(linkify line render-line-count)))))))) (render-link ir-line render-line-count))))))))
(defun collect-ir-lines (request-iri main-window lines)
(with-accessors ((ir-lines ir-lines)
(ir-rendered-lines ir-rendered-lines)
(gemtext-font-scaling gemtext-font-scaling)
(gemtext-widget gemtext-widget)) main-window
(labels ((push-prefixed (prefix ir)
(let ((raw-line (format nil "~a~a" prefix (ir-line ir))))
(vector-push-extend raw-line ir-rendered-lines)))
(collect-link (line)
(vector-push-extend (linkify line) ir-rendered-lines)))
(loop for line in lines do
(vector-push-extend line ir-lines)
(let ((type (ir-type line)))
(ecase (format-keyword type)
(:vertical-space
(vector-push-extend (format nil "") ir-rendered-lines))
(:as-is
(vector-push-extend (ir-line line) ir-rendered-lines))
(:text
(vector-push-extend (ir-line line) ir-rendered-lines))
(:h1
(push-prefixed (gui-conf:gemini-h1-prefix) line))
(:h2
(push-prefixed (gui-conf:gemini-h1-prefix) line))
(:h3
(push-prefixed (gui-conf:gemini-h1-prefix) line))
(:li
(push-prefixed (gui-conf:gemini-bullet-prefix) line))
(:quote
(push-prefixed (gui-conf:gemini-quote-prefix) line))
(:pre
(vector-push-extend (format nil "") ir-rendered-lines))
(:pre-end
(vector-push-extend (format nil "") ir-rendered-lines))
(:a
(collect-link line)))))
(render-ir-lines request-iri main-window))))
(defun displace-gemini-response (response) (defun displace-gemini-response (response)
(values (getf response :status) (values (getf response :status)
@ -1351,7 +1382,7 @@
(if offset (if offset
(max 0.1 (+ (gemtext-font-scaling main-window) offset)) (max 0.1 (+ (gemtext-font-scaling main-window) offset))
1.0))) 1.0)))
(open-iri (get-address-bar-text main-window) main-window t)) (render-ir-lines (get-address-bar-text main-window) main-window))
(defun initialize-keybindings (main-window) (defun initialize-keybindings (main-window)
(let ((inner-gemtext-widget (gui:inner-text (gemtext-widget main-window)))) (let ((inner-gemtext-widget (gui:inner-text (gemtext-widget main-window))))