MODULE WMColorComponents; (** AUTHOR "FN"; PURPOSE "Color Tools GUI"; *) IMPORT Strings, KernelLog, Raster, Texts, TextUtilities, XML, WMStandardComponents, WMGraphics, WMGraphicUtilities, WMComponents, WMRectangles, WMEditors, WMWindowManager, WMProperties, WMDropTarget, WMPopups, WMEvents; TYPE ChangeHandler = PROCEDURE {DELEGATE}; ColorChangeHandler = PROCEDURE {DELEGATE} (sender, color : ANY); Color* = OBJECT VAR value* : WMGraphics.Color END Color; ColorDropTarget = OBJECT(WMDropTarget.DropTarget) VAR setColor : ColorChangeHandler; PROCEDURE & Init*(cch : ColorChangeHandler); BEGIN setColor := cch END Init; PROCEDURE GetInterface*(type : LONGINT) : WMDropTarget.DropInterface; VAR cdi : ColorDropInterface; BEGIN IF type = WMDropTarget.TypeInt32 THEN NEW(cdi, setColor); RETURN cdi ELSE RETURN NIL END END GetInterface; END ColorDropTarget; ColorDropInterface = OBJECT(WMDropTarget.DropInt32) VAR setColor : ColorChangeHandler; PROCEDURE & Init*(cch : ColorChangeHandler); BEGIN setColor := cch END Init; PROCEDURE Set*(i : LONGINT); VAR c : Color; BEGIN NEW(c); c.value := i; setColor(SELF, c) END Set; END ColorDropInterface; (** a controlled input-filed for numeric inputs *) NumberInput* = OBJECT(WMComponents.VisualComponent) VAR input : WMEditors.Editor; buttons : WMStandardComponents.Panel; caption -: WMStandardComponents.Label; min-, max-, value- : WMProperties.Int32Property; changeHandler : ChangeHandler; PROCEDURE & Init*; VAR plus, minus : WMStandardComponents.Button; BEGIN Init^; SetNameAsString(StrNumberInput); SetGenerator("WMColorComponents.GenNumberInput"); (* properties *) NEW(min, NIL, Strings.NewString("Min"), Strings.NewString("Minimal value")); properties.Add(min); NEW(max, NIL, Strings.NewString("Max"), Strings.NewString("Maximal value")); properties.Add(max); NEW(value, NIL, Strings.NewString("Value"), Strings.NewString("Model")); properties.Add(value); (* bounds *) bounds.SetHeight(21); (* caption *) NEW(caption); caption.alignment.Set(WMComponents.AlignLeft); AddInternalComponent(caption); caption.bounds.SetWidth(10); caption.fillColor.Set(0FFFFFFFFH); (* input field *) NEW(input); input.multiLine.Set(FALSE); input.bounds.SetWidth(30); input.alignment.Set(WMComponents.AlignLeft); input.tv.showBorder.Set(TRUE); AddInternalComponent(input); input.tv.textAlignV.Set(WMGraphics.AlignCenter); input.text.onTextChanged.Add(ValueChanged); (* buttons *) NEW(buttons); buttons.bounds.SetWidth(20); buttons.alignment.Set(WMComponents.AlignLeft); AddInternalComponent(buttons); (* plus *) NEW(plus); plus.bounds.SetHeight(10); plus.SetCaption("+"); plus.useBgBitmaps.Set(FALSE); plus.alignment.Set(WMComponents.AlignTop); plus.onClick.Add(Increment); plus.isRepeating.Set(TRUE); buttons.AddInternalComponent(plus); (* minus *) NEW(minus); minus.bounds.SetHeight(10); minus.SetCaption("-"); minus.useBgBitmaps.Set(FALSE); minus.alignment.Set(WMComponents.AlignTop); minus.onClick.Add(Decrement); minus.isRepeating.Set(TRUE); buttons.AddInternalComponent(minus); END Init; (* update input editor *) PROCEDURE RecacheProperties*; VAR buf : ARRAY 128 OF CHAR; BEGIN Strings.IntToStr(value.Get(), buf); input.SetAsString(buf) END RecacheProperties; PROCEDURE PropertyChanged*(sender, prop : ANY); BEGIN IF prop = value THEN RecacheProperties ELSE PropertyChanged^(sender, prop) END END PropertyChanged; PROCEDURE Increment(sender, data : ANY); BEGIN IF value.Get() < max.Get() THEN value.Set(value.Get() + 1); PropertyChanged(SELF, value); changeHandler() END END Increment; PROCEDURE Decrement(sender, data : ANY); BEGIN IF value.Get() > min.Get() THEN value.Set(value.Get() - 1); PropertyChanged(SELF, value); changeHandler() END END Decrement; (* called if user modifies the input-field *) PROCEDURE ValueChanged(sender, data : ANY); VAR buf : ARRAY 128 OF CHAR; new : LONGINT; BEGIN input.GetAsString(buf); IF ~IsNumber(buf) THEN RecacheProperties ELSE Strings.StrToInt(buf, new); IF (new # value.Get()) THEN IF (new >= min.Get()) & (new <= max.Get()) THEN value.Set(new); changeHandler() ELSE RecacheProperties END END END END ValueChanged; END NumberInput; (** gui-component to specify a color in red-green-blue-transparency *) NumericColorChooser* = OBJECT(WMStandardComponents.Panel) VAR r, g, b, t : NumberInput; (* red, green, blue, transparency *) colorChangeHandler : ColorChangeHandler; (* to be called when color has been changed from inside this object *) PROCEDURE & Init*; BEGIN Init^; SetNameAsString(StrNumericColorChooser); SetGenerator("WMColorComponents.GenNumericColorChooser"); (* red *) NEW(r); r.alignment.Set(WMComponents.AlignTop); AddInternalComponent(r); r.caption.SetCaption("R"); r.min.Set(0); r.max.Set(255); r.changeHandler := NumberInputChanged; (* green *) NEW(g); g.alignment.Set(WMComponents.AlignTop); AddInternalComponent(g); g.caption.SetCaption("G"); g.min.Set(0); g.max.Set(255); g.changeHandler := NumberInputChanged; (* blue *) NEW(b); b.alignment.Set(WMComponents.AlignTop); AddInternalComponent(b); b.caption.SetCaption("B"); b.min.Set(0); b.max.Set(255); b.changeHandler := NumberInputChanged; (* transparency *) NEW(t); t.alignment.Set(WMComponents.AlignTop); AddInternalComponent(t); t.caption.SetCaption("T"); t.min.Set(0); t.max.Set(255); t.changeHandler := NumberInputChanged; (* handler *) colorChangeHandler := DefaultColorChangeHandler END Init; PROCEDURE SetColor*(sender, color : ANY); VAR c : LONGINT; BEGIN IF color IS Color THEN c := color(Color).value; t.value.Set(c MOD 256); c := c DIV 256; b.value.Set(c MOD 256); c := c DIV 256; g.value.Set(c MOD 256); c := c DIV 256; r.value.Set(c MOD 256); END END SetColor; PROCEDURE SetExternalColorChangeHandler*(cch : ColorChangeHandler); BEGIN colorChangeHandler := cch END SetExternalColorChangeHandler; PROCEDURE NumberInputChanged; VAR c : Color; BEGIN NEW(c); c.value := (256*256*256)*r.value.Get() + (256*256)*g.value.Get() + (256)*b.value.Get() + t.value.Get(); colorChangeHandler(SELF, c) END NumberInputChanged; PROCEDURE DefaultColorChangeHandler(sender, color : ANY); END DefaultColorChangeHandler; END NumericColorChooser; (** saves a color-value temporarly, color can be dragged from and unto *) ColorPot *= OBJECT(WMStandardComponents.Panel) VAR dragPossible : BOOLEAN; colorChangeHandler : ColorChangeHandler; PROCEDURE & Init*; BEGIN Init^; SetNameAsString(StrColorPot); SetGenerator("WMColorComponents.GenColorPot"); onStartDrag.Add(MyStartDrag); colorChangeHandler := DefaultColorChangeHandler END Init; (* draw a line around the panel *) PROCEDURE DrawBackground*(c : WMGraphics.Canvas); VAR rect : WMRectangles.Rectangle; h, w : LONGINT; BEGIN rect := GetClientRect(); w := rect.r DIV 2; h := rect.b DIV 2; (* background *) c.Fill(WMRectangles.MakeRect(0, 0, w, h), LONGINT(0AAAAAAFFH), WMGraphics.ModeCopy); c.Fill(WMRectangles.MakeRect(w, h, 2*w, 2*h), LONGINT(0AAAAAAFFH), WMGraphics.ModeCopy); (* current color *) DrawBackground^(c); (* frame *) WMGraphicUtilities.DrawRect(c, GetClientRect(), WMGraphics.Black, WMGraphics.ModeSrcOverDst) END DrawBackground; (* return a string with the hex representation of the current color. the string is lead by a '0' and terminated by a 'H' *) PROCEDURE GetHexValue(VAR hex: ARRAY OF CHAR); VAR buf : ARRAY 10 OF CHAR; i : LONGINT; BEGIN Strings.IntToHexStr(fillColor.Get(), 7, buf); hex[0] := '0'; FOR i := 1 TO 8 DO hex[i] := buf[i-1] END; hex[9] := 0X; END GetHexValue; (* set current color for this pot. color will be displayed in GUI *) PROCEDURE SetColor*(sender, color : ANY); BEGIN IF color IS Color THEN fillColor.Set(color(Color).value) END END SetColor; (* default handler; just sets color *) PROCEDURE DefaultColorChangeHandler(sender, color : ANY); BEGIN SetColor(sender, color) END DefaultColorChangeHandler; (* overwrite default handler *) PROCEDURE SetExternalColorChangeHandler*(cch : ColorChangeHandler); BEGIN colorChangeHandler := cch END SetExternalColorChangeHandler; (* ----- mouse handlers ----------------------------------------- *) PROCEDURE PointerDown*(x, y : LONGINT; keys : SET); BEGIN ASSERT(IsCallFromSequencer()); dragPossible := TRUE END PointerDown; PROCEDURE PointerUp*(x, y : LONGINT; keys : SET); BEGIN dragPossible := FALSE END PointerUp; PROCEDURE PointerMove*(x, y : LONGINT; keys : SET); BEGIN IF dragPossible THEN dragPossible := FALSE; AutoStartDrag() END END PointerMove; (* ----- drag and drop handlers ----------------------------------- *) (* called when a drag-operation has been started *) PROCEDURE MyStartDrag(sender, data : ANY); VAR img : WMGraphics.Image; c : WMGraphics.BufferCanvas; a : ANY; BEGIN NEW(img); Raster.Create(img, 15, 15, Raster.BGRA8888); NEW(c, img); c.Fill(WMRectangles.MakeRect(0, 0, 15, 15), fillColor.Get(), WMGraphics.ModeCopy); IF StartDrag(a, img, 0,0,DragArrived, NIL) THEN KernelLog.String("DraggingStarted"); KernelLog.Ln ELSE KernelLog.String("Drag could not be started"); KernelLog.Ln END END MyStartDrag; (* called when color dragged from here has been dropped elsewhere *) PROCEDURE DragArrived(sender, data : ANY); VAR di : WMWindowManager.DragInfo; dt : WMDropTarget.DropTarget; itf : WMDropTarget.DropInterface; text : Texts.Text; textPos : Texts.TextPosition; hex: ARRAY 10 OF CHAR; res : WORD; BEGIN IF (data # NIL) & (data IS WMWindowManager.DragInfo) THEN di := data(WMWindowManager.DragInfo); IF (di.data # NIL) & (di.data IS WMDropTarget.DropTarget) THEN dt := di.data(WMDropTarget.DropTarget) ELSE RETURN END ELSE RETURN END; (* drop text *) itf := dt.GetInterface(WMDropTarget.TypeText); IF itf # NIL THEN text := itf(WMDropTarget.DropText).text; textPos := itf(WMDropTarget.DropText).pos; IF (text # NIL) & (textPos # NIL) THEN text.AcquireWrite; GetHexValue (hex); TextUtilities.StrToText(text, textPos.GetPosition(), hex); text.ReleaseWrite; END; RETURN END; (* drop integer *) itf := dt.GetInterface(WMDropTarget.TypeInt32); IF itf # NIL THEN itf(WMDropTarget.DropInt32).Set(fillColor.Get()); RETURN END; itf := dt.GetInterface(WMDropTarget.TypeString); IF itf # NIL THEN GetHexValue(hex); itf(WMDropTarget.DropString).Set(hex, res); RETURN; END; END DragArrived; (* called by MyDraggedDropped *) PROCEDURE DragDropped*(x, y : LONGINT; dragInfo : WMWindowManager.DragInfo); VAR dt : ColorDropTarget; BEGIN NEW(dt, colorChangeHandler); dragInfo.data := dt; ConfirmDrag(TRUE, dragInfo) END DragDropped; END ColorPot; (** gui-component to choose and manage colors; consisting of a color palette, a numeric color-input and temporary color-stores *) ColorChooser* = OBJECT(WMStandardComponents.Panel) VAR title -: WMStandardComponents.Label; customPots : WMStandardComponents.Panel; numericInputs : NumericColorChooser; palette : WMPopups.ColorSwatchPanel; showColor : ColorPot; onColorChosen : WMEvents.EventSource; color : WMGraphics.Color; PROCEDURE & Init*; VAR main, pnl : WMStandardComponents.Panel; pot : ColorPot; BEGIN Init^; SetNameAsString(StrColorChooser); SetGenerator("WMColorComponents.GenColorChooser"); (* title *) NEW(title); title.bounds.SetHeight(20); title.alignment.Set(WMComponents.AlignTop); title.fillColor.Set(0CCCCCCFFH); title.SetCaption("ColorChooser"); AddInternalComponent(title); (* main panel *) NEW(main); main.bounds.SetWidth(190); main.alignment.Set(WMComponents.AlignLeft); AddInternalComponent(main); (* palette *) NEW(palette); palette.alignment.Set(WMComponents.AlignTop); palette.bearing.SetHeight(20); main.AddInternalComponent(palette); palette.ChosenColorProc := SetColor; (* custom pots for temporary color storage *) NEW(customPots); customPots.bounds.SetWidth(19); customPots.alignment.Set(WMComponents.AlignLeft); customPots.bearing.SetWidth(20); main.AddInternalComponent(customPots); NEW(pot); pot.bearing.SetHeight(2); pot.bounds.SetHeight(19); pot.alignment.Set(WMComponents.AlignTop); customPots.AddInternalComponent(pot); NEW(pot); pot.bearing.SetHeight(2); pot.bounds.SetHeight(19); pot.alignment.Set(WMComponents.AlignTop); customPots.AddInternalComponent(pot); NEW(pot); pot.bearing.SetHeight(2); pot.bounds.SetHeight(19); pot.alignment.Set(WMComponents.AlignTop); customPots.AddInternalComponent(pot); NEW(pot); pot.bearing.SetHeight(2); pot.bounds.SetHeight(19); pot.alignment.Set(WMComponents.AlignTop); customPots.AddInternalComponent(pot); (* show color button *) NEW(pnl); pnl.alignment.Set(WMComponents.AlignLeft); pnl.bounds.SetWidth(75); main.AddInternalComponent(pnl); NEW(showColor); showColor.bounds.SetHeight(82); showColor.bounds.SetHeight(82); showColor.alignment.Set(WMComponents.AlignTop); showColor.SetExternalColorChangeHandler(ShowColorChangeHandler); pnl.AddInternalComponent(showColor); (* numeric inputs *) NEW(numericInputs); numericInputs.alignment.Set(WMComponents.AlignRight); numericInputs.bounds.SetWidth(60); main.AddInternalComponent(numericInputs); numericInputs.SetExternalColorChangeHandler(SetColor2); (* views-registration *) NEW(onColorChosen, SELF, Strings.NewString("OnColorChosen"), Strings.NewString("Listeners are called if a new color has been chosen"), NIL); onColorChosen.Add(showColor.SetColor); onColorChosen.Add(numericInputs.SetColor); (* model initialization *) SetColor(000000FFH); END Init; PROCEDURE SetColor(color : WMGraphics.Color); VAR c : Color; BEGIN SELF.color := color; NEW(c); c.value := color; onColorChosen.Call(c) END SetColor; PROCEDURE SetColor2(sender, color : ANY); BEGIN IF color IS Color THEN SetColor(color(Color).value) END END SetColor2; (* plugin-handler for showColor *) PROCEDURE ShowColorChangeHandler(sender, color : ANY); BEGIN showColor.SetColor(sender, color); SetColor2(sender, color) END ShowColorChangeHandler; END ColorChooser; VAR StrNumberInput, StrNumericColorChooser, StrColorPot, StrColorChooser : Strings.String; (* ----- helpers --------------------------------------- *) PROCEDURE IsNumber(CONST str : ARRAY OF CHAR) : BOOLEAN; VAR i : LONGINT; BEGIN i := 0; WHILE str[i] # 0X DO IF (str[i] < '0') OR (str[i] > '9') THEN RETURN FALSE END; INC(i) END; RETURN TRUE END IsNumber; PROCEDURE InitStrings; BEGIN StrNumberInput := Strings.NewString("NumberInput"); StrNumericColorChooser := Strings.NewString("NumericColorChooser"); StrColorPot := Strings.NewString("ColorPot"); StrColorChooser := Strings.NewString("ColorChooser"); END InitStrings; PROCEDURE GenNumberInput*() : XML.Element; VAR numberInput :NumberInput; BEGIN NEW(numberInput); RETURN numberInput; END GenNumberInput; PROCEDURE GenNumericColorChooser*() : XML.Element; VAR numericColorChooser : NumericColorChooser; BEGIN NEW(numericColorChooser); RETURN numericColorChooser; END GenNumericColorChooser; PROCEDURE GenColorPot*() : XML.Element; VAR colorPot : ColorPot; BEGIN NEW(colorPot); RETURN colorPot; END GenColorPot; PROCEDURE GenColorChooser*() : XML.Element; VAR colorChooser : ColorChooser; BEGIN NEW(colorChooser); RETURN colorChooser; END GenColorChooser; BEGIN InitStrings; END WMColorComponents.