Rem FourBall_v2.bas
!****************************
valueSk=10
gr.open 255,0,0,0,0,1
gr.screen w,h
pause 2000
GOSUB PROLOG

! ЗВЕЗДНОЕ НЕБО
stsky= rnd()*1000
for i=1 to stsky
col=rnd()*100
gr.color 255,col,col,col,1
!gr.circle star,rnd()*w,rnd()*h,rnd()*3


if floor(stsky/2)=i & flagsk=0 then
flagsk=1
sA$="Синий: "
sB$="Зелёный: "
sC$="Белый: "
sD$="Оранжевый: "
vyb$="выбыл"
xa0=0
ya0=0
xC0=0
yC0=h
xb0=w
yb0=0
xD0=w
yD0=h
ra=4
rb=4
rc=4
rD=4
skA=1
skB=1
skC=1
skD=1
xgor=rnd()*w
ygor=rnd()*h/2+h/2

gr.color 255,0,0,255,1
gr.circle ba,xa0,ya0,ra
Gr.paint.get PaintA

gr.color 255,0,255,0,1
gr.circle bb,xb0,yb0,rb
Gr.paint.get PaintB

gr.color 255,255,255,255,1
gr.circle bc,xc0,yc0,rc
Gr.paint.get PaintC




gr.color 255,255,153,0,1
gr.circle bD,xD0,yD0,rD
Gr.paint.get PaintD
endif
next i



gr.color 255,255,0,0,1
Gr.paint.get Red
gr.color 255,255,255,0,1
Gr.paint.get Yellow
gr.circle gor,xgor,ygor,5

gr.color 255,255,0,255,1
Gr.paint.get Sppaint


gr.text.size h/40
gr.color 255,0,0,255,1
gr.text.align 1
gr.text.draw txA,0,h/40,sA$+int$(rA)

gr.color 255,0,255,0,1
gr.text.align 3
gr.text.draw txB,w,h/40,sB$+int$(rB)

gr.color 255,255,255,255,1
gr.text.align 1
gr.text.draw txC,0,h-h/40/4,sC$+int$(rC)

gr.color 255,255,153,0,1
gr.text.align 3
gr.text.draw txD,w,h-h/40/4,sD$+int$(rD)






GOSUB MATH_A
GOSUB MATH_B
GOSUB MATH_C
GOSUB MATH_D


Do
GOSUB MOVINGA
GOSUB MOVINGB
GOSUB MOVINGC
GOSUB MOVINGD
GOSUB ENT
GOSUB FINISH
GOSUB FTIME
!sgame++
!if sgame=100 then
gr.render
!sgame=0
!endif
Until 0


!Start PROLOG
PROLOG:
array.load s$[],"© CH.A.D. 2015","представляет","игру","ЧЕТЫРЕ ШАРААА!!!","Делаем ставки!","Поехалиии!!!"
Array.length lens, s$[]


gr.text.size h/25
gr.text.align 2
gr.color 255,255,255,255,1
gr.text.draw txt,w/2,h/2,"hi!"
!gr.render


for t=1 to lens

for i=1 to 255 step 3
gr.modify txt,"text",s$[t],"alpha",i
gr.render
next i

pause 2000

for i=1 to 255 step 3
gr.modify txt,"alpha",255-i
gr.render
next i
pause 1000
next t

RETURN 
!End PROLOG


!Start ВРЕМЯ
FTIME:
IF FTIME=0 THEN

Time ,,,sth$,stm$,sts$

GR.COLOR 255,255,255,255,1

gr.text.size h/50
gr.text.align 2
!gr.color 255,0,200,0,1
gr.text.draw obtime1,w/2,h/50,"Время"

gr.text.size h/50
gr.text.align 2
!gr.color 255,0,200,0,1
gr.text.draw obtime2,w/2,h/50*2,"Время"

gr.text.size h/50
gr.text.align 2
!gr.color 255,0,200,0,1
gr.text.draw obtime3,w/2,h/50*3,"Время"

FTIME=1
ENDIF

gr.touch fltch,xtch,ytch
if fltch=1 then
gr.show obtime1
gr.show obtime2
gr.show obtime3
else
gr.hide obtime1
gr.hide obtime2
gr.hide obtime3
return
endif

gr.modify obtime1,"text","Начальное время: "+sth$+":"+stm$+":"+sts$

Time ,,,h$,m$,s$

gr.modify obtime2,"text","Текущее время: "+H$+":"+M$+":"+S$

os$=int$(val(s$)-val(sts$))
om$=int$(val(m$)-val(stm$))
oh$=int$(val(h$)-val(sth$))

