Busca en Google

lunes, 1 de septiembre de 2008

Domino Hasta Reparto de Fichas

setscreen ("graphics:v16")
var player, pc : array 1 .. 2, 1 .. 7 of int
var juego : array 1 .. 2, 1 .. 28 of int
var salieron : array 1 .. 14 of int
procedure dibuja_pto (n : int, x, y : int)
var h, k : int
case n of
label 1 :
h := x + 5
k := y + 5
label 2 :
h := x + 13
k := y + 5
label 3 :
h := x + 21
k := y + 5
label 4 :
h := x + 5
k := y + 13
label 5 :
h := x + 13
k := y + 13
label 6 :
h := x + 21
k := y + 13
label 7 :
h := x + 5
k := y + 21
label 8 :
h := x + 13
k := y + 21
label 9 :
h := x + 21
k := y + 21
end case
drawfilloval (h, k, 3, 3, 4)
end dibuja_pto
procedure dibuja_cuadrado (n : int, x, y, p : int)
if p = 0 then
if n = 2 or n = 3 then
dibuja_pto (7, x, y)
dibuja_pto (3, x, y)
end if
if n = 6 then
dibuja_pto (2, x, y)
dibuja_pto (8, x, y)
end if
else
if n = 2 or n = 3 then
dibuja_pto (1, x, y)
dibuja_pto (9, x, y)
end if
if n = 6 then
dibuja_pto (4, x, y)
dibuja_pto (6, x, y)
end if
end if
if n = 1 or n = 5 or n = 3 then
dibuja_pto (5, x, y)
end if
if n = 4 or n = 5 or n = 6 then
dibuja_pto (1, x, y)
dibuja_pto (3, x, y)
dibuja_pto (7, x, y)
dibuja_pto (9, x, y)
end if
end dibuja_cuadrado
procedure dibuja_ficha (n, m, x, y, p : int)
if p = 0 then
drawfillbox (x, y, x + 50, y + 25, 0)
drawbox (x, y, x + 50, y + 25, 12)
drawline (x + 25, y, x + 25, y + 25, 12)
drawfilloval (x + 25, y + 13, 2, 2, 12)
dibuja_cuadrado (n, x, y, p)
dibuja_cuadrado (m, x + 25, y, p)
else
drawfillbox (x, y, x + 25, y + 50, 0)
drawbox (x, y, x + 25, y + 50, 12)
drawline (x, y + 25, x + 25, y + 25, 12)
drawfilloval (x + 13, y + 25, 2, 2, 12)
dibuja_cuadrado (n, x, y, p)
dibuja_cuadrado (m, x, y + 25, p)
end if
end dibuja_ficha
procedure ini_juego
var k : int
k := 1
for i : 0 .. 6
for j : 0 .. 6
if i <= j then
juego (1, k) := i
juego (2, k) := j
k := k + 1
end if
end for
end for
for i : 1 .. 14
salieron (i) := 0
end for
end ini_juego
procedure ver_juego
for i : 1 .. 15
dibuja_ficha (juego (1, i), juego (2, i), 27 * (i - 1), 5, 1)
end for
for i : 16 .. 28
dibuja_ficha (juego (1, i), juego (2, i), 27 * (i - 15 - 1), 60 * (i div 15 + 1), 1)
end for
for i : 1 .. 7
dibuja_ficha (player (1, i), player (2, i), 27 * (i - 1), 120, 1)
end for

end ver_juego
ini_juego

function salio (x : int) : boolean
var n : int
n := 1
var r : boolean
r := false
loop
if n > 14 then
exit
end if
if salieron (n) = x then
r := true
exit
end if
n := n + 1
end loop
result r
end salio
procedure repartir
var x, k : int
k := 1
loop
randomize
randint (x, 1, 28)
if not salio (x) then
player (1, k) := juego (1, x)
player (2, k) := juego (2, x)
dibuja_ficha (player (1, k), player (2, k), 27 * (k - 1), 120, 1)
k := k + 1
salieron (k) := x
end if
if k = 8 then
exit
end if
end loop
k := 1
loop
randomize
randint (x, 1, 28)
if not salio (x) then
pc (1, k) := juego (1, x)
pc (2, k) := juego (2, x)
dibuja_ficha (pc (1, k), pc (2, k), 27 * (k - 1), 180, 1)
k := k + 1
salieron (k + 6) := x
end if
if k = 8 then
exit
end if
end loop
end repartir
repartir

No hay comentarios: