Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Программирование игр для компьютеров > Blitz3D > 2D-программирование

2D-программирование Вопросы, касающиеся двумерного программирования

Ответ
 
Опции темы
Старый 09.12.2013, 15:44   #1
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
(ИИ)RTS... передвижение юнитов по клику

Мышью :
левой выделить
правой указать цель

Код сырой ,иногда попадают в одну точку следования
может тормозить ,из-за говнокода


Const wait =0 ,move = 1 ,attack =2 
Dim formX(200) : Dim formY(200)

Global selectionFlag =0 , groupFlag  = 0 , TargetFlag = 0 
Global mx#,my#,oldx# ,oldy# ,group ,sel 
Global bx0, by0, bx1, by1 , middleX# , middleY# ,tx#,ty# 

Type Unit
Field x# ,tx# ,vx# , angl# , distance#
Field y# ,ty# ,vy# ,speed# , size
Field name$
Field group
Field isSelected =0 
Field action =wait ; wait =0 move = 1 attack =2 
End Type

Function Dis(X1,Y1, xx,yy)
Return Abs(((xx-X1)*(xx-X1)+(yy-Y1)*(yy-Y1))^0.5)
End Function

Function NewUnit.Unit(name$ , x#, y#  )
	this.Unit = New unit 
	this\x# = x#
	this\y# = y#
	this\name$ = name$ 
	this\group = -1
	this\speed = 5
	this\size = 10
End Function 

Function SelectionMove()
	If MouseDown(2)=True And TargetFlag = 0 Then 
		tx# = MouseX()
		ty# = MouseY()
		
		For Un.Unit = Each Unit	
		If un\isSelected = 1 	
		TargetFlag = 1 
		un\tx#  =tx
		un\ty# = ty
		If sel >1 Then MathMove(un)
		
		d2# = dis( un\x, un\y,un\tx,un\ty)	
		If d2<>0
			un\vx# = (un\tx -un\x)/d2
			un\vy#  =  (un\ty - un\y )/d2	
		EndIf 
		
		un\action = move
		EndIf
		Next
	EndIf 
	If MouseDown(2)=fale And TargetFlag = 1 Then 
		TargetFlag = 0 
	EndIf 	
End Function 

Function MathMove#(this.Unit)
	
	Local position = 0 
	
	;While position = 0
	Repeat 
	For Un2.Unit = Each Unit	
		If un2<>this
		If un2\isSelected = 1
		size2# = (this\size + un2\size) 
			If dis( this\tx, this\ty ,un2\tx , un2\ty)<this\size Then  
			;	position = 0
				p = Rnd (0,7)
				Select p
				Case 0 :this\tx = this\tx -size2
				Case 1 :this\tx = this\tx + size2
				Case 2 :this\ty = this\ty -size2
				Case 3 :this\ty = this\ty +size2
				Case 4 :this\tx = this\tx - size2 : this\ty = this\ty -size2
				Case 5 :this\tx = this\tx+ size2 : this\ty = this\ty -size2
				Case 6 :this\tx = this\tx -size2 : this\ty = this\ty + size2
				Case 7 :this\tx = this\tx +size2 : this\ty = this\ty +size2
				Default :this\tx = this\tx : this\ty = this\ty
				End Select  
			Else  				
				position = 1
			EndIf 
			
		EndIf :EndIf 
	Next 
	Until position = 1;Wend

End Function 

Function MoveUnit(this.Unit)
	this\x = this\x + this\vx*this\speed
	this\y = this\y + this\vy*this\speed
	Line this\x ,this\y, this\tx ,this\ty 
End Function 

Graphics 800,600,32,2
SetBuffer BackBuffer()
cyr = LoadFont("ArialCyr",14)
SetFont cyr
For d=0 To 15
NewUnit("sold" , Rnd(800),Rnd(400))
Next
While Not KeyHit(1)
Cls 
MiddleSelect()
SelectionMove()

For Un.Unit = Each Unit		
Selection_Mouse(un)	
	If un\isSelected = 1
	
	Line un\x ,un\y, un\tx ,un\ty 
	EndIf 
	If un\action = move Then 
	If Dis(un\x ,un\y ,  un\tx , un\ty)  <= un\speed+0.1 Then un\action = wait
	MoveUnit(un)
	EndIf 	
	;Text un\x#+12,un\y#+12, un\tx +"  "+ un\ty +"  "+ un\x +"  "+ un\y 
Next 
DrawUnit()


Flip 
Wend
Delete Each Unit
FreeFont cyr
End 



Function Selection_Mouse(this.Unit)

	If MouseDown(1) = True And selectionFlag = 0 Then
	
		selectionFlag = 1
		mx = MouseX()
		my = MouseY()
	EndIf
	If MouseDown(1) = True And selectionFlag = 1 Then
		this\isSelected = 0
		
		oldx= MouseX()
		oldy= MouseY()
	EndIf
	If MouseDown(1) = False Then selectionFlag = 0 
	If MouseHit (1) And RectsOverlap(mx#,my#,1,1,500,400,40,40) Then NewUnit("sold" , Rnd(600),Rnd(400))	
	If selectionFlag = 1 Then	
		If mx < oldx
			bx0 = mx
			bx1 = oldx
		Else
			bx0 = oldx
			bx1 =mx
		EndIf
		
		If my < oldy
			by0 = my
			by1 = oldy
		Else
			by0 = oldy
			by1 = my
		EndIf
	EndIf
	If this\x# > bx0 And this\x# < bx1 And this\y# > by0 And this\y# < by1 
		this\isSelected = 1
	ElseIf Dis(mx,my, this\x#,this\y#)<this\size
		this\isSelected = 1
	EndIf
End Function

Function DrawUnit()
	For Un.Unit = Each Unit
	If un\isSelected = 1 
		Text un\x#,un\y#-18,"S"
	Color 2,200,200	
	Oval middleX#-3 , middleY# -3 , 6 ,6
	Color 255,255,255
		If un\group >-1
			Text un\x#-4,un\y#+8, un\group	
		EndIf
	EndIf 	
	If un\action = move Then Text un\x#+4,un\y#+8,"M"
	If un\action = wait Then Text un\x#+4,un\y#+8,"W"
	
	Rect un\x#-5,un\y#-5,10,10,1 ; Unit
		
	Color 2,200,200
		If selectionFlag = 1	Then Rect bx0, by0, bx1-bx0, by1-by0,0	
	Color 255,255,255
		; -- button --
		Rect 500,400,40,40,0
		; -- info --
		Text 20,20,"mx = "+mx+"  my = "+my+"  oldx = "+oldx+"  oldy = "+oldy+"  group "+group
		Text 20,40,"Selected : "+ sel
	Next
End Function

Function MiddleSelect()
lowX# = 999999
lowY# = 999999
hightX# = 0
hightY# = 0
sel =0
For Un.Unit = Each Unit
	If un\isSelected = 1
	sel = sel +1 
		If un\x <= lowX Then lowX = un\x
		If un\y <= lowY Then lowY = un\y
		If un\x > hightX Then hightX = un\x
		If un\y > hightY Then hightY = un\y
	EndIf 
Next 
middleX = lowX + (hightX-lowX  )/2
middleY = lowY + (hightY-lowY  )/2
End Function
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
pepel (26.12.2013)
Старый 09.12.2013, 19:32   #2
Nikich
Бывалый
 
Регистрация: 22.12.2011
Сообщений: 844
Написано 150 полезных сообщений
(для 275 пользователей)
Ответ: (ИИ)RTS... передвижение юнитов по клику

Модуль от заведомо положительно числа? Вы ожидаете чего-то другого?
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
pepel (26.12.2013)
Старый 09.12.2013, 19:53   #3
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: (ИИ)RTS... передвижение юнитов по клику

Вообще в начале делал расстановку с применением такого кода
Function FormationSelect(n)
	ring = Rand(n)
	idx = n - (ring+ring)
	If idx >= ring Then 
	formationX = 2*ring -idx
	formationY = ring/2+ idx
	Else 
	formationX = idx
	formationY = ring	
	EndIf 
End Function
где n число от 0 до ...???(к примеру 11) ,но чем выше число ,тем дальше значения.

По поводу модуля не совсем понял ,что имеется ввиду ?
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
pepel (26.12.2013)
Старый 09.12.2013, 22:04   #4
Nikich
Бывалый
 
Регистрация: 22.12.2011
Сообщений: 844
Написано 150 полезных сообщений
(для 275 пользователей)
Ответ: (ИИ)RTS... передвижение юнитов по клику

Function Dis(X1,Y1, xx,yy)
Return Abs(((xx-X1)*(xx-X1)+(yy-Y1)*(yy-Y1))^0.5)
End Function
Смотрим.
(xx-X1)*(xx-X1)
Точно неотрицательное.
(yy-Y1)*(yy-Y1)
Точно неотрицательное.
(xx-X1)*(xx-X1)+(yy-Y1)*(yy-Y1)
Супер точно неотрицательное.
((xx-X1)*(xx-X1)+(yy-Y1)*(yy-Y1))^0.5
Неотрицательнее уже некуда.
Зачем ещё модуль?
Хотя, там и корень то не очень нужен.
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
pepel (26.12.2013)
Старый 22.12.2013, 13:28   #5
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: (ИИ)RTS... передвижение юнитов по клику

Дабы не создавать новую тему ,решил выложить здесь, тем более тема близка.
Основывался на статью Эту
Плавный поворот на точку с указанной скоростью:
Код:
Dim cosA#(360)
Dim sinA#(360)

For i# = 0.0 To 360.0 Step 0.0001
cosA(i#)= Cos(i#)
sinA(i#)= Sin(i#)
Next 

Function breakAngle#(AngleBreak#=0)
	If AngleBreak#< 0 
		AngleBreak#= 360 + AngleBreak# 
	ElseIf AngleBreak#>= 360 
		AngleBreak#=   AngleBreak# -360
	EndIf 
	Return AngleBreak#
End Function 

Graphics 800,600,32,2
SetBuffer BackBuffer()
x=200 : y=200
rotation# =10 

While Not KeyHit(1)
Cls 
mx# = MouseX():my#=MouseY()

rotation# = SmoothRotate(x,y ,mx ,my ,rotation# ,1 )


Text 20,20,"rotation "+rotation 

Color 25,25,25
Line x,y,mx , my
Color 255,255,255
Line x,y,x+45*Cosa(rotation)     , y+45*Sina(rotation)
Oval x-5+45*Cosa(rotation)     , y-5+45*Sina(rotation),10,10
Flip 
Wend
End 




Function SmoothRotate#(bodyx#,bodyy# ,bodyx2# ,bodyy2# ,bodyrotation# ,rotToMouseSpeed#=0.1 )
	If rotationSpeed < 0.0001 Then rotationSpeed  =0.0001
	mDx# = bodyx2- bodyx;
	mDy# = bodyy2- bodyy;
	mAngle# = ATan2(mDy, mDx);
	;сколько градусов нехватает для полного поворота на мышь
	dAngleD# = bodyrotation - mAngle;

	dAngleD# =breakAngle#(dAngleD)
;	If (dAngleD < 0) 
;		dAngleD = 360 + dAngleD;
;	Else If (dAngleD > 360) 
;		dAngleD =   dAngleD - 360 ;
;	EndIf 
	Text 20,40,"dAngleD "+dAngleD 
	
	;поворачиваем башню с нашей скоростью
	If ((dAngleD)<=rotToMouseSpeed)
	bodyrotation =mAngle
	Else 
	If(dAngleD < 180) 
		bodyrotation =  bodyrotation - rotToMouseSpeed;
	Else If (dAngleD > 180) 
		bodyrotation = bodyrotation +  rotToMouseSpeed;
	EndIf 
	EndIf 
	
	bodyrotation# =breakAngle#(bodyrotation)
;	If (bodyrotation < 0) 
;		bodyrotation = 360 + bodyrotation ;
;	Else If (bodyrotation >= 360) 
;		bodyrotation =   bodyrotation - 360 ;
;	EndIf 
	Return bodyrotation 
End Function
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
pepel (26.12.2013)
Старый 22.12.2013, 16:50   #6
mr.DIMAS
Дэвелопер
 
Аватар для mr.DIMAS
 
Регистрация: 26.12.2006
Адрес: Санкт-Петербург
Сообщений: 1,572
Написано 547 полезных сообщений
(для 1,540 пользователей)
Ответ: (ИИ)RTS... передвижение юнитов по клику

А не проще ̶л̶и̶н̶е̶й̶н̶о̶й̶ интерполяцией сделать?

curAngle = curAngle + ( destAngle - curAngle ) * t

где curAngle - текущий угол поворота
destAngle - нужный угол поворота
t - скорость изменения
__________________

(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
pepel (26.12.2013)
Старый 22.12.2013, 17:11   #7
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: (ИИ)RTS... передвижение юнитов по клику

Сообщение от mr.DIMAS Посмотреть сообщение
А не проще линейной интерполяцией сделать?

curAngle = curAngle + ( destAngle - curAngle ) * t

где curAngle - текущий угол поворота
destAngle - нужный угол поворота
t - скорость изменения
"Странно" ... получается мгновенный поворот ???
И в чём прикол ?
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
pepel (26.12.2013)
Старый 23.12.2013, 13:18   #8
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: (ИИ)RTS... передвижение юнитов по клику

Итак продолжаю ... Передвижение юнитов по клику.
Код подтомаживает ,но вполне рабочий.


Код:
Const wait =0 ,move = 1 ,attack =2 
Dim formX(200) : Dim formY(200)

Global formationX ,formationY 
Global selectionFlag =0 , groupFlag  = 0 , TargetFlag = 0 
Global mx#,my#,oldx# ,oldy# ,group ,sel 
Global bx0, by0, bx1, by1 , middleX# , middleY# ,tx#,ty# 

Type Unit
Field x# ,tx# ,vx# , vx2#, angl# , distance#
Field y# ,ty# ,vy# , vy2# ,speed# , size
Field name$
Field group
Field isSelected =0 
Field action =wait ; wait =0 move = 1 attack =2 
End Type

Function Dis(X1,Y1, xx,yy)
Return Abs(((xx-X1)*(xx-X1)+(yy-Y1)*(yy-Y1))^0.5)
End Function

Function NewUnit.Unit(name$ , x#, y#  )
	this.Unit = New unit 
	this\x# = x#
	this\y# = y#
	this\name$ = name$ 
	this\group = -1
	this\speed = 5
	this\size = 10
End Function 

Function SelectionMove()
	If MouseDown(2)=True And TargetFlag = 0 Then 
		tx# = MouseX()
		ty# = MouseY()
		TargetFlag = 1 	
	EndIf 
	If TargetFlag = 1			
		For Un.Unit = Each Unit	
		If un\isSelected = 1 			
		;un\tx#  =tx
		;un\ty# = ty		
		
		EndIf
		Next		
		j1 = 0
		For Un.Unit = Each Unit	
		If un\isSelected = 1 	
		j1 = j1+1

		MathMove2(un,j1)
		
		d2# = dis( un\x, un\y,un\tx,un\ty)	
		If d2<>0
			un\vx# = (un\tx -un\x)/d2
			un\vy#  =  (un\ty - un\y )/d2	
		EndIf 
		
		un\action = move
		EndIf
		Next
	EndIf	

	If MouseDown(2)=False And TargetFlag = 1 Then 
		TargetFlag = 0 
	EndIf 	
End Function 

Function MathMove2(this.Unit, j)
	blockFormation(j)
		ss = this\size *2
		this\tx=  tx+formationX * ss
		this\ty = ty+formationY * ss 
End Function 

Function MoveUnit(this.Unit)
	this\x = this\x + this\vx*this\speed
	this\y = this\y + this\vy*this\speed
	Color 120,120,120	
;	Line this\x ,this\y, this\tx ,this\ty 
;	ss# = (this\size+this\size)*2
	Oval this\x-ss/2  ,this\y-ss/2 ,ss,ss,0
End Function 

Graphics 800,600,32,2
SetBuffer BackBuffer()
cyr = LoadFont("ArialCyr",14)
SetFont cyr
For d=0 To 15
NewUnit("sold" , Rnd(800),Rnd(400))
Next
While Not KeyHit(1)
Cls 
MiddleSelect()
SelectionMove()

For Un.Unit = Each Unit		
Selection_Mouse(un)	
	If un\isSelected = 1
	
	Color 120,120,120	
	ss# = (Un\size+Un\size)
	Oval Un\tx-ss/2  ,Un\ty-ss/2 ,ss,ss,0	
	Line un\x ,un\y, un\tx ,un\ty 
	EndIf 
	If un\action = move Then 
	If Dis(un\x ,un\y ,  un\tx , un\ty)  <= un\speed+0.1 Then un\action = wait
	MoveUnit(un)
	EndIf 	
	;Text un\x#+12,un\y#+12, un\tx +"  "+ un\ty +"  "+ un\x +"  "+ un\y 
Next 
DrawUnit()


Flip 
Wend
Delete Each Unit
FreeFont cyr
End 



Function Selection_Mouse(this.Unit)

	If MouseDown(1) = True And selectionFlag = 0 Then
	
		selectionFlag = 1
		mx = MouseX()
		my = MouseY()
	EndIf
	If MouseDown(1) = True And selectionFlag = 1 Then
		this\isSelected = 0
		
		oldx= MouseX()
		oldy= MouseY()
	EndIf
	If MouseDown(1) = False Then selectionFlag = 0 
	If MouseHit (1) And RectsOverlap(mx#,my#,1,1,500,400,40,40) Then NewUnit("sold" , Rnd(600),Rnd(400))	
	If selectionFlag = 1 Then	
		If mx < oldx
			bx0 = mx
			bx1 = oldx
		Else
			bx0 = oldx
			bx1 =mx
		EndIf
		
		If my < oldy
			by0 = my
			by1 = oldy
		Else
			by0 = oldy
			by1 = my
		EndIf
	EndIf
	If this\x# > bx0 And this\x# < bx1 And this\y# > by0 And this\y# < by1 
		this\isSelected = 1
	ElseIf Dis(mx,my, this\x#,this\y#)<this\size
		this\isSelected = 1
	EndIf
End Function

Function DrawUnit()
	For Un.Unit = Each Unit
	If un\isSelected = 1 
		Text un\x#,un\y#-18,"S"
	Color 2,200,200	
	Oval middleX#-3 , middleY# -3 , 6 ,6
	Color 255,255,255
		If un\group >-1
			Text un\x#-4,un\y#+8, un\group	
		EndIf
	EndIf 	
;	If un\action = move Then Text un\x#+4,un\y#+8,"M"
;	If un\action = wait Then Text un\x#+4,un\y#+8,"W"
	
	Rect un\x#-5,un\y#-5,10,10,0 ; Unit
		
	Color 2,200,200
		If selectionFlag = 1	Then Rect bx0, by0, bx1-bx0, by1-by0,0	
	Color 255,255,255
		; -- button --
		Rect 500,400,40,40,0
		; -- info --
		Text 20,20,"mx = "+mx+"  my = "+my+"  oldx = "+oldx+"  oldy = "+oldy+"  group "+group
		Text 20,40,"Selected : "+ sel
	Next
End Function

Function MiddleSelect()
lowX# = 999999
lowY# = 999999
hightX# = 0
hightY# = 0
sel =0
For Un.Unit = Each Unit
	If un\isSelected = 1
	sel = sel +1 
		If un\x <= lowX Then lowX = un\x
		If un\y <= lowY Then lowY = un\y
		If un\x > hightX Then hightX = un\x
		If un\y > hightY Then hightY = un\y
	EndIf 
Next 
middleX = lowX + (hightX-lowX  )/2
middleY = lowY + (hightY-lowY  )/2
End Function

Function blockFormation(n )

ring = Sqr(n)
idx = n - (ring*ring)
If idx >= ring
formationY = ring
formationX = 2*ring - idx
Else
formationX = ring
formationY = idx
EndIf
End Function
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
pepel (26.12.2013)
Старый 23.12.2013, 16:34   #9
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: (ИИ)RTS... передвижение юнитов по клику

Другое построение Формации.

в предыдущем коде заменить функцию blockFormation() на этот код !

Код:
Function blockFormation(n )

ring = Sqr(n)
idx = n - (ring*ring)+ring
If idx >= ring
formationY = ring
formationX = 2*ring - idx
Else
formationX = ring
formationY = idx
EndIf
End Function


ещё вариант :
Function blockFormation(n )

ring = Sqr(n)
idx = n - (ring*ring)-ring
If idx >= ring
formationY = ring
formationX = 2*ring - idx
Else
formationX = ring
formationY = idx
EndIf
End Function


ещё
Function blockFormation(n )

ring = Sqr(n)
idx = (n - (ring*ring)+n)/2
If idx >= ring
formationY = ring
formationX = 2*ring - idx
Else
formationX = ring
formationY = idx
EndIf
End Function


и ещё ...
Function blockFormation(n )

ring = Sqr(n)
idx = (n - (ring*ring))-((ring*ring) /n)
If idx >= ring
formationY = ring
formationX = 2*ring - idx
Else
formationX = ring
formationY = idx
EndIf
End Function


А так же чтоб поменять направление расстановки ,достаточно
добавить эти строки:
formationX = formationX *-1 ; или 1
formationY = formationY *-1 ; или 1
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
pepel (26.12.2013)
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 08:45.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com