Schiffe versenken programmieren

[Sir Rufo]

So, ich kann mir das Elend nicht mehr mit anschauen und hier ein fertiges Schiffe Versenken in einer Konsolen-Version und ohne Highscore.

Wie man sieht bleibt vom eigentlichen Spiel nicht viel mehr als Vorbereiten und SchussAuf.
Logisch, denn die Erfassung der Schusskoordinaten und Ausgabe des Spielfeldes gehört zum User-Interface und nicht zum Spiel, denn das Spiel funktioniert auch ohne User-Interface.

Es ist bewusst rudimentär gehalten ohne viel BlinkBlink um den Blick nicht vom Wesentlichen abzulenken.
Ich habe mir erlaubt keine Kommentare zu setzen, da der Code sich im Wesentlichen selber erklärt, bzw. der TE auch noch etwas zu tun haben soll.

Hautprogramm (User-Interface)

Delphi-Quellcode:

program sv;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  SysUtils,
  SchiffeVersenken in 'SchiffeVersenken.pas';

function ZeichenFuerZelle( Wert : Integer ) : Char;
begin
  case Wert of
    Zelle_Wasser :
      Result := '.';
    Zelle_NebenSchiff :
      Result := '.';
    Zelle_Schiff :
      Result := '.';
    Zelle_SchussWasser :
      Result := 'o';
    Zelle_SchussNebenSchiff :
      Result := 'o';
    Zelle_SchussSchiff :
      Result := 'X';
  end;
end;

procedure ZeigeSpielfeld( Spielfeld : TSpielfeld );
var
  LY : Integer;
  LX : Integer;
begin
  for LY := yMin to yMax do
  begin
    Write( chr( Ord( 'A' ) + LY ), ' ' );
    for LX := xMin to xMax do
      Write( ZeichenFuerZelle( Spielfeld[LX, LY] ) );
    WriteLn;
  end;
end;

function KoordinatenVonEingabe( const Eingabe : string; var x, y : Integer ) : Boolean;
begin
  Result := Length( Eingabe ) >= 2;

  if Result then
    Result := Ord( Eingabe[1] ) >= Ord( 'A' );

  if Result then
    y := Ord( Eingabe[1] ) - Ord( 'A' );

  if Result then
    Result := TryStrToInt( Copy( Eingabe, 2 ), x );

  if Result then
    x := x - 1;
end;

procedure Spiel;
var
  LSpielfeld : TSpielfeld;
  LSchussErgebnis : Integer;
  LSchussKoordinate : string;
  LX, LY : Integer;
begin
  Vorbereiten( LSpielfeld );
  repeat
    ZeigeSpielfeld( LSpielfeld );
    repeat
      repeat
        Write( 'Schuss auf: ' );
        Readln( LSchussKoordinate );
      until KoordinatenVonEingabe( LSchussKoordinate, LX, LY );
      LSchussErgebnis := SchussAuf( LSpielfeld, LX, LY );
      case LSchussErgebnis of
        Schuss_Wasser :
          WriteLn( 'Wasser' );
        Schuss_Treffer :
          WriteLn( 'Treffer' );
        Schuss_SchiffVersenkt :
          WriteLn( 'Treffer und Versenkt' );
        Schuss_FlotteVersenkt :
          WriteLn( 'Treffer, Versenkt und Gewonnen' );
        Schuss_Doppelt :
          WriteLn( 'Auf die Koordinaten ', LSchussKoordinate, ' wurde schon geschossen!' );
        Schuss_Ausserhalb :
          WriteLn( 'Koordinaten ', LSchussKoordinate, ' ungültig!' );
      end;
    until ( LSchussErgebnis <> Schuss_Doppelt ) or ( LSchussErgebnis <> Schuss_Ausserhalb );
  until LSchussErgebnis = Schuss_FlotteVersenkt;
end;

begin
  Randomize;
  try
    Spiel;
  except
    on E : Exception do
      WriteLn( E.ClassName, ': ', E.Message );
  end;
  Readln;

end.

und die Spiellogik

Delphi-Quellcode:

unit SchiffeVersenken;

interface

const
  xMin = 0;
  xMax = 11;
  yMin = 0;
  yMax = 11;

type
  TSpielfeld = array [xMin .. xMax, yMin .. yMax] of Integer;

const
  Zelle_Wasser = 0;
  Zelle_NebenSchiff = 1;
  Zelle_Schiff = 2;
  Schuss = 10;
  Zelle_SchussWasser = Zelle_Wasser + Schuss;
  Zelle_SchussNebenSchiff = Zelle_NebenSchiff + Schuss;
  Zelle_SchussSchiff = Zelle_Schiff + Schuss;

procedure Vorbereiten( var Spielfeld : TSpielfeld );

const
  Schuss_Wasser = 0;
  Schuss_Treffer = 1;
  Schuss_SchiffVersenkt = 2;
  Schuss_FlotteVersenkt = 3;
  Schuss_Doppelt = 4;
  Schuss_Ausserhalb = 5;

function SchussAuf( var Spielfeld : TSpielfeld; x, y : Integer ) : Integer;

implementation

uses
  Math;

const
  Einer = 1;
  Zweier = 2;
  Dreier = 3;
  Vierer = 4;

procedure FuelleBereich( var Spielfeld : TSpielfeld; VonX, BisX, VonY, BisY : Integer; Wert : Integer );
var
  LX : Integer;
  LY : Integer;
begin
  for LY := VonY to BisY do
    for LX := VonX to BisX do
      Spielfeld[LX, LY] := Wert;
end;

const
  Ausrichtung_Horizontal = 0;
  Ausrichtung_Vertikal = 1;

function KannSchiffDorthin( Spielfeld : TSpielfeld; x, y, Ausrichtung, Laenge : Integer ) : Boolean;
var
  LIdx : Integer;
