Skip to content

Commit

Permalink
Support for display of control characters
Browse files Browse the repository at this point in the history
  • Loading branch information
@cxxxr
cxxxr committed Sep 28, 2023
1 parent 98a88c6 commit a71dc47
Show file tree
Hide file tree
Showing 4 changed files with 101 additions and 48 deletions.
6 changes: 4 additions & 2 deletions frontends/sdl2/main.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -174,8 +174,10 @@
(font-config-size (display-font-config *display*)))))))))

(defmethod get-display-font ((display display) &key type bold character)
(check-type type (member :latin :cjk :braille :emoji :icon))
(cond ((eq type :icon)
(check-type type lem-core/display-3::char-type)
(cond ((eq type :control)
(display-latin-font display))
((eq type :icon)
(or (and character (icon-font character))
(display-emoji-font display)))
((eq type :emoji)
Expand Down
24 changes: 17 additions & 7 deletions frontends/sdl2/text-buffer-impl.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -70,6 +70,9 @@
(defmethod object-width ((drawing-object lem-core/display-3::text-object))
(sdl2:surface-width (get-surface drawing-object)))

(defmethod object-width ((drawing-object lem-core/display-3::control-character-object))
(* 2 (lem-sdl2::char-width)))

(defmethod object-width ((drawing-object lem-core/display-3::icon-object))
(sdl2:surface-width (get-surface drawing-object)))

Expand Down Expand Up @@ -104,6 +107,9 @@
(defmethod object-height ((drawing-object lem-core/display-3::icon-object))
(lem-sdl2::char-height))

(defmethod object-height ((drawing-object lem-core/display-3::control-character-object))
(lem-sdl2::char-height))

(defmethod object-height ((drawing-object lem-core/display-3::folder-object))
(lem-sdl2::char-height))

Expand Down Expand Up @@ -131,7 +137,7 @@

;;; draw-object
(defmethod draw-object ((drawing-object lem-core/display-3::void-object) x bottom-y window)
(values))
0)

(defmethod draw-object ((drawing-object lem-core/display-3::text-object) x bottom-y window)
(let* ((surface-width (object-width drawing-object))
Expand Down Expand Up @@ -164,7 +170,8 @@
(if (eq underline t)
(lem-sdl2::attribute-foreground-color attribute)
(or (lem:parse-color underline)
(lem-sdl2::attribute-foreground-color attribute))))))))
(lem-sdl2::attribute-foreground-color attribute))))))
surface-width))

(defmethod draw-object ((drawing-object lem-core/display-3::eol-cursor-object) x bottom-y window)
(lem-sdl2::set-color (lem-core/display-3::eol-cursor-object-color drawing-object))
Expand All @@ -174,7 +181,8 @@
y
(lem-sdl2::char-width)
(object-height drawing-object)))
(sdl2:render-fill-rect (lem-sdl2::current-renderer) rect))))
(sdl2:render-fill-rect (lem-sdl2::current-renderer) rect)))
(object-width drawing-object))

(defmethod draw-object ((drawing-object lem-core/display-3::extend-to-eol-object) x bottom-y window)
(lem-sdl2::set-color (lem-core/display-3::extend-to-eol-object-color drawing-object))
Expand All @@ -183,7 +191,8 @@
(- (lem-core/display-3::window-view-width window) x)
(lem-sdl2::char-height)))
(sdl2:render-fill-rect (lem-sdl2::current-renderer)
rect)))
rect))
(object-width drawing-object))

(defmethod draw-object ((drawing-object lem-core/display-3::line-end-object) x bottom-y window)
(call-next-method drawing-object
Expand All @@ -199,12 +208,13 @@
(lem-core/display-3::image-object-image drawing-object)))
(y (- bottom-y surface-height)))
(lem-sdl2::render-texture (lem-sdl2::current-renderer) texture x y surface-width surface-height)
(sdl2:destroy-texture texture)))
(sdl2:destroy-texture texture)
surface-width))

(defun redraw-physical-line (window x y objects height)
(loop :for current-x := x :then (+ current-x (object-width object))
(loop :with current-x := x
:for object :in objects
:do (draw-object object current-x (+ y height) window)))
:do (incf current-x (draw-object object current-x (+ y height) window))))

(defun clear-to-end-of-line (window x y height)
(sdl2:with-rects ((rect x y (- (lem-core/display-3::window-view-width window) x) height))
Expand Down
99 changes: 65 additions & 34 deletions src/display-2.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -86,27 +86,51 @@
(t
nil)))

