unit speak;

interface

uses
  windows, sysutils, messages, loadz, inventar, expa, Arc;

procedure talk(x, y: byte);

implementation

uses
  MyCRT, svet, aData;

procedure GetBlock(IsExecute: boolean = true); forward;

var
  variantz: array[1..MAXVARS] of string;
  var_loc: array[1..MAXVARS] of string;
  aPos: integer = 0;
  strs: array of string;
  sLen: integer = 0;
  sX: integer = 1;
  sY: integer = 0;

procedure ResetPos;
begin
  sX := 1;
  sY := 0;
end;

function GetChar: char;
begin
  GetChar := strs[sY][sX];
  if (sX = Length(strs[sY])) then
  begin
    inc(sY);
    sX := 1;
  end
  else
    inc(sX);
end;

function IsLetter(c: char): boolean;
begin
  IsLetter := (c in ['A'..'Z', 'a'..'z', 'À'..'ß', 'à'..'ÿ', '_']);
end;

function IsNumber(c: char): boolean;
begin
  IsNumber := (c in ['0'..'9']);
end;

function IsSpecial(c: char): boolean;
begin
  IsSpecial := (c in ['<', '>', '=']);
end;

procedure MoveBack;
begin
  if (sX > 1) then
    dec(sX)
  else if (sY > 0) then
  begin
    dec(sY);
    sX := Length(strs[sY]);
  end;
end;

procedure Error(s: string);
begin
  clrscr;
  TextColor(LightRed);
  Write(STR_ERRORIN + IntToStr(sX) + ', ' + IntToStr(sY + 1) + ': ' + s);
  ReadKey;
  halt;
end;

procedure Expected(c: char);
begin
  if (GetChar <> c) then
    Error(STR_EXPECTED + '"' + c + '"');
end;

function GetName: string;
var
  c: char;
begin
  c := GetChar;
  if (not (IsLetter(c) or IsNumber(c))) then
    Error(STR_NAME_EXPECTED);
  Result := c;
  while ((IsLetter(c)) or (IsNumber(c))) do
  begin
    c := GetChar;
    if ((IsLetter(c)) or (IsNumber(c))) then
      Result := Result + c;
  end;
  MoveBack;
end;

function GetNumber: integer;
var
  c: char;
  res: string;
begin
  c := GetChar;
  if ((not IsNumber(c)) and (c <> '-')) then
    Error(STR_NUMBER_EXPECTED);
  res := c;
  while (IsNumber(c)) do
  begin
    c := GetChar;
    if (IsNumber(c)) then
      res := res + c;
  end;
  MoveBack;
  Result := StrToInt(res);
end;

function GetSpecial: string;
var
  c: char;
begin
  c := GetChar;
  Result := '';
  if (not IsSpecial(c)) then
    Error(STR_SPECIAL_EXPECTED);
  repeat
    Result := Result + c;
    c := GetChar;
  until (not IsSpecial(c));
end;

procedure SkipWhites;
var
  c: char;
begin
  c := GetChar;
  while (c in [' ', #13]) do
    c := GetChar;
  MoveBack;
end;

function GetString: string;
begin
  Result := Copy(strs[sY], sX, Length(strs[sY]) - sX + 1);
  inc(sY);
  sX := 1;
end;

procedure ExtractScript(aType: integer);
var
  f: TextFile;
begin
  AssignFile(f, SPEAKFOLDER + IntToStr(aType) + '.txt');
  reset(f);
  while (not eof(f)) do
  begin
    SetLength(strs, sLen + 1);
    System.Readln(f, strs[sLen]);
    inc(sLen);
  end;
  CloseFile(f);
  ResetPos;
end;

function GetVar(varName: string): string;
var
  res: integer;
  anTest, anError: integer;
begin
  val(varName, anTest, anError);
  res := 0;
  if (anError = 0) then
  begin
    Result := varName;
    exit;
  end;
  if (varName = 'money') then
    res := data.money
  else if (varName = 'health') then
    res := data.health
  else if (varName = 'max_health') then
    res := data.max_health
  else if (varName = 'level') then
    res := data.level
  else if (varName = 'strength') then
    res := data.strength
  else if (varName = 'expa') then
    res := data.expa
  else if (varName = 'intellect') then
    res := data.intellect
  else if (varName = 'luck') then
    res := data.luck
  else if (varName = 'year') then
    res := data.year
  else if (varName = 'month') then
    res := data.month
  else if (varName = 'day') then
    res := data.day
  else if (varName = 'hour') then
    res := data.hours
  else if (varName = 'minute') then
    res := data.minutes
  else if (varName = 'second') then
    res := data.seconds
  else if (varName = 'age') then
    res := data.age
  else if (varName = 'bolezn') then
    res := data.bolezn
  else if (varName = 'tired') then
    res := data.ustal
  else if (varName = 'bloodchosen') then
    res := data.bloodchosen
  else if (varName = 'invisible') then
    res := data.invisible
  else if (varName = 'hunger') then
    res := data.hunger
  else if (varName = 'weapon_primitive') then
    res := data.weapon_primitive
  else if (varName = 'weapon_fire') then
    res := data.weapon_fire
  else if (varName = 'weapon_electric') then
    res := data.weapon_electric
  else if (varName = 'weapon_psi') then
    res := data.weapon_psi
  else if (varName = 'trading') then
    res := data.trading
  else if (varName = 'protect_base') then
    res := data.protect_base
  else if (varName = 'protect_fire') then
    res := data.protect_fire
  else if (varName = 'protect_electric') then
    res := data.protect_electric
  else if (varName = 'protect_psi') then
    res := data.protect_psi
  else if (varName = 'accuracy') then
    res := data.metkost
  else if (varName = 'dexterity') then
    res := data.lovkost
  else if (varName = 'endurance') then
    res := data.vinoslivost
  else if (varName = 'surgery') then
    res := data.surgery
  else if (varName = 'stealth') then
    res := data.stealth
  else if (varName = 'focus') then
    res := data.vnimanie
  else if (varName = 'weight') then
    res := GetWeight
  else if (varName = 'bYear') then
    res := data.bYear
  else if (varName = 'bMonth') then
    res := data.bMonth
  else if (varName = 'bDay') then
    res := data.bDay
  else
    Error(STR_UNDECLARED_VARIABLE);
  Result := IntToStr(res);
end;

function GetFunc(s: string): string;
var
  aName: string;
  i, j, res: integer;
  aPar: string;
  anError: integer;
  intPar: integer;
  item: TItem;
  pi1, pi2: integer;
begin
  SkipWhites;
  aName := '';
  i := 1;
  res := 0;
  if (s = 'item') then
  begin
    {if (s[i] <> '(') then
      Error(STR_EXPECTED + '"("');
    inc(i);
    aPar := '';
    while (IsNumber(s[i])) do
    begin
      aPar := aPar + s[i];
      inc(i);
    end;
    val(aPar, intPar, anError);
    if (anError <> 0) then
      Error(STR_INTEGER_EXPECTED);
    if (s[i] <> ')') then
      Error(STR_EXPECTED + '")"');}
    intPar := GetNumber;
    SkipWhites;
    Expected(')');
    iteminfo(intPar, item);
    for j := 1 to MAXITEMS do
      if (data.inventory[j].number = intPar) then
        if (item.itemtype <> ITAmmo) then
          inc(res)
        else
          inc(res, data.inventory[j].count);
  end
  else if (s = 'perem') then
  begin
{    if (s[i] <> '(') then
      Error(STR_EXPECTED + '"("');
    inc(i);
    aPar := '';
    while (IsNumber(s[i])) do
    begin
      aPar := aPar + s[i];
      inc(i);
    end;
    val(aPar, intPar, anError);
    if (anError <> 0) then
      Error(STR_INTEGER_EXPECTED);
    if (s[i] <> ')') then
      Error(STR_EXPECTED + '")"');}
    intPar := GetNumber;
    SkipWhites;
    Expected(')');
    res := data.missions[intPar];
  end
  else if (s = 'levAttrz') then
  begin
    pi1 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi2 := GetNumber;
    SkipWhites;
    Expected(')');
    if ((pi1 > 0) and (pi1 <= RESOLUTION_X) and (pi2 > 0) and (pi2 <= RESOLUTION_Y)) then
      res := cur_lev.map[pi1, pi2].levAttrz
    else
      res := 0;
  end
  else
    Error(STR_UNDECLARED_FUNCTION);
  Result := IntToStr(res);
end;

function IsSravn(s1, sign, s2: string): boolean;
var
  i1, i2: integer;
begin
  Result := false;
  i1 := StrToInt(s1);
  i2 := StrToInt(s2);
  if ((sign = '<') and (i1 < i2)) then
    Result := true
  else if ((sign = '>') and (i1 > i2)) then
    Result := true
  else if ((sign = '=') and (i1 = i2)) then
    Result := true
  else if ((sign = '>=') and (i1 >= i2)) then
    Result := true
  else if ((sign = '<=') and (i1 <= i2)) then
    Result := true
  else if ((sign = '<>') and (i1 <> i2)) then
    Result := true;
end;

procedure GetIf(IsExecute: boolean);
var
  fComp1, fSign, fComp2: string;
  c: char;
begin
  SkipWhites;
  fComp1 := GetName;
  SkipWhites;
  if (GetChar = '(') then
  begin
{    MoveBack;
    c := GetChar;
    while (c <> ')') do
      if ((c <> ' ') and (c <> #13)) then
      begin
        fComp1 := fComp1 + c;
        c := GetChar;
      end;
    fComp1 := GetFunc(fComp1 + ')');}
    fComp1 := GetFunc(fComp1);
  end
  else
  begin
    MoveBack;
    fComp1 := GetVar(fComp1);
  end;
  SkipWhites;
  fSign := GetSpecial;
  if ((fSign <> '<') and (fSign <> '>') and (fSign <> '<>') and (fSign <> '<=')
    and (fSign <> '>=') and (fSign <> '=')) then
      Error(STR_SRAVN_OPERAND_EXPECTED);
  SkipWhites;
  fComp2 := GetName;
  SkipWhites;
  if (GetChar = '(') then
  begin
    MoveBack;
    c := GetChar;
    while (c <> ')') do
      if ((c <> ' ') and (c <> #13)) then
      begin
        fComp2 := fComp2 + c;
        c := GetChar;
      end;
    fComp2 := GetFunc(fComp2 + ')');
  end
  else
  begin
    MoveBack;
    fComp2 := GetVar(fComp2);
  end;
  if ((IsExecute) and (IsSravn(fComp1, fSign, fComp2))) then
    GetBlock(true)
  else
    GetBlock(false);
end;

procedure GetProc(procName: string; IsExecute: boolean);
var
  p1, p2: string;
  pi1, pi2, pi3, pi4: integer;
  item: TItem;
  i, j: integer;
  cTemp: char;
  aWord: string;
  len: integer;
begin
  SkipWhites;
  if (procName = 'AddMoney') then
  begin
    pi1 := GetNumber;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if (IsExecute) then
      inc(data.money, pi1);
  end
  else if (procName = 'AddExpa') then
  begin
    pi1 := GetNumber;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if (IsExecute) then
      inc(data.expa, pi1);
    CheckForNextLevel;
  end
  else if (procName = 'AddItem') then
  begin
    pi1 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi2 := GetNumber;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if (IsExecute) then
      addinv(pi1, pi2);
  end
  else if (procName = 'DeleteItem') then
  begin
    pi1 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi2 := GetNumber;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if (IsExecute) then
    begin
      iteminfo(pi1, item);
      for i := 1 to MAXITEMS do
      begin
        if (pi2 <= 0) then
          exit;
        if (data.inventory[i].number = pi1) then
        begin
          if (item.IsShooting) then
          begin
            dec(pi2);
            data.inventory[i].number := 0;
            data.inventory[i].count := 0;
          end
          else if (data.inventory[i].count > pi2) then
          begin
            dec(data.inventory[i].count, pi2);
            pi2 := 0;
          end
          else
          begin
            dec(pi2, data.inventory[i].count);
            data.inventory[i].number := 0;
            data.inventory[i].count := 0;
          end;
        end;
      end;
    end;
  end
  else if (procName = 'SetMonster') then
  begin
    pi1 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi2 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    p1 := GetName;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi3 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi4 := GetNumber;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if (IsExecute) then
      SetMonster(pi1, pi2, p1, pi3, pi4);
  end
  else if (procName = 'SetItem') then
  begin
    pi1 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi2 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi3 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi4 := GetNumber;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if (IsExecute) then
    begin
      cur_lev.map[pi1, pi2].item := pi3;
      cur_lev.map[pi1, pi2].ItemCount := pi4;
    end;
  end
  else if (procName = 'SetType') then
  begin
    pi1 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi2 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    p1 := GetName;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if (IsExecute) then
      SetElement(pi1, pi2, p1);
  end
  else if (procName = 'SetObject') then
  begin
    pi1 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi2 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    p1 := GetName;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if (IsExecute) then
      SetObject(pi1, pi2, p1);
  end
  else if (procName = 'var') then
  begin
    p1 := GetName;
    SkipWhites;
    Expected(',');
    SkipWhites;
    Expected('''');
    p2 := '';
    cTemp := GetChar;
    while (cTemp <> '''') do
    begin
      p2 := p2 + cTemp;
      cTemp := GetChar;
    end;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if (IsExecute) then
    begin
      variantz[aPos] := p2;
      var_loc[aPos] := p1;
      inc(aPos);
    end;
  end
  else if (procName = 'Sell') then
  begin
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    sell;
    ClrScr;
  end
  else if (procName = 'BuyWeapons') then
  begin
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    buy(TRADER_WEAPONS);
    ClrScr;
  end
  else if (procName = 'BuyArmor') then
  begin
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    buy(TRADER_ARMOR);
    ClrScr;
  end
  else if (procName = 'BuyOther') then
  begin
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    buy(TRADER_OTHER);
    ClrScr;
  end
  else if ((procName = 'BuyHealth') or (procName = 'HealthHealth')) then
  begin
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    HealthyHealth;
    ClrScr;
  end
  else if (procName = 'AddSkill') then
  begin
    p1 := GetName;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi1 := GetNumber;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if (IsExecute) then
    begin
      if (p1 = 'strength') then
        inc(data.strength, pi1)
      else if (p1 = 'intellect') then
        inc(data.intellect, pi1)
      else if (p1 = 'luck') then
        inc(data.luck, pi1)
      else if (p1 = 'weapon_primitive') then
        inc(data.weapon_primitive, pi1)
      else if (p1 = 'weapon_fire') then
        inc(data.weapon_fire, pi1)
      else if (p1 = 'weapon_electric') then
        inc(data.weapon_electric, pi1)
      else if (p1 = 'weapon_psi') then
        inc(data.weapon_psi, pi1)
      else if (p1 = 'trading') then
        inc(data.trading, pi1)
      else if (p1 = 'protect_base') then
        inc(data.protect_base, pi1)
      else if (p1 = 'protect_fire') then
        inc(data.protect_fire, pi1)
      else if (p1 = 'protect_electric') then
        inc(data.protect_electric, pi1)
      else if (p1 = 'protect_psi') then
        inc(data.protect_psi, pi1)
      else if (p1 = 'accuracy') then
        inc(data.metkost, pi1)
      else if (p1 = 'dexterity') then
        inc(data.lovkost, pi1)
      else if (p1 = 'endurance') then
        inc(data.vinoslivost, pi1)
      else if (p1 = 'surgery') then
        inc(data.surgery, pi1)
      else if (p1 = 'stealth') then
        inc(data.stealth, pi1)
      else if (p1 = 'focus') then
        inc(data.vnimanie, pi1);
    end;
  end
  else if (procName = 'SetPerem') then
  begin
    pi1 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi2 := GetNumber;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if (IsExecute) then
      data.missions[pi1] := pi2;
  end
  else if (procName = 'SetImplants') then
  begin
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    SetImplants;
    ClrScr;
  end
  else if (procName = 'UnlockDoor') then
  begin
    pi1 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi2 := GetNumber;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if ((IsExecute) and (pi1 > 0) and (pi1 <= RESOLUTION_X) and (pi2 > 0) and (pi2 <= RESOLUTION_Y)) then
    begin
      cur_lev.map[pi1, pi2].DoorCode := 0;
      cur_lev.map[pi1, pi2].levAttrz := 0;
    end;
  end
  else if (procName = 'SetLevAttrz') then
  begin
    pi1 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi2 := GetNumber;
    SkipWhites;
    Expected(',');
    SkipWhites;
    pi3 := GetNumber;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    if ((IsExecute) and (pi1 > 0) and (pi1 <= RESOLUTION_X) and (pi2 > 0) and (pi2 <= RESOLUTION_Y)) then
      cur_lev.map[pi1, pi2].levAttrz := pi3;
  end
  else if ((procName = 'print') or (procName = 'p') or (procName = 'println') or (procName = 'pln')) then
  begin
    Expected('''');
    p1 := '';
    c := GetChar;
    while (c <> '''') do
    begin
      p1 := p1 + c;
      c := GetChar;
    end;
    SkipWhites;
    Expected(')');
    SkipWhites;
    Expected(';');
    j := 1;
    len := Length(p1);
    while (j <= len) do
    begin
      while ((j <= len) and (p1[j] = ' ')) do
      begin
        if (IsExecute) then
          write(' ');
        inc(j);
      end;
      aWord := '';
      while ((j <= len) and (p1[j] <> ' ')) do
      begin
        aWord := aWord + p1[j];
        inc(j);
      end;
      if (IsExecute) then
      begin
        if ((WhereX + Length(aWord)) < RESOLUTION_X) then
          write(aWord)
        else
        begin
          Writeln('');
          Write(aWord);
        end;
      end;
    end;
    if (((procName = 'println') or (procName = 'pln')) and (IsExecute)) then
      Writeln('');
  end
  else
    Error(STR_UNDECLARED_PROC);
end;

procedure GetBlock(IsExecute: boolean = true);
var
  c: char;
  s: string;
  Block: boolean;
begin
  Block := false;
  SkipWhites;
  c := GetChar;
  MoveBack;
  if (c = '{') then
  begin
    Block := true;
    c := GetChar;
  end;
  while true do
  begin
    SkipWhites;  
    c := GetChar;
    if ((c = '}') and (Block)) then
      exit
    else if (c = '}') then
      Error(STR_END_WITHOUT_BEGIN)
    else
    begin
      MoveBack;
      s := GetName;
      if (s = 'if') then
        GetIf(IsExecute)
      else if ((s = 'AddMoney') or (s = 'AddExpa')
        or (s = 'AddItem') or (s = 'goto') or (s = 'SetItem') or (s = 'SetMonster')
        or (s = 'SetType') or (s = 'SetObject') or (s = 'var') or (s = 'SetSkill')
        or (s = 'SetPerem') or (s = 'print') or (s = 'p') or (s = 'println')
        or (s = 'pln') or (s = 'AddSkill') or (s = 'Sell') or (s = 'BuyWeapons')
        or (s = 'BuyArmor') or (s = 'BuyOther') or (s = 'BuyHealth')
        or (s = 'HealthyHealth') or (s = 'SetImplants') or (s = 'SetLevAttrz') or (s = 'UnlockDoor')) then
      begin
        SkipWhites;
        Expected('(');
        GetProc(s, IsExecute);
      end
      else
        Error(STR_UNDECLARED_IDENTIFIER + s);
    end;
    if (not Block) then
      exit;
  end;
end;

procedure ExecuteLocation(locName: string);
var
  s: string;
begin
  clrscr;
  ResetPos;
  aPos := 1;
  repeat
    s := GetString;
  until ((s = '[' + locName + ']') or (sY >= sLen));
  if (s <> '[' + locName + ']') then
    Error(STR_UNKNOWN_LOCATION + '"' + locName + '"')
  else
    GetBlock;
end;

procedure WriteItem(StartY, num: integer; IsActive: boolean);
begin
  GoToXY(2, StartY + num - 1);
  if (IsActive) then
  begin
    TextColor(LightGray);
    write('==> ');
  end
  else
    write('    ');
  write(variantz[num]);
  TextColor(white);
end;

function GetVariant(count: integer): string;
var
  y, i, active: integer;
  c: char;
begin
  Result := '';
  y := WhereY + 3;
  for i := 1 to count do
  begin
    GoToXY(6, y + i - 1);
    write(variantz[i]);
  end;
  if (count > 0) then
  begin
    active := 1;
    repeat
      WriteItem(y, active, true);
      c := ReadKey;
      case c of
        KEY_DOWN:
        begin
          WriteItem(y, active, false);
          if (active < count) then
            inc(active)
          else
            active := 1;
        end;
        KEY_UP:
        begin
          WriteItem(y, active, false);
          if (active > 1) then
            dec(active)
          else
            active := count;
        end;
      end;
    until (c = KEY_RETURN);
    Result := var_loc[active];
  end
  else
    ReadKey;
end;

procedure talk(x, y: byte);
var
  NextLoc: string;
begin
  clrscr;
  SetLength(strs, 0);
  TextColor(white);
  ExtractScript(cur_lev.map[x, y].Monster.montype);
  ExecuteLocation('main');
  while true do
  begin
    RepaintScreen;
    NextLoc := GetVariant(aPos - 1);
    if (NextLoc <> 'exit') then
      ExecuteLocation(NextLoc)
    else
    begin
      SetLength(strs, 0);
      clrscr;
      clean_all;
      GoToXY(data.posx, data.posy);
      osv;
      exit;
    end;
  end;
end;

end.