/* Jukebox - DMS - juin 00 - by Ariane Bitoun */


defcom SPlaySound=playsound S;;
defcom CnewSound=newSound S S;;
defcom SDownloadSound=downloadsound S S I;;
defcom Cshow=show S;;
defcom SRemoveSoundQ=removesoundq S I S;;
defcom SAddSound=addsound S ;;
defcom SStopSound=stopsound S I;;
defcom SAdmin=admin S;;
defcom SupdateSoundList=updatesoundlist S;;
defcom SChangeNbMax=changenbmax I I;;

typeof soundlist=[[S S] r1];;
typeof playinglist=[[S S] r1];;
typeof clientlist=[CLIENT r1];;
typeof nextsoundList=[CLIENT r1];;
typeof firstsoundlist=[CLIENT r1];;
typeof adminlist=[CLIENT r1];;

typeof DmiFile=[S S];; /*[Name Head]*/
typeof NbMaxL=I;;
typeof NbMaxQ=I;;

/** **UTILITAIRES*** */

fun MY_listcat (l1, l2)=
  if l1==nil then l2
  else
    let l1 -> [val nxt] in
    val::(MY_listcat nxt l2);;


fun MY_strcmp_name (i1, i2)=
  let i1->[n1 s1] in
  let i2->[n2 s2] in
    if strcmp n1 n2 then 0 else 1;;
 
fun selectname(l)=
 {
  if l!=nil 
  then
   let hd l->[name sound] in
   name::selectname tl l
  else nil
 };;
fun NameStr(l)= strbuild (selectname l)::nil;;

fun selectsound(l)=
 {
  if l!=nil 
  then
   let hd l->[name sound] in
   sound::selectsound tl l
  else nil
 };;
fun SoundStr(l)= strbuild (selectsound l)::nil;;


fun pos_in_r2list(lst,name,n)=
 if lst==nil 
 then nil
 else let lst -> [[a _] nxt] in
  if !strcmp a name 
  then n
  else pos_in_r2list nxt name n+1;;
  
/*proto reflex = fun [Multi [S] I] Multi;;*/
proto pos_in_r2list_client=fun [[[CLIENT I I] r1] CLIENT I] I;;

fun pos_in_r2list_client(lst,client,n)=
 if lst==nil 
 then nil
 else let lst -> [[a _ _] nxt] in
  if a==client 
  then n
  else pos_in_r2list_client nxt client n+1;;

    
fun MY_replace_nth_in_list (list, n, x)=
  if n < 0
  then
    list
  else
    let list -> [first next] in
      if n==0
      then
        x::next
      else
        first::MY_replace_nth_in_list next n-1 x;;
        
/* ***FIN DES UTILITAIRES*** */


/*Appellé a l'initialisation,lit le fichier dmi et charge la liste des morceaux dispo dans soundlist*/
fun _parser (l)=
  if l==nil
  then
    nil
  else
    let hd l-> [key [sound_nb _]] in
    (
      _parser tl l;
      if !strcmp key "sound" then
        let hd tl l -> [key [name _]] in
          if !strcmp key "alias" then
            set soundlist = [name sound_nb]::soundlist
          else nil
      else 
       if !strcmp key "NbMaxL" then
        let hd tl l-> [key [NbMaxLI _]] in
         if !strcmp key "NbMaxQ" then
           (set NbMaxL=atoi sound_nb;
            set NbMaxQ=atoi NbMaxLI;
            nil
           )
         else nil
       else nil
    );;  

/*Enregistrement d'un client dans la liste clientlist*/
fun unregister(client)=
 set clientlist=remove_from_list clientlist client;
 set nextsoundList=remove_from_list nextsoundList client;
 set firstsoundlist=remove_from_list firstsoundlist client;;
 
/*Desenregistrement d'un client dans la liste clientlist*/ 
fun register(client)=
 if (pos_in_list clientlist client 0)==nil
 then
  (_fooS "Ajout d'un client";
   set clientlist=client::clientlist;0)
 else 0;
 if playinglist==nil
  then 0
  else
   (/*let hd playinglist -> [name sound] in _DMSsend this client SDownloadSound [name sound 0];*/
    let hd tl playinglist -> [name sound] in _DMSsend this client SDownloadSound [name sound 1];0); 
    _DMSevent this client "in" nil nil;;

/*Desenregistrement d'un administrateur dans la liste clientlist et dans adminlist*/
fun unregisterAdmin(admin)=
 set adminlist=remove_from_list adminlist admin
 ;;

