!******************** su_exnmg ************************************* !s+++ ! su_exnmg ! _________ ! ! Funktionen konverterar en VARKON yta av CUB_SUR typ till en ! NMG bikubisk yta. Data kommer att skrivas p} NMG's F07 format . ! ! Konverteringen skulle kunna vara exakt men det sker en approximering ! som beror p} att antalet decimaler (5) som koefficienterna skrivs ut ! med inte {r tillr{ckligt. ! ! ! I VARKON kan triangul{ra patchar definieras. NMG's evaluerings- ! rutin klarar antagligen inte att g|ra ber{kningar i en s}dan ! degenerad punkt. ! ! I denna funktion kontrolleras att inga "NULL patches" finns i ytan, ! samt att parameteriseringen {r riktig. Lokala parametern U,V ska ! g} ifr}n 0 till 1 och globala ska vara heltal som best{ms av "patchens" ! IU,IV adress. ! ! ----- Beskrivning av data i F07 filen --------------------------- ! ! Patchdata i f|ljande ordning: ! ----------------------------- ! ! IU=1,IV=NV IU=NU,IV=NV ! ----------------------------------------- ! ! ! ! ! ! ! ! ! ! 13 ! 14 ! 15 ! 16 ! 17 ! 18 ! ! ----------------------------------------- ! ! ! ! ! ! ! ! ! ! 7 ! 8 ! 9 ! 10 ! 11 ! 12 ! ! ---------------------------------------- ! ! ! ! ! ! ! ! ! ! 1 ! 2 ! 3 ! 4 ! 5 ! 6 ! ! ---------------------------------------- ! ! IU=1,IV=1 IU=NU,IV=1 ! ! (Loop variabel iu= IU-1 and iv= IV-1 i programmet nedan) ! ! Huvud f|r datan: ! ---------------- ! ! Surface name Total_number_of_patches (Rad 1) ! YTA/1 594 ( Ex. ) ! ! Huvud f|r patchdata: ! -------------------- ! ! I1 I2 I3 I4 I5 I6 I7 I8 I9 I10 (Rad 2) ! 1 48 1 0 1001 0 0 34 19 0 ( Ex. ) ! ! d{r ! ! I1 = 1 (alltid ett) ! I2 = Antal f{lt (koefficienter) = 48 f|r en bikubisk patch ! I3 = Patch nummer i filen ! I4 = 0 (alltid noll) ! I5 = Yt typ = 1001 for bikubisk yta ! I6 = 0 ! I7 = 0 ! I8 = Antal U kurvor i ytan ! I9 = Antal V kurvor i ytan ! I10 = 0 (alltid noll) ! ! ! Koefficienterna kommer i f|ljande ordning: ! ----------------------------------------- ! ! Rad Koefficienter ( f|r ) Koefficienter ( f|r ) ! ! 1 a00x a00y a00z (1.0 * 1.0 ) a10x a10y a10z (U * 1.0 ) ! 2 a20x a20y a20z (U**2 * 1.0 ) a30x a30y a30z (U**3 * 1.0 ) ! 3 a01x a01y a01z (1.0 * V ) a11x a11y a11z (U * V ) ! 4 a21x a21y a21z (U**2 * V ) a31x a31y a31z (U**3 * V ) ! 5 a02x a02y a02z (1.0 * V**2) a12x a12y a12z (U * V**2) ! 6 a22x a22y a22z (U**2 * V**2) a32x a32y a32z (U**3 * V**2) ! 7 a03x a03y a03z (1.0 * V**3) a13x a13y a13z (U * V**3) ! 8 a23x a23y a23z (U**2 * V**3) a33x a33y a34z (U**3 * V**3) ! ... tom rad (ingen data) ... ! ! Koefficienterna kommer i f|ljande ordning i GETCUBP's utdata vektor ! ____________________________________________________________________ ! ! data( 1) = a00x data( 2) = a00y data( 3) = a00z ! data( 4) = a01x data( 5) = a01y data( 6) = a01z ! data( 7) = a02x data( 8) = a02y data( 9) = a02z ! data(10) = a03x data(11) = a03y data(12) = a03z ! ! data(13) = a10x data(14) = a10y data(15) = a10z ! data(16) = a11x data(17) = a11y data(18) = a11z ! data(19) = a12x data(20) = a12y data(21) = a12z ! data(22) = a13x data(23) = a13y data(24) = a13z ! ! data(25) = a20x data(26) = a20y data(27) = a20z ! data(28) = a21x data(29) = a21y data(30) = a21z ! data(31) = a22x data(32) = a22y data(33) = a22z ! data(34) = a23x data(35) = a23y data(36) = a23z ! ! data(37) = a30x data(38) = a30y data(39) = a30z ! data(40) = a31x data(41) = a31y data(42) = a31z ! data(43) = a32x data(44) = a32y data(45) = a32z ! data(46) = a33x data(47) = a33y data(48) = a33z ! !s--- !e+++ ! su_exnmg ! _________ ! ! Printout of a VARKON CUB_SUR surface as a NMG bicubic surface. ! ! Output: A text file surname.DAT in the bicubic F07 (NMG) format ! ! ----- Description of the data in the F07 file ------------------- ! ! The order of the patches: ! ------------------------- ! ! IU=1,IV=NV IU=NU,IV=NV ! ----------------------------------------- ! ! ! ! ! ! ! ! ! ! 13 ! 14 ! 15 ! 16 ! 17 ! 18 ! ! ----------------------------------------- ! ! ! ! ! ! ! ! ! ! 7 ! 8 ! 9 ! 10 ! 11 ! 12 ! ! ---------------------------------------- ! ! ! ! ! ! ! ! ! ! 1 ! 2 ! 3 ! 4 ! 5 ! 6 ! ! ---------------------------------------- ! ! IU=1,IV=1 IU=NU,IV=1 ! ! (Loop index iu= IU-1 and iv= IV-1 in program below) ! ! Surface data header: ! ------------------- ! ! Surface name Total_number_of_patches (Line 1) ! YTA/1 594 ( Ex. ) ! ! Patch data header: ! ------------------ ! ! I1 I2 I3 I4 I5 I6 I7 I8 I9 I10 (Line 2) ! 1 48 1 0 1001 0 0 34 19 0 ( Ex. ) ! ! where ! I1 = 1 (always one) ! I2 = Number of records (coefficients) = 48 for bicubic patch ! I3 = Patch number in file ! I4 = 0 (always zero) ! I5 = Surface type = 1001 for bicubic surface ! I6 = 0 ! I7 = 0 ! I8 = Number of U lines in the surface ! I9 = Number of V lines in the surface ! I10 = 0 (always zero) ! ! ! The order of the coefficients for a patch: ! ----------------------------------------- ! ! Line Coefficients ( for ) Coefficients ( for ) ! ! 1 a00x a00y a00z (1.0 * 1.0 ) a10x a10y a10z (U * 1.0 ) ! 2 a20x a20y a20z (U**2 * 1.0 ) a30x a30y a30z (U**3 * 1.0 ) ! 3 a01x a01y a01z (1.0 * V ) a11x a11y a11z (U * V ) ! 4 a21x a21y a21z (U**2 * V ) a31x a31y a31z (U**3 * V ) ! 5 a02x a02y a02z (1.0 * V**2) a12x a12y a12z (U * V**2) ! 6 a22x a22y a22z (U**2 * V**2) a32x a32y a32z (U**3 * V**2) ! 7 a03x a03y a03z (1.0 * V**3) a13x a13y a13z (U * V**3) ! 8 a23x a23y a23z (U**2 * V**3) a33x a33y a34z (U**3 * V**3) ! ... empty line (no data) ... ! ! Order of coefficients in VARKON's GETCUBP output vector ! _______________________________________________________ ! ! data( 1) = a00x data( 2) = a00y data( 3) = a00z ! data( 4) = a01x data( 5) = a01y data( 6) = a01z ! data( 7) = a02x data( 8) = a02y data( 9) = a02z ! data(10) = a03x data(11) = a03y data(12) = a03z ! ! data(13) = a10x data(14) = a10y data(15) = a10z ! data(16) = a11x data(17) = a11y data(18) = a11z ! data(19) = a12x data(20) = a12y data(21) = a12z ! data(22) = a13x data(23) = a13y data(24) = a13z ! ! data(25) = a20x data(26) = a20y data(27) = a20z ! data(28) = a21x data(29) = a21y data(30) = a21z ! data(31) = a22x data(32) = a22y data(33) = a22z ! data(34) = a23x data(35) = a23y data(36) = a23z ! ! data(37) = a30x data(38) = a30y data(39) = a30z ! data(40) = a31x data(41) = a31y data(42) = a31z ! data(43) = a32x data(44) = a32y data(45) = a32z ! data(46) = a33x data(47) = a33y data(48) = a33z ! ! The function checks that there are no NULL patches in the surface. ! The parameterization is also checked. Global parameters shall be ! integers defined by the patch adress IU,IV. ! !e--- ! ! Copyright Author: 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. ! ! Revisions ! --------- ! ! 1995-06-25 Originally written ! Copyright 1996-03-23 ex_nmgbic->su_exnmg 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. ! Copyright 1997-04-19 close for error 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 su_exnmg ( REF s_id >"@t16 Select a CUB_SUR surface"; STRING surname*24:="SLASK" >"Surface name (will also be file name with .DAT added)" ); !sdesce Printout of a CUB_SUR surface as a bicubic surface (NMG format) !sdescs Utskrift av en CUB_SUR yta som en bikubisk yta (NMG format) ! Internal variables: CONSTANT INT language= 2; ! 1: English Eq. 2: Swedish FILE dat; ! Output (F07) file INT typ; ! Type of surface INT npatu; ! No patches in U direction INT npatv; ! No patches in V direction INT nopat; ! Patch number in file STRING ermess1*40; ! Error message STRING ermess2*40; ! Error message STRING ermess3*40; ! Error message STRING ermess4*40; ! Error message STRING ermess5*50; ! Error message STRING ermess6*50; ! Error message STRING ermess7*50; ! Error message STRING ermess8*50; ! Error message STRING ermess9*50; ! Error message STRING ermess10*50; ! Error message STRING message1*50; ! PSH_PMT message INT no_c; ! Number of characters INT i_c; ! Loop index character STRING rad*132; ! Line INT iu; ! Loop index U patch INT iv; ! Loop index V patch FLOAT pdat(48); ! Patch data FLOAT offset; ! Offset for patch INT p_typ; ! Patch type FLOAT u1; ! Start U value patch FLOAT u2; ! End U value patch FLOAT v1; ! Start V value patch FLOAT v2; ! End V value patch STRING s*1; ! For debug printout to screen BEGINMODULE !s+++ ! Algoritm !s--- !e+++ ! Algorithm !e--- !e+++ ! 1. Initializations and check of input data !e--- !s+++ ! 1. Initieringar och kontroll av indata !s--- IF language = 1 THEN ! English strings ermess1:=surname+".DAT exists";! ermess2:="Open "+surname+ ! ".DAT failed"; ! ermess3:=" "; ! ermess4:="Not a"+ ! " CUB_SUR surface"; ! ermess5:="Not a"+ ! " CUB_PAT patch. Type= "; ! ermess6:="Parameterization "+ ! " not OK. ustart= "; ! ermess7:="Parameterization "+ ! " not OK. uend= "; ! ermess8:="Parameterization "+ ! " not OK. vstart= "; ! ermess9:="Parameterization "+ ! " not OK. vend= "; ! ermess10:="Offset patch cannot"! + "be exported. Offset= "; ! message1:="su_exnmg "+ ! " Creating "; ! ELIF language = 2 THEN ! Swedish strings ermess1:=surname+".DAT "+ ! "existerar"; ! ermess2:="\ppnandet av "+ ! surname+ ".DAT misslyckades"; ! ermess3:=" "; ! ermess4:="Ej en"+ ! " CUB_SUR yta"; ! ermess5:="Ej en"+ ! " CUB_PAT patch. Typ= "; ! ermess6:="Parameterisering "+ ! " ej OK. ustart= "; ! ermess7:="Parameterisering "+ ! " ej OK. uslut= "; ! ermess8:="Parameterisering "+ ! " ej OK. vstart= "; ! ermess9:="Parameterisering "+ ! " ej OK. vslut= "; ! ermess10:="Offset patch kan " ! + "inte exporteras. Offset= "; ! message1:="su_exnmg "+ ! " Skapar "; ! ELSE ! EXIT("ma_surexdf: " + ! "Language error"); ! ENDIF; ! !e+++ ! Open file. Exit with error if file already exists on ! the active JOB directory !e--- !s+++ ! \ppna fil. Fel om filen redan finns p} aktiva JOB katalogen !s--- OPEN(dat,"r",act_jobdir() ! Check if file already exists +surname+".DAT"); ! IF (IOSTAT(dat) <> 0 ) THEN ! ! OK, file does not exist ! ; ! ELSE ! CLOSE(dat); ! EXIT("su_exnmg " + ! ermess1 ); ! ENDIF; ! PSH_PMT(message1+ACT_JOBDIR() ! Message to screen +surname+".DAT"); ! OPEN(dat,"w",act_jobdir()+ ! Open output .DAT (F07) file surname+".DAT"); ! IF (IOSTAT(dat) <> 0 ) THEN ! Check (program error) EXIT("su_exnmg " + ! ermess2 ); ! ENDIF; ! !e+++ ! Retrieve surface type and number of patches in U and V direction !e--- !s+++ ! H{mta yttyp och antal "patches" i U och V riktningen !s--- GETSURH(s_id,"SUR_TYPE",typ); ! Type GETSURH(s_id,"NPATU",npatu); ! No U patches GETSURH(s_id,"NPATV",npatv); ! No V patches IF typ <> 1 THEN ! Not a CUB_SUR surface CLOSE(dat); ! POP_PMT(); ! EXIT("su_exnmg " + ! ermess4 ); ! ENDIF; !e+++ ! Write header !e--- !s+++ ! Skriv huvud !s--- no_c := LENGTH(surname); ! No characters in surname rad:= " " + surname; ! Two blanks and surname FOR i_c:= 2+no_c TO 30 DO ! Add blanks rad:= rad + " "; ! ENDFOR; ! rad:=rad+STR(npatu*npatv,6,0);! Add total number of patches OUTSTR(dat,rad); ! Write line 1 OUTLIN(dat); ! End Of Line !e+++ ! Write patch data !e--- !s+++ ! Skriv patch data !s--- nopat := 0; ! Initialize no patches FOR iv:= 1 TO npatv DO ! Start loop V patches FOR iu:= 1 TO npatu DO ! Start loop U patches nopat:= nopat+1; ! An additional patch rad:= " "; ! Patch data header (Line 2) rad:= rad+STR( 1 ,5,0); ! rad:= rad+STR( 48 ,5,0); ! rad:= rad+STR(nopat,5,0); ! rad:= rad+STR( 0 ,5,0); ! rad:= rad+STR( 1001,5,0); ! rad:= rad+STR( 0 ,5,0); ! rad:= rad+STR( 0 ,5,0); ! rad:= rad+STR(npatu+1,5,0); ! rad:= rad+STR(npatv+1,5,0); ! rad:= rad+STR( 0 ,5,0); ! OUTSTR(dat,rad); ! Write line 2 OUTLIN(dat); ! End Of Line GETTOPP(s_id,iu,iv,p_typ, ! Get topological data u1,u2,v1,v2); ! IF p_typ <> 1 THEN ! Check for NULL patch CLOSE(dat); ! POP_PMT(); ! EXIT("su_exnmg " + ! ermess5 + ! STR(p_typ,-1,0) ); ! ENDIF; ! IF ABS(iu+0-u1)>0.0001 THEN ! Check parameterization CLOSE(dat); ! POP_PMT(); ! EXIT("su_exnmg " + ! ermess6 + ! STR(u1,-12,8) ); ! ENDIF; ! IF ABS(iu+1-u2)>0.0001 THEN ! CLOSE(dat); ! POP_PMT(); ! EXIT("su_exnmg " + ! ermess7 + ! STR(u2,-12,8) ); ! ENDIF; ! IF ABS(iv+0-v1)>0.0001 THEN ! Check parameterization CLOSE(dat); ! POP_PMT(); ! EXIT("su_exnmg " + ! ermess8 + ! STR(v1,-12,8) ); ! ENDIF; ! IF ABS(iv+1-v2)>0.0001 THEN ! CLOSE(dat); ! POP_PMT(); ! EXIT("su_exnmg " + ! ermess9 + ! STR(v2,-12,8) ); ! ENDIF; ! GETCUBP(s_id,iu,iv,pdat, ! Get patch data offset); ! IF ABS(offset) >0.0001 THEN ! CLOSE(dat); ! POP_PMT(); ! EXIT("su_exnmg " + ! ermess10 + ! STR(offset,-12,8) ); ! ENDIF; ! rad:= STR(pdat( 1),12,5);! a00x (Line 1) rad:=rad+STR(pdat( 2),12,5);! a00y rad:=rad+STR(pdat( 3),12,5);! a00z rad:=rad+STR(pdat(13),12,5);! a10x rad:=rad+STR(pdat(14),12,5);! a10y rad:=rad+STR(pdat(15),12,5);! a10z OUTSTR(dat,rad); ! Write line OUTLIN(dat); ! End Of Line rad:= STR(pdat(25),12,5);! a20x (Line 2) rad:=rad+STR(pdat(26),12,5);! a20y rad:=rad+STR(pdat(27),12,5);! a20z rad:=rad+STR(pdat(37),12,5);! a30x rad:=rad+STR(pdat(38),12,5);! a30y rad:=rad+STR(pdat(39),12,5);! a30z OUTSTR(dat,rad); ! Write line OUTLIN(dat); ! End Of Line rad:= STR(pdat( 4),12,5);! a01x (Line 3) rad:=rad+STR(pdat( 5),12,5);! a01y rad:=rad+STR(pdat( 6),12,5);! a01z rad:=rad+STR(pdat(16),12,5);! a11x rad:=rad+STR(pdat(17),12,5);! a11y rad:=rad+STR(pdat(18),12,5);! a11z OUTSTR(dat,rad); ! Write line OUTLIN(dat); ! End Of Line rad:= STR(pdat(28),12,5);! a21x (Line 4) rad:=rad+STR(pdat(29),12,5);! a21y rad:=rad+STR(pdat(30),12,5);! a21z rad:=rad+STR(pdat(40),12,5);! a31x rad:=rad+STR(pdat(41),12,5);! a31y rad:=rad+STR(pdat(42),12,5);! a31z OUTSTR(dat,rad); ! Write line OUTLIN(dat); ! End Of Line rad:= STR(pdat( 7),12,5);! a02x (Line 5) rad:=rad+STR(pdat( 8),12,5);! a02y rad:=rad+STR(pdat( 9),12,5);! a02z rad:=rad+STR(pdat(19),12,5);! a12x rad:=rad+STR(pdat(20),12,5);! a12y rad:=rad+STR(pdat(21),12,5);! a12z OUTSTR(dat,rad); ! Write line OUTLIN(dat); ! End Of Line rad:= STR(pdat(31),12,5);! a22x (Line 6) rad:=rad+STR(pdat(32),12,5);! a22y rad:=rad+STR(pdat(33),12,5);! a22z rad:=rad+STR(pdat(43),12,5);! a32x rad:=rad+STR(pdat(44),12,5);! a32y rad:=rad+STR(pdat(45),12,5);! a32z OUTSTR(dat,rad); ! Write line OUTLIN(dat); ! End Of Line rad:= STR(pdat(10),12,5);! a03x (Line 7) rad:=rad+STR(pdat(11),12,5);! a03y rad:=rad+STR(pdat(12),12,5);! a03z rad:=rad+STR(pdat(22),12,5);! a13x rad:=rad+STR(pdat(23),12,5);! a13y rad:=rad+STR(pdat(24),12,5);! a13z OUTSTR(dat,rad); ! Write line OUTLIN(dat); ! End Of Line rad:= STR(pdat(34),12,5);! a23x (Line 8) rad:=rad+STR(pdat(35),12,5);! a23y rad:=rad+STR(pdat(36),12,5);! a23z rad:=rad+STR(pdat(46),12,5);! a33x rad:=rad+STR(pdat(47),12,5);! a33y rad:=rad+STR(pdat(48),12,5);! a33z OUTSTR(dat,rad); ! Write line OUTLIN(dat); ! End Of Line OUTLIN(dat); ! Empty Line ENDFOR; ! End loop U patches ENDFOR; ! End loop V patches !e+++ ! Close output file !e--- !s+++ ! St{ng utdata fil !s--- CLOSE(dat); ! Close F07 file POP_PMT(); ! Erase message to screen ENDMODULE