3D Graphics with Squeak - A Tutorial

written by Boris Gaertner (Boris.Gaertner@gmx.net)

Contents:

About this Tutorial

This tutorial is written for those who want to use the threedimensional graphics facilities "Balloon3D" of Squeak. All examples should be tried in a morphic project. Together with this hypertext document you should have received these change sets:

You may wish to use files B3DFixes.cs and B3DComments.cs in your working images. The file B3DTutorial contains examples that you can load into your Squeak image. The tutorial assumes that you use Squeak 3.2. The tutorial does not cover "Wonderland".

Introduction

Squeak comes with a graphics engine that is very powerful, but regrettably almost not explained. Certainly you saw the rotating cube. If not, please execute this statement:

   B3DSceneExplorerMorph new openInWorld

Alternatively, you can open that morph from the WorldMenu. Select the item

That is simple, but from here it is a long way to display the profil of this function:

f(x, y) = (sin(x) + 2)*(cos(2*y) + 1)

Before we do our own work, we will try some modifications of what is available. In instance method initialize of B3DSceneExplorerMorph, find the line that reads

  b3DSceneMorph := AdvancedB3DSceneMorph new.

and add after that line:

  b3DSceneMorph color: Color white.

When you open B3DSceneExplorerMorph now, it comes with a white background.

Next, open class B3DSceneMorph and select instance method createDefaultScene. Find the line:

  sceneObj geometry: (B3DBox from: (-0.7@-0.7@-0.7) to: (0.7@0.7@0.7)).

and replace it with:

  sceneObj geometry: (B3DIndexedMesh vrml97Cylinder).

Open B3DSceneMorph and you will see ...

... something like a small black rectangle, but not exactly a rectangle: The left and the right border are quickly moving. In fact you see a rotating cylinder, but not in its full beauty.

Now open AdvancedB3DSceneMorph. This is a subclass of B3DSceneMorph which adds lights and rotation to a scene. You will see...

... the same thing in green. Try to drag the green object with the mouse. You should be able to move it with the right mouse button and to rotate it with the left mouse button. Now you can convince yourself that the green thing is a cylinder. You will also find, that its top face has a yellow field in the middle.

To remove the green cylinder, call up the handles and click on the handle on the top left corner. It has the help text "remove from screen".

Now open B3DSceneExplorerMorph again. Again you see the green cylinder, but now presented in a window that has a border with five wheels. Grab the lower wheel on the left border and move it. The green thing moves and now you see it from a different viewpoint: It is a cylinder. You should also try the other wheels - aquaintance with the use of the wheels will help you later to inspect other scenes.


It is now a good moment to file in the change sets that are part of this tutorial. To get rid of the changes that you did so far, you may wish first to exit your current image without saving. The files B3DFixes.cs, B3DComments.cs and B3DTutorial.cs can be filed in in any order.

Contents of the Examples File

The tutorial adds the following classes to your image:

The first two classes are helpers for the tutorial, the third class demonstrates an important aspect of geometry definition (that is demonstrated by the examples in B3DDemoSolids), and the four others are the tutorial itself. Look at the class comments to see the statements that you should execute to see the examples. Every example opens a window that shows a short description of the example and the example itself. The methods of every example are grouped into a separate method category to facilitate the examination of the code.

The examples in class B3DDemoSpheres show different possibilities to color a surface. Some examples also show how a scene with several objects is created with geometric operations like scaling and translation.

The examples in class B3DDemoBlockWorld show how simple scenes are created with geometric operations.

The examples in B3DDemoSurfaces show the computation and visualization of surfaces.

The examples in B3DDemoSolids show the use of simple meshes and of geometric objects.


Scenes

A collection of scene objects forms a scene. Scene objects are geometric entities with a visual presentation. A camera is used to look at the scene. Lights are used to illuminate a scene.

Scene Creation

Scene creation is the central task in computer graphics. Typical steps are:

In simple examples all this is done in two or three methods. For real-life problems, it may well be necessary to define classes that can create parts of a scene.

Scene Objects

Scene objects are instances of class B3DSceneObject. Such an instance contains:

A geometry is always needed, all other components of a scene objects are optional.

Object Creation

The class protocol of B3DIndexMesh offers a few methods to create some frequently used geometric bodies like cylinder and sphere, but more often than not it is your responsibility to write methods or even classes for object creation. This may be a formidable task and it requires at least a basic knowledge of geometry.

Object creation always requires the creation of a geometry. Often it requires also the specification of some visual properties of a surface.

Expressions that can be used to create predefined geometric bodies:

These expressions create meshes with geometrically correct vertext normals. It is therefore possible to use these bodies in scenes that use colored lights for surface coloration.

There are two ways to create the geometry of a solid:

The use of meshes is simpler mainly because all meshes implement the method renderOn: that is needed to draw the mesh. When you define a class to represent a geometric entity, you have to implement the instance method renderOn:, too. This requires a fairly good knowledge of the instance protocol of class B3DRenderEngine.

Object Transformations

Object transformations are mathematical operations that resize, translate and rotate geometric objects. Object transformations can be used to assemble scenes from simple geometric objects. Regrettably, the subclasses of B3DGeometry do not implement an uniform transformation protocol.

scaling a geometric object:

   <object> 
     transformBy: (B3DMatrix4x4 identity 
                     setScale: (B3DVector3 x: 0.5 y: 0.5 z: 0.5)).

translation of a geometric object:

   <object>  translateBy: (B3DVector3 x: 0.0  y: 3.0  z: 0.0).

rotation of a geometric object:

   <object> 
     transformBy: (B3DMatrix4x4 
                     withRotation: 45 
                     around: (B3DVector3 x: 0.5 y: 0.5 z: 0.5)).

or:

   <object> 
     transformBy: (B3DMatrix4x4 
                     rotatedBy: 45 
                     around: (B3DVector3 x: 0.5 y: 0.5 z: 0.5)
                     centeredAt: (B3DVector3 x: 1.0 y: 1.0 z: 1.0)).

The messages transformBy: and translateBy: modify the receiver!

Meshes

Meshes are used to model the surfaces of geometric bodies. Meshes use triangles, quadrangles or polygons to approximate curbed surfaces. A variety of different meshes is offered. It is your task to find out what kind of a mesh is best fitted to a given problem. When you find that none of the available meshes is suitable to represent the geometric entity in mind, you will possibly have to define a subclass of B3DGeometry that uses specialized algorithms to represent and to render that geometric entity.

Indexed meshes (classes B3DIndexedQuadMesh and B3DIndexedTriangleMesh) are very suitable to represent computed surfaces like the profil of a function in two variables. A simple mesh (B3DSimpleMesh) is suitable to model polyhedra. To convert a simple mesh into an indexed one, send it the message asIndexedMesh.

Indexed meshes are designed to store the properties of common vertices of adjancent faces only once. Simple meshes do not offer that feature.

Creation of Meshes

An indexed mesh is formed by a collection of vertices (= points in space), and a collection of faces (these are triangles or quadrangles). Optionally, a mesh can have a collection of vertex colors, a collection of vertex normals, a collection of face normals and a collection of texture coordinates. Vertex normals are needed for surface coloration with directed lights.

The vertices are kept in an array and are numbered from 1 up to the number of vertices. A face (here a quadrangle in space) is an instance of B3DIndexedQuad that contains the indices of four vertices. The advantage of this data structure is that vertices are stored only once. The disadvantage is that the programmer has to figure out an algorithm that computes the correct vertex indices for all quadrangles.

Template to compute an indexed mesh of quadrangles

This is a two-step algorithm. In a first step, we compute the spacial points of the mesh. In a second step, we create the quadrangles that form the faces of the mesh. Every quadrangle references four spacial points.

