Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Tutorial

OpenGL und FreeBASIC - eine kleine Einführung - Teil 5 - Texturen

von MitgliedEastler_dartSeite 5 von 6

Eine Laderoutine für alle Dateiformate per FreeImage

Vorweg erst mal ein rießiges Dankeschön an csde_rats,
er hat mit seinem Tutorial die eigentliche Arbeit
geleistet.
Ursprünglich wollte ich auf andere Formate als Bmp
nicht eingehen, nur weil csde_rats die Arbeit mit
seinem Tutorial schon gemacht hatte, konnte ich hier
ohne größeren Aufwand die FreeImage-Lib einbinden.

Das Tutorial von csde_rats finden Sie unter:
tutorial:28

Bedingungen

Falls Sie unter Windows arbeiten, sollten Sie
zuerst sicherstellen, daß beim Installieren von
FreeBasic die Library FreeImage mit installiert wurde.
Im FreeBasic-Paket V. 0.20 ist FreeImage von Haus
aus angehakt, wird also mit installiert.
Prüfen Sie einfach, ob in Ihrem Verzeichnis:
...FreeBasic/lib/win32/
die Datei libFreeImage.dll.a vorhanden ist.

ACHTUNG! In der FreeBasic-Version 0.20b stimmt irgend eine Kleinigkeit im Zusammenspiel mit FreeImage (noch) nicht! Deshalb sollten Sie hier auf eine erprobte und funktionierende FreeImage-Version umstellen! UNTER WINDOWS GEHT DAS WIE FOLGT: Ein Forumsthema dazu finden Sie unter: Externer Link!http://forum.qbasic.at/viewtopic.php?t=5819 darin ist der Downloadlink für die FreeImage-Version 3.9.3 unter download:89 angegeben. Damit erhalten Sie ein Zip-Archiv mit dem Namen freeimg393.zip. Entpacken Sie dieses Archiv irgendwohin, kopieren Sie die Datei: libFreeImage393.a innerhalb der FreeBasic-Programmstruktur unter: ...FreeBasic/lib/win32/libFreeImage393.a und die Datei: FreeImage393.bi ebenfalls innerhalb der FreeBasic-Programmstruktur unter: ...FreeBasic/inc/FreeImage393.bi Damit bleibt die eigentliche Einrichtung der FreeImage-Lib unter FreeBasic 0.20b unberührt, zusätzlich steht nun aber auch die FreeImage-Lib in der Version 3.9.3 zur Verfügung. Es reicht, wenn Sie in Ihrem Programm beim Includen der Library einfach schreiben: #include "FreeImage393.bi" So mache ich das hier im Tutorial auch. Wenn es mit einer späteren FreeBasic-Version dann besser läuft, brauchen Sie nur die "393" aus dem Include-Befehl herausnehmen, dann arbeitet Ihr Programm mit der neueren Version, welche mit FreeBasic mitgeliefert wird. Denken Sie auch an die DLL-Datei, welche Sie Ihrem Programm dazugeben müssen, für die 3.9.3er-Version liegt diese im oben benannten Zip-Archiv mit drin. Bei neueren FreeBasic-Versionen müssen Sie diese von der FreeImage-Internetseite in eben dieser neueren Version herunterladen. UNTER LINUX testen Sie am besten, ob die in Ihrem System installierte FreeImage-Version läuft. Schätze mal, daß es dort keine Probleme geben wird. Falls doch, die Version 3.9.3 läuft ;-)

Wenn Sie Linux als Betriebssystem verwenden,
kann FreeBasic beim Installieren nichts mitbringen,
Sie müssen für Ihre Linux-Version selbst nach einer
FreeImage-Libraray suchen und installieren, falls
diese nicht serienmäßig in Ihrer Distribution
bereits enthalten ist.

Ebenfalls ist es unter Linux notwendig, daß der
Endanwender Ihres Programmes diese FreeImage-Lib
in seinem System installiert hat.

Diese Bedingungen sollten in Ihr neues OpenGL-Projekt
als Entscheidungsgrundlagen mit einfließen.
Falls Sie Ihr neues OpenGL-Projekt auch unter Linux
herausgeben wollen, und Sie mit wenigen Bildern
arbeiten können, ist es für den Linux-Endanwender
einfacher, etwas mehr an Festplattenplatz durch die
Bitmapbilder zu verbrauchen, als für sein Linuxsystem
eine FreeImage-Library zu suchen.
Falls Sie jedoch mit dem Alpha-Kanal, sprich Transparenz
beim Texturieren arbeiten, gehts ja nicht anders, dann
müssen Sie ja in anderen Dateiformaten als Bitmap
die Bilder beilegen, um den Alphakanal mit im Bild
abspeichern zu können.
Und damit sind Sie fast schon gezwungen, mit einer
Library die Dateien einzulesen.
Aber wie gesagt, unter Windows "no Problem", auf Ihrem
kompilierenden System die FreeImage-Lib drauf, dann
steht alles, was der Anwender braucht, in der Exe gleich
mit drin, unter Windows muß der Endanwender also nur
die FreeImage.DLL im selben Verzeichnis haben, in
dem Ihr Exe-Programm steht. Und diese DLL geben Sie
doch bestimmt gleich mit dazu.
Jedoch, beachten Sie die Nutzungsbedingungen der
FreeImage-Lib. Als Open-Source muß der Disclaimer
als Textdatei mit beigelegt werden und in Ihrem
Programm z.B. unter "Hilfe" ein Hinweis, daß eben
die Open-Source FreeImage-Lib in der Version 3.9.9
im Programm enthalten ist.

Die Function dafür erstellen

Als erstes müssen wir die Library FreeImage in unser
Program einbinden, das geschieht ganz einfach mit:
#include "FreeImage393.bi"
(Beachten Sie den Hinweis am Anfang dieser Seite,
mit der FreeImage-Version 3.9.3 zu arbeiten)

Und schon können wir uns darum kümmern, die Function
zu erstellen. Als Namen schlage ich einen deutlichen,
aussagekräftigen vor: BildToOgl:
DECLARE FUNCTION BildToOgl(BildDateiName AS STRING) AS INTEGER
Wie gesagt, wir übergeben den Dateinamen, deshalb
kriegt die Function als Parameter eine Stringvariable,
in der eben dieser Dateiname rüber gegeben wird,
zurück kommt ein Name des Bildes bei OpenGL, welcher
eine IntegerWert darstellt, entsprechend geben wir
der Function und damit auch dem Rückgabewert den
Typ Integer.

Nun die Function selbst:
FUNCTION BildToOgl(BildDateiName AS STRING) AS INTEGER
'...hier alles weitere
END FUNCTION


und innerhalb der Sub dann, die Programmfolge, daß die
Sub die gewählte Datei von der Festplatte in den
Arbeitesspeicher holt.

Um FreeImage vor dem Fall zu bewahren, daß die Bilddatei
gar nicht existiert, prüfen wir dies mit FreeBasic,
indem wir die Datei zum Lesen öffnen und die danach
vorhandene Dateilänge per LOF() abfragen.
Ist diese Länge größer 0, dann gibts eine solche Datei,
ist die Länge gleich Null, dann existiert sie nicht:

FUNCTION BildToOgl(BildDateiName AS STRING) AS INTEGER
   '"Lade Bilddatei von Festplatte in FreeImageRam"
   DIM AS UINTEGER TexturNummer, Breite, Hoehe, ZeilenZaehler, PunktZaehler, BlauWert, RotWert, DateiNummer
   DIM AS FIBITMAP Ptr BildZeiger
   DIM AS ZSTRING PTR DateiNamenZeiger
   DIM AS FREE_IMAGE_FORMAT Ergebnis
   DIM DateiName AS ZSTRING * 512
   DateiName=LEFT(BildDateiName, 512)
   'mit FreeBasic checken, ob die Datei überhaupt existiert
   DateiNummer = FREEFILE
   OPEN DateiName FOR INPUT AS #DateiNummer
      IF LOF(DateiNummer) = 0 THEN
         SCHREIBE("DateiName Läenge=" & LEN(DateiName) & "=" & LEFT(DateiName, 20) & " Dateigroeße=" & LOF(DateiNummer) )
         END
      END IF
   CLOSE #DateiNummer

