Суббота, 23 Ноября 2024, 01:50

Приветствую Вас Гость

[ Новые сообщения · Игроделы · Правила · Поиск ]
  • Страница 1 из 1
  • 1
Тестируем быстродействие различных бейсиков (и не только)
-Mikle-Дата: Четверг, 12 Апреля 2012, 23:03 | Сообщение # 1
Изобретатель велосипедов
Сейчас нет на сайте
Какой код в играх "съедает" основное время процессора? Рендер? Нет, рендерит видеокарта. Это физика либо логика ИИ.
При этом большей частью производятся простые действия (сложение, умножение, деление, сравнение) над игровыми данными.
А сами данные - это, как правило Single и Long, в "чистом" виде, в виде структур и массивов. При большом количестве игровых объектов, с ними работают через Quad или OcTree, это позволяет быстро отсеивать те объекты, которые обрабатывать не нужно (например, они находятся заведомо далеко). Обход Quad и Oc деревьев осуществляют, как правило, с помощью рекурсии.
Исходя из этого для измерения производительности для игр хорошо подходит тест - рисование простого фрактала, это те же самые действия, тоже рекурсия, такие же данные.
Вот проект на Visual Basic 6:
FrVB6
Его можно перевести полностью, а можно только это:

Измерять желательно чем-то более точным, чем GetTickCounter, отлично подходит QueryPerformanceCounter.
Результаты замеров:


Сообщение отредактировал -Mikle- - Воскресенье, 15 Апреля 2012, 09:58
trewДата: Пятница, 13 Апреля 2012, 01:19 | Сообщение # 2
почетный гость
Сейчас нет на сайте
Твой код вписался в FB почти как на нем написан smile

Единственно изменил расположение процедур и сделал глобальным массив MAP

Вот с пуром пришлось каждую строчку колбасить . В общем:

PureBasic и FreeBasic одинаковы: 46-47

VisualBasic 6.0: 532-548

Моя машина: пень DUAL CORE E5200 2500

Все три компилятора проверял функцией GetTickCount

Код FB (компиль 0.22):

Code

#Include "windows.bi"
Private Type Vector
x As Single
y As Single
End Type
Dim Shared Map(1023, 767) As Long
Dim vP As Vector, vD As Vector
Private Sub DrawLine(vP1 As Vector, vP2 As Vector)
  Dim x As Single, y As Single, k As Single, dx As Single, dy As Single
  dx = vP2.x - vP1.x
  dy = vP2.y - vP1.y
  If Abs(dx) < Abs(dy) Then
   k = dx / dy
   If vP2.y > vP1.y Then
    y = vP1.y
    x = vP1.x
    While y < vP2.y
     Map(x, y) = &H50BB50
     x = x + k
     y = y + 1
    Wend
   Else
    y = vP2.y
    x = vP1.x
    While y < vP1.y
     Map(x, y) = &H40FF30
     x = x + k
     y = y + 1
    Wend
   End If
  Else
   k = dy / dx
   If vP2.x > vP1.x Then
    x = vP1.x
    y = vP1.y
    While x < vP2.x
     Map(x, y) = &HA0AF20
     y = y + k
     x = x + 1
    Wend
   Else
    x = vP2.x
    y = vP1.y
    While x < vP1.x
     Map(x, y) = &H609F30
     y = y + k
     x = x + 1
    Wend
   End If
  End If
End Sub

Sub DrawFractal(vPos As Vector, vDir As Vector)
  Dim vP As Vector, vD As Vector
  If vDir.x * vDir.x + vDir.y * vDir.y < 0.017 Then Exit Sub
  vP.x = vPos.x + vDir.x
  vP.y = vPos.y + vDir.y
  DrawLine vPos, vP

  vD.x = vDir.x * 0.9 - vDir.y * 0.04
  vD.y = vDir.y * 0.9 + vDir.x * 0.04
  DrawFractal vP, vD
  vD.x = vDir.x * 0.15 + vDir.y * 0.24
  vD.y = vDir.y * 0.15 - vDir.x * 0.24
  DrawFractal vP, vD
  vD.x = vDir.x * 0.14 - vDir.y * 0.25
  vD.y = vDir.y * 0.14 + vDir.x * 0.25
  DrawFractal vP, vD
End Sub

Var t = GetTickCount()
vP.x = 40
vP.y = 500
vD.x = 87
vD.y = -54
DrawFractal vP, vD
? GetTickCount()-t
Sleep


PB (4.5):

Code
Structure Vector  
   x.f
   y.f
