Lightmapper für Terrains
Übersicht
BlitzBasic Codearchiv
|
NoobodyBetreff: Lightmapper für Terrains |
 Mo, Mai 11, 2009 23:01Antworten mit Zitat 
|
|---|---|---|
|
Nach einer kleinen Idee von mir habe ich einen simplen Lightmapper geschrieben, der aus einer Heightmap und Informationen über die Lichposition eine entsprechende Lightmap generiert.
Diese kann man dazu verwenden, Terrains ohne Performanceverlust zu schattieren und so schönere und realistischere Ergebnisse zu erzielen als ohne Schatten.  +  = 
Der Code: [AUSKLAPPEN] Dim MapHeight#( 0, 0 )
Dim ShadowMap( 0, 0 ) Global AmbientShade = 50, ShadowShade = 30, ShadeMultiply# = 20 ;Mit diesen Werten kann man die Farbwerte beeinflussen ;AmbientShade = Hintergrundhelligkeit, ShadowShade = Schattenhelligkeit, ShadeMultiply = Intensität der Schattierungen Function CreateLightmap( HeightMapPath$, LightX, LightY, LightHeight# ) Local HeightMap = LoadImage( HeightMapPath$ ) If HeightMap Then Local MapWidth = ImageWidth( HeightMap ) Local MapDepth = ImageHeight( HeightMap ) Dim MapHeight( MapWidth - 1, MapDepth - 1 ) Dim ShadowMap( MapWidth - 1, MapDepth - 1 ) LockBuffer ImageBuffer( HeightMap ) ;Heightmap für schnelleren Zugriff in ein Array zwischenspeichern, Höhe ist dabei im Bereich 0-1 For X = 0 To MapWidth - 1 For Y = 0 To MapDepth - 1 MapHeight( X, Y ) = ( ReadPixelFast( X, Y, ImageBuffer( HeightMap ) ) And $FF )/255. Next Next FreeImage HeightMap For X = 1 To MapWidth - 1 For Y = 1 To MapDepth - 1 ;Jeden Punkt der Heightmap überprüfen, ob zwischen diesem Punkt und dem Licht ein höherer Hügel liegt - wenn ja, Schatten setzen If RayTerrainIntersect( LightX, LightY, X, Y, LightHeight# ) Then ShadowMap( X, Y ) = ShadowShade Else ;Scheinbar ist der Weg frei, wir müssen also die Schattierung berechnen VX# = X - LightX ;Vektor von Licht zu Punkt auf der Heightmap VY# = LightHeight# - MapHeight( X, Y ) VZ# = Y - LightY TFormNormal VX#, VY#, VZ#, 0, 0 ;Vektor normalisieren VX# = TFormedX() VY# = TFormedY() VZ# = TFormedZ() DHeight1# = MapHeight( X - 1, Y ) - MapHeight( X, Y ) ;Normale des Terrains in diesem Punkt berechnen DHeight2# = MapHeight( X, Y - 1 ) - MapHeight( X, Y ) NX# = -DHeight1# ;Gekürzte Version des Kreuzprodukts der Vektoren nach links und nach oben auf der Heightmap NY# = 1 NZ# = -DHeight2# TFormNormal NX#, NY#, NZ#, 0, 0 ;Vektor normalisieren ;Skalarprodukt zwischen Licht-Punkt-Vektor und Normalenvektor berechnen und daraus die Schattierungsfarbe berechnen ShadowMap( X, Y ) = Floor( 255*( TFormedX()*VX# + TFormedY()*VY# + TFormedZ()*VZ# )*ShadeMultiply# ) + AmbientShade ;Die Farbe kann nach der Berechnung ausserhalb des gültigen Bereichs liegen, das wird behoben If ShadowMap( X, Y ) > 255 Then ShadowMap( X, Y ) = 255 ElseIf ShadowMap( X, Y ) < 0 Then ShadowMap( X, Y ) = 0 EndIf Next Next ShadowImage = CreateImage( MapWidth, MapDepth ) ;Schattenbild kreieren und zeichnen lassen LockBuffer ImageBuffer( ShadowImage ) For X = 0 To MapWidth - 1 For Y = 0 To MapDepth - 1 WritePixelFast X, Y, ShadowMap( X, Y )*$010101, ImageBuffer( ShadowImage ) Next Next UnlockBuffer ImageBuffer( ShadowImage ) Return ShadowImage ;Endprodukt zurückgeben Else ;Heightmap konnte nicht geladen werden? Pech! RuntimeError "Heightmap does not exist!" EndIf End Function Function RayTerrainIntersect( X1, Y1, X2, Y2, StartHeight# ) Local DX = X2 - X1 ;Good ol' Bresenham - Code ist von der Wikipedia Local DY = Y2 - Y1 Local ADX = Abs( DX ) Local ADY = Abs( DY ) Local SDX = Sgn( DX ) Local SDY = Sgn( DY ) If ADX > ADY Then Local PDX = SDX Local PDY = 0 Local DDX = SDX Local DDY = SDY Local ErrorFast = ADY Local ErrorSlow = ADX Else PDX = 0 PDY = SDY DDX = SDX DDY = SDY ErrorFast = ADX ErrorSlow = ADY EndIf Local X = X1 Local Y = Y1 Local Error = ErrorSlow/2 For i = 1 To ErrorSlow Error = Error - ErrorFast If Error < 0 Then Error = Error + ErrorSlow X = X + DDX Y = Y + DDY Else X = X + PDX Y = Y + PDY EndIf Local Height# = ( ErrorSlow - i )/Float( ErrorSlow )*StartHeight# + MapHeight( X2, Y2 ) If MapHeight#( X, Y ) > Height# Then Return True Next Return False End Function Der Code an sich macht noch nichts und stellt nur die Funktionen zur Verwendung. Zur Veranschaulichung habe ich aber ein kleines Beispiel mit einer Heightmap und einer Textur erstellt, die die Verwendung demonstriert: Download Mit Linksklick kann man die Position des Lichtes setzen. Im Beispiel beschränkt sich das ganze auf 2D (die Bilder werden von Hand miteinander multipliziert). Ich kann aber noch eine kleine Szene in 3D schreiben, die das direkt auf einem Terrain zeigt, wenn Interesse besteht. |
||
| Man is the best computer we can put aboard a spacecraft ... and the only one that can be mass produced with unskilled labor. -- Wernher von Braun | ||
|
XeresModerator |
Mo, Mai 11, 2009 23:22 Antworten mit Zitat
|
|---|---|---|
|
Ich wette, dass Noobody vor einiger zeit gestorben ist und sein selbst geschriebener Bot sich weiterhin Projekte sucht und nach Fertigstellung automatisch ins Forum stellt...
Sieht mal wieder gut aus 
|
||
|
Win10 Prof.(x64)/Ubuntu 16.04|CPU 4x3Ghz (Intel i5-4590S)|RAM 8 GB|GeForce GTX 960
Wie man Fragen richtig stellt || "Es geht nicht" || Video-Tutorial: Sinus & Cosinus THERE IS NO FAIR. THERE IS NO JUSTICE. THERE IS JUST ME. (Death, Discworld) |
||
mDaveBetreff: Re: Lightmapper für Terrains |
Di, Mai 12, 2009 6:17 Antworten mit Zitat
|
|
|---|---|---|
|
Hi Noobody,
sieht allein vom Anblick schon umwerfend aus! Noobody hat Folgendes geschrieben: Ich kann aber noch eine kleine Szene in 3D schreiben, die das direkt auf einem Terrain zeigt, wenn Interesse besteht.  Interresse besteht 
Ich bin mal gespannt was als Nächstes kommt. Deine Codes sind einfach phänomenal! Und dabei wünsch ich dir noch viel Spaß,Glück und Erfolg! =) Mfg mDave |
||
|
Nicdel |
Di, Mai 12, 2009 13:17 Antworten mit Zitat
|
|---|---|---|
|
@Noobody: Mit welchem Programm ist die Terraintextur gemacht?Die sieht gut aus.
@Topic: Eine sehr schöne Sache! sicher nützlich, ich würde es auch gerne mal in 3D sehen. Edit: Habs mal schnell in 3D umgeschrieben. Kann sein, dass noch Fehler drin sind: BlitzBasic: [AUSKLAPPEN]
|
||
|
kriD |
Di, Mai 12, 2009 14:46 Antworten mit Zitat
|
|---|---|---|
|
sieht cool aus.. nur ein wenig dunkel, oder?
geile idee, Xeres 
lg kriD |
||
| Wenn ich du wäre, wäre ich lieber ich! | ||
|
ozzi789 |
Di, Mai 12, 2009 15:20 Antworten mit Zitat
|
|---|---|---|
|
NicdelCode: [AUSKLAPPEN] --------------------------- Runtime Error --------------------------- Array index out of bounds --------------------------- OK --------------------------- @If MapHeight#( X, Y ) > Height# Then Return True |
||
|
0x2B || ! 0x2B
C# | C++13 | Java 7 | PHP 5 |
||
|
|
Nicdel |
Di, Mai 12, 2009 15:23 Antworten mit Zitat
|
|---|---|---|
|
Ist mir auch aufgefallen, ich habs verbessert und noch etwas verschnellert. (Lightmap nur noch 128x128)
BlitzBasic: [AUSKLAPPEN]
|
||
|
Desktop: Intel Pentium 4 2650 Mhz, 2 GB RAM, ATI Radeon HD 3850 512 MB, Windows XP
Notebook: Intel Core i7 720 QM 1.6 Ghz, 4 GB DDR3 RAM, nVidia 230M GT, Windows 7 |
||
|
|
ozzi789 |
Di, Mai 12, 2009 15:37 Antworten mit Zitat
|
|---|---|---|
|
Sieht cool aus, läuft auch flüssig!
(jedenfalls auf meiner kiste )
jedoch hatte ich 2-3 mal einen komischen gelben strich durch den ganzen Schirm Oo |
||
|
0x2B || ! 0x2B
C# | C++13 | Java 7 | PHP 5 |
||
|
|
Noobody |
Di, Mai 12, 2009 16:17 Antworten mit Zitat
|
|---|---|---|
|
Xeres hat Folgendes geschrieben: Ich wette, dass Noobody vor einiger zeit gestorben ist und sein selbst geschriebener Bot sich weiterhin Projekte sucht und nach Fertigstellung automatisch ins Forum stellt...
Ich bin entdeckt! Muss... terminieren.... *zzzzt* Nicdel hat Folgendes geschrieben: Mit welchem Programm ist die Terraintextur gemacht?Die sieht gut aus.
Die ist nicht von mir, sondern von dieser Seite. Es war sehr schwierig, eine Heightmap mit einer passenden Textur zu finden, auf der die Schatten noch nicht eingezeichnet sind. Irgendwann bin ich dann auf das hier gestossen, aber wirklich glücklich bin ich nicht damit (die Heightmap ist JPG, weswegen es manchmal schwarze Pixel(streifen) gibt, da die Kompression von JPG fehlerbehaftet ist). kriD hat Folgendes geschrieben: sieht cool aus.. nur ein wenig dunkel, oder?
Das kann ich immer schlecht einschätzen, da hier am Laptop - Display die Farben immer komplett anders aussehen als auf anderen Bildschirmen 
Du kannst aber mit den beiden Globalen AmbientShade und ShadeMultiply rumspielen, bis die Helligkeit stimmt. Ich habe selber mal eine kleine Version in 3D gemacht, um die Verwendung der Lightmap mit Multitexturing zu zeigen. Der Code: [AUSKLAPPEN] Const GWIDTH = 800
Const GHEIGHT = 600 Graphics3D GWIDTH, GHEIGHT, 0, 2 SetBuffer BackBuffer() Dim MapHeight#( 0, 0 ) Dim ShadowMap#( 0, 0 ) Global AmbientShade = 100, ShadowShade = 30, ShadeMultiply# = 20 ;Mit diesen Werten kann man die Farbwerte beeinflussen ;AmbientShade = Hintergrundhelligkeit, ShadowShade = Schattenhelligkeit, ShadeMultiply = Intensität der Schattierungen Global Lightmap ;Die Textur der Lightmap Local Cam = CreateCamera() ;Wir wollen ja was sehen PositionEntity Cam, 0, 0, 5 TurnEntity Cam, 90, 0, 0 InitTerrain() ;Terrain erstellen, texturieren etc. Local Timer = CreateTimer( 60 ) ;Gebt 100% Auslastung keine Chance >:O MouseXSpeed() ;Tut man das nicht, ist die Kamera anfangs eigenartig gedreht. MouseYSpeed() While Not KeyHit( 1 ) RenderWorld TurnEntity Cam, MouseYSpeed(), -MouseXSpeed(), 0 ;RotateEntity Cam, EntityPitch( Cam ), EntityYaw( Cam ), 0 MoveMouse 400, 300 MoveEntity Cam, ( KeyDown( 32 ) - KeyDown( 30 ) )*0.5, 0, ( KeyDown( 17 ) - KeyDown( 31 ) )*0.5 If KeyHit( 57 ) Then CreateLightmap( "Heightmap.jpg", Rand( 0, 256 ), Rand( 0, 256 ), 1.5, Lightmap ) Flip 0 WaitTimer Timer Wend End Function InitTerrain() Terrain = LoadTerrain( "Heightmap.jpg" ) ;Terrain laden Texture = LoadTexture( "Texture.png" ) ;Textur laden Lightmap = CreateLightmap( "Heightmap.jpg", 50, 50, 1.5 ) ;Lightmap generieren TextureBlend Lightmap, 5 ;Blend 5 macht sich für Lightmaps imho besser als 2 ScaleTexture Texture, TextureWidth( Texture ), TextureHeight( Texture ) ScaleTexture Lightmap, TextureWidth( Texture ), TextureHeight( Texture ) EntityTexture Terrain, Texture, 0, 0 EntityTexture Terrain, Lightmap, 0, 1 ScaleEntity Terrain, 0.2, 4, 0.2 PositionEntity Terrain, -25.6, -50, -25.6 ;Das grenzt schon an Hardcoding. Schlagt mich. End Function Function CreateLightmap( HeightMapPath$, LightX, LightY, LightHeight#, ShadowTexture = 0 ) ;Falls man beim letzten Parameter eine bestehende Textur angibt, wird keine neue erstellt. Local HeightMap = LoadImage( HeightMapPath$ ) If HeightMap Then Local MapWidth = ImageWidth( HeightMap ) Local MapDepth = ImageHeight( HeightMap ) Dim MapHeight( MapWidth - 1, MapDepth - 1 ) Dim ShadowMap( MapWidth - 1, MapDepth - 1 ) LockBuffer ImageBuffer( HeightMap ) ;Heightmap für schnelleren Zugriff in ein Array zwischenspeichern, Höhe ist dabei im Bereich 0-1 For X = 0 To MapWidth - 1 For Y = 0 To MapDepth - 1 MapHeight( X, Y ) = ( ReadPixelFast( X, Y, ImageBuffer( HeightMap ) ) And $FF )/255. Next Next FreeImage HeightMap For X = 1 To MapWidth - 1 For Y = 1 To MapDepth - 1 ;Jeden Punkt der Heightmap überprüfen, ob zwischen diesem Punkt und dem Licht ein höherer Hügel liegt - wenn ja, Schatten setzen If RayTerrainIntersect( LightX, LightY, X, Y, LightHeight# ) Then ShadowMap( X, Y ) = ShadowShade Else ;Scheinbar ist der Weg frei, wir müssen also die Schattierung berechnen VX# = X - LightX ;Vektor von Licht zu Punkt auf der Heightmap VY# = LightHeight# - MapHeight( X, Y ) VZ# = Y - LightY TFormNormal VX#, VY#, VZ#, 0, 0 ;Vektor normalisieren VX# = TFormedX() VY# = TFormedY() VZ# = TFormedZ() DHeight1# = MapHeight( X - 1, Y ) - MapHeight( X, Y ) ;Normale des Terrains in diesem Punkt berechnen DHeight2# = MapHeight( X, Y - 1 ) - MapHeight( X, Y ) NX# = -DHeight1# ;Gekürzte Version des Kreuzprodukts der Vektoren nach links und nach oben auf der Heightmap NY# = 1 NZ# = -DHeight2# TFormNormal NX#, NY#, NZ#, 0, 0 ;Vektor normalisieren ;Skalarprodukt zwischen Licht-Punkt-Vektor und Normalenvektor berechnen und daraus die Schattierungsfarbe berechnen ShadowMap( X, Y ) = Floor( 255*( TFormedX()*VX# + TFormedY()*VY# + TFormedZ()*VZ# )*ShadeMultiply# ) + AmbientShade ;Die Farbe kann nach der Berechnung ausserhalb des gültigen Bereichs liegen, das wird behoben If ShadowMap( X, Y ) > 255 Then ShadowMap( X, Y ) = 255 ElseIf ShadowMap( X, Y ) < 0 Then ShadowMap( X, Y ) = 0 EndIf Next Next If Not ShadowTexture Then ShadowTexture = CreateTexture( MapWidth, MapDepth ) ;Schattenbild kreieren und zeichnen lassen LockBuffer TextureBuffer( ShadowTexture ) For X = 0 To MapWidth - 1 For Y = 0 To MapDepth - 1 WritePixelFast X, Y, ShadowMap( X, Y )*$010101, TextureBuffer( ShadowTexture ) Next Next UnlockBuffer TextureBuffer( ShadowTexture ) Return ShadowTexture ;Endprodukt zurückgeben Else ;Heightmap konnte nicht geladen werden? Pech! RuntimeError "Heightmap does not exist!" EndIf End Function Function RayTerrainIntersect( X1, Y1, X2, Y2, StartHeight# ) Local DX = X2 - X1 ;Good ol' Bresenham - Code ist von der Wikipedia Local DY = Y2 - Y1 Local ADX = Abs( DX ) Local ADY = Abs( DY ) Local SDX = Sgn( DX ) Local SDY = Sgn( DY ) If ADX > ADY Then Local PDX = SDX Local PDY = 0 Local DDX = SDX Local DDY = SDY Local ErrorFast = ADY Local ErrorSlow = ADX Else PDX = 0 PDY = SDY DDX = SDX DDY = SDY ErrorFast = ADX ErrorSlow = ADY EndIf Local X = X1 Local Y = Y1 Local Error = ErrorSlow/2 For i = 1 To ErrorSlow Error = Error - ErrorFast If Error < 0 Then Error = Error + ErrorSlow X = X + DDX Y = Y + DDY Else X = X + PDX Y = Y + PDY EndIf Local Height# = ( ErrorSlow - i )/Float( ErrorSlow )*StartHeight# + MapHeight( X2, Y2 ) If MapHeight#( X, Y ) > Height# Then Return True Next Return False End Function Mit WASD und Maus die Kamera bewegen, mit der Leertaste kann man ausserdem eine neue Lightmap generieren lassen. Die Texturen bleiben die gleichen wie beim alten Code, trotzdem aber ein kleines Paket mit .exe, Texturen und Source: Download |
||
| Man is the best computer we can put aboard a spacecraft ... and the only one that can be mass produced with unskilled labor. -- Wernher von Braun | ||
|
|
ozzi789 |
Di, Mai 12, 2009 17:26 Antworten mit Zitat
|
|---|---|---|
Sieht ein wenig besser aus als Nidcels Version 
Aber bitte, die Steuerung ist grausam Oo ich hab Kopfweh und schlagen muss ich dich auch noch
;Das grenzt schon an Hardcoding. Schlagt mich. |
||
|
0x2B || ! 0x2B
C# | C++13 | Java 7 | PHP 5 |
||
|
|
Nicdel |
Di, Mai 12, 2009 17:32 Antworten mit Zitat
|
|---|---|---|
Ja, sieht besser aus. Meins war nur schnell zusammengecodet. 
Das mit dem Schlagen lass ich mal, werden genug andere machen...
|
||
|
Desktop: Intel Pentium 4 2650 Mhz, 2 GB RAM, ATI Radeon HD 3850 512 MB, Windows XP
Notebook: Intel Core i7 720 QM 1.6 Ghz, 4 GB DDR3 RAM, nVidia 230M GT, Windows 7 |
||
|
|
ozzi789 |
Di, Mai 12, 2009 18:05 Antworten mit Zitat
|
|---|---|---|
|
Nicdel hat Folgendes geschrieben: Ja, sieht besser aus. Meins war nur schnell zusammengecodet.
Nichts gegen deinen Code, ich könnts selber nicht besser 
|
||
|
0x2B || ! 0x2B
C# | C++13 | Java 7 | PHP 5 |
||
KaDuZa |
Di, Mai 12, 2009 23:20 Antworten mit Zitat
|
|
|---|---|---|
|
hast du das usenet enwtickelt??^^
meinen respect |
||
|
DAK |
Do, Mai 14, 2009 11:03 Antworten mit Zitat
|
|---|---|---|
|
da hier n paar leute gemeint haben, dass ma nirgendst wo gscheide texturen für terrains herkriegt, die nicht gelightmappt sind, hab ich mal n kleines prog geschrieben, dass das ganze erledigt.
(das ergebnis is natürlich nicht so gut, wie die texur, die noobody da hat, aber dafür, dass ich das mal einfach so schnell hingeschrieben hab, bin ich ganz zufrieden) download: https://www.blitzforum.de/upload/file.php?id=5515 bedienung: das zeug braucht als input 4 texturen (3 höhenstufen + wassertextur) und eine bearbeitete heightmap bearbeitet heißt, dass für die geländehöhe nur der rotkanal verwendet werden darf. der blaukanal gibt die wassertiefe an dem jeweiligen ort an. dabei wird wasser je nach tiefe automatisch ins gelände 'eingefräst'. falls das ergebnis nicht zufriedenstellend is, spielts doch mal ein wenig mit den konstanten werten am anfang des programms herum. mid_high gibt den oberen rand an, ab dem die mittlere textur verwendet wird mid_low gibt den unteren rand an uebergangsbreite# gibt an, über welche distanz 2 texturen gemischt werden. wassertiefe# ist wohl relativ klar scale# gibt an, wie viel mal die ausgegebene textur größer ist, als das terrain. dadurch kann man genauere texturen erstellen (4 oder 8 ist meist genug, drüber wird die textur normalerweise ziemlich groß und braucht ewig zum berechnen.) ich hab auch noch noobodys genialen lightmapper dazugepackt. der funktioniert allerdings nur, wenn das terrain und die textur gleich groß sind (scale#=1). |
||
| Gewinner der 6. und der 68. BlitzCodeCompo | ||
|
mpmxyzBetreff: Richtungslichter |
Mi, Jun 17, 2009 18:30 Antworten mit Zitat
|
|---|---|---|
|
Moin Moin,
der Thread ist zwar schon leicht angealtert, aber ich möchte unbedingt noch einen Code für Richtungslichter mit Schatten posten: Die Basis für die Helligkeitsberechnung in Abhängigkeit zu den Winkeln von Licht und Boden war Noobodys Code. Sein Code kam mir zur Vollendung ganz recht.
Code: Code: [AUSKLAPPEN] Dim Tested(0,0)
Function LoadHighMap(Filename$);Zum Beschleunigen der Berechnungen werden die Bilder in Banks eingelesen. Local TEMPIMG=LoadImage(Filename$) Local IW=ImageWidth(TEMPIMG),IH=ImageHeight(TEMPIMG) Local Bank=CreateBank(IW*IH*4+4) Local ZWX,ZWY Local IB=ImageBuffer(TEMPIMG) LockBuffer IB For ZWX=0 To IW-1 For ZWY=0 To IH-1 PokeInt(Bank,(ZWX+ZWY*IW)Shl 2,ReadPixelFast(ZWX,ZWY,IB)) Next Next UnlockBuffer IB FreeImage TEMPIMG PokeInt Bank,IW*IH*4,IW Return Bank End Function Function LoadColorMap(Filename$) Local TEMPIMG=LoadImage(Filename$) Local IW=ImageWidth(TEMPIMG),IH=ImageHeight(TEMPIMG) Local Bank=CreateBank(IW*IH*4+4) Local ZWX,ZWY Local IB=ImageBuffer(TEMPIMG) LockBuffer IB For ZWX=0 To IW-1 For ZWY=0 To IH-1 PokeInt(Bank,(ZWX+ZWY*IW)Shl 2,ReadPixelFast(ZWX,ZWY,IB)) Next Next UnlockBuffer IB FreeImage TEMPIMG PokeInt Bank,IW*IH*4,IW Return Bank End Function Function CreateLightMap(Width,Height);Jeder Pixel einer LightMap besteht aus 3 Floats (R,G,B) Local Bank=CreateBank(Width*Height*4*3+4) PokeInt Bank,Width*Height*4*3,Width Return Bank End Function Function DrawColorMap(ColorMap,LightMap,X,Y);Hier wird die Colormap mit der Lightmap kombiniert und eingezeichnet; Achtung: Writepixelfast inside! Local IW=PeekInt(ColorMap,BankSize(ColorMap)-4),IH=(BankSize(ColorMap)-4)/IW/4 Local ZWX,ZWY,RGB,A,R,G,B,FR#,FG#,FB# Local STX=X,ENX=X+IW-1 Local STY=Y,ENY=Y+IH-1 If STX<0 Then STX=0 If ENX>=GraphicsWidth() And (GraphicsBuffer()=BackBuffer() Or GraphicsBuffer()=FrontBuffer()) Then ENX=GraphicsWidth()-1 If STY<0 Then STY=0 If ENY>=GraphicsHeight() And (GraphicsBuffer()=BackBuffer() Or GraphicsBuffer()=FrontBuffer()) Then ENY=GraphicsHeight()-1 STX=STX-X ENX=ENX-X STY=STY-Y ENY=ENY-Y LockBuffer For ZWX=STX To ENX For ZWY=STY To ENY RGB=PeekInt(ColorMap,(ZWX+ZWY*IW)Shl 2) FR=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) If FR>1 Then FR=1 FG=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) If FG>1 Then FG=1 FB=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) If FB>1 Then FB=1 A=RGB Shr 24 R=(((RGB Shr 16) And $FF)*FR)And $FF G=(((RGB Shr 8) And $FF)*FG)And $FF B=((RGB And $FF)*FB)And $FF RGB=(A Shl 24) Or (R Shl 16) Or (G Shl 8) Or B WritePixelFast ZWX+X,ZWY+Y,RGB Next Next UnlockBuffer End Function Function DrawLightMap(LightMap,X,Y);Hier wird nur die Lightmap gezeichnet, um sie zum Beispiel als Bild speichern zu können.;Auch Achtung: WritePixelFast inside! Local ZWX,ZWY,RGB,A,R,G,B,FR#,FG#,FB# Local IW=PeekInt(LightMap,BankSize(LightMap)-4),IH=(BankSize(LightMap)-4)/IW/4/3 Local STX=X,ENX=X+IW-1 Local STY=Y,ENY=Y+IH-1 LockBuffer If STX<0 Then STX=0 If ENX>=GraphicsWidth() And (GraphicsBuffer()=BackBuffer() Or GraphicsBuffer()=FrontBuffer()) Then ENX=GraphicsWidth()-1 If STY<0 Then STY=0 If ENY>=GraphicsHeight() And (GraphicsBuffer()=BackBuffer() Or GraphicsBuffer()=FrontBuffer()) Then ENY=GraphicsHeight()-1 For ZWX=STX To ENX For ZWY=STY To ENY R=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3)*255 If R>255 Then R=255 G=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4)*255 If G>255 Then G=255 B=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8)*255 If B>255 Then B=255 RGB=(R Shl 16) Or (G Shl 8) Or B WritePixelFast ZWX+X,ZWY+Y,RGB Next Next UnlockBuffer End Function Function ResetLightning(LightMap,ValueR#=0,ValueG#=0,ValueB#=0);Hier wird die Lightmap zurückgesetzt Local ZW For ZW=0 To BankSize(LightMap)-4-12 Step 12 PokeFloat LightMap,ZW,ValueR# PokeFloat LightMap,ZW+4,ValueG# PokeFloat LightMap,ZW+8,ValueB# Next End Function Function AddLightMap(DestLightMap,SourceLightMap);Hiermit kann man Lightmaps miteinander addieren. If BankSize(DestLightMap)<>BankSize(SourceLightMap) Then Return Local ZW,Temp# For ZW=0 To BankSize(DestLightMap)-8 Step 4 Temp#=PeekFloat(DestLightMap,ZW)+PeekFloat(SourceLightMap,ZW) If Temp#>1 Then Temp#=1 If Temp#<0 Then Temp#=0 PokeFloat DestLightMap,ZW,Temp# Next End Function Function Shade1(LightMap,HighMap,LightRXY#,LightRZ#,LightR#=1,LightG#=1,LightB#=1);Dies ist die eigentliche Funktion Local IW=PeekInt(LightMap,BankSize(LightMap)-4),IH=(BankSize(LightMap)-4)/IW/4/3 Local ZWX,ZWY Dim Tested(IW-1,IH-1);Beugt doppelter Bearbeitung und damit Artefakten vor. If LightRZ#>90 LightRZ#=180-LightRZ# LightRXY#=LightRXY#+180 EndIf If LightRZ#=90 Then LightRZ#=89.9999;Mit +/-Infinity funktioniert der Code nicht. Local XF#,YF#,ZF#;Momentane Position des Lichtes,ZF ist dabei auf der Höhe der Grenze zwischen Licht und Schatten oder, wenn es keinen Schatten gibt, dann auf der Höhe des Bodens. Local XST#,YST#;Schleifenvariablen mit der Position am Startrand. Local XS#=Sin(LightRXY),YS#=-Cos(LightRXY),ZS#=-Tan(LightRZ);"Bewegungsrichtung" des Lichtes XY-Geschwindigkeit=1 Local MXS#,MYS#,MZS#,MVE#;Hier ist die Geschwindigkeit des Lichtes pro Durchlauf angegeben. Local MZ#;Die aktuelle Höhe der Ebene Local TempInt Local TempR#,TempG#,TempB#;Die momentanen Werte der Lightmap Local LF#;Die Einstrahlungsstärke, abhängig von den Winkeln von Strahlung und Boden. If YS>0;Hier werden die Berechnungen linienweise von den Rändern aus in Lichtrichtung ausgeführt. MXS#=XS/YS MYS#=1 If Abs(MXS)>1 MYS=MYS/Abs(MXS) MXS=Sgn(MXS) EndIf MVE#=Sqr(MXS^2+MYS^2) MZS#=ZS*MVE For XST=0 To IW-1 XF=XST YF=0 ZF=0 While Int(XF)>=0 And Int(XF)<IW And Int(YF)>=0 And Int(YF)<IH ZWX=XF ZWY=YF TempInt=PeekInt(HighMap,(ZWX+ZWY*IW)Shl 2) TempR#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) TempG#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) TempB#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) If (TempInt And $100000)=0;<-durchsichtig und leuchtend MZ#=(TempInt And $FFFFF)/256.0 If ZF<=MZ;kein Schatten LF#=LightFactor#(ZWX+MXS,ZWY+MYS,MZ#+MZS,ZWX,ZWY,HighMap) TempR#=TempR#+LF#*LightR# TempG#=TempG#+LF#*LightG# TempB#=TempB#+LF#*LightB# ZF=MZ EndIf If TempR#>1 Then TempR#=1 If TempR#<0 Then TempR#=0 If TempG#>1 Then TempG#=1 If TempG#<0 Then TempG#=0 If TempB#>1 Then TempB#=1 If TempB#<0 Then TempB#=0 If Tested(ZWX,ZWY)=0 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,TempR# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,TempG# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,TempB# Tested(ZWX,ZWY)=1 EndIf Else PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,1 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,1 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,1 EndIf XF=XF+MXS YF=YF+MYS ZF=ZF+MZS Wend Next ElseIf YS<0 MXS#=-XS/YS MYS#=-1 If Abs(MXS)>1 MYS=MYS/Abs(MXS) MXS=Sgn(MXS) EndIf MVE#=Sqr(MXS^2+MYS^2) MZS#=ZS*MVE For XST=0 To IW-1 XF=XST YF=IH-1 ZF=0 While Int(XF)>=0 And Int(XF)<IW And Int(YF)>=0 And Int(YF)<IH ZWX=XF ZWY=YF TempInt=PeekInt(HighMap,(ZWX+ZWY*IW)Shl 2) If (TempInt And $100000)=0;<-durchsichtig und leuchtend TempR#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) TempG#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) TempB#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) MZ#=(TempInt And $FFFFF)/256.0 If ZF<=MZ;kein Schatten LF#=LightFactor#(ZWX+MXS,ZWY+MYS,MZ#+MZS,ZWX,ZWY,HighMap) TempR#=TempR#+LF#*LightR# TempG#=TempG#+LF#*LightG# TempB#=TempB#+LF#*LightB# ZF=MZ EndIf If TempR#>1 Then TempR#=1 If TempR#<0 Then TempR#=0 If TempG#>1 Then TempG#=1 If TempG#<0 Then TempG#=0 If TempB#>1 Then TempB#=1 If TempB#<0 Then TempB#=0 If Tested(ZWX,ZWY)=0 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,TempR# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,TempG# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,TempB# Tested(ZWX,ZWY)=1 EndIf EndIf XF=XF+MXS YF=YF+MYS ZF=ZF+MZS Wend Next EndIf If XS>0 MYS#=YS/XS MXS#=1 If Abs(MYS)>1 MXS=MXS/Abs(MYS) MYS=Sgn(MYS) EndIf MVE#=Sqr(MXS^2+MYS^2) MZS#=ZS*MVE For YST=0 To IH-1 YF=YST XF=0 ZF=0 While Int(XF)>=0 And Int(XF)<IW And Int(YF)>=0 And Int(YF)<IH ZWX=XF ZWY=YF TempInt=PeekInt(HighMap,(ZWX+ZWY*IW)Shl 2) If (TempInt And $100000)=0;<-durchsichtig und leuchtend TempR#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) TempG#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) TempB#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) MZ#=(TempInt And $FFFFF)/256.0 If ZF<=MZ;kein Schatten LF#=LightFactor#(ZWX+MXS,ZWY+MYS,MZ#+MZS,ZWX,ZWY,HighMap) TempR#=TempR#+LF#*LightR# TempG#=TempG#+LF#*LightG# TempB#=TempB#+LF#*LightB# ZF=MZ EndIf If TempR#>1 Then TempR#=1 If TempR#<0 Then TempR#=0 If TempG#>1 Then TempG#=1 If TempG#<0 Then TempG#=0 If TempB#>1 Then TempB#=1 If TempB#<0 Then TempB#=0 If Tested(ZWX,ZWY)=0 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,TempR# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,TempG# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,TempB# Tested(ZWX,ZWY)=1 EndIf EndIf XF=XF+MXS YF=YF+MYS ZF=ZF+MZS Wend Next ElseIf XS<0 MYS#=-YS/XS MXS#=-1 If Abs(MYS)>1 MXS=MXS/Abs(MYS) MYS=Sgn(MYS) EndIf MVE#=Sqr(MXS^2+MYS^2) MZS#=ZS*MVE For YST=0 To IH-1 YF=YST XF=IW-1 ZF=0 While Int(XF)>=0 And Int(XF)<IW And Int(YF)>=0 And Int(YF)<IH ZWX=XF ZWY=YF TempInt=PeekInt(HighMap,(ZWX+ZWY*IW)Shl 2) If (TempInt And $100000)=0;<-durchsichtig und leuchtend TempR#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) TempG#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) TempB#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) MZ#=(TempInt And $FFFFF)/256.0 If ZF<=MZ;kein Schatten LF#=LightFactor#(ZWX+MXS,ZWY+MYS,MZ#+MZS,ZWX,ZWY,HighMap) TempR#=TempR#+LF#*LightR# TempG#=TempG#+LF#*LightG# TempB#=TempB#+LF#*LightB# ZF=MZ EndIf If TempR#>1 Then TempR#=1 If TempR#<0 Then TempR#=0 If TempG#>1 Then TempG#=1 If TempG#<0 Then TempG#=0 If TempB#>1 Then TempB#=1 If TempB#<0 Then TempB#=0 If Tested(ZWX,ZWY)=0 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,TempR# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,TempG# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,TempB# Tested(ZWX,ZWY)=1 EndIf EndIf XF=XF+MXS YF=YF+MYS ZF=ZF+MZS Wend Next EndIf End Function Function LightFactor#(LightX#,LightY#,LightZ#,X,Y,Highmap);Dies ist eine Funktion auf der Basis von Noobodys Code. Local IW=PeekInt(Highmap,BankSize(Highmap)-4),IH=(BankSize(Highmap)-4)/IW/4 ;Code copied from http://www.blitzforum.de/forum/viewtopic.php?t=31696 ;Thanks to Noobody Local VX# = X - LightX ;Vektor von Licht zu Punkt auf der Heightmap Local VY# = LightZ# - (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 Local VZ# = Y - LightY TFormNormal VX#, -VY#, VZ#, 0, 0 ;Vektor normalisieren VX# = TFormedX() VY# = TFormedY() VZ# = TFormedZ() Local DHeight1#,DHeight2# If X<>0 DHeight1# = (PeekInt(Highmap,((X-1)+Y*IW)Shl 2)And $FFFFF)/256.0 - (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 ;Normale des Terrains in diesem Punkt berechnen Else DHeight1# = (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 - (PeekInt(Highmap,((X+1)+Y*IW)Shl 2)And $FFFFF)/256.0 EndIf If Y<>0 DHeight2# = (PeekInt(Highmap,(X+(Y-1)*IW)Shl 2)And $FFFFF)/256.0 - (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 Else DHeight2# = (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 - (PeekInt(Highmap,(X+(Y+1)*IW)Shl 2)And $FFFFF)/256.0 EndIf Local NX# = --DHeight1# ;Gekürzte Version des Kreuzprodukts der Vektoren nach links und nach oben auf der Heightmap Local NY# = 1 Local NZ# = --DHeight2# TFormNormal NX#, NY#, NZ#, 0, 0 ;Vektor normalisieren ;Skalarprodukt zwischen Licht-Punkt-Vektor und Normalenvektor berechnen und daraus die Schattierungsfarbe berechnen Local Ret#=( TFormedX()*VX# + TFormedY()*VY# + TFormedZ()*VZ# ) If Ret#<0 Then Return 0 Return Ret# End Function Hier ist ein Beispiel mit dem Code für B3D: Code: [AUSKLAPPEN] Local CMapImg$="CM2.png"
Local HMapImg$="HM2.png" Local RenderQuality Local QualitySteps#[9];weniger ist mehr:1-1681 Berechnungen,2-441,0.5-6561 QualitySteps[0]=40 QualitySteps[1]=20 QualitySteps[2]=10 QualitySteps[3]=8 QualitySteps[4]=5 QualitySteps[5]=4 QualitySteps[6]=2 QualitySteps[7]=1 QualitySteps[8]=0.5 QualitySteps[9]=0.25 Local ZW,ZW2#,ZW3# Graphics3D 1024,768,32,2 SetBuffer BackBuffer() Local CMap=LoadColorMap(CMapImg$) Local HMap=LoadColorMap(HMapImg$) Local IW=PeekInt(CMap,BankSize(CMap)-4),IH=(BankSize(CMap)-4)/IW/4 ;;;;;3D Visualisierung If (Log(IW)/Log(2))Mod 1=0 And (Log(IH)/Log(2))Mod 1=0 Local Terrain=CreateTerrain(IW) Local ZWX,ZWY For ZWX=0 To IW-1 For ZWY=0 To IH-1 ModifyTerrain Terrain,ZWX,IH-ZWY-1,Float(PeekInt(HMap,(ZWX+ZWY*IW)Shl 2) And $FFFFF)/256.0/256.0 Next Next ScaleEntity Terrain,1,256,1 TerrainDetail Terrain,10000,1 Local Texture=CreateTexture(IW,IH) ScaleTexture Texture,IW,IH EntityTexture Terrain,Texture EntityFX Terrain,16 Or 1 Or 2 Local Camera=CreateCamera() MoveEntity Camera,0,0,-100 CameraRange Camera,1,100000 PointEntity Camera,Terrain EndIf ;;;;; Local LMap=CreateLightMap(IW,IH) Local AnAus$[1] AnAus[0]="aus" AnAus[1]="an" Local K2 Local K3 Local K5#=1 Local K6#=1 Local K7#=1 Local KEnter Local Plus,Minus Local R# Repeat ;If MouseDown(1) Then ZW=ZW+1 Plus=KeyHit(27) Minus=KeyHit(53) If KeyDown(2) Then K2=(10+(K2+Plus-Minus)Mod 10)Mod 10 If KeyDown(3) Then K3=(10+(K3+Plus-Minus)Mod 10)Mod 10 If KeyDown(5) Then K5=K5+Plus*0.05-Minus*0.05 If K5<0 Then K5=0 If K5>1 Then K5=1 If KeyDown(6) Then K6=K6+Plus*0.05-Minus*0.05 If K6<0 Then K6=0 If K6>1 Then K6=1 If KeyDown(7) Then K7=K7+Plus*0.05-Minus*0.05 If K7<0 Then K7=0 If K7>1 Then K7=1 If KeyHit(28) Then KEnter=1-KEnter If KeyHit(57) Then RenderQuality=1 Else RenderQuality=0 ResetLightning(LMap) Local MX=MouseX(),MY=MouseY(),MZ=MouseZ() R#=(360+ATan2(MX-512,384-MY))Mod 360 Local Rendertimes2=RenderQuality*40/QualitySteps[K2]+1 Local Rendertimes3=RenderQuality*40/QualitySteps[K3]+1 Local Rendered=0 Local MSec=MilliSecs() For ZW2=-20*RenderQuality To 20*RenderQuality For ZW3=-20*RenderQuality To 20*RenderQuality Shade1(LMap,HMap,R#+ZW2,MZ+ZW3,K5#/Float((Rendertimes2)*(Rendertimes3)),K6#/Float((Rendertimes2)*(Rendertimes3)),K7#/Float((Rendertimes2)*(Rendertimes3))) Rendered=Rendered+1 If RenderQuality If KEnter Cls DrawColorMap(CMap,LMap,512-IW/2,384-IH/2) Text 20,20,"XY: "+MZ+"°, RZ: "+R#+"°" Text 20,35,(Int((Rendered/Float(Rendertimes2*Rendertimes3))*1000.0)/10.0)+"%" Text 20,50,"Verbleibene Zeit: "+MSecToTime$(Int((Float(Rendertimes2*Rendertimes3)-Float(Rendered))*(MilliSecs()-MSec)/Float(Rendered)*10.0)/10.0) Text 750,20,"XY-Qualität[1 + Plus/Minus]: "+QualitySteps[K2] Text 750,35,"RZ-Qualität[2 + Plus/Minus]: "+QualitySteps[K3] Text 750,50,"Vorschau-Rendern[Enter]: "+AnAus[KEnter] Text 750,65,"Rendern[Leertaste]: "+AnAus[RenderQuality] Text 750,80,"HelligkeitR[4 + Plus/Minus]: "+K5 Text 750,95,"HelligkeitG[5 + Plus/Minus]: "+K5 Text 750,110,"HelligkeitB[6 + Plus/Minus]: "+K5 Flip EndIf If KeyHit(1) Then RenderQuality=2:Exit EndIf ZW3=ZW3+QualitySteps[K3]-1;Variabler Step Next ZW2=ZW2+QualitySteps[K2]-1 If RenderQuality<>1 Then Exit Next MSec=MilliSecs()-MSec If RenderQuality Then RenderQuality=1 Cls DrawColorMap(CMap,LMap,512-IW/2,384-IH/2) Text 20,20,"XY: "+MZ+"°, RZ: "+R#+"°" If RenderQuality Then Text 20,35,"[Weiter mit beliebiger Taste]" Text 20,50,MSec+"ms" Text 750,20,"XY-Qualität[1 + Plus/Minus]: "+QualitySteps[K2] Text 750,35,"RZ-Qualität[2 + Plus/Minus]: "+QualitySteps[K3] Text 750,50,"Vorschau-Rendern[Enter]: "+AnAus[KEnter] Text 750,65,"Rendern[Leertaste]: "+AnAus[RenderQuality] Text 750,80,"HelligkeitR[4 + Plus/Minus]: "+K5 Text 750,95,"HelligkeitG[5 + Plus/Minus]: "+K6 Text 750,110,"HelligkeitB[6 + Plus/Minus]: "+K7 Text 750,125,"3D-Ansicht[3]: "+AnAus[0] Flip If RenderQuality Then FlushKeys():WaitKey() If KeyHit(4) SetBuffer TextureBuffer(Texture) DrawColorMap(CMap,LMap,0,0) SetBuffer BackBuffer() EntityTexture Terrain,Texture MouseXSpeed() MouseYSpeed() Repeat Cls Text 20,35,"[Zurück mit Escape]" If KeyDown(200) Then MoveEntity Camera,0,0,1+KeyDown(54)*9 If KeyDown(208) Then MoveEntity Camera,0,0,-1-KeyDown(54)*9 TurnEntity Camera,MouseYSpeed(),0,0 TurnEntity Camera,0,-MouseXSpeed(),0,1 MoveMouse 512,384 RenderWorld Flip Until KeyHit(1) EndIf If RenderQuality Then FlushKeys() Until KeyHit(1) End Function MSecToTime$(MSec) Return Replace(RSet(Int(Floor((MSec/1000)/3600.0)),2)+":"+RSet(Int(Floor((MSec/1000)/60.0) Mod 60),2)+":"+RSet((MSec/1000)Mod 60,2)+"."+RSet((MSec/10)Mod 100,2)," ","0") End Function ;;;;;;;;;;;;;;; Dim Tested(0,0) Function LoadHighMap(Filename$);Zum Beschleunigen der Berechnungen werden die Bilder in Banks eingelesen. Local TEMPIMG=LoadImage(Filename$) Local IW=ImageWidth(TEMPIMG),IH=ImageHeight(TEMPIMG) Local Bank=CreateBank(IW*IH*4+4) Local ZWX,ZWY Local IB=ImageBuffer(TEMPIMG) LockBuffer IB For ZWX=0 To IW-1 For ZWY=0 To IH-1 PokeInt(Bank,(ZWX+ZWY*IW)Shl 2,ReadPixelFast(ZWX,ZWY,IB)) Next Next UnlockBuffer IB FreeImage TEMPIMG PokeInt Bank,IW*IH*4,IW Return Bank End Function Function LoadColorMap(Filename$) Local TEMPIMG=LoadImage(Filename$) Local IW=ImageWidth(TEMPIMG),IH=ImageHeight(TEMPIMG) Local Bank=CreateBank(IW*IH*4+4) Local ZWX,ZWY Local IB=ImageBuffer(TEMPIMG) LockBuffer IB For ZWX=0 To IW-1 For ZWY=0 To IH-1 PokeInt(Bank,(ZWX+ZWY*IW)Shl 2,ReadPixelFast(ZWX,ZWY,IB)) Next Next UnlockBuffer IB FreeImage TEMPIMG PokeInt Bank,IW*IH*4,IW Return Bank End Function Function CreateLightMap(Width,Height);Jeder Pixel einer LightMap besteht aus 3 Floats (R,G,B) Local Bank=CreateBank(Width*Height*4*3+4) PokeInt Bank,Width*Height*4*3,Width Return Bank End Function Function DrawColorMap(ColorMap,LightMap,X,Y);Hier wird die Colormap mit der Lightmap kombiniert und eingezeichnet; Achtung: Writepixelfast inside! Local IW=PeekInt(ColorMap,BankSize(ColorMap)-4),IH=(BankSize(ColorMap)-4)/IW/4 Local ZWX,ZWY,RGB,A,R,G,B,FR#,FG#,FB# Local STX=X,ENX=X+IW-1 Local STY=Y,ENY=Y+IH-1 If STX<0 Then STX=0 If ENX>=GraphicsWidth() And (GraphicsBuffer()=BackBuffer() Or GraphicsBuffer()=FrontBuffer()) Then ENX=GraphicsWidth()-1 If STY<0 Then STY=0 If ENY>=GraphicsHeight() And (GraphicsBuffer()=BackBuffer() Or GraphicsBuffer()=FrontBuffer()) Then ENY=GraphicsHeight()-1 STX=STX-X ENX=ENX-X STY=STY-Y ENY=ENY-Y LockBuffer For ZWX=STX To ENX For ZWY=STY To ENY RGB=PeekInt(ColorMap,(ZWX+ZWY*IW)Shl 2) FR=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) If FR>1 Then FR=1 FG=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) If FG>1 Then FG=1 FB=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) If FB>1 Then FB=1 A=RGB Shr 24 R=(((RGB Shr 16) And $FF)*FR)And $FF G=(((RGB Shr 8) And $FF)*FG)And $FF B=((RGB And $FF)*FB)And $FF RGB=(A Shl 24) Or (R Shl 16) Or (G Shl 8) Or B WritePixelFast ZWX+X,ZWY+Y,RGB Next Next UnlockBuffer End Function Function DrawLightMap(LightMap,X,Y);Hier wird nur die Lightmap gezeichnet, um sie zum Beispiel als Bild speichern zu können.;Auch Achtung: WritePixelFast inside! Local ZWX,ZWY,RGB,A,R,G,B,FR#,FG#,FB# Local IW=PeekInt(LightMap,BankSize(LightMap)-4),IH=(BankSize(LightMap)-4)/IW/4/3 Local STX=X,ENX=X+IW-1 Local STY=Y,ENY=Y+IH-1 LockBuffer If STX<0 Then STX=0 If ENX>=GraphicsWidth() And (GraphicsBuffer()=BackBuffer() Or GraphicsBuffer()=FrontBuffer()) Then ENX=GraphicsWidth()-1 If STY<0 Then STY=0 If ENY>=GraphicsHeight() And (GraphicsBuffer()=BackBuffer() Or GraphicsBuffer()=FrontBuffer()) Then ENY=GraphicsHeight()-1 For ZWX=STX To ENX For ZWY=STY To ENY R=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3)*255 If R>255 Then R=255 G=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4)*255 If G>255 Then G=255 B=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8)*255 If B>255 Then B=255 RGB=(R Shl 16) Or (G Shl 8) Or B WritePixelFast ZWX+X,ZWY+Y,RGB Next Next UnlockBuffer End Function Function ResetLightning(LightMap,ValueR#=0,ValueG#=0,ValueB#=0);Hier wird die Lightmap zurückgesetzt Local ZW For ZW=0 To BankSize(LightMap)-4-12 Step 12 PokeFloat LightMap,ZW,ValueR# PokeFloat LightMap,ZW+4,ValueG# PokeFloat LightMap,ZW+8,ValueB# Next End Function Function AddLightMap(DestLightMap,SourceLightMap);Hiermit kann man Lightmaps miteinander addieren. If BankSize(DestLightMap)<>BankSize(SourceLightMap) Then Return Local ZW,Temp# For ZW=0 To BankSize(DestLightMap)-8 Step 4 Temp#=PeekFloat(DestLightMap,ZW)+PeekFloat(SourceLightMap,ZW) If Temp#>1 Then Temp#=1 If Temp#<0 Then Temp#=0 PokeFloat DestLightMap,ZW,Temp# Next End Function Function Shade1(LightMap,HighMap,LightRXY#,LightRZ#,LightR#=1,LightG#=1,LightB#=1);Dies ist die eigentliche Funktion Local IW=PeekInt(LightMap,BankSize(LightMap)-4),IH=(BankSize(LightMap)-4)/IW/4/3 Local ZWX,ZWY Dim Tested(IW-1,IH-1);Beugt doppelter Bearbeitung und damit Artefakten vor. If LightRZ#>90 LightRZ#=180-LightRZ# LightRXY#=LightRXY#+180 EndIf If LightRZ#=90 Then LightRZ#=89.9999;Mit +/-Infinity funktioniert der Code nicht. Local XF#,YF#,ZF#;Momentane Position des Lichtes,ZF ist dabei auf der Höhe der Grenze zwischen Licht und Schatten oder, wenn es keinen Schatten gibt, dann auf der Höhe des Bodens. Local XST#,YST#;Schleifenvariablen mit der Position am Startrand. Local XS#=Sin(LightRXY),YS#=-Cos(LightRXY),ZS#=-Tan(LightRZ);"Bewegungsrichtung" des Lichtes XY-Geschwindigkeit=1 Local MXS#,MYS#,MZS#,MVE#;Hier ist die Geschwindigkeit des Lichtes pro Durchlauf angegeben. Local MZ#;Die aktuelle Höhe der Ebene Local TempInt Local TempR#,TempG#,TempB#;Die momentanen Werte der Lightmap Local LF#;Die Einstrahlungsstärke, abhängig von den Winkeln von Strahlung und Boden. If YS>0;Hier werden die Berechnungen linienweise von den Rändern aus in Lichtrichtung ausgeführt. MXS#=XS/YS MYS#=1 If Abs(MXS)>1 MYS=MYS/Abs(MXS) MXS=Sgn(MXS) EndIf MVE#=Sqr(MXS^2+MYS^2) MZS#=ZS*MVE For XST=0 To IW-1 XF=XST YF=0 ZF=0 While Int(XF)>=0 And Int(XF)<IW And Int(YF)>=0 And Int(YF)<IH ZWX=XF ZWY=YF TempInt=PeekInt(HighMap,(ZWX+ZWY*IW)Shl 2) TempR#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) TempG#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) TempB#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) If (TempInt And $100000)=0;<-durchsichtig und leuchtend MZ#=(TempInt And $FFFFF)/256.0 If ZF<=MZ;kein Schatten LF#=LightFactor#(ZWX+MXS,ZWY+MYS,MZ#+MZS,ZWX,ZWY,HighMap) TempR#=TempR#+LF#*LightR# TempG#=TempG#+LF#*LightG# TempB#=TempB#+LF#*LightB# ZF=MZ EndIf If TempR#>1 Then TempR#=1 If TempR#<0 Then TempR#=0 If TempG#>1 Then TempG#=1 If TempG#<0 Then TempG#=0 If TempB#>1 Then TempB#=1 If TempB#<0 Then TempB#=0 If Tested(ZWX,ZWY)=0 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,TempR# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,TempG# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,TempB# Tested(ZWX,ZWY)=1 EndIf Else PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,1 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,1 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,1 EndIf XF=XF+MXS YF=YF+MYS ZF=ZF+MZS Wend Next ElseIf YS<0 MXS#=-XS/YS MYS#=-1 If Abs(MXS)>1 MYS=MYS/Abs(MXS) MXS=Sgn(MXS) EndIf MVE#=Sqr(MXS^2+MYS^2) MZS#=ZS*MVE For XST=0 To IW-1 XF=XST YF=IH-1 ZF=0 While Int(XF)>=0 And Int(XF)<IW And Int(YF)>=0 And Int(YF)<IH ZWX=XF ZWY=YF TempInt=PeekInt(HighMap,(ZWX+ZWY*IW)Shl 2) If (TempInt And $100000)=0;<-durchsichtig und leuchtend TempR#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) TempG#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) TempB#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) MZ#=(TempInt And $FFFFF)/256.0 If ZF<=MZ;kein Schatten LF#=LightFactor#(ZWX+MXS,ZWY+MYS,MZ#+MZS,ZWX,ZWY,HighMap) TempR#=TempR#+LF#*LightR# TempG#=TempG#+LF#*LightG# TempB#=TempB#+LF#*LightB# ZF=MZ EndIf If TempR#>1 Then TempR#=1 If TempR#<0 Then TempR#=0 If TempG#>1 Then TempG#=1 If TempG#<0 Then TempG#=0 If TempB#>1 Then TempB#=1 If TempB#<0 Then TempB#=0 If Tested(ZWX,ZWY)=0 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,TempR# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,TempG# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,TempB# Tested(ZWX,ZWY)=1 EndIf EndIf XF=XF+MXS YF=YF+MYS ZF=ZF+MZS Wend Next EndIf If XS>0 MYS#=YS/XS MXS#=1 If Abs(MYS)>1 MXS=MXS/Abs(MYS) MYS=Sgn(MYS) EndIf MVE#=Sqr(MXS^2+MYS^2) MZS#=ZS*MVE For YST=0 To IH-1 YF=YST XF=0 ZF=0 While Int(XF)>=0 And Int(XF)<IW And Int(YF)>=0 And Int(YF)<IH ZWX=XF ZWY=YF TempInt=PeekInt(HighMap,(ZWX+ZWY*IW)Shl 2) If (TempInt And $100000)=0;<-durchsichtig und leuchtend TempR#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) TempG#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) TempB#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) MZ#=(TempInt And $FFFFF)/256.0 If ZF<=MZ;kein Schatten LF#=LightFactor#(ZWX+MXS,ZWY+MYS,MZ#+MZS,ZWX,ZWY,HighMap) TempR#=TempR#+LF#*LightR# TempG#=TempG#+LF#*LightG# TempB#=TempB#+LF#*LightB# ZF=MZ EndIf If TempR#>1 Then TempR#=1 If TempR#<0 Then TempR#=0 If TempG#>1 Then TempG#=1 If TempG#<0 Then TempG#=0 If TempB#>1 Then TempB#=1 If TempB#<0 Then TempB#=0 If Tested(ZWX,ZWY)=0 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,TempR# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,TempG# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,TempB# Tested(ZWX,ZWY)=1 EndIf EndIf XF=XF+MXS YF=YF+MYS ZF=ZF+MZS Wend Next ElseIf XS<0 MYS#=-YS/XS MXS#=-1 If Abs(MYS)>1 MXS=MXS/Abs(MYS) MYS=Sgn(MYS) EndIf MVE#=Sqr(MXS^2+MYS^2) MZS#=ZS*MVE For YST=0 To IH-1 YF=YST XF=IW-1 ZF=0 While Int(XF)>=0 And Int(XF)<IW And Int(YF)>=0 And Int(YF)<IH ZWX=XF ZWY=YF TempInt=PeekInt(HighMap,(ZWX+ZWY*IW)Shl 2) If (TempInt And $100000)=0;<-durchsichtig und leuchtend TempR#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) TempG#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) TempB#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) MZ#=(TempInt And $FFFFF)/256.0 If ZF<=MZ;kein Schatten LF#=LightFactor#(ZWX+MXS,ZWY+MYS,MZ#+MZS,ZWX,ZWY,HighMap) TempR#=TempR#+LF#*LightR# TempG#=TempG#+LF#*LightG# TempB#=TempB#+LF#*LightB# ZF=MZ EndIf If TempR#>1 Then TempR#=1 If TempR#<0 Then TempR#=0 If TempG#>1 Then TempG#=1 If TempG#<0 Then TempG#=0 If TempB#>1 Then TempB#=1 If TempB#<0 Then TempB#=0 If Tested(ZWX,ZWY)=0 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,TempR# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,TempG# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,TempB# Tested(ZWX,ZWY)=1 EndIf EndIf XF=XF+MXS YF=YF+MYS ZF=ZF+MZS Wend Next EndIf End Function Function LightFactor#(LightX#,LightY#,LightZ#,X,Y,Highmap);Dies ist eine Funktion auf der Basis von Noobodys Code. Local IW=PeekInt(Highmap,BankSize(Highmap)-4),IH=(BankSize(Highmap)-4)/IW/4 ;Code copied from http://www.blitzforum.de/forum/viewtopic.php?t=31696 ;Thanks to Noobody Local VX# = X - LightX ;Vektor von Licht zu Punkt auf der Heightmap Local VY# = LightZ# - (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 Local VZ# = Y - LightY TFormNormal VX#, -VY#, VZ#, 0, 0 ;Vektor normalisieren VX# = TFormedX() VY# = TFormedY() VZ# = TFormedZ() Local DHeight1#,DHeight2# If X<>0 DHeight1# = (PeekInt(Highmap,((X-1)+Y*IW)Shl 2)And $FFFFF)/256.0 - (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 ;Normale des Terrains in diesem Punkt berechnen Else DHeight1# = (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 - (PeekInt(Highmap,((X+1)+Y*IW)Shl 2)And $FFFFF)/256.0 EndIf If Y<>0 DHeight2# = (PeekInt(Highmap,(X+(Y-1)*IW)Shl 2)And $FFFFF)/256.0 - (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 Else DHeight2# = (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 - (PeekInt(Highmap,(X+(Y+1)*IW)Shl 2)And $FFFFF)/256.0 EndIf Local NX# = --DHeight1# ;Gekürzte Version des Kreuzprodukts der Vektoren nach links und nach oben auf der Heightmap Local NY# = 1 Local NZ# = --DHeight2# TFormNormal NX#, NY#, NZ#, 0, 0 ;Vektor normalisieren ;Skalarprodukt zwischen Licht-Punkt-Vektor und Normalenvektor berechnen und daraus die Schattierungsfarbe berechnen Local Ret#=( TFormedX()*VX# + TFormedY()*VY# + TFormedZ()*VZ# ) If Ret#<0 Then Return 0 Return Ret# End Function Und Hier noch einmal für B2D und B+: Code: [AUSKLAPPEN] Local CMapImg$="CM2.png"
Local HMapImg$="HM2.png" Local RenderQuality Local QualitySteps#[9];weniger ist mehr:1-1681 Berechnungen,2-441,0.5-6561 QualitySteps[0]=40 QualitySteps[1]=20 QualitySteps[2]=10 QualitySteps[3]=8 QualitySteps[4]=5 QualitySteps[5]=4 QualitySteps[6]=2 QualitySteps[7]=1 QualitySteps[8]=0.5 QualitySteps[9]=0.25 Local ZW,ZW2#,ZW3# Graphics3D 1024,768,32,2 SetBuffer BackBuffer() Local CMap=LoadColorMap(CMapImg$) Local HMap=LoadColorMap(HMapImg$) Local IW=PeekInt(CMap,BankSize(CMap)-4),IH=(BankSize(CMap)-4)/IW/4 ;;;;; Local LMap=CreateLightMap(IW,IH) Local AnAus$[1] AnAus[0]="aus" AnAus[1]="an" Local K2 Local K3 Local K5#=1 Local K6#=1 Local K7#=1 Local KEnter Local Plus,Minus Local R# Repeat Plus=KeyHit(27) Minus=KeyHit(53) If KeyDown(2) Then K2=(10+(K2+Plus-Minus)Mod 10)Mod 10 If KeyDown(3) Then K3=(10+(K3+Plus-Minus)Mod 10)Mod 10 If KeyDown(5) Then K5=K5+Plus*0.05-Minus*0.05 If K5<0 Then K5=0 If K5>1 Then K5=1 If KeyDown(6) Then K6=K6+Plus*0.05-Minus*0.05 If K6<0 Then K6=0 If K6>1 Then K6=1 If KeyDown(7) Then K7=K7+Plus*0.05-Minus*0.05 If K7<0 Then K7=0 If K7>1 Then K7=1 If KeyHit(28) Then KEnter=1-KEnter If KeyHit(57) Then RenderQuality=1 Else RenderQuality=0 ResetLightning(LMap) Local MX=MouseX(),MY=MouseY(),MZ=MouseZ() R#=(360+ATan2(MX-512,384-MY))Mod 360 Local Rendertimes2=RenderQuality*40/QualitySteps[K2]+1 Local Rendertimes3=RenderQuality*40/QualitySteps[K3]+1 Local Rendered=0 Local MSec=MilliSecs() For ZW2=-20*RenderQuality To 20*RenderQuality For ZW3=-20*RenderQuality To 20*RenderQuality Shade1(LMap,HMap,R#+ZW2,MZ+ZW3,K5#/Float((Rendertimes2)*(Rendertimes3)),K6#/Float((Rendertimes2)*(Rendertimes3)),K7#/Float((Rendertimes2)*(Rendertimes3))) Rendered=Rendered+1 If RenderQuality If KEnter Cls DrawColorMap(CMap,LMap,512-IW/2,384-IH/2) Text 20,20,"XY: "+MZ+"°, RZ: "+R#+"°" Text 20,35,(Int((Rendered/Float(Rendertimes2*Rendertimes3))*1000.0)/10.0)+"%" Text 20,50,"Verbleibene Zeit: "+MSecToTime$(Int((Float(Rendertimes2*Rendertimes3)-Float(Rendered))*(MilliSecs()-MSec)/Float(Rendered)*10.0)/10.0) Text 750,20,"XY-Qualität[1 + Plus/Minus]: "+QualitySteps[K2] Text 750,35,"RZ-Qualität[2 + Plus/Minus]: "+QualitySteps[K3] Text 750,50,"Vorschau-Rendern[Enter]: "+AnAus[KEnter] Text 750,65,"Rendern[Leertaste]: "+AnAus[RenderQuality] Text 750,80,"HelligkeitR[4 + Plus/Minus]: "+K5 Text 750,95,"HelligkeitG[5 + Plus/Minus]: "+K5 Text 750,110,"HelligkeitB[6 + Plus/Minus]: "+K5 Flip EndIf If KeyHit(1) Then RenderQuality=2:Exit EndIf ZW3=ZW3+QualitySteps[K3]-1;Variabler Step Next ZW2=ZW2+QualitySteps[K2]-1 If RenderQuality<>1 Then Exit Next MSec=MilliSecs()-MSec If RenderQuality Then RenderQuality=1 Cls DrawColorMap(CMap,LMap,512-IW/2,384-IH/2) Text 20,20,"XY: "+MZ+"°, RZ: "+R#+"°" If RenderQuality Then Text 20,35,"[Weiter mit beliebiger Taste]" Text 20,50,MSec+"ms" Text 750,20,"XY-Qualität[1 + Plus/Minus]: "+QualitySteps[K2] Text 750,35,"RZ-Qualität[2 + Plus/Minus]: "+QualitySteps[K3] Text 750,50,"Vorschau-Rendern[Enter]: "+AnAus[KEnter] Text 750,65,"Rendern[Leertaste]: "+AnAus[RenderQuality] Text 750,80,"HelligkeitR[4 + Plus/Minus]: "+K5 Text 750,95,"HelligkeitG[5 + Plus/Minus]: "+K6 Text 750,110,"HelligkeitB[6 + Plus/Minus]: "+K7 Flip If RenderQuality Then FlushKeys():WaitKey() Until KeyHit(1) End Function MSecToTime$(MSec) Return Replace(RSet(Int(Floor((MSec/1000)/3600.0)),2)+":"+RSet(Int(Floor((MSec/1000)/60.0) Mod 60),2)+":"+RSet((MSec/1000)Mod 60,2)+"."+RSet((MSec/10)Mod 100,2)," ","0") End Function ;;;;;;;;;;;;;;; Dim Tested(0,0) Function LoadHighMap(Filename$);Zum Beschleunigen der Berechnungen werden die Bilder in Banks eingelesen. Local TEMPIMG=LoadImage(Filename$) Local IW=ImageWidth(TEMPIMG),IH=ImageHeight(TEMPIMG) Local Bank=CreateBank(IW*IH*4+4) Local ZWX,ZWY Local IB=ImageBuffer(TEMPIMG) LockBuffer IB For ZWX=0 To IW-1 For ZWY=0 To IH-1 PokeInt(Bank,(ZWX+ZWY*IW)Shl 2,ReadPixelFast(ZWX,ZWY,IB)) Next Next UnlockBuffer IB FreeImage TEMPIMG PokeInt Bank,IW*IH*4,IW Return Bank End Function Function LoadColorMap(Filename$) Local TEMPIMG=LoadImage(Filename$) Local IW=ImageWidth(TEMPIMG),IH=ImageHeight(TEMPIMG) Local Bank=CreateBank(IW*IH*4+4) Local ZWX,ZWY Local IB=ImageBuffer(TEMPIMG) LockBuffer IB For ZWX=0 To IW-1 For ZWY=0 To IH-1 PokeInt(Bank,(ZWX+ZWY*IW)Shl 2,ReadPixelFast(ZWX,ZWY,IB)) Next Next UnlockBuffer IB FreeImage TEMPIMG PokeInt Bank,IW*IH*4,IW Return Bank End Function Function CreateLightMap(Width,Height);Jeder Pixel einer LightMap besteht aus 3 Floats (R,G,B) Local Bank=CreateBank(Width*Height*4*3+4) PokeInt Bank,Width*Height*4*3,Width Return Bank End Function Function DrawColorMap(ColorMap,LightMap,X,Y);Hier wird die Colormap mit der Lightmap kombiniert und eingezeichnet; Achtung: Writepixelfast inside! Local IW=PeekInt(ColorMap,BankSize(ColorMap)-4),IH=(BankSize(ColorMap)-4)/IW/4 Local ZWX,ZWY,RGB,A,R,G,B,FR#,FG#,FB# Local STX=X,ENX=X+IW-1 Local STY=Y,ENY=Y+IH-1 If STX<0 Then STX=0 If ENX>=GraphicsWidth() And (GraphicsBuffer()=BackBuffer() Or GraphicsBuffer()=FrontBuffer()) Then ENX=GraphicsWidth()-1 If STY<0 Then STY=0 If ENY>=GraphicsHeight() And (GraphicsBuffer()=BackBuffer() Or GraphicsBuffer()=FrontBuffer()) Then ENY=GraphicsHeight()-1 STX=STX-X ENX=ENX-X STY=STY-Y ENY=ENY-Y LockBuffer For ZWX=STX To ENX For ZWY=STY To ENY RGB=PeekInt(ColorMap,(ZWX+ZWY*IW)Shl 2) FR=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) If FR>1 Then FR=1 FG=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) If FG>1 Then FG=1 FB=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) If FB>1 Then FB=1 A=RGB Shr 24 R=(((RGB Shr 16) And $FF)*FR)And $FF G=(((RGB Shr 8) And $FF)*FG)And $FF B=((RGB And $FF)*FB)And $FF RGB=(A Shl 24) Or (R Shl 16) Or (G Shl 8) Or B WritePixelFast ZWX+X,ZWY+Y,RGB Next Next UnlockBuffer End Function Function DrawLightMap(LightMap,X,Y);Hier wird nur die Lightmap gezeichnet, um sie zum Beispiel als Bild speichern zu können.;Auch Achtung: WritePixelFast inside! Local ZWX,ZWY,RGB,A,R,G,B,FR#,FG#,FB# Local IW=PeekInt(LightMap,BankSize(LightMap)-4),IH=(BankSize(LightMap)-4)/IW/4/3 Local STX=X,ENX=X+IW-1 Local STY=Y,ENY=Y+IH-1 LockBuffer If STX<0 Then STX=0 If ENX>=GraphicsWidth() And (GraphicsBuffer()=BackBuffer() Or GraphicsBuffer()=FrontBuffer()) Then ENX=GraphicsWidth()-1 If STY<0 Then STY=0 If ENY>=GraphicsHeight() And (GraphicsBuffer()=BackBuffer() Or GraphicsBuffer()=FrontBuffer()) Then ENY=GraphicsHeight()-1 For ZWX=STX To ENX For ZWY=STY To ENY R=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3)*255 If R>255 Then R=255 G=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4)*255 If G>255 Then G=255 B=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8)*255 If B>255 Then B=255 RGB=(R Shl 16) Or (G Shl 8) Or B WritePixelFast ZWX+X,ZWY+Y,RGB Next Next UnlockBuffer End Function Function ResetLightning(LightMap,ValueR#=0,ValueG#=0,ValueB#=0);Hier wird die Lightmap zurückgesetzt Local ZW For ZW=0 To BankSize(LightMap)-4-12 Step 12 PokeFloat LightMap,ZW,ValueR# PokeFloat LightMap,ZW+4,ValueG# PokeFloat LightMap,ZW+8,ValueB# Next End Function Function AddLightMap(DestLightMap,SourceLightMap);Hiermit kann man Lightmaps miteinander addieren. If BankSize(DestLightMap)<>BankSize(SourceLightMap) Then Return Local ZW,Temp# For ZW=0 To BankSize(DestLightMap)-8 Step 4 Temp#=PeekFloat(DestLightMap,ZW)+PeekFloat(SourceLightMap,ZW) If Temp#>1 Then Temp#=1 If Temp#<0 Then Temp#=0 PokeFloat DestLightMap,ZW,Temp# Next End Function Function Shade1(LightMap,HighMap,LightRXY#,LightRZ#,LightR#=1,LightG#=1,LightB#=1);Dies ist die eigentliche Funktion Local IW=PeekInt(LightMap,BankSize(LightMap)-4),IH=(BankSize(LightMap)-4)/IW/4/3 Local ZWX,ZWY Dim Tested(IW-1,IH-1);Beugt doppelter Bearbeitung und damit Artefakten vor. If LightRZ#>90 LightRZ#=180-LightRZ# LightRXY#=LightRXY#+180 EndIf If LightRZ#=90 Then LightRZ#=89.9999;Mit +/-Infinity funktioniert der Code nicht. Local XF#,YF#,ZF#;Momentane Position des Lichtes,ZF ist dabei auf der Höhe der Grenze zwischen Licht und Schatten oder, wenn es keinen Schatten gibt, dann auf der Höhe des Bodens. Local XST#,YST#;Schleifenvariablen mit der Position am Startrand. Local XS#=Sin(LightRXY),YS#=-Cos(LightRXY),ZS#=-Tan(LightRZ);"Bewegungsrichtung" des Lichtes XY-Geschwindigkeit=1 Local MXS#,MYS#,MZS#,MVE#;Hier ist die Geschwindigkeit des Lichtes pro Durchlauf angegeben. Local MZ#;Die aktuelle Höhe der Ebene Local TempInt Local TempR#,TempG#,TempB#;Die momentanen Werte der Lightmap Local LF#;Die Einstrahlungsstärke, abhängig von den Winkeln von Strahlung und Boden. If YS>0;Hier werden die Berechnungen linienweise von den Rändern aus in Lichtrichtung ausgeführt. MXS#=XS/YS MYS#=1 If Abs(MXS)>1 MYS=MYS/Abs(MXS) MXS=Sgn(MXS) EndIf MVE#=Sqr(MXS^2+MYS^2) MZS#=ZS*MVE For XST=0 To IW-1 XF=XST YF=0 ZF=0 While Int(XF)>=0 And Int(XF)<IW And Int(YF)>=0 And Int(YF)<IH ZWX=XF ZWY=YF TempInt=PeekInt(HighMap,(ZWX+ZWY*IW)Shl 2) TempR#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) TempG#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) TempB#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) If (TempInt And $100000)=0;<-durchsichtig und leuchtend MZ#=(TempInt And $FFFFF)/256.0 If ZF<=MZ;kein Schatten LF#=LightFactor#(ZWX+MXS,ZWY+MYS,MZ#+MZS,ZWX,ZWY,HighMap) TempR#=TempR#+LF#*LightR# TempG#=TempG#+LF#*LightG# TempB#=TempB#+LF#*LightB# ZF=MZ EndIf If TempR#>1 Then TempR#=1 If TempR#<0 Then TempR#=0 If TempG#>1 Then TempG#=1 If TempG#<0 Then TempG#=0 If TempB#>1 Then TempB#=1 If TempB#<0 Then TempB#=0 If Tested(ZWX,ZWY)=0 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,TempR# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,TempG# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,TempB# Tested(ZWX,ZWY)=1 EndIf Else PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,1 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,1 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,1 EndIf XF=XF+MXS YF=YF+MYS ZF=ZF+MZS Wend Next ElseIf YS<0 MXS#=-XS/YS MYS#=-1 If Abs(MXS)>1 MYS=MYS/Abs(MXS) MXS=Sgn(MXS) EndIf MVE#=Sqr(MXS^2+MYS^2) MZS#=ZS*MVE For XST=0 To IW-1 XF=XST YF=IH-1 ZF=0 While Int(XF)>=0 And Int(XF)<IW And Int(YF)>=0 And Int(YF)<IH ZWX=XF ZWY=YF TempInt=PeekInt(HighMap,(ZWX+ZWY*IW)Shl 2) If (TempInt And $100000)=0;<-durchsichtig und leuchtend TempR#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) TempG#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) TempB#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) MZ#=(TempInt And $FFFFF)/256.0 If ZF<=MZ;kein Schatten LF#=LightFactor#(ZWX+MXS,ZWY+MYS,MZ#+MZS,ZWX,ZWY,HighMap) TempR#=TempR#+LF#*LightR# TempG#=TempG#+LF#*LightG# TempB#=TempB#+LF#*LightB# ZF=MZ EndIf If TempR#>1 Then TempR#=1 If TempR#<0 Then TempR#=0 If TempG#>1 Then TempG#=1 If TempG#<0 Then TempG#=0 If TempB#>1 Then TempB#=1 If TempB#<0 Then TempB#=0 If Tested(ZWX,ZWY)=0 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,TempR# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,TempG# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,TempB# Tested(ZWX,ZWY)=1 EndIf EndIf XF=XF+MXS YF=YF+MYS ZF=ZF+MZS Wend Next EndIf If XS>0 MYS#=YS/XS MXS#=1 If Abs(MYS)>1 MXS=MXS/Abs(MYS) MYS=Sgn(MYS) EndIf MVE#=Sqr(MXS^2+MYS^2) MZS#=ZS*MVE For YST=0 To IH-1 YF=YST XF=0 ZF=0 While Int(XF)>=0 And Int(XF)<IW And Int(YF)>=0 And Int(YF)<IH ZWX=XF ZWY=YF TempInt=PeekInt(HighMap,(ZWX+ZWY*IW)Shl 2) If (TempInt And $100000)=0;<-durchsichtig und leuchtend TempR#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) TempG#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) TempB#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) MZ#=(TempInt And $FFFFF)/256.0 If ZF<=MZ;kein Schatten LF#=LightFactor#(ZWX+MXS,ZWY+MYS,MZ#+MZS,ZWX,ZWY,HighMap) TempR#=TempR#+LF#*LightR# TempG#=TempG#+LF#*LightG# TempB#=TempB#+LF#*LightB# ZF=MZ EndIf If TempR#>1 Then TempR#=1 If TempR#<0 Then TempR#=0 If TempG#>1 Then TempG#=1 If TempG#<0 Then TempG#=0 If TempB#>1 Then TempB#=1 If TempB#<0 Then TempB#=0 If Tested(ZWX,ZWY)=0 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,TempR# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,TempG# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,TempB# Tested(ZWX,ZWY)=1 EndIf EndIf XF=XF+MXS YF=YF+MYS ZF=ZF+MZS Wend Next ElseIf XS<0 MYS#=-YS/XS MXS#=-1 If Abs(MYS)>1 MXS=MXS/Abs(MYS) MYS=Sgn(MYS) EndIf MVE#=Sqr(MXS^2+MYS^2) MZS#=ZS*MVE For YST=0 To IH-1 YF=YST XF=IW-1 ZF=0 While Int(XF)>=0 And Int(XF)<IW And Int(YF)>=0 And Int(YF)<IH ZWX=XF ZWY=YF TempInt=PeekInt(HighMap,(ZWX+ZWY*IW)Shl 2) If (TempInt And $100000)=0;<-durchsichtig und leuchtend TempR#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3) TempG#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+4) TempB#=PeekFloat(LightMap,((ZWX+ZWY*IW)Shl 2)*3+8) MZ#=(TempInt And $FFFFF)/256.0 If ZF<=MZ;kein Schatten LF#=LightFactor#(ZWX+MXS,ZWY+MYS,MZ#+MZS,ZWX,ZWY,HighMap) TempR#=TempR#+LF#*LightR# TempG#=TempG#+LF#*LightG# TempB#=TempB#+LF#*LightB# ZF=MZ EndIf If TempR#>1 Then TempR#=1 If TempR#<0 Then TempR#=0 If TempG#>1 Then TempG#=1 If TempG#<0 Then TempG#=0 If TempB#>1 Then TempB#=1 If TempB#<0 Then TempB#=0 If Tested(ZWX,ZWY)=0 PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3,TempR# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+4,TempG# PokeFloat LightMap,((ZWX+ZWY*IW)Shl 2)*3+8,TempB# Tested(ZWX,ZWY)=1 EndIf EndIf XF=XF+MXS YF=YF+MYS ZF=ZF+MZS Wend Next EndIf End Function Function LightFactor#(LightX#,LightY#,LightZ#,X,Y,Highmap);Dies ist eine Funktion auf der Basis von Noobodys Code. Local IW=PeekInt(Highmap,BankSize(Highmap)-4),IH=(BankSize(Highmap)-4)/IW/4 ;Code copied from http://www.blitzforum.de/forum/viewtopic.php?t=31696 ;Thanks to Noobody Local VX# = X - LightX ;Vektor von Licht zu Punkt auf der Heightmap Local VY# = LightZ# - (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 Local VZ# = Y - LightY TFormNormal VX#, -VY#, VZ#, 0, 0 ;Vektor normalisieren VX# = TFormedX() VY# = TFormedY() VZ# = TFormedZ() Local DHeight1#,DHeight2# If X<>0 DHeight1# = (PeekInt(Highmap,((X-1)+Y*IW)Shl 2)And $FFFFF)/256.0 - (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 ;Normale des Terrains in diesem Punkt berechnen Else DHeight1# = (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 - (PeekInt(Highmap,((X+1)+Y*IW)Shl 2)And $FFFFF)/256.0 EndIf If Y<>0 DHeight2# = (PeekInt(Highmap,(X+(Y-1)*IW)Shl 2)And $FFFFF)/256.0 - (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 Else DHeight2# = (PeekInt(Highmap,(X+Y*IW)Shl 2)And $FFFFF)/256.0 - (PeekInt(Highmap,(X+(Y+1)*IW)Shl 2)And $FFFFF)/256.0 EndIf Local NX# = --DHeight1# ;Gekürzte Version des Kreuzprodukts der Vektoren nach links und nach oben auf der Heightmap Local NY# = 1 Local NZ# = --DHeight2# TFormNormal NX#, NY#, NZ#, 0, 0 ;Vektor normalisieren ;Skalarprodukt zwischen Licht-Punkt-Vektor und Normalenvektor berechnen und daraus die Schattierungsfarbe berechnen Local Ret#=( TFormedX()*VX# + TFormedY()*VY# + TFormedZ()*VZ# ) If Ret#<0 Then Return 0 Return Ret# End Function Hier sind Beispielbilder: Colormap + Heightmap:  
Ergebnis: 
Hinweis: Die Umwandlung von der Heightmapfarbe zur Höhe geschieht so: Height#=(Color and $FFFFF) ;übrigens: Ich dachte, dass ich das mit einem /256 hinten dran gemacht habe...Es ist auch so... Es läuft aber trotzdem so wie oben...  Vielleicht sieht ja jemand den Fehler...
Der Blaue Farbanteil entspricht also einem ganzen Pixel Höhe. Wenn "Color And $100000" nicht 0 ist, dann "leuchtet" diese Stelle und Licht kommt durch sie hindurch. |
||
|
Moin Moin!
Projekte: DBPC CodeCruncher Mandelbrot-Renderer |
||
Übersicht
BlitzBasic Codearchiv
Powered by phpBB © 2001 - 2006, phpBB Group