mixster

program ScaRPG;
const
  FPS = 30; // Fine tune to improve performance
  debugScript = True; // Set to true to output debugging data
type
  TMap = record
    tpTiles: array of array of array of TPoint;
    att: array of array of Integer;
    x, y, z, p: Integer;
  end;
  TNPC = record
    s, m: TPoint;
    sTalk: string;
  end;
  TChar = record
    s, m, d: TPoint;
  end;
  TStat = record
    att, def, spd, hp: Integer;
  end;
  TBattleChar = record
    id, lvl, bHp, xp, atb: Integer;
    ind, cur: TStat;
    moves: TIntegerArray;
  end;
  TMoveList = array of record
    tMo, level: Integer;
  end;
  TSpecies = record
    base: TStat;
    xp: Integer;
    posMoves: TMoveList;
    name: string;
  end;
  TMove = record
    power, acc: Integer;
    name: string;
  end;
  TItem = record
    power, owned: Integer;
    name: string;
  end;
var
  frmMain: TForm;
  imgMain: TImage;
  lblTalk, lblParty, lblEnemies, lblMoves, lblTargets, lblMenu, lblInfo: TLabel;
  shpMove, shpTarget, shpMenu: TShape;
  tmrEngine: TTimer;
  dlgOpen: TOpenDialog;
  tiles, sprites: Integer;
  mapMain: TMap;
  chrMain: TChar;
  npcMain: array of TNPC;
  bcParty, bcEnemies: array of TBattleChar;
  stSRLMon: array of TSpecies;
  moMoves: array of TMove;
  tiItems: array of TItem;
  battling, selTarg: Boolean;
  encCount: Integer;

procedure Debug(s: string);
begin
  if debugScript then
    Writeln(s);
end;

procedure DebugI(i: Integer);
begin
  Debug(IntToStr(i));
end;

procedure DebugTP(t: TPoint);
begin
  Debug(IntToStr(t.x) + ',' + IntToStr(t.y));
end;

procedure Engine(sender: TObject); forward;

// GenerateMap - Uses information in "mapMain" to assemble a 3D map onto a 2D canvas in a small amount of time
procedure GenerateMap;
var
  bmpLay, bmpBuf, a, b, c, s, mapX, mapY, startX, startY, copyXO, copyYO: Integer;
begin
  bmpLay := BitmapFromString(544, 544, '');
  bmpBuf := BitmapFromString(544, 544, '');

  copyXO := Round(chrMain.d.x * (32 / 3)) + 32;
  copyYO := Round(chrMain.d.y * (32 / 3)) + 32;
  startX := chrMain.m.x - 8;
  startY := chrMain.m.y - 8;

  with mapMain do
  begin
    for a := 0 to z - 1 do
    begin
      FastDrawClear(bmpLay, 16448505);
      for b := startY to startY + 17 do
      begin
        if not InRange(b, 0, y - 1) then
          Continue;
        mapY := b - chrMain.m.y;
        for c := startX to startX + 17 do
        begin
          if not InRange(c, 0, x - 1) then
            Continue;
          mapX := c - chrMain.m.x;
          CopyCanvas(GetBitmapCanvas(tiles), 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);
        with chrMain do
        begin
          CopyCanvas(GetBitmapCanvas(sprites), GetBitmapCanvas(bmpLay), s.x * 32, s.y * 32, (s.x * 32) + 32, (s.y * 32) + 32, 224 + copyXO, 224 + copyYO, 256 + copyXO, 256 + copyYO);
        end;
        if High(npcMain) >= 0 then
          for s := 0 to High(npcMain) do
            with npcMain[s] do
            begin
              If InRange(m.x, chrMain.m.x - 8, chrMain.m.x + 9) and InRange(m.y, chrMain.m.y - 8, chrMain.m.y + 9) 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;
  try
    SafeCopyCanvas(GetBitmapCanvas(bmpBuf), imgMain.Canvas, copyXO, copyYO, copyXO + 480, copyYO + 480, 0, 0, 480, 480);
  except
    Writeln('Map drawing failed - exiting');
  end;
  FreeBitmap(bmpBuf);
  FreeBitmap(bmpLay);
end;

procedure GenerateStats(bcChars: array of TBattleChar; maxHp: Boolean); forward;

