////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2023 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWKIT.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Draw a bar (filled rectangle) to BMP file.                                 //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 2019xxxx - Created by A.K.                                                 //
// 20230623 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

program barbmp; // Bar bitmap

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$IFNDEF FPC}{$APPTYPE CONSOLE}{$ENDIF}

{$R *.res}
uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, graphics, interfaces, forms,
 _crw_alloc, _crw_fio, _crw_colors;

type EWriteError=class(Exception);
type EBadArgument=class(Exception);

const stdin  = 0;
const stdout = 1;
const stderr = 2;

procedure Print(n:Integer; const S:LongString);
var h:THandle;
begin
 if Length(S)>0 then begin
  case n of
   stdout: h:=GetStdHandle(STD_OUTPUT_HANDLE);
   stderr: h:=GetStdHandle(STD_ERROR_HANDLE);
   else    h:=0;
  end;
  if (h<>0) then if FileWrite(h,PChar(S)^,Length(S))<0 then Raise EWriteError.Create('Fail write stream '+IntToStr(1));
 end;
end;

procedure Echo(s:LongString);
begin
 Print(stdout,s+EOL);
end;

procedure BugReport(E:Exception; Sender:TObject=nil; Note:LongString='');
var s,t:LongString;
begin
 if Assigned(E) then begin
  s:=Format('Exception "%s" - "%s"',[E.ClassName,E.Message]);
  SetString(t,PChar(s),Length(s));
  {$IFDEF WINDOWS}
  CharToOem(PChar(s),PChar(t));
  {$ENDIF WINDOWS}
  Print(stderr,t+EOL);
 end;
 ExitCode:=1;
end;

procedure PrintColors(Prefix:LongString='');
var i,n:Integer;
begin
 n:=1;
 if Assigned(KnownColorsList) then begin
  for i:=0 to KnownColorsList.Count-1 do n:=Max(n,Length(Prefix+KnownColorsList[i]));
  for i:=0 to KnownColorsList.Count-1 do Echo(Format('%-*s = $%.6x',[n,Prefix+KnownColorsList[i],TColor(KnownColorsList.Objects[i])]));
 end;
end;

function BaseName:LongString;
var i:Integer;
begin
 Result:=ExtractFileName(ParamStr(0));
 for i:=Length(Result) downto 1 do if Result[i]='.' then begin Result:=Copy(Result,1,i-1); break; end;
end;

procedure PrintHelp;
var exe:LongString;
begin
 Exe:=BaseName;
 Echo('Copyright(c) 2019-2023 Alexey Kuryakin kouriakine@mail.ru under MIT.');
 Echo(exe+' v 1.2 is the tool to make BAR BMP (filled rectangle bitmaps).');
 Echo('with given bar pixel width, height, color depth, fill color.');
 Echo('Usage:');
 Echo(' '+exe+' [-o] [w h d c]  - create specified bar bitmap');
 Echo(' with specified options [-o] and/or next parameters:');
 Echo('  w - required bar width  in pixels');
 Echo('  h - required bar height in pixels');
 Echo('  d - required color depth: {1,4,8,15,16,24} bit; by default 24 bit');
 Echo('  c - required fill color, RGB number as hex $BBGGRR or named color');
 Echo('      call "'+exe+' --colors"  to print list of known named colors;');
 Echo('      by default uses color White = $FFFFFF');
 Echo(' Options may have two equivalent forms: short and long');
 Echo('  -oX (short) and --option=X (long) with argument X');
 Echo(' Options are:');
 Echo('  -h --help            - print help');
 Echo('  -v --verbose         - set verbose mode to view details');
 Echo('  -q --quiet           - set quiet (silent) mode to skip printing');
 Echo('     --colors          - print list of colors from X11,HTML,Win32');
 Echo('                       - in format Name = $Value ($BBGGRR hex RGB)');
 Echo('  -w --bar-width=W     - set bar width  W, pixels');
 Echo('  -h --bar-height=H    - set bar height H, pixels');
 Echo('  -d --color-depth=D   - set color depth D: {1,4,8,15,16,24} bit');
 Echo('  -c --fill-color=C    - set fill color number or name C');
 Echo('  -o --out-file=O      - set output file name O');
 Echo('Example:');
 Echo(' '+exe+' 100 15 8 Aqua');
 Echo(' '+exe+' -w100 -h15 -d8 -cAqua');
 Echo(' '+exe+' --bar-width=100 --bar-height=15 --color-depth=8 --fill-color=Aqua');
 Echo(' - creates bitmap file '+exe+'_100_15_8_aqua.bmp');
end;

function CheckOpt(const ShortOpt,LongOpt,Param:LongString; var Arg:LongString):Boolean;
begin
 Result:=False; Arg:='';
 if (ShortOpt<>'') and (Pos(ShortOpt,Param)=1) then begin
  Arg:=Param; Delete(Arg,1,Length(ShortOpt));
  Result:=True;
  Exit;
 end;
 if (LongOpt<>'') and (Pos(LongOpt,Param)=1) then begin
  Arg:=Param; Delete(Arg,1,Length(LongOpt));
  Result:=True;
  Exit;
 end;
end;

