mirror of https://codeberg.org/cage/tinmop/
- [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:
parent
9682b53522
commit
7cd0b5740b
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue