 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
stef
Anmeldungsdatum: 13.01.2005
Beiträge: 102
|
 Verfasst am: 24.06.2008, 22:55 Titel: 3D-Würfel |
 |
|
Hallo Leute,
ich habe vor kurzem eine 3D-Brille in die Hand bekommen und dabei ist mir die Idee für ein QB Programm gekommen. Alles was man also braucht ist eine Brille, die links nur rotes Licht und rechts nur Cyan-Farbenes Licht durch lässt und schon sieht man das Bild dreidimensional. Zugegeben ist nicht viel mehr zu sehen als ein Würfel. Aber der Effekt ist dafür um so cooler. Die Farben kann man natürlich über die Konstanten am Programm Anfang ändern. Es gibt ja noch andersfarbige Brillen.
| Code: | ' Steuerung:
' Pfeiltasten - rechts, links, hoch, runter
' Bild up/down - vor und zurück
' ESC - Beenden
'-----------------------------------------------------------------------------
' Paint Funktionen
'-----------------------------------------------------------------------------
CONST ROT = 4
CONST CYAN = 3
CONST WEISS = 7
TYPE Raum3d
x AS INTEGER
y AS INTEGER
z AS INTEGER
END TYPE
TYPE Raum2d
x AS INTEGER
y AS INTEGER
END TYPE
DECLARE SUB Paint3dBlock (Ecke1 AS Raum3d, Ecke2 AS Raum3d)
DECLARE SUB PaintBlock (A AS Raum3d, B AS Raum3d, Farbe AS INTEGER, MitteX AS INTEGER)
DECLARE SUB Punkt3d (A AS Raum3d, Posi AS Raum2d, MitteX AS INTEGER)
DECLARE SUB PaintLinie (X1 AS INTEGER, Y1 AS INTEGER, X2 AS INTEGER, Y2 AS INTEGER, Farbe%, Methode%)
DECLARE SUB PaintPunkt (x AS INTEGER, y AS INTEGER, Farbe AS INTEGER)
' Parameter für die PaintLinie Funktion
CONST LINIE = 0
CONST RECHTECK = 1
CONST KASTEN = 2
'=============================================================================
' Hauptprogramm
'=============================================================================
DIM A AS Raum3d
DIM B AS Raum3d
DIM x AS INTEGER
DIM y AS INTEGER
DIM z AS INTEGER
DIM Zeit AS SINGLE
DIM Seite AS INTEGER
DIM Eingabe AS STRING
SCREEN 9, , Seite, 1 - Seite
x = 250
y = 130
z = 0
DO
'-----------------
' Würfel zeichnen
'-----------------
LINE (0, 0)-(639, 349), 0, BF
A.x = x: A.y = y: A.z = z
B.x = x + 150: B.y = y + 100: B.z = z + 75
CALL Paint3dBlock(A, B)
LOCATE 23, 1
COLOR 7
PRINT "x = "; x
PRINT "y = "; y
PRINT "z = "; z
Seite = 1 - Seite
SCREEN 9, , Seite, 1 - Seite
'--------------------
' Warten auf Eingabe
'--------------------
DO
Eingabe = INKEY$
LOOP UNTIL LEN(Eingabe)
SELECT CASE Eingabe
'--- Hoch ---
CASE CHR$(0) + "H"
y = y - 5
'--- Runter ---
CASE CHR$(0) + "P"
y = y + 5
'--- Rechts ---
CASE CHR$(0) + "M"
x = x + 5
'--- Links ---
CASE CHR$(0) + "K"
x = x - 5
'--- Näher holen ---
CASE CHR$(0) + "I"
z = z + 5
'--- Weiter weg ---
CASE CHR$(0) + "Q"
z = z - 5
END SELECT
LOOP UNTIL Eingabe = CHR$(27)
SYSTEM
'=============================================================================
' Zeichnet einen rechteckigen Würfel mit dreidimensionalen Koordinaten zweimal
' so auf den Bildschirm, das dieser mit einer 3d-Brille räunlich gesehen
' werden kann.
'
' Parameter:
' Ecke1 - Erster Eckpunkt des Würfels
' Ecke2 - Gegenüberliegender Eckpunkt des Würfels
'=============================================================================
SUB Paint3dBlock (Ecke1 AS Raum3d, Ecke2 AS Raum3d)
CALL PaintBlock(Ecke1, Ecke2, ROT, 280)
CALL PaintBlock(Ecke1, Ecke2, CYAN, 360)
END SUB
'=============================================================================
' Zeichnet einen rechteckigen Würfel mit dreidimensionalen Koordinaten auf
' den Bildschirm unter zu Hilfename der Sub Punkt. Sie benötigt dazu zwei
' gegenüberliegende Punkte des Würfels als Übergabeparameter.
' (Die globale Variable 'Farbe' bestimmt die Farbe)
'
' Parameter:
' A - Erste Ecke des Würfels
' B - Gegenüberliegende Ecke des Würfels
' Farbe - Würfelfarbe
' MitteX - IN - X-Kooridnate des Fluchtpunktes
'=============================================================================
SUB PaintBlock (A AS Raum3d, B AS Raum3d, Farbe AS INTEGER, MitteX AS INTEGER)
DIM tBlock(1 TO 4, 1) AS Raum2d
DIM sBlock AS Raum3d
CALL Punkt3d(A, tBlock(1, 0), MitteX)
CALL Punkt3d(B, tBlock(3, 1), MitteX)
sBlock.z = A.z: sBlock.x = B.x: sBlock.y = B.y
CALL Punkt3d(sBlock, tBlock(3, 0), MitteX)
sBlock.z = B.z: sBlock.x = A.x: sBlock.y = A.y
CALL Punkt3d(sBlock, tBlock(1, 1), MitteX)
FOR i% = 0 TO 1
tBlock(2, i%).x = tBlock(3, i%).x
tBlock(2, i%).y = tBlock(1, i%).y
tBlock(4, i%).x = tBlock(1, i%).x
tBlock(4, i%).y = tBlock(3, i%).y
NEXT i%
FOR i% = 1 TO 4
CALL PaintLinie(tBlock(i%, 0).x, tBlock(i%, 0).y, tBlock(i%, 1).x, tBlock(i%, 1).y, Farbe, LINIE)
NEXT i%
CALL PaintLinie(tBlock(1, 0).x, tBlock(1, 0).y, tBlock(3, 0).x, tBlock(4, 0).y, Farbe, RECHTECK)
CALL PaintLinie(tBlock(1, 1).x, tBlock(1, 1).y, tBlock(3, 1).x, tBlock(4, 1).y, Farbe, RECHTECK)
END SUB
'=============================================================================
' Graphik-Anweisung, die eine Gerade oder ein Rechteck auf dem Bildschirm
' zeichnet.
'
' Parameter:
' X1, Y1 -> Startkoordinaten der Linie / des Rechteckes
' X2, Y2 -> Zielkoordinaten der Linie / des Rechteckes
' Farbe -> Farbe der Linie / des Rechteckes
' Methode = LINIE -> Linie zeichnen
' = RECHTECK -> Rechteck zeichnen
' = KASTEN -> ausgefülltes Rechteck zeichnen
'=============================================================================
SUB PaintLinie (X1 AS INTEGER, Y1 AS INTEGER, X2 AS INTEGER, Y2 AS INTEGER, Farbe%, Methode%)
DIM mX AS INTEGER ' 1 -> X2 >= X1 -1 -> X1 > X2
DIM mY AS INTEGER ' 1 -> Y2 >= Y1 -1 -> Y1 > Y2
'DIM pX2 AS INTEGER
'DIM pY2 AS INTEGER
IF X2 >= X1 THEN
mX = 1
ELSE
mX = -1
END IF
IF Y2 >= Y1 THEN
mY = 1
ELSE
mY = -1
END IF
SELECT CASE Methode%
'----- Linie zeichnen --------------------------------------------------------
CASE LINIE
DIM E AS INTEGER
DIM dx AS INTEGER ' Differenz zwischen X1 und X2
DIM dy AS INTEGER ' Differenz zwischen Y1 und Y2
DIM pX AS INTEGER ' speichern die aktuelle Position ab
DIM pY AS INTEGER
Steep = 0
E = 0
dx = ABS(X2 - X1) ' Differenz berechnen
dy = ABS(Y2 - Y1)
pX = X1 ' Variablen auf Anfangswert setzen
pY = Y1
E = 2 * dy - dx
IF (dy > dx) THEN '----- dY > dX -----
FOR i% = 0 TO dy - 1
CALL PaintPunkt(pX, pY, Farbe%)
DO WHILE E >= 0
pX = pX + mX
E = E - dy * 2
LOOP
pY = pY + mY
E = E + dx * 2
NEXT i%
ELSE '----- dX >= dY -----
FOR i% = 0 TO dx - 1
CALL PaintPunkt(pX, pY, Farbe%)
DO WHILE E >= 0
pY = pY + mY
E = E - dx * 2
LOOP
pX = pX + mX
E = E + dy * 2
NEXT i%
END IF
CALL PaintPunkt(INT(pX2), INT(pY2), Farbe%)
'----- Rechteck zeichnen -----------------------------------------------------
CASE RECHTECK
FOR i% = X1 TO X2 STEP mX
CALL PaintPunkt(i%, Y1, Farbe%)
CALL PaintPunkt(i%, Y2, Farbe%)
NEXT i%
FOR i% = Y1 + 1 TO Y2 - 1 STEP mY
CALL PaintPunkt(X1, i%, Farbe%)
CALL PaintPunkt(X2, i%, Farbe%)
NEXT i%
'----- ausgefülltes Viereck zeichnen -----------------------------------------
CASE KASTEN
FOR i% = X1 TO X2 STEP mX
FOR j% = Y1 TO Y2 STEP mY
CALL PaintPunkt(i%, j%, Farbe%)
NEXT j%, i%
END SELECT
END SUB
'=============================================================================
' Graphik-Anweisung, die einen Punkt auf dem Bildschirm zeichnet.
' Speziel für dieses Programm wird der Punkt nur dann in der gewünschten
' Farbe gezeichnet, wenn der Bildschirmpunkt vorher noch leer war.
' Hatte der Bildschirm bereits eine andere Farbe an dieser Stelle wird der
' Punkt weiß gezeichnet.
'
' Parameter:
' X -> x-Koordinate des Punktes
' Y -> y-Koordinate des Punktes
' Farbe -> Farbe des Punktes
'=============================================================================
SUB PaintPunkt (x AS INTEGER, y AS INTEGER, Farbe AS INTEGER)
DIM Alt AS INTEGER
Alt = POINT(x, y)
IF Alt = 0 THEN
PSET (x, y), Farbe
ELSEIF Alt <> Farbe THEN
PSET (x, y), WEISS
END IF
END SUB
'=============================================================================
' Rechnet die dreidimensionale Koordinate 'Raum' in eine Zweidimensionale
' 'Posi' um, für die Ausgabe am Bildschirm
'
' Parameter:
' Posi3d - IN - Koordinaten des Punktes im Dreidimensionalen Raum
' Pori2d - OUT - Berechnete Bildschirmkoordinaten des Punktes
' MitteX - IN - X-Koordinate des Fluchtpunktes
'=============================================================================
SUB Punkt3d (Posi3d AS Raum3d, Posi2d AS Raum2d, MitteX AS INTEGER)
'Mitte-> X: 320 Y:175
DIM div AS DOUBLE
div = 1.002 ^ Posi3d.z
Posi2d.x = (Posi3d.x - MitteX) / div + MitteX
Posi2d.y = (Posi3d.y - 175) / div + 175
END SUB |
|
|
| Nach oben |
|
 |
max06
Anmeldungsdatum: 05.12.2004
Beiträge: 390
Wohnort: Augsburg
|
| Verfasst am: 24.06.2008, 23:22 Titel: |
|
|
Ich habe mir erlaubt, deinen Code auf die Schnelle etwas zu überarbeiten. Deine Version war bei mir leider so nicht lauffähig.
Ich habe nur die Definitionen einzelner Variablen hinzugefügt, sowie die "CALL" entfernt.
http://www.freebasic-portal.de/index.php?s=fbporticula&mode=show&id=602 wurde mit FB0.18.3 korrekt compiliert und ist normal lauffähig.
Falls du doch etwas dagegen hast, werde ich den Code wieder löschen 
Den optischen Effekt kann ich leider nicht beurteilen, da ich keine rot-grün-Brille da habe 
Müsste man diesen Effekt nicht durch das übereinander Legen zweier identischer Bilder aus unterschiedlichen Perspektiven nachbauen können? Mit QBasic dürfte die Geschwindigkeit etwas zu schaffen machen, aber mit Freebasic dürfte das kein Problem darstellen.
Grüße,
max06 |
|
| Nach oben |
|
|
Devilkevin
aka Kerstin
Anmeldungsdatum: 11.11.2004
Beiträge: 2532
Wohnort: nähe Mannheim
|
| Verfasst am: 25.06.2008, 01:11 Titel: |
|
|
Das ist ne klasse Idee, habe aber leider auch keine Brille zum testen da .. naja gibts bestimmt iwann mal wieder in einer TV Zeitschrift.
_________________
www.piratenpartei.de |
|
| Nach oben |
|
|
Elektronix
Anmeldungsdatum: 29.06.2006
Beiträge: 742
|
| Verfasst am: 25.06.2008, 09:32 Titel: |
|
|
Nette Spielerei. Allerdings: Der Würfel ist nur innerhalb eines bestimmten Bereiches klar zu sehen, außerhalb hinterläßt er bei Bewegungen eine Rasterung- die Linien werden nicht gelöscht.
_________________
Und die Grundgebihr is aa scho drin- DOS is jo nett. |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 25.06.2008, 11:46 Titel: |
|
|
das liegt allerdings am Code von max06...
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
| Nach oben |
|
|
max06
Anmeldungsdatum: 05.12.2004
Beiträge: 390
Wohnort: Augsburg
|
| Verfasst am: 25.06.2008, 17:47 Titel: |
|
|
Ich habe den nur FB-Tauglich gemacht  |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 25.06.2008, 23:55 Titel: |
|
|
und eine zu hohe auflösung (800x600 statt 640x480) gewählt 
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
max06
Anmeldungsdatum: 05.12.2004
Beiträge: 390
Wohnort: Augsburg
|
| Verfasst am: 26.06.2008, 17:54 Titel: |
|
|
Wusste auf die Schnelle nicht, was screen 9 für ne Auflösung hat 
Außerdem ist das doch eher 320*240? So sah das nämlich bei mir aus ... auf nem 17,1"-Widescreen... |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 27.06.2008, 01:01 Titel: |
|
|
screen 9 ist 640x350...
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
stef
Anmeldungsdatum: 13.01.2005
Beiträge: 102
|
| Verfasst am: 29.06.2008, 18:01 Titel: |
|
|
Nun eigentlich hatte ich das Programm für QB gemacht und nicht für FB. Daher kann es in FB zu Probleme kommen, zum Beispiel beim Löschen des alten Bildes. Ich meine mal fest gestellt zu haben, dass der CLS Befehl in QB eine Ewigkeit dauert und es schneller ist den Bildschirm mit einem schwarzen Kasten zu überzeichnen. Wenn aber in FB eine andere Bildschirmauflösung herrscht, dann wird das natürlich dazu führen, dass außen nichts mehr gelöscht wird.
Die schlechte Bildschirmauflösung von QB ist bei solchen Programmen meistens von Vorteil, da dadurch die Linien dicker werden und man den Würfel dadurch besser sieht. Leider ist das Programm recht langsam, da ich jeden Pixel einzeln zeichnen muss. Das braucht natürlich seine Zeit.
Das es nicht sehr viele gibt, die die nötigen Brillen haben war mir natürlich klar. Andererseits frage ich mich, warum eigentlich noch nie jemand auf die Idee gekommen ist Spiele für solche Brillen zu entwickeln. Die Brillen kosten so gut wie nichts und den Effekt zu Programmieren ist wirklich sehr einfach. |
|
| Nach oben |
|
|
28398
Anmeldungsdatum: 25.04.2008
Beiträge: 1917
|
| Verfasst am: 29.06.2008, 18:12 Titel: |
|
|
| Nunja, jeder etwas modernere (nVidia) Grafikkartentreiber bietet sogar diese Option für DirectX und OpenGL an... deswegen braucht man heute das nicht mehr alles von Hand entwickeln |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 30.06.2008, 00:04 Titel: |
|
|
| Zitat: | | . Andererseits frage ich mich, warum eigentlich noch nie jemand auf die Idee gekommen ist Spiele für solche Brillen zu entwickeln. |
Ganz einfach... Es gab schon früh in den USA solche 3D-Kinos, die sich aber sehr schnell als Flopp erwiesen haben...
In Duke Nukem 3D allerdings kann man mit einer Einstellung in der config-datei den rotblau-modus anschalten, höhö!
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
|
|
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.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
