Attribute VB_Name = "Module2"
'**********************************************************
'*               TRANSFORM A 2D FIGURE                    *
'* ------------------------------------------------------ *
'* This program trnsforma a sparrow into its French name, *
'* MOINEAU, with 50 intermediate views.                   *
'* ------------------------------------------------------ *
'* From "Graphisme dans le plan et dans l'espace avec     *
'* Turbo Pascal 4.0 de R. Dony - MASSON 1990", page 211.  *
'*                                                        *
'*           Visual Basic 4 Release By J-P Moreau, Paris  *  
'**********************************************************
DefDbl A-H, O-Z
DefInt I-N

Option Base 1

Const nbdefor = 50     'number of intermediate views
Const lim = 43         'number of points in figure

Public xa(lim), ya(lim), xd(lim), yd(lim), code(lim)


  Sub TracePoly(xr(), yr())
    For i = 1 To lim
      If code(i) = 0# Then
        Call MoveXY(xr(i), yr(i))
      Else
        Call LineXY(xr(i), yr(i))
      End If
    Next i
  End Sub

  Sub Delay(itime)
  Dim duree As Integer
    duree = 30000
    For i = 1 To itime
      zz = 1#               'delay loop
      For k = 1 To duree
        zz = Sin(zz) + Cos(zz)
      Next k
    Next i
  End Sub

  'define starting figure
  Sub FigDepart()
    xd(1) = 95:  yd(1) = 85:  code(1) = 0#
    xd(2) = 87.5: yd(2) = 85: code(2) = 1#
    xd(3) = 82.5: yd(3) = 87.5: code(3) = 1#
    xd(4) = 77.5: yd(4) = 87.5: code(4) = 1#
    xd(5) = 70:  yd(5) = 80:  code(5) = 1#

    xd(6) = 70:  yd(6) = 80:  code(6) = 0#
    xd(7) = 50:  yd(7) = 65:  code(7) = 1#
    xd(8) = 35:  yd(8) = 45:  code(8) = 1#
    xd(9) = 20:  yd(9) = 30:  code(9) = 1#
    xd(10) = 5:  yd(10) = 15: code(10) = 1#

    xd(11) = 5:  yd(11) = 15: code(11) = 0#
    xd(12) = 15: yd(12) = 20: code(12) = 1#

    xd(13) = 15: yd(13) = 20: code(13) = 0#
    xd(14) = 10: yd(14) = 10: code(14) = 1#
    xd(15) = 30: yd(15) = 25: code(15) = 1#

    xd(16) = 30: yd(16) = 25: code(16) = 0#
    xd(17) = 25: yd(17) = 15: code(17) = 1#
    xd(18) = 45: yd(18) = 30: code(18) = 1#
    xd(19) = 60: yd(19) = 40: code(19) = 1#

    xd(20) = 60: yd(20) = 40: code(20) = 0#
    xd(21) = 70: yd(21) = 50: code(21) = 1#
    xd(22) = 75: yd(22) = 60: code(22) = 1#
    xd(23) = 75: yd(23) = 65: code(23) = 1#
    xd(24) = 70: yd(24) = 67.5: code(24) = 1#
    xd(25) = 60: yd(25) = 65: code(25) = 1#
    xd(26) = 50: yd(26) = 55: code(26) = 1#

    xd(27) = 50: yd(27) = 55: code(27) = 0#
    xd(28) = 40: yd(28) = 40: code(28) = 1#
    xd(29) = 30: yd(29) = 25: code(29) = 1#

    xd(30) = 52.5: yd(30) = 35: code(30) = 0#
    xd(31) = 60: yd(31) = 35: code(31) = 1#

    xd(32) = 60: yd(32) = 35: code(32) = 0#
    xd(33) = 75: yd(33) = 45: code(33) = 1#
    xd(34) = 85: yd(34) = 60: code(34) = 1#
    xd(35) = 87.5: yd(35) = 70: code(35) = 1#
    xd(36) = 90: yd(36) = 80: code(36) = 1#
    xd(37) = 95: yd(37) = 85: code(37) = 1#
    xd(38) = 85: yd(38) = 80: code(38) = 1#

    xd(39) = 82.5: yd(39) = 82.5: code(39) = 0#
    xd(40) = 80: yd(40) = 82.5: code(40) = 1#
    xd(41) = 80: yd(41) = 80: code(41) = 1#
    xd(42) = 82.5: yd(42) = 80: code(42) = 1#
    xd(43) = 82.5: yd(43) = 82.5: code(43) = 1#

    Form1.ForeColor = RGB(0, 0, 255) 'blue pen
    Call Display(400, MaxY - 400, "STARTING FIGURE")
    Call Bordure
    TracePoly xd, yd
    Delay 200
    Form1.Cls
  End Sub

  'define and draw ending figure
  Sub FigArrivee()
    xa(1) = 5:   ya(1) = 75
    xa(2) = 5:   ya(2) = 90
    xa(3) = 10:  ya(3) = 80
    xa(4) = 15:  ya(4) = 90
    xa(5) = 15:  ya(5) = 75

    xa(6) = 20:  ya(6) = 80
    xa(7) = 20:  ya(7) = 65
    xa(8) = 30:  ya(8) = 65
    xa(9) = 30:  ya(9) = 80
    xa(10) = 20: ya(10) = 80

    xa(11) = 37.5: ya(11) = 75
    xa(12) = 37.5: ya(12) = 75

    xa(13) = 37.5: ya(13) = 70
    xa(14) = 37.5: ya(14) = 65
    xa(15) = 37.5: ya(15) = 55

    xa(16) = 45: ya(16) = 45
    xa(17) = 45: ya(17) = 60
    xa(18) = 55: ya(18) = 45
    xa(19) = 55: ya(19) = 60

    xa(20) = 70: ya(20) = 50
    xa(21) = 60: ya(21) = 50
    xa(22) = 60: ya(22) = 42.5
    xa(23) = 65: ya(23) = 42.5
    xa(24) = 60: ya(24) = 42.5
    xa(25) = 60: ya(25) = 35
    xa(26) = 70: ya(26) = 35

    xa(27) = 70: ya(27) = 25
    xa(28) = 75: ya(28) = 40
    xa(29) = 80: ya(29) = 25

    xa(30) = 78: ya(30) = 30
    xa(31) = 72: ya(31) = 30

    xa(32) = 85: ya(32) = 30
    xa(33) = 85: ya(33) = 25
    xa(34) = 85: ya(34) = 15
    xa(35) = 90: ya(35) = 15
    xa(36) = 95: ya(36) = 15
    xa(37) = 95: ya(37) = 25
    xa(38) = 95: ya(38) = 30

    xa(39) = 40: ya(39) = 77.5
    xa(40) = 35: ya(40) = 77.5
    xa(41) = 35: ya(41) = 72.5
    xa(42) = 40: ya(42) = 72.5
    xa(43) = 40: ya(43) = 77.5

    Form1.ForeColor = RGB(0, 0, 255) 'blue pen
    Call Display(400, MaxY - 400, "ENDING FIGURE")
    Bordure
    TracePoly xa, ya
    Call Delay(200)
    Form1.Cls
  End Sub

  'draw successive intermediate views
  Sub Deformation(xd(), yd(), xa(), ya())
    Dim xr(lim), yr(lim)
    Form1.ForeColor = RGB(0, 0, 255) 'blue pen
    Bordure
    For i = 1 To nbdefor + 1
      For j = 1 To lim
        xr(j) = xd(j) + i * (xa(j) - xd(j)) / (nbdefor + 1)
        yr(j) = yd(j) + i * (ya(j) - yd(j)) / (nbdefor + 1)
      Next j
      Form1.ForeColor = RGB(0, 0, 255) 'blue pen
      TracePoly xr, yr
      Delay (10)
      Form1.ForeColor = RGB(255, 255, 255) 'white pen to erase
      TracePoly xr, yr
    Next i
    Form1.ForeColor = RGB(0, 0, 255) 'blue pen
    TracePoly xr, yr
  End Sub


  'main subroutine
  Sub Exec_Deform()
      MaxX = 9750: MaxY = 8200
      Call Fenetre(0#, 100#, 0#, 100#)
      Call Cloture(200, MaxX - 200, 100, MaxY - 100)
      Call FigDepart
      Call FigArrivee
      Call Deformation(xd, yd, xa, ya)
      Call Display(400, MaxY - 400, "NICE TRANSFORMATION!")
  End Sub