Da in der FreeImage-Lib beim Laden der Bildtyp anzugeben
ist, nutzen wir die ebenfalls in dieser Lib enthaltenen
Functionen, um eine Datei auf deren Bildtyp zu untersuchen
(sich auf die Endung des Dateinamens zu verlassen, ist
gefährlich, mir sind schon ettliche Bilddateien unter
gekommen, die Bmp heißen, und Jpg enthalten!)
FreeImage_GetFileType(filename AS STRING PTR, FI_DEFAULT(0) AS INTEGER)
Diese Funktion liefert einen Zahlenwert zurück, der für
den Bildtyp wie folgt steht:

'Auszug aus FreeImage.bi:
enum FREE_IMAGE_FORMAT
   FIF_UNKNOWN = -1
   FIF_BMP = 0
   FIF_ICO = 1
   FIF_JPEG = 2
   FIF_JNG = 3
   FIF_KOALA = 4
   FIF_LBM = 5
   FIF_IFF = FIF_LBM
   FIF_MNG = 6
   FIF_PBM = 7
   FIF_PBMRAW = 8
   FIF_PCD = 9
   FIF_PCX = 10
   FIF_PGM = 11
   FIF_PGMRAW = 12
   FIF_PNG = 13
   FIF_PPM = 14
   FIF_PPMRAW = 15
   FIF_RAS = 16
   FIF_TARGA = 17
   FIF_TIFF = 18
   FIF_WBMP = 19
   FIF_PSD = 20
   FIF_CUT = 21
   FIF_XBM = 22
   FIF_XPM = 23
   FIF_DDS = 24
   FIF_GIF = 25
   FIF_HDR = 26
   FIF_FAXG3 = 27
   FIF_SGI = 28
   FIF_EXR = 29
   FIF_J2K = 30
   FIF_JP2 = 31
end enum

Jedoch gibt es ein paar Bilddateien, welche mit dieser Funktion
nicht ermittelt werden können - FreeImage_GetFileTyp ließt bis
zu 16 Bytes aus der Datei um den Typ zu ermitteln. Die Ausnahmen
sind jene Dateitypen, die keinen Vorspann haben, oder die einen
solchen Infoblock am Ende der Datei enthalten, das sind:
z.B. CUT, MNG, PCD, TARGA und WBMP

Also checken wir die Rückantwort von FreeImage_GetFileTyp,
ob ein Wert gößer/gleich Null drin steht = ob die Datei erkannt wurde.
Falls -1 drin steht (unbekannter Typ), lassen wir eine ausführlichere
und langsamere Funktion auf die Datei los:
FreeImage_GetFIFFromFilename(Dateiname AS STRING PTR)
Diese Function geht einen anderen Weg in der Analyse und
liefert zurück, was immer auch gefunden wird.
Also nicht nur Dateitypen, die FreeImage laden kann, auch
andere Typen.
Darum müssen wir hinterher vor dem Laden prüfen, ob
FreeImage für den evtl. erst in der zweiten Variante
gefundenen Dateityp eine Laderoutine kennt:
IF FreeImage_FIFSupportsReading(Ergebnis)

Also nochmal wiederholend im Kurzformat:
mit ERGEBNIS = FreeImage_GetFileType(filename AS STRING PTR, FI_DEFAULT(0) AS INTEGER) die Datei prüfen,
falls dabei -1 zurückgegeben wird, mit ERGEBNIS = FreeImage_GetFIFFromFilename(Dateiname AS STRING PTR)
tiefer prüfen, um danach,
wenn ERGEBNIS ungleich -1 ist und FreeImage_FIFSupportsReading(Ergebnis) wahr ist
die Datei in den (FreeImage-)Ram laden.

Zum Laden verwenden wir den Befehl:
FIBITMAP(AS FIBITMAP PTR) = FreeImage_Load(
     ERGEBNIS(=ermittelter Formatwert nach obiger Liste) AS FREE_IMAGE_FORMAT,
     Dateiname AS STRING PTR,
     FormAttribut (=0)
      )


somit sieht das ganze Kontstrukt für den Teil

   Ergebnis = FIF_UNKNOWN :' Erst mal "Dateityp Unbekannt" reinsetzen, FIF_UNKNOWN = -1
   'Dateityp ermitteln:
   Ergebnis = FreeImage_GetFileType( @DateiName, 0)
   IF Ergebnis = FIF_UNKNOWN THEN
      SCHREIBE("erster Test mit " & DateiName & " schlug fehl, nehme Zweiten!")
      'mit der schnellen Routine kann das Dateiformat nicht ermittelt werden,
      'über die tiefer gehende Routine den Typ ermitteln
      Ergebnis = FreeImage_GetFIFFromFilename( @DateiName )
      IF Ergebnis <> FIF_UNKNOWN AND FreeImage_FIFSupportsReading(Ergebnis) THEN
         BildZeiger = FreeImage_Load( Ergebnis, @DateiName, 0 )
      ELSE
         'Auch die tiefergehende Routine schlägt fehl, Bild einlesen geht nicht!
         Schreibe("kann die Datei " & DateiName & " nicht einlesen, breche ab")
         END
      END IF
   ELSE
      BildZeiger = FreeImage_Load( Ergebnis, @DateiName, 0 )
   END IF
   'Nun steht das Bild im FreeImageFormat im Ram an Adresse BildZeiger

Dann wollten wir grundsätzlich im RAM mit 32-bit Farbtiefe
erstellen, damit wir bei der Übergabe an OpenGL immer von
der gleichen Voraussetzung ausgehen können.
Auch dafür hat FreeImage eine Funktion drin, die jegliches
Bildformat in 32-bit Farbtiefe umwandelt. Jedoch landet
das Ergebnis an einer anderen Speicherstelle, für die
wir einen Pointerwert erhalten. Also brauchen wir dazu
eine zweite Variable AS FIBITMAP Ptr, um uns diese Adresse
im Ram merken zu können:

   'eine Kopie davon mit 32-bit Farbtiefe erstellen
   DIM AS FIBITMAP Ptr BildZeiger32bit
   BildZeiger32bit = FreeImage_ConvertTo32Bits( BildZeiger )

Damit stehen die Bilddaten so, wir wir das brauchen,
also gehen wir an den Abschnitt "Aus RAM an OpenGL".

FreeImage_GetBits liefert uns einen Pointer
auf die eigentlichen Pixeldaten im Arbeitsspeicher,
und damit hätten wir dann alles, was wir für die
Übergabe an OpenGL bräuchten. Jedoch müssen wir beim
Farben umsetzen den Pointer "hochzählen", also den
Wert verändern, obwohl wir den originalen Wert
später auch nochmal brauchen. Deshalb erstellen wir
zwei Pointer-Variablen, die die Adresse der Pixeldaten
enthalten:

   DIM AS BYTE PTR PixelImRam, RamPixelKopie
   PixelImRam = FreeImage_GetBits( BildZeiger32bit )
   RamPixelKopie = PixelImRam

Als Nächstes brauchen wir die Höhe/Breite des Bildes
in Pixel:

   'Bildbreite/Hoehe in Pixel holen
    Breite = FreeImage_GetWidth(BildZeiger32bit)
    Hoehe = FreeImage_GetHeight(BildZeiger32bit)

An diese Stelle können wir nun prüfen, ob das Bild
dem Format entspricht, was OpenGL für Texturen
verlangt.
Da wir hier mit allen OpenGL-Versionen arbeiten wollen,
also auch mit Version 1.0, dürfen wir nur quadratische
Bilder (Breite=Hoehe) verwenden, und die Kantenlängen
dürfen nur entweder 64 oder 128 oder 256 Pixel lang sein:

   IF (Breite <> Hoehe) OR (Breite <> 64 AND Breite <> 128 AND Breite <> 256) THEN
      'Das Bild kann nicht als Textur für OpenGL 1.0 verwendet werden
      SCHREIBE("Das Bild " & DateiName & "kann nicht als Textur für OpenGL 1.0 verwendet werden")
      SCHREIBE("           Das Bild ist entweder nicht quadratisch, oder ")
      SCHREIBE("           die Seitenlängen sind nicht 64, 128 oder 256 Pixel!")
      SCHREIBE("           Breche ab!")
      'Ramspeicher von FreeImage freigeben
      FreeImage_Unload(BildZeiger)
      FreeImage_Unload(BildZeiger32bit)
      END
   END IF

