annotate implementations/tabcode/classes.lisp @ 330:2fbff655ba47 tip

Removed cpitch-adj and cents SQL columns
author Jeremy Gow <jeremy.gow@gmail.com>
date Mon, 21 Jan 2013 11:08:11 +0000
parents 5b2d0e5a99f1
children
rev   line source
c@43 1 (cl:in-package #:amuse-tabcode)
c@43 2
d@179 3 (defclass tabcode-object (amuse-object) ())
c@43 4
d@179 5 (defclass tabcode-composition (standard-composition tabcode-object)
d@179 6 ((bars :initarg :bars :reader tabcode-bars)
d@179 7 (rules :initarg :rules :reader tabcode-rules)
d@179 8 (metres :initarg :metres :reader metrical-signs)))
d@179 9
d@179 10 (defclass tabcode-pitched-event (standard-chromatic-pitched-event tabcode-object)
c@43 11 ((course :initarg :course :reader course)
csr21@58 12 (fret :initarg :fret :reader fret)
d@179 13 (word :initarg :word :reader word)
d@179 14 (bar :initarg :bar :reader in-bar)))
d@179 15
d@179 16 (defclass tabcode-time-signature (standard-anchored-period tabcode-object)
d@179 17 ((word :initarg :word :reader word)
d@179 18 (ul)(ll)(ur)(lr)))
d@183 19 (defgeneric ul (timesig))
d@183 20 (defgeneric ll (timesig))
d@183 21 (defgeneric ur (timesig))
d@183 22 (defgeneric lr (timesig))
d@179 23 (defmethod ul ((timesig tabcode-time-signature))
d@179 24 (unless (slot-boundp timesig 'ul)
d@179 25 (let ((ul (tabcode::ul (word timesig))))
d@179 26 (setf (slot-value timesig 'ul)
d@179 27 (when ul
d@179 28 (or (parse-integer ul :junk-allowed t)
d@179 29 ul)))))
d@179 30 (slot-value timesig 'ul))
d@179 31 (defmethod ll ((timesig tabcode-time-signature))
d@179 32 (unless (slot-boundp timesig 'll)
d@179 33 (let ((ll (tabcode::ll (word timesig))))
d@179 34 (setf (slot-value timesig 'll)
d@179 35 (when ll
d@179 36 (or (parse-integer ll :junk-allowed t)
d@179 37 ll)))))
d@179 38 (slot-value timesig 'll))
d@179 39 (defmethod ur ((timesig tabcode-time-signature))
d@179 40 (unless (slot-boundp timesig 'ur)
d@179 41 (let ((ur (tabcode::ur (word timesig))))
d@179 42 (setf (slot-value timesig 'ur)
d@179 43 (when ur
d@179 44 (or (parse-integer ur :junk-allowed t)
d@179 45 ur)))))
d@179 46 (slot-value timesig 'ur))
d@179 47 (defmethod lr ((timesig tabcode-time-signature))
d@179 48 (unless (slot-boundp timesig 'lr)
d@179 49 (let ((lr (tabcode::lr (word timesig))))
d@179 50 (setf (slot-value timesig 'lr)
d@179 51 (when lr
d@179 52 (or (parse-integer lr :junk-allowed t)
d@179 53 lr)))))
d@179 54 (slot-value timesig 'lr))
d@179 55
d@179 56 (defclass tabcode-file-identifier (identifier tabcode-object)
d@179 57 ((pathname :initarg :pathname :reader tabcode-pathname)))
d@179 58
d@179 59 (defclass tabcode-bar (standard-anchored-period tabcode-object)
d@179 60 ((start :initarg :start :accessor start-tabword)
d@179 61 (end :initarg :end :accessor end-tabword)))
d@179 62
d@179 63 (defclass tabcode-ruleset (standard-anchored-period tabcode-object)
d@179 64 ((rules :initarg :rules :accessor ruleset-rules)
d@179 65 (tuning :initarg :tuning :accessor ruleset-tuning :initform nil)))
d@179 66