Важная информация
Страница 1 из 2 12 ПоследняяПоследняя
Показано с 1 по 10 из 14

Тема: FireFlies

  1. #1 FireFlies 
    Разбирающийся
    Регистрация
    13.10.2013
    Сообщений
    53
    Сказал(а) спасибо
    52
    Поблагодарили 34 раз(а) в 22 сообщениях
    В теме не нашел ни одной (почти не одной) программы 32 и 64 bit... И сложился мнения, что здесь недолюбливают не-ДОС приложения. Однако, т.к. в разделе есть FreeBasic, решил все равно выложить свой проект.

    Проект, конечно, не то, чтобы уж очень грандиозный (страшности тут рассказывают про год или пять коддинга), но писал я его не один день - около недели (для меня эта программа была довольно сложна - не знаю, как для вас).
    Код
    Код freebasic:
    ScreenRes 1024, 768, 32
     
    Const lon=550
    Const turn=6.28
    Const speed=5
    Const radius=50	
    Const speed2=1000
    Const speed3=0.05
     
    Dim Shared mtimer As Double
    Dim Shared start As Double 
    Dim Shared a(1 To 3, 1 To lon, 1 To 2) As Integer
    Dim As Integer i, n, bu, m1, m2, wh, res
    Dim As Single cix, ciy, shift, rad, c1, c2
     
    c1=512
    c2=384
     
    Sub tim (com As Integer)
    	If com=1 Then mtimer=Timer-start
    	If com=0 Then mtimer=0: start=Timer
    	If mtimer>turn/speed Then tim(0)
    End Sub
     
    Sub np (x As Integer, y As Integer, f As Integer)
    	Dim As Integer i
    	For i=0 To lon-2
    		a(f,lon-i,1)=a(f,lon-(i+1),1)
    		a(f,1,1)=x
    	Next i
    	For i=0 To lon-2
    		a(f,lon-i,2)=a(f,lon-(i+1),2)
    		a(f,1,2)=y
    	Next i
    End Sub
     
    Sub pp
    	Dim As Integer i
    	For i=1 To lon-1
    		Line (a(1,i,1),a(1,i,2))-(a(1,i+1,1),a(1,i+1,2)), RGB(Int(255-225*(i-1)/(lon-2)),0,0)
    	Next i
    	For i=1 To lon-1
    		Line (a(2,i,1),a(2,i,2))-(a(2,i+1,1),a(2,i+1,2)), RGB(0,Int(255-225*(i-1)/(lon-2)),0)
    	Next i
    	For i=1 To lon-1
    		Line (a(3,i,1),a(3,i,2))-(a(3,i+1,1),a(3,i+1,2)), RGB(0,0,Int(255-225*(i-1)/(lon-2)))
    	Next i
    End Sub
     
    Sub cir (ByRef x As Single, ByRef y As Single, ByVal shift As Single, rad As Single)
    	x=Sin(mtimer*speed+shift)*rad
    	y=Sin((mtimer+1.57)*speed+shift)*rad
    End Sub
     
    Sub fly(x As integer, y As integer, ByRef c1 As Single, ByRef c2 As Single, ByRef rad As Single)
    	Dim As Single d, v1, v2
    	d=Sqr((x-c1)^2+(y-c2)^2)
    	rad=radius/d^0.4
    	If d<1 Then rad=radius
    	v1=(x-c1)/speed2
    	v2=(y-c2)/speed2
    	If Abs(v1)<speed3 Then v1=speed3*Sgn(v1)
    	If Abs(v2)<speed3 Then v2=speed3*Sgn(v2)
    	c1=c1+v1
    	c2=c2+v2
    End Sub
     
    tim(0)
    While InKey$=""
    	res=GetMouse(m1, m2, wh, bu)
    	If bu=2 Then cls
    	If m1>-1 Then fly(m1, m2, c1, c2, rad) Else rad=radius
    	tim(1)
    	cir(cix, ciy, 0, rad)
    	np(c1+cix, c2+ciy, 1)
    	cir(cix, ciy, 2.09, rad)
    	np(c1+cix, c2+ciy, 2)
    	cir(cix, ciy, 4.18, rad)
    	np(c1+cix, c2+ciy, 3)
    	pp()
    Wend
    End

    Знаю, код местами кривой... Но работает Вот скриншоты:
    [Ссылки могут видеть только зарегистрированные пользователи. ][Ссылки могут видеть только зарегистрированные пользователи. ]
    Можно поиграться с константами:
    [Ссылки могут видеть только зарегистрированные пользователи. ][Ссылки могут видеть только зарегистрированные пользователи. ]
    Также выкладываю .exe, на случай, если у кого нет компилятора (константы можно задать внутри программы) - [Ссылки могут видеть только зарегистрированные пользователи. ] (выход - любая клавиша)
    P.S. На скриншотах получилось немного тускло, но это не особо важно, я полагаю.
    Последний раз редактировалось >Quiet Snow<; 17.10.2013 в 07:59.
    Ответить с цитированием  
     

  2. Пользователь сказал cпасибо:

    Абадябер (14.10.2013)

  3. #2  
    Профи Аватар для stabud
    Регистрация
    05.01.2013
    Сообщений
    787
    Сказал(а) спасибо
    327
    Поблагодарили 350 раз(а) в 277 сообщениях
    Записей в блоге
    6
    Ну че сказать, молодец!
    Ответить с цитированием  
     

  4. #3  
    Профи Аватар для rrrFer
    Регистрация
    01.08.2013
    Сообщений
    561
    Сказал(а) спасибо
    34
    Поблагодарили 249 раз(а) в 164 сообщениях
    А что это?
    [Ссылки могут видеть только зарегистрированные пользователи. ] // программирование на Prolog, Erlang, C++
    Ответить с цитированием  
     

  5. #4  
    Разбирающийся
    Регистрация
    13.10.2013
    Сообщений
    53
    Сказал(а) спасибо
    52
    Поблагодарили 34 раз(а) в 22 сообщениях
    А что это?
    Программа, направлнная на вывод графики... Понятней объяснить не могу.
    Ответить с цитированием  
     

  6. #5  
    Разбирающийся
    Регистрация
    13.10.2013
    Сообщений
    53
    Сказал(а) спасибо
    52
    Поблагодарили 34 раз(а) в 22 сообщениях
    Хотя, нет - могу: это светлячки
    Ответить с цитированием  
     

  7. #6  
    Гуру Аватар для Абадябер
    Регистрация
    09.12.2010
    Адрес
    Беларусь, Минск
    Сообщений
    1,219
    Сказал(а) спасибо
    302
    Поблагодарили 176 раз(а) в 144 сообщениях
    Записей в блоге
    5
    Вы с ней поиграйтесь, с параметрами и прочим, причем чтобы параметры изменялись по ходу выполнения программы. Демосценерский эффект получите)
    Так-то в целом с удовольствием погрался, довольно красиво получилось.
    Последний раз редактировалось Абадябер; 14.10.2013 в 23:39.
    Дружба-магия-радость!
    Ответить с цитированием  
     

  8. #7  
    Разбирающийся
    Регистрация
    13.10.2013
    Сообщений
    53
    Сказал(а) спасибо
    52
    Поблагодарили 34 раз(а) в 22 сообщениях
    Исправил некоторые ошибки минимальной скорости - правильная прорисовка на маленьких скоростях. Также теперь есть маленькое меню - 3 настройки констант, режим отладки (был написан во время отладки, но мне он понравился, и я решил оставить) и выход. (Возможность выхода по любой клавише осталась.)
    Код
    Код FreeBasic:
    ScreenRes 1024, 768, 32
     
    Dim As Integer i, n, bu, m1, m2, wh, res
    Dim As Single cix, ciy, shift, rad, c1, c2
     
    Dim Shared As Integer lon=550 
    Dim Shared As Single turn=6.28
    Dim Shared As Integer speed=5
    Dim Shared As Integer radius=50
    Dim Shared As Integer speed2=1000
    Dim Shared As Single speed3=0.05
    Dim Shared As Integer mlon=1000
    Dim Shared As Integer otl=0
     
    Dim Shared mtimer As Double
    Dim Shared start As Double
    Dim Shared a(1 To 3, 1 To mlon, 1 To 2) As Integer
     
    dat1: Data 400,	6.28,		5,		50,	1000,	0.05
    dat2: Data 1000,	0.1,		5,		100,	1000,	0.05
    dat3: Data 250,	6.28,		5,		50,	1,		0.05
     
    Declare Sub cir (ByRef x As Single, ByRef y As Single, ByVal shift As Single, rad As Single)
    Declare Sub tim (com As Integer)
    Declare Sub pp
    Declare Sub np (x As Integer, y As Integer, f As Integer)
    Declare Sub min (ByRef v1 As Single, ByRef v2 As Single)
    Declare Sub but (x As integer,y As integer,b As integer,v1 As integer,w1 As integer,v2 As integer,w2 As integer,n As integer,sta As String)
    Declare Sub fly (x As integer, y As integer, ByRef c1 As Single, ByRef c2 As Single, ByRef rad As Single)
    Declare Sub but1
    Declare Sub but2
    Declare Sub but3
    Declare Sub but4
    Declare Sub but5
    Declare Sub but6
    Declare Sub otlad
    Declare Sub cla
     
    tim(0)
    c1=512
    c2=384
    While InKey$=""
    	res=GetMouse(m1, m2, wh, bu)
    	If bu=2 Then cls
    	If m1>-1 Then fly(m1, m2, c1, c2, rad) Else rad=radius
    	tim(1)
    	cir(cix, ciy, 0, rad)
    	np(c1+cix, c2+ciy, 1)
    	cir(cix, ciy, 2.09, rad)
    	np(c1+cix, c2+ciy, 2)
    	cir(cix, ciy, 4.18, rad)
    	np(c1+cix, c2+ciy, 3)
    	but (m1, m2, bu, 1, 1, 100, 50, 1, "standart")
    	but (m1, m2, bu, 1, 60, 100, 110, 2, "1st alt")
    	but (m1, m2, bu, 1, 120, 100, 170, 3, "2nd alt")
    	but (m1, m2, bu, 1, 180, 100, 230, 0, "debugging")
    	but (m1, m2, bu, 110, 180, 137, 204, 4, "on")
    	but (m1, m2, bu, 110, 206, 137, 230, 6, "off")
    	but (m1, m2, bu, 1, 240, 100, 290, 5, "exit")
    	If otl=1 Then otlad ()
    	pp()
    Wend
    End
     
     
    Sub tim (com As Integer)
    	If com=1 Then mtimer=Timer-start
    	If com=0 Then mtimer=0: start=Timer
    	If mtimer>turn/speed Then tim(0)
    End Sub
     
    Sub np (x As Integer, y As Integer, f As Integer)
    	Dim As Integer i
    	For i=0 To lon-2
    		a(f,lon-i,1)=a(f,lon-(i+1),1)
    		a(f,1,1)=x
    	Next i
    	For i=0 To lon-2
    		a(f,lon-i,2)=a(f,lon-(i+1),2)
    		a(f,1,2)=y
    	Next i
    End Sub
     
    Sub pp
    	Dim As Integer i
    	For i=1 To lon-1
    		Line (a(1,i,1),a(1,i,2))-(a(1,i+1,1),a(1,i+1,2)), RGB(Int(255-225*(i-1)/(lon-2)),0,0)
    	Next i
    	For i=1 To lon-1
    		Line (a(2,i,1),a(2,i,2))-(a(2,i+1,1),a(2,i+1,2)), RGB(0,Int(255-225*(i-1)/(lon-2)),0)
    	Next i
    	For i=1 To lon-1
    		Line (a(3,i,1),a(3,i,2))-(a(3,i+1,1),a(3,i+1,2)), RGB(0,0,Int(255-225*(i-1)/(lon-2)))
    	Next i
    End Sub
     
    Sub cir (ByRef x As Single, ByRef y As Single, ByVal shift As Single, rad As Single)
    	x=Sin(mtimer*speed+shift)*rad
    	y=Sin((mtimer+1.57)*speed+shift)*rad
    End Sub
     
    Sub min (ByRef v1 As Single, ByRef v2 As Single)
    	Dim As Single s
    	s=v1/v2
    	If v1<>0 And v2<>0 Then
    		v1=Sqr((speed3^2*s^2)/(s^2+1))*Sgn(v1)
    		v2=v1/s
    	End If
    End Sub
     
    Sub but (x As integer,y As integer,b As integer,v1 As integer,w1 As integer,v2 As integer,w2 As integer,n As integer,sta As String)
    	If x<v2 And x>v1 And y<w2 And y>w1 Then 
    		Line (v1,w1)-(v2,w2),RGB(255,0,0), b
    		If b=1 Then 
    			Line (v1-2,w1-2)-(v2+2,w2+2),RGB(255,0,0), b
    			If n=1 Then but1 ()
    			If n=2 Then but2 ()
    			If n=3 Then but3 ()
    			If n=4 Then but4 ()
    			If n=5 Then but5 ()
    			If n=6 Then but6 ()
    		Else 
    			Line (v1-2,w1-2)-(v2+2,w2+2),RGB(0,0,0), b
    		EndIf
    	Else
    		Line (v1,w1)-(v2,w2),RGB(0,255,0), b
    	EndIf
    	Locate Int((w2+w1)/32)*2+1,Int(v1/8)+2
    	Print sta
    End Sub
     
    Sub fly (x As integer, y As integer, ByRef c1 As Single, ByRef c2 As Single, ByRef rad As Single)
    	Dim As Single d, v1, v2
    	d=Sqr((x-c1)^2+(y-c2)^2)
    	rad=radius/d^0.4
    	If d<1 Then rad=radius
    	v1=(x-c1)/speed2
    	v2=(y-c2)/speed2
    	If Sqr(v1*v1+v2*v2)<speed3 Then min (v1, v2)
    	c1=c1+v1
    	c2=c2+v2
    End Sub
     
    Sub but1
    	Restore dat1: Read lon, turn, speed, radius, speed2, speed3
    	cla ()
    	Cls
    End Sub
     
    Sub but2
    	Restore dat2: Read lon, turn, speed, radius, speed2, speed3
    	cla ()
    	Cls
    End Sub
     
    Sub but3
    	Restore dat3: Read lon, turn, speed, radius, speed2, speed3
    	cla ()
    	Cls
    End Sub
     
    Sub but4
    	otl=1
    End Sub
     
    Sub but5
    	End
    End Sub
     
    Sub but6
    	otl=0
    	Cls
    End Sub
     
    Sub otlad
    	Dim As Integer i
    	For i=1 To mlon
    		Line(900, i)-(900+a(1, i, 1)/10, i), RGB(0,255,0)
    		Line(900+a(1, i, 1)/10, i)-(2000, i), RGB(0,0,0)
    	Next
    End Sub
     
    Sub cla
    	Dim As Integer i, j, k
    	For i=1 To mlon
    		For j=1 To 3
    			For k=1 To 2
    				a(j,i,k)=0
    			Next
    		Next
    	Next
    End Sub

    Прикрепляю .exe: [Ссылки могут видеть только зарегистрированные пользователи. ]
    Ответить с цитированием  
     

  9. 2 пользователя(ей) сказали cпасибо:

    >Quiet Snow< (12.11.2013), Абадябер (20.10.2013)

  10. #8  
    Разбирающийся
    Регистрация
    13.10.2013
    Сообщений
    53
    Сказал(а) спасибо
    52
    Поблагодарили 34 раз(а) в 22 сообщениях
    Поправил формулу. Теперь "светлячки" "подлетают" к курсору плавнее.
    К сожалению, стали странно работать второй и третий режимы, но, думаю, это я смогу исправить и, возможно, даже сделаю на этом еще один параметр.
    Код
    Код :
    ScreenRes 1024, 768, 32
     
    Dim As Integer i, n, bu, m1, m2, wh, res
    Dim As Single cix, ciy, shift, rad, c1, c2
     
    Dim Shared As Integer lon=550 
    Dim Shared As Single turn=6.28
    Dim Shared As Integer speed=5
    Dim Shared As Integer radius=50
    Dim Shared As Integer speed2=1000
    Dim Shared As Single speed3=0.05
    Dim Shared As Integer mlon=1000
    Dim Shared As Integer otl=0
     
    Dim Shared mtimer As Double 
    Dim Shared start As Double 
    Dim Shared a(1 To 3, 1 To mlon, 1 To 2) As Integer	
     
    dat1: Data 400,	6.28,		5,		50,	1000,	0.05
    dat2: Data 1000,	0.1,		5,		100,	1000,	0.05
    dat3: Data 250,	6.28,		5,		50,	1,		0.05
     
    Declare Function cor (d As Single) As Single
    Declare Sub cir (ByRef x As Single, ByRef y As Single, ByVal shift As Single, rad As Single)
    Declare Sub tim (com As Integer)
    Declare Sub pp
    Declare Sub np (x As Integer, y As Integer, f As Integer)
    Declare Sub min (ByRef v1 As Single, ByRef v2 As Single)
    Declare Sub but (x As integer,y As integer,b As integer,v1 As integer,w1 As integer,v2 As integer,w2 As integer,n As integer,sta As String)
    Declare Sub fly (x As integer, y As integer, ByRef c1 As Single, ByRef c2 As Single, ByRef rad As Single)
    Declare Sub but1
    Declare Sub but2
    Declare Sub but3
    Declare Sub but4
    Declare Sub but5
    Declare Sub but6
    Declare Sub otlad
    Declare Sub cla
     
    tim(0)
    c1=512
    c2=384
    While InKey$=""
    	res=GetMouse(m1, m2, wh, bu)
    	If bu=2 Then cls
    	If m1>-1 Then fly(m1, m2, c1, c2, rad) Else rad=radius
    	tim(1)
    	cir(cix, ciy, 0, rad)
    	np(c1+cix, c2+ciy, 1)
    	cir(cix, ciy, 2.09, rad)
    	np(c1+cix, c2+ciy, 2)
    	cir(cix, ciy, 4.18, rad)
    	np(c1+cix, c2+ciy, 3)
    	but (m1, m2, bu, 1, 1, 100, 50, 1, "standart")
    	but (m1, m2, bu, 1, 60, 100, 110, 2, "1st alt")
    	but (m1, m2, bu, 1, 120, 100, 170, 3, "2nd alt")
    	but (m1, m2, bu, 1, 180, 100, 230, 0, "debugging")
    	but (m1, m2, bu, 110, 180, 137, 204, 4, "on")
    	but (m1, m2, bu, 110, 206, 137, 230, 6, "off")
    	but (m1, m2, bu, 1, 240, 100, 290, 5, "exit")
    	If otl=1 Then otlad ()
    	pp()
    Wend
    End
     
    Function cor (d As Single) As Single
    	cor=5
    	If (d/75)<3.141592 Then cor=(Cos(d/75)+1)*(radius-5)/2+5
    End Function
     
    Sub tim (com As Integer)
    	If com=1 Then mtimer=Timer-start
    	If com=0 Then mtimer=0: start=Timer
    	If mtimer>turn/speed Then tim(0)
    End Sub
     
    Sub np (x As Integer, y As Integer, f As Integer)
    	Dim As Integer i
    	For i=0 To lon-2
    		a(f,lon-i,1)=a(f,lon-(i+1),1)
    		a(f,1,1)=x
    	Next i
    	For i=0 To lon-2
    		a(f,lon-i,2)=a(f,lon-(i+1),2)
    		a(f,1,2)=y
    	Next i
    End Sub
     
    Sub pp
    	Dim As Integer i
    	For i=1 To lon-1
    		Line (a(1,i,1),a(1,i,2))-(a(1,i+1,1),a(1,i+1,2)), RGB(Int(255-225*(i-1)/(lon-2)),0,0)
    	Next i
    	For i=1 To lon-1
    		Line (a(2,i,1),a(2,i,2))-(a(2,i+1,1),a(2,i+1,2)), RGB(0,Int(255-225*(i-1)/(lon-2)),0)
    	Next i
    	For i=1 To lon-1
    		Line (a(3,i,1),a(3,i,2))-(a(3,i+1,1),a(3,i+1,2)), RGB(0,0,Int(255-225*(i-1)/(lon-2)))
    	Next i
    End Sub
     
    Sub cir (ByRef x As Single, ByRef y As Single, ByVal shift As Single, rad As Single)
    	x=Sin(mtimer*speed+shift)*rad
    	y=Sin((mtimer+1.57)*speed+shift)*rad
    End Sub
     
    Sub min (ByRef v1 As Single, ByRef v2 As Single)
    	Dim As Single s
    	s=v1/v2
    	If v1<>0 And v2<>0 Then
    		v1=Sqr((speed3^2*s^2)/(s^2+1))*Sgn(v1)
    		v2=v1/s
    	End If
    End Sub
     
    Sub but (x As integer,y As integer,b As integer,v1 As integer,w1 As integer,v2 As integer,w2 As integer,n As integer,sta As String)
    	If x<v2 And x>v1 And y<w2 And y>w1 Then 
    		Line (v1,w1)-(v2,w2),RGB(255,0,0), b
    		If b=1 Then 
    			Line (v1-2,w1-2)-(v2+2,w2+2),RGB(255,0,0), b
    			If n=1 Then but1 ()
    			If n=2 Then but2 ()
    			If n=3 Then but3 ()
    			If n=4 Then but4 ()
    			If n=5 Then but5 ()
    			If n=6 Then but6 ()
    		Else 
    			Line (v1-2,w1-2)-(v2+2,w2+2),RGB(0,0,0), b
    		EndIf
    	Else
    		Line (v1,w1)-(v2,w2),RGB(0,255,0), b
    	EndIf
    	Locate Int((w2+w1)/32)*2+1,Int(v1/8)+2
    	Print sta
    End Sub
     
    Sub fly (x As integer, y As integer, ByRef c1 As Single, ByRef c2 As Single, ByRef rad As Single)
    	Dim As Single d, v1, v2
    	d=Sqr((x-c1)^2+(y-c2)^2)
    	rad=cor(d)
    	If d<1 Then rad=radius
    	v1=(x-c1)/speed2
    	v2=(y-c2)/speed2
    	If Sqr(v1*v1+v2*v2)<speed3 Then min (v1, v2)
    	c1=c1+v1
    	c2=c2+v2
    End Sub
     
    Sub but1
    	Restore dat1: Read lon, turn, speed, radius, speed2, speed3
    	cla ()
    	Cls
    End Sub
     
    Sub but2
    	Restore dat2: Read lon, turn, speed, radius, speed2, speed3
    	cla ()
    	Cls
    End Sub
     
    Sub but3
    	Restore dat3: Read lon, turn, speed, radius, speed2, speed3
    	cla ()
    	Cls
    End Sub
     
    Sub but4
    	otl=1
    End Sub
     
    Sub but5
    	End
    End Sub
     
    Sub but6
    	otl=0
    	Cls
    End Sub
     
    Sub otlad
    	Dim As Integer i
    	For i=1 To mlon
    		Line(900, i)-(900+a(1, i, 1)/10, i), RGB(0,255,0)
    		Line(900+a(1, i, 1)/10, i)-(2000, i), RGB(0,0,0)
    	Next
    End Sub
     
    Sub cla
    	Dim As Integer i, j, k
    	For i=1 To mlon
    		For j=1 To 3
    			For k=1 To 2
    				a(j,i,k)=0
    			Next
    		Next
    	Next
    End Sub

    И, как всегда, выкладываю .exe: [Ссылки могут видеть только зарегистрированные пользователи. ]
    Ответить с цитированием  
     

  11. 3 пользователя(ей) сказали cпасибо:

    >Quiet Snow< (26.11.2013), stabud (26.11.2013), Абадябер (27.11.2013)

  12. #9  
    Супер модератор Аватар для >Quiet Snow<
    Регистрация
    11.04.2011
    Адрес
    Планета земля
    Сообщений
    3,944
    Сказал(а) спасибо
    1,847
    Поблагодарили 991 раз(а) в 849 сообщениях
    Записей в блоге
    1
    Good.Morning освоил юзер интерфейс дедовским способом - плюсую. Код открыл - не осилил, но знаю точно
    там много лишнего, хотя всё и почти опрятно(всё же upcase и нормальные пробелы в скобках как делает
    QB - очень много читаемости дают, TAB - лучше не юзать для отступов в моно шрифтах, разное кол-во
    пробелов даёт. в остальном - вообще чётко, прочухивешь и это видно), хотя и мало кто так вылизывает проги,
    но если себя приучить - будет дичайший профит.


    Пример форматирования
    Из твоей проги:
    Код FreeBasic:
    Sub cla
       Dim As Integer i, j, k
       For i=1 To mlon
          For j=1 To 3
             For k=1 To 2
                a(j,i,k)=0
             Next
          Next
       Next
    End Sub
    По канонам QB + напильник:
    Код Qbasic:
    SUB Cla
       DIM i AS INTEGER, j AS INTEGER, k AS INTEGER
       FOR i = 1 TO mlon
          FOR j = 1 TO 3
             FOR k = 1 TO 2
                a(j, i, k) = 0
       NEXT k, j, i
    END SUB


    По проге:
    Good.Morning добавь больше эффектов, чтобы от этих линий что-нть разлеталось, тогда может выйдет
    вполне неплохой скринсейвер. Также можно например убавить разрешение до 640x480, поставить 16 бит
    и сваять честный blur + затемнение(по таблице конечно на 65+ тыщ элементов), тоже думается будет
    неплохо. На подобных функциях как у тебя в проге тоже полезно набивать руку, пригодится в диф. урах.
    Короче ждём в будущем более сложные методы визуализации частиц, демщики на частицах просто чудеса
    творят.
    Последний раз редактировалось >Quiet Snow<; 26.11.2013 в 23:08.
    Обучение прикладному программированию(по skype), качественно, недорого, 18+, вопросы в личку.
    «Если вы ничего не сделаете, я уверяю вас, ничего и не произойдёт» © Жак Фреско
    Ограниченно модерирую.
    Ответить с цитированием  
     

  13. 2 пользователя(ей) сказали cпасибо:

    Good.Morning (03.12.2013), Абадябер (27.11.2013)

  14. #10  
    Разбирающийся
    Регистрация
    13.10.2013
    Сообщений
    53
    Сказал(а) спасибо
    52
    Поблагодарили 34 раз(а) в 22 сообщениях
    >Quiet Snow<, не совсем понял про
    убавить разрешение до 640x480, поставить 16 бит
    и сваять честный blur + затемнение(по таблице конечно на 65+ тыщ элементов)
    Можете объяснить?

    Маленький UpDate.
    То, что давно хотел сделать, но руки не доходили:
    Код
    Код :
    ScreenRes 1024, 768, 32
     
    Dim As Integer i, n
    Dim As Single cix, ciy, shift, rad, c1, c2
     
    Dim Shared As Integer lon=550 
    Dim Shared As Single turn=6.28
    Dim Shared As Integer speed=5
    Dim Shared As Integer radius=50
    Dim Shared As Integer speed2=1000
    Dim Shared As Single speed3=0.05
    Dim Shared As Integer mlon=1000
    Dim Shared As Integer otl=0
     
    Dim Shared As Integer bu, m1, m2, wh, res
    Dim Shared dat As String
    Dim Shared datv As Integer
    Dim Shared mtimer As Double 
    Dim Shared start As Double 
    Dim Shared a(1 To 3, 1 To mlon, 1 To 2) As Integer	
     
    dat1: Data 400,	6.28,		5,		50,	1000,	0.05
    dat2: Data 1000,	0.1,		5,		100,	1000,	0.05
    dat3: Data 250,	6.28,		5,		50,	1,		0.05
     
    Declare Function cor (d As Single) As Single
    Declare Sub cir (ByRef x As Single, ByRef y As Single, ByVal shift As Single, rad As Single)
    Declare Sub tim (com As Integer)
    Declare Sub pp ()
    Declare Sub np (x As Integer, y As Integer, f As Integer)
    Declare Sub min (ByRef v1 As Single, ByRef v2 As Single)
    Declare Sub but (v1 As integer,w1 As integer,v2 As integer,w2 As integer,n As integer,sta As String)
    Declare Sub fly (x As integer, y As integer, ByRef c1 As Single, ByRef c2 As Single, ByRef rad As Single)
    Declare Sub scrol (v1 As Integer, w1 As Integer, v2 As Integer, w2 As Integer, hi As Integer, hig As Integer, ByRef scx As Integer, ByRef scy As Integer)
    Declare Sub but1 ()
    Declare Sub but2 ()
    Declare Sub but3 ()
    Declare Sub but4 ()
    Declare Sub but5 ()
    Declare Sub but6 ()
    Declare Sub buts ()
    Declare Sub otlad ()
    Declare Sub cla ()
     
    tim(0)
    c1=512
    c2=384
    While InKey$=""
    	res=GetMouse(m1, m2, wh, bu)
    	If bu=2 Then cls
    	If m1>-1 Then fly(m1, m2, c1, c2, rad) Else rad=radius
    	tim(1)
    	cir(cix, ciy, 0, rad)
    	np(c1+cix, c2+ciy, 1)
    	cir(cix, ciy, 2.09, rad)
    	np(c1+cix, c2+ciy, 2)
    	cir(cix, ciy, 4.18, rad)
    	np(c1+cix, c2+ciy, 3)
    	but (1, 1, 100, 50, 1, "standart")
    	but (1, 60, 100, 110, 2, "1st alt")
    	but (1, 120, 100, 170, 3, "2nd alt")
    	but (1, 180, 100, 230, 0, "debugging")
    	but (110, 180, 137, 204, 4, "on")
    	but (110, 206, 137, 230, 6, "off")
    	but (1, 240, 100, 290, 5, "exit")
     
    	datv=lon/10
    	scrol(120,0,130,100,10, 10, 0, datv)
    	lon=datv*10
     
    	datv=(speed-1)/2+5
    	scrol(150,0,160,100,10, 10, 0, datv)
    	speed=(datv-5)*2+1
     
    	datv=radius
    	scrol(180,0,190,100,10, 10, 0, datv)
    	radius=datv
     
    	datv=speed2/10
    	scrol(210,0,220,100,10, 10, 0, datv)
    	speed2=datv*10
    	If otl=1 Then otlad ()
    	pp()
    Wend
    End
     
    Function cor (d As Single) As Single
    	cor=5
    	If (d/75)<3.141592 Then cor=(Cos(d/75)+1)*(radius-5)/2+5
    End Function
     
    Sub tim (com As Integer)
    	If com=1 Then mtimer=Timer-start
    	If com=0 Then mtimer=0: start=Timer
    	If mtimer>turn/speed Then tim(0)
    End Sub
     
    Sub np (x As Integer, y As Integer, f As Integer)
    	Dim As Integer i
    	For i=0 To lon-2
    		a(f,lon-i,1)=a(f,lon-(i+1),1)
    		a(f,1,1)=x
    	Next i
    	For i=0 To lon-2
    		a(f,lon-i,2)=a(f,lon-(i+1),2)
    		a(f,1,2)=y
    	Next i
    End Sub
     
    Sub pp ()
    	Dim As Integer i
    	For i=1 To lon-1
    		Line (a(1,i,1),a(1,i,2))-(a(1,i+1,1),a(1,i+1,2)), RGB(Int(255-225*(i-1)/(lon-2)),0,0)
    	Next i
    	For i=1 To lon-1
    		Line (a(2,i,1),a(2,i,2))-(a(2,i+1,1),a(2,i+1,2)), RGB(0,Int(255-225*(i-1)/(lon-2)),0)
    	Next i
    	For i=1 To lon-1
    		Line (a(3,i,1),a(3,i,2))-(a(3,i+1,1),a(3,i+1,2)), RGB(0,0,Int(255-225*(i-1)/(lon-2)))
    	Next i
    End Sub
     
    Sub cir (ByRef x As Single, ByRef y As Single, ByVal shift As Single, rad As Single)
    	x=Sin(mtimer*speed+shift)*rad
    	y=Sin((mtimer+1.57)*speed+shift)*rad
    End Sub
     
    Sub min (ByRef v1 As Single, ByRef v2 As Single)
    	Dim As Single s
    	s=v1/v2
    	If v1<>0 And v2<>0 Then
    		v1=Sqr((speed3^2*s^2)/(s^2+1))*Sgn(v1)
    		v2=v1/s
    	End If
    End Sub
     
    Sub but (v1 As integer,w1 As integer,v2 As integer,w2 As integer,n As integer,sta As String)
    	If m1<v2 And m1>v1 And m2<w2 And m2>w1 Then 
    		Line (v1,w1)-(v2,w2),RGB(255,0,0), b
    		If bu=1 Then 
    			Line (v1-2,w1-2)-(v2+2,w2+2),RGB(255,0,0), b
    			If n=1 Then but1 ()
    			If n=2 Then but2 ()
    			If n=3 Then but3 ()
    			If n=4 Then but4 ()
    			If n=5 Then but5 ()
    			If n=6 Then but6 ()
    			If n=255 Then buts ()
    		Else 
    			Line (v1-2,w1-2)-(v2+2,w2+2),RGB(0,0,0), b
    		EndIf
    	Else
    		Line (v1,w1)-(v2,w2),RGB(0,255,0), b
    	EndIf
    	Locate Int((w2+w1)/32)*2+1,Int(v1/8)+2
    	Print sta
    End Sub
     
    Sub fly (x As integer, y As integer, ByRef c1 As Single, ByRef c2 As Single, ByRef rad As Single)
    	Dim As Single d, v1, v2
    	d=Sqr((x-c1)^2+(y-c2)^2)
    	rad=cor(d)
    	If d<1 Then rad=radius
    	v1=(x-c1)/speed2
    	v2=(y-c2)/speed2
    	If Sqr(v1*v1+v2*v2)<speed3 Then min (v1, v2)
    	c1=c1+v1
    	c2=c2+v2
    End Sub
     
    Sub scrol (v1 As Integer, w1 As Integer, v2 As Integer, w2 As Integer, hi As Integer, hig As Integer, ByRef scx As Integer, ByRef scy As integer)
    	but (v1, w1, v2, w2, 255, "")
    	If dat<>"" Then
    		scx=Val(Left$(dat,4))-v1
    		scy=Val(Right$(dat,4))-w1
    		dat=""
    		Line (v1+1,w1+1)-(v2-1,w2-1), RGB(0,0,0), bf
    	End If
    	If v1+scx+hi/2>v2 Then scx=scx+(v2-v1-scx-hi/2)
    	If w1+scy+hig/2>w2 Then scy=scy+(w2-w1-scy-hig/2)
    	If v1+scx-hi/2<v1 Then scx=scx-(scx-hi/2)
    	If w1+scy-hig/2<w1 Then scy=scy-(scy-hig/2)
    	but (scx+v1-hi/2, scy+w1-hig/2, scx+hi/2+v1, scy+hig/2+w1, 0, "")
    End Sub
     
    Sub but1 ()
    	Restore dat1: Read lon, turn, speed, radius, speed2, speed3
    	cla ()
    	Cls
    End Sub
     
    Sub but2 ()
    	Restore dat2: Read lon, turn, speed, radius, speed2, speed3
    	cla ()
    	Cls
    End Sub
     
    Sub but3 ()
    	Restore dat3: Read lon, turn, speed, radius, speed2, speed3
    	cla ()
    	Cls
    End Sub
     
    Sub but4 ()
    	otl=1
    End Sub
     
    Sub but5 ()
    	End
    End Sub
     
    Sub but6 ()
    	otl=0
    	Cls
    End Sub
     
    Sub buts()
    	dat=Space(4-Len(Str(m1)))&Str(m1)&Space(4-Len(Str(m2)))&Str(m2)
    End Sub
     
    Sub otlad ()
    	Dim As Integer i
    	For i=1 To mlon
    		Line(900, i)-(900+a(1, i, 1)/10, i), RGB(0,255,0)
    		Line(900+a(1, i, 1)/10, i)-(2000, i), RGB(0,0,0)
    	Next
    End Sub
     
    Sub cla
    	Dim As Integer i, j, k
    	For i=1 To mlon
    		For j=1 To 3
    			For k=1 To 2
    				a(j,i,k)=0
    			Next
    		Next
    	Next
    End Sub

    И .exe: [Ссылки могут видеть только зарегистрированные пользователи. ].
    Первый ползунок отвечает за длину следа, второй - за скорость вращения, третий - за радиус, четвертый - за минимальную навигационную скорость.
    Поэкспериментировав, правда, можно заметить некоторые некорректности работы - большинство движений не зависят от системного времени (из-за этого зависимы от производительности процессора, количества точек на экране и т.д.)
    Ответить с цитированием  
     

  15. Пользователь сказал cпасибо:

    >Quiet Snow< (03.12.2013)

Страница 1 из 2 12 ПоследняяПоследняя
Информация о теме
Пользователи, просматривающие эту тему

Эту тему просматривают: 1 (пользователей: 0 , гостей: 1)

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