In der vorigen Routine für Bitmap-Dateien hatten wir ja
bereits das Problem, daß die Farbwerte für Blau und Rot
vertauscht im Speicher stehen, das ist hier ebenfalls
so. Deshalb mit genau dem selben Konstrukt müssen wir
diese beiden Farbwerte austauschen:

   'ROT UND BLAU TAUSCHEN
   FOR ZeilenZaehler = 0 TO Hoehe-1
      FOR PunktZaehler = 0 TO Breite-1
         BlauWert = RamPixelKopie[0]        :'aus Ram das Byte mit dem Blauwert des grad zu bearbeitenden Pixels holen
         RotWert  = RamPixelKopie[2]        :'aus Ram das Byte mit dem Rotwert des grad zu bearbeitenden Pixels holen
         RamPixelKopie[0] = RotWert         :'den Rotwert an die Stelle des Blauwertes im RAM schreiben
         RamPixelKopie[2] = BlauWert        :'den Blauwert an die Stelle des Rotwertes im RAM schreiben
         RamPixelKopie = RamPixelKopie+4 :'Ram-Adresse um 4 bytes erhöhen = Start Pixeldaten des nächsten Pixels
      NEXT PunktZaehler
   NEXT ZeilenZaehler

Und jetzt genau so, wie in der vorigen reinen BMP-Routine,
schauen, mit welcher Tiefe unser OpenGL-Fenster erstellt
wurde:

   'Farbtiefe des OpenGL-Fensters holen
   DIM AS INTEGER FensterFarbTiefe
   SCREENCONTROL 5, FensterFarbTiefe :' 5 = GET_SCREEN_DEPTH : Farbtiefe in Bits des OpenGL-Fensters ermitteln

Und nun der Abschnitt, in dem das RamBild Pixel für Pixel
von OpenGL auf die Grafikkarte geholt wird.
Das Einzige, was sich gegenüber der Bmp-Routine ändert,
ist die Angabe, wo die Pixel im Ram stehen, diesmal
haben wir ja andere Variablen dafür:

   'XXXXXXXXXXXXXXXXXXXXX UND RAM-BILD AN OPENGL ÜBERGEBRN XXXXXXXXXXXXXXXX
   glGenTextures 1, @TexturNummer
   glBindTexture GL_TEXTURE_2D, TexturNummer
   IF FensterFarbTiefe = 32 OR FensterFarbTiefe = 24 THEN
      glTexImage2D GL_TEXTURE_2D, 0, GL_RGBA, Breite, Hoehe, 0, GL_RGBA, GL_UNSIGNED_BYTE, PixelImRam
   ELSE
      glTexImage2D GL_TEXTURE_2D, 0, GL_RGB, Breite, Hoehe, 0, GL_RGBA, GL_UNSIGNED_BYTE, PixelImRam
   END IF
   glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR
   glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR

Zum Schluß wieder aufräumen. Die Bilder bei FreeImage
werden nicht mehr gebraucht, da OpenGL sich die Daten
nun auf die Grafikkarte kopiert hat.

   FreeImage_Unload(BildZeiger)
   FreeImage_Unload(BildZeiger32bit)

Als Letztes nun den Texturnamen(Nummer), den OpenGL für
unser Bild vergeben hat, an die diese Function aufrufende
Zeile zurückgeben:

   BildToOgl=TexturNummer
END FUNCTION

Damit steht diese Function.

Im Hauptprogramm müssen wir jetzt noch den Aufruf
für diese Function ändern, da diese jetzt anderst
heißt (die Zeilen mit den **************im Kommentartext ändern:

glMatrixMode GL_MODELVIEW                      ' Auf den Matrix-Modus Modelview schalten
glLoadIdentity                                 ' und auch diesen auf Anfangswerte setzen
TexturNummer = BildToOgl("mauer_128.bmp")      ' ************************Bitmapdatei als Textur an OpenGL schicken
TexturZwei   =  BildToOgl("Kirschen_256.bmp")  ' ************************eine zweite Bitmapdatei als Textur an OpenGL schicken
glClearColor 0.5, 0.5, 0.50, 0.0               ' Setze Farbe für löschen auf Mittelgrau
glClearDepth 1.0                               ' Depth-Buffer Löschen erlauben
glEnable GL_DEPTH_TEST                         ' den Tiefentest GL_DEPTH_TEST einschalten
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT  'Tiefen- und Farbpufferbits löschen
'---------------------------
'HAUPTTEIL
'---------------------------

Dabei habe ich jetzt die Bilddateien wie bei der vorigen
Routine beibehalten, also mauer_128.bmp und Kirschen_256.bmp.

Sie können nun auch gerne eine fast x-beliebige andere
Datei zum Texturieren nehmen, ob Jpg oder Png, egal.
NUR DIE GRUNDBEDINGUNGEN VON OPENGL sind einzuhalten,
quadratisches Bild (Breite=Hoehe) und drei verschiedene
Kantenlängen sind möglich: 64, 128 oder 256 Pixel.

Fortgeschrittene können nun auch Bilder mit Alphakanal,
also Teil-Durchsichtig verwenden ;-).

Einziges bis jetzt festgestelltes Manko:
eine mit CorelPaint-7 erstellte Jp2-Datei
nimmt FreeImage nicht an, keine Ahnung, was
da schief läuft.

Hier nochmal das gesamte Listing unserer kleinen 3D-Welt
mit den zwei Wänden und den beiden Pyramiden, jeweils
eins mit Mauer_128 texturiert und das Andere mit Kirschen_256.

'REM Tutorial 4 - OpenGL-Tutorial von Eastler
'-------------------------
'DIMs
'-------------------------
DIM SHARED AS STRING Tastendruck
DIM SHARED AS STRING Tlinks, Trechts, Tvor, Tzurueck, TCtrlVor, TCtrlZurueck, TCtrlLinks, TCtrlRechts
Tlinks       = CHR(255) & CHR( 75)  :' beim Drücken der Taste CursorLinks gibt die Tastatur CHR(255) & CHR( 75) zurück
Trechts      = CHR(255) & CHR( 77)  :' CursorRechts
Tvor         = CHR(255) & CHR( 72)  :' CursorHoch
Tzurueck     = CHR(255) & CHR( 80)  :' CursorRunter
TCtrlVor     = CHR(255) & CHR(141)  :'Ctrl oder STRG zusammen mit CursorHoch
TCtrlZurueck = CHR(255) & CHR(145)  :'Ctrl oder STRG zusammen mit CursorRunter
TCtrlLinks   = CHR(255) & CHR(115)  :'<--------CURSOR NACH LINKS-Variable mit Wert belegen
TCtrlRechts  = CHR(255) & CHR(116)  :'<--------CURSOR NACH RECHTS-Variable mit Wert belegenDIM AS SINGLE XRichtg, YRichtg, ZRichtg
DIM AS SINGLE XRichtg, YRichtg, ZRichtg
DIM AS SINGLE PyraXDrehw, PyraYDrehw, PyraZDrehw :'<------------------------ für Pyramide per Tasten drehen
DIM AS SINGLE WeltDrehX, WeltDrehY, WeltDrehZ
DIM AS INTEGER ConNr                :' Dateinummerspeicher beim Consolefenster öffnen
DIM AS UINTEGER TexturNummer, TexturZwei
DIM SHARED AS DOUBLE Pi
Pi = 3.14159265358979323846
'-------------------------
'Includes
'-------------------------
#include "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glu.bi"
#include once "vbcompat.bi" '************** um Zahlen per "format()" formatieren zu können
#include "FreeImage393.bi"     '************** Bilder aller Art von Festplatte einlesen

