mixster

program ScaRPGMapEditor;
type
  TMap = record
    tpTiles: array of array of array of TPoint;
    x, y, z, p: Integer;
    att: array of array of Integer;
  end;
  TNPC = record
    s, m: TPoint;
    sTalk: string;
  end;
var
  frmMain: TForm;
  mnuMain: TMainMenu;
  mnuFile, mnuNew, mnuSave, mnuOpen, mnuRand: TMenuItem;
  mnuAttr: TPopupMenu;
  mnuBlnk, mnuBlck, mnuEnco: TMenuItem;
  dlgOpen: TOpenDialog;
  dlgSave: TSaveDialog;
  imgMain, imgTiles: TImage;
  pnlMain, pnlTiles: TPanel;
  scbMainX, scbMainY: TScrollBar;
  sbxTiles: TScrollBox;
  cmbLay: TComboBox;
  tiles, sprites: Integer;
  mapMain: TMap;
  npcMain: array of TNPC;
  cp, tp, md, mu: TPoint;

// GenerateMap - Draws the map onto a canvas and also applies movement based on input
procedure GenerateMap(x, y: Integer);
var
  bmpLay, bmpBuf, a, b, c, s, mapX, mapY, startX, startY: Integer;
begin
  bmpLay := BitmapFromString(480, 480, '');
  bmpBuf := BitmapFromString(480, 480, '');

  cp.x := cp.x + x;
  cp.y := cp.y + y;

  startX := cp.x - 7;
  startY := cp.y - 7;

  with mapMain do
  begin
    for a := 0 to z - 1 do
    begin
      FastDrawClear(bmpLay, 16448505);
      for b := startY to startY + 15 do
      begin
        if not InRange(b, 0, y - 1) then
          Continue;
        mapY := b - cp.y;
        for c := startX to startX + 15 do
        begin
          if not InRange(c, 0, x - 1) then
            Continue;
          mapX := c - cp.x;
          if not ((tpTiles[a][b][c].x < 0) and (tpTiles[a][b][c].y < 0)) then
            CopyCanvas(imgTiles.Canvas, GetBitmapCanvas(bmpLay), tpTiles[a][b][c].x * 32, tpTiles[a][b][c].y * 32, (tpTiles[a][b][c].x * 32) + 32, (tpTiles[a][b][c].y * 32) + 32, (c - startX) * 32, (b - startY) * 32, ((c - startX) * 32) + 32, ((b - startY) * 32) + 32);
        end;
      end;
      SetTransparentColor(bmpLay, 16448505);
      FastDrawTransparent(0, 0, bmpLay, bmpBuf);
      if a = p then
      begin
        FastDrawClear(bmpLay, 0);
        if High(npcMain) >= 0 then
          for s := 0 to High(npcMain) do
            with npcMain[s] do
            begin
              If InRange(m.x, cp.x - 7, cp.x + 8) and InRange(m.y, cp.y - 7, cp.y + 8) then
                CopyCanvas(GetBitmapCanvas(sprites), GetBitmapCanvas(bmpLay), s.x * 32, s.y * 32, (s.x * 32) + 32, (s.y * 32) + 32, (m.x - startX) * 32, (m.y - startY) * 32, ((m.x - startX) * 32) + 32, ((m.y - startY) * 32) + 32);
            end;
        SetTransparentColor(bmpLay, 0);
        FastDrawTransparent(0, 0, bmpLay, bmpBuf);
      end;
    end;
  end;
  SafeCopyCanvas(GetBitmapCanvas(bmpBuf), imgMain.Canvas, 0, 0, 480, 480, 0, 0, 480, 480);
  FreeBitmap(bmpBuf);
  FreeBitmap(bmpLay);
  for b := 1 to 14 do
  begin
    imgMain.Canvas.MoveTo(0, b * 32);
    imgMain.Canvas.LineTo(480, b * 32);
  end;
  for c := 1 to 14 do
  begin
    imgMain.Canvas.MoveTo(c * 32, 0);
    imgMain.Canvas.LineTo(c * 32, 480);
  end;
end;

// RandomizeMap - Makes a random map based on range input
procedure RandomizeMap(xs, ys, zs, ss, xe, ye, ze, se: Integer);
var
  mx, my, a, b, c: Integer;
  tsaRandTalk: TStringArray;
