|
Das deutsche QBasic- und FreeBASIC-Forum Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
Autor |
Nachricht |
Eternal_pain
Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 31.01.2014, 07:02 Titel: Beleuchtung |
|
|
Nachdem ich mit diesem Thema nicht viel weiter gekommen war, hab ich versucht mich ein wenig mit raytracing beschäftigt.
Allerdings wollte ich anstatt schatten damit zu 'berechnen' ein 'Objekt' je nach licht einfall aufhellen bzw abdunkeln... allerdings scheine ich da noch nicht ganz auf den richtigen Weg zu sein... der 'Grundstein' funktioniert zwar schon relativ 'gewollt' aber noch nicht ganz so wie ich es gern hätte...
Ich benutze hier eine Liste und einen Bresenham algo für 3 dimensionen mit denen ich die einzelnen pixel in der liste festhalte um diese dann durchzugehen...
Ausgehend von meinem 'Objekt' nehme ich also einen 'Strahl' von der lichtquelle zum objekt und helle alles was vom Z wert tiefer ist als der Strahl und versuche alles was höher (und auch dahinter war) abzudunkeln...
glaube aber das funktioniert noch nicht so richtig....
Code: | #Define MAX(a,b) IIF(a>b,a,b)
'' -----------------------
'' VectorList
'' -----------------------
Type tListNode
NextEntry as tListNode ptr
PrevEntry as tListNode ptr
X as Integer
Y as Integer
Z as Integer
End Type
Type tList
Declare Sub AddEntry(byval X as Integer, byval Y as Integer, byval Z as Integer)
Declare Sub DelEntry(byref ListNode as tListNode ptr)
Declare Sub DestroyList()
FirstEntry as tListNode ptr
LastEntry as tListNode ptr
End Type
Sub tList.AddEntry(byval X as Integer, byval Y as Integer, byval Z as Integer)
Dim NewEntry as tListNode ptr = NEW tListNode
NewEntry -> X = X
NewEntry -> Y = Y
NewEntry -> Z = Z
If (LastEntry = 0) Then
FirstEntry = NewEntry
LastEntry = NewEntry
Exit Sub
End If
If LastEntry Then
NewEntry -> PrevEntry = LastEntry
LastEntry -> NextEntry = NewEntry
LastEntry = NewEntry
End If
End Sub
Sub tList.DestroyList()
while FirstEntry
LastEntry = FirstEntry -> NextEntry
Delete FirstEntry
FirstEntry = LastEntry
wend
End Sub
Sub tList.DelEntry(byref ListNode as tListNode ptr)
If ListNode -> NextEntry Then ListNode -> NextEntry -> PrevEntry = ListNode -> PrevEntry
If ListNode -> PrevEntry Then ListNode -> PrevEntry -> NextEntry = ListNode -> NextEntry
If FirstEntry = ListNode Then FirstEntry = FirstEntry -> NextEntry
If LastEntry = ListNode Then LastEntry = LastEntry -> PrevEntry
Delete ListNode
End Sub
'' -----------------------
'' Bresenham 3D Line
'' -----------------------
Function b3dl (byval x0 as integer, byval y0 as integer, byval z0 as Integer, _
byval x1 as integer, byval y1 as integer, byval z1 as Integer) as tList ptr
Dim as tList ptr Line3D = NEW tList
Static as Integer x, y, z, xd, yd, zd, dx, dy, dz, sx, sy, sz, ax, ay, az
dx = (x1-x0) : sx = sgn(dx) : ax = abs(dx) : x = x0
dy = (y1-y0) : sy = sgn(dy) : ay = abs(dy) : y = y0
dz = (z1-z0) : sz = sgn(dz) : az = abs(dz) : z = z0
If (ax >= MAX(ay,az)) Then
yd = ay - ax : zd = az - ax
do
Line3D -> AddEntry(x,y,z)
if (x = x1) then exit do
if (yd >= 0) then y += sy : yd -= ax
if (zd >= 0) then z += sz : zd -= ax
x += sx : yd += ay : zd += az
loop
elseif (ay >= MAX(ax, az)) then
xd = ax - ay : zd = az - ay
do
Line3D -> AddEntry(x,y,z)
if (y = y1) then exit do
if (xd >= 0) then x += sx : xd -= ay
if (zd >= 0) then z += sz : zd -= ay
y += sy : xd += ax : zd += az
loop
elseif (az >= MAX(ax, ay)) then
xd = ax - az : yd = ay - az
do
Line3D -> AddEntry(x,y,z)
if (z = z1) then exit do
if (xd >= 0) then x += sx : xd -= az
if (yd >= 0) then y += sy : yd -= az
z += sz : xd += ax : yd += ay
loop
end if
return Line3D
End Function
Screenres 640,480,32
Dim as any ptr zbmpmap = ImageCreate(640,480)
BLoad "light_test.bmp",zbmpmap
Dim as Integer Z
Dim as Integer lightX, lightY, lightZ '0,0,0
Dim llist as tList ptr
Dim llistN as tListNode ptr
Dim nColor as Integer
Dim nZ as Integer
Dim br as Integer
put(0,0),zbmpmap
For Y as Integer = 0 to 479
For X as Integer = 0 to 639
Z = point(X,Y,zbmpmap) and &hFF
If Z Then
llist = b3dl(639,lightY,660,X,Y,Z)
br = 0
Do
llistN = llist -> FirstEntry
If llistN Then
nZ = point(llistN -> X,llistN -> Y,zbmpmap) and &hFF
If nZ Then
'colortest
nColor = point(llistN -> X,llistN -> Y,zbmpmap) and &hFF
if (nZ<llistN -> Z) and br=0 then
nColor = (point(llistN -> X,llistN -> Y) and &hFF) + 1
else
nColor = (point(llistN -> X,llistN -> Y) and &hFF) - 1
'br = 1
end if
If nColor > 255 then nColor = 255
if nColor < 0 then nColor = 0
'If nColor <> (point(llistN -> X,llistN -> Y,zbmpmap) and &hFF) Then
nColor = rgb(nColor,nColor,nColor)
pset (llistN -> X, llistN -> Y),nColor
'end if
'if br then exit do
else
pset (llistN -> X, llistN -> Y),&h000033
End If
llist -> DelEntry(llistN)
End If
Loop while llistN
llist -> DestroyList()
Delete llist
'llist = 0
'pset (X,Y),&hFF0000
End If
Next X
Next Y
sleep
|
_________________
Zuletzt bearbeitet von Eternal_pain am 15.02.2014, 19:23, insgesamt einmal bearbeitet |
|
Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008 Beiträge: 562 Wohnort: Jüterbog
|
Verfasst am: 31.01.2014, 20:30 Titel: |
|
|
edit: code nochmal in Überarbeitung
naja, zumindest wird nen Strahl verfolgt.... Hmm
nach "oben" hin zum Auge/Projektionsebene ist es auch in deinem Fall eine Parallelprojektion. Außerdem müsste man so etwas wie den Normalvektor(neben gaanz anderen wichtigen Sachen) für jedes Bumpmappixel berechnen. Hab hier ne tolle Schwarte: Marius Apetri 3D-Grafik Programmierung... in meinem Fall echt Perlen vor die Säue. *lach*... mal lernt sogar etwas C dabei
Mutton |
|
Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 01.02.2014, 23:13 Titel: |
|
|
dein code sieht auf jeden fall mal sehr gut aus, damit lässt sich bestimmt mal was tolles anstellen, aber ist auch noch sehr weit von dem was ich eigentlich erreichen wollte....
Ich versuche eigentlich nur einen einfachen effekt nach zu vollziehen...
Um eine Maske einen 3D/Button effekt zu verpassen... erst das licht/glanz macht diese recht schön...
Die Maske selbst ist im moment zum testen nur ein graustufenbild...
Ein Beispiel aus Jasc Paintshop Pro (inzwischen Corel glaub ich)
Leider komme ich einfach nicht drauf wie ich das sinnvoll berechnen soll oder wonach ich noch suchen könnte...
edit: hab mal einen ganz anderen ansatz verfolgt und bisher kommt es dem was ich erreichen wollte schon ziemlich am nächsten...
Code: | Randomize Timer
#Define LineAngle(P1,P2) ((atan2(P2.Y-P1.Y,P2.X-P1.X)*Rad2Deg)+90)
#Define MAX(a,b) IIF(a>b,a,b)
Const Deg2Rad as Double = ATN(1)/45
Const Rad2Deg as Double = 45.0/Atn(1)
Const ScrWidth as Integer = 640
Const ScrHeight as Integer = 480
Dim Shared as any ptr zbmpmap
Dim Shared as Integer LightAngle = 45
Dim Shared as Integer LightHeight = 15
Function pixellight (byval x1 as integer, byval y1 as integer, byval size as integer = 5) as Integer
Static as Integer x, y, z, xd, yd, zd, dx, dy, dz, sx, sy, sz, ax, ay, az
Dim as Integer x0,y0,z0,z1,c,cc
z1 = (point(x1,y1,zbmpmap) and &hFF)
x0 = x1 + cos((LightAngle-90)*Deg2Rad) * size
y0 = y1 + sin((LightAngle-90)*Deg2Rad) * size
z0 = LightHeight
c = size
'pset (x1,y1),&hFF0000
dx = (x1-x0) : sx = sgn(dx) : ax = abs(dx) : x = x0
dy = (y1-y0) : sy = sgn(dy) : ay = abs(dy) : y = y0
dz = (z1-z0) : sz = sgn(dz) : az = abs(dz) : z = z0
If (ax >= MAX(ay,az)) Then
yd = ay - ax : zd = az - ax
do
cc = (point(x,y,zbmpmap) and &hFF)
if z<cc then return -1
if z>cc then return 1
if (x = x1) then exit do
if (yd >= 0) then y += sy : yd -= ax
if (zd >= 0) then z += sz : zd -= ax
x += sx : yd += ay : zd += az : c -= 1
loop while c
elseif (ay >= MAX(ax, az)) then
xd = ax - ay : zd = az - ay
do
cc = (point(x,y,zbmpmap) and &hFF)
if z<cc then return -1
if z>cc then return 1
if (y = y1) then exit do
if (xd >= 0) then x += sx : xd -= ay
if (zd >= 0) then z += sz : zd -= ay
y += sy : xd += ax : zd += az : c -= 1
loop while c
elseif (az >= MAX(ax, ay)) then
xd = ax - az : yd = ay - az
do
cc = (point(x,y,zbmpmap) and &hFF)
if z<cc then return -1
if z>cc then return 1
if (z = z1) then exit do
if (xd >= 0) then x += sx : xd -= az
if (yd >= 0) then y += sy : yd -= az
z += sz : xd += ax : yd += ay : c-= 1
loop while c
end if
return 0
End Function
screenres ScrWidth,ScrHeight,32
zbmpmap = ImageCreate(ScrWidth,ScrHeight)
bload "light_test.bmp",zbmpmap
Dim as integer countshadow, countlight
Dim z as Integer
for y as integer = 0 to ScrHeight-1
for x as integer = 0 to ScrWidth-1
z = (point(x,y,zbmpmap) and &hFF)
If z Then
If pixellight(x,y) = 1 Then
z+=10
countlight += 1
If z>255 then z=255
pset (x,y),rgb(z,z,z)
elseif pixellight(x,y) = -1 then
z-=10
countshadow += 1
If z<0 then z=0
pset (x,y),rgb(z,z,z)
else
pset (x,y),rgb(z,0,0)
End If
end if
next x
next y
?countlight
?countshadow
sleep
imagedestroy(zbmpmap) |
leider immernoch nicht so richtig gut... _________________
|
|
Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008 Beiträge: 562 Wohnort: Jüterbog
|
|
Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 15.02.2014, 19:30 Titel: |
|
|
Das sieht schon ziemlich perfekt aus
Hab das ganze noch ein wenig abgekürzt und experimentiere grad ein wenig damit rum...
Das abschrägen von Masken klappt noch nicht 100% wie ich es gern hätte... das Beleuchten sieht soweit schon ganz gut damit aus, es fehlt nun jedoch irgendwie noch ein glanz-effekt...
Speziell wenn wie bei diesem Test ein farbiges Licht genommen wird
_________________
|
|
Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008 Beiträge: 562 Wohnort: Jüterbog
|
Verfasst am: 15.02.2014, 22:09 Titel: |
|
|
Hmmm, im NoPaste sind meine weiteren Versuche zu finden. Allerdings nicht sehr stable. Vermutlich sind meine Umgehungsversuche von POINT,PSET dran schuld.
ColorDefinition.bi soll ne Art Farbmanipulationsgeschichte sein, wo man schnell mal zwischen RGB und HSV wechseln kann
Die Emboss Routine, ich nenne sie mal so, ist jetzt auch vereinfacht worden, kein Punkt als Lichtquelle, sondern parallele Lichtstrahlen aus bestimmter Höhe/Richtung..., war bei dir ähnlich gehandhabt worden.
Bin jedenfalls auch noch am werkeln... obs verschlimmbessert worden ist, k.A
Mutton |
|
Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 16.02.2014, 01:00 Titel: |
|
|
Diese beiden Berechnungen verstehe ich leider nicht so richtig...
Bei dem ersten Beispiel von Dir hast Du es so berechnet, welche ich
auch erstmal so ohne weiteres übernommen habe und das Licht auch
aus der richtigen Richtung zu kommen scheint
Code: |
'4.Winkel für 0 grd berechnen in Bogenmaß
v.x=50
v.y=hpxl2-hpxl1
pixel_XRad=GetRad(v)
If pixel_XRad>pi then pixel_XRad -=doublepi
'5.Winkel für 90 grd berechnen in Bogenmaß
v.x=50
v.y=hpxl3-hpxl4
pixel_YRad=GetRad(v)
If pixel_YRad>pi then pixel_YRad -=doublepi
|
Hier rechnest Du es so... in einem kurzen Beispiel kommen für die selben Werte aber verschiedene Ergebnise raus... soll das so sein?
Code: |
'1.Winkel für 0 grd berechnen in Bogenmaß
'hier eine einfache gleichmäßige Zuordnung des entsprechenden Bogenmaßes zur 'Höhendifferenz
PixelXRad=halfpi * (Pixel2PosZ-Pixel1PosZ)/255
'2.Winkel für 90 grd berechnen in Bogenmaß
'hier eine einfache gleichmäßige Zuordnung des entsprechenden Bogenmaßes zur 'Höhendifferenz
PixelYRad=halfpi * (Pixel3PosZ-Pixel4PosZ)/255
|
_________________
|
|
Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 16.02.2014, 20:36 Titel: |
|
|
Nachdem ich mit deinen Formeln noch immer nicht so richtig zurecht komme,
da ich obwohl ich scheinbar die selbe Formel nehme ich immer wieder zu anderen Ergebnissen komme oO
... habe ich mal wieder ein eigenen Versuch... der zwar auch nicht perfekt geworden ist, aber obwohl eine völlig andere Richtung immerhin auch ansehnliche Ergebnisse bringt...
Code: | Const as Single Deg2Rad = ATN(1)/45
Const as Single Rad2Deg = 45.0/Atn(1)
const as single pi = atn (1) * 4
Type tmap
as Integer Width
as Integer Height
as ubyte ptr map
End Type
Sub buildShadowMap(byref map as tmap ptr, byval rot_plane as single, byval rot_height as single, byval shadow_attenuation as single)
Dim as single dx = cos((rot_plane-90)*Deg2Rad)
Dim as single dy = sin((rot_plane-90)*Deg2Rad)
Dim as single dz = tan(rot_height*Deg2Rad)'IIF(rot_height < 89, tan(rot_height*Deg2Rad), tan(89*Deg2Rad))
Dim as single adx = abs(dx)
Dim as single ady = abs(dy)
Dim as single adz = abs(dz)
Open cons for output as #1
Dim as single max_d = IIF(ady > adx, IIF(adz > ady, adz, ady), IIF(adz > adx, adz, adx))
print #1,adx,ady,adz,max_d
dx /= max_d
dy /= max_d
dz /= max_d
Dim as single act_x, act_y, act_z, light
if (dz < 0) Then exit sub
Dim nZ as Integer
For y as Integer = 0 to map->Height-1
For x as Integer = 0 to map->Width-1
light = 1.0
act_x = x
act_y = y
act_z = map->map[act_x+(act_y*map->Width)]
if act_z = 0 then continue for
While 1
act_x += dx
act_y += dy
act_z += dz
If ((act_x >= 0) and (act_x < map->Width ) and (act_y >= 0) and (act_y < map->Height) and (act_z < 256)) Then
If (act_z < map->map[int(act_x)+(int(act_y)*map->Width)]) Then
light *= shadow_attenuation
if (light < 0.001) Then Exit While
End If
Else
Exit While
End If
Wend
nZ = (map->map[x+(y*map->Width)] + (light*255)) / 2
'print #1,nZ
'Pset(x,y),rgb(light*255,light*255,light*255)
Pset(x,y),rgb(nZ,nZ,nZ)
Next x
Next y
Close #1
End Sub
Screenres 500,100,32
Dim as ubyte z
Dim as tmap testmap
'Dim as tlight testlight = type(0,255,0,0)
testmap.Width = 500
testmap.Height = 100
testmap.map = callocate(500*100)
Dim as any ptr zimage = Imagecreate(500,100,0)
BLoad "light_test.bmp",zimage
line(0,0)-(499,99),&hFF00FF,bf
For y as Integer = 0 to 99
For x as Integer = 0 to 499
z = point(x,y,zimage) and &hFF
testmap.map[x+(y*testmap.Width)] = z
'pset(x,y),rgb(z,z,z)
Next x
Next y
buildShadowMap(@testmap,315,89,.94)
sleep
deallocate(testmap.map)
imagedestroy(zimage) |
_________________
|
|
Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 17.02.2014, 07:42 Titel: |
|
|
Ursprünglich hab ich deine erste Version abgekürzt benutzt um damit zu experimentieren und die Ergebnise waren eigentlich schon ganz gut
Code: | nZ = 255 * (((atan2(l.h-ph(0),255-(l.h+ph(0)))) - (Cos(atan2(l.y-y,l.x-x))*atan2(ph(2)-ph(1),50)) + (sin(atan2(l.y-y,l.x-x))*atan2(ph(3)-ph(4),50))) / pi) |
und
Code: | nZ = 255 * (((atan2(l.h,l.h - (255-ph(0)))) - (Cos(atan2(l.y,l.x))*atan2(ph(2)-ph(1),50)) + (sin(atan2(l.y,l.x))*atan2(ph(3)-ph(4),50))) / pi) |
waren schon recht vielversprechend...
da ich mit den Berechnungen teilweise nicht richtig was anfangen konnte bzw alles noch nicht ganz so war wie ich mir das vorgestellt habe, wollte ich dein original angepasst nochmal neu schreiben...
aber da kommt nur noch 'murks' raus weiß aber nicht genau woran das jetzt liegt... die Berechnung ist doch genau die selben?
Code: |
#Define D3(x1,y1,z1,x2,y2,z2) sqr( ((x1-x2)*(x1-x2)) + ((y1-y2)*(y1-y2)) + ((z1-z2)*(z1-z2)) )
#Define D2(x1,y1,x2,y2) sqr( ((x1-x2)*(x1-x2)) + ((y1-y2)*(y1-y2)) )
Const as Single Deg2Rad = ATN(1)/45
Const as Single Rad2Deg = 45.0/Atn(1)
const as single pi = atn (1) * 4
Type tmap
as Integer Width
as Integer Height
as ubyte ptr map
End Type
Type tLight
as Integer W 'Winkel
'as Integer X 'Position X
'as Integer Y 'Position Y
as Integer H 'Höhe
as Integer C 'Color
as Integer S 'Specular
End Type
Function EmbossLight(byref map as tmap ptr,byval Light as tLight) as Integer
Dim as ubyte pix(0 to 4) 'pixel
Dim as single pdLight 'Entfernung Pixel Licht, von "oben" betrachtet
Dim as integer phLight 'relative Höhe Licht ausgehend von Höhe Pixel
Dim as single phLightRad 'relative Höhe Licht Bogenmaß
Dim as single pXRad 'Höhenwinkel bei 0 grd durch hpxl1 und hpxl2 definiert (ist bei 180 grd negativ)
Dim as single pYRad 'Höhenwinkel bei 90 grd durch hpxl2 und hpxl3 definiert (ist bei 270 grd negativ)
Dim as single pLRad 'Azimut des Lichtes
Dim as single pXYRad 'Höhenwinkel in Abhängigkeit vom Azimut
Dim as single pDiffHeights '"absolute" Höhe Licht
Dim as Integer nZ
Dim as single lx, ly, lw
For y as Integer = 0 to map->Height-1
For x as Integer = 0 to map->Width-1
pix(0) = map->map[x+(y*map->Width)] 'relative Höhe des Pixels
If pix(0) = 0 Then Continue For
If (x-1 > -1) Then pix(1) = map->map[(x-1)+(y*map->Width)] Else pix(1) = 0 'l
If (x+1 < map->Width) Then pix(2) = map->map[(x+1)+(y*map->Width)] Else pix(2) = 0 'r
If (y-1 > -1) Then pix(3) = map->map[x+((y-1)*map->Width)] Else pix(3) = 0 'o
If (y+1 < map->Height) Then pix(4) = map->map[x+((y+1)*map->Width)] Else pix(4) = 0 'u
'1. Entfernung Pixel Licht, von "oben" betrachtet
lw = Light.W*Deg2Rad
lx = x+cos(lw)
ly = y+sin(lw)
pdLight = D3(x,y,pix(0),lx,ly,Light.H)
'2. relative Höhe Licht
phLight = Light.H-pix(0)
'3. relative Höhe Licht in Bogenmaß
phLightRad = atan2(phLight,pdLight)
'4. Winkel für 0 grad berechnen in Bogenmaß
pXRad = atan2(pix(2)-pix(1),50)
'5. Winkel für 90 grd berechnen in Bogenmaß
pYRad = atan2(pix(3)-pix(4),50)
'6. Azimut des Lichtes relativ zum Pixel in Bogenmaß
pLRad = atan2(ly-y,lx-x)
'7. Höhenwinkel des Pixels in Richtung Licht(Azimut) berechnen in Bogenmaß
pXYRad = (cos(pLRad)*pXRad) + (sin(pLRad)*pYRad)
'8. Differenz relative Höhe Licht - Höhenwinkel Pixel in Richtung Licht
pDiffHeights = phLightRad-pXYRad
If pDiffHeights>pi Then pDiffHeights=pi
If pDiffHeights< 0 Then pDiffHeights=0
'9. helligkeitswert neu berechnen
nZ = 255 * (pDiffHeights/pi)
If nZ>255 Then nZ = 255
If nZ<0 Then nZ = 0
pset (x,y),rgb(nZ,nZ,nZ)
Next x
Next y
return 0
End Function
Screenres 500,100,32
Dim as ubyte z
Dim as tmap testmap
Dim as tlight testlight = type(0,255,0,0)
testmap.Width = 500
testmap.Height = 100
testmap.map = callocate(500*100)
Dim as any ptr zimage = Imagecreate(500,100,0)
BLoad "light_test.bmp",zimage
For y as Integer = 0 to 99
For x as Integer = 0 to 499
z = point(x,y,zimage) and &hFF
testmap.map[x+(y*testmap.Width)] = z
pset(x,y),rgb(z,z,z)
Next x
Next y
sleep 1000
EmbossLight(@testmap,testlight)
sleep
deallocate(testmap.map)
imagedestroy(zimage) |
_________________
|
|
Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008 Beiträge: 562 Wohnort: Jüterbog
|
Verfasst am: 17.02.2014, 13:37 Titel: |
|
|
http://www.freebasic-portal.de/porticula/hoehenzug-1709.html
PS:ist nen Fehler drin, aber es soll ja nur das Prinzip zeigen
Zeile 42-43:
Code: | 'süd->Azimut 270 grd, pi*1.5
PixelWestHeight=200 |
zu
Code: | 'süd->Azimut 270 grd, pi*1.5
PixelSouthHeight=200 |
ändern!!!
Ich fange grad nochmal komplett neu an!
Gegeben sind die vier Höhen der NachbarPixel in Nord,Süd,West und Ost. Die eigene
Höhe ist natürlich auch bekannt. Die "Zwischenhöhen" werden entsprechend berechnet.
Die türkise Line zeigt quasi eine Art Höhenzug, ich stehe auf meinem Pixel (mit bestimmter Höhe) und
drehe mich 360 grd linksherum einmal um die Achse.
So kann man später feststellen in welchem Winkel das "Gelände" in Blickrichtung Lichtquelle hat.
Dieser "Geländewinkel" und die Höhe der Lichtquelle werden dazu benutzt das Pixel entsprechend aufzuhellen
oder abzudunkeln.
die neueste Version:
http://www.freebasic-portal.de/porticula/emboss05-bas-1710.html
Mutton |
|
Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 18.02.2014, 13:26 Titel: |
|
|
Glaube das ich einen ähnlichen Ansatz verfolgt habe, mein pixel bekommt allerdings den 'strahlwinkel' in welchem er Licht reflektieren würde, weiß nur noch nicht ganz wie ich diesen Winkel zusammen mit dem Lichtwinkel so richtig berechnen soll bzw was ich mit einem 0 winkel machen soll...
Code: |
Function EmbossLight(byref map as tmap ptr,byval Light as tLight) as Integer
Dim as Integer pix(0 to 4) 'pixel
Dim as Single dLight 'Entfernung Pixel Licht, von "oben" betrachtet
Dim as Integer hLight 'relative Höhe Licht ausgehend von Höhe Pixel
Dim as Single pX 'Höhenwinkel bei 0 grd durch hpxl1 und hpxl2 definiert (ist bei 180 grd negativ)
Dim as Single pY 'Höhenwinkel bei 90 grd durch hpxl2 und hpxl3 definiert (ist bei 270 grd negativ)
Dim as Single pLRad 'Azimut des Lichtes
Dim as Single pXYRad 'Höhenwinkel in Abhängigkeit vom Azimut
Dim as Integer nD
Dim as Single lx, ly, lw, L
lw = Light.W-90
If lw<0 Then lw+=360
lw *= Deg2Rad
open cons for output as #1
For y as Integer = 0 to map->Height-1
For x as Integer = 0 to map->Width-1
pix(0) = map->map[x+(y*map->Width)] 'relative Höhe des Pixels
If pix(0) = 0 Then Continue For
If (x-1 > -1) Then pix(1) = map->map[(x-1)+(y*map->Width)] Else pix(1) = 0 'l
If (x+1 < map->Width) Then pix(2) = map->map[(x+1)+(y*map->Width)] Else pix(2) = 0 'r
If (y-1 > -1) Then pix(3) = map->map[x+((y-1)*map->Width)] Else pix(3) = 0 'o
If (y+1 < map->Height) Then pix(4) = map->map[x+((y+1)*map->Width)] Else pix(4) = 0 'u
'1. Entfernung Pixel Licht, von "oben" betrachtet
lx = x+cos(lw)
ly = y+sin(lw)
dLight = D2(x,y,lx,ly)
'2. relative Höhe Licht
hLight = Light.H-pix(0)
'3. Horizontalen Winkel berechnen
pX = (pix(2)-pix(1))
'4. Vertikalen Winkel berechnen
pY = (pix(4)-pix(3))
'5. Azimut des Lichtes relativ zum Pixel in Bogenmaß
pLRad = atan2(ly-y,lx-x)
'6. Höhenwinkel des Pixels in Bogenmaß (Normale?)
pXYRad = atan2(y-(y+pY),x-(x+pX))
If pXYRad*Rad2Deg<>0 Then
'reflektionsstrahl...
Line (x,y)-(x+(cos(pXYRad)*10),y+(sin(pXYRad)*10)),&hFF8000
End If
Next x
Next y
return 0
End Function
|
_________________
|
|
Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008 Beiträge: 562 Wohnort: Jüterbog
|
Verfasst am: 19.02.2014, 15:59 Titel: |
|
|
Ist jetzt schwer etwas dazu zu sagen, das beste wäre, mal etwas Krickelkrackel auf Papier zu bringen und selbiges iwie auszutauschen.
So redet man meistens eh aneinander vorbei...
Die andere Möglichkeit besteht darin, dieses Topic so lange zu quälen, bis einer der Profis entnervt nen smarten Dreizeiler dropt, der uns dann vedammt dämlich aussehen läßt *gröhhl*
mein Fortschritt der Baustelle:
http://www.freebasic-portal.de/porticula/emboss10-bas-1711.html
Mutton |
|
Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 19.02.2014, 16:10 Titel: |
|
|
gerade gesehen das du auch ein neues Beispiel gepostet hast
ich glaube im Grunde macht es fast das gleiche wie auch mein Versuch... mit ein paar Zwischenschritten die ich mal außen vor gelassen habe wie das weichzeichnen ect...
Kann grad nicht sagen welches Ergebnis 'besser' ist, deines ist jedenfalls recht groß ausgefallen.
Bei meinem habe ich noch Probleme mit dem anpassen der Helligkeit bzw einem specular licht...
www.freebasic-portal.de/porticula/embosstest4-1712.html _________________
|
|
Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008 Beiträge: 562 Wohnort: Jüterbog
|
Verfasst am: 19.02.2014, 16:56 Titel: |
|
|
... ja, laaang ists.
Wollte deine Code probieren, muß ich was beachten? Hab nur blaue Box und rotierenden Strahl...
oder muß die Bitmap noch weitere Bedingungen erfüllen?
Mutton |
|
Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 19.02.2014, 17:07 Titel: |
|
|
Eigentlich nur eine gültige Bitmap laden, die als Heightmap dient... die erstelle ich zum testen derzeit mit meiner noch nicht ganz fertigen abschräg-funktion..
Einzige Regel die diese Bitmaps haben das die Heightmap auch gleichzeitig als Maske dient.. der Wert 0 (also ganz schwarz) wäre nicht selectiert bzw ein Bereich der nicht beachtet wird _________________
|
|
Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008 Beiträge: 562 Wohnort: Jüterbog
|
Verfasst am: 19.02.2014, 17:29 Titel: |
|
|
Wow...Klein und schnell, dein code
Mein Code ist extrem langsam.
Du kannst aber ne farbige Bitmap nehmen, also die Farben die dein Objekt haben soll.
Du mußt dann im 2.Schritt(CreateMask) die Ausschußfarbe mit angeben, also welche Farbe nicht zum Objekt gehört.
Hier entsteht dann die schwarz-weiß Maske
Der Smoother kann mehrmals über diese Maske laufen
Danach kann sie dann als "Heightfield" benutzt werden.
Wie gesagt, das funzt in bunt
Mutton |
|
Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
Verfasst am: 19.02.2014, 17:46 Titel: |
|
|
Farbe war mir jetzt erst einmal nicht so wichtig... die soll später noch dazu kommen evtl..
dafür hab ich deine RGB2HSV/HSV2RGB etwas für diese Zwecke abgespeckt
Code: | Function Helligkeit(byval RGBvalue as UInteger,byval Helligkeitswert as Integer) as UInteger
dim as integer RGB_Split(3)'[0]=rot,[1]=grün,[2]=blau,[3]=alpha
dim as integer RGB_Max,RGB_Min,RGB_Range
Dim as Double hue, saturation, value
dim as integer huecase,r,g,b
hue = 0 : saturation = 0 : value = 0
RGB_Split(0)=LoByte(HiWord(RGBvalue))
RGB_Split(1)=HiByte(LoWord(RGBvalue))
RGB_Split(2)=LoByte(LoWord(RGBvalue))
RGB_Split(3)=HiByte(HiWord(RGBvalue))
RGB_Max = 0 : RGB_Min = 255
for i as integer=0 to 2
if RGB_Split(i)>RGB_Max then RGB_Max=RGB_Split(i)
if RGB_Split(i)<RGB_Min then RGB_Min=RGB_Split(i)
next i
RGB_Range=RGB_Max-RGB_Min
if RGB_Range then'keine Grauwerte
select case RGB_Max
case RGB_Split(0) 'Maximalwert:rot
hue=60 * (0 + (RGB_Split(1)-RGB_Split(2)) / RGB_Range)
case RGB_Split(1) 'Maximalwert:grün
hue=60 * (2 + (RGB_Split(2)-RGB_Split(0)) / RGB_Range)
case RGB_Split(2) 'Maximalwert:blau
hue=60 * (4 + (RGB_Split(0)-RGB_Split(1)) / RGB_Range)
end select
if hue<0 then hue += 360
else'Grauwerte
hue=0
end if
value=(Helligkeitswert/255)'(RGB_Max/255)
'If Helligkeitswert<245 then
saturation = (RGB_range/RGB_Max)-value
'Else
' saturation = (RGB_range/RGB_Max)-value
'End If
If saturation<0 Then saturation = 0
huecase=int(hue/60)+1
select case huecase
case 1 'grün steigend
r=255 : g=255 * hue/60 : b=0
case 2 'rot fallend
r=255 - (255 * (hue-60) / 60) : g=255 : b=0
case 3 'blau steigend
r=0 : g=255 : b=255 * (hue-120)/60
case 4 'grün fallend
r=0 : g=255 - (255 * (hue-180)/60) : b=255
case 5 'rot steigend
r=255 * (hue-240)/60 : g=0 : b=255
case 6 'blau fallend
r=255 : g=0 : b=255 - (255 * (hue-300)/60)
end select
r=(255 - (255-r)*saturation) * value
g=(255 - (255-g)*saturation) * value
b=(255 - (255-b)*saturation) * value
Return rgba(r,g,b,RGB_Split(3))
End Function |
Die Heightmaps bastel ich mit der BevelFunktion die noch ein wenig ausgearbeitet werden muss:
http://www.freebasic-portal.de/porticula/bevelframe-1713.html
die .frm dateien erstelle ich mit einem BMP2FRM Converter (wollte ein etwas speichersparenderes Format...)
http://www.freebasic-portal.de/porticula/convertbmp2frm-1714.html
Alles zusammen soll eigentlich so eine art Signatur-Maker werden...
Zur Auswahl sollen eine reihe von Frames sein, dann soll man noch eine Schriftart auswählen können (dafür experimentiere ich gerade mit Freetype) und die Möglichkeit haben einen großen und einen kleineren Namen eingeben zu können (zB für Gilde und Spielername) noch ein hintergrund und evtl den einen oder anderen effekt...
später soll dann sowas wie dieses bei rauskommen:
_________________
|
|
Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008 Beiträge: 562 Wohnort: Jüterbog
|
Verfasst am: 19.02.2014, 20:16 Titel: |
|
|
Coole Sache das, gefällt mir!
Für den Fall würd ich dir lieber meine ColorDefinition.bi zum Abspecken empfehlen.
Basiert im übrigen auf deinem Code im Portal
Code: |
#include "ColorDefinition.bi"
dim as ColorDefinition cd
cd.SetRGB(&HFF7F00)
print cd.GetRGB
print cd.GetValue
cd.SetValue(cd.GetValue*90/100)'eine Möglichkeit um 10 Prozent abdunkeln
print cd.GetRGB
print cd.GetValue
sleep
|
Ist zwar auch snailcoded, aber jede Set.xxxx() Methode berechnet auch alle anderen Werte neu und man ist relativ save vor Wertebereichsüberschreitungen
Mutton |
|
Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006 Beiträge: 1783 Wohnort: BW/KA
|
|
Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008 Beiträge: 562 Wohnort: Jüterbog
|
Verfasst am: 23.02.2014, 13:27 Titel: |
|
|
Hab nochmal an meinem Filter etwas herumgeschraubt: nach 3 bis 4 Durchläufen
über die Ausgangsheightmap erhalten die Buchstaben dann eine Fase die bis zur
Mitte reicht. Ich glaub diese Fase haben auch die Buchstaben in deiner Vorlage.
Der erste Schriftzug ganz oben ist übrigens immer die Ausgangsgrafik
edit: etwas verbessert und schneller
http://www.freebasic-portal.de/porticula/lightfx-bas-debug-was-schneller-1717.html
Mutton |
|
Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben. Du kannst auf Beiträge in diesem Forum nicht antworten. Du kannst deine Beiträge in diesem Forum nicht bearbeiten. Du kannst deine Beiträge in diesem Forum nicht löschen. Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|