--******************************************************************************
--*                                                                            *
--*  File:        TkLua_04.lua                          Revision:  1.0         *
--*                                                                            *
--*  Purpose:     displays all currently available fonts                       *
--*                                                                            *
--*  Creation:    12.03.2002                   Last Modification:  12.03.2002  *
--*                                                                            *
--*  Platform:    IBM-compatible PC running Windows 98SE                       *
--*                                                                            *
--*  Environment: Lua 4.0, TkLua 4.0                                           *
--*                                                                            *
--*  Author:      Andreas Rozek           Phone:  ++49 (711) 6770682           *
--*               Kirschblütenweg 15      Fax:    -                            *
--*             D-70569 Stuttgart         EMail:  Andreas.Rozek@T-Online.De    *
--*               Germany                                                      *
--*                                                                            *
--*  URL:         http://www.Andreas-Rozek.de/                                 *
--*                                                                            *
--*  Copyright:   the software is published under the "GNU Lesser General Pub- *
--*               lic  License" (see "http://www.fsf.org/copyleft/lesser.html" *
--*               for additional information)                                  *
--*                                                                            *
--*  Comments:    (none)                                                       *
--*                                                                            *
--******************************************************************************

  dofile("Lua_02_Lib.lua");     -- provides an extended 'tostring' function etc.
  dofile("TkLua_00_Lib.lua");    -- provides a simple console for TkLua programs

  local Icon     = "./Lua.gif";-- specifying the file name is already sufficient
  local Title    = "TkLua_04";
  local Subtitle = "displays all currently available fonts";
  local Status   = "(no special action required)";

  local AQuickBrowFox = "A quick brown fox jumped over the lazy dog";

--******************************************************************************
--*                                                                            *
--* positionView    (re)positions the FontView according to scrollbar settings *
--*                                                                            *
--******************************************************************************

  function positionView (arg)
    local FontViewHeight = tonumber(tkeval("winfo reqheight "..FontView.tkname)[1]);
    local Position = 0;

    local Command = arg[2];
    if (Command == "scroll") then
      local Delta,Unit = arg[3],arg[4];
        if (Unit == "pages") then Delta = Delta*tonumber(tkeval("winfo height "..FontPort.tkname)[1]); end;
        if (Unit == "units") then Delta = Delta*10; end;
      local FontViewY = tonumber(tkeval("winfo y "..FontView.tkname)[1]);
      Position = min(max(0,-FontViewY+Delta),FontViewHeight);
      tkeval("place "..FontView.tkname.." -y -"..Position);
    end;

    if (Command == "moveto") then
      Position = arg[3]*FontViewHeight;
      tkeval("place "..FontView.tkname.." -y -"..Position);
    end;

--  local FontViewY      = tonumber(tkeval("winfo y "..FontView.tkname)[1]);
    local FontPortHeight = tonumber(tkeval("winfo height "..FontPort.tkname)[1]);
      local UpperFraction = Position/FontViewHeight;
      local LowerFraction = (Position+FontPortHeight)/FontViewHeight;
    FontScrollbar:set(UpperFraction,LowerFraction);
  end;

--******************************************************************************
--*                                                                            *
--*                                main program                                *
--*                                                                            *
--******************************************************************************

--**** construct a list of available fonts (resp. font families) ****

  local FontList = tkeval("font families");  -- receives a list of font families
  sort(FontList);                                           -- sort by font name

  local i = 2;
  while (FontList[i] ~= nil) do           -- remove double entries from the list
    if (FontList[i] == FontList[i-1]) then
      tremove(FontList,i);
    else
      i = i+1;
    end;
  end;

