Beiträge von UEZ

**UEZ**

Hmm, habe leider nur die Exe auf 5120 Bytes komprimieren können.

Keine Ahnung, wie ich Crinkler mit FB nutzen kann...

Wer es mal probieren will, im Archiv nur die FB x64 Version, da GDI+ v1.1 nur in der x64 existiert.

**UEZ**

Nachdem ich das Beispiel hier von Bradley Taunt gesehen hatte, das mit CSS realisiert wurde, dachte ich mir, ob das irgendwie auch mit Windows Bordmitteln zu realisieren ist.

Hier das Ergebnis (ohne Shader / Ray Tracing gedöns):

AutoIt

;Inspired from https://codepen.io/bradleytaunt/details/VwvzKyb 
;Coded by UEZ build 2020-05-07

#include <GDIPlus.au3>
#include <GUIConstantsEx.au3>
#include <WindowsConstants.au3>

If @OSBuild < 7600 Then Exit MsgBox(BitOR($MB_TOPMOST, $MB_ICONERROR), "ERROR", "This demo requires GDIPlus v1.1", 10)

_GDIPlus_Startup()

Global Const $iW = 1200, $iH = 700, $iSize_globe = 450
Global Const $hGUI = GUICreate("GDI+ Procedural Gfx / Blue Orb v1.20 by UEZ", $iW, $iH, -1, -1, $WS_POPUP, $WS_EX_TOPMOST)

Global Const $hCanvas = _GDIPlus_GraphicsCreateFromHWND($hGUI)
Global Const $hImage = _GDIPlus_BitmapCreateFromScan0($iW, $iH)
Global Const $hGfx = _GDIPlus_ImageGetGraphicsContext($hImage)
_GDIPlus_GraphicsSetSmoothingMode($hGfx, $GDIP_SMOOTHINGMODE_ANTIALIAS8X8)
;~ _GDIPlus_GraphicsSetCompositingQuality($hGfx, $GDIP_COMPOSITINGQUALITYHIGHQUALITY)
_GDIPlus_GraphicsSetInterpolationMode($hGfx, $GDIP_INTERPOLATIONMODE_HIGHQUALITYBICUBIC)
_GDIPlus_GraphicsSetPixelOffsetMode($hGfx, $GDIP_PIXELOFFSETMODE_HALF)

;draw background
Global Const $hBrush_bg = _GDIPlus_LineBrushCreate($iW / 2, 0, $iW / 2, $iH / 2, 0xFF1E88E5, 0xFF1565C0, 2)
_GDIPlus_LineBrushSetSigmaBlend ($hBrush_bg, 0.95, 1) ;create blurry edge
_GDIPlus_GraphicsFillRect($hGfx, 0, 0, $iW, $iH, $hBrush_bg)

;draw blurred text
Global Const $hImage_text = _GDIPlus_BitmapCreateFromScan0($iW, $iH / 2)
Global Const $hGfx_text = _GDIPlus_ImageGetGraphicsContext($hImage_text)
Global Const $hPath_text = _GDIPlus_PathCreate()
Global Const $hFamily = _GDIPlus_FontFamilyCreate("Impact")
Global Const $hStringFormat = _GDIPlus_StringFormatCreate()
Global Const $hBrush_txt = _GDIPlus_LineBrushCreate($iW / 2, 0, $iW / 2, $iH / 2, 0xE0FFFFFF, 0xA01A237E) ;_GDIPlus_BrushCreateSolid(0xF02E86FB)
_GDIPlus_LineBrushSetSigmaBlend($hBrush_txt, 0.66, 1)
Global Const $hPen_txt = _GDIPlus_PenCreate(0x801A237E, 1)
_GDIPlus_StringFormatSetAlign($hStringFormat, 1)
_GDIPlus_StringFormatSetLineAlign($hStringFormat, 1)
_GDIPlus_GraphicsSetSmoothingMode($hGfx_text, $GDIP_SMOOTHINGMODE_ANTIALIAS8X8)
_GDIPlus_GraphicsSetTextRenderingHint($hGfx_text, $GDIP_TextRenderingHintAntialias)
_GDIPlus_GraphicsSetPixelOffsetMode($hGfx_text, $GDIP_PIXELOFFSETMODE_HALF)
_GDIPlus_GraphicsSetCompositingQuality($hGfx_text, $GDIP_COMPOSITINGQUALITYHIGHQUALITY)
Global $tLayout = _GDIPlus_RectFCreate()
$tLayout.width = $iW
$tLayout.height = $iH / 2
$tLayout.y = -$iH * 0.05
_GDIPlus_PathAddString($hPath_text, "AutoIt rulez!", $tLayout, $hFamily, 0, $iW / 8, $hStringFormat)
_GDIPlus_GraphicsFillPath($hGfx_text, $hPath_text, $hBrush_txt)
_GDIPlus_GraphicsDrawPath($hGfx_text, $hPath_text, $hPen_txt)
Global Const $hEffect_blur_text = _GDIPlus_EffectCreateBlur(20)
_GDIPlus_BitmapApplyEffect($hImage_text, $hEffect_blur_text)
_GDIPlus_GraphicsDrawImageRect($hGfx, $hImage_text, 0, 0, $iW, $iH / 2)