EndStructure
Global Dim Map_.l(1023, 767)
vP.Vector
vD.Vector
Procedure DrawLine(*vP1.Vector,*vP2.Vector)  
   x.l
   y.l
   k.f
   dx.f
   dy.f  
    
   dx = *vP2\x - *vP1\x  
   dy = *vP2\y - *vP1\y  
   If Abs(dx) < Abs(dy)
     k = dx / dy  
     If *vP2\y > *vP1\y
       y = *vP1\y  
       x = *vP1\x  
       While y < *vP2\y  
         Map_(x, y) = $50BB50
         x = x + k  
         y = y + 1  
       Wend  
     Else  
       y = *vP2\y  
       x = *vP1\x  
       While y < *vP1\y  
         Map_(x, y) = $40FF30  
         x = x + k  
         y = y + 1  
       Wend  
     EndIf  
   Else  
     k = dy / dx  
     If *vP2\x > *vP1\x  
       x = *vP1\x  
       y = *vP1\y  
       While x < *vP2\x  
         Map_(x, y) = $A0AF20  
         y = y + k  
         x = x + 1  
       Wend  
     Else  
       x = *vP2\x  
       y = *vP1\y  
       While x < *vP1\x  
         Map_(x, y) = $609F30  
         y = y + k  
         x = x + 1  
       Wend  
     EndIf  
   EndIf  
EndProcedure

Procedure DrawFractal(*vPos.Vector, *vDir.Vector)  
   vP.Vector
   vD.Vector  
    
   If *vDir\x * *vDir\x + *vDir\y * *vDir\y < 0.017  
     ProcedureReturn
   EndIf
   vP\x = *vPos\x + *vDir\x  
   vP\y = *vPos\y + *vDir\y  
   DrawLine (*vPos, vP )
    
   vD\x = *vDir\x * 0.9 - *vDir\y * 0.04  
   vD\y = *vDir\y * 0.9 + *vDir\x * 0.04  
   DrawFractal (vP, vD )
   vD\x = *vDir\x * 0.15 + *vDir\y * 0.24  
   vD\y = *vDir\y * 0.15 - *vDir\x * 0.24  
   DrawFractal (vP, vD )
   vD\x = *vDir\x * 0.14 - *vDir\y * 0.25  
   vD\y = *vDir\y * 0.14 + *vDir\x * 0.25  
   DrawFractal (vP, vD )
EndProcedure

t = GetTickCount_()
vP\x = 40  
vP\y = 500  
vD\x = 87  
vD\y = -54  
DrawFractal (vP, vD)
t=GetTickCount_()-t
OpenConsole()
PrintN(Str(t))
Input()
-Mikle-Дата: Пятница, 13 Апреля 2012, 09:05 | Сообщение # 3
Изобретатель велосипедов
Сейчас нет на сайте
Ты в VB6 из среды запускал? Запускай EXE, желательно мой (или сам включи все оптимизации).
И от PB и FB хотелось бы EXE-шники, потестить на разных компах.
И GetTickCount очень неточен, чем не устроил QPC?
Ну и синтаксис у PB wacko , впервые вижу. Я так понял "\", этот аналог сишного "->"? Но почему тогда
Code
vP\x = *vPos\x + *vDir\x

а не
Code
*vP\x = *vPos\x + *vDir\x

?


Сообщение отредактировал -Mikle- - Пятница, 13 Апреля 2012, 09:13
trewДата: Пятница, 13 Апреля 2012, 09:40 | Сообщение # 4
почетный гость
Сейчас нет на сайте
Quote
Ты в VB6 из среды запускал?


Да, но сейчас после твоего поста запустил твой EXE, результаты:

у VB6 ~0.5122
у FB ~ 0.047
у PB не проверял, но думаю что будет 0.047

Вот код с QPC

Code
#Include "windows.bi"
Private Type Vector
x As Single
y As Single
End Type
Dim Shared Map(1023, 767) As Long

Dim Shared QSpeed As Double
Private Function QTime() As Double
   Dim QD As LARGE_INTEGER, t As Double

   QueryPerformanceCounter @QD
   If QD.LowPart < 0 Then t = QD.LowPart + 4294967296 Else t = QD.LowPart
   If QD.HighPart < 0 Then t = t + (QD.HighPart + 4294967296) * 4294967296 Else t = t + QD.HighPart * 4294967296
   QTime = t * QSpeed
End Function

Private Sub QTimeInit()
   Dim QD As LARGE_INTEGER

   QueryPerformanceFrequency @QD
   If QD.LowPart < 0 Then QSpeed = QD.LowPart + 4294967296 Else QSpeed = QD.LowPart
   If QD.HighPart < 0 Then QSpeed = QSpeed + (QD.HighPart + 4294967296) * 4294967296 Else QSpeed = QSpeed + QD.HighPart * 4294967296
   QSpeed = 1 / QSpeed
End Sub

