Game "Tetragon"

[timur77]

Game "Tetragon"

[timur77]

Given a field filled with colored squares of 7 colors. The player begins to play from the lower left corner, the computer from the upper right. We capture the territory by attaching near the lying squares by choosing their color.

here's a link
Tetragon_Setup

here is the code
'=========================================================
nomainwin
'вызов окна настроек
playwave ""
playwave "wav\nastr.wav", async

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
d=WindowWidth
sh=WindowHeight
[l5]
WindowWidth = 300
WindowHeight = 150
UpperLeftX = d/2-150
UpperLeftY = sh/2-75

ar$(1)="10x10"
ar$(2)="15x15"
ar$(3)="20x20"
size$="10x10"

button #n.save, "Сохранить", [exit], UL, 100, 65, 100, 25
statictext #n.st3, "Размер квадратиков", 40, 25, 110, 25
combobox #n.cb2, ar$(), [cbox2],  150, 25, 100, 25
OPEN "Настройки" FOR window AS #n
print #n, "trapclose [exit]"
#n.cb2 "selectindex 1"
wait
'=========================================================
[exit]
CLOSE #n

if size$="10x10" then goto [l1]
if size$="15x15" then goto [l2]
size$="20x20"
goto [l3]

[l1]
loadbmp "kn10","image\10Lightgray.bmp"
loadbmp "k1","image\10Red.bmp"
loadbmp "k2","image\10Orange.bmp"
loadbmp "k3","image\10Yellow.bmp"
loadbmp "k4","image\10Green.bmp"
loadbmp "k5","image\10Cyan.bmp"
loadbmp "k6","image\10Blue.bmp"
loadbmp "k7","image\10Pink.bmp"
ar=10
if sh>=480 and sh<600 then kol=42
if sh>=600 and sh<767 then kol=54
if sh>=768 and sh<1023 then kol=66
if sh>=1024 then kol=90
goto [l4]
[l2]
loadbmp "kn10","image\15Lightgray.bmp"
loadbmp "k1","image\15Red.bmp"
loadbmp "k2","image\15Orange.bmp"
loadbmp "k3","image\15Yellow.bmp"
loadbmp "k4","image\15Green.bmp"
loadbmp "k5","image\15Cyan.bmp"
loadbmp "k6","image\15Blue.bmp"
loadbmp "k7","image\15Pink.bmp"
ar=15
if sh>=480 and sh<600 then kol=28
if sh>=600 and sh<767 then kol=36
if sh>=768 and sh<1023 then kol=44
if sh>=1024 then kol=60
goto [l4]
[l3]
loadbmp "kn10","image\20Lightgray.bmp"
loadbmp "k1","image\20Red.bmp"
loadbmp "k2","image\20Orange.bmp"
loadbmp "k3","image\20Yellow.bmp"
loadbmp "k4","image\20Green.bmp"
loadbmp "k5","image\20Cyan.bmp"
loadbmp "k6","image\20Blue.bmp"
loadbmp "k7","image\20Pink.bmp"
ar=20
if sh>=480 and sh<600 then kol=21
if sh>=600 and sh<767 then kol=27
if sh>=768 and sh<1023 then kol=33
if sh>=1024 then kol=45


[l4]

'основное окно
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
UpperLeftX = 0
UpperLeftY = 0
'd=WindowWidth
'sh=WindowHeight

dim p(95,95)
dim pp(95,95)
dim ooo(8)

array$(1)="Легкий"
array$(2)="Тройная игра"
array$(3)="Ни Рыба Ни Мясо"
array$(4)="Шустрый как..."
array$(5)="Средний"
array$(6)="Трудный"
urov$="Легкий"

for i=0 to 95
for a=0 to 95
pp(a,i)=0
next a
next i

w=0'выбор компьютера
v=0'выбор игрока
o=0'очки игрока
oo=0'очки компьютера
ur=0'

loadbmp "kn1","image\Red.bmp"
loadbmp "kn2","image\Orange.bmp"
loadbmp "kn3","image\Yellow.bmp"
loadbmp "kn4","image\Green.bmp"
loadbmp "kn5","image\Cyan.bmp"
loadbmp "kn6","image\Blue.bmp"
loadbmp "kn7","image\Pink.bmp"

loadbmp "kn","image\Lightg.bmp"

statictext #t.st4, "Игрок", 15, sh/2-25, 50, 25
statictext #t.st1, "0", 15, sh/2, 50, 25
statictext #t.st5, "Компьютер", d-75, sh/2-25, 75, 25
statictext #t.st2, "0", d-75, sh/2, 75, 25