begin
  tsaRandTalk := ['Hai der', 'Howdy partner', 'Hi', 'SEX', 'How much wood could chuck norris chuck', 'I won''t kill you if you touch my penis'];
  GetBitmapSize(tiles, mx, my);
  with mapMain do
  begin
    x := RandomRange(xs, xe);
    y := RandomRange(ys, ye);
    z := RandomRange(zs, ze);
    p := z - 3;
    SetArrayLength(tpTiles, z);
    for a := 0 to z - 1 do
    begin
      SetArrayLength(tpTiles[a], y);
      SetArrayLength(att, y);
      for b := 0 to y - 1 do
      begin
        SetArrayLength(tpTiles[a][b], x);
        SetArrayLength(att[b], x);
        for c := 0 to x - 1 do
        begin
          tpTiles[a][b][c].x := Random(mx div 32);
          tpTiles[a][b][c].y := Random(my div 32);
          if Random(10) <= 2 then
            att[b][c] := 2
          else
            att[b][c] := 0;
        end;
      end;
    end;
  end;
  GetBitmapSize(tiles, mx, my);
  SetArrayLength(npcMain, RandomRange(ss, se));
  for a := 0 to High(npcMain) do
    with npcMain[a] do
    begin
      s.x := Random(mx div 128) * 3;
      s.y := Random(my div 32);
      m.x := Random(mapMain.x);
      m.y := Random(mapMain.y);
      sTalk := tsaRandTalk[Random(High(tsaRandTalk))];
      mapMain.att[m.y][m.x] := 1;
    end;
end;

// BlankMap - Makes a blank map based on user input
procedure BlankMap;
var
  a, b, c: Integer;
begin
with mapMain do
  begin
    x := StrToIntDef(Readln('Width'), 15);
    y := StrToIntDef(Readln('Height'), 15);
    z := StrToIntDef(Readln('Depth'), 5)
    p := z - 2;
    if p < 0 then
      p := 0;
    SetArrayLength(tpTiles, z);
    for a := 0 to z - 1 do
    begin
      SetArrayLength(tpTiles[a], y);
      SetArrayLength(att, y);
      for b := 0 to y - 1 do
      begin
        SetArrayLength(tpTiles[a][b], x);
        SetArrayLength(att[b], x);
        for c := 0 to x - 1 do
        begin
          tpTiles[a][b][c].x := -1;
          tpTiles[a][b][c].y := -1;
        end;
      end;
    end;
  end;
  cp.x := mapMain.x div 2;
  cp.y := mapMain.y div 2;
  try
    scbMainX.Max := mapMain.x - 8;
  except
    scbMainX.Max := scbMainX.Min + 1;
  end;
  try
    scbMainY.Max := mapMain.y - 8;
  except
    scbMainY.Min := scbMainY.Min + 1;
  end;
  scbMainX.Position := cp.x;
  scbMainY.Position := cp.y;
  for a := 0 to cmbLay.Items.Count + 2 do
    cmbLay.Items.Delete(0);
  for a := 0 to mapMain.z - 1 do
    cmbLay.Items.Add('Layer ' + IntToStr(a));
  cmbLay.ItemIndex := 0;

  GenerateMap(0, 0);
end;

// ExplodeInt - Like other languages explode excepts turns into integers
function ExplodeInt(str, del: string): TIntegerArray;
var
  i: Integer;
begin
  repeat
    i := Pos(del, str);
    SetArrayLength(Result, High(Result) + 2);
    if i <= 0 then
      Break;
    Result[High(Result)] := StrToIntDef(Copy(str, 1, i - 1), 0);
    Delete(str, 1, i);
  until false;
  Result[High(Result)] := StrToIntDef(Copy(str, 1, Length(str)), 0);
end;

// OpenMap - Reads the selected map then puts into mapMain
procedure OpenMap;
var
  titMap: TIntegerArray;
  a, b, c: Integer;
