program triomino;
{not finished !!!}
uses crt, graph, maus, t_steuer, farbwahl;

type spielstein = record
         o, l, r : byte;
         d       : boolean;
       end;

     spielerrec = record
         name        : string;
         steinbesitz : array[1..9] of spielstein;
       end;

var graphdriver, graphmode : integer;
    neuesspiel             : boolean;
    spieleranzahl          : byte;
    spieler                : array[1..4] of spielerrec;
    graphdridir            : string;
    freiesteine            : array[1..38] of spielstein;
    maustasten             : word;

{****************************************************************************}

procedure null;

  var i, j : byte;

  begin
    textcolor(7);
    graphdriver:=9; graphmode:=2;
    graphdridir:='d:\tp\bgi';
    neuesspiel:=false;
    spieleranzahl:=0;
    for i:=1 to 4 do
      begin
        for j:=8 to 9 do
          begin
            spieler[i].steinbesitz[j].r:=6;
            spieler[i].steinbesitz[j].l:=6;
            spieler[i].steinbesitz[j].r:=6;
            spieler[i].steinbesitz[j].d:=false;
          end{or for j};
      end{of for i};
  end{of procedure};

{****************************************************************************}

procedure hintergrund(farbe: byte);
  begin
    setcolor(farbe);
    setfillstyle(1, farbe);
    bar(0, 0, 639, 479);
  end;

{----------------------------------------------------------------------------}

procedure steinverteilung;

  var i, rndnum, zufspie : byte;
      zaehsp             : array[1..4] of byte;
      freistzaeh, j, k   : byte;
      freistsoll         : byte;

  begin
    randomize;
    rndnum:=4+spieleranzahl;
    freistsoll:=56-(11-spieleranzahl)*spieleranzahl;
    for i:=1 to 4 do zaehsp[i]:=1;
    freistzaeh:=1;
    for i:=5 downto 0 do
      for j:=i downto 0 do
        for k:=j downto 0 do
          begin
            repeat
              zufspie:=random(rndnum)+1;
            until (zufspie<=spieleranzahl) or (freistzaeh<=freistsoll);
            if (zufspie <= spieleranzahl) and (zaehsp[zufspie]<=9)
              then
                begin
                  spieler[zufspie].steinbesitz[zaehsp[zufspie]].o:=i;
                  spieler[zufspie].steinbesitz[zaehsp[zufspie]].r:=j;
                  spieler[zufspie].steinbesitz[zaehsp[zufspie]].l:=k;
                  spieler[zufspie].steinbesitz[zaehsp[zufspie]].d:=false;
                  zaehsp[zufspie]:=zaehsp[zufspie]+1;
                end{of then zufspie}
              else
                begin
                  freiesteine[freistzaeh].o:=i;
                  freiesteine[freistzaeh].r:=j;
                  freiesteine[freistzaeh].l:=k;
                  freiesteine[freistzaeh].d:=false;
                  freistzaeh:=freistzaeh+1;
                end{of else zufspie};
          end{of for k};
  end{of procedure};

{----------------------------------------------------------------------------}

