; English forum: http://www.purebasic.fr/english/viewtopic.php?t=47291#47291
; Author: filperj (updated for PB 4.00 by Andre)
; Date: 15. February 2004
; OS: Windows
; Demo: No


; Problem: nur ein schwarzer Bildschirm.... !?


; Let's play with a shoot of the desktop...
; Move the mouse and its wheel, and press any key to quit.

; Grafik-Effekt mit einem Screenshot des Windows-Desktops...
; Bewege die Maus und das Mausrad, sowie irgendeine Taste zum Beenden.

#pipi=2*#PI

Procedure.f wraptour(tr.f)
  tr-Int(tr)
  If tr<0
    ProcedureReturn tr+1
  Else
    ProcedureReturn tr
  EndIf
EndProcedure

Procedure.f anglentour(x.f,y.f)
  dist.f=Sqr(x*x+y*y)
  If ASin(-x/dist)<0
    ProcedureReturn wraptour(-ACos(y/dist)/#pipi)
  Else
    ProcedureReturn wraptour(ACos(y/dist)/#pipi)
  EndIf
EndProcedure


Procedure.l bobface(x1,y1,x2,y2,x3,y3,x4,y4)
  xa=x1: ya=y1: xb=x2: yb=y2: xc=x4: yc=y4
  For t=1 To 2
    If wraptour(anglentour(xc-xa,yc-ya)-anglentour(xb-xa,yb-ya))>0.5
      renvoi | 2
    Else
      renvoi | 1
    EndIf
    xa=x2: ya=y2: xb=x3: yb=y3
  Next
  ProcedureReturn renvoi
EndProcedure


ExamineDesktops()
scx=DesktopWidth(0)
scy=DesktopHeight(0)



;vous pouvez remplacer ça par un LoadImage
imid=CreateImage(0,scx,scy)
BitBlt_(StartDrawing(ImageOutput(0)),0,0,scx,scy,GetDC_(GetDesktopWindow_()),0,0,#SRCCOPY)
StopDrawing()

hwin=OpenWindow(0,0,0,scx,scy,"",#PB_Window_BorderLess)
StartDrawing(WindowOutput(0))
DrawImage(imid,0,0)
StopDrawing()

If scx<>400 Or scy<>300
  ResizeImage(0,400,300)
EndIf

If InitSprite()=0 Or InitSprite3D()=0
  MessageRequester("Sorry!","failed to initialise DirectX") : End
EndIf
If OpenWindowedScreen(hwin,0,0,scx,scy,0,0,0)=0
  MessageRequester("Sorry!","failed to open a screen"): End
EndIf

For x=0 To 49
  For y=0 To 36
    imid=GrabImage(0,1,x<<3,y<<3,8,8)
    numsprite=x+y*50
    If CreateSprite(numsprite,8,8,#PB_Sprite_Texture)=0
      MessageRequester("Sorry!","failed to create the texture n° "+Str(numsprite)): End
    EndIf
    StartDrawing(SpriteOutput(numsprite))
    DrawImage(imid,0,0)
    StopDrawing()
    If CreateSprite3D(numsprite,numsprite)=0
      MessageRequester("Sorry!","failed to create the sprite3D n° "+Str(numsprite)) : End
    EndIf
    ;CopySprite(numsprite,numsprite+10001)
    If WindowEvent()=#WM_KEYUP
      HideWindow(0,1) : End
    EndIf
  Next
Next

FreeImage(0) : FreeImage(1)

For numsprite=10000 To 10000+49+36*50
  If CreateSprite(numsprite,8,8,#PB_Sprite_Texture)=0
    MessageRequester("Sorry!","failed to create the texture n° "+Str(numsprite)): End
  EndIf
  UseBuffer(numsprite)
  For x=0 To 7
    ClipSprite(numsprite-10000,x,0,1,8)
    DisplaySprite(numsprite-10000,7-x,0)
  Next
  If WindowEvent()=#WM_KEYUP
    HideWindow(0,1) : End
  EndIf
  If CreateSprite3D(numsprite,numsprite)=0
    MessageRequester("Sorry!","failed to create the sprite3D n° "+Str(numsprite)) : End
  EndIf
Next

;FreeSprite(17500)
UseBuffer(-1)


Structure noeud
  x.f : y.f
EndStructure



Global Dim grille.noeud(50,37)
For x=0 To 50
  For y=0 To 37
    grille(x,y)\x=(scx*x)/25
    grille(x,y)\y=(scy*y)/18.5
  Next
Next

Define.noeud souris,visee
vitesse.f=0.02
basepondero.f=Sqr(Pow(scx,2)+Pow(scy,2))*20
InitMouse()
SetFrameRate(0)

Repeat


  pondero=basepondero*vitesse+1
  souris\x=MouseX() : souris\y=MouseY()

  For x=0 To 50
    For y=0 To 37

      poids.f=Sqr(Pow(souris\x-(scx*x)/50,2)+Pow(souris\y-(scy*y)/37,2))/pondero
      xv.f=(scx*x)/50 : yv.f=(scy*y)/37
      visee\x=(xv*poids+souris\x*(1-poids))*(1-poids)+xv*poids
      visee\y=(yv*poids+souris\y*(1-poids))*(1-poids)+yv*poids

      ;Décommentez pour un effet "froissé" (pas très au point)

      ;    Repeat
      ;      If visee\x<0
      ;        visee\x=-visee\x
      ;       ElseIf visee\x>scx
      ;        visee\x/scx
      ;        visee\x=(visee\x-Int(visee\x))*scx
      ;       Else
      ;        Break
      ;      EndIf
      ;    ForEver
      ;    Repeat
      ;      If visee\y<0
      ;        visee\y=-visee\y
      ;       ElseIf visee\y>scy
      ;        visee\y/scy
      ;        visee\y=(visee\y-Int(visee\y))*scy
      ;       Else
      ;        Break
      ;      EndIf
      ;    ForEver

      grille(x,y)\x+((visee\x-grille(x,y)\x)*vitesse)
      grille(x,y)\y+((visee\y-grille(x,y)\y)*vitesse)

    Next
  Next

  Start3D()

  For x=0 To 49
    For y=0 To 36

      numsprite=x+y*50
      Define.noeud c1,c2,c3,c4
      CopyMemory(@grille(x,y),@c1,SizeOf(noeud))
      CopyMemory(@grille(x+1,y),@c2,SizeOf(noeud))
      CopyMemory(@grille(x+1,y+1),@c3,SizeOf(noeud))
      CopyMemory(@grille(x,y+1),@c4,SizeOf(noeud));:CallDebugger
      visibilite=bobface(c1\x,c1\y,c2\x,c2\y,c3\x,c3\y,c4\x,c4\y)
      If visibilite & 1
        TransformSprite3D(numsprite,c1\x,c1\y,c2\x,c2\y,c3\x,c3\y,c4\x,c4\y)
        DisplaySprite3D(numsprite,0,0,128)
      EndIf
      If visibilite & 2
        numsprite+10000
        TransformSprite3D(numsprite,c2\x,c2\y,c1\x,c1\y,c4\x,c4\y,c3\x,c3\y)
        DisplaySprite3D(numsprite,0,0,128)
      EndIf

    Next
  Next
  Stop3D()

  ExamineMouse()
  vitesse+(MouseWheel()*0.001)
  If vitesse<=0 : vitesse=0.001 : EndIf
  FlipBuffers() : ClearScreen(RGB(127,127,127))
Until WindowEvent()=#WM_KEYUP
ReleaseMouse(1)
HideWindow(0,1)

; IDE Options = PureBasic v4.02 (Windows - x86)
; Folding = -
; DisableDebugger