Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Emboss
| Uploader: |  Muttonhead |
| Datum/Zeit: | 08.02.2014 14:13:19 |
'******************************************************************************
const as single pi =atn (1) * 4
const as single doublepi=pi*2
const as single halfpi=pi/2
'******************************************************************************
type vectorR2
x as single
y as single
end type
type vectorR3
x as single
y as single
z as single
end type
'******************************************************************************
sub HSV_to_RGB (byval hue as single, byval saturation as single, byval value as single, byref RGBvalue as uinteger)
dim as integer huecase,r,g,b
if hue>=360 then hue=0
if hue<=0 then hue=0
if saturation>100 then saturation=100
if saturation<0 then saturation=0
if value>100 then value=100
if value<0 then value=0
'Grundfarbe ermitteln
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
' s Sättigung und v Helligkeit berechnen
r=(255 - (255-r)*saturation/100) * value/100
g=(255 - (255-g)*saturation/100) * value/100
b=(255 - (255-b)*saturation/100) * value/100
RGBvalue=rgb(r,g,b)
end sub
sub RGB_to_HSV (byval RGBvalue as UInteger, byref hue as single, byref saturation as single, byref value as single)
dim as integer RGB_Split(2)'[0]=rot,[1]=grün,[2]=blau
dim as integer RGB_Max,RGB_Min,RGB_Range
hue=0
saturation=0
value=0
'Aufsplitten der Originalfarbe
RGB_Split(0)=((RGBvalue shr 16) and &HFF)
RGB_Split(1)=((RGBvalue shr 8) and &HFF )
RGB_Split(2)=(RGBvalue and &HFF )
'Maximal- und Minimalwerte ermitteln
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
'Grundfarbe in Grad ermitteln
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
saturation=100 * RGB_range/RGB_Max
value=100 *RGB_Max/255
end sub
'******************************************************************************
'Hilfsfunktionen
'eigener wiederverwendeter Code aus Einparksimulator
'bringt ein Bogenmaß in den Bereich von 0 bis 2PI
'! BYREF es wir die übergebene Variable verändert
sub RadCorrected (byref Rad as single)
if Rad>=doublepi then Rad=Rad-doublepi
if Rad<0 then Rad=doublepi+Rad
end sub
'liefert Entfernung 2er Ortsvektoren nach Pythagoras
Function GetDistance(source as vectorR2, dest as vectorR2) As Single
dim as single dx,dy
dx=dest.x - source.x
dy=dest.y - source.y
function=sqr(dx*dx + dy*dy)
End Function
'Richtung(als Bogenmaß) des Punktes dest vom Standpunkt source aus betrachtet
function GetRad overload(source as vectorR2,dest as vectorR2) as single
dim as single Rad
dim as vectorR2 d
d.x= dest.x - source.x
d.y= dest.y - source.y
Rad=atan2(d.y,d.x)
if sgn(Rad)=-1 then Rad= doublepi + Rad
function=Rad
end function
'wandelt einen Richtungsvektor zu Bogenmaß
function GetRad (v as vectorR2) as single
dim as single Rad=atan2(v.y,v.x)
if sgn(Rad)=-1 then Rad= doublepi + Rad
function=Rad
end function
'wandelt Bogenmaß zu Richtungsvektor
'distance stellt ein Skalar dar, der optional benutzt werden kann
function GetVectorR2(Rad as single,distance as single=1) as vectorR2
dim as vectorR2 v
RadCorrected(Rad)
v.x=cos(Rad)*distance
v.y=sin(Rad)*distance
function=v
end function
'******************************************************************************
'******************************************************************************
'******************************************************************************
Screenres 640,480,32
Dim as any ptr BumpMap = ImageCreate(640,480)
dim as any ptr ColorMap = ImageCreate(640,480)
BLoad "BumpMap.bmp",BumpMap
BLoad "ColorMap.bmp",ColorMap
'Variablen fürs Farbmodell
dim as UInteger rgbval
dim as single hue,saturation,value
'Verortung im Koordinatensystem
dim as single Light_PosRadians
dim as vectorR2 Light_Pos
dim as integer Light_Radius,Light_Height
'Höhe der Nebenpixel
dim as integer hpxl1,hpxl2,hpxl3,hpxl4'in Draufsicht--> l,r,o,u
'Farbe der Pixel
'dim as uinteger cpxl1,cpxl2,cpxl3,cpxl4'in Draufsicht--> l,r,o,u
'das zu untersuchende Pixel
dim as integer pixel_height'Höhe des Pixels
dim as UInteger pixel_Color'Farbe des Pixels, welche manipuliert werden soll
dim as single pixel_dLight'Entfernung Licht-Pixel
dim as integer pixel_hLight'relative Höhe Licht ausgehend von Höhe Pixel
dim as single pixel_hLightRad'relative Höhe Licht Bogenmaß
dim as single pixel_XRad 'Höhenwinkel bei 0 grd durch hpxl1 und hpxl2 definiert (ist bei 180 grd negativ)
dim as single pixel_YRad'Höhenwinkel bei 90 grd durch hpxl2 und hpxl3 definiert (ist bei 270 grd negativ)
dim as single pixel_LRad'Azimut des Lichtes
dim as single pixel_XYRad'Höhenwinkel in Abhängigkeit vom Azimut
dim as single pixel_DiffHeights'"absolute" Höhe Licht
'Berechnungshilfen
dim as vectorR2 v,d,Vo
dim as integer rgbcomp
'Darstellung
dim as integer Xo,Yo
Xo=0
Yo=479
Light_Pos.x=400
Light_Pos.y=480
Light_Height=300
For y As integer= 0 to 479
For x As integer=0 to 639
'0.alle Höhen der Pixel aus Bumpmap holen,Farbwert aus Colormap holen
pixel_height=point(x,Yo-y,BumpMap) and &hFF
if x=0 then hpxl1=pixel_height else hpxl1=point(x-1,Yo-y,BumpMap) and &hFF
if x=639 then hpxl2=pixel_height else hpxl2=point(x+1,Yo-y,BumpMap) and &hFF
if y=0 then hpxl3=pixel_height else hpxl3=point(x,Yo-y-1,BumpMap) and &hFF
if y=479 then hpxl4=pixel_height else hpxl4=point(x,Yo-y+1,BumpMap) and &hFF
pixel_color=point(x,Yo-y,ColorMap)
'1.Entfernung Pixel Licht, von "oben" betrachtet
v.x=x
v.y=y
pixel_dLight=GetDistance(v, Light_Pos)
'2. relative Höhe Licht
pixel_hLight=Light_height - Pixel_height
If pixel_hLight<0 Then pixel_hLight=0
'3. relative Höhe Licht in Bogenmaß
v.x=pixel_dLight
v.y=pixel_hLight
pixel_hLightRad=GetRad(v)
'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
'6.Azimut des Lichtes relativ zum Pixel in Bogenmaß
v.x=x
v.y=y
pixel_LRad=GetRad(v,Light_pos)
'7.Höhenwinkel des Pixels in Richtung Licht(Azimut) berechnen in Bogenmaß
pixel_XYRad=Cos(pixel_LRad)*pixel_XRad + sin(pixel_LRad)*pixel_YRad
'8.Differenz relative Höhe Licht - Höhenwinkel Pixel in Richtung Licht
'dieser Wert "pendelt" zwischen 0 bis pi,
pixel_DiffHeights= pixel_hLightRad-pixel_XYRad
if pixel_DiffHeights>pi then pixel_DiffHeights=doublepi-pixel_DiffHeights
if pixel_DiffHeights<0 then pixel_DiffHeights=0
'9 Farbe berechnen
'rgbcomp=255 * pixel_DiffHeights/pi
'pixel_Color=rgb(rgbcomp,rgbcomp,rgbcomp)
RGB_to_HSV (pixel_Color,hue,saturation,value)
value +=100 * pixel_DiffHeights/pi
saturation -=100 * pixel_DiffHeights/pi
HSV_to_RGB (hue,saturation,value,pixel_Color)
'10. Pixel setzen
pset(x,Yo-y),pixel_color
Next x
Next y
bsave"screenshot.bmp",0
ImageDestroy bumpmap
ImageDestroy colormap
sleep