// RandomizeMap - Takes in info as a range and generates comepletely random content with it, including enemies and party members
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 - 1;
    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);
        end;
      end;
    end;
  end;
  with chrMain do
  begin
    m.x := mapMain.x div 2;
    m.y := mapMain.y div 2;
  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;
  SetArrayLength(moMoves, RandomRange(155,255));
  for a := 0 to High(moMoves) do
    with moMoves[a] do
    begin
      for b := 0 to RandomRange(3, 6) do
        name := name + Chr(RandomRange(32, 127));
      power := (RandomRange(50, 150) + RandomRange(50, 150)) div 2;
      acc := RandomRange(40, 100);
    end;
  SetArrayLength(stSRLMon, RandomRange(155, 255));
  for a := 0 to High(stSRLMon) do
    with stSRLMon[a] do
    begin
      for b := 0 to RandomRange(3, 6) do
        name := name + Chr(RandomRange(32, 127));
      base.hp := RandomRange(75, 150);
      base.att := RandomRange(75, 150);
      base.def := RandomRange(75, 150);
      base.spd := RandomRange(75, 150);
      xp := RandomRange(50, 250);
      SetArrayLength(posMoves, 100);
      for b := 0 to High(posMoves) do
        with posMoves[b] do
        begin
          tMo := Random(High(moMoves) + 1);
          level := b;
        end;
    end;
  if High(bcParty) <= 2 then
  SetArrayLength(bcParty, 4);
  for a := 0 to High(bcParty) do
    with bcParty[a] do
    begin
      if lvl = 0 then
      begin
        id := Random(High(stSRLMon));
        ind.hp := 200;
        ind.att := 200;
        ind.def := 200;
        ind.spd := 500;
        lvl := 5;
        moves := [stSRLMon[id].posMoves[0].tmo, stSRLMon[id].posMoves[1].tmo, stSRLMon[id].posMoves[2].tmo, stSRLMon[id].posMoves[3].tmo, stSRLMon[id].posMoves[4].tmo];
      end;
    end;
  GenerateStats(bcParty, True);
  SetArrayLength(tiItems, RandomRange(10, 20));
  for a := 0 to High(tiItems) do
    with tiItems[a] do
    begin
      power := Random(90) + 10;
      for b := 0 to RandomRange(3, 6) do
        name := name + Chr(RandomRange(32, 127));
      if Random(10) <= 3 then
        owned := Random(5);
    end;
  encCount := Random(100);
end;

// OffScreen - Takes characters movement and will return true is char will end up offscreen
function OffScreen: Boolean;
begin
  with chrMain do
    case s.x of
      3: Result := m.y >= mapMain.y - 1;
      9: Result := m.x >= mapMain.x - 1;
      0: Result := m.y <= 0;
      6: Result := m.x <= 0;
    end;
end;

// Collision - Sees if the characters movement will cause a collision with an attribute such as blocked tile
function Collision(attribute: Integer): Boolean;
begin
  with chrMain do
    case s.x of
      3: if m.y < mapMain.y then
        Result := mapMain.att[m.y + 1][m.x] = attribute;
      9: if m.x < mapMain.x then
        Result := mapMain.att[m.y][m.x + 1] = attribute;
      0: if m.y > 0 then
        Result := mapMain.att[m.y - 1][m.x] = attribute;
      6: if m.x > 0 then
        Result := mapMain.att[m.y][m.x - 1] = attribute;
    end;
end;

// TalkCollision - Returns a TPoint of an npc the character is facing used to find which NPC it is by comparing positions
function TalkCollision: TPoint;
begin
  Result.x := 0;
  Result.y := 0;
  case chrMain.s.x of
    0: Dec(Result.y);
    6: Dec(Result.x);
    3: Inc(Result.y);
    9: Inc(Result.x);
  end;
  IncEx(Result.x, chrMain.m.x);
  IncEx(Result.y, chrMain.m.y);
end;

procedure PrepareBattle; forward;

// HandleMove - Timer procedure that handles the smooth movement of the character
procedure HandleMove(sender: TObject);
begin
  with chrMain do
  begin
    if tmrEngine.Interval = 1000 / FPS then
    begin
      if Collision(1) or OffScreen then
      begin
        tmrEngine.OnTimer := @Engine;
        d.y := 0;
        d.x := 0;
        GenerateMap;
        Exit;
      end
      else if Collision(2) then
        Dec(encCount);
      tmrEngine.Interval := (1000 / FPS) * 4;
    end
    else if d.y < 0 then
      Dec(d.y)
    else if d.x < 0 then
      Dec(d.x)
    else if d.y > 0 then
      Inc(d.y)
    else if d.x > 0 then
      Inc(d.x);

    Inc(s.x);
    if (not (InRange(d.y, -2, 2))) or (not (InRange(d.x, -2, 2))) then
    begin
      DecEx(s.x, 3);
      if d.y < 0 then
        Dec(m.y)
      else if d.y > 0 then
        Inc(m.y)
      else if d.x < 0 then
        Dec(m.x)
      else
        Inc(m.x);
      d.y := 0;
      d.x := 0;
      tmrEngine.OnTimer := @Engine;
      tmrEngine.Interval := 1000 / FPS;
      Writeln('P:' + IntToStr(chrMain.m.x) + ',' + IntToStr(chrMain.m.y) + ' - E:' + IntToStr(encCount));
    end;
  end;
  GenerateMap;
  if (encCount <= 0) and (chrMain.d.x = 0) and (chrMain.d.y = 0) then
    PrepareBattle;
end;

function GetKeyDown: char; forward;

// HandleTalk - Procedure to see if facing a NPC and if so to launch the chat
procedure HandleTalk(sender: TObject);
var
  s: Integer;
  p: TPoint;
begin
  with imgMain do
    if Tag = 0 then
    begin
      if not Collision(1) then
      begin
        tmrEngine.OnTimer := @Engine;
        Exit;
      end
      else
      begin
        p := TalkCollision;
        for s := 0 to High(npcMain) do
          if (p.x = npcMain[s].m.x) and (p.y = npcMain[s].m.y) then
          begin
            lblTalk.Caption := npcMain[s].sTalk;
            Break;
          end;
      end;
      if lblTalk.Caption = '' then
      begin
        tmrEngine.OnTimer := @Engine;
        Exit;
      end;
      Tag := 1;
      Canvas.RoundRect(1, 415, 479, 479, 20, 20);
      lblTalk.Visible := True;
    end
    else if GetKeyDown = 'e' then
    begin
      tmrEngine.OnTimer := @Engine;
      lblTalk.Caption := '';
      lblTalk.Visible := False;
      GenerateMap;
      Tag := 0;
    end;
end;

// GetKeyDown - Returns a general range character that is down
function GetKeyDown: char;
var
  i: Integer;
  s: string;
begin
  for i := 32 to 127 do
    if IsKeyDown(Chr(i)) then
      if IsKeyDown(Chr(i)) then
        s := s + Chr(i);
  if Length(s) > 0 then
    Result := s[Length(s)]
  else
    Result := Chr(1);
end;

// GenerateStats - Takes in a party (own or enemies) and then makes their stats through a formula and will max out hp if maxHp is true
procedure GenerateStats(bcChars: array of TBattleChar; maxHp: Boolean);
var
  i: Integer;
begin
  for i := 0 to High(bcChars) do
    with bcChars[i] do
    begin
      cur.hp := Trunc(((((2 * stSRLMon[id].base.hp) + ind.hp) * lvl) / 100) + lvl + 10);
      cur.att := Trunc(((((2 * stSRLMon[id].base.att) + ind.att) * lvl) / 100) + 5);
      cur.def := Trunc(((((2 * stSRLMon[id].base.def) + ind.def) * lvl) / 100) + 5);
      cur.spd := Trunc(((((2 * stSRLMon[id].base.spd) + ind.spd) * lvl) / 100) + 5);
      if maxHp then
        bHp := cur.hp;
      atb := Random(1001);
    end;
end;

// HandleXP - Will award xp to the party based on a formula and how much damage was done to the enemies
function HandleXp: Integer;
var
  i: Integer;
begin
  for i := 0 to High(bcEnemies) do
    with bcEnemies[i] do
      IncEx(bcEnemies[0].xp, Trunc((((stSRLMon[id].xp * lvl) div 12) div cur.hp) * (cur.hp - bHp)));

  bcEnemies[0].xp := bcEnemies[0].xp div (High(bcParty) + 1);
  for i := 0 to High(bcParty) do
    with bcParty[i] do
    begin
      IncEx(xp, bcEnemies[0].xp);
      if xp >= Trunc(Pow(3 * lvl, 3) / 4) then
      begin
        DecEx(xp,Trunc(Pow(3 * lvl, 3) / 4));
        Inc(lvl);
      end;
    end;
  Result := bcEnemies[0].xp;
end;

// SetupBattleLabels - Puts in the appropriate information to the labels on the battle screen
procedure SetupBattleLabels;
var
  i: Integer;
begin
  lblParty.Caption :=  '';
  for i := 0 to High(bcParty) do
    with bcParty[i] do
      lblParty.Caption := lblParty.Caption + stSRLMon[id].Name + ': L: ' + IntToStr(lvl) + '; HP ' + IntToStr(bHp) + '/' + IntToStr(cur.hp) + '; A: ' + IntToStr(cur.att) + '; D: ' + IntToStr(cur.def) + '; S: ' + IntToStr(cur.spd) + '; ATB: ' + IntToStr(atb) + '; XP: ' + IntToStr(xp) + '/' + IntToStr(Trunc(Pow(3 * lvl, 3) / 4)) + #13;
  lblEnemies.Caption := '';
  for i := 0 to High(bcEnemies) do
    with bcEnemies[i] do
      lblEnemies.Caption := lblEnemies.Caption + stSRLMon[id].Name + ': L: ' + IntToStr(lvl) + '; HP ' + IntToStr(bHp) + '/' + IntToStr(cur.hp) + '; A: ' + IntToStr(cur.att) + '; D: ' + IntToStr(cur.def) + '; S: ' + IntToStr(cur.spd) + '; ATB: ' + IntToStr(atb) + #13;
end;

procedure BattleEngine(Sender: TObject); forward;

// PrepareBattle - Sets up all the necessary stuff for the battle
procedure PrepareBattle;
var
  i, a, r: Integer;
  pM: TIntegerArray;
begin
  battling := True;
  SetArrayLength(bcEnemies, 0);
  SetArrayLength(bcEnemies, High(bcParty) + Random(3) - 1);
  for i := 0 to High(bcParty) do
    IncEx(a, bcParty[i].lvl);
  a := a div (High(bcParty) + 1);
  for i := 0 to High(bcEnemies) do
    with bcEnemies[i] do
    begin
      id := Random(High(stSRLMon) + 1);
      lvl := a + Random(3) - 1;
      ind.hp := RandomRange(75, 125);
      ind.att := RandomRange(75, 125);
      ind.def := RandomRange(75, 125);
      ind.spd := RandomRange(75, 125);
      for a := High(stSRLMon[id].posMoves) downto 0 do
        if stSRLMon[id].posMoves[a].level <= lvl then
        begin
          SetArrayLength(pM, High(pM) + 2);
          pM[High(pM)] := a;
        end;
      if High(pM) > 9 then
        SetArrayLength(pM, 10);
      for a := 0 to 5 do
      begin
        if High(pM) = -1 then
          Break;
        r := Random(High(pM) + 1);
        SetArrayLength(moves, High(moves) + 2);
        moves[High(moves)] := pM[r];
        Swap(pM[r], pM[High(pM)]);
        SetArrayLength(pM, High(pM));
      end;
    end;
  GenerateStats(bcParty, False);
  GenerateStats(bcEnemies, True);
  lblParty.Visible := True;
  lblEnemies.Visible := True;
  imgMain.Canvas.Rectangle(0, 0, 480, 480);
  SetupBattleLabels;
  tmrEngine.Interval := 64;
  tmrEngine.OnTimer := @BattleEngine;
end;

// ApplyDamage - plugs numbers to decide on how much damage will be dealt and random miss chance
procedure ApplyDamage(var bcFrom, bcUpon: TBattleChar; tmoId: Integer);
var
  damage: Integer;
begin
  with bcFrom do
    damage := ((((((((2 * lvl) div 5) + 2) * cur.att * moMoves[moves[tmoId]].Power) div bcUpon.cur.def) div 50) + 2) * RandomRange(217, 255)) div 255;
  if Random(100) + 1 > moMoves[bcFrom.moves[tmoId]].Acc then
    damage := 0;
  DecEx(bcUpon.bHp, damage);
  DecEx(bcFrom.atb, 1000);
  if bcUpon.bHp <= 0 then
    bcUpon.bHp := 0;
end;

// HandleEnd - Gives out xp and tells the user whether won or lost and sets a new encounter number
procedure HandleEnd(victory: Boolean);
var
  i: Integer;
begin
  battling := False;
  if victory then
    lblMoves.Caption := 'Well done, you won!'
  else
    lblMoves.Caption := 'Oh no, defeated!';
  lblMoves.Caption := lblMoves.Caption + ' SRLMon gained ' + IntToStr(HandleXP) + ' xp';
  lblMoves.Visible := True;
  if not victory then
    for i := 0 to High(bcParty) do
      with bcParty[i] do
      begin
        lblMoves.Caption:= lblMoves.Caption + ', but lost ' + IntToStr(Trunc((Pow(3 * lvl, 3) div 4) div 10)) + ' xp';
        DecEx(bcParty[i].xp, Trunc((Pow(3 * lvl, 3) div 4) div 10));
      end;
  encCount := (Random(100) + Random(100) + Random(100)) div 3;
end;

// BattleAI - basic AI that will decide on which move to use depending on current HP - near dead enemies fight better
procedure BattleAI(var bcEnemy: TBattleChar);
var
  hpPcnt, i: Integer;
  m: TPoint;
begin
  with bcEnemy do
  begin
    hpPcnt := Trunc((bHp div cur.hp) * 100);
    if hpPcnt >= 70 then
    begin
      m.x := Random(High(moves) + 1);
      for i := High(bcParty) downto 0 do
        if bcParty[i].bHp > 0 then
        begin
          m.y := Random(i + 1);
          Break;
        end;
    end
    else if hpPcnt >= 40 then
    begin
      if RBool then
      begin
        m.x := Random(High(moves) + 1);
        m.y := 99;
        for i := 0 to High(bcParty) do
          if (bcParty[i].bHp < m.y) and (bcParty[i].bHp > 0) then
            m.y := i;
      end
      else
      begin
        for i := 0 to High(moves) do
          if moMoves[moves[i]].Power > moMoves[moves[m.x]].Power then
            m.x := i;
        for i := High(bcParty) downto 0 do
        if bcParty[i].bHp > 0 then
        begin
          m.y := Random(i + 1);
          Break;
        end;
      end;
    end
    else
    begin
      for i := 0 to High(moves) do
        if moMoves[moves[i]].Power > moMoves[moves[m.x]].Power then
          m.x := i;
      for i := 0 to High(bcParty) do
        if (bcParty[i].bHp < bcParty[m.y].bHp) and (bcParty[i].bHp > 0) then
          m.y := i;
    end;
  end;
  ApplyDamage(bcEnemy, bcParty[m.y], m.x);
  if bcParty[m.y].bHp <= 0 then
  begin
    bcParty[m.y].cur.spd := 0;
    bcParty[m.y].atb := 0;
    for i := High(bcParty) downto 0 do
      if (bcParty[i].bHp > 0) and (m.y < i) then
        Swap(bcParty[i], bcParty[m.y]);
  end;
  if bcParty[0].bHp <= 0 then
    HandleEnd(False);
end;

// ToggleInput - Easy way to display or hide move and target selection
procedure ToggleInput(show: Boolean);
begin
  lblMoves.Visible := show;
  lblTargets.Visible := show;
  shpMove.Visible := show;
  shpTarget.Visible := show;
end;

// HandleTurn - Selects which party member is attacking, applies the damage then checks for enemies death and will see if victory has been obtained
procedure HandleTurn(mo, ta: Integer);
var
  i, p: Integer;
begin
  for i := 0 to High(bcParty) do
    if bcParty[i].atb > 1000 then
    begin
      p := i;
      Break;
    end;
  ApplyDamage(bcParty[p], bcEnemies[ta], mo);
  if bcEnemies[ta].bHp <= 0 then
  begin
    bcEnemies[ta].cur.spd := 0;
    bcEnemies[ta].atb := 0;
    for i := High(bcEnemies) downto 0 do
      if (bcEnemies[i].bHp > 0) and (ta < i) then
        Swap(bcEnemies[i], bcEnemies[ta]);
  end;
  ToggleInput(False);
  if bcEnemies[0].bHp = 0 then
    HandleEnd(True);
  lblMoves.Tag := 0;
  lblTargets.Tag := 0;
  selTarg := False;
  tmrEngine.Enabled := True;
  frmMain.OnKeyPress := nil;
end;

// HandleTurnItem - Handles the dispense of items
procedure HandleTurnItem(item, ally: Integer);
var
  i, p: Integer;
  its: TIntegerArray;
begin
  for i := 0 to High(tiItems) do
    with tiItems[i] do
      if owned > 0 then
      begin
        SetArrayLength(its, GetArrayLength(its) + 1);
        its[High(its)] := i;
      end;
  for i := 0 to High(bcParty) do
    if bcParty[i].atb > 1000 then
    begin
      p := i;
      Break;
    end;
  with bcParty[ally] do
  begin
    IncEx(bHp, tiItems[its[item]].power);
    if bHp > cur.hp then
      bHp := cur.hp;
  end;
  bcParty[p].atb := 500;
  Dec(tiItems[its[item]].owned);
  ToggleInput(False);
  lblMoves.Tag := 0;
  lblTargets.Tag := 0;
  encCount := 0;
  selTarg := False;
  tmrEngine.Enabled := True;
  frmMain.OnKeyPress := nil;
end;

procedure HandleItem(Sender: TObject; var Key: Char); forward;

// PrepareItems - Displays available items when launched
procedure PrepareItems;
var
  a: Integer;
begin
  lblTargets.Caption := '';
  for a := 0 to High(tiItems) do
    with tiItems[a] do
      if owned > 0 then
        lblTargets.Caption := lblTargets.Caption + name + ': Power :' + IntToStr(power) + '; Quantity :' + IntToStr(owned) + #13;
end;

// PrepareItemTargets - Sets up allies as the targets for an item
procedure PrepareItemTargets;
var
  i: Integer;
begin
  lblTargets.Caption := '';
  for i := 0 to High(bcParty) do
    with bcParty[i] do
      if bHp > 0 then
        lblTargets.Caption := lblTargets.Caption + stSRLMon[id].Name + ': HP ' + IntToStr(bHp) + '/' + IntToStr(cur.hp) + #13;
end;

// HandleInput - OnKey event that does what's needed depending on the key
procedure HandleInput(Sender: TObject; var Key: Char);
var
  i: Integer;
begin
  if not battling then
    Exit;
  if not selTarg then
  begin
    with lblMoves do
    begin
      i := Tag;
      case Key of
        'w': Tag := Tag - 1;
        's': Tag := Tag + 1;
        'q': selTarg := True;
      end;
      if (Tag = Round(Height div 13.0) - 1) and selTarg then
      begin
        PrepareItems;
        frmMain.OnKeyPress := @HandleItem;
        selTarg := False;
      end;
      if i = Tag then
        Exit;
      if Tag < 0 then
        Tag := Round(Height div 13.0) - 1
      else if Tag > Round(Height div 13.0) - 1 then
        Tag := 0;
      shpMove.Top := 198 + (Tag * 13);
    end;
  end
  else
  begin
    with lblTargets do
    begin
      i := Tag;
      case Key of
        'w': Tag := Tag - 1;
        's': Tag := Tag + 1;
        'e': selTarg := False;
        'q': HandleTurn(lblMoves.Tag, Tag);
      end;
      if i = Tag then
        Exit;
      if Tag < 0 then
        Tag := Round(Height div 13.0) - 1
      else if Tag > Round(Height div 13.0) - 1 then
        Tag := 0;
      shpTarget.Top := 198 + (Tag * 13);
    end;
  end;
end;

// HandleItem - Does what's needed dependant on input for using an item
procedure HandleItem(Sender: TObject; var Key: Char);
var
  i: Integer;
begin
  if not selTarg then
  begin
    with lblTargets do
    begin
      i := Tag;
      case Key of
        'w': Tag := Tag - 1;
        's': Tag := Tag + 1;
        'e': begin
          frmMain.OnKeyPress := @HandleInput;
          lblTargets.Caption := '';
          for i := 0 to High(bcEnemies) do
            with bcEnemies[i] do
              if bHp > 0 then
                lblTargets.Caption := lblTargets.Caption + stSRLMon[id].Name + ': HP: ' + IntToStr(bHp) + '/' + IntToStr(cur.hp) + ';' + #13;
        end;
        'q': begin
          PrepareItemTargets;
          selTarg := True;
          encCount := Tag;
          Tag := 0;
        end;
      end;
      if i = Tag then
        Exit;
      if Tag < 0 then
        Tag := Round(Height div 13.0) - 1
      else if Tag > Round(Height div 13.0) - 1 then
        Tag := 0;
      shpTarget.Top := 198 + (Tag * 13);
    end;
  end
  else
  begin
    with lblTargets do
    begin
      i := Tag;
      case Key of
        'w': Tag := Tag - 1;
        's': Tag := Tag + 1;
        'e': selTarg := False;
        'q': HandleTurnItem(encCount, Tag);
      end;
      if i = Tag then
        Exit;
      if Tag < 0 then
        Tag := Round(Height div 13.0) - 1
      else if Tag > Round(Height div 13.0) - 1 then
        Tag := 0;
      shpTarget.Top := 198 + (Tag * 13);
    end;
  end;
end;

// PrepareInput - Changes from battle engine to a key based input for move and target selection
procedure PrepareInput(bcAlly: TBattleChar);
var
  i: Integer;
begin
  lblMoves.Caption := '';
  for i := 0 to High(bcAlly.moves) do
    with moMoves[bcAlly.moves[i]] do
      lblMoves.Caption :=  lblMoves.Caption + Name + ': P: ' + IntToStr(Power) + '; A: ' + IntToStr(Acc) + ';' + #13;
  lblMoves.Caption := lblMoves.Caption + 'Items';
  lblTargets.Caption := '';
  for i := 0 to High(bcEnemies) do
    with bcEnemies[i] do
      if bHp > 0 then
        lblTargets.Caption := lblTargets.Caption + stSRLMon[id].Name + ': HP: ' + IntToStr(bHp) + '/' + IntToStr(cur.hp) + ';' + #13;
  ToggleInput(True);
  shpMove.Top := 198;
  shpTarget.Top := 198;
  tmrEngine.Enabled := False;
  frmMain.OnKeyPress := @HandleInput;
end;

procedure BattleEngine(Sender: TObject);
var
  i: Integer;
begin
  if not battling then
  begin
    if GetKeyDown = 'e' then
    begin
      tmrEngine.OnTimer := @Engine;
      lblParty.Visible := False;
      lblEnemies.Visible := False;
      lblMoves.Visible := False;
      GenerateMap;
    end;
    Exit;
  end;
  SetupBattleLabels;
  for i := 0 to High(bcParty) do
  begin
    if bcParty[i].atb > 1000 then
    begin
      PrepareInput(bcParty[i]);
      Continue;
    end;
    IncEx(bcParty[i].atb, bcParty[i].cur.spd);
  end;
  for i := 0 to High(bcEnemies) do
  begin
    if bcEnemies[i].atb > 1000 then
    begin
      BattleAI(bcEnemies[i]);
      Continue;
    end;
    IncEx(bcEnemies[i].atb, bcEnemies[i].cur.spd);
  end;
end;

procedure HandleMenu(Sender: TObject; var Key: Char); forward;

// PrepareMenu - Paints the menu and sets all the labels to display etc.
procedure PrepareMenu;
begin
  tmrEngine.Enabled := False;
  frmMain.OnKeyPress := @HandleMenu;
  imgMain.Canvas.RoundRect(40, 40, 440, 440, 50, 50);
  imgMain.Canvas.RoundRect(190, 50, 430, 430, 25, 25);
  lblMenu.Caption := 'Stats' + #13 + 'Items' + #13 + 'Help';
  lblMenu.Tag := 0;
  lblInfo.Tag := -1;
  lblMenu.Visible := True;
  lblInfo.Visible := True;
  shpMenu.Visible := True;
end;

// UpdateMenu - shows info depending on what selected from menu
procedure UpdateMenu;
var
  i: Integer;
begin
  lblInfo.Caption := '';
  case lblMenu.Tag of
    0: begin
      for i := 0 to High(bcParty) do
        with bcParty[i] do
          lblInfo.Caption := lblInfo.Caption + stSRLMon[id].Name +': ' + IntToStr(bHp) + '/' + IntToStr(cur.hp) + #13 + 'Att: ' + IntToStr(cur.att) + '; Def: ' + IntToStr(cur.def) + '; Spd: ' + IntToStr(cur.spd) + #13 + 'Lvl: ' + IntToSTr(lvl) + 'xp: ' + IntToStr(xp) + '/' + IntToStr(Trunc(Pow(3 * lvl, 3) div 4)) + #13 + #13;
    end;
    1: begin
      for i := 0 to High(tiItems) do
        with tiItems[i] do
          if owned > 0 then
            lblInfo.Caption := lblInfo.Caption + name + ': Power :' + IntToStr(power) + '; Quantity :' + IntToStr(owned) + #13;
    end;
    2: lblInfo.Caption := 'Keys' + #13 + '"wasd" to move' + #13 + '"q" for action' + #13 + '"e" for cancel' + #13 + '"r" for menu';
  end;
end;

// ExitMenu - Sets everything to hide and redraws the map
procedure ExitMenu;
begin
  lblMenu.Caption := '';
  lblInfo.Caption := '';
  lblMenu.Tag := 0;
  lblMenu.Visible := False;
  lblInfo.Visible := False;
  shpMenu.Visible := False;
  tmrEngine.Enabled := True;
  frmMain.OnKeyPress := nil;
  GenerateMap;
end;

// HandleMenu - Key based input that alters information shown/exits the menu
procedure HandleMenu(Sender: TObject; var Key: Char);
var
  i: Integer;
begin
  with lblMenu do
  begin
    i := Tag;
    case Key of
      'w': Tag := Tag - 1;
      's': Tag := Tag + 1;
      'q': UpdateMenu;
      'e': ExitMenu;
    end;
    if Tag > (Height div 13) - 1 then
      Tag := 0
    else if Tag < 0 then
      Tag := (Height div 13) - 1;
    if i <> Tag then
      shpMenu.Top := 69 + (Tag * 13);
  end;
end;

// Engine - Main movement engine that detects user input and deals with appropriately
procedure Engine(sender: TObject);
begin
  with chrMain do
  begin
    case GetKeyDown of
      'w': begin
        d.y := -1;
        s.x := 0;
      end;
      'a': begin
        d.x := -1;
        s.x := 6;
      end;
      's': begin
        d.y := 1;
        s.x := 3;
      end;
      'd': begin
        d.x := 1;
        s.x := 9;
      end;
      'q': tmrEngine.OnTimer := @HandleTalk;
      'b': begin
        tmrEngine.OnTimer := @BattleEngine;
        PrepareBattle;
      end;
      'r': PrepareMenu;
    end;

    if (d.y <> 0) or (d.x <> 0) then
      tmrEngine.OnTimer := @HandleMove;
  end;
end;

// ExplodeInt - Like other languages explodes except breaks it down 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 - Loads the selected map into mapMain then draws the map
procedure OpenMap;
var
  titMap, titAtt: TIntegerArray;
  a, b, c: Integer;
