extract package

lem-project · Dec 30, 2023 · 896ff07 · 896ff07
1 parent b5d4c7c
commit 896ff07
Show file tree

Hide file tree

Showing 4 changed files with 108 additions and 98 deletions.
diff --git a/frontends/ncurses/lem-ncurses.asd b/frontends/ncurses/lem-ncurses.asd
@@ -14,6 +14,7 @@
                (:file "attribute")
                (:file "drawing-object")
                (:file "view")
+               (:file "render")
                (:file "input")
                (:file "mainloop")
                (:file "ncurses")))
diff --git a/frontends/ncurses/ncurses.lisp b/frontends/ncurses/ncurses.lisp
@@ -85,15 +85,15 @@
 
 (defmethod lem-if:render-line ((implementation ncurses)
                                view x y objects height)
-  (lem-ncurses/view:render-line view x y objects))
+  (lem-ncurses/render:render-line view x y objects))
 
 (defmethod lem-if:render-line-on-modeline ((implementation ncurses)
                                            view
                                            left-objects
                                            right-objects
                                            default-attribute
                                            height)
-  (lem-ncurses/view:render-line-on-modeline view left-objects right-objects default-attribute))
+  (lem-ncurses/render:render-line-on-modeline view left-objects right-objects default-attribute))
 
 (defmethod lem-if:object-width ((implementation ncurses) drawing-object)
   (lem-ncurses/drawing-object:object-width drawing-object))
@@ -102,7 +102,7 @@
   (lem-ncurses/drawing-object:object-height drawing-object))
 
 (defmethod lem-if:clear-to-end-of-window ((implementation ncurses) view y)
-  (lem-ncurses/view:clear-to-end-of-window view y))
+  (lem-ncurses/render:clear-to-end-of-window view y))
 
 (defmethod lem-if:get-char-width ((implementation ncurses))
   1)

diff --git a/frontends/ncurses/render.lisp b/frontends/ncurses/render.lisp
@@ -0,0 +1,100 @@
+(defpackage :lem-ncurses/render
+  (:use :cl
+        :lem-core/display)
+  (:export :render-line
+           :render-line-on-modeline
+           :clear-to-end-of-window))
+(in-package :lem-ncurses/render)
+
+(defun print-string (scrwin x y string attribute)
+  (let ((attr (lem-ncurses/attribute:attribute-to-bits attribute)))
+    (charms/ll:wattron scrwin attr)
+    (charms/ll:mvwaddstr scrwin y x string)
+    (charms/ll:wattroff scrwin attr)))
+
+(defgeneric draw-object (object x y view scrwin))
+
+(defmethod draw-object ((object void-object) x y view scrwin)
+  (values))
+
+(defmethod draw-object ((object text-object) x y view scrwin)
+  (let ((string (text-object-string object))
+        (attribute (text-object-attribute object)))
+    (when (and attribute (lem:cursor-attribute-p attribute))
+      (lem-ncurses/view:set-last-print-cursor view x y))
+    (print-string scrwin x y string attribute)))
+
+(defmethod draw-object ((object eol-cursor-object) x y view scrwin)
+  (lem-ncurses/view:set-last-print-cursor view x y)
+  (print-string
+   scrwin
+   x
+   y
+   " "
+   (lem:make-attribute :foreground
+                       (lem:color-to-hex-string (eol-cursor-object-color object)))))
+
+(defmethod draw-object ((object extend-to-eol-object) x y view scrwin)
+  (let ((width (lem-if:view-width (lem:implementation) view)))
+    (when (< x width)
+      (print-string
+       scrwin
+       x
+       y
+       (make-string (- width x) :initial-element #\space)
+       (lem:make-attribute :background
+                           (lem:color-to-hex-string (extend-to-eol-object-color object)))))))
+
+(defmethod draw-object ((object line-end-object) x y view scrwin)
+  (let ((string (text-object-string object))
+        (attribute (text-object-attribute object)))
+    (print-string
+     scrwin
+     (+ x (line-end-object-offset object))
+     y
+     string
+     attribute)))
+
+(defmethod draw-object ((object image-object) x y view scrwin)
+  (values))
+
+(defun render-line-from-behind (view y objects scrwin)
+  (loop :with current-x := (lem-if:view-width (lem:implementation) view)
+        :for object :in objects
+        :do (decf current-x (lem-ncurses/drawing-object:object-width object))
+            (draw-object object current-x y view scrwin)))
+
+(defun clear-line (view x y)
+  (charms/ll:wmove (lem-ncurses/view:view-scrwin view) y x)
+  (charms/ll:wclrtoeol (lem-ncurses/view:view-scrwin view)))
+
+(defun %render-line (view x y objects scrwin)
+  (loop :for object :in objects
+        :do (draw-object object x y view scrwin)
+            (incf x (lem-ncurses/drawing-object:object-width object))))
+
+(defun render-line (view x y objects)
+  (clear-line view x y)
+  (%render-line view x y objects (lem-ncurses/view:view-scrwin view)))
+
+(defun render-line-on-modeline (view
+                                left-objects
+                                right-objects
+                                default-attribute)
+  (print-string (lem-ncurses/view:view-modeline-scrwin view)
+                0
+                0
+                (make-string (lem-ncurses/view:view-width view)
+                             :initial-element #\space)
+                default-attribute)
+  (%render-line view 0 0 left-objects (lem-ncurses/view:view-modeline-scrwin view))
+  (render-line-from-behind view
+                           0
+                           right-objects
+                           (lem-ncurses/view:view-modeline-scrwin view)))
+
+(defun clear-to-end-of-window (view y)
+  (let ((win (lem-ncurses/view:view-scrwin view)))
+    (when (< y (lem-ncurses/view:view-height view))
+      (charms/ll:wmove win y 0)
+      (charms/ll:wclrtobot win))))
diff --git a/frontends/ncurses/view.lisp b/frontends/ncurses/view.lisp
@@ -5,6 +5,8 @@
   (:export :make-view
            :view
            :view-border
+           :view-scrwin
+           :view-modeline-scrwin
            :view-x
            :view-y
            :view-width
@@ -17,7 +19,8 @@
            :render-line
            :render-line-on-modeline
            :clear-to-end-of-window
-           :update-cursor))
+           :update-cursor
+           :set-last-print-cursor))
 (in-package :lem-ncurses/view)
 
 (defclass view ()
@@ -166,100 +169,6 @@
     (charms/ll:wnoutrefresh (view-modeline-scrwin view)))
   (charms/ll:wnoutrefresh (view-scrwin view)))
 
