mixster

program Meh;
type
  TTile = record
    t: TPoint;
    o: Boolean;
  end;
  TBoard = record
    t: array of array of TTile;
    h, w, ground, sprite: Integer;
  end;
  TPiece = record
    t: TIntegerArray;
    h: Integer;
  end;
  TPieceSet = record
    p: array of TPiece;
    s: TPoint;
    h, sl: Integer;
  end;
  TUnitSkel = record
    t: array of Integer;
    s: TPoint;
    h: Integer;
  end;
  TUnit = record
    p: TPoint;
    t: Integer;
  end;
  TFaction = record
    u: array of TUnit;
    h, c: Integer;
  end;
  TUnits = record
    t: array of TFaction;
    h: Integer;
  end;

var
  frmMain: TForm;
  imgBoard: TImage;
  sbxBoard: TScrollBox;
  board: TBoard;
  pieceset: TPieceset;
  unitTypes: TUnitSkel;
  units: TUnits;

procedure Write(v: TVariantArray);
var
  i: Integer;
  s: string;
begin
  if False then
    exit;
  if High(v) < 0 then
    exit;
  for i := 0 to High(v) do
    s := s + v[i];
  Writeln(s);
end;

procedure SetupBoard(var brd: TBoard; pce: TPieceSet; w, h: Integer);
var
  x, y: Integer;
begin
  brd.w := w - 1;
  brd.h := h - 1;
  SetLength(brd.t, h);
  for y := 0 to brd.h do
  begin
    SetLength(brd.t[y], w);
    for x := 0 to brd.w do
    begin
      brd.t[y][x].t.x := 0;
      brd.t[y][x].t.y := 0;
      brd.t[y][x].o := False;
    end;
  end;
  x := (w * ((pce.s.x + pce.sL) * 2)) - pce.sL;
  y := h * (pce.s.y * 2);
  brd.ground := BitmapFromString(x, y, '');
  FastDrawClear(brd.ground, clBlack);
  brd.sprite := BitmapFromString(x, y, '');
  FastDrawClear(brd.sprite, clWhite);
end;

procedure RandomBoard(var brd: TBoard; pce: TPieceset);
var
  i, ii: Integer;
begin
  for i := 0 to brd.h do
    for ii := 0 to brd.w do
      with brd.t[i][ii].t do
      begin
        y := Random(pce.h + 1);
        x := Random(pce.p[y].h + 1);
      end;
end;

procedure SetupPieceset(var pce: TPieceSet; bmp, tw, th: Integer);
var
  l, wl, hl, m, x, y, tb, ii, i: Integer;
  c, ts: TCanvas;
  p: TPointArray;
begin
  l := 20;
  pce.sL := l;
  pce.s.x := Round(Sin(Radians(30)) * l);
  pce.s.y := Round(Cos(Radians(30)) * l);
  wl := (2 * pce.s.x) + l;
  hl := 2 * pce.s.y;
  m := BitmapFromString(wl, hl, '');
  FastDrawClear(m, clBlack);
  c := GetBitmapCanvas(m);
  c.Pen.Color := RGBtoColor(1, 1, 1);
  c.Brush.Color := clWhite;
  with pce.s do
    c.Polygon([Point(0, y), Point(x, y + y), Point(x + l, y + y), Point(x + l + x, y), Point(x + l, 0), Point(x, 0)]);
  SetTransparentColor(m, clWhite);
  GetBitmapSize(bmp, x, y);
  x := x / tw;
  y := y / th;
  tb := BitmapFromString(x, y, '');
  FastDrawClear(tb, 0);
  SetTargetBitmap(bmp);
  ts := GetBitmapCanvas(bmp);
  pce.h := th - 1;
  SetLength(pce.p, th);
  for ii := 0 to pce.h do
    with pce.p[ii] do
    begin
      h := -1;
      for i := 0 to tw - 1 do
      begin
        SetLength(p, 0);
        FindColorsTolerance(p, clBlack, x * i, y * ii, (x * i) + wl, (y * ii) + hl, 0);
        if Length(p) >= ((wl + 1) * (hl + 1)) then
          Break;
        Inc(h);
        SetLength(t, h + 1);
        t[h] := BitmapFromString(wl, hl, '');
        SafeCopyCanvas(ts, GetBitmapCanvas(t[h]), x * i, y * ii, x * i + wl, y * ii + hl, 0, 0, wl, hl);
        FastDrawTransparent(0, 0, m, t[h]);
        SetTransparentColor(t[h], clBlack);
      end;
    end;
  FreeBitmap(m);
  ResetDc;
end;

procedure SetupUnitTypes(var unTy: TUnitSkel; pce: TPieceSet; bmp, l: Integer);
var
  i, w: Integer;
  c, t: TCanvas;
begin
  w := pce.s.y * 2;
  unTy.h := l - 1;
  GetBitmapSize(bmp, unTy.s.x, unTy.s.y);
  unTy.s.x := unTy.s.x / l;
  SetLength(unTy.t, l);
  c := GetBitmapCanvas(bmp);
  for i := 0 to unTy.h do
  begin
    unTy.t[i] := BitmapFromString(w, w, '');
    t := GetBitmapCanvas(unTy.t[i]);
    SafeCopyCanvas(c, t, i * unTy.s.x, 0, i * unTy.s.x + unTy.s.x, unTy.s.y, 0, 0, w, w);
    SetTransparentColor(unTy.t[i], clWhite);
  end;
end;

procedure RandomUnits(var uns: TUnits; unTy: TUnitSkel; brd: TBoard; num: Integer);
var
  i: Integer;
begin
  uns.h := 0;
  SetLength(uns.t, 1);
  uns.t[0].h := num - 1;
  SetLength(uns.t[0].u, num);
  for i := 0 to num - 1 do
    with uns.t[0].u[i] do
    begin
      t := Random(unTy.h + 1);
      p.x := Random(brd.w + 1);
      p.y := Random(brd.h + 1);
      Write([i, ' of ', num, ' - ', p.x, ',', p.y, ',', t]);
    end;
end;

procedure DrawBoard(var img: TImage; brd: TBoard; pce: TPieceSet);
var
  t, i, ii, w, h, l, o: Integer;
begin
  FastDrawClear(t, clBlack);
  l := pce.sL;
  w := (pce.s.x + l) * 2;
  h := pce.s.y;
  img.Width := w * brd.w + w + 1 - l;
  img.Height := h * brd.h + h + h + 1;
  t := BitmapFromString(img.Width, img.Height, '');

  for ii := 0 to brd.h do
  begin
    if ii mod 2 = 0 then
      o := 0
    else
      o := pce.s.x + l;
    for i := 0 to brd.w do
    begin
      if o > 0 then
        if i = brd.w then
          Break;
      with brd.t[ii][i].t do
      begin
        if (y > pce.h) then
          Continue;
        if (x > pce.p[y].h) then
          Continue;
        FastDrawTransparent((i * w) + o, (ii * h), pce.p[y].t[x], t);
      end;
    end;
  end;

  SafeDrawBitmap(t, img.Canvas, 0, 0);
  FastDrawTransparent(0, 0, t, brd.ground);
  FreeBitmap(t);
end;

procedure DrawUnits(var img: TImage; uni: TUnits; unTy: TUnitSkel; brd: TBoard; pce: TPieceSet);
var
  i, ii, w, h, o, l: Integer;
begin
  FastDrawClear(brd.sprite, clWhite);
  w := (pce.s.x + pce.sL) * 2;
  h := pce.s.y;
  l := ((w - (2 * h)) - pce.sL) / 2;
  for i := 0 to uni.h do
    for ii := 0 to uni.t[i].h do
      with uni.t[i].u[ii] do
      begin
        if p.y > brd.h then
          Continue;
        if p.x > brd.w then
          Continue;
        if p.y mod 2 = 0 then
          o := 0
        else
          o := pce.s.x + pce.sL;

        Write([i, ',', ii, ' - ', p.x, ',', p.y, ' - ', (p.x * w) + o + l, ',', p.y * h, ',', unTy.t[t]]);
        FastDrawTransparent((p.x * w) + o + l, p.y * h, unTy.t[t], brd.sprite);
      end;

  GetBitmapSize(brd.ground, w, h);
  i := BitmapFromString(w, h, '');
  FastDrawTransparent(0, 0, brd.ground, i);
  SetTransparentColor(brd.sprite, clWhite);
  FastDrawTransparent(0, 0, brd.sprite, i);
  SafeDrawBitmap(i, img.Canvas, 0, 0);
  FreeBitmap(i);
end;

procedure SetupForm;
begin
  frmMain := CreateForm;
  with frmMain do
  begin
    ClientWidth := 600;
    ClientHeight := 500;
    Position:= poScreenCenter;
    Caption := 'Strategy Game by mixster';
  end;

  sbxBoard := TScrollBox.Create(frmMain);
  with sbxBoard do
  begin
    Parent := frmMain;
    Width := 500;
    Height := 400;
    Left := 50;
    Top := 50;
  end;

  imgBoard := TImage.Create(frmMain);
  with imgBoard do
  begin
    Parent := sbxBoard;
    Width := 800;
    Height := 600
    Left := 0;
    Top := 0;
    DrawBoard(imgBoard, board, pieceset);
    DrawUnits(imgBoard, units, unitTypes, board, pieceset);
  end;

  frmMain.ShowModal;
end;

procedure LaunchForm;
var
  v: TVariantArray;
begin
  ThreadSafeCall('SetupForm', v);
end;

procedure ScriptTerminate;
var
  i: Integer;
begin
  i := 0;
  try
    FreeBitmap(i);
    Inc(i);
  except
  end;
end;

var
  t, i, ii: Integer;
begin
  Write(['Begin']);

  t := BitmapFromString(200, 400, '');
  for i := 0 to 7 do
    for ii := 0 to 3 do
    begin
      if (ii > 0) then
        if Random(3) = 0 then
          Break;

      GetBitmapCanvas(t).Brush.Color := Random(clWhite);
      GetBitmapCanvas(t).Pen.Color := GetBitmapCanvas(t).Brush.Color;
      GetBitmapCanvas(t).Rectangle(ii * 50, i * 50, ii * 50 + 50, i * 50 + 50);
    end;
  DisplayDebugImgWindow(200, 400);
  SafeDrawBitmap(t, GetDebugCanvas, 0, 0);
  SetupPieceset(pieceset, t, 4, 8);
  SetupBoard(board, pieceset, 13, 33);
  RandomBoard(board, pieceset);
  i := LoadBitmap(ScriptPath + 'units.bmp');
  SetupUnitTypes(unitTypes, pieceset, i, 6);
  FreeBitmap(i);
  RandomUnits(units, unitTypes, board, 10);
  LaunchForm;
  HideDebugImgWindow;
  Write(['End']);
end.