From 5a399987c88fb425871c2f2c737218e58f9fba1c Mon Sep 17 00:00:00 2001 From: cage Date: Wed, 31 May 2023 15:05:21 +0200 Subject: [PATCH] - [GUI] added font scaling for gemtext. --- src/gui/client/main-window.lisp | 83 ++++++++++++++++++++------------- 1 file changed, 51 insertions(+), 32 deletions(-) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index 55ecbd1..0a6df7f 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -498,41 +498,55 @@ #'download-background-callback) (gui:popup popup-menu x y))))) -(defmethod maybe-re-emphatize-lines (gemtext-widget from to) - (when (client-configuration:emphasize-wrapped-asterisk-p) - (let ((matches (gui:search-all-text gemtext-widget - "\\*[^*]+\\*" - :start-index from - :end-index to))) - (loop for match in matches do - (gui:tag-configure gemtext-widget - (gui:match-tag-name match) - :font (client-configuration:font-text-bold)) - (gui:tag-raise gemtext-widget (gui:match-tag-name match)))))) +(defun scale-font (font scaling) + (when scaling + (let* ((font-size (parse-integer (getf (gui:font-actual font) :size))) + (increment (round (* font-size scaling))) + (new-font-size (+ font-size increment))) + (gui:font-configure font :size new-font-size))) + font) + +(defun maybe-re-emphatize-lines (main-window from to) + (with-accessors ((gemtext-font-scaling gemtext-font-scaling) + (gemtext-widget gemtext-widget)) main-window + (when (client-configuration:emphasize-wrapped-asterisk-p) + (let ((matches (gui:search-all-text gemtext-widget + "\\*[^*]+\\*" + :start-index from + :end-index to))) + (loop for match in matches do + (gui:tag-configure gemtext-widget + (gui:match-tag-name match) + :font (scale-font (client-configuration:font-text-bold) + gemtext-font-scaling)) + (gui:tag-raise gemtext-widget (gui:match-tag-name match))))))) (defun collect-ir-lines (request-iri main-window lines) - (with-accessors ((ir-lines ir-lines) - (ir-rendered-lines ir-rendered-lines) - (gemtext-widget gemtext-widget)) main-window + (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))) (key->font (key) - (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)))) + (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) @@ -566,7 +580,8 @@ (linkify (line line-number) (multiple-value-bind (link-bg link-fg) (gui-conf:gemini-link-colors) - (let* ((link-font (gui-conf:gemini-link-font-configuration)) + (let* ((link-font (scale-font (gui-conf:gemini-link-font-configuration) + gemtext-font-scaling)) (link-value (ir-href line)) (target-iri (absolutize-link request-iri link-value)) (link-name (or (ir-line line) @@ -650,7 +665,7 @@ (vector-push-extend (ir-line line) ir-rendered-lines) (incf render-line-count) (render-line :text (a:last-elt ir-rendered-lines) render-line-count) - (maybe-re-emphatize-lines gemtext-widget + (maybe-re-emphatize-lines main-window `(:line ,render-line-count :char 0) `(:line ,render-line-count :char :end))) (:h1 @@ -669,7 +684,7 @@ (push-prefixed (gui-conf:gemini-bullet-prefix) line) (incf render-line-count) (render-line :li (a:last-elt ir-rendered-lines) render-line-count) - (maybe-re-emphatize-lines gemtext-widget + (maybe-re-emphatize-lines main-window `(:line ,render-line-count :char 0) `(:line ,render-line-count :char :end))) (:quote @@ -1176,6 +1191,10 @@ :initform nil :initarg :gemtext-widget :accessor gemtext-widget) + (gemtext-font-scaling + :initform 0.0 + :initarg :gemtext-font-scaling + :accessor gemtext-font-scaling) (tool-bar :initform nil :initarg :tool-bar