!********************** csysexp    ********************************
! +++ 
!
! Export of all coordinate systems in a model
!
! Exactly one (1) basic (unity matrix) system must be defined.
!
! Blanked coordinate systems will not be written to files.
!
! A full name (including directories) can be given as input.
! 
! ---
! Revision history
! ________________
!
! Copyright  1997-06-18 Gunnar Liden, All Rights Reserved
! 
! Released under the MIT License: 
! 
! Permission is hereby granted, free of charge, to any person 
! obtaining a copy of this software and associated documentation 
! files (the "Software"), to deal in the Software without 
! restriction, including without limitation the rights to use, 
! copy, modify, merge, publish, distribute, sublicense, and/or sell 
! copies of the Software, and to permit persons to whom the 
! Software is furnished to do so, subject to the following 
! conditions:
! 
! The above copyright notice and this permission notice shall be 
! included in all copies or substantial portions of the Software.
! 
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 
! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 
! OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 
! NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 
! HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 
! WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 
! FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 
! OTHER DEALINGS IN THE SOFTWARE.

! 
!
!******************************************************************

GLOBAL GEOMETRY MODULE csysexp    (

STRING i_name*132:= " "   >"Name of directory <CR> ==> ../job/GEO";
STRING o_write*3 := "NO"  >"Replace existing systems (NO/YES)");

!sdesce Export of all coordinate systems in s model
!sdescs Export av koordinatsystem i en modell


! Internal variables
  REF    tree_id;  ! := #0 >"@ @t16384 Select part (subtree) <CR>= all";
  REF    get_id;           ! Current identity for coordinate system
  REF    csy_id;           ! Identity for system with the given name
  STRING get_name*28;      ! Name of current coordinate system
  STRING csy_name*28;      ! Name of current coordinate system
  FLOAT  csy_mat(4,4);     ! Coordinate system matrix
  FLOAT  bas_mat(4,4);     ! Coordinate system matrix
  STRING bas_name*28;      ! Name of basic coordinate system

  INT    i_csy;            ! Loop index coordinate system
  INT    n_csy;            ! Number of coordinate systems
  REF    csys_all(50);     ! All coordinate systems
  REF    copy_all(50);     ! Copy of csys_all
  INT    n_basic;          ! Ptr to basic system in csys_all

  STRING d_name*132;       ! Full name of directory
  STRING f_name*132;       ! Full file name

  INT    n_leng;           ! Length of string
  INT    i_c;              ! Loop index for string

                           ! For function GETHDR:
  INT    typ;              ! Type of entity
  INT    nref;             ! Number of references to part
                           ! (not used any more !!!! )
  INT    blank;            ! Eq. 0: Unblanked Eq. 1: Blanked
  INT    niva;             ! The layer for the entity
  INT    penna;            ! Pen number (colour)
  REF    grupp_id(3);      ! Global identities for the
                           ! groups, which the entity is part of ..

  INT    status;                  ! For TEST_FILE

  INT    DEBUG;                   ! Eq. 0: No      debug
                                  ! Eq. 1: Full    debug
                                  ! Eq. 2: Reduced debug

  STRING s*1;                     ! For Debug 

BEGINMODULE


! +++
! Algorithm
! _________
! ---

! +++
! 1. Initializations and checks
! ---

! Should be input
  tree_id := #0;

! Debug. Change to 0 or 1
  DEBUG:= 0;

! +++
! Check replace flag
! ---

  IF   o_write = "YES"  OR  o_write = "yes" THEN
    o_write := "YES";
  ELIF o_write = "NO"   OR  o_write = "no"  THEN
    o_write := "NO"; 
  ELSE
    EXIT("csysexp Replace flag not YES or NO");
  ENDIF;

! Initialize local variables
  get_id := #0;
  csy_id := #0;
  FOR  i_csy := 1 TO 50 DO
    csys_all(i_csy) := #0;
    copy_all(i_csy) := #0;
  ENDFOR;
  n_csy    := -12345;
  d_name   := "Undefined";
  f_name   := "Undefined";
  get_name := "Undefined";
  csy_name := "Undefined";
  bas_name := "Undefined";
  n_basic  := -12345;

! Open List window for Debug On
  IF  DEBUG = 1 THEN 
  LST_INI("Debug printout from "+
          "csysexp"); 
  ENDIF;

! +++
! 2. Retrieve all coordinate systems 
! ---
 