;draw shadow of the text
Global Const $hBrush_txt_shadow = _GDIPlus_BrushCreateSolid(0x40000000)
_GDIPlus_GraphicsClear($hGfx_text, 0)
_GDIPlus_PathReset($hPath_text)
$tLayout.width = $iW
$tLayout.height = $iH / 2
$tLayout.y = 0
_GDIPlus_PathAddString($hPath_text, "AutoIt rulez!", $tLayout, $hFamily, 0, $iW / 8, $hStringFormat)
_GDIPlus_GraphicsFillPath($hGfx_text, $hPath_text, $hBrush_txt_shadow)
Global Const $hEffect_blur_text_shadow = _GDIPlus_EffectCreateBlur(60)
_GDIPlus_BitmapApplyEffect($hImage_text, $hEffect_blur_text_shadow)
_GDIPlus_GraphicsDrawImageRect($hGfx, $hImage_text, 0, $iH * 0.55, $iW, $iH / 8)

;draw shadow
Global Const $iW_shadow1 = $iSize_globe * 0.85, $iH_shadow1 = $iSize_globe * 0.1, $iW_shadow2 = $iSize_globe * 0.60, _
        $iW_shadow_Img = $iW_shadow1 * 2, $iH_shadowImg = $iH_shadow1 * 4
Global Const $hImage_shadow = _GDIPlus_BitmapCreateFromScan0($iW_shadow_Img, $iH_shadowImg)
Global Const $hGfx_shadow = _GDIPlus_ImageGetGraphicsContext($hImage_shadow)
_GDIPlus_GraphicsSetSmoothingMode($hGfx_shadow, $GDIP_SMOOTHINGMODE_ANTIALIAS8X8)
Global Const $hBrush_shadow = _GDIPlus_BrushCreateSolid(0x66000000)
_GDIPlus_GraphicsFillEllipse($hGfx_shadow, ($iW_shadow_Img - $iW_shadow1) / 2, ($iH_shadowImg / 4 + $iH_shadow1), $iW_shadow1, $iH_shadow1, $hBrush_shadow)
_GDIPlus_BrushSetSolidColor($hBrush_shadow, 0xB3000000)
_GDIPlus_GraphicsFillEllipse($hGfx_shadow, ($iW_shadow_Img - $iW_shadow2) / 2, ($iH_shadowImg / 4 + $iH_shadow1), $iW_shadow2, $iH_shadow1, $hBrush_shadow)
Global Const $hEffect_blur_shadow = _GDIPlus_EffectCreateBlur(32)
_GDIPlus_BitmapApplyEffect($hImage_shadow, $hEffect_blur_shadow)
_GDIPlus_GraphicsDrawImageRect($hGfx, $hImage_shadow, ($iW - $iW_shadow_Img) / 2, $iH / 2 + $iH_shadow1 * 2.20, $iW_shadow_Img, $iH_shadowImg)

;draw globe
Global Const $hPath_globe = _GDIPlus_PathCreate()
_GDIPlus_PathAddEllipse($hPath_globe, ($iW - $iSize_globe) / 2, ($iH - $iSize_globe) / 2, $iSize_globe, $iSize_globe)
Global Const $hLBrush_globe1 = _GDIPlus_LineBrushCreate($iW / 2, ($iH - $iSize_globe) / 2, $iW / 2, ($iH + $iSize_globe) / 2, 0, 0, 1)
Global $aInterpolations[5][2]
$aInterpolations[0][0] = 4
$aInterpolations[1][0] = 0xFFFFFFFF
$aInterpolations[1][1] = 0
$aInterpolations[2][0] = 0xFFEEEEEE
$aInterpolations[2][1] = 0.10
$aInterpolations[3][0] = 0xFF2E86FB
$aInterpolations[3][1] = 0.50
$aInterpolations[4][0] = 0xFF1A237E
$aInterpolations[4][1] = 1.0
_GDIPlus_LineBrushSetPresetBlend($hLBrush_globe1, $aInterpolations)
_GDIPlus_GraphicsFillPath($hGfx, $hPath_globe, $hLBrush_globe1)
Global Const $iSize_globe2 = $iSize_globe * 0.85, $iSize_globe2_Img = $iSize_globe2 * 1.5
Global Const $hImage_globe2 = _GDIPlus_BitmapCreateFromScan0($iSize_globe2_Img, $iSize_globe2_Img)
Global Const $hGfx_globe2 = _GDIPlus_ImageGetGraphicsContext($hImage_globe2)
Global Const $hBrush_globe2 = _GDIPlus_BrushCreateSolid(0x7F000000)
;draw shadow and blur it
Global Const $px = ($iSize_globe2_Img - $iSize_globe2) / 2, $py = ($iSize_globe2_Img - $iSize_globe2) / 2
_GDIPlus_GraphicsFillEllipse($hGfx_globe2, $px, $py + ($iSize_globe - $iSize_globe2) * 0.25, $iSize_globe2, $iSize_globe2, $hBrush_globe2)
Global Const $hEffect_blur_shadow2 = _GDIPlus_EffectCreateBlur(15)
_GDIPlus_BitmapApplyEffect($hImage_globe2, $hEffect_blur_shadow2)
;draw 2nd smaller globe and blur it, too
Global Const $hLBrush_globe2 = _GDIPlus_LineBrushCreate($iW / 2, $py, $iW / 2, $py + $iSize_globe2, 0, 0)
Dim $aInterpolations[4][2]
$aInterpolations[0][0] = 3
$aInterpolations[1][0] = 0xFFFFFFFF
$aInterpolations[1][1] = 0
$aInterpolations[2][0] = 0xFF2E86FB
$aInterpolations[2][1] = 0.60
$aInterpolations[3][0] = 0xFF283593
$aInterpolations[3][1] = 1.0
_GDIPlus_LineBrushSetPresetBlend($hLBrush_globe2, $aInterpolations)
_GDIPlus_GraphicsFillEllipse($hGfx_globe2, $px, $py, $iSize_globe2, $iSize_globe2, $hLBrush_globe2)
Global Const $hImage_globe2_blur = _Blur($hImage_globe2, $iSize_globe, $iSize_globe) ;windows gdi+ blur doesn't work properly
_GDIPlus_GraphicsDrawImageRect($hGfx, $hImage_globe2_blur, ($iW - $iSize_globe2_Img) / 2 - ($iSize_globe - $iSize_globe2) / 8, ($iH - $iSize_globe2_Img) / 2, $iSize_globe2_Img, $iSize_globe2_Img)
GUISetState()