'-------------------------
'Declarationen
'-------------------------
DECLARE SUB Koordinatensystem(was AS STRING, TxtPara AS STRING, Para1 AS SINGLE, Para2 AS SINGLE, Para3 AS SINGLE)
DECLARE SUB Schachbrettboden(was AS STRING, StrPara AS STRING, Para1 AS SINGLE, Para2 AS SINGLE, Para3 AS SINGLE)
DECLARE SUB Pyramide (was AS STRING, StrPara AS STRING, Para1 AS SINGLE, Para2 AS SINGLE, Para3 AS SINGLE)
DECLARE FUNCTION BildToOgl(BildDateiName AS STRING) AS INTEGER
DECLARE SUB Schreibe(Text AS STRING)
'-------------------------
' das Fenster öffnen
'-------------------------
screen 19, 32, , 2

'-------------------------
' Open-GL Init
'-------------------------
glViewport 0, 0, 800, 600                      ' den Current Viewport auf eine Ausgangsposition setzen
glMatrixMode GL_PROJECTION                     ' Den Matrix-Modus Projection wählen
glLoadIdentity                                 ' Diesen Modus auf Anfangswerte setzen
gluPerspective 45.0, 800.0/600.0, 0.1, 100.0   ' Grundeinstellungen des Anezeigefensters festlegen
glMatrixMode GL_MODELVIEW                      ' Auf den Matrix-Modus Modelview schalten
glLoadIdentity                                 ' und auch diesen auf Anfangswerte setzen
TexturNummer = BildToOgl("Mauer_128.bmp")       ' Bitmapdatei als Textur an OpenGL schicken
TexturZwei   =  BildToOgl("Kirschen_256.bmp")   ' eine zweite Bitmapdatei als Textur an OpenGL schicken
glClearColor 0.5, 0.5, 0.50, 0.0               ' Setze Farbe für löschen auf Mittelgrau
glClearDepth 1.0                               ' Depth-Buffer Löschen erlauben
glEnable GL_DEPTH_TEST                         ' den Tiefentest GL_DEPTH_TEST einschalten
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT  'Tiefen- und Farbpufferbits löschen
'---------------------------
'HAUPTTEIL
'---------------------------
Schachbrettboden("SetzKantenLaenge", "", 0.5,  0,    0)
Schachbrettboden("SetzQuadsZahl",    "", 24,   24,   0)     :'6 Einheiten +und- = 12Einheiten Koordiantensystem, bei 0.5 Quadgröße 24 Stück
Schachbrettboden("SetzFarbe1",       "", 0,    0,    0.5)   :'erste Farbe dunkleres blau
Schachbrettboden("SetzFarbe2",       "", 0.25, 0.25, 0.25)  :'erste Farbe dunkles grau
Schachbrettboden("SetzStartPos",     "", -6,   -6,   -1)     :'ganz vorne ganz links beginnen, Boden auf Hoehe(3.Para)-1 verlegen(Y)

Pyramide("SetzLaengen" , "", 1, 1,  1)
Pyramide("SetzFarbe1"  , "", 1, 0, 0)
Pyramide("SetzFarbe2"  , "", 0, 1, 0)
Pyramide("SetzFarbe3"  , "", 0, 0, 1)
Pyramide("SetzFarbe4"  , "", 1, 1, 0)
Pyramide("SetzFarbe5"  , "", 1, 0, 1)

DO UNTIL Tastendruck = CHR(27)                         :'die Schleife solange immer wiederholen, bis in der Variablen Tastendruck die Esc-Taste (chr(27) steht
   Tastendruck = INKEY                                 :'Jeder Tastendruck wird sofort in die Variable Tastendruck gespeichert
   '---------------------------
   'ProgrammSchleife
   '---------------------------

   'JE NACH TASTENDRUCK DEN ENTSPRECHENDEN POSITIONSWERT VERÄNDERN
   SELECT CASE Tastendruck
      CASE "K", "K"
         Koordinatensystem("AnAus", "", 0, 0, 0) :' Schalter umstellen, falls An ist, auf Aus, sonst auf An
      CASE TCtrlrechts                :'Falls die Tasten "Cursor nach rechts" zuammen mit Strg- bzw. Ctrl gedrückt wurde
         XRichtg = XRichtg - COS((WeltDrehY * Pi) / 180) * 0.04 :' Den X-Pos-Wert anpassen
         ZRichtg = ZRichtg - SIN((WeltDrehY * Pi) / 180) * 0.04 :' Den Y-Pos-Wert anpassen
      CASE TCtrllinks                 :'Falls die Tasten "Cursor nach rechts" zuammen mit Strg- bzw. Ctrl gedrückt wurde
         XRichtg = XRichtg + COS((WeltDrehY * Pi) / 180) * 0.04 :' Den X-Pos-Wert anpassen
         ZRichtg = ZRichtg + SIN((WeltDrehY * Pi) / 180) * 0.04 :' Den Y-Pos-Wert anpassen
      CASE TCtrlzurueck               :'Falls die Tasten "Cursor unten" zuammen mit Strg- bzw. Ctrl gedrückt wurde
         YRichtg = YRichtg + 0.04 :'HOCH und Runter bleibt unberührt von der Y-Drehung
      CASE TCtrlvor                   :'Falls die Tasten "Cursor hoch" zuammen mit Strg- bzw. Ctrl gedrückt wurde
         YRichtg = YRichtg - 0.04 :'HOCH und Runter bleibt unberührt von der Y-Drehung
      CASE TZurueck                   :'Falls die Taste "Cursor runter" gedrückt wurde
         XRichtg = XRichtg + COS((WeltDrehY-90) * Pi / 180) * 0.04 :' Den X-Pos-Wert anpassen
         ZRichtg = ZRichtg + SIN((WeltDrehY-90) * Pi / 180) * 0.04 :' Den Y-Pos-Wert anpassen
      CASE TVor                       :'Falls die Taste "Cursor hoch" gedrückt wurde
         XRichtg = XRichtg + COS((WeltDrehY+90) * Pi / 180) * 0.04 :' Den X-Pos-Wert anpassen
         ZRichtg = ZRichtg + SIN((WeltDrehY+90) * Pi / 180) * 0.04 :' Den Y-Pos-Wert anpassen
      CASE TLinks                      :'Falls die Taste "Cursor links" gedrückt wurde
         WeltDrehY = WeltDrehY - 1
      CASE TRechts                     :'Falls die Taste "Cursor rechts" gedrückt wurde
         WeltDrehY = WeltDrehY + 1
      CASE "x"
         PyraXDrehw=PyraXDrehw+12
      CASE "x"
         PyraXDrehw=PyraXDrehw-12
      CASE "y"
         PyraYDrehw=PyraYDrehw+12
      CASE "y"
         PyraYDrehw=PyraYDrehw-12
      CASE "z"
         PyraZDrehw=PyraZDrehw+12
      CASE "z"
         PyraZDrehw=PyraZDrehw-12
      CASE "i", "i"                       :'<------------------------
         ConNr = FREEFILE                 :'nächste freie Dateinummer für öffnen von FreeBasic holen und in ConNr merken
         open "con" FOR OUTPUT AS #ConNr  :'und nun die Konsole als Datei unter Nr ConNr öffnen
            PRINT #ConNr, "PyraXDrehw:" & format(PyraXDrehw,"0.00") & "  PyraYDrehw:" & format(PyraYDrehw,"0.00") & "  PyraZDrehw:" & format(PyraZDrehw,"0.00")
            PRINT #ConNr, "XRichtg:" & format(XRichtg,"0.00") & "  YRichtg:" & format(YRichtg,"0.00") & "  ZRichtg:" & format(ZRichtg,"0.00")
         CLOSE #ConNr
   END SELECT   'PRÜFEN, DASS DIE POSITIONSWERTE IN ALLEN DREI RICHTUNGEN ZWISCHEN -3 und +3 BLEIBEN
   IF XRichtg >  6 THEN XRichtg =  6           :'falls zu weit rechts, bei  6 festnageln
   IF XRichtg < -6 THEN XRichtg = -6           :'falls zu weit links,  bei -6 festnageln
   IF YRichtg >  6 THEN YRichtg =  6           :'falls zu weit hoch,   bei  6festnageln
   IF YRichtg < -6 THEN YRichtg = -6           :'falls zu weit runter, bei -6 festnageln
   IF ZRichtg >  5 THEN ZRichtg =  5           :'falls zu weit zurück, bei 10 festnageln
   IF ZRichtg < -10 THEN ZRichtg = -10           :'falls zu weit vor,    bei -6 festnageln
   glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT  :'bisherig erstellte Objekte löschen, unsere 3D-Welt wieder von Neuem an erstellen
   glPushMatrix                                        :'aktuelle Position + Drehgrade sichern (2.Zettel mit gleicher Pos auf PositionsSTACK)
    glRotatef WeltDrehY, 0, 1, 0                       :'Rotationsbefehl der Kamera, um Y ist zu drehen
    glTranslatef XRichtg, YRichtg, ZRichtg             :'Verschiebung der Kamera, auf neue Werte einstellen

    '-------------------------
    'AB HIER OBJEKTE ERSTELLEN
    '-------------------------
    glPointSize(5)                             :' Punktgröße auf 5 = deutlich groß
    glColor3f 1.0,0.0,0.0                      :' Anzeigefarbe auf ROT setzen
    Koordinatensystem("Anzeigen", "", 0, 0, 0) :' den Stringwert "Anzeigen" übergeben
    Schachbrettboden("BeschreibungsListeBoden", "", 0, 0, 0):' SchachbrettBoden in der 3D-Welt erstellen
    glPushMatrix                                                             :'akt.Position und Drehgrade sichern
    glEnable GL_TEXTURE_2D                    :'***********Texturieren erlauben*************
    glBindTexture GL_TEXTURE_2D, TexturNummer :'***********das erste Bild(mauer) als Textur aktivieren*************
    Pyramide("BeschreibungsListe"  , "", PyraXDrehw, PyraYDrehw, PyraZDrehw) :'die erste Pyramide
    glPopMatrix                                                              :'auf gesichterte Position und Drehgrade zurücksetzen
    glPushMatrix                                                             :'akt.Position und Drehgrade sichern
    glTranslatef -2, 0, 0                                                    :'hier der Verschiebebefehl, damit die 2.Pyramide woanderst steht
    glBindTexture GL_TEXTURE_2D, TexturZwei   :'***********das zweite Bild(Kirschen) als Textur aktivieren*************
    Pyramide("BeschreibungsListe"  , "", PyraXDrehw, PyraYDrehw, PyraZDrehw) :'und eine zweite Pyramide
    glPopMatrix                                                              :'auf gesichterte Position und Drehgrade zurücksetzen
    glDisable GL_TEXTURE_2D                    :'***********Texturieren wieder ausschalten*************

    '-----------------
    'OBJEKTE ERSTELLEN
    '-----------------