! +++
! Initialize for search in the given part (#0= whole active module)
! ---

  SET_ROOT_GM(tree_id);

! +++
! Search for coordinate systems
! ---

! Start number of coordinate systems
  n_csy  := 0;

nxtcsy:; ! Label: Next coordinate system

  get_id := GET_NEXT_GM(0, 8192);
  IF  get_id = #0 THEN
    GOTO allcsy;
  ENDIF;
  
! Get (coordinate system) header data
  GETHDR(get_id,typ,nref, blank,niva,penna,grupp_id);

! Next coordinate system if the system is blanked
  IF   blank = 1 THEN
    GOTO  nxtcsy;
  ENDIF;

  n_csy           := n_csy + 1;
  csys_all(n_csy) := get_id;
  copy_all(n_csy) := get_id;
  
! Get data for the system
  GETCSY(get_id, get_name, csy_mat);

! The basic system ?
  IF  ABS(csy_mat(1,1) - 1.0) < 0.000001 AND
      ABS(csy_mat(2,2) - 1.0) < 0.000001 AND
      ABS(csy_mat(3,3) - 1.0) < 0.000001 AND
      ABS(csy_mat(1,2))       < 0.000001 AND
      ABS(csy_mat(1,3))       < 0.000001 AND
      ABS(csy_mat(1,4))       < 0.000001 AND
      ABS(csy_mat(2,1))       < 0.000001 AND
      ABS(csy_mat(2,3))       < 0.000001 AND
      ABS(csy_mat(2,4))       < 0.000001 AND
      ABS(csy_mat(3,1))       < 0.000001 AND
      ABS(csy_mat(3,2))       < 0.000001 AND
      ABS(csy_mat(3,4))       < 0.000001      THEN
    IF  n_basic > 0 THEN
      IF  DEBUG = 1 THEN
      LST_LIN("Multiple basic systems "+ get_name+" and "+bas_name);
      LST_EXI();
      ENDIF;
      EXIT("csysexp Multiple basic systems "+get_name+","+bas_name);
    ENDIF;
    n_basic  := n_csy;
!   Get data for the basic system
    GETCSY(get_id, bas_name, bas_mat);
  ENDIF;

! Continue scanning
  GOTO  nxtcsy;

allcsy:; ! Label: All coordinate systems found

! Write to List window for Debug On
  IF  DEBUG = 1 THEN 
  LST_LIN("Number of coordinate systems "+ STR(n_csy ,  4,0));
  LST_LIN("Basic system is              "+ STR(n_basic ,4,0));
  ENDIF;

  IF  n_csy = 0 THEN
    IF  DEBUG = 1 THEN
    LST_LIN("Number of coordinate system in "+RSTR(tree_id)+ " is zero");
    LST_EXI();
    ENDIF;
    EXIT("csysexp No coordinate systems in "+RSTR(tree_id));
  ENDIF;

  IF  n_basic < 0 THEN
    IF  DEBUG = 1 THEN
    LST_LIN("No basic system");
    LST_EXI();
    ENDIF;
    EXIT("csysexp No basic system");
  ENDIF;

! +++
! 3. Full name for the directory 
! ---

! +++
! Check if full name already is defined
! ---

  IF       ACT_OSTYPE() = "UNIX"  AND FINDS(i_name,"/") > 0  THEN
    d_name := i_name;
    GOTO defined;
  ELIF     ACT_OSTYPE() = "WINDOWS" AND FINDS(i_name,"\") > 0 THEN
    d_name := i_name;
    GOTO defined;
  ENDIF;

! +++
! Construct the name
! ---

  IF       ACT_OSTYPE() = "UNIX"    THEN
    d_name := ACT_JOBDIR()+"GEO/";
  ELIF     ACT_OSTYPE() = "WIN32" THEN
    d_name := ACT_JOBDIR()+"GEO\";
  ELSE
    IF  DEBUG = 1 THEN
    LST_LIN("Not programmed for OS "+ ACT_OSTYPE() );
    LST_EXI();
    ENDIF;
    EXIT("csysexp Not programmed for OS "+ACT_OSTYPE());
  ENDIF;

defined:; ! Label: Full name is defined

! Write to List window for Debug On
  IF  DEBUG = 1 THEN 
  LST_LIN("Full name for csys directory : "+ d_name);
  ENDIF;

! +++
! 3. Write all systems to files
! ---
 
!   Replace \ in basic coordinate system name
    get_name := bas_name;
    n_leng := LENGTH(get_name);
    bas_name := "";
    FOR  i_c := 1 TO n_leng  DO
      IF  SUBSTR(get_name, i_c, 1 ) = "/" OR 
          SUBSTR(get_name, i_c, 1 ) = "\"     THEN
        bas_name := bas_name+"_";
      ELSE
        bas_name := bas_name+SUBSTR(get_name,i_c,1);
      ENDIF;
    ENDFOR;

! +++
! Start loop all coordinate system
! ---

  FOR  i_csy := 1 TO n_csy DO

!   Current system
    get_id := csys_all(i_csy);

!   Get data for the system
    GETCSY(get_id, get_name, csy_mat);

!   Replace \ in coordinate system name
    n_leng := LENGTH(get_name);
    csy_name := "";
    FOR  i_c := 1 TO n_leng  DO
!     Write to List window for Debug On
      IF  DEBUG = 1 THEN 
      LST_LIN("SUBSTR(get_name,i_c,1)  "+ SUBSTR(get_name,i_c,1));
      ENDIF;

      IF  SUBSTR(get_name, i_c, 1 ) = "/" OR 
          SUBSTR(get_name, i_c, 1 ) = "\"     THEN
        csy_name := csy_name+"_";
      ELSE
        csy_name := csy_name+SUBSTR(get_name,i_c,1);
      ENDIF;
    ENDFOR;

!   Full name of file
    f_name := d_name+csy_name+".DAT_"+bas_name;

!   Write to List window for Debug On
    IF  DEBUG = 1 THEN 
    LST_LIN("Full name for csys file:       "+ f_name);
    ENDIF;

!   Make check if systems exists ?
    IF  o_write = "YES" THEN
      GOTO nocheck;
    ENDIF;

    status := TEST_FILE(f_name, "X" );
    IF  status = 1 THEN
      IF  DEBUG = 1 THEN
      LST_LIN("Coordinate system "+ f_name + " exists");
      LST_EXI();
      ENDIF;
      EXIT("csysexp "+get_name+" exists");
    ENDIF;

nocheck:; ! Label: No check if system already exists

!   Create coordinate system file
    PART(#1, csyswri( f_name, csy_name, bas_name, csy_mat));


! +++
! Start loop all coordinate system
! ---

  ENDFOR;

! +++
! 4. Exit
! ---
 
! Close List window for Debug On
  IF  DEBUG = 1 THEN
  LST_EXI();
  ENDIF;

ENDMODULE