program Mr_Spock;

uses Graph, Crt, dos, bgidriv, bgifont;

var
  GraphDriver, GraphMode, ErrorCode : integer;
  a,b,c,co,lp,xp,yp,n,mx,my,mz,ss,ss1,cn,ns,pp:integer;
  BX,CX,DX:integer;
  s1,song,nota:string;
  loc:array[0..3,0..3,0..3] of integer;
  song1:array[1..16] of string;
  ok,er,sn,ng,wn:boolean;
  reg :registers;
  hh,mm,sss,hu,nt,ot: Word;

procedure initscr;

  procedure Abort(Msg : string);
  begin
    Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
    Halt(1);
  end;

begin
  { Register all the drivers }
  if RegisterBGIdriver(@CGADriverProc) < 0 then Abort('CGA');
  if RegisterBGIdriver(@EGAVGADriverProc) < 0 then Abort('EGA/VGA');
  if RegisterBGIdriver(@HercDriverProc) < 0 then Abort('Herc');
  if RegisterBGIdriver(@ATTDriverProc) < 0 then Abort('AT&T');
  if RegisterBGIdriver(@PC3270DriverProc) < 0 then Abort('PC 3270');
  { Register all the fonts }
  if RegisterBGIfont(@GothicFontProc) < 0 then Abort('Gothic');
  if RegisterBGIfont(@SansSerifFontProc) < 0 then Abort('SansSerif');
  if RegisterBGIfont(@SmallFontProc) < 0 then Abort('Small');
  if RegisterBGIfont(@TriplexFontProc) < 0 then Abort('Triplex');
  GraphDriver := VGA;GraphMode := VGAHi;
  InitGraph(GraphDriver, GraphMode, '');  { activate graphics }
  if GraphResult <> grOk then             { any errors? }
  begin
    Writeln('Graphics init error: ', GraphErrorMsg(GraphDriver));
    Halt(1);
  end;
end;

function is(i: Longint): string;
var s: string[11];
begin
  Str(i, s);is := s;
end;

procedure mouse(ax:word);
begin
 reg.AX:=ax;intr($33,reg);
end;

procedure initmouse;
begin
 CX:=getmaxx;
 DX:=getmaxy;
 mouse(0);
 reg.CX:=0;
 reg.DX:=getmaxx-10;
 mouse(7);
 reg.CX:=0;
 reg.DX:=getmaxy-10;
 mouse(8);
end;

procedure parall(x1,y1,x2,y2,x3,y3,x4,y4:integer);
begin
  moveto(x1,y1);
  lineto(x2,y2);lineto(x3,y3);
  lineto(x4,y4);lineto(x1,y1);
end;

procedure par(c:integer);
var x1,y1,x2,y2,x3,y3,x4,y4:integer;
begin
 if (mx>-1) and (mx<4) and (my mod 4<4) and (mz-my div 4=0) then begin
   setcolor(c);mouse(2);
   x1:=232+58*mx-round(28.5*(my-mz*4));y1:=7+round(28.5*my)+mz*6;
   x2:=211+58*mx-round(28.5*(my-mz*4));y2:=28+round(28.5*my)+mz*6;
   x3:=261+58*mx-round(28.5*(my-mz*4));y3:=28+round(28.5*my)+mz*6;
   x4:=282+58*mx-round(28.5*(my-mz*4));y4:=7+round(28.5*my)+mz*6;
   parall(x1,y1,x2,y2,x3,y3,x4,y4);mouse(1);end;
end;

procedure ell1(x,y:integer;n:word);
var a:word;
begin
  a:=getcolor;
  setcolor(n);
  setfillstyle(solidfill,n);
  fillellipse(x,y,10,5);
  setcolor(a);
end;

procedure cbar(x1,y1,x2,y2,c:integer);
begin
  setfillstyle(solidfill,14);
  bar(x1,y1,x2,y2);
  setfillstyle(solidfill,c);
  bar(x1+2,y1+2,x2-2,y2-2);