/*Enregistrement d'un administrateur dans la liste clientlist et dans adminlist*/ 
fun registerAdmin(admin)=
 if (pos_in_list adminlist admin 0)==nil
 then
  (set adminlist=admin::clientlist;0)
 else 0
 ;;

  
/*Gestion des evenements*/    
fun activate (from, concerning, action, param, reply)=	
  if !strcmp action "show"
  then
   (
    if playinglist==nil
    then
     ( _DMSsend this concerning Cshow [strcat NameStr soundlist strcat itoa NbMaxL strcat " " itoa NbMaxQ]
     )
    else
     (
     _DMSsend this concerning Cshow [strcat NameStr soundlist strcat itoa NbMaxL strcat " " strcat  itoa NbMaxQ strcat " " NameStr playinglist]
     );
   0)
  else if !strcmp action "destroy"
  then
   (_DMSdelClientDMI this concerning;0)
  else if !strcmp action "unregister"
  then
   (unregister concerning;0)
  else if !strcmp action "register"
  then
   ( _DMScreateClientDMI this concerning nil;
    register concerning;0)
  else if !strcmp (_fooS action) "edit"
  then
   (if (is_in_list clientlist concerning)
    then
     if playinglist==nil
     then
      (registerAdmin concerning;
       _DMSsend this concerning SAdmin [strcat NameStr soundlist strcat  SoundStr soundlist strcat itoa NbMaxL strcat " " itoa NbMaxQ]
      )
     else
      (registerAdmin concerning;
       _DMSsend this concerning SAdmin [strcat NameStr soundlist strcat SoundStr soundlist strcat itoa NbMaxL strcat " " strcat itoa NbMaxQ strcat " " NameStr playinglist]
      )
    else nil;
   0)    
  else
   0
;;


/*fonction appellée lorsque le client se delogue ou destruction*/
fun logout (client)=
 if (pos_in_list adminlist client 0)!=nil
 then
  (unregisterAdmin client;0)
 else 0;
 unregister client;
  _DMSevent this client "destroyed" nil nil
;;

/*fonction reccurente, appellée a l'initialisation pour creer une signature a tous les fichiers son*/
fun RegisterSound(lst)=
 if lst==nil then
  nil
 else
  let hd lst -> [alias file] in
   (_RSregister this file RSfile+RScontrol file;
    RegisterSound tl lst;0
   )
;;

/*fonction reccurente qui permet de lancer un morceau chez tous les clients appellé par __playsound*/
fun SendSoundAllClients(lst, name)=
if lst==nil
then 
 0
else
 (let hd lst->cli in  _DMSsend this cli SPlaySound [name];
  SendSoundAllClients (tl lst) name;
  0
 )
;;

/*fonction reccurente qui ajoute un morceau dans la liste d'attente de tous les clients appellée par __addsound*/
fun AddSoundAllClients(lst,listname)=
if lst==nil
then 
 0
else
(let hd lst->cli in
 _DMSsend this cli SAddSound [listname];
 AddSoundAllClients (tl lst) listname;
 0
);;

/*fonction reccurente qui supprime un morceau dans la liste d'attente de tous les clients */
fun RemoveSoundFromListQ(lst,name,index)=
if lst==nil
then 
 0
else
(let hd lst->cli in _DMSsend this cli SRemoveSoundQ [name index NameStr playinglist];
 RemoveSoundFromListQ (tl lst) name index;
 0
);;


/*fonction qui test si on peut envoyer le morceau suivant*/
fun  testifputnewsound()=
if playinglist==nil 
then 0
else
 (let sizelist clientlist -> taillecli in
  let sizelist nextsoundList -> tailledown in
  let sizelist firstsoundlist ->taillefirst in
    if taillefirst!=0
    then
     if taillecli<=taillefirst
     then 
      (1)
     else
       (0)
    else if taillecli<=tailledown
    then 1
    else 
     (0)
   );;

/*fonction reccurente qui up-load un morceau chez tous les clients */
fun DownloadSoundAllClients(lst,name,sound,index)=   /*index=0->premier morceau, index=1-> second morceau de la liste*/
if lst==nil
then 
 0
else
(let hd lst->cli in
 _DMSsend this cli SDownloadSound [name sound index];
 DownloadSoundAllClients (tl lst) name sound index;
 0
);;

fun stopSoundAllClients(lstcli,name,index)=
if lstcli==nil
then 
 0
