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

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

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

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

Ответ
 
Опции темы
Старый 07.10.2013, 21:51   #1
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
некоторые изометрические демки

Зажать ЛМ кнопку мыши и поводить в прямоугольнике ... немного подождать секунд эдак 2-5 ... пятна постепенно начнут исчезать


maxX = 300 : maxY= 150

Dim c#(maxX ,maxY)
Graphics 800,600,32,2 
SetBuffer BackBuffer() 


c(90,10)= 20


While Not KeyHit(1) 
Cls 
mx = MouseX() : my=MouseY() : z= Abs(MouseZ () )+12

If KeyHit(2) Then q= Not q
If MouseDown(1) Then md=1 Else md=0


	For y= 1 To maxY
		For x=1 To maxX 
			If x<maxX And x>0 And y<maxY And y>0
				If Int( ((mx - x)^2 + (my - y)^2)^.5 )<= z Then 
				If md=1
				If q=0 Then c(x,y)= c(x,y)+1
				If q=1 Then c(x,y)= c(x,y)-2
				EndIf 
				If c(x,y)> 255 Then c(x,y)=255
				Color 222,222,222
				Plot x,y
				EndIf 
			EndIf 
		Next 
	Next 

Color 222,222,222
Rect 0,0,maxX ,maxY,0
;If md=0
	For y= 1 To maxY
		For x=1 To maxX 
			co = 10+c(x,y)
			If co>255 Then co =255
			Color co,co,co
			If co<=0 Then co =0	:Color 0,0,255			
			;Plot 200+x-y,200+y-c(x,y)
			;Line 200+x-y,200+y-c(x,y)  , 200+x-y,200+y+4-c(x,y)
			;For z=1 To 20
;			If Int( ((mx - x)^2 + (my - y)^2)^.5 )<= z And md=1
			If x<maxX And x>0 And y<maxY And y>0
			If c(x,y) > c(x-1,y-1) Then c(x,y)=( c(x,y)+ c(x-1,y-1))/2 :Line 200+x-y,200+y-c(x,y)  , 200+x-y,200+y-c(x-1,y-1)
			If c(x,y) > c(x-1,y+1) Then c(x,y)=( c(x,y)+ c(x-1,y+1))/2 : Line 200+x-y,200+y-c(x,y)  , 200+x-y,200+y-c(x-1,y+1) 
			If c(x,y) > c(x+1,y-1) Then c(x,y)=( c(x,y)+c(x+1,y-1))/2 :Line 200+x-y,200+y-c(x,y)  , 200+x-y,200+y- c(x+1,y-1)
			If c(x,y) > c(x+1,y+1) Then c(x,y)=( c(x,y) + c(x+1,y+1))/2 :Line 200+x-y,200+y-c(x,y)  , 200+x-y,200+y-c(x+1,y+1)
			
			If c(x,y) > c(x,y-1) Then c(x,y)=( c(x,y)+c(x,y-1))/2 :Line 200+x-y,200+y-c(x,y)  , 200+x-y,200+y-c(x,y-1)
			If c(x,y) > c(x,y+1) Then c(x,y)=( c(x,y)+ c(x,y+1))/2 :Line 200+x-y,200+y-c(x,y)  , 200+x-y,200+y-c(x,y+1)
			If c(x,y) > c(x-1,y) Then c(x,y)=( c(x,y)+ c(x-1,y))/2 :Line 200+x-y,200+y-c(x,y)  , 200+x-y,200+y-c(x-1,y)
			If c(x,y) > c(x+1,y) Then c(x,y)=( c(x,y)+c(x+1,y))/2 : Line 200+x-y,200+y-c(x,y)  , 200+x-y,200+y- c(x+1,y)
;			EndIf 
			EndIf 
		Next 
	Next 
Color 222,222,222
Text 300,20,"Q "+q

Flip 
Wend 
End
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Старый 07.10.2013, 22:02   #2
St_AnGer
Элита
 
Аватар для St_AnGer
 
Регистрация: 21.01.2010
Адрес: Россия, Рязанская область, г.Михайлов
Сообщений: 2,067
Написано 1,185 полезных сообщений
(для 2,828 пользователей)
Ответ: некоторые изометрические демки

Мой настольный ПеКа чуть не погиб
__________________
Main PC:
Intel Core i5 4260U 1.44 GHz + LPDDR3 1x4096 1600 MHz + Intel HD Graphics 5000.

Asus Ёжик T101-MT:
Intel Atom N-570 1.66 Ghz + DDR2 2x1024 800 Mhz + Intel GMA 3150 128 Mb DDR2


Скачать Doom 2D: Remake v0.3.8a
(Offline)
 
Ответить с цитированием
Старый 08.10.2013, 12:42   #3
Arton
Быдлокодер
 
Аватар для Arton
 
