cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -615,7 +615,9 @@ local file paths."
(ir-rendered-lines ir-rendered-lines)
(gemtext-font-scaling gemtext-font-scaling)
(gemtext-widget gemtext-widget)) main-window
(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))
@ -632,7 +634,8 @@ local file paths."
(:a
(gui-conf:gemini-link-font-configuration)))))
(scale-font font gemtext-font-scaling)
font))
(setf font-cache (acons key font font-cache))
font)))
(key->colors (key)
(ecase key
((:vertical-space :text :li)
@ -666,8 +669,7 @@ local file paths."
(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)))
(let ((link-font (key->font :a)))
(multiple-value-bind (x link-name link-value)
(linkify line)
(declare (ignore x))
@ -701,6 +703,7 @@ local file paths."
(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
@ -716,7 +719,8 @@ local file paths."
:justify justification)
;; does not works because of a TK bug
;;(colorize-emoji main-window (1- line-number))
(gui:tag-lower gemtext-widget tag))))))
(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)
@ -769,7 +773,7 @@ local file paths."
(render-line :pre-end rendered-line render-line-count))
(:a
(incf render-line-count)
(render-link ir-line rendered-line 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