Dim vP As Vector, vD As Vector
Private Sub DrawLine(vP1 As Vector, vP2 As Vector)
  Dim x As Single, y As Single, k As Single, dx As Single, dy As Single
  dx = vP2.x - vP1.x
  dy = vP2.y - vP1.y
  If Abs(dx) < Abs(dy) Then
   k = dx / dy
   If vP2.y > vP1.y Then
    y = vP1.y
    x = vP1.x
    While y < vP2.y
     Map(x, y) = &H50BB50
     x = x + k
     y = y + 1
    Wend
   Else
    y = vP2.y
    x = vP1.x
    While y < vP1.y
     Map(x, y) = &H40FF30
     x = x + k
     y = y + 1
    Wend
   End If
  Else
   k = dy / dx
   If vP2.x > vP1.x Then
    x = vP1.x
    y = vP1.y
    While x < vP2.x
     Map(x, y) = &HA0AF20
     y = y + k
     x = x + 1
    Wend
   Else
    x = vP2.x
    y = vP1.y
    While x < vP1.x
     Map(x, y) = &H609F30
     y = y + k
     x = x + 1
    Wend
   End If
  End If
End Sub

Sub DrawFractal(vPos As Vector, vDir As Vector)
  Dim vP As Vector, vD As Vector
  If vDir.x * vDir.x + vDir.y * vDir.y < 0.017 Then Exit Sub
  vP.x = vPos.x + vDir.x
  vP.y = vPos.y + vDir.y
  DrawLine vPos, vP

  vD.x = vDir.x * 0.9 - vDir.y * 0.04
  vD.y = vDir.y * 0.9 + vDir.x * 0.04
  DrawFractal vP, vD
  vD.x = vDir.x * 0.15 + vDir.y * 0.24
  vD.y = vDir.y * 0.15 - vDir.x * 0.24
  DrawFractal vP, vD
  vD.x = vDir.x * 0.14 - vDir.y * 0.25
  vD.y = vDir.y * 0.14 + vDir.x * 0.25
  DrawFractal vP, vD
End Sub

QTimeInit()
Var t = QTime()
vP.x = 40
vP.y = 500
vD.x = 87
vD.y = -54
DrawFractal vP, vD
? QTime()-t
Sleep


Quote
И от PB и FB хотелось бы EXE-шники, потестить на разных компах.


Вот ФАЙЛЫ EXE

Quote
Я так понял "\", этот аналог сишного "->"?


Да и точки в том числе. Два в одном так сказать. Именно поэтому:

Quote
vP\x = *vPos\x + *vDir\x
-Mikle-Дата: Пятница, 13 Апреля 2012, 10:02 | Сообщение # 5
Изобретатель велосипедов
Сейчас нет на сайте
Quote
после твоего поста запустил твой EXE, результаты

Почему тогда твои результаты на VB6 в 10 раз хуже моих?
На PB и FB примерно совпадают.
trewДата: Пятница, 13 Апреля 2012, 10:54 | Сообщение # 6
почетный гость
Сейчас нет на сайте
Quote
Почему тогда твои результаты на VB6 в 10 раз хуже моих?
На PB и FB примерно совпадают.


Наверное потому что:

PB (обертка FASM)
FB (обертка GNU ASM)

Кто же с ассемблером меряется в скорости biggrin Хотя я в этом деле не спец. Может кто другой скажет почему так. А вообще возми скачай среду FbEdit уже настроенную вместе с компилем и проверь для FB можно ОТСЮДА (21.8 мб)

Добавлено (13.04.2012, 10:54)
---------------------------------------------
-------------------------------------------------------

Пардон -Mikle-

Извиняюсь за введение в заблуждение. Я запускал твой EXE на виртуалке (привычка). Не знал что на виртуалке скорость в 10 раз ниже

Запустив оба (FB и VB) на виртуалке, результат

у VB:

0.48-0.49

у FB 0.46-0.47

То есть на основной системе будет в 10 раз быстрее

Так что одинаковы можно сказать.

Кстати, а где и как лучше там оптимизировать? Я создаю EXE , дальше в опциях выставлено:





И после тестов, неплохо бы сделать табличку в самом верху.


Сообщение отредактировал trew - Пятница, 13 Апреля 2012, 11:54
-Mikle-Дата: Пятница, 13 Апреля 2012, 12:01 | Сообщение # 7
Изобретатель велосипедов
Сейчас нет на сайте
Да, я ставлю такие же оптимизации.
Проверил на Athlon64 3800+, VB6 довольно сильно вырвался вперёд:
vb6 - 0.0505
pb -0.0594
На интеле примерно такие результаты, как у тебя.
Табличку сделаю, только мне нужен EXE с QPC на PB.


Сообщение отредактировал -Mikle- - Пятница, 13 Апреля 2012, 12:02
trewДата: Пятница, 13 Апреля 2012, 12:12 | Сообщение # 8
почетный гость
Сейчас нет на сайте
Code
Да, я ставлю такие же оптимизации.  
  Проверил на Athlon64 3800+, VB6 довольно сильно вырвался вперёд:  
  vb6 - 0.0505  
  pb -0.0594  
  На интеле примерно такие результаты, как у тебя.


Ну вот , а то часто видел реплики в сети, что VB6 тормоз. Вот прямое доказательство обратного!

