3D レンダリング

{import * from CURL.GRAPHICS.RENDERER3D}
||define a simple repaint handler procedure
{define-proc {primitive-proc
                 rg:Renderer3dGraphic,
                 ren:Renderer3d,
                 area:#RectangleSet}:void
    let d:Drawable={non-null rg.drawable}
    {render-primitive
        p:Primitive,
        type=Primitive.triangles
        on ren do
        {p.color3 1.0, 0, 0} || red
        {p.vertex2 0in, 1in}
        {p.vertex2 1in, 0in}
        {p.vertex2 1in, 2in}

        {p.color3 0, 1.0, 0} || green
        {p.vertex2 1in, 0in}
        {p.vertex2 1in, 2in}
        {p.vertex2 2in, 1in}
    }
}
||create a Renderer3dGraphic,
||passing that procedure as repaint-handler
{Renderer3dGraphic repaint-handler=primitive-proc}
       

{import * from CURL.GRAPHICS.STANDARD}
{import * from CURL.GRAPHICS.RENDERER3D}
{import * from CURL.GUI.STANDARD}

{define-class public final MyFill {inherits Fill}

  field public drawable:#Drawable
  field public renderer:#Renderer3d

  {constructor public {default ...}
    {construct-super
        {on AttachEvent do
            || Create Drawable.
            {assert self.drawable == null}
            set (self.renderer, self.drawable) = {Renderer3d.create-offscreen 2in, 2in}

            || The following code is necessary because Drawables
            || can lose their contents for a number of reasons,
            || including the activation of a screensaver. If this
            || situation is not handled this way, the applet pops
            || up a dialog notifying the user, which is usually
            || not desirable.  All that is necessary is to repaint
            || the entire drawable.
            set self.drawable.forced-redraw-handler =
                {proc {}:void
                    {self.draw-into-offscreen-drawable}
                }

            {self.draw-into-offscreen-drawable}
            
        },
        {on DetachEvent do
            || Destroy Drawable.
            {self.drawable.destroy}
            set self.drawable = null
            set self.renderer = null
        },
        ...
    }


  }

  {method public final {draw r2d:Renderer2d}:void
    let grect:GRect = {self.layout.get-bounds}

    let width:Distance = grect.rextent + grect.lextent
    let height:Distance = grect.ascent + grect.descent

    || Translate by -width/2 and -height/2 because Fill's
    || internal idea of its origin, for purposes of drawing,
    || is in its center.
    {with-render-properties translation =
        {Distance2d -width/2, -height/2}
        on r2d do
        {r2d.render-drawable
            0m, 0m, width, height, {non-null self.drawable}
        }
    }
  }

  {method private {draw-into-offscreen-drawable}:void

    let r:Renderer3d = {non-null self.renderer}

    {render-primitive p:Primitive, type = "quads" on r do
        || red
        {p.color3 1.0, 0.0, 0.0}
        {p.vertex2 .5in, .5in}

        || green
        {p.color3 0.0, 1.0, 0.0}
        {p.vertex2 .5in, 1.5in}

        || blue
        {p.color3 0.0, 0.0, 1.0}
        {p.vertex2 1.5in, 1.5in}

        || yellow - oh yeah
        {p.color3 1.0, 1.0, 0.0}
        {p.vertex2 1.5in, .5in}

    }
  }
}


{let myfill:MyFill = {MyFill width = 2in, height = 2in}}
{value myfill}

{import * from CURL.GRAPHICS.SCENE}

{define-proc public
    {sphere-vertices-normals hres:int, vres:int}:
    ({Array-of FloatDistance3d}, {Array-of FloatDirection3d})
    let vertices:{Array-of FloatDistance3d} =
        {{Array-of FloatDistance3d}.from-size
            (hres + 1) * (vres + 1),
            {FloatDistance3d 0f(m), 0f(m), 0f(m)}
        }
    let normals:{Array-of FloatDirection3d} =
        {{Array-of FloatDirection3d}.from-size
            (hres + 1) * (vres + 1),
            {FloatDirection3d 0, 0, 0}
        }
    let n:int = 0
    {for i:int = 0 to hres do
        {for j:int = 0 to vres do
            let azimuth:FloatAngle = -180f(deg) + i * 360f(deg)/hres
            let elevation:FloatAngle =  -90f(deg) + j * 180f(deg)/vres
            set vertices[n] =
                {FloatDistance3d
                    ({cos azimuth} * {cos elevation}) * 1f(in),
                    ({sin azimuth} * {cos elevation}) * 1f(in),
                    ({sin elevation}) * 1f(in)
                }
            set normals[n] = vertices[n]/1f(in)
            {inc n}
        }
    }
    {return vertices, normals}
}
{define-proc public
    {mesh-faces hres:int, vres:int}:#{Array-of #{Array-of int}}
    let faces:#{Array-of #{Array-of int}} =
        {{Array-of #{Array-of int}}.from-size hres * vres, null}
    let n:int = 0
    {for i:int = 0 to hres - 1 do
        {for j:int = 0 to vres - 1 do
            set faces[n] =
                {new {Array-of int},
                    i       * (vres + 1) + j,
                    (i + 1) * (vres + 1) + j,
                    (i + 1) * (vres + 1) + j + 1,
                    i       * (vres + 1) + j + 1
                }
            {inc n}
        }
    }
    {return faces}
}
{define-class public Sphere {inherits PolygonSet}

  field hres:int
  field vres:int
  {constructor public {default
                          hres:int = 20,
                          vres:int = 10,
                          ...}
    {construct-super ... }
    set self.hres = hres
    set self.vres = vres
    set (self.vertices, self.normals) =
        {sphere-vertices-normals hres, vres}
    set self.faces = {mesh-faces hres, vres}
  }
  {method open public
    {paint renderer:Renderer3d,
        viewport-width:Distance, viewport-height:Distance}:void
    {with
        renderer.cull-face-enabled? = true
     do
        {super.paint renderer, viewport-width, viewport-height}
    }

  }
  {method open public
    {get-local-bounding-box
        check-visibility?:bool = false
    }:(min-xyz:Distance3d,
       max-xyz:Distance3d,
       valid-bounds?:bool)
    {return
        {Distance3d -1in, -1in, -1in},
        {Distance3d 1in, 1in, 1in},
        not check-visibility? or self.bounding-box-or-object-visible?
    }
  }
}
{value
    let scene:Scene = {Scene}
    let camera:Camera = scene.camera
    let camera-target:Distance3d = {Distance3d 0ft, 0ft, 0ft}
    let camera-position:Distance3d = {Distance3d 2in, -1in, 2in}
    let camera-direction:Direction3d =
        {(camera-target - camera-position).direction}
    let up:Direction3d = {Direction3d 0, 0, 1}
    {camera.set-orientation-and-position
        camera-direction, up, position = camera-position}
    set camera.projection = Projection.perspective
    set camera.near-clipping-plane = 1in
    set camera.far-clipping-plane = 20ft
    set camera.field-of-view = 90degrees
    let dir-light-color:Color = {Palette.get-magenta} ||magenta
    let dir-light:DirectionalLight =
        {DirectionalLight
            direction =  {Direction3d -1, 0, 0},
            diffuse-color = dir-light-color,
            specular-color = dir-light-color
        }
    {scene.add-object dir-light}
    let sphere:Sphere =
        {Sphere
            lighting-enabled? = true,
            hres = 50, vres = 25,
            fill-pattern = {FillPattern.get-white}
        }
    {scene.add-object sphere}
    let scene-graphic:SceneGraphic =
        {SceneGraphic
            scene,
            width=2in,
            height=2in,
            background = {FillPattern.get-black}
        }
    scene-graphic
}

{import * from CURL.GRAPHICS.RENDERER3D}
{value
    let fp:FillPattern =
        {FillPattern.from-url {url "curl://install/docs/default/images/adria.jpg"}}

    {mutate-fill-pattern renderer:Renderer3d on fp do
        {render-primitive p:Primitive, type="triangles"
            on renderer do
            {p.color3 1.0, 0, 0} || red
            {p.vertex2 0in, 1in}
            {p.vertex2 1in, 0in}
            {p.vertex2 1in, 2in}

            {p.color3 0, 1.0, 0} || green
            {p.vertex2 1in, 0in}
            {p.vertex2 1in, 2in}
            {p.vertex2 2in, 1in}
        }
    }
    || display the FillPattern in a Frame
    {Frame width=2in, height=2in, background=fp}
}