unit ImageForm;

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

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

Code for ImageForm.lfm

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


interface

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

type
    TFrmImage = class(TForm)
        PopupMenu1: TPopupMenu;
        SavetoJpeg: TMenuItem;
        SDJpeg:     TSaveDialog;

        procedure SavetoJpegClick;
        procedure FormPaint;
        procedure FormOnShow;

    private
        fmult:   Integer;
        fscroll: Integer;
        bmp:     TBitmap;

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

var
    FrmImage: TFrmImage;

implementation uses System.UITypes, 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;
end;


procedure TFrmImage.DisplayMap(Mymap: TMap; Mult: Integer);
var Wid, Hgt,
    offset: Integer;

    procedure Doasquare(WS, H: Integer);
    var R: tterrain;
        Wm: Integer;

        // Draw one Tile box in given color
        procedure SetColor(Color: 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] := Color;
                    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] := Color;
                        bmp.Canvas.Pixels[bmpX, bmpY] := Color;
                    end;
            end;
        end;

    begin
        // Allow for horizontal scroll
        Wm := 1+(WS + fscroll) MOD MyMap.Width;
        R  := MyMap.GetTerrain(Wm, H);

        if (R = Ocean) OR (R = Coast) then
            SetColor(clBlue)
        else
        if Mymap.Tiles[Wm,H].River then
            SetColor(clAqua)
        else
            case R of
                Desert:   SetColor(clRed);
                Prairie:  SetColor(clYellow);
                Grass:    SetColor(clLime);
                Forest:   SetColor(clGreen);
                Hills:    SetColor(clOlive);
                Mountain: SetColor(clLtGray);
                Tundra:   SetColor(clDkGray);
                Arctic:   SetColor(clWhite);
                Swamp:    SetColor(clTeal);

            otherwise
            begin
                ShowMessage ('Terrain label misssing ' + IntToStr(Ord(R)));
                Halt (1);
            end;
            end;
    end;

begin
    with MyMap do
        Init(Width, Height, Mult);

    with MyMap do
        for Hgt := 1 to Mymap.Height do
        begin
            // Offset alternate rows to compensate for Cevo diamond map format }
            if NOT odd(Hgt) then
                offset := fmult
            else
                offset := 0;

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

    Canvas.Draw(0, 0, bmp);
    Update;
    Show;
end;


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

procedure TFrmImage.FormOnShow;
begin
    if Clientheight = 0 then
    begin
        Clientwidth  := 353;
        Clientheight := 176;
    end;
end;

// Write thumbnail display to a Jpeg file
procedure TFrmImage.SavetoJpegClick;
var jp: TJPEGImage;
    bm: TBitMap;
    MyRect: TRect;
begin
    jp := TJPEGImage.Create;
    bm := TBitMap.Create;
    try
        bm.Width := Clientwidth;
        bm.Height := ClientHeight;
        bm.pixelformat := pfDevice;
        MyRect := Rect(0, 0, Clientwidth, ClientHeight);

        bm.Canvas.CopyRect(MyRect, Canvas, MyRect);

        with jp do
        begin
            CompressionQuality := 70;
            Assign(bm);

            if SDJpeg.Execute then
                SaveToFile(SDJpeg.filename);
        end;
    finally
        bm.Free;
        jp.Free;
    end;
end;

destructor TFrmImage.Destroy;
begin
    bmp.Free;
    inherited;
end;

end.
