Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Gfx Spielereien
Gehe zu Seite Zurück  1, 2, 3, 4, 5, 6
 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1051
Wohnort: Ruhrpott

BeitragVerfasst am: 21.12.2020, 17:20    Titel: Antworten mit Zitat

Tolles Programm, ganz großes Kino! Daumen rauf! Daumen rauf! Daumen rauf!

Trotzdem zwei Verbesserungsvorschläge:

1) GFX_ALWAYS_ON_TOP solltest du entfernen. Ein Fenster, das sich so penetrant in den Vordergrund drängt, ist doch ziemlich störend.

2) Eine Lautstärkeregelung wäre nett.

Und eine Frage:

Lassen sich auch andere Musikformate abspielen (.wav oder .mp3)?

Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 125
Wohnort: Opel Stadt

BeitragVerfasst am: 21.12.2020, 18:18    Titel: Antworten mit Zitat

grindstone hat Folgendes geschrieben:
Tolles Programm, ganz großes Kino! Daumen rauf! Daumen rauf! Daumen rauf!

Trotzdem zwei Verbesserungsvorschläge:

1) GFX_ALWAYS_ON_TOP solltest du entfernen. Ein Fenster, das sich so penetrant in den Vordergrund drängt, ist doch ziemlich störend.

2) Eine Lautstärkeregelung wäre nett.

Und eine Frage:

Lassen sich auch andere Musikformate abspielen (.wav oder .mp3)?

Gruß
grindstone


Viele Dank für dein Feedback.

Zu 1) GFX_ALWAYS_ON_TOP habe ich mir angewöhnt, weil, je nach x64 Compiler, nach dem Starten das Fenster in den Hintergrund verschoben und ich immer wieder in den Vordergrund holen muss. Das nervt, ist jetzt aber deaktiviert.

Zu 2) ist jetzt eingebaut. Die Lauststärke habe ich auf 33% gestellt.

Mit FMOD kannst du .MOD, .S3M, .XM, .IT, .MID, .WAV, .MP2, .MP3, .OGG oder .RAW Dateien abspielen. Ich habe die FMOD Hilfe Datei mit ins Zip Archiv gepackt.
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4372
Wohnort: ~/

BeitragVerfasst am: 21.12.2020, 18:40    Titel: Antworten mit Zitat

Ich würde auch den Wert von PI einmal als Konstante speichern statt an mehreren Stellen des Programms.
Das Programm gefällt mir - zeigt mal wieder, wie man mit wenigen Zeilen einiges auf die Beine stellen kann. lächeln
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 125
Wohnort: Opel Stadt

BeitragVerfasst am: 21.12.2020, 18:57    Titel: Antworten mit Zitat

nemored hat Folgendes geschrieben:
Ich würde auch den Wert von PI einmal als Konstante speichern statt an mehreren Stellen des Programms.
Das Programm gefällt mir - zeigt mal wieder, wie man mit wenigen Zeilen einiges auf die Beine stellen kann. lächeln


Freut mich, dass es dir gefällt. happy

Ich denke, du meinst die trigonometrischen Funktionen, wo der PI Wert direkt als Zahl eingetragen ist und nicht als Konstanze, die in Zeile 62 definiert ist. Copy / Paste Resultat.
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4372
Wohnort: ~/

BeitragVerfasst am: 21.12.2020, 19:34    Titel: Antworten mit Zitat

Genau die meine ich - Zeile 92, 93 usw. Dass PI ja auch als Konstante vorkommt, ist mir gar nicht aufgefallen. grinsen
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
volta



Anmeldungsdatum: 04.05.2005
Beiträge: 1870
Wohnort: D59192

BeitragVerfasst am: 22.12.2020, 11:50    Titel: Antworten mit Zitat

Hi,
ob als Konstante oder als Zahl, in älteren FB-Versionen setzte der Compiler
immer nur einmal einen Zeiger auf den Wert im Datenbereich. Vermutlich
auch noch in den neueren Versionen.
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4372
Wohnort: ~/

