gsharp-cvs

gsharp-cvs@common-lisp.net

396 discussions

[gsharp-cvs] GIT update: The Gsharp interactive score editor branch, master, updated. ee24caa7bbde4d44ae2361e6a8d30886a843269b
by David Lewis 14 Sep '11

14 Sep '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "The Gsharp interactive score editor". The branch, master has been updated via ee24caa7bbde4d44ae2361e6a8d30886a843269b (commit) via 84b7ea00538639a811251bbf305d9620a9f5e2e3 (commit) via 38bdf99fdb55109467b7a3e2ae6986ddad756e86 (commit) via bb0bc595f579ccd3a0e93d86f954cbc517e8df52 (commit) via a370b922821ca320a1fdf5196162ef0fe59a7027 (commit) via a5087f708225019550ce1711d06dcedbaff57bf6 (commit) via 34a9f6665fa10df4a11aa2d3b3b61cf91db26c8d (commit) via eda614c4c2c92036510a0835c87e05816ae5cf0b (commit) via 1294461a4345c07929f56fae228552c7b8fdff33 (commit) via 3165088660f91c876b00c17a0471730ea8bce568 (commit) via 46184f8a618ea6a1bb9bbc248eb8442d89c9f6b1 (commit) via 2f1cbfa02872c54e977b23872c6b5d0f95aa461b (commit) via 4e990bdfbb893f9110acfc3b507480a6062e490a (commit) via f6e714b94a7dd1a16edb5c479a6e10743e5bf2fd (commit) via 02f595fddd8f11e76d8c1989540ba31dbcaaacc4 (commit) via 19843aea53a3a6ea35cbd89e50c9ab768025c882 (commit) via ae5b882d097e0276c2828acc7e5be29489cc186d (commit) via 5acbc98f357e2c3ba8ffa5a44f4a3b669caf993d (commit) via 572b4ee1d8c24b34d590b35e6dbe076d18ef4133 (commit) via 62eb5e8edd2dab8aea5611ed8a8bbde151e40f2f (commit) from d851a64a26463c837f6b4c9ee298a13224487f35 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit ee24caa7bbde4d44ae2361e6a8d30886a843269b Author: David Lewis <d.lewis(a)gold.ac.uk> Date: Tue Apr 19 14:24:53 2011 +0100 Basic undo implemented for simple operations. commit 84b7ea00538639a811251bbf305d9620a9f5e2e3 Author: David Lewis <d.lewis(a)gold.ac.uk> Date: Thu Feb 3 14:16:58 2011 +0000 Time signatures commit 38bdf99fdb55109467b7a3e2ae6986ddad756e86 Author: David Lewis <d.lewis(a)gold.ac.uk> Date: Tue Jan 25 09:09:13 2011 +0000 Adding more MXML dtds for checking commit bb0bc595f579ccd3a0e93d86f954cbc517e8df52 Author: David Lewis <d.lewis(a)gold.ac.uk> Date: Fri Oct 22 12:17:17 2010 +0100 Mid-staff clefs commit a370b922821ca320a1fdf5196162ef0fe59a7027 Author: David Lewis <d.lewis(a)gold.ac.uk> Date: Wed Sep 1 16:18:35 2010 +0100 MXML fixes commit a5087f708225019550ce1711d06dcedbaff57bf6 Author: David Lewis <d.lewis(a)gold.ac.uk> Date: Tue Aug 31 12:47:13 2010 +0100 Preparation for the ability to set horizontal spacing. Two types of horizontal positioning -- an offset from the default position (which doesn't affect the flow) and a padding (which does). Also some package exports. commit 34a9f6665fa10df4a11aa2d3b3b61cf91db26c8d Author: David Lewis <d.lewis(a)gold.ac.uk> Date: Thu Aug 19 12:08:08 2010 +0100 Settable inactive colour (to be set, for example, by medium, or based on taste) commit eda614c4c2c92036510a0835c87e05816ae5cf0b Author: David Lewis <d.lewis(a)gold.ac.uk> Date: Thu Aug 19 15:44:54 2010 +0100 COM-JUMP-TO-HERE and click to move cursor interface commit 1294461a4345c07929f56fae228552c7b8fdff33 Author: David Lewis <d.lewis(a)gold.ac.uk> Date: Thu Aug 19 15:44:54 2010 +0100 Basic button support commit 3165088660f91c876b00c17a0471730ea8bce568 Author: David Lewis <dlewis(a)Power.local> Date: Fri Aug 13 11:28:53 2010 +0200 Add images/icon buttons for CLIM commit 46184f8a618ea6a1bb9bbc248eb8442d89c9f6b1 Author: David Lewis <dlewis(a)Power.local> Date: Mon Aug 16 15:21:41 2010 +0100 Draw current element now actually draws current element and in approximately the right place. It's also now calling a DRAW-CURRENT-ELEMENT generic function so that it can be expanded for notations and objects other than clusters. commit 2f1cbfa02872c54e977b23872c6b5d0f95aa461b Author: David Lewis <dlewis(a)Power.local> Date: Thu Aug 12 10:00:18 2010 +0200 Zoom functionality (and change of raster changing function names so that COM-ZOOM-IN means what it should) commit 4e990bdfbb893f9110acfc3b507480a6062e490a Author: David Lewis <dlewis(a)Power.local> Date: Wed Aug 11 22:18:00 2010 +0200 Colour current note commit f6e714b94a7dd1a16edb5c479a6e10743e5bf2fd Author: David Lewis <dlewis(a)Power.local> Date: Wed Aug 11 15:49:38 2010 +0200 Reversed version of ISTATE-ROTATE-NOTEHEADS, associated with keystrokes #\i #\g commit 02f595fddd8f11e76d8c1989540ba31dbcaaacc4 Author: David Lewis <dlewis(a)Power.local> Date: Wed Aug 11 12:52:30 2010 +0200 Spelling error of slipce for slice in cursor.lisp and excess of com-more-sharps in modes.lisp commit 19843aea53a3a6ea35cbd89e50c9ab768025c882 Author: David Lewis <d.lewis(a)gold.ac.uk> Date: Tue Aug 31 11:25:35 2010 +0100 File dialog box (new dependency on CLIM-LISTENER) commit ae5b882d097e0276c2828acc7e5be29489cc186d Author: Christophe Rhodes <csr21(a)cantab.net> Date: Wed Jun 16 12:18:47 2010 +0100 more flexible pagination New generic function SYSTEMS-PER-PAGE commit 5acbc98f357e2c3ba8ffa5a44f4a3b669caf993d Author: Christophe Rhodes <csr21(a)cantab.net> Date: Wed Jun 16 12:13:50 2010 +0100 MusicXML fixes Motivated by use as a webtoy: * be careful in PCDATA not to take the node-value of something that's not a node; * attributes in the wild aren't always the first element in the bar; search harder for them; * new function PARSE-MXML-CLEF; * new function GET-DTD-PATH. commit 572b4ee1d8c24b34d590b35e6dbe076d18ef4133 Author: David Lewis <dlewis(a)Power.local> Date: Mon Jan 25 21:15:24 2010 +0000 Rastral size change with + and - commit 62eb5e8edd2dab8aea5611ed8a8bbde151e40f2f Author: Christophe Rhodes <csr21(a)cantab.net> Date: Wed Jun 16 12:11:06 2010 +0100 Add .gitignore file ----------------------------------------------------------------------- Summary of changes: .gitignore | 1 + Mxml/mxml-dtds/{ => 1.0}/ISOlat1.pen | 0 Mxml/mxml-dtds/{ => 1.0}/ISOlat2.pen | 0 Mxml/mxml-dtds/{ => 1.0}/MIDIEvents10.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/attributes.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/barline.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/common.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/direction.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/identity.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/layout.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/link.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/midixml.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/midixml.xsl | 0 Mxml/mxml-dtds/{ => 1.0}/note.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/opus.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/parttime.xsl | 0 Mxml/mxml-dtds/{ => 1.0}/partwise.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/score.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/timepart.xsl | 0 Mxml/mxml-dtds/{ => 1.0}/timewise.dtd | 0 Mxml/mxml-dtds/{ => 1.0}/to10.xsl | 0 Mxml/mxml-dtds/{ => 1.1}/ISOlat1.pen | 0 Mxml/mxml-dtds/{ => 1.1}/ISOlat2.pen | 0 Mxml/mxml-dtds/{ => 1.1}/MIDIEvents10.dtd | 390 +++--- Mxml/mxml-dtds/{ => 1.1}/attributes.dtd | 722 +++++----- Mxml/mxml-dtds/{ => 1.1}/barline.dtd | 196 ++-- Mxml/mxml-dtds/{ => 1.1}/common.dtd | 1288 +++++++++--------- Mxml/mxml-dtds/{ => 1.1}/direction.dtd | 1232 +++++++++--------- Mxml/mxml-dtds/{ => 1.1}/identity.dtd | 198 ++-- Mxml/mxml-dtds/{ => 1.1}/layout.dtd | 240 ++-- Mxml/mxml-dtds/{ => 1.1}/link.dtd | 120 +- Mxml/mxml-dtds/{ => 1.1}/midixml.dtd | 442 +++--- Mxml/mxml-dtds/{ => 1.1}/midixml.xsl | 112 +- Mxml/mxml-dtds/{ => 1.1}/note.dtd | 2052 ++++++++++++++-------------- Mxml/mxml-dtds/{ => 1.1}/opus.dtd | 132 +- Mxml/mxml-dtds/{ => 1.1}/parttime.xsl | 344 +++--- Mxml/mxml-dtds/{ => 1.1}/partwise.dtd | 298 ++-- Mxml/mxml-dtds/{ => 1.1}/score.dtd | 618 +++++----- Mxml/mxml-dtds/{ => 1.1}/timepart.xsl | 350 +++--- Mxml/mxml-dtds/{ => 1.1}/timewise.dtd | 298 ++-- Mxml/mxml-dtds/{ => 1.1}/to10.xsl | 354 +++--- Mxml/mxml-dtds/2.0/attributes.mod | 414 ++++++ Mxml/mxml-dtds/2.0/barline.mod | 120 ++ Mxml/mxml-dtds/2.0/common.mod | 894 ++++++++++++ Mxml/mxml-dtds/2.0/container.dtd | 95 ++ Mxml/mxml-dtds/2.0/direction.mod | 823 +++++++++++ Mxml/mxml-dtds/2.0/dtd-license.html | 140 ++ Mxml/mxml-dtds/2.0/identity.mod | 127 ++ Mxml/mxml-dtds/2.0/isolat1.ent | 103 ++ Mxml/mxml-dtds/2.0/isolat2.ent | 162 +++ Mxml/mxml-dtds/2.0/layout.mod | 171 +++ Mxml/mxml-dtds/2.0/link.mod | 82 ++ Mxml/mxml-dtds/{ => 2.0}/midixml.dtd | 441 +++--- Mxml/mxml-dtds/{ => 2.0}/midixml.xsl | 112 +- Mxml/mxml-dtds/2.0/musicxml-index.xls | Bin 0 -> 104960 bytes Mxml/mxml-dtds/{note.dtd => 2.0/note.mod} | 2112 +++++++++++++++-------------- Mxml/mxml-dtds/2.0/opus.dtd | 91 ++ Mxml/mxml-dtds/{ => 2.0}/parttime.xsl | 344 +++--- Mxml/mxml-dtds/2.0/partwise.dtd | 148 ++ Mxml/mxml-dtds/2.0/score.mod | 404 ++++++ Mxml/mxml-dtds/{ => 2.0}/timepart.xsl | 350 +++--- Mxml/mxml-dtds/2.0/timewise.dtd | 148 ++ Mxml/mxml-dtds/{ => 2.0}/to10.xsl | 360 +++--- Mxml/mxml-dtds/2.0/to11.xsl | 242 ++++ Mxml/mxml.lisp | 282 +++-- buffer.lisp | 43 +- clim-utils.lisp | 358 +++++ cursor.lisp | 6 +- drawing.lisp | 191 ++- gsharp.asd | 4 +- gui.lisp | 304 ++++- measure.lisp | 32 +- melody.lisp | 25 +- modes.lisp | 11 +- packages.lisp | 9 +- score-pane.lisp | 4 +- sdl.lisp | 1 - undo.lisp | 292 ++++ 78 files changed, 12072 insertions(+), 6760 deletions(-) create mode 100644 .gitignore copy Mxml/mxml-dtds/{ => 1.0}/ISOlat1.pen (100%) copy Mxml/mxml-dtds/{ => 1.0}/ISOlat2.pen (100%) copy Mxml/mxml-dtds/{ => 1.0}/MIDIEvents10.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/attributes.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/barline.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/common.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/direction.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/identity.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/layout.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/link.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/midixml.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/midixml.xsl (100%) create mode 100644 Mxml/mxml-dtds/1.0/mxml.diff copy Mxml/mxml-dtds/{ => 1.0}/note.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/opus.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/parttime.xsl (100%) copy Mxml/mxml-dtds/{ => 1.0}/partwise.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/score.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/timepart.xsl (100%) copy Mxml/mxml-dtds/{ => 1.0}/timewise.dtd (100%) copy Mxml/mxml-dtds/{ => 1.0}/to10.xsl (100%) copy Mxml/mxml-dtds/{ => 1.1}/ISOlat1.pen (100%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/ISOlat2.pen (100%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/MIDIEvents10.dtd (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/attributes.dtd (97%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/barline.dtd (97%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/common.dtd (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/direction.dtd (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/identity.dtd (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/layout.dtd (97%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/link.dtd (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/midixml.dtd (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/midixml.xsl (94%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/note.dtd (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/opus.dtd (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/parttime.xsl (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/partwise.dtd (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/score.dtd (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/timepart.xsl (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/timewise.dtd (96%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 1.1}/to10.xsl (97%) mode change 100644 => 100755 create mode 100755 Mxml/mxml-dtds/2.0/attributes.mod create mode 100755 Mxml/mxml-dtds/2.0/barline.mod create mode 100755 Mxml/mxml-dtds/2.0/common.mod create mode 100755 Mxml/mxml-dtds/2.0/container.dtd create mode 100755 Mxml/mxml-dtds/2.0/direction.mod create mode 100755 Mxml/mxml-dtds/2.0/dtd-license.html create mode 100755 Mxml/mxml-dtds/2.0/identity.mod create mode 100755 Mxml/mxml-dtds/2.0/isolat1.ent create mode 100755 Mxml/mxml-dtds/2.0/isolat2.ent create mode 100755 Mxml/mxml-dtds/2.0/layout.mod create mode 100755 Mxml/mxml-dtds/2.0/link.mod copy Mxml/mxml-dtds/{ => 2.0}/midixml.dtd (54%) mode change 100644 => 100755 copy Mxml/mxml-dtds/{ => 2.0}/midixml.xsl (75%) mode change 100644 => 100755 create mode 100755 Mxml/mxml-dtds/2.0/musicxml-index.xls copy Mxml/mxml-dtds/{note.dtd => 2.0/note.mod} (54%) mode change 100644 => 100755 create mode 100755 Mxml/mxml-dtds/2.0/opus.dtd copy Mxml/mxml-dtds/{ => 2.0}/parttime.xsl (90%) mode change 100644 => 100755 create mode 100755 Mxml/mxml-dtds/2.0/partwise.dtd create mode 100755 Mxml/mxml-dtds/2.0/score.mod copy Mxml/mxml-dtds/{ => 2.0}/timepart.xsl (89%) mode change 100644 => 100755 create mode 100755 Mxml/mxml-dtds/2.0/timewise.dtd copy Mxml/mxml-dtds/{ => 2.0}/to10.xsl (89%) mode change 100644 => 100755 create mode 100755 Mxml/mxml-dtds/2.0/to11.xsl create mode 100644 clim-utils.lisp create mode 100644 undo.lisp hooks/post-receive -- The Gsharp interactive score editor