Quote
Табличку сделаю, только мне нужен EXE с QPC на PB.


Подождем PBPROG может он че еще подправит в коде, я уж давно по нормальному на PB не кодил, может что и не так сделал. Ну а если не захочет, тогда допишу сам.
PBPROGДата: Пятница, 13 Апреля 2012, 13:01 | Сообщение # 9
постоянный участник
Сейчас нет на сайте
Переписал код на пурик, но на экране какая-то бессмыслица http://rghost.ru/37557546
Возможно что-то с SetDIBitsToDevice напутал, хз.


Сообщение отредактировал PBPROG - Пятница, 13 Апреля 2012, 13:02
-Mikle-Дата: Пятница, 13 Апреля 2012, 13:35 | Сообщение # 10
Изобретатель велосипедов
Сейчас нет на сайте
PBPROG, похоже, что в PB массивах поменяны местами строки и столбцы, задай так:
Code
Map.l(767, 1023)

И во всех обращениях к массиву поменяй местами x и y.
trew, хорошо бы тоже сделать визуализацию, чтобы убедиться, что код правильно работает.
Quote
Ну вот , а то часто видел реплики в сети, что VB6 тормоз. Вот прямое доказательство обратного!

Факт. Сколько видел таких тестов, доказывающих тормознутость VB6, везде либо полная безсмыслица, либо навязывание чуждого для VB6 стиля программирования.


Сообщение отредактировал -Mikle- - Пятница, 13 Апреля 2012, 13:38
PBPROGДата: Пятница, 13 Апреля 2012, 14:45 | Сообщение # 11
постоянный участник
Сейчас нет на сайте
Quote (-Mikle-)
похоже, что в PB массивах поменяны местами строки и столбцы
Помогло. http://rghost.ru/37559093

Только непонятно почему так произошло.
Вот тестовый код.
Code
Dim test.b(1,1)

test(0,0)=1
test(0,1)=2
test(1,0)=3
test(1,1)=4

ShowMemoryViewer(test(), 4)
данные в массиве располагаются в такой последовательности.
Code
01 02 03 04
Слева младшие адреса памяти, а справа старшие.


Сообщение отредактировал PBPROG - Пятница, 13 Апреля 2012, 14:47
trewДата: Пятница, 13 Апреля 2012, 14:50 | Сообщение # 12
почетный гость
Сейчас нет на сайте
Quote
PBPROG, похоже, что в PB массивах поменяны местами строки и столбцы, задай так:


В FB кстати тоже

Вот код:

Code

#Include "windows.bi"

Private Type Vector
x As Single
y As Single
End Type

Dim Shared bi32BitInfo As BITMAPINFO
Dim Shared Map(767, 1023) As Long
Declare Sub DrawFractal(vPos As Vector, vDir As Vector)
Declare Sub DrawLine(vP1 As Vector, vP2 As Vector)
Declare Sub Main()
Dim Shared QSpeed As Double

Main '<- вход

Private Function QTime() As Double
  Dim QD As LARGE_INTEGER, t As Double
  QueryPerformanceCounter @QD
  If QD.LowPart < 0 Then t = QD.LowPart + 4294967296 Else t = QD.LowPart
  If QD.HighPart < 0 Then t = t + (QD.HighPart + 4294967296) * 4294967296 Else t = t + QD.HighPart * 4294967296
  QTime = t * QSpeed
End Function

Private Sub QTimeInit()
  Dim QD As LARGE_INTEGER
  QueryPerformanceFrequency @QD
  If QD.LowPart < 0 Then QSpeed = QD.LowPart + 4294967296 Else QSpeed = QD.LowPart
  If QD.HighPart < 0 Then QSpeed = QSpeed + (QD.HighPart + 4294967296) * 4294967296 Else QSpeed = QSpeed + QD.HighPart * 4294967296
  QSpeed = 1 / QSpeed
End Sub

Private Sub Main()
  Dim vP As Vector, vD As Vector
  Dim t1 As Single, t2 As Single
  Dim msg As MSG

  QTimeInit
  vP.x = 40
  vP.y = 500
  vD.x = 87
  vD.y = -54

  t1 = QTime
  DrawFractal vP, vD
  t2 = QTime

  With bi32BitInfo.bmiHeader
   .biBitCount = 32
   .biPlanes = 1
   .biSize = Len(bi32BitInfo.bmiHeader)
   .biWidth = 1024
   .biHeight = -768
   .biSizeImage = 4 * 1024 * 768
  End With
  Var hwnd=CreateWindowEx(0,"#32770","",WS_VISIBLE Or WS_OVERLAPPEDWINDOW,10,10,1024,768,0,0,0,0)
  Dim wRect As RECT
  GetWindowRect(hWnd,@wRect)
  wRect.right   = wRect.right-wRect.left
  wRect.bottom  = wRect.bottom-wRect.top
  MoveWindow(hWnd,(GetSystemMetrics(0) Shr 1) - (wRect.right Shr 1),_
  (GetSystemMetrics(1) Shr 1) - (wRect.bottom Shr 1),_
  wRect.right, wRect.bottom, 1)
  Var hdc = GetDC(hwnd)
  SetDIBitsToDevice( hdc, 0, 0, 1024, 768, 0, 0, 0, 768, @Map(0, 0), @bi32BitInfo, 0)
  SetBkColor(hDC,&h0)
  SetTextColor(hDC,&hffffff)
  TextOut(hdc,20,20,Str(t2-t1),Len(Str(t2-t1)))
  DeleteDC(hdc)
  While GetMessage(@msg,0,0,0)
   DispatchMessage(@msg)
   If msg.message=WM_COMMAND Then Exit While
  Wend