begin
  if not dlgOpen.Execute then
  begin
    if (mapMain.x = 1) and (mapMain.y = 1) then
      TerminateScript;
    Exit;
  end;

  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), ',');
        if a = 0 then
        begin
          SetArrayLength(att[b], 0);
          SetArrayLength(att[b], x);
          SetArrayLength(titAtt, 0);
          titAtt := ExplodeInt(ReadINI('Attrib', 'Row' + IntToStr(b), dlgOpen.FileName), ',');
        end;
        for c := 0 to x - 1 do
        begin
          try
            if a = 0 then
              att[b][c] := titAtt[c];
          except
            Writeln('Attributes section of map may be corrupt - redownload if problem occurs');
            Debug('Att[' + IntToStr(b) + '][' + IntToStr(c) +'] - H(titAtt[' + IntToStr(High(titAtt)) + ']);');
          end;
          try
            tpTiles[a][b][c].x := titMap[c * 2];
            tpTiles[a][b][c].y := titMap[c * 2 + 1];
          except
            Writeln('Tile section of map may be corrupt - redownload if problem occurs');
          end;
        end;
        SetArrayLength(titMap, 0);
      end;
    end;
  end;

  chrMain.m.x := 2;
  chrMain.m.y := 2;
  GenerateMap;
end;

// SetupForm - Sets up all the form objects
procedure SetupForm;
var
  sW, sH: Integer;
begin
  GetClientDimensions(sW, sH);
  frmMain := CreateForm;

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

  with frmMain do
  begin
    Caption := 'ScaRPG by mixster';
    ClientWidth := 500;
    ClientHeight := 500;
    Left := (sW - Width) div 2;
    Top := (sH - Height) div 2;
  end;
  imgMain := TImage.Create(frmMain);
  with imgMain do
  begin
    Parent := frmMain;
    Width := 480;
    Height := 480;
    Left := 10;
    Top := 10;
    GenerateMap;
  end;
  lblTalk := TLabel.Create(frmMain);
  with lblTalk do
  begin
    Parent := frmMain;
    Left := 18;
    Top := 432;
    Visible := False;
    Transparent := True;
  end;
  lblParty := TLabel.Create(frmMain);
  with lblParty do
  begin
    Parent := frmMain;
    Left := 18;
    Top := 380;
    Visible := False;
    Transparent := True;
  end;
  lblEnemies := TLabel.Create(frmMain);
  with lblEnemies do
  begin
    Parent := frmMain;
    Left := 18;
    Top := 18;
    Visible := False;
    Transparent := True;
  end;
  shpMove := TShape.Create(frmMain);
  with shpMove do
  begin
    Parent := frmMain;
    Width := 222;
    Height := 14;
    Left := 17;
    Top := 198;
    Visible := False;
    Shape := stRoundRect;
  end;
  shpTarget := TShape.Create(frmMain);
  with shpTarget do
  begin
    Parent := frmMain;
    Width := 222;
    Height := 14;
    Left := 239;
    Top := 198;
    Visible := False;
    Shape := stRoundRect;
  end;
  lblMoves := TLabel.Create(frmMain);
  with lblMoves do
  begin
    Parent := frmMain;
    Left := 18;
    Top := 199;
    Visible := False;
    Transparent := True;
  end;
  lblTargets := TLabel.Create(frmMain);
  with lblTargets do
  begin
    Parent := frmMain;
    Left := 240;
    Top := 199;
    Visible := False;
    Transparent := True;
  end;
  shpMenu := TShape.Create(frmMain);
  with shpMenu do
  begin
    Parent := frmMain;
    Left := 69;
    Top := 69;
    Width := 111;
    Height := 14;
    Visible := False;
    Shape := stRoundRect;
  end;
  lblMenu := TLabel.Create(frmMain);
  with lblMenu do
  begin
    Parent := frmMain;
    Left := 70;
    Top := 70;
    Visible := False;
    Transparent := True;
  end;
  lblInfo := TLabel.Create(frmMain);
  with lblInfo do
  begin
    Parent := frmMain;
    Left := 205;
    Top := 70;
    Visible := False;
    Transparent := True;
  end;
  tmrEngine := TTimer.Create(frmMain);
  with tmrEngine do
  begin
    Interval := 1000 div FPS;
    OnTimer := @Engine;
  end;
  OpenMap;
  frmMain.ShowModal;
end;

var
  v: TVariantArray;
begin
  tiles := LoadBitmap(ScriptPath + 'Tiles.bmp');
  sprites := LoadBitmap(ScriptPath + 'Sprites.bmp');
  RandomizeMap(1, 1, 1, 0, 1, 1, 1, 0);
  encCount := 15;
  ThreadSafeCall('SetupForm', v);
  FreeForm(frmMain);
  FreeBitmap(sprites);
  FreeBitmap(tiles);
end.