Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Emboss_test4
| Uploader: |  Eternal_Pain |
| Datum/Zeit: | 19.02.2014 14:58:40 |
Const as Single Deg2Rad = ATN(1)/45
Type tmap
as Integer Width
as Integer Height
as ubyte ptr map
End Type
Type tLight
as Integer W 'Winkel
as Integer H 'Höhe
as Integer S 'Specular
End Type
Function EmbossLight(byref map as tmap ptr,byval Light as tLight) as Integer
Dim as ubyte ptr lightmap = callocate(map->Width*map->Height)
Dim as Integer pix(0 to 4), nZ'pixel
Dim as Single pLRad 'Azimut des Lichtes
Dim as Single pZRad 'Höhenwinkel
Dim as Single pX 'Höhenwinkel bei 0 grd
Dim as Single pY 'Höhenwinkel bei 90 grd
Dim as Single lx, ly, ls, lw = Light.W*Deg2Rad
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)]
If pix(0) = 0 Then Continue For
If (x-1 > -1) Then pix(1) = map->map[(x-1)+(y*map->Width)]-Light.H Else pix(1) = -Light.H 'l
If (x+1 < map->Width) Then pix(2) = map->map[(x+1)+(y*map->Width)]-Light.H Else pix(2) = -Light.H 'r
If (y-1 > -1) Then pix(3) = map->map[x+((y-1)*map->Width)]-Light.H Else pix(3) = -Light.H 'o
If (y+1 < map->Height) Then pix(4) = map->map[x+((y+1)*map->Width)]-Light.H Else pix(4) = -Light.H 'u
nZ = Light.H
lx = x+cos(lw)
ly = y+sin(lw)
pX = (pix(2)-pix(1))
pY = (pix(4)-pix(3))
If pX<>0 orelse pY<>0 Then
pLRad = atan2(ly-y,lx-x)
pZRad = atan2(y-(y+pY),x-(x+pX))
ls = sin(pLRad-pZRad)
nZ += nZ*ls
If nZ>Light.H Then nZ *= ((Light.S/255)+1)
End If
If (nZ < 1) Then nZ = 1
If (nZ > 255) Then nZ = 255
lightmap[x+(y*map->Width)]=nZ
Next x
Next y
'smooth
For y as Integer = 0 to map->Height-1
For x as Integer = 0 to map->Width-1
pix(0) = lightmap[x+(y*map->Width)]
if pix(0)=0 Then continue for
If (x-1 > -1) Then pix(1) = lightmap[(x-1)+(y*map->Width)] Else pix(1) = (0) 'l
If (x+1 < map->Width) Then pix(2) = lightmap[(x+1)+(y*map->Width)] Else pix(2) = (0) 'r
If (y-1 > -1) Then pix(3) = lightmap[x+((y-1)*map->Width)] Else pix(3) = (0) 'o
If (y+1 < map->Height) Then pix(4) = lightmap[x+((y+1)*map->Width)] Else pix(4) = (0) 'u
nZ = ((pix(0)*2)+pix(1)+pix(2)+pix(3)+pix(4))/6
lightmap[x+(y*map->Width)]=nZ
Next x
Next y
'testzeichnen
For y as Integer = 0 to map->Height-1
For x as Integer = 0 to map->Width-1
'If map->map[x+(y*map->Width)] Then
nZ = lightmap[x+(y*map->Width)]
If nZ Then pset(x,y),rgb(nZ,nZ,nZ)
'End If
Next x
Next y
deallocate(lightmap)
return 0
End Function
Screenres 640,480,32
Dim as ubyte z
Dim as tmap testmap
Dim as tlight testlight
testmap.Width = 640
testmap.Height = 480
testmap.map = callocate(640*480)
Dim as any ptr zimage = Imagecreate(640,480,0)
BLoad "light_test.bmp",zimage
For y as Integer = 0 to 479
For x as Integer = 0 to 639
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
Dim w as single
Do
w += 11.25
if w > 359 then w-=360
screenlock
cls
line(0,0)-(499,99),&h333388,bf
EmbossLight(@testmap,type(w,90,0))
line(250,50)-(250+(cos((w-90)*Deg2Rad)*100),50+(sin((w-90)*Deg2Rad)*100)),&hFF8800
locate 1,1:?w
screenunlock
sleep 50
Loop until multikey(&h01)
sleep
deallocate(testmap.map)
imagedestroy(zimage)