Регистрация: 05.07.2009
Адрес: Проспит
Сообщений: 5,018
Написано 2,312 полезных сообщений
(для 5,349 пользователей)
Ответ: некоторые изометрические демки

Мой ПеКа конечно не загнулся, но код очень тормознутый.
(Offline)
 
Ответить с цитированием
Старый 08.10.2013, 16:10   #4
moka
.
 
Регистрация: 05.08.2006
Сообщений: 10,429
Написано 3,454 полезных сообщений
(для 6,863 пользователей)
Ответ: некоторые изометрические демки

А можно скрины хоть прикладывать?
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
Mr_F_ (08.10.2013)
Старый 08.10.2013, 16:49   #5
Arton
Быдлокодер
 
Аватар для Arton
 
Регистрация: 05.07.2009
Адрес: Проспит
Сообщений: 5,018
Написано 2,312 полезных сообщений
(для 5,349 пользователей)
Ответ: некоторые изометрические демки

(Offline)
 
Ответить с цитированием
Эти 2 пользователя(ей) сказали Спасибо Arton за это полезное сообщение:
Mr_F_ (08.10.2013), Randomize (11.10.2013)
Старый 08.10.2013, 21:08   #6
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: некоторые изометрические демки

Прокрутить колёсико мыши в прямоугольнике ... Зажать ЛМ кнопку мыши и держать некоторое время постепенно поводя по прямоугольнику ...
И увидеть как растут горы

Dim c(100 ,50) : Dim s(12 ,12 )
Global mx ,my , mz , mzz , md , q
Graphics 800,600,32,2 
SetBuffer BackBuffer() 
k=1

	For b= 1 To 12 
		For a=1 To 12 
		
		c(a,b)= Rand(0,1)
		s(a,b)= Rand(0,255)
		Next 
	Next 


ClsColor 222,222,222
While Not KeyHit(1) 
mx = MouseX() : my=MouseY() : mz = Abs(MouseZ () )+1

Cls 
If mx>1 And mx<100 And my>1 And my<50

Color 115,115,115
Line mx,0,mx,50
Line 0,my,100,my
Color 255,5,5
Oval mx-mz+0.5,my-mz+0.5 ,mz*2,mz*2,0
EndIf 
If MouseDown(1) Then md=1 Else md=0
If KeyHit(2) Then q= Not q

module()
Draw()


Color 55,55,55
Rect 0,0,100,50,0

Text 100,20,"mz = "+mz   +"  q = "+q

Flip 
Wend 
End 

Function module()

	For y= 1 To 50
		For x=1 To 100
	
			For z=0 To mz
			
			If Int( ((mx - x)^2 + (my - y)^2)^.5 ) = z Then 
				
				col1 = mz-z
			If md=1 And q=0 Then 	c(x,y) =c(x,y)+ ((mz-z )*0.2)
			If md=1 And q=1 Then 	c(x,y) =c(x,y)-  ((mz-z )*0.2)
				If col1>255 Then col1 =255
				If c(x,y)<=1 Then c(x,y) =1
			;	Color col1,col1,col1
			;	Plot x,y-z1	
							
			EndIf 

			Next 


		Next 
	Next 
End Function 

Function Draw()
	For y= 1 To 50
		For x=1 To 100 
			col3=c(x,y)
			If col3>255 Then col3=255
			Color col3,col3,col3
			If col3<=1 Then  Color 0,0,100 
				
			;	Plot 100+x+y,100+y-c(x,y)		
				Line 	100+x+y,100+y-c(x,y)  , 100+x+y,100+y+c(x,y)
			For z=0 To mz
			If Int( ((mx - x)^2 + (my - y)^2)^.5 ) = z Then 
				
				col2 = 20+z*4
				If col2>255 Then col2 =255
				Color col2,col2,col2
				If col2<=1 Then  Color 0,0,250 
			;	Plot 100+x+y,100+y-c(x,y)	
				Line 	100+x+y,100+y-c(x,y)  , 100+x+y,100+y+c(x,y)		
			EndIf 

			Next 



		Next 
	Next 
End Function 

Function DistABS(ax,ay,bx,by)
	Return  (Abs(bx-ax)+Abs (by-ay))
End Function
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Старый 08.10.2013, 21:12   #7
Reizel
Задрот
 
Аватар для Reizel
 
Регистрация: 24.07.2009
Адрес: Ивановская область, г. Кинешма
Сообщений: 1,574
Написано 407 полезных сообщений
(для 863 пользователей)
Ответ: некоторые изометрические демки

Я медленно покрутил колёсиком мыши в прямоугольнике...
Сильно стиснув другой рукой ЛКМ, я поводил ею по прямоугольнику, оу..
Прямоугольник был доволен
__________________
(Offline)
 
Ответить с цитированием
Старый 08.10.2013, 21:28   #8
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: некоторые изометрические демки

Ага , я сам тащюсь .

всё тоже самое но по другому
Чур на чёрный кружочек не смотреть , он стесняется .
maxX = 100 : maxY= 100

