1;; NWC to Denemo
2;; A Lexer / Parser to import NWC files into Denemo
3;; By Nils Gey, July / August 2010
4;; Usage of SILex and LALR-scm
5;;;;;;;;;;;;;;;;;;;;;;;;
6
7;(hashq-set! nwc:Nwc2LyTable '0 "b'")
8
9
10;;TOC
11;; Libs
12;; init input port
13;; load and init lexer
14;; lalr-parser definition
15;; execute the parser
16;; cleaning up (input port...)
17;;;;;
18
19;; Libs
20(load "/home/nils/git-denemo/actions/mxml2ly2denemo/lalr.scm")
21(load "/home/nils/git-denemo/actions/mxml2ly2denemo/silex.scm")
22
23;; Input Port
24(set-current-input-port (open-input-file "/home/nils/sampleonestaff.nwctxt"))
25
26;; Import Functions
27(define nwc:cur_pos_offset 0)
28
29(define (nwc:ChangeClef clef) ; clef is a string
30
31    (define (PutDenemoClef clef)
32        (if (d-MoveCursorLeft)
33        (begin
34            (d-MoveCursorRight)
35            (d-InsertClef clef))
36        (d-InitialClef clef)))
37
38    (cond
39        ((string-ci=? clef "Treble") (begin (set! nwc:cur_pos_offset 0) (PutDenemoClef "Treble")))
40        ((string-ci=? clef "TrebleDown") (begin (set! nwc:cur_pos_offset -7) (PutDenemoClef "Treble")))
41        ((string-ci=? clef "TrebleUp") (begin (set! nwc:cur_pos_offset 7) (PutDenemoClef "Treble Octava bassa")))
42
43        ((string-ci=? clef "Bass") (begin (set! nwc:cur_pos_offset -12) (PutDenemoClef "Bass")))
44        ((string-ci=? clef "BassDown") (begin (set! nwc:cur_pos_offset -19) (PutDenemoClef "Bass")))
45        ((string-ci=? clef "BassUp") (begin (set! nwc:cur_pos_offset -5) (PutDenemoClef "Bass Octava bassa")))
46
47        ((string-ci=? clef "Percussion") (begin (set! nwc:cur_pos_offset -12) (PutDenemoClef "Bass")))
48        ((string-ci=? clef "PercussionDown") (begin (set! nwc:cur_pos_offset -19) (PutDenemoClef "Bass Octava bassa")))
49        ((string-ci=? clef "PercussionUp") (begin (set! nwc:cur_pos_offset -5) (PutDenemoClef "Bass")))
50
51        ((string-ci=? clef "Tenor") (begin (set! nwc:cur_pos_offset -8) (PutDenemoClef "Tenor")))
52        ((string-ci=? clef "TenorDown") (begin (set! nwc:cur_pos_offset -15) (PutDenemoClef "Tenor")))
53        ((string-ci=? clef "TenorUp") (begin (set! nwc:cur_pos_offset -1) (PutDenemoClef "Tenor")))
54
55        ((string-ci=? clef "Alto") (begin (set! nwc:cur_pos_offset -6) (PutDenemoClef "Alto")))
56        ((string-ci=? clef "AltoDown") (begin (set! nwc:cur_pos_offset -13) (PutDenemoClef "Alto")))
57        ((string-ci=? clef "AltoUp") (begin (set! nwc:cur_pos_offset 1) (PutDenemoClef "Alto")))
58
59        (else (display "NWC Import Error: Clef unknown"))
60    )
61)
62
63(define (nwc:PutNote listy) ;position is a string
64    (define duration (list-ref listy 0))
65    (define dots (list-ref listy 1))
66    (define position (list-ref listy 2))
67    (cond
68        ((string=? duration "Whole") (d-Insert0))
69        ((string=? duration "Half") (d-Insert1))
70        ((string=? duration "4th") (d-Insert2))
71        ((string=? duration "8th") (d-Insert3))
72        ((string=? duration "16th") (d-Insert4))
73        ((string=? duration "32nd") (d-Insert5))
74        ((string=? duration "64nd") (d-Insert6))
75        ((string=? duration "128nd") (d-Insert7))
76        ((string=? duration "256nd") (d-Insert8))
77        (else (display "NWC Import Error: Duration unknown"))
78    )
79
80    (if (> dots 0) (d-AddDot))
81    (if (= dots 2) (d-AddDot))
82
83
84    ;(+ nwc:cur_pos_offset (string->number position))
85)
86
87
88;; Lexer
89(define (mtoken symbol value)
90    (make-lexical-token symbol (make-source-location (current-input-port) (lexer-get-line) (lexer-get-column) (lexer-get-offset) -1) value)
91)
92
93(lex "/home/nils/git-denemo/actions/mxml2ly2denemo/nwctext.l" "/home/nils/git-denemo/actions/mxml2ly2denemo/nwctext.l.scm" 'counters 'all) ; Oh no!! The generated scm file has comments in the language of the devil!
94(load "/home/nils/git-denemo/actions/mxml2ly2denemo/nwctext.l.scm")
95(lexer-init 'port (current-input-port))
96
97
98
99
100;; Parser Definition
101
102;Helper to print out a value with a custom description, for console output
103
104(define (display-combo string value)
105    (display string)
106    (display ": ")
107    (display value)
108    (newline)
109)
110
111(define nwctext-parser
112
113  (lalr-parser
114   ;; --- token definitions
115   (ALT DBLQUOTE INTEGER STRING LETTER NEXTISNOTE DURATION POSITION WHITESPACE TITLE NUMBER DURATIONVALUE ERROR DOUBLEDOTTED DOTTED BAR-DOUBLE CLEFVALUE CLEF CLEF8UP CLEF8DOWN STAFF STAFFNAME STAFFLABEL)
116
117    (commands (commands command) : #t
118              (command)          : #t)
119    (command
120            (INTEGER)       : (display-combo "Int" $1)
121            (LETTER)        : (display-combo "letter" $1)
122            (note)          : (nwc:PutNote $1)
123            (TITLE)         : (display-combo "title" $1)
124            (ERROR)         : (display-combo "errorr" $1)
125            (BAR-DOUBLE)    : (display-combo "dblbar" $1)
126            (clef)          : (nwc:ChangeClef $1)
127            (staff)         : (display-combo "staff" $1)
128            (WHITESPACE)    : #f
129    )
130
131    (note
132        (NEXTISNOTE duration position)  : (list $2 0 $3)
133        (NEXTISNOTE duration dots position) : (list $2 $3 $4)
134    )
135
136        (position
137            (POSITION NUMBER)   : $2
138            (POSITION ALT NUMBER) : (string-append $2 $3)
139        )
140
141
142        (duration
143            (DURATION DURATIONVALUE) : $2
144        )
145
146        (dots
147            (DOTTED) : 1
148            (DOUBLEDOTTED) : 2
149        )
150
151    (clef
152        (CLEF CLEFVALUE)            : $2
153        (CLEF CLEFVALUE CLEF8UP)    : (string-append $2 "Up")
154        (CLEF CLEFVALUE CLEF8DOWN)  : (string-append $2 "Down")
155    )
156
157    (staff
158        (STAFF STAFFNAME STRING ) : $3
159        (STAFF STAFFNAME STRING STAFFLABEL STRING)  : (string-append $3 " " $5)
160    )
161
162  )
163)
164
165; Just to get this out of my way... I don't wanted to make errors anyway! (real function later)
166(define (displayerror arg1 arg2)
167        (display arg1)
168        (display arg2)(newline)
169)
170
171(system "clear")
172(d-New)
173(nwctext-parser lexer displayerror)
174
175
176;; Close input port
177(close (current-input-port))
178