Stacken/c64-livecoding
6
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Fix and optimize view scrolling by setting scrolling regions

Browse source
This commit is contained in:
John Lorentzson 2025-07-18 21:19:37 +02:00
parent 34f705aef8
commit 121195a1ad
1 changed files with 6 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
wip-duuqnd/editor/editor.lisp
View file

@ -527,23 +527,27 @@ Additionally ensures correct line numbers on the way, as a bonus."
(update-buffer-cursor (buffer view)))) (update-buffer-cursor (buffer view))))
(defmethod scroll-view-down ((view buffer-view)) (defmethod scroll-view-down ((view buffer-view))
(set-scrolling-region 1 (height view))
(scroll-screen-up 1) ; view goes down, screen contents go up (scroll-screen-up 1) ; view goes down, screen contents go up
(set-scrolling-region)
(update-view-bottom view) (update-view-bottom view)
(setf (top-line view) (next-line (top-line view)) (setf (top-line view) (next-line (top-line view))
(bottom-line view) (next-line (bottom-line view))) (bottom-line view) (next-line (bottom-line view)))
(unless (null (bottom-line view)) (unless (null (bottom-line view))
(redisplay-view-from-line view (bottom-line view))) (redisplay-view-from-line view (bottom-line view)))
(redisplay-status-line :completely-p t)) (redisplay-status-line :completely-p nil))
(defmethod scroll-view-up ((view buffer-view)) (defmethod scroll-view-up ((view buffer-view))
(set-scrolling-region 1 (height view))
(scroll-screen-down 1) ; view goes up, screen contents go down (scroll-screen-down 1) ; view goes up, screen contents go down
(set-scrolling-region)
(update-view-bottom view) (update-view-bottom view)
(setf (top-line view) (setf (top-line view)
(prev-line (top-line view)) (prev-line (top-line view))
(bottom-line view) (bottom-line view)
(prev-line (bottom-line view))) (prev-line (bottom-line view)))
(redisplay-line (top-line view)) (redisplay-line (top-line view))
(redisplay-status-line :completely-p t)) (redisplay-status-line :completely-p nil))
(defmethod get-line-into-view ((line line) (view buffer-view)) (defmethod get-line-into-view ((line line) (view buffer-view))
;; Assuming it's not already. ;; Assuming it's not already.