~ubuntu-branches/ubuntu/oneiric/denemo/oneiric

« back to all changes in this revision

Viewing changes to actions/menus/MainMenu/Educational/Aural Training/init.scm

  • Committer: Bazaar Package Importer
  • Author(s): Alessio Treglia
  • Date: 2010-10-27 08:00:18 UTC
  • mfrom: (1.3.3 upstream)
  • mto: This revision was merged to the branch mainline in revision 15.
  • Revision ID: james.westby@ubuntu.com-20101027080018-tuekd0869v8ptnqv
Tags: upstream-0.8.16
ImportĀ upstreamĀ versionĀ 0.8.16

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
 
2
 
(define ChordComparison::Major (cons "Major" "c e g"))
3
 
(define ChordComparison::Minor (cons "Minor" "c ees g"))
4
 
(define ChordComparison::Augmented (cons "Augmented" "c e gis"))
5
 
(define ChordComparison::Diminished (cons "Diminished" "c ees ges"))
6
 
(define ChordComparison::Major7 (cons "Major7" "c e g b"))
7
 
(define ChordComparison::Dominant7 (cons "Dominant7" "c e g bes"))
8
 
(define ChordComparison::Minor7 (cons "Minor7" "c ees g bes"))
9
 
(define ChordComparison::HalfDiminished7 (cons "HalfDiminished7" "c ees ges bes"))
10
 
(define ChordComparison::Diminished7 (cons "Diminished7" "c ees ges beses"))
11
 
 
12
 
 
13
 
(define ChordComparison::ChordPossibilities (list ChordComparison::Major ChordComparison::Minor))
14
 
 
15
 
(define ChordComparison::HighestNote 80)
16
 
(define ChordComparison::LowestNote 55)
17
 
(define ChordComparison::ChordChordComparison::LowestNote 60)
18
 
(define ChordComparison::ChordQuality 0)
19
 
(define ChordComparison::score 0)
20
 
 
21
 
 
22
 
 
23
 
(let ((time (gettimeofday)))
24
 
  (set! *random-state*
25
 
    (seed->random-state (+ (car time)
26
 
      (cdr time)))))
27
 
 
28
 
