;(set! t (trasmorph_all lexdir 'fabio 4))
;(set! t (car t))

(define (_2list t)
  (let (l (buff (read-from-string (string-before t "_")))(n 1) )
    (while (not (eq buff (eof-val))) 
	   (set! l (append l (list buff)))
	   (set! t (string-after t "_"))
	   (set! buff (read-from-string (string-before t "_")))
	   (set! n (+ n 1))
	   )
    l))

;;AGGIUNGERE MAPPATURA!!!
;;(OGI) (SAMPA_FESTIVAL) (CINZIA) (IRST)

(set! phone_map '(
((a) (a) (a) (a))
((aa) (a1) (A) (aa))
((e) (e) (e) (e))
((ee) (e1) (E) (ee))
((i) (i) (i) (i))
((ii) (i1) (I) (ii))
((o) (o) (o) (o))
((oo) (o1) (O) (oo))
((u) (u) (u) (u))
((uu) (u1) (U) (uu))
((E) (E) (~) (E))
((EE) (E1) (~) (EE))
((O) (O) (>) (O))
((OO) (O1) (>) (OO))
;----------------
((f) (f) (f) (f))
((v) (v) (v) (v))
((X) (s) (s) (X))
((x) (z) (z) (x))
((S) (S) (S) (S))
((f) (f f) (f) (ff))
((v) (v v) (v) (vv))
((X) (s s) (s) (XX))
;------------------
((tcl C) (tS) (C) (C))
((dcl G) (dZ) (G) (G))
((tcl Z) (ts) (T) (Z))
((dcl z) (dz) (D) (z))
((tcl C) (tS tS) (C) (CC))
((dcl G) (dZ dZ) (G) (GG))
((tcl Z) (ts ts) (T) (ZZ))
((dcl z) (dz dz) (D) (zz))
;-------------
((j) (j) (y) (j))
((w) (w) (w) (w))
;-------------------------
((@sch) () () (@sch))
((pcl p) (p) (p) (p))
((tcl t) (t) (t) (t))
((kcl k) (k) (k) (k))
((bcl b) (b) (b) (b))
((dcl d) (d) (d) (d))
((gcl g) (g) (g) (g))
((pcl p) (p p) (p) (pp))
((tcl t) (t t) (t) (tt))
((kcl k) (k k) (k) (kk))
((bcl b) (b b) (b) (bb))
((dcl d) (d d) (d) (dd))
((gcl g) (g g) (g) (gg))
;-------------------------
((m) (m) (m) (m))
((n) (n) (n) (n))
((N) (J) (N) (N))
((m) (m m) (m) (mm))
((n) (n n) (n) (nn))
;-------------
((l) (l) (l) (l))
((r) (r) (r) (r))
((L) (L) (L) (L))
((l) (l l) (l) (ll))
((r) (r r) (r) (rr))
;-------------
((.pau) (#) (*) (@))
))

;;attenzione a GZ e nf ng 
;((G) (Z) (Z))
;((nf) (nf) (nf))
;((ng) (ng) (ng))
;
; nf in realtà è riconosciuto come n in OGI ma in set*() lo clasifico come nf
; ng in realtà è riconosciuto come n in OGI ma in set*() lo clasifico come ng
; Z in realtà è riconosciuto come G in OGI ma in set*() lo clasifico come Z
;#####
;#####

(define (genera_colonne a b)
  (let (l (copy_phone_map phone_map))
    (while copy_phone_map
	   (set! l (append l (list (list 
				    (car (nth_cdr (- a 1) (car copy_phone_map)))
				    (car (nth_cdr (- b 1) (car copy_phone_map)))
				    ))))
	   (set! copy_phone_map (cdr copy_phone_map))
	   )
    l))

; (genera_colonne 4 2) è la mappa irst->sampa_festival
(set! irst2sampa_map '(
 ((a) (a))
 ((aa) (a1))
 ((e) (e))
 ((ee) (e1))
 ((i) (i))
 ((ii) (i1))
 ((o) (o))
 ((oo) (o1))
 ((u) (u))
 ((uu) (u1))
 ((E) (E))
 ((EE) (E1))
 ((O) (O))
 ((OO) (O1))
 ((f) (f))
 ((v) (v))
 ((X) (s))
 ((x) (z))
 ((S) (S))
 ((ff) (f f))
 ((vv) (v v))
 ((XX) (s s))
 ((C) (tS))
 ((G) (dZ))
 ((Z) (ts))
 ((z) (dz))
 ((CC) (tS tS))
 ((GG) (dZ dZ))
 ((ZZ) (ts ts))
 ((zz) (dz dz))
 ((j) (j))
 ((w) (w))
 ((@sch) nil)
 ((p) (p))
 ((t) (t))
 ((k) (k))
 ((b) (b))
 ((d) (d))
 ((g) (g))
 ((pp) (p p))
 ((tt) (t t))
 ((kk) (k k))
 ((bb) (b b))
 ((dd) (d d))
 ((gg) (g g))
 ((m) (m))
 ((n) (n))
 ((N) (J))
 ((mm) (m m))
 ((nn) (n n))
 ((l) (l))
 ((r) (r))
 ((L) (L))
 ((ll) (l l))
 ((rr) (r r))
 ((@) (#))
))

;(set! l (trasmorph_all lexdir 'mamma 4))
;(set! l (car l))
;(set! l (_2list l))

(define (irst2sampa l)
  "Mappatura della trascrizioneda irst a italian festival SAMPA"
  (let (out nf_ng_out)
    (while l
	   (let ((copy_irst2sampa_map irst2sampa_map))
	     (while copy_irst2sampa_map
		    (if (equal? (car (car (car copy_irst2sampa_map))) (car l))
			(set! out (append out (car (cdr (car copy_irst2sampa_map))))))
		    (set! copy_irst2sampa_map (cdr copy_irst2sampa_map))))
	     (set! l (cdr l)))
;;nf e ng:
    (let ((nf_ng_out out))
      (set! out)
      (while (cdr nf_ng_out)
	     (if (equal? (car nf_ng_out) 'n)
		 (if (or (equal? (car (cdr nf_ng_out)) 'f) (equal? (car (cdr nf_ng_out)) 'v))
		     (set! out (append out (list 'nf)))
		     (if (or (equal? (car (cdr nf_ng_out)) 'k) (equal? (car (cdr nf_ng_out)) 'g))
			 (set! out (append out (list 'ng)))
			 (set! out (append out (list (car nf_ng_out))))))
		 (set! out (append out (list (car nf_ng_out)))))
	     (set! nf_ng_out (cdr nf_ng_out)))
      (set! out (append out (list (car nf_ng_out)))))
    out))
		    

(define (irst_trascrivi word)
  "(Trascrivi_irst word) 
Ritorna la trascrizione irst di word"
  (irst2sampa(_2list (car (trasmorph_all lexdir word 4)))))


(define (irst_lookup word feats)
  "(Trascrivi_irst word) 
Ritorna la trascrizione irst di word"
  (let (tra_lab tra lab)  
    (set! tra_lab (trasmorph_all lexdir word 5))
    (if (car tra_lab)
	(let ()
	  (set! lab (car (car tra_lab)))
	  (set! tra  (irst2sampa(_2list (car (car (cdr tra_lab))))))
	  (set! tra (lts.apply tra 'sillabe1))
	  (set! tra (lts.apply tra 'sillabe2))
	  (set! tra (italian_tosyl_brackets tra))  
	  (list word lab tra))
	nil)))


;(set! l (trasmorph_all lexdir 'mamma 4))
;(set! l (car l))
;(set! l (_2list l))(trasmorph_all lexdir 'mamma 4))