if val(os$)<0 then
om$=int$(val(om$)-1)
os$=int$(60+val(os$))
endif

if val(om$)<0 then
oh$=int$(val(oh$)-1)
om$=int$(60+val(om$))
endif

if val(oh$)<0 then
oh$=int$(24+val(oh$))
endif

if val(os$)<10 then
os$="0"+os$
endif

if val(om$)<10 then
om$="0"+om$
endif

if val(oh$)<10 then
oh$="0"+oh$
endif
ot$= "Прошло времени: "+oH$+":"+oM$+":"+oS$
gr.modify obtime3,"text",ot$

RETURN 
!End ВРЕМЯ


!Start ЗАВЕРШЕНИЕ ИГРЫ
FINISH:

if (xA1>w+50 | xA1<-50 | yA1>h+50 | yA1<-50) & hiA=0 then
gr.hide bA
hiA=1
gr.modify txA,"text",sA$+vyb$
endif


if (xB1>w+50 | xB1<-50 | yB1>h+50 | yB1<-50) & hiB=0 then
gr.hide bB
hiB=1
gr.modify txB,"text",sB$+vyb$
endif


if (xC1>w+50 | xC1<-50 | yC1>h+50 | yC1<-50) & hiC=0 then
gr.hide bC
hiC=1
gr.modify txC,"text",sC$+vyb$
endif


if (xD1>w+50 | xD1<-50 | yD1>h+50 | yD1<-50) & hiD=0 then
gr.hide bD
hiD=1
gr.modify txD,"text",sD$+vyb$
endif



if hiB=1 & hiC=1 & hiD=1 then
gr.cls
gr.color 255,255,255,255,1
gr.text.size h/40
gr.text.align 2
gr.text.draw fin,w/2,h/2,"Победил синий!"
gr.text.draw fin,w/2,h/2+h/40,ot$

gr.render
pause 5000
end
endif

if hiA=1 & hiC=1 & hiD=1 then
gr.cls
gr.color 255,255,255,255,1
gr.text.size h/40
gr.text.align 2
gr.text.draw fin,w/2,h/2,"Победил зеленый!"
gr.text.draw fin,w/2,h/2+h/40,ot$
gr.render
pause 5000
end
endif

if hiA=1 & hiB=1 & hiD=1 then
gr.cls
gr.color 255,255,255,255,1
gr.text.size h/40
gr.text.align 2
gr.text.draw fin,w/2,h/2,"Победил белый!"
gr.text.draw fin,w/2,h/2+h/40,ot$
gr.render
pause 5000
end
endif

if hiA=1 & hiB=1 & hiC=1 then
gr.cls
gr.color 255,255,255,255,1
gr.text.size h/40
gr.text.align 2
gr.text.draw fin,w/2,h/2,"Победил оранжевый!"
gr.text.draw fin,w/2,h/2+h/40,ot$
gr.render
pause 5000
end
endif

RETURN
!End



!Start ВЫЧ. ТРАЕКТОРИИ "А"
MATH_A:
m=(abs(xa0-xgor)^2+abs(ya0-ygor)^2)^0.5
 if m=0 then
  m=0.0001
 endif
 angA=todegrees(Acos((xgor-xa0)/m))
if yA0>ygor then 
angA=-angA
endif
angleA=toradians(angA)
RETURN
!End


!Start ВЫЧ. ТРАЕКТОРИИ "B"
MATH_B:
m=(abs(xb0-xgor)^2+abs(yB0-ygor)^2)^0.5
 if m=0 then
  m=0.0001
 endif
 angB=todegrees(Acos((xgor-xB0)/m))
if yB0>ygor then 
angB=-angB
endif
angleB=toradians(angB)
RETURN
!End

!Start ВЫЧ. ТРАЕКТОРИИ "C"
MATH_C:
m=(abs(xC0-xgor)^2+abs(yC0-ygor)^2)^0.5
 if m=0 then
  m=0.0001
 endif
 angC=todegrees(Acos((xgor-xC0)/m))
if yC0>ygor then 
angC=-angC
endif
angleC=toradians(angC)
RETURN
!End

!Start ВЫЧ. ТРАЕКТОРИИ "D"
MATH_D:
m=(abs(xD0-xgor)^2+abs(yD0-ygor)^2)^0.5
 if m=0 then
  m=0.0001
 endif
 angD=todegrees(Acos((xgor-xD0)/m))
if yD0>ygor then 
angD=-angD
endif
angleD=toradians(angD)
RETURN
!End

