From 7cd0b5740bb0a6ee87cdada636805883f91213cf Mon Sep 17 00:00:00 2001 From: cage Date: Tue, 15 Aug 2023 20:05:09 +0200 Subject: [PATCH] - [GUI] improved rendering speed by not applying text tags to empty lines and normal text, moreover cached the gemtext fonts. --- src/gui/client/main-window.lisp | 312 ++++++++++++++++---------------- 1 file changed, 158 insertions(+), 154 deletions(-) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index 99c3786..570aeee 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -615,161 +615,165 @@ local file paths." (ir-rendered-lines ir-rendered-lines) (gemtext-font-scaling gemtext-font-scaling) (gemtext-widget gemtext-widget)) main-window - (labels ((key->font (key) - (let ((font (ecase key - ((:vertical-space :text :li) - (gui-conf:gemini-text-font-configuration)) - (:h1 - (gui-conf:gemini-h1-font-configuration)) - (:h2 - (gui-conf:gemini-h2-font-configuration)) - (:h3 - (gui-conf:gemini-h3-font-configuration)) - (:quote - (gui-conf:gemini-quote-font-configuration)) - ((:pre :pre-end :as-is) - (gui-conf:gemini-preformatted-text-font-configuration)) - (:a - (gui-conf:gemini-link-font-configuration))))) - (scale-font font gemtext-font-scaling) - font)) - (key->colors (key) - (ecase key - ((:vertical-space :text :li) - (gui-conf:gemini-window-colors)) - (:h1 - (gui-conf:gemini-h1-colors)) - (:h2 - (gui-conf:gemini-h2-colors)) - (:h3 - (gui-conf:gemini-h3-colors)) - (:quote - (gui-conf:gemini-quote-colors)) - ((:pre :pre-end :as-is) - (gui-conf:gemini-preformatted-text-colors)) - (:a - (gui-conf:gemini-link-colors)))) - (key->justification (key) - (ecase key - ((:vertical-space :text :li :a) - :left) - (:h1 - (gui-conf:gemini-h1-justification)) - (:h2 - (gui-conf:gemini-h2-justification)) - (:h3 - (gui-conf:gemini-h3-justification)) - (:quote - (gui-conf:gemini-quote-justification)) - ((:pre :pre-end :as-is) - (gui-conf:gemini-preformatted-text-justification)))) - (render-link (line link-rendered-label line-number) - (multiple-value-bind (link-bg link-fg) - (gui-conf:gemini-link-colors) - (let ((link-font (scale-font (gui-conf:gemini-link-font-configuration) - gemtext-font-scaling))) - (multiple-value-bind (x link-name link-value) - (linkify line) - (declare (ignore x)) - (let ((target-iri (remove-standard-port (absolutize-link request-iri - link-value))) - (new-text-line-start `(:line ,line-number :char 0))) - (gui:append-text gemtext-widget link-rendered-label) - (let ((tag-link (gui:make-link-button gemtext-widget - new-text-line-start - `(- :end 1 :chars) - link-font - link-fg - link-bg - (link-click-mouse-1-callback-clsr target-iri - main-window) - :cursor-outside - (gui:find-cursor :xterm) - :button-3-callback - (contextual-menu-link-clrs link-name - target-iri - main-window) - :over-callback - (lambda () (print-info-message target-iri)) - :leave-callback - (lambda () (print-info-message ""))))) - (gui:tag-lower gemtext-widget tag-link) - (gui:append-line gemtext-widget ""))))))) - (render-line (key text line-number &key (wrap :word)) - (let ((font (key->font key)) - (justification (key->justification key)) - (start-index `(:line ,line-number :char 0))) - (gui:append-text gemtext-widget text) - (gui:append-line gemtext-widget "") - (multiple-value-bind (background foreground) - (key->colors key) - (let ((tag (gui:tag-create gemtext-widget - (gui::create-tag-name) - start-index - (gui:make-indices-end)))) - (gui:tag-configure gemtext-widget - tag - :wrap wrap - :font font - :foreground foreground - :background background - :justify justification) - ;; does not works because of a TK bug - ;;(colorize-emoji main-window (1- line-number)) - (gui:tag-lower gemtext-widget tag)))))) - (loop with render-line-count = starting-index - with current-pre-block-alt-text = nil - for rendered-line across (subseq ir-rendered-lines starting-index) - for ir-line across (subseq ir-lines starting-index) - do - (let ((type (ir-type ir-line))) - (ecase (format-keyword type) - (:vertical-space - (incf render-line-count) - (render-line :vertical-space rendered-line render-line-count)) - (:as-is - (incf render-line-count) - (render-line :as-is - rendered-line - render-line-count - :wrap :none)) - (:text - (incf render-line-count) - (render-line :text rendered-line render-line-count) - (maybe-re-emphatize-lines main-window - `(:line ,render-line-count :char 0) - `(:line ,render-line-count :char :end))) + (let ((font-cache '())) + (labels ((key->font (key) + (or (cdr (assoc :key font-cache)) + (let ((font (ecase key + ((:vertical-space :text :li) + (gui-conf:gemini-text-font-configuration)) + (:h1 + (gui-conf:gemini-h1-font-configuration)) + (:h2 + (gui-conf:gemini-h2-font-configuration)) + (:h3 + (gui-conf:gemini-h3-font-configuration)) + (:quote + (gui-conf:gemini-quote-font-configuration)) + ((:pre :pre-end :as-is) + (gui-conf:gemini-preformatted-text-font-configuration)) + (:a + (gui-conf:gemini-link-font-configuration))))) + (scale-font font gemtext-font-scaling) + (setf font-cache (acons key font font-cache)) + font))) + (key->colors (key) + (ecase key + ((:vertical-space :text :li) + (gui-conf:gemini-window-colors)) (:h1 - (incf render-line-count) - (render-line :h1 rendered-line render-line-count)) + (gui-conf:gemini-h1-colors)) (:h2 - (incf render-line-count) - (render-line :h2 rendered-line render-line-count)) + (gui-conf:gemini-h2-colors)) (:h3 - (incf render-line-count) - (render-line :h3 rendered-line render-line-count)) - (:li - (incf render-line-count) - (render-line :li rendered-line render-line-count) - (maybe-re-emphatize-lines main-window - `(:line ,render-line-count :char 0) - `(:line ,render-line-count :char :end))) - (:quote - (incf render-line-count) - (render-line :quote rendered-line render-line-count)) - (:pre - (incf render-line-count) - (setf current-pre-block-alt-text (ir-pre-alt-text ir-line)) - (render-line :pre - rendered-line - render-line-count - :wrap :none)) - (:pre-end - (incf render-line-count) - (render-line :pre-end rendered-line render-line-count)) - (:a - (incf render-line-count) - (render-link ir-line rendered-line render-line-count)))))))) + (gui-conf:gemini-h3-colors)) + (:quote + (gui-conf:gemini-quote-colors)) + ((:pre :pre-end :as-is) + (gui-conf:gemini-preformatted-text-colors)) + (:a + (gui-conf:gemini-link-colors)))) + (key->justification (key) + (ecase key + ((:vertical-space :text :li :a) + :left) + (:h1 + (gui-conf:gemini-h1-justification)) + (:h2 + (gui-conf:gemini-h2-justification)) + (:h3 + (gui-conf:gemini-h3-justification)) + (:quote + (gui-conf:gemini-quote-justification)) + ((:pre :pre-end :as-is) + (gui-conf:gemini-preformatted-text-justification)))) + (render-link (line link-rendered-label line-number) + (multiple-value-bind (link-bg link-fg) + (gui-conf:gemini-link-colors) + (let ((link-font (key->font :a))) + (multiple-value-bind (x link-name link-value) + (linkify line) + (declare (ignore x)) + (let ((target-iri (remove-standard-port (absolutize-link request-iri + link-value))) + (new-text-line-start `(:line ,line-number :char 0))) + (gui:append-text gemtext-widget link-rendered-label) + (let ((tag-link (gui:make-link-button gemtext-widget + new-text-line-start + `(- :end 1 :chars) + link-font + link-fg + link-bg + (link-click-mouse-1-callback-clsr target-iri + main-window) + :cursor-outside + (gui:find-cursor :xterm) + :button-3-callback + (contextual-menu-link-clrs link-name + target-iri + main-window) + :over-callback + (lambda () (print-info-message target-iri)) + :leave-callback + (lambda () (print-info-message ""))))) + (gui:tag-lower gemtext-widget tag-link) + (gui:append-line gemtext-widget ""))))))) + (render-line (key text line-number &key (wrap :word)) + (let ((font (key->font key)) + (justification (key->justification key)) + (start-index `(:line ,line-number :char 0))) + (gui:append-text gemtext-widget text) + (gui:append-line gemtext-widget "") + (when (not (member key '(:text :vertical-space))) + (multiple-value-bind (background foreground) + (key->colors key) + (let ((tag (gui:tag-create gemtext-widget + (gui::create-tag-name) + start-index + (gui:make-indices-end)))) + (gui:tag-configure gemtext-widget + tag + :wrap wrap + :font font + :foreground foreground + :background background + :justify justification) + ;; does not works because of a TK bug + ;;(colorize-emoji main-window (1- line-number)) + (gui:tag-lower gemtext-widget tag))))))) + (gui:configure gemtext-widget :font (key->font :text)) + (loop with render-line-count = starting-index + with current-pre-block-alt-text = nil + for rendered-line across (subseq ir-rendered-lines starting-index) + for ir-line across (subseq ir-lines starting-index) + do + (let ((type (ir-type ir-line))) + (ecase (format-keyword type) + (:vertical-space + (incf render-line-count) + (render-line :vertical-space rendered-line render-line-count)) + (:as-is + (incf render-line-count) + (render-line :as-is + rendered-line + render-line-count + :wrap :none)) + (:text + (incf render-line-count) + (render-line :text rendered-line render-line-count) + (maybe-re-emphatize-lines main-window + `(:line ,render-line-count :char 0) + `(:line ,render-line-count :char :end))) + (:h1 + (incf render-line-count) + (render-line :h1 rendered-line render-line-count)) + (:h2 + (incf render-line-count) + (render-line :h2 rendered-line render-line-count)) + (:h3 + (incf render-line-count) + (render-line :h3 rendered-line render-line-count)) + (:li + (incf render-line-count) + (render-line :li rendered-line render-line-count) + (maybe-re-emphatize-lines main-window + `(:line ,render-line-count :char 0) + `(:line ,render-line-count :char :end))) + (:quote + (incf render-line-count) + (render-line :quote rendered-line render-line-count)) + (:pre + (incf render-line-count) + (setf current-pre-block-alt-text (ir-pre-alt-text ir-line)) + (render-line :pre + rendered-line + render-line-count + :wrap :none)) + (:pre-end + (incf render-line-count) + (render-line :pre-end rendered-line render-line-count)) + (:a + (incf render-line-count) + (render-link ir-line rendered-line render-line-count))))))))) (defun collect-ir-lines (request-iri main-window lines) (with-accessors ((ir-lines ir-lines) @@ -1485,8 +1489,8 @@ local file paths." (setf (gemtext-font-scaling main-window) (if offset (max 0.1 (+ (gemtext-font-scaling main-window) offset)) - 1.0))) - (render-ir-lines (get-address-bar-text main-window) main-window)) + 1.0)) + (render-ir-lines (get-address-bar-text main-window) main-window))) (defun initialize-keybindings (main-window target) (gui:bind target