C
C Program INIWRL to initialize a virtual reality description file C C Version: 6.00 C Date: 2006, June 15 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 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,UARRAY REAL UARRAY INTEGER LENGTH C C Filenames and parameters: CHARACTER*80 FILE1,FILE2 INTEGER LU1,LU2 REAL UNDEF PARAMETER (LU1=1,LU2=2) 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 UNDEF=UARRAY() 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 'forms.for' C forms.for INCLUDE 'length.for' C length.for INCLUDE 'wrl.for' C wrl.for C C======================================================================= C