%% %% This is file `pst-3dplot.pro', %% %% IMPORTANT NOTICE: %% %% Package `pst-3dplot.tex' %% %% Herbert Voss %% %% This program can be redistributed and/or modified under the terms %% of the LaTeX Project Public License Distributed from CTAN archives %% in directory macros/latex/base/lppl.txt. %% %% DESCRIPTION: %% `pst-3dplot' is a PSTricks package to draw 3d curves and graphical objects %% %% %% version 0.23 / 2007-08-18 Herbert Voss % /tx@3DPlotDict 50 dict def tx@3DPlotDict begin % /printDot { gsave 2 copy 2 0 360 arc fill stroke grestore } def % /saveCoor { dzUnit mul /z exch def dyUnit mul /y exch def dxUnit mul /x exch def } def % /ConvertTo2D { RotatePoint 1 { % dummy loop, will run only 1 time coorType 0 le { % the default | /x2D x leftHanded not { neg } if Alpha cos mul y Alpha sin mul add def % /\ co system /y2D x leftHanded { neg } if Alpha sin mul y Alpha cos mul add neg Beta sin mul z Beta cos mul add def exit } if coorType 1 le { /x2D y x Alpha 90 sub sin mul sub def % |/_ co system, no shortened x axis /y2D z x Alpha 90 sub cos mul sub def exit } if coorType 2 le { % coorType |/_ with a 1/sqrt(2) shortend x-axis and 135 degrees /x2D y x 0.5 mul sub def /y2D z x 0.5 mul sub def exit } if } repeat } def % /Conv3D2D { /z ED /y ED /x ED ConvertTo2D x2D y2D } def % /ConvertToCartesian { /latitude exch def /longitude exch def /Radius exch def /z { Radius latitude sin mul } def /x { Radius longitude cos mul latitude cos mul } def /y { Radius longitude sin mul latitude cos mul } def } def % /ConvCylToCartesian { % r phi h -> x y z 3 1 roll % h r phi /Phi ED /Radius ED % h->z on stack Radius Phi cos mul exch % x z Radius Phi sin mul exch % x y z } def % /SphericalTo2D { x y z ConvertToCartesian ConvertTo2D } def % /CylinderTo2D { % r phi h x y z ConvCylToCartesian ConvertTo2D } def % /convertStackTo2D { counttomark /n exch def /n3 n 3 div cvi def n3 { n -3 roll SphericalCoor { ConvertToCartesian } { saveCoor } ifelse ConvertTo2D x2D xUnit y2D yUnit /n n 1 sub def } repeat } def % % /CalcCoordinates {% from pst-vue3d formulesTroisD Xi 28.45 mul Yi 28.45 mul } def % pour la 3D conventionnelle /formulesTroisD{% /xObservateur x Sin1 mul neg y Cos1 mul add def /yObservateur x Cos1Sin2 mul neg y Sin1Sin2 mul sub z Cos2 mul add def /zObservateur x neg Cos1Cos2 mul y Sin1Cos2 mul sub z Sin2 mul sub def /Xi xObservateur zObservateur Div def /Yi yObservateur zObservateur Div def } def % /RotatePointXYZ{% Mxx are defined in the TeX file /xi M11 x mul M12 y mul add M13 z mul add def /yi M21 x mul M22 y mul add M23 z mul add def /zi M31 x mul M32 y mul add M33 z mul add def /x xi def /y yi def /z zi def } def % /RotXaxis { /yTemp y RotX cos mul z RotX sin mul sub def /z y RotX sin mul z RotX cos mul add def /y yTemp def } def /RotYaxis { /xTemp x RotY cos mul z RotY sin mul add def /z x RotY sin mul neg z RotY cos mul add def /x xTemp def } def /RotZaxis { /xTemp x RotZ cos mul y RotZ sin mul sub def /y x RotZ sin mul y RotZ cos mul add def /x xTemp def } def /xyz { RotXaxis RotYaxis RotZaxis } def /yxz { RotYaxis RotXaxis RotZaxis } def /yzx { RotYaxis RotZaxis RotXaxis } def /xzy { RotXaxis RotZaxis RotYaxis } def /zxy { RotZaxis RotXaxis RotYaxis } def /zyx { RotZaxis RotYaxis RotXaxis } def % /RotatePoint { RotSequence cvx exec } def % /VecNorm { 0 exch { dup mul add } forall sqrt } def % /UnitVec { % on stack is [a]; returns a vector with [a][a]/|a|=1 dup VecNorm /norm ED { norm div } forall 3 array astore } def % /AxB { % on the stack are the two vectors [a][b] aload pop /b3 ED /b2 ED /b1 ED aload pop /a3 ED /a2 ED /a1 ED a2 b3 mul a3 b2 mul sub a3 b1 mul a1 b3 mul sub a1 b2 mul a2 b1 mul sub 3 array astore } def % /AaddB { % on the stack are the two vectors [a][b] aload pop /b3 ED /b2 ED /b1 ED aload pop /a3 ED /a2 ED /a1 ED a1 b1 add a2 b2 add a3 b3 add 3 array astore } def % /AmulC { % on stack is [a] and c; returns [a] mul c /factor ED { factor mul } forall 3 array astore } def % % % 3D objects /tx@ProjThreeD {% adopted from pst-3d /z ED /y ED /x ED Matrix3D aload pop z mul exch y mul add exch x mul add 4 1 roll z mul exch y mul add exch x mul add exch } def % /setColorLight { % expects 7 values on stack C M Y K xL yL zL % les rayons de lumière xLight dup mul yLight dup mul zLight dup mul add add sqrt /NormeLight ED % the color values /K exch def /Yellow exch def /Magenta exch def /Cyan exch def } def % /facetteSphere { newpath /Xpoint Rsphere theta cos mul phi cos mul CX add def /Ypoint Rsphere theta sin mul phi cos mul CY add def /Zpoint Rsphere phi sin mul CZ add def Xpoint Ypoint Zpoint tx@ProjThreeD moveto theta 1 theta increment add {% /theta1 exch def /Xpoint Rsphere theta1 cos mul phi cos mul CX add def /Ypoint Rsphere theta1 sin mul phi cos mul CY add def /Zpoint Rsphere phi sin mul CZ add def Xpoint Ypoint Zpoint tx@ProjThreeD lineto } for phi 1 phi increment add { /phi1 exch def /Xpoint Rsphere theta increment add cos mul phi1 cos mul CX add def /Ypoint Rsphere theta increment add sin mul phi1 cos mul CY add def /Zpoint Rsphere phi1 sin mul CZ add def Xpoint Ypoint Zpoint tx@ProjThreeD lineto } for theta increment add -1 theta {% /theta1 exch def /Xpoint Rsphere theta1 cos mul phi increment add cos mul CX add def /Ypoint Rsphere theta1 sin mul phi increment add cos mul CY add def /Zpoint Rsphere phi increment add sin mul CZ add def Xpoint Ypoint Zpoint tx@ProjThreeD lineto } for phi increment add -1 phi { /phi1 exch def /Xpoint Rsphere theta cos mul phi1 cos mul CX add def /Ypoint Rsphere theta sin mul phi1 cos mul CY add def /Zpoint Rsphere phi1 sin mul CZ add def Xpoint Ypoint Zpoint tx@ProjThreeD lineto } for closepath } def % /MaillageSphere { % on stack must be x y z Radius increment C M Y K setColorLight /increment exch def /Rsphere exch def /CZ exch def /CY exch def /CX exch def /StartTheta 0 def /condition { PSfacetteSphere 0 ge } def -90 increment 90 increment sub {% /phi exch def StartTheta increment 360 StartTheta add increment sub {% /theta exch def % Centre de la facette /Xpoint Rsphere theta increment 2 div add cos mul phi increment 2 div add cos mul CX add def /Ypoint Rsphere theta increment 2 div add sin mul phi increment 2 div add cos mul CY add def /Zpoint Rsphere phi increment 2 div add sin mul CZ add def % normale à la facette /nXfacette Xpoint CX sub def /nYfacette Ypoint CY sub def /nZfacette Zpoint CZ sub def % test de visibilité /PSfacetteSphere vX nXfacette mul vY nYfacette mul add vZ nZfacette mul add def condition { gsave facetteSphere /cosV { 1 xLight nXfacette mul yLight nYfacette mul zLight nZfacette mul add add NormeLight nXfacette dup mul nYfacette dup mul nZfacette dup mul add add sqrt mul div sub } bind def Cyan cosV mul Magenta cosV mul Yellow cosV mul K cosV mul setcmykcolor fill grestore % 0 setgray facetteSphere stroke } if } for % /StartTheta StartTheta increment 2 div add def } for } def % %---------------------- Cylinder --------------------------- % /PlanCoupeCylinder { % /TableauxPoints [ 0 1 359 { /phi exch def [ Radius phi Height ConvCyl2d ] % on décrit le cercle } for ] def newpath TableauxPoints 0 get aload pop moveto 1 1 359 { TableauxPoints exch get aload pop lineto } for closepath } def % /facetteCylinder { % newpath Radius phi currentHeight ConvCyl2d moveto phi 1 phi dAngle add { % loop variable on stack Radius exch currentHeight ConvCyl2d lineto } for phi dAngle add -1 phi { % fill dHeight Radius exch currentHeight dHeight add ConvCyl2d lineto } for closepath } def % facette % /MaillageCylinder { % on stack true or false for saving values { setColorLight % expects 4 values on stack C M Y K /dHeight ED /dAngle ED /Height ED /Radius ED /CZ ED /CY ED /CX ED } if % 0 dHeight Height dHeight sub { /currentHeight ED 0 dAngle 360 dAngle sub { /phi ED % Normal vector of the center /nXfacetteCylinder Radius phi dAngle 2 div add cos mul CX add def /nYfacetteCylinder Radius phi dAngle 2 div add sin mul CY add def /nZfacetteCylinder currentHeight dHeight 2 div add CZ add def /NormeN nXfacetteCylinder dup mul nYfacetteCylinder dup mul nZfacetteCylinder dup mul add add sqrt def NormeN 0 eq { /NormeN 1e-10 def } if % test de visibilité /PSfacetteCylinder vX nXfacetteCylinder mul vY nYfacetteCylinder mul add vZ nZfacetteCylinder mul add def condition { facetteCylinder /cosV 1 xLight nXfacetteCylinder mul yLight nYfacetteCylinder mul zLight nZfacetteCylinder mul add add NormeLight NormeN mul div sub def Cyan Magenta Yellow K cosV mul 4 1 roll cosV mul 4 1 roll cosV dup mul mul 4 1 roll cosV dup mul mul 4 1 roll setcmykcolor fill 0 setgray facetteCylinder % drawing the segments stroke } if } for } for } def % %------------------------ Cylinder type II ----------------------- % /MoveTo { Conv3D2D moveto } def /LineTo { Conv3D2D lineto } def /IIIDEllipse { % x y z rA rB startAngle endAngle Wedge /dAngle 1 def /isWedge ED /endAngle ED /startAngle ED /radiusB ED /radiusA ED startAngle cos radiusA mul startAngle sin radiusB mul 0 isWedge { 0 0 moveto LineTo }{ MoveTo } ifelse /Angle startAngle def startAngle dAngle endAngle { /Angle ED Angle cos radiusA mul Angle sin radiusB mul 0 LineTo } for isWedge { 0 0 lineto } if } def /IIIDCircle { % x y z r startAngle endAngle Wedge 7 3 roll % startAngle endAngle Wedge x y z r dup % startAngle endAngle Wedge x y z r r 8 -3 roll IIIDEllipse } def /IIIDWedge { % x y z r startAngle endAngle true IIIDCircle } def /IIIDCylinder {% x y z r h start end wedge /isWedge ED /increment ED /endAngle ED /startAngle ED /height ED /radius ED startAngle increment endAngle { /Angle exch def radius Angle 0 ConvCylToCartesian MoveTo radius Angle height ConvCylToCartesian LineTo } for stroke } def % %---------------------- Box --------------------------- % /PlanCoupeBox { % x y z /TableauxPoints [ [ CX CY CZ Height add ConvBox2d ] % top or bottom [ CX CY Depth add CZ Height add ConvBox2d ] [ CX Width add CY Depth add CZ Height add ConvBox2d ] [ CX Width add CY CZ Height add ConvBox2d ] [ CX CY CZ Height add ConvBox2d ] % bottom ] def newpath TableauxPoints 0 get aload pop moveto 0 1 3 { TableauxPoints exch get aload pop lineto } for closepath } def % /facetteBox { % newpath dup 1 eq { % back CX CY CZ ConvBox2d moveto CX CY CZ Height add ConvBox2d lineto CX Width add CY CZ Height add ConvBox2d lineto CX Width add CY CZ ConvBox2d lineto CX CY CZ ConvBox2d lineto } if dup 2 eq { % right CX CY CZ ConvBox2d moveto CX CY CZ Height add ConvBox2d lineto CX CY Depth add CZ Height add ConvBox2d lineto CX CY Depth add CZ ConvBox2d lineto CX CY CZ ConvBox2d lineto } if dup 3 eq { % left CX Width add CY CZ ConvBox2d moveto CX Width add CY Depth add CZ ConvBox2d lineto CX Width add CY Depth add CZ Height add ConvBox2d lineto CX Width add CY CZ Height add ConvBox2d lineto CX Width add CY CZ ConvBox2d lineto } if 4 eq { % front CX CY Depth add CZ ConvBox2d moveto CX CY Depth add CZ Height add ConvBox2d lineto CX Width add CY Depth add CZ Height add ConvBox2d lineto CX Width add CY Depth add CZ ConvBox2d lineto CX CY Depth add CZ ConvBox2d lineto } if closepath } def % facette % /TestPlane { % on stack x y z of the plane center and # of plane /nZfacetteBox ED /nYfacetteBox ED /nXfacetteBox ED /Plane ED /NormeN nXfacetteBox dup mul nYfacetteBox dup mul nZfacetteBox dup mul add add sqrt def NormeN 0 eq { /NormeN 1e-10 def } if % test de visibilité /PSfacetteBox vX nXfacetteBox mul vY nYfacetteBox mul add vZ nZfacetteBox mul add def condition { Plane facetteBox /cosV 1 xLight nXfacetteBox mul yLight nYfacetteBox mul zLight nZfacetteBox mul add add NormeLight NormeN mul div sub def Cyan Magenta Yellow K cosV mul 4 1 roll cosV mul 4 1 roll cosV dup mul mul 4 1 roll cosV dup mul mul 4 1 roll setcmykcolor fill 0 setgray Plane facetteBox % drawing the segments stroke } if } def % /MaillageBox { % on stack true or false for saving values { setColorLight % expects 4 values on stack C M Y K /Depth ED /Height ED /Width ED /CZ ED /CY ED /CX ED } if % % Normal vector of the center /PlaneSet [ [ Width 2 div CX add CY Height 2 div CZ add ] % normal back [ CX Depth 2 div CY add Height 2 div CZ add ] % normal right [ Width CX add Depth 2 div CY add Height 2 div CZ add ] % normal left [ Width 2 div CX add Depth CY add Height 2 div CZ add ] % normal front ] def PlaneSequence length 0 eq { % user defined? Alpha abs cvi 360 mod /iAlpha ED iAlpha 90 lt { [ 1 2 3 4 ] }{ iAlpha 180 lt { [ 2 4 1 3 ] }{ iAlpha 270 lt { [ 3 4 1 2 ] }{ [ 3 1 4 2] } ifelse } ifelse } ifelse }{ PlaneSequence } ifelse { dup 1 sub PlaneSet exch get aload pop TestPlane } forall } def % %--------------------------- Paraboloid ----------------------------- /PlanCoupeParaboloid { /Z height store /V {Z sqrt} bind def /TableauxPoints [ 0 1 359 { /U exch def [ U U Z V calculate2DPoint ] % on décrit le cercle } for ] def newpath TableauxPoints 0 get aload pop moveto 0 1 359 { /compteur exch def TableauxPoints compteur get aload pop lineto } for closepath } def % /facetteParaboloid{ newpath U U Z V calculate2DPoint moveto U 1 U increment add {% /U1 exch def U1 U1 Z V calculate2DPoint lineto } for Z pas10 Z pas add pas10 add{ /Z1 exch def /V {Z1 sqrt} bind def U1 U1 Z1 V calculate2DPoint lineto } for U increment add -1 U {% /U2 exch def U2 U2 Z pas add V calculate2DPoint lineto } for Z pas add pas10 sub pas10 neg Z pas10 sub { /Z2 exch def /V Z2 abs sqrt def U U Z2 V calculate2DPoint lineto } for closepath } def % facette % /MaillageParaboloid { % on stack true or false for saving values { setColorLight % expects 7 values on stack C M Y K xL yL zL % /CZ ED /CY ED /CX ED } if 0 pas height pas sub {% /Z ED /V Z sqrt def 0 increment 360 increment sub {% /U exch def % Centre de la facette /Ucentre U increment 2 div add def /Vcentre Z pas 2 div add sqrt def % normale à la facette /nXfacetteParaboloid 2 Vcentre dup mul mul Ucentre cos mul radius mul def /nYfacetteParaboloid 2 Vcentre dup mul mul Ucentre sin mul radius mul def /nZfacetteParaboloid Vcentre neg radius dup mul mul def /NormeN { nXfacetteParaboloid dup mul nYfacetteParaboloid dup mul nZfacetteParaboloid dup mul add add sqrt} bind def NormeN 0 eq {/NormeN 1e-10 def} if % test de visibilité /PSfacetteParaboloid vX nXfacetteParaboloid mul vY nYfacetteParaboloid mul add vZ nZfacetteParaboloid mul add def condition { facetteParaboloid /cosV 1 xLight nXfacetteParaboloid mul yLight nYfacetteParaboloid mul zLight nZfacetteParaboloid mul add add NormeLight NormeN mul div sub def Cyan Magenta Yellow K cosV mul 4 1 roll cosV mul 4 1 roll cosV dup mul mul 4 1 roll cosV dup mul mul 4 1 roll setcmykcolor fill 0 setgray facetteParaboloid stroke } if } for } for } def % % end