/*

  name : dynparticles - part SERVER
  date : february 2007
  auteur : iri pour I-Maginer (http://www.i-maginer.fr)

*/


typeof class = S;;

struct PART =
			[
				// couleur
				initcolor : S,
				colorcycle : S,
				// taille
				sizemax : S,
				sizecycle : S,
				sizetime : S,
				// expert
				life : S,
				maskEmitter : S,
				volume : S,
				volA : S,
				volB : S,
				effect : S,
				effectA : S,
				effectB :S,
				effectC : S, // inutilisé
				target : S,
				randcolor : S,
				mass : S,
				framerate : S,
				
				png : S,
				ftrans : S
			] mkPART;;
typeof part = PART;;

typeof clis = [[CLIENT I] r1];;
typeof initON = I;;
var cliALL = 0;;	// si vaut 1 tous les clients enregistrés auront les modifications en live sinon seul le client admin les verra
var editSave = 0;;	// si vaut 1, toutes les modifs sont sauvegardés en tant réel sur le *.dms sinon elles sont perdues à la fermeture du serveur


fun miscSize(l, s)=
	if l == nil then
		s
	else
		(
		 set s = strcatn (hd l) :: " " :: s :: nil;
		 miscSize tl l s
		);;

/*
	supprime un client de la liste
	
	l	-> [[CLIENT I] r1] : clis
	cli	-> CLIENT : client à supprimer
		<- [[CLIENT I] r1] : liste à jour
*/
fun remove_from_clis(l, cli)=
 if l == nil then
   l
 else
	let hd l -> [c _] in
	if cli == c then
		tl l
	else
		(hd l) :: remove_from_clis tl l cli;;

// Retourne l'état d'un client
fun getStateByCli(l, cli)=
	if l == nil then
		0
	else
		let hd l -> [c state] in
		if cli == c then
			state
		else
			getStateByCli tl l cli;;

// Change l'état d'un client
fun chgState(l, cli, value)=
	if l == nil then
		nil
	else
		let hd l -> [c _] in
		if cli == c then
			[cli value] :: (tl l)
		else
			chgState tl l cli value;;

// Prépare les données à envoyer à un client			
fun prepareDatas()=
	strbuild ( "initcolor" :: part.initcolor :: nil ) ::
			 ( "colorcycle" :: part.colorcycle :: nil ) ::
			 ( "sizemax" :: part.sizemax :: nil ) ::
			 ( "sizecycle" :: part.sizecycle :: nil ) ::
			 ( "sizetime" :: part.sizetime :: nil ) ::
			 ( "life" :: part.life :: nil ) ::
			 ( "maskEmitter" :: part.maskEmitter :: nil ) ::
			 ( "volume" :: part.volume :: nil ) ::
			 ( "volA" :: part.volA :: nil ) ::
			 ( "volB" :: part.volB :: nil ) ::
			 ( "effect" :: part.effect :: nil ) ::
			 ( "effectA" :: part.effectA :: nil ) ::
			 ( "effectB" :: part.effectB :: nil ) ::
			 ( "effectC" :: part.effectC :: nil ) ::
			 ( "target" :: part.target :: nil ) ::
			 ( "randcolor" :: part.randcolor :: nil ) ::
			 ( "target" :: part.target :: nil ) ::
			 ( "mass" :: part.mass :: nil ) ::
			 ( "framerate" :: part.framerate :: nil ) ::
			 nil;;

/*
	Récupération de toutes les infos du bloc ' dat ' du C3D3 dans lequel dynparticles est intégré
	En effet, si l'admin client décide de sauvegarder les modifications du plugin, il est nécessaire de ne pas
	perdre les autres informations existantes de ce bloc !
	
	dmi		-> DMI : nom du module (ici le C3D3)
	bloc	-> S : nom du bloc (dat, dmi, link, ...)
			<- [[S r1] r1] : contenu du bloc
*/
fun getDmsC3D3(dmi, bloc)=
	_DMSgetDef dmi bloc;;
	
fun updtDmsBloc(bloc, inst, newvalue)=
	if bloc == nil then
		nil
	else
		let hd hd bloc -> key in
		if !strcmp key "instance" then
			if !strcmp hd tl hd bloc inst then
				(key :: inst :: class :: "test" :: newvalue) :: updtDmsBloc tl bloc inst newvalue
			else
				(hd bloc) :: updtDmsBloc tl bloc inst newvalue
		else
			(hd bloc) :: updtDmsBloc tl bloc inst newvalue;;
			
/*
	Sauvegarde les données sur le *.dms
	
*/
fun saveChgDms(o)=
	let getDmsC3D3 this "dat" -> bloc in
	let lineextr part.volA -> [vax [vay [vaz _]]] in
	let lineextr part.volB -> [vbx [vby [vbz _]]] in
	let lineextr part.effectA -> [fax [fay [faz _]]] in
	let lineextr part.effectB -> [fbx [fby [fbz _]]] in
	let lineextr part.effectC -> [fcx [fcy [fcz _]]] in
	let ( strcatn "init" :: " " :: ( if initON then "on" else "off" ) :: "\n" :: nil) ::
			( strcatn "initColor" :: " " :: part.initcolor :: "\n" :: nil ) ::
			( strcatn "initSizes" :: " " :: (miscSize lineextr part.sizetime nil) :: "\n" :: nil ) ::
			( strcatn "maxSize" :: " " :: part.sizemax :: "\n" :: nil ) ::
			( strcatn "colorCycle" :: " " :: part.colorcycle :: "\n" :: nil ) ::	 
			( strcatn "sizeCycle" :: " " :: part.sizecycle :: "\n" :: nil ) ::
			( strcatn "typeFX" :: " " :: part.effect :: "\n" :: nil ) ::
			( strcatn "typeVolEmitter" :: " " :: part.volume :: "\n" :: nil ) ::			 
			( strcatn "life" :: " " :: part.life :: "\n" :: nil ) ::
			( strcatn "typeParticle" :: " " :: part.target :: " " :: part.randcolor :: "\n" :: nil ) ::
			( strcatn "vectorA" :: " " :: vax :: " " :: vay :: " " :: vaz :: "\n" :: nil ) ::
			( strcatn "vectorB" :: " " :: vbx :: " " :: vby :: " " :: vbz :: "\n" :: nil ) ::
			( strcatn "vectorFxA" :: " " :: fax :: " " :: fay :: " " :: faz :: "\n" :: nil ) ::
			( strcatn "vectorFxB" :: " " :: fbx :: " " :: fby :: " " :: fbz :: "\n" :: nil ) ::
			( strcatn "vectorFxC" :: " " :: fcx :: " " :: fcy :: " " :: fcz :: "\n" :: nil ) ::
			( strcatn "mass" :: " " :: part.mass :: "\n" :: nil ) ::
			( strcatn "framerate" :: " " :: part.framerate :: "\n" :: nil ) ::
			( strcatn "target" :: " " :: part.target :: "\n" :: nil ) ::
			( strcatn "randcolor" :: " " :: part.randcolor :: "\n" :: nil ) ::
			nil 
		-> newbloc in
	let updtDmsBloc bloc ObName o newbloc -> newdat in
	_DMSupdateDef this "dat" newdat;
	_DEFsave;;

/*
	Envoi un message vers les clients enregistrés auprès du serveur
	
	l		-> [[CLIENT I] r1] : clis : liste des clients enregistrés
	ui		-> UserI
	action	-> S : Nom de l'action à envoyer
	param	-> S : paramètre à envoyer
			<- I
*/
fun _broadMsg(l, ui, action, param)=
	if l == nil then
		0
	else
		let hd l -> [cli _] in
		(
		 UsendMessage ui cli action param;
		 _broadMsg tl l ui action param
		);;
		
/*
	Envoi un message vers un client pour lancer un système de particules
	
	ui		-> UserI
	cli		-> CLIENT
	action	-> S : nom de l'action a envoyé
	param	-> S : paramètre de cette action
			<- 	i
*/
fun _sendMsgC(cli, ui, action, param)=
	_broadMsg [cli nil]::nil ui action param;;