end;

procedure bartxt(x,y,c,c1:integer;s:string);
begin
  setfillstyle(solidfill,14);
  bar(x*8-4,y*8-3,(x+length(s))*8+2,y*8+10);
  setfillstyle(solidfill,c);
  bar(x*8-2,y*8-1,(x+length(s))*8,y*8+8);
  setcolor(c1);outtextxy(x*8,y*8,s);
end;

procedure screen;
begin
  mouse(2);ng:=false;wn:=false;
  clearviewport;
  setcolor(14);
  cbar(0,0,60,479,7);
  SetTextStyle(TriplexFont, 1, 4);
  SetUserCharSize(3, 1, 1, 1);
  outtextxy(8,1*8,'Mr. Spock');
  SetTextStyle(DefaultFont, 0, 1);
  for a:=0 to 3 do begin
    b:=120*a;setcolor(14);
    parall(231,4+b,463,4+b,348,119+b,116,119+b);
    line(175,119+b,290,4+b);line(232,119+b,348,4+b);
    line(290,119+b,406,4+b);line(204,32+b,434,32+b);
    line(202,32+b,434,32+b);line(175,62+b,406,62+b);
    line(146,90+b,377,90+b);
  end;
  cbar(512,232,590,416,7);
  bartxt(65,30,4,15,'Options ');
  bartxt(65,32,3,15,'New Game');
  bartxt(65,34,3,15,'End Game');
  bartxt(65,38,4,15,'Sound   ');
  bartxt(65,40,3,15,'Song 1  ');
  bartxt(65,42,3,15,'Song 2  ');
  bartxt(65,44,3,15,'Song 3  ');
  bartxt(65,46,3,15,'Song 4  ');
  bartxt(65,48,3,15,'No Song ');
  bartxt(65,50,3,15,'About   ');
  for a:=0 to 3 do
    for b:=0 to 3 do
      for c:=0 to 3 do begin loc[a,b,c]:=0;end;
  setcolor(white);
  mouse(1);
end;

function controllo1:boolean; {controllo orizzontale piano}
begin
  for lp:=0 to 3 do begin
    for yp:=0 to 3 do begin b:=0;
      for a:=0 to 3 do begin b:=b+loc[lp,a,yp];end;
      if abs(b)=4 then begin wn:=true; controllo1:=true;end
      else begin b:=0; controllo1:=false; end;
    end;
  end;
end;

function controllo2:boolean; {controllo verticale piano}
begin
  for lp:=0 to 3 do begin
    for xp:=0 to 3 do begin b:=0;
      for a:=0 to 3 do begin b:=b+loc[lp,xp,a];end;
      if abs(b)=4 then begin wn:=true; controllo2:=true;end
      else begin b:=0; controllo2:=false;end;
    end;
  end;
end;

function controllo3:boolean; {controllo diagonale piano}
var b1:boolean;
  function controllo3_1:boolean;
  begin
    controllo3_1:=false;
    for lp:=0 to 3 do begin b:=0;
      for a:=0 to 3 do begin b:=b+loc[lp,a,3-a];end;
      if abs(b)=4 then begin wn:=true;controllo3_1:=true;end else b:=0;
    end;
  end;

begin
  b1:=false;
  for lp:=0 to 3 do begin b:=0;
    for a:=0 to 3 do begin b:=b+loc[lp,a,a];end;
    if abs(b)=4 then begin b1:=true;wn:=true;controllo3:=true;end else b:=0;
  end;
  if not(b1) then controllo3:=controllo3_1;
end;

function controllo4:boolean; {controllo orizzontale spazio}

  function controllo4_1:boolean;
  begin
    for a:=0 to 3 do begin b:=b+loc[3-a,a,yp];end;
    if abs(b)=4 then begin wn:=true;controllo4_1:=true;end
    else begin b:=0;controllo4_1:=false;end;
  end;

