\ ---------------------------------------------------
\ RedShadowBorder.f
\ ---------------------------------------------------
{  TBG.f and CSG.f Version 1.0
   Text Boolean Gadgets and String/Integer gadget creation helper.

   by Marc Lupien,  Montreal, Canada.
   June of 1988
   CIS user no. 71550,640
}
{ 
These words allocate and define Borders and coordinates pairs.
For use with words StringGadget, IntegerGadget and
   TextBoolGadget.
}
\ ---------------------------------------------------

Find GDefault_F not
Iftrue
  include GDefault.f
Ifend

\ requires SimpleBorder.f

find SimpleBorder_F not
iftrue
   include SimpleBorder.f
ifend

Find RedShadowBorder_f not
Iftrue
cr ." loading RedShadowBorder.f..." cr  decimal

anew RedShadowBorder_f

\ create appropriate PairData for the red shadow

	Create RedBdPdTight	\ tight around the select box
	6 w,	\ nb. of pairs defined
	paWidth+ w,	 1 w,	paABS w,	 0 w,
	paWidth+ w,	 1 w,	paHeight+ w,	 1 w,
	paABS w,	 0 w,	paHeight+ w,	 1 w,
	paABS w,	 0 w,	paHeight+ w,	 2 w,
	paWidth+ w,	 2 w,	paHeight+ w,	 2 w,
	paWidth+ w,	 2 w,	paABS w,	 0 w,

	Create RedBdPdSlack	\ slack around the select box
	6 w,	\ nb. of pairs defined
	paWidth+ w,	 4 w,	paABS w,	 0 w,
	paWidth+ w,	 4 w,	paHeight+ w,	 2 w,
	paABS w,	 0 w,	paHeight+ w,	 2 w,
	paABS w,	 0 w,	paHeight+ w,	 3 w,
	paWidth+ w,	 5 w,	paHeight+ w,	 3 w,
	paWidth+ w,	 5 w,	paABS w,	 0 w,

\ Box with a red shadow

: RedShadowBorder   ( Gadget -- Gadget )
	1 needed ?exec		\ check stack depth and exec state
	0 0 locals| bdStruct1 bdStruct2 Gstruct |
	myFrontPen      AllotBorder to bdStruct1
	bdStruct1 Gstruct  +ggGadgetRender R!
	myHighlightPen  AllotBorder to bdStruct2
	bdStruct2 bdStruct1 +bdNextBorder R!
	bdStruct1
	   Gstruct STRGADGET?
		if   SimpleBdPdSlack
		else SimpleBdPdTight  then
	   Gstruct AllotPairs
	bdStruct2
	   Gstruct STRGADGET?
		if   RedBdPdSlack
		else RedBdPdTight  then
	   Gstruct AllotPairs
	Gstruct ; immediate

Ifend