(define (ChordComparison::lilyname->midikey lilyname)
29
 
  (let (
30
 
                (naturual_notenum '(0 2 4 5 7 9 11))
31
 
                (accidental 0) 
32
 
                (octave 48) 
33
 
                (notename 0) 
34
 
                (notenum 0) 
35
 
                (loop 0))
36
 
      (set! notename
37
 
        (lambda (char)
38
 
          (modulo (- (char->integer char) 99) 7)))
39
 
      (set! loop 
40
 
        (lambda (x)
41
 
          (if (< x (string-length lilyname))
42
 
            (begin
43
 
              (if (= x 0) (set! notename (notename (string-ref lilyname x))))
44
 
              (if (> x 0) 
45
 
                (begin
46
 
                  (if (equal? #\i (string-ref lilyname x))
47
 
                    (set! accidental (+ accidental 1)))
48
 
                  (if (equal? #\e (string-ref lilyname x))
49
 
                    (set! accidental (- accidental 1)))
50
 
                  (if (equal? #\' (string-ref lilyname x))
51
 
                    (set! octave (+ octave 12)))
52
 
                  (if (equal? #\, (string-ref lilyname x))
53
 
                    (set! octave (- octave 12)))))
54
 
                (loop (+ 1 x)))
55
 
                          );end of if
56
 
                      )
57
 
                    );end of loop
58
 
              (loop 0)
59
 
    (set! notenum (list-ref naturual_notenum notename))
60
 
    (+ (+ octave notenum) accidental)      
61
 
            );end of let
62
 
          )
63
 
 
64
 
 
65
 
(define (ChordComparison::midinum->lilyname num)
66
 
  (let (        (octave 0) 
67
 
                (notename "")
68
 
                (OctaveString "")
69
 
                (sharplist '("c" "cis" "d" "dis" "e" "f" "fis" "g" "gis" "a" "ais" "b"))
70
 
                                )
71
 
  (set! octave (- (quotient num 12) 4))
72
 
  (set! notename (list-ref sharplist (remainder num 12)))
73
 
  (if (> octave 0)
74
 
    (set! OctaveString (string-pad "" (abs octave) #\'))
75
 
    (set! OctaveString (string-pad "" (abs octave) #\,)))
76
 
  (string-append notename OctaveString)
77
 
))
78
 
 
79
 
(define (ChordComparison::showscore)
80
 
 (d-DirectivePut-score-display "ChordComparison::GameScore" (string-append "<b>Score: </b>" (number->string ChordComparison::score))))
81
 
 
82
 
(define (ChordComparison::GetRandom)
83
 
  (set! ChordComparison::ChordChordComparison::LowestNote (random ChordComparison::HighestNote))
84
 
  (if (> ChordComparison::LowestNote ChordComparison::ChordChordComparison::LowestNote)
85
 
    (ChordComparison::GetRandom) ))
86
 
 
87
 
(define (ChordComparison::GetChordQuality)
88
 
  (car (list-ref ChordComparison::ChordPossibilities ChordComparison::ChordQuality)))
89
 
  
90
 
(define (ChordComparison::GetChordSpelling)
91
 
  (cdr (list-ref ChordComparison::ChordPossibilities ChordComparison::ChordQuality)))
92
 
 
93
 
(define (ChordComparison::GetNewChord)
94
 
  (ChordComparison::GetRandom)  
95
 
  (set! ChordComparison::ChordQuality (random (length ChordComparison::ChordPossibilities))))
96
 
 
97
 
(define (ChordComparison::GetIntervalList)
98
 
 (let (
99
 
        (SetOctave 0)
100
 
        (IntervalList 0)
101
 
        (ChordNoteList '())
102
 
        )
103
 
(set! SetOctave 
104
 
  (lambda (lilystring)
105
 
    (- (ChordComparison::lilyname->midikey lilystring) 48)))
106
 
  (set! ChordNoteList (string-split (ChordComparison::GetChordSpelling) #\space))
107
 
  (set! IntervalList (map SetOctave ChordNoteList))
108
 
  IntervalList
109
 
  ))
110
 
 
111
 
(define (ChordComparison::PlayChord note)
112
 
  (PlayNote (number->string (+ ChordComparison::ChordChordComparison::LowestNote note)) 1000))
113
 
 
114
 
(define (ChordComparison::Play)  
115
 
  (map ChordComparison::PlayChord (ChordComparison::GetIntervalList)))
116
 
 
117
 
(define (ChordComparison::OfferChord)
118
 
  (ChordComparison::showscore)
119
 
  (ChordComparison::GetNewChord)
120
 
  (usleep 10000)
121
 
  (ChordComparison::Play))
122
 
 
123
 
(if (not (defined? 'Transpose::init))
124
 
  (begin
125
 
    (d-LoadCommand "/MainMenu/EditMenu/Transpose/SetTransposeIntervalFromNote")
126
 
    (d-InitializeScript "SetTransposeIntervalFromNote")))
127
 
 
128
 
(define (ChordComparison::TransposeChord lilyname)
129
 
  (set! Transpose::Note lilyname)
130
 
  (Transpose::SetTransposeInterval Transpose::Note)
131
 
  (Transpose::TransposeNote))
132
 
 
133
 
(define (ChordComparison::PlaceNotes)
134
 
  (d-CursorToNote "c")
135
 
  (d-Insert2)
136
 
  (d-ChangeChordNotes (ChordComparison::GetChordSpelling))
137
 
  (ChordComparison::TransposeChord (ChordComparison::midinum->lilyname ChordComparison::ChordChordComparison::LowestNote)))
138
 
 
139
 
;TODO perhaps inherit this from EducationGames
140
 
(define (ChordComparison::PlaceAnswerStatus gfx)
141
 
  (begin
142
 
    (d-DirectivePut-note-minpixels "ChordComparison::tick" 30)
143
 
    (d-DirectivePut-note-gx "ChordComparison::tick" -15)
144
 
    (d-DirectivePut-note-gy "ChordComparison::tick" 40)
145
 
    (d-DirectivePut-note-graphic "ChordComparison::tick" gfx)))
146
 
 
147
 
;;;;;;;;; callback when user chooses a chord
148
 
(define (ChordComparison::chordchosen chord)
149
 
  (ChordComparison::PlaceNotes) 
150
 
  (let gotoEnd () (if  (d-NextObject) (gotoEnd)))
151
 
  (if  (string=? (ChordComparison::GetChordQuality) chord)
152
 
    (begin
153
 
      (set! ChordComparison::score (+ ChordComparison::score 1))
154
 
      (ChordComparison::PlaceAnswerStatus "CheckMark")
155
 
      )
156
 
    (begin
157
 
      (set! ChordComparison::score (- ChordComparison::score 1))
158
 
      (ChordComparison::PlaceAnswerStatus "CrossSign")
159
 
  ))
160
 
  (ChordComparison::OfferChord))
161
 
 
162
 
(define (ChordComparison::createbuttons chord)
163
 
  (CreateButton (string-append "ChordComparison::" (car chord))  (string-append " <span font_desc=\"32\" foreground=\"blue\">" (car chord)  "</span>"))
164
 
    (d-SetDirectiveTagActionScript  (string-append "ChordComparison::" (car chord)) (string-append "(ChordComparison::chordchosen \"" (car chord) "\")")))
165
 
 
166
 
;;;;main procedure to call for ChordComparison
167
 
(define (ChordComparison::ChordComparison chordlist) 
168
 
 
169
 
  (set! ChordComparison::ChordPossibilities chordlist)
170
 
  (CreateButton "ChordComparison::GameScore" "<span font_desc=\"32\">Click to start</span>")
171
 
  (d-SetDirectiveTagActionScript "ChordComparison::GameScore" "(ChordComparison::OfferChord)")
172
 
 
173
 
  (map ChordComparison::createbuttons ChordComparison::ChordPossibilities)
174
 
 
175
 
  (CreateButton "ChordComparison::replay" "<span font_desc=\"32\">Re-Play</span>")
176
 
  (d-SetDirectiveTagActionScript "ChordComparison::replay" "(ChordComparison::Play)" )
177
 
)
178
 
 
179