_GDIPlus_GraphicsDrawImageRect($hCanvas, $hImage, 0, 0, $iW, $iH)
;~ _GDIPlus_ImageSaveToFile($hImage, @ScriptDir & "\Blue Orb v1.20.png")

;clean-up ressources
_GDIPlus_FontFamilyDispose($hFamily)
_GDIPlus_StringFormatDispose($hStringFormat)
_GDIPlus_EffectDispose($hEffect_blur_text)
_GDIPlus_EffectDispose($hEffect_blur_text_shadow)
_GDIPlus_EffectDispose($hEffect_blur_shadow)
_GDIPlus_EffectDispose($hEffect_blur_shadow2)
_GDIPlus_PathDispose($hPath_text)
_GDIPlus_PathDispose($hPath_globe)
_GDIPlus_PenDispose($hPen_txt)
_GDIPlus_BrushDispose($hBrush_txt)
_GDIPlus_BrushDispose($hBrush_txt_shadow)
_GDIPlus_BrushDispose($hBrush_bg)
_GDIPlus_BrushDispose($hLBrush_globe1)
_GDIPlus_BrushDispose($hLBrush_globe2)
_GDIPlus_BrushDispose($hBrush_globe2)
_GDIPlus_ImageDispose($hImage)
_GDIPlus_ImageDispose($hImage_text)
_GDIPlus_ImageDispose($hImage_shadow)
_GDIPlus_ImageDispose($hImage_globe2)
_GDIPlus_ImageDispose($hImage_globe2_blur)
_GDIPlus_GraphicsDispose($hCanvas)
_GDIPlus_GraphicsDispose($hGfx_text)
_GDIPlus_GraphicsDispose($hGfx_shadow)
_GDIPlus_GraphicsDispose($hGfx_globe2)
_GDIPlus_Shutdown()

Do
Until GUIGetMsg() = $GUI_EVENT_CLOSE

GUIDelete($hGUI)
Exit

Func _Blur($hBitmap, $iW, $iH, $fScale = 0.0525, $dx1 = 0, $dy1 = 0, $dx2 = 0, $dy2 = 0, $qual = 6) ; by eukalyptus
    Local $hBmpSmall = _GDIPlus_BitmapCreateFromScan0($iW, $iH)
    Local $hGfxSmall = _GDIPlus_ImageGetGraphicsContext($hBmpSmall)
    _GDIPlus_GraphicsSetPixelOffsetMode($hGfxSmall, $GDIP_PIXELOFFSETMODE_HALF)
    Local $hBmpBig = _GDIPlus_BitmapCreateFromScan0($iW, $iH)
    Local $hGfxBig = _GDIPlus_ImageGetGraphicsContext($hBmpBig)
    _GDIPlus_GraphicsSetPixelOffsetMode($hGfxBig, $GDIP_PIXELOFFSETMODE_HALF)

    _GDIPlus_GraphicsScaleTransform($hGfxSmall, $fScale, $fScale)
    _GDIPlus_GraphicsSetInterpolationMode($hGfxSmall, $qual)

    _GDIPlus_GraphicsScaleTransform($hGfxBig, 1 / $fScale, 1 / $fScale)
    _GDIPlus_GraphicsSetInterpolationMode($hGfxBig, $qual)

    _GDIPlus_GraphicsDrawImageRect($hGfxSmall, $hBitmap, 0, $dx1, $iW, $iH + $dy1)
    _GDIPlus_GraphicsDrawImageRect($hGfxBig, $hBmpSmall, 0, $dx2, $iW, $iH + $dy2)

    _GDIPlus_BitmapDispose($hBmpSmall)
    _GDIPlus_GraphicsDispose($hGfxSmall)
    _GDIPlus_GraphicsDispose($hGfxBig)
    Return $hBmpBig
EndFunc   ;==>_Blur

Alles anzeigen

Vorschau:

Blue Orb v1.20.png

Ich werde versuchen mit FB an die 4kb Exe Grenze zu kommen. Mal sehen, ob das klappen wird...

Wenn ihr auch was habt, dann postet's einfach hier rein.

**UEZ**

Ähnlich ist es mit FreeBasic und GCC in der Version 5.2.0. Sobald ich was in x86 kompiliere, springt sofort mein AV an.

Alle anderen GCC Versionen funktionieren ohne Probleme.

**UEZ**

Sehr nettes Tools.

