PureBasic

Code : Tout sélectionner

;Comtois 15/08/07
;Polynôme de Lagrange
;http://www-ipst.u-strasbg.fr/pat/program/infogr06.htm
;http://rfv.insa-lyon.fr/~jolion/ANUM/node20.html
;http://ljk.imag.fr/membres/Bernard.Ycart/mel/ev/node20.html
;PB 4.10 beta 3

;Tracé d'une courbe passant par des points prédéfinis

EnableExplicit
InitSprite()
InitKeyboard()
InitMouse()
OpenScreen(800,600,32,"Lagrange")

#PointControle = 5
#Nb_Points=5

Structure PointF
  x.f
  y.f
EndStructure

Global Dim Pf.Pointf(#Nb_Points-1)
Global Dim d.f(#Nb_Points-1)
Global Dim n.f(#Nb_Points-1)
Dim P.Point(800)

Define.f MemX, Memy
Define i, j, s, p, Mx, My, PointControle, Proche

p = 1
For i = 0 To #Nb_Points-1
  Read Pf(i)\x
  Read Pf(i)\y
Next i

;-Sprite
CreateSprite(0,32,32)
StartDrawing(SpriteOutput(0))
  Circle(16,16,15,#Blue)
StopDrawing()
 
Procedure.f Calcul(x.f)
  Define.f y
  Define i, j

  For i=0 To #Nb_Points-1
    ;d(i)=1
    n(i)=1
    For j = 0 To #Nb_Points-1
      If i<>j
        ;d(i) * (Pf(i)\x-Pf(j)\x)
        n(i) * (x-Pf(j)\x)
      EndIf
    Next j 
    y + (n(i) * Pf(i)\y/d(i))
  Next i 
  ProcedureReturn y
EndProcedure

Repeat
  ClearScreen(0)
  ExamineKeyboard()
  ;-Souris
  If ExamineMouse()
    Mx = MouseX()
    My = MouseY()
    ;Test si la souris est proche d'un point de contrôle
    PointControle = -1
    For i=0 To #Nb_Points-1
      If Mx > Pf(i)\x - #PointControle And Mx < Pf(i)\x + #PointControle
        If My > Pf(i)\y - #PointControle And My < Pf(i)\y + #PointControle
          Proche = i
          PointControle = i
          Break
        EndIf
      EndIf
    Next

    ;La souris est proche d'un point de contrôle
    If MouseButton(#PB_MouseButton_Left) And Proche>-1
        Pf(Proche)\x = Mx
        Pf(Proche)\y = My
    Else
      Proche = -1
    EndIf

  EndIf 

 
  StartDrawing(ScreenOutput())
    ;tri des points
    SortStructuredArray(Pf(), 0, OffsetOf(Pointf\x), #PB_Sort_Float)
    ;Précalcule les dénominateurs
    For i=0 To #Nb_Points-1
      d(i)=1
      For j = 0 To #Nb_Points-1
        If i<>j
          d(i) * (Pf(i)\x-Pf(j)\x)
        EndIf
      Next j 
    Next i
    ;Affiche la courbe passant par les points prédéfinis
    For i=Pf(0)\x To Pf(#Nb_Points-1)\x
      p(i)\x=i
      p(i)\y=calcul(i)
    Next i
    For i=Pf(0)\x To Pf(#Nb_Points-1)\x-1
      LineXY(p(i)\x,p(i)\y,p(i+1)\x,p(i+1)\y,#Red)
    Next i
    ;Affiche les points prédéfinis
    For i=0 To #Nb_Points-1 
      Circle(Pf(i)\x,Pf(i)\y,3,#Green)
    Next i   
    ;Affiche la souris
    LineXY(0,My,799,My,#White)
    LineXY(Mx,0,Mx,599,#White)
    ;La souris est proche d'un point de contrôle   
    If PointControle>-1
      DrawingMode(#PB_2DDrawing_Outlined)
      Circle(Mx, My, #PointControle+2, #White)
    EndIf
    ;Affiche positions des points
    DrawingMode(#PB_2DDrawing_Transparent)
    For i=0 To #Nb_Points-1
      DrawText(Pf(i)\x,Pf(i)\y,Str(Pf(i)\x)+"/"+Str(Pf(i)\y),#Yellow,#Black)
    Next 
  StopDrawing()
  s + p
  If s<Pf(0)\x+1
    p=-p
    s=Pf(0)\x
  EndIf
  If s>Pf(#Nb_Points-1)\x-1
    p=-p
    s=Pf(#Nb_Points-1)\x
  EndIf 

  DisplayTransparentSprite(0,p(s)\x-16,p(s)\y-16)
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

DataSection
Data.f 25,570
Data.f 180,380
Data.f 360,520
Data.f 625,240
Data.f 760,380
EndDataSection