'statictext #t.st7, "вектора", d-75, 100, 75, 25'контроль параметров

button #t.plot, "Выход", [QUIT], UL, d-100, 0, 100, 25
button #t.plot2, "Новая Игра", [draw], UL, d-100, 25, 100, 25
button #t.plot3, "Настройки", [option], UL, d-100, 50, 100, 25
abc=sh-10-(sh-kol*ar)/6
bmpbutton #t.but1,"image\Red.bmp",[v1],UL, d/2-70, abc
bmpbutton #t.but2,"image\Orange.bmp",[v2],UL, d/2-50, abc
bmpbutton #t.but3,"image\Yellow.bmp",[v3],UL, d/2-30, abc
bmpbutton #t.but4,"image\Green.bmp",[v4],UL, d/2-10, abc
bmpbutton #t.but5,"image\Cyan.bmp",[v5],UL, d/2+10, abc
bmpbutton #t.but6,"image\Blue.bmp",[v6],UL, d/2+30, abc
bmpbutton #t.but7,"image\Pink.bmp",[v7],UL, d/2+50, abc
bmpbutton #t.but,"image\Name.bmp",[],UL, d/2-139, ((sh-kol*ar)/3)-20
combobox #t.cb1, array$(), [cbox],  d-100, 75, 100, 25

graphicbox #t.g, d/2-kol*ar/2, 2*(sh-kol*ar)/3, kol*ar, kol*ar

OPEN "Тетрагон" FOR window_popup AS #t
print #t, "trapclose [QUIT]"
print #t.but, "disable"
#t.cb1 "selectindex 1"

'wait
'=========================================================
[draw]
playwave ""
playwave "wav\theme.wav", loop

print #t.but1,"bitmap kn1"
print #t.but2,"bitmap kn2"
print #t.but3,"bitmap kn3"
print #t.but4,"bitmap kn4"
print #t.but5,"bitmap kn5"
print #t.but6,"bitmap kn6"
print #t.but7,"bitmap kn7"

print #t.but1, "enable"
print #t.but2, "enable"
print #t.but3, "enable"
print #t.but4, "enable"
print #t.but5, "enable"
print #t.but6, "enable"
print #t.but7, "enable"

print #t.cb1, "enable"

print #t.g, "drawbmp k1 ";0;" ";0'ненужная строка но устроняет маленький баг

for i=0 to kol-1'y
for a=0 to kol-1'x

cb=int(rnd(1)*7+1)
p(a+1,i+1)=cb'массив значений на поле
select case cb
   case 1
       print #t.g, "drawbmp k1 ";a*ar;" ";i*ar
   case 2
       print #t.g, "drawbmp k2 ";a*ar;" ";i*ar
   case 3
       print #t.g, "drawbmp k3 ";a*ar;" ";i*ar
   case 4
       print #t.g, "drawbmp k4 ";a*ar;" ";i*ar
   case 5
       print #t.g, "drawbmp k5 ";a*ar;" ";i*ar
   case 6
       print #t.g, "drawbmp k6 ";a*ar;" ";i*ar
   case 7
       print #t.g, "drawbmp k7 ";a*ar;" ";i*ar
   case else
end select
next a
next i
print #t.g, "drawbmp kn10 ";ar*(kol-1);" ";0
print #t.g, "drawbmp kn10 ";0;" ";ar*(kol-1)
p(kol,1)=9
p(1,kol)=8

#t.g "flush"'закрепление что бы было видно
wait
'=========================================================
[cbox2]
#n.cb2 "selection? size$"
'print #n.cb2, "disable"
wait
'=========================================================
[cbox]
#t.cb1 "selection? urov$"
print #t.cb1, "disable"
wait
'=========================================================
[QUIT]
playwave ""
CLOSE #t
END
'=========================================================
'выбор игрока
[v1]
v=1
goto [v]
[v2]
v=2
goto [v]
[v3]
v=3
goto [v]
[v4]
v=4
goto [v]
[v5]
v=5
goto [v]
[v6]
v=6
goto [v]
[v7]
v=7
[v]

print #t.cb1, "disable"

if w<>1 then print #t.but1, "enable":print #t.but1,"bitmap kn1"
if w<>2 then print #t.but2, "enable":print #t.but2,"bitmap kn2"
if w<>3 then print #t.but3, "enable":print #t.but3,"bitmap kn3"
if w<>4 then print #t.but4, "enable":print #t.but4,"bitmap kn4"
if w<>5 then print #t.but5, "enable":print #t.but5,"bitmap kn5"
if w<>6 then print #t.but6, "enable":print #t.but6,"bitmap kn6"
if w<>7 then print #t.but7, "enable":print #t.but7,"bitmap kn7"