Eine Kleinigkeit ist mir aufgefallen: wenn die Fehlerkorrektur auf 7% steht und die Vergrößerung z.B. auf 486x486 und ich setze die Fehlerkorrektur z.B. auf 25% und drücke auf Show QR Code, dann wird das Bild wieder klein dargestellt, obwohl der Slider immer noch auf 486x486 steht.

**UEZ**

In der CMD Box manuel nim c HelloWorld.nim dauert höchstens 3 Sekunden.

Kann dies am VS bei dir liegen?

**UEZ**

trancexx hatte auch klasse Ideen, wie die Zukunft von Autoit aussehen könnte, aber da gab es auch Differenzen, die zum Ausstieg von trancexx geführt hatten.

**UEZ**

Zitat von water

MVPs arbeiten nicht am Core mit, haben aber die Möglichkeit im Repository an den UDFs und der Doku rumzuschrauben.
Jon ist wahrscheinlich auch sehr, sehr vorsichtig mit Leuten, die am Core rumfummelnd dürfen. Da gab es schlechte Erfahrungen mit Codern, deren großes Ego Kompromisse oder andere Sichtweisen nicht zuliessen.

Wenigstens gäbe es dann einen Fortschritt und keinen Stillstand, auch wenn der Verlauf nicht unbedingt dem entspräche, was sich Jon vorstellt. Soweit ich mich noch erinnern kann, gab es coole Ideen, wie sich Autoit weiter entwickeln könnte...

Apropos Jon, anscheinend schreibt er lieber coole Amiga Demos anstatt sich um die Entwicklung von AutoIt zu kümmern....

**UEZ**

Krasse Fantasie Leute

Ich dachte eher an bewegenden Zellen eines Blattes oder so, aber ein Darm ist mir nie in den Sinn gekommen, dann eher Lava, wenn die Darstellung in rot wäre...

Das wird mir wohl in die Annalen gehen...

**UEZ**

Interessant, dass die x86 Versionen schneller als die x64 Versionen laufen. Ist auf meinem Rechner ähnlich, bis auf -gen gcc -Wc -Ofast, wo die x64 schneller läuft.

Eine andere Sache ist, dass wenn ich die interne Circle Funktion aufrufe, dann ist die Geschwindigkeit auch höher. Ich frage mich, was an der internen Circle Funktion anders läuft, zumal sie noch diverse Checks durchführt, wie z.B. Überschreitung der Ränder, Parameter Check, usw.

Danke allen für's Testen!

**UEZ**

Zitat von AspirinJunkie

Die Bereichsüberlaufabfragen (Iif(px1...)) fehlen ja bei deiner letzten Variante.

Das sollte jetzt in der neuen Version behoben sein.

Das ist sehr interessant, dass nach Optimierung der Code langsamer läuft!

Ich habe jetzt verschiedene Versionen erstellt, um den Vergleich interessanter zu machen.

Hier das Ergebnis:

Code

Test System: AMD Ryzen 5 PRO 3500U w/ Radeon Vega Mobile Gfx / Windows10 x64 1903

1) Atomic Cell World x64 (-gen gcc -Wc -Ofast).exe    45 fps
1) Atomic Cell World x86 (-gen gcc -Wc -Ofast).exe    41 fps
2) Atomic Cell World x64 (-gen gcc -Wc -O2).exe        26 fps
2) Atomic Cell World x86 (-gen gcc -Wc -O2).exe        41 fps
3) Atomic Cell World x64 (-gen gcc -O 3).exe        25 fps
3) Atomic Cell World x86 (-gen gcc -O 3).exe        40 fps
4) Atomic Cell World x64 (Standard).exe             9 fps
4) Atomic Cell World x86 (Standard).exe            10 fps

Eine Minute Laufzeit und FPS ist der "Average" Wert.

Alles anzeigen

Im Anhang die neusten Versionen.

**UEZ**

Zitat von AspirinJunkie

Und doch hast du immer noch eine Addition in der Schleife die nicht sein muss.
Schmeiß dein py doch direkt mit auf px1 und px2 drauf (außerhalb der Schleife - nicht mal im Schleifenkopf). Dann hast du im Loop nur noch pScrn[xx] = c

Ach ja, da war doch noch was.

Die Funktion sieht jetzt so aus

Code

Sub _Circle(x As Short, y As Short, r As Short, c As Ulong)
    Dim As Short r2 = r * r, cx, cy, cyy
    Dim As Ulong py, px1, px2, xx
    For cy = -r to r
        cx = _Sqrt25(r2 - cy * cy) + 0.5
        cyy = cy + y : cyy = Iif(cyy < 0, 0, Iif(cyy > iH - 1, iH - 1, cyy))
        py = cyy * iW + x
        px1 = py - cx
        px2 = py + cx
        For xx = px1 To px2 'fill circle
            pScrn[xx] = c
        Next
    Next
End Sub

Alles anzeigen

Zwar läuft der Code jetzt noch schneller (~47 FPS), aber mit der Darstellung stimmt was nicht.

Problem.jpg

Zitat von AspirinJunkie

Ja kann ich - blöderweise jedoch genau andersherum. Die alte Version macht bei mir ca 40 FPS. Die neue hingegen nur 30 FPS.
Auch wenn ich beide parallel nebeneinander laufen lasse hat die alte ~ 30 und die neue ~ 20.
Keine Ahnung woran das liegt.

Das ist komisch? Die Exe ist als x64 kompiliert und sollte theoretisch durch die Maßnahmen schneller laufen...

**UEZ**

