Steinmetz with Revolving Camera

From	"luser.droog" <luser.droog@gmail.com>
Newsgroups	comp.lang.postscript
Subject	Steinmetz with Revolving Camera
Date	2012-09-24 09:30 -0500
Organization	unorganized
Message-ID	<k3pqqp$f62$1@dont-email.me> (permalink)
References	(18 earlier) <19l2060m89rf3.qhkwlr9njofj.dlg@40tude.net> <k3be7v$cna$1@dont-email.me> <14ft6rfdwakqg.wjjegxgk9adf$.dlg@40tude.net> <k3bmam$dfd$1@dont-email.me> <k3ok5b$4e0$1@dont-email.me>

Show all headers | View raw

Finally, a rotating view from a little above without skew distortions.
It's less "imposing", but more accurate.

For some reason I had to reverse the visibility test again (gt <=> lt).


549(0)09:27 AM:ps 0> cat 3d5c.ps
%!
%Steinmetz, take 5: NEEDFORSPEED
% O(N) generator makes caching largely irrelevant!
% Bounded faces makes clipping unnecessary
% (which wasn't quite working somehow)
% Improved visibility now shows the Front of the object!
% Eliminated those ugly artifacts
% Random Configurations (with optional "less-random" mode)
% Revolving Camera removes skew distortions
(mat.ps)run

/min { 2 copy gt { exch } if pop } def
/max { 2 copy lt { exch } if pop } def

%Write the vertex array [v1 v2 v3 v4]
%to outfile with embedded drawing command
/writeface {
    out ([) writestring
    [ v1 v2 v3 v4 ]{ % forall vertices
        out ([) writestring
        { % forall coords of vertex
            out exch outbuf cvs writestring
            out ( ) writestring
        } forall
        out ( ) writestring
        out (]) writestring
    } forall
    out (] drawface\n) writestring
    out flushfile
} def

/fudge
1 def
%1.03 def
%Generate the faces of the Forward cylinder
%and eliminate faces outside the chopping cylinders
/steinmetz-gen {
    /N exch def
    /R exch def
    /R^2 R dup mul def
    /h exch def
    /dz 1 N div def
    /dt 360 dz mul def
    /hdz h dz mul def

    0 dt 360 { /t exch def
        %0 dt 180 { /u exch def

        /v1 [
              R t cos mul %u cos mul
              R t sin mul %u cos mul
              0
              %R^2 2 index dup mul sub sqrt neg
              %R^2 2 index dup mul sub sqrt neg max
              ] def
        /v2 [ %v1 aload pop neg
              R t cos mul
              R t sin mul
              R^2 2 index dup mul sub sqrt
              R^2 2 index dup mul sub sqrt min
        ] def
        /t t dt fudge mul add def
        /v3 [
              R t cos mul
              R t sin mul
              R^2 2 index dup mul sub sqrt
              R^2 2 index dup mul sub sqrt min
              ] def
        /v4 [ %v3 aload pop neg
              R t cos mul
              R t sin mul
              0
        ] def
        /face [ v1 v2 v3 v4 ] def
        %face cylyz checkface {
            doface
        %} if
        %face ==

        /v1 [
              R t cos mul %u cos mul
              R t sin mul %u cos mul
              0
              %R^2 2 index dup mul sub sqrt neg
              %R^2 2 index dup mul sub sqrt neg max
              ] def
        /v2 [ %v1 aload pop neg
              R t cos mul
              R t sin mul
              R^2 2 index dup mul sub sqrt neg
              R^2 2 index dup mul sub sqrt neg max
        ] def
        /t t dt fudge mul sub def
        /v3 [
              R t cos mul
              R t sin mul
              R^2 2 index dup mul sub sqrt neg
              R^2 2 index dup mul sub sqrt neg max
              %R^2 2 index dup mul sub sqrt neg max
              ] def
        /v4 [ %v3 aload pop neg
              R t cos mul
              R t sin mul
              0
        ] def
        /face [ v1 v2 v3 v4 ] def
        %face cylyz checkface {
            doface
        %} if

        %} for
    } for
} def

%Action performed by steinmetz-gen
%on each face that survives the chopping
/doface {
    usecache? {
        writeface
    }{
        face drawface
    } ifelse
} def


%This controls the parameters of the
%wireframe approximation of the cylinder
/genfaces {
   % Generate the faces
   %h R N
    4 2 90 steinmetz-gen
} def



%Default modeling transform
/I3 3 ident def
/MO I3 def % model->object
/model {} def
/OW I3 def % object->world

/fill? true def
/fillcolor {} def
/wire? false def
/wirecolor
%{} def
%{0 setgray} def
%{1 setgray} def
{normal light dot 1 add 4 div
    %1 exch sub
    setgray} def
%Perform modeling transform
%Perform object->world transform
%Perform perspective projection
%Check visibility
    %Fill if fill?
    %Draw Outline if wire?
/drawface { DICT begin % [ v1 v2 v3 v4 ]
    /face exch def
    /action { moveto /action { lineto } def } def

    face { % [ x y z ]
        aload 4 1 roll model 4 3 roll astore
        %MO matmul
        dup OW matmul 0 get exch copy pop
    } forall

    { %exitloop
        face visible not { exit } if
        face {
            aload pop
            proj %X Y
            action
        } forall
        closepath
        colorface fillcolor
        fill? { gsave fill grestore } if
        wire? { gsave wirecolor stroke grestore } if
        /flushpage where { pop flushpage } if
        newpath
    exit } loop
end } dup 0 2 dict put bind def

/E [ 3 3 10 ] def %eye point %Replaced by disp/cam get
/crackE { % set pointers into E
    /ex E 0 1 getinterval cvx def
    /ey E 1 1 getinterval cvx def
    /ez E 2 1 getinterval cvx def
} def crackE
/E^ E dup [ exch mag neg dup dup ] { div } vop def %eye center vec

/vistest { lt } def
%Check visibility from the eye
/visible { % [ v1 v2 v3 v4 ] . bool
    dup
    aload pop /v4 exch def /v3 exch def /v2 exch def /v1 exch def
    %dup 0 get 1 index 2 get 2 index 3 get % [] v1 v2 v4
    %2 index { sub } vop % [] v1 v2 v14
    %3 1 roll exch { sub } vop % [] v14 v12
    %cross
    v1 v4{sub}vop
    dup mag 0 eq { pop v1 v3{sub}vop } if
    v1 v2{sub}vop
    dup mag 0 eq { pop v1 v3{sub}vop } if
    cross
    /normal exch def %normal ==
    %/normal [ normal mag dup dup ] { div } vop def
    dup 0 get
    %E
    disp /cam get
    { sub } vop % [] ve1
    /ev exch def %ev ==
    ev normal dot %dup =
    0 vistest % [] bool
    exch pop
} def

/light
%[ -7 12 30 ] def
[ 3 2 7 ] def

/colorface {
    %normal light dot 1 add 3 div setgray
    %face 0 get 90 rotz matmul 0 get
    %aload pop pop %exch
    %dup 0 eq { pop .001 } if
    %atan 360 div 3 div
    fn .33 mul %add
    %.5
    face 0 get -90 rotz matmul 0 get
    aload pop pop exch
    dup 0 eq { pop .001 } if
    atan 360 div 2 div .25 add
    normal light dot 1 add 3 div
    3 { 3 1 roll dup 1 gt { pop 1 } if dup 0 lt { pop 0 } if } repeat
    sethsbcolor
} def

{
/proj { 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 } dup 0 10 dict put bind def
} pop

/disp <<
    /cam [ 0 0 10 ] % Camera position
    /theta [ 0 0 0 ] % Rotation sequence
    /eye [ 0 0 20 ] % Eye relative to image surface
    /Rot I3
    /Rad 50 def
    /Ht 5 def
>> def

/makerot {
    theta 0 get roty
    theta 1 get rotx matmul
    theta 2 get rotz matmul
} def

% Ax Ay Az
/proj { DICT begin
    3 array astore
    %dup == flush
    cam {sub}vop %Camera translation
    %pstack()=
    Rot matmul %Camera rotation
    0 get aload pop % Dx Dy Dz
    eye aload pop % Dx Dy Dz Ex Ey Ez
    %pstack()=
    4 3 roll div % Dx Dy Ex Ey Ez/Dz
    exch neg % Dx Dy Ex Ez/Dz -Ey
    4 3 roll add % Dx Ex Ez/Dz Dy-Ey
    1 index mul % Dx Ex Ez/Dz Ez(Dy-Ey)/Dz
    4 1 roll 3 1 roll % Ez(Dy-Ey)/Dz Ez/Dz Dx Ex
    sub mul exch % Ez(Dx-Ex)/Dz Ez(Dy-Ey)/Dz
    %pstack ()=
end } dup 0 disp put bind def


/revcam {
    disp begin
        /ang exch def
        /cam [
            ang neg sin Rad mul
            Ht
            ang neg cos Rad mul %neg
        ] def
        /theta [
            ang neg
            %180 add
            Ht Rad atan %neg
            0
        ] def
        %2 copy get ang add put
        /Rot makerot def
    end
} def


/setuppage {
    310 -600 translate
    1 250 dup dup scale div 2 div setlinewidth
    2 setlinejoin
} def

/usecache? false def
usecache? { % Generate Data File to cache the faces
    /data (stein.fac) def
    {
        /in data (r) file def
    } stopped {
        pop pop pop%clear
        /out data (w) file def
        /outbuf 128 string def
        genfaces
        flush out closefile
        /out null def
        /in data (r) file def
    } if
    /reopen { in closefile /in data (r) file def } def
    /drawshape { in cvx exec reopen } def
}{ % Generate fresh data for each shape
    /drawshape { genfaces } def
} ifelse

/up 90 rotx def
/left 90 roty def

/front { /vistest { gt } def } def
/back { /vistest { lt } def } def

/drawsolid {
    /fn 0 def
    /model {} def % x y z -> x y z
    drawshape

    /fn 1 def
    /model { neg exch } def % x y z -> x -z y
    morerandom? { randconfig } if
    drawshape

    /fn 2 def
    /model { neg 3 1 roll exch } def % x y z -> -z y x
    morerandom? { randconfig } if
    drawshape
} def

/rbool { rand 2 mod 0 eq } def

/randconfig {
    cage? {
        /vistest load 0 get /lt eq { %back
            /fill? true def
            /wire? rbool def
        }{ %front
            /fill? false def
            /wire? true def
        } ifelse
    }{ %at least one of wire?,fill?
        true rbool
        rbool { exch } if /fill? exch def /wire? exch def
    } ifelse
    [{} {} {} {} {} %{0 setgray} {0 setgray}
    %{1 setgray} {1 setgray} {1 setgray}
    {normal light dot 1 add 4 div setgray}
    {normal light dot 1 add 4 div 1 exch sub setgray}
    { 1 currentgray sub setgray }
    { currenthsbcolor exch pop .5 exch sethsbcolor }
    { currenthsbcolor 3 2 roll .33 add dup 1 gt {1 sub} if
        3 1 roll exch pop .5 exch sethsbcolor }
    { currenthsbcolor 1 exch sub sethsbcolor }
    { currentrgbcolor exch 1 exch sub exch setrgbcolor }
    { currenthsbcolor setrgbcolor }
    { currentrgbcolor sethsbcolor }
    { currentrgbcolor 3 1 roll exch setrgbcolor }
    //colorface //colorface //colorface //colorface //colorface
    ] dup
        dup length rand exch mod get /wirecolor exch def
        dup length rand exch mod get /fillcolor exch def
    currentlinewidth .2 rand 6 mod 3 div add mul setlinewidth
    /fudge 1 rand 10 mod 100 div add def
} def

/morerandom? false def
/cage? true def

/axes { %neg:black/white  pos:white/black
    gsave currentlinewidth 2 mul setlinewidth
    -2 0 0 proj moveto
    0 0 0 proj lineto
    gsave currentlinewidth 2 mul setlinewidth stroke grestore
    0 setgray currentpoint stroke moveto
    2 0 0 proj lineto
    gsave currentlinewidth 2 mul setlinewidth stroke grestore
    1 setgray stroke

    0 -2 0 proj moveto
    0 0 0 proj lineto
    gsave currentlinewidth 2 mul setlinewidth stroke grestore
    0 setgray currentpoint stroke moveto
    0 2 0 proj lineto
    gsave currentlinewidth 2 mul setlinewidth stroke grestore
    1 setgray stroke

    0 0 -2 proj moveto
    0 0 0 proj lineto
    gsave currentlinewidth 2 mul setlinewidth stroke grestore
    0 setgray currentpoint stroke moveto
    0 0 2 proj lineto
    gsave currentlinewidth 2 mul setlinewidth stroke grestore
    1 setgray stroke
    grestore
} def

%/randconfig {} /rndcfg /randconfig load def def
%rndcfg
%1536830211 srand
1887638 srand
/ang 0 def
{
    %/OW ang roty def
    ang revcam
    /ang ang 3 add def
    rrand =

    setuppage

    %/fill? true def
    %/wire? true def
    %/wirecolor { 1 currentgray sub setgray } def
    back
    randconfig
    drawsolid

    axes

    %/fill? false def
    %/wire? true def
    %/wirecolor {} def
    %2 setlinewidth
    %currentlinewidth 2 mul setlinewidth
    front
    randconfig
    drawsolid

    pstack flush %cya
    %disp === [ v1 dup == aload pop proj ] ==

    %pause for applause
    500000 { 100 dup cos exch sin exch atan pop } repeat
    showpage
    %exit
} loop

Back to comp.lang.postscript | Previous | Next — Previous 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