;; this code is more or less from Ken's thesis
(declare (special segment-lattice *graphics-port* *echo-port* 
                  *latice-env* *phoneme-lattice-env*))

(defsysr (parse-segment-lattice segment-lattice)
    (with-lower-case
    (with-lattice-env
; print syllable level labels; gc is gc-ed syllables
    (adjmat-print-matrices
    *graphics-port* *echo-port* 
    segment-latice "segments"
    (lattice onset) "onsets"
    (lattice peak) "peak"
    (lattice coda) "coda"
    (lattice inflectional-affix) "inflectional-affix"
    (lattice syllable) "syllable"
    (lattice gc) "gc"
; --------------------------------------------------
; print metrical level labels
    (adjmat-print-matrices
    *graphics-port* *echo-port* 
    segment-latice "segments"
    (lattice foot) "foot"
; --------------------------------------------------
; lexicon
(load-dictionary-files)
(adjmat-print-matrices
    *graphics-port* *echo-port* 
    segment-latice "segments"
    (lattice canonical-onset) "canonical-onset"
    (lattice canonical-rhyme) "canonical-rhyme"
    (lattice canonical-syllable) "canonical-syllable"
    (lattice sylparts-in-dictionary) "sylparts-in-dictionary"
    (lattice words-in-dictionary) "words-in-dictionary"
    (lattice gc-words-in-dictionary) "gc-words-in-dictionary"
    ))))
; --------------------------------------------------
; vowels
(def-lattice vowel (phoneme-lattices "cEIiou"))
; --------------------------------------------------
; stops
(def-lattice voiceless-stop (phoneme-lattices "ptk"))
(def-lattice stop (phoneme-lattices "ptkbdg&?"))
(def-lattice unreleased-stop (m-filter (lattice stop) 'unreleased?))
; --------------------------------------------------
; fricatives
(def-lattice strong-fric (phoneme-lattices "sSzZ"))
(def-lattice weak-fric (phoneme-lattices "fvTD"))
(def-lattice fric (m+ (lattice strong-fric) (lattice weak-fric)))
; --------------------------------------------------
; syllables
(def-lattice fric-stop-cluster (m* (phoneme-lattice #/s )
                                    (lattice voiceless-stop)))
(def-lattice onset-core 
                        (m+ (lattice fric-stop-cluster)
                            (lattice fric)
                            (m- (lattice-stop) (lattice unreleased-stop))))
(def-lattice onset 
                        (m+ (lattice onset-core)
                            (m* (mopt (phoneme-lattice #/s))
                                 (phoneme-lattices "nm"))
                                 (phoneme-lattice #/h)))

(def-lattice coda 
                        (m+  (lattice stop)
                            (m* (mopt (phoneme-lattice #/s))
                                 (phoneme-lattices "nm"))
                                 (phoneme-lattice #/h)))