AspirinJunkie sehr gut. 4 Augen sehen mehr als 2.

In der Tat habe ich es übersehen, dass die kostenintensive Berechnung des Kreises noch optimierbar ist, wenn ich die Konstante cyy * iW innerhalb der For xx Schleife herausnehme.

Auch 255 / BallSize ist eine Konstante die nicht in der Hauptschleife jedesmal berechnet werden muss!

Das mit "2 * BallSize" wird nur einmal durchlaufen und macht sich nicht bemerkbar, aber wäre dies in einer permanenten Schleife, dann könnte man die Bitshift Operation wählen.

Mit diesen zwei Optimierungen konnte ich auf meiner Kiste ca. 10 FPS herausholen!

Den Richtungsvektor bei Kollision mit den Rändern von *-1 auf -vx/-vy zu stellen, macht sich nicht bemerkbar, da nur die Anzahl der Zellen aufgerufen wird, aber auch eine Optimierungsmöglichkeit.

So sieht der Code nach dem Update aus:

Code

'Coded by UEZ build 2020-04-20
#Include "fbgfx.bi"
Using FB

Const iW = 640, iH = 480
Dim Shared As Ulong Ptr pScrn

Function _ASM_Sqr(n As Single) As Single
    Asm
        rsqrtss xmm0, [n]
        mulss   xmm0, [n]
        movss   [Function], xmm0        
    End Asm
End Function

Function _Sqrt1(n As Single) As Single
    Dim As Integer highest = 1, sqrt_highest = 1
    While highest < n
        highest Shl= 2
        sqrt_highest Shl= 1
    Wend
    n /= highest
    Dim As Single result
    result = (n / 4) + 1
    result = (result / 2) + (n / (result * 2))
    result = (result / 2) + (n / (result * 2))
    Return result * sqrt_highest
End Function

Function _Sqrt2(n As Single) As Single 'only 32 bit compatible
    Dim As Integer i = Cvi(n)
    i = &h1FB90000 + (i Shr 1)
    Dim As Single y = Cvs(i)
    Return (y + n / y) / 2
End Function

Function _Sqrt25(n As Single) As Single
    Dim As ULong i = *Cptr(Ulong Ptr, @n)
    i = &h1FB90000 + (i Shr 1)
    Dim As Single y = *Cptr(Single Ptr, @i)
    Return (y + n / y) / 2
End Function

'http://www.codeproject.com/Articles/69941/Best-Square-Root-Method-Algorithm-Function-Precisi
Function _Sqrt3(x As Single) As Single 'only 32bit
  Dim As ULong y = *Cptr(Ulong Ptr, @x), s
  s = y And &h80000000
  y And= &h7FFFFFFF
  y += 127 Shl 23
  y Shr= 1
  y Or= s
  Return *Cptr(Single Ptr, @y)
End Function

Sub _Circle(x As Short, y As Short, r As Short, c As Ulong)
    Dim As Short r2 = r * r, cx, cy, cyy, px1, px2, xx
    Dim As Ulong py
    For cy = -r to r
        cx = _ASM_Sqr(r2 - cy * cy) + 0.5
        cyy = cy + y : cyy = Iif(cyy < 0, 0, Iif(cyy > iH - 1, iH - 1, cyy))
        px1 = x - cx : px1 = Iif(px1 < 0, 0, Iif(px1 > iW - 1, iW - 1, px1))
        px2 = x + cx : px2 = Iif(px2 < 0, 0, Iif(px2 > iW - 1, iW - 1, px2))
        py = cyy * iW
        For xx = px1 To px2'fill circle
            pScrn[py + xx] = c
        Next
    Next
End Sub

Screenres iW, iH, 32, 2, GFX_WINDOWED Or GFX_NO_SWITCH Or GFX_ALWAYS_ON_TOP' Or GFX_ALPHA_PRIMITIVES
ScreenSet 1, 0

Windowtitle("Atomic Cell World v0.3 by UEZ")

pScrn = Screenptr()

Type tPoint
    As Single x, y, vx, vy, s
    As Ubyte r, g, b
End Type

Dim As Ubyte AmountBalls = 50, BallSize = 100, i, BS = BallSize Shr 1
Dim As Single j, c, d, cc = 255 / BallSize, fSpeed = 2 'BallSize / 255

Dim As tPoint Points(AmountBalls - 1)
Dim As Ulong iFPS

Randomize Timer, 2

For i = 0 To AmountBalls - 1
    Points(i).x = BallSize + Rnd() * (iW - 2 * BallSize - 1)
    Points(i).y = BallSize + Rnd() * (iH - 2 * BallSize - 1)
    Points(i).vx = Rnd() - 0.5
    Points(i).vy = Rnd() - 0.5
    Points(i).r = Rnd() * 255 'Iif(Rnd() > 0.50, 1, 0)
    Points(i).g = 0 'Iif(Rnd() > 0.50, 1, 0)
    Points(i).b = 0 'Iif(Rnd() > 0.50, 1, 0)
Next

