Commit 3c5cfe77 authored by David O'Toole's avatar David O'Toole

fixups

parent 7e6b2703
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -7,7 +7,7 @@
(SELF &OPTIONAL OTHER))
(defgeneric add-node
(BUFFER NODE &OPTIONAL X Y (Z) REVIVE-P)
(BUFFER NODE &OPTIONAL X Y (Z))
(:documentation "Add the mode NODE to the BUFFER.
Optionally set the location with X,Y,Z."))
......
......@@ -77,6 +77,10 @@ See sidebar for more commands to try.
(defun clear-clipboard ()
(initialize-clipboard-maybe :force))
(defun clipboard ()
(initialize-clipboard-maybe)
*clipboard*)
(defun bind-event-to-text-insertion (self key mods text)
(bind-event-to-task self key mods
(make-instance 'task :insert-string self (list text))))
......@@ -437,11 +441,11 @@ See sidebar for more commands to try.
;;; The halo, which manages all the handles
(defparameter *halo-handles*
'(evaluate drop move menu rotate resize pick-up cut copy destroy))
'(evaluate drop move open-menu rotate resize pick-up cut copy destroy))
(defclass halo (node) ((target :initform nil)))
(defmethod add-node ((halo halo) (node node) &optional x y (z 0) revive-p)
(defmethod add-node ((halo halo) (node node) &optional x y (z 0))
(with-slots (inputs) halo
(push node inputs)
(adopt halo node)))
......@@ -457,7 +461,6 @@ See sidebar for more commands to try.
(update-result-lists (find-object self))
(layout (find-object self)))
(defun halo-minimum-height () (* 5 *handle-scale* (indicator-size)))
(defun halo-minimum-width () (* 5 *handle-scale* (indicator-size)))
......@@ -582,6 +585,7 @@ See sidebar for more commands to try.
options label
(pinned :initform nil)
(prompt-string :initform *default-prompt-string*)
(cursor-clock :initform 0 :accessor cursor-clock :initarg :cursor-clock)
(category :initform :data)
(history :initform nil :documentation "A queue of strings containing the command history.")
(history-position :initform 0)))
......@@ -1241,13 +1245,13 @@ See sidebar for more commands to try.
(defparameter *cursor-blink-color* "cyan"
"The color of the cursor when blinking.")
(defmethod update-cursor-clock ((self node))
(defmethod update-cursor-clock ((self prompt))
(with-slots (cursor-clock) self
(decf cursor-clock)
(when (> (- 0 *cursor-blink-time*) cursor-clock)
(setf cursor-clock *cursor-blink-time*))))
(defmethod draw-cursor-glyph ((self node)
(defmethod draw-cursor-glyph ((self prompt)
&optional (x 0) (y 0) (width 2) (height (font-height *font*))
&key color blink)
(with-slots (cursor-clock) self
......
This diff is collapsed.
;;; xelf.lisp --- an emacs-inspired Lisp game engine
;; Copyright (C) 2006-2016 David O'Toole
;; Copyright (C) 2006-2017 David O'Toole
;; Author: David O'Toole <dto@xelf.me>
;; Keywords: multimedia, games
......@@ -22,6 +22,7 @@
;; This program is dedicated to our beloved Yogi, who died 2006-10-06.
;; Re-dedicated June 2012 to our beloved Cookie-Puss.
;; Re-dedicated April 2017 to dear Mr. Snaps
;;; Requirements:
......@@ -30,7 +31,7 @@
;;; Code:
(defpackage :xelf
(:documentation "A 2d game engine in Common Lisp.")
(:documentation "A simple 2d game engine in Common Lisp.")
(:use :common-lisp)
(:export
*active-prompt-color*
......@@ -52,6 +53,8 @@
*chatter-period*
*clear-cached-fonts-on-buffer-switch*
*client*
*clipboard*
clipboard
*client-host*
*client-output-port*
*client-port*
......@@ -64,6 +67,9 @@
*debug-on-error*
*default-cursor-width*
*default-entry-label-color*
*clear-cached-fonts-on-buffer-switch*
*clear-cached-images-on-resize*
*clear-cached-images-on-buffer-switch*
*default-entry-text-color*
*default-frame-rate*
*default-joystick-profile*
......
......@@ -78,20 +78,20 @@
(defmethod update ((self modeline))
(mapc #'pin (slot-value self 'inputs))
(set-value (%%inputs self :buffer-id) (or (slot-value (current-buffer) 'buffer-name) "*untitled-buffer*"))
(set-value (%%inputs self :objects) (modeline-database-string (hash-table-count (slot-value (current-buffer) 'objects))
(set-value (input-node self :buffer-id) (or (slot-value (current-buffer) 'buffer-name) "*untitled-buffer*"))
(set-value (input-node self :objects) (modeline-database-string (hash-table-count (slot-value (current-buffer) 'objects))
(hash-table-count *database*)))
(set-value (%%inputs self :position)
(set-value (input-node self :position)
(modeline-position-string
(slot-value (current-buffer) 'window-x)
(slot-value (current-buffer) 'window-y)))
(set-value (%%inputs self :mode)
(set-value (input-node self :mode)
(if (current-buffer)
(if (slot-value (current-buffer) 'paused)
"(paused)"
"(playing)")
"(empty)"))
(set-value (%%inputs self :status)
(set-value (input-node self :status)
(or *modeline-status-string* " ")))
(defmethod draw ((self modeline))
......@@ -157,7 +157,7 @@
(command-argument-string (thing)
(concatenate 'string (command-name-string thing) ": ")))
`(progn
;;(defun ,name (&key ,@arglist) ,@body)
(defun ,name (&key ,@arglist) ,@body)
(export ',name)
(define-node-macro ,name
(:super phrase
......
* Task list
** TODO remove REVIVE-P arg from ADD-NODE
** TODO fix data entry widget
** DONE split up menus declaration var
CLOSED: [2017-04-11 Tue 16:19]
** TODO fix de-selecting objects when opening menubar
** TODO fix POSITION-WITHIN-PARENT error on pressing TAB
** TODO right click pop up menus
** TODO pinnable pop up menus
** TODO allow tear-off menus
......
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment