Морфинг в анимации. Трансформация контура

Дмитрий Маштаков
   Морфингом называется технический приём, позволяющий получать плавно изменяющуюся анимацию в промежуточных кадрах, находящихся между двумя ключевыми кадрами. Помимо того, что таким способом можно получать эффекты превращения персонажей, морфинг экономит труд аниматора, выполняя функции некого подмастерья.

   Полноценный морфинг, это достаточно сложная процедура, требующая кроме развитых компьютерных алгоритмов ещё и кропотливой работы по указанию точек соответствия. С другой стороны, морфинг отдельной линии или контура реализуется очень просто. Я ввёл такой простой морфинг в свою программу MA_Paint, и расскажу сейчас о том, что получилось.

   Процесс поясняется верхним рядом на иллюстрации. След рисования я сделал там точечным и проредил его, так, чтобы точки можно было сосчитать. На первом кадре я провёл короткую линию, состоящую из четырёх точек, а затем, перейдя на кадр №5, провёл кривую из 14-ти точек. Оба следа я запомнил на всех пяти кадрах, с тем, чтобы было видно, куда попадают точки, поручаемые в процессе морфинга – для этих точек я установил чёрный цвет и сделал их размером чуть меньше.

   Получив информацию о первой и о второй кривой, компьютер уравнивает кривые по числу точек – увеличивает число точек в той кривой, в которой точек оказалось меньше. А затем проводит морфинг (линейную интерполяцию), расставляя точки в ключевых и в промежуточных кадрах.
   Тут важно, проводя линии или очерчивая контуры в ключевых кадрах, проводить их в одном направлении и одинаковым манером, иначе траектории точек при морфинге могут перехлеснуться, исказив изображения на промежуточных кадрах.
   Если это условие соблюдено, то морфинг проходит вполне успешно. Квадрат превращается в контур рыбки, а лицо, рисуемое поэтапно, отдельными контурами и деталями с применением морфинга, плавно и естественно меняет своё выражение. Эту серию из пяти кадров можно легко совершенствовать и дальше, работая только над двумя крайними кадрами.
   Можно продолжать раскрашивать персонаж, или приделать к нему рубашку, и ваши раскраски на промежуточных кадрах попадут туда, где они и должны быть.

ДОПОЛНЕНИЕ. Аналогичный морфинг может быть осуществлён с использованием элементов векторной графики - http://proza.ru/2021/05/04/194
   Этот вид морфинга в настоящее время реализован в программе DM_Paint, скачать которую можно тут - http://disk.yandex.ru/d/suZ-qnFu4YOdYw (добавлено 24.1.2022)
__________
 2.01.2020

вот так выглядит подпрограмма, которая делает морфинг
  Обращаю ваше внимание на то, что сам процесс морфинга прост, а подпрограмма выглядит такой сложной исключительно из-за того, что усилия были направлены на создание удобств для пользователя. Например, если мы ошиблись с проведением кривой, то мы можем её вновь провести - запоминается последняя кривая, проведённая в кадре. А когда мы переходим на другой кадр, то кривая начинает запоминаться на другом месте. На места запоминания кривых указывают указатели -
 W -указатель записи,  Wo -указатель на короткую кривую,  wK -указатель на кривую начального кадра.
  Есть и другие нюансы, о которых можно прочесть в разделе Help/Копирование/трансформация контура. В настоящее время текст подпрограммы немного изменён, в частности, к элементам морфинга добавлено избирательное раскрашивание его элементов и копирование дорожкой. Эти опции вынесены в отдельную подпрограмму.
'============
Public Sub Pan2(M As Integer) 'трансформация контура
Dim S As String, I As Integer, DW As Integer, N1 As Integer, N2 As Integer, K As Integer
Dim Wo As Integer, wK As Integer, nK1 As Integer, nK2 As Integer, A As Single, B As Single
Dim X As Integer, Y As Integer
Static nK As Integer, W As Integer, N As Integer
  If M = 4 Then GoTo 10                'морфинг
  If M = 1 Then OldX2 = OldX1: OldY2 = OldY1: OldX1 = XX3: OldY1 = YY3
  If Mopic = 0 Then S = "   кадр не выделен" Else GoTo 6
5    Form1.TCom (S)     'печать комментария
  Exit Sub '=========================
6 If M = 1 Then                'MouseDown
   N = 0: If nK <> Mopic Then nK = Mopic  'номер кадра
   If W = 0 Then W = -1 Else W = -W           'указатель на кривую
  Exit Sub: End If '=========================
  If M = 3 Then                'MouseMove
    If N > 999 Then Exit Sub
    N = N + 1: aXY(N, 1 + W) = Xm: aXY(N, 2 + W) = Ym    'запоминаем координаты
  Exit Sub: End If '=========================
    If M = 2 Then                'MouseUp
    aXY(0, 1 + W) = nK: aXY(0, 2 + W) = N
    S = " записано" + Str(N) + " точек": Form1.TCom (S): Form1.Print W
  Exit Sub: End If '=========================
10  If aXY(0, 2 + W) < 3 Or aXY(0, 2 - W) < 3 Then 'проверка контуров
  S = "  нет контуров": GoTo 5: End If '========
  wK = W: nK1 = aXY(0, 1 + W): nK2 = aXY(0, 1 - W) 'проверка кадров
  If nK1 > nK2 Then wK = -W: nK1 = aXY(0, 1 - W): nK2 = aXY(0, 1 + W)
  If nK2 - nK1 < 2 Then S = " кадры без промежутка": GoTo 5 '=========
    Wo = W: N1 = aXY(0, 2 + W): N2 = aXY(0, 2 - W) 'какой контур длиннее?
    If N1 > N2 Then Wo = -W: N1 = aXY(0, 2 - W): N2 = aXY(0, 2 + W) 'N2>N1
    For I = 1 To N1: aXY(I, 4) = aXY(I, 1 + Wo): aXY(I, 5) = aXY(I, 2 + Wo): Next I 'копируется мал.контур
    A = (N1 - 1) / (N2 - 1): aXY(0, 2 + Wo) = N2
    For I = 2 To N2: B = (I - 1) * A + 1: K = Int(B): B = B - K
    aXY(I, 1 + Wo) = aXY(K, 4) + B * (aXY(K + 1, 4) - aXY(K, 4))
    aXY(I, 2 + Wo) = aXY(K, 5) + B * (aXY(K + 1, 5) - aXY(K, 5)): Next I 'малый контур уплотняется дополнительными точками
    For I = nK1 + FLa8 To nK2 - FLa8: B = (I - nK1) / (nK2 - nK1): A = 1 - B
    If TS(I) = 0 Then
      Form1.Picture1.Line (1, 1)-(1230, 640), RGB(240, 240, 240), BF:
      If Lo(0, 640) = 1 Then
  DW = Form1.Picture1.DrawWidth: Form1.Picture1.DrawWidth = 1
  Form1.Picture1.Line (Lo(1, 640), Lo(2, 640))-(Lo(3, 640), Lo(4, 640)), Lo(5, 640), BF
  Form1.Picture1.DrawWidth = DW: End If: TS(I) = 1
     Else: Call C49(0, I) 'чтение кадра
     End If '=================
     For N = 1 To N2: X = A * aXY(N, 1 + wK) + B * aXY(N, 1 - wK)
       Y = A * aXY(N, 2 + wK) + B * aXY(N, 2 - wK): Form1.Picture1.PSet (X, Y), OldC
       Call C50(I) 'запись кадра
    Next N: Next I
    'For I = 1 To N2: Form1.Picture1.PSet (aXY(I, 1 + Wo) + 5, aXY(I, 2 + Wo)), OldC: Next I 'test
    'For I = 1 To N1: Form1.Picture1.PSet (aXY(I, 4) + 5, aXY(I, 5)), OldC: Next I 'test
    Form1.TCom (" трансформация готова") ': Form1.Print N1; N2
  If Mopic > 0 Then
    If TS(Mopic) > 0 Then Call CWpic(Mopic, 2) Else Call CWpic(Mopic, 3)
  End If
End Sub