Dim As Ushort cfps = 0
Dim As Single fTimer = Timer
Do
    'Cls
    'Line (0, 0)-(iW - 1, iH - 1), &hFF101010, BF
    Line (1, 1)-(70, 10), &hFF000000, BF
    
    For j = 1 To BallSize Step fSpeed
        c = j * cc
        d = (BallSize - j)
        For i = 0 To AmountBalls - 1
            'Circle(Points(i).x, Points(i).y), d, c Shl 8, , , , F
            '_Circle(Points(i).x, Points(i).y, d, Rgb(Iif(Points(i).r, c, 0), Iif(Points(i).g, c, 0), Iif(Points(i).b, c, 0))) 'different color
            _Circle(Points(i).x, Points(i).y, d, c Shl 8) 'static color
        Next
    Next
    For i = 0 To AmountBalls - 1
        Points(i).x += Points(i).vx
        Points(i).y += Points(i).vy
        If Points(i).x < BS Or Points(i).x > (iW - BS) Then Points(i).vx = -Points(i).vx
        If Points(i).y < BS Or Points(i).y > (iH - BS) Then Points(i).vy = -Points(i).vy
    Next
    
    Draw String(1, 1), iFPS & " fps", Rgb(&hFF, &hFF, &hFF)

    Flip
    
    cfps += 1
    If Timer - fTimer > 0.99 Then
        iFPS = cfps
        cfps = 0
        fTimer = Timer
    End If
    
    Sleep(1)
Loop Until Len(Inkey())

Alles anzeigen

Könnt ihr auch den Unterschied auf eurem PC sehen? Auf meinem Rechner ist die FPS von ca. 30 auf ca. 40 FPS geklettert.

**UEZ**

Ich such nach einer Möglichkeit folgenden Code zu beschleunigen:

Code

'Coded by UEZ build 2020-04-20
#Include "fbgfx.bi"
Using FB

Const iW = 640, iH = 480
Dim Shared As Ulong Ptr pScrn

Function _ASM_Sqr(n As Single) As Single
    Asm
        rsqrtss xmm0, [n]
        mulss   xmm0, [n]
        movss   [Function], xmm0        
    End Asm
End Function

Function _Sqrt1(n As Single) As Single
    Dim As Integer highest = 1, sqrt_highest = 1
    While highest < n
        highest Shl= 2
        sqrt_highest Shl= 1
    Wend
    n /= highest
    Dim As Single result
    result = (n / 4) + 1
    result = (result / 2) + (n / (result * 2))
    result = (result / 2) + (n / (result * 2))
    Return result * sqrt_highest
End Function

Function _Sqrt2(n As Single) As Single 'only 32 bit compatible
    Dim As Integer i = Cvi(n)
    i = &h1FB90000 + (i Shr 1)
    Dim As Single y = Cvs(i)
    Return (y + n / y) / 2
End Function

Function _Sqrt25(n As Single) As Single
    Dim As ULong i = *Cptr(Ulong Ptr, @n)
    i = &h1FB90000 + (i Shr 1)
    Dim As Single y = *Cptr(Single Ptr, @i)
    Return (y + n / y) / 2
End Function

'http://www.codeproject.com/Articles/69941/Best-Square-Root-Method-Algorithm-Function-Precisi
Function _Sqrt3(x As Single) As Single 'only 32bit
  Dim As ULong y = *Cptr(Ulong Ptr, @x), s
  s = y And &h80000000
  y And= &h7FFFFFFF
  y += 127 Shl 23
  y Shr= 1
  y Or= s
  Return *Cptr(Single Ptr, @y)
End Function

Sub _Circle(x As Short, y As Short, r As Short, c As Ulong)
    Dim As Short r2 = r * r, cx, cy, cyy, px1, px2, py, xx
    For cy = -r to r
        cx = _ASM_Sqr(r2 - cy * cy) + 0.5
        cyy = cy + y : cyy = Iif(cyy < 0, 0, Iif(cyy > iH - 1, iH - 1, cyy))
        px1 = x - cx : px1 = Iif(px1 < 0, 0, Iif(px1 > iW - 1, iW - 1, px1))
        px2 = x + cx : px2 = Iif(px2 < 0, 0, Iif(px2 > iW - 1, iW - 1, px2))
        For xx = px1 To px2'fill circle
            pScrn[cyy * iW + xx] = c
        Next
    Next
End Sub

Screenres iW, iH, 32, 2, GFX_WINDOWED Or GFX_NO_SWITCH Or GFX_ALWAYS_ON_TOP' Or GFX_ALPHA_PRIMITIVES
ScreenSet 1, 0

Windowtitle("Atomic Cell World v0.3 by UEZ")

pScrn = Screenptr()

Type tPoint
    As Single x, y, vx, vy, s
    As Ubyte r, g, b
End Type

Dim As Ubyte AmountBalls = 50, BallSize = 100, i, BS = BallSize Shr 1
Dim As Single j, c, d, fSpeed = 2 'BallSize / 255

Dim As tPoint Points(AmountBalls - 1)
Dim As Ulong iFPS

Randomize Timer, 2

For i = 0 To AmountBalls - 1
    Points(i).x = BallSize + Rnd() * (iW - 2 * BallSize - 1)
    Points(i).y = BallSize + Rnd() * (iH - 2 * BallSize - 1)
    Points(i).vx = Rnd() - 0.5
    Points(i).vy = Rnd() - 0.5
    Points(i).r = Rnd() * 255 'Iif(Rnd() > 0.50, 1, 0)
    Points(i).g = 0 'Iif(Rnd() > 0.50, 1, 0)
    Points(i).b = 0 'Iif(Rnd() > 0.50, 1, 0)
Next

