Keskustelu: Projektit: Ristinollaa konetta vastaan

Program Ristinolla;
uses crt,winmouse,graph,wincrt,math,sysutils;
CONST
	koko=40;
	voittokoko=5;
TYPE
	Pelilauta=array[1..koko, 1..koko] OF Char;
VAR
	lauta: Pelilauta;
	dx:LongInt;
	dy:LongInt;
	gd,gm: integer;
	error	:	SmallInt;
	eka:BOOLEAN;
PROCEDURE AlustaLauta;
VAR
  i, j: Integer;
BEGIN
  FOR i := 1 to koko DO
    FOR j := 1 to koko DO
      lauta[i, j] := ' ';
END;
PROCEDURE Alusta;
BEGIN
	AlustaLauta;
	WRITELN('heippa');
	gd := D4bit;
  	gm := m800x600;
  	initgraph(gd,gm,'');
    error := graphResult;
  	if (error <> grOk) Then
    	begin
    	writeln('800x600x16 is not supported!');
    	halt(1);
    end;
    dx:=Trunc(800/koko);
    dy:=Trunc(600/koko);
    setTextStyle(defaultFont,horizDir,2);
    initmouse;
    eka:=TRUE;
END;
FUNCTION OnkoLaillinenSiirto(i,j:LongInt):BOOLEAN;
BEGIN
	OnkoLaillinenSiirto:=(lauta[i,j]=' '); //Jos lauta on tyhjä, niin siihen voi laittaa merkin
END;
FUNCTION VoittaakoTietokone: Boolean;
VAR
  i, j: Integer;
BEGIN
  // Tarkistetaan vaakasuorat voitot
  FOR i := 1 TO koko DO
    FOR j := 1 TO (koko - voittoKoko + 1) DO
      if (lauta[i, j] = 'O') and OnkoLaillinenSiirto(i, j) then
        Exit(True);

  // Tarkistetaan pystysuorat voitot
  FOR i := 1 TO (koko - voittoKoko + 1) DO
    FOR j := 1 TO koko DO
      if (lauta[i, j] = 'O') and OnkoLaillinenSiirto(i, j) then
        Exit(True);

  // Tarkistetaan pääviistot
  FOR i := 1 TO (koko - voittoKoko + 1) DO
    FOR j := 1 TO (koko - voittoKoko + 1) DO
      if (lauta[i, j] = 'O') and OnkoLaillinenSiirto(i, j) then
        Exit(True);

  // Tarkistetaan sivuviistot
  FOR i := 1 TO (koko - voittoKoko + 1) DO
    FOR j := voittoKoko TO koko DO
    	BEGIN
	      if (lauta[i, j] = 'O') and OnkoLaillinenSiirto(i, j) then
	        Exit(True);
		END;
  VoittaakoTietokone := False;
END;
FUNCTION Viereinen(i,j:LongInt):BOOLEAN;
VAR apu:BOOLEAN;
BEGIN
	apu:=FALSE;
	IF lauta[i-1,j]='O' THEN apu:=TRUE;
	IF lauta[i-1,j-1]='O' THEN apu:=TRUE;
	IF lauta[i,j-1]='O' THEN apu:=TRUE;
	IF lauta[i+1,j-1]='O' THEN apu:=TRUE;
	IF lauta[i+1,j]='O' THEN apu:=TRUE;
	IF lauta[i+1,j+1]='O' THEN apu:=TRUE;
	IF lauta[i,j+1]='O' THEN apu:=TRUE;
	IF lauta[i-1,j+1]='O' THEN apu:=TRUE;

	Viereinen:=apu;

END;
PROCEDURE TietokoneenSiirto;
VAR
	i,j:Integer;
BEGIN
	FOR i:=1 TO koko DO
		BEGIN
			FOR j:=1 TO koko DO
				BEGIN
					IF OnkoLaillinenSiirto(i,j) THEN
						BEGIN
		        		lauta[i, j] := 'O';
		        		IF VoittaakoTietokone THEN
		          			Exit; // Jos voitto on mahdollinen, valitaan tämä siirto
			        	// Peruutetaan siirto ja jatketaan etsintää
			        	lauta[i, j] := ' ';
		        	END;
	      		END;
	      		  // Jos voittoa ei ole mahdollinen, valitaan siirto jonkin oman merkin vierestä
	      	END;
  REPEAT
    i := Random(koko) + 1;
    j := Random(koko) + 1;
  UNTIL OnkoLaillinenSiirto(i, j) AND Viereinen(i,j) OR eka;
  lauta[i, j] := 'O';
  eka:=FALSE;
END;
PROCEDURE Pelaajansiirto;
VAR
	X,Y,state: LongInt;
	i,j:LongInt;
BEGIN

	REPEAT
		repeat until lpressed;
		getmousestate(X,Y,state);
	    i:=(X div dx)+1;
	    j:=(Y div dy)+1;
    UNTIL OnkoLaillinenSiirto(i,j);
    lauta[i,j]:='X';
END;
PROCEDURE Tulostalauta;
VAR
	i,j:LongInt;
	x,y: LongInt;
BEGIN
	SetColor(white);
	FOR i:=1 TO koko DO
		BEGIN
			x:=(i-1)*dx;
			FOR j:=1 TO koko DO
				BEGIN
					y:=(j-1)*dy;
					line(x,y,x+dx,y);
					line(x,y ,x,y+dy);
					CASE lauta[i,j] OF
						'X': outTextXY(x,y,'X');
						'O': outTextXY(x,y,'O');
					END;
				END;
		END;
END;
BEGIN
	Alusta;
	REPEAT;
		TietokoneenSiirto;
		Tulostalauta;
		Pelaajansiirto;
		repeat until not lpressed;
	UNTIL keypressed;
	CloseGraph;
END.