Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.postscript > #956

Re: A shaded cylinder

Show all headers | View raw

Here's a small improvement over the previous.
Three cylinders each chopped by the other two.
Color selected by (hue,sat,bright) = 
(model-theta, model-z, that-light-model-I-found)
One unfortunate effect is changing the resolution
really messes up your lighting.

I've got it set-up to grow "out of nowhere"
dramatically by setting the depth of the approximation
by the fibonacci sequence. dep=8 is curiously invisible.
And it starts to take shape around 89.


534(1)02:56 PM:ps 0> cat 3d4.ps
%!
%Steinmertz solid (?)

%(mat.ps) run
%!
%mat.ps
%Matrix and Vector math routines

/.error where { pop /signalerror { .error } def } if

/dot { % u v
    2 copy length exch length ne {
        /dot cvx /undefinedresult signalerror
    } if
    % u v
    0 % u v sum
    0 1 3 index length 1 sub { % u v sum i
        3 index 1 index get exch % u v sum u_i i
        3 index exch get % u v sum u_i v_i
        mul add % u v sum
    } for % u v sum

    3 1 roll pop pop % sum
} bind def

% [ x1 x2 x3 ] [ y1 y2 y3 ]  cross  [ x2*y3-y2*x3 x3*y1-x1*y3 x1*y2-x2*y1 ]
/cross { % u v
    dup length 3 ne
    2 index length 3 ne or {
        /cross cvx /undefinedresult signalerror
    } if
    % u v
    exch aload pop 4 3 roll aload pop % x1 x2 x3 y1 y2 y3
    [
        5 index 2 index mul % ... [ x2*y3
        3 index 6 index mul sub % ... [ x2*y3-y2*x3
        5 index 5 index mul % ... [ x2*y3-y2*x3 x3*y1
        8 index 4 index mul sub % ... [ x2*y3-y2*x3 x3*y1-x1*y3
        8 index 5 index mul % ... [ x2*y3-y2*x3 x3*y1-x1*y3 x1*y2
        8 index 7 index mul sub % ... [ x2*y3-y2*x3 x3*y1-x1*y3 x1*y2-x2*y1
    ]
    7 1 roll 6 { pop } repeat
} bind def

/transpose { STATICDICT begin
    /A exch def
    /M A length def
    /N A 0 get length def
    [
    0 1 N 1 sub { /n exch def
        [
        0 1 M 1 sub { /m exch def
            A m get n get
        } for
        ]
    } for
    ]
end } dup 0 6 dict put def

/matmul { STATICDICT begin
    /B exch def
    B 0 get type /arraytype ne { /B [B] def } if
    /A exch def
    A 0 get type /arraytype ne { /A [A] def } if
    /Q B length def
    /R B 0 get length def
    /P A length def
    Q A 0 get length ne {
        /A A transpose def
        /P A length def
        Q A 0 get length ne {
            A B end /matmul cvx /undefinedresult signalerror
        } if
    } if

    [
        0 1 P 1 sub { /p exch def
        [
    0 1 R 1 sub { /r exch def
            0
            0 1 Q 1 sub { /q exch def
                A p get q get
                B q get r get mul
                add
            } for
        } for
        ]
    } for
    ]

end } dup 0 10 dict put def

%u v {operator}  vop  u(op)v
%apply a binary operator to corresponding elements
%in two vectors producing a third vector as result
/vop { 1 dict begin
    /op exch def
    2 copy length exch length ne {
        /vop cvx end /undefinedresult signalerror
    } if

    [ 3 1 roll % [ u v
    0 1 2 index length 1 sub { % [ ... u v i
        3 copy exch pop get % u v i u_i
        3 copy pop get      % u v i u_i v_i
        op exch pop         % u v u_i(op)v_i
        3 1 roll            % u_i(op)v_i u v
    } for % [ ... u v
    pop pop ]

end } def

%length of a vector
/mag { 0 exch { dup mul add } forall } def


/prep {
    transform
    2 {
        exch
        %floor
        round
        %ceiling
        %2 mul cvi 2 div %round
    } repeat
    itransform
} def

% x y z ang -> x y' z'
/rotx { 3 dict begin
    /theta exch def
    /z exch def
    /y exch def
    y theta cos mul
    z theta sin mul sub
    y theta sin mul
    z theta cos mul add
end } def

% x y z ang -> x' y z'
/roty { 4 dict begin
    /theta exch def
    /z exch def
    /y exch def
    /x exch def
    x theta cos mul
    z theta sin mul add
    y
    x theta sin mul neg
    z theta cos mul add
end } def

% x y z ang -> x' y' z
/rotz { 4 dict begin
    /theta exch def
    /z exch def
    /y exch def
    /x exch def
    x theta cos mul
    y theta sin mul sub
    x theta sin mul
    y theta cos mul add
    z
end } def

% x y z -> x' y' z'
/model {
%ang roty
%ang .25 mul rotx
%alpha rotz
beta roty
gamma rotx
} def

% Eye coords
/ex 3 def
/ey 3 def
/ez 10 def
/eyedir [ex ey ez]
    dup mag [ exch dup dup ]{div} vop
def

% x y z -> X Y
/project {
3 dict begin
    /z exch def
    /y exch def
    /x exch def
    1 ez z sub div
    x ez mul z ex mul sub
    1 index mul
    y ez mul z ey mul sub
    3 2 roll mul
end } def

/light
    [ 3 -7 -4 1 ]
    %dup mag [ exch dup dup dup ]{div} vop
def
/Ia .4 def % Incident Ambient Intensity
/Ka .5 def % Ambient Diffuse reflection constant
/Il .3 def % Incident intensity of Lightsource
/Kd .4 def % Diffuse reflection constant

/front { 0 gt } def
/wirecolor
{ .5 .5 .5 sethsbcolor } def %medium-green wirecolor
%{} def %use fill-color as wirecolor
/wire? true def
/fill? true def
%/fudge 1.0 def
/fudge 1.03 def
%/fudge 1.06 def
%h R N
/cylinder { 20 dict begin
    %/facen 0 def
    /N exch def
    /R exch def
    /h exch def
    /dz 1 N div def
    /dt 360 dz mul def
    /fdt dt fudge mul def
    /hdz h dz mul def
    /fhdz hdz fudge mul def

    0 dz 1 dz sub {
        h mul h 2 div sub /z exch def

        0 dt 360 { /t exch def
            % Generate a small face on x^2+y^2=R^2
            % by x = cos, y = sin, z = z
            % w = dz, h ~= k*dt
            %/facen facen 1 add def
            /v1 [ t cos R mul
                t sin R mul
                z ] def
            /v4 [ v1 aload pop pop
                z fhdz add ] def
            /t t fdt add def
            /v2 [ t cos R mul
                t sin R mul
                z ] def
            /v3 [ v2 aload pop pop
                z fhdz add ] def

            % Check if face is inside
            % x^2+z^2=R^2 and y^2+z^2=R^2
            true [ v1 v2 v3 v4 ] {
                aload pop
                3 { 3 1 roll dup mul } repeat % x^2 y^2 z^2
                dup 4 1 roll % z x y z
                R dup mul dup 6 1 roll % r z x y z r
                3 1 roll add exch lt % r z x yz<r
                4 1 roll add exch lt % yz<r zx<r
                and and
            } forall % bool %within bounds of the other 2 cylinders

            { %if

            % Perform model->world transform
            [ v1 v2 v3 v4 ] {
                aload 4 1 roll model 4 3 roll astore pop
            } forall

            % Calculate normal vector in World coords
            /normal v4 v1 {sub} vop
                    v2 v1 {sub} vop
                    cross def
            /nlen normal mag def
            /normal normal [nlen nlen nlen] {div} vop def

            % Check visibility of a point on the face
            %/front { 0 gt } def
            normal v1 [ex ey ez] {sub} vop dot
            front % bool %facing the eye?

            % Draw the face
            { %if
        %[ v1 v2 v3 v4 ] ==
                % Draw the projected path
                /action { moveto /action { lineto } def } def
                %facen 2 mod 0 eq {
                [ v1 v2 v3 v4 ]
                %} {[ v1 v4 v3 v2 ]} ifelse
                { aload pop project
        %2 copy 2 array astore ==
                    prep
                    action }
                forall
                closepath
        %()= flush


                % Calculate illumination
                t 360 div  % hue
                z h 2 div add h div % sat

                [normal aload pop 1]
                light
                %[ex ey ez neg 1] %"radiant"
                dot
                Il
                1 light 0 3 getinterval
                v1 { sub } vop mag div mul
                Kd mul mul
                Ia Ka mul add
                %.2 add
                dup 1 gt { pop 1 } if
                %setgray % bright
                sethsbcolor

                % Draw according to control bools
                wire? { gsave wirecolor stroke grestore } if
                fill? { gsave
                    fill
                    %/flushpage where{pop flushpage}if
                grestore } if
                newpath

            } if % visible

            } if % inside other two cylinders

        } for % dt 0..360
    } for % dz
end } def % cylinder

/depp 0 def
/dep 1 def
{
    %/dep 1 add
    /dep dep depp add /depp dep def def %fibonacci
    (dep = )print dep =

300 400 translate
280 dup dup moveto
dup neg dup neg lineto
dup neg dup lineto
dup neg lineto closepath
.6 setgray
fill
1 70 dup dup scale div setlinewidth

%/front { 0 lt } def
/beta 0 def
/gamma 0 def
4 2 dep cylinder

%/front { 0 gt } def
/beta 90 def
/gamma 0 def
4 2 dep cylinder

/beta 0 def
/gamma 90 def
4 2 dep cylinder

showpage

} loop

Back to comp.lang.postscript | Previous | Next — Previous in thread | Next in thread | Find similar

Thread

ping luser- -droog: SVG or PS project for you? tlvp <mPiOsUcB.EtLlLvEp@att.net> - 2012-07-17 04:48 -0400
  Re: ping luser- -droog: SVG or PS project for you? luser- -droog <mijoryx@yahoo.com> - 2012-07-17 08:16 -0700
    Re: ping luser- -droog: SVG or PS project for you? tlvp <mPiOsUcB.EtLlLvEp@att.net> - 2012-07-17 19:25 -0400
  Re: ping luser- -droog: SVG or PS project for you? luser- -droog <mijoryx@yahoo.com> - 2012-08-17 23:40 -0700
    Re: ping luser- -droog: SVG or PS project for you? luser- -droog <mijoryx@yahoo.com> - 2012-08-18 00:14 -0700
      Re: ping luser- -droog: SVG or PS project for you? tlvp <mPiOsUcB.EtLlLvEp@att.net> - 2012-08-18 22:44 -0400
        Moire Madness! Re: ping luser- -droog: SVG or PS project for you? luser- -droog <mijoryx@yahoo.com> - 2012-08-23 13:00 -0700
          Re: Moire Madness! Re: ping luser- -droog: SVG or PS project for you? tlvp <mPiOsUcB.EtLlLvEp@att.net> - 2012-08-24 01:45 -0400
            Re: Moire Madness! Re: ping luser- -droog: SVG or PS project for you? tlvp <mPiOsUcB.EtLlLvEp@att.net> - 2012-08-24 01:49 -0400
            Re: Moire Madness! Re: ping luser- -droog: SVG or PS project for you? luser- -droog <mijoryx@yahoo.com> - 2012-08-23 23:11 -0700
              Re: Moire Madness! Re: ping luser- -droog: SVG or PS project for you? luser- -droog <mijoryx@yahoo.com> - 2012-08-23 23:58 -0700
                Re: Moire Madness! Re: ping luser- -droog: SVG or PS project for you? tlvp <mPiOsUcB.EtLlLvEp@att.net> - 2012-08-25 02:17 -0400
                Re: Moire Madness! Re: ping luser- -droog: SVG or PS project for you? Luser droog <mijoryx@yahoo.com> - 2012-08-29 18:25 -0500
                Re: Moire Madness! Re: ping luser- -droog: SVG or PS project for you? Luser droog <mijoryx@yahoo.com> - 2012-08-29 21:32 -0500
                Re: Moire Madness! Re: ping luser- -droog: SVG or PS project for you? tlvp <mPiOsUcB.EtLlLvEp@att.net> - 2012-08-30 05:26 -0400
                Hula-Hoop Hullaballoo! Re: ping luser- -droog: SVG or PS project for you? Luser droog <mijoryx@yahoo.com> - 2012-09-02 16:04 -0500
                Re: Hula-Hoop Hullaballoo! Re: ping luser- -droog: SVG or PS project for you? Luser droog <mijoryx@yahoo.com> - 2012-09-03 12:29 -0500
                Re: Hula-Hoop Hullaballoo! Re: ping luser- -droog: SVG or PS project for you? Luser droog <mijoryx@yahoo.com> - 2012-09-04 12:04 -0500
                Re: Hula-Hoop Hullaballoo! Re: ping luser- -droog: SVG or PS project for you? "M. Joshua Ryan" <mijoryx@yahoo.com> - 2012-09-04 12:49 -0500
                A shaded cylinder luser- -droog <mijoryx@yahoo.com> - 2012-09-04 18:11 -0700
                Re: A shaded cylinder luser- -droog <mijoryx@yahoo.com> - 2012-09-11 13:03 -0700
                Spinning Steinmertz Solid (approx.) luser- -droog <mijoryx@yahoo.com> - 2012-09-11 21:29 -0700
                Mulligan (again) luser- -droog <mijoryx@yahoo.com> - 2012-09-13 19:07 -0700
                Re: Mulligan (again) tlvp <mPiOsUcB.EtLlLvEp@att.net> - 2012-09-14 05:05 -0400
                Heineken time "luser.droog" <luser.droog@gmail.com> - 2012-09-15 16:50 -0500
                Bigger and Badderer "luser.droog" <luser.droog@gmail.com> - 2012-09-16 23:33 -0500
                Re: Bigger and Badderer "luser.droog" <luser.droog@gmail.com> - 2012-09-16 23:37 -0500
                QapplaH! "luser.droog" <luser.droog@gmail.com> - 2012-09-17 11:34 -0500
                Re: QapplaH! (appendix: updated mat.ps) "luser.droog" <luser.droog@gmail.com> - 2012-09-17 13:05 -0500
                one more cup of coffee for the road. "luser.droog" <luser.droog@gmail.com> - 2012-09-18 02:51 -0500
                Re: Bigger and Badderer tlvp <mPiOsUcB.EtLlLvEp@att.net> - 2012-09-18 21:52 -0400
                Re: Bigger and Badderer "luser.droog" <luser.droog@gmail.com> - 2012-09-18 22:30 -0500
                Re: Bigger and Badderer tlvp <mPiOsUcB.EtLlLvEp@att.net> - 2012-09-19 00:59 -0400
                Re: Bigger and Badderer "luser.droog" <luser.droog@gmail.com> - 2012-09-19 00:48 -0500
                Revolving Camera prototype "luser.droog" <luser.droog@gmail.com> - 2012-09-23 22:30 -0500
                Steinmetz with Revolving Camera "luser.droog" <luser.droog@gmail.com> - 2012-09-24 09:30 -0500

csiph-web