Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv11178
Modified Files: application.lisp cello-openal.lisp cello-window.lisp cello.lpr control.lisp ctl-markbox.lisp ctl-toggle.lisp focus-utilities.lisp focus.lisp ix-grid.lisp ix-togl.lisp Log Message:
--- /project/cello/cvsroot/cello/application.lisp 2006/10/13 08:04:45 1.8 +++ /project/cello/cvsroot/cello/application.lisp 2006/11/13 05:29:26 1.9 @@ -34,7 +34,7 @@ (cl-ftgl-reset) ;; 2006-09-27 back in temporarily ... ;; new 2006-08-28: in face of weird OGL 1282 when ;; new chars hit in ratios - + (mgk::wands-clear) ;; Init global *sys* ... needed for Cello context ops (when system-type (setf *sys* (make-instance system-type :md-name 'mgsys))) --- /project/cello/cvsroot/cello/cello-openal.lisp 2006/07/06 22:09:10 1.4 +++ /project/cello/cvsroot/cello/cello-openal.lisp 2006/11/13 05:29:26 1.5 @@ -18,6 +18,8 @@
(defstruct sound paths (gain 1) callback loopingp start (source :default) buffer sources)
+(export! make-sound ix-sound-install ix-play-start) + (defun ix-sound-install (self sound) (when (and sound (cl-openal-init)) (ix-play-start self sound) @@ -72,11 +74,16 @@ (pathname (make-sound :paths (list (merge-pathnames sound-spec oal::*audio-files*))))))
+(merge-pathnames (make-pathname :directory '(:relative "mistakes")) + oal::*audio-files*) + (defun ix-sound-spec-find (self key) (when (typep self 'ix-view) (or (cdr (assoc key (sound self))) (ix-sound-spec-find .parent key))))
+(export! sound-manager sounds sources) + (defmodel sound-manager () ((sources :initarg :sources :accessor sources :initform (list (cons :default (car (al-source-gen 1))))) --- /project/cello/cvsroot/cello/cello-window.lisp 2006/10/17 21:30:08 1.6 +++ /project/cello/cvsroot/cello/cello-window.lisp 2006/11/13 05:29:26 1.7 @@ -59,7 +59,7 @@ (:MotionNotify (trc "we got motion!!!!")) (:EnterNotify ) (:LeaveNotify ) - (:FocusIn ) + (:FocusIn (TRC "cello-window-event-handler" self (ctk::tk-event-type (ctk::xsv type xe)) )) (:FocusOut ) (:KeymapNotify ) (:Expose ) --- /project/cello/cvsroot/cello/cello.lpr 2006/11/04 20:56:30 1.15 +++ /project/cello/cvsroot/cello/cello.lpr 2006/11/13 05:29:26 1.16 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Oct 17, 2006 12:56)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Nov 6, 2006 16:43)"; cg: "1.81"; -*-
(in-package :cg-user)
--- /project/cello/cvsroot/cello/control.lisp 2006/10/28 18:22:43 1.7 +++ /project/cello/cvsroot/cello/control.lisp 2006/11/13 05:29:26 1.8 @@ -20,6 +20,7 @@ (title$ (c? (format nil "~:(~a~)" ;; this is just a poor default-- really s.b. supplied by form author (string-downcase (substitute #\space #- (string (md-name self))))))) (ct-action nil :cell nil) + sound click-repeat-p (click-repeat-event (c? (bwhen (c (^click-evt)) (let ((age (f-sensitivity :age (0.1) @@ -36,6 +37,8 @@ (kb-selector nil :cell nil) :gl-name (c? (incf (gl-name-highest .w.))))
+(defmethod kb-selector (other) (declare (ignore other)) nil) + (defobserver click-repeat-event () (with-integrity (:change :obs-click-repeat-event) (when new-value --- /project/cello/cvsroot/cello/ctl-markbox.lisp 2006/11/04 20:56:30 1.10 +++ /project/cello/cvsroot/cello/ctl-markbox.lisp 2006/11/13 05:29:26 1.11 @@ -22,24 +22,21 @@ (defmethod ix-layer-expand ((self (eql :x-mark)) &rest args) `(ix-render-x-mark ,(car args) l-box ,(cadr args))))
-(defmodel ct-mark-box (ct-toggle ix-view) - ((kb-selector :cell nil :initarg :kb-selector :initform nil :reader kb-selector) - ) - (:default-initargs - :ll (- *mark-box-size*) - :lt (ups *mark-box-size*) - :lr *mark-box-size* - :lb (downs *mark-box-size*) - :skin nil ;;(c? (skin .w.)) - :pre-layer (with-layers - (:in 4) - +light-gray+ ;;;(if (^enabled) +white+ +gray+) - :off - (:frame-3d :edge-sunken :thickness 4) - :off - +dark-gray+ - (:out 4) - (:x-mark (^value))))) +(defmd ct-mark-box (ct-toggle ix-view) + :ll (- *mark-box-size*) + :lt (ups *mark-box-size*) + :lr *mark-box-size* + :lb (downs *mark-box-size*) + :skin nil ;;(c? (skin .w.)) + :pre-layer (with-layers + (:in 4) + +light-gray+ ;;;(if (^enabled) +white+ +gray+) + :off + (:frame-3d :edge-sunken :thickness 4) + :off + +dark-gray+ + (:out 4) + (:x-mark (^value))))
(defun ix-render-x-mark (do-p lbox &optional thickness &aux (thick (or thickness (/ (r-width lbox) 4)))) (when do-p @@ -67,7 +64,7 @@ :enabled t :value (c? (find (associated-value self) (value (^radio)))) :ct-action (lambda (self event) - (with-c-change :ct-radio-item + (with-cc :ct-radio-item (radio-item-to-value self event (^radio))))))
@@ -92,7 +89,7 @@
(defobserver .value ((self ct-radio)) ;; /// should every control have this? (when (^on-change) - (trcx nil radio-value-observer self new-value old-value old-value-boundp) + (trcx radio-value-observer self new-value old-value old-value-boundp) (funcall (^on-change) self new-value old-value old-value-boundp)))
(defmodel ct-radio-row (ct-radio) @@ -143,7 +140,7 @@ :ct-action (lambda (self event) (declare (ignorable event)) (trc nil "checktext bingo" (not (value self))) - (with-c-change :check-text-action + (with-cc :check-text-action (setf (value self) (not (value self)))))))
(defmodel ct-radio-labeled (ix-row ct-radio-item) @@ -184,3 +181,6 @@ () (:default-initargs :value (c-in nil))) + +(export! ct-dot-grid) +(defmd ct-dot-grid (control ix-dot-grid)) \ No newline at end of file --- /project/cello/cvsroot/cello/ctl-toggle.lisp 2006/11/04 20:56:30 1.9 +++ /project/cello/cvsroot/cello/ctl-toggle.lisp 2006/11/13 05:29:26 1.10 @@ -32,6 +32,8 @@ :pre-layer (with-layers :off +white+ :fill (:rgba (^text-color)))))
+(export! ix-control ct-action kb-selector) +(defmd ix-control (ix-view control))
(defmd ct-button (control ix-text) ;; same inheritance, but otherwise unrelated to CTText (value (c-in nil) :cell :ephemeral) @@ -39,7 +41,7 @@ (depressed (c? (^hilited))) :ct-action (lambda (self event) (declare (ignore event)) - (with-c-change :button-press + (with-cc :button-press .retog. (setf (^value) t))) :title$ (c? (string-capitalize (md-name self))) @@ -89,7 +91,7 @@ :title$ ,text :ct-action (lambda (self event) (declare (ignorable self event)) - (with-c-change :ct-button-ex-ct-action + (with-cc :ct-button-ex-ct-action ,command)) ,@initargs))
@@ -104,7 +106,7 @@ (:default-initargs :value (c-in nil) :transition-fn (lambda (current-state state-table) - ;(trc "CTFSM :transitionFN curr,table" currentstate statetable) + (trc "CTFSM :transitionFN curr,table" current-state state-table) (or (cadr (member current-state state-table :test (if (stringp current-state) #'string-equal #'eql))) @@ -112,9 +114,10 @@
:ct-action (lambda (self event) (declare (ignorable event)) - (with-integrity (:change :ctfsm-action) - (let ((newv (funcall (transition-fn self) (value self) (states self)))) - (ct-fsm-assume-value self newv)))))) + (trc "twister ct-action" self event) + (with-integrity (:change :ctfsm-action) + (let ((newv (funcall (transition-fn self) (value self) (states self)))) + (ct-fsm-assume-value self newv))))))
(defmethod ct-fsm-assume-value (self new-value) (setf (value self) new-value)) @@ -146,24 +149,34 @@ '((4 . -2) (9 . -7) (4 . -12)))) :ll 0 :lt 0 :lr (u96ths 15) :lb (downs (u96ths 15))))
+(defmethod (setf .value) :around (new (self ct-twister)) + (trcx ct-twister-value-set!!!!!!!!!!!! self new) + (call-next-method)) + +(defobserver .value ((self ct-twister)) + (when (eq :show-contents (md-name self)) + (trcx contents-twister-value-changing!!!!!!! new-value old-value old-value-boundp))) + (export! a-twister)
(defmacro a-twister ((label component-args initial-open &rest twister-args) twisted-widget) `(a-stack (,@component-args) (a-row () - (make-kid 'ct-twister - :md-name :show-contents - :value (c-in ,initial-open) - :visible (c? (^enabled)) - ,@twister-args) + (or (car .cache) + (make-kid 'ct-twister + :md-name :show-contents + :value (c-in ,initial-open) + :visible (c? (^enabled)) + ,@twister-args)) ,(if (stringp label) `(make-kid 'ix-text :text$ ,label :style-id :button) label)) ;; actually should be a form to build a widget - (a-stack (:collapsed (c? (let ((tw (fm^ :show-contents))) - (assert (eq .parent (fm-parent (fm-parent tw)))) - (not (value tw))))) + (a-stack (:collapsed (c? (eko ("collapsed!!!!!!!!!!!!" .cause) + (let ((tw (fm^ :show-contents))) + (assert (eq .parent (fm-parent (fm-parent tw)))) + (not (value tw)))))) ,twisted-widget)))
--- /project/cello/cvsroot/cello/focus-utilities.lisp 2006/06/26 17:05:20 1.4 +++ /project/cello/cvsroot/cello/focus-utilities.lisp 2006/11/13 05:29:26 1.5 @@ -40,7 +40,7 @@
(defmethod focus-on (self &optional focuser) (c-assert (or self focuser)) - ;;(trc "focus-on self, focuser" self focuser) + (trc "focus-on self, focuser" self focuser) (setf (focus (or focuser (s-focuser))) self))
(defmethod focus-gain (self) --- /project/cello/cvsroot/cello/focus.lisp 2006/07/06 22:09:10 1.4 +++ /project/cello/cvsroot/cello/focus.lisp 2006/11/13 05:29:26 1.5 @@ -40,45 +40,45 @@ (defmodel focuser (ix-canvas) ( (focus :initarg :focus - :initform (c-in nil) - :accessor focus) + :initform (c-in nil) + :accessor focus)
(textual-focus :initarg :textual-focus - :initform nil #+chya (c? (bwhen (focus (and #+runtime-system (activep (swdw)) - (^focus))) - (when (and (typep focus 'ct-text) ;; possibly any 'IXText? - (^edit-active)) - focus))) - :accessor textual-focus) - + :initform nil #+chya (c? (bwhen (focus (and #+runtime-system (activep (swdw)) + (^focus))) + (when (and (typep focus 'ct-text) ;; possibly any 'IXText? + (^edit-active)) + focus))) + :accessor textual-focus) + (edit-active :initarg :edit-active - :initform (c-in nil) - :accessor edit-active) - - (insertion-pt :initform (c-in 0) - :initarg :insertion-pt - :accessor insertion-pt) - - (sel-end :initform (c-in nil) - :accessor sel-end) - - (sel-range :documentation "selEnd identified during drag operation" - :reader sel-range :initarg :sel-range - :initform nil #+chya (c? (bwhen (focus (^textual-focus)) - (bwhen (click-evt (click-evt focus)) - (bwhen (mp (in-drag click-evt)) - (cttext-find-ip focus mp)))))) - - (undo-data :cell nil :initarg :undo-data :accessor undo-data - :initform nil #+hunh (new-undo-data) - :documentation "Data structure holding undo information" - ) + :initform (c-in nil) + :accessor edit-active) + + (insertion-pt :initform (c-in 0) + :initarg :insertion-pt + :accessor insertion-pt) + + (sel-end :initform (c-in nil) + :accessor sel-end) + + (sel-range :documentation "selEnd identified during drag operation" + :reader sel-range :initarg :sel-range + :initform nil #+chya (c? (bwhen (focus (^textual-focus)) + (bwhen (click-evt (click-evt focus)) + (bwhen (mp (in-drag click-evt)) + (cttext-find-ip focus mp)))))) + + (undo-data :cell nil :initarg :undo-data :accessor undo-data + :initform nil #+hunh (new-undo-data) + :documentation "Data structure holding undo information" ) - (:default-initargs - :kids (c? (the-kids (^content) - ; (mkPart :caret (CTEditcaret)) - ; (mkPart :selBox (IXEditSelection)) - )))) + ) + (:default-initargs + :kids (c? (the-kids (^content) + ; (mkPart :caret (CTEditcaret)) + ; (mkPart :selBox (IXEditSelection)) + ))))
(defun focuser (self) (swdw) --- /project/cello/cvsroot/cello/ix-grid.lisp 2006/06/05 01:47:49 1.2 +++ /project/cello/cvsroot/cello/ix-grid.lisp 2006/11/13 05:29:26 1.3 @@ -208,3 +208,43 @@ (elt (kids grid) (+ (* row-no (col-ct grid)) col-no)))
+;;; --- ix dot grid ---------------------------------------------------------- + +(export! ix-dot-grid dot-color ^dot-color dot-size ^dot-size) + +(defmd ix-dot-grid (ix-view) + dot-color + (dot-size 6) + (rows (c? (when (numberp (^value)) + (floor (sqrt (abs (^value))))))) + (columns (c? (when (and (numberp (^value)) + (numberp (^rows)) + (plusp (^rows))) + (ceiling (abs (^value)) (^rows))))) + :ll (c? (if (^collapsed) + 0 (- (v2-h (^inset))))) + :lt (c? (if (^collapsed) + 0 (ups (v2-v (^inset))))) + :lb (c? (if (^collapsed) + 0 (+ (downs (* 2 (v2-v (^inset)))) + (* (^rows) (- (+ 2 (^dot-size)))) + -2))) + :lr (c? (if (^collapsed) + 0 (+ (* 2 (v2-h (^inset))) + (* (+ 2 (^dot-size)) (^columns)) + -2))) + :pre-layer (c? (with-layers :off +gray+ :fill + (:poly-mode gl_front_and_back gl_fill) + (:rgba (^dot-color))))) + +(defmethod ix-paint ((self ix-dot-grid)) + (let ((spacing 2) + (offset (ceiling (^dot-size) 2))) + (gl-point-size (^dot-size)) + (gl-enable gl_point_smooth) + (with-gl-translation ((+ offset (v2-h (^inset))) (downs (+ offset (v2-v (^inset))))) + (with-gl-begun (gl_points) + (loop for pn below (abs (^value)) + for row = (mod pn (^rows)) + for col = (floor pn (^rows)) + do (gl-vertex2f (* col (+ spacing (^dot-size)))(* row (- (+ spacing (^dot-size)))))))))) --- /project/cello/cvsroot/cello/ix-togl.lisp 2006/11/04 20:56:30 1.15 +++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/11/13 05:29:26 1.16 @@ -280,7 +280,7 @@ (defmethod togl-reshape-using-class ((self ix-togl) &aux (width (ctk::togl-width (ctk::togl-ptr self))) (height (ctk::togl-height (ctk::togl-ptr self)))) (let ((ctk::*tki* (ctk::togl-interp (ctk::togl-ptr self)))) - (trc nil "mg-window-reshape" self width height) + (trc "mg-window-reshape" self width height) (gl-viewport 0 0 width height)
(gl-matrix-mode gl_projection)