End Sub

Private Sub DrawFractal(vPos As Vector, vDir As Vector)
  Dim vP As Vector, vD As Vector

  If vDir.x * vDir.x + vDir.y * vDir.y < 0.017 Then Exit Sub
  vP.x = vPos.x + vDir.x
  vP.y = vPos.y + vDir.y
  DrawLine vPos, vP

  vD.x = vDir.x * 0.9 - vDir.y * 0.04
  vD.y = vDir.y * 0.9 + vDir.x * 0.04
  DrawFractal vP, vD
  vD.x = vDir.x * 0.15 + vDir.y * 0.24
  vD.y = vDir.y * 0.15 - vDir.x * 0.24
  DrawFractal vP, vD
  vD.x = vDir.x * 0.14 - vDir.y * 0.25
  vD.y = vDir.y * 0.14 + vDir.x * 0.25
  DrawFractal vP, vD
End Sub

Private Sub DrawLine(vP1 As Vector, vP2 As Vector)
  Dim x As Single, y As Single, k As Single, dx As Single, dy As Single

  dx = vP2.x - vP1.x
  dy = vP2.y - vP1.y
  If Abs(dx) < Abs(dy) Then
   k = dx / dy
   If vP2.y > vP1.y Then
    y = vP1.y
    x = vP1.x
    While y < vP2.y
     Map(y, x) = &H50BB50
     x = x + k
     y = y + 1
    Wend
   Else
    y = vP2.y
    x = vP1.x
    While y < vP1.y
     Map(y, x) = &H40FF30
     x = x + k
     y = y + 1
    Wend
   End If
  Else
   k = dy / dx
   If vP2.x > vP1.x Then
    x = vP1.x
    y = vP1.y
    While x < vP2.x
     Map(y, x) = &HA0AF20
     y = y + k
     x = x + 1
    Wend
   Else
    x = vP2.x
    y = vP1.y
    While x < vP1.x
     Map(y, x) = &H609F30
     y = y + k
     x = x + 1
    Wend
   End If
  End If
End Sub


ЗДЕСЬ если надо EXE вместе с сорцом

Quote
Факт. Сколько видел таких тестов, доказывающих тормознутость VB6, везде либо полная безсмыслица, либо навязывание чуждого для VB6 стиля программирования.


Здесь-то было все по честному. Чистая математика и рекурсия.
PBPROGДата: Среда, 26 Сентября 2012, 19:29 | Сообщение # 13
постоянный участник
Сейчас нет на сайте
Похоже что с файлообменника уже удалили файлы, перезалью. http://depositfiles.com/files/vipw13pu3
Код немного оптимизировал чтобы добиться большего быстродействия.
Code
DisableDebugger

Structure Vector
    x.f
    y.f
EndStructure

#ScreenWidth = 1024
#ScreenHeight = 768