Dim As Ushort cfps = 0
Dim As Single fTimer = Timer
Do
    'Cls
    'Line (0, 0)-(iW - 1, iH - 1), &hFF101010, BF
    Line (1, 1)-(70, 10), &hFF000000, BF
    
    For j = 1 To BallSize Step fSpeed
        c = j * 255 / BallSize
        d = (BallSize - j)
        For i = 0 To AmountBalls - 1
            'Circle(Points(i).x, Points(i).y), d, c Shl 8, , , , F
            '_Circle(Points(i).x, Points(i).y, d, Rgb(Iif(Points(i).r, c, 0), Iif(Points(i).g, c, 0), Iif(Points(i).b, c, 0))) 'different color
            _Circle(Points(i).x, Points(i).y, d, c Shl 8) 'static color
        Next
    Next
    For i = 0 To AmountBalls - 1
        Points(i).x += Points(i).vx
        Points(i).y += Points(i).vy
        If Points(i).x < BS Or Points(i).x > (iW - BS) Then Points(i).vx *= - 1
        If Points(i).y < BS Or Points(i).y > (iH - BS) Then Points(i).vy *= - 1
    Next
    
    Draw String(1, 1), iFPS & " fps", Rgb(&hFF, &hFF, &hFF)

    Flip
    
    cfps += 1
    If Timer - fTimer > 0.99 Then
        iFPS = cfps
        cfps = 0
        fTimer = Timer
    End If
    
    Sleep(1)
Loop Until Len(Inkey())

Alles anzeigen

Das Resultat sollte so aussehen:

Atomic Cell World.jpg

Nach meinem Verständnis kostet die "_Circle" Funktion am meisten Zeit. Warum auch immer ist die Build-in Circle Funktion schneller (Zeile 109).

Habt ihr noch Ideen, wie ich den Code optimieren kann, damit der Code schneller läuft?

Soll ich ein kleines Tutorial schreiben, wie man FB benutzt? Ist fast ähnlich einfach zu bedienen wie SciTE, wenn man die erste kleine Hürde genommen hat die Umgebung einzurichten.

**UEZ**

Ein einfaches

Code

AutoItSetOption('GUIOnEventMode', 1)

verlangsamt auch das Skript

Code

AutoItSetOption('GUIOnEventMode', 1)
$start = TimerInit()
$x = 0
For $i = 1 To 5000000
    $x += 1
Next
ConsoleWrite('@@ Debug(' & @ScriptLineNumber & ') : TimerDiff($start) = ' & TimerDiff($start) & @CRLF) ;### Debug Console

Unter FreeBasic gibt es keine Probleme!

Code

#include "string.bi"
#Include Once "windows.bi"

Sub Test(sMsg As String = "")
    Static As Uinteger iLoop = 1, iValue
    ? ">>>>> Check " & iLoop & " " & sMsg & " <<<<<<"
    
    Dim As Double iTime
    For j As Ubyte = 1 To 3
        iTime = Timer
        iValue = 0
        For i As Uinteger = 1 To 750000000
            iValue += 1
        Next
        ? "Elapsed Time " & j & ": " & (Timer - iTime) * 1000 & " ms"
    Next
    iLoop += 1
End Sub

Test("")
Messagebox(0, "Test", "Test", MB_OK)
Test("after Messagebox call")
? "Done"
Sleep

Alles anzeigen

Output:

Code

>>>>> Check 1  <<<<<<
Elapsed Time 1: 1634.368500014247 ms
Elapsed Time 2: 1568.77529999646 ms
Elapsed Time 3: 1718.41980000012 ms
>>>>> Check 2 after Messagebox call <<<<<<
Elapsed Time 1: 1621.735800009915 ms
Elapsed Time 2: 1752.797799986425 ms
Elapsed Time 3: 1734.618899997685 ms
Done

**UEZ**

EGMS : du musst das DirCopy simulieren, d.h. du schreibst dir dein eigene DirCopy Funktion.

Im Prinzip liest du dir alle Ordner und Dateien vom Quell Ordner per _FileListToArrayRec() ein Array ein und kopiert diese Dateien aus dem Array mit FileCopy() sukzessive.

Somit kannst du auch ein Status Balken direkt einbauen.

**UEZ**

Ich glaube, dass du in diesem Fall die Breite und Höhe des Label Controls in Zeile 70/71 explizit angeben musst. D.h. du musst vorher die Breite / Höhe ermitteln.

**UEZ**

https://www.gmx.net/magazine/news/…akrise-34549604

Bleibt gesund!

**UEZ**

Versuche es mal mit

DU von SysInternals

Code

DU v1.61 - Directory disk usage reporter
Copyright (C) 2005-2016 Mark Russinovich
Sysinternals - www.sysinternals.com

usage: du [-c[t]] [-l <levels> | -n | -v] [-u] [-q] <directory>
   -c     Print output as CSV. Use -ct for tab delimiting.
          Use -nobanner to suppress banner.
   -l     Specify subdirectory depth of information (default is one level).
   -n     Do not recurse.
   -q     Quiet.
   -nobanner
          Do not display the startup banner and copyright message.
   -u     Count each instance of a hardlinked file.
   -v     Show size (in KB) of all subdirectories.

CSV output is formatted as:
Path,CurrentFileCount,CurrentFileSize,FileCount,DirectoryCount,DirectorySize,DirectorySizeOnDisk

Alles anzeigen

Dort hast du den Parameter -u.

**UEZ**

Zitat von Andy

//EDIT
UEZ war schneller....so ist das, wenn man die Posts erst Stunden/Tage nach dem Editieren los schickt

**UEZ**

