Graphics 800,600,32,2

debug=0

d$=Input("Datei?        ")
t$=Input("Ziel?         ")

.met
method=Input("Methode? 0/1  ")

If method<0 Or method>1
   Goto met
EndIf

If method=1
   hel#=Input("Kontrast?     ")
EndIf

s=LoadImage(d$)

wid=ImageWidth(s)
hei=ImageHeight(s)

e=CreateImage(wid,hei)

DrawImage s,1,1

LockBuffer ImageBuffer(e)
LockBuffer ImageBuffer(s)

Dim col(wid,hei)

For x=0 To wid-1
   For y=0 To hei-1
      
      c=ReadPixelFast(x,y,ImageBuffer(s))
      
      r=(c Shr 16) And 255
      g=(c Shr  8) And 255
      b=(c Shr  0) And 255
      
      col(x,y)=(r+g+b)/3
      
   Next
Next

If method=0
   
   Color 255,255,0
   
   st=20
   
   For x=0 To GraphicsWidth() Step 20
      
      Line x,0,x,GraphicsHeight()
      
   Next
   
   For y=0 To GraphicsHeight() Step 20
      
      Line 0,y,GraphicsWidth(),y
      
   Next
   
   For x=0 To wid-2
      For y=0 To hei-2
         
         obl=col(x,y)
         obr=col(x+1,y)
         unl=col(x,y+1)
         unr=col(x+1,y+1)
         
         winkx=(ATan2#(1, (obr-obl))+ATan2#(1, (unr-unl)))/8
         winky=(ATan2#(1, (unl-obl))+ATan2#(1, (unr-obr)))/8
         
         xpos#=127.5+Sin#(-winkx)*127.5
         zpos#=127.5+Cos#(-winkx)*127.5
         ypos#=127.5+Sin#(-winky)*127.5
         
         If (x Mod st)=0 And (y Mod st)=0
            Line x,y,x+(xpos#-127.5)/10,y+(ypos#-127.5)/10
         EndIf
         
         If debug=1
            Print x+" "+y
            Print obl+" "+obr+" "+unl+" "+unr
            Print winkx+" "+winky
            Print xpos#+" "+ypos#+" "+zpos#
            Print ""
            WaitKey
         EndIf
         
         cols=(xpos# Shl 16)+(ypos# Shl 8)+(zpos# Shl 0)
         
         WritePixelFast x,y,cols,ImageBuffer(e)
         
      Next
   Next
   
ElseIf method=1
   
   For x=0 To wid-1
      For y=0 To hei-1
         
         cols=col(x,y)*hel#
         
         If cols>255 Then cols=255
         
         WritePixelFast x,y,(cols Shl 16) + (cols Shl 8) + cols,ImageBuffer(e)
         
      Next
   Next
   
EndIf

UnlockBuffer ImageBuffer(e)
UnlockBuffer ImageBuffer(s)

SaveImage e,t$

Print "Fertig!"
WaitKey
End