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

Beleuchtung
Gehe zu Seite 1, 2  Weiter
 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA

BeitragVerfasst am: 31.01.2014, 06:02    Titel: Beleuchtung Antworten mit Zitat

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, 18:23, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Muttonhead



Anmeldungsdatum: 26.08.2008
Beiträge: 510
Wohnort: Jüterbog

BeitragVerfasst am: 31.01.2014, 19:30    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA

BeitragVerfasst am: 01.02.2014, 22:13    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Muttonhead



Anmeldungsdatum: 26.08.2008
Beiträge: 510
Wohnort: Jüterbog

BeitragVerfasst am: 08.02.2014, 14:18    Titel: Antworten mit Zitat

... mich hats nochmal ein wenig beschäftigt, es gibt definitiv bessere Methoden, als meine... lächeln(postedit)
Es ist mehr so ein Emboss Effekt mit variabler Lichtquelle
*lach*

http://www.muttonhead.homepage.t-online.de/data/BumpMap.bmp
http://www.muttonhead.homepage.t-online.de/data/ColorMap.bmp
http://www.muttonhead.homepage.t-online.de/data/screenshot.bmp
http://www.freebasic-portal.de/porticula/emboss-1701.html

Mutton
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA

BeitragVerfasst am: 15.02.2014, 18:30    Titel: Antworten mit Zitat

Das sieht schon ziemlich perfekt aus lächeln
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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Muttonhead



Anmeldungsdatum: 26.08.2008
Beiträge: 510
Wohnort: Jüterbog

BeitragVerfasst am: 15.02.2014, 21:09    Titel: Antworten mit Zitat

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

grinsen

Mutton
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA

BeitragVerfasst am: 16.02.2014, 00:00    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA

BeitragVerfasst am: 16.02.2014, 19:36    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA

BeitragVerfasst am: 17.02.2014, 06:42    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Muttonhead



Anmeldungsdatum: 26.08.2008
Beiträge: 510
Wohnort: Jüterbog

BeitragVerfasst am: 17.02.2014, 12:37    Titel: Antworten mit Zitat

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!grinsen
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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA

BeitragVerfasst am: 18.02.2014, 12:26    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Muttonhead



Anmeldungsdatum: 26.08.2008
Beiträge: 510
Wohnort: Jüterbog

BeitragVerfasst am: 19.02.2014, 14:59    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA

BeitragVerfasst am: 19.02.2014, 15:10    Titel: Antworten mit Zitat

gerade gesehen das du auch ein neues Beispiel gepostet hast happy

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Muttonhead



Anmeldungsdatum: 26.08.2008
Beiträge: 510
Wohnort: Jüterbog

BeitragVerfasst am: 19.02.2014, 15:56    Titel: Antworten mit Zitat

... 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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA

BeitragVerfasst am: 19.02.2014, 16:07    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Muttonhead



Anmeldungsdatum: 26.08.2008
Beiträge: 510
Wohnort: Jüterbog

BeitragVerfasst am: 19.02.2014, 16:29    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA

BeitragVerfasst am: 19.02.2014, 16:46    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Muttonhead



Anmeldungsdatum: 26.08.2008
Beiträge: 510
Wohnort: Jüterbog

BeitragVerfasst am: 19.02.2014, 19:16    Titel: Antworten mit Zitat

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 lächeln

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA

BeitragVerfasst am: 19.02.2014, 20:59    Titel: Antworten mit Zitat

Hab das ganze noch ein wenig mit glanzlicht erweitert... ob das Mathematisch so hinhaut kann ich gar nicht so sagen, und es weicht auch ziemlich vom Original ab, sieht aber soweit schon ganz gut aus...

http://www.freebasic-portal.de/porticula/embosslightspec-1715.html
_________________
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Muttonhead



Anmeldungsdatum: 26.08.2008
Beiträge: 510
Wohnort: Jüterbog

BeitragVerfasst am: 23.02.2014, 12:27    Titel: Antworten mit Zitat



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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC. Alle Zeiten sind GMT + 1 Stunde
Gehe zu Seite 1, 2  Weiter
Seite 1 von 2

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

 Impressum :: Datenschutz