Repeat

   Graphics 640,240,16,2
   SetBuffer BackBuffer()
   
   AppTitle "Stereogramm-Maker"
   
   Repeat
      hpfad$=Input("Hintergrund Bildpfad: ")
      h=LoadImage(hpfad)
      If h=0 Then Print "Bild konnte nicht geladen werden."
   Until h>0
   
   Repeat
      mpfad$=Input("Muster Bildpfad: ")
      m=LoadImage(mpfad)
      If m=0 Then Print "Bild konnte nicht geladen werden."
   Until m>0
   
   Repeat
      t=Input("Farbhelligkeit pro verschobener Pixel (z.B. 20): ")
      If t<=0 Then Print "Bitte Wert über 0 wählen."
      If t>255 Then Print "Bitte Wert unter 256 wählen."
   Until t>0 And t<=255
   
   FlushKeys()

   a=0
   Repeat
      Cls
      If KeyHit(200) Or KeyHit(208) Then a=1-a
      Text 0,0,"Welche Blickmethode?"
      Text 0,12,"   Parallelblick (linkes Bild fürs linke Auge - rechtes Bild fürs rechte Auge)"
      Text 0,24,"   Kreuzblick (linkes Bild fürs rechte Auge - rechtes Bild fürs linke Auge)"
      Text 0,12+a*12,">"
      Flip
   Until KeyHit(28)
   
   FlushKeys()
   
   wm=ImageWidth(m)
   hm=ImageHeight(m)
   
   wh=ImageWidth(h)
   hh=ImageHeight(h)
   
   Graphics wm+wh,hm+14,32,2
   ms=MilliSecs()
   Repeat
   

      If KeyHit(200) And t<255 Then t=t+1
      If KeyHit(208) And t>1 Then t=t-1
      If KeyHit(205) And t<=245 Then t=t+10
      If KeyHit(203) And t>=11 Then t=t-10
      
      h=LoadImage(hpfad)
      m=LoadImage(mpfad)
      
      neu=CreateImage(wm+wh,hm)
      
      SetBuffer ImageBuffer(neu)
      For i = 0 To Floor(wm/wh)+1
         For j = 0 To Floor(hm/hh)
            DrawImage h,i*wh,j*hh
         Next
      Next
      
      For i = 0 To wm-1
         For j = 0 To hm-1
            If a=0 Then
               f=Ceil(((ReadPixel(i,j,ImageBuffer(m)) And $FF0000)/$10000)/t)
            Else
               f=Ceil((255-((ReadPixel(i,j,ImageBuffer(m)) And $FF0000)/$10000))/t)
            EndIf
            If f>0 Then
               x=i Mod wh
               For k = Floor(i/wh) To Ceil(wm/wh)
                  CopyPixel i,j,ImageBuffer(neu),(k+1)*wh+x-f,j,ImageBuffer(neu)
               Next
            EndIf
         Next
      Next
      
      SetBuffer BackBuffer()
      DrawImage neu,0,14
      
      Text wm/2,0,t
      Text wm/2+wh,0,t
      Text 0,0,"ms/f: "+(MilliSecs()-ms):ms=MilliSecs()
      Flip
      
      Cls
      
      If KeyHit(28) Then
         FlushKeys()
         Cls
         Locate 0,0
         savepfad$=Input("Bild speichern unter: ")
         SaveBuffer(ImageBuffer(neu),savepfad$)
         Cls
         FlushKeys()
      EndIf
   
   Until KeyHit(1)
Forever