unit ImageForm;

{***********************************************************

Project:    C-evo External Map Generator
Copyright:  1999-2026 P Blackman
License:    GPLv3+

Code for ImageForm.lfm

***********************************************************}

interface

uses
    LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    ExtCtrls, CevoMap, Menus, System.UITypes;

type
    TFrmImage = class (TForm)
        PopupMenu1 : TPopupMenu;
        SaveImage  : TMenuItem;
        SDImage    : TSaveDialog;

        procedure FormPaint;
        procedure FormOnShow;
        procedure FormOnHide;
        procedure SaveImageClick;

    private
        fMult,
        fScroll,
        Offset  : Integer;
        Bmp     : TBitmap;
        Mymap   : TMap;

    protected
        procedure SetMyColor (Wid, Hgt: Integer; MyColor: TColor);
        procedure DoOneTile (Wid, Hgt: Integer);
        procedure SaveImageBitmap (out Bm : TBitMap);
        procedure SaveJpeg;
        procedure SavePNG;

    public
        procedure Init (W, H, Mult: Integer);
        procedure DisplayMap (DisplayMap: TMap; Mult: Integer);
        property  Scroll: Integer read fScroll write fScroll;
        destructor Destroy; override;
    end;

var
    FrmImage: TFrmImage;


implementation uses MapTiles;

{$R *.lfm}

procedure TFrmImage.Init (W, H, Mult: Integer);
begin
    fMult        := Mult;
    Clientwidth  := 2*W*Mult;
    Clientheight :=   H*Mult;

    if Mult > 0 then
        Show;

    if Bmp <> nil then
        Bmp.Free;

    Bmp         := TBitMap.Create;
    Bmp.Height  := Clientheight;
    Bmp.Width   := Clientwidth;

    SaveImage.Caption   := 'Save Map Image';
    SaveImage.Visible   := True;
    SaveImage.Enabled   := True;
    SDImage.Filter      := 'PNG|*.png|JPEG|*.jpg';
    SDImage.DefaultExt  := 'png';

end;

destructor TFrmImage.Destroy;
begin
    FreeAndNil (Bmp);
    inherited;
end;

procedure TFrmImage.FormPaint;
begin
    Canvas.Draw (0, 0, Bmp);
end;

procedure TFrmImage.FormOnShow;
begin
    inherited;
end;

// Supress the save map popup, when no image to save
procedure TFrmImage.FormOnHide;
begin
    SaveImage.Visible   := False;
    SaveImage.Enabled   := False;
    SaveImage.Caption   := '';
    fMult               := 0;

    inherited;
end;

// Draw one Tile box in given color
procedure TFrmImage.SetMyColor (Wid, Hgt: Integer; MyColor: TColor);
var X, Y, BmpX, BmpY: Integer;
begin
    for Y := 0 to fMult-1 do
    begin
        BmpY := (Hgt-1)*fMult+Y;

        if (Offset = 0) OR (Wid <> MyMap.Width) then
            for X := 0 to fMult*2-1 do
            begin
                BmpX := (Wid-1)*fMult*2+X+Offset;
                Bmp.Canvas.Pixels[BmpX, BmpY] := MyColor;
            end
        else
            // This Tile split, one half at each end
            for X := 0 to fMult-1 do
            begin
                BmpX := (Wid-1)*fMult*2+X+Offset;
                Bmp.Canvas.Pixels[X, BmpY]      := MyColor;
                Bmp.Canvas.Pixels[BmpX, BmpY]   := MyColor;
            end;
    end;
end;

procedure TFrmImage.DoOneTile (Wid, Hgt: Integer);
var R: tterrain;
    Wm: Integer;
begin
    // Allow for horizontal scroll
    Wm := 1+(Wid + fScroll) mod MyMap.Width;
    R  := MyMap.GetTerrain(Wm, Hgt);

    if (R = Ocean) OR (R = Coast) then
        SetMyColor(Wid, Hgt, clBlue)
    else
    if Mymap.Tiles[Wm,Hgt].River then
        SetMyColor(Wid, Hgt, clAqua)
    else
    case R of
        Desert:   SetMyColor (Wid, Hgt, clRed);
        Prairie:  SetMyColor (Wid, Hgt, clYellow);
        Grass:    SetMyColor (Wid, Hgt, clLime);
        Forest:   SetMyColor (Wid, Hgt, clGreen);
        Jungle:   SetMyColor (Wid, Hgt, clGreen);
        Hills:    SetMyColor (Wid, Hgt, clOlive);
        Mountain: SetMyColor (Wid, Hgt, clLtGray);
        Tundra:   SetMyColor (Wid, Hgt, clDkGray);
        Arctic:   SetMyColor (Wid, Hgt, clWhite);
        Swamp:    SetMyColor (Wid, Hgt, clTeal);
        otherwise
        begin
            ShowMessage ('Terrain label missing ' + IntToStr(Ord(R)));
            Halt (1);
        end;
    end;
end;

procedure TFrmImage.DisplayMap (DisplayMap: TMap; Mult: Integer);
var Wid, Hgt : Integer;
begin
    MyMap := DisplayMap;
    with MyMap do
    begin
        Init (Width, Height, Mult);
        for Hgt := 1 to Mymap.Height do
        begin
            // Offset alternate rows to compensate for Cevo diamond map format }
            if NOT odd(Hgt) then
                Offset := Mult
            else
                Offset := 0;

            for Wid := 1 to MyMap.Width do
               // Incorporate scroll offset }
                DoOneTile (Wid, Hgt);
        end;
    end;

    Canvas.Draw (0, 0, Bmp);
    Update;
end;


procedure TFrmImage.SaveImageBitmap (out Bm : TBitMap);
var MyRect  : TRect;
begin
    Bm          := TBitMap.Create;
    Bm.Width    := Clientwidth;
    Bm.Height   := ClientHeight;

    MyRect      := Rect (0, 0, Clientwidth, ClientHeight);
    Bm.Canvas.CopyRect (MyRect, Bmp.Canvas, MyRect);
end;

// Write thumbnail display to a PNG file
procedure TFrmImage.SavePNG;
var Png : TPortableNetworkGraphic;
    Bm  : TBitMap;
begin
    Png := TPortableNetworkGraphic.Create;

    try
        SaveImageBitmap (Bm);
        Png.Assign (Bm);
        if SDImage.Execute then
            Png.SaveToFile (SDImage.filename);
    finally
        Bm.Free;
        Png.Free;
    end;
end;

// Write thumbnail display to a Jpeg file
procedure TFrmImage.SaveJpeg;
var Jp : TJPEGImage;
    Bm : TBitMap;
begin
    Jp := TJPEGImage.Create;

    try
        SaveImageBitmap (Bm);
        Jp.CompressionQuality := 70;
        Jp.Assign (Bm);
        if SDImage.Execute then
            Jp.SaveToFile (SDImage.filename);
    finally
        Bm.Free;
        Jp.Free;
    end;
end;

// Write thumbnail display to a file
procedure TFrmImage.SaveImageClick;
begin
    if  (Bmp <> nil)
    and (fMult > 0) then
    begin
        SDImage.filename := Caption;

        if SDImage.FilterIndex = 2 then
            SaveJpeg
        else
            SavePNG;
    end;
end;

end.