'-------------------------------------------------------------------
'XXXXXXXXXXXXXXXXXXXXX RECHTECK MIT TEXTUR ERZEUGEN XXXXXXXXXXXXXXXX
'-------------------------------------------------------------------
   glEnable GL_TEXTURE_2D          :'Texturieren mit dem grad aktiven Bild einschalten/erlauben
   glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL) :'texturieren "voll drauf" kein durchsichtig etc
   glBindTexture GL_TEXTURE_2D, TexturNummer      :'Unser Bild auf der Grafikkarte als aktives setzen
   glColor3f 1.0,0.0,0.0                          :'Anzeigefarbe (für das Rechteck) auf ROT setzen
   glBegin GL_QUADS                               :'Beginn Beschreibungsliste Objekt Viereck
      glTexCoord2d 0.0, 1.0 : glVertex3f -1.0,  1.0, -4.0  :'die linke obere Ecke des Rechtecks
      glTexCoord2d 0.0, 0.0 : glVertex3f -1.0, -1.0, -4.0  :'die linke untere Ecke des Rechtecks
      glTexCoord2d 1.0, 0.0 : glVertex3f +1.0, -1.0, -4.0  :'die rechte untere Ecke des Rechtecks
      glTexCoord2d 1.0, 1.0 : glVertex3f +1.0,  1.0, -4.0  :'die rechte obere Ecke des Rechtecks
   glEnd                                          :'Fertig mit dem Objekt
   glDisable GL_TEXTURE_2D         :'Texturieren ausschalten (es soll ja nur das Viereck texturiert werden, nicht die Pyramiden)
'-------------------------------------------------------------------
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'-------------------------------------------------------------------
   glEnable GL_TEXTURE_2D          :'Texturieren mit dem grad aktiven Bild einschalten/erlauben
   glEnable GL_Alpha_test          :'Texturieren mit dem grad aktiven Bild einschalten/erlauben
   glBindTexture GL_TEXTURE_2D, TexturZwei        :'Unser Bild auf der Grafikkarte als aktives setzen
   glColor3f 1.0,0.0,0.0                          :'Anzeigefarbe (für das Rechteck) auf ROT setzen
   glBegin GL_QUADS                               :'Beginn Beschreibungsliste Objekt Viereck
      glTexCoord2d 0.0, 1.0 : glVertex3f -4.0,  1.0, -4.0  :'die linke obere Ecke des Rechtecks
      glTexCoord2d 0.0, 0.0 : glVertex3f -4.0, -1.0, -4.0  :'die linke untere Ecke des Rechtecks
      glTexCoord2d 1.0, 0.0 : glVertex3f -2.0, -1.0, -4.0  :'die rechte untere Ecke des Rechtecks
      glTexCoord2d 1.0, 1.0 : glVertex3f -2.0,  1.0, -4.0  :'die rechte obere Ecke des Rechtecks
   glEnd                                          :'Fertig mit dem Objekt
   glDisable GL_TEXTURE_2D         :'Texturieren ausschalten (es soll ja nur das Viereck texturiert werden, nicht die Pyramiden)
'-------------------------------------------------------------------
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'-------------------------------------------------------------------


    flip                                               :'liebes OpenGL, zeig alles, was in der Schleife für dich vornedran steht, auf Monitor an
   '---------------------------
   'Ende der Schleife
   '---------------------------
   glPopMatrix                                         :' Aufgabe erledigt, den zweiten Zettel mit der geänderten Pos wegschmeißen, dann ist Alte Pos wieder aktuelle Pos
LOOP

END

