/* ********************************************************************* This source file is a part of the standard library of Scol For the latest info, see http://www.scolring.org Copyright (c) 2015 Stephane Bisaro aka Iri. This program is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA, or go to http://www.gnu.org/copyleft/lesser.txt ********************************************************************* */ /* * 2d functions for Scol * See http://redmine.scolring.org/projects/tutorials/wiki/Scol_usage * for more informations */ /*! \file gselectcolors.pkg * \author Scol team * \version 0.1 * \copyright GNU Lesser General Public License 2.0 or later * \brief Scol select 2d graphic colors API * * Dependancies : * - lib/std/stdlib.pkg * - lib/2d/colors.pkg * - lib/2dos/rsc2d.pkg * - lib/std/list.pkg * * \image html gcselect.png **/ /* PRIVATE FUNCTIONS */ var L2D_GCSELECTMAPFILE = "lib/2d/rscs/colors.png";; var L2D_GCSELECTCURSORFILE = "lib/2d/rscs/cross.png";; var L2D_GCSELECTCHECKFILE = "lib/2d/rscs/checkcolor.png";; var L2D_GCSELECTLIDEFILE = "lib/2d/rscs/colorsSlide.png";; var L2D_GCSELECTBGCOLOR = 0xffffff;; var L2D_GCSELECTFOCOLOR = 0;; fun L2D_GCSELECTISRGB ()= 0;; fun L2D_GCSELECTISHSV ()= 1;; struct L2D_gColorsSelect = [ l2d_gcselectChn : Chn, l2d_gcselectWin : ObjWin, l2d_gcselectCont : ObjContainer, l2d_gcselectFont : ObjFont, l2d_gcselectAMap : AlphaBitmap, l2d_gcselectACursor : AlphaBitmap, l2d_gcselectAResult : AlphaBitmap, l2d_gcselectACResult : AlphaBitmap, // Complementary color l2d_gcselectACheck : AlphaBitmap, l2d_gcselectabSlideR : AlphaBitmap, l2d_gcselectabSlideG : AlphaBitmap, l2d_gcselectabSlideB : AlphaBitmap, l2d_gcselectabSlideValue : AlphaBitmap, l2d_gcselectabSlideSaturation : AlphaBitmap, l2d_gcselectabCancel : AlphaBitmap, l2d_gcselectabApply : AlphaBitmap, l2d_gcselectchHSV : CompCheck, l2d_gcselectchRGB : CompCheck, l2d_gcselectcMap : CompBitmap, l2d_gcselectResult : CompBitmap, l2d_gcselectResultC : CompBitmap, // Complementary color l2d_gcselectcCursor : CompBitmap, l2d_gcselectcApply : CompBitmap, l2d_gcselectcCancel : CompBitmap, l2d_gcselecttModel : CompText, l2d_gcselecttLabelHue : CompText, l2d_gcselecttLabelValue : CompText, l2d_gcselecttLabelSaturation : CompText, l2d_gcselecttValue : CompText, l2d_gcselecttSaturation : CompText, l2d_gcselecttSlideRLabel : CompText, l2d_gcselecttSlideR : CompText, l2d_gcselecttSlideGLabel : CompText, l2d_gcselecttSlideG : CompText, l2d_gcselecttSlideBLabel : CompText, l2d_gcselecttSlideB : CompText, l2d_gcselecttComplementary : CompText, l2d_gcselectcSlideValue : CompSlideBar, l2d_gcselectcSlideSaturation : CompSlideBar, l2d_gcselectcSlideR : CompSlideBar, l2d_gcselectcSlideG : CompSlideBar, l2d_gcselectcSlideB : CompSlideBar, l2d_gcselectiId : I, l2d_gcselectiType : I, l2d_gcselecttPosPreview : [I I], l2d_gcselecttColorCurrent : [I I I], // rgb, hsv, ... l2d_gcselectDestroyed : I, l2d_gcselectCbCancel : fun [I] I, l2d_gcselectCbApply : fun [I I I I I] I // id flag components 1,2,3 ] mkL2D_gColorsSelect;; typeof L2d_gcselect = [L2D_gColorsSelect r1];; typeof L2d_gcselectFontUser = ObjFont;; typeof L2d_gcselectCbCancelUser = fun [] I;; /* Initialize the structure */ fun l2d_gcselectInit ()= mkL2D_gColorsSelect [ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 0 nil nil ];; /* Free all 2d graphic objects and 2d resources */ fun l2d_gcselect_destroy (sC)= if sC.l2d_gcselectDestroyed != 0 then ( _DScompSlideBar sC.l2d_gcselectcSlideValue; _DScompSlideBar sC.l2d_gcselectcSlideSaturation; _DScompSlideBar sC.l2d_gcselectcSlideR; _DScompSlideBar sC.l2d_gcselectcSlideG; _DScompSlideBar sC.l2d_gcselectcSlideB; _DScompText sC.l2d_gcselecttModel; _DScompText sC.l2d_gcselecttLabelHue; _DScompText sC.l2d_gcselecttLabelValue; _DScompText sC.l2d_gcselecttLabelSaturation; _DScompText sC.l2d_gcselecttValue; _DScompText sC.l2d_gcselecttSaturation; _DScompText sC.l2d_gcselecttSlideRLabel; _DScompText sC.l2d_gcselecttSlideR; _DScompText sC.l2d_gcselecttSlideGLabel; _DScompText sC.l2d_gcselecttSlideG; _DScompText sC.l2d_gcselecttSlideBLabel; _DScompText sC.l2d_gcselecttSlideB; _DScompText sC.l2d_gcselecttComplementary; _DScompBitmap sC.l2d_gcselectcMap; _DScompBitmap sC.l2d_gcselectResult; _DScompBitmap sC.l2d_gcselectResultC; _DScompBitmap sC.l2d_gcselectcCursor; _DScompBitmap sC.l2d_gcselectcApply; _DScompBitmap sC.l2d_gcselectcCancel; _DScompCheck sC.l2d_gcselectchHSV; _DScompCheck sC.l2d_gcselectchRGB; _DSalphaBitmap sC.l2d_gcselectAMap; _DSalphaBitmap sC.l2d_gcselectACursor; _DSalphaBitmap sC.l2d_gcselectAResult; _DSalphaBitmap sC.l2d_gcselectACResult; _DSalphaBitmap sC.l2d_gcselectACheck; _DSalphaBitmap sC.l2d_gcselectabSlideR; _DSalphaBitmap sC.l2d_gcselectabSlideG; _DSalphaBitmap sC.l2d_gcselectabSlideB; _DSalphaBitmap sC.l2d_gcselectabSlideValue; _DSalphaBitmap sC.l2d_gcselectabSlideSaturation; _DSalphaBitmap sC.l2d_gcselectabCancel; _DSalphaBitmap sC.l2d_gcselectabApply; _DSfont sC.l2d_gcselectFont; if nil != sC.l2d_gcselectCont then _DScontainer sC.l2d_gcselectCont; if nil != sC.l2d_gcselectWin then _DSwindow sC.l2d_gcselectWin; set sC.l2d_gcselectDestroyed = 1; set L2d_gcselect = std_lRemoveElt L2d_gcselect sC; ); 0;; fun l2d_gcselectCbPreDestroyCont (o, sC)= l2d_gcselect_destroy sC; set sC = nil; 0;; // callback 'Cancel' button fun l2d_gcselectCbBtnCancel (o, sC, x, y, btn, mask)= exec sC.l2d_gcselectCbCancel with [sC.l2d_gcselectiId]; l2d_gcselect_destroy sC; set sC = nil; 0;; // callback 'Apply' button fun l2d_gcselectCbBtnApply (o, sC, x, y, btn, mask)= let sC.l2d_gcselecttColorCurrent -> [c1 c2 c3] in exec sC.l2d_gcselectCbApply with [sC.l2d_gcselectiId sC.l2d_gcselectiType c1 c2 c3]; 0;; fun l2d_gcselectGetStFromId (id)= nth_list L2d_gcselect (sizelist L2d_gcselect)-id;; fun l2d_gcselectGetComplFromRGB (sC, r, g, b)= let l2d_colorsGetComplFromRGB r g b -> [rc gc bc] in ( _SETcompText sC.l2d_gcselecttComplementary sprintf "RVB #%s%s%s" [itoh rc itoh gc itoh bc] sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] CT_BEGIN; l2d_colorsRGB2C rc gc bc );; fun l2d_gcselectCompResult (sC)= _DScompBitmap sC.l2d_gcselectResult; _DScompBitmap sC.l2d_gcselectResultC; let _GETcontainerPositionSize sC.l2d_gcselectCont -> [_ _ wc hc] in let _GETalphaBitmapSize sC.l2d_gcselectAResult -> [w h] in let sC.l2d_gcselecttPosPreview -> [x y] in //_CRcompBitmap sC.l2d_gcselectChn sC.l2d_gcselectCont nil [wc-20-w hc-h-10-30] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_ALLEVENTS sC.l2d_gcselectAResult 0 0 w h; ( set sC.l2d_gcselectResult = _CRcompBitmap sC.l2d_gcselectChn sC.l2d_gcselectCont nil [x y+20] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_ALLEVENTS sC.l2d_gcselectAResult 0 0 w h; set sC.l2d_gcselectResultC = _CRcompBitmap sC.l2d_gcselectChn sC.l2d_gcselectCont nil [x y+20+h+20+10] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_ALLEVENTS sC.l2d_gcselectACResult 0 0 w h; 0 );; fun l2d_gcselectMakeAResult (sC, c, cc)= let _DRAWrectangle _CRbitmap sC.l2d_gcselectChn 140 30 0 0 139 29 DRAW_SOLID 1 0 DRAW_SOLID c -> bmp in set sC.l2d_gcselectAResult = _CRalphaBitmap sC.l2d_gcselectChn bmp nil nil nil; let _DRAWrectangle _CRbitmap sC.l2d_gcselectChn 140 30 0 0 139 29 DRAW_SOLID 1 0 DRAW_SOLID cc -> bmp in set sC.l2d_gcselectACResult = _CRalphaBitmap sC.l2d_gcselectChn bmp nil nil nil;; // Callbacks HSV fun l2d_gcselectCbMapClick (o, sC, x, y, btn, mask)= let _GETalphaBitmapSize sC.l2d_gcselectACursor -> [wac hac] in let _GETobjNodePositionSizeInContainerRef _CONVERTcompBitmapToObjNode o -> [xo _ _ _] in let [x-xo+(wac/2) atoi _GETcompText sC.l2d_gcselecttSaturation atoi _GETcompText sC.l2d_gcselecttValue] -> [h s v] in let l2d_colors_hsv2rgb h s v -> [r g b] in let [0 0 0] -> [R G B] in ( set R = ftoi (255.0*.r); set G = ftoi (255.0*.g); set B = ftoi (255.0*.b); _CHANGEobjNodeCoordinates _CONVERTcompBitmapToObjNode sC.l2d_gcselectcCursor [x-wac/2 y-hac/2] 0; l2d_gcselectMakeAResult sC l2d_colorsrgb R G B l2d_gcselectGetComplFromRGB sC R G B; l2d_gcselectCompResult sC; set sC.l2d_gcselecttColorCurrent = [h s v]; _PAINTcontainer sC.l2d_gcselectCont; 0 );; fun l2d_gcselectCbValueChange (o, sC, v)= let _GETobjNodePositionSizeInContainerRef _CONVERTcompBitmapToObjNode sC.l2d_gcselectcMap -> [xcmap ycmap _ _] in let _GETobjNodePositionSizeInContainerRef _CONVERTcompBitmapToObjNode sC.l2d_gcselectcCursor -> [xcur ycur _ _] in let _GETalphaBitmapSize sC.l2d_gcselectACursor -> [wac _] in let [xcur-xcmap+(wac/2) atoi _GETcompText sC.l2d_gcselecttSaturation] -> [h s] in let l2d_colors_hsv2rgb h s v -> [r g b] in let [0 0 0] -> [R G B] in ( set R = ftoi (255.0*.r); set G = ftoi (255.0*.g); set B = ftoi (255.0*.b); l2d_gcselectMakeAResult sC l2d_colorsrgb R G B l2d_gcselectGetComplFromRGB sC R G B; l2d_gcselectCompResult sC; set sC.l2d_gcselecttColorCurrent = [h s v]; _SETcompText sC.l2d_gcselecttValue itoa v sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] CT_BEGIN; _PAINTcontainer sC.l2d_gcselectCont; 0 );; fun l2d_gcselectCbSaturationChange (o, sC, s)= let _GETobjNodePositionSizeInContainerRef _CONVERTcompBitmapToObjNode sC.l2d_gcselectcMap -> [xcmap ycmap _ _] in let _GETobjNodePositionSizeInContainerRef _CONVERTcompBitmapToObjNode sC.l2d_gcselectcCursor -> [xcur ycur _ _] in let _GETalphaBitmapSize sC.l2d_gcselectACursor -> [wac _] in let [xcur-xcmap+(wac/2) atoi _GETcompText sC.l2d_gcselecttValue] -> [h v] in let l2d_colors_hsv2rgb h s v -> [r g b] in let [0 0 0] -> [R G B] in ( set R = ftoi (255.0*.r); set G = ftoi (255.0*.g); set B = ftoi (255.0*.b); l2d_gcselectMakeAResult sC l2d_colorsrgb R G B l2d_gcselectGetComplFromRGB sC R G B; l2d_gcselectCompResult sC; set sC.l2d_gcselecttColorCurrent = [h s v]; _SETcompText sC.l2d_gcselecttSaturation itoa s sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] CT_BEGIN; _PAINTcontainer sC.l2d_gcselectCont; 0 );; // Callbacks RGB fun l2d_gcselectCbRedChange (o, sC, r)= let [atoi _GETcompText sC.l2d_gcselecttSlideG atoi _GETcompText sC.l2d_gcselecttSlideB] -> [g b] in ( l2d_gcselectMakeAResult sC l2d_colorsrgb r g b l2d_gcselectGetComplFromRGB sC r g b; l2d_gcselectCompResult sC; set sC.l2d_gcselecttColorCurrent = [r g b]; _SETcompText sC.l2d_gcselecttSlideR itoa r sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] CT_BEGIN; _PAINTcontainer sC.l2d_gcselectCont; 0 );; fun l2d_gcselectCbGreenChange (o, sC, g)= let [atoi _GETcompText sC.l2d_gcselecttSlideR atoi _GETcompText sC.l2d_gcselecttSlideB] -> [r b] in ( l2d_gcselectMakeAResult sC l2d_colorsrgb r g b l2d_gcselectGetComplFromRGB sC r g b; l2d_gcselectCompResult sC; set sC.l2d_gcselecttColorCurrent = [r g b]; _SETcompText sC.l2d_gcselecttSlideG itoa g sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] CT_BEGIN; _PAINTcontainer sC.l2d_gcselectCont; 0 );; fun l2d_gcselectCbBlueChange (o, sC, b)= let [atoi _GETcompText sC.l2d_gcselecttSlideR atoi _GETcompText sC.l2d_gcselecttSlideG] -> [r g] in ( l2d_gcselectMakeAResult sC l2d_colorsrgb r g b l2d_gcselectGetComplFromRGB sC r g b; l2d_gcselectCompResult sC; set sC.l2d_gcselecttColorCurrent = [r g b]; _SETcompText sC.l2d_gcselecttSlideB itoa b sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] CT_BEGIN; _PAINTcontainer sC.l2d_gcselectCont; 0 );; fun l2d_cbslide (o, u, v)= let u -> [sC t] in ( _SETcompText t itoa v sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] CT_BEGIN; _PAINTcontainer sC.l2d_gcselectCont; 0 );; fun l2d_gcselectCbCheck (o, sC, state)= if state == CHK_CHECKED then // model : RGB let _GETobjNodePositionSizeInContainerRef _CONVERTcompBitmapToObjNode sC.l2d_gcselectcMap -> [xcmap ycmap _ _] in let _GETobjNodePositionSizeInContainerRef _CONVERTcompBitmapToObjNode sC.l2d_gcselectcCursor -> [xcur ycur _ _] in let _GETalphaBitmapSize sC.l2d_gcselectACursor -> [wac _] in let l2d_colors_hsv2rgb xcur-xcmap+(wac/2) atoi _GETcompText sC.l2d_gcselecttSaturation atoi _GETcompText sC.l2d_gcselecttValue -> [r g b] in let [0 0 0] -> [R G B] in ( _SETcompText sC.l2d_gcselecttModel "RGB. Change to HSV ?" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] CT_BEGIN; _CHANGEobjNodeFlags _CONVERTcompSlideBarToObjNode sC.l2d_gcselectcSlideR OBJ_ENABLE|OBJ_VISIBLE|SLB_GAUGE 0; _CHANGEobjNodeFlags _CONVERTcompSlideBarToObjNode sC.l2d_gcselectcSlideG OBJ_ENABLE|OBJ_VISIBLE|SLB_GAUGE 0; _CHANGEobjNodeFlags _CONVERTcompSlideBarToObjNode sC.l2d_gcselectcSlideB OBJ_ENABLE|OBJ_VISIBLE|SLB_GAUGE 0; set R = ftoi (255.0*.r); set G = ftoi (255.0*.g); set B = ftoi (255.0*.b); l2d_gcselectMakeAResult sC l2d_colorsrgb R G B l2d_gcselectGetComplFromRGB sC R G B; l2d_gcselectCompResult sC; _SETcompSlideBarValue sC.l2d_gcselectcSlideR R; _SETcompSlideBarValue sC.l2d_gcselectcSlideG G; _SETcompSlideBarValue sC.l2d_gcselectcSlideB B; _CHANGEobjNodeFlags _CONVERTcompBitmapToObjNode sC.l2d_gcselectcMap OBJ_DISABLE|OBJ_VISIBLE 0; _CHANGEobjNodeFlags _CONVERTcompSlideBarToObjNode sC.l2d_gcselectcSlideValue OBJ_DISABLE|OBJ_VISIBLE|SLB_GAUGE 0; _CHANGEobjNodeFlags _CONVERTcompSlideBarToObjNode sC.l2d_gcselectcSlideSaturation OBJ_DISABLE|OBJ_VISIBLE|SLB_GAUGE 0; set sC.l2d_gcselectiType = L2D_GCSELECTISRGB; ) else // model : HSV let [atoi _GETcompText sC.l2d_gcselecttSlideR atoi _GETcompText sC.l2d_gcselecttSlideG atoi _GETcompText sC.l2d_gcselecttSlideB] -> [r g b] in let l2d_colors_rgb2hsv r g b-> [fH fS fV] in let [0 0 0] -> [H S V] in let _GETobjNodePositionSizeInContainerRef _CONVERTcompBitmapToObjNode sC.l2d_gcselectcCursor -> [_ ycur _ _] in let _GETobjNodePositionSizeInContainerRef _CONVERTcompBitmapToObjNode sC.l2d_gcselectcMap -> [xmap _ _ _] in let _GETalphaBitmapSize sC.l2d_gcselectACursor -> [wac _] in ( _SETcompText sC.l2d_gcselecttModel "HSV. Change to RGB ?" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] CT_BEGIN; _CHANGEobjNodeFlags _CONVERTcompBitmapToObjNode sC.l2d_gcselectcMap OBJ_ENABLE|OBJ_VISIBLE 0; _CHANGEobjNodeFlags _CONVERTcompSlideBarToObjNode sC.l2d_gcselectcSlideValue OBJ_ENABLE|OBJ_VISIBLE|SLB_GAUGE 0; _CHANGEobjNodeFlags _CONVERTcompSlideBarToObjNode sC.l2d_gcselectcSlideSaturation OBJ_ENABLE|OBJ_VISIBLE|SLB_GAUGE 0; set H = ftoi fH; set S = ftoi (100.0*.fS); set V = ftoi (100.0*.fV); l2d_gcselectMakeAResult sC l2d_colorsrgb r g b l2d_gcselectGetComplFromRGB sC r g b; l2d_gcselectCompResult sC; _CHANGEobjNodeCoordinates _CONVERTcompBitmapToObjNode sC.l2d_gcselectcCursor [xmap+H-(wac/2) ycur] 0; _SETcompSlideBarValue sC.l2d_gcselectcSlideSaturation S; _SETcompSlideBarValue sC.l2d_gcselectcSlideValue V; _CHANGEobjNodeFlags _CONVERTcompSlideBarToObjNode sC.l2d_gcselectcSlideR OBJ_DISABLE|OBJ_VISIBLE|SLB_GAUGE 0; _CHANGEobjNodeFlags _CONVERTcompSlideBarToObjNode sC.l2d_gcselectcSlideG OBJ_DISABLE|OBJ_VISIBLE|SLB_GAUGE 0; _CHANGEobjNodeFlags _CONVERTcompSlideBarToObjNode sC.l2d_gcselectcSlideB OBJ_DISABLE|OBJ_VISIBLE|SLB_GAUGE 0; set sC.l2d_gcselectiType = L2D_GCSELECTISHSV; ); _PAINTcontainer sC.l2d_gcselectCont; 0;; fun l2d_gcselectnew (sC, oMother, oCont, tPos, iIsInside, szTitle, cbFun)= let tPos -> [x y] in let _GETalphaBitmapSize sC.l2d_gcselectAMap -> [wam ham] in let [wam+30 310] -> [w h] in let lib2d_rscGetPath -> szRscDir in ( if (((x == nil) || (y == nil)) && (iIsInside != 1)) then let _GETscreenSize -> [ws hs] in ( if x == nil then set x = (ws/2)-(w/2); if y == nil then set y = (hs/2)-(h/2); ) else if (((x == nil) || (y == nil)) && (iIsInside == 1)) then ( set x = 0; set y = 0; ); if (oMother == nil) && (oCont != nil) then ( if iIsInside then let _GETcontainerPositionSize oCont -> [_ _ wcont hcont] in ( set w = wcont; set h = hcont; ); set sC.l2d_gcselectCont = _CRcontainerFromObjCont sC.l2d_gcselectChn oCont x y w h if iIsInside then CO_CHILDINSIDE else CO_MENU|CO_MINBOX|CO_NOSCOL L2D_GCSELECTBGCOLOR szTitle ) else if oMother != nil then ( if iIsInside then let _GETwindowPositionSize oMother -> [_ _ wwin hwin] in ( set w = wwin; set h = hwin; ); set sC.l2d_gcselectCont = _CRcontainerFromObjWin sC.l2d_gcselectChn oMother x y w h if iIsInside then CO_CHILDINSIDE else CO_MENU|CO_MINBOX|CO_NOSCOL L2D_GCSELECTBGCOLOR szTitle ) else ( set sC.l2d_gcselectWin = _CRwindow sC.l2d_gcselectChn nil x y w h WN_MENU|WN_MINBOX|WN_NOSCOL szTitle; set sC.l2d_gcselectCont = _CRcontainerFromObjWin sC.l2d_gcselectChn sC.l2d_gcselectWin x y w h CO_CHILDINSIDE L2D_GCSELECTBGCOLOR szTitle ); // message _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [5 5] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL|CT_CENTER OBJ_CONTAINER_ALLEVENTS w-10 20 "Choose and validate a color (from HSV or RGB)" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; set sC.l2d_gcselectchHSV = _CRcompCheck sC.l2d_gcselectChn sC.l2d_gcselectCont nil [5 (5*2)+20] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE 0 sC.l2d_gcselectACheck; _SETcompCheckState sC.l2d_gcselectchHSV CHK_CHECKED; _CBcompCheckStateChanged sC.l2d_gcselectchHSV @l2d_gcselectCbCheck sC; _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [35 (5*2)+20] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL OBJ_CONTAINER_ALLEVENTS 75 20 "Current model : " sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; set sC.l2d_gcselecttModel = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [120 (5*2)+20] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL OBJ_CONTAINER_ALLEVENTS 200 20 "RGB. Change to HSV ?" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; // title hsv //_CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [5 (5*2)+20] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL OBJ_CONTAINER_ALLEVENTS 100 20 "- From HSV :" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; // map (hue) set sC.l2d_gcselecttLabelHue = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [5 (5*3)+20+20] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL OBJ_CONTAINER_ALLEVENTS 10 20 "H" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; set sC.l2d_gcselectcMap = _CRcompBitmap sC.l2d_gcselectChn sC.l2d_gcselectCont nil [(5*2)+10 (5*4)+20+20] OBJ_DISABLE|OBJ_VISIBLE 0 sC.l2d_gcselectAMap 0 0 wam ham; _CBcompBitmapClick sC.l2d_gcselectcMap @l2d_gcselectCbMapClick sC; // value set sC.l2d_gcselectabSlideValue = _LDalphaBitmap sC.l2d_gcselectChn _checkpack L2D_GCSELECTLIDEFILE; set sC.l2d_gcselecttLabelValue = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [5 (5*6)+40+ham] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL OBJ_CONTAINER_ALLEVENTS 10 20 "V" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; set sC.l2d_gcselectcSlideValue = _CRcompSlideBar sC.l2d_gcselectChn sC.l2d_gcselectCont nil [(5*2)+10 (5*6)+40+ham] OBJ_DISABLE|OBJ_VISIBLE|SLB_GAUGE 0 sC.l2d_gcselectabSlideValue [10 110 120] SLB_HORIZONTAL 0 100 1; set sC.l2d_gcselecttValue = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [(5*2)+10+125 (5*6)+40+ham] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL|CT_SELECT OBJ_CONTAINER_ALLEVENTS 50 20 "0" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; _CBcompSlideBarValue sC.l2d_gcselectcSlideValue @l2d_gcselectCbValueChange sC; // saturation set sC.l2d_gcselectabSlideSaturation = _LDalphaBitmap sC.l2d_gcselectChn _checkpack L2D_GCSELECTLIDEFILE; set sC.l2d_gcselecttLabelSaturation = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [5 (5*7)+40+ham+20] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL OBJ_CONTAINER_ALLEVENTS 10 20 "S" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; set sC.l2d_gcselectcSlideSaturation = _CRcompSlideBar sC.l2d_gcselectChn sC.l2d_gcselectCont nil [(5*2)+10 (5*7)+40+ham+20] OBJ_DISABLE|OBJ_VISIBLE|SLB_GAUGE 0 sC.l2d_gcselectabSlideSaturation [10 110 120] SLB_HORIZONTAL 0 100 1; set sC.l2d_gcselecttSaturation = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [(5*2)+10+125 (5*7)+40+ham+20] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL|CT_SELECT OBJ_CONTAINER_ALLEVENTS 50 20 "0" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; _CBcompSlideBarValue sC.l2d_gcselectcSlideSaturation @l2d_gcselectCbSaturationChange sC; // title rgb _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [35 (5*8)+40+ham+40] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL OBJ_CONTAINER_ALLEVENTS 100 20 "- From RGB :" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; //set sC.l2d_gcselectchRGB = _CRcompCheck sC.l2d_gcselectChn sC.l2d_gcselectCont nil [5 (5*8)+40+ham+40] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE 0 sC.l2d_gcselectACheck; //_SETcompCheckState sC.l2d_gcselectchRGB CHK_CHECKED; //_CBcompCheckStateChanged sC.l2d_gcselectchRGB @l2d_gcselectCbCheck sC; //set sC.l2d_gcselectndRGB = _CONVERTcompCheckToObjNode sC.l2d_gcselectchRGB; // slide red set sC.l2d_gcselectabSlideR = _LDalphaBitmap sC.l2d_gcselectChn _checkpack L2D_GCSELECTLIDEFILE; set sC.l2d_gcselecttSlideRLabel = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [5 ham+100+(5*9)] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL OBJ_CONTAINER_ALLEVENTS 10 20 "R" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; set sC.l2d_gcselectcSlideR = _CRcompSlideBar sC.l2d_gcselectChn sC.l2d_gcselectCont nil [(5*2)+10 ham+100+(5*9)] OBJ_ENABLE|OBJ_VISIBLE|SLB_GAUGE 0 sC.l2d_gcselectabSlideR [10 110 120] SLB_HORIZONTAL 0 255 1; set sC.l2d_gcselecttSlideR = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [(5*2)+10+125 ham+100+(5*9)] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL|CT_SELECT OBJ_CONTAINER_ALLEVENTS 50 20 "0" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; _CBcompSlideBarValue sC.l2d_gcselectcSlideR @l2d_gcselectCbRedChange sC; // slide green set sC.l2d_gcselectabSlideG = _LDalphaBitmap sC.l2d_gcselectChn _checkpack L2D_GCSELECTLIDEFILE; set sC.l2d_gcselecttSlideGLabel = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [5 ham+100+20+(5*10)] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL OBJ_CONTAINER_ALLEVENTS 10 20 "G" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; set sC.l2d_gcselectcSlideG = _CRcompSlideBar sC.l2d_gcselectChn sC.l2d_gcselectCont nil [(5*2)+10 ham+100+20+(5*10)] OBJ_ENABLE|OBJ_VISIBLE|SLB_GAUGE 0 sC.l2d_gcselectabSlideG [10 110 120] SLB_HORIZONTAL 0 255 1; set sC.l2d_gcselecttSlideG = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [(5*2)+10+125 ham+100+20+(5*10)] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL|CT_SELECT OBJ_CONTAINER_ALLEVENTS 50 20 "0" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; _CBcompSlideBarValue sC.l2d_gcselectcSlideG @l2d_gcselectCbGreenChange sC; // slide blue set sC.l2d_gcselectabSlideB = _LDalphaBitmap sC.l2d_gcselectChn _checkpack L2D_GCSELECTLIDEFILE; set sC.l2d_gcselecttSlideBLabel = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [5 ham+100+20+20+(5*11)] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL OBJ_CONTAINER_ALLEVENTS 10 20 "B" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; set sC.l2d_gcselectcSlideB = _CRcompSlideBar sC.l2d_gcselectChn sC.l2d_gcselectCont nil [(5*2)+10 ham+100+20+20+(5*11)] OBJ_ENABLE|OBJ_VISIBLE|SLB_GAUGE 0 sC.l2d_gcselectabSlideB [10 110 120] SLB_HORIZONTAL 0 255 1; set sC.l2d_gcselecttSlideB = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [(5*2)+10+125 ham+100+20+20+(5*11)] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL|CT_SELECT OBJ_CONTAINER_ALLEVENTS 50 20 "0" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; _CBcompSlideBarValue sC.l2d_gcselectcSlideB @l2d_gcselectCbBlueChange sC; // cursor (for hue) let _GETalphaBitmapSize sC.l2d_gcselectACursor -> [wac hac] in let _GETobjNodePositionSizeInContainerRef _CONVERTcompBitmapToObjNode sC.l2d_gcselectcMap -> [xcmap ycmap _ _] in set sC.l2d_gcselectcCursor = _CRcompBitmap sC.l2d_gcselectChn sC.l2d_gcselectCont nil [xcmap-(wac/2) ycmap+(hac/4)] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_ALLEVENTS sC.l2d_gcselectACursor 0 0 wac hac; _TOPobjNode _CONVERTcompBitmapToObjNode sC.l2d_gcselectcCursor; // color preview _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [w-150 (5*6)+40+ham] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL OBJ_CONTAINER_ALLEVENTS 140 20 "Color preview :" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; set sC.l2d_gcselecttPosPreview = [w-150 (5*6)+40+ham]; // complementary color preview _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [w-150 (5*6)+40+ham+60] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL OBJ_CONTAINER_ALLEVENTS 140 20 "Complementary preview :" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; set sC.l2d_gcselecttComplementary = _CRcompText sC.l2d_gcselectChn sC.l2d_gcselectCont nil [w-150 (5*6)+40+ham+60+60] OBJ_ENABLE|OBJ_VISIBLE|CT_LABEL|CT_SELECT|CT_CENTER OBJ_CONTAINER_ALLEVENTS 140 20 "RGB ; #000000" sC.l2d_gcselectFont [L2D_GCSELECTFOCOLOR nil nil nil] nil nil nil; // cancel button lib2d_rscSetPath "lib/2d/rscs/"; set sC.l2d_gcselectabCancel = _LDalphaBitmap _channel _checkpack lib2d_rscCancel; let _GETalphaBitmapSize sC.l2d_gcselectabCancel -> [wcancel hcancel] in set sC.l2d_gcselectcCancel = _CRcompBitmap sC.l2d_gcselectChn sC.l2d_gcselectCont nil [5 h-hcancel-5] OBJ_ENABLE|OBJ_VISIBLE 0 sC.l2d_gcselectabCancel 0 0 wcancel hcancel; _CBcompBitmapClick sC.l2d_gcselectcCancel @l2d_gcselectCbBtnCancel sC; // apply button set sC.l2d_gcselectabApply = _LDalphaBitmap _channel _checkpack lib2d_rscApply; let _GETalphaBitmapSize sC.l2d_gcselectabCancel -> [wapply hcapply] in set sC.l2d_gcselectcApply = _CRcompBitmap sC.l2d_gcselectChn sC.l2d_gcselectCont nil [w-wapply-5 h-hcapply-5] OBJ_ENABLE|OBJ_VISIBLE 0 sC.l2d_gcselectabApply 0 0 wapply hcapply; _CBcompBitmapClick sC.l2d_gcselectcApply @l2d_gcselectCbBtnApply sC; lib2d_rscSetPath szRscDir; l2d_gcselectMakeAResult sC 0 0xffffff; l2d_gcselectCompResult sC; //l2d_gcselectCbCheck nil sC CHK_CHECKED; set sC.l2d_gcselectiType = L2D_GCSELECTISRGB; set sC.l2d_gcselecttColorCurrent = [0 0 0]; set sC.l2d_gcselectCbApply = cbFun; _CBcontainerPreDestroy sC.l2d_gcselectCont @l2d_gcselectCbPreDestroyCont sC; _PAINTcontainer sC.l2d_gcselectCont; set sC.l2d_gcselectiId = sizelist L2d_gcselect // dialog id );; /* PUBLIC FUNCTIONS */ /*! \brief Create a colors map graphical user interface. * * One only interface can be called simultaneously. * * In the mostly cases, other API functions should be called before. * * \ingroup l2d_selectcolors * Prototype : fun [Chn ObjWin ObjContainer [I I] I S fun [I] u0] I * * \param Chn : the owner channel. * \param ObjWin : the window mother, can be nil. In this last case, the parent will be ObjContainer. * \param ObjContainer : the container father. Can be nil too. In this last case, the gui will be created ex-nihilo. * \param [I I] : the x, y coordinates. One or both can be nil, in this case, the gui will be centered (vertically and/or honrizontaly) * \param I : the gui should be inside the parent (1) or not (other integer). * \param S : the title of the gui. * \param fun [I I I I I] I : the apply callback. The arguments are : * - the dialog box id * - the color model : L2D_GCSELECTISRGB or L2D_GCSELECTISHSV * - the 1st color component ('red' or 'hue') * - the 2nd color component ('green' or 'saturation') * - the 3rd color component ('blue' or 'value') * \return I : the dialog identifier if success else nil (typically, a bad map file name or the map color file is not found or the font is incorrect). * * \see l2d_gcselectCbCancel * \see l2d_gcselectDestroy **/ fun l2d_gcselectNew (chn, oMother, oCont, tPos, iIsInside, szTitle, cbFun)= let l2d_gcselectInit -> c in if c == nil then nil else ( set L2d_gcselect = c :: L2d_gcselect; set c.l2d_gcselectChn = chn; if L2d_gcselectFontUser == nil then set c.l2d_gcselectFont = _CRfont chn 12 0 0 "Arial" else set c.l2d_gcselectFont = L2d_gcselectFontUser; set c.l2d_gcselectACursor = _LDalphaBitmap c.l2d_gcselectChn _checkpack L2D_GCSELECTCURSORFILE; set c.l2d_gcselectAMap = _LDalphaBitmap c.l2d_gcselectChn _checkpack L2D_GCSELECTMAPFILE; set c.l2d_gcselectACheck = _LDalphaBitmap c.l2d_gcselectChn _checkpack L2D_GCSELECTCHECKFILE; //l2d_gcselectAResult chn L2D_GCSELECTBGCOLOR; if (c.l2d_gcselectAMap != nil) && (c.l2d_gcselectFont != nil) && (c.l2d_gcselectACursor != nil) && (c.l2d_gcselectChn != nil) && (c.l2d_gcselectACheck != nil) then l2d_gcselectnew c oMother oCont tPos iIsInside szTitle cbFun else nil );; /*! \brief Set the background color. The interface will be immediately repaint, if any. * * By default, it is white (0xffffff). * * \ingroup l2d_selectcolors * Prototype : fun [I I] I * * \param I : the new background color. If nil, the old color is kept. * \param I : the colors dialog id. Can be nil if no colors dialog set. * \return I : the color. **/ fun l2d_gcselectSetBgColor (iBgColor, iC)= set L2D_GCSELECTBGCOLOR = iBgColor; if (iC != nil) && (iC > 0) then let l2d_gcselectGetStFromId iC -> sC in if sC.l2d_gcselectCont != nil then _SETcontainerBackgroundColor sC.l2d_gcselectCont L2D_GCSELECTBGCOLOR 1; L2D_GCSELECTBGCOLOR;; /*! \brief Set the foreground color. * * By default, it is black (0). * * \ingroup l2d_selectcolors * Prototype : fun [I] I * * \param I : the new background color. If nil, the old color is kept. * \return I : the color. **/ fun l2d_gcselectSetFoColor (iFoColor)= if L2D_GCSELECTFOCOLOR != nil then set L2D_GCSELECTFOCOLOR = iFoColor; L2D_GCSELECTFOCOLOR;; /*! \brief Returns the foreground color. * * By default, it is black (0). * * \ingroup l2d_selectcolors * Prototype : fun [] I * * \return I : the current background color. **/ fun l2d_gcselectGetBgColor ()= L2D_GCSELECTBGCOLOR;; /*! \brief Returns the background color. * * By default, it is white (0xffffff). * * \ingroup l2d_selectcolors * Prototype : fun [] I * * \return I : the current background color. **/ fun l2d_gcselectGetFoColor ()= L2D_GCSELECTFOCOLOR;; /*! \brief Set the colors map file. * * By default, it is "lib/2d/rscs/colors.png". * * \ingroup l2d_selectcolors * Prototype : fun [S] S * * \param S : the new colors map file. It should be a PNG file. If nil, the old file is kept. * \return S : the file name. **/ fun l2d_gcselectSetMapFile (szFile)= if szFile != nil then set L2D_GCSELECTMAPFILE = szFile; L2D_GCSELECTMAPFILE;; /*! \brief Returns the colors map file. * * By default, it is "lib/2d/rscs/colors.png". * * \ingroup l2d_selectcolors * Prototype : fun [] S * * \return S : the current file name. **/ fun l2d_gcselectGetMapFile ()= L2D_GCSELECTMAPFILE;; /*! \brief Set the check resource file. * * By default, it is "lib/2d/rscs/checkcolor.png". * * \ingroup l2d_selectcolors * Prototype : fun [S] S * * \param S : the new check resource file. It should be a PNG file. If nil, the old file is kept. * \return S : the file name. **/ fun l2d_gcselectSetCheckFile (szFile)= if szFile != nil then set L2D_GCSELECTCHECKFILE = szFile; L2D_GCSELECTCHECKFILE;; /*! \brief Returns the check resource file. * * By default, it is "lib/2d/rscs/checkcolor.png". * * \ingroup l2d_selectcolors * Prototype : fun [] S * * \return S : the current file name. **/ fun l2d_gcselectGetCheckFile ()= L2D_GCSELECTCHECKFILE;; /*! \brief Set the cursor file. * * By default, it is "lib/2d/rscs/cross.bmp". * * \ingroup l2d_selectcolors * Prototype : fun [S] S * * \param S : the new cursor file. It should be a PNG file. If nil, the old file is kept. * \return S : the cursor file name. **/ fun l2d_gcselectSetCursorFile (szFile)= if szFile != nil then set L2D_GCSELECTCURSORFILE = szFile; L2D_GCSELECTCURSORFILE;; /*! \brief Returns the cursor file. * * By default, it is "lib/2d/rscs/cross.bmp". * * \ingroup l2d_selectcolors * Prototype : fun [] S * * \return S : the current cursor file name. **/ fun l2d_gcselectGetCursorFile ()= L2D_GCSELECTCURSORFILE;; /*! \brief Set the font text. * * By default, it is "Arial" in size 12. * * \ingroup l2d_selectcolors * Prototype : fun [ObjFont] ObjFont * * \param ObjFont : the new font Scol object. If nil, the old file is kept. * \return ObjFont : the used Scol font object. **/ fun l2d_gcselectSetFont (oFont)= if oFont != nil then set L2d_gcselectFontUser = oFont; L2d_gcselectFontUser;; /*! \brief Returns the current font text. * * \ingroup l2d_selectcolors * Prototype : fun [] ObjFont * * \return ObjFont : the current Scol font object. **/ fun l2d_gcselectGetFont ()= L2d_gcselectFontUser;; /*! \brief Set the cancelling callback. * * By default, it is nil (no call). 'Cancel' closes the dialog box. * * \ingroup l2d_selectcolors * Prototype : fun [fun [I] I] I * * \param fun [I] I : the new cancelling callback. The argument is the dialog box id. * \return I : always 0. **/ fun l2d_gcselectSetCbCancel (cbfun)= set L2d_gcselectCbCancelUser = cbfun; 0;; /*! \brief Set the apply callback. * * \ingroup l2d_selectcolors * Prototype : fun [I fun [I I I I I] I] I * * \param I : id dialog * \param fun [I I I I I] I : the new apply callback. The arguments are : * - the dialog box id * - the color model : L2D_GCSELECTISRGB or L2D_GCSELECTISHSV * - the 1st color component ('red' or 'hue') * - the 2nd color component ('green' or 'saturation') * - the 3rd color component ('blue' or 'value') * \return I : always 0. * * Note : 'Apply' doesn't close the dialog. For that, the user must click on 'Cancel'. **/ fun l2d_gcselectSetCbApply (iId, cbfun)= let l2d_gcselectGetStFromId iId -> sC in set sC.l2d_gcselectCbApply = cbfun; 0;; /*! Destroy the colors map interface without the user choice. * * \ingroup l2d_selectcolors * Prototype : fun [] I * * \param I : id dialog * \return I : 0 if success, else nil **/ fun l2d_gcselectDestroy (iId)= let l2d_gcselectGetStFromId iId -> sC in l2d_gcselect_destroy sC; 0;;