--**** define window components ****

  local IconLabel      = tklabel{image=Icon, anchor="center", width=32, height=32};
  local TitleLabel     = tklabel{Title;      anchor="e", font="-*-helvetica-bold-o-*--16"};
  local SubtitleLabel  = tklabel{Subtitle;   anchor="e", font="-*-helvetica-bold-r-*--12"};
  local UpperSeparator = tkframe{relief="sunken", borderwidth=2,        height=2};

  local ViewList = {};                          -- receives a list of font views
  for Index = 1,getn(FontList) do
    local FontFamily = FontList[Index];

    tinsert(ViewList, tklabel{FontFamily..":"; anchor="w", font="-*-helvetica-bold-r-*--12"});
      tinsert(ViewList, {padx=0, expand=1});

    local LabelFont = tkeval(                                -- style = "normal"
      "font create -family {"..FontFamily.."} -size 12 -weight normal -slant roman"
    )[1];
    tinsert(ViewList, tklabel{AQuickBrowFox; anchor="w", font=LabelFont});
    tinsert(ViewList, {padx=8});

    LabelFont = tkeval(                                        -- style = "bold"
      "font create -family {"..FontFamily.."} -size 12 -weight bold -slant roman"
    )[1];
    tinsert(ViewList, tklabel{AQuickBrowFox; anchor="w", font=LabelFont});
    tinsert(ViewList, {padx=8});

    LabelFont = tkeval(                                      -- style = "italic"
      "font create -family {"..FontFamily.."} -size 12 -weight normal -slant italic"
    )[1];
    tinsert(ViewList, tklabel{AQuickBrowFox; anchor="w", font=LabelFont});
    tinsert(ViewList, {padx=8});

    LabelFont = tkeval(                                 -- style = "bold italic"
      "font create -family {"..FontFamily.."} -size 12 -weight bold -slant italic"
    )[1];
    tinsert(ViewList, tklabel{AQuickBrowFox; anchor="w", font=LabelFont});
    tinsert(ViewList, {padx=8});
  end;
  FontView = tkframe{objects=ViewList, borderwidth=0, side="top", fill="x"};

  FontPort      = tkframe{FontView; relief="sunken", height=240}; -- geoman="place"
  FontScrollbar = tkscrollbar{orient="vertical", command="positionView(arg)"};

  local FontPane = tkframe{
    FontPort,      {side="left", fill="both", expand=1},
    FontScrollbar, {side="left", fill="y"};
    relief="sunken", borderwidth=2
  };

  local LowerSeparator = tkframe{relief="sunken", borderwidth=2, height=2};
  local StatusBar      = tklabel{Status; anchor="w", font="-*-helvetica-medium-r-*--11"};

--**** construct application window ****

  local MainWindow = tkmain{
    tkframe{
      IconLabel,     {side="left"},
      TitleLabel,    {side="top", fill="x"},
      SubtitleLabel, {side="top", fill="x"}
    },               {side="top", fill="x"},
    UpperSeparator,  {side="top", fill="x"},
    FontPane,        {side="top", fill="both", expand=1, pady=2},
    LowerSeparator,  {side="top", fill="x"},
    StatusBar,       {side="top", fill="x"}
  };

--**** display application window ****

  MainWindow:title(Title.." - "..Subtitle);
  MainWindow:show();                            -- also triggers a window layout
--MainWindow:resizable(0,0);                     -- disables window size changes
--MainWindow:raise();                   -- brings the window into the foreground

--**** it's now time to fine-tune the display ****

  FontPort.geoman="place";
  tkeval("place "..FontView.tkname.." -in "..FontPort.tkname.." -x 0 -y 0 -relwidth 1.0");

--tkeval("update idletasks");                 -- guarantee actual window display
  tkeval("update");              -- "update idletasks" doesn't seem to be enough

  local FontViewHeight = tonumber(tkeval("winfo reqheight "..FontView.tkname)[1]);
  FontScrollbar:set(0.0, FontPort.height/FontViewHeight);

--**** provide an explicit method to terminate this program! ****

  MainWindow:protocol("WM_DELETE_WINDOW", "print('done...'); tkexit()");