!Start ДВИЖЕНИЕ A
MOVINGA:
vA=vA+skA
xA1=cos(angleA)*vA+xA0
yA1=sin(angleA)*vA+yA0

gr.modify ba,"x",xA1,"y",yA1 ,"radius",rA
if ra<=0 then
gr.modify ba,"radius",4,"paint", Sppaint
else
gr.modify ba,"paint", PaintA
endif
RETURN
!End


!Start ДВИЖЕНИЕ B
MOVINGB:
vB=vB+skB
xB1=cos(angleB)*vB+xB0
yB1=sin(angleB)*vB+yB0

gr.modify bB,"x",xB1,"y",yB1 ,"radius",rB

if rB<=0 then
gr.modify bB,"radius",4,"paint", Sppaint
else
gr.modify bb,"paint", PaintB
endif
RETURN
!End

!Start ДВИЖЕНИЕ C
MOVINGC:
vC=vC+skC
xC1=cos(angleC)*vC+xC0
yC1=sin(angleC)*vC+yC0

gr.modify bC,"x",xC1,"y",yC1 ,"radius",rC
if rC<=0 then
gr.modify bC,"radius",4,"paint", Sppaint
else
gr.modify bc,"paint", PaintC
endif
RETURN
!End


!Start ДВИЖЕНИЕ D
MOVINGD:
vD=vD+skD
xD1=cos(angleD)*vD+xD0
yD1=sin(angleD)*vD+yD0

gr.modify bD,"x",xD1,"y",yD1 ,"radius",rD
if rD<=0 then
gr.modify bD,"radius",4,"paint", Sppaint
else
gr.modify bD,"paint", PaintD
endif
RETURN
!End


!Start ПРОВЕРКА СТОЛКНОВЕНИЙ И СОБЫТИЙ
ENT:

lgor--
if lgor<0 then
GOSUB LIVEGOR
xA0=xA1
yA0=yA1
xB0=xB1
yB0=yB1
xC0=xC1
yC0=yC1
xD0=xD1
yD0=yD1


vA=0
vB=0
vC=0
vD=0
GOSUB MATH_A
GOSUB MATH_B
GOSUB MATH_C
GOSUB MATH_D
endif

if gr_collision(bA,gor) then
skA=skA+valueSk
rA=rA+valueSk*10
GOSUB LIVEGOR
xA0=xA1
yA0=yA1
xB0=xB1
yB0=yB1
xC0=xC1
yC0=yC1
xD0=xD1
yD0=yD1
vA=0
vB=0
vC=0
vD=0
gr.modify txA,"text",sA$+int$(rA)
GOSUB MATH_A
GOSUB MATH_B
GOSUB MATH_C
GOSUB MATH_D
endif

if gr_collision(bB,gor) then
skB=skB+valueSk
rB=rB+valueSk*10
GOSUB LIVEGOR
xA0=xA1
yA0=yA1
xB0=xB1
yB0=yB1
xC0=xC1
yC0=yC1
xD0=xD1
yD0=yD1
vA=0
vB=0
vC=0
vD=0
gr.modify txB,"text",sB$+int$(rB)
GOSUB MATH_A
GOSUB MATH_B
GOSUB MATH_C
GOSUB MATH_D
endif

if gr_collision(bC,gor) then
skC=skC+valueSk
rC=rC+valueSk*10
GOSUB LIVEGOR
xA0=xA1
yA0=yA1
xB0=xB1
yB0=yB1
xC0=xC1
yC0=yC1
xD0=xD1
yD0=yD1
vA=0
vB=0
vC=0
vD=0
gr.modify txC,"text",sC$+int$(rC)
GOSUB MATH_A
GOSUB MATH_B
GOSUB MATH_C
GOSUB MATH_D
endif


if gr_collision(bD,gor) then
skD=skD+valueSk
rD=rD+valueSk*10
GOSUB LIVEGOR
xA0=xA1
yA0=yA1
xB0=xB1
yB0=yB1
xC0=xC1
yC0=yC1
xD0=xD1
yD0=yD1

vA=0
vB=0
vC=0
vD=0

gr.modify txD,"text",sD$+int$(rD)
GOSUB MATH_A
GOSUB MATH_B
GOSUB MATH_C
GOSUB MATH_D
endif




if gr_collision(bB,bA) then
skA=skA-valueSk
rA=rA-valueSk*10
skB=skB-valueSk
rB=rB-valueSk*10
GOSUB SP

xA0=rnd()*w
yA0=rnd()*h
xB0=rnd()*w
yB0=rnd()*h
vA=0
vB=0
GOSUB MATH_A
GOSUB MATH_B
gr.modify txA,"text",sA$+int$(rA)
gr.modify txB,"text",sB$+int$(rB)

endif

if gr_collision(bC,bA) then
skA=skA-valueSk
rA=rA-valueSk*10
skC=skC-valueSk
rC=rC-valueSk*10
GOSUB SP


xA0=rnd()*w
yA0=rnd()*h
xC0=rnd()*w
yC0=rnd()*h
vA=0
vC=0
GOSUB MATH_A
GOSUB MATH_C
gr.modify txA,"text",sA$+int$(rA)
gr.modify txC,"text",sC$+int$(rC)
endif

if gr_collision(bD,bA) then
skA=skA-valueSk
rA=rA-valueSk*10
skD=skD-valueSk
rD=rD-valueSk*10
GOSUB SP

xA0=rnd()*w
yA0=rnd()*h
xD0=rnd()*w
yD0=rnd()*h
vA=0
vD=0
GOSUB MATH_A
GOSUB MATH_D
gr.modify txA,"text",sA$+int$(rA)
gr.modify txD,"text",sD$+int$(rD)
endif


if gr_collision(bC,bB) then
skB=skB-valueSk
rB=rB-valueSk*10
skC=skC-valueSk
rC=rC-valueSk*10
GOSUB SP

xB0=rnd()*w
yB0=rnd()*h
xC0=rnd()*w
yC0=rnd()*h
vB=0
vC=0
GOSUB MATH_B
GOSUB MATH_C
gr.modify txC,"text",sC$+int$(rC)
gr.modify txB,"text",sB$+int$(rB)
endif

if gr_collision(bD,bB) then
skB=skB-valueSk
rB=rB-valueSk*10
skD=skD-valueSk
rD=rD-valueSk*10
GOSUB SP
xB0=rnd()*w
yB0=rnd()*h
xD0=rnd()*w
yD0=rnd()*h
vB=0
vD=0
GOSUB MATH_B
GOSUB MATH_D

gr.modify txD,"text",sD$+int$(rD)
gr.modify txB,"text",sB$+int$(rB)
endif


if gr_collision(bC,bD) then
skD=skD-valueSk
rD=rD-valueSk*10
skC=skC-valueSk
rC=rC-valueSk*10
GOSUB SP

xD0=rnd()*w
yD0=rnd()*h
xC0=rnd()*w
yC0=rnd()*h
vD=0
vC=0
GOSUB MATH_D
GOSUB MATH_C
gr.modify txC,"text",sC$+int$(rC)
gr.modify txD,"text",sD$+int$(rD)
endif
RETURN
!End



!Start ЖИЗНЬ И РАСПОЛОЖЕНИЕ ГОРОХА
LIVEGOR:

vsov=floor(10*rnd()+1) % Вероятность красн.гороха


xgor=rnd()*w
ygor=rnd()*h
lgor=rnd()*h

if int(vsov)=10 then
gr.modify gor,"x",xgor,"y",ygor,"paint",red
valueSk=1
tone 1000,200
else
gr.modify gor,"x",xgor,"y",ygor,"paint",Yellow
valueSk=0.1
endif
Gosub sp
RETURN
!End


!Start Скорость духа
Sp:
vSp=10 % В стандарте vSp=3
if rA<=0 & KeA=0 then
KeA=1
skA=skA+vSp
elseif rA>0 & KeA=1 then
KeA=0
skA=skA-vSp
Endif

if  rb<=0 & KeB=0 then
KeB=1
skB=skB+ vSp
elseif rB>0 & KeB=1 then
KeB=0
skB=skB-vSp
Endif

if  rC<=0 & KeC=0 then
KeC=1
skC=skc+vSp
elseif rC>0 & KeC=1 then
KeC=0
skC=skC-vSp
endif

if  rD<=0 & KeD=0 then
KeD=1
skD=skD+vSp
elseif rD>0 & KeD=1 then
KeD=0
skD=skD-vSp
endif

!!
xA0=xA1
yA0=yA1
xB0=xB1
yB0=yB1
xC0=xC1
yC0=yC1
vA=0
vB=0
vC=0
GOSUB MATH_A
GOSUB MATH_B
GOSUB MATH_C
!!
RETURN
!End


OnBackKey:

gosub Exitmessage
Back.resume


OnMenuKey:
gosub Exitmessage
MenuKey.resume


!Start
Exitmessage:
obkdm:
DIALOG.MESSAGE ,"Меню паузы", bbb, "Выйти","Продолжить"
   if bbb=1 then
     end
   elseif bbb=2 then
   
   else
    goto obkdm
   endif
return
!End