Skip to content

Commit

Permalink
Add T as an alias for *STANDARD-WINDOW*
Browse files Browse the repository at this point in the history
Fixes #34
  • Loading branch information
sjl authored and stylewarning committed Nov 3, 2017
1 parent 983d6b9 commit e41103a
Show file tree
Hide file tree
Showing 6 changed files with 79 additions and 57 deletions.
42 changes: 23 additions & 19 deletions src/high-level/cursor.lisp
Expand Up @@ -7,20 +7,20 @@
(defun cursor-position (window)
"Given a window WINDOW, return its X and Y coordinates as two values respectively."
(let (x y)
(charms/ll:getyx (window-pointer window) y x)
(charms/ll:getyx (window-pointer (resolve-window window)) y x)
(values x y)))

(defun move-cursor (window x y)
"Move the cursor in window WINDOW to the coordinates (X, Y)."
(check-status (charms/ll:wmove (window-pointer window) y x))
(check-status (charms/ll:wmove (window-pointer (resolve-window window)) y x))
t)

(defmacro with-restored-cursor (window &body body)
"Execute the body BODY, restoring the cursor position in the window WINDOW to its beginning state."
(let ((gwindow (gensym "WINDOW-"))
(cursor-x (gensym "CURSOR-X"))
(cursor-y (gensym "CURSOR-Y")))
`(let ((,gwindow ,window))
`(let ((,gwindow (resolve-window ,window)))
(multiple-value-bind (,cursor-x ,cursor-y)
(cursor-position ,gwindow)
(multiple-value-prog1 (progn ,@body)
Expand All @@ -29,31 +29,35 @@
(defun move-cursor-up (window &key (amount 1))
"Move the cursor in the window WINDOW up by 1 character. If the positive integer AMOUNT is specified, it will be moved up AMOUNT characters. If negative, it will move down AMOUNT characters."
(check-type amount integer)
(multiple-value-bind (x y) (cursor-position window)
(move-cursor window
x
(max 0 (- y amount)))))
(let ((window (resolve-window window)))
(multiple-value-bind (x y) (cursor-position window)
(move-cursor window
x
(max 0 (- y amount))))))

(defun move-cursor-down (window &key (amount 1))
"Move the cursor in the window WINDOW down by 1 character. If the positive integer AMOUNT is specified, it will be moved down AMOUNT characters. If negative, it will move up AMOUNT characters."
(check-type amount integer)
(multiple-value-bind (x y) (cursor-position window)
(move-cursor window
x
(max 0 (+ y amount)))))
(let ((window (resolve-window window)))
(multiple-value-bind (x y) (cursor-position window)
(move-cursor window
x
(max 0 (+ y amount))))))

(defun move-cursor-right (window &key (amount 1))
"Move the cursor in the window WINDOW right by 1 character. If the positive integer AMOUNT is specified, it will be moved right AMOUNT characters. If negative, it will move left AMOUNT characters."
(check-type amount integer)
(multiple-value-bind (x y) (cursor-position window)
(move-cursor window
(max 0 (+ x amount))
y)))
(let ((window (resolve-window window)))
(multiple-value-bind (x y) (cursor-position window)
(move-cursor window
(max 0 (+ x amount))
y))))

(defun move-cursor-left (window &key (amount 1))
"Move the cursor in the window WINDOW left by 1 character. If the positive integer AMOUNT is specified, it will be moved left AMOUNT characters. If negative, it will move right AMOUNT characters."
(check-type amount integer)
(multiple-value-bind (x y) (cursor-position window)
(move-cursor window
(max 0 (- x amount))
y)))
(let ((window (resolve-window window)))
(multiple-value-bind (x y) (cursor-position window)
(move-cursor window
(max 0 (- x amount))
y))))
12 changes: 8 additions & 4 deletions src/high-level/initialization.lisp
Expand Up @@ -55,12 +55,14 @@ Currently, there are no OPTIONS."

(defun enable-extra-keys (window)
"Enable extra keys, such as arrow and function keys, in the window WINDOW."
(check-status (charms/ll:keypad (window-pointer window) charms/ll:TRUE))
(check-status (charms/ll:keypad (window-pointer (resolve-window window))
charms/ll:TRUE))
t)

(defun disable-extra-keys (window)
"Disable extra keys, such as arrow and function keys, in the window WINDOW."
(check-status (charms/ll:keypad (window-pointer window) charms/ll:FALSE))
(check-status (charms/ll:keypad (window-pointer (resolve-window window))
charms/ll:FALSE))
t)

(defvar *input-mode* nil)
Expand Down Expand Up @@ -98,8 +100,10 @@ If INTERPRET-CONTROL-CHARACTERS is T, then control characters like Ctrl-C will b

(defun enable-non-blocking-mode (window)
"Enable non-blocking mode for the window WINDOW. This will cause character input functions to not block and error (or return NIL)."
(check-status (charms/ll:nodelay (window-pointer window) charms/ll:TRUE)))
(check-status (charms/ll:nodelay (window-pointer (resolve-window window))
charms/ll:TRUE)))