begin
  for yp:=0 to 3 do begin b:=0;
    for a:=0 to 3 do begin b:=b+loc[a,a,yp];end;
    if abs(b)=4 then begin wn:=true;controllo4:=true;end
    else begin b:=0;controllo4:=controllo4_1;end;
  end;
end;

function controllo5:boolean; {controllo verticale spazio}

  function controllo5_1:boolean;
  begin
    for a:=0 to 3 do begin b:=b+loc[3-a,xp,a];end;
    if abs(b)=4 then begin wn:=true;controllo5_1:=true;end
    else begin b:=0;controllo5_1:=false;end;
  end;

begin
  for xp:=0 to 3 do begin b:=0;
    for a:=0 to 3 do begin b:=b+loc[a,xp,a];end;
    if abs(b)=4 then begin wn:=true;controllo5:=true;end
    else begin b:=0;controllo5:=controllo5_1;end;
  end;
end;

function controllo6:boolean; {controllo diagonale spazio}

  function controllo6_1:boolean;

    function controllo6_2:boolean;

      function controllo6_3:boolean;
      begin
        b:=0;
        for a:=0 to 3 do begin b:=b+loc[3-a,a,3-a];end;
        if abs(b)=4 then begin wn:=true;controllo6_3:=true;end
        else begin b:=0;controllo6_3:=false;
        end;
      end;

    begin
      b:=0;
      for a:=0 to 3 do begin b:=b+loc[a,a,3-a];end;
      if abs(b)=4 then begin wn:=true;controllo6_2:=true;end
      else controllo6_2:=controllo6_3;
    end;

  begin
    b:=0;
    for a:=0 to 3 do begin b:=b+loc[3-a,a,a];end;
    if abs(b)=4 then begin wn:=true;controllo6_1:=true;end
    else controllo6_1:=controllo6_2;
  end;

begin
  b:=0;
  for a:=0 to 3 do begin b:=b+loc[a,a,a];end;
  if abs(b)=4 then begin wn:=true;controllo6:=true;end
  else controllo6:=controllo6_1;
end;

function controllo7:boolean; {controllo colonna spazio}
begin
  for xp:=0 to 3 do begin
    for yp:=0 to 3 do begin b:=0;
      for a:=0 to 3 do begin b:=b+loc[a,xp,yp];end;
      if abs(b)=4 then begin wn:=true;controllo7:=true;exit;end
      else begin b:=0;controllo7:=false;end;
    end;
  end;
end;

procedure controllo;
begin
  ok:=true;
  if not(controllo1) then
  if not(controllo2) then
  if not(controllo3) then
  if not(controllo4) then
  if not(controllo5) then
  if not(controllo6) then ok:=controllo7;
end;

procedure piece(lp,xp,yp,n:integer);
begin
  if loc[lp,xp,yp]<>0 then begin er:=true;end
  else begin
    er:=false;mouse(2);
    if n=1 then loc[lp,xp,yp]:=1 else loc[lp,xp,yp]:=-1;
    xp:=246+xp*58-yp*29;
    yp:=18+yp*28+lp*120;
    ell1(xp,yp+4,2);ell1(xp,yp,n+2);mouse(1);
  end;
end;

procedure s3;
begin
  if nota='g' then sound(392);
  if nota='h' then sound(440);
  if nota='j' then sound(494);
  if nota='z' then sound(523);
  if nota='x' then sound(587);
  if nota='c' then sound(659);
  if nota='v' then sound(701);
  if nota='b' then sound(783);
  if nota='n' then sound(880);
  if nota='m' then sound(993);
  if nota=',' then sound(1046);
end;

