\ test.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
}

find Relocater not
iftrue
   include aux:devl/relocater
   100 Make.RTable \ create reloc table
ifend

Find SimpleBorder_f not iftrue
include SimpleBorder.f
ifend

Find RedShadowBorder_f not iftrue
include RedShadowBorder.f
ifend

Find CheckBoxBorder_f not iftrue
include CheckBoxBorder.f
ifend

Find csg_f not iftrue
include csg.f	\ complete string/integer gadget
ifend

Find tbg_f not iftrue
include tbg.f	\ text boolean gadget
ifend

anew TCSG_F

cr ." Loading test.f..." cr

\ --------------------------
\       String Gadgets
\ --------------------------

StringGadget myStrGadget1
   20 20 1	setTop\Left\ID
   15 20	StringGadgetSize
   SimpleBorder
EndStringGadget

StringGadget myStrGadget2
   20 200 2	setTop\Left\ID
   15 20	StringGadgetSize
   FrontLabel" File"
   RedShadowBorder
EndStringGadget

IntegerGadget myIGadget1
   35 20 2	setTop\Left\ID
   15		IntegerGadgetSize
   SimpleBorder
EndIntegerGadget

\ --------------------------
\       Boolean Gadgets
\ --------------------------

TextBoolGadget myTBGadget1
   55 20 3	setTop\Left\ID
   BoolGadgetText"  Bonjour! "
   SimpleBorder
EndBoolGadget

TextBoolGadget myTBGadget2
   55 200 3	setTop\Left\ID
   BoolGadgetText" Shit!"
   RedShadowBorder
EndBoolGadget

TextBoolGadget myTBGadget3
   80 100 3	setTop\Left\ID
   BoolGadgetText" CheckBox"
   CheckBoxBorder
EndBoolGadget

\ --------------------------
\         MyWindow
\ --------------------------

struct NewWindow MyWindow     MyWindow InitWindow
   120		MyWindow +nwLeftEdge	w!
   30		MyWindow +nwTopEdge	w!
   400		MyWindow +nwWidth	w!
   140		MyWindow +nwHeight	w!
   fCLOSEWINDOW 
   GADGETUP      |	MyWindow +nwIDCMPFlags    !
   WINDOWCLOSE
   ACTIVATE      |
   WINDOWDRAG    |
   WINDOWDEPTH   |
   SMART_REFRESH |
   NOCAREREFRESH |	MyWIndow +nwFlags         !
structend 


: open.window ( -- )
	MyWindow OpenWindow VerifyWindow ;


: WithGadget  ( previous-struct\gadget -- )
	swap ! ;	\ link to previous

: WithGadgetAnd ( previous-struct\gadget -- next-struct )
	dup rot !
	+ggNextGadget ;


: setups   ( -- )	\ link things to the window & open
	MyWindow +nwFirstGadget
	   myTBGadget1  WithGadgetand
	   myTBGadget2  WithGadgetand
	   myTBGadget3  WithGadgetand
	   myStrGadget1 WithGadgetand
	   myStrGadget2 WithGadgetand
	   myIGadget1   WithGadget
	open.window ;

: cleanupIDCMP   ( -- )	\ cleanup pending IDCMP messages
	begin
	   GetEvent 0=
	until
	currentwindow @ closewindow ;

: goodbye   ( -- )
	cleanupIDCMP
	?turnkey if bye  else abort then ;

find eWaitPort not
iftrue
: eWaitPort   ( Port -- Message )   !A0 exec@ 64 ;
ifend

: WaitIDCMP    ( -- ) \ on current window
	CurrentWindow @ +wdUserPort @ eWaitPort drop ;

: test      ( -- )
   do-relocation
   setups
   begin
      WaitIDCMP
      GetEvent   ( -- 0 | class )
      case
        fCloseWindow  of  goodbye  endof
      endcase
   again ;

cr ." HIT close window gadget to end; type test to see again." cr
test