Recent

Author Topic: [Done] $50 - Create an example of using Gadgets in Intuition for AmigaOS 3.x  (Read 4171 times)

Trenatos

  • Hero Member
  • *****
  • Posts: 535
    • MarcusFernstrom.com
I'm having trouble getting Gadgets to work in Intuition for AmigaOS 3.x

All I'm needing is a working example of an Intuition window with three different gadgets and how to read their values/respond to actions/IDCMP messages for them.

Gadgets: Text input, Button, Checkbox/Radio/Toggle (Pick one)

Payment through PayPal.
« Last Edit: March 24, 2024, 10:20:51 pm by Trenatos »

Trenatos

  • Hero Member
  • *****
  • Posts: 535
    • MarcusFernstrom.com
Re: $50 - Create an example of using Gadgets in Intuition for AmigaOS 3.x
« Reply #1 on: March 24, 2024, 10:20:23 pm »
Many thanks to TRon for providing the following example!
I've tested it on AROS 68k as well as AmigaOS 3.x

Code: Pascal  [Select][+][-]
  1. program trenatos;
  2.  
  3. {$ifndef HASAMIGA}
  4. {$fatal This source is compatible with Amiga, AROS and MorphOS only !}
  5. {$endif}
  6.  
  7. {$h+}{$hints ON}
  8.  
  9.  
  10. {
  11.   Project     : gadtools gadgets example for Trenatos
  12.   Details     : modified example from RKRM to match request
  13.   Reference   : RKRM, gadtoolsgadgets.c
  14.   Date        : 2024-03-17
  15. }
  16.  
  17.  {*
  18.  ** Simple example of using a number of gadtools gadgets.
  19.  *}
  20.  
  21. uses
  22.   exec, agraphics, intuition, gadtools, utility;
  23.  
  24.  
  25. {$ifdef AROS}
  26. {* sight, 12 years and still going strong !! outrage ! *}
  27. function  GT_GetGadgetAttrs(gad:pGadget; win:pWindow; req:pRequester; Const argv:array of PtrUInt): LONGINT; begin GT_GetGadgetAttrs:=GT_GetGadgetAttrsA(gad,win,req,@argv); end;
  28. procedure GT_SetGadgetAttrs(gad:pGadget; win:pWindow; req:pRequester; Const argv:array of PtrUInt); begin GT_SetGadgetAttrsA(gad,win,req,@argv); end;
  29. function  CreateGadget(kind:ULONG; gad:pGadget; ng:pNewGadget; Const argv:array of PtrUInt): pGadget; begin CreateGadget:=CreateGadgetA(kind,gad,ng,@argv); end;
  30. function  GetVisualInfo(screen:pScreen; const argv:array of PtrUInt):POINTER; begin GetVisualInfo:=GetVisualInfoA(screen,@argv); end;
  31. {$endif}
  32.  
  33.  
  34. type
  35.   {*
  36.   ** Gadget defines of our choosing, to be used as GadgetID's,
  37.   ** also used as the index into the gadget array my_gads[].
  38.   *}
  39.   TMyGadgets = (tmgString, tmgCheckBox, tmgRadioBtn, tmgButton);
  40.  
  41. const
  42.  
  43.   Topaz80       : TTextAttr =
  44.   (
  45.     ta_Name     : 'topaz.font';
  46.     ta_YSize    : 8;
  47.     ta_Style    : 0;
  48.     ta_Flags    : 0;
  49.   );
  50.  
  51.  
  52. var
  53.   // strings used for the radiobuttons. This declaration must
  54.   // be similar to ppchar, e.g. terminated with zero.
  55.   RadioStrings : array[0..3] of pchar = ('Free Pascal','on','Amiga', nil);
  56.  
  57.  
  58. {*
  59. ** Print any error message.  We could do more fancy handling (like
  60. ** an EasyRequest()), but this is only a demo.
  61. *}
  62. procedure errorMessage(error: STRPTR);
  63. begin
  64.   if assigned(error)
  65.     then WriteLn('Error: ', error);
  66. end;
  67.  
  68.  
  69. {*
  70. ** Function to handle a GADGETUP or GADGETDOWN event.  For GadTools gadgets,
  71. ** it is possible to use this function to handle MOUSEMOVEs as well, with
  72. ** little or no work.
  73. *}
  74. procedure handleGadgetEvent(win: PWindow; gad: PGadget; code: UWORD; my_gads: array of PGadget);
  75. var
  76.   StrBuf             : pchar;
  77.   CheckBoxStatus     : longbool;
  78.   SelectedRadioIndex : ulong;
  79.   n                  : integer;  // number of requested/returned attributes, if they differ then an error occured.
  80. begin
  81.   case TMyGadgets(gad^.GadgetID) of
  82.     tmgSTRING:
  83.     begin
  84.       //* String gadgets report GADGETUP's */
  85.       WriteLn('String gadget 1: "', PStringInfo(gad^.SpecialInfo)^.Buffer ,'".');
  86.     end;
  87.  
  88.     tmgCheckBox:
  89.     begin
  90.       writeln('checkbox clicked');
  91.     end;
  92.  
  93.     tmgRADIOBTN:
  94.     begin
  95.       //* String gadgets report GADGETUP's */
  96.       WriteLn('radio button clicked');
  97.     end;
  98.  
  99.     tmgButton:
  100.     begin
  101.       //* Buttons report GADGETUP's */
  102.       WriteLn('Button was pressed, now displaying some gadget info.');
  103.  
  104.       // obtain and emit info on string gadget
  105.       n := GT_GetGadgetAttrs(my_gads[ord(tmgString)], win, nil,
  106.       [
  107.          GTST_String, AsTag(@StrBuf),
  108.          TAG_END
  109.       ]);
  110.       if n = 1 then writeln('string contents = "', StrBuf, '"')
  111.       else writeln('unable to obtain contents from string gadget');
  112.  
  113.       // obtain and emit info on CheckBox gadget
  114.       n := GT_GetGadgetAttrs(my_gads[ord(tmgCheckBox)], win, nil,
  115.       [
  116.         GTCB_Checked, AsTag(@CheckBoxStatus),
  117.         TAG_END
  118.       ]);
  119.       if n = 1 then writeln('checkbox status = ', CheckBoxStatus)
  120.       else writeln('unable to obtain status from CheckBox gadget');
  121.  
  122.       // obtain and emit info on MX gadget
  123.       n := GT_GetGadgetAttrs(my_gads[ord(tmgRadioBtn)], win, nil,
  124.       [
  125.         GTMX_Active, AsTag(@SelectedRadioIndex),
  126.         TAG_END
  127.       ]);
  128.       if n = 1 then writeln('selected radio (string) index = ', SelectedRadioIndex)
  129.       else writeln('unable to obtain index from RadioBtn (MX) gadget');
  130.  
  131.     end;
  132.   end;
  133. end;
  134.  
  135.  
  136. {*
  137. ** Function to handle vanilla keys.
  138. *}
  139. procedure handleVanillaKey(win: PWindow; code: UWORD; my_gads: array of PGadget);
  140. begin
  141.   case chr(code) of
  142.     'f', 'F':
  143.     begin
  144.       ActivateGadget(my_gads[ord(tmgSTRING)], win, nil);
  145.     end;
  146.     's', 'S':
  147.     begin
  148.       ActivateGadget(my_gads[ord(tmgCHECKBOX)], win, nil);
  149.     end;
  150.     't', 'T':
  151.     begin
  152.       ActivateGadget(my_gads[ord(tmgRADIOBTN)], win, nil);
  153.     end;
  154.   end;
  155. end;
  156.  
  157.  
  158. {*
  159. ** Here is where all the initialization and creation of GadTools gadgets
  160. ** take place.  This function requires a pointer to a NULL-initialized
  161. ** gadget list pointer.  It returns a pointer to the last created gadget,
  162. ** which can be checked for success/failure.
  163. *}
  164. function  createAllGadgets(var glistptr: PGadget; vi: Pointer;
  165.     topborder: UWORD; var my_gads: array of PGadget): PGadget;
  166. var
  167.   ng  : TNewGadget;
  168.   gad : PGadget;
  169. begin
  170.   {*
  171.   ** All the gadget creation calls accept a pointer to the previous gadget, and
  172.   ** link the new gadget to that gadget's NextGadget field.  Also, they exit
  173.   ** gracefully, returning NULL, if any previous gadget was NULL.  This limits
  174.   ** the amount of checking for failure that is needed.  You only need to check
  175.   ** before you tweak any gadget structure or use any of its fields, and finally
  176.   ** once at the end, before you add the gadgets.
  177.   *}
  178.  
  179.   {*
  180.   ** The following operation is required of any program that uses GadTools.
  181.   ** It gives the toolkit a place to stuff context data.
  182.   *}
  183.   gad := CreateContext(@glistptr);
  184.  
  185.   {*
  186.   ** Since the NewGadget structure is unmodified by any of the CreateGadget()
  187.   ** calls, we need only change those fields which are different.
  188.   *}
  189.   ng.ng_LeftEdge    := 140;
  190.   ng.ng_TopEdge     := 20 + topborder;
  191.   ng.ng_Width       := 200;
  192.   ng.ng_Height      := 12;
  193.   ng.ng_GadgetText  := '_Volume:   ';
  194.   ng.ng_TextAttr    := @Topaz80;
  195.   ng.ng_VisualInfo  := vi;
  196.   ng.ng_Flags       := NG_HIGHLABEL;
  197.  
  198.   // String gadget:
  199.   ng.ng_TopEdge     := ng.ng_TopEdge + 20;
  200.   ng.ng_Height      := 14;
  201.   ng.ng_GadgetText  := '_First:';
  202.   ng.ng_GadgetID    := ord(tmgSTRING);
  203.  
  204.   gad := CreateGadget(STRING_KIND, gad, @ng,
  205.   [
  206.     GTST_String   , AsTag(PChar('A string gadget')),
  207.     GTST_MaxChars , 50,
  208.     GA_Immediate  , AsTag(true),
  209.     GT_Underscore , Ord('_'),
  210.     TAG_END
  211.   ]);
  212.   my_gads[ord(tmgSTRING)] := gad;
  213.  
  214.   // CheckBox gadget:
  215.   ng.ng_TopEdge     := ng.ng_TopEdge + 20;
  216.   ng.ng_GadgetText  := '_Second:';
  217.   ng.ng_GadgetID    := ord(tmgCHECKBOX);
  218.   gad := CreateGadget(CHECKBOX_KIND, gad, @ng,
  219.   [
  220.     GT_Underscore , Ord('_'),
  221.     TAG_END
  222.   ]);
  223.   my_gads[ord(tmgCHECKBOX)] := gad;
  224.  
  225.   // RadioButtons gadget:
  226.   ng.ng_TopEdge     := ng.ng_TopEdge + 20;
  227.   ng.ng_GadgetText  := '_Third:';
  228.   ng.ng_GadgetID    := ord(tmgRADIOBTN);
  229.   gad := CreateGadget(MX_KIND, gad, @ng,
  230.   [
  231.     GTMX_Labels   , AsTag(@RadioStrings[0]),
  232.     GT_Underscore , Ord('_'),
  233.     TAG_END
  234.   ]);
  235.   my_gads[ord(tmgRADIOBTN)] := gad;
  236.  
  237.   // Button gadget:
  238.   ng.ng_LeftEdge    := ng.ng_LeftEdge + 50;
  239.   ng.ng_TopEdge     := ng.ng_TopEdge + 30;
  240.   ng.ng_Width       := 100;
  241.   ng.ng_Height      := 12;
  242.   ng.ng_GadgetText  := '_Click Here';
  243.   ng.ng_GadgetID    := ord(tmgBUTTON);
  244.   ng.ng_Flags       := 0;
  245.   gad := CreateGadget(BUTTON_KIND, gad, @ng,
  246.   [
  247.     GT_Underscore , Ord('_'),
  248.     TAG_END
  249.   ]);
  250.   createAllGadgets := (gad);
  251. end;
  252.  
  253.  
  254. {*
  255. ** Standard message handling loop with GadTools message handling functions
  256. ** used (GT_GetIMsg() and GT_ReplyIMsg()).
  257. *}
  258. procedure process_window_events(mywin: PWindow; my_gads: array of PGadget);
  259. var
  260.   imsg       : PIntuiMessage;
  261.   imsgClass  : ULONG;
  262.   imsgCode   : UWORD;
  263.   gad        : PGadget;
  264.   terminated : Boolean = false;
  265. begin
  266.   while not(terminated) do
  267.   begin
  268.     Wait(1 shl mywin^.UserPort^.mp_SigBit);
  269.  
  270.     {*
  271.     ** GT_GetIMsg() returns an IntuiMessage with more friendly information for
  272.     ** complex gadget classes.  Use it wherever you get IntuiMessages where
  273.     ** using GadTools gadgets.
  274.     *}
  275.  
  276.     imsg := GT_GetIMsg(mywin^.UserPort);
  277.     while not(terminated) and assigned(iMsg) do
  278.     begin
  279.       {*
  280.       ** Presuming a gadget, of course, but no harm...
  281.       ** Only dereference this value (gad) where the Class specifies
  282.       ** that it is a gadget event.
  283.       *}
  284.       gad := PGadget(imsg^.IAddress);
  285.  
  286.       imsgClass := imsg^.IClass;
  287.       imsgCode := imsg^.Code;
  288.  
  289.       //* Use the toolkit message-replying function here... */
  290.       GT_ReplyIMsg(imsg);
  291.  
  292.       case (imsgClass) of
  293.         {*
  294.         **  --- WARNING --- WARNING --- WARNING --- WARNING --- WARNING ---
  295.         ** GadTools puts the gadget address into IAddress of IDCMP_MOUSEMOVE
  296.         ** messages.  This is NOT true for standard Intuition messages,
  297.         ** but is an added feature of GadTools.
  298.         *}
  299.         IDCMP_GADGETDOWN,
  300.         IDCMP_MOUSEMOVE,
  301.         IDCMP_GADGETUP:
  302.         begin
  303.           handleGadgetEvent(mywin, gad, imsgCode, my_gads);
  304.         end;
  305.         IDCMP_VANILLAKEY:
  306.         begin
  307.           handleVanillaKey(mywin, imsgCode, my_gads);
  308.         end;
  309.         IDCMP_CLOSEWINDOW:
  310.         begin
  311.           terminated := true;
  312.         end;
  313.         IDCMP_REFRESHWINDOW:
  314.         begin
  315.           {*
  316.           ** With GadTools, the application must use GT_BeginRefresh()
  317.           ** where it would normally have used BeginRefresh()
  318.           *}
  319.           GT_BeginRefresh(mywin);
  320.           GT_EndRefresh(mywin, ord(true));
  321.         end;
  322.       end;
  323.       imsg := GT_GetIMsg(mywin^.UserPort);
  324.     end;
  325.   end;
  326. end;
  327.  
  328.  
  329. {*
  330. ** Prepare for using GadTools, set up gadgets and open window.
  331. ** Clean up and when done or on error.
  332. *}
  333. procedure gadtoolsWindow;
  334. var
  335.   font          : PTextFont;
  336.   mysc          : PScreen;
  337.   mywin         : PWindow;
  338.   glist         : PGadget = nil;
  339.   vi            : Pointer;
  340.   topborder     : UWORD;
  341.   my_gads       : array[TMyGadgets] of PGadget;
  342. begin
  343.  
  344.   {*
  345.   ** Open topaz 8 font, so we can be sure it's openable
  346.   ** when we later set ng_TextAttr to &Topaz80:
  347.   *}
  348.   font := OpenFont(@Topaz80);
  349.   if not assigned(font) then errorMessage('Failed to open Topaz 80')
  350.   else
  351.   begin
  352.     mysc := LockPubScreen(nil);
  353.     if not assigned(mysc) then errorMessage('Couldn''t lock default public screen"')
  354.     else
  355.     begin
  356.       vi := GetVisualInfo(mysc, [TAG_END]);
  357.       if not assigned(vi) then errorMessage('GetVisualInfo() failed')
  358.       else
  359.       begin
  360.         //* Here is how we can figure out ahead of time how tall the  */
  361.         //* window's title bar will be:                               */
  362.         topborder := mysc^.WBorTop + (mysc^.Font^.ta_YSize + 1);
  363.  
  364.         if (nil = createAllGadgets(glist, vi, topborder, my_gads))
  365.         then errorMessage('createAllGadgets() failed')
  366.         else
  367.         begin
  368.           mywin := OpenWindowTags(nil,
  369.           [
  370.             WA_Title        , AsTag(pchar('GadTools Gadget Demo')),
  371.             WA_Gadgets      , AsTag(glist),
  372.             WA_AutoAdjust   , AsTag(true),
  373.             WA_Width        , 400,
  374.             WA_MinWidth     ,  60,
  375.             WA_InnerHeight  , 140,
  376.             WA_MinHeight    ,  60,
  377.             WA_DragBar      , AsTag(true),
  378.             WA_DepthGadget  , AsTag(true),
  379.             WA_Activate     , AsTag(true),
  380.             WA_CloseGadget  , AsTag(true),
  381.             WA_SizeGadget   , AsTag(true),
  382.             WA_SimpleRefresh, AsTag(true),
  383.             WA_IDCMP        , IDCMP_CLOSEWINDOW or IDCMP_REFRESHWINDOW or IDCMP_VANILLAKEY or STRINGIDCMP or CHECKBOXIDCMP or MXIDCMP or BUTTONIDCMP,
  384.             WA_PubScreen    , AsTag(mysc),
  385.             TAG_END
  386.           ]);
  387.  
  388.           if not assigned(mywin)
  389.           then errorMessage('OpenWindow() failed')
  390.           else
  391.           begin
  392.             {*
  393.             ** After window is open, gadgets must be refreshed with a
  394.             ** call to the GadTools refresh window function.
  395.             *}
  396.              GT_RefreshWindow(mywin, nil);
  397.  
  398.              process_window_events(mywin, my_gads);
  399.  
  400.              CloseWindow(mywin);
  401.           end;
  402.         end;
  403.         {*
  404.         ** FreeGadgets() even if createAllGadgets() fails, as some
  405.         ** of the gadgets may have been created...If glist is NULL
  406.         ** then FreeGadgets() will do nothing.
  407.         *}
  408.         FreeGadgets(glist);
  409.         FreeVisualInfo(vi);
  410.       end;
  411.       UnlockPubScreen(nil, mysc);
  412.     end;
  413.     CloseFont(font);
  414.   end;
  415. end;
  416.  
  417.  
  418. {*
  419. ** Check all libraries and run.  Clean up when finished or on error..
  420. *}
  421. begin
  422.   if (pLibrary(IntuitionBase)^.lib_version < 37)
  423.    then errorMessage('Requires V37 intuition.library')
  424.   else
  425.   begin
  426.     if (pLibrary(GfxBase)^.lib_version < 37)
  427.      then errorMessage('Requires V37 graphics.library')
  428.     else
  429.     begin
  430.       if (pLibrary(GadtoolsBase)^.lib_version < 37)
  431.        then errorMessage('Requires V37 gadtools.library')
  432.       else
  433.       begin
  434.         gadtoolsWindow;
  435.       end;
  436.     end;
  437.   end;
  438. end.
  439.  

 

TinyPortal © 2005-2018