1 0

[gsharp-cvs] GIT update: The Gsharp interactive score editor branch, master, updated. d851a64a26463c837f6b4c9ee298a13224487f35
by Robert Strandh 07 Feb '11

07 Feb '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "The Gsharp interactive score editor". The branch, master has been updated via d851a64a26463c837f6b4c9ee298a13224487f35 (commit) from 4cf078f5c810320c65fc7f4a2337aeecdb1d6263 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit d851a64a26463c837f6b4c9ee298a13224487f35 Author: Robert Strandh <strandh(a)hecl.(none)> Date: Mon Feb 7 15:46:51 2011 +0700 Added install instructions using Quicklisp. ----------------------------------------------------------------------- Summary of changes: INSTALL | 9 +++++++++ 1 files changed, 9 insertions(+), 0 deletions(-) hooks/post-receive -- The Gsharp interactive score editor

1 0

[gsharp-cvs] CVS gsharp
by crhodes 17 May '09

17 May '09

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv11043 Modified Files: gui.lisp modes.lisp Log Message: Slightly rudimentary support for view/buffer handling (C-x b and C-x k) The major thing that needs fixing is being currently unable to name and refer to views with a sensible (unique) string name. --- /project/gsharp/cvsroot/gsharp/gui.lisp 2009/04/20 15:04:47 1.97 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2009/05/17 16:11:57 1.98 @@ -25,6 +25,30 @@ ((cursor :initarg :cursor :reader cursor) (buffer :initarg :buffer :reader buffer))) +;;; FIXME: we need to sort out Drei's definition of accept methods for +;;; the general VIEW type. +;;; +;;; FIXME: we should name our views so that they can be found by a +;;; string name, rather than the unreadable-object print. There's a +;;; SUBSCRIPTABLE-NAME-MIXIN in ESA-UTILS that is used for this +;;; purpose in the analogous place in Climacs. +(define-presentation-method accept + ((type orchestra-view) stream (view textual-view) + &key (default nil defaultp) (default-type type)) + (multiple-value-bind (object success string) + (complete-input stream + (lambda (so-far action) + (complete-from-possibilities + so-far (views *esa-instance*) '() + :action action + :name-key #'princ-to-string + :value-key #'identity)) + :partial-completers '(#\Space)) + (cond + (success (values object type)) + ((and defaultp (= (length string) 0)) (values default default-type)) + (t (input-not-of-required-type string type))))) + ;;; exists for the sole purpose of a :before method that updates the ;;; measures of each modified buffer. (defclass gsharp-pane-mixin () ()) @@ -302,6 +326,7 @@ (view (make-instance 'orchestra-view :buffer buffer :cursor cursor))) + (push view (views *application-frame*)) (setf (view (car (windows *application-frame*))) view (input-state *application-frame*) input-state (filepath buffer) filepath) @@ -1533,6 +1558,38 @@ (defmethod frame-make-new-buffer ((frame gsharp) &key &allow-other-keys) (make-instance 'buffer)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Buffer / View handling + +;;; FIXME: these utility functions should live elsewhere. +(defun current-view () + (view (current-window))) + +(defun not-current-view () + (find (current-view) (views *application-frame*) :test (complement #'eq))) + +(defun not-current-view-or-first () + (or (not-current-view) (car (views *application-frame*)))) + +(defun next-or-new-buffer-view () + (or (not-current-view) + (progn (com-new-buffer) + (car (views *application-frame*))))) + +(define-gsharp-command (com-switch-to-view :name t) + ((view 'orchestra-view :default (not-current-view-or-first))) + (setf (view (current-window)) view)) + +(define-gsharp-command (com-kill-view :name t) + ((view 'orchestra-view :default (current-view))) + (let ((views (views *application-frame*))) + (setf (views *application-frame*) (remove view views)) + (when (eq view (current-view)) + (let ((next-view (next-or-new-buffer-view))) + (setf (view (current-window)) next-view))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Printing --- /project/gsharp/cvsroot/gsharp/modes.lisp 2008/04/29 07:54:24 1.29 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2009/05/17 16:11:57 1.30 @@ -11,6 +11,9 @@ (set-key `(com-delete-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\Rubout))) (set-key `(com-erase-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\Backspace))) +(set-key `(com-switch-to-view ,*unsupplied-argument-marker*) 'global-gsharp-table '((#\x :control) #\b)) +(set-key `(com-kill-view ,*unsupplied-argument-marker*) 'global-gsharp-table '((#\x :control) #\k)) + ;;; FIXME: implement numeric arg handling (set-key 'com-forward-page 'global-gsharp-table '((#\x :control) #\])) (set-key 'com-backward-page 'global-gsharp-table '((#\x :control) #\[))

1 0

[gsharp-cvs] CVS gsharp
by dlewis 20 Apr '09

20 Apr '09

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv25231 Modified Files: buffer.lisp cursor.lisp drawing.lisp gui.lisp melody.lisp packages.lisp score-pane.lisp Log Message: Basic time signature support. Only some sigs supported and spacing is basic. Key and time signatures now share a staffwise-elements slot in the stave. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2008/02/09 16:58:35 1.59 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2009/04/20 15:04:47 1.60 @@ -208,8 +208,8 @@ ;; there might be more than one key signature in the bar, ;; and they might have changed their relative order as a ;; result of the edit. - (setf (key-signatures staff) - (sort (key-signatures staff) + (setf (staffwise-elements staff) + (sort (staffwise-elements staff) (lambda (x y) (gsharp::starts-before-p x (bar y) y)))))))))) (defmethod add-element :after ((element element) (bar bar) position) --- /project/gsharp/cvsroot/gsharp/cursor.lisp 2008/11/19 16:05:13 1.8 +++ /project/gsharp/cvsroot/gsharp/cursor.lisp 2009/04/20 15:04:47 1.9 @@ -166,10 +166,10 @@ (when (> (pos cursor) position) (incf (pos cursor))))) -(defmethod add-element :after ((keysig key-signature) bar position) - (let ((staff (staff keysig))) - (setf (key-signatures staff) - (merge 'list (list keysig) (key-signatures staff) +(defmethod add-element :after ((element staffwise-element) bar position) + (let ((staff (staff element))) + (setf (staffwise-elements staff) + (merge 'list (list element) (staffwise-elements staff) (lambda (x y) (gsharp::starts-before-p x (bar y) y)))))) (defmethod remove-element :before ((element element) (bar cbar)) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/11/19 16:05:13 1.87 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2009/04/20 15:04:47 1.88 @@ -162,6 +162,13 @@ (score-pane:staff-step 5) (score-pane:staff-step 2))) +(defmethod right-bulge ((timesig time-signature) pane) + ;; FIXME: this is probably wrong; it should either compute the bulge + ;; properly, or else approximate using (length - 0.5) * + ;; typical-width-of-component + (* (length (time-signature-components timesig)) + (score-pane:staff-step 5))) + (defmethod right-bulge ((keysig key-signature) pane) ;; FIXME: shares much code with DRAW-ELEMENT (KEY-SIGNATURE). (let ((old-keysig (keysig keysig))) @@ -697,7 +704,7 @@ (defun draw-beam-group (pane elements) (let ((e (car elements))) - (when (typep e 'key-signature) + (when (typep e 'staffwise-element) (assert (null (cdr elements))) (return-from draw-beam-group (draw-element pane e (final-absolute-element-xoffset e))))) @@ -1115,3 +1122,15 @@ for x from x by (score-pane:staff-step 2.5) while (eq (aref (alterations keysig) pitch) :sharp) do (score-pane:draw-accidental pane :sharp x (+ line yoffset))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Time signature element + +(defmethod draw-element (pane (timesig time-signature) &optional (flags t)) + (declare (ignore flags)) + (let ((staff (staff timesig)) + (x (final-absolute-element-xoffset timesig))) + (score-pane:with-vertical-score-position (pane (staff-yoffset staff)) + (dolist (component (time-signature-components timesig)) + (score-pane:draw-time-signature-component pane component x))))) \ No newline at end of file --- /project/gsharp/cvsroot/gsharp/gui.lisp 2008/11/19 16:05:13 1.96 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2009/04/20 15:04:47 1.97 @@ -955,10 +955,28 @@ (define-gsharp-command com-insert-keysig () (insert-keysig)) -(defmethod remove-element :before ((keysig key-signature) (bar bar)) - (let ((staff (staff keysig))) - (setf (key-signatures staff) - (remove keysig (key-signatures staff))) +(defun insert-timesig (numerator denominator) + (let* ((cursor (current-cursor)) + (staff (car (staves (layer cursor)))) + (timesig (make-instance 'time-signature + :staff staff + :components + (list (if denominator + (cons numerator denominator) + numerator))))) + (insert-element timesig cursor) + (forward-element cursor) + timesig)) + +(define-gsharp-command (com-insert-timesig :name t) + ((numerator '(integer 1 8) :prompt "Numerator") + (denominator '(integer 1 8) :prompt "Denominator")) + (insert-timesig numerator denominator)) + +(defmethod remove-element :before ((element staffwise-element) (bar bar)) + (let ((staff (staff element))) + (setf (staffwise-elements staff) + (remove element (staffwise-elements staff))) (gsharp-measure::invalidate-everything-using-staff (current-buffer) staff))) ;;; FIXME: this isn't quite right (argh) for the case of two --- /project/gsharp/cvsroot/gsharp/melody.lisp 2007/10/22 11:45:37 1.1 +++ /project/gsharp/cvsroot/gsharp/melody.lisp 2009/04/20 15:04:47 1.2 @@ -78,8 +78,17 @@ ((clef :accessor clef :initarg :clef :initform (make-clef :treble)) (%keysig :accessor keysig :initarg :keysig :initform (make-array 7 :initial-element :natural)) - (key-signatures :accessor key-signatures :initform nil))) - + (staffwise-elements :accessor staffwise-elements :initform nil))) + +(defgeneric key-signatures (staff) + (:method ((s fiveline-staff)) + (remove-if #'(lambda (x) (not (typep x 'key-signature))) + (staffwise-elements s)))) +(defgeneric time-signatures (staff) + (:method ((s fiveline-staff)) + (remove-if #'(lambda (x) (not (typep x 'time-signature))) + (staffwise-elements s)))) + (defmethod initialize-instance :after ((obj fiveline-staff) &rest args) (declare (ignore args)) (with-slots (%keysig) obj @@ -309,9 +318,13 @@ (:documentation "make the key signature N alterations flatter by removing some sharps and/or adding some flats")) -(defclass key-signature (element) - ((%staff :initarg :staff :reader staff) - (%alterations :initform (make-array 7 :initial-element :natural) +(defclass staffwise-element (element) + ((%staff :initarg :staff :reader staff))) +(defmethod slots-to-be-saved append ((s-e staffwise-element)) + '(%staff)) + +(defclass key-signature (staffwise-element) + ((%alterations :initform (make-array 7 :initial-element :natural) :initarg :alterations :reader alterations))) (defun make-key-signature (staff &rest args &key alterations) @@ -320,7 +333,7 @@ (apply #'make-instance 'key-signature :staff staff args)) (defmethod slots-to-be-saved append ((k key-signature)) - '(%staff %alterations)) + '(%alterations)) (defmethod more-sharps ((sig key-signature) &optional (n 1)) (let ((alt (alterations sig))) @@ -357,6 +370,20 @@ ((eq (aref alt 4) :natural) (setf (aref alt 4) :flat)) ((eq (aref alt 0) :natural) (setf (aref alt 0) :flat)) ((eq (aref alt 3) :natural) (setf (aref alt 3) :flat)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Time signature +;; * no make function (no type checking) +;; * slots-to-be-saved only 'cos it's there +;; * What accessors do we need (if any)? +;; * Should I copy the (keysig) functionality from gui.lisp? + +(defclass time-signature (staffwise-element) + ((%components :initarg :components :reader time-signature-components + :initform nil))) +(defmethod slots-to-be-saved append ((t-s time-signature)) + '(%components)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/gsharp/cvsroot/gsharp/packages.lisp 2008/11/19 16:05:13 1.67 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2009/04/20 15:04:47 1.68 @@ -41,6 +41,7 @@ #:draw-stem #:draw-right-stem #:draw-left-stem #:draw-ledger-line #:draw-bar-line #:draw-beam #:staff-step #:draw-notehead #:draw-accidental #:draw-clef #:draw-rest #:draw-dot + #:draw-time-signature-component #:draw-flags-up #:draw-flags-down #:draw-tie-up #:draw-tie-down #:with-score-pane #:with-vertical-score-position @@ -55,7 +56,8 @@ (:shadow #:rest) (:export #:clef #:name #:lineno #:make-clef #:staff #:fiveline-staff #:make-fiveline-staff - #:key-signatures + #:key-signatures #:time-signatures + #:staffwise-elements #:lyrics-staff #:make-lyrics-staff #:gsharp-condition #:pitch #:accidentals #:dots #:note #:make-note @@ -91,7 +93,9 @@ #:clef #:f-position #:b-position #:bottom-line #:keysig #:staff-pos #:xoffset #:read-everything #:read-buffer-from-stream + #:staffwise-element #:key-signature #:make-key-signature + #:time-signature #:time-signature-components #:alterations #:more-sharps #:more-flats #:line-width #:lines-per-page #:min-width #:spacing-style #:right-edge #:left-offset --- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2007/09/18 21:19:03 1.39 +++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2009/04/20 15:04:47 1.40 @@ -170,6 +170,35 @@ (with-output-as-presentation (stream object 'clef) (draw-clef stream name x staff-step))) +;;;;;;;;;;;;;;;;;; time signature + +(defun draw-time-signature-component (stream component x) + (flet ((component-name (c) + (ecase c + (1 :time-signature-1) + (2 :time-signature-2) + (3 :time-signature-3) + (4 :time-signature-4) + (5 :time-signature-5) + (6 :time-signature-6) + (7 :time-signature-7) + (8 :time-signature-8)))) + (etypecase component + ((integer 1 8) + (let* ((design (sdl::ensure-design *font* (component-name component)))) + (sdl::draw-shape stream *font* design x (staff-step -2)) + (bounding-rectangle-width design))) + ((cons (integer 1 8) (integer 1 8)) + (destructuring-bind (num . den) component + (let* ((num-name (component-name num)) + (den-name (component-name den)) + (ndesign (sdl::ensure-design *font* num-name)) + (ddesign (sdl::ensure-design *font* den-name))) + (sdl::draw-shape stream *font* num-name x (staff-step -4)) + (sdl::draw-shape stream *font* den-name x (staff-step 0)) + (max (bounding-rectangle-width ndesign) + (bounding-rectangle-width ddesign)))))))) + ;;;;;;;;;;;;;;;;;; rest (defun draw-rest (stream duration x staff-step)

1 0

[gsharp-cvs] CVS gsharp
by crhodes 19 Nov '08

19 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv15490 Modified Files: cursor.lisp drawing.lisp gui.lisp packages.lisp Log Message: Export make-key-signature, key-signatures from gsharp-buffer --- /project/gsharp/cvsroot/gsharp/cursor.lisp 2008/11/19 15:45:46 1.7 +++ /project/gsharp/cvsroot/gsharp/cursor.lisp 2008/11/19 16:05:13 1.8 @@ -168,8 +168,8 @@ (defmethod add-element :after ((keysig key-signature) bar position) (let ((staff (staff keysig))) - (setf (gsharp-buffer::key-signatures staff) - (merge 'list (list keysig) (gsharp-buffer::key-signatures staff) + (setf (key-signatures staff) + (merge 'list (list keysig) (key-signatures staff) (lambda (x y) (gsharp::starts-before-p x (bar y) y)))))) (defmethod remove-element :before ((element element) (bar cbar)) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/11/19 15:45:47 1.86 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/11/19 16:05:13 1.87 @@ -33,7 +33,7 @@ (format stream "[lyrics staff ~a]" (name object))) (defun key-signature-for-staff (staff measures) - (let ((key-signatures (gsharp-buffer::key-signatures staff)) + (let ((key-signatures (key-signatures staff)) (barno (gsharp-numbering:number (car (measure-bars (car measures)))))) (or (and key-signatures (find barno key-signatures :from-end t :test #'> --- /project/gsharp/cvsroot/gsharp/gui.lisp 2008/11/19 15:45:47 1.95 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2008/11/19 16:05:13 1.96 @@ -942,9 +942,9 @@ (cursor (current-cursor)) (staff (car (staves (layer cursor)))) (keysig (if (keysig cursor) - (gsharp-buffer::make-key-signature + (make-key-signature staff :alterations (copy-seq (alterations (keysig cursor)))) - (gsharp-buffer::make-key-signature staff)))) + (make-key-signature staff)))) ;; FIXME: should only invalidate elements temporally after the ;; cursor. (gsharp-measure::invalidate-everything-using-staff (current-buffer) staff) @@ -957,8 +957,8 @@ (defmethod remove-element :before ((keysig key-signature) (bar bar)) (let ((staff (staff keysig))) - (setf (gsharp-buffer::key-signatures staff) - (remove keysig (gsharp-buffer::key-signatures staff))) + (setf (key-signatures staff) + (remove keysig (key-signatures staff))) (gsharp-measure::invalidate-everything-using-staff (current-buffer) staff))) ;;; FIXME: this isn't quite right (argh) for the case of two @@ -1005,14 +1005,14 @@ ;; in. (assert (eq cursor (current-cursor))) (let* ((staff (car (staves (layer cursor)))) - (key-signatures (gsharp-buffer::key-signatures staff)) + (key-signatures (key-signatures staff)) (bar (bar cursor)) (element-or-nil (cursor-element cursor))) (%keysig staff key-signatures bar element-or-nil))) (defmethod keysig ((note note)) (let* ((staff (staff note)) - (key-signatures (gsharp-buffer::key-signatures staff)) + (key-signatures (key-signatures staff)) (bar (bar (cluster note))) (element-or-nil (cluster note))) (%keysig staff key-signatures bar element-or-nil))) @@ -1024,7 +1024,7 @@ (defmethod keysig ((element element)) (let* ((staff (staff element)) - (key-signatures (gsharp-buffer::key-signatures staff)) + (key-signatures (key-signatures staff)) (bar (bar element))) (%keysig staff key-signatures bar element))) --- /project/gsharp/cvsroot/gsharp/packages.lisp 2008/02/09 16:58:35 1.66 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2008/11/19 16:05:13 1.67 @@ -55,6 +55,7 @@ (:shadow #:rest) (:export #:clef #:name #:lineno #:make-clef #:staff #:fiveline-staff #:make-fiveline-staff + #:key-signatures #:lyrics-staff #:make-lyrics-staff #:gsharp-condition #:pitch #:accidentals #:dots #:note #:make-note @@ -90,7 +91,8 @@ #:clef #:f-position #:b-position #:bottom-line #:keysig #:staff-pos #:xoffset #:read-everything #:read-buffer-from-stream - #:key-signature #:alterations #:more-sharps #:more-flats + #:key-signature #:make-key-signature + #:alterations #:more-sharps #:more-flats #:line-width #:lines-per-page #:min-width #:spacing-style #:right-edge #:left-offset #:left-margin #:text #:append-char #:erase-char

1 0

[gsharp-cvs] CVS gsharp
by crhodes 19 Nov '08

19 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv10002 Modified Files: cursor.lisp drawing.lisp gui.lisp Log Message: Remove gsharp-buffer:: prefix from key-signature (since it's exported). --- /project/gsharp/cvsroot/gsharp/cursor.lisp 2007/07/27 22:28:05 1.6 +++ /project/gsharp/cvsroot/gsharp/cursor.lisp 2008/11/19 15:45:46 1.7 @@ -166,8 +166,7 @@ (when (> (pos cursor) position) (incf (pos cursor))))) -(defmethod add-element :after - ((keysig gsharp-buffer::key-signature) bar position) +(defmethod add-element :after ((keysig key-signature) bar position) (let ((staff (staff keysig))) (setf (gsharp-buffer::key-signatures staff) (merge 'list (list keysig) (gsharp-buffer::key-signatures staff) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/02/09 16:58:35 1.85 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/11/19 15:45:47 1.86 @@ -162,7 +162,7 @@ (score-pane:staff-step 5) (score-pane:staff-step 2))) -(defmethod right-bulge ((keysig gsharp-buffer::key-signature) pane) +(defmethod right-bulge ((keysig key-signature) pane) ;; FIXME: shares much code with DRAW-ELEMENT (KEY-SIGNATURE). (let ((old-keysig (keysig keysig))) (let ((bulge 0)) @@ -697,7 +697,7 @@ (defun draw-beam-group (pane elements) (let ((e (car elements))) - (when (typep e 'gsharp-buffer::key-signature) + (when (typep e 'key-signature) (assert (null (cdr elements))) (return-from draw-beam-group (draw-element pane e (final-absolute-element-xoffset e))))) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2008/02/09 16:58:35 1.94 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2008/11/19 15:45:47 1.95 @@ -955,7 +955,7 @@ (define-gsharp-command com-insert-keysig () (insert-keysig)) -(defmethod remove-element :before ((keysig gsharp-buffer::key-signature) (bar bar)) +(defmethod remove-element :before ((keysig key-signature) (bar bar)) (let ((staff (staff keysig))) (setf (gsharp-buffer::key-signatures staff) (remove keysig (gsharp-buffer::key-signatures staff)))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 17 Nov '08

17 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv7837 Modified Files: sdl.lisp Log Message: Time signature digit 8. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 07:44:00 1.43 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 10:45:22 1.44 @@ -2164,4 +2164,83 @@ pn right (tensions 1 3) po (tensions 3 1) pp down ++ pq down ++ pr left ++ cycle))))) - \ No newline at end of file +;;; +;;; +;;; +;;; w2 +;;; __________ +;;; | | +;;; e _ +;;; ****** | +;;; ************ | +;;; **** i **** | +;;; **** **** | +;;; ***** **** | +;;; ******l j****f | +;;; d****** **** | +;;; ******* **** | +;;; ********** k **** | +;;; ******************* | +;;; ******************g | h1 +;;; c****************** | +;;; ******************** | +;;; ***** o ******** | +;;; ***** ***** | +;;; **** p*****h - | +;;; - b****n ***** | | +;;; | **** ***** | | +;;; | **** ***** | h3 | +;;; h2 | **** m ****** | | +;;; | **************** | | +;;; |_ ********* _| _| +;;; a +;;; +;;; |___________| +;;; w1 +;;; |________| +;;; w3 +;;; +;;; |_____| +;;; w4 + +(defmethod compute-design ((font font) (shape (eql :time-signature-8))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + yoffset) + font + (flet ((c (x y) (complex x y))) + (let* (;; This symbol should have its lowest point + ;; at the bottom of the staff line + (ya (+ (- (/ slt 2)) yoffset)) + ;; it should have its top at the lower edge of the staff line + (h1 (* 2 sld)) + (h2 (* 0.23 h1)) + (h3 (* 0.27 h1)) + (w1 (round (* 0.38 h1))) + (w2 (round (* 0.35 h1))) + (w3 (round (* 0.26 h1))) + (w4 (* 0.07 h1)) + (pa (c 0 ya)) + (pb (c (- w1) (+ ya h2))) + (pc (c (- w3) (+ ya (* 0.48 h1)))) + (pd (c (- w2) (+ ya (- h1 h3)))) + (pe (c 0 (+ ya h1))) + (pf (c w2 (+ ya (- h1 h2)))) + (pg (c w3 (+ ya (* 0.52 h1)))) + (ph (c w1 (+ ya h3))) + (pm (+ pa (c 0 (round (* 0.28 sld))))) + (pn (+ pb (round (* 0.33 sld)))) + (po (c (- w4) (+ ya (* 0.43 h1)))) + (pp (- ph (round (* 0.40 sld)))) + (ppi (- pe (c 0 (round (* 0.28 sld))))) + (pj (- pf (round (* 0.33 sld)))) + (pk (c w4 (+ ya (* 0.57 h1)))) + (pl (+ pd (round (* 0.40 sld))))) + (clim:region-difference + (mf pa left ++ pb up (tensions 1 5) pc up (tensions 5 1) pd up ++ + right pe -- ppi left ++ pl down (tensions 1 20) pk right + (tensions 3 1) pj up ++ left ppi -- pe right ++ pf down + (tensions 1 5) pg down (tensions 5 1) ph down ++ cycle) + (mf pm left ++ pn up (tensions 1 3) po right (tensions 20 1) + pp down ++ cycle)))))) + \ No newline at end of file

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 17 Nov '08

17 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv14574 Modified Files: sdl.lisp Log Message: Time signature digit 7. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 06:40:26 1.42 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 07:44:00 1.43 @@ -2080,4 +2080,88 @@ (mf pa left ++ pb up ++ pc right ++ pd down ++ pe left ++ pf up (tensions 1 20) pg (tensions 20 1) ph down ++ ppi (tensions 5 1) pj right ++ pk down ++ cycle) - (mf pl left ++ pm up ++ pn right ++ po down ++ cycle)))))) \ No newline at end of file + (mf pl left ++ pm up ++ pn right ++ po down ++ cycle)))))) + +;;; +;;; +;;; w1 +;;; __________ +;;; | | +;;; +;;; +;;; k m o _ +;;; * l ************ * | +;;; j******************* * | +;;; ********************n ** | +;;; *********************** | +;;; *** g ************e*** | +;;; ** ********* ** | +;;; i* f d** | +;;; h *** | +;;; **** | +;;; **** | +;;; ***** | +;;; ***** | h1 +;;; ****** | +;;; ****** | +;;; ******* | +;;; ******* | +;;; ******* | +;;; ******* | +;;; ******* | +;;; ********p | +;;; ******** | +;;; ********* | +;;; c ****a****q | +;;; *** *** _| +;;; b r +;;; +;;; +;;; +;;; +;;; +;;; +;;; +;;; + +(defmethod compute-design ((font font) (shape (eql :time-signature-7))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + yoffset) + font + (flet ((c (x y) (complex x y))) + (let* (;; This symbol should sit on top of a staff line + (yb (+ (/ slt 2) yoffset)) + ;; if the little notch is to be visible, the top + ;; of this character should hang below the upper staff line. + (h1 (- (* 2 sld) slt)) + (yl (+ yb (- h1 slt))) + (w1 (round (* 0.37 h1))) + (yn (+ yb (- h1 (* 2 slt)))) + (yf (+ yb (round (* 0.65 h1)))) + (ya (+ yb slt)) + (pc (c (round (* -0.20 h1)) (+ yb (* 0.03 h1)))) + (pb (c (+ (realpart pc) (* 0.03 h1)) yb)) + (pd (c (round (* 0.18 h1)) yf)) + (pe (c (realpart pd) (+ (imagpart pd) (* 0.03 h1)))) + (pf (c (* 0.06 h1) yf)) + (pg (c (* -0.21 h1) (+ yf (round (* 0.8 slt))))) + (ph (c (- (* 0.03 h1) w1) (+ yb (* 0.55 h1)))) + (ppi (c (- w1) (+ (imagpart ph) (* 0.03 h1)))) + (pj (c (- w1) (+ yb (- h1 (* 0.03 h1))))) + (pk (c (+ (realpart pj) (* 0.03 h1)) (+ yb h1))) + (pl (c (- (* 0.11 h1) w1) yl)) + (pm (c (* -0.05 h1) (+ yb h1))) + (pn (c (* 0.23 h1) yn)) + (po (c (round (* 0.9 w1)) (+ yb h1))) + (pp (c (round (* 0.15 h1)) (+ yb (* 0.13 h1)))) + (pq (c (realpart pp) (+ yb (* 0.03 h1)))) + (pr (c (- (realpart pp) (* 0.03 h1)) yb)) + (pa (c (* 0.00 h1) ya))) + (mf pa left ++ pb left ++ pc up (tensions 1 5) pd up ++ pe left ++ + pf left ++ pg left ++ ph left ++ ppi up ++ + pj up ++ pk right ++ pl right ++ pm right ++ + pn right (tensions 1 3) po (tensions 3 1) + pp down ++ pq down ++ pr left ++ cycle))))) + + \ No newline at end of file

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 17 Nov '08

17 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv29936 Modified Files: sdl.lisp Log Message: Time signature digit 6. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 05:49:28 1.41 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 06:40:26 1.42 @@ -1999,3 +1999,85 @@ pf right ++ pg up ++ ph left ++ ppi left ++ pj up ++ pk up ++ pl right ++ pm right ++ pn right ++ po down ++ pp left ++ pq left ++ pr down ++ ps right ++ pt right ++ pu down ++ cycle))))) + +;;; +;;; w2 +;;; __________ +;;; | | +;;; c _ +;;; **** | +;;; ******g***** | +;;; ***** ******** | +;;; ****** **********d | +;;; ****** f********** | +;;; *******h ******** | +;;; ******** **e* | +;;; ********** j | +;;; ************i********** | +;;; ************************* | +;;; ************* n ********** | h1 +;;; b*********** ********** | +;;; ********** ********** | +;;; ********** **********k | +;;; **********m o********** | +;;; ********** ********** | +;;; ********* ********* | +;;; ********* l ******** | +;;; ******************** | +;;; **************** | +;;; ********* _| +;;; a +;;; +;;; +;;; |____________| +;;; w1 +;;; +;;; + +(defmethod compute-design ((font font) (shape (eql :time-signature-6))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + yoffset) + font + (flet ((c (x y) (complex x y))) + (let* (;; This symbol should have its lowest point + ;; at the bottom of the staff line + (ya (+ (- (/ slt 2)) yoffset)) + ;; it should have its top at the lower edge of the staff line + (h1 (* 2 sld)) + (w1 (round (* 0.4 h1))) + (w2 (round (* 0.35 h1))) + (xc (* 0.1 w2)) + (xf (round (* 0.05 h1))) + (yf (+ ya (* 0.8 h1))) + (xe (* 0.5 (+ w2 xf))) + (ye (+ ya (* 0.68 h1))) + (xg (+ xf (* 0.02 h1))) + (yg (+ ya (- h1 slt))) + (xh (* -0.12 h1)) + (yh (+ ya (* 0.7 h1))) + (xj (* 0.12 h1)) + (yj (- ye slt)) + (xi (* -0.09 h1)) + (yi (- yj (* 0.5 slt))) + (yn (- yj (* 2 slt))) + (pa (c 0 0)) + (pb (c (- w1) (+ ya (* 0.45 h1)))) + (pc (c xc (+ ya h1))) + (pd (c w2 yf)) + (pe (c xe ye)) + (pf (c xf yf)) + (pg (c xg yg)) + (ph (c xh yh)) + (ppi (c xi yi)) + (pj (c xj yj)) + (pk (c w1 (+ ya (* 0.35 h1)))) + (pl (+ pa (c 0 slt))) + (pm (c (* -0.13 h1) (+ ya (* 0.32 h1)))) + (pn (c 0 yn)) + (po (c (* 0.13 h1) (+ ya (* 0.32 h1))))) + (clim:region-difference + (mf pa left ++ pb up ++ pc right ++ pd down ++ pe left ++ + pf up (tensions 1 20) pg (tensions 20 1) ph down ++ ppi + (tensions 5 1) pj right ++ pk down ++ cycle) + (mf pl left ++ pm up ++ pn right ++ po down ++ cycle)))))) \ No newline at end of file

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 17 Nov '08

17 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv15942 Modified Files: sdl.lisp Log Message: Time signature digit 5. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/16 06:36:03 1.40 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 05:49:28 1.41 @@ -1797,7 +1797,7 @@ yoffset) font (flet ((c (x y) (complex x y))) - (let* (;; This symbol should sit have its lowest point + (let* (;; This symbol should have its lowest point ;; at the bottom of the staff line (ya (+ (- (/ slt 2)) yoffset)) ;; it should have its top at the lower edge of the staff line @@ -1909,4 +1909,93 @@ pg left ++ ph ++ ppi (tensions 1 3) pj ++ right pk -- pl right ++ pm ++ pn (tensions 1 5) po down ++ pp right ++ pr up ++ up ps -- pt (direction (- pt ps)) ++ down pv -- pw down ++ px down ++ - py down ++ pz down ++ left paa -- cycle))))) \ No newline at end of file + py down ++ pz down ++ left paa -- cycle))))) + +;;; +;;; w2 +;;; _______ +;;; | | +;;; +;;; l n _ +;;; ******* m *****o | +;;; k******************** | +;;; ******************* | +;;; ****************** | +;;; *****q********** | +;;; **** **p** | +;;; ****r | +;;; **** s **t** - | +;;; *************** | | +;;; ****************** | | h1 +;;; j**** h ********** | | +;;; i ********* | | +;;; c ********* | | +;;; - ***** g*********u | | +;;; | ********* ********* | h2 | +;;; | *********** ********* | | +;;; - | b************d ********* | | +;;; | h4| ********** ********* | | +;;; h3| | ******e f ********* | | +;;; | | ************** | | +;;; |_ |_ ******** _| _| +;;; a +;;; +;;; |___________| +;;; w1 +;;; +;;; + +(defmethod compute-design ((font font) (shape (eql :time-signature-5))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + yoffset) + font + (flet ((c (x y) (complex x y))) + (let* (;; This symbol should have its lowest point + ;; at the bottom of the staff line + (ya (+ (- (/ slt 2)) yoffset)) + ;; it should have its top at the lower edge of the staff line + (h1 (* 2 sld)) + (h2 (round (* 0.62 h1))) + (h3 (* 0.30 h1)) + (h4 (round (* 0.44 h1))) + (yi (+ ya h4 (max 1 (round (* 0.04 h1))))) + (yp (+ ya h2 (max 1 (round (* 0.08 h1))))) + (ym (+ ya (round (* 0.95 h1)))) + (yn (+ ya (round (* 0.975 h1)))) + (yg (+ ya (* 0.35 h1))) + (yh (+ ya (- h2 (max 1 (round (* 0.07 h1)))))) + (w1 (round (* 0.4 h1))) + (w2 (round (* 0.3 h1))) + (xd 0) + (xc (* 0.5 (- xd w1))) + (xe (- xd (* 0.09 h1))) + (xg (round (* 0.10 h1))) + (xr (- (round (* 0.13 h1)) w2)) + (ys (- h2 (* 0.03 h1))) + (yq (+ yp (* 0.03 h1))) + (pa (c 0 ya)) + (pb (c (- w1) (+ ya h3))) + (pc (c xc (+ ya h4))) + (pd (c xd (+ ya h3))) + (pe (c xe (+ ya (* 0.13 h1)))) + (pf (c (* -0.2 w1) (+ ya slt))) + (pg (c xg (+ ya yg))) + (ph (c (* -0.05 h1) yh)) + (ppi (c (- (* 0.05 h1) w2) yi)) + (pj (c (- w2) (+ yi (* 0.05 h1)))) + (pk (c (- w2) (+ ya (- h1 (* 0.10 h1))))) + (pl (c (- (* 0.07 h1) w2) (+ ya h1))) + (pm (c (* 0.18 h1) ym)) + (pn (c (- w2 (* 0.03 h1)) yn)) + (po (c (round (* 1.1 w2)) (+ ya (- h1 (* 0.03 h1))))) + (pp (c (* 0.05 h1) yp)) + (pq (c (+ xr (* 0.03 h1)) yq)) + (pr (c xr (+ (* 0.7 ys) (* 0.3 yq)))) + (ps (c (+ xr (* 0.03 h1)) ys)) + (pt (c (* 0.1 h1) (+ ya h2))) + (pu (c w1 (+ ya yg)))) + (mf pa left ++ pb up ++ pc right ++ pd down ++ pe (tensions 20 1) + pf right ++ pg up ++ ph left ++ ppi left ++ pj up ++ pk up ++ + pl right ++ pm right ++ pn right ++ po down ++ pp left ++ + pq left ++ pr down ++ ps right ++ pt right ++ pu down ++ cycle)))))

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

gsharp-cvs