BeitragVerfasst am: 22.12.2020, 15:51    Titel: Antworten mit Zitat

Mir geht es da mehr um die Gefahr eines Tippfehlers. Speicher- und geschwindigkeitstechnisch ist es sicher egal. Wenn der Wert da natürlich wegen C&P steht, ist das Tippfehler-Argument natürlich auch hinfällig. happy
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 125
Wohnort: Opel Stadt

BeitragVerfasst am: 20.01.2021, 17:55    Titel: Ray Tracer Antworten mit Zitat

Ich war mal so frei und habe den coolen JavaScript Code von hier "pure js ray tracer" nach FB portiert.

Hier das Resultat:
Code:

'Ported from https://js1k.com/2017-magic/demo/2648 by Igor Sbitnev To FB by UEZ build 2021-01-19

#Include "crt/math.bi"
#Include "fbgfx.bi"
Using FB
Randomize

Type Vector3D
   As Single x, y, z
End Type

Type tSpheresData
   As Vector3D position, color
   As Single radius
End Type

Type tIntersect
   As Integer intersection
   As Vector3D rayEnd, lightDirection, normal, sphereColor
End Type

Function Vector(x As Single, y As Single, z As Single) As Vector3D
   Return Type(x, y, z)
End Function

Const INTERSECTION_NONE = 0, INTERSECTION_SPHERE = 1, INTERSECTION_FLOOR = 2
Dim Shared As Vector3D CENTER_TILE_COLOR, OTHERS_TILE_COLOR, COLOR_SKY, COLOR_LIGHT_SOURCE, COLOR_STARS
CENTER_TILE_COLOR    = Vector(8, 0, 8)
OTHERS_TILE_COLOR    = Vector(8, 5, 8)
COLOR_SKY            = Vector(5, 6, 8)
COLOR_LIGHT_SOURCE    = Vector(8, 8, 8)
COLOR_STARS       = Vector(8, 8, 8)

Dim Shared As tSpheresData spheresData(5)
spheresData(0).position   = Vector(10, 2, 2)
spheresData(0).color    = Vector(4, 0, 4)
spheresData(0).radius    = 1.5
spheresData(1).position = Vector(-3, 0, 2)
spheresData(1).color    = Vector(8, 5, 7)
spheresData(1).radius    = 1.5
spheresData(2).position = Vector(3, 0, 2)
spheresData(2).color    = Vector(0, 0, 4)
spheresData(2).radius    = 1.5
spheresData(3).position = Vector(1.5, 0, 4.5)
spheresData(3).color    = Vector(8, 8, 6)
spheresData(3).radius    = 1.5
spheresData(4).position = Vector(-1, 10, 4)
spheresData(4).color    = Vector(0, 4, 4)
spheresData(4).radius    = 4.0
spheresData(5).position = Vector(0, 0, 7)
spheresData(5).color    = Vector(8, 5, 4)
spheresData(5).radius    = 1.5

Function Sum(first As Vector3D, second As Vector3D) As Vector3D
   Return Type(first.x + second.x, first.y + second.y, first.z + second.z)
End Function

Function Scale(v As Vector3D, factor As Single) As Vector3D
   Return Type(v.x * factor, v.y * factor, v.z * factor)
End Function

Function dotProduct(first As Vector3D, second As Vector3D) As Single
   Return first.x * second.x + first.y * second.y + first.z * second.z
End Function

Function crossProduct(first As Vector3D, second As Vector3D) As Vector3D
   Return Type(first.y * second.z - first.z * second.y, first.z * second.x - first.x * second.z, first.x * second.y - first.y * second.x)
End Function

Function normalize(v As Vector3D) As Vector3D
   Return scale(v, 1 / Sqr(dotProduct(v, v)))
End Function

Function subtract(first As Vector3D, second As Vector3D) As Vector3D
   Return sum(first, scale(second, -1))
End Function

