timur77
Junior Member
Someday I will tell my grandsons that I am older than the Internet. And it will blow their brain.
Posts: 79
|
Post by timur77 on Apr 2, 2020 3:15:18 GMT -5
Corrected all headers and pictures from the Cyrillic alphabet to the Latin alphabet here's a link Batle Seahere is the code nomainwin
'=========================================================
loadbmp "fon","image\fon.bmp"
loadbmp "s11","image\11.bmp"
loadbmp "s12","image\12.bmp"
loadbmp "s13","image\13.bmp"
loadbmp "s14","image\14.bmp"
loadbmp "s15","image\15.bmp"
loadbmp "s16","image\16.bmp"
loadbmp "s21","image\21.bmp"
loadbmp "s31","image\31.bmp"
loadbmp "s41","image\41.bmp"
loadbmp "s51","image\51.bmp"
loadbmp "s61","image\61.bmp"
loadbmp "s17","image\17.bmp"
loadbmp "s71","image\71.bmp"
loadbmp "ran","image\ran.bmp"
loadbmp "ubit","image\ubit.bmp"
loadbmp "ubitt","image\ubitt.bmp"
loadbmp "mim","image\mim.bmp"
loadbmp "rp","image\rp.bmp"
loadbmp "pr","image\pr.bmp"
loadbmp "ig","image\ig.bmp"
loadbmp "cr","image\ccr.bmp"
dim namer1$(11),snir1(11),namer2$(11),strr2(11),namer3$(11),hapr3(11)
dim spuk$(600)
data "fon", "s11", "s12", "s13", "s14", "s21", "s31", "s41", "s15", "s51", "s16", "s61", "s17", "s71", "ubit", "ubitt", "ran", "ubit", "mim"
read buf$
spuk$(0)=buf$
read buf$
spuk$(111)=buf$
read buf$
spuk$(112)=buf$
read buf$
spuk$(113)=buf$
read buf$
spuk$(114)=buf$
read buf$
spuk$(121)=buf$
read buf$
spuk$(131)=buf$
read buf$
spuk$(141)=buf$
read buf$
spuk$(115)=buf$
read buf$
spuk$(151)=buf$
read buf$
spuk$(116)=buf$
read buf$
spuk$(161)=buf$
read buf$
spuk$(117)=buf$
read buf$
spuk$(171)=buf$
read buf$
spuk$(301)=buf$
read buf$
spuk$(302)=buf$
read buf$
spuk$(300)=buf$
read buf$
spuk$(500)=buf$
read buf$
spuk$(200)=buf$
spuk$(1)=spuk$(0)
spuk$(201)=spuk$(200)
dim mkor(9,9)'массив текущего корабля
dim mkorp(9,9)
dim kx(171),ky(171)'размеры массива корабля по типам
kx(171)=3:ky(171)=9:kx(117)=9:ky(117)=3
kx(161)=3:ky(161)=8:kx(116)=8:ky(116)=3
kx(151)=3:ky(151)=7:kx(115)=7:ky(115)=3
kx(141)=3:ky(141)=6:kx(114)=6:ky(114)=3
kx(131)=3:ky(131)=5:kx(113)=5:ky(113)=3
kx(121)=3:ky(121)=4:kx(112)=4:ky(112)=3
kx(111)=3:ky(111)=3
dim kar1(50,50),kar2(50,50)'поле игрока и компьютера
dim kar1d(50,50),kar2d(50,50)'поле временно
for i=0 to 50
for a=0 to 50
kar1(i,a)=0
kar2(i,a)=0
kar1d(i,a)=0
next a
next i
dim korabl(20,30)'порядок расстановки кораблей
data 117,116,116,115,115,115,114,114,114,114,113,113,113,113,113,112,112,112,112,112,112,111,111,111,111,111,111,111
for i=1 to 28
read buf
korabl(20,i)=buf
next i
data 116,115,115,114,114,114,113,113,113,113,112,112,112,112,112,111,111,111,111,111,111
for i=1 to 21
read buf
korabl(17,i)=buf
next i
data 115,114,114,113,113,113,112,112,112,112,111,111,111,111,111
for i=1 to 15
read buf
korabl(14,i)=buf
next i
data 114,113,113,112,112,112,111,111,111,111
for i=1 to 10
read buf
korabl(10,i)=buf
next i
dim korablp(15)'проверка кораблей
data 117,171,116,161,115,151,114,141,113,131,112,121,111
i=0
[p1]
i=i+1
read buf
korablp(i)=buf
if i<13 then goto [p1]
dim koltip(7,2)'количество кораблей по типу
ks=10'предел счетчика расставленных
size$="10x10"'выбранный по умолчанию размер поля
name$="Gamer"
creat=0
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
'определение текущих параметров экрана
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
d=WindowWidth
sh=WindowHeight
UpperLeftX = 0
UpperLeftY = 0
TextboxColor$ = "black"
ComboboxColor$ = "black"
BackgroundColor$ = "black"
ForegroundColor$ = "green"
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
if d>=600 and d<840 then ar$(1)="10x10"
if d>=840 and d<1020 then ar$(1)="10x10":ar$(2)="14x14"
if d>=1020 and d<1200 then ar$(1)="10x10":ar$(2)="14x14":ar$(3)="17x17"
if d>=1200 then ar$(1)="10x10":ar$(2)="14x14":ar$(3)="17x17":ar$(4)="20x20"
if d<=640 then loadbmp "bg","image\bg640.bmp":loadbmp "bg2","image\bg2640.bmp"
if d>640 and d<=800 then loadbmp "bg","image\bg800.bmp":loadbmp "bg2","image\bg2800.bmp"
if d>800 and d<=1024 then loadbmp "bg","image\bg1024.bmp":loadbmp "bg2","image\bg21024.bmp"
if d>1024 then loadbmp "bg","image\bg1280.bmp":loadbmp "bg2","image\bg21280.bmp"
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
[m1]
oi=0:ok=0
sni1=0:sni2=0:str=0:hap=0
sni=(sni1+0/0001)*10/(sni2+0.001)
ch=1'счетчик расставленных
koltip(1,2)=0
koltip(2,2)=0
koltip(3,2)=0
koltip(4,2)=0
koltip(5,2)=0
koltip(6,2)=0
koltip(7,2)=0
koltip(1,1)=0
koltip(2,1)=0
koltip(3,1)=0
koltip(4,1)=0
koltip(5,1)=0
koltip(6,1)=0
koltip(7,1)=0
bmpbutton #n.b1, "image\Play.bmp", [game], UL, d/2-87, sh-500
bmpbutton #n.b1, "image\Exit.bmp", [QUIT], UL, d/2-87, sh-75
bmpbutton #n.b1, "image\Rec.bmp", [records], UL, d/2-87, sh-325
combobox #n.cb2, ar$(), [selekt], d/2-87,sh-350, 175, 25
textbox #n.t1, d/2-87, sh-175, 175, 25
bmpbutton #n.b1, "image\Cr.bmp", [Cr], UL, d/2-87, sh-150
graphicbox #n.bg, 0, 0, d, sh
'вызов окна настроек
OPEN "Menyu" FOR window_popup AS #n
print #n, "font courier new 12";
print #n.bg, "drawbmp bg2 ";(d-1280);" ";0
print #n.bg, "drawbmp bg2 ";0;" ";0'устраняет глюк
print #n.bg, "drawbmp rp ";d/2-87;" ";sh-425
print #n.bg, "drawbmp ig ";d/2-87;" ";sh-250
print #n.t1, name$
print #n, "trapclose [QUIT]"
if size$="10x10" then #n.cb2 "selectindex 1"
if size$="14x14" then #n.cb2 "selectindex 2"
if size$="17x17" then #n.cb2 "selectindex 3"
if size$="20x20" then #n.cb2 "selectindex 4"
#n.bg "flush"
wait
'=========================================================
[selekt]
#n.cb2 "selection? size$"
wait
'=========================================================
[game]
print #n.t1, "!contents? name$"
if len(name$)>9 then name$=mid$(name$,1,9)
CLOSE #n
if size$="10x10" then raz=10:ks=10:str=100:hap=20
if size$="14x14" then raz=14:ks=15:str=196:hap=35
if size$="17x17" then raz=17:ks=21:str=289:hap=56
if size$="20x20" then raz=20:ks=28:str=400:hap=84
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
[drawo]
UpperLeftX = 0
UpperLeftY = 0
WindowWidth = d
WindowHeight = sh
BackgroundColor$ = "black"
bmpbutton #t.g3, "image\NewGame.bmp", [drawc], UL, 0, sh-75
bmpbutton #t.g4, "image\Menyu.bmp", [option], UL, d-175, sh-75
graphicbox #t.g1, d/2-raz*30,0, raz*30, raz*30'поле игрока
graphicbox #t.g2, d/2,0, raz*30, raz*30 'поле компьютера
graphicbox #t.g3, 0, sh-75, 175, 75 'поле кнопки Новая Игра
graphicbox #t.g4, d-175, sh-75, 175, 75 'поле кнопки Меню
graphicbox #t.g5, 10, sh-168, 125, 88 'поле очков
graphicbox #t.g6, d-165, sh-95, 125, 15 'поле очков
graphicbox #t.g7, 0, 0, d, sh 'фон
OPEN "Batle Sea" FOR window_popup AS #t
print #t, "font courier new 12";
print #t.g5, "font courier new 12";
print #t.g6, "font courier new 12";
print #t.g7, "font courier new 12";
print #t.g7, "drawbmp bg ";(d-1280);" ";0
print #t.g7, "drawbmp bg ";0;" ";0
print #t.g5, "backcolor black"
print #t.g6, "backcolor black"
print #t.g7, "backcolor black"
print #t.g5, "color green"
print #t.g6, "color green"
print #t.g7, "color green"
print #t.g5, "set 0 10"
print #t.g5, "\";name$;" "
print #t.g5, "\ShpsLft ";ks-ok;" "
print #t.g5, "\Sniper ";sni;" "
print #t.g5, "\Strateg ";str;" "
print #t.g5, "\Lucky ";hap;" "
print #t.g6, "set 0 10"
print #t.g6, "\Computer ";ks-oi;" "
gosub [koltip1]
gosub [koltip2]
print #t.g7, "drawbmp s11 ";d/2-15;" ";sh-30
print #t.g7, "drawbmp s12 ";d/2-30;" ";sh-60
print #t.g7, "drawbmp s13 ";d/2-45;" ";sh-90
print #t.g7, "drawbmp s14 ";d/2-60;" ";sh-120
if size$="10x10" then goto [rkt3]
print #t.g7, "drawbmp s15 ";d/2-75;" ";sh-150
if size$="14x14" then goto [rkt3]
print #t.g7, "drawbmp s16 ";d/2-90;" ";sh-180
if size$="17x17" then goto [rkt3]
print #t.g7, "drawbmp s17 ";d/2-105;" ";sh-210
[rkt3]
print #t, "trapclose [QUIT]"
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
print #t.g1, "when mouseMove [draw2]"
print #t.g1, "when rightButtonDown [tune]"
print #t.g1, "when leftButtonDown [set]"
print #t.g2, "when mouseMove [draw3]"
print #t.g2, "when leftButtonDown [fire]"
print #t.g2, "when rightButtonDown [fire]"
#t.g7 "flush"'закрепление что бы было видно
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
[draw]
i=0:a=0
for i=0 to 50
for a=0 to 50
kar1(i,a)=0
kar2(i,a)=0
kar1d(i,a)=0
kar1(i,a)=0
kar2(i,a)=0
kar1d(i,a)=0
next a
next i
i=0:a=0
for i=0 to raz+1'y
for a=0 to raz+1'x
print #t.g1, "drawbmp ";spuk$(0);" ";(a-1)*30;" ";(i-1)*30
next a
next i
i=0:a=0
for i=0 to raz+1'y
for a=0 to raz+1'x
print #t.g2, "drawbmp ";spuk$(0);" ";(a-1)*30;" ";(i-1)*30
next a
next i
#t.g1 "flush"'закрепление что бы было видно
#t.g2 "flush"
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
'расстановка кораблей компьютером
ch=0
[next]
ch=ch+1
[resiv]
ran=rnd(1)
if ran<0.45 then x=int(rnd(1)*raz*0.3+1)
if ran>=0.45 and ran<0.55 then x=int(rnd(1)*raz*0.4+1+raz*0.3)
if ran>=0.55 then x=int(rnd(1)*raz*0.3+1+raz*0.7)
ran=rnd(1)
if ran<0.45 then y=int(rnd(1)*raz*0.3+1)
if ran>=0.45 and ran<0.55 then y=int(rnd(1)*raz*0.4+1+raz*0.3)
if ran>=0.55 then y=int(rnd(1)*raz*0.3+1+raz*0.7)
if rnd(1)>0.5 then goto [tuneR2]
[jumpR2]
'обновление массива корабля на случай поворота
i=-1
[next5]
i=i+1
a=-1
[next6]
a=a+1
mkor(a,i)=1
if i>0 and a>0 and i<ky(korabl(raz,ch))-1 and a<kx(korabl(raz,ch))-1 then mkor(a,i)=11
if a<kx(korabl(raz,ch))-1 then goto [next6]
if i<ky(korabl(raz,ch))-1 then goto [next5]
mkor(1,1)=korabl(raz,ch)
'возможноли поставить на поле
if x+kx(korabl(raz,ch))-3>raz then goto [resiv]
if y+ky(korabl(raz,ch))-3>raz then goto [resiv]
i=0
[next1]
i=i+1
a=0
[next2]
a=a+1
if kar2(x-1+a,y-1+i)=1 then goto [resiv]
if kar2(x-1+a,y-1+i)=11 then goto [resiv]
if a<kx(korabl(raz,ch))-2 then goto [next2]
if i<ky(korabl(raz,ch))-2 then goto [next1]
if kar2(x,y)>100 or kar2(x,y)=11 then goto [resiv]
'вписывание корабля в массив поля
i=-1
[next3]
i=i+1
a=-1
[next4]
a=a+1
kar2(x-1+a,y-1+i)=mkor(a,i)
if a<kx(korabl(raz,ch))-1 then goto [next4]
if i<ky(korabl(raz,ch))-1 then goto [next3]
'обновление поля
i=-1
[next7]
i=i+1
a=-1
[next8]
a=a+1
if kar2(a,i)=11 then goto [jumpR]
'print #t.g2, "drawbmp ";spuk$(kar2(a,i));" ";(a-1)*30;" ";(i-1)*30
[jumpR]
if a<raz+1 then goto [next8]
if i<raz+1 then goto [next7]
if korabl(raz,ch)=117 or korabl(raz,ch)=171 then koltip(7,2)=koltip(7,2)+1
if korabl(raz,ch)=116 or korabl(raz,ch)=161 then koltip(6,2)=koltip(6,2)+1
if korabl(raz,ch)=115 or korabl(raz,ch)=151 then koltip(5,2)=koltip(5,2)+1
if korabl(raz,ch)=114 or korabl(raz,ch)=141 then koltip(4,2)=koltip(4,2)+1
if korabl(raz,ch)=113 or korabl(raz,ch)=131 then koltip(3,2)=koltip(3,2)+1
if korabl(raz,ch)=112 or korabl(raz,ch)=121 then koltip(2,2)=koltip(2,2)+1
if korabl(raz,ch)=111 then koltip(1,2)=koltip(1,2)+1
gosub [koltip2]
#t.g2 "flush"'закрепление что бы было видно
if ch<ks then goto [next]
'обновление массива кораблей для игрока
ch=1
for i=0 to ky(korabl(raz,ch))-1
for a=0 to kx(korabl(raz,ch))-1
mkor(a,i)=1
if i>0 and a>0 and i<ky(korabl(raz,ch))-1 and a<kx(korabl(raz,ch))-1 then mkor(a,i)=11
next a
next i
mkor(1,1)=korabl(raz,ch)
wait
'=========================================================
[koltip1]
print #t.g7, "set ";d/2-115;" ";sh-8
print #t.g7, "\";koltip(1,1)
print #t.g7, "set ";d/2-115;" ";sh-38
print #t.g7, "\";koltip(2,1)
print #t.g7, "set ";d/2-115;" ";sh-68
print #t.g7, "\";koltip(3,1)
print #t.g7, "set ";d/2-115;" ";sh-98
print #t.g7, "\";koltip(4,1)
if size$="10x10" then goto [rkt4]
print #t.g7, "set ";d/2-115;" ";sh-128
print #t.g7, "\";koltip(5,1)
if size$="14x14" then goto [rkt4]
print #t.g7, "set ";d/2-115;" ";sh-158
print #t.g7, "\";koltip(6,1)
if size$="17x17" then goto [rkt4]
print #t.g7, "set ";d/2-115;" ";sh-188
print #t.g7, "\";koltip(7,1)
[rkt4]
#t.g7 "flush"
return
'=========================================================
[koltip2]
print #t.g7, "set ";d/2+105;" ";sh-8
print #t.g7, "\";koltip(1,2)
print #t.g7, "set ";d/2+105;" ";sh-38
print #t.g7, "\";koltip(2,2)
print #t.g7, "set ";d/2+105;" ";sh-68
print #t.g7, "\";koltip(3,2)
print #t.g7, "set ";d/2+105;" ";sh-98
print #t.g7, "\";koltip(4,2)
if size$="10x10" then goto [rkt5]
print #t.g7, "set ";d/2+105;" ";sh-128
print #t.g7, "\";koltip(5,2)
if size$="14x14" then goto [rkt5]
print #t.g7, "set ";d/2+105;" ";sh-158
print #t.g7, "\";koltip(6,2)
if size$="17x17" then goto [rkt5]
print #t.g7, "set ";d/2+105;" ";sh-188
print #t.g7, "\";koltip(7,2)
[rkt5]
#t.g7 "flush"
return
'=========================================================
[drawc]
koltip(1,2)=0
koltip(2,2)=0
koltip(3,2)=0
koltip(4,2)=0
koltip(5,2)=0
koltip(6,2)=0
koltip(7,2)=0
koltip(1,1)=0
koltip(2,1)=0
koltip(3,1)=0
koltip(4,1)=0
koltip(5,1)=0
koltip(6,1)=0
koltip(7,1)=0
oi=0:ok=0
sni1=0:sni2=0:str=0
if size$="10x10" then hap=20
if size$="14x14" then hap=35
if size$="17x17" then hap=56
if size$="20x20" then hap=84
CLOSE #t
goto [drawo]
'=========================================================
[tuneR2]
if korabl(raz,ch)=112 then korabl(raz,ch)=121 else if korabl(raz,ch)=121 then korabl(raz,ch)=112
if korabl(raz,ch)=113 then korabl(raz,ch)=131 else if korabl(raz,ch)=131 then korabl(raz,ch)=113
if korabl(raz,ch)=114 then korabl(raz,ch)=141 else if korabl(raz,ch)=141 then korabl(raz,ch)=114
if korabl(raz,ch)=115 then korabl(raz,ch)=151 else if korabl(raz,ch)=151 then korabl(raz,ch)=115
if korabl(raz,ch)=116 then korabl(raz,ch)=161 else if korabl(raz,ch)=161 then korabl(raz,ch)=116
if korabl(raz,ch)=117 then korabl(raz,ch)=171 else if korabl(raz,ch)=171 then korabl(raz,ch)=117
goto [jumpR2]
'=========================================================
[QUIT]
CLOSE #n
unloadbmp "fon"
unloadbmp "s11"
unloadbmp "s12"
unloadbmp "s13"
unloadbmp "s14"
unloadbmp "s21"
unloadbmp "s31"
unloadbmp "s41"
unloadbmp "s15"
unloadbmp "s51"
unloadbmp "s16"
unloadbmp "s61"
unloadbmp "s17"
unloadbmp "s71"
unloadbmp "ran"
unloadbmp "ubit"
unloadbmp "mim"
unloadbmp "rp"
if creat=1 then CLOSE #c
END
'=========================================================
[option]
CLOSE #t
goto [m1]
'=========================================================
[tune]
if ch>ks then wait
if korabl(raz,ch)=112 then korabl(raz,ch)=121 else if korabl(raz,ch)=121 then korabl(raz,ch)=112
if korabl(raz,ch)=113 then korabl(raz,ch)=131 else if korabl(raz,ch)=131 then korabl(raz,ch)=113
if korabl(raz,ch)=114 then korabl(raz,ch)=141 else if korabl(raz,ch)=141 then korabl(raz,ch)=114
if korabl(raz,ch)=115 then korabl(raz,ch)=151 else if korabl(raz,ch)=151 then korabl(raz,ch)=115
if korabl(raz,ch)=116 then korabl(raz,ch)=161 else if korabl(raz,ch)=161 then korabl(raz,ch)=116
if korabl(raz,ch)=117 then korabl(raz,ch)=171 else if korabl(raz,ch)=171 then korabl(raz,ch)=117
for i=0 to ky(korabl(raz,ch))-1
for a=0 to kx(korabl(raz,ch))-1
mkor(a,i)=1
if i>0 and a>0 and i<ky(korabl(raz,ch))-1 and a<kx(korabl(raz,ch))-1 then mkor(a,i)=11
next a
next i
mkor(1,1)=korabl(raz,ch)
goto [draw21]
[draw2]
if ch>ks then wait
xj=int(MouseX/30)+1
yj=int(MouseY/30)+1
if xj=x and yj=y then wait else x=xj:y=yj
[draw21]
'- - - - - - - - - - - - - - - - - - - -
if x+kx(korabl(raz,ch))-3>raz then wait
if y+ky(korabl(raz,ch))-3>raz then wait
'- - - - - - - - - - - - - - - - - - - -
for i=0 to raz+1'y
for a=0 to raz+1'x
if kar1(a,i)=11 then goto [jump2]
print #t.g1, "drawbmp ";spuk$(kar1(a,i));" ";(a-1)*30;" ";(i-1)*30
[jump2]
next a
next i
kar1d(x,y)=korabl(raz,ch)
print #t.g1, "drawbmp ";spuk$(kar1d(x,y));" ";(x-1)*30;" ";(y-1)*30
#t.g1 "flush"'закрепление что бы было видно
wait
'=========================================================
[draw3]
if ch<=ks then wait
if int(MouseX/30)+1=x and int(MouseY/30)+1=y then wait else x=int(MouseX/30)+1:y=int(MouseY/30)+1
if kar2(x,y)>=200 then wait
if kar2(xg,yg)<200 then print #t.g2, "drawbmp ";spuk$(0);" ";(xg-1)*30;" ";(yg-1)*30 else print #t.g2, "drawbmp ";spuk$(kar2(xg,yg));" ";(xg-1)*30;" ";(yg-1)*30
'if kar2(xg,yg)<111 and kar2(xg,yg)>199 then
xg=x
yg=y
print #t.g2, "drawbmp pr ";(xg-1)*30;" ";(yg-1)*30
#t.g2 "flush"'закрепление что бы было видно
wait
'=========================================================
[set]
if ch>ks then wait
x=0:y=0
x=int(MouseX/30)+1
y=int(MouseY/30)+1
if x+kx(korabl(raz,ch))-3>raz then wait
if y+ky(korabl(raz,ch))-3>raz then wait
i=0:a=0
for i=1 to ky(korabl(raz,ch))-2
for a=1 to kx(korabl(raz,ch))-2
if kar1(x-1+a,y-1+i)=1 then wait
if kar1(x-1+a,y-1+i)=11 then wait
next a
next i
if kar1(x,y)>100 or kar1(x,y)=11 then wait
i=0:a=0
for i=0 to ky(korabl(raz,ch))-1
for a=0 to kx(korabl(raz,ch))-1
if kar1(x-1+a,y-1+i)=11 then wait
if kar1(x-1+a,y-1+i)>110 and kar1(x-1+a,y-1+i)<200 then wait
next a
next i
i=0:a=0
for i=0 to ky(korabl(raz,ch))-1
for a=0 to kx(korabl(raz,ch))-1
kar1(x-1+a,y-1+i)=mkor(a,i)
next a
next i
print #t.g1, "drawbmp ";spuk$(kar1(x,y));" ";(x-1)*30;" ";(y-1)*30
if korabl(raz,ch)=117 or korabl(raz,ch)=171 then koltip(7,1)=koltip(7,1)+1
if korabl(raz,ch)=116 or korabl(raz,ch)=161 then koltip(6,1)=koltip(6,1)+1
if korabl(raz,ch)=115 or korabl(raz,ch)=151 then koltip(5,1)=koltip(5,1)+1
if korabl(raz,ch)=114 or korabl(raz,ch)=141 then koltip(4,1)=koltip(4,1)+1
if korabl(raz,ch)=113 or korabl(raz,ch)=131 then koltip(3,1)=koltip(3,1)+1
if korabl(raz,ch)=112 or korabl(raz,ch)=121 then koltip(2,1)=koltip(2,1)+1
if korabl(raz,ch)=111 then koltip(1,1)=koltip(1,1)+1
gosub [koltip1]
ch=ch+1
i=0:a=0
for i=0 to ky(korabl(raz,ch))-1
for a=0 to kx(korabl(raz,ch))-1
mkor(a,i)=1
if i>0 and a>0 and i<ky(korabl(raz,ch))-1 and a<kx(korabl(raz,ch))-1 then mkor(a,i)=11
next a
next i
mkor(1,1)=korabl(raz,ch)
#t.g1 "flush"'закрепление что бы было видно
wait
'=========================================================
[fire]
if ch<=ks then wait
x=int(MouseX/30)+1
y=int(MouseY/30)+1
if kar2(x,y)>=200 then wait
if kar2(x,y)=0 or kar2(x,y)=1 then kar2(x,y)=200:playwave "sound\mim.wav", sync:sni2=sni2+1
if kar2(x,y)=11 then kar2(x,y)=300:playwave "sound\pop2.wav", sync:sni1=sni1+1
if kar2(x,y)>110 and kar2(x,y)<200 then kar2(x,y)=300:playwave "sound\pop2.wav", sync:sni1=sni1+1
print #t.g2, "drawbmp ";spuk$(kar2(x,y));" ";(x-1)*30;" ";(y-1)*30
str=0
i=0
[jrec3]
i=i+1
a=0
[jrec4]
a=a+1
if kar1(a,i)=0 or kar1(a,i)=1 then str=str+1
if a<raz then goto [jrec4]
if i<raz then goto [jrec3]
yp=0
[jumpF7]
yp=yp+1
xp=0
[jumpF6]
xp=xp+1
if kar2(xp-1,yp-1)=0 or kar2(xp-1,yp-1)=11 or kar2(xp-1,yp-1)=300 then goto [jF1]
if kar2(xp,yp)=0 or kar2(xp,yp)=1 or kar2(xp,yp)=302 or kar2(xp,yp)=11 or kar2(xp,yp)=301 then goto [jF1]
pp=0
[jumpF8]
pp=pp+1
'обновление массива корабля
i=-1
[next14]
i=i+1
a=-1
[next15]
a=a+1
mkorp(a,i)=1
if i>0 and a>0 and i<ky(korablp(pp))-1 and a<kx(korablp(pp))-1 then mkorp(a,i)=11
if a<kx(korablp(pp))-1 then goto [next15]
if i<ky(korablp(pp))-1 then goto [next14]
mkorp(1,1)=korablp(pp)
i=-1
[jumpF4]
i=i+1
a=-1
[jumpF5]
a=a+1
if mkorp(a,i)=1 and kar2(xp-1+a,yp-1+i)=1 then goto [jimpF16]
if mkorp(a,i)=1 and kar2(xp-1+a,yp-1+i)=200 then goto [jimpF16]
if mkorp(a,i)=1 and kar2(xp-1+a,yp-1+i)=302 then goto [jimpF16]
if mkorp(a,i)=korablp(pp) and kar2(xp-1+a,yp-1+i)=300 then goto [jimpF16]
if mkorp(a,i)=11 and kar2(xp-1+a,yp-1+i)=300 then goto [jimpF16]
goto [jumpF9]
[jimpF16]
if a<kx(korablp(pp))-1 then goto [jumpF5]
if i<ky(korablp(pp))-1 then goto [jumpF4]
playwave "sound\ubil.wav", async
oi=oi+1
if korablp(pp)=117 or korablp(pp)=171 then koltip(7,2)=koltip(7,2)-1
if korablp(pp)=116 or korablp(pp)=161 then koltip(6,2)=koltip(6,2)-1
if korablp(pp)=115 or korablp(pp)=151 then koltip(5,2)=koltip(5,2)-1
if korablp(pp)=114 or korablp(pp)=141 then koltip(4,2)=koltip(4,2)-1
if korablp(pp)=113 or korablp(pp)=131 then koltip(3,2)=koltip(3,2)-1
if korablp(pp)=112 or korablp(pp)=121 then koltip(2,2)=koltip(2,2)-1
if korablp(pp)=111 then koltip(1,2)=koltip(1,2)-1
gosub [koltip2]
i=-1
[jumpF10]
i=i+1
a=-1
[jumpF11]
a=a+1
if kar2(xp-1+a,yp-1+i)=1 or kar2(xp-1+a,yp-1+i)=200 or kar2(xp-1+a,yp-1+i)=302 then
kar2(xp-1+a,yp-1+i)=302:print #t.g2, "drawbmp ";spuk$(kar2(xp-1+a,yp-1+i));" ";(xp-1+a-1)*30;" ";(yp-1+i-1)*30
else
kar2(xp-1+a,yp-1+i)=301:print #t.g2, "drawbmp ";spuk$(kar2(xp-1+a,yp-1+i));" ";(xp-1+a-1)*30;" ";(yp-1+i-1)*30
end if
if a<kx(korablp(pp))-1 then goto [jumpF11]
if i<ky(korablp(pp))-1 then goto [jumpF10]
[jumpF9]
if pp<13 then goto [jumpF8]
[jF1]
if xp<raz+1 then goto [jumpF6]
if yp<raz+1 then goto [jumpF7]
print #t.g6, "set 0 10"
print #t.g6, "\Computer ";ks-oi;" "
sni=int((sni1+0/0001)*10/(sni2+0.001))
print #t.g5, "set 0 10"
print #t.g5, "\";name$;" "
print #t.g5, "\ShpsLft ";ks-ok;" "
print #t.g5, "\Sniper ";sni;" "
print #t.g5, "\Strateg ";str;" "
print #t.g5, "\Lucky ";hap;" "
if oi>=ks then goto [finish]
if kar2(x,y)=300 or kar2(x,y)=301 then wait
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
[jumpF3]
if popa>0 then [popal]
xr=int(rnd(1)*raz+1)
yr=int(rnd(1)*raz+1)
[popal2]
if kar1(xr,yr)>=200 then goto [jumpF3]
if kar1(xr,yr)=0 or kar1(xr,yr)=1 then kar1(xr,yr)=200:playwave "sound\prom.wav", async
if kar1(xr,yr)=11 then kar1(xr,yr)=300:playwave "sound\pop.wav", sync:hap=hap-1
if kar1(xr,yr)>110 and kar1(xr,yr)<200 then kar1(xr,yr)=300:playwave "sound\pop.wav", sync:hap=hap-1
'if xr<1 or xr>raz or yr<1 or yr>raz then goto [jumpF3]
print #t.g1, "drawbmp ";spuk$(kar1(xr,yr));" ";(xr-1)*30;" ";(yr-1)*30
str=0
i=0
[frec3]
i=i+1
a=0
[frec4]
a=a+1
if kar1(a,i)=0 or kar1(a,i)=1 then str=str+1
if a<raz then goto [frec4]
if i<raz then goto [frec3]
yp=0
[F7]
yp=yp+1
xp=0
[F6]
xp=xp+1
if kar1(xp-1,yp-1)=0 or kar1(xp-1,yp-1)=11 or kar1(xp-1,yp-1)=300 then goto [gF1]
if kar1(xp,yp)=0 or kar1(xp,yp)=1 or kar1(xp,yp)=302 or kar1(xp,yp)=11 or kar1(xp,yp)=301 then goto [gF1]
pp=0
[F8]
pp=pp+1
'обновление массива корабля
i=-1
[t14]
i=i+1
a=-1
[t15]
a=a+1
mkorp(a,i)=1
if i>0 and a>0 and i<ky(korablp(pp))-1 and a<kx(korablp(pp))-1 then mkorp(a,i)=11
if a<kx(korablp(pp))-1 then goto [t15]
if i<ky(korablp(pp))-1 then goto [t14]
mkorp(1,1)=korablp(pp)
i=-1
[F4]
i=i+1
a=-1
[F5]
a=a+1
if mkorp(a,i)=1 and kar1(xp-1+a,yp-1+i)=1 then goto [pF16]
if mkorp(a,i)=1 and kar1(xp-1+a,yp-1+i)=200 then goto [pF16]
if mkorp(a,i)=1 and kar1(xp-1+a,yp-1+i)=302 then goto [pF16]
if mkorp(a,i)=korablp(pp) and kar1(xp-1+a,yp-1+i)=300 then goto [pF16]
if mkorp(a,i)=11 and kar1(xp-1+a,yp-1+i)=300 then goto [pF16]
goto [F9]
[pF16]
if a<kx(korablp(pp))-1 then goto [F5]
if i<ky(korablp(pp))-1 then goto [F4]
playwave "sound\ubil.wav", async
ok=ok+1
if korablp(pp)=117 or korablp(pp)=171 then koltip(7,1)=koltip(7,1)-1
if korablp(pp)=116 or korablp(pp)=161 then koltip(6,1)=koltip(6,1)-1
if korablp(pp)=115 or korablp(pp)=151 then koltip(5,1)=koltip(5,1)-1
if korablp(pp)=114 or korablp(pp)=141 then koltip(4,1)=koltip(4,1)-1
if korablp(pp)=113 or korablp(pp)=131 then koltip(3,1)=koltip(3,1)-1
if korablp(pp)=112 or korablp(pp)=121 then koltip(2,1)=koltip(2,1)-1
if korablp(pp)=111 then koltip(1,1)=koltip(1,1)-1
gosub [koltip1]
i=-1
[F10]
i=i+1
a=-1
[F11]
a=a+1
if kar1(xp-1+a,yp-1+i)=1 or kar1(xp-1+a,yp-1+i)=200 or kar1(xp-1+a,yp-1+i)=302 then
kar1(xp-1+a,yp-1+i)=302:print #t.g1, "drawbmp ";spuk$(kar1(xp-1+a,yp-1+i));" ";(xp-1+a-1)*30;" ";(yp-1+i-1)*30
else
kar1(xp-1+a,yp-1+i)=301:print #t.g1, "drawbmp ";spuk$(kar1(xp-1+a,yp-1+i));" ";(xp-1+a-1)*30;" ";(yp-1+i-1)*30
end if
if a<kx(korablp(pp))-1 then goto [F11]
if i<ky(korablp(pp))-1 then goto [F10]
[F9]
if pp<13 then goto [F8]
[gF1]
if xp<raz+1 then goto [F6]
if yp<raz+1 then goto [F7]
sni=int((sni1+0/0001)*10/(sni2+0.001))
print #t.g5, "set 0 10"
print #t.g5, "\";name$;" "
print #t.g5, "\ShpsLft ";ks-ok;" "
print #t.g5, "\Sniper ";sni;" "
print #t.g5, "\Strateg ";str;" "
print #t.g5, "\Lucky ";hap;" "
if ok>=ks then goto [finish]
if kar1(xr,yr)=300 then popa=popa+1:goto [popal]
if kar1(xr,yr)=301 then popa=0:np=0:pop=0:goto [jumpF3]
if popa=1 and np=1 then xr=xr-1
if popa=1 and np=2 then xr=xr+1
if popa=1 and np=3 then yr=yr-1
if popa=1 and np=4 then yr=yr+1
if popa>1 and np=1 then np=2 else if np=2 then np=1
if popa>1 and np=3 then np=4 else if np=4 then np=3
#t.g1 "flush"'закрепление что бы было видно
#t.g2 "flush"
wait
'------------------------------------------------------
[popal]
if popa>1 then goto [popal15]
if rnd(1)>0.5 then goto [popal4] else goto [popal5]
[popal4]
if rnd(1)>0.5 then np=1 else np=2
goto [popal15]
[popal5]
if rnd(1)>0.5 then np=3 else np=4
[popal15]
if np=1 then goto [popal7]
if np=2 then goto [popal8]
if np=3 then goto [popal9]
if np=4 then goto [popal10]
[popal7]
hod=kar1(xr+1,yr)
if hod=300 then xr=xr+1:goto [popal7]
if hod=200 or hod=302 or xr+1>raz then np=2:goto [jumpF3]
if hod=0 or hod=1 or hod=11 then xr=xr+1:goto [popal2]
if hod>110 and hod<200 then xr=xr+1:goto [popal2]
goto [jumpF3]
[popal8]
hod=kar1(xr-1,yr)
if hod=300 then xr=xr-1:goto [popal8]
if hod=200 or hod=302 or xr-1<1 then np=1:goto [jumpF3]
if hod=0 or hod=1 or hod=11 then xr=xr-1:goto [popal2]
if hod>110 and hod<200 then xr=xr-1:goto [popal2]
goto [jumpF3]
[popal9]
hod=kar1(xr,yr+1)
if hod=300 then yr=yr+1:goto [popal9]
if hod=200 or hod=302 or yr+1>raz then np=4:goto [jumpF3]
if hod=0 or hod=1 or hod=11 then yr=yr+1:goto [popal2]
if hod>110 and hod<200 then yr=yr+1:goto [popal2]
goto [jumpF3]
[popal10]
hod=kar1(xr,yr-1)
if hod=300 then yr=yr-1:goto [popal10]
if hod=200 or hod=302 or yr-1<1 then np=3:goto [jumpF3]
if hod=0 or hod=1 or hod=11 then yr=yr-1:goto [popal2]
if hod>110 and hod<200 then yr=yr-1:goto [popal2]
if hod=200 or hod=302 or yr-1<1 then np=3
goto [jumpF3]
'-----------------------------------------------------------
[finish]
if oi>=ks then notice "You sank the enemy fleet, ADMIRAL!":goto [records2]
if ok>=ks then notice "Ha, ha herring, like some water!"
goto [drawc]
'-----------------------------------------------------------
[records2]
'sni1:sni2:str:hap
sni=int((sni1+0/0001)*10/(sni2+0.001))
str=0
i=0
[rec3]
i=i+1
a=0
[rec4]
a=a+1
if kar1(a,i)=0 or kar1(a,i)=1 then str=str+1
if a<raz then goto [rec4]
if i<raz then goto [rec3]
if size$="10x10" then Open "records10.dat" For Random As #records Len = 36
if size$="14x14" then Open "records14.dat" For Random As #records Len = 36
if size$="17x17" then Open "records17.dat" For Random As #records Len = 36
if size$="20x20" then Open "records20.dat" For Random As #records Len = 36
Field #records, 9 As name1$, 3 As sni$, 9 As name2$, 3 As str$, 9 As name3$, 3 As hap$
i=0
[rec2]
i=i+1
Get #records, i
namer1$(i)=name1$
snir1(i)=Val(sni$)
namer2$(i)=name2$
strr2(i)=Val(str$)
namer3$(i)=name3$
hapr3(i)=Val(hap$)
if i<10 then goto [rec2]
nameb$=name$
i=0
[rec5]
i=i+1
if snir1(i)<=sni then buf=snir1(i):snir1(i)=sni:sni=buf:bufn$=namer1$(i):namer1$(i)=name$:name$=bufn$
if i<10 then goto [rec5]
name$=nameb$
i=0
[rec6]
i=i+1
if strr2(i)<=str then buf=strr2(i):strr2(i)=str:str=buf:bufn$=namer2$(i):namer2$(i)=name$:name$=bufn$
if i<10 then goto [rec6]
name$=nameb$
i=0
[rec8]
i=i+1
if hapr3(i)<=hap then buf=hapr3(i):hapr3(i)=hap:hap=buf:bufn$=namer3$(i):namer3$(i)=name$:name$=bufn$
if i<=10 then goto [rec8]
name$=nameb$
i=0
[rec7]
i=i+1
nam$=namer1$(i)+" "
name1$=Mid$(nam$,1,9)
sni$= using("###", snir1(i))
nam$=namer2$(i)+" "
name2$=Mid$(nam$,1,9)
str$= using("###", strr2(i))
nam$=namer3$(i)+" "
name3$=Mid$(nam$,1,9)
hap$= using("###", hapr3(i))
Put #records, i
if i<10 then goto [rec7]
CLOSE #records
goto [records]
goto [drawc]
'-----------------------------------------------------------
[Cr]
if creat=1 then goto [QUITcr]
UpperLeftX = d/2-320
UpperLeftY = sh/2-240
WindowWidth = 640
WindowHeight = 480
creat=1
graphicbox #c.cg, 0, 0, 640, 480
OPEN "Creators" FOR window_nf AS #c
print #c.cg, "drawbmp cr ";0;" ";0
print #c.cg, "drawbmp cr ";0;" ";0'устраняет глюк
print #c, "trapclose [QUITcr]"
wait
'-----------------------------------------------------------
[QUITcr]
creat=0
CLOSE #c
wait
'-----------------------------------------------------------
[records]
UpperLeftX = 0
UpperLeftY = 0
WindowWidth = d
WindowHeight = sh
BackgroundColor$ = "black"
bmpbutton #r.b1, "image\Exit.bmp", [exitR], UL, d/2-87, sh-75
graphicbox #r.rg, 0, 0, d, sh
OPEN "Highscores" FOR window_popup AS #r
print #r.rg, "font courier_new 12";
if size$="10x10" then Open "records10.dat" For Random As #records Len = 36
if size$="14x14" then Open "records14.dat" For Random As #records Len = 36
if size$="17x17" then Open "records17.dat" For Random As #records Len = 36
if size$="20x20" then Open "records20.dat" For Random As #records Len = 36
Field #records, 9 As name1$, 3 As sni$, 9 As name2$, 3 As str$, 9 As name3$, 3 As hap$
print #r.rg, "backcolor black"
print #r.rg, "fill black"
print #r.rg, "color green"
print #r.rg, "set ";d/2-250;" ";sh/2-150
print #r.rg, "\+---------------------------------------------+"
print #r.rg, "\| Record holders ";size$;" |"
print #r.rg, "\+--------------+---------------+--------------+"
print #r.rg, "\| Sniper | Strategist | Lucky |"
print #r.rg, "\+--------------+---------------+--------------+"
i=0
[rec1]
i=i+1
Get #records, i
print #r.rg, "\|";name1$;" ";sni$;" | ";name2$;" ";str$;" | ";name3$;" ";hap$;"|"
if i<10 then goto [rec1]
print #r.rg, "\+--------------+---------------+--------------+"
wait
'-----------------------------------------------------------
[exitR]
close #records
close #r
wait
|
|