computeQuadGeometryFor: fn

   " fn is required to be a block with two arguments 
     and to return the value of a function f(x, y) at 
     the given arguments. Only the mandatory parts of
     the mesh are created."

   | nroPx nroPy stepPx stepPy x y
     low high xStart xStop yStart yStop idxF
     vtx face faces mesh |

  nroPx := 48.  " number of points in direction x "
  nroPy := 48.  " number of points in direction y "
  xStart := 0.0.
  xStop  := 6.25.
  yStart := 0.0.
  yStop  := 6.25.
  stepPx := xStop - xStart / (nroPx - 1).
  stepPy := yStop - yStart / (nroPy - 1).

  vtx := WriteStream on: (B3DVector3Array new: nroPx * nroPy).
  x := xStart.
  y := yStart.
    " compute the vertices "
  nroPx timesRepeat:
    [y := yStart.
     nroPy timesRepeat:
       [vtx nextPut: (B3DVector3 x: x y: (fn value: x value: y) z: y).
         " here is the right place to compute
           vertex normals and vertext colors.  " 
        y := y + stepPy.  
       ].
      x := x + stepPx. 
    ].

   "  create the quads "
   faces := B3DIndexedQuadArray new: (nroPx - 1)*(nroPy - 1).
   idxF := low := 1.
   1 to: nroPx -1 do: [:i |
     high := low + nroPy.
     1 to: nroPy - 1 do: [:j |
       face := B3DIndexedQuad 
                with: low + j - 1
                with: low + j
                with: high + j
                with: high + j - 1.
       faces at: idxF put: face.
       idxF := idxF + 1.
      ].
     low := high.
   ].

    "  create the mesh  "
   mesh := B3DIndexedQuadMesh new.
   mesh vertices: vtx contents;
        faces: faces.
     " add:  mesh vertexNormals.  here if you need
       vertex normals, but did not compute them earlier. "
  ^mesh

Note that only the mandatory parts of an indexed mesh are created. When you need texture coordinates, face normals or vertex normals, you will have to add the code that is needed to create these features.

Template to compute a mesh of triangles

This is also a two-step algorithm. Its first step - the computation of the spacial points - is the same as for the creation of a quadrangle mesh. The second step is slightly different: Two triangles are created instead of a quadrangle. For greater clarity, the point that is dropped from the quadrangle to create a triangle is written as a comment.

computeTriangleGeometryFor: fn

   " fn is required to be a block with two arguments 
     and to return the value of a function f(x, y) at 
     the given arguments. "

   | nroPx nroPy stepPx stepPy x y
     low high xStart xStop yStart yStop idxF
     vtx face faces mesh |

  nroPx := 48.  " number of points in direction x "
  nroPy := 48.  " number of points in direction y "
  xStart := 0.0.
  xStop  := 6.25.
  yStart := 0.0.
  yStop  := 6.25.
  stepPx := xStop - xStart / (nroPx - 1).
  stepPy := yStop - yStart / (nroPy - 1).

  vtx := WriteStream on: (B3DVector3Array new: nroPx * nroPy).
  x := xStart.
  y := yStart.
    " compute the vertices "
  nroPx timesRepeat:
    [y := yStart.
     nroPy timesRepeat:
       [vtx nextPut: (B3DVector3 x: x y: (fn value: x value: y) z: y).
         " here is the right place to compute
           vertex normals and vertext colors.  " 
        y := y + stepPy.  
       ].
      x := x + stepPx. 
    ].

   "  create the quads "
   faces := B3DIndexedTriangleArray new: (nroPx - 1)*(nroPy - 1)*2.
   idxF := low := 1.
   1 to: nroPx -1 do: [:i |
      high := low + nroPy.
      1 to: nroPy - 1 do: [:j |
         face := B3DIndexedTriangle 
                   with: low + j - 1
                   with: low + j
                   with: high + j
                   "with: high + j - 1".
         faces at: idxF put: face.
         idxF := idxF + 1.
         face := B3DIndexedTriangle 
                   with: low + j - 1
                   "with: low + j"
                   with: high + j
                   with: high + j - 1.
         faces at: idxF put: face.
         idxF := idxF + 1.
        ].
      low := high.
     ].

    "  create the mesh  "
   mesh := B3DIndexedTriangleMesh new.
   mesh vertices: vtx contents;
        faces: faces.
     " add:  mesh vertexNormals.  here if you need
       vertex normals, but did not compute them earlier. "
  ^mesh

Example for the computation of vertex colors:

    vtxColors := WriteStream on: B3DColor4Array new.
    0 to: gridU - 1 do:
     [:idU | | u | 
       u := dU * idU + u1.
       0 to: gridV - 1 do:
         [:idV | | v x y fn |
           vtxColors nextPut:
                      (Color h: 360*(v - v1)/(v2 -  v1)
                             s: 0.6*((u - u1) abs min: (u - u2) abs)/(u2 -  u1) + 0.4
                             v: -0.6*((u - u1) abs min: (u - u2) abs)/(u2 -  u1) + 1.0) asB3DColor
         ].
     ].

Example for the computation of vertex normals:

The partial derivations of a function f(u, v) are needed to compute the normal vector to the surface that is defined by that function. Let f(u, v) be a function in the variables u and v, duf its derivation with respect to variable u, dvf its derivation with respect to variable v. When the surface ist constructed from points (u, f(u, v), v), its normal at point (u, v) is (duf(u, v), -1, dvf(u, v)).

Normals should be normalized; the method safelyNormalize can be used to normalize a vector.

  vtxColors := WriteStream on: (B3DColor4Array new: nroPx * nroPy).
  x := xStart.
  y := yStart.
  nroPx timesRepeat:
    [y := yStart.
     nroPy timesRepeat:
       [vtxNormals
           nextPut:
              (B3DVector3 x: (dufn value: x value: y)
                          y: -1.0
                          z: (dvfn value: x value: y)) safelyNormalized].
        y := y + stepPy.  
       ].
      x := x + stepPx. 
    ].

Note that the computation of vertices, vertex normals and vertex colors can be carried out in one loop.

Structure of indexed meshes

An indexed mesh has these instance variables:

Simple Meshes

A simple mesh is a collection of mesh faces, where a mesh face is a closed polygon. The possibility to use not only triangles or quadrangles, but polygons with an arbitrary number of vertices, makes a simple mesh a suitable structure to model geometric entities that can not easily be modelled as an indexed triangle mesh.

The simple mesh contains only a collection of faces. The face normals are stored in instances of B3DSimpleMeshFace and all vertex-related properties (vertex normal, vertex color, texture coordinats) are stored in instances of B3DSimpleMeshVertex.

Geometric Objects

A geometric object is implemented as a subclass of class B3DGeometry. Such a subclass has to implement the mandatory protocol for geometric objects. The following instance methods are required:

It is highly desirable to implement also the object transformation protocol:

Once you have defined this methods, you can use them to place instances of the geometric object in a scene.

Class B3DBox is an example of a geometric object. Class B3DRegularSolid, which is part of this tutorial, is another, more elaborated example. Instances of B3DRegularSolid represent one of the five Platonic solids. It is possible to individually color faces or vertices.

Hint:

Rendering should be fast. It is not recommended to do any computations in method renderOn:. When this method is called, all needed data should be available and ready for use.

Surface Coloring

The are different possibilities to color a surface. For some purposes it is best to use textures, for others coloration with lights is to be preferred. Vertex coloration gives the best control over surface colors - it is the method of choice for special effects.

The use of textures does not require the computation of vertex normals and this is certainly an advantage. Objects with texture look artificial, but in spite of their artificiality, such scenes can look beautiful. When more realistic scenes are needed, it is more appropriate to color the scene bodies with directed colored lights.

Vertex coloration also does not require the computation of vertex normals. Instances of B3DIndexedTriangleMesh support vertex coloration.

Textures

Texture mapping is a techique to add a visible decoration to a surface.

Regardless of its size, a texture has always coordinates from 0.0 to 1.0 in both the x-direction and the y-direction. 0.0 @ 0.0 is the origin of a texture, 1.0 @ 1.0 is its corner.

Point 0.0 @ 0.0 is mapped to the origin of the underlying form, point 1.0 @ 1.0 is mapped to its corner. Coordinate values larger than 1.0 or smaller than 0.0 are remapped to the range 0.0 to 1.0. This remapping allows for repetition of a texture on a (larger) surface.

A texture is a specialised form. Often, you may wish to file in a suitable bitmap (there are a lot of beautiful bitmaps that are carefully designed for seemless continuation!), but sometimes it is more convenient to compute one. This is not difficult, but you have to know where you can find useful methods. Here is a very simple example:

createTextureWith: firstColor and: lastColor 
  " This method computes a texure with a
    chess board coloring.  "

  | form txt |

  form := Form extent: (32@ 32) depth: 32.
  form fill: (0 @ 0 extent: 16 @ 16) fillColor: firstColor;
       fill: (16 @ 16 extent: 16 @ 16) fillColor: firstColor;
       fill: (0 @ 16 extent: 16 @ 16) fillColor: lastColor;
       fill: (16 @ 0 extent: 16 @ 16) fillColor: lastColor.

  txt := form asTexture. 
  txt wrap: true.
  txt interpolate: false.
  txt envMode: 1.
  ^txt

For the colors Color green and Color lightGreen this method creates a texture with this pattern:

It is highly recommended to begin with a form and to use the method 'asTexture' to convert it into an instance of B3DTexture.

Forms with smoothly changing colors (gradient fill effects) can be programmed with an instance of BalloonCanvas and a kind of a FillStyle:

    |  fill bc |

    fill _ GradientFillStyle ramp: {
        0.0 -> (Color r: 0.85 g: 0.85 b: 0.75).
        1.0 -> (Color r: 0.85 g: 0.5 b: 0.05)}.
    fill origin: (100@100).
    
    fill direction: 70@70.
    fill radial: true.
    bc := BalloonCanvas extent: (200 @ 200) depth: 32.
    bc fillRectangle: (0@0 extent: 200 @ 200)
        fillStyle: fill.

  txt := bc form asTexture.

This texture is useful to wrap a sphere:

The BalloonCanvas is given a Form that is later fetched and used in a texture.

Click here to see additional examples for the use of BalloonCanvas and FillStype.

The instance protocol of Form has simpler methods to create horizontal or vertical gradient fill patterns, these methods are fillFromXColorBlock: and fillFromYColorBlock: .

Materials

A material specifies the visual properties of a surface. Properties included are: own color, shininess, reflection (and absorbtion) of directed and ambient light.

Creation of a Material:

  B3DMaterialColor new
     shininess: <aFloat>;
     emission: <aColor>;
     ambientPart: <aColor>;
     diffusePart: <aColor>;
     specularPart: <aColor>.

Vertex Coloring

For triangle meshes, it is possible to add a color (that is, an instance of B3DColor) to every vertex of the mesh. The triangle coloring is then computed from the colors of its vertices by interpolation. This is the most versatile method to color a surface.

Lights

Lights are used together with materials, which reflect the light. Every light has a color. Usually lights are used together with materials. Meshes with vertex normals are required for all shading algorithms that model absorbtion and reflection of light.

Ambient Light

This is a light that has only a color. When this light is used, it colors the entire scene in a very special way: The ambient light has everywhere the same intensity. It is not recommended to add more than one ambient light to a scene.

Creation of an ambient light:

    ambientLight :=B3DAmbientLight new.
    ambientLight lightColor: (B3DMaterialColor color: (Color r: 0.0 g: 0.1 b: 0.0)).
    scene lights add: ambientLight.

Ambient light is recommended to display solids with a texture or solids with vertex coloring. A white ambient light does not influence the colors of the geometric objects; a colored ambient light may change the object colors.

Directional Light

This light has a color and a direction. The position of the light source is at infinity; the light rays are parallel. The intensity of such a light does not diminish with increasing distance. Three differently colored directional lights from different directions are often a good initial choice to color a scene with lights.

Creation of a directional light:

    light := B3DDirectionalLight new.
    light direction: 10 @ 0 @ 10.	
    light lightColor: (B3DMaterialColor color: (Color r: 0.1 g: 0.2 b: 0.0)).
    scene lights add: light.

Directed light is best used together with a reflecting material, that does not respond to ambient or diffuse light. A good choice for first tests is:

    mat := B3DMaterial new.
    mat shininess: 0.9;
        emission: (Color gray: 0.25);
        specularPart: (Color gray: 0.99). 

Positional Light

A light source of this type has a color and a position. Is has no direction, but emits its light into all directions. (Use spot lights when you need both a position and a direction.) A positional light must have an attenuation. The attenuation defines the reduction of the light intensity at increasing distances.

Creation of a positional light:

     light1 := B3DPositionalLight new.
     light1 position: 100 @ 0 @ 0.
     light1 attenuation: (B3DLightAttenuation constant: 1.0 linear: 0.5 squared: 0.0).
     light1 lightColor: (B3DMaterialColor color: (Color r: 0.8 g: 0.15 b: 0.15)).
     scene lights add: light1.

Spot Light

A spot light is a positional light that is directed to a target and that gives a light cone with a well-defined angle. A colored spot light with a small light angle can be used to color a part of the scene. The light angle is defined by two angles. The region between the minimal and the maximal angles is a region of rapidly decreasing light intensity. For a color spot with a sharp border, both angles should be equal.

Creation of a spotlight:

     light1 := B3DSpotLight new.
     light1 position: 20 @ 0 @ 0;
             direction: 20 negated @ 0 @ 0;
             target: 0 @ 0 @ 0.
     light1 attenuation: (B3DLightAttenuation constant: 1.0 linear: 0.5 squared: 0.2).
     light1 lightColor: (B3DMaterialColor color: (Color r: 0.8 g: 0.15 b: 0.15)).
     light1 minAngle: 3;
             maxAngle: 5.
	scene lights add: light1.

Positional lights and spotlights are part of the scene. When a scene is zoomed or rotated, its lights are rotated together with all other scene objects. The relative positions between lights ans solids remain unchanged under geometric transformation. In other words: We do not have a stage with fixed lights that illuminate a moving scene.

The light color:

There are two ways to specify the light color:
First, the method setColor:, which requires an instance of Color as its argument:

  light setColor: (Color r: 0.7 g: 0.4 b: 0.05)
The color is converted into a B3DMaterialColor where it is used for all three parts of that kind of a color: The ambient part, the diffuse part and the speculat part.

The other way to specify a ligth color is the method lightColor:, which requires an instance of B3DMaterialColor as its argument:

  light lightColor: (B3DMaterialColor color: (Color green))

The Camera

The camera defines the position of the scene observer. The camera has a position and a target. The target is the point that the camera is looking to. An additional property, the field of view (fov) defines the view angle. A change of the fov creates a zoom effect. A small field of view gives a larger picture. Note that a short camera distance and a large fov shows details in the foreground much enlarged (This is known as "fisheye effect"). A longer distance and a smaller fov gives a different perspective that does not enlarge details in the foreground that much.

Protocol of the Render Engine

As long as you use meshes, there is no need to use the protocol of the render engine. When you define geometric objects as subclasses of B3DGeometry, you will have to write methods that tell the render engine how these geometric objects are rendered.

For the purpose of surface rendering, the most important method of the render engine B3DRenderEngine is drawPolygonAfter: <aBlock>.

Example of use:

  renderOn: aRenderer
    
    aRenderer
      normal: faceNormal;
      color: faceColor;	
      drawPolygonAfter:
        [aRenderer
           vertex: vertex1;
           vertex: vertex2;
           vertex: vertex3.
        ].

The methods that preceed the drawPolygonAfter: specify the properties of the polygon to be drawn. The statements within the block are executed before the polygon is drawn. In the example, the polygon vertices of a triangle are sent to the render engine. Within such a block, one can send these methods to the renderer:

The following options can be sent to the render engine:

Practical Considerations

Balloon3D offers many possibilities to create three-dimensional graphics. Before you begin to program an application that uses Balloon3D, you should try to find answers to some important questions:

While it is possible to combine e.g. different methods of surface coloration, it is recommended to choose one method and to specify early what kind of meshes, lights, textures and materials are needed.

When you use textures, you do not need vertex normals. Also, it is sufficient to have an ambient light (preferably one that contains all three basic colors.)

Use with MVC

Balloon3D is not restricted to Morphic. The renderer can draw on any form. Here is the sequence of statements to draw on a form:

	| renderer form extent |

   extent := aPoint.
   form := Form extent: extent depth: 16.
   renderer := (B3DRenderEngine defaultForPlatformOn: form).
   renderer viewport: (0@0 extent: extent);
            clipRect: (0@0 extent: extent);
            clearViewport: Color white;
            clearDepthBuffer.
   scene renderOn: renderer.
   renderer finish;
            destroy.

You can now display the form in a FormView.

Additional Examples for FillStyles

gradientTexture
    | txt fill bc |

   fill _ GradientFillStyle ramp: {
            0.0 -> (Color r: 0.05 g: 0.5 b: 1.0).  "blue" 
            0.5 -> (Color r: 0.70 g: 0.85 b: 1.0). "almost white"
            1.0 -> (Color r: 0.05 g: 0.5 b: 1.0)}. "blue again"
   fill origin: (50@0);    
        direction: 100@0;
        radial: false.
   bc := BalloonCanvas extent: (200 @ 100) depth: 32.
   bc fillRectangle: (0@0 extent: 200 @ 100)
      fillStyle: fill.

  txt := bc form asTexture.
  txt wrap: true.
  txt interpolate: false.
  txt envMode: 1.
  ^txt

This creates a form that can be wrapped around a stick:

The GradientFillStyle uses three colors to describe the smooth change: The start color at value 0.0 is blue, the color at 0.5 (the middle of the ramp) is almost white, the end color is again the blue of the start position. The color change is vertically and starts at x position 50. The region of the change has a width of 100 pixels. A form of width 200 is used to draw the gradient.