1
0
Fork 0

- [GUI] improved rendering speed by not applying text tags to empty lines and normal text, moreover cached the gemtext fonts.

This commit is contained in:
cage 2023-08-15 20:05:09 +02:00
parent 9682b53522
commit 7cd0b5740b
1 changed files with 158 additions and 154 deletions

View File

@ -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