/* 
	Communications intramodules (cli/srv)
	
	ui     -> UserI
	cli    -> CLIENT
	action -> S
	param  -> S
	p      -> [Ob] 
			<-  I   
*/
fun cbComm(ui, cli, action, param, o)=
	// Générales
	if !strcmp action "register" then
		(
		 set clis = [cli initON] :: clis;
		 UsendMessage ui cli "registered" nil;
		 if initON == 1 then
			UsendMessage ui cli "start" prepareDatas
		 else
			0;
		 0
		)
	else if !strcmp action "unregister" then
		(
		 set clis = remove_from_clis clis cli;
		 UsendMessage ui cli "unregistered" nil;
		 UsendMessage ui cli "stop" nil;
		 0
		)
	else if !strcmp action "start" then
		_broadMsg clis ui "start" prepareDatas
	else if !strcmp action "started" then
		(
		 set clis = chgState clis cli 1;
		 0
		)
	// Edition en ligne du client admin : les noms des actions sont suffisamment explicites
	else if !strcmp action "size_newSizeMax" then
		(
		 set part.sizemax = param;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "color_cycleColor" then
		(
		 set part.colorcycle = param;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "color_chgAlpha" then
		(
		 let htoi part.initcolor -> col in
		 let get_rgba col -> [r g b _] in
		 let make_rgba r g b atoi param -> col in
		 set part.initcolor = itoh col;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "color_chgColor" then
		(
		 let htoi part.initcolor -> col in
		 let get_rgba col -> [_ _ _ a] in
		 let htoi substr param 0 2 -> r in
		 let htoi substr param 2 2 -> g in
		 let htoi substr param 4 2 -> b in
		 let make_rgba r g b a -> col in
		 set part.initcolor = itoh col;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_infinit" then
		(
		 set part.life = param;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_volSphreRadius" then
		(
		 let lineextr part.volA -> [a [b [c _]]] in
		 set part.volA = linebuild param :: b :: c :: nil;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_volCone" then
		(
		 let lineextr param -> [n [value _]] in
		 let atoi n -> n in
		 let lineextr part.volA -> [a [b [c _]]] in
		 if n then
			set part.volA = linebuild value :: b :: c :: nil
		 else if n == 2 then
			set part.volA = linebuild a :: value :: c :: nil
		 else if n == 3 then
			set part.volA = linebuild a :: b :: value :: nil
		 else
			nil;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_volPlan" then
		(
		 let lineextr param -> [n [value _]] in
		 let atoi n -> n in
		 let lineextr part.volA -> [a [b [c _]]] in
		 if n then
			set part.volA = linebuild value :: b :: c :: nil
		 else if n == 2 then
			set part.volA = linebuild a :: value :: c :: nil
		 else
			nil;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_volLine" then
		(
		 let lineextr part.volA -> [a [b [c _]]] in
		 set part.volA = linebuild param :: b :: c :: nil;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_effectNone" then
		(
		 set part.effect = nil;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_effectConstant" then
		(
		 set part.effect = "EFFECT_CONSTANT";
		 set part.effectA = param;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_effectElectric" then
		(
		 set part.effect = "EFFECT_ELECTRIC";
		 let lineextr param -> [ax [ay [az [bx _]]]] in
		 (
		  set part.effectA = linebuild ax :: ay :: az :: nil;
		  set part.effectB = linebuild bx :: "0" :: "0" :: nil;
		 );
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_effectMagnetic" then
		(
		 set part.effect = "EFFECT_MAGNETIC";
		 let lineextr param -> [ax [ay [az [bx _]]]] in
		 (
		  set part.effectA = linebuild ax :: ay :: az :: nil;
		  set part.effectB = linebuild bx :: "0" :: "0" :: nil;
		 );
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_effectChotic0" then
		(
		 set part.effect = "EFFECT_CHAOTIC0";
		 let lineextr param -> [ax [ay [az [bx [by [bz _]]]]]] in
		 (
		  set part.effectA = linebuild ax :: ay :: az :: nil;
		  set part.effectB = linebuild bx :: by :: bz :: nil;
		 );
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_effectChotic1" then
		(
		 set part.effect = "EFFECT_CHAOTIC1";
		 let lineextr param -> [ax [ay [az [bx [by [bz _]]]]]] in
		 (
		  set part.effectA = linebuild ax :: ay :: az :: nil;
		  set part.effectB = linebuild bx :: by :: bz :: nil;
		 );
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_effectHelicoid" then
		(
		 set part.effect = "EFFECT_HELICOID";
		 let lineextr param -> [ax [ay [az [bx [by [bz _]]]]]] in
		 (
		  set part.effectA = linebuild ax :: ay :: az :: nil;
		  set part.effectB = linebuild bx :: by :: bz :: nil;
		 );
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_effectPlancoll" then
		(
		 set part.effect = "EFFECT_PLANCOLL";
		 let lineextr param -> [ax [ay [az [bx [by [bz _]]]]]] in
		 (
		  set part.effectA = linebuild ax :: ay :: az :: nil;
		  set part.effectB = linebuild bx :: by :: bz :: nil;
		 );
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_allClients" then
		(
		 set cliALL = atoi param
		)
	else if !strcmp action "expert_upload" then
		(
		 set editSave = atoi param
		)
	else if !strcmp action "plugin_stop" then
		(
		 _broadMsg clis ui "stop" nil
		)
	else if !strcmp action "expert_billboard" then
		(
		 set part.target = param;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_rainbow" then
		(
		 set part.randcolor = param;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_masse" then
		(
		 set part.mass = param;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "size_newSize" then
		(
		 set part.sizetime = param;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	else if !strcmp action "expert_rate" then
		(
		 set part.framerate = param;
		 if cliALL then
			_broadMsg clis ui "start" prepareDatas
		 else
			_sendMsgC cli ui "start" prepareDatas;
		 if editSave then
			saveChgDms o
		 else
			0
		)
	// Autres cas
	else
		0;;

/*
	Un client se déconnecte : il est supprimé de la liste ' clis '
	
	o	-> Ob
	cli	-> CLIENT : client déconnecté
		<- I
*/
fun out(o, cli)=
	set clis = remove_from_clis clis cli;
	0;;

fun newOb(o)= 
	let hd UgetParam ObUi o "init" -> tmp in
	set initON = if !strcmp tmp "on" then 1 else 0;
	
	let hd UgetParam ObUi o "initColor" -> p1 in
	let linebuild UgetParam ObUi o "initSizes" -> p2 in
	let hd UgetParam ObUi o "colorCycle" -> p3 in
	let hd UgetParam ObUi o "sizeCycle" -> p4 in
	let hd UgetParam ObUi o "maxSize" -> p5 in
	let hd UgetParam ObUi o "typeFX" -> p6 in
	let hd UgetParam ObUi o "typeVolEmitter" -> p7 in
	let hd UgetParam ObUi o "typeMaskEmitter" -> p8 in
	let hd UgetParam ObUi o "target" -> p9 in
	let hd UgetParam ObUi o "rainbow" -> p18 in
	let linebuild UgetParam ObUi o "vectorA" -> p10 in
	let linebuild UgetParam ObUi o "vectorB" -> p11 in
	let hd UgetParam ObUi o "life" -> p13 in
	let hd UgetParam ObUi o "mass" -> p14 in
	let hd UgetParam ObUi o "framerate" -> p15 in
	let linebuild UgetParam ObUi o "vectorFxA" -> p12 in
	let linebuild UgetParam ObUi o "vectorFxB" -> p16 in
	let linebuild UgetParam ObUi o "vectorFxC" -> p17 in	
	let linebuild UgetParam ObUi o "png" -> p19 in
	let linebuild UgetParam ObUi o "ftrans" -> p20 in			
	set part = mkPART[
						p1
						p3
						
						p5
						p4
						p2
						
						p13
						p8
						p7
						p10
						p11
						p6
						p12
						p16
						p17
						p9
						p18
						p14
						p15
						
						p19
						p20
					 ];
	
	UcbComm this ObUi o mkfun5 @cbComm o;
    OB_CBclientDestroyed o @out;
	0;;

fun IniPlug(file)=
 set class = getInfo strextr _getpack _checkpack file "name";
 PlugRegister class @newOb nil;
 0
;;