Dim c#(maxX ,maxY)
Graphics 800,600,32,2 
SetBuffer BackBuffer() 

s=10
;c(90,10)= 20

ClsColor 152,251,152
While Not KeyHit(1) 
Cls 
mx = MouseX() : my=MouseY() : z= Abs(MouseZ () )+1

mmy= (2*my-mx)/2
mmx= mx+mmy


If KeyHit(2) Then q= Not q
If KeyHit(57) Then flips=Not flips

If MouseDown(1) Then md=1 Else md=0

Color 60,179,113
Rect s,s,maxX ,maxY,1


	For y= 1 To maxY ;Step 2
		For x=1 To maxX   ;Step 2
			If x+s<=maxX+s  And x+s>=0 And y+s<=maxY+s And y+s>=0 Then

				If Int( (((mx+s )-( x+s))^2 + ((my+s) -( y+s))^2)^.5 )= z ;And md=1  	
					Color 222,222,222
					Plot x+s,y+s
					If md=1	
					If q=0 Then c(x,y)= c(x,y)+Rnd(3)
					If q=1 Then c(x,y)= c(x,y)-Rnd(3)
					
					If c(x,y)> 255 Then c(x,y)=255
					
					If c(x,y)<=0 Then c(x,y)=0

					EndIf 		
				EndIf 

			EndIf 
		Next 
	Next 


;If md=0
	For y= 1 To maxY ;Step 2
		For x=1 To maxX  ;Step 2

			If flips=0 Then frontX= 200+(x-y) : frontY= 300+((x+y)/2) Else frontX=(200+maxX)+ (-x-y) : frontY= (300+maxY /2)+((-x+y)/2)		 
			
			co = 50+c(x,y)
			If co>255 Then co =255
			If co<=0 Then 
			 co=0
			Color 0,0,255
			Plot 200+frontX,200+frontY-c(x,y)
			Else 
			Color co,co,co

			Line   frontX,frontY-c(x,y)  , frontX,frontY-c(x,y) +5
			
			EndIf
			If Int( ((mx - x)^2 + (my - y)^2)^.5 )<= z 
			If x+1<=maxX  And x-1>=0 And y+1<=maxY And y-1>=0 And md=1
			If c(x,y) > c(x-1,y-1) Then c(x-1,y-1)=c(x,y)- 2
			If c(x,y) > c(x-1,y+1) Then c(x-1,y+1)=c(x,y)- 2
			If c(x,y) > c(x+1,y-1) Then c(x+1,y-1)=c(x,y)-2
			If c(x,y) > c(x+1,y+1) Then c(x+1,y+1)=c(x,y)-2
			
			If c(x,y) > c(x,y-1) Then c(x,y-1)=c(x,y)- 1
			If c(x,y) > c(x,y+1) Then c(x,y+1)=c(x,y)- 1
			If c(x,y) > c(x-1,y) Then c(x-1,y)=c(x,y)- 1
			If c(x,y) > c(x+1,y) Then c(x+1,y)=c(x,y)-1
			EndIf 
			EndIf 
		Next 
	Next 
Color 22,22,22
Oval 200+mmx-3,300+mmy-3,6,6,1
Text 300,20,"Q "+q+" flips = "+ flips

Flip 
Wend 
End  

Function DistABS(ax,ay,bx,by)
	Return  (Abs(bx-ax)+Abs (by-ay))
End Function
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Старый 14.10.2013, 19:39   #9
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: некоторые изометрические демки

Думаю немного наглядных примеров действий с векторами под блитз ,не помешаеют.
Статья донор здесь и здесь , а так же там много разных примеров .

; наглядное изображение векторов 

Type Vector
	Field X# , Y# , L# , vX# , vY#
End Type
	
Graphics 800,600,32,2 
SetBuffer BackBuffer() 
ArialCyrFont = LoadFont ("Arial cyr",16)
SetFont ArialCyrFont 
qx1# = 200 : qy1# = 200
qx2# = 220 : qy2# = 350
F.Vector= Vector(qx1,qy1,qx2,qy2)
VectorNormalize(F)
F1.Vector= VectorClone(F)
F2.Vector= VectorClone(F)
F3.Vector= VectorClone(F)

VectorLeft(F2)
VectorRight(F1)
VectorReverse(F3)
While Not KeyHit(1) 
mx#  = MouseX() : my# = MouseY()
Cls 

	Color 120,120,120
	If Dist( qx1,qy1,mx,my)<10 And MouseDown(1) 
		qx1= mx : qy1=my
		Oval mx-10,my-10, 20,20,0	
		
	Else 
		Rect  qx1-5,qy1-5, 10,10,0	
	EndIf 
	If Dist( qx2,qy2,mx,my)<10  And MouseDown(1) 
		qx2= mx : qy2=my
		Oval mx-10,my-10, 20,20,0	
		VectorReverseClone(F3,F)
	Else 
		Rect  qx2-5,qy2-5, 10,10,0
	EndIf
	
	VectorUpdata(F, qx1,qy1,qx2,qy2)
	VectorCloneUpdata(F1 , F)
	VectorCloneUpdata(F2 , F)
	VectorCloneUpdata(F3 , F)
	VectorLeft(F2)
	VectorRight(F1)	
	VectorReverseClone(F3,F)
	
	


