!********************** surfexp    ********************************
! +++ 
!
! Export of a surface including conversion/approximation
!
! 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 surfexp    (
REF    s_id                       >"@t16 Surface reference";
STRING s_name*132:= "wing_01"     >"Name of surface file";
STRING c_name*28 := "AIRCRAFT"    >"Name of coordinate system";
STRING o_write*3 := "NO"          >"Replace existing surface (NO/YES)";
INT    graphic := 1 >"Graphics 0: No surface 1: Surface 2: All");

!sdesce Export of a surface including conversion/approximation
!sdescs Export av yta med konvertering/approximering


! Internal variables

  INT    s_type;                  ! Surface type        

  REF    apr_id;                  ! Id. for approximate surface

  STRING f_name*132;              ! Full file name

  INT    status;                  ! For TEST_FILE

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

  INT    b_val_a;                 ! Blank value for all geometry
  INT    b_val_s;                 ! Blank value for surface

  STRING s*1;                     ! For Debug 

BEGINMODULE


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

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

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

! Check graphics
  IF    graphic = 0 THEN
    b_val_s := 1;
    b_val_a := 1;
  ELIF  graphic = 1 THEN
    b_val_s := 0;
    b_val_a := 1;
  ELIF  graphic = 2 THEN
    b_val_s := 0;
    b_val_a := 0;
  ELSE
    EXIT("surfexp Graphic not OK");
  ENDIF;

! +++
! 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("surexp Replace flag not YES or NO");
  ENDIF;

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

! +++
! 2. Approximate to cubic surface if necessary
! ---
 
! Retrieve surface type
  GETSURH(s_id,"SUR_TYPE",s_type);

! Write to List window for Debug On
  IF  DEBUG = 1 THEN 
  LST_LIN("Surface type "+ STR(s_type,4,0));
  ENDIF;

! Approximation/conversion 
  IF        s_type = 1 THEN
!   CUB_SUR
    apr_id := s_id;
  ELIF      s_type = 7 THEN
    SUR_APPROX(#4, s_id, "CUB_SUR", 1, 3, 3 :BLANK=b_val_a);
    apr_id := GLOBAL_REF(#4); 
  ELSE
    SUR_APPROX(#5, s_id, "CUB_SUR", 1, 5, 5 :BLANK=b_val_a);
    apr_id := GLOBAL_REF(#5);
  ENDIF;

! +++
! 3. Write surface data to text file
! ---
 
! +++
! Full name for surface data file
! ---

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

  IF       ACT_OSTYPE() = "UNIX"  AND FINDS(s_name,"/") > 0  THEN
    f_name := s_name;
    GOTO defined;
  ELIF     ACT_OSTYPE() = "WIN32" AND FINDS(s_name,"\") > 0 THEN
    f_name := s_name;
    GOTO defined;
  ENDIF;

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

  IF       ACT_OSTYPE() = "UNIX"    THEN
    f_name := ACT_JOBDIR()+"GEO/"+s_name+".DAT_"+c_name;
  ELIF     ACT_OSTYPE() = "WIN32" THEN
    f_name := ACT_JOBDIR()+"GEO\"+s_name+".DAT_"+c_name;
  ELSE
    IF  DEBUG = 1 THEN
    LST_LIN("Not programmed for OS "+ ACT_OSTYPE() );
    LST_EXI();
    ENDIF;
    EXIT("surfexp 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("Surface file name: "+ f_name);
  ENDIF;

! +++
! Check if surface already exists if replace flag is NO
! ---

  IF  o_write = "YES" THEN
    GOTO nocheck;
  ENDIF;

  status := TEST_FILE(f_name, "X" );
  IF  status = 1 THEN
    IF  DEBUG = 1 THEN
    LST_LIN("Surface file "+ f_name + " exists");
    LST_EXI();
    ENDIF;
    EXIT("surfexp "+f_name+" exists");
  ENDIF;


! +++
! Save surface on the given directory
! ---

nocheck:; ! Label: No check if the surface exists

  PART(#6, su_exnmg(s_id, "SLASK"));

  COPY_FILE(ACT_JOBDIR()+"SLASK.DAT", f_name);

  DELETE_FILE(ACT_JOBDIR()+"SLASK.DAT");

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

ENDMODULE