Use gravity to generate Cartoon animation frames

I wrote a cartoon animation program around 1982 in C. The Honolulu Academy of Arts asked me to demo the program in their Focus on Computer Graphics.

The program allows the user to draw lines of a cartoon frame using the mouse. The user then saves that frame and draws another. To animate, the program draws the line segments of the 1st frame, then calculates and draws the “in between frames” that morph the 1st frame to the 2nd frame.

The new version below makes the Demo mode automatically generates cartoon frames of pairs of closed loop “objects” using gravity. It’s interesting to watch the shapes as they morph into other shapes.

I wrote the original on my $2100 IBM PC with 256K Ram and dual 360k floppy disk drives, running MSDOS, using the 100$ DeSmet C compiler.

I remember setting the machine up to use a RamDisk to minimize the swapping to Floppy disk when compiling and linking. I bought my first 23 Megabyte PC hard disk soon after.

The color graphics adapter on my machine had a display buffer: write a byte to address 0xb800 and it shows on the top left corner of the screen.

For animation to appear smooth, the code had to be fast, so I wrote the code in assembly code. The 8088 CPU ran at 4.77 Megahertz. Here’s the code to draw a single pixel from my cartoon program:

wdot(x,y) {


    mov    dx,[bp+6]

    mov    cx,[bp+4]

    sal    cx,1

;cx has column 0-639, dx has row 0-199

    mov    al,28h

    push   dx

    and    dl,0feh

    mul    dl

    pop    dx

    test   dl,1

    jz     r4

    add    ax,2000h

r4: mov    si,ax        ;address of first byte of row

    mov    ax,0b800h

    mov    es,ax

    mov    dx,cx

    mov    cx,703h

    and    ch,dl        ;address of pel within byte

    shr    dx,cl

    add    si,dx        ;address of requested byte

    mov    cl,ch        ;bit #

    mov    al,colfl_

    shr    al,cl        ;put a 1 in the right bit location

    xor    es:[si],al       



Similarly, I had to implement write my own line drawing based on Bresenham’s line algortihm

I wrote an RS232 Serial port decoder and mouse driver in assembly code to interface with my VisiOn mouse. Good thing my C Compiler supported inline assembly code (VS C++ still does)

I had to write my own pull-down menu code and decide various menu behaviors, like whether the menu disappears when the user moved off its area, whether the item was selected with a mouse down or mouse up, etc.

Microsoft Windows, coming a decade later made it easier for programmers to do such programming tasks. Mouse, Printer and Graphics drivers isolated the programmer from the myriad of devices and their quirks. Rather than having to buy every possible mouse/printer and testing my code against them, I could write to a common API.

I wanted to demo my Cartoon program and found there were a few problems with my post from 7 years ago.

The code in the original post is double spaced Visual Basic code, and white space is significant to VB, so some of the lines had syntax errors because of the spacing.

The Quotes, Apostrophes and hyphens were munged into the Word Smart Quote (here I attempt to use Word Quotes around a quote char “"”). The Apostrophe is the beginning of a comment in VB. (Here I attempt to use Word Smart Apostrophes around a normal apostrophe: ‘'’

Also while cleaning up the code for this post, I thought I’d add some new features.

1. Wrap around: after drawing the N-1 to Nth frame, draw the frames between the Nth frame to the first frame so the animations wrap around

2. I’ve added color, changing, so line segments are assigned a changing color: the Nth segment in each frame will be the same color. This allows more easily seeing how segments morph from one frame to the next.

3. I’ve added thickness, so if you’re using a stylus, the thickness will be proportional to the stylus pressure. Even without a stylus, the demo has a mode that increases the thickness with the line segment number

4. A slider allows the user to control the number of frames generated in between.

5. Demo: I’ve made the demo mode automatically generate cartoon frames. By default, it generates 20 frames of 2 objects each, with each object composed of 1000 lines

a. The 2 objects each are drawn randomly, starting from an initial random point and an initial random velocity.

b. The 4 walls each exert a force on the line inversely proportional to the square of the distance to the wall, just as gravity does (inverse square law). This force causes an acceleration which is perturbed randomly in the cartoon frame.

c. The final line segment of each object is a line connecting the last point with the first point, thus forming a closed curve. For these 2 objects, the colors are blue and pink.

d. If you hit the Left Control button and click Demo, the demo will vary the line thickness from thinnest to thickest per object.

Try running the code below

1. Using a mouse, your finger or a stylus, draw a shape with multiple line segments. The Status shows the # of line segments. Try several hundred segments.

2. Hit New Frame

3. Draw another one of roughly the same # of line segments.

4. Hit Play

5. Try moving the slider (or using the mouse wheel) to change the number of generated animation frames.

6. Try drawing the letters of the alphabet in each frame.

See also:

Why was the original IBM PC 4.77 Megahertz?

My toys over the years




< Code>

 Imports System.Windows.Markup
Imports System.Windows.Media
Imports System.Windows.Threading
' Start Visual Studio.
' File-> New->Project->Visual Basic->Windows->WPF
' Replace MainWindow.xaml.vb with this code
' see also

Class MainWindow
  Friend WithEvents btnNewFrame As Button
  Friend WithEvents btnErase As Button
  Friend WithEvents btnPlay As Button
  Friend WithEvents btnDemo As Button
  Friend WithEvents btnReset As Button
  Friend WithEvents sldBetween As Slider
  Friend txtStatus As TextBlock
  Private _AnimControl As AnimControl
  Sub Load() Handles MyBase.Initialized
    WindowState = WindowState.Maximized
    Title = "Cartoon Animation by Calvin Hsia 1982"
    Dim xaml =
  xmlns:x="" LastChildFill="True">
  <StackPanel Background="Transparent" Orientation="Vertical" DockPanel.Dock="Top">
    <TextBlock>Draw To create lines For a cartoon frame. Add a New frame, hit play. 
                        Rebirth Of Calvin's cartoon program circa 1982
  <Border DockPanel.Dock="Top" Height="25">
    <StackPanel Orientation="Horizontal">
      <Button Name="btnNewFrame"
        ToolTip="Add current drawing to cartoon, so you can create a new one">_New Frame</Button>
      <Button Name="btnErase"
        ToolTip="erase current frame">_Erase</Button>
      <Button Name="btnPlay"
        ToolTip="Animate the current frames or stop animation" Width="40">_Play</Button>
      <Button Name="btnDemo"
        ToolTip="Automatically generate frames with curves. Left Ctrl-Click to vary thickness">_Demo</Button>
      <Button Name="btnReset"
        ToolTip="Erase all frames">_Reset</Button>
      <Slider Name="sldBetween" Width="200"
        ToolTip="# Frames to generate in between"
        Maximum="1000" Minimum="0" Value="500"/>
      <TextBlock Name="txtStatus"/>
  <UserControl Name="MyCtrl"/>

    Dim dPanel = CType(XamlReader.Load(xaml.CreateReader), DockPanel)
    Dim MyCtrl = CType(dPanel.FindName("MyCtrl"), UserControl)
    _AnimControl = New AnimControl(Me)
    MyCtrl.Content = _AnimControl
    btnPlay = CType(dPanel.FindName("btnPlay"), Button)
    btnNewFrame = CType(dPanel.FindName("btnNewFrame"), Button)
    btnPlay = CType(dPanel.FindName("btnPlay"), Button)
    btnDemo = CType(dPanel.FindName("btnDemo"), Button)
    btnErase = CType(dPanel.FindName("btnErase"), Button)
    btnReset = CType(dPanel.FindName("btnReset"), Button)
    txtStatus = CType(dPanel.FindName("txtStatus"), TextBlock)
    sldBetween = CType(dPanel.FindName("sldBetween"), Slider)
    Me.Content = dPanel
  End Sub
  Sub winloaded() Handles Me.Loaded
  End Sub
  Sub btnNewFrame_Click() Handles btnNewFrame.Click
  End Sub
  Sub btnPlay_Click() Handles btnPlay.Click
    If _AnimControl._timer.IsEnabled Then
      btnNewFrame_Click()   ' save any currently drawn changes first
      btnPlay.Content = "Sto_p"
    End If
  End Sub
  Sub StopPlay()
    If _AnimControl._timer.IsEnabled Then
      btnPlay.Content = "_Play"
      _AnimControl._timer.IsEnabled = False
    End If
  End Sub
  Sub btnDemo_Click() Handles btnDemo.Click
    Dim varyThickness = Keyboard.IsKeyDown(Key.LeftCtrl)
  End Sub
  Sub btnErase_Click() Handles btnErase.Click
  End Sub
  Sub btnReset_Click() Handles btnReset.Click
  End Sub

  Friend Sub RefreshStatus()
    Me.txtStatus.Text = $"Between={CInt(sldBetween.Value),4:n0}  Frame count={_AnimControl._UserFrameList.Count} #Lines={_AnimControl._CurLineList.Count} CurFrame={_AnimControl._ndxUserFrame}"
  End Sub
End Class

Public Class AnimControl
  Inherits FrameworkElement
  Friend WithEvents _timer As New DispatcherTimer
  Friend _rand = New Random()
  Private _MainWindow As MainWindow
  Friend _ndxUserFrame As Integer   ' index into user created frames. 
  Private _ndxBetween As Integer  ' from 0 to nBetween
  Private _ptCurrent As Point?
  Private _ptOld As Point?
  Private _fPenDown As Boolean
  Private _PenModeDrag As Boolean = True ' either create line segs, or continuous drag to create multiple segs
  ' lines to draw for current image: could be while composing, or playing.
  Friend _CurLineList As New List(Of cFrameLine)
  Public Const ThicknessDefault = 10
  Public Const ThicknessMax = 50
  Public Const InBetweenDefault = 100

  'Frames stored by user
  Friend _UserFrameList As New List(Of cCartoonFrame)
  Sub New(w As MainWindow)
    _MainWindow = w
  End Sub
  Sub Reset()
    Me._MainWindow.sldBetween.Value = InBetweenDefault
    Me._UserFrameList.Clear() ' erase all user data
  End Sub
  Sub EraseBtn() ' erase current frame
    Me._ptOld = Nothing
    Me._fPenDown = False
  End Sub
  Sub Demo(varyThickness As Boolean)
    Dim nFrames = 20
    Dim numObjects = 2
    Dim numSegsPerObject = 1000
    Dim fForce = Me.ActualHeight / 5
    Dim pow = 2
    Dim wallBound = 15
    For nFrame = 0 To nFrames - 1
      Dim nInitSpeed = 4
      For nObject = 0 To numObjects - 1
        Dim pos0 As New Point With {
            .X = _rand.Next(Me.ActualWidth),
            .Y = _rand.Next(Me.ActualHeight)
        Dim startPos = pos0
        Dim vel As New Vector With {
            .X = _rand.NextDouble * nInitSpeed,
            .Y = _rand.NextDouble * nInitSpeed
        Dim thickness = AnimControl.ThicknessDefault
        For nSeg = 0 To numSegsPerObject - 2
          Dim pos1 = Point.Add(pos0, vel)
          If varyThickness Then
            thickness = 1 + AnimControl.ThicknessMax * nSeg / numSegsPerObject
          End If
          Me._CurLineList.Add(New cFrameLine(pos0, pos1, thickness))
          ' all 4 walls exert a force proportional to inverse square of distance
          Dim dWest = Math.Max(pos1.X, wallBound) ' displacement 
          Dim accWest = fForce / dWest ^ pow
          Dim dEast = Math.Max(Me.ActualWidth - pos1.X, wallBound)
          Dim accEast = -fForce / dEast ^ pow
          Dim dNorth = Math.Max(pos1.Y, wallBound)
          Dim accNorth = fForce / dNorth ^ pow
          Dim dSouth = Math.Max(Me.ActualHeight - pos1.Y, wallBound)
          Dim accSouth = -fForce / dSouth ^ pow
          Dim accEastWest = (accEast + accWest) * _rand.NextDouble * 20
          Dim accNorthSouth = (accNorth + accSouth) * _rand.NextDouble * 20
          Dim accel = New Vector(accEastWest, accNorthSouth)
          vel = Vector.Add(vel, accel)
          pos0 = pos1 ' next line segment starts at end of cur seg
        ' now add a final line segment that closes the curve
        Me._CurLineList.Add(New cFrameLine(pos0, startPos))
      Me._UserFrameList.Add(New cCartoonFrame(Me._CurLineList))
      Me._CurLineList.Clear() ' reset for next frame
  End Sub
  Sub NewFrame()
    If _CurLineList.Count > 0 Then
      Dim curFrame = New cCartoonFrame(_CurLineList)
    End If
  End Sub

  Friend Sub Play()
    If _UserFrameList.Count < 2 Then
      MsgBox("Need at least 2 frames to animate")
    End If
    If _timer.IsEnabled Then ' if we're already playing, stop
      _timer.IsEnabled = False
      _timer.Interval = New TimeSpan(0, 0, 0, 0, 50) ' days,hrs,mins,secs,msecs
      _timer.IsEnabled = True
    End If
    Me._fPenDown = False
    Me._ndxUserFrame = 0
    Me._ndxBetween = 1 ' 1st is drawn now, next by timer tick
    Me._CurLineList.AddRange(Me._UserFrameList(0)._Lines) 'get the 1st frame
    Me.InvalidateVisual() ' show it
  End Sub
  Sub tmr_tick() Handles _timer.Tick ' let's do the animating
    If _ndxUserFrame = Me._UserFrameList.Count Then ' restart at last frame
      Me._ndxUserFrame = 0
      Me._ndxBetween = 0
    End If
    Dim frmLeft = Me._UserFrameList(Me._ndxUserFrame) ' the frame on the left
    Dim ndxFrmRight = Me._ndxUserFrame + 1
    If ndxFrmRight = Me._UserFrameList.Count Then
      ndxFrmRight = 0 ' wrap around to first frame
    End If
    Dim frmRight = Me._UserFrameList(ndxFrmRight)
    Dim nBetween = CInt(_MainWindow.sldBetween.Value) + 1
    Dim fnInterpolate = Function(lVal, rVal) lVal + Me._ndxBetween * (rVal - lVal) / nBetween
    Dim nLinesToDraw = Math.Max(frmLeft._Lines.Count, frmRight._Lines.Count) - 1
    Dim pt0, pt1 As Point

    For ndx = 0 To nLinesToDraw ' calc the lines to draw
      Dim lineLeft = frmLeft._Lines(Math.Min(ndx, frmLeft._Lines.Count - 1))
      Dim lineRight = frmRight._Lines(Math.Min(ndx, frmRight._Lines.Count - 1))

      Dim thickness = fnInterpolate(lineLeft.thickness, lineRight.thickness)
      pt0.X = fnInterpolate(lineLeft.pt0.X, lineRight.pt0.X)
      pt0.Y = fnInterpolate(lineLeft.pt0.Y, lineRight.pt0.Y)
      pt1.X = fnInterpolate(lineLeft.pt1.X, lineRight.pt1.X)
      pt1.Y = fnInterpolate(lineLeft.pt1.Y, lineRight.pt1.Y)

      Dim newLine = New cFrameLine(pt0, pt1, thickness)
    If Me._ndxBetween >= nBetween Then ' we've reached the right
      Me._ndxUserFrame += 1 ' advance to next user frame 
      Me._ndxBetween = 0
    End If
    Me._ndxBetween += 1 ' advance to next frame
  End Sub
  Protected Overrides Sub OnRender(drawingContext As DrawingContext)
        New Pen(Brushes.Purple, 1),
        New Rect(0, 0, Me.RenderSize.Width, Me.RenderSize.Height))
    Dim colorVal = &H0
    Dim colorDelta = IIf(_timer.IsEnabled, Me._CurLineList.Count, 50)
    For Each lin In Me._CurLineList ' draw the lines in the current frame
      Dim c = Color.FromRgb((colorVal / 256) And &HFF,
                            (colorVal / 256 / 256) And &HFF,
                            colorVal And &HFF)
      Dim brush = New SolidColorBrush(c)

      Dim oPen = New Pen(brush, lin.thickness)
      colorVal = (colorVal + 10 * colorDelta) Mod &HFFFFFF
      drawingContext.DrawLine(oPen, lin.pt0, lin.pt1)
    If Me._fPenDown Then
      If Me._ptOld.HasValue Then
            New Pen(Brushes.Black, 2),
      End If
    End If
  End Sub
  Protected Overrides Sub OnMouseDown(e As MouseButtonEventArgs)
    If e.RightButton = MouseButtonState.Pressed Then
      Me._PenModeDrag = Not Me._PenModeDrag ' toggle modes on right click
      If Me._PenModeDrag Then
        Me._ptOld = e.GetPosition(Me)
        If e.RightButton = MouseButtonState.Pressed Then
          Me._fPenDown = False
          Me._ptOld = Nothing
          Me._fPenDown = True
          Me._ptCurrent = e.GetPosition(Me) ' get cur pos rel to self
          If Not Me._ptOld.HasValue Then
            Me._ptOld = Me._ptCurrent ' same
          End If
        End If
      End If
    End If
  End Sub

  Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
    If Me._PenModeDrag Then
      If e.LeftButton = MouseButtonState.Pressed Then
        If Me._ptOld.HasValue Then
          Me._ptCurrent = e.GetPosition(Me)
          Dim thickNesss = AnimControl.ThicknessDefault
          If e.StylusDevice IsNot Nothing Then
            Dim pts = e.StylusDevice.GetStylusPoints(e.StylusDevice.Target)
            Dim avgPressure = Aggregate pt In pts Into Average(pt.PressureFactor)
            thickNesss = AnimControl.ThicknessMax * avgPressure
          End If
          Dim newFrameLine = New cFrameLine(Me._ptOld, Me._ptCurrent, thickNesss)
          Me._ptOld = Me._ptCurrent
        End If
      End If
      If Me._fPenDown Then
        If Me._ptOld.HasValue Then
          Me._ptCurrent = e.GetPosition(Me)
        End If
      End If
    End If
  End Sub
  Protected Overrides Sub OnMouseUp(e As MouseButtonEventArgs)
    If Me._fPenDown Then
      Me._ptCurrent = e.GetPosition(Me) ' get cur pos rel to self
      Dim newFrameLine = New cFrameLine(Me._ptOld, Me._ptCurrent)
      Me._ptOld = Me._ptCurrent
      Me._fPenDown = False
    End If
  End Sub
  Protected Overrides Sub OnMouseWheel(e As MouseWheelEventArgs)
    If Me._timer.IsEnabled Then ' only when playing
      Me._MainWindow.sldBetween.Value += If(e.Delta > 0, 10, -10)
    End If
  End Sub

  Public Class cCartoonFrame ' User created cartoon frame
    Public ReadOnly _Lines As New List(Of cFrameLine) ' a frame is a list of lines
    ' # of frames to gen between real user frames
    Sub New(lst As List(Of cFrameLine))
    End Sub
    Public Overrides Function ToString() As String
      Return String.Format("LineCount = {0}", _Lines.Count)
    End Function
  End Class
  'A line to be animated. Could belong to a real or gen'd user frame, or while user is actively drawing
  Public Class cFrameLine ' User created cartoon line. It's just 2 points.
    Friend ReadOnly pt0 As Point
    Friend ReadOnly pt1 As Point
    Friend ReadOnly thickness As Double
    Sub New(pt0 As Point, pt1 As Point, Optional thickness As Double = AnimControl.ThicknessDefault)
      Me.pt0 = pt0
      Me.pt1 = pt1
      Me.thickness = thickness
    End Sub
    Public Overrides Function ToString() As String
      Return String.Format("Line = ({0:n0}, {1:n0}) ({2:n0}, {3:n0}) {4:n3}", pt0.X, pt0.Y, pt1.X, pt1.Y, (pt1 - pt0).Length)
    End Function
  End Class
End Class