'--------------------------------
SUB Koordinatensystem(was AS STRING, TxtPara AS STRING, Para1 AS SINGLE, Para2 AS SINGLE, Para3 AS SINGLE)
   DIM AS INTEGER Zaehler
   STATIC AS INTEGER AnzeigeSchalter
   SELECT CASE UCASE(was)
      CASE "AnAus"
         IF AnzeigeSchalter = 0 THEN AnzeigeSchalter = 1 ELSE AnzeigeSchalter = 0
      CASE "Anzeigen"
        IF AnzeigeSchalter = 1 THEN
         glBegin GL_LINES:' Ja, wir beginnen mit der Beschreibungsliste fuer Linien
         'und zwar zuerst die positiven Bereiche jeder Achse
         glColor3f 1.0, 1.0, 1.0        :' Positives Maß = weiße Teilstriche (Rot 1.0, blau 1.0, grün 1.0 = weiß)
         FOR Zaehler = 1 TO 6 :'fuer die Maßeinheitspositionen 1, 2 und 3 Striche Ziehen
            'X-ACHSE
               'senkrechter Strich (wie Y-Achse)
            glVertex3f  Zaehler+Para1,  0.2+Para2,  0.0+Para3 :' Anfangspunkt auf XAchse-Maßpunkt, 0.2 Einheiten drüber(+Y), Tiefe = 0
            glVertex3f  Zaehler+Para1, -0.2+Para2,  0.0+Para3 :' Endpunkt auf XAchse-Maßpunkt, 0.2 Einheiten drunter(-Y), Tiefe = 0
               'waagerechter Strich (wie Z-Achse)
            glVertex3f  Zaehler+Para1,  0.0+Para2,  0.2+Para3 :' Anfangspunkt auf XAchse-Maßpunkt, 0.2 Einheiten drüber(+Y), Tiefe = 0
            glVertex3f  Zaehler+Para1,  0.0+Para2, -0.2+Para3 :' Endpunkt auf XAchse-Maßpunkt, 0.2 Einheiten drunter(-Y), Tiefe = 0
            'Y-ACHSE
               'Strich wie X-Achse
            glVertex3f  0.2+Para1, Zaehler+Para2,  0.0+Para3 :' Anfangspunkt auf YAchse-Maßpunkt, 0.2 Einheiten nach +X, Tiefe = 0
            glVertex3f -0.2+Para1, Zaehler+Para2,  0.0+Para3 :' Endpunkt auf YAchse-Maßpunkt, 0.2 Einheiten nach -X, Tiefe = 0
               'Strich wie Z-Achse
            glVertex3f  0.0+Para1, Zaehler+Para2,  0.2+Para3 :' Anfangspunkt auf YAchse-Maßpunkt, 0.2 Einheiten nach vorne/+Z, Seite (X) = 0
            glVertex3f  0.0+Para1, Zaehler+Para2, -0.2+Para3 :' Endpunkt auf YAchse-Maßpunkt, 0.2 Einheiten nach hinten/-Z, Seite (X) = 0
            'Z-ACHSE
               'Strich waagerecht (X)
            glVertex3f  0.2+Para1,  0.0+Para2, Zaehler+Para3 :' Anfangspunkt auf ZAchse-Maßpunkt, 0.2 Einheiten nach rechts +X, Hoehe = 0
            glVertex3f -0.2+Para1,  0.0+Para2, Zaehler+Para3 :' Endpunkt auf ZAchse-Maßpunkt, 0.2 Einheiten nach links -X, Hoehe = 0
               'Strich senkreicht (Y)
            glVertex3f  0.0+Para1,  0.2+Para2,  Zaehler+Para3 :' Anfangspunkt auf ZAchse-Maßpunkt, 0.2 Einheiten nach oben +Y, Seite = 0
            glVertex3f  0.0+Para1, -0.2+Para2,  Zaehler+Para3 :' Endpunkt auf ZAchse-Maßpunkt, 0.2 Einheiten nach unten -Y, Seite = 0
         NEXT Zaehler
         glColor3f 0.0, 0.0, 0.0        :' Negatives Maß = schwrze Teilstriche (alles auf 0)
         FOR Zaehler = -6 TO -1 :'fuer die Maßeinheitspositionen -3, -2 und -1 Striche Ziehen
         'X-ACHSE
            'senkrechter Strich (wie Y-Achse)
            glVertex3f  Zaehler+Para1,  0.2+Para2,  0.0+Para3 :' Anfangspunkt auf XAchse-Maßpunkt, 0.2 Einheiten drüber(+Y), Tiefe = 0
            glVertex3f  Zaehler+Para1, -0.2+Para2,  0.0+Para3 :' Endpunkt auf XAchse-Maßpunkt, 0.2 Einheiten drunter(-Y), Tiefe = 0
            'waagerechter Strich (wie Z-Achse)
            glVertex3f  Zaehler+Para1,  0.0+Para2,  0.2+Para3 :' Anfangspunkt auf XAchse-Maßpunkt, 0.2 Einheiten drüber(+Y), Tiefe = 0
            glVertex3f  Zaehler+Para1,  0.0+Para2, -0.2+Para3 :' Endpunkt auf XAchse-Maßpunkt, 0.2 Einheiten drunter(-Y), Tiefe = 0
            'Y-ACHSE
               'Strich wie X-Achse
            glVertex3f  0.2+Para1, Zaehler+Para2,  0.0+Para3 :' Anfangspunkt auf YAchse-Maßpunkt, 0.2 Einheiten nach +X, Tiefe = 0
            glVertex3f -0.2+Para1, Zaehler+Para2,  0.0+Para3 :' Endpunkt auf YAchse-Maßpunkt, 0.2 Einheiten nach -X, Tiefe = 0
               'Strich wie Z-Achse
            glVertex3f  0.0+Para1, Zaehler+Para2,  0.2+Para3 :' Anfangspunkt auf YAchse-Maßpunkt, 0.2 Einheiten nach vorne/+Z, Seite (X) = 0
            glVertex3f  0.0+Para1, Zaehler+Para2, -0.2+Para3 :' Endpunkt auf YAchse-Maßpunkt, 0.2 Einheiten nach hinten/-Z, Seite (X) = 0
            'Z-ACHSE
               'Strich waagerecht (X)
            glVertex3f  0.2+Para1,  0.0+Para2, Zaehler+Para3 :' Anfangspunkt auf ZAchse-Maßpunkt, 0.2 Einheiten nach rechts +X, Hoehe = 0
            glVertex3f -0.2+Para1,  0.0+Para2, Zaehler+Para3 :' Endpunkt auf ZAchse-Maßpunkt, 0.2 Einheiten nach links -X, Hoehe = 0
               'Strich senkreicht (Y)
            glVertex3f  0.0+Para1,  0.2+Para2,  Zaehler+Para3 :' Anfangspunkt auf ZAchse-Maßpunkt, 0.2 Einheiten nach oben +Y, Seite = 0
            glVertex3f  0.0+Para1, -0.2+Para2,  Zaehler+Para3 :' Endpunkt auf ZAchse-Maßpunkt, 0.2 Einheiten nach unten -Y, Seite = 0
         NEXT Zaehler
         'UND NUN DIE DREI ACHSEN SELBST:
         'X-ACHSE
         glColor3f 1.0, 0.0, 0.0        :' Xachse = rot
         glVertex3f  -6.0+Para1, 0+Para2, 0+Para3
         glVertex3f  +6.0+Para1, 0+Para2, 0+Para3
         'Y-ACHSE
         glColor3f 0.0, 1.0, 0.0        :' Yachse = grün
         glVertex3f  0+Para1, -6.0+Para2, 0+Para3
         glVertex3f  0+Para1, +6.0+Para2, 0+Para3
         'Z-ACHSE
         glColor3f 0.0, 0.0, 1.0        :' Zachse = blau
         glVertex3f  0+Para1, 0+Para2, -6.0+Para3
         glVertex3f  0+Para1, 0+Para2, +6.0+Para3
         glEnd
       END IF
   END SELECT