begin
  if not dlgOpen.Execute then
    Exit;

  with mapMain do
  begin
    x := StrToIntDef(ReadINI('Layout', 'Width', dlgOpen.FileName), 15);
    y := StrToIntDef(ReadINI('Layout', 'Height', dlgOpen.FileName), 15);
    z := StrToIntDef(ReadINI('Layout', 'Depth', dlgOpen.FileName), 15);
    p := z - 2;
    if p < 0 then
      p := 0;

    SetArrayLength(tpTiles, 0);
    SetArrayLength(tpTiles, z);
    SetArrayLength(att, 0);
    SetArrayLength(att, y);
    for a := 0 to z - 1 do
    begin
      SetArrayLength(tpTiles[a], 0);
      SetArrayLength(tpTiles[a], y);
      for b := 0 to y - 1 do
      begin
        SetArrayLength(tpTiles[a][b], 0);
        SetArrayLength(tpTiles[a][b], x);
        titMap := ExplodeInt(ReadINI('Layer' + IntToStr(a), 'Row' + IntToStr(b), dlgOpen.FileName), ',');
        for c := 0 to x - 1 do
        begin
          try
            tpTiles[a][b][c].x := titMap[c * 2];
            tpTiles[a][b][c].y := titMap[c * 2 + 1];
          except
            if not Lowercase(Readln('Map corrupted - open anyway?(yes/no)')) = 'yes' then
              frmMain.Close;
          end;
        end;
        if a = 0 then
        begin
          SetArrayLength(att[b], 0);
          SetArrayLength(att[b], x);
          mapMain.att[b] := ExplodeInt(ReadINI('Attrib', 'Row' + IntToStr(b), dlgOpen.FileName), ',');
        end;
        SetArrayLength(titMap, 0);
      end;
    end;
  end;

  cp.x := mapMain.x div 2;
  cp.y := mapMain.y div 2;
  try
    scbMainX.Max := mapMain.x - 8;
  except
    scbMainX.Max := scbMainX.Min;
  end;
  try
    scbMainY.Max := mapMain.y - 8;
  except
    scbMainY.Min := scbMainY.Min;
  end;
  scbMainX.Position := cp.x;
  scbMainY.Position := cp.y;
  while cmbLay.Items.Count > 0 do
    cmbLay.Items.Delete(0);
  for a := 0 to mapMain.z - 1 do
    cmbLay.Items.Add('Layer ' + IntToStr(a));
  cmbLay.ItemIndex := 0;
  GenerateMap(0, 0);
end;

// ImplodeInt - Reverse of explode, takes a TIntegerArray and turns it into a string based on the delimiter
function ImplodeInt(tit: TIntegerArray; del: string): string;
var
  i: Integer;
begin
  for i :=  0 to High(tit) do
    Result := Result + IntToStr(tit[i]) + del;
  Delete(Result, Length(Result), 1);
end;

// SaveMap - Takes apart the map and puts it into strings before saving in selected file
procedure SaveMap;
var
  a, b, c: Integer;
  titMap: TIntegerArray;
begin
  if not dlgSave.Execute then
    Exit;
  with mapMain do
  begin
    WriteINI('Layout', 'Width', IntToStr(x), dlgSave.FileName);
    WriteINI('Layout', 'Height', IntToStr(y), dlgSave.FileName);
    WriteINI('Layout', 'Depth', IntToStr(z), dlgSave.FileName);
    SetArrayLength(titMap, x * 2);
    for a := 0 to z - 1 do
    begin
      for b := 0 to y - 1 do
      begin
        for c := 0 to x - 1 do
        begin
          titMap[c * 2] := mapMain.tpTiles[a][b][c].x;
          titMap[c * 2 + 1] := mapMain.tpTiles[a][b][c].y;
        end;
        WriteINI('Layer' + IntToStr(a), 'Row' + IntToStr(b), ImplodeInt(titMap, ','), dlgSave.Filename);
      end;
    end;
  end;
  with mapMain do
  begin
    for b := 0 to y - 1 do
      WriteINI('Attrib', 'Row' + IntToStr(b), ImplodeInt(mapMain.att[b], ','), dlgSave.Filename)
  end;
end;

// RandMap - Generates a random map based on user input
procedure RandMap;
var
  a, b, c: Integer;
begin
with mapMain do
  begin
    x := StrToIntDef(Readln('Width'), 15);
    y := StrToIntDef(Readln('Height'), 15);
    z := StrToIntDef(Readln('Depth'), 4)
    p := z - 2;
    SetArrayLength(tpTiles, z);
    for a := 0 to z - 1 do
    begin
      SetArrayLength(tpTiles[a], y);
      SetArrayLength(att, y);
      for b := 0 to y - 1 do
      begin
        SetArrayLength(tpTiles[a][b], x);
        SetArrayLength(att[b], x);
        for c := 0 to x - 1 do
        begin
          tpTiles[a][b][c].x := Random(imgTiles.Width div 32);
          tpTiles[a][b][c].y := Random(imgTiles.Height div 32);
        end;
      end;
    end;
  end;
  cp.x := mapMain.x div 2;
  cp.y := mapMain.y div 2;
  try
    scbMainX.Max := mapMain.x - 8;
  except
    scbMainX.Max := scbMainX.Min + 1;
  end;
  try
    scbMainY.Max := mapMain.y - 8;
  except
    scbMainY.Min := scbMainY.Min + 1;
  end;
  scbMainX.Position := cp.x;
  scbMainY.Position := cp.y;
  for a := 0 to cmbLay.Items.Count + 2 do
    cmbLay.Items.Delete(0);
  for a := 0 to mapMain.z - 1 do
    cmbLay.Items.Add('Layer ' + IntToStr(a));
  cmbLay.ItemIndex := 0;

  GenerateMap(0, 0);