else
(let hd lstcli->cli in
  (_DMSsend this cli SStopSound [name index]);
 stopSoundAllClients (tl lstcli) name index;
 0
);;

/*Fonction qui gere l'envoie du morceau suivant et la suppression du morceau fini*/
fun PutNewSound()=
 if testifputnewsound ==1
 then
  (
   let sizelist firstsoundlist ->taillefirst in
   if taillefirst==0    /*il ne s'agit pas du premier morceau*/  
   then 
    (let hd playinglist -> [name _] in 
     (set playinglist=endlist playinglist 1;
      RemoveSoundFromListQ clientlist name 0
     );     
     0
    )
   else 
    (set firstsoundlist=nil; /* il s'agit du premier morceau de la liste*/
     0); 
   /*Envoi du morceau courant*/
   let hd playinglist -> [name sound] in 
    (SendSoundAllClients clientlist name);
    
   /*Download du morceau suivant*/      
   if (tl playinglist )==nil
   then 
    (0)   
   else 
    (
     let hd tl playinglist -> [name sound] in 
     (set nextsoundList=nil; 
      DownloadSoundAllClients clientlist name sound 1
     );
     0
    );
    0
   )
 else
  0;;
  
/****************************************************************************************/
/****************************************************************************************/


/*Permet de sauvegarder les noms et alias des morceaux dans le 
fichier dmi avec les mots clefs name et sound*/    
fun buildFile (l)=
 if l==nil
 then
   nil
 else
   let hd l -> [name sound] in ("sound"::sound::nil)::("alias"::name::nil)::buildFile tl l;;
   
/*Sauvegarde les parametres du module dans le fichier DMI*/      
fun save ()=
 let DmiFile ->[filename headstring] in 
  _storepack strcat headstring strcat (strbuild buildFile soundlist) strcat "NbMaxL "strcat itoa NbMaxL strcat "\nNbMaxQ " itoa NbMaxQ filename;;    

/*Fonction reccurente, charge la liste soundlist chez tous les clients*/ 
fun updateSoundList(clientlist)=
 if clientlist==nil
 then 
  0
 else
  (let hd clientlist->cli in
   _DMSsend this cli SupdateSoundList [strcat NameStr soundlist SoundStr soundlist];
   updateSoundList tl clientlist;
   0
  );;
  
/*Fonction reccurente, change */ 
fun ChangeNbMaxAllClient(clientlist)=
 if clientlist==nil
 then 0
 else
  (let hd clientlist->cli in _DMSsend this cli SChangeNbMax [NbMaxL NbMaxQ];
   ChangeNbMaxAllClient tl clientlist;
   0);;
 
      
/****************************************************************************************/
/****************************************************************************************/

 
fun IniDMI (filename)=
  _DMSregisterDMI this @activate @logout @logout nil;
  set soundlist=nil;
  set clientlist=nil;
  set playinglist=nil;
  set nextsoundList=nil;
  let _getpack _checkpack filename -> ficstring in
  let strfind "sound" ficstring 0 -> indexend in
    (set DmiFile= [filename substr ficstring 0 indexend];
     let strextr ficstring ->l in  _parser l
    );
  RegisterSound soundlist;;
    
/****** DEFCOM ****/   
  
/*Appellée lorsqu'un morceau doit etre rajouté dans la liste d'attente de tous les clients
Si on ajoute l'un des deux premiers morceaux de la liste, on les upload immediatement*/
fun __addsound(name)=
 let pos_in_r2list soundlist name 0 ->index in
 let nth_list soundlist index -> [name sound] in
 let sizelist playinglist ->taille in
 (if taille==0 then
   (set firstsoundlist=nil;
    DownloadSoundAllClients clientlist name sound 0;
    0)
  else 
   if taille==1
   then 
    (set nextsoundList=nil;
     DownloadSoundAllClients clientlist name sound 1;
     0)
   else 0;
  set playinglist=listcat playinglist [name sound]::nil
 ); 
  AddSoundAllClients clientlist NameStr playinglist;;
  
/*Appellée lorsqu'un morceau est fini, on stocke l'information et on lance eventuellement le suivant avec PutNewSound*/ 
fun __finished(name)=

let hd playinglist ->[currentName currentSound] in
if !strcmp name currentName
then
 (if (sizelist playinglist)==1
  then 
   (set playinglist=nil;
    RemoveSoundFromListQ clientlist name 0;0)
  else
   (PutNewSound;0)
  )