END SUB
'-------------------------
SUB Schachbrettboden(was AS STRING, StrPara AS STRING, Para1 AS SINGLE, Para2 AS SINGLE, Para3 AS SINGLE)
   STATIC AS SINGLE QuadKantenLaenge, QuadsQuer, QuadsTief
   STATIC AS SINGLE Farbe1Rot, Farbe1Gruen, Farbe1Blau
   STATIC AS SINGLE Farbe2Rot, Farbe2Gruen, Farbe2Blau
   STATIC AS SINGLE StartPosX, StartPosZ, BodenHoehe
   STATIC AS INTEGER ZaehlerX, ZaehlerZ                   :'ForNext-Zählvars, ggf. rekursiver aufruf dieser Sub, drum STATIC
   SELECT CASE UCASE(was)
      CASE "SetzKantenLaenge"
         'Aufruf hierfür in Para1 die Länge der Kanten der Quadrate
         QuadKantenLaenge = Para1
      CASE "SetzQuadsZahl"
         'Aufruf hierfür in Para1 die Anzahl von Quads quer,
         'in Para2 die Anzahl in der Tiefenrichtung
         QuadsQuer = Para1
         QuadsTief = Para2
      CASE "SetzFarbe1"
         'in Para1 Para2 Para2 die Rot Grün und Blauwerte der ersten Quadratfarbe
         Farbe1Rot   = Para1
         Farbe1Gruen = Para2
         Farbe1Blau  = Para3
      CASE "SetzFarbe2"
         'in Para1 Para2 Para2 die Rot Grün und Blauwerte der ersten Quadratfarbe
         Farbe2Rot   = Para1
         Farbe2Gruen = Para2
         Farbe2Blau  = Para3
      CASE "SetzStartPos"
         'in Para1 Para2 Para2 die X und Z Position, von wo begonnen wird,
         'die vielen Quadrate zu erstellen
         StartPosX   = Para1
         StartPosZ   = Para2
         BodenHoehe  = Para3
      CASE "BeschreibungsListeBoden"
         'Hier erstellen wir die FOR-NEXT-SCHLEIFEN,
         'welche die OpenGL-Beschreibungsliste
         'zum Anzeigen des Bodens erstellen
         glBegin GL_QUADS
            FOR ZaehlerX = 1 TO QuadsQuer     :'Laufnr des grad zu zeichnenden Quads auf der X-Achse
               FOR ZaehlerZ = 1 TO QuadsTief  :'Laufnr des grad zu zeichnenden Quads auf der Z-Achse
                  'Die Farbe festlegen
                  IF ((ZaehlerX+ZaehlerZ)\2)*2=(ZaehlerX+ZaehlerZ) THEN
                     'Wenn die Summe von ZahlerX+ZaehlerY gerade ist Farbe1 nehmen
                     glColor3f Farbe1Rot, Farbe1Gruen, Farbe1Blau
                  ELSE
                     'Wenn die Summe von ZahlerX+ZaehlerY UNgerade ist Farbe2 nehmen
                     glColor3f Farbe2Rot, Farbe2Gruen, Farbe2Blau
                  END IF
                  'Die Eckpunkte der Quadrate benennen wir in der Reihenfolge GEGEN DEN UHRZEIGERSINN, von oben draufschauend
                  glVertex3f StartPosX+(ZaehlerX-1)*QuadKantenLaenge,  BodenHoehe,  StartPosZ+(ZaehlerZ-1)*QuadKantenLaenge
                  glVertex3f StartPosX+ ZaehlerX   *QuadKantenLaenge,  BodenHoehe,  StartPosZ+(ZaehlerZ-1)*QuadKantenLaenge
                  glVertex3f StartPosX+ ZaehlerX   *QuadKantenLaenge,  BodenHoehe,  StartPosZ+ ZaehlerZ   *QuadKantenLaenge
                  glVertex3f StartPosX+(ZaehlerX-1)*QuadKantenLaenge,  BodenHoehe,  StartPosZ+ ZaehlerZ   *QuadKantenLaenge
               NEXT ZaehlerZ
            NEXT ZaehlerX
         glEnd
      CASE ELSE
         'Hier kommen alle SUB-Aufrufe an, welche als
         'was-Parameter einen Eintrag haben, der hier
         'nicht ausgewertet wurde.
         'Tippfehler vom Programmierer????
   END SELECT
END SUB
'-------------------------
SUB Pyramide(was AS STRING, StrPara AS STRING, Para1 AS SINGLE, Para2 AS SINGLE, Para3 AS SINGLE)
   'Pyramide erstellen, Grundfläche/Quadrat = auf Höhe 0, seitlich mittig auf X- und Z-Achse Positioniert
   'Grundflächengroesse = XLaenge x ZLaenge, Höhe Pyramide = ZLaenge
   STATIC AS SINGLE XLaenge, YLaenge, ZLaenge
   STATIC AS SINGLE Farbe1Rot, Farbe1Gruen, Farbe1Blau
   STATIC AS SINGLE Farbe2Rot, Farbe2Gruen, Farbe2Blau
   STATIC AS SINGLE Farbe3Rot, Farbe3Gruen, Farbe3Blau
   STATIC AS SINGLE Farbe4Rot, Farbe4Gruen, Farbe4Blau
   STATIC AS SINGLE Farbe5Rot, Farbe5Gruen, Farbe5Blau
   STATIC AS INTEGER ZaehlerX, ZaehlerZ                   :'ForNext-Zählvars, ggf. rekursiver aufruf dieser Sub, drum STATIC
   SELECT CASE UCASE(was)
      CASE "SetzLaengen"  : XLaenge   = Para1 : YLaenge     = Para2 : ZLaenge     = Para3
      CASE "SetzFarbe1"   : Farbe1Rot = Para1 : Farbe1Gruen = Para2 : Farbe1Blau  = Para3 :'ein Dreieck
      CASE "SetzFarbe2"   : Farbe2Rot = Para1 : Farbe2Gruen = Para2 : Farbe2Blau  = Para3 :'ein Dreieck
      CASE "SetzFarbe3"   : Farbe3Rot = Para1 : Farbe3Gruen = Para2 : Farbe3Blau  = Para3 :'ein Dreieck
      CASE "SetzFarbe4"   : Farbe4Rot = Para1 : Farbe4Gruen = Para2 : Farbe4Blau  = Para3 :'ein Dreieck
      CASE "SetzFarbe5"   : Farbe5Rot = Para1 : Farbe5Gruen = Para2 : Farbe5Blau  = Para3 :'der Boden/Quadrat
      CASE "BeschreibungsListe"
         glrotatef Para1, 1, 0, 0    :'<----------- um X-Achse drehen
         glrotatef Para2, 0, 1, 0    :'<----------- um Y-Achse drehen
         glrotatef Para3, 0, 0, 1    :'<----------- um Z-Achse drehen
         'die OpenGL-Beschreibungsliste zum Anzeigen der Pyramide erstellen
         glBegin GL_QUADS
            'der Boden der Pyramide als Quadrat, auf Höhe 0(Y-Achse),
            'seitliche Ausrichtungen = Quadratmitte = X-Achsenmitte und Z-Achsenmitte
            'damit Zentriert sitzt, für 1.Punkt einfach halbe Kantenlänge von 0 Abziehen, für 2. dazuaddieren
            'Reihenfolge Eckpunktangabe gegen Uhrzeigersinn VON UNTEN her gesehen (unten=Außenseite später)
            glColor3f  Farbe5Rot, Farbe5Gruen, Farbe5Blau :'falls Texturieren Disabled ist, wird diese Farbe genommen
            glTexCoord2d 0.0, 1.0 : glVertex3f 0-(XLaenge/2)    , 0  , 0+(ZLaenge/2) :'Ecke links oben
            glTexCoord2d 0.0, 0.0 : glVertex3f 0-(XLaenge/2)    , 0  , 0-(ZLaenge/2) :'Ecke links unten
            glTexCoord2d 1.0, 0.0 : glVertex3f 0+(XLaenge/2)    , 0  , 0-(ZLaenge/2) :'Ecke rechts unten
            glTexCoord2d 1.0, 1.0 : glVertex3f 0+(XLaenge/2)    , 0  , 0+(ZLaenge/2) :'Ecke rechts oben
         glEnd
         glBegin GL_TRIANGLES
            '   Dreieckseite 1 = linke Seite
            glColor3f  Farbe1Rot, Farbe1Gruen, Farbe1Blau
            glTexCoord2d 0.0, 0.0 : glVertex3f 0-(XLaenge/2)    , 0       , 0-(ZLaenge/2) :'links unten
            glTexCoord2d 1.0, 0.0 : glVertex3f 0-(XLaenge/2)    , 0       , 0+(ZLaenge/2) :'rechts unten
            glTexCoord2d 0.1, 1.0 : glVertex3f 0                , YLaenge , 0             :'Spitze oben
            '   Dreieckseite 2 = hintere Seite /Rückseite
            glColor3f  Farbe2Rot, Farbe2Gruen, Farbe2Blau
            glTexCoord2d 0.0, 0.0 : glVertex3f 0+(XLaenge/2)    , 0  , 0-(ZLaenge/2) :'links unten
            glTexCoord2d 1.0, 0.0 : glVertex3f 0-(XLaenge/2)    , 0  , 0-(ZLaenge/2) :'rechts unten
            glTexCoord2d 0.5, 1.0 : glVertex3f 0                , YLaenge , 0        :'Spitze oben mitte
            '   Dreieckseite 3 = rechte Seite
            glColor3f  Farbe3Rot, Farbe3Gruen, Farbe3Blau
            glTexCoord2d 0.0, 0.0 : glVertex3f 0+(XLaenge/2)    , 0  , 0+(ZLaenge/2) :'links unten
            glTexCoord2d 1.0, 0.0 : glVertex3f 0+(XLaenge/2)    , 0  , 0-(ZLaenge/2) :'rechts unten
            glTexCoord2d 0.5, 1.0 : glVertex3f 0                , YLaenge , 0        :'Spitze oben mitte
            '   Dreieckseite 4 = Vorderseite
            glColor3f  Farbe4Rot, Farbe4Gruen, Farbe4Blau
            glTexCoord2d 0.0, 0.0 : glVertex3f 0-(XLaenge/2)    , 0  , 0+(ZLaenge/2) :'links unten
            glTexCoord2d 1.0, 0.0 : glVertex3f 0+(XLaenge/2)    , 0  , 0+(ZLaenge/2) :'rechts unten
            glTexCoord2d 0.5, 1.0 : glVertex3f 0                , YLaenge , 0        :'Spitze oben mitte
         glEnd
      CASE ELSE
         'Hier kommen alle SUB-Aufrufe an, welche als
         'was-Parameter einen Eintrag haben, der hier
         'nicht ausgewertet wurde.
         'Tippfehler vom Programmierer????
   END SELECT
END SUB
'--------------------------------
FUNCTION BildToOgl(BildDateiName AS STRING) AS INTEGER
   '"Lade Bilddatei von Festplatte in FreeImageRam"
   DIM AS UINTEGER TexturNummer, Breite, Hoehe, ZeilenZaehler, PunktZaehler, BlauWert, RotWert, DateiNummer
   DIM AS FIBITMAP Ptr BildZeiger
   DIM AS ZSTRING PTR DateiNamenZeiger
   DIM AS FREE_IMAGE_FORMAT Ergebnis
   DIM DateiName AS ZSTRING * 512
   DateiName=LEFT(BildDateiName, 512)
   'mit FreeBasic checken, ob die Datei überhaupt existiert
   DateiNummer = FREEFILE
   OPEN DateiName FOR INPUT AS #DateiNummer
   IF LOF(DateiNummer) = 0 THEN
      SCHREIBE("DateiName Läenge=" & LEN(DateiName) & "=" & LEFT(DateiName, 20) & " Dateigroeße=" & LOF(DateiNummer) )
      END
   END IF
   CLOSE #DateiNummer
   Ergebnis = FIF_UNKNOWN :' Erst mal "Dateityp Unbekannt" reinsetzen, FIF_UNKNOWN = -1
   'Dateityp ermitteln:
   Ergebnis = FreeImage_GetFileType( @DateiName, 0)
   IF Ergebnis = FIF_UNKNOWN THEN
      SCHREIBE("erster Test mit " & DateiName & " schlug fehl, nehme Zweiten!")
      'mit der schnellen Routine kann das Dateiformat nicht ermittelt werden,
      'über die tiefer gehende Routine den Typ ermitteln
      Ergebnis = FreeImage_GetFIFFromFilename( @DateiName )
      IF Ergebnis <> FIF_UNKNOWN AND FreeImage_FIFSupportsReading(Ergebnis) THEN
         BildZeiger = FreeImage_Load( Ergebnis, @DateiName, 0 )
      ELSE
         'Auch die tiefergehende Routine schlägt fehl, Bild einlesen geht nicht!
         Schreibe("kann die Datei " & DateiName & " nicht einlesen, breche ab")
         END
      END IF
   ELSE
      BildZeiger = FreeImage_Load( Ergebnis, @DateiName, 0 )
   END IF
   'Nun steht das Bild im FreeImageFormat im Ram an Adresse BildZeiger

   'eine Kopie davon mit 32-bit Farbtiefe erstellen
   DIM AS FIBITMAP Ptr BildZeiger32bit
   BildZeiger32bit = FreeImage_ConvertTo32Bits( BildZeiger )
   'Pointer/Zeiger auf das Erste Pixel im Ram holen
   DIM AS BYTE PTR PixelImRam, RamPixelKopie
   PixelImRam = FreeImage_GetBits( BildZeiger32bit )
   RamPixelKopie = PixelImRam
   'Bildbreite/Hoehe in Pixel holen
    Breite = FreeImage_GetWidth(BildZeiger32bit)
    Hoehe = FreeImage_GetHeight(BildZeiger32bit)
   IF (Breite <> Hoehe) OR (Breite <> 64 AND Breite <> 128 AND Breite <> 256) THEN
      'Das Bild kann nicht als Textur für OpenGL 1.0 verwendet werden
      SCHREIBE("Das Bild " & DateiName & "kann nicht als Textur für OpenGL 1.0 verwendet werden")
      SCHREIBE("           Das Bild ist entweder nicht quadratisch, oder ")
      SCHREIBE("           die Seitenlängen sind nicht 64, 128 oder 256 Pixel!")
      SCHREIBE("           Breche ab!")
      'Ramspeicher von FreeImage freigeben
      FreeImage_Unload(BildZeiger)
      FreeImage_Unload(BildZeiger32bit)
      END
   END IF
   'ROT UND BLAU TAUSCHEN
   FOR ZeilenZaehler = 0 TO Hoehe-1
      FOR PunktZaehler = 0 TO Breite-1
         BlauWert = RamPixelKopie[0]        :'aus Ram das Byte mit dem Blauwert des grad zu bearbeitenden Pixels holen
         RotWert  = RamPixelKopie[2]        :'aus Ram das Byte mit dem Rotwert des grad zu bearbeitenden Pixels holen
         RamPixelKopie[0] = RotWert         :'den Rotwert an die Stelle des Blauwertes im RAM schreiben
         RamPixelKopie[2] = BlauWert        :'den Blauwert an die Stelle des Rotwertes im RAM schreiben
         RamPixelKopie = RamPixelKopie+4 :'Ram-Adresse um 4 bytes erhöhen = Start Pixeldaten des nächsten Pixels
      NEXT PunktZaehler
   NEXT ZeilenZaehler
   'Farbtiefe des OpenGL-Fensters holen
   DIM AS INTEGER FensterFarbTiefe
   SCREENCONTROL 5, FensterFarbTiefe :' 5 = GET_SCREEN_DEPTH : Farbtiefe in Bits des OpenGL-Fensters ermitteln
   'XXXXXXXXXXXXXXXXXXXXX UND RAM-BILD AN OPENGL ÜBERGEBRN XXXXXXXXXXXXXXXX
   glGenTextures 1, @TexturNummer
   glBindTexture GL_TEXTURE_2D, TexturNummer
   IF FensterFarbTiefe = 32 OR FensterFarbTiefe = 24 THEN
      glTexImage2D GL_TEXTURE_2D, 0, GL_RGBA, Breite, Hoehe, 0, GL_RGBA, GL_UNSIGNED_BYTE, PixelImRam
   ELSE
      glTexImage2D GL_TEXTURE_2D, 0, GL_RGB, Breite, Hoehe, 0, GL_RGBA, GL_UNSIGNED_BYTE, PixelImRam
   END IF
   glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR
   glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR
   'die von FreeImage belegten Bildspeicher wieder freigeben
   FreeImage_Unload(BildZeiger)
   FreeImage_Unload(BildZeiger32bit)
   'als Funktionsrückgabe den Namen/Nummer der OpenGL-Textur setzen
   BildToOgl=TexturNummer
END FUNCTION
'-------------------
SUB Schreibe(Text AS STRING)
   DIM AS INTEGER DateiNummer
   'AUF DEN MONITOR IN DIE TEXTCONSOLE
   DateiNummer=FREEFILE
   OPEN "CONS" FOR OUTPUT AS #DateiNummer
   PRINT #DateiNummer, Text
   CLOSE #DateiNummer
   'NOCHMAL IN EINE DATEI
   DateiNummer=FREEFILE
   OPEN "Protokoll.txt" FOR APPEND AS #DateiNummer
   PRINT #DateiNummer, DATE & " " & TIME & " " & Text
   CLOSE #DateiNummer
END SUB

 

Gehe zu Seite Gehe zu Seite  1  2  3  4  5  6  
Zusätzliche Informationen und Funktionen
  • Das Tutorial wurde am 28.09.2008 von MitgliedEastler_dart angelegt.
  • Die aktuellste Version wurde am 30.09.2008 von MitgliedEastler_dart gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen