mixster

program Master;
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;
  mnuMain: TMainMenu;
  popNewUnit, popSetFact: TPopupMenu;
  mnuFactOpts, mnuUnits, mnuFactions: array of TMenuItem;
  board: TBoard;
  pieceset: TPieceset;
  unitTypes: TUnitSkel;
  units: TUnits;
  rp: TPoint;

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; var brd: TBoard; unTy: TUnitSkel; 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);
  uns.t[0].c := clRed;
  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);
      brd.t[p.y][p.x].o := True;
    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, b: Integer;
begin
  FastDrawClear(brd.sprite, clWhite);
  w := (pce.s.x + pce.sL) * 2;
  h := pce.s.y;
  b := BitmapFromString(w - pce.sL, h * 2, '');
  l := ((w - (2 * h)) - pce.sL) / 2;
  FastDrawClear(b, clWhite);
  for i := 0 to uni.h do
  begin
    if uni.h < 0 then
      Break;
    for ii := 0 to uni.t[i].h do
    begin
      if uni.t[i].h < 0 then
        Break;
      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;

        FastDrawTransparent((p.x * w) + o + l, p.y * h, unTy.t[t], brd.sprite);
      end;
      FastReplaceColor(brd.sprite, clBlack, uni.t[i].c);
    end;
  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 popupMenuClick(Sender: TObject); forward;
procedure mnuMainClick(Sender: TObject);
var
  i, c, f: Integer;
begin
  for i := 0 to High(mnuFactOpts) do
    if Sender = mnuFactOpts[i] then
      Break;
  with units do
  begin
    case i of
      1: begin
        h := h + 1;
        SetLength(t, h + 1);
        t[h].h := -1;
        SetLength(mnuFactions, h + 2);
        t[h].c := Random(clWhite) + 1;
        mnuFactions[h + 1] := TMenuItem.Create(frmMain);
        mnuFactions[h + 1].Caption := 'Faction ' + IntToStr(h + 1);
        mnuFactions[h + 1].OnClick := @popupMenuClick;
        popSetFact.Items.Add(mnuFactions[h + 1]);
      end;
      2: begin
        c := -1;
        case StrToIntDef(Readln('New colour (1-8)'), 1) of
          2: c := clGreen;
          3: c := clBlue;
          4: c := clYellow;
          5: c := clBronze;
          6: c := clWhite;
          7: c := clGray;
          8: c := clBlack;
        end;
        if c < 0 then
          c := clRed;

        f := StrToIntDef(Readln('Which faction (number)'), 1) - 1;
        if f > h then
          f := h;
        t[f].c := c;
      end;
      3: begin
        c := StrToIntDef(Readln('Which faction (number)'), h);
        if c > h then
          c := h;
        Swap(t[h], t[c]);
        SetLength(t, h);
        h := h - 1;
      end;
    end;
  end;

  DrawUnits(imgBoard, units, unitTypes, board, pieceset);
end;

procedure imgBoardMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: Integer);
var
  px, py: Integer;
begin
  if not (Button = mbRight) then
    Exit;

  rp.x := Trunc(Abs(x - pieceset.s.x / 2)) div (pieceset.s.x + pieceset.sL);
  if rp.x mod 2 = 0 then
    rp.y := ((y div (pieceset.s.y * 2)) * 2)
  else
    rp.y := (((y - pieceset.s.y) div (pieceset.s.y * 2)) * 2) + 1;

  if rp.y mod 2 = 0 then
    rp.x := x div ((pieceset.s.x + pieceset.sL) * 2)
  else
    rp.x := (x - (pieceset.s.x + pieceset.sL)) div ((pieceset.s.x + pieceset.sL) * 2);


  GetMousePos(px, py);

  if not board.t[rp.y][rp.x].o then
    popNewUnit.Popup(px, py)
  else
    popSetFact.Popup(px, py);

end;

procedure popupMenuClick(Sender: TObject);
var
  i, a, b, h, hh: Integer;
  nu: Boolean;
  up: TPoint;