Function trace(rayStart As Vector3D, rayDirection As Vector3D) As tIntersect
   Dim As Vector3D rayEnd, lightDirection, normal, sphereColor, distanceToSphereCenter, lightPosition = Vector(Rnd() * 27, -81 + Rnd() * 27, 81)
   Dim As Integer i, intersection = INTERSECTION_NONE
   Dim As Single distanceToFloor = -rayStart.z / rayDirection.z, a = 1, b, c, d, distanceToSphere
   Dim As Ulongint distanceToNearestSphere = -1
   If distanceToFloor > 0 And rayStart.z > 0 Then
      intersection = INTERSECTION_FLOOR
      rayEnd = sum(rayStart, scale(rayDirection, distanceToFloor))
      lightDirection = normalize(subtract(lightPosition, rayEnd))
      normal = Vector(0, 0, 1)
   End If
   For i = 0 To Ubound(spheresData)
      distanceToSphereCenter = subtract(rayStart, spheresData(i).position)
      'a = 1 'dotProduct(rayDirection, rayDirection)
      b = 2 * dotProduct(rayDirection, distanceToSphereCenter)
      c = dotProduct(distanceToSphereCenter, distanceToSphereCenter) - spheresData(i).radius * spheresData(i).radius
      d = b * b - 4 * a * c
      distanceToSphere = (-b - Sqr(d)) / 2 * a
      If (distanceToSphere < distanceToNearestSphere) And (distanceToSphere > 0) Then
         distanceToNearestSphere = distanceToSphere
         intersection = INTERSECTION_SPHERE
         sphereColor = spheresData(i).color
         rayEnd = sum(rayStart, scale(rayDirection, distanceToSphere))
         lightDirection = normalize(subtract(lightPosition, rayEnd))
         normal = normalize(subtract(rayEnd, spheresData(i).position))
      End If
   Next
   Return Type(intersection, rayEnd, lightDirection, normal, sphereColor)
End Function

Function getFloorColor(x As Integer, y As Integer) As Vector3D
   If x + y <> 0 Then
      If fmod(x, 3) = 1 And fmod(y, 3) = 1 Then Return CENTER_TILE_COLOR
      Return getFloorColor((x \ 3), (y \ 3))
   End If
   Return OTHERS_TILE_COLOR
End Function

Function sample(rayStart As Vector3D, rayDirection As Vector3D, renderStars As Boolean = False) As Vector3D
   Dim As tIntersect ti = trace(rayStart, rayDirection)
   Dim As Vector3D reflectionRayDirection, color_, diffuse, specular, reflection, floorColor, uVector, vVector, randomizedDirection
   Select Case ti.intersection
      Case INTERSECTION_NONE
         Return Iif(renderStars And Rnd() > 0.9, COLOR_STARS, scale(COLOR_SKY, Pow(1 - rayDirection.z, 4)))
      Case INTERSECTION_SPHERE
         diffuse = scale(ti.sphereColor, 0.7 * dotProduct(ti.normal, ti.lightDirection))
         specular = scale(COLOR_LIGHT_SOURCE, Pow(dotProduct(ti.normal, normalize(subtract(ti.lightDirection, rayDirection))), 64))
         reflectionRayDirection = sum(rayDirection, scale(ti.normal, -2 * dotProduct(ti.normal, rayDirection)))
         reflection = scale(sample(ti.rayEnd, reflectionRayDirection), 0.4)
         color_ = sum(diffuse, sum(specular, reflection))
      Case INTERSECTION_FLOOR
         reflectionRayDirection = sum(rayDirection, scale(ti.normal, -2 * dotProduct(ti.normal, rayDirection)))
         floorColor = getFloorColor(CInt(fmod((ti.rayEnd.x + 81) * 27, 81)), CInt(fmod((ti.rayEnd.y + 81) * 27, 81)))
         uVector = crossProduct(rayDirection, reflectionRayDirection)
         vVector = crossProduct(uVector, reflectionRayDirection)
         randomizedDirection = sum(reflectionRayDirection, sum(scale(uVector, (Rnd() - 0.5) / 3), scale(vVector, (Rnd() - 0.5) / 3)))
         color_ = sum(floorColor, sample(ti.rayEnd, randomizedDirection))
         color_ = scale(color_, 0.5)
   End Select
   Dim As Integer isShadowed = trace(ti.rayEnd, ti.lightDirection).intersection
   Return scale(color_, Iif(isShadowed, 0.5, 1))
