/******************************************************************************* Module Whiteboard Client part Version: 1.0 Authors: LEBLOND Gregory & BRESCIA Franck & OHAYON Franck Last update: 6/09/2001 Whiteboard Module *******************************************************************************/ defcom CsetLines = setLines S I I I;; defcom CinitSize = initSize I I;; defcom CsetCircle = setCircle I I I I I;; defcom CsetRect = setRect I I I I I I;; defcom CsetLigne = setLigne I I I I I I;; defcom SgetText = getText S I I I I;; defcom CEffacerCanvas = EffacerCanvas;; defcom CgetPicture = getPicture ;; /* permet de récupérer l'image du whiteboard serveur */ defcom CgetUndoPicture = getUndoPicture;; defcom CgetListCli = getListCli ;; /* permet de récupérer la liste client lorsqu'on show le white board */ defcom CClientDeleted = ClientDeleted;; /* permet d'enlever le client de la liste des clients */ defcom CClientAdd = ClientAdd;; /* permet d'ajouter client quand celui-ci fait hide puis show */ defcom CUndoCopy = UndoCopy;; defcom CUndo = Undo;; /* permet d'effectuer un Undo chez les autres clients */ defcom CCut = Cut I I I I;; defcom CPaste = Paste I I I I;; /* permet d'effectuer un paste : posx, posy , Wcopy, Hcopy */ /*defcom CFillColor = FillColor I I I ;;*/ /* permet d'effectuer le remplissage de surface : posx,posy,color */ var BUFFER_SIZE = 100;; /*taille buffer*/ /* structure pour l'affichage dans la fenetre client */ struct Ctrl= [ ctr_win :ObjWin, /* Window */ ctr_bitmap :ObjBitmap, /* Bitmap */ ctr_x :I, /* X pos */ ctr_y :I, /* Y pos */ ctr_l :I, /* Width */ ctr_h :I /* Lenght */ ]mkCtrl;; /* Structure pour les différents types de tracé */ struct Trait= [ bros :AlphaBitmap, /* Image bitmap (Alpha) */ brtype :I, /* Type de brush 1 2 3 4 5 nil=trait, Gomme=235 */ wid :I, /* width */ col :I, /* current color */ lastcolor:I, /* last color */ lastwid:I ]mkTrait;; /* Structure pour les différents type d'objet géométriques */ struct Geom= [ gtype :I, /* Type d'objet geometrique GEO_Rectangle,GEO_Ligne,GEO_Cercle,0=Gomme ou trait */ size :I, /* Width */ OriginX :I, /* X pos */ OriginY :I, /* Y pos */ ray :I /* rayon */ ] mkGeom;; typeof control=Ctrl;; typeof trt=Trait;; typeof geo=Geom;; /* Filling */ /*typeof Flood=I;; typeof FloodEnable=I;;*/ /* Picking */ typeof pick=I;; /* utilisation du picking */ typeof flagG=I;; /* flag utilisation du picking */ /* Paste */ typeof copy=I;; /* flag for Paste */ typeof Wcopy=I;; /* W of Paste */ typeof Hcopy=I;; /* H of Paste */ typeof Gomme=I;; typeof brush = I;; /*to know when a brush is selecte*/ typeof bmp = S;; typeof Geobuf=ObjBitmap;; /* Buffer Bitmap Temporaire pour l'affichage des objets géométriques et du texte en local */ typeof UndoBuf=ObjBitmap;; /* Buffer de Undo */ typeof CopyBuf=ObjBitmap;; /* Buffer de Copier coller */ typeof SelectionColor=ObjBitmap;; /* image selection de la couleur */ /*typeof flagUndo=I;; */ /* permet de savoir si la personne à deja dessiner */ typeof ColorBitmap=ObjBitmap;; /* Bitmap de la palette des couleurs */ typeof tamponTrace=[[S r1] r1];; /* Buffer des modifications */ typeof pposx=I;; /* PositionX précédente dans Move Mouse */ typeof pposy=I;; /* PositionY précédente dans Move Mouse */ typeof CountMax=I;; /* Compteur des modifications , apres 50 modifs envoie au serveur pour affichage aux autres clients */ /* different type of cursor */ typeof penCurs=ObjCursor;; typeof gomCurs=ObjCursor;; typeof linCurs=ObjCursor;; typeof recCurs=ObjCursor;; typeof crcCurs=ObjCursor;; typeof jpgCurs=ObjCursor;; typeof txtCurs=ObjCursor;; /*different colour */ typeof Noir=I;; typeof Rouge=I;; typeof Vert=I;; typeof Bleu=I;; typeof Blanc=I;; typeof Transparent=I;; /*************** Main Window interface **********************/ typeof MainWin=ObjWin;; /***************bottom part of the interface******************/ /* container of the bottom part of the interface */ typeof drawtools=ObjContainer;; typeof selection=ObjContainer;; /* palette de couleur */ var ColorX=18;; var ColorY=23;; var ColorL=113;; var ColorH=83;; var SelectX=600;; var SelectY=70;; var SelectL=30;; var SelectH=28;; /* used for text */ typeof TextDirection=I;; typeof TextString=S;; typeof TextFont=ObjFont;; typeof tipFont=ObjFont;; /* type de font pour les bouttons */ /* list of the button*/ typeof ListeCheck=[CompCheck r1];; /* list of the largeurTrait */ typeof ListeLargeurTrait=[[CompCheck I] r1];; /* list of the TailleTexte */ typeof ListeTailleTexte=[[CompCheck I] r1];; /* pour afficher des images */ typeof jpegbuf=ObjBitmap;; typeof jpegbufsizew=I;; typeof jpegbufsizeh=I;; typeof xormode=I;; typeof JPEG_posl=[[S I I] r1];; /* used for DL picture from the server */ typeof TraitCheck=CompCheck;; typeof TexteCheck=CompCheck;; typeof Eraser=CompCheck;; /******************left part of the interface******************/ typeof clientcont = ObjContainer;; /******************right part of the interface******************/ /* container of the right part of the interface */ typeof brushtools=ObjContainer;; /* CompList of the different Client */ typeof ClientInfoList=CompList;; /* List of the different type of brush */ typeof brosListe= [AlphaBitmap r1];; typeof cursorListe = [ObjBitmap r1];; typeof tmpalphaListe= [AlphaBitmap r1];; /* CompList of the different type of brush */ typeof brushLst=CompList;; /*path*/ typeof modulePath = S;; var GEO_Cercle=1;; var GEO_Rectangle=2;; var GEO_Ligne=3;; var VAR_GEO_Texte=0;; /* VAR_GEO_Texte=0 lorsqu'on a envoyer le texte au serveur */ /* VAR_GEO_Texte=1 lorsqu'on clique sur le bouton texte */ /* VAR_GEO_Texte=2 apres un clicUp */ var clic=0;; /* button number ->0 si pas appuyer sur button */ var BrushL=82;; var BrushH=82;; typeof refreshtimer = Timer;; typeof modif = I;; /* Max L/H of the picture sended to the server */ var TransfertImageMaxL=400;; var TransfertImageMaxH=300;; /********************************************************************************* raffraichir la texture du plug-in image en cas de modification timer -> TIMER : timer appelant la callback toute les secondes parma -> S : not used ***********************************************************************************/ fun cbshowImage(timer, param)= if modif == 1 then ( set modif = 0; let _GETbitmap control.ctr_bitmap -> string in _DMSevent this "showImage" strbuild ("type"::"contents"::nil)::("value"::(string)::nil)::nil nil ) else nil ;; /******************************************************************************* blitter bitmap on window *******************************************************************************/ fun refresh()= _BLTbitmap control.ctr_win control.ctr_bitmap control.ctr_x control.ctr_y; /* copie la bitmap sur la fenetre */ 0 ;; /******************************************************************************* Callback on Repaint win -> : a -> : <- *******************************************************************************/ fun WinPAINT(win, a) = refresh ;; /******************************************************************************* Decal + Color (for Picking) color -> I : color to adjust color <- I : color adjusted *******************************************************************************/ fun DecalColor_moins(C) = if C<0 then ( set C = C + 255 ) else C ;; /******************************************************************************* Decal - Color (for Picking) color -> I : color to adjust color <- I : color adjusted *******************************************************************************/ fun DecalColor_plus(C) = if C>255 then ( set C = C - 255 ) else C ;; /******************************************************************************* Adjust Color (for Picking) color -> I : color to adjust decal -> I : decal color <- I : color adjusted *******************************************************************************/ fun AdjustColor(color, decal) = let ((color&255) + decal ) -> B in let ((color>>8)&255 + decal ) -> G in let ((color>>16) + decal ) -> R in ( if decal then ( set G = DecalColor_plus G ; set R = DecalColor_plus R ; set B = DecalColor_plus B ; set color = make_rgb B G R ) else ( set G = DecalColor_moins G; set R = DecalColor_moins R; set B = DecalColor_moins B; set color = make_rgb B G R ) ) ;; /******************************************************************************* Flood Fill at all 4 neighbors x -> I : posX y -> I : posY old -> I : old color new -> I : new color <- *******************************************************************************/ /*fun FloodFill4(x,y,Old,New) = if ((_GETpixel16 control.ctr_bitmap x y) == Old) then ( let (AdjustColor New (-5)) -> Color in (On fonce la couleur car Putpixel l'eclairci) _PUTpixel16 control.ctr_bitmap x y Color; FloodFill4 x y+1 Old New; FloodFill4 x y-1 Old New; FloodFill4 x+1 y Old New; FloodFill4 x-1 y Old New; 0 ) else nil ;;*/ /******************************************************************************* Send the text to the server *******************************************************************************/ fun IniTxt()= if (VAR_GEO_Texte==2 && TextString!="") then ( _CPbitmap16 control.ctr_bitmap 0 0 Geobuf 0 0 control.ctr_l control.ctr_h nil; /* permet de retirer le _ à la fin du texte */ _CPbitmap16 UndoBuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; /* Pour le Undo */ _DRAWtext control.ctr_bitmap TextFont geo.OriginX geo.OriginY TD_LEFT|TD_BASELINE trt.col TextString; /* On a tout le texte ecrit avant ENTER */ refresh; _DMSsend this SgetText [TextString geo.OriginX geo.OriginY trt.col geo.size]; /* envoie texte au serveur */ set modif = 1; 0 ) else nil; set VAR_GEO_Texte = 0 ;; /******************************************************************************* Check the state of button (check only c and uncheck all the others) c -> CompCheck: <- : *******************************************************************************/ fun SetAllChecks(c) = apply_on_list (remove_from_list ListeCheck c) @_SETcompCheckState CHK_UNCHECKED; /* deselectionne tout sauf notre bouton c */ _SETcompCheckState c CHK_CHECKED; _PAINTcontainer drawtools; _PAINTcontainer selection; if brush == 1 then set brush = 0 else ( _SETcompListClicked brushLst (-1); _PAINTcontainer brushtools; nil; ); 0 ;; /******************************************************************************* Callback on Keyboard entering win -> ObjWin : a -> util : key -> I : scancode vcode -> I : value (ascii code for usual keys) <- : *******************************************************************************/ fun EnterTxt(win, a, key, vcode) = if (vcode == 13) then /* pour gerer la touche Enter */ ( IniTxt; /* envoie le texte au serveur pour le redonner aux différents clients */ _SETwinCursor control.ctr_win penCurs; SetAllChecks (nth_list ListeCheck 1); 0 ) else nil; if (VAR_GEO_Texte==2 && vcode==8 && TextString != "") then /* pour gerer la touche Suppr */ ( /* a chaque fois qu'on écrit on efface tout (les ecriture precedentes, pas les dessins) et on réaffiche de nouveau les anciennes+nouvelles ecritures */ _CPbitmap16 control.ctr_bitmap 0 0 Geobuf 0 0 control.ctr_l control.ctr_h nil; set TextString = substr TextString 0 (strlen TextString)-1; set control.ctr_bitmap=_DRAWtext control.ctr_bitmap TextFont geo.OriginX geo.OriginY TD_LEFT|TD_BASELINE trt.col strcat TextString "_"; refresh; 0 ) else nil; if (VAR_GEO_Texte==2 && vcode >= 32) then /* pour gerer toutes les touches d'ecriture */ ( _CPbitmap16 control.ctr_bitmap 0 0 Geobuf 0 0 control.ctr_l control.ctr_h nil; set TextString = strcat TextString ctoa vcode; /* ajoute au fur et a mesure le texte ecrit dans la fenetre à TextString */ set control.ctr_bitmap=_DRAWtext control.ctr_bitmap TextFont geo.OriginX geo.OriginY TD_LEFT|TD_BASELINE trt.col strcat TextString "_"; refresh; 0 ) else nil ;; /******************************************************************************* Callback on click down win -> ObjWin : window where there was a click event a -> param utilisateur : posx -> I : position X of the click posy -> I : position Y of the click btn -> I : button of the click <- ObjWin : the same window *******************************************************************************/ fun ClicDWN(win, a, posx, posy, btn) = if (posx>=control.ctr_x && posy>=control.ctr_y && posx coller*/ ( _DMSsend this CPaste[posx posy Wcopy Hcopy]; _CPbitmap16 UndoBuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; /* Pour le Undo */ _CPbitmap16 control.ctr_bitmap posx posy CopyBuf 0 0 Wcopy Hcopy nil; refresh; ) else ( /* FLOOD */ /*if (Flood==0) then ( if (FloodEnable==1) then ( set FloodEnable = 0; _CPbitmap16 UndoBuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; (Pour le Undo) if ( AdjustColor (_GETpixel16 control.ctr_bitmap posx posy) (8) ) != trt.col then ( _DMSsend this CFillColor [posx posy trt.col]; FloodFill4 posx posy _GETpixel16 control.ctr_bitmap posx posy trt.col; refresh; set FloodEnable = 1; ) else ( set FloodEnable = 1; 0; ) ) else nil ) else (*/ /* PICKING */ if (pick == 0) then ( if posx>=0 && posx<500 && posy>=0 && posy<300 then ( set trt.col = AdjustColor (_GETpixel16 control.ctr_bitmap posx posy) 5; /* Adjustment of the color */ _PAINTcontainer selection; nil; /* on éclairci la couleur car Getpixel la fonce */ ) else nil; ) else ( if (VAR_GEO_Texte>0) then ( 0 ) else ( if (geo.gtype==0 && jpegbuf==nil) then ( set tamponTrace=((itoa posx)::(itoa posy)::nil)::((itoa posx+1)::(itoa posy)::nil)::nil; /* envoie aux autres clients du point */ 0 ) else nil; if (/*Flood!=0 &&*/ pick!=0 && geo.gtype==0 && jpegbuf==nil) then ( _CPbitmap16 UndoBuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; /* Undo */ _DMSsend this CUndoCopy []; /* send message to server to tell other clients to copy bitmap courant */ if (trt.brtype!=nil) then /* si on a une brush */ ( if (trt.brtype==Gomme) then /* et si c la gomme */ ( _DRAWline control.ctr_bitmap posx posy posx+1 posy DRAW_SOLID 20 Blanc; refresh; 0 ) else /* si c une brush diff de la gomme */ ( let (max 0 posy-BrushH/2)->ybros in let _GETalphaBitmaps trt.bros->[b _] in ( /*set trt.col = AdjustColor (trt.col) 5;*/ _FILLbitmap b trt.col; _CPalphaBitmap control.ctr_bitmap posx-BrushL/2 ybros trt.bros 0 0 BrushL BrushH; _FILLbitmap b 0; ); refresh; 0 ) ) else /* si c pas une brush*/ ( _DRAWline control.ctr_bitmap posx posy posx+1 posy DRAW_SOLID trt.wid trt.col; refresh; 0 ) ) else nil; set CountMax=0; set geo.OriginX=posx; set geo.OriginY=posy; set clic=btn; 0 ); ) /*)*/ ) ) else /* si le click n'est pas dans la fenetre */ nil; 0 ;; /******************************************************************************* Callback on click move win -> ObjWin : window a -> util : param utilisateur posx -> I : PosX of cursor posy -> I : PosY of Cursor aa -> I : button state <- : *******************************************************************************/ fun MouseMV(win, a, posx, posy, aa) = if (posx>=control.ctr_x && posy>=control.ctr_y && posxBUFFER_SIZE) then /* Envoie au serveur du tampon des modifications après 50 modifs */ ( if (trt.brtype==Gomme) then ( _DMSsend this CsetLines [(zip strbuild tamponTrace) nil 20 Blanc]; 0 ) else ( _DMSsend this CsetLines [(zip strbuild tamponTrace) trt.brtype trt.wid trt.col]; 0 ); set tamponTrace=((itoa posx)::(itoa posy)::nil)::nil; /* on vide le tampon des modifs */ set CountMax=0; 0 ) else nil; /* tracé de la brosse prédéfinie */ if (trt.brtype!=nil) then ( if (trt.brtype==Gomme) then ( _DRAWline control.ctr_bitmap pposx pposy posx posy DRAW_SOLID 20 Blanc; refresh; 0 ) else ( let (max 0 posy-BrushH/2)->ybros in let _GETalphaBitmaps trt.bros->[b _] in ( _FILLbitmap b trt.col; _CPalphaBitmap control.ctr_bitmap posx-BrushL/2 ybros trt.bros 0 0 BrushL BrushH; _FILLbitmap b 0; ); refresh; 0 ) /* sinon tracé normal */ ) else ( _DRAWline control.ctr_bitmap pposx pposy posx posy DRAW_SOLID trt.wid trt.col; refresh; 0 ); 0 ) else nil; if (/*Flood!=0 &&*/ pick!=0 && clic!=0 && jpegbuf==nil && tamponTrace==nil && VAR_GEO_Texte==0) then ( /* tracé des formes géométriques : lorsque l'on bouge on dessine dans un buffer temporaire GeoBuf */ _CPbitmap16 Geobuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; /* important */ _CPbitmap16 UndoBuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; /* Undo */ _DMSsend this CUndoCopy []; /* send message to server to tell other client to copy bitmap courant */ if (geo.gtype==GEO_Cercle) then ( set geo.ray=max (abs geo.OriginX-posx) (abs geo.OriginY-posy); _DRAWcircle Geobuf geo.OriginX geo.OriginY geo.ray DRAW_SOLID trt.wid trt.col DRAW_INVISIBLE nil; 0 ) else ( if (geo.gtype==GEO_Rectangle) then ( _DRAWrectangle Geobuf geo.OriginX geo.OriginY posx-geo.OriginX posy-geo.OriginY DRAW_SOLID trt.wid trt.col DRAW_INVISIBLE nil; 0 ) else ( if (geo.gtype==GEO_Ligne) then ( _DRAWline Geobuf geo.OriginX geo.OriginY posx posy DRAW_SOLID trt.wid trt.col; 0 ) else nil; ) ); _BLTbitmap control.ctr_win Geobuf control.ctr_x control.ctr_y; /* Utilisation d'un buffer Temp des formes geo */ 0 /* permet de modifier rayon cercle sans relacher */ ) /* bouton et on blit tout ca ds notre fenetre */ else nil; set pposx=posx; set pposy=posy; 0 ) else nil; 0 ;; /******************************************************************************* Callback on click up win -> ObjWin : Window a -> param : posx -> I : PosX of cursor posy -> I : PosY of cursor btn -> I : Button State <- ObjWin : Window *******************************************************************************/ fun ClicUP(win, a, posx, posy, btn) = set clic = 0; /* permet de ne plus dessiner lorqu'on a cliquer en dehors de la zone de dessin et qu'on revient dedans */ if (/*Flood!=0 &&*/ pick!=0 && tamponTrace!=nil && geo.gtype==0) then ( if (trt.brtype==Gomme) then ( _DMSsend this CsetLines [zip strbuild tamponTrace nil 20 Blanc]; 0 ) else ( _DMSsend this CsetLines [zip strbuild tamponTrace trt.brtype trt.wid trt.col]; 0 ); set tamponTrace=nil; 0 ) else nil; if (/*Flood!=0 &&*/ pick!=0 && posx>=control.ctr_x && posy>=control.ctr_y && posx coller */ ( _CPbitmap16 control.ctr_bitmap posx posy CopyBuf 0 0 Wcopy Hcopy nil; refresh; set trt.col = trt.lastcolor; set trt.wid = trt.lastwid ) else ( _CPbitmap16 control.ctr_bitmap 0 0 Geobuf 0 0 control.ctr_l control.ctr_h nil; refresh; /*set geo.gtype=0;*/ /* si on ne veut pas rester sur l'outil */ _DMSsend this CsetRect [geo.OriginX geo.OriginY posx posy trt.wid trt.col]; nil ); nil ); nil ) else ( if (geo.gtype==GEO_Ligne) then /* affichage de la ligne et envoie au serveur */ ( _CPbitmap16 control.ctr_bitmap 0 0 Geobuf 0 0 control.ctr_l control.ctr_h nil; refresh; /*set geo.gtype=0;*/ /* si on ne veut pas rester sur l'outil*/ _DMSsend this CsetLigne [geo.OriginX geo.OriginY posx posy trt.wid trt.col]; 0 ) else nil ) ) ) ) else ( if (VAR_GEO_Texte==1) then /* Si le bouton Texte a été sélectionné mettre le curseur "_" */ ( /* 1 clic > on obtient le curseur "_" */ _SETfocus control.ctr_win; set geo.OriginX=posx; set geo.OriginY=posy; set TextString=""; set TextDirection=0; set VAR_GEO_Texte=2; /* comme cela au 2eme click on ira à l'autre condition pour envoyer txt au serveur */ if (TextFont != nil) then ( _DSfont TextFont; 0 ) else nil; set TextFont=_CRfont _channel geo.size TextDirection 0 (_loc this "FONT" nil); _CPbitmap16 Geobuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; /* on copie tout dans Buf tempo avant d'ecrire */ _DRAWtext control.ctr_bitmap TextFont geo.OriginX geo.OriginY TD_LEFT|TD_BASELINE trt.col "_"; refresh; 0 ) else ( if (VAR_GEO_Texte==2) then /* 2eme clic on envoye le txt au serveur */ ( IniTxt; /* envoie au serveur du txt */ set VAR_GEO_Texte=2; /* on veut qu'a chaque fois qu'on clic on puisse envoyer */ _SETfocus control.ctr_win; set geo.OriginX=posx; set geo.OriginY=posy; set TextString=""; set TextDirection=0; if (TextFont != nil) then ( _DSfont TextFont; 0 ) else nil; set TextFont=_CRfont _channel geo.size TextDirection 0 (_loc this "FONT" nil); _CPbitmap16 Geobuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; _DRAWtext control.ctr_bitmap TextFont geo.OriginX geo.OriginY TD_LEFT|TD_BASELINE trt.col "_"; refresh; 0 ) else nil; 0 ) ) ) else /* si on relache le bouton souris à l'exterieur du WhiteBoard ne pas afficher la figure geo */ ( if (geo.gtype==GEO_Cercle)||(geo.gtype==GEO_Rectangle)||(geo.gtype==GEO_Ligne) then _BLTbitmap control.ctr_win control.ctr_bitmap control.ctr_x control.ctr_y else nil; 0 ); set modif = 1; 0 ;; /****************************************************************************************/ /* Messages send to server */ /****************************************************************************************/ fun ListCli() = /* permet de récupérer la liste des clients ayant un whiteboard ouvert */ _DMSsend this CgetListCli [ ] ;; fun DelCli() = /* permet de s'enlever de la liste des clients */ _DMSsend this CClientDeleted [ ] ;; fun AddCli() = /* permet de s'ajouter à la liste des clients */ _DMSsend this CClientAdd [ ] ;; fun WhiteBServer() = /* permet de récupérer l'image du whiteboard serveur en ouvrant un whiteboard */ _DMSsend this CgetPicture [ ] ;; fun UndoBufferServer() = /* permet de récupérer l'image Undo du serveur */ _DMSsend this CgetUndoPicture [ ] ;; /*****************************************************************************/ /* CallBack of the CompCheck (bottom of the interface) */ /*****************************************************************************/ /******************************************************************************* Callback on Unclick to get a color pixel of the ColorInterface obj -> ObjContainer : param -> : posx -> I : Xpos of cursor posy -> I : Ypos of cursor btn -> I : State of button mask -> I : Mask <- ObjContainer : *******************************************************************************/ fun ChangeColor(obj, param, posx, posy, btn, mask) = if posx>=ColorX && posx<(ColorX+ColorL) && posy>=ColorY && posy<(ColorY+ColorH) then ( if (VAR_GEO_Texte) > 0 then ( IniTxt; set VAR_GEO_Texte = 2; let _GETstringSize TextFont TextString -> [Tx Ty] in set geo.OriginX=geo.OriginX+Tx; set TextString=""; set trt.col=_GETpixel16 ColorBitmap posx-ColorX posy-ColorY; _SETfocus control.ctr_win; _CPbitmap16 Geobuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; /* on copie tout dans Buf tempo avant d'ecrire */ _DRAWtext control.ctr_bitmap TextFont geo.OriginX geo.OriginY TD_LEFT|TD_BASELINE trt.col "_"; refresh; 0 ) else ( set trt.col=_GETpixel16 ColorBitmap posx-ColorX posy-ColorY; _PAINTcontainer drawtools; _PAINTcontainer selection; 0 ); ) else nil ;; fun RepaintSelection (cont, param, rect) = _FILLbitmap (_GETcontainerMap selection) trt.col ;; /******************************************************************************* Callback of the square button obj -> : a -> not used : x -> I : X pos of click y -> I : Y pos of click btn -> I : Button State mask -> I : Mask <- : *******************************************************************************/ fun rctBtnCB(obj, a, x, y, btn, mask) = SetAllChecks obj; IniTxt; /* send the text to server */ _SETwinCursor control.ctr_win recCurs; set geo.gtype=GEO_Rectangle; set jpegbuf=nil; set trt.brtype=nil; set pick = 1; /*set Flood = 1;*/ set copy = 0 ;; /******************************************************************************* Callback of the circle button obj -> : a -> not used : x -> I : X pos of click y -> I : Y pos of click btn -> I : Button State mask -> I : Mask <- : *******************************************************************************/ fun crlBtnCB(obj, a, x, y, btn, mask) = SetAllChecks obj; IniTxt; _SETwinCursor control.ctr_win crcCurs; set geo.gtype=GEO_Cercle; set jpegbuf=nil; set trt.brtype=nil; set pick = 1; /*set Flood = 1;*/ set copy = 0 ;; /******************************************************************************* Callback of the line button obj -> : a -> not used : x -> I : X pos of click y -> I : Y pos of click btn -> I : Button State mask -> I : Mask <- : *******************************************************************************/ fun linBtnCB(obj, a, x, y, btn, mask) = SetAllChecks obj; IniTxt; _SETwinCursor control.ctr_win linCurs; set geo.gtype=GEO_Ligne; set jpegbuf=nil; set trt.brtype=nil; set pick = 1; /*set Flood = 1;*/ set copy = 0 ;; /******************************************************************************* Callback of the eraser button obj -> : a -> not used : x -> I : X pos of click y -> I : Y pos of click btn -> I : Button State mask -> I : Mask <- : *******************************************************************************/ fun gomBtnCB(obj, a, x, y, btn, mask) = SetAllChecks obj; IniTxt; _SETwinCursor control.ctr_win gomCurs; set geo.gtype=0; set jpegbuf=nil; set trt.brtype=Gomme; set pick = 1; /*set Flood = 1;*/ set copy = 0 ;; /******************************************************************************* Callback of the pen button obj -> : a -> not used : x -> I : X pos of click y -> I : Y pos of click btn -> I : Button State mask -> I : Mask <- : *******************************************************************************/ fun drwBtnCB(obj, a, x, y, btn, mask) = SetAllChecks obj; IniTxt; _SETwinCursor control.ctr_win penCurs; set geo.gtype=0; set jpegbuf=nil; set trt.brtype=nil; set pick = 1; /*set Flood = 1;*/ set copy = 0 ;; /******************************************************************************* Callback of the text button obj -> : a -> not used : x -> I : X pos of click y -> I : Y pos of click btn -> I : Button State mask -> I : Mask <- : *******************************************************************************/ fun txtBtnCB(obj, a, x, y, btn, mask) = SetAllChecks obj; IniTxt; _SETwinCursor control.ctr_win txtCurs; set geo.gtype=0; set jpegbuf=nil; set VAR_GEO_Texte=1; set trt.brtype=nil; set pick = 1; /*set Flood = 1;*/ set copy = 0 ;; /******************************************************************************* Jauge ( check or uncheck buttons ) l -> [[CompCheck I] r1] : id -> I : Id of the lenght/Text button (0 to 4) <- : *******************************************************************************/ fun mjauge(l, id) = if l==nil then 0 else ( let l->[[cc ccid] t] in ( if ccid<=id then _SETcompCheckState cc CHK_CHECKED else _SETcompCheckState cc CHK_UNCHECKED; mjauge t id; ); nil ) ;; /******************************************************************************* Callback of the lenght of drawing obj -> : id -> I : Id of the lenght button (0 to 4) x -> I : X pos of click y -> I : Y pos of click btn -> I : Button State mask -> I : Mask <- : *******************************************************************************/ fun largeurtraitCB(obj, id, x, y, btn, mask) = set trt.wid=3*id+1; if ((_GETcompCheckState Eraser)==CHK_CHECKED || (_GETcompCheckState TexteCheck)==CHK_CHECKED) then ( drwBtnCB TraitCheck nil nil nil nil nil ) else nil; mjauge ListeLargeurTrait id; _PAINTcontainer drawtools; 0 ;; /******************************************************************************* Callback of the length of the font obj -> : id -> : Id of the lenght button (0 to 4) x -> I : X pos of click y -> I : Y pos of click btn -> I : Button State mask -> I : Mask <- : *******************************************************************************/ fun tailletexteCB(obj, id, x, y, btn, mask) = mjauge ListeTailleTexte id; _PAINTcontainer drawtools; if (VAR_GEO_Texte) > 0 then ( IniTxt; let _GETstringSize TextFont TextString -> [Tx Ty] in set geo.OriginX=geo.OriginX+Tx; set geo.size=10*id+15; set VAR_GEO_Texte = 2; set TextString=""; set TextFont=_CRfont _channel geo.size TextDirection 0 (_loc this "FONT" nil); _CPbitmap16 Geobuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; /* on copie tout dans Buf tempo avant d'ecrire */ _DRAWtext control.ctr_bitmap TextFont geo.OriginX geo.OriginY TD_LEFT|TD_BASELINE trt.col "_"; refresh; ) else set geo.size=10*id+15; _SETfocus control.ctr_win ;; /******************************************************************************* Get the extension of the picture fi -> S : extension of the picture <- : *******************************************************************************/ fun U_extension(fi)= let 0 ->j in let 0 ->find in ( while ((set find=strfind "." fi j)!=nil) do ( set j=find+1 ); substr fi j (strlen fi)-j ) ;; /******************************************************************************* Choose different type of picture (png jpg bmp tga ) in the interface (used in Insert Callback) fP -> File : file selected to open <- : *******************************************************************************/ fun U_openBitmap(fP)= let _GetFileNameFromP fP->stringF in /* permet de recuperer le nom de l'image sans le path */ let nil->Bitmap in let 0->BitmapL in let 0->BitmapH in if (fP != nil) then ( if (!strcmpi (U_extension stringF) "png") then ( let _LDalphaBitmap _channel fP->alphabmp in let _GETalphaBitmapSize alphabmp->[l h] in let _GETalphaBitmaps alphabmp -> [bmp _] in /* pas ds la doc */ ( set Bitmap=bmp; set BitmapL=l; set BitmapH=h; ); 0 ) else ( if (!strcmpi (U_extension stringF) "jpg") then ( let _LDjpeg _channel fP->bmp in let _GETbitmapSize bmp -> [l h] in ( set Bitmap=bmp; set BitmapL=l; set BitmapH=h; ); 0 ) else ( if (!strcmpi (U_extension stringF) "bmp") then ( let _LDbitmap _channel fP->bmp in let _GETbitmapSize bmp -> [l h] in ( set Bitmap=bmp; set BitmapL=l; set BitmapH=h; ); 0 ) else ( if (!strcmpi (U_extension stringF) "tga") then ( let _LDtga _channel fP->bmp in let _GETbitmapSize bmp -> [l h] in ( set Bitmap=bmp; set BitmapL=l; set BitmapH=h; ); 0 ) else nil ) ) ); if Bitmap!=nil then [Bitmap BitmapL BitmapH] else nil ) else nil ;; /******************************************************************************* Open an interface to choose a new picture (used in Insert Callback) open -> OpenBox : window param -> nil : nil fichier -> File : file selected to open <- : *******************************************************************************/ fun openFichierImage(open, param, fichier) = if (fichier != nil) then ( let U_openBitmap fichier->[bm l h] in /* bm = ma bitmap */ if bm!=nil then ( IniTxt; _SETwinCursor control.ctr_win jpgCurs; set geo.gtype=0; set trt.brtype=nil; if (l>TransfertImageMaxL || h>TransfertImageMaxH) then ( let min l TransfertImageMaxL->nl in let min h TransfertImageMaxH->nh in let (itof l)/.(itof nl)->rl in let (itof h)/.(itof nh)->rh in ( if (rl>.rh) then /* permet d'obtenir une image avec des dimensions qui rentre ds la fenetre */ ( set nh=(ftoi ((itof h)/.rl)); ) else ( set nl=(ftoi ((itof l)/.rh)); ); set jpegbuf=_CRbitmap _channel nl nh; _SCPbitmap jpegbuf 0 0 nl nh bm 0 0 l h nil; set jpegbufsizew=nl; set jpegbufsizeh=nh; ); 0 ) else ( set jpegbuf = bm; set jpegbufsizew=l; set jpegbufsizeh=h; 0 ); ) else nil ) else nil; 0 ;; /******************************************************************************* Callback to Insert new Picture obj -> : a -> : x -> I : X pos y -> I : Y pos btn -> I : Button State mask -> I : Mask <- : *******************************************************************************/ fun jpgBtnCB(obj, a, x, y, btn, mask) = if (jpegbuf==nil) then ( let _DLGOpenFile _channel control.ctr_win "c:" nil "PNG(*.PNG)\0*.png\0JPG(*.JPG)\0*.jpg\0BMP(*.BMP)\0*.bmp\0 TGA(*.TGA)\0*.tga\0\0" -> open in _DLGrflopen open @openFichierImage nil; 0 ) else nil ;; /******************************************************************************* Response of box Yes or No to Erase the WhiteBoard > send message to server a -> MessageBox : b -> : param r -> I : 1 if Ok 0 if Annuler <- : *******************************************************************************/ fun YesNoCln(a, b, r) = if (r==0) then nil else ( _FILLbitmap control.ctr_bitmap Blanc; refresh; set modif = 1; _DMSsend this CEffacerCanvas[] ) ;; /******************************************************************************* Callback to erase all the whiteboard obj -> : a -> : not used x -> I : not used y -> I : not used btn -> I : not used mask -> I : not used <- : *******************************************************************************/ fun clnBtnCB(obj, a, x, y, btn, mask) = IniTxt; set jpegbuf=nil; _DLGrflmessage (_DLGMessageBox _channel nil (_loc this "ATTENTION" nil) (_loc this "EFFACER_Q" nil) 2) @YesNoCln 0 ;; /******************************************************************************* Callback to Undo last action obj -> : a -> : not used x -> I : not used y -> I : not used btn -> I : not used mask -> I : not used <- : *******************************************************************************/ fun UndoBtnCB(obj, a, x, y, btn, mask) = SetAllChecks obj; IniTxt; _SETwinCursor control.ctr_win penCurs; _CPbitmap16 control.ctr_bitmap 0 0 UndoBuf 0 0 control.ctr_l control.ctr_h nil; _BLTbitmap control.ctr_win UndoBuf control.ctr_x control.ctr_y; _DMSsend this CUndo []; /* permet d'effectuer un Undo */ set modif = 1; /* Apres Undo > on remet le crayon*/ set geo.gtype=0; set jpegbuf=nil; set trt.brtype=nil; set pick = 1; /*set Flood = 1;*/ set copy = 0; _SETcompCheckState obj CHK_UNCHECKED; _SETcompCheckState (nth_list ListeCheck 2) CHK_CHECKED; /*mettre le crayon 2eme ds la liste */ _PAINTcontainer drawtools; 0 ;; /******************************************************************************* Callback to Pick Color obj -> : a -> : not used x -> I : not used y -> I : not used btn -> I : not used mask -> I : not used <- : *******************************************************************************/ fun PickBtnCB(obj, a, x, y, btn, mask) = _PAINTcontainer selection; SetAllChecks obj; IniTxt; _SETwinCursor control.ctr_win penCurs; set pick = 0; /* activation du picking */ /*set Flood = 1;*/ /* desactivation du fill color */ /* set copy = 1; */ 0 ;; /******************************************************************************* Callback to Fill Color obj -> : a -> : not used x -> I : not used y -> I : not used btn -> I : not used mask -> I : not used <- : *******************************************************************************/ /*fun FillBtnCB(obj, a, x, y, btn, mask) = SetAllChecks obj; IniTxt; _SETwinCursor control.ctr_win penCurs; set Flood = 0; set FloodEnable = 1; 0 ;;*/ /******************************************************************************* Callback to Cut and Paste obj -> : a -> : not used x -> I : not used y -> I : not used btn -> I : not used mask -> I : not used <- : *******************************************************************************/ fun PasteBtnCB(obj, a, x, y, btn, mask) = SetAllChecks obj; IniTxt; _SETwinCursor control.ctr_win penCurs; set copy = 1; _SETwinCursor control.ctr_win recCurs; set geo.gtype=GEO_Rectangle; set jpegbuf=nil; set trt.brtype=nil; set pick = 1; /*set Flood = 1;*/ set trt.lastwid = trt.wid; set trt.wid = 2; set trt.lastcolor = trt.col; set trt.col = Noir; 0 ;; /******************************************************************************* Save jpeg picture (used in callback after ) open -> OpenBox : window param -> nil : nil fichier -> File : file to save <- : *******************************************************************************/ fun savejpeg(open, param, fichier)= if (fichier != nil) then ( _SAVEjpeg control.ctr_bitmap fichier 95; 0 ) else nil ;; /******************************************************************************* Callback to save new Picture obj -> : a -> : x -> I : not used y -> I : not used btn -> I : not used mask -> I : not used <- : *******************************************************************************/ fun savBtnCB(obj, a, x, y, btn, mask) = let _DLGSaveFile _channel control.ctr_win "c:" "photo.jpg" "JPG(*.JPG)\0*.jpg\0\0" -> save in _DLGrflsave save @savejpeg nil ;; /****************************************************************************************/ /* Callback of Brushlist on the right part of the interface */ /****************************************************************************************/ /******************************************************************************* Callback corresponding to a user selection in list box (right interface) obj -> CompList : a -> not used : not used v -> I : Item position in the list <- : *******************************************************************************/ fun brushLstCB(obj, a, v) = set brush = 1; drwBtnCB TraitCheck nil nil nil nil nil; IniTxt; _SETwinCursor control.ctr_win jpgCurs; set jpegbuf=nil; set trt.brtype=v; let nth_list brosListe v-> abmp in /* permet de recuperer l'element choisi dans la brosListe et sa bitmap */ set trt.bros=abmp ;; /******************************************************************************* Buttons Creation *******************************************************************************/ /******************************************************************************* Create Button with a disabled state fichierS -> S : name of the png file CB -> : callback tiptext -> S : text when mouse enter area of button x -> I : x localisation of the button y -> I : y localisation of the button v -> : <- CompCheck *******************************************************************************/ fun CreateCheck(fichierS, CB, tiptext, x, y, v) = let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"interface/"::fichierS::nil)) -> bc in let _CRcompCheck _channel drawtools nil [x y] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE OBJ_CONTAINER_CLICK bc -> c in ( _CBcompCheckUnClick c CB v; _CRtoolTipDefault (_CONVERTcompCheckToObjNode c) 1000 tiptext nil tipFont nil; /* tooltip to show when mouse cursor enters */ c ) ;; /******************************************************************************* Create a Button with a mask state fichierS -> S : name of the png file CB -> : callback tiptext -> S : text when mouse enter area of button x -> I : x localisation of the button y -> I : y localisation of the button v -> <- CompCheck *******************************************************************************/ fun CreateCheck2(fichierS, CB, tiptext, x, y, v) = let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"interface/"::fichierS::nil))-> bc in let _CRcompCheck _channel drawtools nil [x y] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK OBJ_CONTAINER_CLICK bc->c in ( _CBcompCheckUnClick c CB v; _CRtoolTipDefault (_CONVERTcompCheckToObjNode c) 1000 tiptext nil tipFont nil; c ) ;; /******************************************************************************* Create a RollOverButton fichierS -> S : name of the png file CB -> : callback tiptext -> S : text when mouse enter area of button x -> I : x localisation of the button y -> I : y localisation of the button <- CompCheck *******************************************************************************/ fun CreateRollOver(fichierS, CB, tiptext, x, y)= let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"interface/"::fichierS::nil)) -> bc in let _CRcompRollOver _channel drawtools nil [x y] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE OBJ_CONTAINER_CLICK bc -> c in ( _CBcompRollOverClick c CB nil; _CRtoolTipDefault (_CONVERTcompRollOverToObjNode c) 1000 tiptext nil tipFont nil; c ) ;; /****************************************************************************************/ /* Messages Received from the server */ /****************************************************************************************/ /******************************************************************************* Fill Color from Server posx -> I : posx posy -> I : posy color -> I : color <- *******************************************************************************/ /*fun __FillColorCli(posx, posy, color) = _CPbitmap16 UndoBuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; (Undo ) FloodFill4 posx posy (_GETpixel16 control.ctr_bitmap posx posy) color; refresh; showImage; 0 ;;*/ /******************************************************************************* Cut Zone posx -> I : posx posy -> I : posy Wcopy -> I : W Hcopy -> I : H <- *******************************************************************************/ fun __CutCli(posx, posy, Wcopy, Hcopy) = _CPbitmap16 CopyBuf 0 0 control.ctr_bitmap posx posy Wcopy Hcopy nil; refresh; 0 ;; /******************************************************************************* Paste Zone posx -> I : posx posy -> I : posy Wcopy -> I : W Hcopy -> I : H <- *******************************************************************************/ fun __PasteCli(posx, posy, Wcopy, Hcopy) = _CPbitmap16 UndoBuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; /* Undo */ _CPbitmap16 control.ctr_bitmap posx posy CopyBuf 0 0 Wcopy Hcopy nil; refresh; set modif = 1; 0 ;; /******************************************************************************* Copy current buffer in UndoBuffer *******************************************************************************/ fun __UndoCopyCli() = _CPbitmap16 UndoBuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; /* Undo */ set modif = 1; 0 ;; /******************************************************************************* Copy UndoBuffer in current buffer *******************************************************************************/ fun __UndoCli() = _CPbitmap16 control.ctr_bitmap 0 0 UndoBuf 0 0 control.ctr_l control.ctr_h nil; _BLTbitmap control.ctr_win UndoBuf control.ctr_x control.ctr_y; set modif = 1 ;; /******************************************************************************* Tracing Lines l -> : list of modification buf -> ObjBitmap : Bitmap to draw x2 -> I : X2 pos y2 -> I : Y2 pos brt -> I : numero du brush utiliser (1->5) wd -> I : Width of the border cl -> I : color <- *******************************************************************************/ fun Trace(l, buf, x2, y2, brt, wd, cl) = if l==nil then nil else let l->[h t] in ( if (brt==nil) then ( _DRAWline buf atoi nth_list h 0 atoi nth_list h 1 x2 y2 DRAW_SOLID wd cl; 0 ) else ( let nth_list brosListe brt->abmp in let _GETalphaBitmapSize abmp->[l h ] in let (max 0 y2-(h/2))->ybros in let _GETalphaBitmaps abmp->[b _] in ( _FILLbitmap b cl; _CPalphaBitmap buf x2-l/2 ybros abmp 0 0 l h; _FILLbitmap b 0; ); 0 ); Trace t buf atoi nth_list h 0 atoi nth_list h 1 brt wd cl ); 0 ;; /******************************************************************************* Set Lines from Server l -> S : list of modification brt -> I : numero du brush utiliser (1->5) wd -> I : Width of the border cl -> I : color <- *******************************************************************************/ fun __getLines(l, brt, wd, cl) = let (strextr l)->[h t] in ( Trace t control.ctr_bitmap atoi nth_list h 0 atoi nth_list h 1 brt wd cl; if ((VAR_GEO_Texte==2)||(clic!=0 && jpegbuf==nil && tamponTrace==nil && VAR_GEO_Texte==0)) then Trace t Geobuf atoi nth_list h 0 atoi nth_list h 1 brt wd cl else nil; refresh; set modif = 1; ) ;; /******************************************************************************* Set Circle from Server x -> I : X Center y -> I : Y center r -> I : Rayon wid -> I : Width of the border col -> I : Color <- *******************************************************************************/ fun __getCircle(x, y, r, wid, col) = _DRAWcircle control.ctr_bitmap x y r DRAW_SOLID wid col DRAW_INVISIBLE nil; if ((VAR_GEO_Texte==2)||(clic!=0 && jpegbuf==nil && tamponTrace==nil && VAR_GEO_Texte==0)) then _DRAWcircle Geobuf x y r DRAW_SOLID wid col DRAW_INVISIBLE nil else nil; refresh; set modif = 1; 0 ;; /******************************************************************************* Set square from Server x1 -> I : X up left y1 -> I : Y up left x2 -> I : X down right y2 -> I : Y down right wid -> I : Width of border col -> I : Color <- *******************************************************************************/ fun __getRect(x1, y1, x2, y2, wid, col) = _DRAWrectangle control.ctr_bitmap x1 y1 x2-x1 y2-y1 DRAW_SOLID wid col DRAW_INVISIBLE nil; if ((VAR_GEO_Texte==2)||(clic!=0 && jpegbuf==nil && tamponTrace==nil && VAR_GEO_Texte==0)) then _DRAWrectangle Geobuf x1 y1 x2-x1 y2-y1 DRAW_SOLID wid col DRAW_INVISIBLE nil else nil; refresh; set modif = 1; 0 ;; /******************************************************************************* Set Line from Server x1 -> I : Xinit y1 -> I : Yinit x2 -> I : Xfinal y2 -> I : Yfinal wid -> I : width col -> I : color <- *******************************************************************************/ fun __getLigne(x1, y1, x2, y2, wid, col) = _DRAWline control.ctr_bitmap x1 y1 x2 y2 DRAW_SOLID wid col; if ((VAR_GEO_Texte==2)||(clic!=0 && jpegbuf==nil && tamponTrace==nil && VAR_GEO_Texte==0)) then _DRAWline Geobuf x1 y1 x2 y2 DRAW_SOLID wid col else nil; refresh; set modif = 1; 0 ;; /******************************************************************************* Set WhiteBoard to Blanc (clear everything) <- *******************************************************************************/ fun __cleanCanvasC()= _FILLbitmap control.ctr_bitmap Blanc; refresh; set modif = 1 ;; /******************************************************************************* Set Text from Server txtStr -> S : Text to draw TxtPosX -> I : X pos TxtPosY -> I : Y pos col -> I : Flag TxtSize -> I : Font size <- *******************************************************************************/ fun __setText(txtStr, TxtPosX, TxtPosY, col, TxtSize) = let _CRfont _channel TxtSize 0 0 (_loc this "FONT" nil) -> TxtFont in ( _CPbitmap16 UndoBuf 0 0 control.ctr_bitmap 0 0 control.ctr_l control.ctr_h nil; /* Pour le Undo */ _DRAWtext control.ctr_bitmap TxtFont TxtPosX TxtPosY TD_LEFT|TD_BASELINE col txtStr; if ((VAR_GEO_Texte==2)||(clic!=0 && jpegbuf==nil && tamponTrace==nil && VAR_GEO_Texte==0)) then _DRAWtext Geobuf TxtFont TxtPosX TxtPosY TD_LEFT|TD_BASELINE col txtStr else nil; refresh; set modif = 1; _DSfont TxtFont; ) ;; /******************************************************************************* Update ListName of the client *******************************************************************************/ fun rafraichiliste(l) = if (l==nil) then nil else let l->[h t] in ( _ADDcompList ClientInfoList 0 [h nil]; rafraichiliste t; 0 ) ;; /******************************************************************************* Get ListName of the user liste -> S : <- *******************************************************************************/ fun __getListeName(liste) = _RSTcompList ClientInfoList; let strextr liste -> l in let l -> [h _] in rafraichiliste h; _PAINTcontainer clientcont ;; /******************************************************************************* Allow to have Xpos and Ypos (upper left corner ) to put the picture on screen l -> [[S I I] r1] : list of [name x y ] of picture DL fichier -> S : <- *******************************************************************************/ fun JPEG_getpos(l, fichier) = if l==nil then /* cas ou un nouveau client arrive et on lui donne l'image complète en x=0 y=0 */ [0 0] else ( let l->[h t] in let h->[name x y]in ( if !strcmp name fichier then ( [x y] /* cas ou on affiche une image qu'un client à mis sur son whiteboard */ ) else ( JPEG_getpos t fichier ); ) ) ;; /******************************************************************************* l -> [[S I I] r1] : fichier -> S : <- *******************************************************************************/ fun JPEG_rempos(l, fichier) = if l==nil then nil else ( let l->[h t] in let h->[name _ _]in ( if !strcmp name fichier then t else h::JPEG_rempos t fichier ) ) ;; /******************************************************************************* Callback when download is finished Fichier -> S : <- *******************************************************************************/ fun JPEG_FinDownload(Fichier) = let _LDjpeg _channel (_checkpack Fichier)->bitmap in let _GETbitmapSize bitmap -> [l h] in let JPEG_getpos JPEG_posl Fichier->[x y] in _CPbitmap16 control.ctr_bitmap x y bitmap 0 0 l h nil; set JPEG_posl=JPEG_rempos JPEG_posl Fichier; refresh; set modif = 1; 0 ;; /******************************************************************************* Callback when download is finished Fichier -> S : <- *******************************************************************************/ fun JPEG_FinDownload1(Fichier) = let _LDjpeg _channel (_checkpack Fichier)->bitmap in let _GETbitmapSize bitmap -> [l h] in let JPEG_getpos JPEG_posl Fichier->[x y] in _CPbitmap16 UndoBuf x y bitmap 0 0 l h nil; set modif = 1; 0 ;; /******************************************************************************* Download Undo Picture from the server name -> S : name of the picture x -> I : posX y -> I : posY <- *******************************************************************************/ fun __JPEG_new(name1,name, x, y) = if !strcmp name1 "UndoSERVER.jpg" then ( _RSCdownload this name name @JPEG_FinDownload1 1; ) else ( set JPEG_posl=[name x y]::JPEG_posl; _RSCdownload this name name @JPEG_FinDownload 1; ); 0 ;; /******************************************************************************* Delete All Check of the List used in (ListeCheck) C -> CompCheck : param -> S <- *******************************************************************************/ fun DelAllChecks(C, param) = _DScompCheck C ;; /******************************************************************************* Delete All Check of the List used in (ListeLargeurTrait & ListeTailleTexte) C -> [CompCheck _] : param -> S <- *******************************************************************************/ fun DelAllChecks2(C, param) = let C->[h _] in _DScompCheck h ;; /******************************************************************************* Delete All AlphaBitmap of the List used in (brosListe) C -> CompCheck : param -> S <- *******************************************************************************/ fun DelAllAlphaBitmap (C, param) = _DSalphaBitmap C ;; /******************************************************************************* Delete All Bitmap of the List used in (cursorListe) C -> CompCheck : param -> S <- *******************************************************************************/ fun DelAllCursorBitmap (C, param) = _DSbitmap C ;; /******************************************************************************* Hide interface from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : not used others -> [User r1] : not used tag -> Tag : not used <- I : nothing special *******************************************************************************/ fun cbHide (from, action, param, others, tag) = _DSwindow MainWin; _DMSreleaseZone this "Canvas"; _DMSreleaseZone this "DrawTools"; apply_on_list ListeCheck @DelAllChecks nil; apply_on_list ListeLargeurTrait @DelAllChecks2 nil; apply_on_list ListeTailleTexte @DelAllChecks2 nil; apply_on_list brosListe @DelAllAlphaBitmap nil; apply_on_list cursorListe @DelAllCursorBitmap nil; apply_on_list tmpalphaListe @DelAllAlphaBitmap nil; _DScompList ClientInfoList; _DScompList brushLst; _DSbitmap jpegbuf; /* différents buffer */ _DSbitmap Geobuf; _DSbitmap UndoBuf; _DSbitmap CopyBuf; _DSbitmap SelectionColor; _DSbitmap ColorBitmap; _DScontainer brushtools; /* droite */ _DScontainer drawtools; /* bas */ _DScontainer selection; /* bas */ _DScontainer clientcont; /* gauche */ _DSfont TextFont; /* Font */ _DSfont tipFont; set trt=nil; set geo=nil; set control.ctr_win = nil; set MainWin = nil; /* _DMSsend this CgetNbCli [ ]; *//* on recup le nb de cli connectés (si y'a plus qu'1 client on part effacer WhiteBoard Server) */ DelCli; /* permet de s'enlever de la liste des clients qui on ouvert un whiteboard */ 0 ;; /******************************************************************************* Callback on destroy Window win -> ObjWin : Window to destroy a -> nil : not used <- *******************************************************************************/ fun WinDestroy(win, a) = cbHide nil nil nil nil nil ;; /******************************************************************************* Show interface from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : not used others -> [User r1] : not used tag -> Tag : not used <- I : nothing special *******************************************************************************/ fun cbShow (from, action, param, others, tag) = if MainWin!=nil then nil else ( /* creation of the different type of brush */ set brosListe = ( (_LDalphaBitmap _channel _checkpack strcat modulePath "brush/01.png")):: ( (_LDalphaBitmap _channel _checkpack strcat modulePath "brush/02.png") ):: ( (_LDalphaBitmap _channel _checkpack strcat modulePath "brush/03.png") ):: ( (_LDalphaBitmap _channel _checkpack strcat modulePath "brush/04.png") ):: ( (_LDalphaBitmap _channel _checkpack strcat modulePath "brush/05.png") ):: ( (_LDalphaBitmap _channel _checkpack strcat modulePath "brush/06.png") )::nil; set cursorListe = ( (_LDbitmap _channel _checkpack strcat modulePath "cursors/pen.bmp")):: ( (_LDbitmap _channel _checkpack strcat modulePath "cursors/gomme.bmp") ):: ( (_LDbitmap _channel _checkpack strcat modulePath "cursors/line.bmp") ):: ( (_LDbitmap _channel _checkpack strcat modulePath "cursors/rect.bmp") ):: ( (_LDbitmap _channel _checkpack strcat modulePath "cursors/circle.bmp") ):: ( (_LDbitmap _channel _checkpack strcat modulePath "cursors/main.bmp") ):: ( (_LDbitmap _channel _checkpack strcat modulePath "cursors/text.bmp") )::nil; set tmpalphaListe = ( ( _LDalphaBitmap _channel _checkpack strcat modulePath "interface/bottom.png")):: ( (_LDalphaBitmap _channel _checkpack strcat modulePath "interface/boardright.png") ):: ( (_LDalphaBitmap _channel _checkpack strcat modulePath "interface/vlift1.png") )::nil; set tipFont=(_CRfont _channel 12 0 0 (_loc this "FONT" nil)); set Gomme=235; set TextFont=nil; set Noir=0; set Rouge=(255); set Vert=(255<<8); set Bleu=(255<<16); set Blanc=((255<<16)|(255<<8)|(255)); set Transparent=Bleu; set xormode=0; /*creation des curseurs*/ set penCurs=_CRcursor _channel (_LDbitmap _channel _checkpack strcat modulePath "cursors/pen.bmp") 13 20 0x000000 0xff0000; set gomCurs=_CRcursor _channel (_LDbitmap _channel _checkpack strcat modulePath "cursors/gomme.bmp") 9 18 0x000000 0xff0000; set linCurs=_CRcursor _channel (_LDbitmap _channel _checkpack strcat modulePath "cursors/line.bmp") 9 20 0x000000 0xff0000; set recCurs=_CRcursor _channel (_LDbitmap _channel _checkpack strcat modulePath "cursors/rect.bmp") 9 20 0x000000 0xff0000; set crcCurs=_CRcursor _channel (_LDbitmap _channel _checkpack strcat modulePath "cursors/circle.bmp") 9 20 0x000000 0xff0000; set jpgCurs=_CRcursor _channel (_LDbitmap _channel _checkpack strcat modulePath "cursors/main.bmp") 13 20 0x000000 0xff0000; set txtCurs=_CRcursor _channel (_LDbitmap _channel _checkpack strcat modulePath "cursors/text.bmp") 14 28 0x000000 0xff0000; set trt=mkTrait [nil nil 1 0 0 0]; set geo=mkGeom [0 30 0 0 0]; set MainWin=_CRwindow _channel nil 0 0 680 420 WN_MENU "Whiteboard"; _CBwinDestroy MainWin @WinDestroy nil; _SETwinCursor MainWin penCurs; /* Creation of the bottom part of the interface */ let MainWin -> win in let 0 -> x in let 300 -> y in let 680 -> l in let 120 -> h in ( if win==nil then nil else ( /* Creation of the container */ set drawtools=_CRcontainerFromObjWin _channel win x y l h CO_NOBORDER|CO_CHILDINSIDE Blanc "Draw"; set selection=_CRcontainerFromObjWin _channel win x+SelectX y+SelectY SelectL SelectH CO_NOBORDER|CO_CHILDINSIDE Blanc "Selection"; /* creation de la palette de couleur */ let _LDalphaBitmap _channel _checkpack strcat modulePath "interface/bottom.png" ->alphabmp in let _GETalphaBitmaps alphabmp->[bmp _] in let _GETalphaBitmapSize alphabmp->[l h] in ( set ColorBitmap=_CRbitmap _channel ColorL ColorH; _CPbitmap16 ColorBitmap 0 0 bmp ColorX ColorY ColorL ColorH nil; set trt.col=_GETpixel16 ColorBitmap ColorL/2 ColorH/2; set SelectionColor =_CRbitmap _channel SelectL SelectH; _CPbitmap16 SelectionColor 0 0 bmp SelectX SelectY SelectL SelectH nil; _CRcompBitmap _channel drawtools nil [0 0] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_UNCLICK alphabmp 0 0 l h; _CRcompBitmap _channel selection nil [0 0] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_UNCLICK alphabmp 145 70 SelectL SelectH ); /* creation of the different buttons (square,circle,line,eraser,trait,text) */ set ListeCheck=nil; set ListeCheck=(CreateCheck "ccreatecarre.png" @rctBtnCB (_loc this "RECTANGLE" nil) 100+50 20 nil)::ListeCheck; set ListeCheck=(CreateCheck "ccreaterond.png" @crlBtnCB (_loc this "CERCLE" nil) 100+50*2 20 nil)::ListeCheck; set ListeCheck=(CreateCheck "ccreateligne.png" @linBtnCB (_loc this "LIGNE" nil) 100+50*3 20 nil)::ListeCheck; /*set ListeCheck=(CreateCheck "cfilling.png" @FillBtnCB (_loc this "FILL" nil) 140+50*3 20 nil)::ListeCheck;*/ set ListeCheck=(CreateCheck "cpicking.png" @PickBtnCB (_loc this "PICKING" nil) 294 20 nil)::ListeCheck; set ListeCheck=(CreateCheck "ceraser.png" @gomBtnCB (_loc this "GOMME" nil) 294+50*1 20 nil)::ListeCheck; set ListeCheck=(CreateCheck "cundo.png" @UndoBtnCB (_loc this "UNDO" nil) 294+50*2 20 nil)::ListeCheck; set ListeCheck=(CreateCheck "ccreatetrait.png" @drwBtnCB (_loc this "CRAYON" nil) 150 65 nil)::ListeCheck; set ListeCheck=(CreateCheck "cpaste.png" @PasteBtnCB (_loc this "PASTE" nil) 294 65 nil)::ListeCheck; set ListeCheck=(CreateCheck "ctext.png" @txtBtnCB (_loc this "TEXTE" nil) 344 65 nil)::ListeCheck; /* creation of the button for the length of the drawing */ set ListeLargeurTrait=nil; set ListeLargeurTrait=[(CreateCheck2 "dimension.png" @largeurtraitCB (_loc this "LARGEURTRAIT" nil) 194+80 65 4) 4]::ListeLargeurTrait; set ListeLargeurTrait=[(CreateCheck2 "dimension.png" @largeurtraitCB (_loc this "LARGEURTRAIT" nil) 194+60 65 3) 3]::ListeLargeurTrait; set ListeLargeurTrait=[(CreateCheck2 "dimension.png" @largeurtraitCB (_loc this "LARGEURTRAIT" nil) 194+40 65 2) 2]::ListeLargeurTrait; set ListeLargeurTrait=[(CreateCheck2 "dimension.png" @largeurtraitCB (_loc this "LARGEURTRAIT" nil) 194+20 65 1) 1]::ListeLargeurTrait; set ListeLargeurTrait=[(CreateCheck2 "dimension.png" @largeurtraitCB (_loc this "LARGEURTRAIT" nil) 194 65 0) 0]::ListeLargeurTrait; /* creation of the button for the length of the font */ set ListeTailleTexte=nil; set ListeTailleTexte=[(CreateCheck2 "dimension.png" @tailletexteCB (_loc this "TAILLETEXTE" nil) 398+80 65 4) 4]::ListeTailleTexte; set ListeTailleTexte=[(CreateCheck2 "dimension.png" @tailletexteCB (_loc this "TAILLETEXTE" nil) 398+60 65 3) 3]::ListeTailleTexte; set ListeTailleTexte=[(CreateCheck2 "dimension.png" @tailletexteCB (_loc this "TAILLETEXTE" nil) 398+40 65 2) 2]::ListeTailleTexte; set ListeTailleTexte=[(CreateCheck2 "dimension.png" @tailletexteCB (_loc this "TAILLETEXTE" nil) 398+20 65 1) 1]::ListeTailleTexte; set ListeTailleTexte=[(CreateCheck2 "dimension.png" @tailletexteCB (_loc this "TAILLETEXTE" nil) 398 65 0) 0]::ListeTailleTexte; /* creation of rollover button*/ CreateRollOver "rinsert.png" @jpgBtnCB (_loc this "CHARGER" nil) 444 20; CreateRollOver "rsave.png" @savBtnCB (_loc this "SAUVER" nil) 494 20; CreateRollOver "rtrashcan.png" @clnBtnCB (_loc this "EFFACER" nil) 494 65; set trt.wid=1; set geo.size=15; mjauge ListeLargeurTrait 0; mjauge ListeTailleTexte 0; SetAllChecks TraitCheck; _CBcontainerUnClick drawtools @ChangeColor nil; _CBcontainerPostRender selection @RepaintSelection nil; _PAINTcontainer drawtools; _PAINTcontainer selection; ) ); /* Creation of the right part of the interface */ let MainWin -> win in let 540 -> x in let 0 -> y in let 140 -> width in let 300 -> h in ( if win==nil then nil else ( /* Creation of the container */ set brushtools = _CRcontainerFromObjWin _channel win x y width h CO_NOBORDER|CO_CHILDINSIDE Blanc "Brush"; let _LDalphaBitmap _channel _checkpack strcat modulePath "interface/boardright.png" ->alphabmp in let _GETalphaBitmapSize alphabmp->[l h] in _CRcompBitmap _channel brushtools nil [0 0] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_CLICK alphabmp 0 0 l h; /* creation of the left upper lift to store brush list */ let _LDalphaBitmap _channel _checkpack strcat modulePath "interface/vlift1.png" -> vlift in set brushLst = _CRcompList _channel brushtools nil [20 5] OBJ_ENABLE|OBJ_VISIBLE|LST_HIGHLIGHT_CLICKED OBJ_CONTAINER_CLICK 100 290 3 LST_VERTICAL (_CRfont _channel 10 0 0 (_loc this "FONT" nil)) 0 [Noir 0 0 0] [Noir 50] [[90 0] SLB_ROLLOVER|SLB_MASK vlift [14 276 290]]; let 0->j in ( while (j<(sizelist brosListe)) do ( _ADDcompList brushLst j ["" (nth_list brosListe j)]; set j=j+1 ); ); _CBcompListClick brushLst @brushLstCB nil; _PAINTcontainer brushtools; 0 ) ); /* Creation of the left part of the interface */ let MainWin -> win in let 0 -> x in let 0 -> y in let 140 -> width in let 300 -> h in ( if win==nil then nil else ( set clientcont = _CRcontainerFromObjWin _channel win x y width h CO_NOBORDER|CO_CHILDINSIDE Blanc "Client"; let _LDalphaBitmap _channel _checkpack strcat modulePath "interface/boardright.png" ->alphabmp in let _GETalphaBitmapSize alphabmp->[l h] in _CRcompBitmap _channel clientcont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_CLICK alphabmp 0 0 l h; /* creation of the left lift to store client list */ let _LDalphaBitmap _channel _checkpack strcat modulePath "interface/vlift1.png" -> vlift in set ClientInfoList =_CRcompList _channel clientcont nil [20 5] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_CLICK 100 290 20 LST_VERTICAL (_CRfont _channel 14 0 0 (_loc this "FONT" nil)) 0 [Noir 0 0 0] [Noir 50] [[90 0] SLB_ROLLOVER|SLB_MASK vlift [14 276 290]]; _PAINTcontainer clientcont; ) ); /* Creation of central part of the interface (here we are drawing !!) */ let MainWin -> win in let 0 -> x in let 0 -> y in let 400 -> width in let 300 -> h in ( if win==nil then nil else ( set control.ctr_win = win; _CBwinKeydown win @EnterTxt nil; _CBwinClick win @ClicDWN nil; _CBwinUnclick win @ClicUP nil; _CBcursorMove win @MouseMV nil; _CBwinPaint win @WinPAINT nil; _DMSsend this CinitSize [width h]; 0 ) ); _DSfont tipFont; AddCli; /* permet de s'ajouter à la liste des clients */ ListCli; /* permet de recuperer la liste des autres clients */ /*set flagUndo = 0;*/ set copy = 0; refresh; 0 ) ;; /***********************************************************************************/ /* Initialisation du DMI */ /***********************************************************************************/ fun IniDMI(param)= _DMSdefineActions this (["show" @cbShow]):: (["hide" @cbHide])::nil; set modulePath = _DMSgetpath _DMSgetClass this; /*creation des buffers d'image*/ let 400 -> width in let 300 -> h in ( set control=mkCtrl[nil (_FILLbitmap (_CRbitmap _channel width h) Blanc) 140 0 width h]; set Geobuf=_FILLbitmap (_CRbitmap _channel width h) Blanc; set UndoBuf=_FILLbitmap (_CRbitmap _channel width h) Blanc; set CopyBuf=_FILLbitmap (_CRbitmap _channel width h) Blanc; ); WhiteBServer; /* permet de récuperer le whiteboard server */ UndoBufferServer; /* permet de récupérer l'image du buffer UndobufS du serveur */ set refreshtimer = _rfltimer _starttimer _channel 1000 @cbshowImage nil; _DMSevent this "in" nil nil ;;