begin
  Result := False;
  case Ausrichtung of
    Ausrichtung_Horizontal :
      begin
        if x + Laenge - 1 <= xMax then
        begin
          Result := True;
          for LIdx := x to x + Laenge - 1 do
          begin
            Result := Result and ( Spielfeld[LIdx, y] = Zelle_Wasser );
          end;
        end;
      end;
    Ausrichtung_Vertikal :
      begin
        if y + Laenge - 1 <= yMax then
        begin
          Result := True;
          for LIdx := y to y + Laenge - 1 do
          begin
            Result := Result and ( Spielfeld[x, LIdx] = Zelle_Wasser );
          end;
        end;
      end;
  end;
end;

procedure PositioniereSchiff( var Spielfeld : TSpielfeld; Laenge : Integer );
var
  LX, LY : Integer;
  LAusrichtung : Integer;
begin
  repeat
    LAusrichtung := Random( 2 );
    LX := Random( xMin + xMax + 1 ) + xMin;
    LY := Random( yMin + yMax + 1 ) + yMin;
  until KannSchiffDorthin( Spielfeld, LX, LY, LAusrichtung, Laenge );

  case LAusrichtung of
    Ausrichtung_Horizontal :
      begin
        FuelleBereich( Spielfeld, Max( xMin, LX - 1 ), Min( xMax, LX + Laenge ), Max( yMin, LY - 1 ), Min( yMax, LY + 1 ), Zelle_NebenSchiff );
        FuelleBereich( Spielfeld, LX, LX + Laenge - 1, LY, LY, Zelle_Schiff );
      end;
    Ausrichtung_Vertikal :
      begin
        FuelleBereich( Spielfeld, Max( xMin, LX - 1 ), Min( xMax, LX + 1 ), Max( xMin, LY - 1 ), Min( yMax, LY + Laenge ), Zelle_NebenSchiff );
        FuelleBereich( Spielfeld, LX, LX, LY, LY + Laenge - 1, Zelle_Schiff );
      end;
  end;

end;

procedure Vorbereiten( var Spielfeld : TSpielfeld );
begin
  FuelleBereich( Spielfeld, xMin, xMax, yMin, yMax, Zelle_Wasser );
  PositioniereSchiff( Spielfeld, Vierer );
  PositioniereSchiff( Spielfeld, Dreier );
  PositioniereSchiff( Spielfeld, Dreier );
  PositioniereSchiff( Spielfeld, Zweier );
  PositioniereSchiff( Spielfeld, Zweier );
  PositioniereSchiff( Spielfeld, Einer );
  PositioniereSchiff( Spielfeld, Einer );
end;

function IstSchiffVersenkt( Spielfeld : TSpielfeld; x, y : Integer ) : Boolean;
var
  LIdx : Integer;
begin
  Result := True;
  LIdx := x;
  while Result and ( LIdx >= xMin ) and ( ( Spielfeld[LIdx, y] = Zelle_Schiff ) or ( Spielfeld[LIdx, y] = Zelle_SchussSchiff ) ) do
  begin
    if Spielfeld[LIdx, y] = Zelle_Schiff then
      Result := False;
    Inc( LIdx, - 1 );
  end;
  LIdx := x;
  while Result and ( LIdx <= xMax ) and ( ( Spielfeld[LIdx, y] = Zelle_Schiff ) or ( Spielfeld[LIdx, y] = Zelle_SchussSchiff ) ) do
  begin
    if Spielfeld[LIdx, y] = Zelle_Schiff then
      Result := False;
    Inc( LIdx, 1 );
  end;
  LIdx := y;
  while Result and ( LIdx >= yMin ) and ( ( Spielfeld[x, LIdx] = Zelle_Schiff ) or ( Spielfeld[x, LIdx] = Zelle_SchussSchiff ) ) do
  begin
    if Spielfeld[x, LIdx] = Zelle_Schiff then
      Result := False;
    Inc( LIdx, - 1 );
  end;
  LIdx := y;
  while Result and ( LIdx <= yMax ) and ( ( Spielfeld[x, LIdx] = Zelle_Schiff ) or ( Spielfeld[x, LIdx] = Zelle_SchussSchiff ) ) do
  begin
    if Spielfeld[x, LIdx] = Zelle_Schiff then
      Result := False;
    Inc( LIdx, 1 );
  end;
end;

function IstFlotteVersenkt( Spielfeld : TSpielfeld ) : Boolean;
var
  LY : Integer;
  LX : Integer;
begin
  Result := True;
  for LY := yMin to yMax do
    for LX := xMin to xMax do
    begin
      if Spielfeld[LX, LY] = Zelle_Schiff then
        Result := False;
    end;
end;

function SchussAuf( var Spielfeld : TSpielfeld; x, y : Integer ) : Integer;
begin
  if InRange( x, xMin, xMax ) and InRange( y, yMin, yMax ) then
  begin
    if Spielfeld[x, y] < Schuss then
    begin
      case Spielfeld[x, y] of
        Zelle_Wasser :
          Result := Schuss_Wasser;
        Zelle_NebenSchiff :
          Result := Schuss_Wasser;
        Zelle_Schiff :
          Result := Schuss_Treffer;
      end;

      Spielfeld[x, y] := Spielfeld[x, y] + Schuss;

      if Result = Schuss_Treffer then
        if IstSchiffVersenkt( Spielfeld, x, y ) then
          if IstFlotteVersenkt( Spielfeld ) then
            Result := Schuss_FlotteVersenkt
          else
            Result := Schuss_SchiffVersenkt;
    end
    else
      Result := Schuss_Doppelt;
  end
  else
    Result := Schuss_Ausserhalb;
end;

end.