else 
 (_fooS strcat "*****__finished PB de Nom de fichiers name : " strcat name strcat "  currentsound : " currentName;0)
   ;;


  
/*Appellée lorsqu'un morceau est entierement uploadé chez le client, on stocke l'information et;
s'il s'agit du premier morceau de la liste d'attente, on le lance*/  
fun __downloaded(name, index)=
 let hd playinglist ->[firstname _] in
 let hd tl playinglist ->[nextname _] in
 if index==0
 then
   (set firstsoundlist=DMSsender::firstsoundlist;
    PutNewSound;
    0)
 else 
  if index==1
  then
   (set nextsoundList=DMSsender::nextsoundList;0)
  else
   (_fooS strcat "*** __downloaded : Pb index<>0 ou 1  name= " name;0);;



/*Appellée lorsqu'un morceau est démarré chez un client*/
fun __started(name)=
let hd playinglist ->[currentName currentSound] in
if !strcmp name currentName
then
 (0)
else 
 (_fooS strcat "*****__started PB de Nom de fichiers name : " strcat name strcat "currentsound : " currentName;0)
 ;;
 
/****************************************************************************************/
/****************************************************************************************/
/*Enleve un morceau de la liste d'attente*/
fun __removeq(name,index)=
if (pos_in_list adminlist DMSsender 0)!=nil
then
(if (index==0) /*On retire le son joué, le premier*/
 then 
  (stopSoundAllClients clientlist name index;
   let nth_list playinglist 1 ->[firstname _] in
   let nth_list playinglist 2 ->[nextname nextsound] in  
    (
     if testifputnewsound ==1 
     then 
      (set firstsoundlist=nextsoundList;
       set playinglist= remove_nth_from_list playinglist index; 
       RemoveSoundFromListQ clientlist name index;
       SendSoundAllClients clientlist firstname;
       /*PutNewSound;*/
       0)
     else 
       if (sizelist playinglist)==1
       then
        (set playinglist=nil;
         RemoveSoundFromListQ clientlist name index;
         0)
       else 
        (set playinglist= remove_nth_from_list playinglist index; 
         RemoveSoundFromListQ clientlist name index;
         0
        );
     set nextsoundList=nil;
     DownloadSoundAllClients clientlist nextname nextsound 1;
     0
    )
  )
 else 
  if index==1 /*On retire le second son */
  then
   (let nth_list playinglist index+1 ->[nextName nextSound] in
     (set nextsoundList=nil;
      DownloadSoundAllClients clientlist nextName nextSound 1;
      set playinglist= remove_nth_from_list playinglist index; 
      RemoveSoundFromListQ clientlist name index;
      0
      );
    0
   )
  else 
   (set playinglist= remove_nth_from_list playinglist index; 
    RemoveSoundFromListQ clientlist name index;
    0
   )
)
else nil;;

/*Retire un morceau de la liste de sons disponibles*/
fun __removel(name, index)=
if (pos_in_list adminlist DMSsender 0)!=nil
then
(set soundlist= remove_nth_from_list soundlist index;
 updateSoundList clientlist;
 save
)
else nil;;

/*Ajoute un nouveau son dans la liste de sons disponibles*/
fun __addsoundl (name, sound, filestr)=
if (pos_in_list adminlist DMSsender 0)!=nil
then
( _storepack filestr sound;
  _RSregister this sound RSfile+RScontrol sound;
  set soundlist=MY_listcat soundlist [name sound]::nil;
  updateSoundList clientlist;
  save
)
else nil;;

/*Met un son en seconde position*/
fun __putnextl(n, index)=
if (pos_in_list adminlist DMSsender 0)!=nil
then
(let nth_list playinglist index -> [name sound] in 
  (set playinglist = remove_nth_from_list playinglist index;
   set playinglist = add_nth_in_list playinglist 1 [name sound];
   set nextsoundList=nil;
   RemoveSoundFromListQ clientlist name 1;
   DownloadSoundAllClients clientlist name sound 1;
   
  );
  /*AddSoundAllClients clientlist NameStr playinglist*/
  
)
else nil;;

fun __changenbmax(nbmaxL,nbmaxQ)=
if (pos_in_list adminlist DMSsender 0)!=nil
then
(set NbMaxL=nbmaxL;
 set NbMaxQ=nbmaxQ;
 ChangeNbMaxAllClient clientlist;
 save
)
else nil ;;

/****************************************************************************************/
/****************************************************************************************/
/****** END  DEFCOM ****/