-;;;
-(defun print-string (scrwin x y string attribute)
-  (let ((attr (lem-ncurses/attribute:attribute-to-bits attribute)))
-    (charms/ll:wattron scrwin attr)
-    (charms/ll:mvwaddstr scrwin y x string)
-    (charms/ll:wattroff scrwin attr)))
-
-(defgeneric draw-object (object x y view scrwin))
-
-(defmethod draw-object ((object void-object) x y view scrwin)
-  (values))
-
-(defmethod draw-object ((object text-object) x y view scrwin)
-  (let ((string (text-object-string object))
-        (attribute (text-object-attribute object)))
-    (when (and attribute (lem:cursor-attribute-p attribute))
-      (set-last-print-cursor view x y))
-    (print-string scrwin x y string attribute)))
-
-(defmethod draw-object ((object eol-cursor-object) x y view scrwin)
-  (set-last-print-cursor view x y)
-  (print-string
-   scrwin
-   x
-   y
-   " "
-   (lem:make-attribute :foreground
-                       (lem:color-to-hex-string (eol-cursor-object-color object)))))
-
-(defmethod draw-object ((object extend-to-eol-object) x y view scrwin)
-  (let ((width (lem-if:view-width (lem:implementation) view)))
-    (when (< x width)
-      (print-string
-       scrwin
-       x
-       y
-       (make-string (- width x) :initial-element #\space)
-       (lem:make-attribute :background
-                           (lem:color-to-hex-string (extend-to-eol-object-color object)))))))
-
-(defmethod draw-object ((object line-end-object) x y view scrwin)
-  (let ((string (text-object-string object))
-        (attribute (text-object-attribute object)))
-    (print-string
-     scrwin
-     (+ x (line-end-object-offset object))
-     y
-     string
-     attribute)))
-
-(defmethod draw-object ((object image-object) x y view scrwin)
-  (values))
-
-(defun render-line-from-behind (view y objects scrwin)
-  (loop :with current-x := (lem-if:view-width (lem:implementation) view)
-        :for object :in objects
-        :do (decf current-x (lem-ncurses/drawing-object:object-width object))
-            (draw-object object current-x y view scrwin)))
-
-(defun clear-line (scrwin x y)
-  (charms/ll:wmove scrwin y x)
-  (charms/ll:wclrtoeol scrwin))
-
-(defun %render-line (view x y objects scrwin)
-  (loop :for object :in objects
-        :do (draw-object object x y view scrwin)
-            (incf x (lem-ncurses/drawing-object:object-width object))))
-
-(defun render-line (view x y objects)
-  (clear-line (view-scrwin view) x y)
-  (%render-line view x y objects (view-scrwin view)))
-
-(defun render-line-on-modeline (view
-                                left-objects
-                                right-objects
-                                default-attribute)
-  (print-string (view-modeline-scrwin view)
-                0
-                0
-                (make-string (view-width view)
-                             :initial-element #\space)
-                default-attribute)
-  (%render-line view 0 0 left-objects (view-modeline-scrwin view))
-  (render-line-from-behind view
-                           0
-                           right-objects
-                           (view-modeline-scrwin view)))
-
-(defun clear-to-end-of-window (view y)
-  (let ((win (view-scrwin view)))
-    (when (< y (view-height view))
-      (charms/ll:wmove win y 0)
-      (charms/ll:wclrtobot win))))
-
 (defun update-cursor (view)
   (let ((cursor-x (view-last-print-cursor-x view))
         (cursor-y (view-last-print-cursor-y view))