End Function

Randomize
Dim Shared As Integer iW, iW2, iH, iH2, i, j, pixel = 0, CANVAS_WIDTH, CANVAS_HEIGHT
iW = 512 : iH = 512
CANVAS_WIDTH = iW : CANVAS_HEIGHT = iH

#Define PutPixel(_x, _y, colour)   *Cptr(Ulong Ptr, pScrn + (_y) * pitch + (_x) Shl 2) = (colour)
#Define GetPixel(_x, _y)           *Cptr(Ulong Ptr, pScrn + (_y) * pitch + (_x) Shl 2)

Dim Shared As Any Ptr pScrn
Dim Shared As Integer pitch

#Define Min(a, b)   (Iif(a < b, a, b))
#Define Max(a, b)   (Iif(a > b, a, b))
#Define Map(Val, source_start, source_stop, dest_start, dest_stop)   ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)

Screenres iW, iH, 32, 2, GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0

pScrn = Screenptr()
Screeninfo ,,,, pitch

Const RAYS_PER_PIXEL = 32, DISTANCE_TO_VIEWPORT = 10, VIEWPORT_WIDTH = 12, VIEWPORT_HEIGHT = 12, ALPHA_CHANNEL_COLOR = 255
Dim As Vector3D UP_DIRECTION = Vector(0, 0, 1), camera = Vector(-7, -10, 8), target = Vector(0, 0, 4), normalToViewport = normalize(subtract(camera, target)), _
      uVector = normalize(crossProduct(UP_DIRECTION, normalToViewport)), vVector = crossProduct(uVector, normalToViewport), viewportCenter = sum(camera, scale(normalToViewport, -DISTANCE_TO_VIEWPORT)), _
      leftDown = sum(viewportCenter, sum(scale(uVector, -VIEWPORT_WIDTH / 2), scale(vVector, -VIEWPORT_HEIGHT / 2))), colorSum, rayStart, viewportPixel, direction, color_
Dim As Ulong line_ = 0, b = 0

Dim As Double t = Timer
Do
   If line_ < iH Then
      For i = iW - 1 To 0 Step -1
         colorSum = Vector(0, 0, 0)
         For j = 0 To RAYS_PER_PIXEL - 1
            rayStart = sum(camera, sum(scale(uVector, (Rnd() - 0.5) / 3), scale(vVector, (Rnd() - 0.5) / 3)))
            viewportPixel = sum(leftDown, sum(scale(uVector, i * VIEWPORT_WIDTH / CANVAS_WIDTH), scale(vVector, line_ * VIEWPORT_HEIGHT / CANVAS_HEIGHT)))
            direction = normalize(subtract(viewportPixel, rayStart))
            color_ = sample(rayStart, direction, True)
            colorSum = sum(colorSum, color_)
         Next     
         PutPixel(i, line_, Rgba(Max(0, Min(255, colorSum.x)), Max(0, Min(255, colorSum.y)), Max(0, Min(255, colorSum.z)), ALPHA_CHANNEL_COLOR))
      Next
      line_ += 1
   Else
      If b = 0 Then Windowtitle("Ray Tracer / Rendered in " & Timer - t & " seconds") : b = 1
   Endif
   Flip
   Sleep(1)
Loop Until Len(Inkey())


So sollte es aussehen:


Mehr Details zum Code kann hier eingesehen werden: https://js1k.com/2017-magic/details/2648

Viel Spaß. happy
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Sebastian
Administrator


Anmeldungsdatum: 10.09.2004
Beiträge: 5939
Wohnort: Deutschland