VectorDraw(F,qx1,qy1,255,0,0)
VectorDraw(F1,qx1,qy1,0,0,255)
VectorDraw(F2,qx1,qy1,0,255,0)
VectorDraw(F3,qx1,qy1,150,150,150)

Text 20,20,"Навести мышь на квадрат и удерживая нажатой левую кнопку мыши, затем "
Text 20,40,"переместить стрелку мыши в новую позицию"
Flip 
Wend 
Delete Each Vector
FreeFont ArialCyrFont 
End


Function VectorDraw(a.Vector ,X1# , Y1# , R=255, G=255, B=255)

	Color R,G,B
	Line X1 ,Y1 , X1+ a\X*a\L , Y1+a\Y*a\L
	Oval X1+a\X*a\L-2,Y1+ a\Y*a\L-2,3,3,1
	Color 255,255,255
	Line X1 ,Y1 , X1+ a\X*5 , Y1+a\Y*5	
End Function	

Function VectorClone.Vector(a.Vector)
	Local v.Vector = New Vector
	v\X = a\X
	v\Y = a\Y
	v\L = a\L
	Return v
End Function

Function Vector.Vector(X1#=0,Y1#=0,X2#=0,Y2#=0)
	Local v.Vector = New Vector
	v\X = X2 -X1
	v\Y = Y2 -Y1
	v\vX = v\X
	v\vY = v\Y
	Return v
End Function

Function VectorUpdata(a.Vector , X1#=0,Y1#=0,X2#=0,Y2#=0)
	a\X = X2 -X1
	a\Y = Y2 -Y1
	a\vX = a\X
	a\vY = a\Y
	a\L = VectorMagnitude#(a)
	VectorNormalize(a)
End Function

Function VectorCloneUpdata(a.Vector , b.Vector)
	a\X =b\X
	a\Y = b\Y
	a\vX = b\vX
	a\vY = b\vY
	a\L = b\L
End Function
	
Function VectorAdd(a.Vector,b.Vector)
	a\X =a\X + b\X
	a\Y =a\Y + b\Y
End Function
	
Function VectorRight(a.Vector)
Local  cX# , cY#
	cX= -a\X  : cY = a\Y
	a\X =cY
	a\Y =cX
End Function
	
Function VectorLeft(a.Vector)
Local  cX# , cY#
	cX= a\X  : cY = -a\Y
	a\X =cY
	a\Y =cX
End Function

Function VectorReverse(a.Vector)
Local  cX# , cY#
	cX= -a\X  : cY = -a\Y
	a\X =cX
	a\Y =cY
End Function

Function VectorReverseClone(a.Vector,b.Vector)
	a\X =-b\X
	a\Y =-b\Y
End Function
	
Function VectorSubtract(a.Vector,b.Vector)
	a\X =a\X - b\X
	a\Y =a\Y - b\Y
End Function
	
Function VectorSum.Vector(a.Vector,b.Vector)
	Return Vector(a\X+b\X,a\Y+b\Y)
End Function
	
Function VectorDifference.Vector(a.Vector,b.Vector)
	Return Vector(a\X-b\X,a\Y-b\Y)
End Function
	
Function VectorMultiply(a.Vector,b.Vector)
	a\X =a\X * b\X
	a\Y =a\Y * b\Y
End Function
	
Function VectorDivide(a.Vector,b.Vector)
	a\X =a\X / b\X
	a\Y =a\Y / b\Y
End Function
	
Function VectorProduct.Vector(a.Vector,b.Vector)
	Return Vector(a\X*b\X,a\Y*b\Y)
End Function
	
Function VectorQuotient.Vector(a.Vector,b.Vector)
	Return Vector(a\X/b\X,a\Y/b\Y)
End Function

Function VectorCross(a.Vector,b.Vector)
	Return  (a\X*b\Y)-(a\Y*b\X) 
End Function	

Function VectorDot#(a.Vector,b.Vector)
	Return (a\X*b\X) + (a\Y*b\Y)
End Function
	
Function VectorAngle#(a.Vector,b.Vector)
	Local d# = VectorDot(a,b)
	Local m# = VectorMagnitude(a)*VectorMagnitude(b)
	Return ACos(d#/m#)
End Function
	
Function VectorNormalize(a.Vector)
	Local m# = VectorMagnitude(a)
	If m<= 0.0001Then m=1
	a\X = a\X / m#
	a\Y = a\Y / m#
End Function
	
Function VectorMagnitude#(a.Vector)
	a\L = Sqr(a\X*a\X + a\Y*a\Y)
	Return a\L
End Function

Function Dist#( X1#, Y1#, X2#, Y2# )
	Return Abs(( (X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2) )^0.5)
End Function

; наглядное изображение векторов 

Type Vector
	Field X# , Y# , L# , vX# , vY#
	Field px# , py# ,px2# , py2#
End Type
Global qx1#,qy1#
	
Graphics 800,600,32,2 
SetBuffer BackBuffer() 
ArialCyrFont = LoadFont ("Arial cyr",16)
SetFont ArialCyrFont 
qx1# = 300 :qx2# = 290 
qy1# = 50 : qy2# = 120

F.Vector= Vector(qx1,qy1,qx2,qy2)
;VectorNormalize(F)
F1.Vector= Vector(250,250,400,200)
VectorNormalize(F1)
F2.Vector= Vector(qx1,qy1,250,250)
;VectorNormalize(F2)
While Not KeyHit(1) 
mx#  = MouseX() : my# = MouseY()
Cls 

	Color 120,120,120
	If Dist( qx1,qy1,mx,my)<10 And MouseDown(1) 
		qx1= mx : qy1=my
		Oval mx-10,my-10, 20,20,0			
	Else 
		Rect  qx1-5,qy1-5, 10,10,0	
	EndIf 
	If Dist( qx2,qy2,mx,my)<10  And MouseDown(1) 
		qx2= mx : qy2=my
		Oval mx-10,my-10, 20,20,0	
	Else 
		Rect  qx2-5,qy2-5, 10,10,0
	EndIf

	VectorUpdata(F, qx1,qy1,qx2,qy2)
	VectorUpdata(F2, qx1,qy1,250,250)
	t# = FindIntersectionVectors#(F,F1, F2); 
	fx# = FindX#(F1,t#)
	fy# = FindY#(F1,t#)
	Rect fx-5,fy-5,10,10,1
	Color 120,0,0
	Rect fx-5,fy-5,10,10,0
VectorDraw(F,255,0,0)
VectorDraw(F1,0,0,255)
VectorDraw(F2,0,255,0)

Text 20,20,"Навести мышь на квадрат и удерживая нажатой левую кнопку мыши, затем "
Text 20,40,"переместить стрелку мыши в новую позицию"
Text 20,60,"VectorMagnitude : "+t
Flip 
Wend 
Delete Each Vector
FreeFont ArialCyrFont 
End


Function VectorDraw(a.Vector , R=255, G=255, B=255)

	Color R,G,B
	Line a\px ,a\py , a\px+ a\X*a\L , a\py+a\Y*a\L
	Oval a\px+a\X*a\L-2,a\py+ a\Y*a\L-2,3,3,1
	Color 255,255,255
	Line a\px,a\py , a\px+ a\X*5 , a\py+a\Y*5	
	Oval a\px+a\X*a\L-3,a\py+ a\Y*a\L-3,5,5,0
End Function	

Function VectorClone.Vector(a.Vector)
	Local v.Vector = New Vector
	v\X = a\X
	v\Y = a\Y
	v\L = a\L
	v\px = a\px
	v\py = a\py
	v\px2 = a\px2
	v\py2 = a\py2
	Return v
End Function

Function Vector.Vector(X1#=0,Y1#=0,X2#=0,Y2#=0)
	Local v.Vector = New Vector
	v\X = X2 -X1
	v\Y = Y2 -Y1
	v\vX = v\X
	v\vY = v\Y
	v\px =X1
	v\py = Y1
	v\px2 =X2
	v\py2 = Y2
	Return v
End Function

Function VectorUpdata(a.Vector , X1#=0,Y1#=0,X2#=0,Y2#=0)
	a\X = X2 -X1
	a\Y = Y2 -Y1
	a\vX = X2 -X1
	a\vY = Y2 -Y1
	a\px = X1
	a\py = Y1
	a\L = VectorMagnitude#(a)
	VectorNormalize(a)
End Function

Function	FindIntersectionVectors#(a.Vector,b.Vector, c.Vector); 
	Local t#
	
	VectorUpdata(c, a\px,a\py,b\px,b\py)
	If ((a\x = b\x And a\y = b\y) Or (a\x = -a\x And a\y = -b\y)) 
		t = 1000000
	 Else 
		 t# =(c\vx*a\vy-c\vy*a\vx)/(a\vx*b\vy-a\vy*b\vx)
	EndIf
	Return t
End Function	

Function FindX#(a.Vector,tt#)
	Return a\px + a\vx*tt
End Function

Function FindY#(a.Vector,tt#)
	Return  a\py + a\vy*tt
End Function

Function VectorCloneUpdata(a.Vector , b.Vector)
	a\X =b\X
	a\Y = b\Y
	a\vX = b\vX
	a\vY = b\vY
	a\L = b\L
End Function
	
Function VectorAdd(a.Vector,b.Vector)
	a\X =a\X + b\X
	a\Y =a\Y + b\Y
End Function
	
Function VectorRight(a.Vector)
Local  cX# , cY#
	cX= -a\X  : cY = a\Y
	a\X =cY
	a\Y =cX
End Function
	
Function VectorLeft(a.Vector)
Local  cX# , cY#
	cX= a\X  : cY = -a\Y
	a\X =cY
	a\Y =cX
End Function

Function VectorReverse(a.Vector)
Local  cX# , cY#
	cX= -a\X  : cY = -a\Y
	a\X =cX
	a\Y =cY
End Function

Function VectorReverseClone(a.Vector,b.Vector)
	a\X =-b\X
	a\Y =-b\Y
End Function
	
Function VectorSubtract(a.Vector,b.Vector)
	a\X =a\X - b\X
	a\Y =a\Y - b\Y
End Function
	
Function VectorSum.Vector(a.Vector,b.Vector)
	Return Vector(a\X+b\X,a\Y+b\Y)
End Function
	
Function VectorDifference.Vector(a.Vector,b.Vector)
	Return Vector(a\X-b\X,a\Y-b\Y)
End Function
	
Function VectorMultiply(a.Vector,b.Vector)
	a\X =a\X * b\X
	a\Y =a\Y * b\Y
End Function
	
Function VectorDivide(a.Vector,b.Vector)
	a\X =a\X / b\X
	a\Y =a\Y / b\Y
End Function
	
Function VectorProduct.Vector(a.Vector,b.Vector)
	Return Vector(a\X*b\X,a\Y*b\Y)
End Function
	
Function VectorQuotient.Vector(a.Vector,b.Vector)
	Return Vector(a\X/b\X,a\Y/b\Y)
End Function

Function VectorCross#(a.Vector,b.Vector)
	Return (a\X*b\Y)-(a\Y*b\X) 
End Function	


Function VectorDot#(a.Vector,b.Vector)
	Return (a\X*b\X) + (a\Y*b\Y)
End Function
	
Function VectorAngle#(a.Vector,b.Vector)
	Local d# = VectorDot(a,b)
	Local m# = VectorMagnitude(a)*VectorMagnitude(b)
	Return ACos(d#/m#)
End Function
	
Function VectorNormalize(a.Vector)
	Local m# = VectorMagnitude(a)
	If m<= 0.0001Then m=1
	a\X = a\X / m#
	a\Y = a\Y / m#
End Function
	
Function VectorMagnitude#(a.Vector)
	a\L = Sqr(a\X*a\X + a\Y*a\Y)
	Return a\L
End Function

Function Dist#( X1#, Y1#, X2#, Y2# )
	Return Abs(( (X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2) )^0.5)
End Function


Конечно ,лучше оформить отдельный ББ файл с функциями операций над векторами и просто присоединять его к основной программе.
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Старый 18.10.2013, 21:11   #10
Randomize
[object Object]
 
Аватар для Randomize
 
Регистрация: 01.08.2008
Адрес: В России
Сообщений: 4,354
Написано 2,470 полезных сообщений
(для 6,850 пользователей)
Ответ: некоторые изометрические демки

Сообщение от polopok Посмотреть сообщение
Статья донор здесь и здесь , а так же там много разных примеров .
Рекомендую по теме:
http://habrahabr.ru/post/131931/
__________________
Retry, Abort, Ignore? █
Intel Core i7-9700 4.70 Ghz; 64Gb; Nvidia RTX 3070
AMD Ryzen 7 3800X 4.3Ghz; 64Gb; Nvidia 1070Ti
AMD Ryzen 7 1700X 3.4Ghz; 8Gb; AMD RX 570
AMD Athlon II 2.6Ghz; 8Gb; Nvidia GTX 750 Ti
(Offline)
 
Ответить с цитированием
Старый 18.10.2013, 23:11   #11
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: некоторые изометрические демки

Рекомендую по теме:
http://habrahabr.ru/post/131931/
Спасибо ,давно лежит в закладках ...

продолжаем ...
проекция вектора на вектор .Статья донор Урок: базовые алгоритмы определения столкновений
код:
Type Vector
	Field lenght# ,vx#,vy#, dx# , dy# , rx#,ry# ,lx#,ly#
	Field px#[1] , py#[1] , selected = False , R ,G ,B
End Type
Global qx1#,qy1#

Graphics 800,600,32,2 
SetBuffer BackBuffer() 
ArialCyrFont = LoadFont ("Arial cyr",16)
SetFont ArialCyrFont 

v1.Vector = NewVector(150,100,200,150,0,0,100)
v2.Vector = NewVector(150,100,150,50,88,88,88)

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

For point.Vector = Each Vector
	If point <>Null Then 
	
		For p = 0 To 1
			Color 120,120,120
			If Dist(point\px[p] ,point\py[p],mx,my)<10 And MouseDown(1) 
				point\px[p] = mx 
				point\py[p] = my
				Oval mx-10,my-10, 20,20,0
				
			Else 
				Rect  point\px[p]-5,point\py[p]-5, 10,10,0	
			EndIf
		Next 
		If point\px[0]=point\px[1] And point\py[0]=point\py[1] Then 
			point\px[1]= point\px[1] +15
			point\py[1]= point\py[1] +15
		EndIf
	End If 
Next
		
		VectorUpdate(v1,v1\R ,v1\G ,v1\B)
		VectorUpdate(v2,v2\R ,v2\G ,v2\B)	
		dp# = projectVector(v1,v2\dx,v2\dy)


For point.Vector = Each Vector
	If point <>Null Then 		
		VectorDraw(point )
	End If 
Next		
	Color 0,255,0
	Line v2\px[0],v2\py[0] , v2\px[0] + v2\dx*dp	,v2\py[0]+ v2\dy*dp
	Oval v2\px[0]+v2\dX*dp -3,v2\py[0]+ v2\dY*dp -3,5,5,0
	Color 48,48,48
	Line v1\px[1],v1\py[1] , v2\px[0] + v2\dx*dp	,v2\py[0]+ v2\dy*dp

Text 220,20,"Навести мышь на квадрат и удерживая нажатой левую кнопку мыши,"
Text 220,40,"переместить стрелку мыши в новую позицию"
Text 220,60,"VectorDot: "+dp#
Flip 
Wend 
Delete Each Vector
FreeFont ArialCyrFont 
End
;[ end ]==============================================================================

Function projectVector#(a.Vector,dx#,dy#);
	; find dot product
	Local dp# =  a\vx*dx+a\vy*dy;
	Return dp#
End Function

Function FindXproject#(v.Vector,dp#)
	Return v\vx = dp#*v\dx;
End Function

Function FindYproject#(v.Vector,dp#)
	Return v\vy = dp#*v\dy;
End Function

Function VectorDraw(a.Vector  )
	Color 68,68,68
	Line a\px[0]+(-a\dx*1000 ) ,a\py[0]+(-a\dy*1000)  , a\px[0]+a\dx*1000   , a\py[0]+a\dy*1000 
	Color a\R,a\G,a\B
	Line a\px[0] ,a\py[0] , a\px[0]+ a\dX*a\lenght  , a\py[0]+a\dY*a\lenght 
	
	Oval a\px[0]+a\dX*a\lenght -2,a\py[0]+ a\dy*a\lenght -2,3,3,1
	
	Color 205,205,205
	Line a\px[0],a\py[0] , a\px[0]+ a\dX*5 , a\py[0]+a\dY*5	
	
	Oval a\px[0]+a\dX*a\lenght -3,a\py[0]+ a\dY*a\lenght -3,5,5,0
End Function	

Function NewVector.Vector(X1#=0,Y1#=0,X2#=0,Y2#=0, R= 255,G= 255,B= 255)
	Local v.Vector = New Vector
	v\vx = X2 -X1
	v\vy = Y2 -Y1
	v\lenght = VectorMagnitude#(v)
	; normalized
	v\dx = v\vx / v\lenght
	v\dy = v\vy / v\lenght
	; Right hand normal
	v\rx = -v\vy
	v\ry = v\vx
	; Left hand normal
	v\lx = v\vy
	v\ly = -v\vx
	; Coordinate Points
	v\px[0] =X1
	v\py[0] = Y1
	v\px[1] =X2
	v\py[1] = Y2
	; Vector colors 
	v\R = R
	v\G = G
	v\B = B
	Return v
End Function

Function VectorUpdate(v.Vector, R= 255,G= 255,B= 255)
	v\vx = v\px[1] -v\px[0]
	v\vy = v\py[1] -v\py[0]
	v\lenght = VectorMagnitude#(v)
	; normalized
	v\dx = v\vx / v\lenght
	v\dy = v\vy / v\lenght
	; Right hand normal
	v\rx = -v\vy
	v\ry = v\vx
	; Left hand normal
	v\lx = v\vy
	v\ly = -v\vx
	; Vector colors 
	v\R = R
	v\G = G
	v\B = B
End Function

Function VectorReverse(a.Vector)
	a\vX = -a\vX
	a\vY = -a\vY
End Function

Function VectorSubtract(a.Vector,b.Vector)
	a\vX =a\vX - b\vX
	a\vY =a\vY - b\vY
End Function

;Function VectorSum.Vector(a.Vector,b.Vector)
;	Return (a\vX+b\vX,a\vY+b\vY)
;End Function
	
;Function VectorDifference.Vector(a.Vector,b.Vector)
;	Return Vector(a\vX-b\vX,a\vY-b\vY)
;End Function
	
Function VectorMultiply(a.Vector,b.Vector)
	a\vX =a\vX * b\vX
	a\vY =a\vY * b\vY
End Function
	
Function VectorDivide(a.Vector,b.Vector)
	a\vX =a\vX / b\vX
	a\vY =a\vY / b\vY
End Function

Function VectorCross#(a.Vector,b.Vector)
	Return (a\vX*b\vY)-(a\vY*b\vX) 
End Function	


Function VectorDot#(a.Vector,b.Vector)
	Return (a\vX*b\vX) + (a\vY*b\vY)
End Function
	
Function VectorAngle#(a.Vector,b.Vector)
	Local d# = VectorDot(a,b)
	Local m# = VectorMagnitude(a)*VectorMagnitude(b)
	Return ACos(d#/m#)
End Function
	
Function VectorNormalize(a.Vector)
	Local m# = VectorMagnitude(a)
	If m<= 0.0001Then m=1
	a\vX = a\vX / m#
	a\vY = a\vY / m#
End Function
	
Function VectorMagnitude#(a.Vector)
	a\lenght = Sqr(a\vX*a\vX + a\vY*a\vY)
	Return a\lenght
End Function


;Function VectorProduct.Vector(a.Vector,b.Vector)
;	Return Vector(a\vX*b\vX,a\vY*b\vY)
;End Function
	
;Function VectorQuotient.Vector(a.Vector,b.Vector)
;	Return Vector(a\vX/b\vX,a\vY/b\vY)
;End Function

Function Dist#( X1#, Y1#, X2#, Y2# )
	Return Abs(( (X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2) )^0.5)
End Function
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Старый 26.10.2013, 08:44   #12
Randomize
[object Object]
 
Аватар для Randomize
 
Регистрация: 01.08.2008
Адрес: В России
Сообщений: 4,354
Написано 2,470 полезных сообщений
(для 6,850 пользователей)
Ответ: некоторые изометрические демки

Сообщение от polopok Посмотреть сообщение
Function Dist#( X1#, Y1#, X2#, Y2# )
	Return Abs(( (X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2) )^0.5)
End Function
Ммм... Для такой записи есть причины? Суть то ясна, но не проще ли
Function Dist#(x1#, y1#, x2#, y2#)
	Local nx# = x1 - x2
	Local ny# = y1 - y2
	Return Sqr( (nx * nx) + (ny * ny))
End Function
__________________
Retry, Abort, Ignore? █
Intel Core i7-9700 4.70 Ghz; 64Gb; Nvidia RTX 3070
AMD Ryzen 7 3800X 4.3Ghz; 64Gb; Nvidia 1070Ti
AMD Ryzen 7 1700X 3.4Ghz; 8Gb; AMD RX 570
AMD Athlon II 2.6Ghz; 8Gb; Nvidia GTX 750 Ti
(Offline)
 
Ответить с цитированием
Старый 26.10.2013, 10:56   #13
MiXaeL
Бывалый
 
Аватар для MiXaeL
 
Регистрация: 22.08.2006
Сообщений: 700
Написано 146 полезных сообщений
(для 267 пользователей)
Ответ: некоторые изометрические демки

Брать корни для расстояния - плохой тон. Особенно в блитце
(Offline)
 
Ответить с цитированием
Старый 26.10.2013, 10:59   #14
Randomize
[object Object]
 
Аватар для Randomize
 
Регистрация: 01.08.2008
Адрес: В России
Сообщений: 4,354
Написано 2,470 полезных сообщений
(для 6,850 пользователей)
Ответ: некоторые изометрические демки

Сообщение от MiXaeL Посмотреть сообщение
Брать корни для расстояния - плохой тон. Особенно в блитце
Какие ваши доказательства?
__________________
Retry, Abort, Ignore? █
Intel Core i7-9700 4.70 Ghz; 64Gb; Nvidia RTX 3070
AMD Ryzen 7 3800X 4.3Ghz; 64Gb; Nvidia 1070Ti
AMD Ryzen 7 1700X 3.4Ghz; 8Gb; AMD RX 570
AMD Athlon II 2.6Ghz; 8Gb; Nvidia GTX 750 Ti
(Offline)
 
Ответить с цитированием
Старый 26.10.2013, 12:11   #15
MiXaeL
Бывалый
 
Аватар для MiXaeL
 
Регистрация: 22.08.2006
Сообщений: 700
Написано 146 полезных сообщений
(для 267 пользователей)
Ответ: некоторые изометрические демки

На вычисление корня уходит порядка 15-20 тактов. Можно просто хранить квадрат расстояния в double имея в итоге расстояние с точностью до float. Т.е. если отношение максимального расстояния к минимальному не превышает 1 << 32, то вычислять корни бессмысленно.
А в блитце вообще с математикой беда какая-то, она в десятки раз медленнее сишной.
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
Randomize (26.10.2013)
Ответ


Опции темы

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

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


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


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