end;

// HandleMenu - Does appropriate task based on what menu item selected
procedure HandleMenu(Sender: TObject);
begin
  case Sender of
    mnuNew: BlankMap;
    mnuOpen: OpenMap;
    mnuSave: SaveMap;
    mnuRand: RandMap;
  end;
end;

// HandlePopup - Changes attribute of square to selected one
procedure HandlePopup(Sender: TObject);
var
  x, y, a: Integer;
begin
  case Sender of
    mnuBlnk: a := 0;
    mnuBlck: a := 1;
    mnuEnco: a := 2;
  end;
  for y := md.y to mu.y do
    for x := md.x to mu.x do
      mapMain.att[y][x] := a;
end;

// HandleScroll - Repaints map if map scroll bar sent or changes visible tiles if tile scroll bar sent
procedure HandleScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
  case Sender of
    scbMainX: if ScrollPos = cp.x then
      Exit;
    scbMainY: if ScrollPos = cp.y then
      Exit;
  end;

  if Sender is TScrollBar then
    TScrollBar(Sender).OnScroll := nil;
  case Sender of
    scbMainX: GenerateMap(Scrollpos - cp.x, 0);
    scbMainY: GenerateMap(0, Scrollpos - cp.y);
  end;
  if Sender is TScrollBar then
    TScrollBar(Sender).OnScroll := @HandleScroll;
end;

// HandleMouseDown - Sets tile to selected tile when left clicking or shows popup menu when right clicking
procedure HandleMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  X := ((X div 32) * 32) + 16;
  Y := ((Y div 32) * 32) + 16;
  if Button = mbRight then
  begin
    md.x := X div 32;
    md.y := Y div 32;
    imgMain.Canvas.MoveTo(X, Y);
    imgMain.Canvas.Pen.Width := 8;
    imgMain.Canvas.LineTo(X, Y);
    imgMain.Canvas.Pen.Width := 1;
    Exit;
  end;
  if Sender = imgTiles then
  begin
    tp.x := X div 32;
    tp.y := Y div 32;
  end
  else if Sender = imgMain then
  begin
    imgMain.Canvas.MoveTo(X, Y);
    imgMain.Canvas.Pen.Width := 8;
    imgMain.Canvas.LineTo(X, Y);
    imgMain.Canvas.Pen.Width := 1;
    md.x := X div 32;
    md.y := Y div 32;
  end;
end;

procedure HandleMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  mu.x := X div 32;
  mu.y := Y div 32;
  if Button = mbRight then
  begin
    GenerateMap(0, 0);
    if md.x > mu.x then
      Swap(md.x, mu.x);
    if md.y > mu.y then
      Swap(md.y, mu.y);
    GetMousePos(X, Y);
    mnuAttr.Popup(X, Y);
    Exit;
  end;
  if Sender = imgMain then
  begin
    if md.x > mu.x then
      Swap(md.x, mu.x);
    if md.y > mu.y then
      Swap(md.y, mu.y);
    for Y := md.y to mu.y do
      for X := md.x to mu.x do
      begin
        mapMain.tpTiles[cmbLay.ItemIndex][Y + cp.y - 7][X + cp.x - 7].x := tp.x;
        mapMain.tpTiles[cmbLay.ItemIndex][Y + cp.y - 7][X + cp.x - 7].y := tp.y;
      end;
    GenerateMap(0, 0);
  end;
end;

// SetupForm - Sets up all the forms objects
procedure SetupForm;
var
  sw, sh, bw, bh, i: Integer;
begin
  GetClientDimensions(sw, sh);
  GetBitmapSize(tiles, bw, bh);
  frmMain := CreateForm;

  dlgOpen := TOpenDialog.Create(frmMain);
  dlgOpen.Filter := 'maps| *.ini';

  dlgSave := TSaveDialog.Create(frmMain);
  dlgSave.Filter := 'maps| *.ini';

  mnuMain := TMainMenu.Create(frmMain);

  mnuFile := TMenuItem.Create(frmMain);
  mnuFile.Caption := 'File';
  mnuMain.Items.Add(mnuFile);

  mnuNew := TMenuItem.Create(frmMain);
  mnuNew.Caption := 'New';
  mnuNew.OnClick := @HandleMenu;
  mnuMain.Items.Items[0].Add(mnuNew);

  mnuOpen := TMenuItem.Create(frmMain);
  mnuOpen.Caption := 'Open';
  mnuOpen.OnClick := @HandleMenu;
  mnuMain.Items.Items[0].Add(mnuOpen);

  mnuSave := TMenuItem.Create(frmMain);
  mnuSave.Caption := 'Save';
  mnuSave.OnClick := @HandleMenu;
  mnuMain.Items.Items[0].Add(mnuSave);

  mnuRand := TMenuItem.Create(frmMain);
  mnuRand.Caption := 'Random';
  mnuRand.OnClick := @HandleMenu;
  mnuMain.Items.Items[0].Add(mnuRand);

  mnuAttr := TPopupMenu.Create(frmMain);

  mnuBlnk := TMenuItem.Create(frmMain);
  mnuBlnk.Caption := 'No attribute';
  mnuBlnk.OnClick := @HandlePopup;
  mnuAttr.Items.Add(mnuBlnk);

  mnuBlck := TMenuItem.Create(frmMain);
  mnuBlck.Caption := 'Blocked';
  mnuBlck.OnClick := @HandlePopup;
  mnuAttr.Items.Add(mnuBlck);

  mnuEnco := TMenuItem.Create(frmMain);
  mnuEnco.Caption := 'Encounter';
  mnuEnco.OnClick := @HandlePopup;
  mnuAttr.Items.Add(mnuEnco);

  with frmMain do
  begin
    Caption := 'ScaRPG Map Editor by mixster';
    ClientWidth := 554 + bw;
    ClientHeight := 522;
    Left := (sw - Width) div 2;
    Top := (sh - Height) div 2;
  end;

  pnlMain := TPanel.Create(frmMain);
  with pnlMain do
  begin
    Parent := frmMain;
    Width := 502;
    Height := 502;
    Left := 10;
    Top := 10;
  end;

  scbMainX := TScrollBar.Create(pnlMain)
  with scbMainX do
  begin
    Parent := pnlMain;
    Width := 480;
    Top := 480;
    Min := 7;
    Max := mapMain.x - 8;
    Position := mapMain.x div 2;
    Kind := sbHorizontal;
    OnScroll := @HandleScroll;
  end;

  scbMainY := TScrollBar.Create(pnlMain)
  with scbMainY do
  begin
    Parent := pnlMain;
    Width := 480;
    Left := 480;
    Min := 7;
    Max := mapMain.y - 8;
    Position := mapMain.y div 2;
    Kind := sbVertical;
    OnScroll := @HandleScroll;
  end;

  imgMain := TImage.Create(pnlMain);
  with imgMain do
  begin
    Parent := pnlMain;
    Width := 480;
    Height := 480;
    OnMouseDown := @HandleMouseDown;
    OnMouseUp := @HandleMouseUp;
    Canvas.Pen.Color := clYellow;
  end;

  pnlTiles := TPanel.Create(frmMain);
  with pnlTiles do
  begin
    Parent := frmMain;
    Width := bw + 22;
    Height := 480;
    Left := 522;
    Top := 10;
  end;

  sbxTiles := TScrollBox.Create(pnlTiles);
  with sbxTiles do
  begin
    Parent := pnlTiles;
    Align := alClient;
    sbxTiles.VertScrollBar.Range := bh;
    sbxTiles.VertScrollBar.Increment := 4;
    sbxTiles.VertScrollBar.Tracking := True;
  end;

  imgTiles := TImage.Create(sbxTiles);
  with imgTiles do
  begin
    Parent := sbxTiles;
    Width := bw;
    Height := bh;
    SafeDrawBitmap(tiles, Canvas, 0, 0);
    OnMouseDown := @HandleMouseDown;
  end;

  cmbLay := TComboBox.Create(frmMain);
  with cmbLay do
  begin
    Parent := frmMain;
    Left := 522;
    Top := 490;
    for i := 0 to mapMain.z - 1 do
      Items.Add('Layer ' + IntToStr(i));
    ItemIndex := 0;
  end;

  FreeBitmap(sprites);
  FreeBitmap(tiles);
  GenerateMap(0, 0);
  frmMain.ShowModal;
end;

var
  v: TVariantArray;
begin
  tiles := LoadBitmap(ScriptPath + 'Tiles.bmp');
  sprites := LoadBitmap(ScriptPath + 'Sprites.bmp');
  RandomizeMap(50, 50, 4, 0, 50, 50, 4, 0);
  cp.x := mapMain.x div 2;
  cp.y := mapMain.y div 2;
  ThreadSafeCall('SetupForm', v);
  FreeForm(frmMain);
end.