if v=1 then print #t.but1,"bitmap kn":print #t.but1, "disable"
if v=2 then print #t.but2,"bitmap kn":print #t.but2, "disable"
if v=3 then print #t.but3,"bitmap kn":print #t.but3, "disable"
if v=4 then print #t.but4,"bitmap kn":print #t.but4, "disable"
if v=5 then print #t.but5,"bitmap kn":print #t.but5, "disable"
if v=6 then print #t.but6,"bitmap kn":print #t.but6, "disable"
if v=7 then print #t.but7,"bitmap kn":print #t.but7, "disable"
[m3]
r=0'контроль полноты
for i=kol to 1 step -1
for a=1 to kol
if p(a,i)<>v and p(a,i)<>8 then [m1]
if p(a,i)=8 then drw=v:gosub [m2]:p(a,i)=18:goto [m1]
if p(a+1,i)=8 or p(a-1,i)=8 or p(a,i+1)=8 or p(a,i-1)=8 or p(a+1,i)=18 or p(a-1,i)=18 or p(a,i+1)=18 or p(a,i-1)=18 then p(a,i)=18:r=r+1
[m1]
next a
next i
if r>0 then goto [m3]

o=0
for i=kol to 1 step -1
for a=1 to kol
if p(a,i)=18 or p(a,i)=8 then p(a,i)=8:o=o+1
next a
next i
print #t.st1,str$(o)
if oo+o=kol*kol then [finish]

'ход компьютера
if urov$="Легкий" then gosub [easy]

if urov$="Тройная игра" then urov$="Трой"
if urov$="игра" then urov$="Трой":gosub [meadle]:goto[uroven]
if urov$="Тройная" then urov$="игра":gosub [easy]:goto[uroven]
if urov$="Трой" then urov$="Тройная":gosub [easy]:goto[uroven]

if urov$="Ни Рыба Ни Мясо" then urov$="Рыба"
if urov$="Мясо" then urov$="Рыба":gosub [meadle]:goto[uroven]
if urov$="Рыба" then urov$="Мясо":gosub [easy]:goto[uroven]


if urov$="Шустрый как..." then urov$="Шуст"
if urov$="Шустрый как" then urov$="Шуст":gosub [meadle]:goto[uroven]
if urov$="Шустрый" then urov$="Шустрый как":gosub [meadle]:goto[uroven]
if urov$="Шуст" then urov$="Шустрый":gosub [easy]:goto[uroven]

if urov$="Средний" then gosub [meadle]:goto[uroven]

if urov$="Трудный" and kk>sqr(kol*kol*2)*0.75 then gosub [hard1]:goto[uroven]
if urov$="Трудный" then urov$="Тр"
if urov$="дн" then urov$="Тр":gosub [hard2]:goto[uroven]
if urov$="Тр" then urov$="дн":gosub [hard3]

[uroven]
if v<>1 then print #t.but1, "enable":print #t.but1,"bitmap kn1"
if v<>2 then print #t.but2, "enable":print #t.but2,"bitmap kn2"
if v<>3 then print #t.but3, "enable":print #t.but3,"bitmap kn3"
if v<>4 then print #t.but4, "enable":print #t.but4,"bitmap kn4"
if v<>5 then print #t.but5, "enable":print #t.but5,"bitmap kn5"
if v<>6 then print #t.but6, "enable":print #t.but6,"bitmap kn6"
if v<>7 then print #t.but7, "enable":print #t.but7,"bitmap kn7"

if w=1 then print #t.but1,"bitmap kn":print #t.but1, "disable"
if w=2 then print #t.but2,"bitmap kn":print #t.but2, "disable"
if w=3 then print #t.but3,"bitmap kn":print #t.but3, "disable"
if w=4 then print #t.but4,"bitmap kn":print #t.but4, "disable"
if w=5 then print #t.but5,"bitmap kn":print #t.but5, "disable"
if w=6 then print #t.but6,"bitmap kn":print #t.but6, "disable"
if w=7 then print #t.but7,"bitmap kn":print #t.but7, "disable"
[m6]
r=0'контроль полноты
for i=1 to kol
for a=kol to 1 step -1
if p(a,i)=9 then drw=w:gosub [m2]:p(a,i)=19:goto [m4]
if p(a,i)<>w then [m4]
if p(a+1,i)=9 or p(a-1,i)=9 or p(a,i+1)=9 or p(a,i-1)=9 or p(a+1,i)=19 or p(a-1,i)=19 or p(a,i+1)=19 or p(a,i-1)=19 then p(a,i)=19:r=r+1
[m4]
next a
next i
if r>0 then goto [m6]