procedure steinzeichnen(unterstein: spielstein; oxp, oyp: integer);

  var dreieckst              : array[1..4] of pointtype;
      rxp, ryp, lxp, lyp, yz : integer;
      oanstr : string;

  begin
    yz:=round(sqrt(sqr(70)-sqr(35)));
    if unterstein.d=true then yz:=yz*(-1);
    rxp:=oxp+35; ryp:=oyp+yz; lxp:=oxp-35; lyp:=oyp+yz;
    dreieckst[1].x:=oxp; dreieckst[1].y:=oyp;
    dreieckst[2].x:=rxp; dreieckst[2].y:=ryp;
    dreieckst[3].x:=lxp; dreieckst[3].y:=lyp;
    dreieckst[4].x:=oxp; dreieckst[4].y:=oyp;
    setcolor(black);
    setfillstyle(1, black);
    fillpoly(4, dreieckst);
    setcolor(white);
    setfillstyle(1, white);
    if unterstein.o>=1 then pieslice(oxp, oyp+7, 0, 360, 2);
    if unterstein.o=2 then pieslice(oxp, oyp+14, 0, 360, 2);
    if unterstein.o>=3 then
      begin
        pieslice(oxp-3, oyp+14, 0, 360, 2);
        pieslice(oxp+3, oyp+14, 0, 360, 2);
      end;
    if unterstein.o=4 then pieslice(oxp, oyp+21, 0, 360, 2);
    if unterstein.o=5 then
      begin
        pieslice(oxp-7, oyp+21, 0, 360, 2);
        pieslice(oxp+7, oyp+21, 0, 360, 2);
      end;
    if unterstein.l>=1 then pieslice(lxp+7, lyp-5, 0, 360, 2);
    if unterstein.l=2 then pieslice(lxp+13, lyp-8, 0, 360, 2);
    if unterstein.l>=3 then
      begin
        pieslice(lxp+11, lyp-11, 0, 360, 2);
        pieslice(lxp+15, lyp-5, 0, 360, 2);
      end;
    if unterstein.l=4 then pieslice(lxp+18, lyp-12, 0, 360, 2);
    if unterstein.l=5 then
      begin
        pieslice(lxp+15, lyp-17, 0, 360, 2);
        pieslice(lxp+22, lyp-5, 0, 360, 2);
      end;
    if unterstein.r>=1 then pieslice(rxp-7, ryp-5, 0, 360, 2);
    if unterstein.r=2 then pieslice(rxp-13, ryp-8, 0, 360, 2);
    if unterstein.r>=3 then
      begin
        pieslice(rxp-11, ryp-11, 0, 360, 2);
        pieslice(rxp-15, ryp-5, 0, 360, 2);
      end;
    if unterstein.r=4 then pieslice(rxp-18, ryp-12, 0, 360, 2);
    if unterstein.r=5 then
      begin
        pieslice(rxp-15, ryp-17, 0, 360, 2);
        pieslice(rxp-22, ryp-5, 0, 360, 2);
      end;
  end;

procedure steinvorspielzeich;

  var i, j, xd : integer;
      is       : string[1];
      sp, k    : byte;

  begin
    if spieleranzahl=2 then sp:=2 else sp:=1;
    settextstyle(1, 0, 3);
    for i:=1 to spieleranzahl do
      begin
        setcolor(brown);
        str(i, is);
        outtextxy(5, (i-1)*110*sp, 'Spieler '+ is+ ' : '+spieler[i].name+
          ' : Seine Steine :');
        if spieleranzahl>2
          then
            for j:=1 to 11-spieleranzahl do
              steinzeichnen(spieler[i].steinbesitz[j], (j-1)*80+38, (i-1)*115+35)
          else
            for j:=1 to 9 do
              begin
                xd:=(i-1)*115*2+35;
                if j>5 then xd:=xd+115;
                if j<6 then k:=j;
                if j=6 then k:=1;
                if j>6 then k:=k+1;
                if j<6 then
                  steinzeichnen(spieler[i].steinbesitz[j], (k-1)*80+38, xd);
                if j>5 then
                  steinzeichnen(spieler[i].steinbesitz[j], (k-1)*80+38, xd);
              end;
      end{of for i};
    delay(500);
    setcolor(brown);
    outtextxy(190, 440, 'Bitte ENTER dr�cken');
    readln;
    cleardevice;
  end{of procedure};

{----------------------------------------------------------------------------}

procedure start;

  var i, j   : byte;
      mausin : string;

  begin
    writeln('Spiel "TRIOMINO"');
    writeln;
    write('Maustreiber installiert (sonst Programmende) (J/N) ? '); readln(mausin);
    for i:=1 to length(mausin) do mausin[i]:=upcase(mausin[i]);
    if (mausin='J') or (mausin='JA') then else exit;
    repeat
      {$I-}
      write('Anzahl der Tasten der Maus (2/3): '); readln(maustasten);
      {$I+}
    until (ioresult=0) and ((maustasten = 2) or (maustasten=3));
    repeat
      {$I-}
      write('Anzahl der Spieler (2-4): '); readln(spieleranzahl);
      {$I+}
    until (ioresult=0) and (spieleranzahl < 5) and (spieleranzahl>1);
    {spieleranzahl:=2;
    spieler[1].name:='rejof';
    spieler[2].name:='hadwko';}
    for i:=1 to spieleranzahl do
      begin
        repeat
          write('Name von Spieler ', i, ': ');
          readln(spieler[i].name);
        until length(spieler[i].name)<=31;
      end;
    writeln;
    writeln('Spielsteine werden verteilt');
    steinverteilung;
    delay(100);
    initgraph(graphdriver, graphmode, graphdridir);
    hintergrund(green);
    steinvorspielzeich;
    for i:=0 to 54 do for j:=0 to 60 do putpixel(i*12, j*8, 15);
    settextstyle(1, 0, 8);
    setcolor(brown);
    outtextxy(150, 200, 'TRIOMINO');
    for i:=1 to 245 do
      begin
        delay(20);
        setrgbpalette(20, i, 0, 0);
        if i mod 10 = 0 then setrgbpalette(63, 0, 0, 0);
        if i mod 6 = 0 then  resetcolor(15);
      end;
    settextstyle(1, 0, 2);
    outtextxy(225, 280, 'Spiel wird gestartet.');
    delay(500);
    outtextxy(225, 300, 'Bitte ENTER dr�cken.');
    readln;
    resetcolor(6);
    resetcolor(15);
    cleardevice;
  end;