begin
  nu := False;
  for i := 0 to High(mnuUnits) do
    if Sender = mnuUnits[i] then
    begin
      nu := True;
      Break;
    end;
  if not nu then
    for i := 0 to High(mnuFactions) do
      if Sender = mnuFactions[i] then
        Break;

  if (not nu) then
  begin
    for a := 0 to units.h do
      for b := 0 to units.t[a].h do
        if (units.t[a].u[b].p.x = rp.x) and (units.t[a].u[b].p.y = rp.y) then
        begin
          up := Point(b, a);
          break;
        end;
    if (up.y = i - 1) then
      exit;
    h := High(units.t[up.y].u);
    Swap(units.t[up.y].u[up.x], units.t[up.y].u[h]);

    if (i > 0) then
    begin
      hh := units.t[i - 1].h;
      units.t[i - 1].h := hh + 1;
      SetLength(units.t[i - 1].u, hh + 2);
      Swap(units.t[i - 1].u[hh + 1], units.t[up.y].u[h]);
    end;

    SetLength(units.t[up.y].u, h);
    units.t[up.y].h := h - 1;
  end
  else
  begin
    with units.t[0] do
    begin
      h := h + 1;
      SetLength(u, h + 1);
      u[h].p := rp;
      u[h].t := i;
      board.t[rp.y][rp.x].o := True;
    end;
  end;

  DrawUnits(imgBoard, units, unitTypes, board, pieceset);
end;

procedure SetupForm;
var
  i, h: Integer;
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;
    Align := alClient;
  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);
    OnMouseUp := @imgBoardMouseUp;
  end;

  mnuMain := TMainMenu.Create(frmMain);
  SetLength(mnuFactOpts, 4);
  for i := 0 to High(mnuFactOpts) do
  begin
    mnuFactOpts[i] := TMenuItem.Create(frmMain);
    case i of
      0: mnuFactOpts[i].Caption := 'Factions';
      1: mnuFactOpts[i].Caption := 'New';
      2: mnuFactOpts[i].Caption := 'Set color';
      3: mnuFactOpts[i].Caption := 'Delete';
    end;
    if i > 0 then
    begin
      mnuFactOpts[i].OnClick := @mnuMainClick;
      mnuMain.Items.Items[0].Add(mnuFactOpts[i]);
    end
    else
      mnuMain.Items.Add(mnuFactOpts[0]);
  end;

  popNewUnit := TPopupMenu.Create(frmMain);
  SetLength(mnuUnits, unitTypes.h + 1);

  popSetFact := TPopupMenu.Create(frmMain);
  SetLength(mnuFactions, units.h + 2);

  mnuFactions[0] := TMenuItem.Create(frmMain);
  mnuFactions[0].Caption := 'Delete unit';
  mnuFactions[0].OnClick := @popupMenuClick;
  popSetFact.Items.Add(mnuFactions[0]);

  for i := 0 to unitTypes.h do
  begin
    mnuUnits[i] := TMenuItem.Create(frmMain);
    mnuUnits[i].Caption := 'Unit ' + IntToStr(i + 1);
    mnuUnits[i].OnClick := @popupMenuClick;
    popNewUnit.Items.Add(mnuUnits[i]);
    if i > units.h then
      continue;
    mnuFactions[i + 1] := TMenuItem.Create(frmMain);
    mnuFactions[i + 1].Caption := 'Faction ' + IntToStr(i + 1);
    mnuFactions[i + 1].OnClick := @popupMenuClick;
    popSetFact.Items.Add(mnuFactions[i + 1])
  end;

  for i := unitTypes.h to units.h do
  begin
    if i > units.h then
      break;
    mnuFactions[i + 1] := TMenuItem.Create(frmMain);
    mnuFactions[i + 1].Caption := 'Faction ' + IntToStr(i + 1);
    mnuFactions[i + 1].OnClick := @popupMenuClick;
    popSetFact.Items.Add(mnuFactions[i + 1])
  end;

  frmMain.ShowModal;
end;

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

procedure ScriptTerminate;
var
  i: Integer;
begin
  i := 0;
  try
    repeat
      FreeBitmap(i);
      Inc(i);
    until false;
  except
  end;
  try
    FreeForm(frmMain);
  except
  end;
  Write(['Freed: ', i, ' bitmap(s) and the form']);
end;

var
  t, i, ii: Integer;
begin
  Write(['Begin']);
  DisplayDebugImgWindow(200, 400);
  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) + 1;
      GetBitmapCanvas(t).Pen.Color := GetBitmapCanvas(t).Brush.Color;
      GetBitmapCanvas(t).Rectangle(ii * 50, i * 50, ii * 50 + 50, i * 50 + 50);
    end;
  try
    SafeDrawBitmap(t, GetDebugCanvas, 0, 0);
  except
    Write(['Debug canvas failed again']);
  end;
  SetupPieceset(pieceset, t, 4, 8);
  FreeBitmap(t);
  SetupBoard(board, pieceset, 13, 33);
  RandomBoard(board, pieceset);
  i := LoadBitmap(ScriptPath + 'units.bmp');
  SetupUnitTypes(unitTypes, pieceset, i, 6);
  FreeBitmap(i);
  RandomUnits(units, board, unitTypes, 10);
  LaunchForm;
  HideDebugImgWindow;
  Write(['End']);
  TerminateScript;
end.