oo=0
for i=1 to kol
for a=kol to 1 step -1
if p(a,i)=19 then p(a,i)=9:oo=oo+1
next a
next i
print #t.st2,str$(oo)
'print #t.st7,str$(kk)

if oo+o=kol*kol then [finish]

#t.g "flush"'закрепление что бы было видно
wait
'=========================================================
[easy]
ww=int(rnd(1)*7+1)
if ww=w then goto [easy]
if ww=v then goto [easy]
w=ww
return
'=========================================================
[meadle]
for i=0 to 7
ooo(i)=0'подготовка массива сбора предварительных результатов
next i

for ww=1 to 7

if ww=w then goto [7]
if ww=v then goto [7]

for i=0 to 95
for a=0 to 95
pp(a,i)=p(a,i)'перенос поля в массив предварительного хода
next a
next i

[m9]
r=0'контроль полноты
for i=1 to kol
for a=kol to 1 step -1
if pp(a,i)=9 then pp(a,i)=19:goto [m8]
if pp(a,i)<>ww then [m8]
if pp(a+1,i)=9 or pp(a-1,i)=9 or pp(a,i+1)=9 or pp(a,i-1)=9 or pp(a+1,i)=19 or pp(a-1,i)=19 or pp(a,i+1)=19 or pp(a,i-1)=19 then pp(a,i)=19:r=r+1
[m8]
next a
next i
if r>0 then goto [m9]


for i=1 to kol
for a=kol to 1 step -1
if pp(a,i)=19 then pp(a,i)=9:ooo(ww)=ooo(ww)+1
next a
next i
[7]
next ww

www=0'ход с максимальным результатом
kk=0'контроль количества
for i=1 to 7
if i=w then goto [m10]
if i=v then goto [m10]
if ooo(i)>kk then www=i:kk=ooo(i)'выбор максимального
[m10]
next i
if www=0 then gosub [easy] else w=www
if kk=oo then gosub [easy]
return

'=========================================================
[m2]
select case drw
   case 1
       print #t.g, "drawbmp k1 ";(a-1)*ar;" ";(i-1)*ar
   case 2
       print #t.g, "drawbmp k2 ";(a-1)*ar;" ";(i-1)*ar
   case 3
       print #t.g, "drawbmp k3 ";(a-1)*ar;" ";(i-1)*ar
   case 4
       print #t.g, "drawbmp k4 ";(a-1)*ar;" ";(i-1)*ar
   case 5
       print #t.g, "drawbmp k5 ";(a-1)*ar;" ";(i-1)*ar
   case 6
       print #t.g, "drawbmp k6 ";(a-1)*ar;" ";(i-1)*ar
   case 7
       print #t.g, "drawbmp k7 ";(a-1)*ar;" ";(i-1)*ar
   case else
end select
return
'=========================================================
[finish]
playwave ""
if o>oo then playwave "wav\viigr.wav", async:notice "Это Победа!"
if o<oo then playwave "wav\Proigral.wav", async:notice "Полное Поражение!"
if o=oo then playwave "wav\nich.wav", async:notice "Боевая Ничья-Это Чудо!"
wait
'=========================================================
[option]
CLOSE #t
goto [l5]
'=========================================================
[hard1]
for i=0 to 7
ooo(i)=0'подготовка массива сбора предварительных результатов
voo(i)=10000'подготовка массива сбора максимальных векторов
next i

for ww=1 to 7

if ww=w then goto [h7]
if ww=v then goto [h7]

for i=0 to 95
for a=0 to 95
pp(a,i)=p(a,i)'перенос поля в массив предварительного хода
next a
next i

vo=10000'максимальный вектор
[h9]
r=0'контроль полноты
for i=1 to kol
for a=kol to 1 step -1
if pp(a,i)=9 then pp(a,i)=19:goto [h8]
if pp(a,i)<>ww then [h8]
if pp(a+1,i)=9 or pp(a-1,i)=9 or pp(a,i+1)=9 or pp(a,i-1)=9 or pp(a+1,i)=19 or pp(a-1,i)=19 or pp(a,i+1)=19 or pp(a,i-1)=19 then pp(a,i)=19:r=r+1 else goto [h8]

vo=sqr(a*a+(kol-i)*(kol-i))'расчет вектора
if vo<voo(ww) then voo(ww)=vo'поиск максимального вектора

[h8]
next a
next i
if r>0 then goto [h9]


for i=1 to kol
for a=kol to 1 step -1
if pp(a,i)=19 then pp(a,i)=9:ooo(ww)=ooo(ww)+1
next a
next i
[h7]
next ww

www=0'ход с максимальным вектором
kk=10000'контроль количества
for i=1 to 7
if i=w then goto [h10]
if i=v then goto [h10]
if voo(i)<kk and ooo(i)>oo then www=i:kk=voo(i)'выбор хода с максимальным вектором
[h10]
next i
if www=0 then gosub [meadle] else w=www
'if kk=oo then gosub [easy]
return
'=========================================================
[hard2]
for i=0 to 7
ooo(i)=0'подготовка массива сбора предварительных результатов
voo(i)=10000'подготовка массива сбора максимальных векторов
next i

for ww=1 to 7

if ww=w then goto [hh7]
if ww=v then goto [hh7]

for i=0 to 95
for a=0 to 95
pp(a,i)=p(a,i)'перенос поля в массив предварительного хода
next a
next i

vo=10000'максимальный вектор
[hh9]
r=0'контроль полноты
for i=1 to kol
for a=kol to 1 step -1
if pp(a,i)=9 then pp(a,i)=19:goto [hh8]
if pp(a,i)<>ww then [hh8]
if pp(a+1,i)=9 or pp(a-1,i)=9 or pp(a,i+1)=9 or pp(a,i-1)=9 or pp(a+1,i)=19 or pp(a-1,i)=19 or pp(a,i+1)=19 or pp(a,i-1)=19 then pp(a,i)=19:r=r+1 else goto [hh8]

vo=sqr((abs(kol*0.75-a))^2+(kol*1.5-i)^2)'расчет вектора
if vo<voo(ww) then voo(ww)=vo'поиск максимального вектора

[hh8]
next a
next i
if r>0 then goto [hh9]


for i=1 to kol
for a=kol to 1 step -1
if pp(a,i)=19 then pp(a,i)=9:ooo(ww)=ooo(ww)+1
next a
next i
[hh7]
next ww

www=0'ход с максимальным вектором
kk=10000'контроль количества
for i=1 to 7
if i=w then goto [hh10]
if i=v then goto [hh10]
if voo(i)<kk and ooo(i)>oo then www=i:kk=voo(i)'выбор хода с максимальным вектором
[hh10]
next i
if www=0 then gosub [meadle] else w=www
'if kk=oo then gosub [easy]
return
'=========================================================
[hard3]
for i=0 to 7
ooo(i)=0'подготовка массива сбора предварительных результатов
voo(i)=10000'подготовка массива сбора максимальных векторов
next i

for ww=1 to 7

if ww=w then goto [h37]
if ww=v then goto [h37]

for i=0 to 95
for a=0 to 95
pp(a,i)=p(a,i)'перенос поля в массив предварительного хода
next a
next i

vo=10000'максимальный вектор
[h39]
r=0'контроль полноты
for i=1 to kol
for a=kol to 1 step -1
if pp(a,i)=9 then pp(a,i)=19:goto [h38]
if pp(a,i)<>ww then [h38]
if pp(a+1,i)=9 or pp(a-1,i)=9 or pp(a,i+1)=9 or pp(a,i-1)=9 or pp(a+1,i)=19 or pp(a-1,i)=19 or pp(a,i+1)=19 or pp(a,i-1)=19 then pp(a,i)=19:r=r+1 else goto [h38]

vo=sqr((kol*0.25+a)^2+(abs(kol/2-i))^2)'расчет вектора
if vo<voo(ww) then voo(ww)=vo'поиск максимального вектора

[h38]
next a
next i
if r>0 then goto [h39]


for i=1 to kol
for a=kol to 1 step -1
if pp(a,i)=19 then pp(a,i)=9:ooo(ww)=ooo(ww)+1
[h3max]
next a
next i
[h37]
next ww

www=0'ход с максимальным вектором
kk=10000'контроль количества
for i=1 to 7
if i=w then goto [h310]
if i=v then goto [h310]
if voo(i)<kk and ooo(i)>oo then www=i:kk=voo(i)'выбор хода с максимальным вектором
[h310]
next i
if www=0 then gosub [meadle] else w=www
'if kk=oo then gosub [easy]
return
'=========================================================