typeof backColor=S;; /*tool tip*/ var beforeToolTipDelay=250;; var hideToolTipDelay=4000;; typeof positions = [[S [[S I] r1]] r1];; /* list of positions : [c3dName [list_of_positions + validite position]] */ proto UpdatePositionValidity = fun [S S I] I;; proto UpdateDefaultPosition = fun [S S] I;; proto TeleportUser = fun [S S I] I;; proto GoHide = fun [I] I;; proto GoShow = fun [I] I;; typeof Node = ObjNode;; typeof Font = ObjFont;; typeof ContGeneral = ObjContainer;; typeof Cont = ObjContainer;; typeof ContPere = ObjContainer;; typeof Path = S;; typeof SlideBmp = ObjBitmap;; typeof SlideBmp8 = ObjBitmap8;; typeof ListBmp = ObjBitmap;; typeof ListBmp8 = ObjBitmap8;; typeof ButtonBmp = ObjBitmap;; typeof ButtonBmp8 = ObjBitmap8;; typeof TeleportAlpha = AlphaBitmap;; typeof BackAlpha = AlphaBitmap;; typeof GoAlpha = AlphaBitmap;; typeof PushAlpha = AlphaBitmap;; typeof ValidPic = AlphaBitmap;; typeof InvalidPic = AlphaBitmap;; typeof UserPic = AlphaBitmap;; typeof Img = AlphaBitmap;; typeof ImgBack = AlphaBitmap;; typeof ImgFwd = AlphaBitmap;; typeof ContToolTip = ObjContainer;; typeof TextToolTip = CompText;; typeof Flag = I;; var OldFlag = 0;; typeof ListCellName = [S r1];; typeof ListPos = CompList;; typeof TeleportButton = CompRollOver;; typeof BackButton = CompRollOver;; typeof GoButton = CompRollOver;; typeof PushButton = CompRollOver;; typeof DefaultButton = CompRollOver;; typeof Label = CompText;; typeof TextVide = CompText;; var Update = 0;; var Cell = "µµµµ";; var Position = "µµµµ";; var Fenetre = 0;; var cellIndex = 0;; var posIndex = 0;; var VALID = 1;; var INVALID = 0;; /* container coresponding to tabBox' item */ struct TContainerTabBox = [ CTB_Container : ObjContainer, /* the container object */ CTB_Visited : I, /* 1 if item already visited else 0. Serve for the OnFirstLoad callBack */ CTB_OnFirstLoad : fun [TTabBox ObjContainer] I /* onFirstLoad callBack */ ] mkContainerTabBox;; /* item of the tabBox */ struct TItemTabBox = [ ITB_Index : I, /* identification of the item !NOT USED WELL! */ ITB_Container : TContainerTabBox, /* container */ ITB_CompCheck : CompCheck, /* CompCheck coresponding to the item */ ITB_Title : S, /* Title inserted in the CompCheck */ ITB_FullTitle : S, /* Full Title */ ITB_MsgToolTip : S, /* message on the ToolTip */ ITB_ToolTip : ObjContainer, /* toolTip container */ ITB_TitleSize : I, /* Width of the CompCheck */ ITB_OnFocus : fun [TTabBox TItemTabBox] I /* onFocus callBack */ ] mkItemTabBox;; /* structure for the tabBox */ struct TTabBox = [ TBOX_Channel : Chn, /* channel */ TBOX_MainContainer : ObjContainer, /* will contain the items menu on top */ TBOX_NodeFather : ObjNode, /* node father !NOT USED!*/ TBOX_MenuHeight : I, /* height of the items menu from the top !NOT USED WELL! */ TBOX_Font : ObjFont, /* font */ TBOX_ImgBtn : AlphaBitmap, /* AlphaBitmap to create Item CompCheck */ TBOX_BtnBack : CompRollOver, /* Back button */ TBOX_BtnForward : CompRollOver, /* Forward button */ TBOX_BackFwdMargin : I, /* width of Button Back and Button Forward */ TBOX_MenuWidth : I, /* MenuWidth = MainContainer's Width - BackFwdMargin */ TBOX_TransColor : I, /* Transparent color */ TBOX_ListItens : [TItemTabBox r1], /* lists of the itens */ TBOX_MaxSizeItemBtn : I, /* width maximum for the itens' buttons */ TBOX_NbItens : I, /* number of itens !NOT USED WELL! = sizelist TBOX_ListItens*/ TBOX_CurrentFirstItem : I, /* first item showed in the TabBox */ TBOX_CurrentItem : I, /* current item focused */ TBOX_ModeToolTip : I /* TBOX_ENABLETOOLTIP / TBOX_DISABLETOOLTIP */ ] mkTabBox;; /* ToolTip Mode constants */ var TBOX_ENABLETOOLTIP = 1;; var TBOX_DISABLETOOLTIP = 0;; typeof TabList = TTabBox;; /* proto */ proto TBOXsetItem = fun [I TTabBox] ObjContainer;; /******************************************************************************* Draw a vertical slide bar w -> I : weight of the slide bar h -> I : height of the slide bar <- AlphaBitmap : the alphabitmap containing the slide bar *******************************************************************************/ fun DessineSlideV (w, h) = /* set the transparency color of the source file */ let make_rgb 0 0 255 -> trans in /* creation of the two destination bitmap */ let _CRbitmap _channel w*3 h+18 -> tempBmp in let _CRbitmap8 _channel w*3 h+18 -> tempBmp8 in ( /* construction of the two final bitmap with the elements of the file */ _SCPbitmap tempBmp 0 0 15 12 SlideBmp 34 16 49 28 nil; _SCPbitmap tempBmp 16 0 31 12 SlideBmp 34 16 49 28 nil; _SCPbitmap tempBmp 32 0 47 12 SlideBmp 51 16 66 28 nil; _SCPbitmap tempBmp 0 13 15 15 SlideBmp 2 16 17 17 nil; _SCPbitmap tempBmp 16 13 31 15 SlideBmp 2 16 17 17 nil; _SCPbitmap tempBmp 32 13 47 15 SlideBmp 2 16 17 17 nil; _SCPbitmap tempBmp 0 16 15 h-18 SlideBmp 2 18 17 23 nil; _SCPbitmap tempBmp 16 16 31 h-18 SlideBmp 2 18 17 23 nil; _SCPbitmap tempBmp 32 16 47 h-18 SlideBmp 2 18 17 23 nil; _SCPbitmap tempBmp 0 h-17 15 h-14 SlideBmp 2 24 17 27 nil; _SCPbitmap tempBmp 16 h-17 31 h-14 SlideBmp 2 24 17 27 nil; _SCPbitmap tempBmp 32 h-17 47 h-14 SlideBmp 2 24 17 27 nil; _SCPbitmap tempBmp 0 h-13 15 h-1 SlideBmp 34 30 49 42 nil; _SCPbitmap tempBmp 16 h-13 31 h-1 SlideBmp 34 30 49 42 nil; _SCPbitmap tempBmp 32 h-13 47 h-1 SlideBmp 51 30 66 42 nil; _SCPbitmap tempBmp 0 h 15 h+17 SlideBmp 18 16 33 33 nil; _SCPbitmap tempBmp 16 h 31 h+17 SlideBmp 18 16 33 33 nil; _SCPbitmap tempBmp 32 h 47 h+17 SlideBmp 18 16 33 33 nil; _SCPbitmap8 tempBmp8 0 0 15 12 SlideBmp8 34 16 49 28 nil; _SCPbitmap8 tempBmp8 16 0 31 12 SlideBmp8 34 16 49 28 nil; _SCPbitmap8 tempBmp8 32 0 47 12 SlideBmp8 51 16 66 28 nil; _SCPbitmap8 tempBmp8 0 13 15 15 SlideBmp8 2 16 17 17 nil; _SCPbitmap8 tempBmp8 16 13 31 15 SlideBmp8 2 16 17 17 nil; _SCPbitmap8 tempBmp8 32 13 47 15 SlideBmp8 2 16 17 17 nil; _SCPbitmap8 tempBmp8 0 16 15 h-18 SlideBmp8 2 18 17 23 nil; _SCPbitmap8 tempBmp8 16 16 31 h-18 SlideBmp8 2 18 17 23 nil; _SCPbitmap8 tempBmp8 32 16 47 h-18 SlideBmp8 2 18 17 23 nil; _SCPbitmap8 tempBmp8 0 h-17 15 h-14 SlideBmp8 2 24 17 27 nil; _SCPbitmap8 tempBmp8 16 h-17 31 h-14 SlideBmp8 2 24 17 27 nil; _SCPbitmap8 tempBmp8 32 h-17 47 h-14 SlideBmp8 2 24 17 27 nil; _SCPbitmap8 tempBmp8 0 h-13 15 h-1 SlideBmp8 34 30 49 42 nil; _SCPbitmap8 tempBmp8 16 h-13 31 h-1 SlideBmp8 34 30 49 42 nil; _SCPbitmap8 tempBmp8 32 h-13 47 h-1 SlideBmp8 51 30 66 42 nil; _SCPbitmap8 tempBmp8 0 h 15 h+17 SlideBmp8 18 16 33 33 nil; _SCPbitmap8 tempBmp8 16 h 31 h+17 SlideBmp8 18 16 33 33 nil; _SCPbitmap8 tempBmp8 32 h 47 h+17 SlideBmp8 18 16 33 33 nil; /* creation of the new alphabitmap */ let _CRalphaBitmap _channel tempBmp tempBmp8 make_rgb 255 255 255 trans -> alphaBmp in let _DSbitmap tempBmp -> truc in let _DSbitmap8 tempBmp8 -> truc in alphaBmp ) ;; fun MakeAlpha (bmp, bmp8,trans /**/) = let _CRbitmap _channel 22 110 -> tempBmp in let _CRbitmap8 _channel 22 110 -> tempBmp8 in ( _SCPbitmap tempBmp 0 0 21 109 bmp 0 0 21 109 nil; _SCPbitmap8 tempBmp8 0 0 21 109 bmp8 0 0 21 109 nil; let _CRalphaBitmap _channel tempBmp tempBmp8 make_rgb 255 255 255 /*make_rgb 0 0 255*/ trans -> alphaBmp in let _DSbitmap tempBmp -> truc in let _DSbitmap8 tempBmp8 -> truc in alphaBmp ) ;; /*callback of resize of the list's vertical slidebar*/ fun cbResize_List (objslide, param, w, h, bmpcoords) = [DessineSlideV w/3 h [15 h-15 h]] ;; /*Create the List background alphabitmap*/ fun DessineList (w, h) = let _CRbitmap _channel w h -> tempBmp in let _CRbitmap8 _channel w h -> tempBmp8 in ( _SCPbitmap tempBmp 0 0 13 13 ListBmp 0 0 13 13 nil; _SCPbitmap tempBmp 14 0 w-15 13 ListBmp 14 0 15 13 nil; _SCPbitmap tempBmp w-14 0 w-1 13 ListBmp 16 0 29 13 nil; _SCPbitmap tempBmp 0 14 13 h-15 ListBmp 0 14 13 15 nil; _SCPbitmap tempBmp 14 14 w-15 h-15 ListBmp 14 14 15 15 nil; _SCPbitmap tempBmp w-14 14 w-1 h-15 ListBmp 16 14 29 15 nil; _SCPbitmap tempBmp 0 h-14 13 h-1 ListBmp 0 16 13 29 nil; _SCPbitmap tempBmp 14 h-14 w-15 h-1 ListBmp 14 16 15 29 nil; _SCPbitmap tempBmp w-14 h-14 w-1 h-1 ListBmp 16 16 29 29 nil; _SCPbitmap8 tempBmp8 0 0 13 13 ListBmp8 0 0 13 13 nil; _SCPbitmap8 tempBmp8 14 0 w-15 13 ListBmp8 14 0 15 13 nil; _SCPbitmap8 tempBmp8 w-14 0 w-1 13 ListBmp8 16 0 29 13 nil; _SCPbitmap8 tempBmp8 0 14 13 h-15 ListBmp8 0 14 13 15 nil; _SCPbitmap8 tempBmp8 14 14 w-15 h-15 ListBmp8 14 14 15 15 nil; _SCPbitmap8 tempBmp8 w-14 14 w-1 h-15 ListBmp8 16 14 29 15 nil; _SCPbitmap8 tempBmp8 0 h-14 13 h-1 ListBmp8 0 16 13 29 nil; _SCPbitmap8 tempBmp8 14 h-14 w-15 h-1 ListBmp8 14 16 15 29 nil; _SCPbitmap8 tempBmp8 w-14 h-14 w-1 h-1 ListBmp8 16 16 29 29 nil; let _CRalphaBitmap _channel tempBmp tempBmp8 make_rgb 255 255 255 make_rgb 0 0 255 -> alphaBmp in let _DSbitmap tempBmp -> truc in let _DSbitmap8 tempBmp8 -> truc in alphaBmp ) ;; /*Create the CompBitmap of the List*/ fun CreateBitmap (x, y, w, h) = _CRcompBitmap _channel Cont nil [x y] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_CLICK|OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_DBLCLICK|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_MOVE DessineList w h 0 0 w h ;; /*resize the bitmap of the list*/ fun cbResizeBitmap (object, param, w, h, tuple) = let tuple -> [sx sy sw sh] in let DessineList w h -> alphabmp in [alphabmp [sx sy w h]] ;; /******************************************************************************* Function that add a state to the final bitmap of the button tmpBmp -> ObjBitmap : a temporary bitmap used for create the final alphabitmap hTmp -> I : the height of start for the _SCPbitmap function wBmp -> I : the weight of start of the state in the source bitmap hBmp -> I : the height of start of the state in the source bitmap w -> I : the weight of the final alphabitmap h -> I : the height of a state in the final alphabitmap (one fifth of the final alphabitmap for a 3 state button plus disable state and a mask <- nothing : *******************************************************************************/ fun AddBmp (tmpBmp, hTmp, wBmp, hBmp, w, h) = /* construction of a final bitmap with the elements of the file */ _SCPbitmap tmpBmp 0 hTmp 9 hTmp+9 ButtonBmp wBmp hBmp wBmp+9 hBmp+9 nil; _SCPbitmap tmpBmp 10 hTmp w-11 hTmp+9 ButtonBmp wBmp+10 hBmp wBmp+11 hBmp+9 nil; _SCPbitmap tmpBmp w-10 hTmp w-1 hTmp+9 ButtonBmp wBmp+12 hBmp wBmp+22 hBmp+9 nil; _SCPbitmap tmpBmp 0 hTmp+10 9 hTmp+h-11 ButtonBmp wBmp hBmp+10 wBmp+9 hBmp+11 nil; _SCPbitmap tmpBmp 10 hTmp+10 w-11 hTmp+h-11 ButtonBmp wBmp+10 hBmp+10 wBmp+11 hBmp+11 nil; _SCPbitmap tmpBmp w-10 hTmp+10 w-1 hTmp+h-11 ButtonBmp wBmp+12 hBmp+10 wBmp+22 hBmp+11 nil; _SCPbitmap tmpBmp 0 hTmp+h-10 9 hTmp+h-1 ButtonBmp wBmp hBmp+12 wBmp+9 hBmp+22 nil; _SCPbitmap tmpBmp 10 hTmp+h-10 w-11 hTmp+h-1 ButtonBmp wBmp+10 hBmp+12 wBmp+11 hBmp+22 nil; _SCPbitmap tmpBmp w-10 hTmp+h-10 w-1 hTmp+h-1 ButtonBmp wBmp+12 hBmp+12 wBmp+22 hBmp+22 nil ;; /******************************************************************************* Function that add a state to the final bitmap of the button tmpBmp8 -> ObjBitmap8 : a temporary bitmap8 used for create the final alphabitmap hTmp -> I : the height of start for the _SCPbitmap8 function wBmp -> I : the weight of start of the state in the source bitmap8 hBmp -> I : the height of start of the state in the source bitmap8 w -> I : the weight of the final alphabitmap h -> I : the height of a state in the final alphabitmap (one fifth of the final alphabitmap for a 3 state button plus disable state and a mask <- nothing : *******************************************************************************/ fun AddBmp8 (tmpBmp8, hTmp, wBmp, hBmp, w, h) = /* construction of a final bitmap with the elements of the file */ _SCPbitmap8 tmpBmp8 0 hTmp 9 hTmp+9 ButtonBmp8 wBmp hBmp wBmp+9 hBmp+9 nil; _SCPbitmap8 tmpBmp8 10 hTmp w-11 hTmp+9 ButtonBmp8 wBmp+10 hBmp wBmp+11 hBmp+9 nil; _SCPbitmap8 tmpBmp8 w-10 hTmp w-1 hTmp+9 ButtonBmp8 wBmp+12 hBmp wBmp+21 hBmp+9 nil; _SCPbitmap8 tmpBmp8 0 hTmp+10 9 hTmp+h-11 ButtonBmp8 wBmp hBmp+10 wBmp+9 hBmp+11 nil; _SCPbitmap8 tmpBmp8 10 hTmp+10 w-11 hTmp+h-11 ButtonBmp8 wBmp+10 hBmp+10 wBmp+11 hBmp+11 nil; _SCPbitmap8 tmpBmp8 w-10 hTmp+10 w-1 hTmp+h-11 ButtonBmp8 wBmp+12 hBmp+10 wBmp+21 hBmp+11 nil; _SCPbitmap8 tmpBmp8 0 hTmp+h-10 9 hTmp+h-1 ButtonBmp8 wBmp hBmp+12 wBmp+9 hBmp+21 nil; _SCPbitmap8 tmpBmp8 10 hTmp+h-10 w-11 hTmp+h-1 ButtonBmp8 wBmp+10 hBmp+12 wBmp+11 hBmp+21 nil; _SCPbitmap8 tmpBmp8 w-10 hTmp+h-10 w-1 hTmp+h-1 ButtonBmp8 wBmp+12 hBmp+12 wBmp+21 hBmp+21 nil ;; /******************************************************************************* Function that create the button alphabitmap text -> S : the text written on the button w -> I : the weight of the button and the alphabitmap hght -> I : the height of the alphabitmap, 5 time the height of the button for a 3 states button plus disable state and a mask <- AlphaBitmap : the final AlphaBitmap of the button *******************************************************************************/ fun DrawRollOver (text, w, hght) = let hght/5 -> h in /* creation of the two destination bitmap */ let _CRbitmap _channel w 5*h -> tempBmp in let _CRbitmap8 _channel w 5*h -> tempBmp8 in ( AddBmp tempBmp 0 2 40 w h; AddBmp tempBmp h 25 40 w h; AddBmp tempBmp 2*h 48 40 w h; AddBmp tempBmp 3*h 2 88 w h; AddBmp tempBmp 4*h 25 88 w h; AddBmp8 tempBmp8 0 2 40 w h; AddBmp8 tempBmp8 h 25 40 w h; AddBmp8 tempBmp8 2*h 48 40 w h; AddBmp8 tempBmp8 3*h 2 88 w h; AddBmp8 tempBmp8 4*h 25 88 w h; let _GETstringSize Font text -> [wtxt htxt] in /* calculation of the position of the text */ let if w>wtxt then (w-wtxt)/2 else 0 -> xpos in let if h>htxt then (h-htxt)/2 else 0 -> ypos in ( /* draw of the text in the different state of the bitmap */ _DRAWtext tempBmp Font xpos ypos make_rgb 0 255 255 TD_TOP|TD_LEFT text; _DRAWtext tempBmp Font xpos ypos+h 0 TD_TOP|TD_LEFT text; _DRAWtext tempBmp Font xpos ypos+2*h 0 TD_TOP|TD_LEFT text; _DRAWtext tempBmp Font xpos ypos+3*h 0 TD_TOP|TD_LEFT text ); /* creation of the final alphabitmap */ let _CRalphaBitmap _channel tempBmp tempBmp8 make_rgb 255 255 255 make_rgb 0 0 255 -> alphaBmp in let _DSbitmap tempBmp -> truc in let _DSbitmap8 tempBmp8 -> truc in alphaBmp ) ;; fun _CBtimerHideToolTip(t, b) = _deltimer t; _killchannel b ;; fun cbHideToolTip (node, toolTipChannel, txt) = _killchannel toolTipChannel ;; fun cbShowToopTip (node,b,txt,x,y)= let b -> [toolTipChannel cont] in ( let _GETwindowPositionSize DMSwin -> [xp yp wp hp] in let _GETcursorPos DMSwin -> [xx yy] in let (xp + xx) + 20 -> x in let (yp + yy) + 30 -> y in if txt==nil || (!strcmp txt "") then nil else let _GETstringSize Font txt -> [w h] in let [w+1 h+1] -> [w h] in /*let [((w*3)/4) h*2] -> [w h] in*/ let _GETscreenSize -> [sw sh] in let if (x+w)>sw-10 then sw-w-10 else x -> x in /*si depassement ecran, on decale à gauche*/ let 4 -> dw in let 4 -> dh in let _CRcontainerFromObjCont toolTipChannel cont x y w+dw h+dh CO_NOCAPTION make_rgb /*37 131 185*/ 240 240 240 "tooltip" -> cont in ( _CRcompText toolTipChannel cont nil [dw/2+1 dh/2] OBJ_ENABLE|OBJ_VISIBLE|CT_CENTER|CT_WORDWRAP 0 w h txt Font [make_rgb /*255 255 255*/0 0 0 0 0 0] [0 0] nil nil; _PAINTcontainer cont; _TOPcontainer cont; _rfltimer _starttimer toolTipChannel hideToolTipDelay @_CBtimerHideToolTip toolTipChannel ); ) ;; fun CreateToolTip (cont, node, txt) = let _openchannel nil nil nil -> toolTipChannel in ( _CRtoolTip node beforeToolTipDelay txt @cbShowToopTip [toolTipChannel cont] @cbHideToolTip toolTipChannel; toolTipChannel ) ;; /*****************************Système d'onglet*********************************/ fun BBMP_HResize (resBmp, orgBmp, resBmp8, orgBmp8, nbCol, numCol, trans, borders) = let borders -> [wl wr ht hb] in let _GETbitmapSize resBmp -> [resW resH] in let resW/nbCol -> widthRes in let numCol*widthRes -> resPos in let _GETbitmapSize orgBmp -> [orgW orgH] in let orgW/nbCol -> widthOrg in let numCol*widthOrg -> orgPos in ( _SCPbitmap resBmp resPos 0 resPos+wl-1 resH orgBmp orgPos 0 orgPos+wl-1 resH trans; _SCPbitmap resBmp resPos+wl 0 resPos+widthRes-wr-1 resH orgBmp orgPos+wl 0 orgPos+widthOrg-wr-1 resH trans; _SCPbitmap resBmp resPos+widthRes-wr 0 resPos+widthRes-1 resH orgBmp orgPos+widthOrg-wr 0 orgPos+widthOrg-1 resH trans; _SCPbitmap8 resBmp8 resPos 0 resPos+wl-1 resH orgBmp8 orgPos 0 orgPos+wl-1 resH trans; _SCPbitmap8 resBmp8 resPos+wl 0 resPos+widthRes-wr-1 resH orgBmp8 orgPos+wl 0 orgPos+widthOrg-wr-1 resH trans; _SCPbitmap8 resBmp8 resPos+widthRes-wr 0 resPos+widthRes-1 resH orgBmp8 orgPos+widthOrg-wr 0 orgPos+widthOrg-1 resH trans; if (numCol+1)==nbCol then 0 else BBMP_HResize resBmp orgBmp resBmp8 orgBmp8 nbCol numCol+1 trans borders ) ;; fun BBMP_VResize (resBmp, orgBmp, resBmp8, orgBmp8, nbLine, numLine, trans, borders) = let borders -> [wl wr ht hb] in let _GETbitmapSize resBmp -> [resW resH] in let resH/nbLine -> heightRes in let numLine*heightRes -> resPos in let _GETbitmapSize orgBmp -> [orgW orgH] in let orgH/nbLine -> heightOrg in let numLine*heightOrg -> orgPos in ( _SCPbitmap resBmp 0 resPos resW resPos+ht-1 orgBmp 0 orgPos resW orgPos+ht-1 trans; _SCPbitmap resBmp 0 resPos+ht resW resPos+heightRes-hb-1 orgBmp 0 orgPos+ht resW orgPos+heightOrg-hb-1 trans; _SCPbitmap resBmp 0 resPos+heightRes-hb resW resPos+heightRes-1 orgBmp 0 orgPos+heightOrg-hb resW orgPos+heightOrg-1 trans; _SCPbitmap8 resBmp8 0 resPos resW resPos+ht-1 orgBmp8 0 orgPos resW orgPos+ht-1 trans; _SCPbitmap8 resBmp8 0 resPos+ht resW resPos+heightRes-hb-1 orgBmp8 0 orgPos+ht resW orgPos+heightOrg-hb-1 trans; _SCPbitmap8 resBmp8 0 resPos+heightRes-hb resW resPos+heightRes-1 orgBmp8 0 orgPos+heightOrg-hb resW orgPos+heightOrg-1 trans; if (numLine+1)==nbLine then 0 else BBMP_VResize resBmp orgBmp resBmp8 orgBmp8 nbLine numLine+1 trans borders ) ;; fun BBMP_DrawText (bmp, text, tabl, size, pos, colors, numLine, numCol) = let text -> [txt font] in let tabl -> [nbLine nbCol] in let pos -> [xpos ypos] in let size -> [width height] in ( let hd hd colors -> coul in if coul!=-1 then _DRAWtext bmp font xpos+(width*numCol) ypos+(height*numLine) TD_TOP|TD_LEFT coul txt else nil; if (numLine+1)==nbLine then if (numCol+1)==nbCol then 0 else BBMP_DrawText bmp text tabl size pos (tl colors) 0 numCol+1 else BBMP_DrawText bmp text tabl size pos ((tl hd colors)::(tl colors)) numLine+1 numCol ) ;; /* construct the alphaBitmap for the CompChecks of the itens' Menu w and h are the width and the height of the future button */ fun BBMP_stretchButtonText (chan, text, size, colors, borders, tabl, img) = let text -> [txt font] in let size -> [width height] in let colors -> [background trans write] in let borders -> [wl wr ht hb] in let tabl -> [nbLine nbCol] in let _GETalphaBitmaps img -> [Bmp Bmp8] in let _GETbitmapSize Bmp -> [bmpW bmpH] in /* creation of the two destination bitmap */ let _CRbitmap chan width*nbCol bmpH -> tempBmp in let _CRbitmap8 chan width*nbCol bmpH -> tempBmp8 in ( BBMP_HResize tempBmp Bmp tempBmp8 Bmp8 nbCol 0 nil borders; let _CRbitmap chan width*nbCol nbLine*height -> temp2Bmp in let _CRbitmap8 chan width*nbCol nbLine*height -> temp2Bmp8 in ( BBMP_VResize temp2Bmp tempBmp temp2Bmp8 tempBmp8 nbLine 0 nil borders; /* calculation of the position of the text */ let _GETstringSize font txt -> [wtxt htxt] in let if width-(wl+wr)>wtxt then ((width-(wl+wr)-wtxt)/2)+wl else wl -> xpos in let if height>htxt then height-htxt-hb else ht -> ypos in ( /* draw of the text in the different state of the bitmap */ BBMP_DrawText temp2Bmp text tabl size [xpos ypos] write 0 0; /* _SAVEjpeg temp2Bmp _getmodifypack (strcatn "testBBMP"::txt::".jpg"::nil) 80;*/ /* creation of the final alphabitmap */ let _CRalphaBitmap chan temp2Bmp temp2Bmp8 nil trans -> final in let _DSbitmap tempBmp -> truc in let _DSbitmap8 tempBmp8 -> truc in let _DSbitmap temp2Bmp -> truc in let _DSbitmap8 temp2Bmp8 -> truc in final ) ) ) ;; /* generic functions */ fun getStrWidth (font, str) = let _GETstringSize font str-> [width _] in width ;; fun getAbreviation (str, size, font, endstr) = if (getStrWidth font str) <= size then [(getStrWidth font str) str] else getAbreviation (strcat (substr str 0 ((strlen str)-4)) endstr) size font endstr ;; /**********************************/ /* TItemTabBox functions */ /**********************************/ /* get the item structure from the index */ fun ITBgetItem (list, idx) = if list == nil then nil else let hd list -> item in if item.ITB_Index==idx then item else ITBgetItem tl list idx ;; /* replace every container from list equal to item by item */ fun ITBdelContainerDoublon (list, item)= if list==nil then 0 else let hd list -> item2 in ( if item2.ITB_Container.CTB_Container == item.ITB_Container.CTB_Container then set item2.ITB_Container = item.ITB_Container else nil; ITBdelContainerDoublon tl list item ) ;; fun cbDestroyToolTip (object, texte) = _DScompText texte ;; /* construct the ToolTipContainer and show it */ fun ITBshowTip (node, param, texte, x, y) = /*_DLGMessageBox _channel nil "SHOWTIPS" "" 0;*/ let param -> [tb item] in let _GETcontainerPositionSize tb.TBOX_MainContainer -> [posx posy wcont _] in let _GETstringSize tb.TBOX_Font texte -> [w h] in let ( if x-posx+w > wcont then wcont-w else x-posx ) -> xtab in ( set item.ITB_ToolTip = _CRcontainerFromObjCont tb.TBOX_Channel tb.TBOX_MainContainer xtab-5 y-(posy+20) w+10 h CO_CHILDINSIDE make_rgb 255 255 255 "tooltip"; let _CRcompText tb.TBOX_Channel item.ITB_ToolTip nil [5 0] OBJ_ENABLE|OBJ_VISIBLE|CT_CENTER|CT_LABEL nil w h texte tb.TBOX_Font [0 0 0 0] [0 0] nil nil -> texte in _CBcontainerPreDestroy item.ITB_ToolTip @cbDestroyToolTip texte; _PAINTcontainer _SHOWcontainer item.ITB_ToolTip CONTAINER_UNHIDDEN; 0 ) ;; /* hide ToolTip */ fun ITBhideTip (node, item, texte) = _DScontainer item.ITB_ToolTip; 0 ;; /**********************************/ /* TTabBox functions */ /**********************************/ /* simplify all container equal replacing them by one unique */ fun TBOXdelContainerDoublon (list) = if list == nil then 0 else let hd list-> item in ( ITBdelContainerDoublon tl list item; TBOXdelContainerDoublon tl list ) ;; /* set all container item equal to container cont to nil */ fun TBOXsetContainerToNil (list, cont) = if list == nil then 0 else let hd list -> item in ( if item.ITB_Container.CTB_Container == cont then set item.ITB_Container.CTB_Container = nil else nil; TBOXsetContainerToNil tl list cont ) ;; /* focus a new item */ fun TBOXfocusItem (idx, tb) = let ITBgetItem tb.TBOX_ListItens idx -> item in let ITBgetItem tb.TBOX_ListItens tb.TBOX_CurrentItem -> curItem in ( if item.ITB_Container.CTB_Container != nil then ( if idx != tb.TBOX_CurrentItem then ( _SETcompCheckState curItem.ITB_CompCheck CHK_UNCHECKED; _SHOWcontainer curItem.ITB_Container.CTB_Container CONTAINER_HIDDEN; ) else nil; set tb.TBOX_CurrentItem = idx; if item.ITB_Container.CTB_Visited == 0 then ( exec item.ITB_Container.CTB_OnFirstLoad with [tb item.ITB_Container.CTB_Container]; set item.ITB_Container.CTB_Visited = 1 ) else nil; exec item.ITB_OnFocus with [tb item]; let _GETcontainerPositionSize tb.TBOX_MainContainer -> [_ _ width h] in _SIZEEXcontainer item.ITB_Container.CTB_Container 0 25 width h-25; _PAINTcontainer _SHOWcontainer item.ITB_Container.CTB_Container CONTAINER_UNHIDDEN ) else if idx != tb.TBOX_CurrentItem then ( set tb.TBOX_CurrentItem = idx; _SETcompCheckState curItem.ITB_CompCheck CHK_UNCHECKED; _PAINTcontainer _SHOWcontainer curItem.ITB_Container.CTB_Container CONTAINER_HIDDEN; ) else nil ) ;; /* callBack on click on an item's CompCheck */ fun cbTBOXClickCheck (objChec, param, x, y, btn, mask) = let param -> [tb item] in ( if (_GETcompCheckState objChec) == CHK_UNCHECKED then _SETcompCheckState objChec CHK_CHECKED else ( TBOXfocusItem item.ITB_Index tb; nil ); _PAINTcontainer tb.TBOX_MainContainer ) ;; fun ITBbuildCheck (tb, item) = let _GETcontainerPositionSize tb.TBOX_MainContainer -> [_ _ width _] in ( let BBMP_stretchButtonText tb.TBOX_Channel [item.ITB_Title tb.TBOX_Font] [item.ITB_TitleSize tb.TBOX_MenuHeight] [make_rgb 255 255 255 tb.TBOX_TransColor (0::(make_rgb 37 131 185)::(make_rgb 37 131 185)::(make_rgb /*100 100 100*/ 176 168 208 )::(make_rgb 255 255 255)::nil):: (0::0::0::0::(make_rgb 255 255 255)::nil):: nil ] [7 7 8 3] [5 2] tb.TBOX_ImgBtn -> img in ( set item.ITB_CompCheck = _CRcompCheck tb.TBOX_Channel tb.TBOX_MainContainer nil [-item.ITB_TitleSize 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK nil img; _CBcompCheckUnClick item.ITB_CompCheck @cbTBOXClickCheck [tb item]; if tb.TBOX_ModeToolTip then CreateToolTip tb.TBOX_MainContainer (_CONVERTcompCheckToObjNode item.ITB_CompCheck) item.ITB_MsgToolTip else nil ); item ) ;; /* create a new TItemTabBox */ fun ITBmkItem (tb, item, idxItem) = let item -> [cont title funload funfocus] in let mkContainerTabBox [cont 0 funload] -> contTB in let (if tb.TBOX_ModeToolTip then title else "") -> tooltipMsg in let mkItemTabBox [idxItem contTB nil nil title tooltipMsg nil 0 funfocus] -> item in let item.ITB_FullTitle -> str in let ( if (getStrWidth tb.TBOX_Font str)< tb.TBOX_MaxSizeItemBtn-14 then [(getStrWidth tb.TBOX_Font str) str] else getAbreviation (strcat (substr str 0 ((strlen str)-3)) "...") tb.TBOX_MaxSizeItemBtn-14 tb.TBOX_Font "..." ) -> [size title] in ( set item.ITB_Title = title; set item.ITB_TitleSize = size+14; ITBbuildCheck tb item ) ;; /* add all items of the list [[ObjContainer S fun[TTabBox ObjContainer]I fun[TTbaxBox TItemTabBox]I ] r1] in tb */ fun TBOXaddListItens (tb, list, idxItem) = if list == nil then nil else (ITBmkItem tb hd list idxItem)::(TBOXaddListItens tb (tl list) idxItem+1) ;; /* construct the button (RollOver) for eather the Back button or the Forward button */ fun TBOXmkBtnBF (param, tb, func, param2) = let param -> [btnImg txt] in let _GETstringSize tb.TBOX_Font txt -> [wtxt htxt] in let _GETalphaBitmaps btnImg -> [bmp bmp8] in let _GETbitmapSize bmp -> [wimg himg] in let BBMP_stretchButtonText tb.TBOX_Channel [txt tb.TBOX_Font] [wtxt+24 tb.TBOX_MenuHeight] [(make_rgb 255 255 255) tb.TBOX_TransColor nil] [12 12 12 12] [5 1] btnImg -> img in ( set tb.TBOX_BackFwdMargin = tb.TBOX_BackFwdMargin + wtxt+24; _CBcompRollOverClick ( _CRcompRollOver tb.TBOX_Channel tb.TBOX_MainContainer nil [-wtxt-24 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK nil img ) func param2 ) ;; /* Draw the menu with the CompChecks visible and the Back/Forward buttons if needed */ /* Note all buttons that aren't showen are designed out off the container's range */ fun TBOXshowMenu (tb, list, contWidth, num, pos) = if list == nil then 0 else let hd list -> item in let _CONVERTcompCheckToObjNode item.ITB_CompCheck -> node in let _CONVERTcompRollOverToObjNode tb.TBOX_BtnForward -> nodeFwd in let _CONVERTcompRollOverToObjNode tb.TBOX_BtnBack -> nodeBack in let _GETobjNodePositionSizeInContainerRef nodeFwd -> [_ _ wFwd hFwd] in let _GETobjNodePositionSizeInContainerRef nodeBack -> [_ _ wBack hBack] in if pos+item.ITB_TitleSize>contWidth then ( /* item out of the container */ _CHANGEobjNodeCoordinates node [-item.ITB_TitleSize 0] 0; /* invisible */ if pos nodeBack in let _GETobjNodePositionSizeInContainerRef nodeBack -> [_ _ wBack hBack] in ( _CHANGEobjNodeCoordinates nodeBack [-wBack 0] 0 ); set tb.TBOX_CurrentFirstItem = tb.TBOX_CurrentFirstItem - 1; TBOXshowMenu tb tb.TBOX_ListItens tb.TBOX_MenuWidth 0 0; _PAINTcontainer tb.TBOX_MainContainer ) ;; /* Callback on click on the Forward button */ fun cbTBOXClickForward (objRoll, tb, x, y, btn, mask) = if tb.TBOX_CurrentFirstItem >= sizelist tb.TBOX_ListItens then nil else ( let _CONVERTcompRollOverToObjNode tb.TBOX_BtnForward -> nodeFwd in let _GETobjNodePositionSizeInContainerRef nodeFwd -> [_ _ wFwd hFwd] in ( _CHANGEobjNodeCoordinates nodeFwd [-wFwd 0] 0 ); set tb.TBOX_CurrentFirstItem = tb.TBOX_CurrentFirstItem + 1; TBOXshowMenu tb tb.TBOX_ListItens tb.TBOX_MenuWidth 0 0; _PAINTcontainer tb.TBOX_MainContainer ) ;; /* Resize the container of the current item showen */ fun TBOXresizeCurrentItem (list, width, h) = if list == nil then nil else let hd list -> item in if (_GETcompCheckState item.ITB_CompCheck) == CHK_CHECKED then ( _SIZEEXcontainer item.ITB_Container.CTB_Container 0 25 width h-25; _PAINTcontainer item.ITB_Container.CTB_Container ) else TBOXresizeCurrentItem tl list width h ;; /* calculates the maximum number of item CompCheck possible to show from the end */ /* return the lowest numero of the item with which the rest of the menu we be showen */ fun TBOXgetMaxItensFromEnd (list, n, width, pos) = if n == 0 then 0 else let nth_list list n-1 -> item in if (pos+item.ITB_TitleSize)>width then n else TBOXgetMaxItensFromEnd list n-1 width pos+item.ITB_TitleSize ;; /* Callback when resizing the main container */ fun cbTBOXSizeContainer (objcont, tabBox, state, width, h) = set tabBox.TBOX_MenuWidth = width - tabBox.TBOX_BackFwdMargin; let _CONVERTcompRollOverToObjNode tabBox.TBOX_BtnForward -> nodeFwd in let _CONVERTcompRollOverToObjNode tabBox.TBOX_BtnBack -> nodeBack in let _GETobjNodePositionSizeInContainerRef nodeFwd -> [_ _ wFwd hFwd] in let _GETobjNodePositionSizeInContainerRef nodeBack -> [_ _ wBack hBack] in ( _CHANGEobjNodeCoordinates nodeFwd [-wFwd 0] 0; _CHANGEobjNodeCoordinates nodeBack [-wBack 0] 0; ); let TBOXgetMaxItensFromEnd tabBox.TBOX_ListItens (sizelist tabBox.TBOX_ListItens) tabBox.TBOX_MenuWidth 0 -> firstItemPossible in if firstItemPossible [_ _ width h] in TBOXresizeCurrentItem tabBox.TBOX_ListItens width h; _PAINTcontainer tabBox.TBOX_MainContainer ;; /* reset an item from the ites list */ fun TBOXrstItemFromList (tb, list, idx) = if list == nil then ( if idx == tb.TBOX_CurrentItem then ( TBOXsetItem 0 tb; 0 ) else if idx < tb.TBOX_CurrentItem then set tb.TBOX_CurrentItem = tb.TBOX_CurrentItem-1 else nil; nil ) else let hd list -> item in if item.ITB_Index res in let (res == 1) -> modeToolTip in /* let flag/2 -> flag in let mod flag 2 -> res in let (res==1) -> modeXXXXX in ... */ [modeToolTip] ;; fun ITBdsItemTabBox (item, param) = if item.ITB_Container.CTB_Container != nil then ( _DScontainer item.ITB_Container.CTB_Container; set item.ITB_Container.CTB_Container = nil ) else nil ;; /**********************************/ /* functions to use externely */ /**********************************/ /*return the index of a name in the cell's list*/ fun FindPlaceInListCell (list, name, compteur) = if list == nil then 0 else if !strcmp name (hd list) then compteur else FindPlaceInListCell tl list name compteur+1 ;; /* set the current item */ fun TBOXsetItem (n, tb) = if n item in ( _SETcompCheckState item.ITB_CompCheck CHK_CHECKED; TBOXfocusItem n tb; ) else nil ;; /******************************************************************************* creation function for the TabBox chnl -> Chn mainCont -> ObjContainer node -> ObjNode menuHeight -> I itemList -> [[ObjContainer S fun[TTabBox ObjContainer]I fun[TTbaxBox TItemTabBox]I ] r1] : container Title OnFirstLoad callback OnFocus callback btnImg -> alphaBitmap : for the itens' CompCheck back -> [alphaBitmap S] : for the Back Button forward -> [alphaBitmap S] : for the Forward Button font -> ObjFont transcolor -> I maxSizeItemBtn -> I flag -> I : modes TBOX_ENABLETOOLTIP / TBOX_DISABLETOOLTIP <- TTabBox *******************************************************************************/ fun TBOXcrTabBox (chnl,mainCont,node,menuHeight,itemList,btnImg,back,forward, font,transColor,maxSizeItemBtn,flag) = let TBOXgetFlags flag -> [toolTipMode] in let _GETcontainerPositionSize mainCont-> [_ _ width _] in let mkTabBox [ chnl mainCont node menuHeight font btnImg nil nil 0 width transColor nil maxSizeItemBtn 0 0 0 toolTipMode ] -> tabBox in ( set tabBox.TBOX_BtnBack = TBOXmkBtnBF back tabBox @cbTBOXClickBack tabBox; set tabBox.TBOX_BtnForward = TBOXmkBtnBF forward tabBox @cbTBOXClickForward tabBox; set tabBox.TBOX_MenuWidth = tabBox.TBOX_MenuWidth - tabBox.TBOX_BackFwdMargin; set tabBox.TBOX_ListItens = TBOXaddListItens tabBox itemList tabBox.TBOX_NbItens; TBOXdelContainerDoublon tabBox.TBOX_ListItens; TBOXshowMenu tabBox tabBox.TBOX_ListItens tabBox.TBOX_MenuWidth 0 0; set tabBox.TBOX_NbItens = sizelist tabBox.TBOX_ListItens; _CBcontainerSize tabBox.TBOX_MainContainer @cbTBOXSizeContainer tabBox; let FindPlaceInListCell ListCellName Cell 0 -> index in TBOXsetItem index tabBox; /* TBOXsetItem 0 tabBox;*/ _PAINTcontainer tabBox.TBOX_MainContainer; tabBox ) ;; /* get the index of the item (first index = 0) */ fun TBOXgetIndex (item) = item.ITB_Index ;; /* reset Tab Box */ fun TBOXrstTabBox (tb) = set tb.TBOX_ListItens = nil; set tb.TBOX_NbItens = 0 ;; /* destroy Tab Box */ fun TBOXdsTabBox (tb) = apply_on_list tb.TBOX_ListItens @ITBdsItemTabBox nil; _DScontainer tb.TBOX_MainContainer; set tb.TBOX_MainContainer = nil ;; /* add an item to a complist */ fun AddList (compList, liste, compteur) = if liste == nil then nil else ( AddList compList tl liste compteur; _ADDcompList compList compteur hd liste ) ;; /* make a list for the complist with the validity pictures */ fun MakeList (list) = if list == nil then nil else let hd list -> [nom flag] in if Flag == 1 then let ( if flag == VALID then ValidPic else InvalidPic ) -> pic in [nom pic]:: MakeList tl list else [nom UserPic]:: MakeList tl list ;; /* return the position's list of a cell */ fun FindCell (liste, name) = if liste == nil then nil else let hd liste -> [nom position] in if !strcmp nom name then position else FindCell tl liste name ;; /* replace an element in a list */ fun 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::replace_nth_in_list next n-1 x ;; /* change the validity of a given position in a given cell */ fun Remplace (list, nom, validite, indexpos, indexcell) = let nth_list ListCellName indexcell -> name in let FindCell positions name -> listpos in let [nom validite] -> val in let replace_nth_in_list listpos indexpos val -> newlistpos in let [name newlistpos] -> newcell in set positions = replace_nth_in_list positions indexcell newcell ;; /* double click callback in the list change the validity of the double-clicked position */ fun cbDblClick_ListPos (ojbect, param, index) = /*_DLGMessageBox _channel nil "doubleclick" "" 0;*/ set posIndex = index; let nth_list ListCellName cellIndex -> name in let FindCell positions name -> liste in let nth_list liste index -> [nom valid] in let ( if valid == INVALID then VALID else INVALID ) -> validite in ( Remplace positions nom validite posIndex cellIndex; let ( if validite == VALID then ValidPic else InvalidPic ) -> image in _SETcompListValue ListPos index [nom image]; set Position = nom; UpdatePositionValidity name nom validite ); _PAINTcontainer Cont ;; /* Select the clicked position */ fun cbClick_ListPos (object, param, index) = set posIndex = index; let nth_list ListCellName cellIndex -> name in let FindCell positions name -> liste in let nth_list liste index -> [nom valid] in set Position = nom ;; /* select the clicked cell */ fun _clickCell (index) = set cellIndex = index; set posIndex = 0; _RSTcompList ListPos; let nth_list ListCellName index -> name in let FindCell positions name -> liste in let MakeList liste -> listebis in ( AddList ListPos listebis 0; set Cell = name ); 0 ;; /* find the index of a position in the list */ fun FindPlaceInListPos (list, name, compteur) = if list == nil then 0 else let hd list -> [nom _] in if !strcmp name nom then compteur else FindPlaceInListPos tl list name compteur+1 ;; /* get the item from index */ fun TBOXgetItem (tb,idx) = ITBgetItem tb.TBOX_ListItens idx ;; /* click callback of the tab */ fun AnotherClick (param, indexcell) = let TBOXgetIndex indexcell -> index in _clickCell index; 0 ;; /* select a specific position in a specific cell */ fun SelectPosition (room, pos) = let FindPlaceInListCell ListCellName room 0 -> index in TBOXsetItem index TabList; /* let TBOXgetItem TabList index -> item in AnotherClick TabList item;*/ let FindCell positions room -> liste in let FindPlaceInListPos liste pos 0 -> index in _SETcompListClicked ListPos index; _PAINTcontainer ContPere; _PAINTcontainer Cont ;; /* predestroy callback of the father container */ fun _quitter (cont, param) = TBOXrstTabBox TabList; TBOXdsTabBox TabList; _DSfont Font; _RSTcompList ListPos; _DScompList ListPos; _DStoolTip (_CONVERTcompRollOverToObjNode TeleportButton); _DStoolTip (_CONVERTcompRollOverToObjNode BackButton); _DStoolTip (_CONVERTcompRollOverToObjNode GoButton); _DStoolTip (_CONVERTcompRollOverToObjNode PushButton); _DScompRollOver TeleportButton; _DScompRollOver BackButton; _DScompRollOver GoButton; _DScompRollOver PushButton; _DScompRollOver DefaultButton; _DSalphaBitmap Img; _DSalphaBitmap ImgBack; _DSalphaBitmap ImgFwd; _DSbitmap SlideBmp; _DSbitmap8 SlideBmp8; _DSbitmap ListBmp; _DSbitmap8 ListBmp8; _DSbitmap ButtonBmp; _DSbitmap8 ButtonBmp8; _DSalphaBitmap ValidPic; _DSalphaBitmap InvalidPic; _DSalphaBitmap UserPic; _DScompText Label; _DScontainer Cont; _DScontainer ContPere; _DScontainer ContGeneral; set Update = 0; set Position = ""; set Cell = ""; GoHide Flag ;; /* create the list of the cell's name */ fun CreateListCellName (list) = if list == nil then nil else let hd list -> [Name Reste] in if Reste == nil then CreateListCellName tl list else Name:: CreateListCellName tl list ;; /* set the default position */ fun cbClickDefault (object, param, posx, posy, btn, mask) = let nth_list ListCellName cellIndex -> name in let FindCell positions name -> liste in let nth_list liste posIndex -> [nom validite] in ( UpdateDefaultPosition name nom; TeleportUser name nom 1; _SETcompText Label strcatn name::" -> "::nom::nil Font nil nil; SelectPosition name nom ); _PAINTcontainer Cont ;; /* click callback of the teleportation's buttons*/ fun cbClickButton (button, param, posx, posy, btn, mask) = let nth_list ListCellName cellIndex -> name in let _GETcompListValue ListPos posIndex -> [nom _] in if param == 2 then TeleportUser nil nil param else TeleportUser name nom param ;; fun cbSizeContainer (object, param, state, w, h) = _SIZEcontainer object 0 0 w h; _PAINTcontainer object; 0 ;; /* create different items */ fun cr_tab (father, w, h) = let strcat Path "resources/Lifts.png" -> chemin in let _GETalphaBitmaps _LDalphaBitmap _channel _checkpack chemin -> [tmpBmp tmpBmp8] in ( set SlideBmp = tmpBmp; set SlideBmp8 = tmpBmp8 ); let strcat Path "resources/listframe.png" -> chemin in let _GETalphaBitmaps _LDalphaBitmap _channel _checkpack chemin -> [tmpBmp tmpBmp8] in ( set ListBmp = tmpBmp; set ListBmp8 = tmpBmp8 ); let strcat Path "resources/buttons.png" -> chemin in let _GETalphaBitmaps _LDalphaBitmap _channel _checkpack chemin -> [tmpBmp tmpBmp8] in ( set ButtonBmp = tmpBmp; set ButtonBmp8 = tmpBmp8 ); let strcat Path "resources/Tport.png" -> chemin in let _LDalphaBitmap _channel _checkpack chemin -> alphabitmap in let _GETalphaBitmaps alphabitmap -> [tmpBmp tmpBmp8] in let _GETalphaBitmapTransparency alphabitmap -> trans in /* MODIF */ ( _fooS strcat ">>>>>>>>>>>" itoa trans; set TeleportAlpha = MakeAlpha tmpBmp tmpBmp8 trans; _DSbitmap tmpBmp; _DSbitmap8 tmpBmp8 ); let strcat Path "resources/TportPreced.png" -> chemin in let _LDalphaBitmap _channel _checkpack chemin -> alphabitmap in let _GETalphaBitmaps alphabitmap -> [tmpBmp tmpBmp8] in let _GETalphaBitmapTransparency alphabitmap -> trans in /* MODIF */ ( set BackAlpha = MakeAlpha tmpBmp tmpBmp8 trans; _DSbitmap tmpBmp; _DSbitmap8 tmpBmp8 ); let strcat Path "resources/CoTport.png" -> chemin in let _LDalphaBitmap _channel _checkpack chemin -> alphabitmap in let _GETalphaBitmaps alphabitmap -> [tmpBmp tmpBmp8] in let _GETalphaBitmapTransparency alphabitmap -> trans in /* MODIF */ ( set GoAlpha = MakeAlpha tmpBmp tmpBmp8 trans; _DSbitmap tmpBmp; _DSbitmap8 tmpBmp8 ); let strcat Path "resources/PushTport.png" -> chemin in let _LDalphaBitmap _channel _checkpack chemin -> alphabitmap in let _GETalphaBitmaps alphabitmap -> [tmpBmp tmpBmp8] in let _GETalphaBitmapTransparency alphabitmap -> trans in /* MODIF */ ( set PushAlpha = MakeAlpha tmpBmp tmpBmp8 trans; _DSbitmap tmpBmp; _DSbitmap8 tmpBmp8 ); let strcat Path "resources/coche.png" -> chemin in set ValidPic = _LDalphaBitmap _channel _checkpack chemin; let strcat Path "resources/pascoche.png" -> chemin in set InvalidPic = _LDalphaBitmap _channel _checkpack chemin; let strcat Path "resources/user.png" /*"resources/user.png"*/ -> chemin in set UserPic = _LDalphaBitmap _channel _checkpack chemin; /*_SETalphaBitmapTransparency UserPic make_rgb 0 0 255;*/ let strcat Path "resources/_ongletUE.png" -> chemin in set Img = _LDalphaBitmap _channel _checkpack chemin; let strcat Path "resources/_ongletBack.png" -> chemin in set ImgBack = _LDalphaBitmap _channel _checkpack chemin; let strcat Path "resources/_ongletForward.png" -> chemin in set ImgFwd = _LDalphaBitmap _channel _checkpack chemin; set ListCellName = nil; set Cont = _CRcontainerFromObjCont _channel father 0 0 w h CO_CHILDINSIDE /*make_rgb 158 158 158 208 200 224*/ atoi backColor "container"; /* _CBcontainerSize Cont @cbSizeContainer nil;*/ _PAINTcontainer Cont ;; /* callback of first selection of a tab */ fun FirstClick (un, deux) = 0 ;; /* create the tab's list */ fun MakeListOnglet (liste) = if liste == nil then nil else [Cont hd liste @FirstClick @AnotherClick]:: MakeListOnglet tl liste ;; /* close the interface */ fun HidePositionInterface () = _quitter nil nil ;; fun cbKeyDown2 (cont, param, key2, key) = if key == 13 then ( cbClickButton nil 1 nil nil nil nil; nil ) else if key == 26 then ( cbClickButton nil 2 nil nil nil nil; nil ) else if key == 65471 then ( cbClickButton nil 3 nil nil nil nil; nil ) else if key == 65472 then ( cbClickButton nil 4 nil nil nil nil; nil ) else if key == 65362 then if posIndex > 0 then ( _SETcompListClicked ListPos posIndex-1; cbClick_ListPos nil nil posIndex-1; _PAINTcontainer Cont; nil ) else nil else if key == 65364 then let _GETcompListCount ListPos -> compteur in if posIndex < (compteur-1) then ( _SETcompListClicked ListPos posIndex+1; cbClick_ListPos nil nil posIndex+1; _PAINTcontainer Cont; nil ) else nil else nil; 0 ;; fun cbKeyDown (cont, param, key2, key) = if key == 13 then cbClickButton nil 1 nil nil nil nil else if key == 122 then if _keybdstate == 2 then cbClickButton nil 2 nil nil nil nil else nil else if key == 65362 then if posIndex > 0 then ( _SETcompListClicked ListPos posIndex-1; cbClick_ListPos nil nil posIndex-1; _PAINTcontainer Cont; nil ) else nil else if key == 65364 then let _GETcompListCount ListPos -> compteur in if posIndex < (compteur-1) then ( _SETcompListClicked ListPos posIndex+1; cbClick_ListPos nil nil posIndex+1; _PAINTcontainer Cont; nil ) else nil else nil; 0 ;; fun cbResizeZone (param, zone) = let param -> [object x y w h] in ( _SIZEcontainer ContGeneral x y w h; _SIZEcontainer ContPere 0 0 w h; let _CONVERTcompListToObjNode ListPos -> listPos in _SIZEobjNode listPos w-73 h-146 1; _PAINTcontainer Cont; ); _PAINTcontainer ContGeneral; 0 ;; /* display the interface */ fun ShowPositionsInterface2(default_room_name, default_position, flag, focus) = let ( if Fenetre == 1 then [nil 250 150 190 210] else _DMSgetZone this "view" /*@cbConflictZone*/ nil @cbResizeZone /*@cbDestroyZone*/ nil ) -> [win xwin ywin wwin hwin] in let (wwin-98)/4 -> ecart in ( set Path = _DMSgetpath _DMSgetClass this; set OldFlag = Flag; set Flag = flag; if focus == 1 then _SETfocusContainer Cont else nil; if Update == 1 then 0 else ( _DScontainer ContGeneral; _DSfont Font; _DScompList ListPos; _DScontainer Cont; _DSbitmap SlideBmp; _DSbitmap8 SlideBmp8; _DSbitmap ListBmp; _DSbitmap8 ListBmp8; _DSbitmap ButtonBmp; _DSbitmap8 ButtonBmp8; _DSalphaBitmap ValidPic; _DSalphaBitmap InvalidPic; _DSalphaBitmap UserPic; _DStoolTip (_CONVERTcompRollOverToObjNode TeleportButton); _DStoolTip (_CONVERTcompRollOverToObjNode BackButton); _DScompRollOver TeleportButton; _DScompRollOver BackButton; set Font = _CRfont _channel 12 0 0 "arial"; if win == nil then ( set ContGeneral = _CRcontainerFromObjWin _channel nil 250 150 190 210 CO_MENU|CO_MINBOX make_rgb 158 158 158 (_loc this "TEL_TITRE" nil); set wwin = 190; set hwin = 210; set ecart = 23; set Fenetre = 1; 0 ) else ( set ContGeneral = _CRcontainerFromObjWin _channel win xwin ywin wwin hwin CO_NOBORDER|CO_CHILDINSIDE|CO_3DBORDER make_rgb 158 158 158 (_loc this "TEL_TITRE" nil); 0 ); cr_tab ContGeneral wwin hwin; let wwin-45 -> w in let hwin-90 -> h in let CreateBitmap 10 10 w h -> cpbitmap in /* let _CONVERTcompBitmapToObjNode cpbitmap -> node in*/ let set Node = _CONVERTcompBitmapToObjNode cpbitmap -> _ in ( let (h-56)/15 -> nbitem in set ListPos = _CRcompList _channel Cont Node [14 14] OBJ_ENABLE|OBJ_VISIBLE|LST_LEFT|LST_HIGHLIGHT_CLICKED|OBJ_MW_FLEX OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOVE w-28 h-56 nbitem LST_VERTICAL Font 20 [(make_rgb 0 0 0) nil nil nil] [(make_rgb /*15 34 139*/ 100 100 100) 75] [[w 0-14] OBJ_MH_FLEX|OBJ_LW_FLEX|SLB_ROLLOVER DessineSlideV 16 h [15 h-15 h]]; _CBcompListResizeResource ListPos @cbResize_List nil; _CBcompBitmapResizeResource cpbitmap @cbResizeBitmap nil ); set TeleportButton = _CRcompRollOver _channel Cont nil [15 hwin-70] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK|OBJ_LH_FLEX|OBJ_RW_FLEX OBJ_CONTAINER_MOVE TeleportAlpha; CreateToolTip Cont (_CONVERTcompRollOverToObjNode TeleportButton) (_loc this "TEL_TELEPORT" nil); set BackButton = _CRcompRollOver _channel Cont nil [(5+(4*ecart)+66) hwin-70] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK|OBJ_LH_FLEX|OBJ_LW_FLEX OBJ_CONTAINER_MOVE BackAlpha; CreateToolTip Cont (_CONVERTcompRollOverToObjNode BackButton) (_loc this "TEL_BACK" nil); _CBcompRollOverClick TeleportButton @cbClickButton 1; _CBcompRollOverClick BackButton @cbClickButton 2; _CBcompListClick ListPos @cbClick_ListPos nil; _CBcontainerKeyDown Cont @cbKeyDown nil; _CBcontainerPreDestroy ContGeneral @_quitter nil; 0 ); TBOXrstTabBox TabList; TBOXdsTabBox TabList; _DScontainer ContPere; _DScompText TextVide; set ListCellName = CreateListCellName positions; if ListCellName == nil then ( set TextVide = _CRcompText _channel Cont nil [25 hwin-70] OBJ_ENABLE|OBJ_VISIBLE|CT_CENTER|CT_LABEL|CT_WORDWRAP|OBJ_LH_FLEX nil 150 30 (_loc this "TEL_VOID" nil) Font nil nil nil nil; set Flag = 0; _RSTcompList ListPos; _DStoolTip (_CONVERTcompRollOverToObjNode GoButton); _DStoolTip (_CONVERTcompRollOverToObjNode PushButton); _DScompRollOver GoButton; _DScompRollOver PushButton; _DScompRollOver DefaultButton; _DScompText Label; _PAINTcontainer Cont; 0 ) else ( /*_DLGMessageBox _channel nil "doubleclick" "0" 0;*/ set ContPere = _CRcontainerFromObjCont _channel ContGeneral 0 0 wwin hwin CO_NOBORDER | CO_CHILDINSIDE atoi backColor ""; /* _CBcontainerMove ContPere @cbMoveContainer nil;*/ _CBcontainerSize ContPere @cbSizeContainer nil; let MakeListOnglet ListCellName -> ListOnglet in set TabList = TBOXcrTabBox _channel ContPere nil 25 ListOnglet Img [ImgBack ""] [ImgFwd ""] Font make_rgb 0 0 255 80 TBOX_ENABLETOOLTIP; let FindCell positions Cell -> liste in let FindPlaceInListPos liste Position 0 -> index in _SETcompListClicked ListPos index; if flag == 1 then if (OldFlag == 1) && (Update == 1) then 0 else if (OldFlag == 2) && (Update == 1) then ( set DefaultButton = _CRcompRollOver _channel Cont nil [25 hwin-70] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK|OBJ_LH_FLEX|OBJ_RW_FLEX|OBJ_LW_FLEX OBJ_CONTAINER_MOVE DrawRollOver (_loc this "TEL_DEFAULT" nil) 100 5*20; set Label = _CRcompText _channel Cont nil [10 hwin-45] OBJ_ENABLE|OBJ_VISIBLE|/*CT_CENTER*/CT_LEFT|CT_LABEL|CT_WORDWRAP|OBJ_LH_FLEX nil 200 30 strcatn default_room_name::" -> "::default_position::nil Font nil nil nil nil; _CBcompRollOverClick DefaultButton @cbClickDefault nil; _CBcompListDblClick ListPos @cbDblClick_ListPos nil; _CBcontainerKeyDown Cont @cbKeyDown2 nil; _PAINTcontainer Cont; 0 ) else /* if OldFlag == 3 then*/ ( /* _DScompRollOver GoButton; _DScompRollOver PushButton; _DScompRollOver DefaultButton; _DScompText Label;*/ /*_DLGMessageBox _channel nil "doubleclick" "1" 0;*/ set GoButton = _CRcompRollOver _channel Cont nil [15+ecart+22 hwin-98] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK|OBJ_LH_FLEX|OBJ_RW_FLEX|OBJ_LW_FLEX OBJ_CONTAINER_MOVE GoAlpha; CreateToolTip Cont (_CONVERTcompRollOverToObjNode GoButton) (_loc this "TEL_GO" nil); set PushButton = _CRcompRollOver _channel Cont nil [15+(2*ecart)+44 hwin-98] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK|OBJ_LH_FLEX|OBJ_RW_FLEX|OBJ_LW_FLEX OBJ_CONTAINER_MOVE PushAlpha; CreateToolTip Cont (_CONVERTcompRollOverToObjNode PushButton) (_loc this "TEL_PUSH" nil); set DefaultButton = _CRcompRollOver _channel Cont nil [25 hwin-70] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK|OBJ_LH_FLEX|OBJ_RW_FLEX|OBJ_LW_FLEX OBJ_CONTAINER_MOVE DrawRollOver (_loc this "TEL_DEFAULT" nil) 100 5*20; set Label = _CRcompText _channel Cont nil [25 hwin-45] /* MODIF */ OBJ_ENABLE|OBJ_VISIBLE|/*CT_CENTER*/CT_LEFT|CT_LABEL/*|CT_WORDWRAP*/|OBJ_LH_FLEX nil /*150*/ 200 30 strcatn default_room_name::" -> "::default_position::nil Font nil nil nil nil; _CBcompRollOverClick DefaultButton @cbClickDefault nil; _CBcompListDblClick ListPos @cbDblClick_ListPos nil; _CBcompRollOverClick GoButton @cbClickButton 3; _CBcompRollOverClick PushButton @cbClickButton 4; _CBcontainerKeyDown Cont @cbKeyDown2 nil; _PAINTcontainer Cont; 0 ) /* else nil*/ else if flag == 2 then if (OldFlag == 1) && (Update == 1) then ( /*_DLGMessageBox _channel nil "doubleclick" "2" 0;*/ _CBcompListDblClick ListPos nil nil; _DScompRollOver DefaultButton; _DScompText Label; _CBcontainerKeyDown Cont @cbKeyDown nil; _PAINTcontainer Cont; 0 ) else if (OldFlag == 2) && (Update == 1) then 0 else /* if OldFlag == 3 then*/ ( /* _DScompRollOver GoButton; _DScompRollOver PushButton;*/ /*_DLGMessageBox _channel nil "ecart" itoa ecart 0;*/ set GoButton = _CRcompRollOver _channel Cont nil [15+ecart+22 hwin-98] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK|OBJ_LH_FLEX|OBJ_RW_FLEX|OBJ_LW_FLEX OBJ_CONTAINER_MOVE GoAlpha; CreateToolTip Cont (_CONVERTcompRollOverToObjNode GoButton) (_loc this "TEL_GO" nil); set PushButton = _CRcompRollOver _channel Cont nil [15+(2*ecart)+44 hwin-98] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK|OBJ_LH_FLEX|OBJ_RW_FLEX|OBJ_LW_FLEX OBJ_CONTAINER_MOVE PushAlpha; CreateToolTip Cont (_CONVERTcompRollOverToObjNode PushButton) (_loc this "TEL_PUSH" nil); _CBcompRollOverClick GoButton @cbClickButton 3; _CBcompRollOverClick PushButton @cbClickButton 4; _PAINTcontainer Cont; 0 ) /* else nil*/ else if flag == 3 then if OldFlag == 1 then ( _DStoolTip (_CONVERTcompRollOverToObjNode GoButton); _DStoolTip (_CONVERTcompRollOverToObjNode PushButton); _DScompRollOver PushButton; _DScompRollOver GoButton; _DScompRollOver DefaultButton; _DScompText Label; /*_DLGMessageBox _channel nil "doubleclick" "3" 0;*/ _CBcompListDblClick ListPos nil nil; _CBcontainerKeyDown Cont @cbKeyDown nil; _PAINTcontainer Cont; 0 ) else if OldFlag == 2 then ( _DStoolTip (_CONVERTcompRollOverToObjNode GoButton); _DStoolTip (_CONVERTcompRollOverToObjNode PushButton); _DScompRollOver PushButton; _DScompRollOver GoButton; _PAINTcontainer Cont; 0 ) else /* if OldFlag == 3 then 0 else*/ nil else nil ) ); set Update = 1; _PAINTcontainer TabList.TBOX_MainContainer; _PAINTcontainer Cont; _PAINTcontainer ContGeneral; SelectPosition default_room_name default_position; GoShow Flag; 0 ;;