cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-01-04 01:19:27 +01:00
Code Issues

- [GUI] fixed image positioning.

Browse Source
This commit is contained in:
cage 2023-06-07 16:31:30 +02:00
parent fe86a3f1e0
commit 8f9b4d0cf5
1 changed files with 30 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -419,20 +419,23 @@
(let* ((file-path (slurp-iri main-window link-value))
(image (gui:make-image file-path))
(coordinates `(+ (:line ,line-index :char 0) 1 :lines)))
(gui:insert-image (gemtext-widget main-window) image coordinates)
(with-accessors ((ir-lines ir-lines)
(ir-rendered-lines ir-rendered-lines)) main-window
(ir-rendered-lines ir-rendered-lines)
(gemtext-widget gemtext-widget)) main-window
(let* ((parent-line (elt ir-lines (- line-index 1)))
(new-line (copy-list parent-line)))
(gui:move-cursor-to gemtext-widget coordinates)
(gui:insert-text gemtext-widget (format nil "~%"))
(gui:insert-image gemtext-widget image coordinates)
(setf (getf new-line :type) (inline-type link-value))
(setf ir-lines
(fresh-vector-insert@ ir-lines
new-line
line-index))
(1- line-index)))
(setf ir-rendered-lines
(fresh-vector-insert@ ir-lines
(fresh-vector-insert@ ir-rendered-lines
""
line-index))))))
(1- line-index)))))))
(defun inline-all-images (main-window)
(gui-goodies:with-busy* (main-window)
@ -449,7 +452,7 @@
(lambda ()
(inline-all-images main-window)))
(defun contextual-menu-link-clrs (link-name link-value main-window line-count)
(defun contextual-menu-link-clrs (link-name link-value main-window)
(labels ((add-to-tour-callback ()
(ev:with-enqueued-process-and-unblock ()
(comm:make-request :tour-add-link
@ -479,17 +482,23 @@
link-value)
:bold t)
(client-bookmark-window:init-window main-window link-value))))
(open-inline-callback ()
(if (inline-possible-p link-value)
(gui-goodies:with-busy* (main-window)
(inline-image main-window link-value line-count))
(funcall (link-click-mouse-1-callback-clsr link-value main-window)))))
(open-inline-clsr (line-number)
(lambda ()
(if (inline-possible-p link-value)
(gui-goodies:with-busy* (main-window)
(inline-image main-window link-value line-number))
(funcall (link-click-mouse-1-callback-clsr link-value main-window))))))
(lambda ()
(let* ((popup-menu (gui:make-menu nil (_"link menu")))
(x (gui:screen-mouse-x))
(y (gui:screen-mouse-y)))
(y (gui:screen-mouse-y))
(relative-x (- x (gui:root-x (gemtext-widget main-window))))
(relative-y (- y (gui:root-y (gemtext-widget main-window)))))
(gui:move-cursor-to (gemtext-widget main-window)`(:x ,relative-x :y ,relative-y))
(when (inline-possible-p link-value)
(gui:make-menubutton popup-menu (_ "Inline") #'open-inline-callback))
(gui:make-menubutton popup-menu
(_ "Inline")
(open-inline-clsr (gui:cursor-index (gemtext-widget main-window)))))
(gui:make-menubutton popup-menu (_ "Add link to bookmarks") #'bookmark-link-callback)
(gui:make-menubutton popup-menu (_ "Add link to tour") #'add-to-tour-callback)
(gui:make-menubutton popup-menu (_ "Copy link to the clipboard") #'copy-link-callback)
@ -541,7 +550,7 @@
(format nil "~a~a" prefix-other link-name))))))
(values link-rendered-label link-name link-value)))
(defun colorize-emoji (main-window line-index color &optional (start 0))
(defun colorize-emoji (main-window line-index &optional (start 0))
(with-accessors ((ir-lines ir-lines)
(ir-rendered-lines ir-rendered-lines)
(gemtext-widget gemtext-widget)) main-window
@ -557,9 +566,11 @@
`(:char ,(1+ i) :line ,(1+ line-index)))))
(gui:tag-configure gemtext-widget
tag
:foreground color))
:font (gui:font-create (gui::create-name)
:family "Noto Color Emoji"
:size 11))
(incf skip-index (length emoji-code-points)))
(incf skip-index))))))
(incf skip-index)))))))
(defun render-ir-lines (request-iri main-window)
(with-accessors ((ir-lines ir-lines)
@ -636,8 +647,7 @@
:button-3-callback
(contextual-menu-link-clrs link-name
target-iri
main-window
line-number)
main-window)
:over-callback
(lambda () (print-info-message target-iri))
:leave-callback
@ -662,6 +672,8 @@
:foreground foreground
:background background
:justify justification)
;; does not works because of a TK bug
;;(colorize-emoji main-window (1- line-number))
tag)))))
(loop with render-line-count = 0
with starting-pre-block-line = -1