uses mycrt,Mouse,unix;
type
  tsquare=array[0..5] of string;
  tscreen=array of array of array[0..1] of string;
var
  SX,SY,SX2:integer;
const
  delay1=550;       { delay when cycling between options }
  delay2=250;       { score increment delay }
  delay3=400;       { embrace delay }
  delay4=100;       { delay when placing parts of a stone }
  fanim=5;          { # of animation phases }
  b0=#$70;
  arrows:array[0..3] of tsquare=
            ((' ',b0,'←',b0,' ',b0),
             (' ',b0,'↑',b0,' ',b0),
             (' ',b0,'→',b0,' ',b0),
             (' ',b0,'↓',b0,' ',b0));
  digits:array[0..3] of tsquare=
            ((' ',b0,'1',b0,' ',b0),
             (' ',b0,'2',b0,' ',b0),
             (' ',b0,'3',b0,' ',b0),
             (' ',b0,'4',b0,' ',b0));
  empty:tsquare=(' ',#7,' ',#7,' ',#7);
  timem:tsquare=(' ',#7,'•',#7,' ',#7);
  dirx:array[0..3] of integer=(-1,0,1,0);
  diry:array[0..3] of integer=(0,-1,0,1);
  wtl=3;            { width of time indicator }
  tlmx=14; tlmy=3;  { pos of time limit indicator, per move }
  tlgx1=3; tlgy=10; { pos of time limit indicator, per game }
  py=4;
  cb1=#$0f;
  cb2=#$07;
  ct0=#$70;
  c1= #$1a;
  c1s=#$12;
  c2= #$5d;
  c2s=#$5c;
  sqb1:tsquare=('▒',cb1,'▒',cb1,'▒',cb1);
  sqb2:tsquare=('▓',cb2,'▓',cb2,'▓',cb2);
  sqc:tsquare=(' ',ct0,'Θ',ct0,' ',ct0);
  sqs:array[1..2] of tsquare=
    ((' ',c1s,'•',c1s,' ',c1s), (' ',c2s,'•',c2s,' ',c2s));
  sqf:array[1..2] of tsquare=
    ((' ',c1 ,'•',c1 ,' ',c1 ), (' ',c2 ,'•',c2 ,' ',c2 ));
  sqcf:array[1..2] of tsquare=
    ((' ',c1 ,'Ω',c1 ,' ',c1 ), (' ',c2 ,'Ω',c2 ,' ',c2 ));
var
  quitting:boolean;
  fast:boolean;
  tl_kind:(TL_NONE,TL_MOVE,TL_GAME);
  tlimit:array[1..2] of integer;
  sco:array[1..2] of integer;
  screen:tscreen;
  board,board1:array[0..15,0..15] of integer;
  queue:array[1..196] of record x,y:byte end;
  qp1,qp2:integer; { queue indices: producer, consumer }
  em:boolean; { just embraced? }
  freesq:integer;
  an:array[1..2] of integer;
  vx,vy:integer; { virtual cursor's position }

procedure delay(ms:integer);
begin
  if fast
    then exit;
  mycrt.delay(ms);
end;

procedure gotoxy(x,y:integer);
begin
  vx:=x;
  vy:=y;
end;

procedure outtext(txt:string);
var
  i:integer;
begin
  for i:=1 to length(txt)
    do begin
         if txt[i]<' '
           then txt[i]:='?';
         screen[vy,vx+i-1,0]:=txt[i];
         screen[vy,vx+i-1,1]:=char(TextAttr);
       end;
  mycrt.gotoxy(vx,vy);
  crtwrite(txt);
end;

procedure draw(x,y:integer;p:tsquare);
  procedure c(s:string);
  begin
    if s=''
      then TextAttr:=7
      else TextAttr:=ord(s[1]);
  end;
var
  i:integer;
begin
  for i:=0 to 5
    do screen[y,x+(i div 2),i mod 2]:=p[i];
  mycrt.gotoxy(x,y);
  c(p[1]);
  crtwrite(p[0]);
  c(p[3]);
  crtwrite(p[2]);
  c(p[5]);
  crtwrite(p[4]);
end;

procedure clearqueue;
begin
  qp1:=0;
  qp2:=0
end;

procedure pushqueue(x,y:integer);
begin
  inc(qp1);
  queue[qp1].x:=x;
  queue[qp1].y:=y
end;

procedure showtime(pl:integer);
var
  m,n:integer;
  txt:string[20];
begin
  case tl_kind of
    TL_MOVE:begin
              textattr:=$70;
              if pl=1
                then m:=tlmx
                else m:=SX-tlmx-wtl*14;
              for n:=1 to 14
                 do draw(m-wtl+n*wtl,tlmy,timem)
            end;
    TL_GAME:begin
              textattr:=7;
              if pl=1
                then gotoxy(tlgx1+1,tlgy)
                else gotoxy(SX-tlgx1-5+1,tlgy);
              outtext('Time:');
              if pl=1
                then gotoxy(tlgx1+2,     tlgy+2)
                else gotoxy(SX-tlgx1-5+2,tlgy+2);
              str(tlimit[pl]:3, txt);
              outtext(txt)
            end;
  end;
end;

procedure showdectime(pl:integer);
var
  txt:string[20];
begin
  case tl_kind of
    TL_MOVE:begin
              textattr:=$70;
              if pl=1
                then draw(tlmx+tlimit[pl]*wtl,tlmy,empty)
                else draw(SX-tlmx-wtl-tlimit[pl]*wtl,tlmy,empty)
            end;
    TL_GAME:begin
              textattr:=7;
              if pl=1
                then gotoxy(tlgx1+2,     tlgy+2)
                else gotoxy(SX-tlgx1-5+2,tlgy+2);
              str(tlimit[pl]:3, txt);
              outtext(txt)
            end;
  end;
end;

procedure cleartime(pl:integer);
var
  m,n:integer;
begin
  case tl_kind of
    TL_MOVE:begin
              textattr:=$70;
              if pl=1
                then m:=tlmx
                else m:=SX-tlmx-wtl*14;
              for n:=1 to 14
                do draw(m-wtl+n*wtl,tlmy,empty)
            end;
   end;
end;

function waskey(timed:boolean;pl:integer):boolean;
var
  ch:char;
begin
  if not (quitting or timed)
    then waitkey;
  if keypressed or quitting
    then begin
           while keypressed
             do ch:=readkey;
           if ch='q'
             then begin
                    quitting:=true;
                    fast:=true
                  end;
           waskey:=true
         end
  else if (GetMouseButtons and 1)<>0
         then waskey:=true
  else if timed and (tl_kind<>TL_NONE)
         then begin
               dec(tlimit[pl]);
               if tlimit[pl]<0
                 then begin
                        tlimit[pl]:=0;
                        waskey:=true
                      end
                 else begin
                        showdectime(pl);
                        waskey:=false
                      end
              end
  else waskey:=false
end;

procedure drawsquare(x,y:integer;w:tsquare);
begin
  draw(SX2-23+3*x,4+y,w);
end;

procedure clearsquare(x,y:integer);
begin
  if ((x=1) or (x=14)) and ((y=1) or (y=14))
    then drawsquare(x,y,sqc)
    else if odd(x+y)
           then drawsquare(x,y,sqb1)
           else drawsquare(x,y,sqb2)
end;

procedure fillsquare(x,y,pl:integer);
begin
  if ((x=1) or (x=14)) and ((y=1) or (y=14))
    then drawsquare(x,y,sqcf[pl])
    else drawsquare(x,y,sqf[pl])
end;


procedure anim(x,y,pl:integer);
var
  x0,y0,x1,y1:integer;
  xc,yc:integer;
  n,i:integer;
  tmp:tsquare;
  numc:integer;
const
  corners:array[1..4,1..2] of integer=((1,1),(14,1),(14,14),(1,14));
begin
  numc:=0;
  for n:=1 to 4
    do if board[corners[n,1],corners[n,2]]=pl*2
         then inc(numc);
  if numc=0
    then begin
           fillsquare(x,y,pl);
           delay(delay3);
           exit
         end;
  an[pl]:=an[pl] mod numc+1;
  numc:=0;
  for n:=1 to 4
    do if board[corners[n,1],corners[n,2]]=pl*2
         then begin
                inc(numc);
                if numc=an[pl]
                  then begin
                         x0:=corners[n,1];
                         y0:=corners[n,2]
                       end
              end;
  y1:=py+y;
  x1:=SX2-23+3*x;
  y0:=py+y0;
  x0:=SX2-23+3*x0;
  for n:=0 to fanim
    do begin
         xc:=x0+longint((x1-x0))*n div fanim;
         yc:=y0+longint((y1-y0))*n div fanim;
         for i:=0 to 5
           do tmp[i]:=screen[yc,xc+(i div 2),i mod 2];
         draw(xc,yc,sqf[pl]);
         delay(delay3 div (fanim+1));
         draw(xc,yc,tmp);
       end;
  fillsquare(x,y,pl)
end;

function boardsame:boolean;
var
  x,y:integer;
begin
  for x:=1 to 14
    do for y:=1 to 14
         do if board[x,y]<>board1[x,y]
              then begin
                     boardsame:=false;
                     exit
                   end;
  boardsame:=true
end;

procedure message(pl:integer;str:string);
begin
  gotoxy(SX2-1-length(str) div 2,SY-4);
  if pl=1
    then textattr:=byte(c1)
    else if pl=2
           then textattr:=byte(c2)
           else textattr:=byte(b0);
  outtext(' '+str+' ')
end;

procedure clearmessage;
begin
  textattr:=7;
  gotoxy(SX2-10,SY-4);
  outtext('                    ')
end;

procedure showwinner;
begin
  if sco[1]>sco[2]
    then message(1,'EL-IXIR')
    else if sco[1]<sco[2]
           then message(2,'EL-IXIR')
           else message(0,'EL-IXIR');
  waskey(false,0);
  quitting:=true
end;

procedure markplayer(pl:integer);
var
  x:integer;
begin
  if pl=1
    then x:=2
    else x:=SX-7;
  draw(x,6,sqf[pl]);
  draw(x+2,6,sqf[pl]);
  draw(x,7,sqf[pl]);
  draw(x+2,7,sqf[pl]);
  if pl=1
    then x:=SX-7
    else x:=2;
  draw(x,6,empty);
  draw(x+2,6,empty);
  draw(x,7,empty);
  draw(x+2,7,empty);
end;

procedure score(pl:integer);
var
  x:integer;
  n:integer;
begin
  if pl=1
    then textattr:=byte(c1)
    else textattr:=byte(c2);
  if pl=1
    then x:=9
    else x:=SX-10;
  gotoxy(x-2,2);
  outtext('Score');
  textattr:=7;
  if sco[pl]>99
    then n:=0
    else if sco[pl]>9
           then n:=1
           else n:=2;
  if sco[pl]>99
    then begin
           gotoxy(x,4);
           outtext('1')
         end;
  if sco[pl]>9
    then begin
           gotoxy(x,5-n);
           outtext(char(ord('0')+sco[pl] div 10 mod 10))
         end;
  gotoxy(x,6-n);
  outtext(char(ord('0')+sco[pl] mod 10))
end;

procedure sweepandmark(pl:integer;msg:string);
  procedure check(x,y:integer);
  begin
    if board1[x,y]=pl*2-1
      then begin
             pushqueue(x,y);
             board1[x,y]:=pl*2
           end
  end;
var
  x,y:integer;
begin
  board1:=board;
  for x:=1 to 14
    do for y:=1 to 14
         do if board1[x,y]=pl*2
              then board1[x,y]:=pl*2-1;
  clearqueue;
  check(1,1);
  check(1,14);
  check(14,1);
  check(14,14);
  while qp1>qp2
    do begin
         inc(qp2);
         x:=queue[qp2].x;
         y:=queue[qp2].y;
         check(x+1,y);
         check(x-1,y);
         check(x,y+1);
         check(x,y-1)
       end;
  if not boardsame
    then begin
           message(pl,msg);
           for x:=1 to 14
             do for y:=1 to 14
                  do if board1[x,y]<>board[x,y]
                       then begin
                              inc(sco[pl]);
                              score(pl);
                              delay(delay2)
                            end;
           board:=board1;
           clearmessage
         end;
end;

procedure completeembrace(pl:integer);
var
  b:boolean;
  procedure check(x,y:integer);
  begin
    if board1[x,y]=0
      then begin
             pushqueue(x,y);
             board1[x,y]:=-1
           end
  end;
  procedure check1(x,y:integer);
  begin
    if board1[x,y]=0
      then begin
             pushqueue(x,y);
             board1[x,y]:=-2;
             if (board[x-1,y]=pl*2) or
                  (board[x+1,y]=pl*2) or
                  (board[x,y-1]=pl*2) or
                  (board[x,y+1]=pl*2)
               then b:=true
           end
  end;
var
  x,y,x1,y1:integer;
begin
  board1:=board;
  for x:=1 to 14
    do for y:=1 to 14
         do if board1[x,y]=pl*2
              then board1[x,y]:=pl*2-1;
  for x:=1 to 14
    do for y:=1 to 14
         do if board1[x,y]<>pl*2-1
              then board1[x,y]:=0;
  clearqueue;
  check(1,1);
  check(1,14);
  check(14,1);
  check(14,14);
  while qp1>qp2
    do begin
         inc(qp2);
         x:=queue[qp2].x;
         y:=queue[qp2].y;
         check(x+1,y);
         check(x-1,y);
         check(x,y+1);
         check(x,y-1);
         check(x+1,y+1);
         check(x-1,y-1);
         check(x-1,y+1);
         check(x+1,y-1)
       end;
  b:=false;
  for x:=1 to 14
    do for y:=1 to 14
         do if board1[x,y]=0
              then begin
                     x1:=x;
                     y1:=y;
                     b:=true
                   end;
  if not b
    then exit;
  b:=false;
  clearqueue;
  check1(x1,y1);
  while qp1>qp2
    do begin
         inc(qp2);
         x:=queue[qp2].x;
         y:=queue[qp2].y;
         check1(x+1,y);
         check1(x-1,y);
         check1(x,y+1);
         check1(x,y-1)
       end;
  message(pl,'Complete Embrace');
  em:=true;
  for y:=1 to 14
    do for x:=1 to 14
         do if board1[x,y]=-2
              then begin
                     if board[x,y]=0
                       then dec(freesq);
                     if b
                       then begin
                             inc(sco[pl]);
                             score(pl);
                             board[x,y]:=pl*2
                            end
                      else board[x,y]:=pl*2-1;
                    anim(x,y,pl)
                  end;
  sweepandmark(pl,'Complete Embrace');
  clearmessage
end;

procedure anchorembrace(pl:integer);
  procedure check(x,y:integer);
  begin
    if board1[x,y]=-3
      then begin
             pushqueue(x,y);
             board1[x,y]:=-1
           end
  end;
  procedure check1(x,y:integer);
  begin
    if board[x,y]=(3-pl)*2
      then begin
             pushqueue(x,y);
             board1[x,y]:=-1
           end
  end;
  procedure check2(x,y:integer);
  begin
    if board1[x,y]=-3
      then begin
             pushqueue(x,y);
             board1[x,y]:=-2
           end
  end;
var
  b:boolean;
  x,y,x1,y1:integer;
begin
  board1:=board;
  for x:=1 to 14
    do for y:=1 to 14
         do if (board1[x,y]<>pl*2) and (board1[x,y]<>0)
              then board1[x,y]:=-3;
  clearqueue;
  for y:=1 to 14
    do for x:=1 to 14
         do if board[x,y]=0
              then begin
                     pushqueue(x,y);
                     board1[x,y]:=-1
                   end;
  check1(1,1);
  check1(1,14);
  check1(14,1);
  check1(14,14);
  while qp1>qp2
    do begin
         inc(qp2);
         x:=queue[qp2].x;
         y:=queue[qp2].y;
         check(x+1,y);
         check(x-1,y);
         check(x,y+1);
         check(x,y-1)
       end;
  b:=false;
  for y:=1 to 14
    do for x:=1 to 14
         do if board1[x,y]=-3
              then begin
                     x1:=x;
                     y1:=y;
                     b:=true
                   end;
  if not b
    then exit;
  clearqueue;
  check2(x1,y1);
  while qp1>qp2
    do begin
         inc(qp2);
         x:=queue[qp2].x;
         y:=queue[qp2].y;
         check2(x+1,y);
         check2(x-1,y);
         check2(x,y+1);
         check2(x,y-1)
       end;
  message(pl,'Anchoring Embrace');
  em:=true;
  for y:=1 to 14
    do for x:=1 to 14
         do if board1[x,y]=-2
              then begin
                     if board[x,y]=0
                       then dec(freesq);
                     inc(sco[pl]);
                     score(pl);
                     board[x,y]:=pl*2;
                     anim(x,y,pl)
                   end;
  sweepandmark(pl,'Anchoring Embrace');
  clearmessage
end;

procedure playermove(pl:integer);
var
  selsq:array[1..4] of record x,y:integer end;
  numsel,len:integer;
  x,y,n,m:integer;
begin
  if freesq<4
    then numsel:=freesq
    else numsel:=4;
  if tl_kind=TL_MOVE
    then tlimit[pl]:=14;
  showtime(pl);
  for n:=1 to numsel
    do begin
         repeat
           x:=random(14)+1;
           y:=random(14)+1;
         until board[x,y]=0;
         board[x,y]:=-1;
         selsq[n].x:=x;
         selsq[n].y:=y
       end;
  n:=1;
  if numsel>1
    then repeat
           with selsq[n]
             do clearsquare(x,y);
           inc(n);
           if n>numsel
             then n:=1;
           with selsq[n]
             do drawsquare(x,y,sqs[pl]);
           delay(delay1);
         until waskey(true,pl);
  for m:=1 to numsel
    do with selsq[m]
         do board[x,y]:=0;
  x:=selsq[n].x;
  y:=selsq[n].y;
  if (board[x+1,y]=0) or
     (board[x-1,y]=0) or
     (board[x,y+1]=0) or
     (board[x,y-1]=0)
    then begin
           if tl_kind=TL_MOVE
             then begin
                    tlimit[pl]:=14;
                    showtime(pl)
                  end;
           n:=random(4);
           repeat
             n:=succ(n) mod 4;
             drawsquare(x,y,arrows[n]);
             delay(delay1);
           until waskey(true,pl);
           m:=n;
           n:=1;
           if tl_kind=TL_MOVE
             then begin
                    tlimit[pl]:=14;
                    showtime(pl)
                  end;
           repeat
             n:=(n+2) mod 4+1;
             drawsquare(x,y,digits[n-1]);
             delay(delay1);
           until waskey(true,pl)
         end
    else m:=0;
  cleartime(pl);
  len:=n;
  n:=0;
  repeat
    board[x+n*dirx[m],y+n*diry[m]]:=pl*2-1;
    fillsquare(x+n*dirx[m],y+n*diry[m],pl);
    delay(delay4);
    dec(freesq);
    inc(n);
  until (n=len) or (board[x+n*dirx[m],y+n*diry[m]]>0);
  sweepandmark(pl,'Anchoring Chain');
  repeat
    em:=false;
    completeembrace(pl);
    anchorembrace(3-pl);
    anchorembrace(pl);
  until not em
end;

procedure setsize;
var
  i:integer;
begin
  SX:=ScreenWidth;
  SY:=ScreenHeight;
  SX2:=SX div 2;
  SetLength(screen, SY+1);
  for i:=1 to SY
    do SetLength(screen[i], SX+1);
end;

procedure quit;
begin
  write(#27'[0m'#27'[2J'#27'[0;0f');
  cursorin;
  DoneMouse;
  halt
end;

procedure instructions;
var
  f:text;
  manpath:string;
begin
  DoneCrt;
  DoneMouse;
  cursorin;
  write(#27'[0m'#27'[2J'#27'[0;0f');
  {$I-}
  assign(f, 'el-ixir.6');
  reset(f);
  {$I+}
  if IOResult=0
    then begin
           close(f);
           manpath:='./el-ixir.6'
         end
    else manpath:='el-ixir';
  if fpSystem(ansistring('man '+manpath))<>0
    then begin
           writeln('== Press any key ==');
           readln
         end;
  InitCrt;
  InitMouse;
  setsize
end;

procedure menu;
var
  m,n:integer;
  ch:char;
const
  min=11;
  choices:array[min..24] of string[15]=(
                       ' EL-IXIR ',
                       '',
                       '',
                       '',
                       '',
                       'TIME:',
                       'For one move',
                       'For all game',
                       'No limit',
                       '',
                       'Instructions',
                       '',
                       'Play game',
                       'Exit to DOS');
  options:set of byte=[17,18,19,21,23,24];
begin
  n:=23;
  repeat
    textattr:=7;
    clrscr;
    cursorout;
    for m:=min to 24
      do begin
           if m=min
             then textattr:=$5e
             else textattr:=7;
           gotoxy(SX2+2-length(choices[m]) div 2,m);
           outtext(choices[m])
         end;
    if tl_kind=TL_NONE
      then gotoxy(SX2+11,19)
      else gotoxy(SX2+11,integer(tl_kind)+16);
    outtext('√');
    repeat
      gotoxy(SX2-5,n);
      textattr:=$70;
      outtext('               ');
      gotoxy(SX2+2-length(choices[n]) div 2,n);
      outtext(choices[n]);
      ch:=readkey;
      gotoxy(SX2-5,n);
      textattr:=$07;
      outtext('               ');
      gotoxy(SX2+2-length(choices[n]) div 2,n);
      outtext(choices[n]);
      case ch of
        #0:begin
             ch:=readkey;
             case ch of
               #72:repeat
                     if n>min
                       then dec(n)
                       else n:=24;
                   until n in options;
               #80:repeat
                     if n<24
                       then inc(n)
                       else n:=min
                   until n in options;
              end;
           end;
        #27:begin
              ch:=readkey;
              case ch of
                '[':case readkey of
                      'A':repeat
                            if n>min
                              then dec(n)
                              else n:=24;
                          until n in options;
                      'B':repeat
                            if n<24
                              then inc(n)
                              else n:=min
                          until n in options;
                    end;
                #27:quit;
              end;
            end;
        'q':quit;
       end;
    until (ch=#13) or (ch=' ');
    textattr:=7;
    clrscr;
    case n of
     24:quit;
     23:break;
     19:tl_kind:=TL_NONE;
     18:tl_kind:=TL_GAME;
     17:tl_kind:=TL_MOVE;
     21:instructions;
    end;
  until false
end;

var
  x,y:integer;
  pl:integer;
begin
  tl_kind:=TL_NONE;
  InitMouse;
  setsize;
  repeat
    menu;
    tlimit[1]:=400;
    tlimit[2]:=400;
    quitting:=false;
    sco[1]:=0;
    sco[2]:=0;
    cursorout;
    randomize;
    textattr:=7;
    clrscr;
    for x:=1 to 14
      do for y:=1 to 14
           do clearsquare(x,y);
    if tl_kind=TL_GAME
      then begin
             showtime(1);
             showtime(2)
           end;
    for x:=0 to 15
      do begin board[x,0]:=127; board[x,15]:=127 end;
    for y:=1 to 14
      do begin board[0,y]:=127; board[15,y]:=127 end;
    for x:=1 to 14
      do for y:=1 to 14
           do board[x,y]:=0;
    freesq:=196;
    fast:=false;
    pl:=1;
    repeat
      message(pl,'Press any key');
      markplayer(pl);
      waskey(false,0);
      clearmessage;
      playermove(pl);
      pl:=3-pl;
    until quitting or (freesq=0) or (sco[1]>98) or (sco[2]>98);
    showwinner;
  until false
end.
