unit voice;

interface

uses
  sysutils, loadz;


procedure wave(x, y: byte; aStrength: integer; aType: integer = VOICE_HERO);
procedure mon_voice;
procedure PrintVoice;
procedure MakeANoise(x, y: byte);
procedure CleanVoice;
procedure MakeHeroAttackNoise(x, y: integer);
procedure MakeHeroNoise(x, y: integer; VoiceType: integer = VOICE_HERO; VoiceStrength: integer = -1);


implementation
uses
  MyCRT, svet;

procedure MakeHeroAttackNoise(x, y: integer);
var
  NoiseStrength: integer;
begin
  NoiseStrength := (100 - data.stealth) div 4;
  if NoiseStrength < 0 then
    NoiseStrength := 1;
  Wave(x, y, NoiseStrength, VOICE_HERO);
end;

procedure mon_voice;
var
  i, j: integer;
  x, y: integer;
  enemy: TEnemy;
begin
  for j := 1 to RESOLUTION_Y do
    for i := 1 to RESOLUTION_X do
      if (IsThisAMonster(i, j)) and (cur_lev.map[i, j].Monster.montype < FRIEND) then
      begin
        x := data.posx;
        y := data.posy;
        data.posx := i;
        data.posy := j;
        mon_info(cur_lev.map[i, j].Monster.montype, enemy);
        MakeHeroNoise(i, j, cur_lev.map[i, j].Monster.montype, enemy.VoiceStrength);
        data.posx := x;
        data.posy := y;
      end;
end;

procedure MakeHeroNoise(x, y: integer; VoiceType: integer = VOICE_HERO; VoiceStrength: integer = -1);
var
  NoiseStrength: integer;
begin
  if VoiceStrength = -1 then
    NoiseStrength := (100 - data.stealth) div 6
  else
    NoiseStrength := VoiceStrength;
  if NoiseStrength < 0 then
    NoiseStrength := 1;
  Wave(x, y, NoiseStrength, VoiceType);
end;

procedure MakeANoise(x, y: byte);
var
  Monster: TEnemy;
  NoiseStrength: integer;
begin
  mon_info(cur_lev.map[x, y].Monster.montype, Monster);
  NoiseStrength := Monster.voiceStrength;
  Wave(x, y, NoiseStrength, cur_lev.map[x, y].Monster.montype);
  PrintVoice;
end;

procedure CleanVoice;
var
  i, j: byte;
begin
  for j := 1 to RESOLUTION_Y do
    for i := 1 to RESOLUTION_X do
    begin
      cur_lev.map[i, j].Voice := 0;
      cur_lev.map[i, j].VoiceType := 0;
    end;
end;

function sten(x, y: byte): boolean;
begin
  if (x in [1..RESOLUTION_X]) and (y in [1..RESOLUTION_Y]) then
    sten := IsSeeStopping(x, y)
  else
    sten := true;
end;

procedure osvkletka(x, y: byte; aStrength: integer; aType: integer = VOICE_HERO);
begin
  if (x in [1..RESOLUTION_X]) and (y in [1..RESOLUTION_Y - 1]) then
  begin
    if (cur_lev.map[x, y].Voice <= aStrength) or (cur_lev.map[x, y].VoiceType = VOICE_HERO) then
    begin
      cur_lev.map[x, y].Voice := aStrength;
      cur_lev.map[x, y].VoiceType := aType;
    end;
  end;
end;

procedure luch(x, y: shortint; aStrength: integer; aType: integer = VOICE_HERO);
var
  i: byte;
  stena: boolean;
  xx, yy: byte;
  aMoment: integer;
  moment_strength: integer;
begin
  aMoment := 0;
  xx := data.posx;
  yy := data.posy;
  if abs(x) > abs(y) then
  begin
    stena := false;
    i := 1;
    while (yy > 1) and (xx > 1) and (aMoment <= aStrength) do
    begin
        for i := i to abs(x) do
        begin
          if (not stena) and ((abs(xx - data.posx) < aStrength)) then
          begin
            xx := xx + (x div abs(x));
            moment_strength := aStrength - aMoment;
            osvkletka(xx, yy, moment_strength, aType);
            inc(aMoment);
            if sten(xx, yy) then
              x := - x;
          end;
        end;
          yy := yy + (y div abs(y));
          moment_strength := aStrength - aMoment;
          osvkletka(xx, yy, moment_strength, aType);
          inc(aMoment);
          i := 2;
          if sten(xx, yy) then
            y := - y;
    end;
  end
  else if abs(y) > abs(x) then
  begin
    stena := false;
    i := 1;
    while (yy > 1) and (xx > 1) and (aMoment <= aStrength) do
    begin
        for i := i to abs(y) do
        begin
          if (not stena) and ((abs(yy - data.posy) < aStrength)) then
          begin
            yy := yy + (y div abs(y));
            moment_strength := aStrength - aMoment;
            osvkletka(xx, yy, moment_strength, aType);
            inc(aMoment);
            if sten(xx, yy) then
              y := - y;
          end;
        end;
          xx := xx + (x div abs(x));
          moment_strength := aStrength - aMoment;
          osvkletka(xx, yy, moment_strength, aType);
          inc(aMoment);
          i := 2;
          if sten(xx, yy) then
            x := - x;
    end;
  end
  else if abs(x) = abs(y) then
  begin
    stena := false;
    while (yy > 1) and (xx > 1) and (aMoment <= aStrength) do
    begin
      if not stena then
      begin
        for i := 1 to abs(y) do
        begin
          if not stena then
          begin
            xx := xx + (x div abs(x));
            yy := yy + (y div abs(y));
            moment_strength := aStrength - aMoment;
            osvkletka(xx, yy, moment_strength, aType);
            inc(aMoment);
            if sten(xx, yy) then
            begin
              x := - x;
              y := - y;
            end;
         end;
        end;
      end;
    end;
  end;
end;


procedure PrintVoice;
var
  i, j: byte;
begin
  textcolor(white);
  for j := 1 to RESOLUTION_Y do
    for i := 1 to RESOLUTION_X do
    begin
      gotoxy(i, j);
      write(inttostr(cur_lev.map[i, j].Voice)[1]);
    end;
  readkey;
end;


procedure wavenew(x, y: byte; aStrength: integer; aType: integer = VOICE_HERO);
var
  i: integer;
begin
  for i := 1 to aStrength do
  begin
    luch(i, 1, aStrength, aType);
    luch(i, -1, aStrength, aType);
    luch(-i, 1, aStrength, aType);
    luch(-i, -1, aStrength, aType);
    luch(1, i, aStrength, aType);
    luch(1, -i, aStrength, aType);
    luch(-1, i, aStrength, aType);
    luch(-1, -i, aStrength, aType);
    luch(1, 1, aStrength, aType);
    luch(1, -1, aStrength, aType);
    luch(-1, 1, aStrength, aType);
    luch(-1, -1, aStrength, aType);
  end;
end;



procedure wave(x, y: byte; aStrength: integer; aType: integer = VOICE_HERO);
begin
  if data.location = MAP_MAIN then
    exit;
  wavenew(x, y, AStrength, aType);
end;

begin
end.