procedure s2;
var code:integer;
begin
  song1[1]:='z2z2 2z2z2z2v1b1,2m2m2 2m2v2v2 2v1b1z2z2 9j2z2z2 6**';
  song1[2]:='z2z2 2z2z2z2v1b1,2m2m2 2m2v2v2 2v1b1z2z2 9j2z2z2 6**';
  song1[3]:='v1m2m2v2,2m2n2c2v2m2n2v2,2m2b2c2v3**';
  song1[4]:='v1m2m2v2,2m2n2c2v2m2n2v2,2m2b2c2v3 6**'; {the look of love}
  song1[5]:='z2x2z2b2x2z2x2 2z2x2z2b2x2z2x2 2x2c2x2n2c2x2c1x3x2c2x2n2c2x2c2 2**';
  song1[6]:='z2c2z2m2b2c2b2 2z2c2z2m2b2c2b2 2z2v2z2n2v2z1v1z2 2z2v2z2n2v2z1v1z2 2**';
  song1[7]:='z2x2z2b2x2z2x2 2z2x2z2b2x2z2x2 2x2c2x2n2c2x2c1x3x2c2x2n2c2x2c2 2**';
  song1[8]:='z2c2z2m2b2c2b2 2z2c2z2m2b2c2b2 2z2v2z22n2v2z1v1z2 2z2v2z2n2v2z1v1z2 2**'; {us and them}
  song1[9]:='n2h2 1h2h2j1z1j2h2g1b2z2 2z1x1c1v2,1v1c1m1b1x1n2x2 2**';
  song1[10]:='x2x2c1v1c2x1z2b2z2 2z1x1c1v2,1v1m1b1z1 1**';
  song1[11]:='n2h2 1h2h2j1z1j2h2g1b2z2 2z1x1c1v2,1v1c1m1b1x1n2x2 2**';
  song1[12]:='x2x2c1v1c2x1z2b2z2 2z1x1c1v2,1v1m1b1z1 1**'; {who's that girl}
  song1[13]:='x1c1v3x1c1v3x1c1v1c1x1z3**';
  song1[14]:='x1c1v3x1c1v3x1c1v1c1x1z3**';
  song1[15]:='x1v1n1m1v1x1x1n1v1x1b3c1z3**';
  song1[16]:='x1v1n1m1v1x1x1n1v1x1,6 4**'; {turn it up}
  GetTime(hh,mm,sss,hu);nt:=hh*60*60*100+mm*60*100+sss*100+hu;
  if ss*14<(nt-ot) then
  begin
    nosound;ot:=nt;
    nota:=copy(song1[cn+ns],co,1);co:=co+1;
    s3;
    if nota='*' then begin ss:=0;co:=1;cn:=cn+1;if cn=5 then cn:=1;end else
    begin nota:=copy(song1[cn+ns],co,1);co:=co+1;val(nota,ss,code);end;
  end;
end;

procedure about;
var size,c1:word;p:pointer;ch:char;s:string;
begin
nosound;
c1:=getcolor;setcolor(white);mouse(2);
Size := ImageSize(150,110,450,250);
GetMem(P, Size); { Get memory from heap }
GetImage(150,110,450,250,P^);
cbar(170,110,440,240,3);
outtextxy(180,120,'Mr. Spock : The Space Draughts');
outtextxy(180,140,'Programmed By Raffaele Pinna');
outtextxy(180,150,'Copyright (c) 1991 TechInc');
outtextxy(180,160,'Song1: The Look Of Love');
outtextxy(180,170,'Song2: Us And Them');
s:='Song3: Who'+chr(39)+'s That Girl';
outtextxy(180,180,s);
outtextxy(180,190,'Song4: Turn It Up');
outtextxy(180,200,'This software is Public Domain.');
outtextxy(250,220,'Press a key');
ch:=readkey;setcolor(c1);
PutImage(150,110,P^,NormalPut);mouse(1);
end;


procedure click;
var x,y:integer;
begin
  x:=cx div 8;y:=dx div 8;
  if (x>64) and (x<73) then
  begin
    if y=32 then ng:=true else
    if y=34 then begin nosound;closegraph;halt(1);end else
    if y=40 then begin cn:=1;ns:=0;co:=1;sn:=true;end else
    if y=42 then begin cn:=1;ns:=4;co:=1;sn:=true;end else
    if y=44 then begin cn:=1;ns:=8;co:=1;sn:=true;end else
    if y=46 then begin cn:=1;ns:=12;co:=1;sn:=true;end else
    if y=48 then sn:=false;
    if y=50 then about;
  end;
end;

procedure mouse1;
begin
  mouse(3);
  if CX<>reg.CX then begin
    if not(wn) then par(0);
    CX:=reg.CX;
    mx:=(cx-232+dx) div 60-mz*2;
    if not(wn) then par(15);
  end;
  if DX<>reg.DX then begin
    if not(wn) then par(0);
    DX:=reg.DX;
    mz:=(dx div 122);
    my:=(dx-4-8*mz) div 28;
    if not(wn) then par(15);
  end;
  reg.BX:=0;mouse(5);
  if (reg.bx<>0) and not(ng) then click;
  if (reg.bx<>0) and (mx>-1)
  and (mx<4) and (my mod 4<4)
  and (mz-my div 4=0) and not(ng)
  and not(wn) then piece(mz,mx,my-mz*4,n) else er:=true;
end;

procedure win(n:integer);
var a:char;

function cv(x:integer):integer;
begin
cv:=x div 8;
end;

begin
 mouse(2);
  if wn then begin
    setfillstyle(solidfill,15);
    bar(80,0,490,480);
    setfillstyle(solidfill,10);
    bar(84,4,486,476);
    settextstyle(Gothicfont,0,3);
    outtextxy(194,100,'You won Player '+is(n));
    outtextxy(170,200,'You played Mr. Spock');
    outtextxy(140,300,'Do you want to play again ?');
    cbar(210,340,240,360,2);cbar(325,340,355,360,2);
    settextstyle(defaultfont,0,1);
    outtextxy(214,347,'YES');outtextxy(333,347,'NO');
    repeat mouse(1);repeat mouse1;if sn then s2 else nosound;
    until reg.bx<>0;
    if (cv(cx)>25) and (cv(cx)<30)
      and (cv(dx)>42) and (cv(dx)<45) then begin screen;wn:=false;exit;end;
    if (cv(cx)>40) and (cv(cx)<44)
      and (cv(dx)>42) and (cv(dx)<45) then
      begin nosound;closegraph;clrscr;halt(1);exit;end;
    until false;
  end;
end;

procedure pal;
begin
  Setpalette(14,Random(15));Setpalette(14,63);mouse1;
  if sn then s2 else nosound;
end;

procedure mossa;
begin
  repeat
    pal;
    if (reg.bx<>0) and not(ng) then controllo;
  until not(er) and (reg.bx<>0) or ng or wn;
end;

procedure player(a:integer);
var s:string;
begin
  s:='Player '+is(a);
  bartxt(65,3,3,14,s);
  n:=a;
  setcolor(white);
  mossa;
  if wn then win(n);
  if pp=64 then ng:=true;
end;

procedure help;
begin
writeln;
writeln('Mr. Spock : The Space Draughts');
writeln('Copyright (c) 1990-1991 TechInc');
writeln('Programmed By Raffaele Pinna');
writeln('Song1: The Look Of Love');
writeln('Song2: Us And Them');
writeln('Song3: Who',chr(39),'s That Girl');
writeln('Song4: Turn It Up');
writeln('This software is Public Domain.');
writeln;
end;

begin
  if paramstr(1)='/?' then begin;help;halt(1);end;
  initscr;
  initmouse;
  sn:=true;repeat
  screen;ng:=false;wn:=false;co:=1;cn:=1;ns:=0;pp:=0;
  mouse(1);
  repeat
    player(1);
    if not(ng) then player(2);
  until ng;mouse(2);until false;
  CloseGraph;
end.