(defun expand-tab (string attributes tab-width)
(setf attributes (copy-tree attributes))
(values (with-output-to-string (out)
(loop :with i := 0
:for c :across string
:do (cond ((char= c #\tab)
(let ((n (- tab-width (mod i tab-width))))
(loop :for elt :in attributes
:do (cond ((< i (first elt))
(incf (first elt) (1- n))
(incf (second elt) (1- n)))
((and (< i (second elt))
(not (cursor-attribute-p (third elt))))
(incf (second elt) (1- n)))))
(loop :repeat n
:do (write-char #\space out))
(incf i n)))
(t
(write-char c out)
(incf i)))))
attributes))

(defun create-logical-line (point overlays active-modes)
(let* ((end-of-line-cursor-attribute nil)
(extend-to-end-attribute nil)
(line-end-overlay nil)
(left-content
(lem-core::compute-left-display-area-content active-modes
(lem-base:point-buffer point)
point)))
point))
(tab-width (lem-core:variable-value 'lem-core:tab-width :default point)))
(destructuring-bind (string . attributes)
(lem-base::line-string/attributes (lem-base::point-line point))
(loop :for overlay :in overlays
:when (overlay-within-point-p overlay point)
:do (cond ((typep overlay 'lem-core::overlay-line-endings)
(setf line-end-overlay overlay))
((typep overlay 'lem-core::overlay-line)
(setf attributes
(lem-core::overlay-attributes attributes
0
(length string)
(lem-core:overlay-attribute overlay)))
(setf extend-to-end-attribute (lem-core:overlay-attribute overlay)))
(let ((attribute (lem-core:overlay-attribute overlay)))
(setf attributes
(lem-core::overlay-attributes attributes
0
(length string)
attribute))
(setf extend-to-end-attribute attribute)))
(t
(let ((overlay-start-charpos (overlay-start-charpos overlay point))
(overlay-end-charpos (overlay-end-charpos overlay point))
Expand All @@ -124,6 +148,7 @@
overlay-start-charpos
(or overlay-end-charpos (length string))
overlay-attribute))))))
(setf (values string attributes) (expand-tab string attributes tab-width))
(make-logical-line :string string
:attributes attributes
:left-content left-content
Expand Down Expand Up @@ -176,42 +201,48 @@
nil)

(defun compute-items-from-string-and-attributes (string attributes)
(let ((items '()))
(flet ((add (item)
(if (null items)
(push item items)
(let ((last-item (first items)))
(if (and (string-with-attribute-item-p last-item)
(string-with-attribute-item-p item)
(equal (string-with-attribute-item-attribute last-item)
(string-with-attribute-item-attribute item)))
(setf (string-with-attribute-item-string (first items))
(str:concat (string-with-attribute-item-string last-item)
(string-with-attribute-item-string item)))
(push item items))))))
(loop :for last-pos := 0 :then end
:for (start end attribute) :in attributes
:do (unless (= last-pos start)
(add (make-string-with-attribute-item :string (subseq string last-pos start))))
(add (if (and attribute
(lem-core:attribute-p attribute)
(cursor-attribute-p attribute))
(make-cursor-item :string (subseq string start end) :attribute attribute)
(make-string-with-attribute-item
:string (subseq string start end)
:attribute attribute)))
:finally (push (make-string-with-attribute-item :string (subseq string last-pos))
items)))
items))
(handler-case
(let ((items '()))
(flet ((add (item)
(if (null items)
(push item items)
(let ((last-item (first items)))
(if (and (string-with-attribute-item-p last-item)
(string-with-attribute-item-p item)
(equal (string-with-attribute-item-attribute last-item)
(string-with-attribute-item-attribute item)))
(setf (string-with-attribute-item-string (first items))
(str:concat (string-with-attribute-item-string last-item)
(string-with-attribute-item-string item)))
(push item items))))))
(loop :for last-pos := 0 :then end
:for (start end attribute) :in attributes
:do (unless (= last-pos start)
(add (make-string-with-attribute-item :string (subseq string last-pos start))))
(add (if (and attribute
(lem-core:attribute-p attribute)
(cursor-attribute-p attribute))
(make-cursor-item :string (subseq string start end) :attribute attribute)
(make-string-with-attribute-item
:string (subseq string start end)
:attribute attribute)))
:finally (push (make-string-with-attribute-item :string (subseq string last-pos))
items)))
items)
(error (e)
(log:info e string attributes)
nil)))

(defun attribute-foreground-color (attribute)
(or (and attribute
(lem-core:parse-color (lem-core:attribute-foreground attribute)))
;; TODO: fix
(display-foreground-color *display*)))

(defun attribute-background-color (attribute)
(or (and attribute
(lem-core:parse-color (lem-core:attribute-background attribute)))
;; TODO: fix
(display-background-color *display*)))

(defun compute-items-from-logical-line (logical-line)
Expand Down
20 changes: 15 additions & 5 deletions src/display-3.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,9 @@

(defvar *line-wrap*)

(deftype char-type ()
'(member :latin :cjk :braille :emoji :icon :control))

(defclass text-buffer-v2 (lem-core:text-buffer) ())

(defun attribute-image (attribute)
Expand Down Expand Up @@ -79,7 +82,9 @@

(defun char-type (char)
(let ((code (char-code char)))
(cond ((eql code #x1f4c1)
(cond ((lem-base:control-char char)
:control)
((eql code #x1f4c1)
:folder)
((<= code 128)
:latin)
Expand Down Expand Up @@ -108,6 +113,8 @@
(type :initarg :type :reader text-object-type)
(within-cursor :initform nil :initarg :within-cursor :reader text-object-within-cursor-p)))

(defclass control-character-object (text-object) ())

(defclass icon-object (text-object) ())
(defclass folder-object (text-object) ())
(defclass emoji-object (text-object) ())
Expand Down Expand Up @@ -179,15 +186,15 @@
(defun object-height (drawing-object)
(lem-if:object-height (lem-core:implementation) drawing-object))

;;; draw-object
(defun split-string-by-character-type (string)
(loop :with pos := 0 :and items := '()
:while (< pos (length string))
:for type := (char-type (char string pos))
:do (loop :with start := pos
:while (and (< pos (length string))
(eq type (char-type (char string pos))))
:do (incf pos)
:while (and (< pos (length string))
(eq type (char-type (char string pos)))
(not (eq type :control)))
:finally (push (cons type (subseq string start pos)) items))
:finally (return (nreverse items))))

Expand All @@ -205,8 +212,11 @@
(:folder 'folder-object)
(:icon 'icon-object)
(:emoji 'emoji-object)
(:control 'control-character-object)
(otherwise 'text-object))
:string string
:string (if (eq type :control)
(lem-base:control-char (char string 0))
string)
:attribute attribute
:type type
:within-cursor (and attribute
Expand Down

0 comments on commit a71dc47

Please sign in to comment.