C
C Program INIWRL to initialize a virtual reality description file
C
C Version: 5.50
C Date: 2001, January 7
C
C Coded by: Ludek Klimes
C Department of Geophysics, Charles University Prague,
C Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C E-mail: klimes@seis.karlov.mff.cuni.cz
C
C References:
C
C VRML (Virtual Reality Modeling Language) version 1.0C
C
C VRML97 (Virtual Reality Modeling Language ISO/IEC 14772)
C
C GOCAD
C
C Persistence of Vision scene description language, version 3.1
C
C.......................................................................
C
C Description of data files:
C
C Input data read from the standard input device (*):
C The data are read by the list directed input (free format) and
C consist of a single string 'SEP':
C 'SEP'...String in apostrophes containing the name of the input
C SEP parameter or history file with the input data.
C No default, 'SEP' must be specified and cannot be blank.
C
C
C Input data file 'SEP':
C File 'SEP' has the form of the SEP
C parameter file. The parameters, which do not differ from their
C defaults, need not be specified in file 'SEP'.
C Data specifying input files:
C WRLINI='string'... Name of the file to be copied to the beginning
C of the output file. If the filename is blank (default),
C the output file is initialized from its beginning.
C File WRLINI may contain the user-coded description in the
C corresponding VRML language. The default value is mostly
C appropriate.
C Default: WRLINI=' '
C CAMERA='string'... Name of the file with cameras (viewpoints).
C May or may not be specified. The default initial view
C of a VRML viewer is in the direction of the -X3 half-axis.
C Description of file CAMERA
C Not used if VRML='GOCAD'.
C Default: CAMERA=' '
C DLIGHT='string'... Name of the file with directional lights.
C Description of file DLIGHT
C If not specified, the viewer will use its default
C illumination.
C Not used if VRML='GOCAD'.
C Default: DLIGHT=' '
C PLIGHT='string'... Name of the file with point lights.
C Description of file PLIGHT
C Often need not be specified.
C Not used if VRML='GOCAD'.
C Default: PLIGHT=' '
C Data specifying the output file:
C WRL='string'... Name of the output file. It is recommended to
C specify it rather than to use the default name.
C Default: WRL='out.wrl'
C Data specifying the form of the output file:
C VRML='string'... Virtual reality scene description language.
C The case of the characters does not matter.
C VRML='VRML1': VRML (Virtual Reality Modeling Language)
C version 1.0.
C VRML='VRML2': VRML97 according to ISO/IEC 14772 standard.
C VRML='GOCAD': GOCAD description of points (VSet), curves
C (PLine) and surfaces (TSurf).
C VRML='POV': POV (Persistence Of Vision) scene
C description language, version 3.1.
C Default: VRML='VRML2' (recommended)
C Data specifying the illumination and background (not used if
C VRML='GOCAD'):
C UP1=real, UP2=real, UP3=real... Components of a vector pointing
C upwards. It is used to properly rotate the camera.
C Note that VRML uses right-handed Cartesian coordinates.
C If the model coordinates are left-handed, all objects
C will be seen mirrored.
C Defaults: UP1=0, UP2=0, UP3=1 (X3 axis pointing up)
C AMBIENT=real... Float number between 0 and 1 specifying the
C intensity of the ambient light. The colour of the ambient
C light is assumed white.
C If VRML='vrml1', the implicit ambient light has intensity
C 1.00 and parameter AMBIENT is applied directly to the
C material of the surface objects by subsequent programs.
C If VRML='vrml2', the ambient light is the first light,
C followed by directional lights and point lights.
C Default: AMBIENT=0.20 (default for VRML materials)
C R=real, G=real, B=real... Float numbers between 0 and 1 specifying
C the colour of the background.
C Not applied if VRML='vrml1' or VRML='gocad' .
C Defaults: R=0, G=0, B=0 (black background)
C
C
C Input file CAMERA with the cameras (viewpoints):
C (1) None to several strings terminated by / (a slash)
C (2) For each camera data (2.1):
C (2.1) 'NAME',X1,X2,X3,T1,T2,T3,WIDTH,HEIGHT,/
C 'NAME'... Name of the viewpoint. Will be used by VRML viewers to
C refer the viewpoint.
C X1,X2,X3... Coordinates of the viewpoint (camera).
C T1,T2,T3... Coordinates of the target point.
C Defaults: T1=0, T2=0, T3=0
C WIDTH,HEIGHT... Width and height of the rectangle around the
C target point to fit in the display window.
C If specified, the width and height should be positive.
C Otherwise, the results may be browser-dependent.
C For VRML='vrml1': HEIGHT fits into the vertical window
C dimension. The aspect ratio is proportional.
C For VRML='vrml2': Square of side max(HEIGHT,WIDTH*3/4)
C is maximized in the display window. The aspect ratio is
C proportional.
C Note that VRML uses right-handed Cartesian coordinates.
C If the model coordinates are left-handed, all objects
C will be seen mirrored.
C For VRML='pov': Rectangle of sides HEIGHT and WIDTH fills
C the display window. The aspect ratio depends on the
C dimensions of the display window.
C Defaults if one of the values is given: WIDTH=HEIGHT*4/3,
C HEIGHT=WIDTH*3/4.
C Defaults if none of them is given: HEIGHT=distance between
C the camera and the target point, WIDTH=HEIGHT*4/3
C (3) / or end of file.
C
C
C Input file DLIGHT with the directional lights:
C (1) None to several strings terminated by / (a slash)
C (2) For each light data (2.1):
C (2.1) 'NAME',X1,X2,X3,VALUE,/
C 'NAME'... Name of the light. Not considered. May be blank.
C X1,X2,X3... Directional vector towards the light.
C VALUE...Intensity of the light source, possibly supplemented by
C the minus sign if the light should be initially switched
C off. The colour of the light is assumed white.
C Default: VALUE=0.80 (default for VRML materials)
C (3) / or end of file.
C
C
C Input file PLIGHT with the point lights:
C (1) None to several strings terminated by / (a slash)
C (2) For each light data (2.1):
C (2.1) 'NAME',X1,X2,X3,VALUE,/
C 'NAME'... Name of the light. Not considered. May be blank.
C X1,X2,X3... Coordinates of the light.
C VALUE...Intensity of the light source, possibly supplemented by
C the minus sign if the light should be initially switched
C off. The colour of the light is assumed white.
C Default: VALUE=0.80 (default for VRML materials)
C (3) / or end of file.
C
C=======================================================================
C
C External functions and subroutines:
EXTERNAL LENGTH,ERROR,RSEP1,RSEP3T,RSEP3R
INTEGER LENGTH
C
C Filenames and parameters:
CHARACTER*80 FILE1,FILE2
INTEGER LU1,LU2
REAL UNDEF
PARAMETER (LU1=1,LU2=2,UNDEF=-999999.)
C
C Other variables:
CHARACTER*5 VRML
CHARACTER*255 TEXT
INTEGER I,J
REAL UP1,UP2,UP3,RED,GREEN,BLUE
REAL X1,X2,X3,T1,T2,T3,R1,R2,R3,R4,W,H,C,S,DIST,AUX
REAL R11,R21,R31,R12,R22,R32,R13,R23,R33
REAL S11,S21,S31,S12,S22,S32,S13,S23,S33
C
C.......................................................................
C
C Reading main input data:
WRITE(*,'(A)') '+INIWRL: Enter input filename: '
FILE1=' '
READ(*,*) FILE1
IF(FILE1.EQ.' ') THEN
C INIWRL-01
CALL ERROR('INIWRL-01: No input file specified')
C Input file in the form of the SEP (Stanford Exploration Project)
C parameter or history file must be specified.
C There is no default filename.
END IF
CALL RSEP1(LU1,FILE1)
WRITE(*,'(A)') '+INIWRL: Working... '
C
C Reading the form of the output file:
CALL RSEP3T('VRML',VRML ,'vrml2' )
CALL LOWER(VRML)
IF(VRML.NE.'vrml1'.AND.
* VRML.NE.'vrml2'.AND.
* VRML.NE.'pov' .AND.
* VRML.NE.'gocad') THEN
C INIWRL-02
CALL ERROR('INIWRL-02: No valid string in VRML')
C Valid string specifying the form of the output file is:
C VRML='VRML1' or 'VRML2' or 'POV' or 'GOCAD'.
C Default and recommended value is 'VRML2'.
END IF
C
C Opening the output file and writing its beginning:
CALL RSEP3T('WRLINI',FILE1,' ')
CALL RSEP3T('WRL' ,FILE2,'out.wrl')
CALL WRL1(LU1,LU2,FILE1,FILE2,VRML,0)
C
C.......................................................................
C
C Cameras (viewpoints):
C
CALL RSEP3T('CAMERA',FILE1,' ')
CALL RSEP3R('UP1',UP1,0.)
CALL RSEP3R('UP2',UP2,0.)
CALL RSEP3R('UP3',UP3,1.)
IF(FILE1.NE.' ') THEN
OPEN(LU1,FILE=FILE1,STATUS='OLD')
READ(LU1,*) (TEXT,I=1,20)
C
C Loop over viewpoints
20 CONTINUE
TEXT='$'
X1=0.
X2=0.
X3=0.
T1=0.
T2=0.
T3=0.
W=UNDEF
H=UNDEF
READ(LU1,*,END=29) TEXT,X1,X2,X3,T1,T2,T3,W,H
IF(TEXT.EQ.'$') THEN
GO TO 29
END IF
C
C Camera back unit vector
R13=X1-T1
R23=X2-T2
R33=X3-T3
DIST=SQRT(R13*R13+R23*R23+R33*R33)
IF(DIST.EQ.0.) THEN
C INIWRL-03
CALL ERROR('INIWRL-03: Zero distance from camera to model')
END IF
R13=R13/DIST
R23=R23/DIST
R33=R33/DIST
C
C Viewing frame
IF(W.EQ.UNDEF.AND.H.EQ.UNDEF) THEN
H=DIST*2.*(SQRT(2.)-1.)
W=H*4./3.
ELSE IF(W.EQ.UNDEF) THEN
W=H*4./3.
ELSE IF(H.EQ.UNDEF) THEN
H=W*3./4.
END IF
C
IF(VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
C Camera top unit vector
AUX=UP1*R13+UP2*R23+UP3*R33
R12=UP1-R13*AUX
R22=UP2-R23*AUX
R32=UP3-R33*AUX
AUX=SQRT(R12*R12+R22*R22+R32*R32)
IF(AUX.GE.0.00025) THEN
R12=R12/AUX
R22=R22/AUX
R32=R32/AUX
ELSE IF(ABS(R13).LE.ABS(R23).AND.ABS(R13).LE.ABS(R33)) THEN
AUX=SQRT(R23*R23+R33*R33)
R12=0.
R22= R33/AUX
R32=-R23/AUX
ELSE IF(ABS(R23).LE.ABS(R33)) THEN
AUX=SQRT(R13*R13+R33*R33)
R12= R33/AUX
R22=0.
R32=-R13/AUX
ELSE
AUX=SQRT(R13*R13+R23*R23)
R12= R23/AUX
R22=-R13/AUX
R32=0.
END IF
C
C Camera right unit vector
R11=R22*R33-R32*R23
R21=R32*R13-R12*R33
R31=R12*R23-R22*R13
C
C Rotation axis vector
C=R11+R22+R33-1.
R11=R11-1.
R22=R22-1.
R33=R33-1.
S11=R22*R33-R32*R23
S21=R32*R13-R12*R33
S31=R12*R23-R22*R13
S12=R23*R31-R33*R21
S22=R33*R11-R13*R31
S32=R13*R21-R23*R11
S13=R21*R32-R31*R22
S23=R31*R12-R11*R32
S33=R11*R22-R21*R12
IF(S11.LE.0..AND.S22.LE.0..AND.S33.LE.0.) THEN
R1=0.
R2=0.
R3=1.
R4=0.
ELSE IF(S33.GE.S22.AND.S33.GE.S11) THEN
R1=S13+S31
R2=S23+S32
R3=S33+S33
ELSE IF(S22.GE.S11) THEN
R1=S12+S21
R2=S22+S22
R3=S32+S23
ELSE
R1=S11+S11
R2=S21+S12
R3=S31+S13
END IF
AUX=SQRT(R1*R1+R2*R2+R3*R3)
R1=R1/AUX
R2=R2/AUX
R3=R3/AUX
S=R1*(R32-R23)+R2*(R13-R31)+R3*(R21-R12)
R4=ATAN2(S,C)
C
IF(VRML.EQ.'vrml1') THEN
AUX=2.*ATAN(H/DIST/2.)
WRITE(LU2,'(A)')
* 'PerspectiveCamera {'
WRITE(LU2,'(A,F8.6)')
* ' heightAngle ',AUX
WRITE(LU2,'(A,G15.6)')
* ' focalDistance ',DIST
ELSE
AUX=2.*ATAN(AMAX1(W*3./4.,H)/DIST/2.)
WRITE(LU2,'(A)')
* 'Viewpoint {'
WRITE(LU2,'(3A)')
* ' description "',TEXT(1:LENGTH(TEXT)),'"'
WRITE(LU2,'(A,F8.6)')
* ' fieldOfView ',AUX
END IF
WRITE(LU2,'(3(A,G15.6))')
* ' position ',X1,' ',X2,' ',X3
WRITE(LU2,'(4(A,F9.6))')
* ' orientation ',R1,' ',R2,' ',R3,' ',R4
WRITE(LU2,'(A)')
* '}'
C
ELSE IF(VRML.EQ.'pov') THEN
WRITE(LU2,'(A)')
* 'camera {'
* ,' perspective'
WRITE(LU2,'(A,3(G15.6,A))')
* ' right <',-W ,',', 0.,',', 0. ,'>'
* ,' up <', 0.,',', H ,',', 0. ,'>'
* ,' direction <', 0.,',', 0.,',',DIST,'>'
* ,' sky <',UP1,',',UP2,',',UP3 ,'>'
* ,' location <', X1,',', X2,',', X3 ,'>'
* ,' look_at <', T1,',', T2,',', T3 ,'>'
WRITE(LU2,'(A)')
* '}'
C
END IF
GO TO 20
C End of the loop over viewpoints
C
29 CONTINUE
CLOSE(LU1)
END IF
C
C.......................................................................
C
C Ambient light:
C
CALL RSEP3R('AMBIENT',W,0.20)
C VRML 1.0 has an implicit ambient light of intensity 1.00
IF(VRML.EQ.'vrml2') THEN
WRITE(LU2,'(A)')
* 'NavigationInfo {'
* ,' headlight FALSE'
* ,'}'
* ,'DirectionalLight {'
* ,' color 1.00 1.00 1.00'
* ,' intensity 0.00'
WRITE(LU2,'(A,F4.2)')
* ' ambientIntensity ',W
WRITE(LU2,'(A)')
* ' on TRUE'
* ,'}'
ELSE IF(VRML.EQ.'pov') THEN
WRITE(LU2,'(A,3(F4.2,A))')
* 'global_settings { ambient_light rgb <',W,',',W,',',W,'> }'
END IF
C
C.......................................................................
C
C Directional and point lights:
C
DO 39 J=1,2
IF(J.EQ.1) THEN
C Directional lights
CALL RSEP3T('DLIGHT',FILE1,' ')
ELSE
C Point lights
CALL RSEP3T('PLIGHT',FILE1,' ')
END IF
IF(FILE1.NE.' ') THEN
OPEN(LU1,FILE=FILE1,STATUS='OLD')
READ(LU1,*) (TEXT,I=1,20)
C
C Loop over lights
30 CONTINUE
TEXT='$'
X1=0.
X2=0.
X3=0.
W =0.80
READ(LU1,*,END=38) TEXT,X1,X2,X3,W
IF(TEXT.EQ.'$') THEN
GO TO 38
END IF
C
IF(VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
IF(J.EQ.1) THEN
WRITE(LU2,'(A)')
* 'DirectionalLight {'
AUX=SQRT(X1*X1+X2*X2+X3*X3)
X1=-X1/AUX
X2=-X2/AUX
X3=-X3/AUX
WRITE(LU2,'(3(A,F9.6))')
* ' direction ',X1,' ',X2,' ',X3
ELSE
WRITE(LU2,'(A)')
* 'PointLight {'
WRITE(LU2,'(3(A,G15.6))')
* ' location ',X1,' ',X2,' ',X3
WRITE(LU2,'(A)')
* ' radius 999999'
END IF
WRITE(LU2,'(A)')
* ' color 1.00 1.00 1.00'
WRITE(LU2,'(A,F4.2)')
* ' intensity ',ABS(W)
IF(VRML.EQ.'vrml2') THEN
WRITE(LU2,'(A)')
* ' ambientIntensity 0.00'
END IF
IF(W.GT.0.) THEN
WRITE(LU2,'(A)')
* ' on TRUE'
ELSE
WRITE(LU2,'(A)')
* ' on FALSE'
END IF
WRITE(LU2,'(A)')
* '}'
ELSE IF(VRML.EQ.'pov') THEN
WRITE(LU2,'(A)')
* 'light_source {'
WRITE(LU2,'(A,3(G15.6,A))')
* ' <',X1,',',X2,',',X3,'>'
WRITE(LU2,'(A,3(F4.2,A))')
* ' rgb <',W,',',W,',',W,'>'
WRITE(LU2,'(A)')
* '}'
END IF
GO TO 30
C End of the loop over directional lights
C
38 CONTINUE
CLOSE(LU1)
END IF
39 CONTINUE
C
C.......................................................................
C
C Background colour:
C
CALL RSEP3R('R',RED ,0.)
CALL RSEP3R('G',GREEN,0.)
CALL RSEP3R('B',BLUE ,0.)
C VRML 1.0 has no background node
IF(VRML.EQ.'vrml2') THEN
WRITE(LU2,'(A,3(F4.2,A))')
* 'Background { skyColor ',RED,' ',GREEN,' ',BLUE,' }'
ELSE IF(VRML.EQ.'pov') THEN
WRITE(LU2,'(A,3(F4.2,A))')
* 'background { color rgb <',RED,',',GREEN,',',BLUE,'> }'
END IF
C
C.......................................................................
C
C Separating the header by a blank line
IF (VRML.NE.'gocad') THEN
WRITE(LU2,'(A)')
END IF
C
C.......................................................................
C
C Subroutine for surfaces:
C
IF(VRML.EQ.'vrml2') THEN
WRITE(LU2,'(A)')
* 'PROTO Surface ['
* ,' exposedField SFNode appearance NULL'
* ,' field MFVec3f point []'
* ,' exposedField SFNode normalPos NULL'
* ,' exposedField SFNode normalNeg NULL'
* ,' exposedField SFNode colorPos NULL'
* ,' exposedField SFNode colorNeg NULL'
* ,' field MFInt32 coordIndex []'
* ,']{'
* ,' Transform {'
* ,' children ['
* ,' Shape {'
* ,' appearance IS appearance'
* ,' geometry IndexedFaceSet {'
* ,' ccw TRUE # positive surface side'
* ,' coord DEF SurfaceCoord Coordinate {'
* ,' point IS point'
* ,' }'
* ,' normal IS normalPos'
* ,' color IS colorPos'
* ,' coordIndex IS coordIndex'
* ,' }'
* ,' }'
* ,' Shape {'
* ,' appearance IS appearance'
* ,' geometry IndexedFaceSet {'
* ,' ccw FALSE # negative surface side'
* ,' coord USE SurfaceCoord'
* ,' normal IS normalNeg'
* ,' color IS colorNeg'
* ,' coordIndex IS coordIndex'
* ,' }'
* ,' }'
* ,' ]'
* ,' }'
* ,'}'
END IF
C
C.......................................................................
C
C Subroutine for lines:
C
IF(VRML.EQ.'vrml2') THEN
WRITE(LU2,'(A)')
* 'PROTO Line ['
* ,' exposedField SFNode appearance NULL'
* ,' field MFVec3f point []'
* ,' exposedField SFNode color NULL'
* ,' field MFInt32 coordIndex []'
* ,']{'
* ,' Transform {'
* ,' children ['
* ,' Shape {'
* ,' appearance IS appearance'
* ,' geometry IndexedLineSet {'
* ,' coord Coordinate {'
* ,' point IS point'
* ,' }'
* ,' color IS color'
* ,' coordIndex IS coordIndex'
* ,' }'
* ,' }'
* ,' ]'
* ,' }'
* ,'}'
ELSE IF (VRML.EQ.'pov') THEN
WRITE(LU2,'(A)')
* '#declare LINERADIUS = 0.1;'
* ,' '
* ,'#macro LINE(X1,X2,X3,X4,Y1,Y2,Y3,Y4)'
* ,' #local X=;'
* ,' #local Y=;'
* ,' #local VD=X4-Y4;'
* ,' #local VY= Y4;'
* ,' #if (VD=0)'
* ,' #local VD=VPER/999999;'
* ,' #end'
* ,' #local G0=(X-Y)*VPER/VD;'
* ,' cylinder {'
* ,' X Y LINERADIUS'
* ,' texture {'
* ,' pigment {'
* ,' gradient x'
* ,' translate ((VREF-V3)/VPER-CREF-100)*x'
* ,' matrix '
* ,' translate Y'
* ,' }'
* ,' }'
* ,' }'
* ,'#end'
* ,' '
END IF
C
C.......................................................................
C
C Subroutine for points:
C
IF(VRML.EQ.'vrml2') THEN
WRITE(LU2,'(A)')
* 'PROTO Point ['
* ,' exposedField SFNode appearance NULL'
* ,' field MFVec3f point []'
* ,' exposedField SFNode color NULL'
* ,']{'
* ,' Transform {'
* ,' children ['
* ,' Shape {'
* ,' appearance IS appearance'
* ,' geometry PointSet {'
* ,' coord Coordinate {'
* ,' point IS point'
* ,' }'
* ,' color IS color'
* ,' }'
* ,' }'
* ,' ]'
* ,' }'
* ,'}'
END IF
C
C.......................................................................
C
C Subroutine for texts:
C
IF(VRML.EQ.'vrml2') THEN
WRITE(LU2,'(A)')
* 'PROTO text ['
* ,' exposedField SFNode appearance NULL'
* ,' exposedField SFVec3f point 0 0 0'
* ,' exposedField MFString string []'
* ,' exposedField SFNode fontStyle NULL'
* ,']{'
* ,' Transform {'
* ,' translation IS point'
* ,' children ['
* ,' Billboard {'
AUX=SQRT(UP1*UP1+UP2*UP2+UP3*UP3)
R1=UP1/AUX
R2=UP2/AUX
R3=UP3/AUX
WRITE(LU2,'(3(A,F6.3))')
* ' axisOfRotation ',R1,' ',R2,' ',R3
AUX=SQRT(UP2*UP2+UP3*UP3)
WRITE(LU2,'(A)')
* ' children ['
* ,' Transform {'
AUX=SQRT(UP1*UP1+UP3*UP3)
IF(AUX.NE.0.) THEN
R1=UP3/AUX
R2=0.
R3=-UP1/AUX
R4=ATAN2(AUX,UP2)
ELSE
R1=1.
R2=0.
R3=0.
IF(UP2.GE.0.) THEN
R4=0.
ELSE
R4=3.141593
END IF
END IF
WRITE(LU2,'(3(A,F6.3),A,F9.6)')
* ' rotation ',R1,' ',R2,' ',R3,' ',R4
WRITE(LU2,'(A)')
* ' children ['
* ,' Shape {'
* ,' appearance IS appearance'
* ,' geometry Text {'
* ,' string IS string'
* ,' fontStyle IS fontStyle'
* ,' }'
* ,' }'
* ,' ]'
* ,' }'
* ,' ]'
* ,' }'
* ,' ]'
* ,' }'
* ,'}'
END IF
C
C.......................................................................
C
CLOSE(LU2)
WRITE(*,'(A)') '+INIWRL: Done. '
STOP
END
C
C=======================================================================
C
INCLUDE 'error.for'
C error.for
INCLUDE 'sep.for'
C sep.for
INCLUDE 'length.for'
C length.for
INCLUDE 'forms.for'
C forms.for
INCLUDE 'wrl.for'
C wrl.for
C
C=======================================================================
C