{****************************************************************************}

procedure spielregeln;

  var j     : integer;
      strfeld  : array[1..20] of string[80];

  begin
    strfeld[1]:='Spielregeln des Spieles "Triomino"';
    strfeld[2]:=' ';
    strfeld[3]:='Jeder Spieler bekommt bei 2 Mitspielern 9, bei 3 8 und bei 4 7';
    strfeld[4]:='Spielsteine. Insgesamt gibt es 56 mit 0 bis 5 Punkten in jeder der';
    strfeld[5]:='drei Ecken. Beim Start liegt ein Stein in der Mitte. Der ausgew�hlte';
    strfeld[6]:='Stein (s/Schalter "stein") kann gedreht werden(d/Schalter "drehen")';
    strfeld[7]:='oder angelegt werden(l und Nummer/Maus an Seite) an vorhandene';
    strfeld[8]:='Steine auf dem Feld wobei die 2 angrenzenden Ecken �berein-';
    strfeld[9]:='stimmen m�ssen. Wenn ein Stein richtig angelegt wurde, mu� ein';
    strfeld[10]:='neuer gezogen werden. Ansonsten setzt der Spieler aus(a/Schalter';
    strfeld[11]:='"aussetzen"). Beim 2. Aussetzen mu� er aus dem Spiel aussteigen.';
    strfeld[12]:='Gewonnen hat der einzig �brig gebliebene Spieler oder, wenn alle';
    strfeld[13]:='56 Steine gezogen wurden, wer zuerst keine Spielsteine mehr hat.';
    strfeld[14]:=' ';
    strfeld[15]:='Bedienung jeweils in Klammern hinter den Aktionen.';
    strfeld[16]:='Bei angegebenem Schalter auf diesen mit der Maus klicken.';
    strfeld[17]:='Rechte Maustaste oder Backspace wiederruft letzte Aktion.';
    strfeld[18]:='Bewegung im Spielfeld mit Pfeilschaltern oder Strg-Taste und';
    strfeld[19]:='Cursortasten.';
    settextstyle(1, 0, 1);
    setcolor(brown);
    setbkcolor(green);
    for j:=1 to 19 do outtextxy(5, (j-1)*20, strfeld[j]);
    settextstyle(1, 0, 2);
    outtextxy(225, 440, 'Bitte ENTER dr�cken');
    readln;
  end;

{----------------------------------------------------------------------------}

procedure spielfeld;
  begin
    cleardevice;
    hintergrund(green);
    setbkcolor(black);
    setcolor(black);
    line(0, 402, 639, 402);
    setfillstyle(1, red);
    bar(594, 404, 637, 478);
    setfillstyle(1, lightblue);
    bar(450, 404, 580, 439);
    bar(315, 404, 445, 439);
    bar(315, 444, 445, 477);
    bar(450, 444, 580, 477);
    setcolor(brown);
    outtextxy(350, 406, '(l)egen');
    outtextxy(475, 406, '(d)rehen');
    outtextxy(325, 446, '(a)ussetzen');
    outtextxy(485, 446, '(s)tein');
    {spieler[1].name:='Andreas';
    spieler[2].name:='Stefan Ziegler sjofdsjofdjosfdj';}
    outtextxy(5, 404, spieler[1].name);
    outtextxy(5, 444, 'ist am Zug');
  end;

procedure mausstart;

  var ja : boolean;
      i  : 1..9;

  begin
    ja:=true;
    init_maus(ja, maustasten, ja);
    select_maus(1);
    show_maus;
    set_maus(320, 240);
  end;