BeitragVerfasst am: 20.01.2021, 23:13    Titel: Antworten mit Zitat

Wow! durchgeknallt

Ich habe erfolglos den Aufruf einer magischen externen 3D-Bibliothek gesucht, der das mit dem bisschen Code möglich macht... lachen
_________________

Der Markt regelt das! | Opas Leistung muss sich wieder lohnen - für 6 bis 10 Generationen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1051
Wohnort: Ruhrpott

BeitragVerfasst am: 21.01.2021, 15:14    Titel: Antworten mit Zitat

Spitze! Daumen rauf!

Mein betagter Rechenknecht (Core 2 Quad 2,4GHz / WinXP 32) hat dafür zwar knapp 128 Sekunden gebraucht, aber das Ergebnis ist absolut überzeugend. Und das alles mit FB - Bordmitteln. Echt beeindruckend!

Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
volta



Anmeldungsdatum: 04.05.2005
Beiträge: 1870
Wohnort: D59192

BeitragVerfasst am: 23.01.2021, 11:07    Titel: Antworten mit Zitat

Klasse vor Freude klatschen

der Quellcode ist mir zwar en Rätsel aber tolles Program.
46 Sec. auf Celeron 2,16, Win10-64

Bleibt gesund!
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 125
Wohnort: Opel Stadt

BeitragVerfasst am: 23.01.2021, 15:07    Titel: Antworten mit Zitat

Danke für euer Feedback.

Den JavaScript Code zu verstehen und zu übersetzen ist das eine. Das andere ist der Code selbst, also wie Ray Tracing funktioniert. happy
Ganz offen und ehrlich, ist Ray Tracing mir auch ein Rätsel...

Aber der Code lässt sich als Benchmark gut verwenden.
Hier die Resulate mit verschiedenen Compile Parametern auf meinem Notebook (AMD Ryzen 5 PRO Mobile 3500U):

FreeBASIC Compiler - Version 1.07.2 (2020-12-25)
-s gui:
32-bit: 25,21 Sekunden
64-bit: 29,72 Sekunden

-s gui -gen gcc -Wc -O3:
32-bit: 16,36 Sekunden
64-bit: 14,49 Sekunden

gen gcc -Wc -Ofast -s gui
32-bit: 14,42 Sekunden
64-bit: 13,79 Sekunden

-gen gcc -Wc -Ofast -Wc -march=native -Wc -funroll-loops -Wc -mfpmath=sse -s gui
32-bit: 12,52 Sekunden
64-bit: 13,98 Sekunden

FreeBASIC Compiler - Version 1.08.0 (2020-05-19), built for win64 (64bit)
-gen gcc -Wc -Ofast -Wc -march=native -Wc -funroll-loops -Wc -mfpmath=sse -s gui
32-bit: 11,29 Sekunden
64-bit: 8,51 Sekunden

Zwischen der langsamsten und schnellsten Version (x64) liegt ein Faktor von 3,5!
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 125
Wohnort: Opel Stadt

BeitragVerfasst am: 02.03.2021, 20:45    Titel: Dwitter.net Portierungen Antworten mit Zitat

Ich war so frei und habe einige Beispiele von Dwitter.net nach FreeBasic portiert.

Zu vermerken wäre, dass der JS Code auf 140 Bytes limitiert ist. Die JS Grafik Befehle sind um einiges umfangreicher als in FB, somit lassen sich leider manche Beispiele nicht direkt übersetzen. traurig

Download der Beispiele (Source Code + Windows kompilierte Dateien): The beauty - magic of math Vol. I - V.7z (858 kB)

Zum Entpacken wird 7-Zip benötigt oder ein anderer Entpacker, welcher das 7-Zip Archiv unterstützt.

Viel Spaß beim Anschauen.
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen Alle Zeiten sind GMT + 1 Stunde
Gehe zu Seite Zurück  1, 2, 3, 4, 5, 6
Seite 6 von 6

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz