PROGRAM GetOpt;
     
USES DOS, Exec, Intuition, utility, gadtools, graphics, AmigaDOS, LSKExtras;

TYPE
	ch2A = ARRAY[0..1] of char;
	
CONST
   
   LLGad  = 1; CCGad  = 2;
   Bool_1 = 3; Bool_2 = 4; { used as gadget ID's and array identifiers}
   
   Vers        : string = '$VER: GetOpt v1.0 © Lee S Kindness 18.12.93'#0;
   ScreenTitle : string = 'GetOption v1.0 (c)1993 LSK...';
      
VAR
   Gads                    : ARRAY [LLGad..Bool_2] OF pGadget;
   Gad_Tags                : tNewGadget;
   My_Font                 : tTextAttr;
   screendef               : pScreen;
   visualinf               : pointer;
   TheWindow               : pWindow;
   TBorderS                : INTEGER;
   Gad1txt, Gad2txt, title : STRING;
   DrawInf                 : pDrawInfo;
   IntText                 : tIntuiText;
   ch1, ch2                : ch2A;
   Txt1len, txt2len        : integer; 
   
   
{ ===================================================================== }

Procedure ErrExit(Errortxt : string; ExitCode : integer);

Begin
	ErrorExit('** GetOption Error **', Errortxt);
	CloseLibrary(pLibrary(IntuitionBase));
	If GadToolsBase <> NIL then CloseLibrary(pLibrary(GadtoolsBase));
	If TheWindow <> NIL then CloseWindow(TheWindow);
	If gads[LLGad] <> NIL then FreeGadgets(gads[LLGad]);
	If VisualInf <> NIL then FreeVisualInfo(VisualInf);
	Halt(exitcode);
end;
  
{ ===================================================================== }

PROCEDURE open_libs; { open used libraries }

BEGIN
	IntuitionBase := NIL;
   IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',34));
   if IntuitionBase = NIL then halt(122);
   If IntuitionBase^.LibNode.lib_Version < 36 Then
    	ErrExit('Intuition library v36 (2.0) required'#0, 122);
    	      
   GadToolsBase := NIL; 
   GadToolsBase  := Openlibrary('gadtools.library',36); 
   IF GadtoolsBase = NIL THEN 
   	ErrExit('Gadtools Library v36 (2.0) required'#0, 122);

	UtilityBase := NIL;
   UtilityBase  := Openlibrary('utility.library',36); 
   IF utilityBase = NIL THEN 
   	ErrExit('Utility Library v36 (2.0) required'#0, 122);
END;

{ ===================================================================== }

Function RetrieveStr(p : pointer) : string;
Type
  a = Packed Array [0..255] Of Char;     { fills a string with the }
Var                                      { contents of the string  }
  i    : Integer;                        { pointed at              }
  sptr : ^a;                             { (from HSPC init.unit)   }
  s    : string;
Begin
  sptr := p;
  s := '';
  i := 0;
  While sptr^[i] <> #0 Do Begin
    s := s + sptr^[i];
    inc(i)
  End;
  RetrieveStr := s
End;

{ ===================================================================== }

PROCEDURE open_window;

CONST
	PubName : string = 'error';
	
VAR 
	Win_Tags    : ARRAY[0..15] OF tTagItem;
	UScore_Tags : ARRAY[0..1] OF tTagItem;
	xsze        : integer;
	LockKey : Longint;
	PS_List : pList;
	My_Node : pPubScreenNode;

BEGIN
	gads[LLGad]  := NIL;
	LockKey := LockIBase(0);
	screendef := IntuitionBase^.ActiveScreen;
	PS_List := LockPubScreenList;
	My_Node := pPubScreenNode(PS_List^.lh_Head);
	While My_Node^.psn_Node.ln_Succ <> NIL Do Begin
		If my_Node^.psn_Screen = screendef Then
			PubName := retrievestr(My_Node^.psn_Node.ln_Name);
		My_Node := pPubScreenNode(My_Node^.psn_Node.ln_Succ);
	End;
	UnLockPubScreenList;
	UnlockIBase(LockKey);
	
	If pubname = 'error' Then Begin
		screendef := lockPubScreen(NIL);
   	If screendef = NIL Then 
      	ErrExit('Failed to lock public screen'#0, 0);
   End Else Begin
		pubname := pubname + #0;
   	screendef := lockPubScreen(@PubName[1]);
   	If screendef = NIL Then 
      	ErrExit('Failed to lock public screen'#0, 0);
	End;
	
   VisualInf := GetVisualInfoA(screendef, NIL);
   IF visualinf = NIL THEN
      ErrExit('Failed to get visual info'#0, 0);
   Gads[CCGad] := CreateContext(@gads[LLGad]);
   IF Gads[CCGad] = NIL THEN
      ErrExit('Failed to create context'#0, 0);
   TBorderS := screendef^.WBorTop + (screendef^.Font^.ta_YSize + 1);
   
   DrawInf := GetScreenDrawInfo(screendef);
{ get the screens font }
	WITH My_Font DO BEGIN
      ta_Name  := DrawInf^.dri_font^.tf_message.mn_Node.ln_Name;
      ta_YSize := DrawInf^.dri_font^.tf_YSize;
      ta_Style := DrawInf^.dri_font^.tf_Style;
      ta_Flags := DrawInf^.dri_font^.tf_Flags;
   END;
   XSze := TBorderS + 1;
   
   IntText.ITextFont := @My_Font;
   IntText.IText     := @Gad1txt[1];
	txt1len := IntuiTextLength(@IntText);
	txt1len := txt1len + 10;
	IntText.IText     := @Gad2txt[1];
	txt2len := IntuiTextLength(@IntText);
	txt2len := txt2len + 10;
   
{ Initilise gadget structures }
   WITH Gad_Tags DO BEGIN
      ng_TextAttr   := @My_Font;
      ng_LeftEdge   := 8;
      ng_TopEdge    := TBorderS + 2;
      ng_Width      := txt1len;
      ng_Height     := XSze;
      ng_GadgetText := @Gad1txt[1];
      ng_VisualInfo := VisualInf;
      ng_GadgetID   := Bool_1;
   END;
   UScore_Tags[0].ti_Tag  := GT_Underscore;
   UScore_Tags[0].ti_Data := LONG('~');
   UScore_Tags[1].ti_Tag  := TAG_END;
{ create gadgets }
   Gads[Bool_1] := CreateGadgetA(BUTTON_KIND, Gads[CCGad], @Gad_Tags, @UScore_Tags);
   WITH Gad_Tags DO BEGIN
   	ng_Leftedge   := txt1len + 14;
   	ng_Width      := txt2len;
      ng_GadgetText := @Gad2txt[1];
      ng_GadgetID   := Bool_2;
   END;
   Gads[Bool_2] := CreateGadgetA(BUTTON_KIND, Gads[Bool_1], @Gad_Tags, @UScore_Tags);
      IF Gads[CCGad] = NIL THEN
      ErrExit('Failed to create gadgets'#0, 0);
{ window structure }
   Win_Tags[0].ti_Tag  := WA_InnerWidth;
   Win_Tags[0].ti_Data := txt1len + 14 + txt2len;
   Win_Tags[1].ti_Tag  := WA_InnerHeight;
   Win_Tags[1].ti_Data := XSze + 4;
   Win_Tags[2].ti_Tag  := WA_Left;
   Win_Tags[2].ti_Data := screendef^.MouseX - ((txt1len + 14 + txt2len) div 2);
   Win_Tags[3].ti_Tag  := WA_Top;
   Win_Tags[3].ti_Data := screendef^.MouseY - ((XSze + 4) div 2);
   Win_Tags[4].ti_Tag  := WA_Title;
   Win_Tags[4].ti_Data := LONG(@title[1]); 
   Win_Tags[5].ti_Tag  := WA_IDCMP;
   Win_Tags[5].ti_Data := IDCMP_REFRESHWINDOW 
   							  OR BUTTONIDCMP
   							  OR IDCMP_VANILLAKEY
   							  OR IDCMP_MOUSEBUTTONS;
   Win_Tags[6].ti_Tag  := WA_DragBar;
   Win_Tags[6].ti_Data := True_;
   Win_Tags[7].ti_Tag  := WA_Gadgets;
   Win_Tags[7].ti_Data := LONG(gads[LLGad]);
   Win_Tags[8].ti_Tag  := WA_SimpleRefresh;
   Win_Tags[8].ti_Data := True_;
   Win_Tags[9].ti_Tag  := WA_Activate;
   Win_Tags[9].ti_Data := True_;
   Win_Tags[10].ti_Tag := WA_ScreenTitle;
   Win_Tags[10].ti_Data:= LONG(@ScreenTitle[1]);
   Win_Tags[11].ti_Tag := WA_RMBTrap;
   Win_Tags[11].ti_Data:= True_; 
   Win_Tags[12].ti_Tag  := WA_DepthGadget;
   Win_Tags[12].ti_Data := True_;
	Win_Tags[13].ti_Tag := WA_PubScreenName;
   Win_Tags[13].ti_Data:= LONG(@pubname[1]);
   Win_Tags[14].ti_Tag := WA_PubScreenFallBack;
   Win_Tags[14].ti_Data:= True_;
   Win_Tags[15].ti_Tag := TAG_DONE;
   
   TheWindow := OpenWindowTaglist(NIL,@Win_Tags);
   IF TheWindow = NIL THEN
      ErrExit('Failed to create window'#0, 206);
   GT_RefreshWindow(TheWindow, NIL);
   UnlockPubScreen(NIL, screendef);
END;
{ ===================================================================== }

PROCEDURE Close_Libs;   { close all opened libs }
BEGIN
   CloseLibrary(pLibrary(IntuitionBase));
   CloseLibrary(pLibrary(GadtoolsBase));
   CloseLibrary(pLibrary(UtilityBase));
END;

{ ===================================================================== }

PROCEDURE Close_Window;
BEGIN
   CloseWindow(TheWindow);       { close window and free gadgets and }
   FreeGadgets(gads[LLGad]);     { visualinfo                        }
   FreeVisualInfo(VisualInf);
END;

{ ===================================================================== }

FUNCTION HandleIDCMP : ShortInt;
CONST
   exitflag : shortint = -33;
   
VAR                                { the main loop of the program. }
   dummy      : longint;           { monitors IDCMP messages and   }
   message    : pIntuiMessage;     { responds as appropriate       }
   MsgClass   : LongInt;
   MsgCode    : Word;
   gadcode    : pGadget;
   tempint    : ARRAY[1..4] of longint;
   small      : boolean;

BEGIN
	tempint[4] := TheWindow^.Height;
	Small := false;
   WHILE exitflag < 0 DO BEGIN
      dummy    := Wait(BitMask(TheWindow^.UserPort^.MP_SIGBIT));
      repeat
      	message  := GT_GetIMsg(TheWindow^.userPort);
      	MsgClass := message^.Class;
      	MsgCode  := message^.Code;
      	GadCode  := pGadget(message^.IAddress);
      	GT_ReplyIMsg(message);
      	CASE MsgClass OF
      	
      		IDCMP_MOUSEBUTTONS : begin
      			CASE MsgCode OF
      				MENUUP : begin
      					tempint[1] := TheWindow^.LeftEdge;
    	 	 				tempint[2] := TheWindow^.TopEdge;
     		 				tempint[3] := TheWindow^.Width;
     		 				IF Small then begin
      						ChangeWindowBox(TheWindow, tempint[1], tempint[2], tempint[3], Tempint[4]);
      						Small := false;
      					end else begin
      						ChangeWindowBox(TheWindow, tempint[1], tempint[2], tempint[3], TBorderS);
      						Small := true;
      					end;
      				end;
      			end;
      		end;
      		
         	IDCMP_REFRESHWINDOW : BEGIN
            	GT_BeginRefresh(TheWindow);
            	GT_EndRefresh(TheWindow, TRUE);
         	END;
         	
         	IDCMP_GADGETUP : BEGIN
            	CASE gadcode^.GadgetID OF
               	Bool_1 : ExitFlag := 0;   
               	Bool_2 : ExitFlag := RETURN_WARN;
            	END; {case}
         	END; {case}
         	
         	IDCMP_VANILLAKEY : BEGIN
         		IF (Chr(MsgCode) = ch1[0]) OR (Chr(MsgCode) = ch1[1]) OR
         										(Chr(MsgCode) = '0') then ExitFlag := 0;
         		IF (Chr(MsgCode) = ch2[0]) OR (Chr(MsgCode) = ch2[1]) OR
         										(Chr(MsgCode) = '1') then ExitFlag := RETURN_WARN
         	END;
      	END; {case}
      until message = NIL;
   END; {while}
   HandleIDCMP := ExitFlag;
END;

{ ===================================================================== }

Function MakeUScore(strn : string; VAR ch : char) : string;

{ Puts a ~ in front of the first letter, this letter is outputted as ch }
{ and forms the keyboard shortcut.                                      }

VAR tmp : string;
	n : byte;

Begin
	strn := strn + ' '; 
	tmp[0] := strn[0]; 
	tmp[1] := '~'; 
	For n := 1 to length(strn)-1 do begin
		tmp[n+1] := strn[n];
	end;
	ch := tmp[2];
	MakeUScore := tmp;
end;
	
{ ==== Main Procedure ================================================= }

PROCEDURE main;

VAR ErrorCode, n : Shortint;
	tmp1, tmp2 : string;
	c1, c2 : byte;
	
	

BEGIN
	IF NOT (paramstr(1) = '?') then begin
		CASE Paramcount OF
		2 : begin
				tmp1 := paramstr(1);
				tmp2 := paramstr(2);
				Title := 'What''s your choice?'#0;
				ScreenTitle := ScreenTitle + ' ' + 'What''s your choice?' + #0;
			 end;
		1 : begin
				tmp1 := paramstr(1);
				tmp2 := 'Shell';
				Title := 'What''s your choice?'#0;
				ScreenTitle := ScreenTitle + ' ' + 'What''s your choice?' + #0;
			 end;
		0 : begin
				tmp1 := 'Workbench';
				tmp2 := 'Shell';
				Title := 'What''s your choice?'#0;
				ScreenTitle := ScreenTitle + ' ' + 'What''s your choice?' + #0;
			 end;
		else begin
				tmp1 := paramstr(1);
				tmp2 := paramstr(2);
				title := paramstr(3) + #0;
				ScreenTitle := ScreenTitle + ' ' + Paramstr(3) + #0;
			 end;
		end;
		Gad1txt := MakeUScore(tmp1, ch1[0]) + #0;
		Gad2txt := MakeUScore(tmp2, ch2[0]) + #0;
		Open_Libs;
		ch1[0] := chr(ToLower(ord(ch1[0])));
      ch1[1] := chr(ToUpper(ord(ch1[0])));
		ch2[0] := chr(ToLower(ord(ch2[0])));
		ch2[1] := chr(ToUpper(ord(ch2[0])));
   	Open_Window;
   	ErrorCode := HandleIDCMP; 
   	close_Window;
   	Close_Libs;
   	Halt(ErrorCode);
	end else begin
   	Writeln('GetOption (c)LSK. USAGE: GetOption [Button1txt] [button2txt] [WindowTitle]');
   	writeln('                         Return ok for button 1, Return warn for button 2 ');
   	Halt(116);
	end;
END;

{ =================================================================== }

BEGIN
main
END.