Global Dim Map.l(#ScreenHeight-1, #ScreenWidth-1)

Procedure.d TimeGet()
    Protected.q f, t
      
    QueryPerformanceFrequency_(@f)
    QueryPerformanceCounter_(@t)    
      
    ProcedureReturn t/f
EndProcedure

Procedure DrawLine(*vP1.Vector, *vP2.Vector)
    Static.f  k, dx, dy, x, y, Temp
    Static.l xx, yy
      
    dx = *vP2\x - *vP1\x
    dy = *vP2\y - *vP1\y
      
    If Abs(dx) < Abs(dy)
      k = dx / dy
      If *vP2\y > *vP1\y
        y = *vP1\y
        x = *vP1\x
        While y < *vP2\y
          xx=x : yy=y
          Map(yy, xx) = $50BB50
          x + k
          y + 1
        Wend
      Else
        y = *vP2\y
        x = *vP1\x
        While y < *vP1\y
          xx=x : yy=y
          Map(yy, xx) = $40FF30
          x + k
          y + 1
        Wend
      EndIf
    Else
      k = dy / dx
      If *vP2\x > *vP1\x
        x = *vP1\x
        y = *vP1\y
        While x < *vP2\x
          xx=x : yy=y
          Map(yy, xx) = $A0AF20
          y + k
          x + 1
        Wend
      Else
        x = *vP2\x
        y = *vP1\y
        While x < *vP1\x
          xx=x : yy=y
          Map(yy, xx) = $609F30
          y + k
          x + 1
        Wend
      EndIf
    EndIf
      
EndProcedure

Procedure DrawFractal(*vPos.Vector, *vDir.Vector)
    vP.Vector : vD.Vector

    If *vDir\x * *vDir\x + *vDir\y * *vDir\y >= 0.017
      vP\x = *vPos\x + *vDir\x
      vP\y = *vPos\y + *vDir\y
      DrawLine(*vPos, vP)
        
      vD\x = *vDir\x * 0.9 - *vDir\y * 0.04
      vD\y = *vDir\y * 0.9 + *vDir\x * 0.04
      DrawFractal(vP, vD)
      vD\x = *vDir\x * 0.15 + *vDir\y * 0.24
      vD\y = *vDir\y * 0.15 - *vDir\x * 0.24
      DrawFractal(vP, vD)
      vD\x = *vDir\x * 0.14 - *vDir\y * 0.25
      vD\y = *vDir\y * 0.14 + *vDir\x * 0.25
      DrawFractal(vP, vD)
    EndIf
EndProcedure

Procedure WinCB(hWnd, Msg, wParam, lParam)
      
    Select Msg
      Case #WM_CHAR
        DestroyWindow_(hWnd)
        PostQuitMessage_(0) : Result  = 0   
      Case #WM_CLOSE   
        DestroyWindow_(hWnd)   
      Case #WM_DESTROY   
        PostQuitMessage_(0) : Result  = 0   
      Default   
        Result  = DefWindowProc_(hWnd, Msg, wParam, lParam)   
    EndSelect   
      
    ProcedureReturn Result   
EndProcedure    

Procedure Open_Window()
    WindowClass.s    = "PB_Win"   
    wc.WNDCLASSEX   
    wc\cbsize        = SizeOf(WNDCLASSEX)   
    wc\lpfnWndProc   = @WinCB()   
    wc\hCursor       = LoadCursor_(0, #IDC_ARROW)   
    wc\hbrBackground = #COLOR_WINDOW
    wc\lpszClassName = @WindowClass   
    RegisterClassEx_(@wc)   
      
    hWnd  = CreateWindowEx_(#WS_EX_APPWINDOW, WindowClass, "PureBasic тест", #WS_POPUP | #WS_VISIBLE, 0, 0, #ScreenWidth, #ScreenHeight, 0, 0, 0, 0)
      
    ProcedureReturn hWnd
EndProcedure

Procedure Main()
    vP.Vector : vD.Vector
    bi32BitInfo.BITMAPINFO
      
    vP\x = 40
    vP\y = 500
    vD\x = 87
    vD\y = -54
      
    t1.d=TimeGet()
    DrawFractal(vP, vD)
    t2.d = TimeGet()
      
    With bi32BitInfo\bmiHeader
      \biBitCount = 32
      \biPlanes = 1
      \biSize = SizeOf(bi32BitInfo\bmiHeader)
      \biWidth = #ScreenWidth
      \biHeight = -#ScreenHeight
      \biSizeImage = 4 * #ScreenWidth * #ScreenHeight
    EndWith

    hWnd=Open_Window()
    hDC = GetDC_(hWnd)
    SetDIBitsToDevice_(hDC, 0, 0, #ScreenWidth, #ScreenHeight, 0, 0, 0, #ScreenHeight, Map(), bi32BitInfo, 0)
      
    String.s = StrF(t2 - t1, 5)+" секунд.    Нажмите любую кнопку."
    SetTextColor_(hDC, $FFFFFF)
    SetBkMode_(hDC, #TRANSPARENT)
    TextOut_(hDC, 10, 10, String, Len(String))
      
EndProcedure

Main()

While GetMessage_(msg.MSG, #Null, 0, 0)   
    TranslateMessage_(msg)   
    DispatchMessage_(msg)   
Wend


Сообщение отредактировал PBPROG - Среда, 26 Сентября 2012, 19:30
-Mikle-Дата: Четверг, 27 Сентября 2012, 12:06 | Сообщение # 14
Изобретатель велосипедов
Сейчас нет на сайте
PBPROG, выложи на нормальный файлообменник. MTS вообще пишет, что хост блокирован по решению суда, ну, это обходится, попал на депозит, подождал минуту, ввёл капчу... ещё одна капча, и так шесть раз, надоело, закрыл. Капчи хорошо читаемы, я не мог ошибаться.
Есть Narod.ru, 188.ru.
Quote (PBPROG)
Код немного оптимизировал чтобы добиться большего быстродействия.

Вот это зря, мы же сравниваем на алгоритмы, а компиляторы, теперь придётся для остальных языков переписывать.


Сообщение отредактировал -Mikle- - Четверг, 27 Сентября 2012, 13:31
PBPROGДата: Четверг, 27 Сентября 2012, 19:28 | Сообщение # 15
постоянный участник
Сейчас нет на сайте
Quote (-Mikle-)
выложи на нормальный файлообменник
http://rghost.ru/40600302
http://rusfolder.com/32845839

Quote (-Mikle-)
Вот это зря, мы же сравниваем на алгоритмы, а компиляторы, теп
ерб придётся для остальных языков переписывать.
Не нужно ничего переписывать.
Изменения были произведены в процедуре DrawFractal().
Было.
Code
Procedure DrawFractal(*vPos.Vector, *vDir.Vector)    
     vP.Vector   
     vD.Vector    
        
     If *vDir\x * *vDir\x + *vDir\y * *vDir\y < 0.017  :  ProcedureReturn  :  EndIf   
     vP\x = *vPos\x + *vDir\x    
     vP\y = *vPos\y + *vDir\y    
     DrawLine (*vPos, vP )   
        
     vD\x = *vDir\x * 0.9 - *vDir\y * 0.04    
     vD\y = *vDir\y * 0.9 + *vDir\x * 0.04    
     DrawFractal (vP, vD )   
     vD\x = *vDir\x * 0.15 + *vDir\y * 0.24    
     vD\y = *vDir\y * 0.15 - *vDir\x * 0.24    
     DrawFractal (vP, vD )   
     vD\x = *vDir\x * 0.14 - *vDir\y * 0.25    
     vD\y = *vDir\y * 0.14 + *vDir\x * 0.25    
     DrawFractal (vP, vD )   
   EndProcedure
Стало.
Code
Procedure DrawFractal(*vPos.Vector, *vDir.Vector)
    vP.Vector : vD.Vector

    If *vDir\x * *vDir\x + *vDir\y * *vDir\y >= 0.017
      vP\x = *vPos\x + *vDir\x
      vP\y = *vPos\y + *vDir\y
      DrawLine(*vPos, vP)
        
      vD\x = *vDir\x * 0.9 - *vDir\y * 0.04
      vD\y = *vDir\y * 0.9 + *vDir\x * 0.04
      DrawFractal(vP, vD)
      vD\x = *vDir\x * 0.15 + *vDir\y * 0.24
      vD\y = *vDir\y * 0.15 - *vDir\x * 0.24
      DrawFractal(vP, vD)
      vD\x = *vDir\x * 0.14 - *vDir\y * 0.25
      vD\y = *vDir\y * 0.14 + *vDir\x * 0.25
      DrawFractal(vP, vD)
    EndIf
EndProcedure
Разница в том, что теперь процедура ничего не возвращает (т. е. работает как процедура, а не как функция) и не тратится время на копирование в регистры, возвращаемых данных.
Хоть это требует не очень много времени, но учитывая что процедура DrawFractal() вызывается 1653637 раз (если отладчик не врет), это позволило сэкономить немного времени.

Добавлено (27.09.2012, 19:28)
---------------------------------------------
Я немного проанализировал код и по моему он не оптимален с точки зрения тестирования.
В процедуру по ссылке передаются параметры, но не возвращаются. Это дало возможность схитрить, например, использовав const в параметрах процедур кода на дельфи. Кстати, если убрать const, то дельфи оказывается в хвосте по скорости выполнения кода.
А ведь часто некоторые данные нужно возвращать через аргументы процедур/функций.
Поэтому предлагаю доработать тест, добавив в структуру Vector поле Color в котором будет хранится цвет точки, выводимой на экран. Заодно и массив точек передавать по ссылке процедурам.

Код.
Code
DisableDebugger

Structure Vector
    x.f
    y.f
    Color.l
EndStructure

#ScreenWidth = 1024
#ScreenHeight = 768

Dim Map.l(#ScreenHeight-1, #ScreenWidth-1)
;   

Procedure.d TimeGet()
    Protected.q f, t
      
    QueryPerformanceFrequency_(@f)
    QueryPerformanceCounter_(@t)    
      
    ProcedureReturn t/f
EndProcedure

Procedure DrawLine(*vP1.Vector, *vP2.Vector, Array Map.l(2))
    Static.f  k, dx, dy, x, y, Temp
    Static.l xx, yy
      
    dx = *vP2\x - *vP1\x
    dy = *vP2\y - *vP1\y
      
    If Abs(dx) < Abs(dy)
      k = dx / dy
      If *vP2\y > *vP1\y
        y = *vP1\y
        x = *vP1\x
        While y < *vP2\y
          xx=x : yy=y
          Map(yy, xx) = *vP1\Color
          x + k
          y + 1
        Wend
        *vP2\Color - x
      Else
        y = *vP2\y
        x = *vP1\x
        While y < *vP1\y
          xx=x : yy=y
          Map(yy, xx) = *vP2\Color
          x + k
          y + 1
        Wend
        *vP1\Color + x
      EndIf
    Else
      k = dy / dx
      If *vP2\x > *vP1\x
        x = *vP1\x
        y = *vP1\y
        While x < *vP2\x
          xx=x : yy=y
          Map(yy, xx) = *vP2\Color
          y + k
          x + 1
        Wend
        *vP1\Color + y
      Else
        x = *vP2\x
        y = *vP1\y
        While x < *vP1\x
          xx=x : yy=y
          Map(yy, xx) = *vP1\Color
          y + k
          x + 1
        Wend
        *vP2\Color - y
      EndIf
    EndIf
      
EndProcedure

Procedure DrawFractal(*vPos.Vector, *vDir.Vector, Array Map.l(2))
     
      
    If *vDir\x * *vDir\x + *vDir\y * *vDir\y >= 0.017
        
      vP.Vector\Color = *vPos\Color
      vD.Vector\Color = *vDir\Color
        
      vP\x = *vPos\x + *vDir\x
      vP\y = *vPos\y + *vDir\y
      DrawLine(*vPos, vP, Map())
      vD\x = *vDir\x * 0.9 - *vDir\y * 0.04
      vD\y = *vDir\y * 0.9 + *vDir\x * 0.04
      DrawFractal(vP, vD, Map())
      vP.Vector\Color + vD.Vector\Color
      vD.Vector\Color + vP.Vector\Color
      vP.Vector\Color + vD.Vector\Color
      vD\x = *vDir\x * 0.15 + *vDir\y * 0.24
      vD\y = *vDir\y * 0.15 - *vDir\x * 0.24
      DrawFractal(vP, vD, Map())
      vD\x = *vDir\x * 0.14 - *vDir\y * 0.25
      vD\y = *vDir\y * 0.14 + *vDir\x * 0.25
      DrawFractal(vP, vD, Map())
    EndIf
EndProcedure

Procedure WinCB(hWnd, Msg, wParam, lParam)
      
    Select Msg
      Case #WM_CHAR
        DestroyWindow_(hWnd)
        PostQuitMessage_(0) : Result  = 0   
      Case #WM_CLOSE   
        DestroyWindow_(hWnd)   
      Case #WM_DESTROY   
        PostQuitMessage_(0) : Result  = 0   
      Default   
        Result  = DefWindowProc_(hWnd, Msg, wParam, lParam)   
    EndSelect   
      
    ProcedureReturn Result   
EndProcedure    

Procedure Open_Window()
    WindowClass.s    = "PB_Win"   
    wc.WNDCLASSEX   
    wc\cbsize        = SizeOf(WNDCLASSEX)   
    wc\lpfnWndProc   = @WinCB()   
    wc\hCursor       = LoadCursor_(0, #IDC_ARROW)   
    wc\hbrBackground = #COLOR_WINDOW
    wc\lpszClassName = @WindowClass   
    RegisterClassEx_(@wc)   
      
    hWnd  = CreateWindowEx_(#WS_EX_APPWINDOW, WindowClass, "PureBasic тест", #WS_POPUP | #WS_VISIBLE, 0, 0, #ScreenWidth, #ScreenHeight, 0, 0, 0, 0)
      
    ProcedureReturn hWnd
EndProcedure

Procedure Main(Array Map.l(2))
    vP.Vector : vD.Vector
    bi32BitInfo.BITMAPINFO
      
    vP\x = 40
    vP\y = 500
    vD\x = 87
    vD\y = -54
    vP\Color = $7FFFFF
    vD\Color = $FFFFFF
      
    t1.d=TimeGet()
    DrawFractal(vP, vD, Map())
    t2.d = TimeGet()
      
    With bi32BitInfo\bmiHeader
      \biBitCount = 32
      \biPlanes = 1
      \biSize = SizeOf(bi32BitInfo\bmiHeader)
      \biWidth = #ScreenWidth
      \biHeight = -#ScreenHeight
      \biSizeImage = 4 * #ScreenWidth * #ScreenHeight
    EndWith

    hWnd=Open_Window()
    hDC = GetDC_(hWnd)
    SetDIBitsToDevice_(hDC, 0, 0, #ScreenWidth, #ScreenHeight, 0, 0, 0, #ScreenHeight, Map(), bi32BitInfo, 0)
      
    String.s = StrF(t2 - t1, 5)+" секунд.    Нажмите любую кнопку."
    SetTextColor_(hDC, $FFFFFF)
    SetBkMode_(hDC, #TRANSPARENT)
    TextOut_(hDC, 10, 10, String, Len(String))
      
EndProcedure

Main(Map())

While GetMessage_(msg.MSG, #Null, 0, 0)   
    TranslateMessage_(msg)   
    DispatchMessage_(msg)   
Wend

Скомпилированная прога. http://rusfolder.com/32853166
http://rghost.ru/40607404


Сообщение отредактировал PBPROG - Четверг, 27 Сентября 2012, 19:29
  • Страница 1 из 1
  • 1
Поиск:

Все права сохранены. GcUp.ru © 2008-2024 Рейтинг