Hier eine tick schnellere Version:

C

#cs ----------------------------------------------------------------------------

 AutoIt Version: 3.3.14.5
 Author:         alpines

 Script Function:
    AutoIt implementation of the "game" Rule 110.
    https://en.wikipedia.org/wiki/Rule_110

#ce ----------------------------------------------------------------------------

#include <GDIPlus.au3>
#include <GUIConstantsEx.au3>
#include <StringConstants.au3>

Global Const $I_GUI_WIDTH = 1024
Global Const $I_GUI_HEIGHT = 768

Opt("GUIOnEventMode", 1)

#cs
    Interessante Rules

    Rule 126 = Sierpinski Dreieck
    Rule 122 = Schachbrett
    Rule 118 = Schattierte Pyramide

    Rule 137 = Invertiertes Rule 110
#ce

Global Const $I_RULE = 110; max. 8 bit => 255

Global $oRule = ObjCreate("Scripting.Dictionary")

For $iBitA = 0 To 1
    For $iBitB = 0 To 1
        For $iBitC = 0 To 1
            Local $iCurrentBit = BitShift(1, -(BitShift($iBitA, -2) + BitShift($iBitB, -1) + BitShift($iBitC, -0)))
            $oRule.Add($iBitA & $iBitB & $iBitC, BitAND($I_RULE, $iCurrentBit) ? 1 : 0)
        Next
    Next
Next

Global $hGUI = GUICreate("Rule " & $I_RULE, $I_GUI_WIDTH, $I_GUI_HEIGHT)
GUISetOnEvent($GUI_EVENT_CLOSE, ExitApp)
GUISetState(@SW_SHOW, $hGUI)

Global $aCells[$I_GUI_HEIGHT][$I_GUI_WIDTH]
For $i = 0 To UBound($aCells) - 1
    For $j = 0 To UBound($aCells, 2) - 1
        $aCells[$i][$j] = 0
    Next
Next

;Ausgangssituation! Für Rule 110 die letzte Spalte in der ersten Zeile 1 setzen.
;Es ist hier in die Mitte gesetzt um es nicht ständig umsetzen zu müssen.
;Interessante Muster kommen auch raus wenn man mehrere Startpunkte 1 setzt ;)
$aCells[0][UBound($aCells, 2) / 2] = 1

_GDIPlus_Startup()
Global $hGraphics = _GDIPlus_GraphicsCreateFromHWND($hGUI)
Global $tPixelData = DllStructCreate("uint scan0[" & $I_GUI_WIDTH * $I_GUI_HEIGHT  & "];")
Global $hBitmap = _GDIPlus_BitmapCreateFromScan0($I_GUI_WIDTH, $I_GUI_HEIGHT, $GDIP_PXF32ARGB, $I_GUI_WIDTH * 4, $tPixelData)

Global $iUB1 = UBound($aCells) - 1, $iUB2 = UBound($aCells, 2) - 1, $t1, $tmrRow = TimerInit()

For $iRow = 1 To $iUB1
    $t1 = $iRow - 1
    $iRO = $t1
    $iRowOffset = $iRO * $I_GUI_WIDTH
    For $iColumn = 0 To $iUB2
        $aCells[$iRow][$iColumn] = $oRule.Item((($iColumn = 0) ? 0 : $aCells[$t1][$iColumn - 1]) & _
                                                                     ($aCells[$t1][$iColumn]) & _
                                                                    (($iColumn = $iUB2) ? 0 : $aCells[$t1][$iColumn + 1]))
        $tPixelData.Scan0(($iRowOffset + $iColumn)) = $aCells[$iRow][$iColumn] ? 0xFF000000 : 0xFFFFFFFF
    Next
    DllCall($__g_hGDIPDll,  "int", "GdipDrawImageRectRect", "handle", $hGraphics, "handle", $hBitmap, _
                                        "float", 0, "float", $iRO, "float", $I_GUI_WIDTH, "float", 1, _
                                        "float", 0, "float", $iRO, "float", $I_GUI_WIDTH, "float", 1, _
                                        "int", 2, "handle", 0, "ptr", 0, "ptr", 0)
Next

ConsoleWrite(TimerDiff($tmrRow) & @CRLF)

While Sleep(10)
WEnd

Func ExitApp()
    _GDIPlus_GraphicsDispose($hGraphics)
    _GDIPlus_BitmapDispose($hBitmap)
    _GDIPlus_Shutdown()
    Exit
EndFunc

Alles anzeigen

Beiträge von UEZ

Prozedurale Grafik mit der Windows API

Prozedurale Grafik mit der Windows API

Kann mein eigenes Programm nicht löschen - von Avira keine Unterstützung...

QRCode.au3 & QRCodeUI.au3 & QRCreatorCI.au3 mit aktueller quricol.dll (32 & 64 bit) integriert

[Nim] Kompilieren dauert lange

MsgBox verlangsamt den Skriptablauf unter Win 10

MsgBox verlangsamt den Skriptablauf unter Win 10

FB Code Optimierung

FB Code Optimierung

FB Code Optimierung

FB Code Optimierung

FB Code Optimierung

FB Code Optimierung

MsgBox verlangsamt den Skriptablauf unter Win 10

Variablen

WinMove zerstört Label

Allgemeiner Meinungsaustausch zum Thema "Corona"

Mehr Daten, als Partition groß ist! wtf...

Rule 110 - zellulärer Automat

Rule 110 - zellulärer Automat