{----------------------------------------------------------------------------}

function gerade(zahl: byte): boolean;

  begin
    if zahl mod 2 = 0
      then gerade:=true
      else gerade:=false;
  end;

procedure gewinner;

  var i, j : 0..15;
      farbegew : byte;

  begin
    for i:=0 to 11 do
      for j:=0 to 15 do
        begin
          if gerade(i)
            then if gerade(j)
                  then farbegew:=white
                  else farbegew:=black
            else if gerade(j)
                  then farbegew:=black
                  else farbegew:=white;
          setcolor(farbegew);
          setfillstyle(1, farbegew);
          bar(40*j, 40*i, 40*(j+1), 40*(i+1));
        end;
    setcolor(lightblue);
    setfillstyle(1, lightblue);
    bar(119, 419, 519, 479);
    bar(119, 359, 419, 419);
    bar(219, 299, 319, 359);
    setcolor(brown);
    settextstyle(1, 0, 7);
    outtextxy(254, 289, '1');
    outtextxy(154, 349, '2');
    outtextxy(354, 349, '3');
    outtextxy(454, 409, '4');
  end;

{----------------------------------------------------------------------------}

procedure neuzug(spielernr : byte);

  begin
    setcolor(green);
    outtextxy(5, 402, '������������������������������');
    outtextxy(5, 408, '������������������������������');
    setcolor(brown);
    settextstyle(1, 0, 2);
    setcolor(brown);
    outtextxy(5, 404, spieler[spielernr].name);
  end;

{----------------------------------------------------------------------------}

procedure spiel;

  var ch     : char;
      gewinn, gesetzt1, gesetzt2 : boolean;
      xp, yp, stat : word;
      taststr, punktx, punkty : string;
      tast : word;
      anz : integer;

  procedure schleife;

    var i : 1..4;
        nr : string[1];

    begin
      i:=1;
      gewinn:=false;
      for i:=1 to spieleranzahl do
        begin
          gesetzt1:=false;
          gesetzt2:=false;
          ch:=chr(0);
          neuzug(i);
          repeat
            if keypressed then ch:=readkey;
            maus_status(xp, yp, tast);
            if (tast=2) or (ch=chr(8)) or (ch=chr(27))
              then gesetzt1:=false
              else if gesetzt1=true
                     then gesetzt2:=true;
            if gesetzt2=false then
              case ch of
                  'a'     : gesetzt1:=aussetzen;
                  'd'     : steindrehen;
                  'l'     : steinlegen(gesetzt1);
                  's'     : steinauswahl;
                  chr(27) : begin
                              gewinn:=true;
                              exit;
                            end{of chr(27) von case ch};
                end{of case ch};
            maus_status(xp, yp, tast);
            if gesetzt2=false then
              if tast=1 then maussteuer(xp, yp, tast, gesetzt1);
            delay(75);
          until gesetzt2;
        end{of for i};
    end{of procedure schleife};

  begin
    spieleranzahl:=2;
    spielregeln;
    spielfeld;
    mausstart;
    setcolor(brown);
    repeat
      schleife;
    until gewinn=true;
    closegraph;
    initgraph(graphdriver, graphmode, graphdridir);
    gewinner;
    readln;
  end;

{****************************************************************************}

procedure ende;

  var neusp : string;
      i     : byte;

  begin
    cleardevice;
    setbkcolor(green);
    setcolor(brown);
    settextstyle(1, 0, 8);
    outtextxy(150, 200, 'Spielende');
    delay(300);
    settextstyle(1, 0, 2);
    outtextxy(225, 300, 'Bitte ENTER dr�cken');
    readln;
    closegraph;
    clrscr;
    write('Neues Spiel (J/N) ? '); readln(neusp);
    for i:=1 to length(neusp) do neusp[i]:=upcase(neusp[i]);
    if (neusp='J') or (neusp='JA') then neuesspiel:=true;
    delay(500);
  end;

{****************************************************************************}
{Haptprogramm}

procedure haupt;
  begin
    repeat
      clrscr;
      null;
      start;
      if spieleranzahl=0 then exit;
      initgraph(graphdriver, graphmode, graphdridir);
      spiel;
      ende;
    until neuesspiel=false;
    clrscr;
  end;

begin
  haupt;
  closegraph;
  clrscr;
  null;
end.