(defun disable-non-blocking-mode (window)
"Disable non-blocking mode for the window WINDOW. This will cause character input to block."
(check-status (charms/ll:nodelay (window-pointer window) charms/ll:FALSE)))
(check-status (charms/ll:nodelay (window-pointer (resolve-window window))
charms/ll:FALSE)))
2 changes: 1 addition & 1 deletion src/high-level/input.lisp
Expand Up @@ -6,7 +6,7 @@

(defun get-char (window &key ignore-error)
"Get a character from the window WINDOW. In the event a character is not ready or could not be returned, thensignal an error. If IGNORE-ERROR is T, then instead return NIL."
(let ((c (charms/ll:wgetch (window-pointer window))))
(let ((c (charms/ll:wgetch (window-pointer (resolve-window window)))))
(cond
((not (eql c charms/ll:ERR)) (c-char-to-character c))
(ignore-error nil)
Expand Down
39 changes: 21 additions & 18 deletions src/high-level/output.lisp
Expand Up @@ -7,14 +7,14 @@
(defun insert-char-at-cursor (window char)
"Insert the character CHAR at the cursor within the window WINDOW, advancing the rest of the line, without moving the cursor. (This is akin to pressing the 'insert' key and typing a character.)"
(check-status
(charms/ll:winsch (window-pointer window)
(charms/ll:winsch (window-pointer (resolve-window window))
(character-to-c-char char)))
t)

(defun insert-char-at-point (window char x y)
"Insert the character CHAR at the coordinates (X,Y) within the window WINDOW, advancing the rest of the line, without moving the cursor. (This is akin to pressing the 'insert' key and typing a character.)"
(check-status
(charms/ll:mvwinsch (window-pointer window)
(charms/ll:mvwinsch (window-pointer (resolve-window window))
y
x
(character-to-c-char char)))
Expand All @@ -24,47 +24,50 @@
;;; WINDOW?
(defun last-position-p (window x y)
(multiple-value-bind (width height)
(window-dimensions window)
(window-dimensions (resolve-window window))
(and (= x (1- width))
(= y (1- height)))))

;;; Write the character CHAR at the last position of the window
;;; WINDOW. This assumes that the width of the window is at least 2.
(defun write-char-at-last-position (window char)
(multiple-value-bind (width height)
(window-dimensions window)
(let* ((last-x (1- width))
(last-y (1- height)))
(insert-char-at-point window char last-x last-y))))
(let ((window (resolve-window window)))
(multiple-value-bind (width height)
(window-dimensions window)
(let* ((last-x (1- width))
(last-y (1- height)))
(insert-char-at-point window char last-x last-y)))))

(defun write-char-at-cursor (window char)
"Write the character CHAR to the window WINDOW at the cursor."
(multiple-value-bind (x y)
(cursor-position window)
(if (last-position-p window x y)
(let ((window (resolve-window window)))
(multiple-value-bind (x y)
(cursor-position window)
(if (last-position-p window x y)
(write-char-at-last-position window char)
(check-status
(charms/ll:waddch (window-pointer window)
(character-to-c-char char)))))
(charms/ll:waddch (window-pointer window)
(character-to-c-char char))))))
t)

(defun write-string-at-cursor (window string)
"Write the string STRING to the window WINDOW at the cursor."
(check-status
(charms/ll:waddstr (window-pointer window) string))
(charms/ll:waddstr (window-pointer (resolve-window window)) string))
t)

(defun write-char-at-point (window char x y)
"Write the character CHAR to the window WINDOW at the coordinates (X, Y)."
(if (last-position-p window x y)
(let ((window (resolve-window window)))
(if (last-position-p window x y)
(write-char-at-last-position window char)
(check-status
(charms/ll:mvwaddch (window-pointer window) y x
(character-to-c-char char))))
(charms/ll:mvwaddch (window-pointer window) y x
(character-to-c-char char)))))
t)

(defun write-string-at-point (window string x y)
"Write the string STRING to the window WINDOW at the coordinates (X, Y)."
(check-status
(charms/ll:mvwaddstr (window-pointer window) y x string))
(charms/ll:mvwaddstr (window-pointer (resolve-window window)) y x string))
t)
6 changes: 6 additions & 0 deletions src/high-level/utilities.lisp
Expand Up @@ -42,3 +42,9 @@
(if (eql value charms/ll:ERR)
(error (or error-message "Error in curses call."))
value))

(declaim (inline resolve-window))
(defun resolve-window (window-designator)
(if (eq t window-designator)
*standard-window*
window-designator))
35 changes: 20 additions & 15 deletions src/high-level/windows.lisp
Expand Up @@ -45,56 +45,61 @@ Note that windows may not overlap."

(defun destroy-window (window)
"Destroy the window WINDOW."
(check-status (charms/ll:delwin (window-pointer window)))
(slot-makunbound window 'pointer)
(let ((window (resolve-window window)))
(check-status (charms/ll:delwin (window-pointer window)))
(slot-makunbound window 'pointer))
t)

(defun copy-window (window)
"Copy the window WINDOW."
(let ((new-pointer (charms/ll:dupwin (window-pointer window))))
(when (cffi:null-pointer-p new-pointer)
(error "Failed to copy the window ~S." window))
(make-instance 'window :pointer new-pointer)))
(let ((window (resolve-window window)))
(let ((new-pointer (charms/ll:dupwin (window-pointer window))))
(when (cffi:null-pointer-p new-pointer)
(error "Failed to copy the window ~S." window))
(make-instance 'window :pointer new-pointer))))

(defun window-dimensions (window)
"Given a window WINDOW, return its width and height as two values respectively."
(let (width height)
(charms/ll:getmaxyx (window-pointer window) height width)
(charms/ll:getmaxyx (window-pointer (resolve-window window)) height width)
(values width height)))

(defun refresh-window (window)
"Refresh the display of the window WINDOW."
(check-status (charms/ll:wrefresh (window-pointer window)))
(check-status (charms/ll:wrefresh (window-pointer (resolve-window window))))
t)

(defun force-repaint (window)
"Force the entire window to be cleared and repainted on the next call to `CHARMS:REFRESH-WINDOW'."
(check-status (charms/ll:clearok (window-pointer window) charms/ll:TRUE))
(check-status (charms/ll:clearok (window-pointer (resolve-window window))
charms/ll:TRUE))
t)

(defun clear-window (window &key force-repaint)
"Blank out the contents of the window WINDOW. If FORCE-REPAINT is T, then the window will be repainted entirely in the next refresh. (Using this option can be more optimally performant than calling `CHARMS:FORCE-REPAINT' manually.)"
(if force-repaint
(let ((window (resolve-window window)))
(if force-repaint
(check-status (charms/ll:wclear (window-pointer window)))
(check-status (charms/ll:werase (window-pointer window))))
(check-status (charms/ll:werase (window-pointer window)))))
t)

(defun clear-window-after-cursor (window)
"Clear the rest of the window after the cursor in the window WINDOW."
;; XXX: Man page says "returns an error if the cursor position is
;; about to wrap"
(check-status (charms/ll:wclrtobot (window-pointer window))))
(check-status (charms/ll:wclrtobot (window-pointer (resolve-window window)))))

(defun clear-line-after-cursor (window)
"Clear the rest of the line after the cursor in the window WINDOW."
(check-status (charms/ll:wclrtoeol (window-pointer window))))
(check-status (charms/ll:wclrtoeol (window-pointer (resolve-window window)))))

(defun char-at-cursor (window)
"What is the character at the cursor in the window WINDOW?"
(c-char-to-character (charms/ll:winch (window-pointer window))))
(c-char-to-character (charms/ll:winch (window-pointer (resolve-window window)))))

(defun char-at-point (window x y)
"What is the character at the point (X, Y) in the window WINDOW?"
(c-char-to-character (charms/ll:mvwinch (window-pointer window) y x)))
(c-char-to-character (charms/ll:mvwinch (window-pointer (resolve-window window))
y x)))

;;; TODO: scrollok, idlok, idcok, nl, nonl

0 comments on commit e41103a

Please sign in to comment.