function CreateBarBmp(BarWidth,BarHeight,ColorDepth,FillColor:Integer):TBitmap;
var bmp:TBitmap;
begin
 Result:=nil;
 if (BarWidth>0) then if (BarHeight>0) then
 if (ColorDepth in [1,4,8,15,16,24]) then begin
  bmp:=TBitmap.Create;
  try
   bmp.Width:=BarWidth;
   bmp.Height:=BarHeight;
   case ColorDepth of
    1  : bmp.PixelFormat:=pf1bit;
    4  : bmp.PixelFormat:=pf4bit;
    8  : bmp.PixelFormat:=pf8bit;
    15 : bmp.PixelFormat:=pf15bit;
    16 : bmp.PixelFormat:=pf16bit;
    24 : bmp.PixelFormat:=pf24bit;
   end;
   bmp.Canvas.Brush.Color:=FillColor;
   bmp.Canvas.Brush.Style:=bsSolid;
   bmp.Canvas.Pen.Color:=FillColor;
   bmp.Canvas.Pen.Mode:=pmCopy;
   bmp.Canvas.Pen.Style:=psSolid;
   bmp.Canvas.Pen.Width:=2;
   bmp.Canvas.Rectangle(0,0,bmp.Width,bmp.Height);
  except
   on E:Exception do begin
    BugReport(E,bmp,'CreateBarBmp');
    FreeAndNil(bmp);
   end;
  end;
  Result:=bmp;
 end;
end;

procedure Main;
var BarWidth,BarHeight,ColorDepth,FillColor,ParamNum,ParamMax,ArgNum:Integer;
    OutFile,Param,Arg:LongString; bmp:TBitmap; Quiet,Verbose:Boolean;
begin
 if (ParamCount<1) then PrintHelp else
 try
  // Initialize and set defaults
  BarWidth:=0; BarHeight:=0; ColorDepth:=24; FillColor:=clWhite; OutFile:='';
  Quiet:=false; Verbose:=false; Param:=''; Arg:=''; bmp:=nil;
  // Parse command line options and argiments
  ParamNum:=1; ArgNum:=1; ParamMax:=ParamCount;
  while (ParamNum<=ParamMax) do begin
   Param:=ParamStr(ParamNum);
   if Pos('-',Param)=1 then begin
    if CheckOpt('','--help',Param,Arg) then begin
     PrintHelp;
     Exit;
    end else
    if CheckOpt('','--colors',Param,Arg) then begin
     PrintColors;
     Exit;
    end else
    if CheckOpt('-v','--verbose',Param,Arg) then begin
     Verbose:=True;
    end else
    if CheckOpt('-q','--quiet',Param,Arg) then begin
     Quiet:=True;
    end else
    if CheckOpt('-w','--bar-width=',Param,Arg) then begin
     if (Arg<>'') then BarWidth:=StrToInt(Arg);
    end else
    if CheckOpt('-h','--bar-height=',Param,Arg) then begin
     if (Arg<>'') then BarHeight:=StrToInt(Arg) else begin
      if CheckOpt('-h','',Param,Arg) then begin
       PrintHelp;
       Exit;
      end;
     end;
    end else
    if CheckOpt('-d','--color-depth=',Param,Arg) then begin
     if (Arg<>'') then ColorDepth:=StrToInt(Arg);
    end else
    if CheckOpt('-c','--fill-color=',Param,Arg) then begin
     if (Arg<>'') then FillColor:=StringToColor(Arg);
    end else
    if CheckOpt('-o','--out-file=',Param,Arg) then begin
     if (Arg<>'') then OutFile:=ChangeFileExt(Arg,'.bmp');
    end else
    Raise EBadArgument.Create('Invalid option: '+Param);
   end else begin
    // Read arguments
    Arg:=Param;
    case ArgNum of
     1: if (Arg<>'') then BarWidth:=StrToInt(Arg);
     2: if (Arg<>'') then BarHeight:=StrToInt(Arg);
     3: if (Arg<>'') then ColorDepth:=StrToInt(Arg);
     4: if (Arg<>'') then FillColor:=StringToColor(Arg);
    end;
    inc(ArgNum);
   end;
   inc(ParamNum);
  end;
  if (BarWidth<=0) then Raise EBadArgument.Create('Bar width is not valid: '+IntToStr(BarWidth));
  if (BarHeight<=0) then Raise EBadArgument.Create('Bar height is not valid: '+IntToStr(BarHeight));
  if not (ColorDepth in [1,4,8,15,16,24]) then Raise EBadArgument.Create('Invalid Color Depth: out of set [1,4,8,15,16,24].');
  if (OutFile='') then OutFile:=Format('%s_%d_%d_%d_%s.bmp',[BaseName,BarWidth,BarHeight,ColorDepth,ColorToString(FillColor)]);
  OutFile:=LowerCase(OutFile);
  // Verbose information
  if Verbose and not Quiet then begin
   Echo('Options:');
   Echo(Format('--bar-width   = %d',[BarWidth]));
   Echo(Format('--bar-height  = %d',[BarHeight]));
   Echo(Format('--color-depth = %d',[ColorDepth]));
   Echo(Format('--fill-color  = %s',[ColorToString(FillColor)]));
   Echo(Format('--out-file    = %s',[OutFile]));
  end;
  // Create & fill bitmap
  bmp:=CreateBarBmp(BarWidth,BarHeight,ColorDepth,FillColor);
  if Assigned(bmp) then
  try
   bmp.SaveToFile(OutFile);
   if not Quiet then Echo(Format('%s - %d x %d x %d bitmap',[OutFile,bmp.Width,bmp.Height,ColorDepth]));
  finally
   FreeAndNil(bmp);
  end;
 except
  on E:Exception do BugReport(E,nil,'Main');
 end;
end;

begin
 try
  Main;
 except
  on E:Exception do BugReport(E,nil,'barbmp');
 end;
end.

//////////////
// END OF FILE
//////////////

