Program boopsi_1;
uses

	Exec,Intuition,Utility;

const

	MINWINDOWWIDTH  = 100;
	MINWINDOWHEIGHT = 50;

  VISIBLE         = 10;
	TOTAL           = 100;
	INITIALVAL      = 25;
	MAXCHAR         = 3;
	
	PROPGADGETID    = 1;
	PROPGADGETTOP   = 12;
	PROPGADGETWIDTH = 10;
	RELRIGHT        = -13;
	RELHEIGHT       = -23; { 2 * -11 - 1 }
	
	STRGADGETID     = 2;
	STRGADGETTOP    = 30;
	STRGADGETLEFT   = 20;
	STRGADGETWIDTH  = 50;
	STRGADGETHEIGHT = 12;

	wintags : array[0..5] of tTagItem =
		( ( ti_Tag : WA_Flags    ; ti_Data : 0 ), 
		  ( ti_Tag : WA_IDCMP    ; ti_Data : 0 ),
		  ( ti_Tag : WA_Title    ; ti_Data : 0 ),
		  ( ti_Tag : WA_MinWidth ; ti_Data : MINWINDOWWIDTH ),
		  ( ti_Tag : WA_MinHeight; ti_Data : MINWINDOWHEIGHT ),
		  ( ti_Tag : TAG_END     ; ti_Data : 0 ));
		  
	proptags : array[0..24] of LONG = 
		( GA_TOP,       PROPGADGETTOP ,
      GA_RELRIGHT,  RELRIGHT ,
      GA_WIDTH,		  PROPGADGETWIDTH ,	
      GA_RELHEIGHT, RELHEIGHT ,
      GA_ID,		    PROPGADGETID ,
      GA_IMMEDIATE ,TRUE_,
      GA_RELVERIFY, TRUE_,
      PGA_FREEDOM,  FREEVERT,
      PGA_VISIBLE,  VISIBLE,		
      PGA_TOTAL,    TOTAL ,
      PGA_TOP,      INITIALVAL,
      PGA_NewLook , TRUE_ ,
      TAG_END );

	stringtags : array[0..20] of LONG =
		( GA_ID,                 STRGADGETID ,
      GA_TOP,		             STRGADGETTOP ,
      GA_LEFT,               STRGADGETLEFT ,
      GA_WIDTH,		           STRGADGETWIDTH ,
      GA_IMMEDIATE,	         TRUE_ ,
      GA_RELVERIFY,	         TRUE_ ,
      GA_HEIGHT,             STRGADGETHEIGHT ,
      STRINGA_MaxChars,      MAXCHAR ,
      STRINGA_LongVal,       INITIALVAL ,	
      STRINGA_Justification, GACT_STRINGRIGHT ,
      TAG_END );

	w : pWindow = NIL;

	title : string = ' Gadgety BOOPSI '#0;

var

	propgadget,
	strgadget   : pGadget;

	classID     : string;

	dummy       : long;
	
	t           : array[0..20] of tTagItem;

Procedure CleanUp( s : string );
begin
	writeln( s );
	if ( w <> NIL ) then
		CloseWindow( w );
	if ( IntuitionBase <> NIL ) then
		CloseLibrary( pLibrary(IntuitionBase) );
	halt(0);
end;

Procedure MainLoop( w : pWindow );
var
  dummy    : longint;
  Imessage : pIntuiMessage;   
  class    : long;            
  quit     : boolean;
  gadget   : pGadget;
  val      : LONG;         
begin
  quit := FALSE;                          
  repeat
    dummy := Wait( BitMask( w^.UserPort^.MP_SIGBIT ) );
    Imessage := pIntuiMessage(GetMsg( w^.UserPort ) );
    while Imessage <> NIL do begin
      class   := Imessage^.class;       
      gadget  := pGadget(Imessage^.IAddress);
      ReplyMsg(pMessage(Imessage));     
      case class of

        IDCMP_CLOSEWINDOW: quit := TRUE;
        
        IDCMP_GADGETUP   : 
	        case gadget^.GadgetID of
	
  	      	PROPGADGETID:
    	    		begin
      	  			dummy := GetAttr( PGA_TOP , gadget , @val );
        				t[0].ti_Tag := STRINGA_LongVal ; t[0].ti_Data := val ;
        				t[1].ti_Tag := TAG_END;
        				dummy := SetAttrsA( strgadget , @t[0] );
        				RefreshGList( propgadget , w , NIL , -1 );
        			end;
        	
	        	STRGADGETID :          
  	      		begin
    	    			dummy := GetAttr( STRINGA_LongVal , gadget , @val );
      	  			t[0].ti_Tag := PGA_TOP ; t[0].ti_Data := val ;
        				t[1].ti_Tag := TAG_END;
        				dummy := SetGadgetAttrsA( propgadget , w , NIL , @t[0] );
        			end;
	        end;
      end;
      
      Imessage := pIntuiMessage(GetMsg( w^.UserPort ))
    
    end;
  until quit
end;

BEGIN

	IntuitionBase := pIntuitionBase(OpenLibrary( 'intuition.library' , 37 ));

	if ( IntuitionBase = NIL ) then 
		CleanUp( 'Nie moge otworzyc Biblioteki Intuition wer. 37');

	with wintags[0] do
		ti_Data := WFLG_DEPTHGADGET OR
	             WFLG_DRAGBAR OR
	             WFLG_CLOSEGADGET OR
	             WFLG_SIZEGADGET;

	with wintags[1] do
		ti_Data := IDCMP_CLOSEWINDOW OR
		           IDCMP_GADGETUP;
		           
  with wintags[2] do
  	ti_Data := LONG( @title[1] );

	w := OpenWindowTagList( NIL , @wintags[0] );

	if ( w = NIL ) then
		CleanUp( 'Nie moge otworzyc okna' );

	classID := 'propgclass'#0;

	propgadget := NewObjectA( NIL , @classID[1] , @proptags[0] );

	if propgadget <> NIL then
		begin

			classID := 'strgclass'#0;

			t[0].ti_Tag := GA_Previous ; t[0].ti_Data := long( propgadget );
			t[1].ti_Tag := TAG_MORE ;    t[1].ti_Data := long( @stringtags[0] );
			t[2].ti_Tag := TAG_END;
			
			strgadget := NewObjectA( NIL , @classID[1] , @t[0] );
			
			if strgadget <> NIL then
				begin

					dummy := AddGList( w , propgadget , $FFFF , -1 , NIL );  

          RefreshGList( propgadget , w , NIL , -1 );

					MainLoop( w );

  				dummy := RemoveGList( w , propgadget , -1 );

  				DisposeObject( strgadget ); 

  			end;

  		DisposeObject( propgadget );

		end;

	CleanUp(' OK ')

END.