DATE
PROG
TRN
<
< DEFINITIONS ARBITRAIRES POUR
< LA TAILLE DE LA LISTE DES NOEUDS :
<
XX:: VAL 32 < NOMBRE DE COLONNES.
YY:: VAL 2*29+1 < NOMBRE DE LIGNES.
< (2 : CAR ON VA DE 2 EN 2,
< 29 : AFIN D'AVOIR UN NOMBRE PAIR (29+1)
< DE BANDES, PUISQUE LES TRIANGLES
< SONT EN QUINCONCE...)
<
<
< D E F I N I T I O N S G E N E R A L E S :
<
<
XUNDEF:: VAL -1 < POUR NE DEFINIR QUE LES 'XX...' DANS LES
< FICHIERS DE DEFINITION...
CALL #SIP DEFINITION CTTE#
<
< PREPARATION DE L'APPEL DE #SIP UTILITAIRES# :
<
XXXDEF: VAL XUNDEF
XXXLOC: VAL XUNDEF
XXXTAB: VAL XUNDEF
XXXPRO: VAL XUNDEF
CALL #SIP UTILITAIRES#
<
<
< D E F I N I T I O N D E L ' I M A G E :
<
<
XXXIMA: VAL XUNDEF < AFIN DE NE DEFINIR QUE LES 'XXIMA'...
CALL #SIP IMAGE 512#
XXXIMA: VAL XXIMA0 < DEFINITION DES CONSTANTES "IMAGES".
CALL #SIP IMAGE 512#
YYYIMA: VAL YYYIM1 < POUR ENVOYER SEQUENTIELLEMENT
< (NIVEAU,X,Y) DANS 'STORP'...
<
<
< D E F I N I T I O N D E L ' E S P A C E :
<
<
DIMESP:: VAL 3 < ON TRAVAILLE DANS L'ESPACE EUCLIDIEN
< A 3 DIMENSIONS...
PAGE
<
<
< O P T I O N S D ' A S S E M B L A G E :
<
<
XOPT01: @
XWOR%1: VAL KOLF=FMASK+KOLTES=FVAL
XWOR%1: VAL KOLC=FMASK+KDP=FVAL?XWOR%1
XWOR%2: VAL KOLTED=FMASK+KOL0=FVAL
XWOR%2: VAL KOLTEF=FMASK+KOL0+KOLON=FVAL?XWOR%2
XWOR%3: VAL XWOR%2=XWOR%1-KOL0 < LONGUEUR DU SYMBOLE COURANT...
XWOR%4: VAL MSYMBI=FMASK+KOL0=FVAL
XWOR%4: VAL MSYMBL=FMASK+XWOR%3=FVAL?XWOR%4
XWOR%5: VAL XWOR%4=FCSYMT < ETAT DU SYMBOLE 'XOPT01'...
XWOR%6: VAL XWOR%5=FCSIGN
XWOR%7: VAL XWOR%5(MSYMBN)MSYMBN=FCSIGN
IF XWOR%6*XWOR%7,XEIF%,,XEIF%
XOPT01:: VAL EXIST < TRACE GRAPHIQUE, ET VERIFICATIONS CROI-
< SEES DES EQUATIONS CALCULEES...
XEIF%: VAL ENDIF
PAGE
<
<
< B A S D E L A M E M O I R E :
<
<
ZERO: EQU $
DZS PEPROG-D+Z
<
< POINT D'ENTREE :
<
ENTRY: EQU $
LRM A,K
WORD DEBUT < POINT D'ENTREE DU PROGRAMME,
WORD STACK-DEPILE < INITIALISATION DE LA PILE.
PSR A
RSR < ON EFFECTUE AINSI UN 'GOTO' 'DEBUT'...
PAGE
<
<
< M E S S A G E S :
<
<
TABLE
<
<
< L O C A L :
<
<
LOCAL
LOC: EQU $
<
< INDICATEURS DE CONTROLE
< DES GENERATIONS 'SGN' ET
< DES TRACES GRAPHIQUES :
<
ISGNFI: WORD EXIST < GENERER ('EXIST') OU PAS ('NEXIST')
< LES FACETTES "INTERNES".
ISGNFE: WORD EXIST < GENERER ('EXIST') OU PAS ('NEXIST')
< LES FACETTES "EXTERNES".
IF XOPT01-EXIST,XOPT1,,XOPT1
IWGFI: WORD EXIST < TRACER ('EXIST') OU PAS ('NEXIST') LES
< FACETTES "INTERNES".
IWGNFI: WORD EXIST < TRACER ('EXIST') OU PAS ('NEXIST') LES
< NORMALES AUX FACETTES "INTERNES".
IWGIFI: WORD EXIST < TRACER ('EXIST') OU PAS ('NEXIST') LES
< INTERSECTIONS DE LA DROITE 'D' ET DES
< FACETTES "INTERNES".
IWGFE: WORD EXIST < TRACER ('EXIST') OU PAS ('NEXIST') LES
< FACETTES "EXTERNES".
IWGIFE: WORD EXIST < TRACER ('EXIST') OU PAS ('NEXIST') LES
< INTERSECTIONS DE LA DROITE 'D' ET DES
< FACETTES "EXTERNES".
IWGIDS: WORD EXIST < TRACER ('EXIST') OU PAS ('NEXIST') LES
< INTERSECTIONS DE LA DROITE 'D' ET DE
< LA SURFACE 'S'.
IWPRST: WORD EXIST < TRACER ('EXIST') OU PAS ('NEXIST') LES
< POINTS RASTER LORS DU BALAYAGE DE
< L'ECRAN.
IWCONV: WORD EXIST < TRACER ('EXIST') OU PAS ('NEXIST') LA
< CONVERGENCE LORS DE LA RECHERCHE DE
< L'INTERSECTION DE 'D' ET DE 'S'.
XOPT1: VAL ENDIF
IVSUR: WORD EXIST < QUE DOIT-ON VISUALISER :
< 'NEXIST' : UNIQUEMENT LES FACETTES PLANES
< 'EXIST' : LA SURFACE...
<
< NOM ET VALEUR COURANTE :
<
NMAIL: ASCI "X*"
LRMAIL:: VAL $-NMAIL*NOCMO < LONGUEUR DE LA RACINE DU NOM...
NMAIL1: ASCI "YYXX"
BYTE KEOT;K
LNMAIL:: VAL $-NMAIL*NOCMO-W < LONGUEUR DU NOM DE LA MAILLE...
FVALS: EQU $
CS3D: EQU $ < DEBUT DES COORDONNEES 3D :
FXS: FLOAT <NILK<NILK<NILK < COORDONNEE 'X' 3D,
FYS: FLOAT <NILK<NILK<NILK < COORDONNEE 'Y' 3D,
FZS: FLOAT <NILK<NILK<NILK < COORDONNEE 'Z' 3D.
LBUF3D:: VAL $-CS3D < NOMBRE DE MOTS POUR UN POINT 3D...
IF LBUF3D/DFLOT-DIMESP,,XEIF%,
IF ATTENTION : INCOHERENCE DANS LES
IF DIMENSIONS DE L'ESPACE !!!
XEIF%: VAL ENDIF
XN: FLOAT <NILK<NILK<NILK < X(NORMALE AU NOEUD),
YN: FLOAT <NILK<NILK<NILK < Y(NORMALE AU NOEUD),
ZN: FLOAT <NILK<NILK<NILK < Z(NORMALE AU NOEUD).
VARU3D: FLOAT <NILK<NILK<NILK < COORDONNEE CURVILIGNE 'U',
VARV3D: FLOAT <NILK<NILK<NILK < COORDONNEE CURVILIGNE 'V'.
LMAIL:: VAL $-NMAIL*NOCMO < LONGUEUR TOTALE NOM+VALEUR DU NOEUD...
LVMAIL:: VAL LMAIL-LNMAIL < LONGUEUR DE LA VALEUR SEULE.
IDENT: BYTE NILK;NILK < ENSEMBLE (I,J) REMPLACANT TOPOLOGIQUE-
< MENT POUR CHAQUE NOEUD LE COUPLE (YR,XR)
< RENVOYE DANS LE NOM...
LBUF4D:: VAL $-CS3D < LONGUEUR DU BLOC (FXS,FYS,FZS,NORMALE,
< U,V,IDENT).
<
< DONNEES DE RECONSTITUTION
< DE SOUS-CATALOGUES 'SGN' :
<
ACATAL: WORD CATAL < SOUS-PROGRAMME DE RECONSTITUTION DU
< SOUS-CATALOGUE ARGUMENT.
APVAR: WORD NILK < SOUS-PROGRAMME SPECIFIQUE A APPELER
< POUR CHAQUE NOM RECUPERE.
ANOM: WORD NILK < RELAI INDEXE VERS LE NOM COURANT.
DEMSGN: BYTE NILK;FAVW < DEMANDE D'ACCES AU 'SGN' :
WORD NILK < ADRESSE OCTET DU NOM COURANT.
WORD NILK < LA LONGUEUR VARIE SUIVANT LE 'NVP'...
WORD FOLLOW
XRAC: WORD NILK < NOMBRE DE CARACTERES DE LA RACINE
< COURANTE DU CATALOGUE.
AGOSGN: WORD GOSGN < SOUS-PROGRAMME D'ACCES AU 'SGN'...
<
< DONNEES DE CORRESPONDANCE (YR,XR) --> (I,J) :
<
NUMI: WORD NILK < NUMERO DE LIGNE,
NUMJ: WORD NILK < NUMERO DE COLONNE.
XR: WORD NILK < 'XR' COURANT,
XRP: WORD NILK < 'XR' ANTERIEUR.
YR: WORD NILK < 'YR' COURANT,
YRP: WORD NILK < 'YR' ANTERIEUR.
AMOCDN: WORD MOCD+N < POUR INITIALISER 'YRP' ET 'XRP'...
< (VALEUR IMPOSSIBLE POUR 'XR' ET 'YR')
IMAX:: VAL YY < VALEUR MAXIMALE (INACCESSIBLE) DE 'I'.
APLIGX: WORD PLIGX,X < TABLE DES INDEX DE LIGNES DANS 'BUF'
< POUR CHAQUE LIGNE 'I' MEMORISEE...
APLIGM: WORD PLIGM,X < TABLE DES 'J' MAX POUR CHAQUE LIGNE
< 'I' MEMORISEE.
<
< BUFFER DES NOEUDS :
<
XBUF: WORD NILK < INDEX COURANT D'INSERTION,
< N O T A : 'INDEX' SIGNIFIE EN FAIT PAR
< LA SUITE : ADRESSE PAR RAP-
< PORT A L'ORIGINE DE LA 'CDA'.
XBUFI0: WORD NILK < XBUF(I,0), POUR 'SP3'...
XBUFMX: WORD XX*YY*LBUF4D < VALEUR MAXIMALE DE L'INDEX 'XBUF'.
ABUF4D: WORD LBUF4D < CONSTANTE MULTIPLICATIVE...
<
< RECONSTITUTION DES TRIANGLES :
<
ITORE: WORD K < INDICATEUR DE "I-TORE" :
< =K : NON,
< #K : OUI, ON GERE UN "I-TORE"...
SAVEX0: WORD NILK < XBUF(I,J),
SAVEX1: WORD NILK < XBUF(I,J+2),
SAVEX2: WORD NILK < XBUF(I+2,J+1),
SAVEX3: WORD NILK < XBUF(I+2,J+1+2).
SNUMI: WORD NILK < SAUVEGARDE DU 'I' DE LA LIGNE COURANTE.
ASP1: WORD SP1 < TRANSFERT D'UN NOEUD DE 'BUF' VERS
< LE LOCAL ET PROJECTION 2D.
ASP2: WORD SP2 < TRACE D'UN VECTEUR ET CHAINAGE VERS
< LE SUIVANT.
IF XOPT01-EXIST,XOPT1,,XOPT1
ASP2B: WORD SP2B < IDENTIQUE A 'SP2', MAIS SANS L'APPEL
< A 'SP1' A L'ENTREE...
ASP4: WORD SP4 < MISE EN PLACE DU PREMIER SOMMET D'UN
< TRIANGLE, ET PLUS GENERALEMENT DE
< L'ORIGINE D'UN VECTEUR.
ASP7: WORD SP7 < MISE EN PLACE DE L'EXTREMITE D'UN
< VECTEUR.
ASP1E: WORD SP1E < TRACE D'UNE FACETTE "EXTERNE"...
XOPT1: VAL ENDIF
ASP3: WORD SP3 < INCREMENTATION DE 'J' MODULO...
ASP5: WORD SP5 < INCREMENTATION DE 'I' SUIVANT "I-TORE".
XXXLOC: VAL YYYHIN < 'YYYHIN'.
CALL #SIP UTILITAIRES#
XXXLOC: VAL YYYHEX < 'YYYHEX'.
CALL #SIP UTILITAIRES#
IF XOPT01-EXIST,XOPT1,,XOPT1
<
< DONNEES DE VERIFICATION
< DES EQUATIONS DE PLAN :
<
ASPB: WORD SPB < VERIFICATION DE L'APPARTENANCE DES 3
< SOMMETS (A,B,C) AU PLAN 'P'.
ASPD: WORD SPD < VERIFICATION DE L'APPARTENANCE DU POINT
< 3D COURANT AU PLAN 'P'.
XOPT1: VAL ENDIF
<
< CALCUL DE LA VALEUR DE
< L'EQUATION D'UN PLAN EN
< LE POINT COURANT :
<
ASPC: WORD SPC < CALCUL DE LA VALEUR DE L'EQUATION DU PLAN
< (A,B,C) EN LE POINT COURANT 3D...
<
< DEFINITION D'UN SYSTEME
< LINEAIRE 3*3 :
<
FDETER: FLOAT <NILK<NILK<NILK < DETERMINANT D'UN SYSTEME 3*3...
MAT33: EQU $ < DEBUT DE LA MATRICE 3*3 :
M11: FLOAT <NILK<NILK<NILK
M12: FLOAT <NILK<NILK<NILK
M13: FLOAT <NILK<NILK<NILK
M14: FLOAT <NILK<NILK<NILK
M21: FLOAT <NILK<NILK<NILK
M22: FLOAT <NILK<NILK<NILK
M23: FLOAT <NILK<NILK<NILK
M24: FLOAT <NILK<NILK<NILK
M31: FLOAT <NILK<NILK<NILK
M32: FLOAT <NILK<NILK<NILK
M33: FLOAT <NILK<NILK<NILK
M34: FLOAT <NILK<NILK<NILK
LMAT33:: VAL $-MAT33 < LONGUEUR D'UNE MATRICE 3*3 Y COMPRIS
< LE VECTEUR COLONNE M(I,4), QUI SERA
< PARFOIS VECTEUR DE TRANSLATION...
IF M12-M11-DFLOT,,XEIF%,
IF ATTENTION : 'M11' ET 'M12' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
IF M13-M12-DFLOT,,XEIF%,
IF ATTENTION : 'M12' ET 'M13' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
IF M22-M21-DFLOT,,XEIF%,
IF ATTENTION : 'M21' ET 'M22' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
IF M23-M22-DFLOT,,XEIF%,
IF ATTENTION : 'M22' ET 'M23' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
IF M32-M31-DFLOT,,XEIF%,
IF ATTENTION : 'M31' ET 'M32' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
IF M33-M32-DFLOT,,XEIF%,
IF ATTENTION : 'M32' ET 'M33' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
XXXLOC: VAL YYYDET < 'YYYDET'.
CALL #SIP UTILITAIRES#
XXXLOC: VAL YYYCRA < 'YYYCRA'.
CALL #SIP UTILITAIRES#
<
< DONNEES DE CALCUL D'UN
< PRODUIT SCALAIRE :
<
APRSCA: WORD PRSCA < CE SOUS-PROGRAMME CALCULE LE PRODUIT
< SCALAIRE DES 2 VECTEURS ARGUMENTS.
<
< DEFINITION D'UNE DROITE :
<
CD3D: EQU $ < POINT 'D' :
FXSD: FLOAT <NILK<NILK<NILK < X(POINT D),
FYSD: FLOAT <NILK<NILK<NILK < Y(POINT D),
FZSD: FLOAT <NILK<NILK<NILK < Z(POINT D).
DV3D: EQU $ < VECTEUR DIRECTEUR DE LA DROITE 'D' :
DVX: FLOAT <NILK<NILK<NILK < X(VECTEUR DIRECTEUR V),
DVY: FLOAT <NILK<NILK<NILK < Y(VECTEUR DIRECTEUR V),
DVZ: FLOAT <NILK<NILK<NILK < Z(VECTEUR DIRECTEUR V).
<
< DONNEES DU TRI DE
< TROIS NOMBRES :
<
ASPTRI: WORD SPTRI < SOUS-PROGRAMME DE TRI DE TROIS NOMBRES
< DONT ON SE DONNE LES ADRESSES.
<
< DONNEES D'INTERSECTION DE
< LA DROITE 'D' ET DE LA BOULE 'B' :
<
BINTER: WORD NILK < (BINTER)='NEXIST' : SI LA DROITE 'D' NE
< COUPE PAS LA BOULE 'B',
< ='EXIST' : SI LA DROITE 'D' EST
< TANGENTE OU COUPE LA BOULE 'B'.
AINTDB: WORD INTDB < CALCUL DE L'INTERSECTION DE 'D' ET 'B'.
<
< DONNEES POUR L'INTERSECTION DE
< LA DROITE 'D' ET DU PLAN 'P' :
<
PINTER: WORD NILK < 'PINTER' N'A DE SENS QUE LORSQUE L'INDI-
< CATEUR 'BINTER' VAUT 'EXIST', ET ALORS :
< (PINTER)='NEXIST' SI AUCUN POINT D'INTER-
< SECTION ENTRE 'D' ET 'P' INTE-
< RIEUR A (A,B,C) N'A ETE TROUVE,
< (PINTER)='EXIST', SINON, (FXSM,FYSM,FZSM)
< SONT SES COORDONNEES 3D, ET
< (ALPHA,BETA,GAMMA) SES COORDON-
< NEES BARYCENTRIQUES.
CM3D: EQU $ < POINT 'M' :
FXSM: FLOAT <NILK<NILK<NILK < X(POINT D'INTERSECTION M),
FYSM: FLOAT <NILK<NILK<NILK < Y(POINT D'INTERSECTION M),
FZSM: FLOAT <NILK<NILK<NILK < Z(POINT D'INTERSECTION M).
ALPHA: FLOAT <NILK<NILK<NILK < COORDONNEE BARYCENTRIQUE 1 DE M,
BETA: FLOAT <NILK<NILK<NILK < COORDONNEE BARYCENTRIQUE 2 DE M,
GAMMA: FLOAT <NILK<NILK<NILK < COORDONNEE BARYCENTRIQUE 3 DE M.
FRHOM: FLOAT <NILK<NILK<NILK < PARAMETRE DU POINT 'M' PAR RAPPORT AU
< POINT 'D' SUR LA DROITE 'D'.
VARUM: FLOAT <NILK<NILK<NILK < COORDONNEE CURVILIGNE U(M),
VARVM: FLOAT <NILK<NILK<NILK < COORDONNEE CURVILIGNE V(M).
AINTDP: WORD INTDP < CALCUL DE L'INTERSECTION DE 'D' ET 'P'.
APUVM: WORD PUVM < CALCUL DE LA SOLUTION INITIALE LORS
< DES ITERATIONS (VARUM,VARVM).
IF XOPT01-EXIST,XOPT1,,XOPT1
ASP8: WORD SP8 < TRACE DE CONTROLE DE (AM,BM,CM).
XOPT1: VAL ENDIF
<
< DONNEES POUR L'INTERSECTION DE
< LA DROITE 'D' ET DE LA SURFACE 'S' :
<
SINTER: WORD NILK < 'SINTER' N'A DE SENS QUE LORSQUE L'INDI-
< CATEUR 'BINTER' ET L'INDICATEUR 'PINTER'
< VALENT TOUS DEUX 'EXIST', ET ALORS :
< (SINTER)='NEXIST' : PAS DE POINT D'INTER-
< SECTION ENTRE 'D' ET 'S' A
< L'INTERIEUR DE LA FACETTE COU-
< RANTE,
< (SINTER)='EXIST' : (FXS,FYS,FZS) EST UN
< POINT D'INTERSECTION ENTRE 'D'
< ET 'S' POUR LA FACETTE COURANTE.
DVARU: FLOAT <NILK<NILK<NILK < ACCROISSEMENT DE 'VARU',
DVARV: FLOAT <NILK<NILK<NILK < ACCROISSEMENT DE 'VARV',
DRHO: FLOAT <NILK<NILK<NILK < ACCROISSEMENT DE 'RHO'.
XWOR%3: VAL 3 < AFIN DE DEFINIR 'FEPSUV' :
FEPSUV: FLOAT <W<K<-XWOR%3 < 'EPSILON' DE TEST DE CONVERGENCE DE LA
< METHODE ITERATIVE DE RESOLUTION.
MAXCO1:: VAL 32 < NOMBRE MAXIMAL DE RELANCE DES ITERATIONS
< SUR CONVERGENCE VERS UNE MAUVAISE
< RACINE.
IF MAXCO1-K,,,XEIF%
IF ATTENTION : 'MAXCO1' EST MAUVAIS !!!
XEIF%: VAL ENDIF
MAXCO2:: VAL 128 < LIMITE DU NOMBRE D'ITERATIONS DANS LA
< RESOLUTION AVANT DE DECRETER LA NON-
< CONVERGENCE...
IF MAXCO2-K,,,XEIF%
IF ATTENTION : 'MAXCO2' EST MAUVAIS !!!
XEIF%: VAL ENDIF
AINTDS: WORD INTDS < SOUS-PROGRAMME CALCULANT L'INTERSECTION
< ENTRE 'D' ET 'S' POUR LA FACETTE
< "EXTERNE" COURANTE...
XWOR%1: VAL I+I < FACTEUR D'EXTENSION DE LA NOTION DE
< COORDONNEE BARYCENTRIQUE...
< EN FAIT, (FBARI,FBARS) SONT CALCULES
< DYNAMIQUEMENT EN FONCTION DE L'ANGLE
< ENTRE LE PLAN 'P' DE LA FACETTE ET DE
< LA DROITE 'D'...
FBARI: FLOAT <K-XWOR%1<K<K < BORNE INFERIEURE DE DEFINITION DES
< COORDONNEES BARYCENTRIQUES GENERALISEES,
FBARS: FLOAT <W+XWOR%1<K<K < BORNE SUPERIEURE DE DEFINITION DES
< COORDONNEES BARYCENTRIQUES GENERALISEES.
XNBARC:: VAL XXXMOY*XXXMOY*XXXMOY*XXXMOY*XXXMOY*XXXMOY
< POUR CALCULER 'FBARC'...
FBARC: FLOAT <XNBARC<K<K
< CONSTANTE MULTIPLICATIVE DE CALCUL DE
< (FBARI,FBARS) DANS 'INTDP'...
FREDUC: FLOAT <XXXMOY<K<K < FACTEUR DE REDUCTION RELATIVEMENT ARBI-
< TRAIRE, LORS DE LA RELANCE APRES UNE
< CONVERGENCE VERS UNE MAUVAISE RACINE.
IF XOPT01-EXIST,XOPT1,,XOPT1
ASP8S: WORD SP8S < MODULE DE VISUALISATION DE CETTE INTER-
< SECTION...
XOPT1: VAL ENDIF
ATRIGU: WORD TRIGU < DETERMINATION DE LA POSITION DU TRIANGLE
< (A,B,C) DANS LE SEGMENT (MIN(U),MAX(U)).
ATRIGV: WORD TRIGV < DETERMINATION DE LA POSITION DU TRIANGLE
< (A,B,C) DANS LE SEGMENT (MIN(V),MAX(V)).
ASEGMU: WORD SEGMU < DETERMINATION DE LA POSITION D'UN SEGMENT
< (A,B), (B,C) OU (C,A) DANS LE SEGMENT
< (MIN(U),MAX(U)).
ASEGMV: WORD SEGMV < DETERMINATION DE LA POSITION D'UN SEGMENT
< (A,B), (B,C) OU (C,A) DANS LE SEGMENT
< (MIN(V),MAX(V)).
APERIU: WORD PERIU < MISE DE 'VARU' DANS (MIL(U),MAX(U)).
APERIV: WORD PERIV < MISE DE 'VARV' DANS (MIL(V),MAX(V)).
APSEGU: WORD PSEGU < MISE DE 'VARU' DANS (MIN(U),MAX(U)).
APSEGV: WORD PSEGV < MISE DE 'VARV' DANS (MIN(V),MAX(V)).
ALTORE: WORD LTORE,X < RELAI INDEXE VERS UNE TABLE DONNANT DES
< INFORMATIONS SUR L'ESPACE DES COORDON-
< NEES CURVILIGNES (U,V), QUI EN GENERAL
< EST UN TORE ; ON TROUVE :
< ((MIN(U),MIL(U),MAX(U),PERIOD(U),EPS(U)),
< (MIN(V),MIL(V),MAX(V),PERIOD(V),EPS(V)))
FEPSTO: FLOAT <W<K<K
< CONSTANTE MULTIPLICATIVE DE CALCUL DE
< EPS(U) ET EPS(V) DANS 'INTDP'.
FPERSI: FLOAT <XXXMOY*XXXMOY*XXXMOY<K<K
< CONSTANTE MULTIPLICATIVE PERMETTANT DE
< PERTURBER LA SOLUTION INITIALE 'M' EN
< 'MP' LE LONG DE LA PROJECTION DE 'D'
< SUR 'P'.
<
< DONNEES DE GENERATION DES
< SPHERES :
<
ASPHER: WORD SPHERE < SOUS-PROGRAMME DE GENERATION DE LA BOULE
< MINIMALE CIRCONSCRITE A UNE FACETTE.
<
< DONNEES DE CALCUL DES
< PLANS DE TYPE 'P2' :
<
FPRMIX: FLOAT <NILK<NILK<NILK < PRODUIT MIXTE DE 3 VECTEURS.
FMODUL: FLOAT <NILK<NILK<NILK < MODULE AU CARRE D'UN VECTEUR.
<
< DONNEES DE CALCUL DES POINTS
< 'MAB', 'MBC', 'MCA' ET 'MABC' :
<
ASP1F: WORD SP1F < SOUS-PROGRAMME DE NORMALISATION DU
< VECTEUR LIGNE (M11,M12,M13).
<
< DONNEES DE GENERATION DES
< FACETTES "EXTERNES" :
<
AFACE: WORD FACE < DETERMINATION DES 6 FACETTES "EXTERNES"
< ASSOCIEES A LA FACETTE "INTERNE" (A,B,C).
< (FACETTE COURANTE...)
<
< COORDONNEES DES POINTS
< DU TYPE 'MAB' :
<
CAB3D: EQU $ < POINT 'MAB' :
FXSAB: FLOAT <NILK<NILK<NILK < X(MAB),
FYSAB: FLOAT <NILK<NILK<NILK < Y(MAB),
FZSAB: FLOAT <NILK<NILK<NILK < Z(MAB).
<
< COORDONNEES DES POINTS
< DU TYPE 'MBC' :
<
CBC3D: EQU $ < POINT 'MBC' :
FXSBC: FLOAT <NILK<NILK<NILK < X(MBC),
FYSBC: FLOAT <NILK<NILK<NILK < Y(MBC),
FZSBC: FLOAT <NILK<NILK<NILK < Z(MBC).
<
< COORDONNEES DES POINTS
< DU TYPE 'MCA' :
<
CCA3D: EQU $ < POINT 'MCA' :
FXSCA: FLOAT <NILK<NILK<NILK < X(MCA),
FYSCA: FLOAT <NILK<NILK<NILK < Y(MCA),
FZSCA: FLOAT <NILK<NILK<NILK < Z(MCA).
<
< COORDONNEES DES POINTS
< DU TYPE 'MABC' :
<
CABC3D: EQU $ < POINT 'MABC' :
FXSABC: FLOAT <NILK<NILK<NILK < X(MABC),
FYSABC: FLOAT <NILK<NILK<NILK < Y(MABC),
FZSABC: FLOAT <NILK<NILK<NILK < Z(MABC).
<
< DONNEES DE CONVERGENCE
< HEURISTIQUE :
<
VARU0: EQU FXSAB < COORDONNEE 'U' CALCULEE AU DEBUT DE
< 'INTDS' PAR PERTURBATION DE CELLE FOUR-
< NIE PAR 'INTDP',
VARV0: EQU FYSAB < COORDONNEE 'V' CALCULEE AU DEBUT DE
< 'INTDS' PAR PERTURBATION DE CELLE FOUR-
< NIE PAR 'INTDP'.
<
< DONNEES DE LA PROJECTION :
<
FACT: FLOAT <NILK<NILK<NILK < FACTEUR D'ECHELLE...
PZ: FLOAT <NILK<NILK<NILK < POSITION DU POINT DE VUE SUR L'AXE OZ,
< QUI EST DEVANT L'ECRAN...
TRX: WORD NILK < TRANSLATION DU
TRY: WORD NILK < TRACE (VISU ET RASTER).
CS2D: EQU $ < DEBUT DES COORDONNEES 2D :
YS: WORD NILK < COORDONNEES 2D DU
XS: WORD NILK < POINT 3D PROJETE...
LBUF2D:: VAL $-CS2D < NOMBRE DE MOTS NECESSAIRES POUR UN POINT,
LBUFGR:: VAL LBUF2D+LBUF2D < ET POUR UN VECTEUR.
APROJ: WORD PROJ < SOUS-PROGRAMME DE PROJECTION 3D --> 2D...
<
< POUR LES TESTS DE COHERENCE :
<
ALIGNE: WORD LIGNE,X < RELAI VERS UNE LIGNE RASTER, CONTENANT,
< 'X' ETANT LA COORDONNE 'X' COURANTE
< RASTER : SUR (0,X-1) : LA LIGNE COURANTE,
< SUR (X,511) : LA LIGNE PRECEDEN-
< TE (Y-1).
NSEUIL: WORD NILK < SEUIL INDIQUANT LE "GAP" MAXIMAL ENTRE
< LE NIVEAU DU POINT COURANT ET CELUI DE
< SES VOISINS (DE GAUCHE ET DU DESSOUS)
< TEL QUE LA CONVERGENCE SOIT COHERENTE.
IF XOPT01-EXIST,XOPT1,,XOPT1
<
< DONNEES DE TRACE DE LA
< NORMALE A UN PLAN :
<
FACTN: FLOAT <NILK<NILK<NILK < FACTEUR D'ECHELLE DE LA NORMALE (CE QUI
< DONNE D'AILLEURS SA LONGUEUR...).
ASP6: WORD SP6 < SOUS-PROGRAMME DE TRACE D'UN VECTEUR
< COLINEAIRE AU VECTEUR NORMAL EN 'G' LE
< BARYCENTRE D'UN FACETTE.
XOPT1: VAL ENDIF
IF XOPT01-EXIST,XOPT1,,XOPT1
<
< DONNEES DE TRACE DES COOR-
< DONNEES BARYCENTRIQUES :
<
FEPS: EQU FEPSUV < 'EPSILON' POUR TESTER LA VALEUR DES
< (ALPHA,BETA,GAMMA) PAR RAPPORT AUX
< COORDONNEES (XM,YM,ZM) DEJA CONNUES...
ASP9: WORD SP9 < SOUS-PROGRAMME DE MISE EN PLACE DES
< SOMMETS (A,B,C) PUIS DE TRACE DES
< VECTEURS (AM,BM,CM)...
ASPA: WORD SPA < TRACE D'UNE ETOILE (AM,BM,CM).
XOPT1: VAL ENDIF
XXXLOC: VAL YYYCCI < 'YYYCCI'.
CALL #SIP UTILITAIRES#
<
< SOUS-PROGRAMMES DIVERS :
<
AMOVE3: WORD MOVE3 < SOUS-PROGRAMME EFFECTUANT UN 'MOVE' DE
< 3 ('LBUF3D') MOTS, DE (A) VERS (B)...
<
< DONNEES DE CLEAR ET D'INDETER-
< MINATION D'UN VECTEUR NORMAL :
<
IDENTX: BYTE MOCD;MOCD < IDENTIFICATEUR TOPOLOGIQUE D'UN POINT
< N'APPARTENANT PAS AU MAILLAGE DE BASE
< DE LA SURFACE ("X*"), MAIS AUX POINTS
< CALCULES POUR LES FACETTES "EXTERNES"...
IF XOPT01-EXIST,XOPT1,,XOPT1
<
< DONNEES DU TRACE GRAPHIQUE :
<
BUFGR: EQU $
BUFGR1: DZS LBUF2D < ORIGINE D'UN VECTEUR,
BUFGR2: DZS LBUF2D < ET EXTREMITE.
DEMOG: BYTE NVPOUT;FAVOG < MISE EN GRAPHIQUE DE LA VISU.
DEMCG: BYTE NVPOUT;FAVCG < RETOUR EN ALPHA-NUMERIQUE DE LA VISU.
DEMWG: BYTE NVPOUT;FAVWG < ECRITURE GRAPHIQUE D'UN VECTEUR.
WORD BUFGR=FCTA*NOCMO
WORD LBUFGR*NOCMO
DEMWD0: BYTE NVPOUT;FAVWD < DEMANDE DE MISE EN MODE NORMAL...
BYTE KESC;'60;KEOT
DEMWD1: BYTE NVPOUT;FAVWD < DEMANDE DE MISE EN POINTILLES...
BYTE KESC;'61;KEOT
DEMWD2: BYTE NVPOUT;FAVWD < DEMANDE DE MISE EN TIRETES...
BYTE KESC;'63;KEOT
XOPT1: VAL ENDIF
<
< SUITE DES DONNEES DE CLEAR
< ET D'INDETERMINATION D'UN
< VECTEUR NORMAL (ZONE INAC-
< CESSIBLE DU 'LOCAL') :
<
NX3D: EQU $ < VECTEUR NORMAL INDETERMINE...
DO LBUF3D/DFLOT
FLOAT <K<K<K < REMISE A 0 FLOTTANTE...
<
< DEMANDE DE TEMPORISATION
< APRES EFFACEMENT :
<
TEMPO: BYTE NVPSER;FONDOR
WORD NILK < INUTILE...
WORD XXXMOY < 2 PETITES SECONDES...
IF XOPT01-EXIST,XOPT1,,XOPT1
<
< DEMANDE D'EFFACEMENT
< DE L'ECRAN DE LA VISU :
<
DEMERA: BYTE NVPOUT;FAVER < DEMANDE D'EFFACEMENT DE L'ECRAN DE LA
< VISU DE DIALOGUE.
XOPT1: VAL ENDIF
PAGE
<
<
< C O M M O N :
<
<
COMMON
COM: EQU $
<
< MOT DESTINE AU BLOC FLOTTANT :
<
COMFLO: WORD NILK < MOT "BIDON" DESTINE AU BLOC FLOTTANT
< POUR QU'IL Y FIT SES MERDES...
ATSFLO: WORD TSFLO < POUR TESTER DE TEMPS EN TEMPS 'COMFLO'...
<
< CONSTANTES FLOTTANTES DE BASE :
<
F0: FLOAT <K<K<K < REMISE A ZERO FLOTTANTE...
F1: FLOAT <W<K<K < L'UNITE EN FLOTTANT...
F3: FLOAT <W+W+W<K<K < NOMBRE DE SOMMETS D'UN TRIANGLE...
XXXLOC: VAL YYYFLO < 'YYYFLO'.
CALL #SIP UTILITAIRES#
APWORK: EQU APFWOR < POUR LA COMPATIBILITE AVEC LES OVERLAYS
< DE " +" (CF. 'SIO...').
<
< DONNEES DE TEST D'UNDER-
< FLOW FLOTTANT PREVISIBLE :
<
AFLEPS: WORD FLEPS < CE SOUS-PROGRAMME TESTE LES NOMBRES
< FLOTTANTS EN VALEUR ABSOLUE VOISINS
< DU PLUS PETIT RECONNE...
XXXLOC: VAL YYYGOT < 'YYYGOT'.
CALL #SIP UTILITAIRES#
<
< VARIABLES DE TRAVAIL :
<
FWORK1: FLOAT <NILK<NILK<NILK
FWORK2: FLOAT <NILK<NILK<NILK
<
<
< D E F I N I T I O N D E S F A C E T T E S :
<
<
IDEGEN: WORD NEXIST < INDICATEUR DE DEGENERESCENCE DES
< FACETTES :
< 'NEXIST' : FACETTE COURANTE DEGENEREE,
< 'EXIST' : FACETTE COURANTE=VRAI TRIAN-
< GLE (A,B,C).
NFACET: ASCI "X/" < NOM DES FACETTES "X/YYXX"...
IF $-NFACET*NOCMO-LRMAIL,,XEIF%,
IF ATTENTION : 'GCATAL' VA MERDER EN PASSANT DE LA RECU-
IF PERATION DES NOEUDS A CELLE DES FACETTES !!!
XEIF%: VAL ENDIF
NFACE1: ASCI "YYXX" < DESTINE A CONTENIR L'INDICE TOPOLOGIQUE.
NFACE2: BYTE "Z";KEOT
LNFACE:: VAL $-NFACET*NOCMO
< LONGUEUR DU NOM D'UNE FACETTE...
FAC: EQU $ < DEBUT DE LA FACETTE :
CF3D: EQU $ < DEBUT DE LA LISTE DES SOMMETS :
CA3D: EQU $ < SOMMET 'A' :
FXSA: FLOAT <NILK<NILK<NILK < XA,
FYSA: FLOAT <NILK<NILK<NILK < YA,
FZSA: FLOAT <NILK<NILK<NILK < ZA.
NA3D: EQU $ < VECTEUR NORMAL EN 'A' :
XNA: FLOAT <NILK<NILK<NILK < XN(A),
YNA: FLOAT <NILK<NILK<NILK < YN(A),
ZNA: FLOAT <NILK<NILK<NILK < ZN(A).
VARUA: FLOAT <NILK<NILK<NILK < UA,
VARVA: FLOAT <NILK<NILK<NILK < VA.
IDENTA: BYTE NILK;NILK < IDENTA.
CB3D: EQU $ < SOMMET 'B' :
FXSB: FLOAT <NILK<NILK<NILK < XB,
FYSB: FLOAT <NILK<NILK<NILK < YB,
FZSB: FLOAT <NILK<NILK<NILK < ZB.
NB3D: EQU $ < VECTEUR NORMAL EN 'B' :
XNB: FLOAT <NILK<NILK<NILK < XN(B),
YNB: FLOAT <NILK<NILK<NILK < YN(B),
ZNB: FLOAT <NILK<NILK<NILK < ZN(B).
VARUB: FLOAT <NILK<NILK<NILK < UB,
VARVB: FLOAT <NILK<NILK<NILK < VB.
IDENTB: BYTE NILK;NILK < IDENTB.
CC3D: EQU $ < SOMMET 'C' :
FXSC: FLOAT <NILK<NILK<NILK < XC,
FYSC: FLOAT <NILK<NILK<NILK < YC,
FZSC: FLOAT <NILK<NILK<NILK < ZC.
NC3D: EQU $ < VECTEUR NORMAL EN 'C' :
XNC: FLOAT <NILK<NILK<NILK < XN(C),
YNC: FLOAT <NILK<NILK<NILK < YN(C),
ZNC: FLOAT <NILK<NILK<NILK < ZN(C).
VARUC: FLOAT <NILK<NILK<NILK < UC,
VARVC: FLOAT <NILK<NILK<NILK < VC.
IDENTC: BYTE NILK;NILK < IDENTC.
PLAN3D: EQU $ < DEFINITION DU PLAN DE LA FACETTE :
PLANA: FLOAT <NILK<NILK<NILK < A=XN,
PLANB: FLOAT <NILK<NILK<NILK < B=YN,
PLANC: FLOAT <NILK<NILK<NILK < C=ZN,
PLAND: FLOAT <NILK<NILK<NILK < D.
CO3D: EQU $ < CENTRE 'O' DE LA BOULE CIRCONSCRITE :
FXSO: FLOAT <NILK<NILK<NILK < XO,
FYSO: FLOAT <NILK<NILK<NILK < YO,
FZSO: FLOAT <NILK<NILK<NILK < ZO,
FRAYO: FLOAT <NILK<NILK<NILK < CARRE DU RAYON DE LA BOULE (R**2).
XITYPE:: VAL EXIST < TYPE "FACETTE INTERNE",
XETYPE:: VAL NEXIST < TYPE "FACETTE EXTERNE".
IF XITYPE-XETYPE,XEIF%,,XEIF%
IF ATTENTION : ON NE POURRA PAS DISCRIMINER
IF LES FACETTES INTERNES DES FACETTES EXTERNES !!!
XEIF%: VAL ENDIF
FTYPE: WORD NILK < TYPE 'XITYPE'/'XETYPE' DE LA FACETTE.
XNOCTA:: VAL BIT>DIMESP < NOMBRE D'OCTANTS DANS L'ESPACE A 3
< DIMENSIONS...
FOCTA: WORD NILK < CE MOT CONTIENT UNE VALEUR NUMERIQUE
< DANS (K,XNOCTA*DFLOT-DFLOT), QUI PERMET
< DE CONNAITRE LA DIRECTION DU VECTEUR
< NORMAL (PLANA,PLANB,PLANC) DU PLAN, ET
< QUI EST UTILISE DANS LE PROCESSUS
< HEURISTIQUE DE CONVERGENCE.
LFAC:: VAL $-FAC < LONGUEUR EN MOTS DES DONNEES DECRIVANT
< UNE FACETTE...
LFACET:: VAL $-NFACET*NOCMO < LONGUEUR TOTALE NOM+VALEUR D'UNE FACETTE.
<
< GENERATION DES FACETTES :
<
FIDENT: BYTE NILK;NILK < IDENTIFICATEUR DE LA FACETTE COURANTE...
ASP1A: WORD SP1A < GENERATION DE 'A', ET DU NOM DE (A,B,C).
ASP1B: WORD SP1B < GENERATION DE 'B'.
ASP1C: WORD SP1C < GENERATION DE 'C' ET DE LA FACETTE A
< CONDITION QU'ELLE NE SOIT PAS DEGENEREE.
ASP1D: WORD SP1D < SOUS-PROGRAMME D'ENVOI D'UNE FACETTE
< AU 'SGN'...
<
< DONNEES DE CALCUL DE
< QUELQUES DISTANCES :
<
DAMAB: FLOAT <NILK<NILK<NILK < D(A,MAB),
DMABB: FLOAT <NILK<NILK<NILK < D(MAB,B),
DAMABB: FLOAT <NILK<NILK<NILK < D(A,MAB)+D(MAB,B).
DA: FLOAT <NILK<NILK<NILK < D(A,MABC),
DB: FLOAT <NILK<NILK<NILK < D(B,MABC),
DC: FLOAT <NILK<NILK<NILK < D(C,MABC),
DBDC: FLOAT <NILK<NILK<NILK < D(B,MABC)*D(C,MABC),
DCDA: FLOAT <NILK<NILK<NILK < D(C,MABC)*D(A,MABC),
DADB: FLOAT <NILK<NILK<NILK < D(A,MABC)*D(B,MABC),
DADBDC: FLOAT <NILK<NILK<NILK < D(B,MABC)*D(C,MABC)+
< D(C,MABC)*D(A,MABC)+
< D(A,MABC)+D(B,MABC).
<
< COORDONNEES CURVILIGNES 'U' ET 'V' :
<
VARUVW: EQU $ < LISTE ORDONNEE DES COORDONNEES (U,V) :
VARU: FLOAT <NILK<NILK<NILK < COORDONNEE CURVILIGNE 'U',
XVARU:: VAL $-VARUVW-DFLOT < INDEX COORDONNEE U.
VARV: FLOAT <NILK<NILK<NILK < COORDONNEE CURVILIGNE 'V'.
XVARV:: VAL $-VARUVW-DFLOT < INDEX COORDONNEE V.
XLASTX:: VAL $-VARUVW-DFLOT < DERNIER INDEX, POUR VALIDATION...
LVARUV:: VAL $-VARUVW < LONGUEUR DE LA ZONE (VARU,VARV)...
AVAR: WORD VARUVW,X < RELAI D'ACCES AUX COORDONNEES.
FRHO: FLOAT <NILK<NILK<NILK < ABSCISSE COURANTE D'UN POINT SUR LA
< DROITE 'D'...
<
< CONSTANTES DE DERIVATION :
<
XWOR%1: VAL W < PARTIE ENTIERE,
XWOR%2: VAL K < PARTIE DECIMALE,
XWOR%3: VAL 2 < VALEUR ABSOLUE DE L'EXPOSANT,
FHU: FLOAT <XWOR%1<XWOR%2<-XWOR%3
< PAS DE DERIVATION NUMERIQUE PAR RAPPORT
< A 'U',
FHV: FLOAT <XWOR%1<XWOR%2+I<-XWOR%3
< ET PAR RAPPORT A 'V' ; ON NOTERA QUE
< (FHU)#(FHV)...
F2H: FLOAT <NILK<NILK<NILK < EN FAIT, 'F2H' EST RECALCULEE A CHAQUE
< APPEL DE 'ADERIV'...
<
< SOUS PROGRAMMES DE CALCUL
< DE (X(U,V),Y(U,V),Z(U,V))
< ET DE DERIVATION NUMERIQUE :
<
ASPX: WORD SPX < CALCUL
ASPY: WORD SPY < DIRECT
ASPZ: WORD SPZ < DE LA FONCTION.
SPXYZ: EQU $ < LISTE ORDONNEE SOUS-PROGRAMMES (X,Y,Z) :
ASPXP: WORD SPXP < SOUS-PROGRAMME DE CALCUL DE X(U,V),
XSPX:: VAL $-SPXYZ-D < INDEX DE X(U,V).
ASPYP: WORD SPYP < SOUS-PROGRAMME DE CALCUL DE Y(U,V),
XSPY:: VAL $-SPXYZ-D < INDEX DE Y(U,V).
ASPZP: WORD SPZP < SOUS-PROGRAMME DE CALCUL DE Z(U,V),
XSPZ:: VAL $-SPXYZ-D < INDEX DE Z(U,V).
ASPXYZ: WORD SPXYZ,X < RELAI VERS LES SOUS-PROGRAMMES...
ADERIP: WORD DERIP < SOUS-PROGRAMME DE DERIVATION DU PREMIER
< ORDRE EN 'U' OU 'V'.
<
< CONSTANTES DE CALCUL DES SINUS ET COSINUS :
<
ASIN: WORD SIN < S/P DE CALCUL DU SINUS,
ACOS: WORD COS < ET DU COSINUS.
SCWOR1: FLOAT <NILK<NILK<NILK
SCWOR2: FLOAT <NILK<NILK<NILK
ISIGSC: WORD NILK < SIGNE...
DEUXPI: FLOAT 6.2831853 < 2 PI
PI3141: FLOAT 3.1415926 < PI
PISUR2: FLOAT 1.5707963 < PI/2
POLSC1: FLOAT -0.6459636 < COEFFICIENTS
POLSC2: FLOAT 0.7968969E-1 < DU
POLSC3: FLOAT -0.4673766E-2 < POLYNOME
POLSC4: FLOAT 0.1514842E-3 < SIN(X)/COS(X).
XXXIMA: VAL XXIMA2 < DEFINITION DES DONNEES DE L'IMAGE 512...
CALL #SIP IMAGE 512#
<
< CONSTANTES DE TRAVAIL ACCESSIBLES
< AU SOUS-PROGRAMME SPECIFIQUE PAR
< INDEXATION DOUBLE-MOT :
<
FK: FLOAT <W<K<K < PAR COMPATIBILITE AVEC " +"...
NCT:: VAL 48+5-4 < NOMBRE DE CONSTANTES DE TRAVAIL.
ACT: WORD CT,X < RELAI D'ACCES A LA LISTE DES CONSTANTES.
ASPCT: WORD SPCT < SOUS-PROGRAMME COMMUN D'ACCES.
<
< DEFINITION D'UNE MATRICE DE
< TRANSFORMATION 3*3 :
<
< (M(I,1),(MI,2),M(I,3)) EST UN VECTEUR LIGNE POUR PRODUIT SCALAIRE,
< M(I,4) EST UNE CONSTANTE DE TRANSLATION.
<
MT11:: VAL M11-MAT33
MT12:: VAL M12-MAT33
MT13:: VAL M13-MAT33
MT14:: VAL M14-MAT33
MT21:: VAL M21-MAT33
MT22:: VAL M22-MAT33
MT23:: VAL M23-MAT33
MT24:: VAL M24-MAT33
MT31:: VAL M31-MAT33
MT32:: VAL M32-MAT33
MT33:: VAL M33-MAT33
MT34:: VAL M34-MAT33
IF MT12-MT11-DFLOT,,XEIF%,
IF ATTENTION : 'MT11' ET 'MT12' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
IF MT13-MT12-DFLOT,,XEIF%,
IF ATTENTION : 'MT12' ET 'MT13' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
IF MT22-MT21-DFLOT,,XEIF%,
IF ATTENTION : 'MT21' ET 'MT22' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
IF MT23-MT22-DFLOT,,XEIF%,
IF ATTENTION : 'MT22' ET 'MT23' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
IF MT32-MT31-DFLOT,,XEIF%,
IF ATTENTION : 'MT31' ET 'MT32' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
IF MT33-MT32-DFLOT,,XEIF%,
IF ATTENTION : 'MT32' ET 'MT33' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
AMTRAN: WORD MTRAN,X < RELAI D'ACCES A LA MATRICE...
<
<
< Z O N E D E S A U V E G A R D E D E
< L A F A C E T T E " I N T E R N E "
< C O U R A N T E :
<
<
<
< RELAIS VERS LES INFOR-
< MATIONS UTILES DE LA
< FACETTE SAUVEGARDEE ; ON
< ACCEDE CES INFORMATIONS
< PAR UN RELAI AFIN DE NE
< PAS METTRE LA ZONE DE
< SAUVEGARDE DANS LE 'COM-
< MON' ADRESSABLE, ET AINSI
< PERDRE DES MOTS INUTI-
< LISES...
<
AFXSAS: WORD FXSAS < RELAI VERS 'XAS',
AFYSAS: WORD FYSAS < RELAI VERS 'YAS',
AFZSAS: WORD FZSAS < RELAI VERS 'ZAS',
AVRUAS: WORD VARUAS < RELAI VERS 'UAS',
AVRVAS: WORD VARVAS < RELAI VERS 'VAS',
AIDNAS: WORD IDENAS < RELAI VERS 'IDENAS'.
AFXSBS: WORD FXSBS < RELAI VERS 'XBS',
AFYSBS: WORD FYSBS < RELAI VERS 'YBS',
AFZSBS: WORD FZSBS < RELAI VERS 'ZBS',
AVRUBS: WORD VARUBS < RELAI VERS 'UBS',
AVRVBS: WORD VARVBS < RELAI VERS 'VBS',
AIDNBS: WORD IDENBS < RELAI VERS 'IDENBS'.
AFXSCS: WORD FXSCS < RELAI VERS 'XCS',
AFYSCS: WORD FYSCS < RELAI VERS 'YCS',
AFZSCS: WORD FZSCS < RELAI VERS 'ZCS',
AVRUCS: WORD VARUCS < RELAI VERS 'UCS',
AVRVCS: WORD VARVCS < RELAI VERS 'VCS',
AIDNCS: WORD IDENCS < RELAI VERS 'IDENCS'.
<
< ZONE DE SAUVEGARDE :
<
FACS: EQU $ < DEBUT DE LA FACETTE :
DZS LFAC < ET RESERVATION DE L'ESPACE DE SAVE...
CF3DS: EQU CF3D-FAC+FACS < DEBUT DE LA LISTE DES SOMMETS :
CA3DS: EQU CA3D-FAC+FACS < SOMMET 'A' :
FXSAS: EQU FXSA-FAC+FACS < XA,
FYSAS: EQU FYSA-FAC+FACS < YA,
FZSAS: EQU FZSA-FAC+FACS < ZA.
NA3DS: EQU NA3D-FAC+FACS < VECTEUR NORMAL EN 'A' :
XNAS: EQU XNA-FAC+FACS < XN(A),
YNAS: EQU YNA-FAC+FACS < YN(A),
ZNAS: EQU ZNA-FAC+FACS < ZN(A).
VARUAS: EQU VARUA-FAC+FACS < UA,
VARVAS: EQU VARVA-FAC+FACS < VA.
IDENAS: EQU IDENTA-FAC+FACS < IDENTA.
CB3DS: EQU CB3D-FAC+FACS < SOMMET 'B' :
FXSBS: EQU FXSB-FAC+FACS < XB,
FYSBS: EQU FYSB-FAC+FACS < YB,
FZSBS: EQU FZSB-FAC+FACS < ZB.
NB3DS: EQU NB3D-FAC+FACS < VECTEUR NORMAL EN 'B' :
XNBS: EQU XNB-FAC+FACS < XN(B),
YNBS: EQU YNB-FAC+FACS < YN(B),
ZNBS: EQU ZNB-FAC+FACS < ZN(B).
VARUBS: EQU VARUB-FAC+FACS < UB,
VARVBS: EQU VARVB-FAC+FACS < VB.
IDENBS: EQU IDENTB-FAC+FACS < IDENTB.
CC3DS: EQU CC3D-FAC+FACS < SOMMET 'C' :
FXSCS: EQU FXSC-FAC+FACS < XC,
FYSCS: EQU FYSC-FAC+FACS < YC,
FZSCS: EQU FZSC-FAC+FACS < ZC.
NC3DS: EQU NC3D-FAC+FACS < VECTEUR NORMAL EN 'C' :
XNCS: EQU XNC-FAC+FACS < XN(C),
YNCS: EQU YNC-FAC+FACS < YN(C),
ZNCS: EQU ZNC-FAC+FACS < ZN(C).
VARUCS: EQU VARUC-FAC+FACS < UC,
VARVCS: EQU VARVC-FAC+FACS < VC.
IDENCS: EQU IDENTC-FAC+FACS < IDENTC.
PLAN3S: EQU PLAN3D-FAC+FACS < DEFINITION DU PLAN :
PLANAS: EQU PLANA-FAC+FACS < A=XN,
PLANBS: EQU PLANB-FAC+FACS < B=YN,
PLANCS: EQU PLANC-FAC+FACS < C=ZN,
PLANDS: EQU PLAND-FAC+FACS < D.
CO3DS: EQU CO3D-FAC+FACS < CENTRE 'O' DE LA BOULE CIRCONSCRITE :
FXSOS: EQU FXSO-FAC+FACS < XO,
FYSOS: EQU FYSO-FAC+FACS < YO,
FZSOS: EQU FZSO-FAC+FACS < ZO,
FRAYOS: EQU FRAYO-FAC+FACS < CARRE DU RAYON DE LA BOULE (R**2).
FTYPES: EQU FTYPE-FAC+FACS < TYPE "INTERNE"/"EXTERNE" DE LA FACETTE.
FOCTAS: EQU FOCTA-FAC+FACS < OCTANT DU VECTEUR NORMAL.
LFACES:: VAL LFAC < LONGUEUR EN MOTS DE LA ZONE DE SAUVE-
< GARDE DE LA FACETTE "INTERNE"...
<
< DEMANDES DE GENERATION
< DES FACETTES (NON ADRES-
< SABLES PAR LA BASE 'C') :
<
DEMDFA: BYTE COSBT?XASSIM=FMASK(K?NVPDLN=FCINST;FAVW
< DESTRUCTION D'UNE FACETTE.
WORD NFACET=FCTA*NOCMO
WORD LNFACE
WORD FOLLOW
DEMSFA: BYTE COSBT?XASSIM=FMASK(K?NVPSTN=FCINST;FAVW
< GENERATION D'UNE FACETTE.
WORD NFACET=FCTA*NOCMO
WORD LFACET
WORD FOLLOW
PAGE
<
<
< L I S T E D E S C O N S T A N T E S
< I N I T I A L I S E E S A L ' U N I T E :
<
<
CT: EQU $ < LISTE DES CONSTANTES :
DO NCT
FLOAT <W<K<K
PAGE
<
<
< M A T R I C E D E T R A N S F O R M A T I O N
< I N I T I A L I S E E A L ' U N I T E :
<
<
MTRAN: EQU $
FLOAT <W<K<K < MT11,
FLOAT <K<K<K < MT12,
FLOAT <K<K<K < MT13,
FLOAT <K<K<K < MT14,
FLOAT <K<K<K < MT21,
FLOAT <W<K<K < MT22,
FLOAT <K<K<K < MT23,
FLOAT <K<K<K < MT24,
FLOAT <K<K<K < MT31,
FLOAT <K<K<K < MT32,
FLOAT <W<K<K < MT33,
FLOAT <K<K<K < MT34,
IF $-MTRAN-LMAT33,,XEIF%,
IF ATTENTION : INCOHERENCE DANS LA LONGUEUR
IF DES MATRICES 3*3 !!!
XEIF%: VAL ENDIF
PAGE
<
<
< T A B L E D E D E F I N I T I O N D E L ' E S P A C E
< D E S C O O R D O N N E S C U R V I L I G N E S ( U , V ) :
<
<
< FONCTION :
< L'ESPACE DES COORDONNEES CURVI-
< LIGNES EST EN GENERAL UN TORE QUE
< L'ON DEFINIT ICI, EN DONNANT POUR
< CHACUNE DES COORDONNEES 'U' ET 'V',
< LE SEGMENT DE DEFINITION (MIN,MAX),
< LE MILIEUR 'MIL' DE SON SEGMENT
< DE DEFINITION, LE MAXIMUM 'MAX'
< DU SEGMENT DE DEFINITION, ET LA
< PERIODE 'PER', AINSI QU'UN
< 'EPS' FONCTION DE LA "TAILLE"
< DE LA FACETTE COURANTE, ET
< DESTINE AUX TESTS DE CONVER-
< GENCE...
< ENFIN, ON TROUVE DES DONNEES
< PERMETTANT UNE AMELIORATION
< HEURISTIQUE DANS LE CHOIX DES
< SOLUTIONS INITIALES (U0,V0) :
< D'UNE PART (XHEURU,XHEURV) QUI
< SONT DES CONSTANTES MULTIPLICA-
< TIVES DE L'ERREUR ENTRE LA SOLU-
< TION REELLE (U,V) ET LA SOLUTION
< INTIALE (U0,V0), ET D'AUTRE PART
< CES ERREURS COURANTES (1 PAR OC-
< TANT)...
<
<
LTORE: EQU $
XMINU:: VAL $-LTORE < MIN(U),
FLOAT <NILK<NILK<NILK
XMILU:: VAL $-LTORE < MIL(U),
FLOAT <NILK<NILK<NILK
XMAXU:: VAL $-LTORE < MAX(U),
FLOAT <NILK<NILK<NILK
XPERU:: VAL $-LTORE < PERIOD(U),
FLOAT <NILK<NILK<NILK
XEPSU:: VAL $-LTORE < EPS(U),
FLOAT <NILK<NILK<NILK
XHEURU:: VAL $-LTORE < MULTIPLICATEUR DE (U-U0),
FLOAT <K<W+W<K
XEPSU0:: VAL $-LTORE < EPS(U0) PAR OCTANT.
DO XNOCTA
FLOAT <NILK<NILK<NILK
XMINV:: VAL $-LTORE < MIN(V),
FLOAT <NILK<NILK<NILK
XMILV:: VAL $-LTORE < MIL(V),
FLOAT <NILK<NILK<NILK
XMAXV:: VAL $-LTORE < MAX(V),
FLOAT <NILK<NILK<NILK
XPERV:: VAL $-LTORE < PERIOD(V),
FLOAT <NILK<NILK<NILK
XEPSV:: VAL $-LTORE < EPS(V),
FLOAT <NILK<NILK<NILK
XHEURV:: VAL $-LTORE < MULTIPLICATEUR DE (V-V0),
FLOAT <K<W+W<K
XEPSV0:: VAL $-LTORE < EPS(V0) PAR OCTANT.
DO XNOCTA
FLOAT <NILK<NILK<NILK
PAGE
<
<
< P I L E D E T R A V A I L :
<
<
STACK: EQU $
DZS 64
PROG
XXXPRO: VAL YYYCCI < 'YYYCCI'.
CALL #SIP UTILITAIRES#
XXXIMA: VAL XXIMA3 < DEFINITION DES PROGRAMMES IMAGE 512...
CALL #SIP IMAGE 512#
PAGE
<
<
< T E S T P E R I O D I Q U E D E ' C O M F L O ' :
<
<
< FONCTION :
< CE SOUS-PROGRAMME EST
< APPELE DERRIERE CHAQUE
< 'FDV' EXPLICITE AINSI
< QU'APRES LES APPELS DE
< 'RAC' ET 'CRAMR'...
<
<
TSFLO: EQU $
PSR A
LA COMFLO < TEST DE 'COMFLO' PAR UN 'LA' AFIN DE NE
< PAS MODIFIER LES CODES (CARY & CO)...
JAE TSFLO1 < OK...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
< ON A :
< (A)=INDICATEURS FLOTTANTS...
< BIT 0 : UNDERFLOW,
< BIT 1 : OVERFLOW,
< BIT 2 : DIVISION PAR ZERO,
< BIT 3 : 'FIX' IMPOSSIBLE.
STZ COMFLO < PUIS RAZ, CAR CES INDICATEURS SONT
< REMANENTS...
TSFLO1: EQU $
PLR A
RSR
PAGE
<
<
< M O V E D E ' L B U F 3 D ' M O T S :
<
<
< ARGUMENTS :
< (A)=ADRESSE DE L'EMETTEUR,
< (B)=ADRESSE DU RECEPTEUR.
<
<
< RESULTAT :
< (X)=K...
<
<
MOVE3: EQU $
LXI LBUF3D < (X)=NOMBRE DE MOTS A DEPLACER,
MOVE < ET DEPLACEMENT DE (A) VERS (B)...
RSR < THAT'S ALL FOLK...
XXXPRO: VAL YYYHIN < 'YYYHIN'.
CALL #SIP UTILITAIRES#
XXXPRO: VAL YYYHEX < 'YYYHEX'.
CALL #SIP UTILITAIRES#
XXXPRO: VAL YYYGOT < 'YYYGOT'.
CALL #SIP UTILITAIRES#
PAGE
<
<
< A P P E L D U ' S G N ' :
<
<
< FONCTION :
< CE SOUS-PROGRAMME PERMET
< D'APPELER LE 'SGN' POUR
< CONNAITRE SOIT LE SUIVANT
< SERIE, SOIT LE SUIVANT PA-
< RALLELE DE LA CHAINE DE CA-
< RACTERES COURANTE.
<
<
< ARGUMENT :
< (A)='NVPLON', 'NVPNXS' OU 'NVPNXP',
< (X)=INDEX DU CARACTERE COURANT,
< (Y)=LONGUEUR EN OCTETS DE LA VALEUR SEULE.
<
<
< RESULTAT :
< (A)=CODES D'ERREUR EVENTUELS.
<
<
GOSGN: EQU $
<
< INITIALISATIONS :
<
PSR X < SAUVEGARDE DE L'INDEX COURANT...
STBY DEMSGN+NVPFON < MISE EN PLACE DU 'NVP' CHOISI...
<
< VALIDATIONS :
<
CPZR X
JGE GOSGN1 < OK...
QUIT XXQUIT < E R R E U R P R O G R A M M E...
GOSGN1: EQU $
<
< ACCES AU 'SGN' :
<
CPI COSBT?XASSIM=FMASK(K?NVPLON=FCINST
JNE GOSGN2 < CE N'EST PAS 'LON'...
LR Y,A < CAS DE 'LON', ON MET ON PLACE LA LONGUEUR
< NOM+VALEUR...
CPI LVMAIL < EST-CE UN NOEUD ???
LAI LMAIL
JE GOSGN3 < OUI, ON PREND 'LMAIL'...
LR Y,A < NON,
CPI LFAC*NOCMO < EST-CE UNE FACETTE ???
LAI LFACET
JE GOSGN3 < OUI, ON PREND 'LFACET'...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
JMP GOSGN3
GOSGN2: EQU $ < CAS DE 'NXP' ET 'NXS' :
LR X,A < ON CALCULE LA LONGUEUR DE LA CHAINE
ADRI Z,A < COURANTE...
GOSGN3: EQU $
STA DEMSGN+COESC < MISE EN PLACE DE LA LONGUEUR
< COURANTE.
LAD DEMSGN
SVC < APPEL DU 'SGN'.
<
< ET RETOUR :
<
LR X,A < A=CONDITIONS DE RETOUR.
PLR X < RESTAURE X COURANT.
RSR
PAGE
<
<
< P R O J E C T I O N 3 D --> 2 D :
<
<
< ARGUMENT :
< (FXS,FYS,FZS)=POINT 3D.
<
<
< RESULTAT :
< (XS,YS)=POINT 2D PROJETE SUIVANT 'IPROJ'.
<
<
PROJ: EQU $
<
< INITIALISATIONS :
<
PSR A,B < SAUVEGARDES...
#/FLD# FZS
<
< PROJECTION PERSPECTIVE SUR 'OX' :
<
FDV PZ
BSR ATSFLO
FSB F1
BSR AFNEG
BSR ASFWOR < 1-(FZS/PZ)
BSR AFCAZ
JNE EOK3 < OK, 1-(FZS/PZ)#0...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
EOK3: EQU $
#/FLD# FXS
FDV FWORK < FXS/(1-(FZS/PZ))
BSR ATSFLO
<
< CALCUL DE 'XS' :
<
FMP FACT < MISE A L'ECHELLE 2D...
BSR AROND
AD TRX < TRANSLATION 2D...
STA XS
<
< PROJECTION PERSPECTIVE SUR 'OY' :
<
#/FLD# FYS
FDV FWORK < FYS/(1-(FZS/PZ))
BSR ATSFLO
<
< CALCUL DE 'YS' :
<
FMP FACT < MISE A L'ECHELLE 2D...
BSR AROND
AD TRY < TRANSLATION 2D...
STA YS
<
< SORTIE :
<
PLR A,B < RESTAURATIONS...
RSR
XXXPRO: VAL YYYFLO < 'YYYFLO'.
CALL #SIP UTILITAIRES#
PAGE
<
<
< R E C U P E R A T I O N D ' U N P O I N T 3 D :
<
<
< FONCTION :
< CE SOUS-PROGRAMME RECUPERE
< DANS 'BUF' UN POINT TRI-DIMENSIONNEL
< ET ENSUITE LE PROJETTE.
<
<
< ARGUMENT :
< (X)='XBUF' DU POINT A RECUPERER.
<
<
SP1: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
<
< RECUPERATION DU POINT COURANT :
<
LAD CS3D
LR A,B
LR X,A
LXI LBUF4D
RCDA
IF XOPT01-EXIST,XOPT1,,XOPT1
<
< PROJECTION 3D --> 2D :
<
BSR APROJ
XOPT1: VAL ENDIF
<
< ET RETOUR :
<
PLR A,B,X
RSR
PAGE
IF XOPT01-EXIST,XOPT1,,XOPT1
<
<
< M I S E E N P L A C E D U P R E M I E R
< S O M M E T D ' U N T R I A N G L E
< E T P L U S G E N E R A L E M E N T
< D E L ' O R I G I N E D ' U N V E C T E U R :
<
<
< FONCTION :
< CE SOUS-PROGRAMME INSERE
< DANS LA LISTE D'EDITION
< GRAPHIQUE 'BUFGR' LE PREMIER
< SOMMET D'UN TRIANGLE.
<
<
SP4: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
<
< TRANSFERT 2D --> 'BUFGR' :
<
LRM A,B,X
WORD CS2D
WORD BUFGR1
WORD LBUF2D
MOVE < MISE EN PLACE DE L'ORIGINE.
<
< ET RETOUR :
<
PLR A,B,X
RSR
XOPT1: VAL ENDIF
PAGE
IF XOPT01-EXIST,XOPT1,,XOPT1
<
<
< I N S E R T I O N D E L ' E X T R E M I T E
< D ' U N V E C T E U R :
<
<
< FONCTION :
< CE SOUS-PROGRAMME INSERE
< DANS LA LISTE D'EDITION
< GRAPHIQUE 'BUFGR' L'EXTRE-
< MITE D'UN VECTEUR.
<
<
SP7: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
<
< TRANSFERT 2D --> 'BUFGR' :
<
LRM A,B,X
WORD CS2D
WORD BUFGR2
WORD LBUF2D
MOVE < LE POINT 2D COURANT DEVIENT L'EXTREMITE
< DU COTE COURANT DU TRIANGLE COURANT...
<
< ET RETOUR :
<
PLR A,B,X
RSR
XOPT1: VAL ENDIF
PAGE
<
<
< T R A C E D ' U N C O T E D ' U N T R I A N G L E
< E T C H A I N A G E :
<
<
< FONCTION :
< CE MODULE RECUPERE L'EXTREMITE
< COURANTE DU COTE COURANT DU
< TRIANGLE COURANT, PUIS L'INSERE
< DANS LA LISTE GRAPHIQUE 'BUFGR',
< EDITE CE COTE ; PUIS, ENFIN,
< CHAINE, C'EST-A-DIRE QU'IL
< FAIT DE L'EXTREMITE COURANTE
< LA FUTURE ORIGINE...
<
<
< F A C E T T E S " I N T E R N E S " :
<
<
SP2: EQU $ < ENTRY 1 :
<
< INITIALISATIONS :
<
BSR ASP1 < RECUPERATION DE L'EXTREMITE...
IF XOPT01-EXIST,XOPT1,,XOPT1
PSR A,B,X
<
< MISE EN PLACE DE L'EXTREMITE :
<
BSR ASP7 < LE POINT 2D COURANT DEVIENT L'EXTREMITE
< DU COTE COURANT DU TRIANGLE COURANT...
<
< TRACE DU COTE COURANT :
<
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IWGFI < TRACE-T'ON LES FACETTES "INTERNES" ???
< (POUR LES FACETTES "EXTERNES" VOIR LE
< SOUS-PROGRAMME 'SP1E'...)
JE E200 < NON...
E240: EQU $ < CAS DES FACETTES "EXTERNES"...
LAD DEMWG
SVC < TRACE DU VECTEUR CONTENU DANS 'BUFGR'.
E200: EQU $
<
< CHAINAGE : EXTREMITE --> ORIGINE :
<
LRM A,B,X
WORD BUFGR2
WORD BUFGR1
WORD LBUF2D
MOVE < ET CHAINAGE...
<
< ET RETOUR :
<
PLR A,B,X
XOPT1: VAL ENDIF
RSR
IF XOPT01-EXIST,XOPT1,,XOPT1
<
<
< F A C E T T E S " E X T E R N E S " :
<
<
SP2B: EQU $ < ENTRY 2 :
<
< INITIALISATIONS :
<
PSR A,B,X
<
< MISE EN PLACE DE L'EXTREMITE :
<
BSR ASP7 < LE POINT 2D COURANT DEVIENT L'EXTREMITE
< DU COTE COURANT DU TRIANGLE COURANT...
JMP E240 < VERS LE TRACE...
XOPT1: VAL ENDIF
PAGE
<
<
< I N C R E M E N T A T I O N M O D U L O D E ' J ' :
<
<
< ARGUMENTS :
< (W)='J' COURANT,
< (X)=INCREMENT DE 'J',
< (B)='J' MAX SUR LA LIGNE COURANTE 'I',
< XBUFI0=XBUF(I,0).
<
<
< RESULTAT :
< (W)=NOUVELLE VALEUR DE 'J',
< (X)=XBUF(I,J), OU 'J' REPRESENTE LE NOUVEAU 'J'...
<
<
SP3: EQU $
<
< INITIALISATIONS :
<
PSR A,B
<
< INCREMENTATION MODULO DE 'J' :
<
ADR X,W < PASSAGE A J+1 OU J+2,
CPR B,W < GESTION MODULO, CAR ON EST SUR UN J-TORE,
JLE SP31 < (W) <= (B) : DONC ON N'EST PAS REVENU
< EN DEBUT DE LIGNE...
SBR B,W < ET CALCUL DE 'W'
ADRI -Z,W < MODULO (B)+Z...
SP31: EQU $
<
< CALCUL DE XBUF(I,J) :
<
LR W,A < J+2,
MP ABUF4D
LX XBUFI0 < (X)=XBUF(I,0), OU XBUF(I+2,0)...
ADR B,X < (X)=XBUF(I,J+2), OU XBUF(I+2,J+2)...
<
< ET RETOUR :
<
PLR A,B
RSR
PAGE
<
<
< I N C R E M E N T A T I O N M O D U L O D E ' I ' :
<
<
< ARGUMENT :
< (X)='I' COURANT.
<
<
< RESULTAT :
< (X)='I' INCREMENTE MODULO (NUMI)+Z.
<
<
SP5: EQU $
<
< INITIALISATIONS :
<
PSR A
<
< INCREMENTATION DE 'I' :
<
PASI:: VAL W+W < PAS DE 'I'.
ADRI PASI,X < INCREMENTATION DE 'I',
LR X,A
CP NUMI < ET CALCUL MODULO (NUMI)+Z :
JLE SP51 < (X) <= (NUMI)...
I0:: VAL K < NUMERO DE LA PREMIERE LIGNE...
LXI I0 < (X) > (NUMI)...
SP51: EQU $
<
< ET RETOUR :
<
PLR A
RSR
PAGE
<
<
< G E N E R A T I O N D U S O M M E T ' A ' :
<
<
< FONCTION :
< CE MODULE, GENERE LE PREMIER
< SOMMET ('A') D'UNE FACETTE ; PUIS
< IL PREPARE LE NOM DE LA FACETTE
< A PARTIR DE L'INDICE TOPOLOGIQUE
< 'IDENT' DE 'A'.
<
<
SP1A: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
<
< GENERATION DE 'A' :
<
LRM A,B,X
WORD CS3D < (A)=POINT 3D COURANT,
WORD CA3D < (B)=SOMMET 'A',
WORD LBUF4D < (X)=NOMBRE DE MOTS A DEPLACER,
MOVE < GENERATION DE 'A'...
<
< PREPARATION DU NOM DE LA FACETTE :
<
PASJ:: VAL W+W < PAS DE 'J'.
XWOR%1: VAL NBITMO-B
XWOR%2: VAL CORBT?XWOR%1=FMASK(K?PASJ=FCINST
IF PASJ-XWOR%2,,XEIF%,
IF ATTENTION : 'PASJ' EST TEL QUE LES 'IDENT'
IF SUCCESSIFS NE PEUVENT TOUS ETRE PAIRS !!!
XEIF%: VAL ENDIF
LBY IDENT < (A)=INDICE TOPOLOGIQUE DE 'A',
< (DONT ON NE GARDE QUE 'I')
SLRS PASJ=K < ET ON PROCEDE A UNE REDUCTION...
JNC SP1A1 < OK...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
SP1A1: EQU $
STBY FIDENT < QUI DEVIENT CELUI DE LA FACETTE...
< LA PARTIE 'J' SERA INCREMENTEE APRES
< LA GENERATION DE LA FACETTE COURANTE...
LAD NFACE1 < (A)=ADRESSE DU BUFFER DE GENERATION,
LB FIDENT < (B)=IDENTIFICATEUR DE LA FACETTE,
LXI K < (X)=INDEX DU PREMIER CARACTERE,
BSR AHEXEX < ET GENERATION DU NOM "X/YYXX"...
<
< ET RETOUR :
<
PLR A,B,X
RSR
PAGE
<
<
< G E N E R A T I O N D U S O M M E T ' B ' :
<
<
< FONCTION :
< CE MODULE, GENERE LE SECOND
< SOMMET ('B') D'UNE FACETTE.
<
<
SP1B: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
<
< GENERATION DE 'B' :
<
LRM A,B,X
WORD CS3D < (A)=POINT 3D COURANT,
WORD CB3D < (B)=SOMMET 'B',
WORD LBUF4D < (X)=NOMBRE DE MOTS A DEPLACER,
MOVE < GENERATION DE 'B'...
<
< ET RETOUR :
<
PLR A,B,X
RSR
PAGE
<
<
< G E N E R A T I O N D U S O M M E T ' C '
< E T D E S F A C E T T E S A S S O C I E E S :
<
<
< FONCTION :
< CE MODULE GENERE LE TROISIEME
< SOMMET ('C') D'UNE FACETTE ; EN-
< SUITE, SI LE TRIANGLE N'EST PAS
< DEGENERE (REDUIT A UN SEGMENT, OU
< A UN POINT), IL GENERE LES FACETTES
< AUX 3 POINTS 'A', 'B' ET 'C'.
< EN UTILISANT UNE TERMINOLOGIE
< PROPRE AUX SURFACES CONVEXES, IL
< GENERE 2 TYPES DE FACETTES :
<
< 1 - UNE FACETTE "INTERNE" (OU "INS-
< SCRITE") : IL S'AGIT EN FAIT DU
< TRIANGLE (A,B,C) ; ELLE EST DITE
< "INTERNE", CAR EN EFFET, SI LE
< POLYHEDRE EST CONVEXE, (A,B,C) SE
< TROUVE A L'INTERIEUR.
<
< 2 - SIX FACETTES "EXTERNES" (OU
< "CIRCONSCRITES") : EN EFFET LES
< FACETTES "INTERNES", SI LE POLY-
< HEDRE EST UNE APPROXIMATION D'UNE
< SURFACE, NE SUFFISENT PAS A CALCULER
< LES INTERSECTIONS DE CELLES-CI AVEC
< UNE DROITE QUELCONQUE, PUISQUE DES
< POINTS DE L'ESPACE 3D APPARTIENNENT
< A L'INTERIEUR DE LA SURFACE, TOUT EN
< ETANT EXTERIEURS AU POLYHEDRE... ON
< DOIT DONC RAJOUTER UNE COUVERTURE
< "EXTERNE" A LA SURFACE DE LA FACON
< SUIVANTE :
< * ON CONSIDERE LES 3 PLANS TANGENTS
< A LA SURFACE EN 'A', 'B' ET 'C', ET
< DONC DE VECTEURS NORMAUX RESPECTIFS
< 'NA', 'NB' ET 'NC' : SOIT PTA, PTB
< ET PTC CES 3 PLANS TANGENTS.
< * SOIENT LES 3 DROITES D'INTERSECTION
< DES PLANS TANGENTS 2 A 2 :
< DAB=PTA.INTER.PTB,
< DBC=PTB.INTER.PTC,
< DCA=PTC.INTER.PTA.
< * SOIENT ENSUITE LES 3 PLANS SUIVANTS :
< P1AB : AB.E.P1AB, P1AB//DAB,
< P1BC : BC.E.P1BC, P1BC//DBC,
< P1CA : CA.E.P1CA, P1CA//DCA.
< (OU .E. EXPRIME L'APPARTENANCE)
< * SOIENT ENFIN LES 3 PLANS :
< P2AB : AB.E.P2AB, P2AB.T.P1AB,
< P2BC : BC.E.P2BC, P2BC.T.P1BC,
< P2CA : CA.E.P2CA, P2CA.T.P1CA.
< (OU .T. EXPRIME L'ORTHOGONALITE)
< * ON CALCULE ALORS LES 4 POINTS SUIVANTS :
< MAB=PTA.INTER.PTB.INTER.P2AB,
< MBC=PTB.INTER.PTC.INTER.P2BC,
< MCA=PTC.INTER.PTA.INTER.P2CA,
< MABC=PTA.INTER.PTB.INTER.PTC.
< * LES 6 FACETTES "EXTERNES" SONT ALORS :
< (A,MAB,MABC),
< (MAB,B,MABC),
< (B,MBC,MABC),
< (MBC,C,MABC),
< (C,MCA,MABC),
< (MCA,A,MABC).
< ON NOTERA QUE CES 6 FACETTES
< "EXTERNES" SONT TOUTES TANGENTES
< A LA SURFACE, ET DONC ORTHOGONALES
< AUX VECTEURS 'NA', 'NB' ET 'NC'.
<
<
< RESULTAT :
< IDEGEN='NEXIST' SI LA FACETTE EST DEGENEREE,
< ='EXIST' SI ELLE EST UN VRAI TRIANGLE.
<
<
SP1C: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE 'STZ' QUI SUIT EST IDIOT !!!
XEIF%: VAL ENDIF
STZ IDEGEN < A PRIORI, LA FACETTE SERA DEGENEREE...
<
< GENERATION DE 'C' :
<
LRM A,B,X
WORD CS3D < (A)=POINT 3D COURANT,
WORD CC3D < (B)=SOMMET 'C',
WORD LBUF4D < (X)=NOMBRE DE MOTS A DEPLACER.
MOVE < ET GENERATION DE 'C'...
<
< TEST DE DEGENERESCENCE DE (A,B,C) :
<
#/FLD# FXSA
FCAM FXSB
JNE SP1C1 < A#B...
#/FLD# FYSA
FCAM FYSB
JNE SP1C1 < A#B...
#/FLD# FZSA
FCAM FZSB
JE SP1C9 < A=B : LE TRIANGLE EST DEGENERE, ON
< L'IGNORE...
SP1C1: EQU $
#/FLD# FXSA
FCAM FXSC
JNE SP1C2 < A#C...
#/FLD# FYSA
FCAM FYSC
JNE SP1C2 < A#C...
#/FLD# FZSA
FCAM FZSC
JE SP1C9 < A=C : LE TRIANGLE EST DEGENERE, ON
< L'IGNORE...
SP1C2: EQU $
#/FLD# FXSB
FCAM FXSC
JNE SP1C3 < B#C...
#/FLD# FYSB
FCAM FYSC
JNE SP1C3 < B#C...
#/FLD# FZSB
FCAM FZSC
JNE SP1C3 < B#C...
<
< CAS DES TRIANGLES DEGENERES :
<
SP1C9: EQU $ < CAS DES TRIANGLES DEGENERES :
BSR AGOTO
WORD SP1C8 < ON LES IGNORE...
<
<
< C A L C U L D E L A F A C E T T E " I N T E R N E " :
<
<
<
< EQUATION D'UN PLAN PASSANT
< PAR 3 POINTS (A,B,C) :
<
< I X-XA Y-YA Z-ZA I
< I XB-XA YB-YA ZB-ZA I = 0
< I XC-XA YC-YA ZC-ZA I
<
< LE VECTEUR NORMAL A POUR
< COMPOSANTE LES COFACTEURS DE
< (X-XA), (Y-YA), (Z-ZA)
< RESPECTIVEMENT...
<
SP1C3: EQU $
<
< CAS D'UN TRIANGLE (A,B,C) NON
< DEGENERE, CALCUL DE L'EQUATION
< DE SON VECTEUR NORMAL :
<
#/FLD# FYSC < YC,
FSB FYSA < YC-YA,
BSR ASFWOR < ET SAVE...
#/FLD# FZSB < ZB,
FSB FZSA < ZB-ZA,
FMP FWORK < (YC-YA)*(ZB-ZA),
#/FST# PLANA < ET SAVE...
#/FLD# FYSB < YB,
FSB FYSA < YB-YA,
BSR ASFWOR < ET SAVE...
#/FLD# FZSC < ZC,
FSB FZSA < ZC-ZA,
FMP FWORK < (YB-YA)*(ZC-ZA),
FSB PLANA < (YB-YA)*(ZC-ZA)-(YC-YA)*(ZB-ZA).
#/FST# PLANA < SOIT 'XN', PREMIERE COMPOSANTE DU
< VECTEUR NORMAL...
#/FLD# FXSC < XC,
FSB FXSA < XC-XA,
BSR ASFWOR < ET SAVE...
#/FLD# FZSB < ZB,
FSB FZSA < ZB-ZA,
FMP FWORK < (XC-XA)*(ZB-ZA),
#/FST# PLANB < ET SAVE...
#/FLD# FXSB < XB,
FSB FXSA < XB-XA,
BSR ASFWOR < ET SAVE...
#/FLD# FZSC < ZC,
FSB FZSA < ZC-ZA,
FMP FWORK < (XB-XA)*(ZC-ZA),
FSB PLANB < (XB-XA)*(ZC-ZA)-(XC-XA)*(ZB-ZA),
BSR AFNEG < -((XB-XA)*(ZC-ZA)-(XC-XA)*(ZB-ZA)).
< (A NOTER QUE CETTE PROGRAMMATION N'EST
< PAS OPTIMISEE ('FNEG'), MAIS QU'AINSI
< LES FORMULES SONT RESPECTEES...)
#/FST# PLANB < SOIT 'YN', DEUXIEME COMPOSANTE
< DU VECTEUR NORMAL...
#/FLD# FXSC < XC,
FSB FXSA < XC-XA,
BSR ASFWOR < ET SAVE...
#/FLD# FYSB < YB,
FSB FYSA < YB-YA,
FMP FWORK < (XC-XA)*(YB-YA),
#/FST# PLANC < ET SAVE...
#/FLD# FXSB < XB,
FSB FXSA < XB-XA,
BSR ASFWOR < ET SAVE...
#/FLD# FYSC < YC,
FSB FYSA < YC-YA,
FMP FWORK < (XB-XA)*(YC-YA),
FSB PLANC < (XB-XA)*(YC-YA)-(XC-XA)*(YB-YA).
#/FST# PLANC < SOIT 'ZN', TROISIEME COMPOSANTE
< DU VECTEUR NORMAL...
<
< "NORMALISATION" DU VECTEUR NORMAL :
<
LRM A,B
WORD PLAN3D < (A)=ADRESSE DE (XN,YN,ZN),
WORD PLAN3D < (B)=ADRESSE DE (XN,YN,ZN).
BSR APRSCA < XN*XN+YN*YN+ZN*ZN,
BSR ARAC < ET CALCUL DE LA NORME DU VECTEUR NORMAL,
BSR ATSFLO
BSR AFNEG < AFIN D'AVOIR DES NORMALES DIRIGEES VERS
< L'EXTERIEUR DES SURFACES "ORDINAIRES"...
BSR ASFWOR < ET SAVE...
#/FLD# PLANA
FDV FWORK
BSR ATSFLO
#/FST# PLANA < ET NORMALISATION
#/FLD# PLANB
FDV FWORK
BSR ATSFLO
#/FST# PLANB < DU VECTEUR
#/FLD# PLANC
FDV FWORK
BSR ATSFLO
#/FST# PLANC < NORMAL...
<
< CALCUL DU COEFFICIENT 'D' DU PLAN :
<
LRM A,B
WORD PLAN3D < (A)=ADRESSE DE (XN,YN,ZN),
WORD CA3D < (B)=ADRESSE DE (XA,YA,ZA).
BSR APRSCA < XN*XA+YN*YA+ZN*ZA,
BSR AFNEG < -XN*XA-YN*YA-ZN*ZA,
#/FST# PLAND < SOIT LE COEFFICIENT 'D' DU PLAN DE LA
< FACETTE...
<
< GENERATION DE LA BOULE MINIMALE
< ASSOCIEE A LA FACETTE "INTERNE" :
<
BSR ASPHER
<
< GENERATION DE LA FACETTE :
<
IF EXIST-K,,,XEIF%
IF ATTENTION : LE 'IC' QUI SUIT EST IDIOT !!!
XEIF%: VAL ENDIF
IC IDEGEN < ET BIEN, LA FACETTE N'EST PAS DEGENEREE..
NUFACI:: VAL HZERO < NUMERO A DONNER A LA FACETTE "INTERNE",
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ ISGNFI < GENERE-T'ON LES FACETTES "INTERNES" ???
JE E201 < NON...
LAI NUFACI
BSR ASP1D < GENERATION DE LA FACETTE "INTERNE"
< DE NOM "X/YYXX0"...
E201: EQU $
<
< SAUVEGARDE DE LA FACETTE "INTERNE" :
<
LRM A,B,X
WORD CF3D < (A)=ADRESSE DE LA FACETTE "INTERNE",
WORD CF3DS < (B)=ADRESSE DE LA ZONE DE SAUVEGARDE,
WORD LFACES < (X)=NOMBRE DE MOTS A DEPLACER...
MOVE < ET SAUVEGARDE DE LA FACETTE "INTERNE"...
IC FIDENT < ET ON FAIT PROGRESSER L'INDICE 'J'
< DES FACETTES SUR LA LIGNE COURANTE...
<
<
< C A L C U L D E S 6 F A C E T T E S " E X T E R N E S " :
<
<
<
<
< C A L C U L D E ' M A B ' :
<
<
SP1C10: EQU $
<
< INITIALISATION DU CALCULATEUR
< DE DETERMINANT, TEL QUE LES
< 2 DERNIERES LIGNES DE LA MATRICE
< M(I,J) CONTIENNENT LES VECTEURS
< NORMAUX : M(2)='NA' ET M(3)='NB' :
<
LAD XNA
STA AM21 < M21 --> XN(A),
LAD YNA
STA AM22 < M22 --> YN(A),
LAD ZNA
STA AM23 < M23 --> ZN(A).
LAD XNB
STA AM31 < M31 --> XN(B),
LAD YNB
STA AM32 < M32 --> YN(B),
LAD ZNB
STA AM33 < M33 --> ZN(B).
<
< CALCUL DES COMPOSANTES DU VECTEUR 'AB' :
<
#/FLD# FXSB < XB,
FSB FXSA < XB-XA,
#/FST# M14 < M14=XB-XA.
#/FLD# FYSB < YB,
FSB FYSA < YB-YA,
#/FST# M24 < M24=YB-YA.
#/FLD# FZSB < ZB,
FSB FZSA < ZB-ZA,
#/FST# M34 < M34=ZB-ZA.
<
< CALCUL DU VECTEUR NORMAL 'NAB'
< AU PLAN P2AB :
<
< CELUI-CI EST DEFINI PAR :
< NAB=AB$(AB$(NA$NB)), OU '$' DESIGNE LE PRODUIT VECTORIEL.
< EN EFFET,
< NA$NB EST PARALLELE A LA DROIRE DAB,
< AB$(NA$NB) EST DONC UN VECTEUR NORMAL AU PLAN P1AB,
< AB$(AB$(NA$NB)) EST DONC NORMAL AU PLAN P2AB.
<
< ON A :
< NAB=AB$(AB$(NA$NB)),
< NAB=(AB.(NA$NB))AB-(AB.AB)(NA$NB), OU '.' EST LE PRODUIT
< SCALAIRE,
< NAB=(AB,NA,NB)AB-(AB.AB)(NA$NB), OU LE PREMIER TERME
< REPRESENTE LE PRODUIT
< MIXTE DE 3 VECTEURS.
<
NAB3D: EQU M11 < VECTEUR NORMAL 'NAB'...
<
< CALCUL DU PRODUIT MIXTE :
<
< I XB-XA YB-YA ZB-ZA I
< (AB,NA,NB) = I XNA YNA ZNA I
< I XNB YNB ZNB I
<
LAD M14
STA AM11 < M11 --> M14=XB-XA,
LAD M24
STA AM12 < M12 --> M24=YB-YA,
LAD M34
STA AM13 < M13 --> M34=ZB-ZA.
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < (A,B)=PRODUIT MIXTE (AB,NA,NB).
#/FST# FPRMIX < ET SAUVEGARDE...
<
< CALCUL DU CARRE DU MODULE
< DU VECTEUR 'AB', SOIT (AB.AB) :
<
#/FLD# M14 < XB-XA,
FMP M14 < (XB-XA)*(XB-XA),
BSR ASFWOR < ET SAVE...
#/FLD# M24 < YB-YA,
FMP M24 < (YB-YA)*(YB-YA),
BSR APFWOR < (XB-XA)*(XB-XA)+(YB-YA)*(YB-YA).
#/FLD# M34 < ZB-ZA,
FMP M34 < (ZB-ZA)*(ZB-ZA),
BSR APFWOR < CE QUI DONNE LE CARRE DU MODULE DU
< VECTEUR 'AB', SOIT :
#/FST# FMODUL < (XB-XA)**2+(YB-YA)**2+(ZB-ZA)**2.
<
< CALCUL DE LA COMPOSANTE XNAB :
<
< XNAB=(AB,NA,NB)*(XB-XA)-(AB.AB)*(YNA*ZNB-YNB*ZNA).
<
XNAB: EQU M11
IF NAB3D-XNAB,,XEIF%,
IF ATTENTION : INCOHERENCE !!!
XEIF%: VAL ENDIF
#/FLD# YNA < YNA,
FMP ZNB < YNA*ZNB,
BSR ASFWOR < ET SAVE...
#/FLD# YNB < YNB,
FMP ZNA < YNB*ZNA,
FSB FWORK < -(YNA*ZNB-YNB*ZNA),
FMP FMODUL < -(AB.AB)*(YNA*ZNB-YNB*ZNA),
BSR ASFWOR < ET SAVE...
#/FLD# FPRMIX < (AB,NA,NB),
FMP M14 < (AB,NA,NB)*(XB-XA),
BSR APFWOR < (AB,NA,NB)*(XB-XA)-(AB.AB)*(YNA*ZNB-
< -YNB*ZNA),
#/FST# XNAB < CE QUI DONNE XNAB DANS 'M11'...
<
< CALCUL DE LA COMPOSANTE YNAB :
<
< YNAB=(AB,NA,NB)*(YB-YA)+(AB.AB)*(XNA*ZNB-XNB*ZNA).
<
YNAB: EQU M12
#/FLD# XNB < XNB,
FMP ZNA < XNB*ZNA,
BSR ASFWOR < ET SAVE...
#/FLD# XNA < XNA,
FMP ZNB < XNA*ZNB,
FSB FWORK < +(XNA*ZNB-XNB*ZNA),
FMP FMODUL < +(AB.AB)*(XNA*ZNB-XNB*ZNA),
BSR ASFWOR < ET SAVE...
#/FLD# FPRMIX < (AB,NA,NB),
FMP M24 < (AB,NA,NB)*(YB-YA),
BSR APFWOR < (AB,NA,NB)*(YB-YA)+(AB.AB)*(XNA*ZNB-
< -XNB*ZNA),
#/FST# YNAB < CE QUI DONNE YNAB DANS 'M12'...
<
< CALCUL DE LA COMPOSANTE ZNAB :
<
< ZNAB=(AB,NA,NB)*(ZB-ZA)-(AB.AB)*(XNA*YNB-XNB*YNA).
<
ZNAB: EQU M13
#/FLD# XNA < XNA,
FMP YNB < XNA*YNB,
BSR ASFWOR < ET SAVE...
#/FLD# XNB < XNB,
FMP YNA < XNB*YNA,
FSB FWORK < -(XNA*YNB-XNB*YNA),
FMP FMODUL < -(AB.AB)*(XNA*YNB-XNB*YNA),
BSR ASFWOR < ET SAVE...
#/FLD# FPRMIX < (AB,NA,NB),
FMP M34 < (AB,NA,NB)*(ZB-ZA),
BSR APFWOR < (AB,NA,NB)*(ZB-ZA)-(AB.AB)*(XNA*YNB-
< -XNB*YNA),
#/FST# ZNAB < CE QUI DONNE ZNAB DANS 'M13'.
<
< NORMALISATION DU VECTEUR NORMAL 'NAB' :
<
BSR ASP1F < ON NORMALISE (M11,M12,M13)...
<
< CALCUL DES SECONDS MEMBRES DU
< SYSTEME LINEAIRE 3*3 A RESOUDRE
< POUR CALCULER LE POINT :
<
< MAB=PTA.INTER.PTB.INTER.P2AB.
<
< LE SYSTEME EST :
<
< (P2AB) : XNAB*(X-XA)+YNAB*(Y-YA)+ZNAB*(Z-ZA)=0,
< (PTA) : XNA*(X-XA) +YNA*(Y-YA) +ZNA*(Z-ZA) =0,
< (PTB) : XNB*(X-XB) +YNB*(Y-YB) +ZNB*(Z-ZB) =0.
<
< SOIT :
<
< (P2AB) : XNAB*X+YNAB*Y+ZNAB*Z=XNAB*XA+YNAB*YA+ZNAB*ZA,
< (PTA) : XNA*X +YNA*Y +ZNA*Z =XNA*XA +YNA*YA +ZNA*ZA,
< (PTB) : XNB*X +YNB*Y +ZNB*Z =XNB*XB +YNB*YB +ZNB*ZB.
<
LRM A,B
WORD NAB3D < (A)=ADRESSE DE (XNAB,YNAB,ZNAB),
WORD CA3D < (B)=ADRESSE DE (FXSA,FYSA,FZSA).
BSR APRSCA < XNAB*XA+YNAB*YA+ZNAB*ZA,
#/FST# M14 < CE QUI DONNE 'M14'...
LRM A,B
WORD NA3D < (A)=ADRESSE DE (XNA,YNA,ZNA),
WORD CA3D < (B)=ADRESSE DE (FXSA,FYSA,FZSA).
BSR APRSCA < XNA*XA+YNA*YA+ZNA*ZA,
#/FST# M24 < CE QUI DONNE 'M24'...
LRM A,B
WORD NB3D < (A)=ADRESSE DE (XNB,YNB,ZNB),
WORD CB3D < (B)=ADRESSE DE (FXSB,FYSB,FZSB).
BSR APRSCA < XNB*XB+YNB*YB+ZNB*ZB,
#/FST# M34 < CE QUI DONNE 'M34'...
<
< PREPARATION DU CALCUL DU
< DETERMINANT DU SYSTEME :
<
LAD XNAB
STA AM11 < M11 --> XNAB,
LAD YNAB
STA AM12 < M12 --> YNAB,
LAD ZNAB
STA AM13 < M13 --> ZNAB.
<
< CALCUL DU POINT 'MAB' :
<
LAD FXSAB
STA AVARX < ADRESSE DE LA PREMIERE VARIABLE,
LAD FYSAB
STA AVARY < ADRESSE DE LA SECONDE VARIABLE,
LAD FZSAB
STA AVARZ < ADRESSE DE LA TROISEME VARIABLE.
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ACRAMR < ET CALCUL DE (FXSAB,FYSAB,FZSAB) PAR
< UTILISATION DE LA METHODE DE CRAMER...
BSR ATSFLO
<
<
< C A L C U L D E ' M B C ' :
<
<
SP1C20: EQU $
<
< INITIALISATION DU CALCULATEUR
< DE DETERMINANT, TEL QUE LES
< 2 DERNIERES LIGNES DE LA MATRICE
< M(I,J) CONTIENNENT LES VECTEURS
< NORMAUX : M(2)='NB' ET M(3)='NC' :
<
LAD XNB
STA AM21 < M21 --> XN(B),
LAD YNB
STA AM22 < M22 --> YN(B),
LAD ZNB
STA AM23 < M23 --> ZN(B).
LAD XNC
STA AM31 < M31 --> XN(C),
LAD YNC
STA AM32 < M32 --> YN(C),
LAD ZNC
STA AM33 < M33 --> ZN(C).
<
< CALCUL DES COMPOSANTES DU VECTEUR 'BC' :
<
#/FLD# FXSC < XC,
FSB FXSB < XC-XB,
#/FST# M14 < M14=XC-XB.
#/FLD# FYSC < YC,
FSB FYSB < YC-YB,
#/FST# M24 < M24=YC-YB.
#/FLD# FZSC < ZC,
FSB FZSB < ZC-ZB,
#/FST# M34 < M34=ZC-ZB.
<
< CALCUL DU VECTEUR NORMAL 'NBC'
< AU PLAN P2BC :
<
< CELUI-CI EST DEFINI PAR :
< NBC=BC$(BC$(NB$NC)), OU '$' DESIGNE LE PRODUIT VECTORIEL.
< EN EFFET,
< NB$NC EST PARALLELE A LA DROIRE DBC,
< BC$(NB$NC) EST DONC UN VECTEUR NORMAL AU PLAN P1BC,
< BC$(BC$(NB$NC)) EST DONC NORMAL AU PLAN P2BC.
<
< ON A :
< NBC=BC$(BC$(NB$NC)),
< NBC=(BC.(NB$NC))BC-(BC.BC)(NB$NC), OU '.' EST LE PRODUIT
< SCALAIRE,
< NBC=(BC,NB,NC)BC-(BC.BC)(NB$NC), OU LE PREMIER TERME
< REPRESENTE LE PRODUIT
< MIXTE DE 3 VECTEURS.
<
NBC3D: EQU NAB3D < VECTEUR NORMAL 'NBC'...
<
< CALCUL DU PRODUIT MIXTE :
<
< I XC-XB YC-YB ZC-ZB I
< (BC,NB,NC) = I XNB YNB ZNB I
< I XNC YNC ZNC I
<
LAD M14
STA AM11 < M11 --> M14=XC-XB,
LAD M24
STA AM12 < M12 --> M24=YC-YB,
LAD M34
STA AM13 < M13 --> M34=ZC-ZB.
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < (A,B)=PRODUIT MIXTE (BC,NB,NC).
#/FST# FPRMIX < ET SAUVEGARDE...
<
< CALCUL DU CARRE DU MODULE
< DU VECTEUR 'BC', SOIT (BC.BC) :
<
#/FLD# M14 < XC-XB,
FMP M14 < (XC-XB)*(XC-XB),
BSR ASFWOR < ET SAVE...
#/FLD# M24 < YC-YB,
FMP M24 < (YC-YB)*(YC-YB),
BSR APFWOR < (XC-XB)*(XC-XB)+(YC-YB)*(YC-YB).
#/FLD# M34 < ZC-ZB,
FMP M34 < (ZC-ZB)*(ZC-ZB),
BSR APFWOR < CE QUI DONNE LE CARRE DU MODULE DU
< VECTEUR 'BC', SOIT :
#/FST# FMODUL < (XC-XB)**2+(YC-YB)**2+(ZC-ZB)**2.
<
< CALCUL DE LA COMPOSANTE XNBC :
<
< XNBC=(BC,NB,NC)*(XC-XB)-(BC.BC)*(YNB*ZNC-YNC*ZNB).
<
XNBC: EQU M11
IF XNBC-NBC3D,,XEIF%,
IF ATTENTION : INCOHERENCE !!!
XEIF%: VAL ENDIF
#/FLD# YNB < YNB,
FMP ZNC < YNB*ZNC,
BSR ASFWOR < ET SAVE...
#/FLD# YNC < YNC,
FMP ZNB < YNC*ZNB,
FSB FWORK < -(YNB*ZNC-YNC*ZNB),
FMP FMODUL < -(BC.BC)*(YNB*ZNC-YNC*ZNB),
BSR ASFWOR < ET SAVE...
#/FLD# FPRMIX < (BC,NB,NC),
FMP M14 < (BC,NB,NC)*(XC-XB),
BSR APFWOR < (BC,NB,NC)*(XC-XB)-(BC.BC)*(YNB*ZNC-
< -YNC*ZNB),
#/FST# XNBC < CE QUI DONNE XNBC DANS 'M11'...
<
< CALCUL DE LA COMPOSANTE YNBC :
<
< YNBC=(BC,NB,NC)*(YC-YB)+(BC.BC)*(XNB*ZNC-XNC*ZNB).
<
YNBC: EQU M12
#/FLD# XNC < XNC,
FMP ZNB < XNC*ZNB,
BSR ASFWOR < ET SAVE...
#/FLD# XNB < XNB,
FMP ZNC < XNB*ZNC,
FSB FWORK < +(XNB*ZNC-XNC*ZNB),
FMP FMODUL < +(BC.BC)*(XNB*ZNC-XNC*ZNB),
BSR ASFWOR < ET SAVE...
#/FLD# FPRMIX < (BC,NB,NC),
FMP M24 < (BC,NB,NC)*(YC-YB),
BSR APFWOR < (BC,NB,NC)*(YC-YB)+(BC.BC)*(XNB*ZNC-
< -XNC*ZNB),
#/FST# YNBC < CE QUI DONNE YNBC DANS 'M12'...
<
< CALCUL DE LA COMPOSANTE ZNBC :
<
< ZNBC=(BC,NB,NC)*(ZC-ZB)-(BC.BC)*(XNB*YNC-XNC*YNB).
<
ZNBC: EQU M13
#/FLD# XNB < XNB,
FMP YNC < XNB*YNC,
BSR ASFWOR < ET SAVE...
#/FLD# XNC < XNC,
FMP YNB < XNC*YNB,
FSB FWORK < -(XNB*YNC-XNC*YNB),
FMP FMODUL < -(BC.BC)*(XNB*YNC-XNC*YNB),
BSR ASFWOR < ET SAVE...
#/FLD# FPRMIX < (BC,NB,NC),
FMP M34 < (BC,NB,NC)*(ZC-ZB),
BSR APFWOR < (BC,NB,NC)*(ZC-ZB)-(BC.BC)*(XNB*YNC-
< -XNC*YNB),
#/FST# ZNBC < CE QUI DONNE ZNBC DANS 'M13'.
<
< NORMALISATION DU VECTEUR NORMAL 'NBC' :
<
BSR ASP1F < ON NORMALISE (M11,M12,M13)...
<
< CALCUL DES SECONDS MEMBRES DU
< SYSTEME LINEAIRE 3*3 A RESOUDRE
< POUR CALCULER LE POINT :
<
< MBC=PTB.INTER.PTC.INTER.P2BC.
<
< LE SYSTEME EST :
<
< (P2BC) : XNBC*(X-XB)+YNBC*(Y-YB)+ZNBC*(Z-ZB)=0,
< (PTB) : XNB*(X-XB) +YNB*(Y-YB) +ZNB*(Z-ZB) =0,
< (PTC) : XNC*(X-XC) +YNC*(Y-YC) +ZNC*(Z-ZC) =0.
<
< SOIT :
<
< (P2BC) : XNBC*X+YNBC*Y+ZNBC*Z=XNBC*XB+YNBC*YB+ZNBC*ZB,
< (PTB) : XNB*X +YNB*Y +ZNB*Z =XNB*XB +YNB*YB +ZNB*ZB,
< (PTC) : XNC*X +YNC*Y +ZNC*Z =XNC*XC +YNC*YC +ZNC*ZC.
<
LRM A,B
WORD NBC3D < (A)=ADRESSE DE (XNBC,YNBC,ZNBC),
WORD CB3D < (B)=ADRESSE DE (FXSB,FYSB,FZSB).
BSR APRSCA < XNBC*XB+YNBC*YB+ZNBC*ZB,
#/FST# M14 < CE QUI DONNE 'M14'...
LRM A,B
WORD NB3D < (A)=ADRESSE DE (XNB,YNB,ZNB),
WORD CB3D < (B)=ADRESSE DE (FXSB,FYSB,FZSB).
BSR APRSCA < XNB*XB+YNB*YB+ZNB*ZB,
#/FST# M24 < CE QUI DONNE 'M24'...
LRM A,B
WORD NC3D < (A)=ADRESSE DE (XNC,YNC,ZNC),
WORD CC3D < (B)=ADRESSE DE (FXSC,FYSC,FZSC).
BSR APRSCA < XNC*XC+YNC*YC+ZNC*ZC,
#/FST# M34 < CE QUI DONNE 'M34'...
<
< PREPARATION DU CALCUL DU
< DETERMINANT DU SYSTEME :
<
LAD XNBC
STA AM11 < M11 --> XNBC,
LAD YNBC
STA AM12 < M12 --> YNBC,
LAD ZNBC
STA AM13 < M13 --> ZNBC.
<
< CALCUL DU POINT 'MBC' :
<
LAD FXSBC
STA AVARX < ADRESSE DE LA PREMIERE VARIABLE,
LAD FYSBC
STA AVARY < ADRESSE DE LA SECONDE VARIABLE,
LAD FZSBC
STA AVARZ < ADRESSE DE LA TROISIEME VARIABLE.
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ACRAMR < ET CALCUL DE (FXSBC,FYSBC,FZSBC) PAR
< UTILISATION DE LA METHODE DE CRAMER...
BSR ATSFLO
<
<
< C A L C U L D E ' M C A ' :
<
<
SP1C30: EQU $
<
< INITIALISATION DU CALCULATEUR
< DE DETERMINANT, TEL QUE LES
< 2 DERNIERES LIGNES DE LA MATRICE
< M(I,J) CONTIENNENT LES VECTEURS
< NORMAUX : M(2)='NC' ET M(3)='NA' :
<
LAD XNC
STA AM21 < M21 --> XN(C),
LAD YNC
STA AM22 < M22 --> YN(C),
LAD ZNC
STA AM23 < M23 --> ZN(C).
LAD XNA
STA AM31 < M31 --> XN(A),
LAD YNA
STA AM32 < M32 --> YN(A),
LAD ZNA
STA AM33 < M33 --> ZN(A).
<
< CALCUL DES COMPOSANTES DU VECTEUR 'CA' :
<
#/FLD# FXSA < XA,
FSB FXSC < XA-XC,
#/FST# M14 < M14=XA-XC.
#/FLD# FYSA < YA,
FSB FYSC < YA-YC,
#/FST# M24 < M24=YA-YC.
#/FLD# FZSA < ZA,
FSB FZSC < ZA-ZC,
#/FST# M34 < M34=ZA-ZC.
<
< CALCUL DU VECTEUR NORMAL 'NCA'
< AU PLAN P2CA :
<
< CELUI-CI EST DEFINI PAR :
< NCA=CA$(CA$(NC$NA)), OU '$' DESIGNE LE PRODUIT VECTORIEL.
< EN EFFET,
< NC$NA EST PARALLELE A LA DROIRE DCA,
< CA$(NC$NA) EST DONC UN VECTEUR NORMAL AU PLAN P1CA,
< CA$(CA$(NC$NA)) EST DONC NORMAL AU PLAN P2CA.
<
< ON A :
< NCA=CA$(CA$(NC$NA)),
< NCA=(CA.(NC$NA))CA-(CA.CA)(NC$NA), OU '.' EST LE PRODUIT
< SCALAIRE,
< NCA=(CA,NC,NA)CA-(CA.CA)(NC$NA), OU LE PREMIER TERME
< REPRESENTE LE PRODUIT
< MIXTE DE 3 VECTEURS.
NCA3D: EQU NAB3D < VECTEUR NORMAL 'NCA'...
<
< CALCUL DU PRODUIT MIXTE :
<
< I XA-XC YA-YC ZA-ZC I
< (CA,NC,NA) = I XNC YNC ZNC I
< I XNA YNA ZNA I
<
LAD M14
STA AM11 < M11 --> M14=XA-XC,
LAD M24
STA AM12 < M12 --> M24=YA-YC,
LAD M34
STA AM13 < M13 --> M34=ZA-ZC.
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < (A,B)=PRODUIT MIXTE (CA,NC,NA).
#/FST# FPRMIX < ET SAUVEGARDE...
<
< CALCUL DU CARRE DU MODULE
< DU VECTEUR 'CA', SOIT (CA.CA) :
<
#/FLD# M14 < XA-XC,
FMP M14 < (XA-XC)*(XA-XC),
BSR ASFWOR < ET SAVE...
#/FLD# M24 < YA-YC,
FMP M24 < (YA-YC)*(YA-YC),
BSR APFWOR < (XA-XC)*(XA-XC)+(YA-YC)*(YA-YC).
#/FLD# M34 < ZA-ZC,
FMP M34 < (ZA-ZC)*(ZA-ZC),
BSR APFWOR < CE QUI DONNE LE CARRE DU MODULE DU
< VECTEUR 'CA', SOIT :
#/FST# FMODUL < (XA-XC)**2+(YA-YC)**2+(ZA-ZC)**2.
<
< CALCUL DE LA COMPOSANTE XNCA :
<
< XNCA=(CA,NC,NA)*(XA-XC)-(CA.CA)*(YNC*ZNA-YNA*ZNC).
<
XNCA: EQU M11
IF XNCA-NCA3D,,XEIF%,
IF ATTENTION : INCOHERENCE !!!
XEIF%: VAL ENDIF
#/FLD# YNC < YNC,
FMP ZNA < YNC*ZNA,
BSR ASFWOR < ET SAVE...
#/FLD# YNA < YNA,
FMP ZNC < YNA*ZNC,
FSB FWORK < -(YNC*ZNA-YNA*ZNC),
FMP FMODUL < -(CA.CA)*(YNC*ZNA-YNA*ZNC),
BSR ASFWOR < ET SAVE...
#/FLD# FPRMIX < (CA,NC,NA),
FMP M14 < (CA,NC,NA)*(XA-XC),
BSR APFWOR < (CA,NC,NA)*(XA-XC)-(CA.CA)*(YNC*ZNA-
< -YNA*ZNC),
#/FST# XNCA < CE QUI DONNE XNCA DANS 'M11'...
<
< CALCUL DE LA COMPOSANTE YNCA :
<
< YNCA=(CA,NC,NA)*(YA-YC)+(CA.CA)*(XNC*ZNA-XNA*ZNC).
<
YNCA: EQU M12
#/FLD# XNA < XNA,
FMP ZNC < XNA*ZNC,
BSR ASFWOR < ET SAVE...
#/FLD# XNC < XNC,
FMP ZNA < XNC*ZNA,
FSB FWORK < +(XNC*ZNA-XNA*ZNC),
FMP FMODUL < +(CA.CA)*(XNC*ZNA-XNA*ZNC),
BSR ASFWOR < ET SAVE...
#/FLD# FPRMIX < (CA,NC,NA),
FMP M24 < (CA,NC,NA)*(YA-YC),
BSR APFWOR < (CA,NC,NA)*(YA-YC)+(CA.CA)*(XNC*ZNA-
< -XNA*ZNC),
#/FST# YNCA < CE QUI DONNE YNCA DANS 'M12'...
<
< CALCUL DE LA COMPOSANTE ZNCA :
<
< ZNCA=(CA,NC,NA)*(ZA-ZC)-(CA.CA)*(XNC*YNA-XNA*YNC).
<
ZNCA: EQU M13
#/FLD# XNC < XNC,
FMP YNA < XNC*YNA,
BSR ASFWOR < ET SAVE...
#/FLD# XNA < XNA,
FMP YNC < XNA*YNC,
FSB FWORK < -(XNC*YNA-XNA*YNC),
FMP FMODUL < -(CA.CA)*(XNC*YNA-XNA*YNC),
BSR ASFWOR < ET SAVE...
#/FLD# FPRMIX < (CA,NC,NA),
FMP M34 < (CA,NC,NA)*(ZA-ZC),
BSR APFWOR < (CA,NC,NA)*(ZA-ZC)-(CA.CA)*(XNC*YNA-
< -XNA*YNC),
#/FST# ZNCA < CE QUI DONNE ZNCA DANS 'M13'.
<
< NORMALISATION DU VECTEUR NORMAL 'NCA' :
<
BSR ASP1F < ON NORMALISE (M11,M12,M13)...
<
< CALCUL DES SECONDS MEMBRES DU
< SYSTEME LINEAIRE 3*3 A RESOUDRE
< POUR CALCULER LE POINT :
<
< MCA=PTC.INTER.PTA.INTER.P2CA.
<
< LE SYSTEME EST :
<
< (P2CA) : XNCA*(X-XC)+YNCA*(Y-YC)+ZNCA*(Z-ZC)=0,
< (PTC) : XNC*(X-XC) +YNC*(Y-YC) +ZNC*(Z-ZC) =0,
< (PTA) : XNA*(X-XA) +YNA*(Y-YA) +ZNA*(Z-ZA) =0.
<
< SOIT :
<
< (P2CA) : XNCA*X+YNCA*Y+ZNCA*Z=XNCA*XC+YNCA*YC+ZNCA*ZC,
< (PTC) : XNC*X +YNC*Y +ZNC*Z =XNC*XC +YNC*YC +ZNC*ZC,
< (PTA) : XNA*X +YNA*Y +ZNA*Z =XNA*XA +YNA*YA +ZNA*ZA.
<
LRM A,B
WORD NCA3D < (A)=ADRESSE DE (XNCA,YNCA,ZNCA),
WORD CC3D < (B)=ADRESSE DE (FXSC,FYSC,FZSC).
BSR APRSCA < XNCA*XC+YNCA*YC+ZNCA*ZC,
#/FST# M14 < CE QUI DONNE 'M14'...
LRM A,B
WORD NC3D < (A)=ADRESSE DE (XNC,YNC,ZNC),
WORD CC3D < (B)=ADRESSE DE (FXSC,FYSC,FZSC).
BSR APRSCA < XNC*XC+YNC*YC+ZNC*ZC,
#/FST# M24 < CE QUI DONNE 'M24'...
LRM A,B
WORD NA3D < (A)=ADRESSE DE (XNA,YNA,ZNA),
WORD CA3D < (B)=ADRESSE DE (FXSA,FYSA,FZSA).
BSR APRSCA < XNA*XA+YNA*YA+ZNA*ZA,
#/FST# M34 < CE QUI DONNE 'M34'...
<
< PREPARATION DU CALCUL DU
< DETERMINANT DU SYSTEME :
<
LAD XNCA
STA AM11 < M11 --> XNCA,
LAD YNCA
STA AM12 < M12 --> YNCA,
LAD ZNCA
STA AM13 < M13 --> ZNCA.
<
< CALCUL DU POINT 'MCA' :
<
LAD FXSCA
STA AVARX < ADRESSE DE LA PREMIERE VARIABLE,
LAD FYSCA
STA AVARY < ADRESSE DE LA SECONDE VARIABLE,
LAD FZSCA
STA AVARZ < ADRESSE DE LA TROISIEME VARIABLE.
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ACRAMR < ET CALCUL DE (FXSCA,FYSCA,FZSCA) PAR
< UTILISATION DE LA METHODE DE CRAMER...
BSR ATSFLO
<
<
< C A L C U L D E ' M A B C ' :
<
<
SP1C40: EQU $
<
< INITIALISATION DU CALCULATEUR
< DE DETERMINANT, TEL QUE LES
< 3 LIGNES DE LA MATRICE M(I,J)
< CONTIENNENT LES VECTEURS NORMAUX :
< M(1)='NA', M(2)='NB' ET M(3)='NC' :
<
LAD XNA
STA AM11 < M11 --> XN(A),
LAD YNA
STA AM12 < M12 --> YN(A),
LAD ZNA
STA AM13 < M13 --> ZN(A).
LAD XNB
STA AM21 < M21 --> XN(B),
LAD YNB
STA AM22 < M22 --> YN(B),
LAD ZNB
STA AM23 < M23 --> ZN(B).
LAD XNC
STA AM31 < M31 --> XN(C),
LAD YNC
STA AM32 < M32 --> YN(C),
LAD ZNC
STA AM33 < M33 --> ZN(C).
<
< CALCUL DES SECONDS MEMBRES DU
< SYSTEME LINEAIRE 3*3 A RESOUDRE
< POUR CALCULER LE POINT :
<
< MABC=PTA.INTER.PTB.INTER.PTC.
<
< LE SYSTEME EST :
<
< (PTA) : XNA*(X-XA)+YNA*(Y-YA)+ZNA*(Z-ZA)=0,
< (PTB) : XNB*(X-XB)+YNB*(Y-YB)+ZNB*(Z-ZB)=0,
< (PTC) : XNC*(X-XC)+YNC*(Y-YC)+ZNC*(Z-ZC)=0.
<
< SOIT :
<
< (PTA) : XNA*X+YNA*Y+ZNA*Z=XNA*XA+YNA*YA+ZNA*ZA,
< (PTB) : XNB*X+YNB*Y+ZNB*Z=XNB*XB+YNB*YB+ZNB*ZB.
< (PTC) : XNC*X+YNC*Y+ZNC*Z=XNC*XC+YNC*YC+ZNC*ZC.
<
LRM A,B
WORD NA3D < (A)=ADRESSE DE (XNA,YNA,ZNA),
WORD CA3D < (B)=ADRESSE DE (FXSA,FYSA,FZSA).
BSR APRSCA < XNA*XA+YNA*YA+ZNA*ZA,
#/FST# M14 < CE QUI DONNE 'M14'...
LRM A,B
WORD NB3D < (A)=ADRESSE DE (XNB,YNB,ZNB),
WORD CB3D < (B)=ADRESSE DE (FXSB,FYSB,FZSB).
BSR APRSCA < XNB*XB+YNB*YB+ZNB*ZB,
#/FST# M24 < CE QUI DONNE 'M24'...
LRM A,B
WORD NC3D < (A)=ADRESSE DE (XNC,YNC,ZNC),
WORD CC3D < (B)=ADRESSE DE (FXSC,FYSC,FZSC).
BSR APRSCA < XNC*XC+YNC*YC+ZNC*ZC,
#/FST# M34 < CE QUI DONNE 'M34'...
<
< CALCUL DU POINT 'MABC' :
<
LAD FXSABC
STA AVARX < ADRESSE DE LA PREMIERE VARIABLE,
LAD FYSABC
STA AVARY < ADRESSE DE LA SECONDE VARIABLE,
LAD FZSABC
STA AVARZ < ADRESSE DE LA TROISIEME VARIABLE.
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ACRAMR < ET CALCUL DE (FXSABC,FYSABC,FZSABC) PAR
< UTILISATION DE LA METHODE DE CRAMER...
BSR ATSFLO
<
< ET RETOUR :
<
SP1C8: EQU $
PLR A,B,X
RSR
PAGE
<
<
< N O R M A L I S A T I O N D U V E C T E U R
< ( M 1 1 , M 1 2 , M 1 3 ) :
<
<
< FONCTION :
< CE SOUS-PROGRAMME NORMALISE
< LE VECTEUR-LIGNE (M11,M12,M13)
< LORS DU CALCUL DES POINTS 'MAB',
< 'MBC' ET 'MCA'...
<
<
SP1F: EQU $
<
< INITIALISATIONS :
<
PSR A,B
<
< CALCUL DE LA NORME DU
< VECTEUR (M11,M12,M13) :
<
LRM A,B
WORD M11 < (A)=ADRESSE DE (M11,M12,M13),
WORD M11 < (B)=ADRESSE DE (M11,M12,M13).
IF M12-M11-DFLOT,,XEIF%,
IF ATTENTION : MAUVAISE IMPLANTATION !!!
XEIF%: VAL ENDIF
IF M13-M12-DFLOT,,XEIF%,
IF ATTENTION : MAUVAISE IMPLANTATION !!!
XEIF%: VAL ENDIF
BSR APRSCA < XN*XN+YN*YN+ZN*ZN,
BSR ARAC < ET CALCUL DE LA NORME DU VECTEUR NORMAL,
BSR ATSFLO
BSR ASFWOR < ET SAVE...
<
< ET NORMALISATION :
<
#/FLD# M11
FDV FWORK
BSR ATSFLO
#/FST# M11 < ET NORMALISATION
#/FLD# M12
FDV FWORK
BSR ATSFLO
#/FST# M12 < DU VECTEUR
#/FLD# M13
FDV FWORK
BSR ATSFLO
#/FST# M13 < NORMAL...
<
< ET RETOUR :
<
PLR A,B
RSR
PAGE
<
<
< C A L C U L D E S 6 F A C E T T E S " E X T E R N E S " :
<
<
< FONCTION :
< CE SOUS-PROGRAMME CALCULE
< LES 6 FACETTES "EXTERNES"
< ASSOCIEES A LA FACETTE "INTER-
< NE COURANTE.
<
<
FACE: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X,Y
<
< IDENTIFICATION DES SEGMENTS :
< (POUR 'SEGMU' ET 'SEGMV')
<
XSEGAB:: VAL K < SEGMENT (A,B),
XSEGBC:: VAL XSEGAB+I < SEGMENT (B,C),
XSEGCA:: VAL XSEGBC+I < SEGMENT (C,A).
IF XSEGAB-XSEGBC,XEIF%,,XEIF%
IF ATTENTION : IDENTIFICATEUR DE (A,B)=
IF IDENTIFICATEUR DE (B,C) !!!
XEIF%: VAL ENDIF
IF XSEGBC-XSEGCA,XEIF%,,XEIF%
IF ATTENTION : IDENTIFICATEUR DE (B,C)=
IF IDENTIFICATEUR DE (C,A) !!!
XEIF%: VAL ENDIF
IF XSEGCA-XSEGAB,XEIF%,,XEIF%
IF ATTENTION : IDENTIFICATEUR DE (C,A)=
IF IDENTIFICATEUR DE (A,B) !!!
XEIF%: VAL ENDIF
<
<
< F A C E T T E ( A , M A B , M A B C ) :
<
<
<
< GENERATION DES 3 SOMMETS :
<
LRM A,B
WORD CA3DS
WORD CA3D
BSR AMOVE3 < PREMIER SOMMET <-- 'A'.
LRM A,B
WORD CAB3D
WORD CB3D
BSR AMOVE3 < DEUXIEME SOMMET <-- 'MAB'.
LRM A,B
WORD CABC3D
WORD CC3D
BSR AMOVE3 < TROISIEME SOMMET <-- 'MABC'.
<
< GENERATION DES NORMALES
< A LA SURFACE AUX 3 SOMMETS :
<
LRM A,B
WORD NA3DS
WORD NA3D
BSR AMOVE3 < VECTEUR NORMAL EN 'A'.
LRM A,B
WORD NX3D
WORD NB3D
BSR AMOVE3 < LA NORMALE EN 'MAB' EST INDEFINIE...
LRM A,B
WORD NX3D
WORD NC3D
BSR AMOVE3 < LA NORMALE EN 'MABC' EST INDEFINIE...
<
< EQUATION DU PLAN DE LA FACETTE :
<
LRM A,B
WORD NA3DS
WORD PLAN3D
BSR AMOVE3 < C'EST LE PLAN TANGENT EN 'A'.
LRM A,B
WORD NA3DS < (A)=ADRESSE DE (XNAS,YNAS,ZNAS),
WORD CA3DS < (B)=ADRESSE DE (FXSAS,FYSAS,FZSAS).
BSR APRSCA < XN*XA+YN*YA+ZN*ZA,
BSR AFNEG < -XN*XA-YN*YA-ZN*ZA,
#/FST# PLAND < SOIT LE COEFFICIENT 'D' DU PLAN DE LA
< FACETTE...
<
< IDENTIFICATEURS DES SOMMETS
< DE LA FACETTE COURANTE :
<
LA IDENTX
LB &AIDNAS
STB IDENTA < SOMMET 'A',
STA IDENTB < SOMMET 'MAB',
STA IDENTC < SOMMET 'MABC'...
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'A' :
<
FLD &AVRUAS
#/FST# VARUA < UA <-- UA,
FLD &AVRVAS
#/FST# VARVA < VA <-- VA.
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'MAB' :
<
FLD &AFXSAS < XA,
FSB FXSAB < XA-XAB,
#/FST# FMODUL
FMP FMODUL < (XA-XAB)**2.
BSR ASFWOR < ET SAVE...
FLD &AFYSAS < YA,
FSB FYSAB < YA-YAB,
#/FST# FMODUL
FMP FMODUL < (YA-YAB)**2,
BSR APFWOR < (XA-XAB)**2+(YA-YAB)**2.
FLD &AFZSAS < ZA,
FSB FZSAB < ZA-ZAB,
#/FST# FMODUL
FMP FMODUL < (ZA-ZAB)**2,
BSR APFWOR < (XA-XAB)**2+(YA-YAB)**2+(ZA-ZAB)**2,
BSR ARAC < CALCUL DE LA DISTANCE DE 'A' A 'MAB',
BSR ATSFLO
#/FST# DAMAB < DAMAB=D(A,MAB).
#/FLD# FXSAB < XAB,
FSB &AFXSBS < XAB-XB,
#/FST# FMODUL
FMP FMODUL < (XAB-XB)**2.
BSR ASFWOR < ET SAVE...
#/FLD# FYSAB < YAB,
FSB &AFYSBS < YAB-YB,
#/FST# FMODUL
FMP FMODUL < (YAB-YB)**2,
BSR APFWOR < (XAB-XB)**2+(YAB-YB)**2.
#/FLD# FZSAB < ZAB,
FSB &AFZSBS < ZAB-ZB,
#/FST# FMODUL
FMP FMODUL < (ZAB-ZB)**2,
BSR APFWOR < (XAB-XB)**2+(YAB-YB)**2+(ZAB-ZB)**2,
BSR ARAC < CALCUL DE LA DISTANCE DE 'MAB' A 'B',
BSR ATSFLO
#/FST# DMABB < DMABB=D(MAB,B).
FAD DAMAB
#/FST# DAMABB < DAMABB=D(A,MAB)+D(MAB,B)...
LAI XSEGAB
BSR ASEGMU < POSITION DU SEGMENT (A,B) --> 'Y'...
FLD &AVRUBS < UB,
BSR APERIU
FMP DAMAB < D(A,MAB)*UB,
BSR ASFWOR < ET SAVE...
FLD &AVRUAS < UA,
BSR APERIU
FMP DMABB < D(MAB,B)*UA,
BSR APFWOR < D(A,MAB)*UB+D(MAB,B)*UA,
FDV DAMABB
BSR ATSFLO
BSR APSEGU < POSITIONNEMENT DANS LA PERIODE DE 'U'...
#/FST# VARUB < UB <-- UAB=(D(A,MAB)*UB+D(MAB,B)*UA))/
< (D(A,MAB)+D(MAB,B)).
LAI XSEGAB
BSR ASEGMV < POSITION DU SEGMENT (A,B) --> 'Y'...
FLD &AVRVBS < VB,
BSR APERIV
FMP DAMAB < D(A,MAB)*VB,
BSR ASFWOR < ET SAVE...
FLD &AVRVAS < VA,
BSR APERIV
FMP DMABB < D(MAB,B)*VA,
BSR APFWOR < D(A,MAB)*VB+D(MAB,B)*VA,
FDV DAMABB
BSR ATSFLO
BSR APSEGV < POSITIONNEMENT DANS LA PERIODE DE 'V'...
#/FST# VARVB < VB <-- VAB=(D(A,MAB)*VB+D(MAB,B)*VA))/
< (D(A,MAB)+D(MAB,B)).
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'MABC' :
<
FLD &AFXSAS < XA,
FSB FXSABC < XA-XABC,
#/FST# FMODUL
FMP FMODUL < (XA-XABC)**2.
BSR ASFWOR < ET SAVE...
FLD &AFYSAS < YA,
FSB FYSABC < YA-YABC,
#/FST# FMODUL
FMP FMODUL < (YA-YABC)**2,
BSR APFWOR < (XA-XABC)**2+(YA-YABC)**2.
FLD &AFZSAS < ZA,
FSB FZSABC < ZA-ZABC,
#/FST# FMODUL
FMP FMODUL < (ZA-ZB)**2,
BSR APFWOR < (XA-XABC)**2+(YA-YABC)**2+(ZA-ZABC)**2,
BSR ARAC < CALCUL DE LA DISTANCE DE 'A' A 'MABC',
BSR ATSFLO
#/FST# DA < DA=D(A,MABC).
FLD &AFXSBS < XB,
FSB FXSABC < XB-XABC,
#/FST# FMODUL
FMP FMODUL < (XB-XABC)**2.
BSR ASFWOR < ET SAVE...
FLD &AFYSBS < YB,
FSB FYSABC < YB-YABC,
#/FST# FMODUL
FMP FMODUL < (YB-YABC)**2,
BSR APFWOR < (XB-XABC)**2+(YB-YABC)**2.
FLD &AFZSBS < ZB,
FSB FZSABC < ZB-ZABC,
#/FST# FMODUL
FMP FMODUL < (ZB-ZB)**2,
BSR APFWOR < (XB-XABC)**2+(YB-YABC)**2+(ZB-ZABC)**2,
BSR ARAC < CALCUL DE LA DISTANCE DE 'B' A 'MABC',
BSR ATSFLO
#/FST# DB < DB=D(B,MABC).
FLD &AFXSCS < XC,
FSB FXSABC < XC-XABC,
#/FST# FMODUL
FMP FMODUL < (XC-XABC)**2.
BSR ASFWOR < ET SAVE...
FLD &AFYSCS < YC,
FSB FYSABC < YC-YABC,
#/FST# FMODUL
FMP FMODUL < (YC-YABC)**2,
BSR APFWOR < (XC-XABC)**2+(YC-YABC)**2.
FLD &AFZSCS < ZC,
FSB FZSABC < ZC-ZABC,
#/FST# FMODUL
FMP FMODUL < (ZC-ZB)**2,
BSR APFWOR < (XC-XABC)**2+(YC-YABC)**2+(ZC-ZABC)**2,
BSR ARAC < CALCUL DE LA DISTANCE DE 'C' A 'MABC',
BSR ATSFLO
#/FST# DC < DC=D(C,MABC).
< NOTONS EN ABREGE D(X,MABC) PAR 'DX'...
FMP DB < DB*DC,
#/FST# DBDC < DBDC=DB*DC,
BSR ASFWOR < ET SAVE...
#/FLD# DC < DC,
FMP DA < DC*DA,
#/FST# DCDA < DCDA=DC*DA,
BSR APFWOR < DB*DC+DC*DA,
#/FLD# DA < DA,
FMP DB < DA*DB,
#/FST# DADB < DADB=DA*DB,
BSR APFWOR < DB*DC+DC*DA+DA*DB,
#/FST# DADBDC < DADBDC=DB*DC+DC*DA+DA*DB.
PSR A,B,X
LXI XPERU < (X)=INDEX DE LA PERIOD(U).
LYI EXIST < (Y)=INDICATEUR :
< ='EXIST' : (A,B,C) EST SUR LE REBOU-
< CLAGE DU TORE,
< ='NEXIST' : (A,B,C) EST "NORMAL"...
FLD &AVRUAS < UA,
FSB &AVRUBS < UA-UB,
BSR AFABS < ABS(UA-UB),
FDV F05 < 2*ABS(UA-UB), ET CECI AFIN DE COMPARER
< ABS(UA-UB) A LA PERIOD(U)...
FCAM &ALTORE < ALORS, (UA-UB) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(U),MAX(U)) ???
JG TRIGU9 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUCLAGE DU TORE...
FLD &AVRUBS < UB,
FSB &AVRUCS < UB-UC,
BSR AFABS < ABS(UB-UC),
FDV F05 < 2*ABS(UB-UC), ET CECI AFIN DE COMPARER
< ABS(UB-UC) A LA PERIOD(U)...
FCAM &ALTORE < ALORS, (UB-UC) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(U),MAX(U)) ???
JG TRIGU9 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUBLAGE DU TORE...
FLD &AVRUCS < UC,
FSB &AVRUAS < UC-UA,
BSR AFABS < ABS(UC-UA),
FDV F05 < 2*ABS(UC-UA), ET CECI AFIN DE COMPARER
< ABS(UC-UA) A LA PERIOD(U)...
FCAM &ALTORE < ALORS, (UC-UA) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(U),MAX(U)) ???
JG TRIGU9 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUCLAGE DU TORE...
LYI NEXIST < ET BIEN, LE TRIANGLE (A,B,C) SEMBLE
< "NORMAL" :
< ABS(UU-UU)<PERIOD(U)/2, OU "UU" REPRE-
< SENTE 'UA', 'UB' ET 'UC'...
TRIGU9: EQU $
PLR A,B,X
FLD &AVRUAS < UA,
BSR APERIU
FMP DBDC < DB*DC*UA,
BSR ASFWOR < ET SAVE...
FLD &AVRUBS < UB,
BSR APERIU
FMP DCDA < DC*DA*UB,
BSR APFWOR < DB*DC*UA+DC*DA*UB,
FLD &AVRUCS < UC,
BSR APERIU
FMP DADB < DA*DB*UC,
BSR APFWOR < DB*DC*UA+DC*DA*UB+DA*DB*UC,
FDV DADBDC < ET DIVISION PAR (DB*DC+DC*DA+DA*DB),
BSR ATSFLO
BSR APSEGU < POSITIONNEMENT DANS LA PERIODE DE 'U'...
#/FST# VARUC < UC <-- UABC=(DB*DC*UA+DC*DA*UB+DA*DB*UC)/
< (DB*DC+DC*DA+DA*DB)...
PSR A,B,X
LXI XPERV < (X)=INDEX DE LA PERIOD(V).
LYI EXIST < (Y)=INDICATEUR :
< ='EXIST' : (A,B,C) EST SUR LE REBOU-
< CLAGE DU TORE,
< ='NEXIST' : (A,B,C) EST "NORMAL"...
FLD &AVRVAS < VA,
FSB &AVRVBS < VA-VB,
BSR AFABS < ABS(VA-VB),
FDV F05 < 2*ABS(VA-VB), ET CECI AFIN DE COMPARER
< ABS(VA-VB) A LA PERIOD(V)...
FCAM &ALTORE < ALORS, (VA-VB) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(V),MAX(V)) ???
JG TRIGV9 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUCLAGE DU TORE...
FLD &AVRVBS < VB,
FSB &AVRVCS < VB-VC,
BSR AFABS < ABS(VB-VC),
FDV F05 < 2*ABS(VB-VC), ET CECI AFIN DE COMPARER
< ABS(VB-VC) A LA PERIOD(V)...
FCAM &ALTORE < ALORS, (VB-VC) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(V),MAX(V)) ???
JG TRIGV9 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUBLAGE DU TORE...
FLD &AVRVCS < VC,
FSB &AVRVAS < VC-VA,
BSR AFABS < ABS(VC-VA),
FDV F05 < 2*ABS(VC-VA), ET CECI AFIN DE COMPARER
< ABS(VC-VA) A LA PERIOD(V)...
FCAM &ALTORE < ALORS, (VC-VA) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(V),MAX(V)) ???
JG TRIGV9 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUCLAGE DU TORE...
LYI NEXIST < ET BIEN, LE TRIANGLE (A,B,C) SEMBLE
< "NORMAL" :
< ABS(VV-VV)<PERIOD(V)/2, OU "VV" REPRE-
< SENTE 'VA', 'VB' ET 'VC'...
TRIGV9: EQU $
PLR A,B,X
FLD &AVRVAS < VA,
BSR APERIV
FMP DBDC < DB*DC*VA,
BSR ASFWOR < ET SAVE...
FLD &AVRVBS < VB,
BSR APERIV
FMP DCDA < DC*DA*VB,
BSR APFWOR < DB*DC*VA+DC*DA*VB,
FLD &AVRVCS < VC,
BSR APERIV
FMP DADB < DA*DB*VC,
BSR APFWOR < DB*DC*VA+DC*DA*VB+DA*DB*VC,
FDV DADBDC < ET DIVISION PAR (DB*DC+DC*DA+DA*DB),
BSR ATSFLO
BSR APSEGV < POSITIONNEMENT DANS LA PERIODE DE 'V'...
#/FST# VARVC < VC <-- VABC=(DB*DC*VA+DC*DA*VB+DA*DB*VC)/
< (DB*DC+DC*DA+DA*DB)...
<
< GENERATION DE LA BOULE MINIMALE
< ASSOCIEE A LA FACETTE "EXTERNE" :
<
BSR ASPHER
<
< GENERATION ET TRACE DE LA FACETTE :
<
NUFACE:: VAL NUFACI+I < NUMERO DE LA PREMIERE FACETTE "EXTERNE".
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ ISGNFE < GENERE-T'ON LES FACETTES "EXTERNES" ???
JE E202 < NON...
LAI NUFACE
BSR ASP1D < ENVOI DE LA PREMIERE FACETTE "EXTERNE".
E202: EQU $
IF XOPT01-EXIST,XOPT1,,XOPT1
BSR ASP1E < ET TRACE GRAPHIQUE...
XOPT1: VAL ENDIF
<
<
< F A C E T T E ( M A B , B , M A B C ) :
<
<
<
< GENERATION DES 3 SOMMETS :
<
LRM A,B
WORD CAB3D
WORD CA3D
BSR AMOVE3 < PREMIER SOMMET <-- 'MAB'.
LRM A,B
WORD CB3DS
WORD CB3D
BSR AMOVE3 < DEUXIEME SOMMET <-- 'B'.
< (TROISIEME SOMMET INCHANGE : 'MABC')
<
< GENERATION DES NORMALES
< A LA SURFACE AUX 3 SOMMETS :
<
LRM A,B
WORD NX3D
WORD NA3D
BSR AMOVE3 < LA NORMALE EN 'MAB' EST INDEFINIE...
LRM A,B
WORD NB3DS
WORD NB3D
BSR AMOVE3 < VECTEUR NORMAL EN 'B'.
< (NORMALE EN 'MABC' TOUJOURS INDEFINIE)
<
< EQUATION DU PLAN DE LA FACETTE :
<
LRM A,B
WORD NB3DS
WORD PLAN3D
BSR AMOVE3 < C'EST LE PLAN TANGENT EN 'B'.
LRM A,B
WORD NB3DS < (A)=ADRESSE DE (XNBS,YNBS,ZNBS),
WORD CB3DS < (B)=ADRESSE DE (FXSBS,FYSBS,FZSBS).
BSR APRSCA < XN*XB+YN*YB+ZN*ZB,
BSR AFNEG < -XN*XB-YN*YB-ZN*ZB,
#/FST# PLAND < SOIT LE COEFFICIENT 'D' DU PLAN DE LA
< FACETTE...
<
< IDENTIFICATEURS DES SOMMETS
< DE LA FACETTE COURANTE :
<
LA IDENTX
LB &AIDNBS
STA IDENTA < SOMMET 'MAB',
STB IDENTB < SOMMET 'B',
< (IDENTIFICATEUR DE 'MABC' INCHANGE)
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'MAB' :
<
LAI XSEGAB
BSR ASEGMU < POSITION DU SEGMENT (A,B) --> 'Y'...
FLD &AVRUBS < UB,
BSR APERIU
FMP DAMAB < D(A,MAB)*UB,
BSR ASFWOR < ET SAVE...
FLD &AVRUAS < UA,
BSR APERIU
FMP DMABB < D(MAB,B)*UA,
BSR APFWOR < D(A,MAB)*UB+D(MAB,B)*UA,
FDV DAMABB
BSR ATSFLO
BSR APSEGU < POSITIONNEMENT DANS LA PERIODE DE 'U'...
#/FST# VARUA < UA <-- UAB=(D(A,MAB)*UB+D(MAB,B)*UA))/
< (D(A,MAB)+D(MAB,B)).
LAI XSEGAB
BSR ASEGMV < POSITION DU SEGMENT (A,B) --> 'Y'...
FLD &AVRVBS < VB,
BSR APERIV
FMP DAMAB < D(A,MAB)*VB,
BSR ASFWOR < ET SAVE...
FLD &AVRVAS < VA,
BSR APERIV
FMP DMABB < D(MAB,B)*VA,
BSR APFWOR < D(A,MAB)*VB+D(MAB,B)*VA,
FDV DAMABB
BSR ATSFLO
BSR APSEGV < POSITIONNEMENT DANS LA PERIODE DE 'V'...
#/FST# VARVA < VA <-- VAB=(D(A,MAB)*VB+D(MAB,B)*VA))/
< (D(A,MAB)+D(MAB,B)).
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'B' :
<
FLD &AVRUBS
#/FST# VARUB < UB <-- UB,
FLD &AVRVBS
#/FST# VARVB < VB <-- VB.
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'MABC' :
<
< ELLES SONT INCHANGEES :
< UABC=(DB*DC*UA+DC*DA*UB+DA*DB*UC)/
< (DB*DC+DC*DA+DA*DB)...
< VABC=(DB*DC*VA+DC*DA*VB+DA*DB*VC)/
< (DB*DC+DC*DA+DA*DB)...
<
< GENERATION DE LA BOULE MINIMALE
< ASSOCIEE A LA FACETTE "EXTERNE" :
<
BSR ASPHER
<
< GENERATION ET TRACE DE LA FACETTE :
<
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ ISGNFE < GENERE-T'ON LES FACETTES "EXTERNES" ???
JE E203 < NON...
LAI NUFACE+I
BSR ASP1D < ENVOI DE LA DEUXIEME FACETTE "EXTERNE".
E203: EQU $
IF XOPT01-EXIST,XOPT1,,XOPT1
BSR ASP1E < ET TRACE GRAPHIQUE...
XOPT1: VAL ENDIF
<
<
< F A C E T T E ( B , M B C , M A B C ) :
<
<
<
< GENERATION DES 3 SOMMETS :
<
LRM A,B
WORD CB3DS
WORD CA3D
BSR AMOVE3 < PREMIER SOMMET <-- 'B'.
LRM A,B
WORD CBC3D
WORD CB3D
BSR AMOVE3 < DEUXIEME SOMMET <-- 'MBC'.
< (TROISIEME SOMMET INCHANGE : 'MABC')
<
< GENERATION DES NORMALES
< A LA SURFACE AUX 3 SOMMETS :
<
LRM A,B
WORD NB3DS
WORD NA3D
BSR AMOVE3 < VECTEUR NORMAL EN 'B'.
LRM A,B
WORD NX3D
WORD NB3D
BSR AMOVE3 < LA NORMALE EN 'MBC' EST INDEFINIE...
< (NORMALE EN 'MABC' TOUJOURS INDEFINIE)
<
< EQUATION DU PLAN DE LA FACETTE :
<
< C'EST LE PLAN TANGENT EN 'B'.
<
< IDENTIFICATEURS DES SOMMETS
< DE LA FACETTE COURANTE :
<
LA IDENTX
LB &AIDNBS
STB IDENTA < SOMMET 'B',
STA IDENTB < SOMMET 'MBC',
< (IDENTIFICATEUR DE 'MABC' INCHANGE)
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'B' :
<
DBMBC: EQU DAMAB < D(B,MBC),
DMBCC: EQU DMABB < D(MBC,C),
DBMBCC: EQU DAMABB < D(B,MBC)+D(MBC,C).
FLD &AVRUBS
#/FST# VARUA < UA <-- UB,
FLD &AVRVBS
#/FST# VARVA < VA <-- VB.
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'MBC' :
<
FLD &AFXSBS < XB,
FSB FXSBC < XB-XBC,
#/FST# FMODUL
FMP FMODUL < (XB-XBC)**2.
BSR ASFWOR < ET SAVE...
FLD &AFYSBS < YB,
FSB FYSBC < YB-YBC,
#/FST# FMODUL
FMP FMODUL < (YB-YBC)**2,
BSR APFWOR < (XB-XBC)**2+(YB-YBC)**2.
FLD &AFZSBS < ZB,
FSB FZSBC < ZB-ZBC,
#/FST# FMODUL
FMP FMODUL < (ZB-ZBC)**2,
BSR APFWOR < (XB-XBC)**2+(YB-YBC)**2+(ZB-ZBC)**2,
BSR ARAC < CALCUL DE LA DISTANCE DE 'B' A 'MBC',
BSR ATSFLO
#/FST# DBMBC < DBMBC=D(B,MBC).
#/FLD# FXSBC < XBC,
FSB &AFXSCS < XBC-XC,
#/FST# FMODUL
FMP FMODUL < (XBC-XC)**2.
BSR ASFWOR < ET SAVE...
#/FLD# FYSBC < YBC,
FSB &AFYSCS < YBC-YC,
#/FST# FMODUL
FMP FMODUL < (YBC-YC)**2,
BSR APFWOR < (XBC-XC)**2+(YBC-YC)**2.
#/FLD# FZSBC < ZBC,
FSB &AFZSCS < ZBC-ZC,
#/FST# FMODUL
FMP FMODUL < (ZBC-ZC)**2,
BSR APFWOR < (XBC-XC)**2+(YBC-YC)**2+(ZBC-ZC)**2,
BSR ARAC < CALCUL DE LA DISTANCE DE 'MBC' A 'C',
BSR ATSFLO
#/FST# DMBCC < DMBCC=D(MBC,C).
FAD DBMBC
#/FST# DBMBCC < DBMBCC=D(B,MBC)+D(MBC,C)...
LAI XSEGBC
BSR ASEGMU < POSITION DU SEGMENT (B,C) --> 'Y'...
FLD &AVRUCS < UC,
BSR APERIU
FMP DBMBC < D(B,MBC)*UC,
BSR ASFWOR < ET SAVE...
FLD &AVRUBS < UB,
BSR APERIU
FMP DMBCC < D(MBC,C)*UB,
BSR APFWOR < D(B,MBC)*UC+D(MBC,C)*UB,
FDV DBMBCC
BSR ATSFLO
BSR APSEGU < POSITIONNEMENT SUR LA PERIODE DE 'U'...
#/FST# VARUB < UB <-- UBC=(D(B,MBC)*UC+D(MBC,C)*UB))/
< (D(B,MBC)+D(MBC,C)).
LAI XSEGBC
BSR ASEGMV < POSITION DU SEGMENT (B,C) --> 'Y'...
FLD &AVRVCS < VC,
BSR APERIV
FMP DBMBC < D(B,MBC)*VC,
BSR ASFWOR < ET SAVE...
FLD &AVRVBS < VB,
BSR APERIV
FMP DMBCC < D(MBC,C)*VB,
BSR APFWOR < D(B,MBC)*VC+D(MBC,C)*VB,
FDV DBMBCC
BSR ATSFLO
BSR APSEGV < POSITIONNEMENT SUR LA PERIODE DE 'V'...
#/FST# VARVB < VB <-- VBC=(D(B,MBC)*VC+D(MBC,C)*VB))/
< (D(B,MBC)+D(MBC,C)).
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'MABC' :
<
< ELLES SONT INCHANGEES :
< UABC=(DB*DC*UA+DC*DA*UB+DA*DB*UC)/
< (DB*DC+DC*DA+DA*DB)...
< VABC=(DB*DC*VA+DC*DA*VB+DA*DB*VC)/
< (DB*DC+DC*DA+DA*DB)...
<
< GENERATION DE LA BOULE MINIMALE
< ASSOCIEE A LA FACETTE "EXTERNE" :
<
BSR ASPHER
<
< GENERATION ET TRACE DE LA FACETTE :
<
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ ISGNFE < GENERE-T'ON LES FACETTES "EXTERNES" ???
JE E204 < NON...
LAI NUFACE+I+I
BSR ASP1D < ENVOI DE LA TROISIEME FACETTE "EXTERNE".
E204: EQU $
IF XOPT01-EXIST,XOPT1,,XOPT1
BSR ASP1E < ET TRACE GRAPHIQUE...
XOPT1: VAL ENDIF
<
<
< F A C E T T E ( M B C , C , M A B C ) :
<
<
<
< GENERATION DES 3 SOMMETS :
<
LRM A,B
WORD CBC3D
WORD CA3D
BSR AMOVE3 < PREMIER SOMMET <-- 'MBC'.
LRM A,B
WORD CC3DS
WORD CB3D
BSR AMOVE3 < DEUXIEME SOMMET <-- 'C'.
< (TROISIEME SOMMET INCHANGE : 'MABC')
<
< GENERATION DES NORMALES
< A LA SURFACE AUX 3 SOMMETS :
<
LRM A,B
WORD NX3D
WORD NA3D
BSR AMOVE3 < LA NORMALE EN 'MBC' EST INDEFINIE...
LRM A,B
WORD NC3DS
WORD NB3D
BSR AMOVE3 < VECTEUR NORMAL EN 'C'.
< (NORMALE EN 'MABC' TOUJOURS INDEFINIE)
<
< EQUATION DU PLAN DE LA FACETTE :
<
LRM A,B
WORD NC3DS
WORD PLAN3D
BSR AMOVE3 < C'EST LE PLAN TANGENT EN 'C'.
LRM A,B
WORD NC3DS < (A)=ADRESSE DE (XNCS,YNCS,ZNCS),
WORD CC3DS < (B)=ADRESSE DE (FXSCS,FYSCS,FZSCS).
BSR APRSCA < XN*XC+YN*YC+ZN*ZC,
BSR AFNEG < -XN*XC-YN*YC-ZN*ZC,
#/FST# PLAND < SOIT LE COEFFICIENT 'D' DU PLAN DE LA
< FACETTE...
<
< IDENTIFICATEURS DES SOMMETS
< DE LA FACETTE COURANTE :
<
LA IDENTX
LB &AIDNCS
STA IDENTA < SOMMET 'MBC',
STB IDENTB < SOMMET 'C',
< (IDENTIFICATEUR DE 'MABC' INCHANGE)
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'MBC' :
<
LAI XSEGBC
BSR ASEGMU < POSITION DU SEGMENT (B,C) --> 'Y'...
FLD &AVRUCS < UC,
BSR APERIU
FMP DBMBC < D(B,MBC)*UC,
BSR ASFWOR < ET SAVE...
FLD &AVRUBS < UB,
BSR APERIU
FMP DMBCC < D(MBC,C)*UB,
BSR APFWOR < D(B,MBC)*UC+D(MBC,C)*UB,
FDV DBMBCC
BSR ATSFLO
BSR APSEGU < POSITIONNEMENT SUR LA PERIODE DE 'U'...
#/FST# VARUA < UA <-- UBC=(D(B,MBC)*UC+D(MBC,C)*UB))/
< (D(B,MBC)+D(MBC,C)).
LAI XSEGBC
BSR ASEGMV < POSITION DU SEGMENT (B,C) --> 'Y'...
FLD &AVRVCS < VC,
BSR APERIV
FMP DBMBC < D(B,MBC)*VC,
BSR ASFWOR < ET SAVE...
FLD &AVRVBS < VB,
BSR APERIV
FMP DMBCC < D(MBC,C)*VB,
BSR APFWOR < D(B,MBC)*VC+D(MBC,C)*VB,
FDV DBMBCC
BSR ATSFLO
BSR APSEGV < POSITIONNEMENT SUR LA PERIODE DE 'V'...
#/FST# VARVA < VA <-- VBC=(D(B,MBC)*VC+D(MBC,C)*VB))/
< (D(B,MBC)+D(MBC,C)).
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'C' :
<
FLD &AVRUCS
#/FST# VARUB < UB <-- UC,
FLD &AVRVCS
#/FST# VARVB < VB <-- VC.
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'MABC' :
<
< ELLES SONT INCHANGEES :
< UABC=(DB*DC*UA+DC*DA*UB+DA*DB*UC)/
< (DB*DC+DC*DA+DA*DB)...
< VABC=(DB*DC*VA+DC*DA*VB+DA*DB*VC)/
< (DB*DC+DC*DA+DA*DB)...
<
< GENERATION DE LA BOULE MINIMALE
< ASSOCIEE A LA FACETTE "EXTERNE" :
<
BSR ASPHER
<
< GENERATION ET TRACE DE LA FACETTE :
<
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ ISGNFE < GENERE-T'ON LES FACETTES "EXTERNES" ???
JE E205 < NON...
LAI NUFACE+I+I+I
BSR ASP1D < ENVOI DE LA QUATRIEME FACETTE "EXTERNE".
E205: EQU $
IF XOPT01-EXIST,XOPT1,,XOPT1
BSR ASP1E < ET TRACE GRAPHIQUE...
XOPT1: VAL ENDIF
<
<
< F A C E T T E ( C , M C A , M A B C ) :
<
<
<
< GENERATION DES 3 SOMMETS :
<
LRM A,B
WORD CC3DS
WORD CA3D
BSR AMOVE3 < PREMIER SOMMET <-- 'C'.
LRM A,B
WORD CCA3D
WORD CB3D
BSR AMOVE3 < DEUXIEME SOMMET <-- 'MCA'.
< (TROISIEME SOMMET INCHANGE : 'MABC')
<
< GENERATION DES NORMALES
< A LA SURFACE AUX 3 SOMMETS :
<
LRM A,B
WORD NC3DS
WORD NA3D
BSR AMOVE3 < VECTEUR NORMAL EN 'C'.
LRM A,B
WORD NX3D
WORD NB3D
BSR AMOVE3 < LA NORMALE EN 'MCA' EST INDEFINIE...
< (NORMALE EN 'MABC' TOUJOURS INDEFINIE)
<
< EQUATION DU PLAN DE LA FACETTE :
<
< C'EST LE PLAN TANGENT EN 'C'.
<
< IDENTIFICATEURS DES SOMMETS
< DE LA FACETTE COURANTE :
<
LA IDENTX
LB &AIDNCS
STB IDENTA < SOMMET 'C',
STA IDENTB < SOMMET 'MCA',
< (IDENTIFICATEUR DE 'MABC' INCHANGE)
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'C' :
<
DCMCA: EQU DAMAB < D(C,MCA),
DMCAA: EQU DMABB < D(MCA,A),
DCMCAA: EQU DAMABB < D(C,MCA)+D(MCA,A).
FLD &AVRUCS
#/FST# VARUA < UA <-- UC,
FLD &AVRVCS
#/FST# VARVA < VA <-- VC.
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'MCA' :
<
FLD &AFXSCS < XC,
FSB FXSCA < XC-XCA,
#/FST# FMODUL
FMP FMODUL < (XC-XCA)**2.
BSR ASFWOR < ET SAVE...
FLD &AFYSCS < YC,
FSB FYSCA < YC-YCA,
#/FST# FMODUL
FMP FMODUL < (YC-YCA)**2,
BSR APFWOR < (XC-XCA)**2+(YC-YCA)**2.
FLD &AFZSCS < ZC,
FSB FZSCA < ZC-ZCA,
#/FST# FMODUL
FMP FMODUL < (ZC-ZCA)**2,
BSR APFWOR < (XC-XCA)**2+(YC-YCA)**2+(ZC-ZCA)**2,
BSR ARAC < CALCUL DE LA DISTANCE DE 'C' A 'MCA',
BSR ATSFLO
#/FST# DCMCA < DCMCA=D(C,MCA).
#/FLD# FXSCA < XCA,
FSB &AFXSAS < XCA-XA,
#/FST# FMODUL
FMP FMODUL < (XCA-XA)**2.
BSR ASFWOR < ET SAVE...
#/FLD# FYSCA < YCA,
FSB &AFYSAS < YCA-YA,
#/FST# FMODUL
FMP FMODUL < (YCA-YA)**2,
BSR APFWOR < (XCA-XA)**2+(YCA-YA)**2.
#/FLD# FZSCA < ZCA,
FSB &AFZSAS < ZCA-ZA,
#/FST# FMODUL
FMP FMODUL < (ZCA-ZA)**2,
BSR APFWOR < (XCA-XA)**2+(YCA-YA)**2+(ZCA-ZA)**2,
BSR ARAC < CALCUL DE LA DISTANCE DE 'MCA' A 'A',
BSR ATSFLO
#/FST# DMCAA < DMCAA=D(MCA,A).
FAD DCMCA
#/FST# DCMCAA < DCMCAA=D(C,MCA)+D(MCA,A)...
LAI XSEGCA
BSR ASEGMU < POSITION DU SEGMENT (C,A) --> 'Y'...
FLD &AVRUAS < UA,
BSR APERIU
FMP DCMCA < D(C,MCA)*UA,
BSR ASFWOR < ET SAVE...
FLD &AVRUCS < UC,
BSR APERIU
FMP DMCAA < D(MCA,A)*UC,
BSR APFWOR < D(C,MCA)*UA+D(MCA,A)*UC,
FDV DCMCAA
BSR ATSFLO
BSR APSEGU < POSITIONNEMENT SUR LA PERIODE DE 'U'...
#/FST# VARUB < UB <-- UCA=(D(C,MCA)*UA+D(MCA,A)*UC))/
< (D(C,MCA)+D(MCA,A)).
LAI XSEGCA
BSR ASEGMV < POSITION DU SEGMENT (C,A) --> 'Y'...
FLD &AVRVAS < VA,
BSR APERIV
FMP DCMCA < D(C,MCA)*VA,
BSR ASFWOR < ET SAVE...
FLD &AVRVCS < VC,
BSR APERIV
FMP DMCAA < D(MCA,A)*VC,
BSR APFWOR < D(C,MCA)*VA+D(MCA,A)*VC,
FDV DCMCAA
BSR ATSFLO
BSR APSEGV < POSITIONNEMENT SUR LA PERIODE DE 'V'...
#/FST# VARVB < VB <-- VCA=(D(C,MCA)*VA+D(MCA,A)*VC))/
< (D(C,MCA)+D(MCA,A)).
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'MABC' :
<
< ELLES SONT INCHANGEES :
< UABC=(DB*DC*UA+DC*DA*UB+DA*DB*UC)/
< (DB*DC+DC*DA+DA*DB)...
< VABC=(DB*DC*VA+DC*DA*VB+DA*DB*VC)/
< (DB*DC+DC*DA+DA*DB)...
<
< GENERATION DE LA BOULE MINIMALE
< ASSOCIEE A LA FACETTE "EXTERNE" :
<
BSR ASPHER
<
< GENERATION ET TRACE DE LA FACETTE :
<
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ ISGNFE < GENERE-T'ON LES FACETTES "EXTERNES" ???
JE E206 < NON...
LAI NUFACE+I+I+I+I
BSR ASP1D < ENVOI DE LA CINQUIEME FACETTE "EXTERNE".
E206: EQU $
IF XOPT01-EXIST,XOPT1,,XOPT1
BSR ASP1E < ET TRACE GRAPHIQUE...
XOPT1: VAL ENDIF
<
<
< F A C E T T E ( M C A , A , M A B C ) :
<
<
<
< GENERATION DES 3 SOMMETS :
<
LRM A,B
WORD CCA3D
WORD CA3D
BSR AMOVE3 < PREMIER SOMMET <-- 'MCA'.
LRM A,B
WORD CA3DS
WORD CB3D
BSR AMOVE3 < DEUXIEME SOMMET <-- 'A'.
< (TROISIEME SOMMET INCHANGE : 'MABC')
<
< GENERATION DES NORMALES
< A LA SURFACE AUX 3 SOMMETS :
<
LRM A,B
WORD NX3D
WORD NA3D
BSR AMOVE3 < LA NORMALE EN 'MCA' EST INDEFINIE...
LRM A,B
WORD NA3DS
WORD NB3D
BSR AMOVE3 < VECTEUR NORMAL EN 'A'.
< (NORMALE EN 'MABC' TOUJOURS INDEFINIE)
<
< EQUATION DU PLAN DE LA FACETTE :
<
LRM A,B
WORD NA3DS
WORD PLAN3D
BSR AMOVE3 < C'EST LE PLAN TANGENT EN 'A'.
LRM A,B
WORD NA3DS < (A)=ADRESSE DE (XNAS,YNAS,ZNAS),
WORD CA3DS < (B)=ADRESSE DE (FXSAS,FYSAS,FZSAS).
BSR APRSCA < XN*XA+YN*YA+ZN*ZA,
BSR AFNEG < -XN*XA-YN*YA-ZN*ZA,
#/FST# PLAND < SOIT LE COEFFICIENT 'D' DU PLAN DE LA
< FACETTE...
<
< IDENTIFICATEURS DES SOMMETS
< DE LA FACETTE COURANTE :
<
LA IDENTX
LB &AIDNAS
STA IDENTA < SOMMET 'MCA',
STB IDENTB < SOMMET 'A',
< (IDENTIFICATEUR DE 'MABC' INCHANGE)
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'MCA' :
<
LAI XSEGCA
BSR ASEGMU < POSITION DU SEGMENT (C,A) --> 'Y'...
FLD &AVRUAS < UA,
BSR APERIU
FMP DCMCA < D(C,MCA)*UA,
BSR ASFWOR < ET SAVE...
FLD &AVRUCS < UC,
BSR APERIU
FMP DMCAA < D(MCA,A)*UC,
BSR APFWOR < D(C,MCA)*UA+D(MCA,A)*UC,
FDV DCMCAA
BSR ATSFLO
BSR APSEGU < POSITIONNEMENT SUR LA PERIODE DE 'U'...
#/FST# VARUA < UA <-- UAB=(D(C,MCA)*UA+D(MCA,A)*UC))/
< (D(C,MCA)+D(MCA,A)).
LAI XSEGCA
BSR ASEGMV < POSITION DU SEGMENT (C,A) --> 'Y'...
FLD &AVRVAS < VA,
BSR APERIV
FMP DCMCA < D(C,MCA)*VA,
BSR ASFWOR < ET SAVE...
FLD &AVRVCS < VC,
BSR APERIV
FMP DMCAA < D(MCA,A)*VC,
BSR APFWOR < D(C,MCA)*VA+D(MCA,A)*VC,
FDV DCMCAA
BSR ATSFLO
BSR APSEGV < POSITIONNEMENT SUR LA PERIODE DE 'V'...
#/FST# VARVA < VA <-- VAB=(D(C,MCA)*VA+D(MCA,A)*VC))/
< (D(C,MCA)+D(MCA,A)).
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'A' :
<
FLD &AVRUAS
#/FST# VARUB < UB <-- UA,
FLD &AVRVAS
#/FST# VARVB < VB <-- VA.
<
< COORDONNEES CURVILIGNES
< AU SOMMET 'MABC' :
<
< ELLES SONT INCHANGEES :
< UABC=(DB*DC*UA+DC*DA*UB+DA*DB*UC)/
< (DB*DC+DC*DA+DA*DB)...
< VABC=(DB*DC*VA+DC*DA*VB+DA*DB*VC)/
< (DB*DC+DC*DA+DA*DB)...
<
< GENERATION DE LA BOULE MINIMALE
< ASSOCIEE A LA FACETTE "EXTERNE" :
<
BSR ASPHER
<
< GENERATION ET TRACE DE LA FACETTE :
<
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ ISGNFE < GENERE-T'ON LES FACETTES "EXTERNES" ???
JE E207 < NON...
LAI NUFACE+I+I+I+I+I
BSR ASP1D < ENVOI DE LA SIXIEME FACETTE "EXTERNE".
E207: EQU $
IF XOPT01-EXIST,XOPT1,,XOPT1
BSR ASP1E < ET TRACE GRAPHIQUE...
XOPT1: VAL ENDIF
<
< ET RETOUR :
<
PLR A,B,X,Y
RSR
PAGE
<
<
< E N V O I D ' U N E F A C E T T E A U ' S G N ' :
<
<
< FONCTION :
< CE MODULE ENVOIE UNE FACETTE
< "INTERNE" OU "EXTERNE" AU 'SGN'
< APRES AVOIR COMPLETE SON NOM, ET
< INSERE SON TYPE "INTERNE"/"EXTERNE"...
<
<
< ARGUMENT :
< (A)=NUMERO DE FACETTE ("0" POUR "INTERNE", ET
< SUIVANTS POUR LES FACETTES "EXTERNES").
<
<
SP1D: EQU $
<
< INITIALISATIONS :
<
PSR A,X
STBY NFACE2 < MISE EN PLACE DU NUMERO DE LA FACETTE
< DANS SON NOM...
<
< "TYPE" DE LA FACETTE :
<
IF NUFACI-NUFACE,XEIF%,,XEIF%
IF ATTENTION : ON NE PEUT DISCRIMINER LES
IF FACETTES "INTERNES" DES FACETTES "EXTERNES" !!!
XEIF%: VAL ENDIF
CPI NUFACI < EST-CE UNE FACETTE "INTERNE" ???
LAI XITYPE < OUI A PRIORI...
JE SP1D2 < OUI : (A)=TYPE "INTERNE"...
LAI XETYPE < NON : (A)=TYPE "EXTERNE"...
SP1D2: EQU $
STA FTYPE < ET MEMORISATION DU TYPE DE LA FACETTE...
<
< CALCUL DE L'OCTANT DU
< VECTEUR NORMAL AU PLAN :
<
LAI K < INITIALISATION DE 'FOCTA',
FCMZ PLANA < TEST DE 'XN' ???
JGE SP1D3 < POSITIF OU NUL...
SBT NBITMO-B < NEGATIF : ON LE MARQUE...
SP1D3: EQU $
SLLS S < ET CADRAGE...
FCMZ PLANB < TEST DE 'YN' ???
JGE SP1D4 < POSITIF OU NUL...
SBT NBITMO-B < NEGATIF : ON LE MARQUE...
SP1D4: EQU $
SLLS S < ET CADRAGE...
FCMZ PLANC < TEST DE 'ZN' ???
JGE SP1D5 < POSITIF OU NUL...
SBT NBITMO-B < NEGATIF : ON LE MARQUE...
SP1D5: EQU $
XWOR%1: VAL DFLOT=K
IF BIT>XWOR%1-DFLOT,,XEIF%,
IF ATTENTION : 'DFLOT' N'EST PAS UNE PUISSANCE DE 2 !!!
XEIF%: VAL ENDIF
SLLS XWOR%1 < ET CONVERSION EN UN INDEX FLOTTANT,
STA FOCTA < QUE L'ON MEMORISE...
<
< ENVOI AU 'SGN' :
<
LRM A
WORD DEMDFA
SVC < DESTRUCTION PRELIMINAIRE...
LRM A
WORD DEMSFA
SVC < ET ENVOI DE LA FACETTE COURANTE AU 'SGN',
JE SP1D1 < OK...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
SP1D1: EQU $
<
< ET RETOUR :
<
PLR A,X
RSR
PAGE
IF XOPT01-EXIST,XOPT1,,XOPT1
<
<
< T R A C E D ' U N E F A C E T T E " E X T E R N E " :
<
<
< FONCTION :
< CE MODULE PREND LA FACETTE
< "EXTERNE" (A,B,C) COURANTE,
< LA PROJETTE ET LA TRACE SUR
< L'ECRAN.
<
<
SP1E: EQU $
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IWGFE < TRACE-T'ON LES FACETTES "EXTERNES" ???
JE E208 < NON...
<
< INITIALISATIONS :
<
PSR A,B,X
LAD DEMOG
SVC < DECHAINAGE DE LA FACETTE COURANTE...
<
< PREMIER SOMMET :
<
LRM A,B
WORD CA3D
WORD CS3D
BSR AMOVE3 < RECUPERATION DU SOMMET 'A',
BSR APROJ < ET PROJECTION,
BSR ASP4 < ET MISE EN PLACE DE L'ORIGINE DU TRACE...
<
< DEUXIEME SOMMET :
<
LRM A,B
WORD CB3D
WORD CS3D
BSR AMOVE3 < RECUPERATION DU SOMMET 'B',
BSR APROJ < ET PROJECTION,
BSR ASP2B < PUIS TRACE DU COTE 'AB', ET CHAINAGE...
<
< TROISIEME SOMMET :
<
LRM A,B
WORD CC3D
WORD CS3D
BSR AMOVE3 < RECUPERATION DU SOMMET 'C',
BSR APROJ < ET PROJECTION,
BSR ASP2B < PUIS TRACE DU COTE 'BC', ET CHAINAGE...
<
< RETOUR AU PREMIER SOMMET :
<
LRM A,B
WORD CA3D
WORD CS3D
BSR AMOVE3 < RECUPERATION DU SOMMET 'A',
BSR APROJ < ET PROJECTION,
BSR ASP2B < PUIS TRACE DU COTE 'CA'...
<
< ET RETOUR :
<
PLR A,B,X
E208: EQU $
RSR
XOPT1: VAL ENDIF
PAGE
<
<
< D E T E R M I N A T I O N D E L A P L U S
< P E T I T E S P H E R E E N V E L O P P A N T
< L A F A C E T T E C O U R A N T E :
<
<
< FONCTION :
< SI L'ON ENVELOPPE CHAQUE FACETTE
< D'UNE SPHERE MINIMALE OBTENUE A
< PARTIR DU CERCLE CIRCONSCRIT A
< LA FACETTE 'ABC', IL EST POSSIBLE,
< AVANT DE DETERMINER L'INTERSECTION
< D'UNE DROITE 'D' AVEC CETTE FACETTE
< 'ABC', DE REGARDER SI L'EQUATION DU
< SECOND DEGRE DONNANT L'INTERSECTION
< DE LA DROITE 'D' ET DE LA SPHERE
< MINIMALE A DES SOLUTIONS REELLES
< PAR EXAMEN DE SON DISCRIMINANT...
<
< EQUATION DE LA SPHERE :
<
< (X-XO)**2+(Y-YO)**2+(Z-ZO)**2=R**2,
<
< LES 3 POINTS 'A', 'B' ET 'C' LA VERIFIENT :
<
< (1) (XA-XO)**2+(YA-YO)**2+(ZA-ZO)**2=R**2,
< (2) (XB-XO)**2+(YB-YO)**2+(ZB-ZO)**2=R**2,
< (3) (XC-XO)**2+(YC-YO)**2+(ZC-ZO)**2=R**2,
<
< DE PLUS LE CENTRE 'O' DU CERCLE EST DANS LE PLAN 'ABC' :
<
< I XO-XA YO-YA ZO-ZA I
< (4) I XB-XA YB-YA ZB-ZA I = 0
< I XC-XA YC-YA ZC-ZA I
<
< POSONS :
< DA**2=XA**2+YA**2+ZA**2,
< DB**2=XB**2+YB**2+ZB**2,
< DC**2=XC**2+YC**2+ZC**2,
<
< ET :
<
< I YB-YA ZB-ZA I
< COX = +I I
< I YC-YA ZC-ZA I
<
< I XB-XA ZB-ZA I
< COY = -I I
< I XC-XA ZC-ZA I
<
< I XB-XA YB-YA I
< COZ = +I I
< I XC-XA YC-YA I
<
< PAR UNE SIMPLE MANIPULATION, ON A LE SYSTEME 3*3
< EN (XO,YO,ZO) :
<
< (1)-(2) (XB-XA)*XO+(YB-YA)*YO+(ZB-ZA)*ZO=(DB**2-DA**2)/2
< (1)-(3) (XC-XA)*XO+(YC-YA)*YO+(ZC-ZA)*ZO=(DC**2-DA**2)/2
< (4) COX*XO +COY*YO +COZ*ZO=COX*XA+COY*YA+COZ*ZA
<
< ENFIN, LE CARRE DU RAYON EST DONNE PAR (1), (2) OU (3)...
<
<
< RESULTAT :
< LE CENTRE (FXSO,FYSO,FZSO),
< AINSI QUE LE CARRE DU RAYON DE
< LA SPHERE CIRCONSCRITE MINIMALE
< SONT RANGES DANS LA FACETTE COU-
< RANTE.
<
<
SPHERE: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
<
< INITIALISATION DU MODULE
< DE RESOLUTION DES SYSTEMES
< LINEAIRES 3*3, INITIALI-
< SATION DES COEFFICIENTS :
<
LAD M11
STA AM11
LAD M12
STA AM12
LAD M13
STA AM13
LAD M21
STA AM21
LAD M22
STA AM22
LAD M23
STA AM23
LAD M31
STA AM31
LAD M32
STA AM32
LAD M33
STA AM33
<
< INITIALISATION DU MODULE
< DE RESOLUTION DES SYSTEMES
< LINEAIRES 3*3, INITIALI-
< SATION DES VARIABLES :
<
LAD FXSO
STA AVARX < PREMIERE VARIABLE : XO,
LAD FYSO
STA AVARY < DEUXIEME VARIABLE : YO,
LAD FZSO
STA AVARZ < TROISIEME VARIABLE : ZO.
<
< CALCUL DU VECTEUR LIGNE 'AB' :
<
#/FLD# FXSB < XB,
FSB FXSA < XB-XA,
#/FST# M11 < M11=XB-XA.
#/FLD# FYSB < YB,
FSB FYSA < YB-YA,
#/FST# M12 < M12=YB-YA.
#/FLD# FZSB < ZB,
FSB FZSA < ZB-ZA,
#/FST# M13 < M13=ZB-ZA.
<
< CALCUL DU VECTEUR LIGNE 'AC' :
<
#/FLD# FXSC < XC,
FSB FXSA < XC-XA,
#/FST# M21 < M21=XC-XA.
#/FLD# FYSC < YC,
FSB FYSA < YC-YA,
#/FST# M22 < M22=YC-YA.
#/FLD# FZSC < ZC,
FSB FZSA < ZC-ZA,
#/FST# M23 < M23=ZC-ZA.
<
< CALCUL DES 3 DISTANCES DES
< POINTS 'A', 'B' ET 'C' A
< L'ORIGINE DES COORDONNEES :
<
LRM A,B
WORD CA3D < (A)=VECTEUR ORIGINE --> 'A',
WORD CA3D < (B)=VECTEUR ORIGINE --> 'A',
BSR APRSCA < XA**2+YA**2+ZA**2,
#/FST# M34 < ET SAVE TEMPORAIRE DA**2...
LRM A,B
WORD CB3D < (A)=VECTEUR ORIGINE --> 'B',
WORD CB3D < (B)=VECTEUR ORIGINE --> 'B',
BSR APRSCA < XB**2+YB**2+ZB**2,
< SOIT DB**2,
FSB M34 < DB**2-DA**2,
FMP F05 < (DB**2-DA**2)/2,
#/FST# M14 < M14=(DB**2-DA**2)/2.
LRM A,B
WORD CC3D < (A)=VECTEUR ORIGINE --> 'C',
WORD CC3D < (B)=VECTEUR ORIGINE --> 'C',
BSR APRSCA < XC**2+YC**2+ZC**2,
< SOIT DC**2,
FSB M34 < DC**2-DA**2,
FMP F05 < (DC**2-DA**2)/2,
#/FST# M24 < M24=(DC**2-DA**2)/2.
<
< CALCUL DES COFACTEURS (M31,M32,M33) :
<
< M31=+(M12*M23-M13*M22),
< M32=-(M11*M23-M21*M13),
< M33=+(M11*M22-M21*M12).
<
#/FLD# M13 < ZB-ZA,
FMP M22 < (ZB-ZA)*(YC-YA),
BSR ASFWOR
#/FLD# M12 < YB-YA,
FMP M23 < (YB-YA)*(ZC-ZA),
FSB FWORK < (YB-YA)*(ZC-ZA)-(ZB-ZA)*(YC-YA),
#/FST# M31 < SOIT 'M31' OU 'COX'.
#/FLD# M11 < XB-XA,
FMP M23 < (XB-XA)*(ZC-ZA),
BSR ASFWOR
#/FLD# M13 < ZB-ZA,
FMP M21 < (ZB-ZA)*(XC-XA),
FSB FWORK < -((XB-XA)*(ZC-ZA)-(ZB-ZA)*(XC-XA)),
#/FST# M32 < SOIT 'M32' OU 'COY'.
#/FLD# M12 < YB-YA,
FMP M21 < (YB-YA)*(XC-XA),
BSR ASFWOR
#/FLD# M11 < XB-XA,
FMP M22 < (XB-XA)*(YC-YA),
FSB FWORK < (XB-XA)*(YC-YA)-(YB-YA)*(XC-XA),
#/FST# M33 < SOIT 'M33' OU 'COZ'.
<
< CALCUL DE 'M34' :
<
LRM A,B
WORD CA3D < (A)=VECTEUR ORIGINE --> 'A',
WORD M31 < (B)=LISTE DES COFACTEURS (M31,M32,M33),
IF M32-M31-DFLOT,,XEIF%,
IF ATTENTION : LE CALCUL DU PRODUIT SCALAIRE QUI VA
IF SUIVRE (ET PEUT-ETRE AILLEURS) VA MERDER !!!
XEIF%: VAL ENDIF
IF M33-M32-DFLOT,,XEIF%,
IF ATTENTION : LE CALCUL DU PRODUIT SCALAIRE QUI VA
IF SUIVRE (ET PEUT-ETRE AILLEURS) VA MERDER !!!
XEIF%: VAL ENDIF
BSR APRSCA < COX*XA+COY*YA+COZ*ZA,
#/FST# M34 < SOIT 'M34'...
<
< RESOLUTION DU SYSTEME
< 3*3 COURANT :
<
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ACRAMR < ON UTILISE LA METHODE DE CRAMER...
< CE QUI DONNE LE CENTRE (XO,YO,ZO) DE
< LA SPHERE CHERCHEE.
BSR ATSFLO
<
< CALCUL DU CARRE DU RAYON :
<
#/FLD# FXSA < XA,
FSB FXSO < (XA-XO),
#/FST# FRAYO
FMP FRAYO < (XA-XO)**2,
BSR ASFWOR < ET SAVE...
#/FLD# FYSA < YA,
FSB FYSO < (YA-YO),
#/FST# FRAYO
FMP FRAYO < (YA-YO)**2,
BSR APFWOR < (XA-XO)**2+(YA-YO)**2, ET SAVE...
#/FLD# FZSA < ZA,
FSB FZSO < (ZA-ZO),
#/FST# FRAYO
FMP FRAYO < (ZA-ZO)**2,
BSR APFWOR < (XA-XO)**2+(YA-YO)**2+(ZA-ZO)**2,
#/FST# FRAYO < CE QUI DONNE LE CARRE DU RAYON DE LA
< SPHERE CHERCHEE...
<
< ET RETOUR :
<
PLR A,B,X
RSR
XXXPRO: VAL YYYCRA < 'YYYCRA'.
CALL #SIP UTILITAIRES#
PAGE
<
<
< T R I D E T R O I S N O M B R E S :
<
<
< FONCTION :
< CE SOUS-PROGRAMME FAIT
< LE TRI DE TROIS NOMBRES
< ARGUMENTS.
<
<
< ARGUMENTS :
< (AMIN,AMIL,AMAX)=ADRESSES DES TROIS NOMBRES NON TRIES.
<
<
< RESULTATS :
< (AMIN,AMIL,AMAX)=ADRESSES DES TROIS NOMBRES TRIES.
<
<
SPTRI: EQU $
<
< DEFINITION DES ADRESSES
< ARGUMENTS/RESULTATS :
<
AMIN: EQU DA < ADRESSE DE MIN(NOMBRE1,NOMBRE2,NOMBRE3),
AMIL: EQU DB < ADRESSE DE MIL(NOMBRE1,NOMBRE2,NOMBRE3),
AMAX: EQU DC < ADRESSE DE MAX(NOMBRE1,NOMBRE2,NOMBRE3),
< AVEC : MIN <= MIL <= MAX...
<
< INITIALISATION :
<
PSR A,B
<
< TRI DES TROIS NOMBRES :
<
FLD &AMAX < TEST DE 'MAX' ET 'MIL' COURANTS :
FCAM &AMIL
JGE SPTRI1 < OK : MAX >= MIL...
LA AMAX < L'ORDRE EST MAUVAIS,
XM AMIL < ON PERMUTE
STA AMAX < 'MAX' ET 'MIL' COURANTS...
SPTRI1: EQU $
FLD &AMIL < TEST DE 'MIL' ET 'MIN' COURANTS :
FCAM &AMIN
JGE SPTRI2 < OK : MIL >= MIN...
LA AMIL < L'ORDRE EST MAUVAIS,
XM AMIN < ON PERMUTE
STA AMIL < 'MIL' ET 'MIN' COURANTS...
SPTRI2: EQU $
FLD &AMAX < TEST DE 'MAX' ET 'MIL' COURANTS :
FCAM &AMIL
JGE SPTRI3 < OK : MAX >= MIL...
LA AMAX < L'ORDRE EST MAUVAIS,
XM AMIL < ON PERMUTE
STA AMAX < 'MAX' ET 'MIL' COURANTS...
SPTRI3: EQU $
IF XOPT01-EXIST,XOPT1,,XOPT1
<
< VALIDATION DU TRI :
<
FLD &AMIL < ACCES A 'MIL' COURANT :
FCAM &AMAX < ET VALIDATION DE 'MAX' COURANT :
JLE SPTRI4 < OK : (MIL) <= (MAX)...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
SPTRI4: EQU $
FCAM &AMIN < ET VALIDATION DE 'MIN' COURANT :
JGE SPTRI5 < OK : (MIL) >= (MIN)...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
SPTRI5: EQU $
XOPT1: VAL ENDIF
<
< ET RETOUR :
<
PLR A,B
RSR
PAGE
<
<
< P R O D U I T S C A L A I R E D E 2 V E C T E U R S :
<
<
< ARGUMENTS :
< (A)=ADRESSE DU PREMIER VECTEUR 'VECT1',
< (B)=ADRESSE DU DEUXIEME VECTEUR 'VECT2'.
<
<
< RESULTAT :
< (A,B)=VALEUR DU PRODUIT SCALAIRE...
<
<
< ATTENTION :
< AUX BASES 'L' ET 'W' !!!
<
<
PRSCA: EQU $
VECT1X:: MOT O < X(VECT1),
VECT1Y:: MOT VECT1X+DFLOT < Y(VECT1),
VECT1Z:: MOT VECT1Y+DFLOT < Z(VECT1).
VECT2X:: MOT O < X(VECT2),
VECT2Y:: MOT VECT2X+DFLOT < Y(VECT2),
VECT2Z:: MOT VECT2Y+DFLOT < Z(VECT2).
<
< INITIALISATIONS :
<
PSR Y,L,W < SAUVEGARDE DE 2 BASES ; MAIS 'C' NE DOIT
< PAS ETRE UTILISEE A CAUSE DU BLOC FLOT-
< TANT...
LR L,Y < SAUVEGARDE DE 'L' DANS 'Y' POUR POUVOIR
< ACCEDER EVENTUELLEMENT LE 'LOCAL'...
LR A,L < (L)=BASE DU VECTEUR 'VECT1',
LR B,W < (W)=BASE DU VECTEUR 'VECT2'.
<
< CALCUL DU PRODUIT SCALAIRE :
<
#/FLD# VECT1X,L < X(1),
FMP VECT2X,W < X(1)*X(2),
BSR ASFWOR < ET SAVE...
#/FLD# VECT1Y,L < Y(1),
FMP VECT2Y,W < Y(1)*Y(2),
BSR APFWOR < X(1)*X(2)+Y(1)*Y(2),
< ET SAVE...
#/FLD# VECT1Z,L < Z(1),
FMP VECT2Z,W < Z(1)*Z(2),
BSR APFWOR < (A,B)=X(1)*X(2)+Y(1)*Y(2)+Z(1)*Z(2),
< SOIT LE PRODUIT SCALAIRE DES 2
< VECTEURS 'VECT1' ET 'VECT2'...
< ET MISE DANS 'FWORK', ON NE SAIT
< JAMAIS...
<
< ET RETOUR :
<
PLR Y,L,W
RSR
PAGE
<
<
< C A L C U L D E L A V A L E U R D E L ' E Q U A T I O N
< D ' U N P L A N P O U R L E P O I N T C O U R A N T :
<
<
< ARGUMENT :
< (FXS,FYS,FZS)=POINT 3D COURANT.
<
<
< RESULTAT :
< (A,B)=VALEUR DE L'EQUATION DU PLAN POUR CE POINT.
<
<
SPC: EQU $
<
< CALCUL DE L'EQUATION DU PLAN :
<
LRM A,B
WORD PLAN3D < (A)=ADRESSE DE (PLANA,PLANB,PLANC),
WORD CS3D < (B)=ADRESSE DE (FXS,FYS,FZS).
BSR APRSCA < A*X+B*Y+C*Z,
FAD PLAND < A*X+B*Y+C*Z+D.
<
< ET RETOUR :
<
RSR
PAGE
IF XOPT01-EXIST,XOPT1,,XOPT1
<
<
< V E R I F I C A T I O N D E L ' E Q U A T I O N D U
< P L A N P O U R L E S 3 S O M M E T S ( A , B , C ) :
<
<
SPB: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
<
< VERIFICATION POUR 'A' :
<
LRM A,B,X
WORD CA3D < (A)=SOMMET 'A',
WORD CS3D < (B)=POINT 3D COURANT,
WORD LBUF3D < (X)=NOMBRE DE MOTS A DEPLACER.
BSR ASPD < VERIFICATION DE 'A' DANS 'P'...
<
< VERIFICATION POUR 'B' :
<
LRM A,B,X
WORD CB3D < (A)=SOMMET 'B',
WORD CS3D < (B)=POINT 3D COURANT,
WORD LBUF3D < (X)=NOMBRE DE MOTS A DEPLACER.
BSR ASPD < VERIFICATION DE 'B' DANS 'P'...
<
< VERIFICATION POUR 'C' :
<
LRM A,B,X
WORD CC3D < (A)=SOMMET 'C',
WORD CS3D < (B)=POINT 3D COURANT,
WORD LBUF3D < (X)=NOMBRE DE MOTS A DEPLACER.
BSR ASPD < VERIFICATION DE 'C' DANS 'P'...
<
< ET RETOUR :
<
PLR A,B,X
RSR
XOPT1: VAL ENDIF
PAGE
IF XOPT01-EXIST,XOPT1,,XOPT1
<
<
< V E R I F I C A T I O N P O U R ( A , B , C )
< D E L A P O S I T I O N D A N S ' P ' :
<
<
SPD: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
<
< MISE EN PLACE DU SOMMET COURANT :
<
MOVE
BSR ASPC < ET CALCUL DE LA VALEUR DE L'EQUATION DU
< PLAN POUR LE SOMMET COURANT,
BSR AFABS
FCAM FEPS < ET VALIDATION :
JL SPD1 < OK...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
SPD1: EQU $
<
< ET RETOUR :
<
PLR A,B,X
RSR
XOPT1: VAL ENDIF
XXXPRO: VAL YYYDET < 'YYYDET'.
CALL #SIP UTILITAIRES#
PAGE
<
<
< I N T E R S E C T I O N D ' U N E D R O I T E
< E T D ' U N E S P H E R E ( O U B O U L E ) :
<
<
< FONCTION :
< CHAQUE FACETTE EST ENTOUREE D'UNE
< SPHERE (APPELEE ICI "BOULE", CAR
< "SPHERE" ET "SURFACE" COMMENCENT TOUS
< DEUX PAR LA LETTRE "S") MINIMALE OBTE-
< NUE A PARTIR DU CERCLE CIRCONSCRIT AU
< TRIANGLE CONSTITUANT LA FACETTE 'ABC' ;
< AVANT DE CALCULER L'INTERSECTION EXPLI-
< CITE ENTRE LA DROITE 'D' ET LA FACETTE
< 'ABC', ON REGARDE ICI SI LA DROITE 'D'
< COUPE LA BOULE 'B' :
<
< EQUATION DE LA BOULE 'B' :
<
< (1) (X-XO)**2+(X-YO)**2+(Z-ZO)**2=R**2,
<
< EQUATION DE LA DROITE 'D' :
<
< (2) X=XD+RHO*VX,
< (3) Y=YD+RHO*VY,
< (4) Z=ZD+RHO*VZ.
<
< PORTANT (2), (3) ET (4) DANS (1), ON ARRIVE A
< UNE EQUATION DU SECOND DEGRE :
<
< (VX**2+VY**2+VZ**2)*(RHO**2)+
< 2*(VX*(XD-XO)+VY*(YD-YO)+VZ*(ZD-ZO))*RHO+
< ((XD-XO)**2+(YD-YO)**2+(ZD-ZO)**2-R**2)=0,
<
< DONT LE DISCRIMINANT REDUIT 'DELTA' VAUT :
<
< DELTA=(VX*(XD-XO)+VY*(YD-YO)+VZ*(ZD-ZO))**2-
< (VX**2+VY**2+VZ**2)*((XD-XO)**2+(YD-YO)**2+(ZD-ZO)**2-R**2),
<
< IL SUFFIT DE TESTER LE SIGNE DE 'DELTA'
< POUR SAVOIR SI LA DROITE 'D' COUPE LA
< BOULE 'B' :
<
< (DELTA)>=0...
<
<
< ARGUMENT :
< DROITE 'D',
< BOULE 'B'.
<
<
< RESULTAT :
< BINTER='NEXIST' SI LA DROITE 'D' NE COUPE
< PAS LA BOULE 'B', SANS ETRE TANGENTE
< NON PLUS,
< ='EXIST' SI LA DROITE 'D' COUPE LA
< BOULE 'B' EN 1 OU 2 POINTS.
< CODES CONDITIONS SUR UN 'CPZ BINTER'...
<
<
INTDB: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X,Y
IF NEXIST-K,,XEIF%,
IF ATTENTION : LES 'STZ' SUIVANTS SONT IDIOTS !!!
XEIF%: VAL ENDIF
STZ BINTER < PAS D'INTERSECTION A PRIORI ENTRE 'D'
< ET 'B',
STZ PINTER < NON PLUS QU'ENTRE 'D' ET 'P',
STZ SINTER < ET QU'ENTRE 'D' ET 'S'...
<
< CALCUL DU VECTEUR 'DO' :
<
#/FLD# FXSD < XD,
FSB FXSO < XD-XO,
#/FST# M11 < M11=XD-XO,
#/FLD# FYSD < YD,
FSB FYSO < YD-YO,
#/FST# M12 < M12=YD-YO.
#/FLD# FZSD < ZD,
FSB FZSO < ZD-ZO,
#/FST# M13 < M13=ZD-ZO.
IF M12-M11-DFLOT,,XEIF%,
IF ATTENTION : LE CALCUL DU PRODUIT SCALAIRE QUI VA
IF SUIVRE (ET PEUT-ETRE AILLEURS) VA MERDER !!!
XEIF%: VAL ENDIF
IF M13-M12-DFLOT,,XEIF%,
IF ATTENTION : LE CALCUL DU PRODUIT SCALAIRE QUI VA
IF SUIVRE (ET PEUT-ETRE AILLEURS) VA MERDER !!!
XEIF%: VAL ENDIF
<
< CALCUL DU CARRE DE LA
< NORME DU VECTEUR DIRECTEUR
< DE LA DROITE 'D' :
<
LRM A,B
WORD DV3D < (A)=VECTEUR DIRECTEUR DE 'D',
WORD DV3D < (B)=VECTEUR DIRECTEUR DE 'D',
BSR APRSCA < ET CALCUL DU CARRE DE LA NORME :
#/FST# M14 < M14=(VX**2+VY**2+VZ**2).
<
< CALCUL DE LA NORME DU
< VECTEUR 'OD' MOINS LE
< CARRE DU RAYON DE LA
< SPHERE 'B' :
<
LRM A,B
WORD M11 < (A)=VECTEUR 'OD',
WORD M11 < (B)=VECTEUR 'OD',
BSR APRSCA < ET CALCUL DU CARRE DE LA NORME,
FSB FRAYO < AUQUEL ON RETRANCHE R**2,
< SOIT :
< ((XD-XO)**2+(YD-YO)**2+(ZD-ZO)**2-R**2).
FMP M14 < PUIS MULTIPLIE PAR LE CARRE DE LA NORME
< DU VECTEUR DIRECTEUR DE 'D',
#/FST# M14 < ET QUE L'ON SAUVEGARDE DANS 'M14'...
<
< CALCUL DU PRODUIT SCALAIRE DU
< VECTEUR DIRECTEUR DE LA DROITE
< 'D' ET DU VECTEUR 'OD' :
<
LRM A,B
WORD DV3D < (A)=VECTEUR DIRECTEUR DE 'D',
WORD M11 < (B)=VECTEUR 'OD',
BSR APRSCA < ET CALCUL DE LEUR PRODUIT SCALAIRE :
#/FST# M24 < SAVE TEMPORAIRE,
FMP M24 < ET QUE L'ON ELEVE AU CARRE, SOIT :
< (VX*(XD-XO)+VY*(YD-YO)+VZ*(ZD-ZO))**2
<
< CALCUL DU DISCRIMINANT REDUIT
< DE L'EQUATION DU SECOND DEGRE
< D'INTERSECTION DE 'D' ET DE 'B' :
<
FSB M14 < FACILE...
<
< TEST DES RACINES DE L'EQUATION :
<
BSR AFCAZ < QUEL EST LE SIGNE DU DISCRIMINANT ???
JL INTDB1 < NEGATIF, L'EQUATION N'A DONC PAS DE
< RACINES REELLES...
IF EXIST-K,,,XEIF%
IF ATTENTION : LE 'IC' QUI SUIT EST IDIOT !!!
XEIF%: VAL ENDIF
IC BINTER < POSITIF OU NUL, L'EQUATION A DONC
< UNE OU DEUX RACINES, ET DONC 'D'
< COUPE 'B' EN 1 OU 2 POINTS...
<
< ET RETOUR :
<
INTDB1: EQU $
CPZ BINTER < POSITIONNEMENT DES INDICATEURS...
PLR A,B,X,Y
RSR
PAGE
<
<
< I N T E R S E C T I O N D ' U N E D R O I T E
< E T D ' U N P L A N :
<
<
< FONCTION :
< CE MODULE CALCULE L'INTERSECTION
< D'UNE DROITE DEFINIE PAR UN POINT
< D(FXSD,FYSD,FZSD) ET UN VECTEUR
< DIRECTEUR DV(DVX,DVY,DVZ), ET D'UN
< PLAN P(PLANA,PLANB,PLANC,PLAND).
<
<
< ARGUMENT :
< DROITE 'D',
< PLAN 'P'.
<
<
< RESULTAT :
< PINTER='NEXIST' SI LE POINT D'INTERSECTION
< N'EXISTE PAS ('D' PARALLELE A 'P'),
< ='EXIST', ALORS (FXSM,FYSM,FZSM)
< EST LE POINT D'INTERSECTION.
< LES INDICATEURS SONT POSITIONNES SUR UN 'CPZ PINTER'...
<
<
INTDP: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X,Y
IF NEXIST-K,,XEIF%,
IF ATTENTION : LES 'STZ' SUIVANTS SONT IDIOTS !!!
XEIF%: VAL ENDIF
STZ PINTER < PAS D'INTERSECTION A PRIORI ENTRE 'D'
< ET 'P',
STZ SINTER < NON PLUS QU'ENTRE 'D' ET 'S'...
CPZ BINTER < 'D' COUPE-T'ELLE LA BOULE 'B' ???
JE INTDP3 < NON, PAS LA PEINE DE CALCULER L'INTER-
< SECTION DE 'D' ET DE 'P'...
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE 'CPZ' CI-DESSUS EST IDIOT !!!
XEIF%: VAL ENDIF
<
< TEST DE PARALLELISME DE 'D' ET 'P' :
<
LRM A,B
WORD PLAN3D < (A)=ADRESSE DE (PLANA,PLANB,PLANC),
WORD DV3D < (B)=ADRESSE DE (DVX,DVY,DVZ).
BSR APRSCA < A*VX+B*VY+C*VZ ; LA NULLITE DE CETTE
< QUANTITE (PRODUIT SCALAIRE DU VECTEUR
< DIRECTEUR DE LA DROITE ET DU VECTEUR
< NORMAL AU PLAN) INDIQUE LE PARALLELISME.
BSR AFCAZ < 'D' EST-ELLE PARALLELE A 'P' ???
JNE INTDP4 < NON...
FCMZ DVX < OUI, (VX)=0 ???
JNE INTDP3 < NON...
FCMZ DVY < OUI, (VY)=0 ???
JNE INTDP3 < NON...
FCMZ DVZ < OUI, (VZ)=0 ???
JNE INTDP3 < NON...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
< LA DROITE 'D' EST INDETERMINEE !!!
INTDP3: EQU $
BSR AGOTO
WORD INTDP1 < (PINTER)='NEXIST'...
< NOTONS, QUE LA DROITE 'D' EST PEUT-ETRE
< PARALLELE AU PLAN 'P', MAIS QU'IL PEUT
< S'AGIR AUSSI D'UNE INDETERMINATION SUR
< LA DROITE 'D', TELLE QUE (VX)=(VY)=(VZ)=0
< CE QUI EST PIRE...
INTDP4: EQU $
<
< 'P' ET 'D' NE SONT PAS
< PARALLELES, CALCULONS
< LE PARAMETRE DU POINT 'M'
< D'INTERSECTION DE 'P' ET DE 'D' :
<
#/FST# FRHOM < ON SAUVEGARDE TEMPORAIREMENT LE PRODUIT
< SCALAIRE A*VX+B*VY+C*VZ DANS 'FRHOM'...
LRM A,B
WORD PLAN3D < (A)=ADRESSE DE (PLANA,PLANB,PLANC),
WORD CD3D < (B)=ADRESSE DE (FXSD,FYSD,FZSD).
BSR APRSCA < A*XD+B*YD+C*ZD,
FAD PLAND < A*XD+B*YD+C*ZD+D,
FDV FRHOM < (A*XD+B*YD+C*ZD+D)/(A*VX+B*VY+C*VZ) ; A
< NOTER QUE SI CETTE QUANTITE EST NULLE,
< ALORS 'M'='D'...
BSR ATSFLO
BSR AFNEG
#/FST# FRHOM < LE PARAMETRE 'FRHOM' EST LE PARAMETRE
< DE DEFINITION DU POINT D'INTERSECTION DE
< 'P' ET DE 'D' SUR 'D'...
<
< CALCUL DES COORDONNEES
< DU POINT 'M' :
<
#/FLD# DVX < VX,
FMP FRHOM < RHOM*VX,
FAD FXSD < XD+RHOM*VX,
#/FST# FXSM < XM=XD+RHOM*VX.
#/FLD# DVY < VY,
FMP FRHOM < RHOM*VY,
FAD FYSD < YD+RHOM*VY,
#/FST# FYSM < YM=YD+RHOM*VY.
#/FLD# DVZ < VZ,
FMP FRHOM < RHOM*VZ,
FAD FZSD < ZD+RHOM*VZ,
#/FST# FZSM < ZM=ZD+RHOM*VZ.
<
< CALCUL DES COORDONNEES
< BARYCENTRIQUES DE 'M'
< DANS LE TRIANGLE (A,B,C) :
<
<
< ON DOIT RESOUDRE LE SYSTEME
< SUIVANT QUI REND COMPTE DU
< FAIT QUE LE POINT 'M' APPAR-
< TIENT A LA DROITE 'D', ET
< QU'IL EST DANS LE PLAN 'ABC',
< SES COORDONNEES VERIFIENT
< DONC SIMULTANEMENT :
<
< XM=XD+RHOM*VX,
< YM=YD+RHOM*VY,
< ZM=ZD+RHOM*VZ,
<
< ET :
<
< XM=ALPHA*XA+BETA*XB+GAMMA*XC,
< YM=ALPHA*YA+BETA*YB+GAMMA*YC,
< ZM=ALPHA*ZA+BETA*ZB+GAMMA*ZC.
<
< ENFIN, (ALPHA,BETA,GAMMA)
< ETANT DES COORDONNEES BARY-
< CENTRIQUES, ON A :
<
< ALPHA+BETA+GAMMA=1.
<
< D'OU LE SYSTEME :
<
< ALPHA*XA+BETA*XB+GAMMA*XC=XD+RHOM*VX,
< ALPHA*YA+BETA*YB+GAMMA*YC=YD+RHOM*VY,
< ALPHA*ZA+BETA*ZB+GAMMA*ZC=ZD+RHOM*VZ,
< ALPHA +BETA +GAMMA =1,
<
INTDP5: EQU $
<
< DEFINITION DE LA MATRICE M(I,J) :
<
LAD M11
STA AM11
LAD M12
STA AM12
LAD M13
STA AM13
LAD M21
STA AM21
LAD M22
STA AM22
LAD M23
STA AM23
LAD F1
STA AM31
LAD F1
STA AM32
LAD F1
STA AM33
<
< AIGUILLAGE SUIVANT LA VALEUR
< DES COMPOSANTES (VX,VY,VZ) :
<
FCMZ DVX < (VX) EST-IL DIFFERENT DE 0 ???
JE INTDP6 < NON, IL EST NUL, ALLONS TESTER LA
< COORDONNEE SUIVANTE DU VECTEUR 'D'...
<
< CAS (VX)#0 :
<
< ON DOIT RESOUDRE LE SYSTEME :
<
< ALPHA*(VX*YA-VY*XA)+BETA*(VX*YB-VY*XB)+GAMMA*(VX*YC-VY*XC)=VX*YD-VY*XD,
< ALPHA*(VX*ZA-VZ*XA)+BETA*(VX*ZB-VZ*XB)+GAMMA*(VX*ZC-VZ*XC)=VX*ZD-VZ*XD,
< ALPHA +BETA +GAMMA =1.
<
< QUI EST EN FAIT UNE REDUCTION
< PAR ELIMINATION DE 'RHOM' DANS
< LA PREMIERE EQUATION (AVEC (VX)#0)
< DU SYSTEME SUIVANT :
<
< ALPHA*XA+BETA*XB+GAMMA*XC=XD+RHOM*VX,
< ALPHA*YA+BETA*YB+GAMMA*YC=YD+RHOM*VY,
< ALPHA*ZA+BETA*ZB+GAMMA*ZC=ZD+RHOM*VZ,
< ALPHA +BETA +GAMMA =1,
<
< CALCUL DES M(I,J) :
<
#/FLD# DVY < VY,
FMP FXSA < VY*XA,
BSR ASFWOR
#/FLD# DVX < VX,
FMP FYSA < VX*YA,
FSB FWORK < VX*YA-VY*XA,
#/FST# M11 < M11=VX*YA-VY*XA.
#/FLD# DVY < VY,
FMP FXSB < VY*XB,
BSR ASFWOR
#/FLD# DVX < VX,
FMP FYSB < VX*YB,
FSB FWORK < VX*YB-VY*XB,
#/FST# M12 < M12=VX*YB-VY*XB.
#/FLD# DVY < VY,
FMP FXSC < VY*XC,
BSR ASFWOR
#/FLD# DVX < VX,
FMP FYSC < VX*YC,
FSB FWORK < VX*YC-VY*XC,
#/FST# M13 < M13=VX*YC-VY*XC.
#/FLD# DVY < VY,
FMP FXSD < VY*XD,
BSR ASFWOR
#/FLD# DVX < VX,
FMP FYSD < VX*YD,
FSB FWORK < VX*YD-VY*XD,
#/FST# M14 < M14=VX*YD-VY*XD.
#/FLD# DVZ < VZ,
FMP FXSA < VZ*XA,
BSR ASFWOR
#/FLD# DVX < VX,
FMP FZSA < VX*ZA,
FSB FWORK < VX*ZA-VZ*XA,
#/FST# M21 < M21=VX*ZA-VZ*XA.
#/FLD# DVZ < VZ,
FMP FXSB < VZ*XB,
BSR ASFWOR
#/FLD# DVX < VX,
FMP FZSB < VX*ZB,
FSB FWORK < VX*ZB-VZ*XB,
#/FST# M22 < M22=VX*ZB-VZ*XB.
#/FLD# DVZ < VZ,
FMP FXSC < VZ*XC,
BSR ASFWOR
#/FLD# DVX < VX,
FMP FZSC < VX*ZC,
FSB FWORK < VX*ZC-VZ*XC,
#/FST# M23 < M23=VX*ZC-VZ*XC.
#/FLD# DVZ < VZ,
FMP FXSD < VZ*XD,
BSR ASFWOR
#/FLD# DVX < VX,
FMP FZSD < VX*ZD,
FSB FWORK < VX*ZD-VZ*XD,
#/FST# M24 < M24=VX*ZD-VZ*XD.
<
< CALCUL DU DETERMINANT :
<
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < (A,B)=DETERMINANT, ET VALIDATION :
JE INTDP6 < IL EST NUL, ALLONS ESSAYER DE RESOUDRE
< PAR RAPPORT A 'VY'...
BSR AGOTO
WORD INTDP9 < OK, NON NUL : VERS LA RESOLUTION DU
< SYSTEME...
<
< CAS (VX)=0 :
<
INTDP6: EQU $
FCMZ DVY < (VY) EST-IL DIFFERENT DE 0 ???
JE INTDP7 < NON, IL EST NUL, ALLONS TESTER LA
< COORDONNEE SUIVANTE DU VECTEUR 'D'...
<
< CAS (VY)#0 :
<
< ON DOIT RESOUDRE LE SXSTEME :
<
< ALPHA*(VY*XA-VX*YA)+BETA*(VY*XB-VX*YB)+GAMMA*(VY*XC-VX*YC)=VY*XD-VX*YD,
< ALPHA*(VY*ZA-VZ*YA)+BETA*(VY*ZB-VZ*YB)+GAMMA*(VY*ZC-VZ*YC)=VY*ZD-VZ*YD,
< ALPHA +BETA +GAMMA =1.
<
< QUI EST EN FAIT UNE REDUCTION
< PAR ELIMINATION DE 'RHOM' DANS
< LA PREMIERE EQUATION (AVEC (VY)#0)
< DU SXSTEME SUIVANT :
<
< ALPHA*XA+BETA*XB+GAMMA*XC=XD+RHOM*VX,
< ALPHA*YA+BETA*YB+GAMMA*YC=YD+RHOM*VY,
< ALPHA*ZA+BETA*ZB+GAMMA*ZC=ZD+RHOM*VZ,
< ALPHA +BETA +GAMMA =1,
<
< CALCUL DES M(I,J) :
<
#/FLD# DVX < VX,
FMP FYSA < VX*YA,
BSR ASFWOR
#/FLD# DVY < VY,
FMP FXSA < VY*XA,
FSB FWORK < VY*XA-VX*YA,
#/FST# M11 < M11=VY*XA-VX*YA.
#/FLD# DVX < VX,
FMP FYSB < VX*YB,
BSR ASFWOR
#/FLD# DVY < VY,
FMP FXSB < VY*XB,
FSB FWORK < VY*XB-VX*YB,
#/FST# M12 < M12=VY*XB-VX*YB.
#/FLD# DVX < VX,
FMP FYSC < VX*YC,
BSR ASFWOR
#/FLD# DVY < VY,
FMP FXSC < VY*XC,
FSB FWORK < VY*XC-VX*YC,
#/FST# M13 < M13=VY*XC-VX*YC.
#/FLD# DVX < VX,
FMP FYSD < VX*YD,
BSR ASFWOR
#/FLD# DVY < VY,
FMP FXSD < VY*XD,
FSB FWORK < VY*XD-VX*YD,
#/FST# M14 < M14=VY*XD-VX*YD.
#/FLD# DVZ < VZ,
FMP FYSA < VZ*YA,
BSR ASFWOR
#/FLD# DVY < VY,
FMP FZSA < VY*ZA,
FSB FWORK < VY*ZA-VZ*YA,
#/FST# M21 < M21=VY*ZA-VZ*YA.
#/FLD# DVZ < VZ,
FMP FYSB < VZ*YB,
BSR ASFWOR
#/FLD# DVY < VY,
FMP FZSB < VY*ZB,
FSB FWORK < VY*ZB-VZ*YB,
#/FST# M22 < M22=VY*ZB-VZ*YB.
#/FLD# DVZ < VZ,
FMP FYSC < VZ*YC,
BSR ASFWOR
#/FLD# DVY < VY,
FMP FZSC < VY*ZC,
FSB FWORK < VY*ZC-VZ*YC,
#/FST# M23 < M23=VY*ZC-VZ*YC.
#/FLD# DVZ < VZ,
FMP FYSD < VZ*YD,
BSR ASFWOR
#/FLD# DVY < VY,
FMP FZSD < VY*ZD,
FSB FWORK < VY*ZD-VZ*YD,
#/FST# M24 < M24=VY*ZD-VZ*YD.
<
< CALCUL DU DETERMINANT :
<
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < (A,B)=DETERMINANT, ET VALIDATION :
JE INTDP7 < IL EST NUL, ALLONS ESSAYER DE RESOUDRE
< PAR RAPPORT A 'VZ'...
BSR AGOTO
WORD INTDP9 < OK, NON NUL : VERS LA RESOLUTION DU
< SYSTEME...
<
< CAS (VX)=(VY)=0 :
<
INTDP7: EQU $
FCMZ DVZ < (VZ) EST-IL DIFFERENT DE 0 ???
JE INTDP8 < NON, IL EST NUL, ALLONS TESTER LA
< COORDONNEE SUIVANTE DU VECTEUR 'D'...
<
< CAS (VZ)#0 :
<
< ON DOIT RESOUDRE LE SXSTEME :
<
< ALPHA*(VZ*XA-VX*ZA)+BETA*(VZ*XB-VX*ZB)+GAMMA*(VZ*XC-VX*ZC)=VZ*XD-VX*ZD,
< ALPHA*(VZ*YA-VY*ZA)+BETA*(VZ*YB-VY*ZB)+GAMMA*(VZ*YC-VY*ZC)=VZ*YD-VY*ZD,
< ALPHA +BETA +GAMMA =1.
<
< QUI EST EN FAIT UNE REDUCTION
< PAR ELIMINATION DE 'RHOM' DANS
< LA PREMIERE EQUATION (AVEC (VZ)#0)
< DU SXSTEME SUIVANT :
<
< ALPHA*XA+BETA*XB+GAMMA*XC=XD+RHOM*VX,
< ALPHA*YA+BETA*YB+GAMMA*YC=YD+RHOM*VY,
< ALPHA*ZA+BETA*ZB+GAMMA*ZC=ZD+RHOM*VZ,
< ALPHA +BETA +GAMMA =1,
<
< CALCUL DES M(I,J) :
<
#/FLD# DVX < VX,
FMP FZSA < VX*ZA,
BSR ASFWOR
#/FLD# DVZ < VZ,
FMP FXSA < VZ*XA,
FSB FWORK < VZ*XA-VX*ZA,
#/FST# M11 < M11=VZ*XA-VX*ZA.
#/FLD# DVX < VX,
FMP FZSB < VX*ZB,
BSR ASFWOR
#/FLD# DVZ < VZ,
FMP FXSB < VZ*XB,
FSB FWORK < VZ*XB-VX*ZB,
#/FST# M12 < M12=VZ*XB-VX*ZB.
#/FLD# DVX < VX,
FMP FZSC < VX*ZC,
BSR ASFWOR
#/FLD# DVZ < VZ,
FMP FXSC < VZ*XC,
FSB FWORK < VZ*XC-VX*ZC,
#/FST# M13 < M13=VZ*XC-VX*ZC.
#/FLD# DVX < VX,
FMP FZSD < VX*ZD,
BSR ASFWOR
#/FLD# DVZ < VZ,
FMP FXSD < VZ*XD,
FSB FWORK < VZ*XD-VX*ZD,
#/FST# M14 < M14=VZ*XD-VX*ZD.
#/FLD# DVY < VY,
FMP FZSA < VY*ZA,
BSR ASFWOR
#/FLD# DVZ < VZ,
FMP FYSA < VZ*YA,
FSB FWORK < VZ*YA-VY*ZA,
#/FST# M21 < M21=VZ*YA-VY*ZA.
#/FLD# DVY < VY,
FMP FZSB < VY*ZB,
BSR ASFWOR
#/FLD# DVZ < VZ,
FMP FYSB < VZ*YB,
FSB FWORK < VZ*YB-VY*ZB,
#/FST# M22 < M22=VZ*YB-VY*ZB.
#/FLD# DVY < VY,
FMP FZSC < VY*ZC,
BSR ASFWOR
#/FLD# DVZ < VZ,
FMP FYSC < VZ*YC,
FSB FWORK < VZ*YC-VY*ZC,
#/FST# M23 < M23=VZ*YC-VY*ZC.
#/FLD# DVY < VY,
FMP FZSD < VY*ZD,
BSR ASFWOR
#/FLD# DVZ < VZ,
FMP FYSD < VZ*YD,
FSB FWORK < VZ*YD-VY*ZD,
#/FST# M24 < M24=VZ*YD-VY*ZD.
<
< CALCUL DU DETERMINANT :
<
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < (A,B)=DETERMINANT, ET VALIDATION :
JNE INTDP9 < OK, NON NUL : VERS LA RESOLUTION DU
< SYSTEME...
<
< CAS (VX)=(VY)=(VZ)=0, OU
< BIEN, LES TROIS DETERMINANTS
< SONT NULS :
<
INTDP8: EQU $
QUIT XXQUIT < E R R E U R P R O G R A M M E...
< NOTONS, QUE VU LE TEST DE PARALLELISME
< ENTRE 'D' ET 'P', ON NE PEUT JAMAIS
< ARRIVER ICI !!!
<
< CALCUL DE (ALPHA,BETA,GAMMA) :
<
INTDP9: EQU $
#/FST# FDETER < MEMORISATION DU DETERMINANT (A,B),
BSR AFCAZ < ET REVALIDATION...
JNE INTDP2 < OK, IL N'EST PAS NUL...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
INTDP2: EQU $
<
< CALCUL DE 'ALPHA' :
<
LAD M14
STA AM11
LAD M24
STA AM21 < NOTA : LA TROISIEME EQUATION
< A SES 4 COEFFICIENTS EGAUX A 1, IL EST
< DONC INUTILE DE CHANGER 'AM31' (PUIS
< 'AM32' ET 'AM33'), TOUS POINTANT SUR
< LA CONSTANTE 'F1' ; C'EST AUSSI POURQUOI
< ON N'INITIALISE PAS 'M34'...
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < CALCUL DU DETERMINANT (4,2,3),
FDV FDETER
BSR ATSFLO
BSR AFCAZ < LE POINT 'M' EST-IL INTERIEUR A (A,B,C) ?
JL AINDP1 < NON, (PINTER)='NEXIST'...
FCAM F1 < LE POINT 'M' EST-IL INTERIEUR A (A,B,C) ?
JG AINDP1 < NON, (PINTER)='NEXIST'...
#/FST# ALPHA < ALPHA=DETER(4,2,3)/DETER(1,2,3).
<
< CALCUL DE 'BETA' :
<
LAD M11
XM AM11
STA AM12
LAD M21
XM AM21
STA AM22
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < CALCUL DU DETERMINANT (1,4,3),
FDV FDETER
BSR ATSFLO
BSR AFCAZ < LE POINT 'M' EST-IL INTERIEUR A (A,B,C) ?
JL AINDP1 < NON, (PINTER)='NEXIST'...
FCAM F1 < LE POINT 'M' EST-IL INTERIEUR A (A,B,C) ?
JG AINDP1 < NON, (PINTER)='NEXIST'...
#/FST# BETA < BETA=DETER(1,4,3)/DETER(1,2,3).
<
< CALCUL DE 'GAMMA' :
<
LAD M12
XM AM12
STA AM13
LAD M22
XM AM22
STA AM23
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < CALCUL DU DETERMINANT (1,2,4),
FDV FDETER
BSR ATSFLO
BSR AFCAZ < LE POINT 'M' EST-IL INTERIEUR A (A,B,C) ?
JL AINDP1 < NON, (PINTER)='NEXIST'...
FCAM F1 < LE POINT 'M' EST-IL INTERIEUR A (A,B,C) ?
JLE INTDPC < OUI...
AINDP1: EQU $ < NON, ET RELAI...
BSR AGOTO
WORD INTDP1 < NON, (PINTER)='NEXIST'...
INTDPC: EQU $
#/FST# GAMMA < GAMMA=DETER(1,2,4)/DETER(1,2,3).
<
< LE POINT 'M' EST INTERIEUR
< AU TRIANGLE (A,B,C) :
<
IF EXIST-K,,,XEIF%
IF ATTENTION : LE 'IC' QUI SUIT EST IDIOT !!!
XEIF%: VAL ENDIF
IC PINTER < OK, ON A TROUVE UN POINT D'INTERSECTION
< 'M' (FXSM,FYSM,FZSM) ENTRE LA DROITE
< 'D' ET LE PLAN 'P' QUI SOIT INTERIEUR AU
< TRIANGLE (A,B,C) ; SES COORDONNEES BARY-
< CENTRIQUES SONT (ALPHA,BETA,GAMMA),
< (PINTER)='EXIST'.
<
< CALCUL DE 'VARU' ET 'VARV'
< AU POINT 'M' D'INTERSECTION
< PAR UTILISATION DES COORDON-
< NEES BARYCENTRIQUES DE 'M' :
<
BSR APUVM < CALCUL DE (VARUM,VARVM).
<
< CALCUL DE (FBARI,FBARS) :
<
ABSCOS: EQU DADBDC < POUR MEMORISER LA FONCTION
< 1-ABS(COS(P,D)).
LRM A,B
WORD PLAN3D < (A)=ADRESSE DU VECTEUR NORMAL AU
< PLAN 'P' DE LA FACETTE (NORMALISE),
WORD DV3D < (B)=ADRESSE DU VECTEUR DIRECTEUR DE
< LA DROITE 'D' (NORMALISE).
BSR APRSCA < CALCUL DU PRODUIT SCALAIRE DE CES DEUX
< VECTEURS ; ETANT NORMALISES :
< (A,B)=COS(P,D),
BSR AFABS < ABS(COS(P,D)), AFIN DE FAIRE UNE SYMETRIE
< D'AXE VERTICAL, PERMETTANT DE PRENDRE
< EN COMPTE L'ANGLE "SIGNIFICATIF" ENTRE
< 'P' ET 'D'...
BSR AFNEG < -ABS(COS(P,D)), AFIN D'AVOIR UN GRAND
< COEFFICIENT POUR LES PETITS ANGLES ENTRE
< LA DROITE 'D' ET LE PLAN 'P', SOIT LES
< GRANDS ANGLES ENTRE 'D' ET LA LA NORMALE
< A 'P' (DROITE 'D' RAZANT LE PLAN 'P', ET
< COUPANT LA SURFACE 'S' LOIN DE LA FACET-
< TE CORRESPONDANTE) ET INVERSEMENT...
FAD F1 < 1-ABS(COS(P,D)),
< CE QUI DONNE UNE VALEUR DANS (0,1)...
#/FST# ABSCOS < ET SAVE...
FMP FBARC < PUIS DANS (0,FBARC),
BSR AFNEG
#/FST# FBARI < 'FBARI' EST UNE VALEUR NEGAIVE,
BSR AFCAZ < ET VALIDATION :
JLE INTDPA < OK, 'FBARI' NEGATIF...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
INTDPA: EQU $
BSR AFNEG
FAD F1
#/FST# FBARS < 'FBARS' EST UNE VALEUR SUPERIEURE A 1.
<
< CALCUL DU SEUIL DE COHERENCE :
<
NTRN
XSEUIL:: VAL XXN255+Z/XXXMOY/XXXMOY
TRN
LAI XXN255+Z/XXXMOY-XSEUIL
< (A)=PLUS GRAND SEUIL (A 'XSEUIL' PRES)
< RECONNU POUR LES TESTS DE COHERENCE,
BSR AFLT
FMP ABSCOS < QUE L'ON MULTIPLIE PAR 'ABSCOS' QUI EST
< UNE FONCTION VALANT :
< 0 : 'D' EST PERPENDICULAIRE A 'P',
< 1 : 'D' EST PARALLELE A 'P',
< (SOIT 1-ABS(COS(P,D))).
BSR AROND < CONVERSION ENTIERE,
ADRI XSEUIL/XXXMOY/XXXMOY/XXXMOY,A
< AFIN DE N'AVOIR JAMAIS DE SEUILS NULS...
STA NSEUIL < ET MEMORISE...
<
< MODIFICATION DE 'ABSCOS' :
<
#/FLD# ABSCOS < 1-ABS(COS(P,D)),
FAD F1 < 2-ABS(COS(P,D)),
FMP FEPSTO < FEPSTO*(2-ABS(COS(P,D))),
#/FST# ABSCOS < AFIN QUE 'ABSCOS' NE S'ANNULE PAS, ET
< SOIT SUPERIEURE OU EGALE A 'FEPSTO'...
<
< CALCUL DE EPS(U) :
<
BSR ATRIGU < DONNE DANS 'Y' LA POSITION DU TRIANGLE
< (A,B,C) PAR RAPPORT A LA ZONE DE "REBOU-
< CLAGE" DU TORE...
VARUAB: EQU DADB < ABS(UA-UB),
VARUBC: EQU DBDC < ABS(UB-UC),
VARUCA: EQU DCDA < ABS(UC-UA).
#/FLD# VARUB < UB,
BSR APERIU < POSITIONNEMENT SUR LE TORE,
BSR ASFWOR
#/FLD# VARUA < UA,
BSR APERIU < POSITIONNEMENT SUR LE TORE,
PSR A,B < ET SAVE UA...
FSB FWORK < UA-UB,
BSR AFABS < ABS(UA-UB),
#/FST# VARUAB < ET SAVE...
#/FLD# VARUC < UC,
BSR APERIU < POSITIONNEMENT SUR LE TORE,
BSR ASFWOR
#/FLD# VARUB < UB,
BSR APERIU < POSITIONNEMENT SUR LE TORE,
FSB FWORK < UB-UC,
BSR AFABS < ABS(UB-UC),
#/FST# VARUBC < ET SAVE...
PLR A,B < UA,
BSR ASFWOR
#/FLD# VARUC < UC,
BSR APERIU < POSITIONNEMENT SUR LE TORE,
FSB FWORK < UC-UA,
BSR AFABS < ABS(UC-UA),
#/FST# VARUCA < ET SAVE...
LAD VARUAB
STA AMIN < INITIALISATION
LAD VARUBC
STA AMIL < DES TROIS
LAD VARUCA
STA AMAX < RELAIS,
BSR ASPTRI < ET TRI DE (ABS(UA-UB),ABS(UB-UC),
< ABS(UC-UA))...
FLD &AMIL < (A,B)=VALEUR MEDIANE,
FMP ABSCOS < QUE L'ON MET "A L'ECHELLE",
LXI XEPSU
FST &ALTORE < CE QUI DONNE EPS(U)...
<
< CALCVL DE EPS(V) :
<
BSR ATRIGV < DONNE DANS 'Y' LA POSITION DU TRIANGLE
< (A,B,C) PAR RAPPORT A LA ZONE DE "REBOU-
< CLAGE" DU TORE...
VARVAB: EQU DADB < ABS(VA-VB),
VARVBC: EQU DBDC < ABS(VB-VC),
VARVCA: EQU DCDA < ABS(VC-VA).
#/FLD# VARVB < VB,
BSR APERIV < POSITIONNEMENT SUR LE TORE,
BSR ASFWOR
#/FLD# VARVA < VA,
BSR APERIV < POSITIONNEMENT SUR LE TORE,
PSR A,B < ET SAVE VA...
FSB FWORK < VA-VB,
BSR AFABS < ABS(VA-VB),
#/FST# VARVAB < ET SAVE...
#/FLD# VARVC < VC,
BSR APERIV < POSITIONNEMENT SUR LE TORE,
BSR ASFWOR
#/FLD# VARVB < VB,
BSR APERIV < POSITIONNEMENT SUR LE TORE,
FSB FWORK < VB-VC,
BSR AFABS < ABS(VB-VC),
#/FST# VARVBC < ET SAVE...
PLR A,B < VA,
BSR ASFWOR
#/FLD# VARVC < VC,
BSR APERIV < POSITIONNEMENT SUR LE TORE,
FSB FWORK < VC-VA,
BSR AFABS < ABS(VC-VA),
#/FST# VARVCA < ET SAVE...
LAD VARVAB
STA AMIN < INITIALISATION
LAD VARVBC
STA AMIL < DES TROIS
LAD VARVCA
STA AMAX < RELAIS,
BSR ASPTRI < ET TRI DE (ABS(VA-VB),ABS(VB-VC),
< ABS(VC-VA))...
FLD &AMIL < (A,B)=VALEUR MEDIANE,
FMP ABSCOS < QUE L'ON MET "A L'ECHELLE",
LXI XEPSV
FST &ALTORE < CE QUI DONNE EPS(V)...
IF XOPT01-EXIST,XOPT1,,XOPT1
<
< VISUALISATION DES FACETTES
< TELLES QU'ELLES INTERSEC-
< TENT LA DROITE 'D' :
<
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST QUI SUIT EST IDIOT !!!
XEIF%: VAL ENDIF
LA IWCONV < LA VISUALISATION EST-ELLE DEMANDEE ???
JAE INTDPB < NON...
XM IWGFE < OUI, ON POSITIONNE 'IWGFE' AVEC 'EXIST'
< (A CAUSE DE 'SP1E'), ET ON SAUVEGARDE
< (IWGFE) DANS 'A'...
LR A,X < (X)=SAUVEGARDE DE 'IWGFE'...
XWOR%1: VAL SIZXVI/XC512 < X-FACTEUR DE PASSAGE '512' --> 'VISU',
XWOR%2: VAL SIZYVI/XL512 < Y-FACTEUR DE PASSAGE '512' --> 'VISU'.
IF XWOR%1-XWOR%2,,XEIF%,
IF ATTENTION : LE CALCUL DE 'FACT' EST IDIOT !!!
XEIF%: VAL ENDIF
#/FLD# FACT
PSR A,B < SAUVEGARDE DE 'FACT'...
LRM A,B
FLOAT <XWOR%1?XWOR%2<K<K
#/FST# FACT < FACTEUR D'ECHELLE POUR LE TRACE GRA-
< PHIQUE SUR VISU...
LRM A
WORD DEMWD0
SVC < MISE DU TRACE EN MODE NORMAL...
BSR ASP1E < TRACE DE LA FACETTE (A,B,C) COURANTE.
STX IWGFE < RESTAURATION DE 'IWGFE'...
PLR A,B
#/FST# FACT < ET DE 'FACT'...
INTDPB: EQU $
XOPT1: VAL ENDIF
<
< ET SORTIE :
<
INTDP1: EQU $
CPZ PINTER < ET POSITIONNEMENT DES INDICATEURS...
PLR A,B,X,Y
RSR
PAGE
<
<
< C A L C U L D E ' V A R U M ' E T ' V A R V M ' :
<
<
PUVM: EQU $
<
< INITIALISATION :
<
PSR A,B,Y
<
< TEST DE LA POSITION DU TRIANGLE
< (A,B,C) PAR RAPPORT AU MILIEU DU
< SEGMENT (MIN(U),(MAX(U)) :
<
BSR ATRIGU < RENVOIE (Y)...
<
< CALCUL DE 'VARUM' :
<
#/FLD# VARUA < UA,
BSR APERIU < POSITIONNEMENT SUR LE TORE...
FMP ALPHA < ALPHA*UA,
BSR ASFWOR < ET SAVE...
#/FLD# VARUB < UB,
BSR APERIU < POSITIONNEMENT SUR LE TORE...
FMP BETA < BETA*UB,
BSR APFWOR < ALPHA*UA+BETA*UB,
#/FLD# VARUC < UC,
BSR APERIU < POSITIONNEMENT SUR LE TORE...
FMP GAMMA < GAMMA*UC,
BSR APFWOR < CALCUL DE 'UM' :
BSR APSEGU < POSITIONNEMENT SUR LE TORE,
#/FST# VARUM < UM=ALPHA*UA+BETA*UB+GAMMA*UC.
<
< TEST DE LA POSITION DU TRIANGLE
< (A,B,C) PAR RAPPORT AU MILIEU DU
< SEGMENT (MIN(V),(MAX(V)) :
<
BSR ATRIGV < RENVOIE (Y)...
<
< CALCUL DE 'VARVM' :
<
#/FLD# VARVA < VA,
BSR APERIV < POSITIONNEMENT SUR LE TORE...
FMP ALPHA < ALPHA*VA,
BSR ASFWOR < ET SAVE...
#/FLD# VARVB < VB,
BSR APERIV < POSITIONNEMENT SUR LE TORE...
FMP BETA < BETA*VB,
BSR APFWOR < ALPHA*VA+BETA*VB,
#/FLD# VARVC < VC,
BSR APERIV < POSITIONNEMENT SUR LE TORE...
FMP GAMMA < GAMMA*VC,
BSR APFWOR < CALCUL DE 'VM' :
BSR APSEGV < POSITIONNEMENT SUR LE TORE,
#/FST# VARVM < VM=ALPHA*VA+BETA*VB+GAMMA*VC.
<
< ET RETOUR :
<
PLR A,B,Y
RSR
PAGE
<
<
< D E T E R M I N A T I O N D E L A P O S I T I O N
< D U T R I A N G L E ( A , B , C ) D A N S L E
< S E G M E N T ( M I N ( U ) , M A X ( U ) ) O U
< D A N S ( M I N ( V ) , M A X ( V ) ) :
<
<
< RESULTAT :
< (Y)='EXIST' SI (A,B,C) EST A CHEVAL SUR
< LE REBOUCLAGE DU TORE POUR
< 'U' OU 'V' SUIVANT LE MODULE
< APPELE,
< ='NEXIST' DANS LE CAS CONTRAIRE.
<
<
< E N T R Y ' U ' :
<
<
TRIGU: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
LXI XPERU < (X)=INDEX DE LA PERIOD(U).
LYI EXIST < (Y)=INDICATEUR :
< ='EXIST' : (A,B,C) EST SUR LE REBOU-
< CLAGE DU TORE,
< ='NEXIST' : (A,B,C) EST "NORMAL"...
<
< POSITION DE (A,B,C)
< DANS (MIN(U),MAX(U)) :
<
#/FLD# VARUA < UA,
FSB VARUB < UA-UB,
BSR AFABS < ABS(UA-UB),
FDV F05 < 2*ABS(UA-UB), ET CECI AFIN DE COMPARER
< ABS(UA-UB) A LA PERIOD(U)...
FCAM &ALTORE < ALORS, (UA-UB) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(U),MAX(U)) ???
JG TRIGU1 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUCLAGE DU TORE...
#/FLD# VARUB < UB,
FSB VARUC < UB-UC,
BSR AFABS < ABS(UB-UC),
FDV F05 < 2*ABS(UB-UC), ET CECI AFIN DE COMPARER
< ABS(UB-UC) A LA PERIOD(U)...
FCAM &ALTORE < ALORS, (UB-UC) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(U),MAX(U)) ???
JG TRIGU1 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUBLAGE DU TORE...
#/FLD# VARUC < UC,
FSB VARUA < UC-UA,
BSR AFABS < ABS(UC-UA),
FDV F05 < 2*ABS(UC-UA), ET CECI AFIN DE COMPARER
< ABS(UC-UA) A LA PERIOD(U)...
FCAM &ALTORE < ALORS, (UC-UA) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(U),MAX(U)) ???
JG TRIGU1 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUCLAGE DU TORE...
<
< ET RETOUR :
<
LYI NEXIST < ET BIEN, LE TRIANGLE (A,B,C) SEMBLE
< "NORMAL" :
< ABS(UU-UU)<PERIOD(U)/2, OU "UU" REPRE-
< SENTE 'UA', 'UB' ET 'UC'...
TRIGU1: EQU $
PLR A,B,X
RSR
<
<
< E N T R Y ' V ' :
<
<
TRIGV: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
LXI XPERV < (X)=INDEX DE LA PERIOD(V).
LYI EXIST < (Y)=INDICATEUR :
< ='EXIST' : (A,B,C) EST SUR LE REBOU-
< CLAGE DU TORE,
< ='NEXIST' : (A,B,C) EST "NORMAL"...
<
< POSITION DE (A,B,C)
< DANS (MIN(V),MAX(V)) :
<
#/FLD# VARVA < VA,
FSB VARVB < VA-VB,
BSR AFABS < ABS(VA-VB),
FDV F05 < 2*ABS(VA-VB), ET CECI AFIN DE COMPARER
< ABS(VA-VB) A LA PERIOD(V)...
FCAM &ALTORE < ALORS, (VA-VB) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(V),MAX(V)) ???
JG TRIGV1 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUCLAGE DU TORE...
#/FLD# VARVB < VB,
FSB VARVC < VB-VC,
BSR AFABS < ABS(VB-VC),
FDV F05 < 2*ABS(VB-VC), ET CECI AFIN DE COMPARER
< ABS(VB-VC) A LA PERIOD(V)...
FCAM &ALTORE < ALORS, (VB-VC) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(V),MAX(V)) ???
JG TRIGV1 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUBLAGE DU TORE...
#/FLD# VARVC < VC,
FSB VARVA < VC-VA,
BSR AFABS < ABS(VC-VA),
FDV F05 < 2*ABS(VC-VA), ET CECI AFIN DE COMPARER
< ABS(VC-VA) A LA PERIOD(V)...
FCAM &ALTORE < ALORS, (VC-VA) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(V),MAX(V)) ???
JG TRIGV1 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUCLAGE DU TORE...
<
< ET RETOUR :
<
LYI NEXIST < ET BIEN, LE TRIANGLE (A,B,C) SEMBLE
< "NORMAL" :
< ABS(VV-VV)<PERIOD(V)/2, OU "VV" REPRE-
< SENTE 'VA', 'VB' ET 'VC'...
TRIGV1: EQU $
PLR A,B,X
RSR
PAGE
<
<
< D E T E R M I N A T I O N D E L A P O S I T I O N
< D ' U N S E G M E N T D U T R I A N G L E
< ( A S , B S , C S ) D A N S L E
< S E G M E N T ( M I N ( U ) , M A X ( U ) ) O U
< D A N S ( M I N ( V ) , M A X ( V ) ) :
<
<
< ARGUMENT :
< (A)=XSEGAB/XSEGBC/XSEGCA SUIVANT QUE
< L'ON TESTE (A,B), (B,C) OU (C,A).
<
<
< RESULTAT :
< (Y)='EXIST' SI LE SEGMENT EST A CHEVAL SUR
< LE REBOUCLAGE DU TORE POUR
< 'U' OU 'V' SUIVANT LE MODULE
< APPELE,
< ='NEXIST' DANS LE CAS CONTRAIRE.
<
<
< E N T R Y ' U ' :
<
<
SEGMU: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
LXI XPERU < (X)=INDEX DE LA PERIOD(U).
LYI EXIST < (Y)=INDICATEUR :
< ='EXIST' : (A,B,C) EST SUR LE REBOU-
< CLAGE DU TORE,
< ='NEXIST' : (A,B,C) EST "NORMAL"...
CPI XSEGAB < EST-CE (A,B) ???
JE SEGMU5 < OUI...
CPI XSEGBC < EST-CE (B,C) ???
JE SEGMU3 < OUI...
CPI XSEGCA < EST-CE (C,A) ???
JE SEGMU4 < OUI...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
JMP SEGMU2 < ET VERS LA SORTIE...
<
< POSITION DE (A,B,C)
< DANS (MIN(U),MAX(U)) :
<
SEGMU5: EQU $
FLD &AVRUAS < UA,
FSB &AVRUBS < UA-UB,
BSR AFABS < ABS(UA-UB),
FDV F05 < 2*ABS(UA-UB), ET CECI AFIN DE COMPARER
< ABS(UA-UB) A LA PERIOD(U)...
FCAM &ALTORE < ALORS, (UA-UB) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(U),MAX(U)) ???
JG SEGMU1 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUCLAGE DU TORE...
JMP SEGMU2 < OUI...
SEGMU3: EQU $
FLD &AVRUBS < UB,
FSB &AVRUCS < UB-UC,
BSR AFABS < ABS(UB-UC),
FDV F05 < 2*ABS(UB-UC), ET CECI AFIN DE COMPARER
< ABS(UB-UC) A LA PERIOD(U)...
FCAM &ALTORE < ALORS, (UB-UC) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(U),MAX(U)) ???
JG SEGMU1 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUBLAGE DU TORE...
JMP SEGMU2 < OUI...
SEGMU4: EQU $
FLD &AVRUCS < UC,
FSB &AVRUAS < UC-UA,
BSR AFABS < ABS(UC-UA),
FDV F05 < 2*ABS(UC-UA), ET CECI AFIN DE COMPARER
< ABS(UC-UA) A LA PERIOD(U)...
FCAM &ALTORE < ALORS, (UC-UA) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(U),MAX(U)) ???
JG SEGMU1 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUCLAGE DU TORE...
<
< ET RETOUR :
<
SEGMU2: EQU $
LYI NEXIST < ET BIEN, LE TRIANGLE (A,B,C) SEMBLE
< "NORMAL" :
< ABS(UU-UU)<PERIOD(U)/2, OU "UU" REPRE-
< SENTE 'UA', 'UB' ET 'UC'...
SEGMU1: EQU $
PLR A,B,X
RSR
<
<
< E N T R Y ' V ' :
<
<
SEGMV: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
LXI XPERV < (X)=INDEX DE LA PERIOD(V).
LYI EXIST < (Y)=INDICATEUR :
< ='EXIST' : (A,B,C) EST SUR LE REBOU-
< CLAGE DU TORE,
< ='NEXIST' : (A,B,C) EST "NORMAL"...
CPI XSEGAB < EST-CE (A,B) ???
JE SEGMV5 < OUI...
CPI XSEGBC < EST-CE (B,C) ???
JE SEGMV3 < OUI...
CPI XSEGCA < EST-CE (C,A) ???
JE SEGMV4 < OUI...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
JMP SEGMV2 < ET VERS LA SORTIE...
<
< POSITION DE (A,B,C)
< DANS (MIN(V),MAX(V)) :
<
SEGMV5: EQU $
FLD &AVRVAS < VA,
FSB &AVRVBS < VA-VB,
BSR AFABS < ABS(VA-VB),
FDV F05 < 2*ABS(VA-VB), ET CECI AFIN DE COMPARER
< ABS(VA-VB) A LA PERIOD(V)...
FCAM &ALTORE < ALORS, (VA-VB) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(V),MAX(V)) ???
JG SEGMV1 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUCLAGE DU TORE...
JMP SEGMV2 < OUI...
SEGMV3: EQU $
FLD &AVRVBS < VB,
FSB &AVRVCS < VB-VC,
BSR AFABS < ABS(VB-VC),
FDV F05 < 2*ABS(VB-VC), ET CECI AFIN DE COMPARER
< ABS(VB-VC) A LA PERIOD(V)...
FCAM &ALTORE < ALORS, (VB-VC) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(V),MAX(V)) ???
JG SEGMV1 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUBLAGE DU TORE...
JMP SEGMV2 < OUI...
SEGMV4: EQU $
FLD &AVRVCS < VC,
FSB &AVRVAS < VC-VA,
BSR AFABS < ABS(VC-VA),
FDV F05 < 2*ABS(VC-VA), ET CECI AFIN DE COMPARER
< ABS(VC-VA) A LA PERIOD(V)...
FCAM &ALTORE < ALORS, (VC-VA) EST-IL A CHEVAL SUR LE
< MILIEU DU SEGMENT (MIN(V),MAX(V)) ???
JG SEGMV1 < NON, EN FAIT IL EST A CHEVAL SUR LE
< REBOUCLAGE DU TORE...
<
< ET RETOUR :
<
SEGMV2: EQU $
LYI NEXIST < ET BIEN, LE TRIANGLE (A,B,C) SEMBLE
< "NORMAL" :
< ABS(VV-VV)<PERIOD(V)/2, OU "VV" REPRE-
< SENTE 'VA', 'VB' ET 'VC'...
SEGMV1: EQU $
PLR A,B,X
RSR
PAGE
<
<
< G E S T I O N D E L ' E S P A C E D E S
< C O O R D O N N E E S C U R V I L I G N E S :
<
<
< FONCTION :
< L'ESPACE DES COORDONNEES
< CURVILIGNES (U,V) EST EN GENE-
< RAL UN TORE ; DANS CES CONDITIONS,
< N'ETANT PAS UN PLAN, ON PEUT
< RENCONTRER DES DIFFICULTES LORS
< DES INTERPOLATIONS DANS UN TRIAN-
< GLE (A,B,C).
< PAR EXEMPLE, SOIT POUR LA COOR-
< DONNEE 'U', UNE PERIODE DE 2*PI,
< ET UNE DEFINITION DANS LE SEG-
< MENT (-PI,+PI) ; DONNONS NOUS
< ALORS :
<
< UA=-(PI-EPS(A)),
< UB=+(PI-EPS(B)),
< OU 'EPS' SIGNIFIE 'EPSILON'.
<
< UNE INTERPOLATION LINERAIRE SIM-
< PLISTE DONNERA DES RESULTATS
< FANTAISISTES ; PAR EXEMPLE LA
< MOYENNE ARITHMETIQUE DONNERA :
<
< UM=(UA+UB)/2,
< UM=(-(PI-EPS(A))+(PI-EPS(B)))/2,
< UM=(EPS(A)-(EPS(B))/2,
<
< 'UM' EST ALORS UN NOMBRE VOISIN
< DE ZERO, ET QUI N'EST DONC PAS
< COMPRIS ENTRE 'UA' ET 'UB' SUR
< LE TORE DES COORDONNEES...
<
< LA SOLUTION EST DONC DE TRANS-
< LATER LES COORDONNEES CURVILIGNES
< INFERIEURES AU MILIEU 'MIL' DU SEGMENT
< (MIN,MAX) D'UNE QUANTITE EGALE A
< LA PERIODE, PUIS APRES LE CALCUL
< DES INTERPOLATIONS, DE RETRANCHER
< CETTE MEME PERIODE DES COORDONNEES
< RESULTANTES QUI SORTIRAIENT
< DE L'INTERVALLE DE DEFINITION
< (MIN,MAX) DE LA COORDONNEE EN
< CAUSE.
< MAIS CECI NE PEUT ETRE FAIT
< DANS L'ABSOLU : C'EST POURQUOI
< 'PERIU' ET 'PERIV' RECOIVENT
< L'ARGUMENT (Y), QUI EN GENERAL
< PREND EN COMPTE LA POSITION DU
< TRIANGLE (A,B,C) PAR RAPPORT
< AU SEGMENT (MIN( ),(MAX( ))...
<
<
< ARGUMENT :
< (A,B)=COORDONNEE CURVILIGNE RESULTANT
< D'UNE INTERPOLATION OU D'UNE ITERATION,
< (Y)=(POUR 'PERIU' ET PERIV' UNIQUEMENT)
< ='EXIST' : FAIRE LE TRAITEMENT DEMANDE,
< ='NEXIST' : NE RIEN FAIRE.
<
<
< RESULTAT :
< (A,B)=COORDONNEE CURVILIGNE DANS
< LE SEGMENT APPROPRIE :
< (MIL,MAX) : POUR 'PERIU' ET 'PERIV',
< (MIN,MAX) : POUR 'PSEGU' ET 'PSEGV'.
<
<
< M I S E D E ' U ' D A N S L E S E G M E N T
< ( M I L U , M A X U ) :
<
<
PERIU: EQU $
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZR Y < FAUT-IL FAIRE QUELQUE CHOSE ???
JE PERIU3 < NON, ON SORT IMMEDIATEMENT...
PSR X < OUI :
PERIU2: EQU $
LXI XMILU
FCAM &ALTORE < LA COORDONNEE CURVILIGNE 'U' EST-ELLE
< DANS LE SEGMENT (MIN,MIL) ???
JGE PERIU1 < NON, ON LA LAISSE INTACTE...
LXI XPERU < OUI :
FAD &ALTORE < ON LA TRANSLATE DE LA PERIODE...
JMP PERIU2 < ET ON ITERE EVENTUELLEMENT...
PERIU1: EQU $
PLR X
PERIU3: EQU $
RSR < ET RETOUR...
<
<
< M I S E D E ' V ' D A N S L E S E G M E N T
< ( M I L V , M A X V ) :
<
<
PERIV: EQU $
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZR Y < FAUT-IL FAIRE QUELQUE CHOSE ???
JE PERIV3 < NON, ON SORT IMMEDIATEMENT...
PSR X < OUI :
PERIV2: EQU $
LXI XMILV
FCAM &ALTORE < LA COORDONNEE CURVILIGNE 'V' EST-ELLE
< DANS LE SEGMENT (MIN,MIL) ???
JGE PERIV1 < NON, ON LA LAISEE INTACTE...
LXI XPERV < OUI :
FAD &ALTORE < ON LA TRANSLATE DE LA PERIODE...
JMP PERIV2 < ET ON ITERE EVENTUELLEMENT...
PERIV1: EQU $
PLR X
PERIV3: EQU $
RSR < ET RETOUR...
<
<
< M I S E D E ' U ' D A N S L E S E G M E N T
< ( M I N U , M A X U ) :
<
<
PSEGU: EQU $
<
< INITIALISATIONS :
<
PSR X
<
< TEST D'AU-DELA DE 'MAXU' :
<
PSEGU3: EQU $
LXI XMAXU
FCAM &ALTORE < 'U' REBOUCLE-T'ELLE SUR LE TORE ???
JLE PSEGU1 < NON...
LXI XPERU < OUI :
FSB &ALTORE < ON LUI RETRANCHE LA PERIOD(U)...
JMP PSEGU3 < ET ON ITERE EVENTUELLEMENT...
PSEGU1: EQU $
<
< TEST D'EN-DECA DE 'MINU' :
<
PSEGU4: EQU $
LXI XMINU
FCAM &ALTORE < 'U' REBOUCLE-T'IL SUR LE TORE ???
JGE PSEGU2 < NON...
LXI XPERU < OUI :
FAD &ALTORE < ON LUI AJOUTE LA PERIOD(U)...
JMP PSEGU4 < ET ON ITERE EVENTUELLEMENT...
PSEGU2: EQU $
<
< ET RETOUR :
<
PLR X
RSR
<
<
< M I S E D E ' V ' D A N S L E S E G M E N T
< ( M I N V , M A X V ) :
<
<
PSEGV: EQU $
<
< INITIALISATIONS :
<
PSR X
<
< TEST D'AU-DELA DE 'MAXV' :
<
PSEGV3: EQU $
LXI XMAXV
FCAM &ALTORE < 'V' REBOUCLE-T'ELLE SUR LE TORE ???
JLE PSEGV1 < NON...
LXI XPERV < OUI :
FSB &ALTORE < ON LUI RETRANCHE LA PERIOD(V)...
JMP PSEGV3 < ET ON ITERE EVENTUELLEMENT...
PSEGV1: EQU $
<
< TEST D'EN-DECA DE 'MINV' :
<
PSEGV4: EQU $
LXI XMINV
FCAM &ALTORE < 'U' REBOUCLE-T'IL SUR LE TORE ???
JGE PSEGV2 < NON...
LXI XPERV < OUI :
FAD &ALTORE < ON LUI AJOUTE LA PERIOD(V)...
JMP PSEGV4 < ET ON ITERE EVENTUELLEMENT...
PSEGV2: EQU $
<
< ET RETOUR :
<
PLR X
RSR
PAGE
<
<
< C A L C U L D U P O I N T D ' I N T E R S E C T I O N
< E N T R E L A D R O I T E ' D ' E T L A S U R F A C E
< C O U R A N T E ' S ' :
<
<
< FONCTION :
< CE MODULE EXPLOITE LES
< RESULTATS DE 'INTDP' QUI A
< DETERMINE L'INTERSECTION
< ENTRE LA DROITE 'D' ET L'UNE
< DES FACETTES D'APPROXIMATION
< DE LA SURFACE 'S'.
< ON NOTERA QUE L'ON FAIT
< L'HYPOTHESE SUIVANTE : IL
< N'Y A QU'UNE SEULE SOLUTION (U,V)
< DANS UNE MAILLE TRIANGULAIRE
< (A,B,C)...
<
< SOIT LA SURFACE 'S' :
<
< X=X(U,V),
< Y=Y(U,V),
< Z=Z(U,V).
<
< ET LA DROITE 'D' :
<
< X=XD+RHO*VX,
< Y=YD+RHO*VY,
< Z=ZD+RHO*VZ.
<
< POUR CALCULER : 'M'='D'.INTER.'S', IL
< FAUT DONC RESOUDRE LE SYSTEME :
<
< X(U,V)=XD+RHO*VX,
< Y(U,V)=YD+RHO*VY,
< Z(U,V)=ZD+RHO*VZ.
<
< LES INCONNUES ETANT (U,V,RHO).
< DEVELOPPONS LES 3 FONCTIONS 'X',
< 'Y' ET 'Z' A L'AIDE DES DERIVEES
< PARTIELLES :
<
< X(U,V)=X(U0,V0)+(U-U0)*DX(U0,V0)/DU+(V-V0)*DX(U0,V0)/DV,
< Y(U,V)=Y(U0,V0)+(U-U0)*DY(U0,V0)/DU+(V-V0)*DY(U0,V0)/DV,
< Z(U,V)=Z(U0,V0)+(U-U0)*DZ(U0,V0)/DU+(V-V0)*DZ(U0,V0)/DV.
<
< POSONS :
< U=U0+$U,
< V=V0+$V,
< RHO=RHO0+$RHO,
<
< LE SYSTEME S'ECRIT ALORS :
<
< DX(U0,V0)/DU*$U+DX(U0,V0)/DV*$V-VX*$RHO=XD+RHO0*VX-X(U0,V0)
< DY(U0,V0)/DV*$U+DY(U0,V0)/DV*$V-VY*$RHO=YD+RHO0*VY-Y(U0,V0)
< DZ(U0,V0)/DV*$U+DZ(U0,V0)/DV*$V-VZ*$RHO=ZD+RHO0*VZ-Z(U0,V0)
<
< SOIT SOUS FORME MATRICIELLE :
<
< I DX(U0,V0)/DU DX(U0,V0)/DV -VX I I $U I I XD+RHO0*VX-X(U0,V0) I
< I DY(U0,V0)/DU DY(U0,V0)/DV -VY I * I $V I = I YD+RHO0*VY-Y(U0,V0) I
< I DZ(U0,V0)/DU DZ(U0,V0)/DV -VZ I I$RHOI I ZD+RHO0*VZ-Z(U0,V0) I
<
< LA RESOLUTION VA SE FAIRE
< A L'AIDE D'UNE METHODE ITERA-
< TIVE, DU TYPE :
<
< U0 <-- U0+$U,
< V0 <-- V0+$V,
< RHO0 <-- RHO0+$RHO,
<
< TANT QUE :
< I $U I
< I $V I > EPSILON
< I$RHOI
<
<
< ARGUMENTS :
< LA DROITE 'D',
< LA SURFACE 'S'.
<
<
< RESULTATS :
< SINTER='NEXIST' SI LE POINT D'INTERSECTION
< N'EXISTE PAS,
< ='EXIST' S'IL EXISTE (FXS,FYS,FZS).
< INDICATEURS POSITIONNES PAR UN 'CPZ SINTER'.
<
<
INTDS: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X,Y
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE 'STZ' SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
STZ SINTER < PAS D'INTERSECTION A PRIORI ENTRE 'D'
< ET 'S' (INITIALISATION REDONDANTE AVEC
< CELLE FAITE DANS 'INTDP'...).
CPZ PINTER < Y-A-T'IL UNE INTERSECTION ENTRE LA
< FACETTE COURANTE ET LA DROITE 'D' ???
IF NEXIST-K,,XEIF%,
IF ATTENTION : CE TEST EST IDIOT !!!
XEIF%: VAL ENDIF
JNE INTDS2 < OUI, ALLONS TRAITER L'INTERSECTION
< COMPLETE AVEC LA SURFACE 'S' ???
BSR AGOTO
WORD INTDS7 < NON, RIEN A FAIRE...
INTDS2: EQU $
<
<
< P E R T U R B A T I O N I N I T I A L E D E L A
< S O L U T I O N I N I T I A L E ' M ' :
<
<
< FONCTION :
< IL EST EVIDENT QUE SI LA DROITE
< 'D' EST QUASI-ORTHOGONALE AU PLAN
< 'P' DE LA FACETTE, LA SOLUTION INI-
< TIALE (UM,VM) EST TRES PROCHE DE LA
< SOLUTION EXACTE, ET QU'A L'OPPOSE,
< SI LA DROITE 'D' EST TRES INCLINEE
< PAR RAPPORT AU PLAN 'P', LA SOLUTION
< INITIALE (UM,VM) EST TRES ELOIGNEE
< DE LA SOLUTION EXACTE...
< ON VA DONC ICI DEPLACER LA SOLU-
< TION INITIALE SUIVANT LA PROJECTION
< ORIENTEE DE 'D' SUR 'P' :
<
< 1 - PROJECTION DE 'D' SUR 'P' : '$' VA
< DESIGNER LE PRODUIT VECTORIEL, 'NP' LE
< VECTEUR NORMAL (PLANA,PLANB,PLANC) AU
< PLAN 'P', ET 'VD' LE VECTEUR DIRECTEUR
< DE LA DROITE 'D' ; DANS CES CONDITIONS :
<
< - VD$NP EST ORTHOGONAL AU PLAN (NP,D),
< - NP$(VD$NP) EST DONC UN VECTEUR DU PLAN
< 'P' ET DU PLAN (NP,D), IL DEFINIT DONC LA
< PROJECTION DE 'D' SUR 'P'.
<
< 2 - PERTURBATION DU POINT 'M' : ON VA
< DEPLACER 'M' LE LONG DE LA PROJECTION
< DE 'D' SUR 'P' D'UN VECTEUR COLINEAIRE
< A NP$(VD$NP), CE QUI DONNE LE POINT
< 'MP' (XMP,YMP,ZMP).
<
< 3 - PUIS CALCUL DES COORDONNEES BARY-
< CENTRIQUES GENERALISEES (ALPHAP,BETAP,
< GAMMAP) DU POINT 'MP' TELLES QUE :
<
< ALPHAP*XA+BETAP*XB+GAMMAP*XC=XMP,
< ALPHAP*YA+BETAP*YB+GAMMAP*YC=YMP,
< ALPHAP*ZA+BETAP*ZB+GAMMAP*ZC=ZMP,
< ALPHAP +BETAP +GAMMAP =1,
< ET :
< (ALPHA,BETA,GAMMA) ETANT CETTE FOIS
< DES NOMBRES REELS QUELCONQUES, NON
< RESTREINTS A (0,1), PUISQUE LA SOLU-
< TION PERTURBEE 'MP' N'EST PAS NECESSAI-
< REMENT DANS LE TRIANGLE (A,B,C)...
< NOTONS QUE LE SYSTEME PRECEDENT
< CONTIENT QUATRE EQUATIONS POUR TROIS
< INCONNUES ; CELA N'EST PAS GENANT
< PUISQUE 'MP' APPARTIENT AU PLAN
< (A,B,C), CE QUI FAIT QU'IL EXISTE
< UNE RELATION LINEAIRE ENTRE LES
< TROIS PREMIERE EQUATIONS...
<
< 4 - ENFIN, CALCUL D'UNE NOUVELLE
< SOLUTION INITIALE (UMP,VMP) TELLE
< QUE :
<
< UMP=ALPHAP*UA+BETAP*UB+GAMMAP*UC,
< VMP=ALPHAP*VA+BETAP*VB+GAMMAP*VC.
<
<
< NOTA :
< DANS 'INTDP', ON CONTINUE
< MALGRE TOUT A CALCULER (ALPHA,
< BETA,GAMMA) AFIN D'UNE PART DE
< SAVOIR SI 'M' EST A L'INTERIEUR
< DU TRIANGLE (A,B,C), ET D'AUTRE
< PART DE PERMETTRE AINSI DE VI-
< SUALISER LA SURFACE EN TANT QU'
< ENSEMBLE DE FACETTES (VOIR L'OP-
< TION 'IVSUR')...
<
<
INTDSA: EQU $
<
< CALCUL DU VECTEUR DE
< PROJECTION DE 'D' SUR 'P' :
<
< NP$(VD$NP)=(NP*NP)*VD-(NP*VD)*NP,
<
< SOIT, PUISQUE 'NP' EST NORMALISE :
<
< NP$(VD$NP)=VD-(NP*VD)*NP.
<
< ET TRANSLATION 'M' --> 'MP' :
<
LXI XEPSU
FLD &ALTORE < EPS(U),
LXI XEPSV
FMP &ALTORE < EPS(U)*EPS(V),
BSR ARAC < RAC(EPS(U)*EPS(V)), SOIT LA MOYENNE GEO-
< METRIQUE DE EPS(U) ET EPS(V),
FMP FPERSI < QUE L'ON PONDERE,
IF XITYPE-K,XEIF%,,XEIF%
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ FTYPE < QUEL EST LE TYPE DE LA FACETTE COURANTE ?
JE INTDSJ < "EXTERNE"...
BSR AFNEG < "INTERNE" : N'OUBLIONS PAS QUE L'ERREUR
< COMMISE POUR LES FACETTES "INTERNES" EST
< A L'INVERSE DE CELLE DES FACETTES
< "EXTERNES" COMME LE MONTRE AISEMENT UN
< PETIT DESSIN...
INTDSJ: EQU $
FMP FK < AFIN D'ETRE HOMOTHETIQUE...
#/FST# FWORK1 < ET QUE L'ON MET TEMPORAIREMENT DANS
< 'FWORK1'...
LRM A,B
WORD PLAN3D < (A)=ADRESSE DU VECTEUR NORMAL 'NP' A 'P',
WORD DV3D < (B)=ADRESSE DU VECTEUR DIRECTEUR 'VD'
< DE LA DROITE 'D',
BSR APRSCA < (A,B)=PRODUIT SCALAIRE (NP*VD),
BSR AFNEG < (A,B)=-(NP*VD),
BSR ASFWOR < ET SAVE :
< FWORK=-(NP*VD).
< NOTONS :
< NP=(XN,YN,ZN),
< VD=(VX,VY,VZ).
FMP PLANA < -(NP*VD)*XN,
FAD DVX < VX-(NP*VD)*XN,
FMP FWORK1 < FACTEUR D'ECHELLE HOMOTHETIQUE,
FAD FXSM < ET TRANSLATION
#/FST# FXSM < DE 'M' --> 'MP'.
#/FLD# FWORK < -(NP*VD),
FMP PLANB < -(NP*VD)*YN,
FAD DVY < VY-(NP*VD)*YN,
FMP FWORK1 < FACTEUR D'ECHELLE HOMOTHETIQUE,
FAD FYSM < ET TRANSLATION
#/FST# FYSM < DE 'M' --> 'MP'.
#/FLD# FWORK < -(NP*VD),
FMP PLANC < -(NP*VD)*ZN,
FAD DVZ < VZ-(NP*VD)*ZN,
FMP FWORK1 < FACTEUR D'ECHELLE HOMOTHETIQUE,
FAD FZSM < ET TRANSLATION
#/FST# FZSM < DE 'M' --> 'MP'.
<
< INITIALISATION GENERALE
< DU CALCUL DES COORDONNEES
< BARYCENTRIQUES GENERALISEES
< (ALPHAP,BETAP,GAMMAP) (MISE
< EN FAIT DANS (ALPHA,BETA,
< GAMMA)) DE LA SOULTION
< PERTURBEE 'MP' :
<
LAD F1
STA AM31 < M31 --> 1 (TOUJOURS),
STA AM32 < M32 --> 1 (TOUJOURS),
STA AM33 < M33 --> 1 (TOUJOURS),
#/FLD# F1
#/FST# M34 < M34 --> 1 (TOUJOURS).
LAD ALPHA
STA AVARX < PREMIERE VARIABLE : ALPHAP (NOTEE ALPHA),
LAD BETA
STA AVARY < DEUXIEME VARIABLE : BETAP (NOTEE BETA),
LAD GAMMA
STA AVARZ < TROISIEME VARIABLE : GAMMAP (NOTEE GAMMA)
<
< PREMIERE TENTATIVE : ON
< VA ESSAYER DE RESOUDRE
< LE SYSTEME 3*3 :
<
< ALPHAP*XA+BETAP*XB+GAMMAP*XC=XMP,
< ALPHAP*YA+BETAP*YB+GAMMAP*YC=YMP,
< ALPHAP +BETAP +GAMMAP =1.
<
LAD FXSA
STA AM11 < M11 --> XA,
LAD FXSB
STA AM12 < M12 --> XB,
LAD FXSC
STA AM13 < M13 --> XC,
#/FLD# FXSM
#/FST# M14 < M14 --> XMP.
LAD FYSA
STA AM21 < M21 --> YA,
LAD FYSB
STA AM22 < M22 --> YB,
LAD FYSC
STA AM23 < M23 --> YC,
#/FLD# FYSM
#/FST# M24 < M24 --> YMP.
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < ON EST OBLIGE DE CALCULER LE DETERMI-
< NANT AVANT, CAR EN EFFET LE MODULE
< DE RESOLUTION 'ACRAMR' CONSIDERE SA
< NULLITE COMME UNE ERREUR PROGRAMME...
< LE DETERMINANT DU SYSTEME COURANT
< EST-IL NUL ???
JE INTDSC < OUI, CHANGEONS DE SYSTEME...
BSR ACRAMR < NON, CALCULONS (ALPHAP,BETAP,GAMMAP)
< QUE L'ON MET DANS (ALPHA,BETA,GAMMA)...
BSR ATSFLO
JMP INTDSH < ET VERS LE CALCUL DE (UMP,VMP)...
<
< DEUXIEME TENTATIVE : ON
< VA ESSAYER DE RESOUDRE
< LE SYSTEME 3*3 :
<
< ALPHAP*XA+BETAP*XB+GAMMAP*XC=XMP,
< ALPHAP*ZA+BETAP*ZB+GAMMAP*ZC=ZMP,
< ALPHAP +BETAP +GAMMAP =1.
<
INTDSC: EQU $
LAD FZSA
STA AM21 < M21 --> ZA,
LAD FZSB
STA AM22 < M22 --> ZB,
LAD FZSC
STA AM23 < M23 --> ZC,
#/FLD# FZSM
#/FST# M24 < M24 --> ZMP.
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < ON EST OBLIGE DE CALCULER LE DETERMI-
< NANT AVANT, CAR EN EFFET LE MODULE
< DE RESOLUTION 'ACRAMR' CONSIDERE SA
< NULLITE COMME UNE ERREUR PROGRAMME...
< LE DETERMINANT DU SYSTEME COURANT
< EST-IL NUL ???
JE INTDSD < OUI, CHANGEONS DE SYSTEME...
BSR ACRAMR < NON, CALCULONS (ALPHAP,BETAP,GAMMAP)
< QUE L'ON MET DANS (ALPHA,BETA,GAMMA)...
BSR ATSFLO
JMP INTDSH < ET VERS LE CALCUL DE (UMP,VMP)...
<
< TROISIEME TENTATIVE : ON
< VA ESSAYER DE RESOUDRE
< LE SYSTEME 3*3 :
<
< ALPHAP*YA+BETAP*YB+GAMMAP*YC=YMP,
< ALPHAP*ZA+BETAP*ZB+GAMMAP*ZC=ZMP,
< ALPHAP +BETAP +GAMMAP =1.
<
INTDSD: EQU $
LAD FYSA
STA AM11 < M11 --> YA,
LAD FYSB
STA AM12 < M12 --> YB,
LAD FYSC
STA AM13 < M13 --> YC,
#/FLD# FYSM
#/FST# M14 < M14 --> YMP.
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < ON EST OBLIGE DE CALCULER LE DETERMI-
< NANT AVANT, CAR EN EFFET LE MODULE
< DE RESOLUTION 'ACRAMR' CONSIDERE SA
< NULLITE COMME UNE ERREUR PROGRAMME...
< LE DETERMINANT DU SYSTEME COURANT
< EST-IL NUL ???
JE INTDSG < OUI, PETIT PROBLEME...
BSR ACRAMR < NON, CALCULONS (ALPHAP,BETAP,GAMMAP)
< QUE L'ON MET DANS (ALPHA,BETA,GAMMA)...
BSR ATSFLO
JMP INTDSH < ET VERS LE CALCUL DE (UMP,VMP)...
<
< CAS OU TOUS LES DETER-
< MINANTS SONT NULS :
<
INTDSG: EQU $
QUIT XXQUIT < E R R E U R P R O G R A M E ...
< NOTA : (ALPHA,BETA,GAMMA) SONT
< ALORS INCHANGES...
<
< CALCUL DE LA NOUVELLE
< SOLUTION INITIALE PER-
< TURBEE (UMP,VMP) NOTEE
< (UM,VM) :
<
INTDSH: EQU $
BSR APUVM < CALCUL DE (VARUM,VARVM).
#/FLD# VARUM
#/FST# VARU0 < SAUVEGARDE DE LA SOLUTION INITIALE :
< UM --> U0,
LX FOCTA < (X)=OCTANT DE LA FACETTE,
ADRI XEPSU0,X < CONVERSION EN UN INDEX FLOTTANT,
FAD &ALTORE < ET PERTURBATION HEURISTIQUE...
BSR APSEGU
#/FST# VARUM < D'OU LA NOUVELLE SOLUTION INITIALE :
< UM=U0+DU0...
#/FLD# VARVM
#/FST# VARV0 < SAUVEGARDE DE LA SOLUTION INITIALE :
< VM --> V0,
ADRI XEPSV0-XEPSU0,X < PROGRESSION DE L'INDEX FLOTTANT,
FAD &ALTORE < ET PERTURBATION HEURISTIQUE...
BSR APSEGV
#/FST# VARVM < D'OU LA NOUVELLE SOLUTION INITIALE :
< VM=V0+DV0...
<
<
< P R O C E S S U S I T E R A T I F " N O R M A L "
< E T L O R S D E S " M A U V A I S E S
< C O N V E R G E N C E S " :
<
<
INTDSW: EQU $
<
< INITIALISATION DU DETEC-
< TEUR DE CONVERGENCE :
<
LRM X
WORD MAXCO1 < (X)=NOMBRE MAXIMAL D'ITERATIONS DE LA
< RELANCE LORS DES CONVERGENCES VERS
< UNE MAUVAISE RACINE...
INTDS1: EQU $
PSR X < SAUVEGARDE DE 'MAXCO1'...
<
< INITIALISATION DU MODULE
< DE RESOLUTION DES SYSTEMES
< LINEAIRES 3*3, INITIALI-
< SATION DES COEFFICIENTS :
<
LAD M11
STA AM11
LAD M12
STA AM12
LAD M13
STA AM13
LAD M21
STA AM21
LAD M22
STA AM22
LAD M23
STA AM23
LAD M31
STA AM31
LAD M32
STA AM32
LAD M33
STA AM33
<
< INITIALISATION DU MODULE
< DE RESOLUTION DES SYSTEMES
< LINEAIRES 3*3, INITIALI-
< SATION DES VARIABLES :
<
LAD DVARU
STA AVARX < PREMIERE VARIABLE : $U,
LAD DVARV
STA AVARY < DEUXIEME VARIABLE : $V,
LAD DRHO
STA AVARZ < TROISIEME VARIABLE : $RHO.
<
< MISE EN PLACE DU VECTEUR
< COLONNE (M13,M23,M33) QUI
< NE CHANGE JAMAIS :
<
#/FLD# DVX
BSR AFNEG
#/FST# M13 < M13=-VX,
#/FLD# DVY
BSR AFNEG
#/FST# M23 < M23=-VY,
#/FLD# DVZ
BSR AFNEG
#/FST# M33 < M33=-VZ.
<
< INITIALISATION DES
< VARIABLES COURANTES
< A PARTIR DU POINT 'M' :
<
#/FLD# VARUM
#/FST# VARU < U <-- U(M),
#/FLD# VARVM
#/FST# VARV < V <-- V(M),
#/FLD# FRHOM
#/FST# FRHO < RHO <-- RHO(M).
IF XOPT01-EXIST,XOPT1,,XOPT1
<
< INITIALISATION EVENTUELLE
< DU SUIVI DE LA CONVERGENCE :
<
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST QUI SUIT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IWCONV < LA VISUALISATION DE LA CONVERGENCE
< EST-ELLE DEMANDEE ???
JE INTDST < NON...
BSR ASPXP
#/FST# FXS < FXS=X(U0,V0),
BSR ASPYP
#/FST# FYS < FYS=Y(U0,V0),
BSR ASPZP
#/FST# FZS < FZS=Z(U0,V0).
XWOR%1: VAL SIZXVI/XC512 < X-FACTEUR DE PASSAGE '512' --> 'VISU',
XWOR%2: VAL SIZYVI/XL512 < Y-FACTEUR DE PASSAGE '512' --> 'VISU'.
IF XWOR%1-XWOR%2,,XEIF%,
IF ATTENTION : LE CALCUL DE 'FACT' EST IDIOT !!!
XEIF%: VAL ENDIF
#/FLD# FACT
PSR A,B < SAUVEGARDE DE 'FACT'...
LRM A,B
FLOAT <XWOR%1?XWOR%2<K<K
#/FST# FACT < FACTEUR D'ECHELLE POUR LE TRACE GRA-
< PHIQUE SUR VISU...
BSR APROJ < PROJECTION DU POINT COURANT :
< (FXS,FYS,FZS) --> (XS,YS)...
PLR A,B
#/FST# FACT < ET RESTAURATION DE 'FACT'...
BSR ASP4 < MISE EN PLACE DU PREMIER POINT DU SUIVI
< DE LA CONVERGENCE.
QUIT XXQUIT < OUI, ON S'ARRETE A CHAQUE NOUVELLE
< SERIE D'ITERATIONS, PUIS AU RETOUR :
LAD DEMOG
SVC < DECHAINAGE GRAPHIQUE,
LRM A
WORD DEMWD2
SVC < ET MISE EN MODE TIRETES...
INTDST: EQU $
XOPT1: VAL ENDIF
<
< PREPARATION DU TEST DE
< NON CONVERGENCE DE LA
< METHODE DE NEWTON :
<
LRM X
WORD MAXCO2 < (X)=NOMBRE DE BOUCLES D'ITERATION
< MAXIMUM AVANT DE DECRETER LA NON-
< CONVERGENCE DE L'ALGORITHME...
<
<
< R E S O L U T I O N I T E R A T I V E :
<
<
INTDS3: EQU $
PSR X < SAVE LE DETECTEUR DE NON CONVERGENCE...
<
< CALCUL DES DERIVEES
< PARTIELLES DE X(U,V) :
<
LXI XVARU < (X)=VARIABLE DE DERIVATION (U),
LYI XSPX < (Y)=FONCTION A DERIVER (X(U,V)),
LAD FHU < (A)=ADRESSE DU PAS DE DERIVATION.
BSR ADERIP
#/FST# M11 < M11=DX(U0,V0)/DU.
LXI XVARV < (X)=VARIABLE DE DERIVATION (V),
< (Y)=FONCTION A DERIVER (X(U,V)),
LAD FHV < (A)=ADRESSE DU PAS DE DERIVATION.
BSR ADERIP
#/FST# M12 < M12=DX(U0,V0)/DV.
<
< CALCUL DES DERIVEES
< PARTIELLES DE Y(U,V) :
<
LXI XVARU < (X)=VARIABLE DE DERIVATION (U),
LYI XSPY < (Y)=FONCTION A DERIVER (Y(U,V)),
LAD FHU < (A)=ADRESSE DU PAS DE DERIVATION.
BSR ADERIP
#/FST# M21 < M21=DY(U0,V0)/DU.
LXI XVARV < (X)=VARIABLE DE DERIVATION (V),
< (Y)=FONCTION A DERIVER (Y(U,V)),
LAD FHV < (A)=ADRESSE DU PAS DE DERIVATION.
BSR ADERIP
#/FST# M22 < M22=DY(U0,V0)/DV.
<
< CALCUL DES DERIVEES
< PARTIELLES DE Z(U,V) :
<
LXI XVARU < (X)=VARIABLE DE DERIVATION (U),
LYI XSPZ < (Y)=FONCTION A DERIVER (Z(U,V)),
LAD FHU < (A)=ADRESSE DU PAS DE DERIVATION.
BSR ADERIP
#/FST# M31 < M31=DZ(U0,V0)/DU.
LXI XVARV < (X)=VARIABLE DE DERIVATION (V),
< (Y)=FONCTION A DERIVER (Z(U,V)),
LAD FHV < (A)=ADRESSE DU PAS DE DERIVATION.
BSR ADERIP
#/FST# M32 < M32=DZ(U0,V0)/DV.
<
< CALCUL DES SECONDS
< MEMBRES (M14,M24,M34) :
<
BSR ASPXP < X(U0,V0),
#/FST# FXS < FXS=X(U0,V0),
#/FLD# FRHO < RHO0,
FMP DVX < RHO0*VX,
FAD FXSD < XD+RHO0*VX,
FSB FXS < XD+RHO0*VX-X(U0,V0),
#/FST# M14 < M14=XD+RHO0*VX-X(U0,V0).
BSR ASPYP < Y(U0,V0),
#/FST# FYS < FYS=Y(U0,V0),
#/FLD# FRHO < RHO0,
FMP DVY < RHO0*VY,
FAD FYSD < YD+RHO0*VY,
FSB FYS < YD+RHO0*VY-Y(U0,V0),
#/FST# M24 < M24=YD+RHO0*VY-Y(U0,V0).
BSR ASPZP < Z(U0,V0),
#/FST# FZS < FZS=Z(U0,V0),
#/FLD# FRHO < RHO0,
FMP DVZ < RHO0*VZ,
FAD FZSD < ZD+RHO0*VZ,
FSB FZS < ZD+RHO0*VZ-Z(U0,V0),
#/FST# M34 < M34=ZD+RHO0*VZ-Z(U0,V0).
IF XOPT01-EXIST,XOPT1,,XOPT1
<
< TRACE DE LA CONVERGENCE :
<
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST QUI SUIT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IWCONV < LE TRACE DE CONVERGENCE EST-IL DEMANDE ??
JE INTDSR < NON...
BSR APROJ < OUI :
XWOR%1: VAL SIZXVI/XC512 < X-FACTEUR DE PASSAGE '512' --> 'VISU',
XWOR%2: VAL SIZYVI/XL512 < Y-FACTEUR DE PASSAGE '512' --> 'VISU'.
IF XWOR%1-XWOR%2,,XEIF%,
IF ATTENTION : LE CALCUL DE 'FACT' EST IDIOT !!!
XEIF%: VAL ENDIF
#/FLD# FACT
PSR A,B < SAUVEGARDE DE 'FACT'...
LRM A,B
FLOAT <XWOR%1?XWOR%2<K<K
#/FST# FACT < FACTEUR D'ECHELLE POUR LE TRACE GRA-
< PHIQUE SUR VISU...
BSR APROJ < PROJECTION 3D --> 2D DU POINT COURANT
< (FXS,FYS,FZS).
LAI EXIST
XM IWGFI < ON FORCE 'EXIST' DANS 'IWGFI' AFIN QUE
< 'SP2B' FONCTIONNE, ET ON SAUVEGARDE
< (IWGFI) DANS 'A'...
BSR ASP2B < TRACE DU SUIVI COURANT, ET CHAINAGE...
STA IWGFI < ET RESTAURATION DE 'IWGFI'...
PLR A,B
#/FST# FACT < ET RESTAURATION DE 'FACT'...
INTDSR: EQU $
XOPT1: VAL ENDIF
<
< RESOLUTION DU SYSTEME
< 3*3 COURANT :
<
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ACRAMR < ON UTILISE LA METHODE DE CRAMER...
< CE QUI DONNE ($U,$V,$RHO), SOIT
< (DVARU,DVARV,DRHO)...
BSR ATSFLO
<
< VALIDATION DE LA SOLUTION :
<
#/FLD# DVARU < $U,
BSR AFABS < ABS($U),
LXI XEPSU
FCAM &ALTORE < ABS($U) EST SUPPOSE INFERIEUR A LA
< EPS(U) :
JL INTDSK < EFFECTIVEMENT...
QUIT01: QUIT XXQUIT < E R R E U R P R O G R A M M E ...
JMP INTDSX < ET ON VA FORCER UNE NON CONVERGENCE...
INTDSK: EQU $
#/FLD# DVARV < $V,
BSR AFABS < ABS($V),
LXI XEPSV
FCAM &ALTORE < ABS($V) EST SUPPOSE INFERIEUR A LA
< EPS(V) :
JL INTDSL < EFFECTIVEMENT...
QUIT02: QUIT XXQUIT < E R R E U R P R O G R A M M E ...
INTDSX: EQU $
PLR X < RESTAURATION DU 'MAXCO2',
JMP INTDS6 < ET ON FORCE UNE NON-CONVERGENCE...
INTDSL: EQU $
<
< CALCUL DE LA NOUVELLE
< SOLUTION COURANTE :
<
#/FLD# VARU < U0,
FAD DVARU < U0+$U,
BSR APSEGU < POSITIONNEMENT SUR LE TORE...
BSR AFLEPS < TEST D'UNDERFLOW PREVISIBLE...
#/FST# VARU < U0 <-- U0+$U.
#/FLD# VARV < V0,
FAD DVARV < V0+$V,
BSR APSEGV < POSITIONNEMENT SUR LE TORE...
BSR AFLEPS < TEST D'UNDERFLOW PREVISIBLE...
#/FST# VARV < V0 <-- V0+$V.
#/FLD# FRHO < RHO0,
FAD DRHO < RHO0+$RHO,
BSR AFLEPS < TEST D'UNDERFLOW PREVISIBLE...
#/FST# FRHO < RHO0 <-- RHO0+$RHO.
<
< TEST DE CONVERGENCE :
<
PLR X < RESTAURATION DU 'MAXCO2' COURANT :
JDX INTDS5 < TEST DE NON CONVERGENCE...
<
< CAS DE LA NON CONVERGENCE :
<
INTDSQ: EQU $
PLR X < RESTAURATION DE (X)='MAXCO1', C'EST-A-
< DIRE DU 'MAXCO1' COURANT...
BSR AGOTO
WORD INTDS7 < NON, CONVERGENCE : CELA SIGNIFIE QUE LA
< DROITE 'D' COUPE LA FACETTE COURANTE,
< MAIS PAS LA SURFACE 'S' AU VOISINNAGE
< DE CETTE FACETTE (CAS FREQUENT AVEC LES
< FACETTES "EXTERNES" POUR LES SURFACES
< CONVEXES...), DONC ON SORT AVEC :
< (SINTER)='NEXIST'...
<
< CAS DE LA "PEUT-ETRE"
< CONVERGENCE :
<
INTDS5: EQU $
#/FLD# DVARU < TEST DE $U,
FDV FK < HOMOTHETIE...
BSR ATSFLO
BSR AFABS < EN VALEUR ABSOLUE :
FCAM FEPSUV < 'U0' CONVERGE-T'IL ???
JG INTDS4 < NON, ON ITERE...
#/FLD# DVARV < TEST DE $V,
FDV FK < HOMOTHETIE...
BSR ATSFLO
BSR AFABS < EN VALEUR ABSOLUE :
FCAM FEPSUV < 'V0' CONVERGE-T'IL ???
JG INTDS4 < NON, ON ITERE...
#/FLD# DRHO < TEST DE $RHO :
FDV FK < HOMOTHETIE...
BSR ATSFLO
BSR AFABS < EN VALEUR ABSOLUE :
FCAM FEPSUV < 'RHO0' CONVERGE-T'IL ???
JLE INTDS6 < ET OUI, LA RESOLUTION EST TERMINEE...
<
< BOUCLE D'ITERATION:
<
INTDS4: EQU $
BSR AGOTO
WORD INTDS3 < ET ON ITERE...
<
< CAS DE LA CONVERGENCE :
<
INTDS6: EQU $
PLR X < RESTAURATION DU 'MAXCO1' COURANT :
JDX INTDSI < OK, ON A ENCORE DE LA MARGE...
QUIT31: QUIT XXQUIT < N O N - C O N V E R G E N C E ...
BSR AGOTO
WORD INTDS7 < ET ON SORT, SANS AVOIR TROUVE DE
< SOLUTION...
INTDSI: EQU $
<
<
< V E R I F I C A T I O N D E L A C O N V E R G E N C E
< V E R S L A B O N N E R A C I N E :
<
<
< FONCTION :
< EN EFFET, VUE LA METHODE
< ITERATIVE UTILISEE, IL EST
< TOUJOURS POSSIBLE QUE LA ME-
< THODE CONVERGE VERS UNE AUTRE
< RACINE QUE CELLE QUE L'ON
< CHERCHE.
< POUR CE FAIRE, ON TESTE ICI
< QUE LA SOLUTION TROUVEE (VARU,VARV)
< EST INTERIEURE AU TRIANGLE (A,B,C).
< ON CALCULE ALORS LES COORDONNEES
< BARYCENTRIQUES DE LA SOLUTION
< TROUVEE (U,V) DANS (A,B,C), ON
< RESOUD DONC LE SYSTEME :
<
< ALPHA*UA+BETA*UB+GAMMA*UC=U,
< ALPHA*VA+BETA*VB+GAMMA*VC=V,
< ALPHA +BETA +GAMMA =1.
<
< PUIS ON VERIFIE QUE LES COOR-
< DONNEES TROUVEES SONT BIEN
< BARYCENTRIQUES, C'EST-A-DIRE
< QU'ELLES VERIFIENT BIEN :
<
< 0 <= ALPHA <= 1,
< 0 <= BETA <= 1,
< 0 <= GAMMA <= 1.
<
< EN FAIT, CETTE FACON DE VOIR
< LES CHOSE NE SUFFIT PAS ; EN
< EFFET, LA CONVERGENCE, LORSQUE
< LA DROITE 'D' EST ASSEZ INCLINEE
< RAPPORT A LA FACETTE COURANTE,
< PEUT AVOIR LIEU "HORS" DE LA
< FACETTE ; ON DEFINIT ALORS LA
< NOTION DE "COORDONNEES BARY-
< CENTRIQUES GENERALISEES", DEFI-
< NIES COMME CI-DESSUS, ET TELLES
< QUE :
<
< 'FBARI' <= ALPHAP <= 'FBARS',
< 'FBARI' <= BETAP <= 'FBARS',
< 'FBARI' <= GAMMAP <= 'FBARS',
<
< ET TEL QUE LE SEGMENT (0,1) DE
< DEFINITION DES COORDONNEES BARY-
< CENTRIQUES "NORMALES" SOIT INCLUS
< DANS LE SEGMENT (FBARI,FBARS) DE
< DEFINITION DES COORDONNEES BARY-
< CENTRIQUES "GENERALISEES"...
<
<
INTDS8: EQU $
<
< VERIFIONS AU PREALABLE
< QUE (U,V,RHO) EST UNE
< SOLUTION ACCEPTABLE,
< MEME SI CE N'EST PAS
< CELLE QUE L'ON ATTEN-
< DAIT :
<
BSR ASPXP < X(U,V),
BSR ASFWOR < ET SAVE...
#/FLD# FRHO < RHO,
FMP DVX < RHO*VX,
FAD FXSD < XD+RHO*VX,
FSB FWORK < (XD+RHO*XV)-X(U,V),
BSR AFABS < ABS((XD+RHO*VX)-X(U,V)),
FCAM FEPSUV < ALORS, (U,V,RHO) EST-IL PRESQUE UNE
< BONNE SOLUTION ???
JLE INTDSM < OUI, OK...
QUIT11: QUIT XXQUIT < E R R E U R D E C O N V E R G E N C E
JMP AINDS9 < ET ON FORCE UNE CONVERGENCE VERS UNE
< MAUVAISE RACINE...
INTDSM: EQU $
BSR ASPYP < Y(U,V),
BSR ASFWOR < ET SAVE...
#/FLD# FRHO < RHO,
FMP DVY < RHO*VY,
FAD FYSD < YD+RHO*VY,
FSB FWORK < (YD+RHO*XV)-Y(U,V),
BSR AFABS < ABS((YD+RHO*VY)-Y(U,V)),
FCAM FEPSUV < ALORS, (U,V,RHO) EST-IL PRESQUE UNE
< BONNE SOLUTION ???
JLE INTDSN < OUI, OK...
QUIT12: QUIT XXQUIT < E R R E U R D E C O N V E R G E N C E
JMP AINDS9 < ET ON FORCE UNE CONVERGENCE VERS UNE
< MAUVAISE RACINE...
INTDSN: EQU $
BSR ASPZP < Z(U,V),
BSR ASFWOR < ET SAVE...
#/FLD# FRHO < RHO,
FMP DVZ < RHO*VZ,
FAD FZSD < ZD+RHO*VZ,
FSB FWORK < (ZD+RHO*XV)-Z(U,V),
BSR AFABS < ABS((ZD+RHO*VZ)-Z(U,V)),
FCAM FEPSUV < ALORS, (U,V,RHO) EST-IL PRESQUE UNE
< BONNE SOLUTION ???
JLE INTDSO < OUI, OK...
QUIT13: QUIT XXQUIT < E R R E U R D E C O N V E R G E N C E
AINDS9: EQU $ < RELAI...
BSR AGOTO
WORD INTDS9 < ET ON FORCE UNE CONVERGENCE VERS UNE
< MAUVAISE RACINE...
INTDSO: EQU $
<
< INITIALISATION DU MODULE
< DE RESOLUTION DES SYSTEMES
< LINEAIRES 3*3 ; A NOTER QUE
< LES RELAIS ((AM11,AM12,AM13),
< (AM21,AM22,AM23)) SONT BONS :
<
PSR Y
<
< TEST DE LA POSITION DU TRIANGLE
< (A,B,C) PAR RAPPORT AU MILIEU DU
< SEGMENT (MIN(U),(MAX(U)) :
<
BSR ATRIGU < RENVOIE (Y)...
<
< INITIALISATION DU VECTEUR M(1) :
<
#/FLD# VARUA < UA,
BSR APERIU < POSITIONNEMENT SUR LE TORE,
#/FST# M11 < M11=UA.
#/FLD# VARUB < UB,
BSR APERIU < POSITIONNEMENT SUR LE TORE,
#/FST# M12 < M12=UB.
#/FLD# VARUC < UC,
BSR APERIU < POSITIONNEMENT SUR LE TORE,
#/FST# M13 < M13=UC.
<
< TEST DE LA POSITION DU TRIANGLE
< (A,B,C) PAR RAPPORT AU MILIEU DU
< SEGMENT (MIN(V),(MAX(V)) :
<
BSR ATRIGV < RENVOIE (Y)...
<
< INITIALISATION DU VECTEUR M(2) :
<
#/FLD# VARVA < VA,
BSR APERIV < POSITIONNEMENT SUR LE TORE,
#/FST# M21 < M21=VA.
#/FLD# VARVB < VB,
BSR APERIV < POSITIONNEMENT SUR LE TORE,
#/FST# M22 < M22=VB.
#/FLD# VARVC < VC,
BSR APERIV < POSITIONNEMENT SUR LE TORE,
#/FST# M23 < M23=VC.
<
< INITIALISATION DU VECTEUR M(3) :
<
LAD F1
STA AM31 < M31 --> 1,
STA AM32 < M32 --> 1,
STA AM33 < M33 --> 1.
<
< INITIALISATION "PHYSIQUE"
< DES SECONDS MEMBRES :
<
#/FLD# VARU
#/FST# M14 < M14=U,
#/FLD# VARV
#/FST# M24 < M24=V,
#/FLD# F1
#/FST# M34 < M34=1,
PLR Y
<
< INITIALISATION DU MODULE
< DE RESOLUTION DES SYSTEMES
< LINEAIRES 3*3, INITIALI-
< SATION DES VARIABLES :
<
ALPHAP: EQU DA < DEFINITION DE
BETAP: EQU DB < (ALPHA,BETA,GAMMA)
GAMMAP: EQU DC < PRIME.
LAD ALPHAP
STA AVARX < PREMIERE VARIABLE : 'ALPHAP',
LAD BETAP
STA AVARY < DEUXIEME VARIABLE : 'BETAP',
LAD GAMMAP
STA AVARZ < TROISIEME VARIABLE : 'GAMMAP'.
<
< RESOLUTION DU SYSTEME 3*3 :
<
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ACRAMR < CALCUL DE (ALPHA,BETA,GAMMA) PAR LA
< METHODE DE CRAMER...
BSR ATSFLO
<
< LA SOLUTION (U,V) EST-ELLE
< DANS LE TRIANGLE GENERALISE
< (AP,BP,CP) DES COORDONNEES
< BARYCENTRIQUES "GENERALISEES" :
<
#/FLD# ALPHAP < TEST DE 'ALPHAP' :
FCAM FBARI < TEST PAR RAPPORT A LA BORNE INFERIEURE ?
JL INTDS9 < HORS TRIANGLE...
FCAM FBARS < TEST PAR RAPPORT A LA BORNE SUPERIEURE ?
JG INTDS9 < HORS TRIANGLE...
#/FLD# BETAP < TEST DE 'BETAP' :
FCAM FBARI < TEST PAR RAPPORT A LA BORNE INFERIEURE ?
JL INTDS9 < HORS TRIANGLE...
FCAM FBARS < TEST PAR RAPPORT A LA BORNE SUPERIEURE ?
JG INTDS9 < HORS TRIANGLE...
#/FLD# GAMMAP < TEST DE 'GAMMAP' :
FCAM FBARI < TEST PAR RAPPORT A LA BORNE INFERIEURE ?
JL INTDS9 < HORS TRIANGLE...
FCAM FBARS < TEST PAR RAPPORT A LA BORNE SUPERIEURE ?
JLE INTDS0 < SUPER... LA SOLUTION (U,V) EST RESTEE
< DANS LE TRIANGLE (AP,BP,CP), ON ESTIME
< A JUSTE TITRE QUE LE PROCESSUS A
< CONVERGE VERS LA RACINE CHERCHEE...
<
<
< C A S D E L A C O N V E R G E N C E V E R S
< L A M A U V A I S E R A C I N E :
<
<
INTDS9: EQU $
<
< CAS DE CONVERGENCE VERS UNE
< AUTRE SOLUTION ; CE COMPOR-
< TEMENT ETANT APPAREMMENT ALEA-
< TOIRE ET IMPREVISIBLE, ON VA
< PROCEDER A UNE PERTURBATION
< DES CONDITIONS INITIALES :
< PERTURBATION DE LA SOLUTION
< INITIALE (VARUM,VARVM) ; POUR
< CELA, ON VA MODIFIE LES COOR-
< DONNEES BARYCENTRIQUES
< (ALPHA,BETA,GAMMA) DE CETTE
< SOLUTION D'UNE MANIERE FINE,
< ET EN RESTANT BIEN ENTENDU A
< L'INTERIEUR DE LA DEFINITION
< DES COORDONNEES BARYCENTRIQUES :
<
INTDSB: EQU $
<
< INITIALISATION :
<
LAD ALPHA
STA AMIN < A PRIORI : ALPHA=MIN(ALPHA,BETA,GAMMA),
LAD BETA
STA AMIL < A PRIORI : BETA=MIL(ALPHA,BETA,GAMMA),
LAD GAMMA
STA AMAX < A PRIORI : GAMMA=MAX(ALPHA,BETA,GAMMA).
<
< TRI PAR ORDRE DECROISSANT
< DES COORDONNEES BARYCENTRIQUES
< (ALPHA,BETA,GAMMA) DE LA
< SOLUTION INITIALE :
<
BSR ASPTRI < TRI(ALPHA,BETA,GAMMA)...
<
< PERTURBATION DE (ALPHA,BETA,GAMMA) ;
< ON VA DIMINUER MAX(ALPHA,BETA,GAMMA),
< AUGMENTER MIN(ALPHA,BETA,GAMMA),
< SACHANT QU'ON RESPECTE LA RELATION
< MAX+MIL+MIN=ALPHA+BETA+GAMMA=1 :
<
FLD &AMAX < MAX(ALPHA,BETA,GAMMA),
FDV FREDUC < DONT ON PRELEVE UNE FRACTION,
BSR AFLEPS < ATTENTION AUX UNDERFLOWS...
JNE INTDSE < OK...
QUIT41: QUIT XXQUIT < QUE FAIRE : CAR LA FRACTION A ETE RAMENEE
< A 0 ???
INTDSE: EQU $
BSR AFNEG
FAD &AMAX
FST &AMAX < MAX <-- (MAX)-(MAX)/FREDUC.
FLD &AMIN < MIN(ALPHA,BETA,GAMMA),
FDV FREDUC < DONT ON PRELEVE UNE FRACTION,
BSR AFLEPS < ATTENTION AUX UNDERFLOWS...
JNE INTDSF < OK...
QUIT42: QUIT XXQUIT < QUE FAIRE : CAR LA FRACTION A ETE RAMENEE
< A 0 ???
INTDSF: EQU $
FAD &AMIN
FST &AMIN < MIN <-- (MIN)+(MIN)/FREDUC.
FAD &AMAX < MIN+MAX,
FSB F1 < MIN+MAX-1,
BSR AFNEG < 1-MIN-MAX,
FST &AMIL < MIL <-- 1-(MAX)-(MIN)...
BSR ATSFLO
<
< CALCUL D'UNE NOUVELLE
< SOLUTION APPROCHEE DE
< DEPART (VARUM,VARVM) :
<
BSR APUVM < CALCUL DE (VARUM,VARVM)...
<
< CALCUL D'UNE NOUVELLE
< SOLUTION APPROCHEE DE
< DEPART (FRHOM) ; ON A
< TENDANCE A PENSER QUE
< L'ITERATEUR EST ALLE
< DANS LE MAUVAIS SENS,
< ON VA DONC TENTER D'IN-
< VERSER LE MOUVEMENT :
<
#/FLD# FRHOM < 'RHO' DE DEPART PRECEDENT, SOIT 'RHO0',
FDV F05 < 2*RHO0,
FSB FRHO < 2*RHO0-RHO,
#/FST# FRHOM < CE QUI DONNE LE NOUVEAU 'RHO0', QUI EST
< EN FAIT LE SYMETRIQUE DU 'RHO' CALCULE
< PAR RAPPORT AU 'RHO0' PRECEDENT...
<
< VERS UNE NOUVELLE ITERATION :
<
BSR AGOTO
WORD INTDS1 < APRES QUELQUES MODIFICATIONS (??!?!!???),
< ON RE-TENTE...
<
<
< C A S D E L A C O N V E R G E N C E V E R S L A
< B O N N E R A C I N E Q U E L ' O N S U P P O S E
< E T R E S E U L E D A N S L E T R I A N G L E ( A , B , C ) :
<
<
INTDS0: EQU $
<
< CONVERGENCE HEURISTIQUE :
<
#/FLD# VARU < ACCES A LA SOLUTION 'U',
FSB VARU0 < U-U0,
LXI XHEURU
FMP &ALTORE < (U-U0)*HEUR(U),
LX FOCTA < (X)=OCTANT DE LA FACETTE,
ADRI XEPSU0,X < CONVERSION EN UN INDEX FLOTTANT,
FST &ALTORE < 'DU0' POUR LE PROCHAIN COUP...
#/FLD# VARV < ACCES A LA SOLUTION 'V',
FSB VARV0 < V-V0,
LXI XHEURV
FMP &ALTORE < (V-V0)*HEUR(V),
LX FOCTA < (X)=OCTANT DE LA FACETTE,
ADRI XEPSV0,X < CONVERSION EN UN INDEX FLOTTANT,
FST &ALTORE < 'DV0' POUR LE PROCHAIN COUP...
<
< MEMORISATION DE LA CON-
< VERGENCE (POINT D'INTER-
< SECTION TROUVE) :
<
IF EXIST-K,,,XEIF%
IF ATTENTION : LE 'IC' QUI SUIT EST IDIOT !!!
XEIF%: VAL ENDIF
IC SINTER < ON A TROUVE UN POINT D'INTERSECTION ENTRE
< 'D' ET 'S', DONT ON VA METTRE LES COOR-
< DONNEES DANS (FXS,FYS,FZS)...
<
<
< C A L C U L D U P O I N T D ' I N T E R S E C T I O N
< E N T R E L A D R O I T E ' D ' E T L A S U R F A C E :
<
<
BSR ASPXP
#/FST# FXS < XM=X(U0,V0),
BSR ASPYP
#/FST# FYS < YM=Y(U0,V0),
BSR ASPZP
#/FST# FZS < ZM=Z(U0,V0).
<
< ET RETOUR :
<
INTDS7: EQU $
CPZ SINTER < POSITIONNEMENT DES INDICATEURS...
PLR A,B,X,Y
RSR
PAGE
<
<
< T E S T D ' U N D E R F L O W F L O T T A N T
< P R E V I S I B L E :
<
<
< FONCTION :
< LORS DE L'UTILISATION DE METHODES
< ITERATIVES EN PARTICULIER, LORSQUE
< LES NOMBRE FLOTTANTS CONVERGENT VERS
< LE ZERO FLOTTANT, ILS PASSENT PAR LE
< PLUS PETIT NOMBRE FLOTTANT REPRESEN-
< TABLE (E-37) ; CE SOUS-PROGRAMME
< DETECTE DONC L'APPROCHE DE SON VOI-
< SINNAGE, ET REMPLACE ALORS LE NOMBRE
< ARGUMENT PAR LE VRAI ZERO FLOTTANT...
<
<
< ARGUMENT :
< (A,B)=NOMBRE FLOTTANT A TESTER.
<
<
< RESULTAT :
< (A,B)=NOMBRE FLOTTANT EVENTUELLEMENT NUL,
< INDICATEURS POUR FAIRE UN 'JE' SI LE REMPLACEMENT
< PAR LE VRAI ZERO FLOTTANT A ETE FAIT, OU BIEN SI
< L'ARGUMENT ETAIT DEJA NUL...
<
<
< A T T E N T I O N :
< CE SOUS-PROGRAMME DETRUIT 'FWORK' !!!
<
<
FLEPS: EQU $
PSR A,B < SAUVEGARDE DU NOMBRE FLOTTANT ARGUMENT...
BSR AFABS < AFIN DE FAIRE DES TESTS EN VALEUR ABSOLUE
BSR ASFWOR < ET MISE DE ABS(ARGUMENT) DANS 'FWORK'...
LRM A,B
XWOR%1: VAL BASE10=K
XWOR%1: VAL NBITMO-B-XWOR%1 < RANG DU DERNIER BIT DE BASE10...
XWOR%1: VAL CORBT?XWOR%1=FMASK(K?BASE10=FCINST
XWOR%2: VAL XWOR%1=K
XWOR%2: VAL NBITMO-B-XWOR%2
XWOR%3: VAL CORBT?XWOR%2=FMASK(K?XWOR%1=FCINST
IF XWOR%3-K,,XEIF%,
IF ATTENTION : IL Y A PLUS DE 2 BITS A 1 DANS 'BASE10' !!!
XEIF%: VAL ENDIF
XWOR%4: VAL COSBT?XWOR%2=FMASK(K=FCINST
XWOR%4: VAL XWOR%4=K+E < 'XWOR%4' EST UNE VALEUR ENTIERE PAR
< EXCES DE LOG(BASE10) EN BASE2...
XWOR%5: VAL CORBT?BITPAR=FMASK(K?MOCD=FCINST
NTRN
XWOR%5: VAL XWOR%5/XWOR%4 < 'XWOR%5' EST UN EXPOSANT VOISIN DU
< PLUS PETIT (AVEC LE SIGNE 'MOINS') RE-
< PRESENTABLE EN FLOTTANT...
XWOR%6: VAL XWOR%5/XXXMOY < AFIN DE PREVENIR UNE EVENTUELLE ELEVA-
< TION AU CARRE (COMME C'EST PAR EXEMPLE
< LE CAS DANS 'SIN' ET 'COS' POUR 'VARU'
< ET 'VARV'...).
TRN
XWOR%6: VAL XWOR%6-W < AFIN D'AVOIR UNE MARGE DE SECURITE
< SUPPLEMENTAIRE...
FLOAT <W<K<-XWOR%6 < (A,B)=UN NOMBRE FLOTTANT TOUT PETIT
< VOISIN DU PLUS PETIT NOMBRE
< FLOTTANT REPRESENTABLE...
FCAM FWORK < ALORS, LE NOMBRE FLOTTANT ARGUMENT
< EST-IL VOISIN DE CE MINIMUM ???
PLR A,B < (A,B)=NOMBRE ARGUMENT A PRIORI...
JL FEPS1 < NON :
< ABS(ARGUMENT)>1.E-30...
#/FLD# F0 < OUI, ON REMPLACE DONC LE NOMBRE ARGUMENT
< PAR LE VRAI ZERO FLOTTANT...
FEPS1: EQU $
BSR AFCAZ < POSITIONNEMENT DES INDICATEURS POUR UN
< TEST EN RETOUR...
RSR < ET RETOUR...
PAGE
IF XOPT01-EXIST,XOPT1,,XOPT1
<
<
< V I S U A L I S A T I O N D E L' I N T E R S E C T I O N
< D E ' D ' E T ' S ' :
<
<
< FONCTION :
< CE MODULE VISUALISE SOUS
< FORME D'UN POINT (FXS,FYS,FZS)
< QUI CONTIENT L'INTERSEC-
< TION DE 'D' ET DE 'S'...
<
<
SP8S: EQU $
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IWGIDS < FAUT-IL VISUALISER CETTE INTERSECTION ???
JE SP8S1 < NON...
CPZ BINTER < OUI, MAIS Y-A-T'IL INTERSECTION ENTRE
< 'D' ET 'B' ???
JE SP8S1 < NON...
CPZ PINTER < OUI, MAIS Y-A-T'IL INTERSECTION ENTRE
< 'D' ET 'P' ???
JE SP8S1 < NON...
CPZ SINTER < OUI, ENTRE 'D' ET 'P', MAIS ENTRE 'D'
< ET 'S' ???
JE SP8S1 < NON...
<
< INITIALISATIONS :
<
PSR A,B,X
<
< PROJECTION 2D --> 3D :
<
BSR APROJ < (FXS,FYS,FZS) --> (XS,YS)...
<
< ET MISE DANS LE BUFFER
< GRAPHIQUE D'EDITION :
<
BSR ASP4 < TRANSFERT DE L'ORIGINE,
BSR ASP7 < ET DE L'EXTREMITE...
<
< ET TRACE D'UN POINT :
<
LAD DEMOG
SVC < DECHAINAGE...
LAD DEMWG
SVC < ET TRACE DU POINT...
<
< ET RETOUR :
<
PLR A,B,X
SP8S1: EQU $
RSR
XOPT1: VAL ENDIF
PAGE
IF XOPT01-EXIST,XOPT1,,XOPT1
<
<
< T R A C E D E L A N O R M A L E A U N P L A N :
<
<
< FONCTION :
< CE MODULE, POUR CHAQUE
< FACETTE DETERMINE LE BARYCENTRE
< G=(A,B,C)/3, ET EN CE POINT TRACE
< LE VECTEUR NORMAL (PLANA,PLANB,PLANC).
<
<
SP6: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
<
< CALCUL DU BARYCENTRE :
<
#/FLD# FXSA < XA,
FAD FXSB < XA+XB,
FAD FXSC < XA+XB+XC,
FDV F3 < (XA+XB+XC)/3,
BSR ATSFLO
#/FST# FXS < CE QUI DONNE XG.
#/FLD# FYSA < YA,
FAD FYSB < YA+YB,
FAD FYSC < YA+YB+YC,
FDV F3 < (YA+YB+YC)/3,
BSR ATSFLO
#/FST# FYS < CE QUI DONNE YG.
#/FLD# FZSA < ZA,
FAD FZSB < ZA+ZB,
FAD FZSC < ZA+ZB+ZC,
FDV F3 < (ZA+ZB+ZC)/3,
BSR ATSFLO
#/FST# FZS < CE QUI DONNE ZG.
BSR APROJ < PROJECTION DU BARYCENTRE,
BSR ASP4 < ET INSERTION DANS LA LISTE GRAPHIQUE.
<
< DEFINITION D'UN VECTEUR
< COLINEAIRE AU VECTEUR
< NORMAL EN 'G' :
<
#/FLD# PLANA < XN,
FMP FACTN < FN*XN,
FAD FXS < XG+FN*XN,
#/FST# FXS < CE QUI DONNE 'X'.
#/FLD# PLANB < YN,
FMP FACTN < FN*YN,
FAD FYS < YG+FN*YN,
#/FST# FYS < CE QUI DONNE 'Y'.
#/FLD# PLANC < ZN,
FMP FACTN < FN*ZN,
FAD FZS < ZG+FN*ZN,
#/FST# FZS < CE QUI DONNE 'Z'.
BSR APROJ < PROJECTION DE L'EXTREMITE DU VECTEUR
< COLINEAIRE AU VECTEUR NORMAL EN 'G',
BSR ASP7 < ET MISE DANS LA LISTE GRAPHIQUE...
<
< TRACE DU VECTEUR NORMAL :
<
LAD DEMOG
SVC < DECHAINAGE...
LRM A
WORD DEMWD1
SVC < MISE EN MODE POINTILLES...
LAD DEMWG
SVC < ET TRACE DU VECTEUR NORMAL...
LRM A
WORD DEMWD0
SVC < AFIN DE REVENIR AU TRACE NORMAL...
<
< ET RETOUR :
<
PLR A,B,X
RSR
XOPT1: VAL ENDIF
PAGE
IF XOPT01-EXIST,XOPT1,,XOPT1
<
<
< R E P R E S E N T A T I O N D E S C O O R D O N N E E S
< B A R Y C E N T R I Q U E S ,
< E T V E R I F I C A T I O N S C R O I S E E S :
<
<
< FONCTION :
< SOIT 'M' LE POINT D'INTER-
< SECTION DE LA DROITE 'D' ET
< DU PLAN 'P' ; IL A POUR COORDON-
< NEES BARYCENTRIQUES (ALPHA,
< BETA,GAMMA). ON TRACE LES 3
< VECTEURS AM, BM ET CM...
<
<
SP8: EQU $
<
< TEST D'EXISTENCE DE 'M' :
<
CPZ PINTER < LE POINT 'M' EXISTE-T'IL ET EST-IL
< INTERIEUR A LA FACETTE (A,B,C) ???
IF NEXIST-K,,XEIF%,
IF ATTENTION : CE TEST EST IDIOT !!!
XEIF%: VAL ENDIF
JE SP81 < NON, RIEN A FAIRE...
<
< INITIALISATIONS :
<
PSR A,B,X
<
< RE-CALCUL DU POINT 'M' PAR SES
< COORDONNEES BARYCENTRIQUES :
<
#/FLD# FXSA < XA,
FMP ALPHA < ALPHA*XA,
BSR ASFWOR
#/FLD# FXSB < XB,
FMP BETA < BETA*XB,
BSR APFWOR < ALPHA*XA+BETA*XB,
#/FLD# FXSC < XC,
FMP GAMMA < GAMMA*XC,
BSR APFWOR < ALPHA*XA+BETA*XB+GAMMA*XC,
#/FST# FXS < CE QUI DONNE LA COORDONNEE 'XM'...
FSB FXSM < ET COMPARAISON A 'XM' VERITABLE :
BSR AFABS
FCAM FEPS
JL SP82 < OK, ERREUR INFERIEURE A 'EPSILON'...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
SP82: EQU $
#/FLD# FYSA < YA,
FMP ALPHA < ALPHA*YA,
BSR ASFWOR
#/FLD# FYSB < YB,
FMP BETA < BETA*YB,
BSR APFWOR < ALPHA*YA+BETA*YB,
#/FLD# FYSC < YC,
FMP GAMMA < GAMMA*YC,
BSR APFWOR < ALPHA*YA+BETA*YB+GAMMA*YC,
#/FST# FYS < CE QUI DONNE LA COORDONNEE 'YM'...
FSB FYSM < ET COMPARAISON A 'YM' VERITABLE :
BSR AFABS
FCAM FEPS
JL SP83 < OK, ERREUR INFERIEURE A 'EPSILON'...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
SP83: EQU $
#/FLD# FZSA < ZA,
FMP ALPHA < ALPHA*ZA,
BSR ASFWOR
#/FLD# FZSB < ZB,
FMP BETA < BETA*ZB,
BSR APFWOR < ALPHA*ZA+BETA*ZB,
#/FLD# FZSC < ZC,
FMP GAMMA < GAMMA*ZC,
BSR APFWOR < ALPHA*ZA+BETA*ZB+GAMMA*ZC,
#/FST# FZS < CE QUI DONNE LA COORDONNEE 'ZM'...
FSB FZSM < ET COMPARAISON A 'YM' VERITABLE :
BSR AFABS
FCAM FEPS
JL SP84 < OK, ERREUR INFERIEURE A 'EPSILON'...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
SP84: EQU $
BSR APROJ < PROJECTION DU POINT 'M',
BSR ASP4 < ET INSERTION DANS LA LISTE GRAPHIQUE...
BSR ASPA < TRACE DE L'ETOILE (AM,BM,CM) AVEC LE
< POINT 'M' CALCULE PAR (ALPHA,BETA,GAMMA).
<
< RETOUR AU POINT 'M' CALCULE PAR 'RHOM' :
<
LRM A,B
WORD CM3D < (A)=POINT 'M' CALCULE,
WORD CS3D < (B)=POINT 3D COURANT,
BSR AMOVE3 < MISE EN PLACE DU POINT 'M',
BSR APROJ < PROJECTION 2D --> 3D,
BSR ASP4 < INSERTION DANS LA LISTE GRAPHIQUE,
BSR ASPA < ET TRACE DE L'ETOILE (AM,BM,CM),
< OU 'M' EST CALCULE PAR 'RHOM'...
<
< ET RETOUR :
<
PLR A,B,X
SP81: EQU $
RSR
<
<
< V E R S I O N F A C E T T E S " I N T E R N E S " :
<
<
SP8I: EQU $
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IWGIFI < TRACE-T'ON LES INTERSECTIONS DES FACETTES
< "INTERNES" ET DE LA DROITE 'D' ???
JE E220 < NON...
BSR ASP8 < OUI, ALLONS-Y...
E220: EQU $
RSR < ET RETOUR...
<
<
< V E R S I O N F A C E T T E S " E X T E R N E S " :
<
<
SP8E: EQU $
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IWGIFE < TRACE-T'ON LES INTERSECTIONS DES FACETTES
< "EXTERNES" ET DE LA DROITE 'D' ???
JE E221 < NON...
BSR ASP8 < OUI, ALLONS-Y...
E221: EQU $
RSR < ET RETOUR...
XOPT1: VAL ENDIF
PAGE
IF XOPT01-EXIST,XOPT1,,XOPT1
<
<
< T R A C E D E ( A M , B M , C M ) :
<
<
< FONCTION :
< CE MODULE CALCULE
< L'ETOILE (AM,BM,CM)
< ET L'AFFICHE...
<
<
SPA: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
<
< TRACE DE AM :
<
LRM A,B,X
WORD CA3D < (A)=SOMMET 'A',
WORD CS3D < (B)=POINT 3D COURANT,
WORD LBUF3D < (X)=NOMBRE DE MOTS A DEPLACER.
BSR ASP9 < ET TRACE DU VECTEUR AM...
<
< TRACE DE BM :
<
LRM A,B,X
WORD CB3D < (A)=SOMMET 'B',
WORD CS3D < (B)=POINT 3D COURANT,
WORD LBUF3D < (X)=NOMBRE DE MOTS A DEPLACER.
BSR ASP9 < ET TRACE DU VECTEUR BM...
<
< TRACE DE CM :
<
LRM A,B,X
WORD CC3D < (A)=SOMMET 'C',
WORD CS3D < (B)=POINT 3D COURANT,
WORD LBUF3D < (X)=NOMBRE DE MOTS A DEPLACER.
BSR ASP9 < ET TRACE DU VECTEUR CM...
<
< ET RETOUR :
<
PLR A,B,X
RSR
XOPT1: VAL ENDIF
PAGE
IF XOPT01-EXIST,XOPT1,,XOPT1
<
<
< T R A C E D E S V E C T E U R S ( A M , B M , C M ) :
<
<
< ARGUMENTS :
< (A)=ADRESSE DU SOMMET COURANT (A,B,C),
< (B)=ADRESSE DU POINT 3D COURANT,
< (X)=NOMBRE DE MOTS A DEPLACER.
<
<
SP9: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
<
< GESTION GRAPHIQUE :
<
MOVE < MISE EN PLACE DE L'UN DES 3 SOMMETS
< (A,B,C)...
BSR APROJ < PROJECTION 2D --> 3D,
BSR ASP7 < ET MISE DANS LA LISTE GRAPHIQUE...
<
< REPRESENTATION GRAPHIQUE :
<
LAD DEMOG
SVC < DECHAINAGE...
LRM A
WORD DEMWD2
SVC < MISE EN MODE TIRETES...
LAD DEMWG
SVC < ET TRACE DE L'UN DES VECTEURS (AM,BM,CM).
LRM A
WORD DEMWD0
SVC < ET RETOUR AU MODE NORMAL...
<
< ET RETOUR :
<
PLR A,B,X
RSR
XOPT1: VAL ENDIF
PAGE
<
<
< A C C E S C O N S T A N T E D E T R A V A I L :
<
<
< ARGUMENT :
< (X)=NUMERO DE LA CONSTANTE (DE 0 A NCT-1), ET NON PAS
< SON INDEX EN DOUBLE-MOTS !!!
<
<
< RESULTAT :
< (A,B)=VALEUR DE LA CONSTANTE.
<
<
SPCT: EQU $
<
< INITIALISATION :
<
PSR X
<
< VALIDATION DE LA CONSTANTE :
<
LR X,A < VALIDATION DU NUMERO :
JAL SPCT1 < ERREUR...
CPI NCT
JL SPCT2 < OK...
SPCT1: EQU $
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
SPCT2: EQU $
<
< ACCES A LA CONSTANTE (X) :
<
ADR X,X < (X)=INDEX-MOTS DE LA CONSTANTE,
FLD &ACT < (A,B)=CONSTANTE DE TRAVAIL...
<
< ET RETOUR :
<
PLR X
RSR
PAGE
<
<
< C A L C U L S I N U S E T C O S I N U S :
<
<
< ARGUMENT :
< (A,B)=ANGLE EN RADIANS,
<
<
< RESULTAT :
< (A,B)=LIGNE TRIGONOMETRIQUE DEMANDEE.
<
<
COS: EQU $ < ENTRY 'COSINUS' :
FSB PISUR2 < (A,B)=TETA-PI/2,
BSR AFNEG < (A,B)=PI/2-TETA.
SIN: EQU $ < ENTRY 'SINUS' :
<
< INITIALISATIONS ET
< PREPARATION DE L'ANGLE :
<
#/FST# SCWOR1 < SAVE TEMPORAIRE DE L'ANGLE.
STZ ISIGSC
JAGE PSC072
BSR AFNEG
#/FST# SCWOR1
IC ISIGSC
PSC072: EQU $
FDV DEUXPI
BSR AFIX
BSR AFLT
FMP DEUXPI
FSB SCWOR1
BSR AFNEG
FCAM PI3141
JL PSC073
FSB PI3141
IC ISIGSC
PSC073: EQU $
FCAM PISUR2
JL PSC074
FSB PI3141
BSR AFNEG
PSC074: EQU $
<
< CALCUL DU POLYNOME :
<
FDV PISUR2
#/FST# SCWOR1
FMP SCWOR1
#/FST# SCWOR2
FMP POLSC4
FAD POLSC3
FMP SCWOR2
FAD POLSC2
FMP SCWOR2
FAD POLSC1
FMP SCWOR2
FAD PISUR2
FMP SCWOR1
DC ISIGSC
JNE PSC075
BSR AFNEG
PSC075: EQU $
<
< ET RETOUR :
<
BSR ATSFLO
RSR
PAGE
<
<
< D E F I N I T I O N D E S T A B L E S
< D ' A C C E L E R A T I O N P O U R
< L E C A L C U L D E S F O N C T I O N S :
<
<
< FONCTION :
< AFIN D'EVITER DES RECALCULS
< DES FONCTIONS X(U,V), Y(U,V)
< ET Z(U,V) LORSQUE CELA EST
< POSSIBLE, ON MEMORISE DANS 3
< HASH-TABLES DES TRIPLETS DU
< TYPE (U,V,F(U,V)), OU 'F' DESI-
< GNE L'UNE DES 3 FONCTIONS 'X',
< 'Y' OU 'Z'...
<
<
< D E F I N I T I O N D U F O R M A T D ' U N E E N T R E E :
<
<
HASHT:: VAL O < DEBUT D'UNE ENTREE DES HASH-TABLES :
HASHFR:: MOT HASHT < INDICATEUR DE LIBERTE :
< ='NEXIST' : L'ENTREE EST INOCUPPEE,
< ='EXIST' : L'ENTREE EST OCCUPEE.
HASHU:: MOT HASHFR+D < COORDONNEE CURVILIGNE 'U',
HASHV:: MOT HASHU+DFLOT < COORDONNEE CURVILIGNE 'V'.
HASHF:: MOT HASHV+DFLOT < VALEUR DE F(U,V).
XWOR%7: VAL HASHF+DFLOT < LONGUEUR UTILE D'UNE ENTREE...
XWOR%2: VAL -S < POUR FAIRE UN DECALAGE A DROITE.
XWOR%1: VAL XWOR%7 < LONGUEUR UTILE D'ENE ENTREE...
DO NBITMO
XWOR%1: VAL XWOR%1>XWOR%2=FCPUSH
XWOR%1: VAL I < INITIALISATION DU COMPTAGE...
DO NBITMO
XWOR%1: VAL K=FCPULL=FCSIGN+XWOR%1
LEHASH:: VAL BIT>XWOR%1 < PLUS PETITE LONGUEUR D'UNE ENTREE D'UNE
< HASH-TABLE QUI SOIT UNE PUISSANCE DE 2...
<
<
< L O N G U E U R D E S H A S H - T A B L E S :
<
<
LNHASH:: VAL 4 < LOGARITHME EN BASE 2 DU NOMBRE D'ENTREE,
< ET CECI AFIN QUE LE NOMBRE D'ENTREE SOIT
< UNE PUISSANCE DE 2...
NEHASH:: VAL BIT>LNHASH < NOMBRE D'ENTREE DE CHAQUE HASH-TABLE...
<
<
< H A S H - T A B L E S :
<
<
IF NEXIST-K,,XEIF%,
IF ATTENTION : L'INITIALISATION DE 'HASHFR'
IF AVEC 'NEXIST' A L'AIDE D'UN 'DZS' EST MAUVAISE !!!
XEIF%: VAL ENDIF
XWOR%9: VAL NEHASH*LEHASH < LONGUEUR EN MOTS DE CHACUNE DES HASH-
< TABLES...
HASHTX: EQU $ < HASH-TABLE DES X(U,V).
DZS XWOR%9
HASHTY: EQU $ < HASH-TABLE DES Y(U,V).
DZS XWOR%9
HASHTZ: EQU $ < HASH-TABLE DES Z(U,V).
DZS XWOR%9
PAGE
<
<
< C A L C U L D E X ( U , V ) :
<
<
< FONCTION :
< CE MODULE CALCULE LA FONCTION
< 'X' AU POINT (U,V) SUR LA SURFA-
< CE ARGUMENT, SUIVANT L'EQUATION :
<
< X=MT11*X(U,V)+MT12*Y(U,V)+MT13*Z(U,V)+MT14.
<
<
SPXP: EQU $
<
< INITIALISATIONS :
<
PSR X,Y,L,W
LRM L,W
WORD FLOC+DEPBAS < (L)=BASE DU LOCAL DE X(U,V),
WORD HASHTX < (W)=BASE LA HASH-TABLE 'HASHTX'...
<
< TENTATIVE D'OPTIMISATION :
<
LA VARU < U(0),
EOR VARU+DFLOT-Z < U(0)*U(1),
EOR VARV < U(0)*U(1)*V(0),
EOR VARV+DFLOT-Z < U(0)*U(1)*V(0)*V(1), CE QUI NOUS DONNE
< UNE COMBINAISON DE 'U' ET DE 'V'...
LR A,B < ET SAVE...
SCRS LNHASH
EORR B,A < ON COMBINE U(0)*U(1)*V(0)*V(1) A LUI-
< MEME DECALE DU LOGARITHME EN BASE 2 DE
< LA LONGUEUR D'UNE ENTREE DES HASH-
< TABLES...
LR A,B < ET SAVE...
SCRS NBITMO/NOCMO
EORR B,A < ET ON RECOMMENCE SUR LA MOITIE D'UN MOT..
< CE QUI DONNE 'LNHASH' PAQUETS IDENTIQUES
< DE 'LNHASH' BITS, QUI CORRESPONDENT EN
< FAIT A UNE GENERALISATION DE LA NOTION
< DE BIT DE PARITE...
IF LNHASH*LNHASH-NBITMO,,XEIF%,
IF ATTENTION : CE QUI PRECEDE EST IDIOT !!!
XEIF%: VAL ENDIF
IF NBITMO/NOCMO/LNHASH=K-W,,XEIF%,
IF ATTENTION : CE QUI PRECEDE EST INCOMPLET !!!
XEIF%: VAL ENDIF
ANDI BIT>LNHASH-N < (A)=INDEX "ALEATOIRE" ASSOCIE AU COUPLE
< (U,V) COURANT,
XWOR%1: VAL LEHASH=K
IF BIT>XWOR%1-LEHASH,,XEIF%,
IF ATTENTION : 'LEHASH' N'EST PAS UNE PUISSANCE DE 2 !!!
XEIF%: VAL ENDIF
SLLS XWOR%1 < (A)=INDEX-MOT D'ACCES AUX HASH-TABLES
< ASSOCIE AU COUPLE (U,V) COURANT.
ADR A,W < (W)=ADRESSE DE L'ENTREE DE 'HASHTX'
< ASSOCIEE AU COUPLE (U,V) COURANT...
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ HASHFR,W < L'ENTREE EST-ELLE INOCCUPEE ???
JE SPXP4 < OUI, INUTILE DE TESTER (U,V)...
#/FLD# VARU < NON, ELLE EST OCCUPEE :
FCAM HASHU,W < EST-ON EN PRESENCE DU 'U' COURANT ???
JNE SPXP4 < NON, PAS D'OPTIMISATION...
#/FLD# VARV < OUI :
FCAM HASHV,W < EST-ON EN PRESENCE DU 'V' COURANT ???
JNE SPXP4 < NON, PAS D'OPTIMISATION...
<
< CAS D'UNE RECHERCHE POSITIVE :
<
#/FLD# HASHF,W < (A,B)=VALEUR DE X(U,V)...
JMP SPXP5 < ET VERS LA SORTIE IMMEDIATE...
<
< CAS D'UNE RECHERCHE NEGATIVE :
<
SPXP4: EQU $
PSR W < ON MEMORISE L'ADRESSE DE L'ENTREE EN
< HASH-TABLE...
<
< CALCUL DE X(U,V) :
<
LXI MT11
#/FLD# F0 < 'MT11' NUL A PRIORI...
FCMZ &AMTRAN < QU'EN EST-IL REELLEMENT ???
JE SPX1 < OUI, (A,B)=0,
BSR ASPX < NON, (A,B)=X(U,V),
LXI MT11
FMP &AMTRAN < (A,B)=MT11*X(U,V),
SPX1: EQU $
PSR A,B < ET SAUVEGARDE DE MT11*X(U,V)...
LXI MT12
#/FLD# F0 < 'MT12' NUL A PRIORI...
FCMZ &AMTRAN < QU'EN EST-IL REELLEMENT ???
JE SPX2 < OUI, (A,B)=0,
BSR ASPY < NON, (A,B)=Y(U,V),
LXI MT12
FMP &AMTRAN < (A,B)=MT12*Y(U,V),
SPX2: EQU $
PSR A,B < ET SAUVEGARDE DE MT12*Y(U,V)...
LXI MT13
#/FLD# F0 < 'MT13' NUL A PRIORI...
FCMZ &AMTRAN < QU'EN EST-IL REELLEMENT ???
JE SPX3 < OUI, (A,B)=0,
BSR ASPZ < NON, (A,B)=Z(U,V),
LXI MT13
FMP &AMTRAN < (A,B)=MT13*Z(U,V),
SPX3: EQU $
BSR ASFWOR < ET SAUVEGARDE DE MT13*Z(U,V)...
PLR A,B
BSR APFWOR < MT12*Y(U,V)+MT13*Z(U,V),
PLR A,B
BSR APFWOR < MT11*X(U,V)+MT12*Y(U,V)+MT13*Z(U,V),
LXI MT14
FAD &AMTRAN < MT11*X(U,V)+MT12*Y(U,V)*MT13*Z(U,V)+MT14,
FMP FK < ET MISE A L'ECHELLE...
<
< PREPARATION DES OPTIMISATIONS :
<
PLR W < RESTAURATION DE 'W' :
< (W)=ADRESSE DE L'ENTREE DE 'HASHTX'
< ASSOCIEE AU COUPLE (U,V) COURANT.
PSR A,B < MEMORISATION DE X(U,V)...
LAI EXIST
STA HASHFR,W < ON OCCUPE L'ENTREE SYSTEMATIQUEMENT...
#/FLD# VARU
#/FST# HASHU,W < MEMORISATION DE 'U',
#/FLD# VARV
#/FST# HASHV,W < MEMORISATION DE 'V',
PLR A,B
#/FST# HASHF,W < ET MEMORISATION DE X(U,V)...
<
< ET RETOUR :
<
BSR ATSFLO
SPXP5: EQU $
PLR X,Y,L,W
RSR
<
<
< C A L C U L D E Y ( U , V ) :
<
<
< FONCTION :
< CE MODULE CALCULE LA FONCTION
< 'Y' AU POINT (U,V) SUR LA SURFA-
< CE ARGUMENT, SUIVANT L'EQUATION :
<
< Y=MT21*X(U,V)+MT22*Y(U,V)+MT23*Z(U,V)+MT24.
<
<
SPYP: EQU $
<
< INITIALISATIONS :
<
PSR X,Y,L,W
LRM L,W
WORD FLOC+DEPBAS < (L)=BASE DU LOCAL DE Y(U,V),
WORD HASHTY < (W)=BASE LA HASH-TABLE 'HASHTY'...
<
< TENTATIVE D'OPTIMISATION :
<
LA VARU < U(0),
EOR VARU+DFLOT-Z < U(0)*U(1),
EOR VARV < U(0)*U(1)*V(0),
EOR VARV+DFLOT-Z < U(0)*U(1)*V(0)*V(1), CE QUI NOUS DONNE
< UNE COMBINAISON DE 'U' ET DE 'V'...
LR A,B < ET SAVE...
SCRS LNHASH
EORR B,A < ON COMBINE U(0)*U(1)*V(0)*V(1) A LUI-
< MEME DECALE DU LOGARITHME EN BASE 2 DE
< LA LONGUEUR D'UNE ENTREE DES HASH-
< TABLES...
LR A,B < ET SAVE...
SCRS NBITMO/NOCMO
EORR B,A < ET ON RECOMMENCE SUR LA MOITIE D'UN MOT..
< CE QUI DONNE 'LNHASH' PAQUETS IDENTIQUES
< DE 'LNHASH' BITS, QUI CORRESPONDENT EN
< FAIT A UNE GENERALISATION DE LA NOTION
< DE BIT DE PARITE...
IF LNHASH*LNHASH-NBITMO,,XEIF%,
IF ATTENTION : CE QUI PRECEDE EST IDIOT !!!
XEIF%: VAL ENDIF
IF NBITMO/NOCMO/LNHASH=K-W,,XEIF%,
IF ATTENTION : CE QUI PRECEDE EST INCOMPLET !!!
XEIF%: VAL ENDIF
ANDI BIT>LNHASH-N < (A)=INDEX "ALEATOIRE" ASSOCIE AU COUPLE
< (U,V) COURANT,
XWOR%1: VAL LEHASH=K
IF BIT>XWOR%1-LEHASH,,XEIF%,
IF ATTENTION : 'LEHASH' N'EST PAS UNE PUISSANCE DE 2 !!!
XEIF%: VAL ENDIF
SLLS XWOR%1 < (A)=INDEX-MOT D'ACCES AUX HASH-TABLES
< ASSOCIE AU COUPLE (U,V) COURANT.
ADR A,W < (W)=ADRESSE DE L'ENTREE DE 'HASHTY'
< ASSOCIEE AU COUPLE (U,V) COURANT...
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ HASHFR,W < L'ENTREE EST-ELLE INOCCUPEE ???
JE SPYP4 < OUI, INUTILE DE TESTER (U,V)...
#/FLD# VARU < NON, ELLE EST OCCUPEE :
FCAM HASHU,W < EST-ON EN PRESENCE DU 'U' COURANT ???
JNE SPYP4 < NON, PAS D'OPTIMISATION...
#/FLD# VARV < OUI :
FCAM HASHV,W < EST-ON EN PRESENCE DU 'V' COURANT ???
JNE SPYP4 < NON, PAS D'OPTIMISATION...
<
< CAS D'UNE RECHERCHE POSITIVE :
<
#/FLD# HASHF,W < (A,B)=VALEUR DE Y(U,V)...
JMP SPYP5 < ET VERS LA SORTIE IMMEDIATE...
<
< CAS D'UNE RECHERCHE NEGATIVE :
<
SPYP4: EQU $
PSR W < ON MEMORISE L'ADRESSE DE L'ENTREE EN
< HASH-TABLE...
<
< CALCUL DE Y(U,V) :
<
LXI MT21
#/FLD# F0 < 'MT21' NUL A PRIORI...
FCMZ &AMTRAN < QU'EN EST-IL REELLEMENT ???
JE SPY1 < OUI, (A,B)=0,
BSR ASPX < NON, (A,B)=X(U,V),
LXI MT21
FMP &AMTRAN < (A,B)=MT21*X(U,V),
SPY1: EQU $
PSR A,B < ET SAUVEGARDE DE MT21*X(U,V)...
LXI MT22
#/FLD# F0 < 'MT22' NUL A PRIORI...
FCMZ &AMTRAN < QU'EN EST-IL REELLEMENT ???
JE SPY2 < OUI, (A,B)=0,
BSR ASPY < NON, (A,B)=Y(U,V),
LXI MT22
FMP &AMTRAN < (A,B)=MT22*Y(U,V),
SPY2: EQU $
PSR A,B < ET SAUVEGARDE DE MT22*Y(U,V)...
LXI MT23
#/FLD# F0 < 'MT23' NUL A PRIORI...
FCMZ &AMTRAN < QU'EN EST-IL REELLEMENT ???
JE SPY3 < OUI, (A,B)=0,
BSR ASPZ < NON, (A,B)=Z(U,V),
LXI MT23
FMP &AMTRAN < (A,B)=MT23*Z(U,V),
SPY3: EQU $
BSR ASFWOR < ET SAUVEGARDE DE MT23*Z(U,V)...
PLR A,B
BSR APFWOR < MT22*Y(U,V)+MT23*Z(U,V),
PLR A,B
BSR APFWOR < MT21*X(U,V)+MT22*Y(U,V)+MT23*Z(U,V),
LXI MT24
FAD &AMTRAN < MT21*X(U,V)+MT22*Y(U,V)*MT23*Z(U,V)+MT24,
FMP FK < ET MISE A L'ECHELLE...
<
< PREPARATION DES OPTIMISATIONS :
<
PLR W < RESTAURATION DE 'W' :
< (W)=ADRESSE DE L'ENTREE DE 'HASHTY'
< ASSOCIEE AU COUPLE (U,V) COURANT.
PSR A,B < MEMORISATION DE Y(U,V)...
LAI EXIST
STA HASHFR,W < ON OCCUPE L'ENTREE SYSTEMATIQUEMENT...
#/FLD# VARU
#/FST# HASHU,W < MEMORISATION DE 'U',
#/FLD# VARV
#/FST# HASHV,W < MEMORISATION DE 'V',
PLR A,B
#/FST# HASHF,W < ET MEMORISATION DE Y(U,V)...
<
< ET RETOUR :
<
BSR ATSFLO
SPYP5: EQU $
PLR X,Y,L,W
RSR
<
<
< C A L C U L D E Z ( U , V ) :
<
<
< FONCTION :
< CE MODULE CALCULE LA FONCTION
< 'Z' AU POINT (U,V) SUR LA SURFA-
< CE ARGUMENT, SUIVANT L'EQUATION :
<
< Z=MT31*X(U,V)+MT32*Y(U,V)+MT33*Z(U,V)+MT34.
<
<
SPZP: EQU $
<
< INITIALISATIONS :
<
PSR X,Y,L,W
LRM L,W
WORD FLOC+DEPBAS < (L)=BASE DU LOCAL DE Z(U,V),
WORD HASHTZ < (W)=BASE LA HASH-TABLE 'HASHTZ'...
<
< TENTATIVE D'OPTIMISATION :
<
LA VARU < U(0),
EOR VARU+DFLOT-Z < U(0)*U(1),
EOR VARV < U(0)*U(1)*V(0),
EOR VARV+DFLOT-Z < U(0)*U(1)*V(0)*V(1), CE QUI NOUS DONNE
< UNE COMBINAISON DE 'U' ET DE 'V'...
LR A,B < ET SAVE...
SCRS LNHASH
EORR B,A < ON COMBINE U(0)*U(1)*V(0)*V(1) A LUI-
< MEME DECALE DU LOGARITHME EN BASE 2 DE
< LA LONGUEUR D'UNE ENTREE DES HASH-
< TABLES...
LR A,B < ET SAVE...
SCRS NBITMO/NOCMO
EORR B,A < ET ON RECOMMENCE SUR LA MOITIE D'UN MOT..
< CE QUI DONNE 'LNHASH' PAQUETS IDENTIQUES
< DE 'LNHASH' BITS, QUI CORRESPONDENT EN
< FAIT A UNE GENERALISATION DE LA NOTION
< DE BIT DE PARITE...
IF LNHASH*LNHASH-NBITMO,,XEIF%,
IF ATTENTION : CE QUI PRECEDE EST IDIOT !!!
XEIF%: VAL ENDIF
IF NBITMO/NOCMO/LNHASH=K-W,,XEIF%,
IF ATTENTION : CE QUI PRECEDE EST INCOMPLET !!!
XEIF%: VAL ENDIF
ANDI BIT>LNHASH-N < (A)=INDEX "ALEATOIRE" ASSOCIE AU COUPLE
< (U,V) COURANT,
XWOR%1: VAL LEHASH=K
IF BIT>XWOR%1-LEHASH,,XEIF%,
IF ATTENTION : 'LEHASH' N'EST PAS UNE PUISSANCE DE 2 !!!
XEIF%: VAL ENDIF
SLLS XWOR%1 < (A)=INDEX-MOT D'ACCES AUX HASH-TABLES
< ASSOCIE AU COUPLE (U,V) COURANT.
ADR A,W < (W)=ADRESSE DE L'ENTREE DE 'HASHTZ'
< ASSOCIEE AU COUPLE (U,V) COURANT...
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ HASHFR,W < L'ENTREE EST-ELLE INOCCUPEE ???
JE SPZP4 < OUI, INUTILE DE TESTER (U,V)...
#/FLD# VARU < NON, ELLE EST OCCUPEE :
FCAM HASHU,W < EST-ON EN PRESENCE DU 'U' COURANT ???
JNE SPZP4 < NON, PAS D'OPTIMISATION...
#/FLD# VARV < OUI :
FCAM HASHV,W < EST-ON EN PRESENCE DU 'V' COURANT ???
JNE SPZP4 < NON, PAS D'OPTIMISATION...
<
< CAS D'UNE RECHERCHE POSITIVE :
<
#/FLD# HASHF,W < (A,B)=VALEUR DE Z(U,V)...
JMP SPZP5 < ET VERS LA SORTIE IMMEDIATE...
<
< CAS D'UNE RECHERCHE NEGATIVE :
<
SPZP4: EQU $
PSR W < ON MEMORISE L'ADRESSE DE L'ENTREE EN
< HASH-TABLE...
<
< CALCUL DE Z(U,V) :
<
LXI MT31
#/FLD# F0 < 'MT31' NUL A PRIORI...
FCMZ &AMTRAN < QU'EN EST-IL REELLEMENT ???
JE SPZ1 < OUI, (A,B)=0,
BSR ASPX < NON, (A,B)=X(U,V),
LXI MT31
FMP &AMTRAN < (A,B)=MT31*X(U,V),
SPZ1: EQU $
PSR A,B < ET SAUVEGARDE DE MT31*X(U,V)...
LXI MT32
#/FLD# F0 < 'MT32' NUL A PRIORI...
FCMZ &AMTRAN < QU'EN EST-IL REELLEMENT ???
JE SPZ2 < OUI, (A,B)=0,
BSR ASPY < NON, (A,B)=Y(U,V),
LXI MT32
FMP &AMTRAN < (A,B)=MT32*Y(U,V),
SPZ2: EQU $
PSR A,B < ET SAUVEGARDE DE MT32*Y(U,V)...
LXI MT33
#/FLD# F0 < 'MT33' NUL A PRIORI...
FCMZ &AMTRAN < QU'EN EST-IL REELLEMENT ???
JE SPZ3 < OUI, (A,B)=0,
BSR ASPZ < NON, (A,B)=Z(U,V),
LXI MT33
FMP &AMTRAN < (A,B)=MT33*Z(U,V),
SPZ3: EQU $
BSR ASFWOR < ET SAUVEGARDE DE MT33*Z(U,V)...
PLR A,B
BSR APFWOR < MT32*Y(U,V)+MT33*Z(U,V),
PLR A,B
BSR APFWOR < MT31*X(U,V)+MT32*Y(U,V)+MT33*Z(U,V),
LXI MT34
FAD &AMTRAN < MT31*X(U,V)+MT32*Y(U,V)*MT33*Z(U,V)+MT34,
FMP FK < ET MISE A L'ECHELLE...
<
< PREPARATION DES OPTIMISATIONS :
<
PLR W < RESTAURATION DE 'W' :
< (W)=ADRESSE DE L'ENTREE DE 'HASTHZ'
< ASSOCIEE AU COUPLE (U,V) COURANT.
PSR A,B < MEMORISATION DE Z(U,V)...
LAI EXIST
STA HASHFR,W < ON OCCUPE L'ENTREE SYSTEMATIQUEMENT...
#/FLD# VARU
#/FST# HASHU,W < MEMORISATION DE 'U',
#/FLD# VARV
#/FST# HASHV,W < MEMORISATION DE 'V',
PLR A,B
#/FST# HASHF,W < ET MEMORISATION DE Z(U,V)...
<
< ET RETOUR :
<
BSR ATSFLO
SPZP5: EQU $
PLR X,Y,L,W
RSR
PAGE
<
<
< D E R I V A T I O N N U M E R I Q U E D U P R E M I E R
< O R D R E P A R R A P P O R T A ' U ' O U ' V ' :
<
<
< FONCTION :
< CE MODULE CALCULE LA DERIVEE
< PARTIELLE DU PREMIER ORDRE DE
< LA FONCTION 'F' PAR RAPPORT A
< LA VARIABLE 'X' SUIVANT LA
< FORMULE :
<
< DF(X)/DX=(F(X+DX)-(F(X-DX))/(2*DX).
<
< PAR LA SUITE LA VARIABLE 'X'
< SERA NOTEE 'ALPHA', ET 'DX', 'H'...
<
<
< ARGUMENTS :
< (A)=ADRESSE DU PAS DE DERIVATION 'FHU/V',
< (Y)=NUMERO DE LA FONCTION QUE L'ON DESIRE DERIVER
< (XSPX, XSPY OU XSPZ),
< (X)=NUMERO DE LA VARIABLE PAR RAPPORT A LAQUELLE
< ON DERIVE (XVARU OU XVARV).
<
<
< RESULTAT :
< (A,B)=VALEUR DE LA DERIVEE AU POINT CONSIDERE.
<
<
DERIP: EQU $
<
< INITIALISATIONS ET CALCUL DU
< PAS DE DERIVATION :
<
FH:: MOT O < ACCES A 'FHU/V'...
PSR W
LR A,W < (W)=ADRESSE DU PAS DE DERIVATION 'FH',
#/FLD# FH,W
FDV F05
#/FST# F2H < ET CALCUL DE F2H=2*FH...
<
< VALIDATION DE LA FONCTION :
<
LR Y,A < VALIDATION DE LA FONCTION :
JAL DERIP1 < ERREUR...
CPI XSPZ
JLE DERIP2 < OK...
DERIP1: EQU $
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
DERIP2: EQU $
LR X,A < VALIDATION DE LA VARIABLE DE DERIVATION :
TBT NBITMO-B
JC DERIP3
JAL DERIP3
CPI XLASTX
JLE DERIP4
DERIP3: EQU $
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
DERIP4: EQU $
<
< CALCUL DE LA DERIVEE :
<
FLD &AVAR < VARIABLE ALPHA,
PSR A,B < SAUVEGARDE DE ALPHA...
FAD FH,W < 'FHU/V'...
FST &AVAR < ALPHA+H,
XR X,Y
BSR &ASPXYZ < F(ALPHA+H),
XR X,Y
PSR A,B < ET SAVE...
FLD &AVAR
FSB F2H
FST &AVAR < ALPHA-H,
XR X,Y
BSR &ASPXYZ < F(ALPHA-H),
XR X,Y
BSR ASFWOR < ET SAVE...
PLR A,B < F(ALPHA+H),
FSB FWORK < F(ALPHA+H)-F(ALPHA-H),
FDV F2H < (F(ALPHA+H)-F(ALPHA-H))/(2*H),
BSR ASFWOR < DERIVEE=(F(ALPHA+H)-F(ALPHA-H))/(2*H).
PLR A,B < RESTAURE ALPHA...
FST &AVAR
<
< ET RETOUR :
<
BSR ATSFLO
#/FLD# FWORK < (A,B)=VALEUR DE LA DERIVEE.
PLR W
RSR
PAGE
<
<
< D E R I V A T I O N N U M E R I Q U E D U S E C O N D
< O R D R E P A R R A P P O R T A ' U ' O U ' V ' :
<
<
< FONCTION :
< CE MODULE CALCULE LA DERIVEE
< PARTIELLE DU SECOND ODRE DE
< LA FONCTION 'F' PAR RAPPORT A
< LA VARIABLE 'X' SUIVANT LA
< FORMULE :
<
< D2F(X)/DX2=(F(X-DX)+F(X+DX)-2*F(X))/(DX**2)
<
< SOIT POUR UNE FONCTION 'F' DE
< 2 VARIABLES 'U' ET 'V' :
<
< D2F(U0,V0)/DU2=(F(U0-DU,V0)+F(U0+DU,V0)-2*F(U0,V0))/(DU**2)
< D2F(U0,V0)/DV2=(F(U0,V0-DV)+F(U0,V0+DV)-2*F(U0,V0))/(DV**2)
<
<
< ARGUMENTS :
< (A)=ADRESSE DU PAS DE DERIVATION 'FHU/V',
< (Y)=NUMERO DE LA FONCTION QUE L'ON DESIRE DERIVER
< (XSPX, XSPY OU XSPZ),
< (X)=NUMERO DE LA VARIABLE PAR RAPPORT A LAQUELLE
< ON DERIVE (XVARU OU XVARV).
<
<
< RESULTAT :
< (A,B)=VALEUR DE LA DERIVEE AU POINT CONSIDERE.
<
<
DERIS: EQU $
<
< INITIALISATIONS :
<
PSR W
LR A,W < (W)=ADRESSE DU PAS DE DERIVATION 'FH',
<
< VALIDATION DE LA FONCTION :
<
LR Y,A < VALIDATION DE LA FONCTION :
JAL DERIS1 < ERREUR...
CPI XSPZ
JLE DERIS2 < OK...
DERIS1: EQU $
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
DERIS2: EQU $
LR X,A < VALIDATION DE LA VARIABLE DE DERIVATION :
TBT NBITMO-B
JC DERIS3
JAL DERIS3
CPI XLASTX
JLE DERIS4
DERIS3: EQU $
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
DERIS4: EQU $
<
< CALCUL DE LA DERIVEE :
<
FLD &AVAR < VARIABLE ALPHA,
PSR A,B < SAUVEGARDE DE ALPHA...
FSB FH,W
FST &AVAR < ALPHA-H,
XR X,Y
BSR &ASPXYZ < F(ALPHA-H),
XR X,Y
PSR A,B < ET SAVE...
FLD &AVAR
FAD FH,W
FAD FH,W
FST &AVAR < ALPHA+H,
XR X,Y
BSR &ASPXYZ < F(ALPHA+H),
XR X,Y
PSR A,B < ET SAVE...
FLD &AVAR
FSB FH,W
FST &AVAR < ALPHA,
XR X,Y
BSR &ASPXYZ < F(ALPHA),
XR X,Y
FDV F05 < 2*F(ALPHA),
BSR AFNEG < -2*F(ALPHA),
BSR ASFWOR < ET SAVE...
PLR A,B < F(ALPHA+H),
BSR APFWOR < F(ALPHA+H)-2*F(ALPHA),
PLR A,B < F(ALPHA-H),
BSR APFWOR < F(ALPHA-H)+F(ALPHA+H)-2*F(ALPHA),
FDV FH,W < ET DIVISION
FDV FH,W < PAR H**2,
BSR ASFWOR < CE QUI DONNE LA DERIVEE :
< (F(ALPHA-H)+F(ALPHA+H)-2*F(ALPHA)/(H**2).
PLR A,B < RESTAURE ALPHA (CECI EST EN FAIT PEUT-
FST &AVAR < INUTILE, MAIS AVEC LE CALCUL FLOTTANT
< ON NE SAIT JAMAIS...).
<
< ET RETOUR :
<
BSR ATSFLO
#/FLD# FWORK < (A,B)=VALEUR DE LA DERIVEE.
PLR W
RSR
PAGE
<
<
< D E R I V A T I O N N U M E R I Q U E D U S E C O N D
< O R D R E P A R R A P P O R T A ' U ' E T ' V ' :
<
<
< FONCTION :
< CE MODULE CALCULE LA DERIVEE
< PARTIELLE DU SECOND ODRE DE
< LA FONCTION 'F' PAR RAPPORT AUX
< VARIABLES 'U' ET 'V' SUIVANT LA
< FORMULE :
<
< D2F(U0,V0)/DVDV=(F(U0+DU,V0+DV)+F(U0-DU,V0-DV)-
< F(U0-DU,V0+DV)-F(U0+DU,V0-DV))/(4*DU*DV).
<
<
< ARGUMENT :
< (X)=NUMERO DE LA FONCTION QUE L'ON DESIRE DERIVER
< (XSPX, XSPY OU XSPZ),
<
<
< RESULTAT :
< (A,B)=VALEUR DE LA DERIVEE AU POINT CONSIDERE.
<
<
DERIX: EQU $
<
< VALIDATION DE LA FONCTION :
<
LR X,A < VALIDATION DE LA FONCTION :
JAL DERIX1 < ERREUR...
CPI XSPZ
JLE DERIX2 < OK...
DERIX1: EQU $
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
DERIX2: EQU $
<
< CALCUL DE LA DERIVEE :
<
#/FLD# VARU
PSR A,B < SAUVEGARDE DE 'U',
#/FLD# VARV
PSR A,B < ET DE 'V'...
#/FLD# VARU < U0,
FAD FHU < U0+DU,
#/FST# VARU < ET SAVE...
#/FLD# VARV < V0,
FAD FHV < V0+DV,
#/FST# VARV < ET SAVE...
BSR &ASPXYZ < F(U0+DU,V0+DV),
PSR A,B < ET SAVE...
#/FLD# VARU < U0+DU,
FSB FHU < U0,
FSB FHU < U0-DU,
#/FST# VARU < ET SAVE...
#/FLD# VARV < V0+DV,
FSB FHV < V0,
FSB FHV < V0-DV,
#/FST# VARV < ET SAVE...
BSR &ASPXYZ < F(U0-DU,V0-DV),
PSR A,B < ET SAVE...
#/FLD# VARV < V0-DV,
FAD FHV < V0,
FAD FHV < V0+DV,
#/FST# VARV < ET SAVE...
BSR &ASPXYZ < F(U0-DU,V0+DV),
BSR AFNEG < -F(U0-DU,V0+DV),
PSR A,B < ET SAVE...
#/FLD# VARU < U0-DU,
FAD FHU < U0,
FAD FHU < U0+DU,
#/FST# VARU < ET SAVE...
#/FLD# VARV < V0+DV,
FSB FHV < V0,
FSB FHV < V0-DV,
#/FST# VARV < ET SAVE...
BSR &ASPXYZ < F(U0+DU,V0-DV),
BSR AFNEG < -F(U0+DU,V0+DV),
BSR ASFWOR < ET SAVE...
PLR A,B < -F(U0-DU,V0+DV),
BSR APFWOR < -F(U0-DU,V0+DV)-F(U0+DU,V0-DV),
PLR A,B < F(U0-DU,V0-DV),
BSR APFWOR < F(U0-DU,V0-DV)-F(U0-DU,V0+DV)-
< F(U0+DU,V0-DV),
PLR A,B < F(U0+DU,V0+DV),
BSR APFWOR < F(U0+DU,V0+DV)+F(U0-DU,V0-DV)-
< F(U0-DU,V0+DV)-F(U0+DU,V0-DV),
FDV FHU < /DU,
FDV FHV < /(DU*DV),
FMP F05 < /(2*DU*DV),
FMP F05 < /(4*DU*DV),
BSR ASFWOR < ET SAVE...
PLR A,B
#/FST# VARV < RESTAURATION DE 'V',
PLR A,B
#/FST# VARU < ET DE 'U'...
<
< ET RETOUR :
<
BSR ATSFLO
#/FLD# FWORK < (A,B)=VALEUR DE LA DERIVEE.
RSR
PAGE
<
<
< P A R C O U R S D U C A T A L O G U E C O U R A N T :
<
<
< FONCTION :
< CE MODULE EXPLORE EXHAUSTI-
< VEMENT LE CATALOGUE COURANT,
< ET POUR CHAQUE NOM RECUPERE
< EFFECTUE LE TRAITEMENT ARGUMENT.
<
<
< ARGUMENTS :
< (A)=ADRESSE OCTET DU NOM A GENERE,
< (B)=ADRESSE DU SOUS-PROGRAMME SPECI-
< FIQUE A APPELER POUR CHAQUE NOM,
< (Y)=NOMBRE D'OCTETS ATTENDUS POUR LA VALEUR.
<
<
CATAL: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X
STA DEMSGN+AMESC < MISE EN PLACE DE L'ADRESSE OCTET DU
< NOM COURANT.
SLRS NOCMO=K < CETTE ADRESSE EST CONVERTIE EN UNE
< ADRESSE MOT,
JNC CATA20 < OK...
QUIT XXQUIT < E R R E U R P R O G R A M M E...
CATA20: EQU $
SBT BITX < QUE L'ON INDEXE,
STA ANOM < CE QUI DONNE UN RELAI INDEXE VERS
< LE NOM COURANT...
STB APVAR < ET ON GENERE UN RELAI VERS LE SOUS-
< PROGRAMME SPECIFIQUE A APPELER POUR
< CHAQUE NOM RECUPERE...
<
< INITIALISATION DU PARCOURS
< DU CATALOGUE COURANT :
<
LXI LRMAIL < (X)=LONGUEUR DE LA RACINE,
STX XRAC < (XRAC)=LONGUEUR DE LA RACINE,
ADRI -I,X
<
< B O U C L E D E R E C U P E R A T I O N :
<
CATA00: EQU $
LAI COSBT?XASSIM=FMASK(K?NVPNXS=FCINST
BSR AGOSGN < DEMANDE DE NEXT-SERIE.
CPI ENSX < TEST DU CODE D'ERREUR.
JE CATA03 < IL N'Y A PAS DE NEXT SERIE...
JAE CATA01 < OK, LE NEXT-SERIE EXISTE.
LR X,A
CP XRAC < EST-ON DE RETOUR SUR LA RACINE ???
JL CATA06 < OUI, ON ARRETE LE PARCOURS DU CATALOGUE
ADRI -I,X < DANS LES AUTRES CAS D'ERREURS,
< ON FAIT UN RETOUR ARRIERE, CAR
< EN EFFET ON NE DOIT PLUS SAVOIR
< OU L'ON EN EST SUITE A UN
< DELETE SIMULTANE...
JMP CATA00 < N'ETANT PAS DE RETOUR SUR
< LA RACINE, ON CONTINUE.
<
< CAS OU IL Y A UN NEXT-SERIE :
<
CATA01: EQU $
ADRI I,X
LBY &ANOM < RECUPERATION DE CE NEXT-SERIE.
CPI KEOT < EST-CE UNE FIN DE NOM ???
JNE CATA00 < NON, ON CONTINUE A RECUPERER.
<
< ACCES A LA VALEUR COURANTE :
<
LAI COSBT?XASSIM=FMASK(K?NVPLON=FCINST
BSR AGOSGN < CHARGEMENT DE LA VALEUR...
ACTD XXXSIZ < ACCES A LA TAILLE DE LA VALEUR CHARGEE :
< (B)=NOMBRE D'OCTETS OCCUPES :
CPR B,Y < EST-CE BIEN CE QUE L'ON ATTEND ???
JNE CATA02 < NON, ON L'IGNORE...
<
< TRAITEMENT DU NOM COURANT :
<
BSR APVAR < ET APPEL DU SOUS-PROGRAMME
< SPECIFIQUE...
<
< RECHERCHE DU NEXT-PARALLELE :
<
CATA02: EQU $
CATA03: EQU CATA02 < ENTRY DE PREMIERE RECHERCHE DE NEXT-
< SERIE (CF. RACINE D'UN CATALOGUE)
LAI COSBT?XASSIM=FMASK(K?NVPNXP=FCINST
BSR AGOSGN < RECHERCHE NEXT-PARALLELE.
CPI ENSX < TEST DU CODE D'ERREUR.
JE CATA05 < CAS DU NEXT-PARALLELE QUI
< N'EXISTE PAS...
JANE CATA00 < AUTRES CAS DU SUREMENT A UN
< DELETE SIMULTANE QUI DESORIENTE!!!
<
< CAS OU IL Y A UN NEXT-PARALLELE :
<
CATA04: EQU $
ADRI I,X
LBY &ANOM < RECUPERATION DE CELUI-CI.
ADRI -I,X
STBY &ANOM < ET ON LE MET A SA BONNE PLACE.
JMP CATA00 < ET RETOUR A LA BOUCLE DE
< RECUPERATION.
<
< CAS OU IL N'Y A PAS DE NEXT-PARALLELE :
<
CATA05: EQU $
ADRI -I,X < RETOUR ARRIERE DANS LE NOM.
LR X,A < POUR VALIDATION.
CP XRAC < EST-ON DE RETOUR SUR LA RACINE ???
JGE CATA02 < NON, ON CONTINUE...
<
< FIN DE PARCOURS,
< ET RETOUR :
<
CATA06: EQU $
PLR A,B,X
RSR
PAGE
<
<
< T R A I T E M E N T D ' U N N O E U D C O U R A N T
< D U M A I L L A G E :
<
<
< FONCTION :
< CE MODULE PREND LE NOEUD
< COURANT RECUPERE DANS LE CA-
< TALOGUE "X*", ET L'INSERE
< DANS LA MEMOIRE DE LA LIGNE
< COURANTE.
<
<
GMAIL: EQU $
<
< INITIALISATIONS :
<
PSR A,B,X,Y
<
< RECUPERATION DE L'IDENTITE
< DU NOEUD COURANT :
<
LAD NMAIL1
LXI K < (X)=INDEX DE DECODAGE,
BSR AHEXIN < CONVERSION BINAIRE DU NOEUD COURANT,
< TELLE QUE :
< (A)=(YR,XR) DU NOEUD...
<
< P A S S A G E D E S C O O R D O N N E S G E O M E T R I Q U E S
< A U X C O O R D O N N E E S T O P O L O G I Q U E S :
<
SLRD NBITMO/NOCMO
STA YR < 'YR' DU NOEUD COURANT,
LAI K
SLLD NBITMO/NOCMO
STA XR < 'XR' DU NOEUD COURANT.
LA YR
CP YRP < 'YR' A-T'IL CHANGE PAR RAPPORT A CELUI
< DU NOEUD PRECEDENT ???
JNE GMAIL0 < OUI...
<
< CAS D'UN 'YR' INCHANGE :
<
LA XR
CP XRP < 'XR' A-T'IL CHANGE PAR RAPPORT A CELUI
< DU NOEUD PRECEDENT ???
JNE GMAIL1 < OUI...
QUIT XXQUIT < NON, CELA VIENT SUREMENT DU MODE DE
< GENERATION DU MAILLAGE : DES POINTS
< DOIVENT ETRE DUPLIQUES...
JMP GMAIL9 < ET ON SAUTE L'INSERTION...
<
< CAS D'UN 'XR' CHANGE :
<
GMAIL1: EQU $
STA XRP < MEMORISATION DU NOUVEAU 'XRP'...
IC NUMJ < CHANGEMENT DE COLONNE...
JMP GMAIL2 < VERS L'INSERTION...
<
< CAS D'UN 'YR' CHANGE :
<
GMAIL0: EQU $
STA YRP < MEMORISATION DU NOUVEAU 'YRP'...
LA AMOCDN
STA XRP < ET DU NOUVEAU 'XRP' (INEXISTANT)...
LA NUMJ
JAE GMAIL5 < CAS DE L'INITIALISATION...
CPI W < Y-A-T'IL PLUS D'UN POINT DANS LA LIGNE
< PRECEDENTE ???
JG GMAIL3 < OUI, OK...
QUIT XXQUIT < NON, ON NE PEUT RIEN FAIRE...
GMAIL3: EQU $
TBT NBITMO-B < TEST DE LA PARITE DE 'J' :
JC GMAIL5 < 'J' EST IMPAIR, IL Y A DONC UN NOMBRE
< PAIR DE POINTS SUR LA LIGNE, OK...
QUIT XXQUIT < E R R E U R : LE NOMBRE DE POINTS SUR
< LA LIGNE COURANTE EST IMPAIR ; ON NE
< POURRA DONC PAS ALLER DE 2 EN 2...
< (ET CE EN MODE J-TORE)
GMAIL5: EQU $
STZ NUMJ < (NUMJ)=PREMIERE COLONNE...
IC NUMI < CHANGEMENT DE LIGNE...
LA NUMI
CPI IMAX < VALIDATION DE 'I' :
JL GMAIL4 < OK...
QUIT XXQUIT < D E B O R D E M E N T...
GMAIL4: EQU $
LR A,X < (X)=(NUMI)=NUMERO DE LA NOUVELLE LIGNE,
LA XBUF < (A)=INDEX D'INSERTION DE SON PREMIER
< POINT,
STA &APLIGX < QUE L'ON MEMORISE DANS LA LISTE DES
< LIGNES...
<
< TRANSFORMATION MATRICIELLE
< DES NOEUDS DU MAILLAGE :
<
GMAIL2: EQU $
LXI MT11
LAD &AMTRAN
LR A,B < (B)=ADRESSE DU VECTEUR LIGNE 'MT1',
LAD CS3D < (A)=ADRESSE DU VECTEUR (FXS,FYS,FZS),
BSR APRSCA < ET CALCUL DE LEUR PRODUIT SCALAIRE,
< MT11*XS+MT12*YS+MT13*ZS,
LXI MT14
FAD &AMTRAN < ET TRANSLATION :
< MT11*XS+MT12*YS+MT13*ZS+MT14,
FMP FK < PUIS MISE A L'ECHELLE,
PSR A,B < ET SAUVEGARDE DU FUTUR 'FXS'...
LXI MT21
LAD &AMTRAN
LR A,B < (B)=ADRESSE DU VECTEUR LIGNE 'MT2',
LAD CS3D < (A)=ADRESSE DU VECTEUR (FXS,FYS,FZS),
BSR APRSCA < ET CALCUL DE LEUR PRODUIT SCALAIRE,
< MT21*XS+MT22*YS+MT23*ZS,
LXI MT24
FAD &AMTRAN < ET TRANSLATION :
< MT21*XS+MT22*YS+MT23*ZS+MT24,
FMP FK < PUIS MISE A L'ECHELLE,
PSR A,B < ET SAUVEGARDE DU FUTUR 'FYS'...
LXI MT31
LAD &AMTRAN
LR A,B < (B)=ADRESSE DU VECTEUR LIGNE 'MT3',
LAD CS3D < (A)=ADRESSE DU VECTEUR (FXS,FYS,FZS),
BSR APRSCA < ET CALCUL DE LEUR PRODUIT SCALAIRE,
< MT31*XS+MT32*YS+MT33*ZS,
LXI MT34
FAD &AMTRAN < ET TRANSLATION :
< MT31*XS+MT32*YS+MT33*ZS+MT34,
FMP FK < PUIS MISE A L'ECHELLE,
#/FST# FZS < ET VOILA LE NOUVEAU 'FZS' :'...
< ZS=K*(MT31*XS+MT32*YS+MT33*ZS+MT34),
PLR A,B
#/FST# FYS < ET VOILA LE NOUVEAU 'FYS' :'...
< YS=K*(MT21*XS+MT22*YS+MT23*ZS+MT24),
PLR A,B
#/FST# FXS < ET VOILA LE NOUVEAU 'FXS' :'...
< XS=K*(MT11*XS+MT12*YS+MT13*ZS+MT14),
<
< INSERTION DANS LA LISTE
< DES NOEUDS DU MAILLAGE :
<
LA NUMI
SWBR A,A
OR NUMJ < (A)=(I,J),
STA IDENT < MEMORISATION DE (I,J)...
LX NUMI < (X)=(NUMI)=NUMERO DE LA LIGNE COURANTE,
LA NUMJ < (A)=NUMERO DU POINT COURANT,
STA &APLIGM < ON MEMORISE AINSI EN PERMANENCE LE
< POINT COURANT, ET DONC FINALEMENT LE
< 'J' MAXIMAL DE CHAQUE LIGNE 'I'...
LX XBUF
LR X,A < ET VALIDATION :
CP XBUFMX
JL GMAIL6 < OK...
QUIT XXQUIT < E R R E U R : DEBORDEMENT DE 'BUF' !!!
GMAIL6: EQU $
LR X,B < (B)=ADRESSE DU RECEPTEUR (LISTE),
ADRI LBUF4D,X
STX XBUF < MISE A JOUR DE L'INDEX...
LAD CS3D < (A)=ADRESSE DE L'EMETTEUR (POINT 3D),
XR A,B < (A)=ADRESSE DU RECEPTEUR,
< (B)=ADRESSE DE L'EMETTEUR,
LXI LBUF4D < (X)=NOMBRE DE MOTS A DEPLACER,
WCDA
< ET DEPLACEMENT DU POINT 3D COURANT.
<
< ET RETOUR :
<
GMAIL9: EQU $
PLR A,B,X,Y
RSR
PAGE
<
<
< T R A I T E M E N T D E L A F A C E T T E C O U R A N T E :
<
<
GFACET: EQU $
<
< INITIALISATION :
<
PSR A,B,X
<
< MEMORISATION DE LA FACETTE COURANTE :
<
LX XBUF < (X)=INDEX D'INSERTION COURANT,
LR X,A
ADRI LFAC,A < AFIN D'AVOIR UNE MARGE DE MANOEUVRE...
CP XBUFMX < A-T'ON ASSEZ DE PLACE ???
JL GFACE2 < OUI, ALLONS INSERER LA FACETTE COURANTE..
QUIT XXQUIT < P L U S D E P L A C E ...
JMP GFACE1 < NON, ON IGNORE CETTE FACETTE, APRES
< L'AVOIR SIGNALE PAR LE 'CCI'...
GFACE2: EQU $
LR X,A < (A)=ADRESSE DE RANGEMENT,
ADRI LFAC,X
STX XBUF < ET PROGRESSION DE 'XBUF'...
LRM B,X
WORD FAC < (B)=ADRESSE DE LA FACETTE COURANTE,
WORD LFAC < (X)=NOMBRE DE MOTS A DEPLACER...
WCDA
< ET INSERTION DE LA FACETTE COURANTE DANS
< LA LISTE DES FACETTES...
GFACE1: EQU $
<
< ET RETOUR :
<
PLR A,B,X
RSR
PAGE
<
<
< P O I N T D ' E N T R E E :
<
<
DEBUT: EQU $
<
< INITIALISATION DES REGISTRES :
<
LRM C,L,K
WORD COM+DEPBAS < POSITIONNEMENT DE 'C', QUE LE BLOC
WORD LOC+DEPBAS < DE 'L',
WORD STACK-DEPILE < ET DE 'K'.
<
< CONNEXION A LA 'CDA' :
<
LAI PAGER
BSR AGPCDA < AFIN D'ATTEINDRE LA MEMOIRE DU '68000'
< ET LA MEMOIRE 'SOLAR' QUI LA PRECEDE
< AFIN D'Y METTRE 'BUF'...
PAGE
<
<
< G E N E R A T I O N D E S F A C E T T E S P A R
< R E C U P E R A T I O N E T T R A I T E M E N T
< D U C A T A L O G U E " X * " :
<
<
DEBUT1: EQU $
<
< INITIALISATION DES DIFFERENTS
< INDICATEURS ET INDEXES :
<
STZ XBUF < INITIALISATION DU BUFFER DE STOCKAGE
< DES ENSEMBLES (FXS,FYS,FZS,IDENT).
STZ NUMI < (NUMI)=NUMERO DE LA PREMIERE LIGNE,
DC NUMI < (A CAUSE D'UN 'IC' INITIAL...)
STZ NUMJ < (NUMJ)=NUMERO DE LA PREMIERE COLONNE.
LA AMOCDN
STA XRP < ON INDIQUE AINSI QU'IL N'Y A PAS
STA YRP < ENCORE DE (YR,XR) ANTERIEUR...
IF XOPT01-EXIST,XOPT1,,XOPT1
XWOR%1: VAL SIZXVI/XC512 < X-FACTEUR DE PASSAGE '512' --> 'VISU',
XWOR%2: VAL SIZYVI/XL512 < Y-FACTEUR DE PASSAGE '512' --> 'VISU'.
IF XWOR%1-XWOR%2,,XEIF%,
IF ATTENTION : LE CALCUL DE 'FACT' EST IDIOT !!!
XEIF%: VAL ENDIF
LRM A,B
WORD XMIN*XWOR%1
WORD YMIN*XWOR%2
STA TRX < TRANSLATION DU
STB TRY < TRACE GRAPHIQUE.
LRM A,B
FLOAT <XWOR%1?XWOR%2<K<K
#/FST# FACT < FACTEUR D'ECHELLE POUR LE TRACE DES
< FACETTES...
XOPT1: VAL ENDIF
<
<
< R E C U P E R A T I O N D U C A T A L O G U E " X * " :
<
<
LRM A,B,Y
WORD NMAIL=FCTA*NOCMO
< (A)=ADRESSE OCTET DU NOM DU CATALOGUE,
WORD GMAIL < (B)=ADRESSE DU SOUS-PROGRAMME DE TRAI-
< TEMENT DES NOEUDS DU MAILLAGE,
WORD LVMAIL < (Y)=NOMBRE D'OCTETS ATTENDUS POUR UN
< NOEUD.
BSR ACATAL < RECUPERATION ET TRAITEMENT DU SOUS-
< CATALOGUE "X*" DES NOEUDS DU MAILLAGE.
<
<
< G E N E R A T I O N D E S F A C E T T E S
< T R I A N G U L A I R E S :
<
<
DEBUT2: EQU $
<
< INITIALISATION DE LA GENE-
< RATION DES FACETTES :
<
STZ FIDENT < INITIALISATION DE L'IDENTIFICATEUR DE
DC FIDENT < LA FACETTE PRECEDENTE...
LA NUMI
TBT NBITMO-B < TEST DE LA PARITE DE 'I' :
JNC E120 < 'I' EST PAIR, IL Y A DONC UN NOMBRE
< IMPAIR DE LIGNES, OK...
QUIT XXQUIT < E R R E U R : IL Y A UN NOMBRE PAIR DE
< LIGNES, ON NE PEUT DONC PAS ALLER DE
< 2 EN 2 EN MODE NON-I-TORE...
E120: EQU $
PSR W
<
< BOUCLE DE PARCOURS DES LIGNES :
<
SLRS PASI=K
CPZ ITORE < EST-ON SUR UN "I-TORE" ???
JE E123 < NON, (A) EST OK...
ADRI W,A < OUI : IL FAUT RAJOUTER UNE LIGNE...
TBT NBITMO-B < QUELLE EST LA PARITE DU NOMBRE DE
< LIGNES ???
JNC E125 < PAIRE, OK... EN EFFET IL NE FAUT PAS
< OUBLIER QU'ON IMPLANTE LES TRIANGLES
< EN QUINCONCE D'UNE LIGNE A L'AUTRE,
< LE NOMBRE DE LIGNES DOIT ETRE ALORS UN
< MULTIPLE DE 2 !!!
QUIT XXQUIT < E R R E U R (CF. CI-DESSUS)...
E125: EQU $
E123: EQU $
LR A,X < (X)=NOMBRE DE LIGNES A TRAITER...
LYI I0 < (Y)=INDEX 'I' DES LIGNES.
E121: EQU $
STY SNUMI < SAUVEGARDE DE LA LIGNE 'I' COURANTE.
STZ FIDENT < CLEAR DU 'J' DES FACETTES SUR LA LIGNE
< COURANTE...
PSR X,Y < SAUVEGARDE DE 'I' ET DU NOMBRE DE LIGNES.
LR Y,X < (X)=NUMERO DE LA LIGNE COURANTE,
<
< BOUCLE DE PARCOURS DES NOEUDS
< DE LA LIGNE 'I' COURANTE :
<
LY &APLIGX < (Y)=XBUF(I,0), SOIT L'INDEX DANS 'BUF'
< DU PREMIER NOEUD DE LA LIGNE 'I'.
STY XBUFI0 < (XBUFI0)=XBUF(I,0)=INDEX 'XBUF' DU
< PREMIER NOEUD DE CHAQUE LIGNE...
LA &APLIGM < (A)='J' MAX DE LA LIGNE 'I',
LR A,B < (B)='J' MAX DE LA LIGNE 'I',
ADRI Z,A < PARCE QUE L'ON EST SUR UN J-TORE, LE
< NOEUD (I,0)=(I,JMAX+1), ET COMPTE DONC
< 2 FOIS...
SLRS PASJ=K
LR A,X < (X)=NOMBRE DE COUPLES DE TRIANGLES A
< GENERER SUR LA LIGNE 'I'.
EORR W,W < (W)='J' COURANT SUR LA LIGNE 'I'...
LA SNUMI < (A)=NUMERO DE LA LIGNE COURANTE,
SLRS XXXMOY=K
TBT NBITMO-B < QUELLE EST SA PARITE ???
JNC E130 < PAIRE, ON COMMENCE SUR (I,0)...
ADRI I,W < IMPAIRE, ON COMMENCE SUR (I,1)...
ADRI LBUF4D,Y < (Y)=XBUF(I,1)...
IF PASJ-XXXMOY,,XEIF%,
IF ATTENTION : CE QUI PRECEDE EST IDIOT !!!
XEIF%: VAL ENDIF
E130: EQU $
E122: EQU $
<
< OUVERTURE GRAPHIQUE :
<
PSR X,Y < SAUVEGARDE DU NOMBRE DE COUPLES DE TRIAN-
< GLES ET DE L'INDEX 'XBUF' DU PREMIER
< NOEUD DE LA LIGNE 'I'.
IF XOPT01-EXIST,XOPT1,,XOPT1
LAD DEMOG
SVC < MISE EN GRAPHIQUE...
XOPT1: VAL ENDIF
<
< GENERATION DU PREMIER TRIANGLE, SOIT :
< (I,J) --> (I,J+2) --> (I+2,J+1) --> (I,J),
< OU 'J' EST GERE MODULO...
<
LR Y,X < (X)=XBUF(I,J),
STX SAVEX0 < ET SAUVEGARDE DU PREMIER SOMMET :
< SAVEX0=XBUF(I,J).
BSR ASP1 < RECUPERATION, ET PROJECTION DU PREMIER
< SOMMET.
BSR ASP1A < GENERATION DE FACETTE(A).
IF XOPT01-EXIST,XOPT1,,XOPT1
BSR ASP4 < MISE EN PLACE DU PREMIER SOMMET...
XOPT1: VAL ENDIF
PSR B,W < SAUVEGARDE DE 'J' MAX, ET DE 'I' COURANT.
LXI PASJ < INCREMENT DE 'J',
BSR ASP3 < CALCUL DE XBUF(I,J+2),
STX SAVEX1 < ET SAUVEGARDE DU DEUXIEME SOMMET :
< SAVEX1=XBUF(I,J+2).
BSR ASP2 < RECUPERATION, PROJECTION DU DEUXIEME
< SOMMET, ET TRACE DU PREMIER COTE.
BSR ASP1B < GENERATION DE FACETTE(B).
PLR B,W < RESTAURATION DE :
< (B)='J' MAX,
< (W)='J' COURANT...
LA XBUFI0 < POUR EMPILER XBUF(I,0)...
PSR A,B,W < ET RESAUVEGARDE IMMEDIATE...
LX SNUMI < (X)='I' COURANT,
BSR ASP5 < PASSAGE A I+2,
LB &APLIGM < (B)='J' MAX DE LA LIGNE I+2,
LX &APLIGX < (X)=XBUF(I+2,0), SOIT L'INDEX 'XBUF'
< DU PREMIER NOEUD DE LA LIGNE I+2.
STX XBUFI0 < (XBUFI0)=XBUF(I+2,0)=INDEX 'XBUF' DU PRE-
< MIER NOEUD DE LA LIGNE I+2...
PSR B < SAUVEGARDE DU 'J' MAX DE LA LIGNE I+2.
LXI PASJ/XXXMOY < INCREMENT DE 'J',
BSR ASP3 < PASSAGE AU NOEUD (I+2,J+1),
STX SAVEX2 < ET SAUVEGARDE DU TROISIEME SOMMET :
< SAVEX2=XBUF(I+2,J+1).
PLR B < RESTAURE :
< (B)='J' MAX DE LA LIGNE I+2.
BSR ASP2 < RECUPERATION, PROJECTION DU TROISIEME
< SOMMET ET TRACE DU DEUXIEME COTE.
BSR ASP1C < GENERATION DE FACETTE(C), ET DE LA
< FACETTE (A,B,C)...
LXI PASJ < INCREMENT DE 'J',
BSR ASP3 < CALCUL DE XBUF(I+2,J+1+2) EN PREVISION
< DU DEUXIEME SOMMET DU DEUXIEME TRIANGLE.
STX SAVEX3 < SAUVEGARDE DU "QUATRIEME" SOMMET :
< SAVEX3=XBUF(I+2,J+1+2).
PLR A,B,W < RESTAURE :
< (A)=XBUF(I,0),
< (B)='J' MAX DE LA LIGNE 'I',
< (W)='J' COURANT.
STA XBUFI0 < RESTAURE XBUF(I,0)...
LX SAVEX0
BSR ASP2 < RETOUR AU PREMIER SOMMET, AFIN DE FERMER
< LE PREMIER TRIANGLE...
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE 'JE' QUI SUIT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IDEGEN < LA FACETTE (A,B,C) EST-ELLE DEGENEREE ???
JE E160 < OUI, ON L'IGNORE...
IF XOPT01-EXIST,XOPT1,,XOPT1
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IWGNFI < TRACE-T'ON LES NORMALES AUX FACETTES
< "INTERNES" ???
JE E230 < NON...
BSR ASP6 < TRACE DE LA NORMALE A LA PREMIERE
< FACETTE...
E230: EQU $
BSR ASPB < VERIFICATION DE L'EQUATION DU PLAN...
XOPT1: VAL ENDIF
BSR AFACE < CALCUL DES 6 FACETTES "EXTERNES" ASSO-
< CIEES A LA FACETTE "INTERNE" COURANTE...
E160: EQU $ < CAS DES FACETTES DEGENEREES...
<
< TRACE DU DEUXIEME TRIANGLE, A SAVOIR :
< (I,J+2) --> (I+2,J+1+2) --> (I+2,J+1) --> (I,J+2),
< OU 'J' EST GERE MODULO...
<
IF XOPT01-EXIST,XOPT1,,XOPT1
LAD DEMOG
SVC < AFIN DE NE PAS CHAINER LES 2 TRIANGLES
< GRAPHIQUEMENT...
XOPT1: VAL ENDIF
LX SAVEX1
BSR ASP1 < RECUPERATION DE (I,J+2),
BSR ASP1A < GENERATION DE FACETTE(A).
IF XOPT01-EXIST,XOPT1,,XOPT1
BSR ASP4 < MISE EN PLACE DU PREMIER SOMMET...
XOPT1: VAL ENDIF
LX SAVEX3
BSR ASP2 < RECUPERATION DE (I+2,J+1+2) ET TRACE DU
< PREMIER COTE,
BSR ASP1B < GENERATION DE FACETTE(B).
LX SAVEX2
BSR ASP2 < RECUPERATION DE (I+2,J+1) ET TRACE DU
< DEUXIEME COTE,
BSR ASP1C < GENERATION DE FACETTE(C), ET DE LA
< FACETTE (A,B,C)...
LX SAVEX1
BSR ASP2 < RECUPERATION DE (I,J+2) ET TRACE DU
< DERNIER COTE...
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE 'JE' QUI SUIT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IDEGEN < LA FACETTE (A,B,C) EST-ELLE DEGENEREE ???
JE E161 < OUI, ON L'IGNORE...
IF XOPT01-EXIST,XOPT1,,XOPT1
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IWGNFI < TRACE-T'ON LES NORMALES AUX FACETTES
< "INTERNES" ???
JE E231 < NON...
BSR ASP6 < TRACE DE LA NORMALE A LA DEUXIEME
< FACETTE...
E231: EQU $
BSR ASPB < VERIFICATION DE L'EQUATION DU PLAN...
XOPT1: VAL ENDIF
BSR AFACE < CALCUL DES 6 FACETTES "EXTERNES" ASSO-
< CIEES A LA FACETTE "INTERNE" COURANTE...
E161: EQU $ < CAS DES FACETTES DEGENEREES...
<
< PASSAGE AU NOEUD (I,J+2) SUIVANT :
<
PLR X,Y < RESTAURE :
< (X)=NOMBRE DE NOEUDS SUR LA LIGNE 'I',
< (Y)=XBUF(I,J).
ADRI PASJ,W < PASSAGE DE 'J' A 'J+2'...
ADRI LBUF4D*PASJ,Y < (Y)=XBUF(I,J)...
JDX E122 < ET PASSAGE AU NOUVEAU COUPLE DE TRIAN-
< GLES...
<
< PASSAGE A LA LIGNE I+2 SUIVANTE :
<
PLR X,Y < RESTAURE :
< (X)=NOMBRE DE LIGNES,
< (Y)='I' COURANT.
XR X,Y < AFIN D'APPELER 'SP5'...
BSR ASP5 < I <-- (I)+2,
XR X,Y < RESTAURATION DE 'X' ET 'Y'...
JDX E121 < ET PASSAGE A LA LIGNE SUIVANTE...
<
< A LA FIN, RETOUR EN ALPHA-NUMERIQUE :
<
PLR W
IF XOPT01-EXIST,XOPT1,,XOPT1
LAD DEMCG
SVC
XOPT1: VAL ENDIF
BSR ATSFLO
PAGE
<
<
< V I S U A L I S A T I O N D E L A S U R F A C E P A R
< R E C U P E R A T I O N E T T R A I T E M E N T
< D U C A T A L O G U E " X / " :
<
<
DEBUT3: EQU $
<
< INITIALISATIONS DES DIFFERENTS
< INDEXES ET DE CERTAINES VARIABLES :
<
STZ XBUF < RAZ DE L'INDEX D'INSERTION DES FACETTES.
LRM A,B
WORD XMIN
WORD YMIN
STA TRX < TRANSLATION DU
STB TRY < TRACE RASTER.
#/FLD# F1
#/FST# FACT < FACTEUR D'ECHELLE POUR LE TRACE RASTER...
#/FLD# F0
#/FST# FXSD < ON PLACE LE POINT DE VUE EN : XD=0,
#/FST# FYSD < YD=0,
#/FLD# PZ
#/FST# FZSD < ZD=PZ.
<
<
< R E C U P E R A T I O N D U C A T A L O G U E " X / " :
<
<
LRM A,B,Y
WORD NFACET=FCTA*NOCMO
< (A)=ADRESSE OCTET DU NOM DU CATALOGUE,
WORD GFACET < (B)=ADRESSE DU SOUS-PROGRAMME DE TRAI-
< TEMENT DES FACETTES DU MAILLAGE,
WORD LFAC*NOCMO < (Y)=NOMBRE D'OCTETS ATTENDUS POUR UNE
< FACETTE.
BSR ACATAL < RECUPERATION ET TRAITEMENT DU SOUS-
< CATALOGUE "X/" DES FACETTES.
LX XBUF
STX SAVEX0 < SAUVEGARDE DE L'INDEX MAXIMAL DE RANGE-
< MENT DES FACETTES...
<
<
< V I S U A L I S A T I O N :
<
<
DEBUT4: EQU $
LRM A
WORD DEBUT5 < POUR 'XXXPRE'...
ACTD XXXPRE < ON CHANGE ALORS SYSTEMATIQUEMENT APRES
< PASSAGE ICI LE 'PRESC' DU PROGRAMME, AFIN
< DE REVENIR SUR LA VISUALISATION APRES
< CHAQUE ALT-MODE (VIA 'DEBUT5'...).
<
< (RE-)INITIALISATION DES
< HASH-TABLES D'OPTIMISATION
< DU CALCUL DES 3 FONCTIONS
< X(U,V), Y(U,V) ET Z(U,V) :
<
PSR C,L,W < PRUDENCE...
LRM C,L,W
WORD HASHTX < (C)=BASE DE 'HASHTX',
WORD HASHTY < (L)=BASE DE 'HASHTY',
WORD HASHTZ < (W)=BASE DE 'HASHTZ'...
#/FLD# F0 < PAR PURE PROPRETE...
LXI NEHASH < (X)=NOMBRE D'ENTREES PAR TABLE...
VISU10: EQU $
IF NEXIST-K,,XEIF%,
IF ATTENTION : L'INITIALISATION SUIVANTE EST IDIOTE !!!
XEIF%: VAL ENDIF
STZ HASHFR,C < LIBERATION ET NETTOYAGE DE 'HASHTX'...
#/FST# HASHU,C
#/FST# HASHV,C
#/FST# HASHF,C
STZ HASHFR,L < LIBERATION ET NETTOYAGE DE 'HASHTY'...
#/FST# HASHU,L
#/FST# HASHV,L
#/FST# HASHF,L
STZ HASHFR,W < LIBERATION ET NETTOYAGE DE 'HASHTZ'...
#/FST# HASHU,W
#/FST# HASHV,W
#/FST# HASHF,W
ADRI LEHASH,C < ET PASSAGE
ADRI LEHASH,L < AUX ENTREES
ADRI LEHASH,W < SUIVANTES,
JDX VISU10 < SI ELLES EXISTENT...
PLR C,L,W < ET RESTAURATIONS...
<
< REINITIALISATION DU BUFFER
< DE LIGNE DE COHERENCE :
<
LAI XXNOIR < (A)=NIVEAU DE NOIR,
LRM X
WORD XC512-Z < (X)=INDEX DU DERNIER POINT...
VISU93: EQU $
STBY &ALIGNE < REMISE DU BUFFER DE LIGNE A NOIR...
ADRI -I,X < PASSAGE AU POINT PRECEDENT,
CPZR X < S'IL EXISTE...
JGE VISU93 < ET OUI...
<
< INITIALISATION DU
< SYSTEME DE VISUALISATION :
<
XWOR%1: VAL NIV256=K
IF BIT>XWOR%1-NIV256,,XEIF%,
IF ATTENTION : LE CALCUL DU MASQUE SELECTANT TOUS
IF LES PLANS EST ABSURDE !!!
XEIF%: VAL ENDIF
LAI NIV256-N)MOCD
STA MCDAJ
LA ARPLAN < (A)=ADRESSE DU REGISTRE DE SELECTION...
BSR APWCDA < ET ON SELECTIONNE TOUS LES PLANS...
LAI ERASE
STA MCDAJ
LA ARCMD
BSR APWCDA < EFFACEMENT DE L'ECRAN, ET REINITIALISA-
< TION DE TOUS LES REGISTRES...
LRM A
WORD TEMPO
SVC < ET ON ATTEND UN PEU...
<
< BOUCLE DE PARCOURS
< DES LIGNES DE L'IMAGE :
<
LRM Y
LYMIN: WORD YMIN < (Y)=COORDONNEE 'Y' DE L'IMAGE.
VISU9: EQU $
PSR Y < SAUVEGARDES...
LYI XEPSU0 < (Y)=INDEX D'ACCES AUX 'DU0',
LXI XNOCTA < (X)=NOMBRE D'OCTANTS DE L'ESPACE,
#/FLD# F0 < (A,B)=VALEUR INITIALE DE 'DU0' ET 'DV0',
VISU94: EQU $
XR X,Y
FST &ALTORE < EN DEBUT DE CHAQUE LIGNE DE BALAYAGE
< RASTER, ON REINITIALISE L'ENSEMBLE DES
< (DU0,DV0), CAR EN EFFET, UN CHANGEMENT
< DE LIGNE CONSTITUE UNE DISCONTINUITE ;
< DE PLUS, ON FAIT UN TRI DES FACETTES
< SUIVANT L'OCTANT AUQUEL APPARTIENT LEUR
< VECTEUR NORMAL...
ADRI XEPSV0-XEPSU0,X < PASSAGE A 'DV0',
FST &ALTORE < 'DV0',
XR X,Y
ADRI XEPSU0-XEPSV0+DFLOT,Y
< PASSAGE AU 'DU0' SUIVANT,
JDX VISU94 < S'IL EXISTE...
PLR Y < ET RESTAURATIONS...
<
< BOUCLE DE PARCOURS DE
< LA LIGNE COURANTE (Y) :
<
LRM X
LXMIN: WORD XMIN < (X)=COORDONNEE 'X' DE L'IMAGE.
VISU1: EQU $
PSR X,Y,W < SAUVEGARDES...
LR X,A < AFIN DE FAIRE DES VERIFICATIONS ENTRE
AD TRX < LE POINT (X,Y) COURANT DE BALAYAGE, ET
STA XS < LA PROJECTION DU POINT D'INTERSECTION
STA XR
LR Y,A < COURANT, ET L'EVENTUELLE VISUALISATION
AD TRY < GRAPHIQUE...
STA YS
STA YR < (XR,YR) MEMORISE LE POINT RASTER COURANT,
< ET EST UTILISE LORS DU TEST DE LA POSI-
< TION DE CELUI-CI PAR RAPPORT A LA
< PROJECTION DE LA FACETTE COURANTE...
<
< COMPOSANTE EN 'X' DE LA DROITE 'D' :
< LA DROITE 'D' EST ISSUE DU POINT
< (FXSD,FYSD,FZSD), ET PASSE PAR
< LE POINT COURANT (XP,YP) DU PLAN DE
< PROJECTION (ZP=0), SON EQUATION EST DONC :
<
< X=XD+RHO*VX,
< Y=YD+RHO*VY,
< Z=ZD+RHO*VZ,
<
< OU :
<
< VX=(XP-XD)/V,
< VY=(YP-YD)/V,
< VZ=(ZP-ZD)/V=-ZD/V PUISQUE ZP=0 (PLAN DE PROJECTION).
<
< OU :
< 'V' DESIGNE LA NORME DU VECTEUR (VX,VY,VZ).
<
LR X,A
BSR AFLT < X,
FSB FXSD < X-XD,
#/FST# DVX < DVX=X-XD, OU 'X' DESIGNE LE 'X' DU POINT
< COURANT.
<
< COMPOSANTE EN 'Y' DE LA DROITE 'D' :
<
LR Y,A
BSR AFLT < Y,
FSB FYSD < Y-YD,
#/FST# DVY < DVY=Y-YD, OU 'Y' DESIGNE LE 'Y' DU POINT
< COURANT...
<
< COMPOSANTE EN 'Z' DE LA DROITE 'D' ;
<
#/FLD# FZSD
BSR AFNEG
#/FST# DVZ < EN EFFET, LE PLAN DE PROJECTION EST
< LE PLAN Z=0...
<
< NORMALISATION DU VECTEUR
< DIRECTEUR DE LA DROITE 'D' :
<
LRM A,B
WORD DV3D < (A)=ADRESSE DE (DVX,DVY,DVZ),
WORD DV3D < (B)=ADRESSE DE (DVX,DVY,DVZ),
BSR APRSCA < CALCUL DU CARRE DE LA NORME DU VECTEUR
< DIRECTEUR DE LA DROITE 'D',
BSR ARAC < PUIS DE SA NORME,
BSR ASFWOR < QUE L'ON SAUVEGARDE DANS 'WORK'...
#/FLD# DVX
FDV FWORK
#/FST# DVX < NORMALISATION DE 'DVX',
#/FLD# DVY
FDV FWORK
#/FST# DVY < NORMALISATION DE 'DVY',
#/FLD# DVZ
FDV FWORK
#/FST# DVZ < NORMALISATION DE 'DVZ'.
BSR ATSFLO
IF XOPT01-EXIST,XOPT1,,XOPT1
<
< SUIVI GRAPHIQUE DU BALAYAGE
< RASTER DE L'IMAGE :
<
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST QUI SUIT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IWPRST < LE TRACE RASTER EST-IL DEMANDE ???
JE VISU60 < NON...
BSR ASP4 < OUI, MISE EN PLACE DE L'ORIGINE,
BSR ASP7 < ET DE L'EXTREMITE DU VECTEUR COURANT
< QUI SE REDUIT AU POINT (X,Y)...
LAD DEMOG
SVC < DECHAINAGE GRAPHIQUE...
LAD DEMWG
SVC < ET TRACE DU POINT (X,Y) COURANT...
VISU60: EQU $
XOPT1: VAL ENDIF
<
< BOUCLE DE TEST DE CHAQUE FACETTE :
<
IF XOPT01-EXIST,XOPT1,,XOPT1
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST QUI SUIT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IWCONV < LE TRACE DE SUIVI DE LA CONVERGENCE
< EST-IL DEMANDE ???
JE VISU61 < NON...
QUIT XXQUIT < PETITE PAUSE AVANT D'EFFACER L'ECRAN
< AFIN DE LAISSER LE TEMPS D'EXAMINER LE
< SUIVI DE CONVERGENCE PRECEDENT...
LRM A < OUI :
WORD DEMERA
SVC < ON EFFACE L'ECRAN DE LA VISU...
VISU61: EQU $
XOPT1: VAL ENDIF
STZ XBUF < AFIN DE COMMENCER SUR LA PREMIERE
< FACETTE...
LYI K < (Y)=COMPTEUR DES POINTS D'INTERSECTIONS,
LRM W
WORD LPINT < (W)=ADRESSE DES POINTS D'INTERSECTION
< TROUVES DANS 'LPINT'.
VISU2: EQU $
<
< ACCES A LA FACETTE COURANTE :
<
LX XBUF
LR X,A
CP SAVEX0 < A-T'ON EXPLORE TOUTE LA LISTE ???
JL VISU37 < NON, ON CONTINUE...
BSR AGOTO
WORD VISU3 < OUI, ON ARRETE ICI...
VISU37: EQU $
< NON :
< (A)=ADRESSE DE LA FACETTE COURANTE,
LRM B,X
WORD FAC < (B)=ADRESSE DE MANOEUVRE DE LA
< FACETTE COURANTE,
WORD LFAC < (X)=NOMBRE DE MOTS A DEPLACER,
RCDA
< ET RECUPERATION DE LA FACETTE COURANTE.
<
< EXAMINONS LA POSITION DU
< POINT RASTER COURANT (XR,YR),
< EN CALCULANT SES COORDONNEES
< BARYCENTRIQUES (ALPHA,BETA,GAMMA)
< PAR RAPPORT A LA FACETTE (A,B,C)
< COURANTE PROJETEE PARALLELEMENT
< A LA DROITE 'D' ; ON DOIT DONC
< RESOUDRE :
<
< ALPHA*X(A)+BETA*X(B)+GAMMA*X(C)=XR,
< ALPHA*Y(A)+BETA*Y(B)+GAMMA*Y(C)=YR,
< ALPHA +BETA +GAMMA =1.
<
< OU X( ) ET Y( ) DESIGNENT LES COORDONNEES
< PROJETEES PARALLELEMENT A LA DROITE 'D'
< SUIVANT LES FORMULES OBTENUES EN CALCU-
< LANT L'INTERSECTION D'UNE DROITE PARAL-
< LELE A 'D' ET PASSANT PAR LE POINT 'M'
< COURANT AVEC LE PLAN DE PROJECTION,
< SOIT :
< X=X(M)+RHO*VX,
< Y=Y(M)+RHO*VY,
< Z=Z(M)+RHO*VZ=0,
<
< D'OU :
<
< X=X(M)-Z(M)*(VX/VZ),
< Y=Y(M)-Z(M)*(VY/VZ).
<
LA XR
BSR AFLT
#/FST# M14 < ABSCISSE DU POINT D'INTERSECTION
< ENTRE LA DROITE 'D' ET LA PROJEC-
< TION DE LA FACETTE (A,B,C),
< M14 --> XR,
LA YR
BSR AFLT
#/FST# M24 < DE MEME, SON ORDONNEE...
< M24 --> YR,
#/FLD# F1
#/FST# M34 < M34 --> 1.
#/FLD# DVX < VX,
FDV DVZ < VX/VZ,
BSR AFNEG < -(VX/VZ),
#/FST# FWORK1 < FWORK1=-(VX/VZ).
#/FLD# DVY < VY,
FDV DVZ < VY/VZ,
BSR AFNEG < -(VY/VZ),
#/FST# FWORK2 < FWORK2=-(VY/VZ).
BSR ATSFLO
#/FLD# FWORK1 < -(VX/VZ),
FMP FZSA < -ZA*(VX/VZ),
FAD FXSA < XA-ZA*(VX/VZ),
#/FST# M11 < X(A) PROJETE PARALLELEMENT A 'D'.
#/FLD# FWORK2 < -(VY/VZ),
FMP FZSA < -ZA*(VY/VZ),
FAD FYSA < YA-ZA*(VY/VZ),
#/FST# M21 < Y(A) PROJETE PARALLELEMENT A 'D'.
#/FLD# FWORK1 < -(VX/VZ),
FMP FZSB < -ZB*(VX/VZ),
FAD FXSB < XB-ZB*(VX/VZ),
#/FST# M12 < X(B) PROJETE PARALLELEMENT A 'D'.
#/FLD# FWORK2 < -(VY/VZ),
FMP FZSB < -ZB*(VY/VZ),
FAD FYSB < YB-ZB*(VY/VZ),
#/FST# M22 < Y(B) PROJETE PARALLELEMENT A 'D'.
#/FLD# FWORK1 < -(VX/VZ),
FMP FZSC < -ZC*(VX/VZ),
FAD FXSC < XC-ZC*(VX/VZ),
#/FST# M13 < X(C) PROJETE PARALLELEMENT A 'D'.
#/FLD# FWORK2 < -(VY/VZ),
FMP FZSC < -ZC*(VY/VZ),
FAD FYSC < YC-ZC*(VY/VZ),
#/FST# M23 < Y(C) PROJETE PARALLELEMENT A 'D'.
LAD M11
STA AM11 < M11 --> X(A) PROJETE,
LAD M12
STA AM12 < M12 --> X(B) PROJETE.
LAD M13
STA AM13 < M13 --> X(C) PROJETE.
LAD M21
STA AM21 < M21 --> Y(A) PROJETE,
LAD M22
STA AM22 < M22 --> Y(B) PROJETE,
LAD M23
STA AM23 < M23 --> Y(C) PROJETE.
LAD F1
STA AM31 < M31 --> 1,
STA AM32 < M32 --> 1,
STA AM33 < M33 --> 1.
LAD ALPHA
STA AVARX < PREMIERE VARIABLE : ALPHA,
LAD BETA
STA AVARY < DEUXIEME VARIABLE : BETA,
LAD GAMMA
STA AVARZ < TROISIEME VARIABLE : GAMMA.
#/FLD# F0 < AFIN DE CALCULER LE DETERMINANT...
BSR ADETER < CALCUL DU DETERMINANT DU SYSTEME :
< ALORS : LES SOMMETS (A,B,C) PROJETES
< SONT-ILS ALIGNES ???
JE VISU4 < OUI, ON IGNORE CETTE FACETTE...
BSR ACRAMR < CALCUL DE (ALPHA,BETA,GAMMA)...
BSR ATSFLO
#/FLD# ALPHA < ALORS, (XR,YR) EST-IL DANS (A,B,C) ???
BSR AFCAZ
JL VISU4 < NON...
FCAM F1
JG VISU4 < NON...
#/FLD# BETA < PEUT-ETRE ???
BSR AFCAZ
JL VISU4 < NON...
FCAM F1
JG VISU4 < NON...
#/FLD# GAMMA < PEUT-ETRE ???
BSR AFCAZ
JL VISU4 < NON...
FCAM F1
JG VISU4 < NON...
<
< CALCUL DU POINT D'INTERSECTION
< ENTRE LA DROITE 'D' COURANTE (ALLANT
< DE L'OBSERVATEUR (FXSD,FYSD,FZSD) AU
< POINT RASTER (X,Y) COURANT) ET DE
< LA FACETTE COURANTE ET/OU DE
< DE LA SURFACE 'S' :
<
IF NEXIST-K,,XEIF%,
IF ATTENTION : LES 'JE' QUI SUIVENT SONT IDIOTS !!!
XEIF%: VAL ENDIF
BSR AINTDB < TEST DE L'INTERSECTION ENTRE 'D' ET LA
< BOULE 'B' COURANTE :
JE VISU4 < INEXISTANTE, ON SAUTE...
BSR AINTDP < TEST DE L'INTERSECTION ENTRE 'D' ET LA
< FACETTE ELLE-MEME :
JE VISU4 < INEXISTANTE, ON SAUTE...
IF EXIST-K,XEIF%,,XEIF%
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!!
XEIF%: VAL ENDIF
CPZ IVSUR < QUE VISUALISE-T'ON ???
JNE VISU70 < LA SURFACE 'S'...
<
< VISUALISATION DES
< FACETTES PLANES :
<
LRM A,B
WORD CM3D < (A)=ADRESSE DU POINT D'INTERSECTION
< ENTRE LA DROITE 'D' ET LA FACETTE,
WORD CS3D < (B)=ADRESSE DU POINT 3D COURANT,
BSR AMOVE3 < (FXS,FYS,FZS) <-- (FXSM,FYSM,FZSM).
#/FLD# VARUM < LE DEPLACEMENT DES
#/FST# VARU < COORDONNEES CURVILIGNES
#/FLD# VARVM < EST FAIT PAR PURE QUESTION
#/FST# VARV < D'HYGIENE...
JMP VISU71 < VERS LA MEMORISATION DU POINT D'INTER-
< SECTION...
<
< VISUALISATION DE LA SURFACE 'S' :
<
VISU70: EQU $
BSR AINTDS < TEST DE L'INTERSECTION ENTRE 'D' ET LA
< SURFACE 'S' PROPREMENT DITE :
JE VISU4 < INEXISTANTE, ON SAUTE...
< LORSQU'ON LA TROUVE, ON NOTERA QUE
< 'VARU' ET 'VARV' DONNE LES COORDONNEES
< CURVULIGNES DU POINT D'INTERSECTION SUR
< LA SURFACE 'S'.
<
< CAS OU L'ON A TROUVE UN
< POINT D'INTERSECTION (FXS,FYS,FZS)
< ENTRE LA DROITE 'D' COURANTE ET
< LA SURFACE 'S' :
<
VISU71: EQU $
NPINT:: VAL 8 < NOMBRE MAXIMAL DE POINTS D'INTERSECTION
< RECONNUS ENTRE UNE DROITE 'D' ET UNE
< SURFACE 'S'...
PINT3D:: MOT O < COORDONNEES (X,Y,Z) DU POINT D'INTERSEC-
< TION SUR LA FACETTE OU LA SURFACE SUI-
< VANT 'IVSUR',
LPIN3D:: VAL LBUF3D < LONGUEUR DE 'PINT3D'.
PINTUV:: MOT PINT3D+LPIN3D < COORDONNEES CURVILIGNES (U,V) DU POINT
< D'INTERSECTION SUR 'S',
LPINUV:: VAL LVARUV < LONGUEUR DE 'PINTUV'.
PINTAD:: MOT PINTUV+LPINUV < INDEX DE LA FACETTE AYANT FOURNI L'INTER-
< SECTION DANS 'BUF',
LPINAD:: VAL D < LONGUEUR DE 'PINTAD'.
LOPINT:: VAL LPIN3D+LPINUV+LPINAD
< LONGUEUR DE LA ZONE DE SAUVEGARDE D'UN
< POINT D'INTERSECTION TROUVE.
IF PINTAD+LPINAD-PINT3D-LOPINT,,XEIF%,
IF ATTENTION : LES DEFINITIONS PRECEDENTES
IF SONT INCOHERENTES !!!
XEIF%: VAL ENDIF
LR Y,A < (A)=(Y)=NOMBRE D'INTERSECTIONS COURANT,
CPI NPINT < ET VALIDATION...
JL VISU5 < OK...
QUIT XXQUIT < D E B O R D E M E N T ...
JMP VISU3 < ET ON PERD CE POINT D'INTERSECTION, TOUT
< ARRETANT LA LE PARCOURS DE LA LISTE DES
< FACETTES...
VISU5: EQU $
LRM A,X
WORD CS3D < (A)=POINT D'INTERSECTION COURANT,
WORD LPIN3D < (X)=NOMBRE DE MOTS A DEPLACER...
LR W,B < (B)=ZONE DE SAUVEGARDE DU POINT D'INTER-
< SECTION COURANT DANS 'LPINT'.
ADR X,W < ET PROGRESSION DE L'ADRESSE DE SAUVE-
< GARDE DES POINTS D'INTERSECTION...
MOVE < ET SAUVEGARDE DU POINT D'INTERSECTION
< COURANT...
LRM A,X
WORD VARUVW < (A)=COORDONNEE CURVILIGNES DU POINT
< D'INTERSECTION COURANT,
WORD LPINUV < (X)=NOMBRE DE MOTS A DEPLACER,
LR W,B < (B)=ZONE DE SAUVEGARDE,
ADR X,W < ET PROGRESSION DE L'ADRESSE DE SAUVE-
< GARDE...
MOVE < ET SAUVEGARDE DE (VARU,VARV) DU POINT
< D'INTERSECTION COURANT...
LX XBUF < (X)=INDEX DE LA FACETTE EN CAUSE,
STX O,W < QUE L'ON SAUVEGARDE (UTILISE LORSQUE L'ON
< NE VISUALISE QUE LES FACETTES...
ADRI LPINAD,W < ET PROGRESSION DE L'ADRESSE DE SAUVE-
< GARDE...
ADRI I,Y < ET COMPTAGE DANS 'Y' DES POINTS
< D'INTERSECTION...
<
< PASSAGE A LA FACETTE SUIVANTE :
<
VISU4: EQU $
LX XBUF
ADRI LFAC,X
STX XBUF < ET PROGRESSION DANS LA LISTE DES
< DES FACETTES,
BSR AGOTO
WORD VISU2 < SI ELLE EXISTE...
<
< FIN DE LA LISTE DES FACETTES :
<
VISU3: EQU $
LR Y,X < (X)=NOMBRE DE POINTS D'INTERSECTION
< RENCONTRES,
CPZR X < Y-EN-A-T'IL AU MOINS UN ???
JG VISU40 < OUI, ON VA TRACER...
BSR AGOTO < NON,
WORD VISU6 < RIEN A FAIRE...
VISU40: EQU $
<
< ELIMINATION DES PARTIES CACHEES,
< PAR RECHERCHE DU POINT D'INTER-
< SECTION DE 'Z' EXTREMAL :
<
LRM A,Y,W
AZMAX: WORD Q8000 < (A)=MAXIMUM COURANT DE LA COORDONNEE 'Z',
WORD LPINT < (Y)=ADRESSE DU MAXIMUM COURANT,
WORD LPINT < (W)=ADRESSE DU POINT COURANT DANS 'LPINT'
BSR AFLT < "FLOTTAGE" DE 'ZMAX',
BSR AFCAZ < QUEL EXTREMUM RECHERCHE-T'ON ???
JL VISU80 < LE MAXIMUM (VISUALISATION DES FACES
< AVANT)...
<
< LE MINIMUM (VISUALISATION
< DES FACES ARRIERE) :
<
VISU87: EQU $
FCAM FZS-CS3D+PINT3D,W
< RECHERCHE DU MINIMUM :
JLE VISU88 < NON...
#/FLD# FZS-CS3D+PINT3D,W
< OUI,
< (A,B)=NOUVEAU MINIMUM COURANT,
LR W,Y < DONT ON MEMORISE L'ADRESSE DANS 'Y'...
VISU88: EQU $
ADRI LOPINT,W < PASSAGE AU POINT D'INTERSECTION SUIVANT..
JDX VISU87 < S'IL EXISTE...
JMP VISU81 < VERS LA REPRESENTATION GRAPHIQUE...
<
< LE MAXIMUM (VISUALISATION
< DES FACES AVANT) :
<
VISU80: EQU $
VISU7: EQU $
FCAM FZS-CS3D+PINT3D,W
< RECHERCHE DU MAXIMUM :
JGE VISU8 < NON...
#/FLD# FZS-CS3D+PINT3D,W
< OUI,
< (A,B)=NOUVEAU MAXIMUM COURANT,
LR W,Y < DONT ON MEMORISE L'ADRESSE DANS 'Y'...
VISU8: EQU $
ADRI LOPINT,W < PASSAGE AU POINT D'INTERSECTION SUIVANT..
JDX VISU7 < S'IL EXISTE...
<
< RECUPERATION DU POINT D'INTERSECTION
< LE PLUS PROCHE OU LE PLUS ELOIGNE
< DE L'OBSERVATEUR :
<
VISU81: EQU $
LR Y,W < (W)=ADRESSE DE CELUI-CI,
LAD PINT3D,W < (A)=ADRESSE DU POINT D'INTERSECTION,
LRM B,X
WORD CS3D < (B)=ADRESSE DU POINT COURANT,
WORD LBUF3D < (X)=NOMBRE DE MOTS A DEPLACER.
MOVE < (FXS,FYS,FZS)=POINT D'INTERSECTION
< ENTRE 'D' ET 'S' LE PLUS PROCHE
< DE L'OBSERVATEUR...
LAD PINTUV,W < (A)=ADRESSE DE (VARU,VARV),
LRM B,X
WORD VARUVW < (B)=ADRESSE DE (VARU,VARV),
WORD LVARUV < (X)=NOMBRE DE MOTS A DEPLACER,
MOVE < ET RECUPERATION DES COORDONNEES CURVI-
< LIGNES (VARU,VARV) DU POINT D'INTER-
< SECTION COURANT...
BSR APROJ < (XS,YS)=PROJECTION 3D --> 2D DU
< POINT (FXS,FYS,FZS).
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST SUIVANT EST IDIOT !!
XEIF%: VAL ENDIF
CPZ IVSUR < QUE REPRESENTE-T'ON ???
JE VISU72 < LES FACETTES UNIQUEMENT...
<
<
< R E P R E S E N T A T I O N D E L A S U R F A C E :
<
<
VISU90: EQU $
<
< CALCUL DES 6 DERIVEES PARTIELLES
< AU POINT D'INTERSECTION LE PLUS
< PROCHE DE L'OBSERVATEUR :
<
DXDU: EQU DA < DX/DU,
DXDV: EQU DB < DX/DV,
DYDU: EQU DC < DY/DU,
DYDV: EQU DBDC < DY/DV,
DZDU: EQU DCDA < DZ/DU,
DZDV: EQU DADB < DZ/DV.
LYI XSPX
LXI XVARU
LAD FHU
BSR ADERIP
#/FST# DXDU < CALCUL DE DX/DU.
LXI XVARV
LAD FHV
BSR ADERIP
#/FST# DXDV < CALCUL DE DX/DV.
LYI XSPY
LXI XVARU
LAD FHU
BSR ADERIP
#/FST# DYDU < CALCUL DE DY/DU.
LXI XVARV
LAD FHV
BSR ADERIP
#/FST# DYDV < CALCUL DE DY/DV.
LYI XSPZ
LXI XVARU
LAD FHU
BSR ADERIP
#/FST# DZDU < CALCUL DE DZ/DU.
LXI XVARV
LAD FHV
BSR ADERIP
#/FST# DZDV < CALCUL DE DZ/DV.
<
< CALCUL DU VECTEUR NORMAL
< AU POINT D'INTERSECTION
< LE PLUS PROCHE DE L'OBSERVATEUR,
< TEL QUE CELUI-CI SOIT DIRIGE,
< POUR DES SURFACES "NORMALES"
< (ASTUCE...), VERS L'EXTERIEUR :
<
N3D: EQU M11 < DEBUT DU VECTEUR NORMAL :
NX: EQU M11 < COMPOSANTE 'X' DU VECTEUR NORMAL,
NY: EQU M12 < COMPOSANTE 'Y' DU VECTEUR NORMAL,
NZ: EQU M13 < COMPOSANTE 'Z' DU VECTEUR NORMAL.
NORMN: EQU M14 < NORME DU VECTEUR NORMAL.
IF NY-NX-DFLOT,,XEIF%,
IF ATTENTION : 'NX' ET 'NY' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
IF NZ-NY-DFLOT,,XEIF%,
IF ATTENTION : 'NY' ET 'NZ' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
#/FLD# DZDV
FMP DYDU
BSR ASFWOR
#/FLD# DYDV
FMP DZDU
FSB FWORK
#/FST# NX < NX=(DY/DV)*(DZ/DU)-(DZ/DV)*(DY/DU).
#/FLD# DXDV
FMP DZDU
BSR ASFWOR
#/FLD# DZDV
FMP DXDU
FSB FWORK
#/FST# NY < NY=(DZ/DV)*(DX/DU)-(DX/DV)*(DZ/DU).
#/FLD# DYDV
FMP DXDU
BSR ASFWOR
#/FLD# DXDV
FMP DYDU
FSB FWORK
#/FST# NZ < NZ=(DX/DV)*(DY/DU)-(DY/DV)*(DX/DU).
JMP VISU73 < VERS LE VECTEUR OBSERVATION...
<
<
< R E P R E S E N T A T I O N D E S F A C E T T E S :
<
<
VISU72: EQU $
LA PINTAD,W < (A)=INDEX DE LA FACETTE COURANTE,
< =ADRESSE DE LA FACETTE COURANTE,
LRM B,X
WORD FAC < (B)=ADRESSE DE LA FACETTE DE TRAVAIL,
WORD LFAC < (X)=LONGUEUR D'UNE FACETTE,
RCDA
< RAPPEL DE LA FACETTE QUI COUPE LA DROITE
< 'D' COURANTE...
LRM A,B
WORD PLAN3D < (A)=ADRESSE DES COEFFICIENTS (A,B,C)
< DU PLAN DE LA FACETTE,
WORD N3D < (B)=ADRESSE DE LA NORMALE A LA FACETTE
< AU POINT D'INTERSECTION,
BSR AMOVE3 < LA NORMALE AU POINT D'INTERSECTION DE
< LA FACETTE EST LE VECTEUR (A,B,C) DU PLAN
< DE LA FACETTE...
<
<
< V I S U A L I S A T I O N :
<
<
VISU73: EQU $
<
< NORMALISATION DU VECTEUR NORMAL :
<
LRM A,B
WORD NX < (A)=VECTEUR NORMAL,
WORD NX < (B)=VECTEUR NORMAL,
BSR APRSCA < ET CALCUL DU CARRE DE SA NORME,
BSR ARAC < PUIS DE SA NORME...
#/FST# NORMN < QUE L'ON SAUVEGARDE...
<
< VECTEUR OBSERVATION :
< (ALLANT DU POINT COURANT
< (FXS,FYS,FZS) AU POINT
< D'OBSERVATION (FXSD,FYSD,FZSD))
<
CS3DOB: EQU M21 < DEBUT DU VECTEUR OBSERVATION :
FXSOB: EQU M21 < 'X' DU VECTEUR OBSERVATION,
FYSOB: EQU M22 < 'Y' DU VECTEUR OBSERVATION,
FZSOB: EQU M23 < 'Z' DU VECTEUR OBSERVATION.
NORMS: EQU M24 < NORME DU VECTEUR OBSERVATION.
IF FYSOB-FXSOB-DFLOT,,XEIF%,
IF ATTENTION : 'FXSOB' ET 'FYSOB' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
IF FZSOB-FYSOB-DFLOT,,XEIF%,
IF ATTENTION : 'FYSOB' ET 'FZSOB' DOIVENT ETRE CONTIGUS !!!
XEIF%: VAL ENDIF
#/FLD# FXSD < XD,
FSB FXS < XD-X,
#/FST# FXSOB < ET SAVE...
#/FLD# FYSD < YD,
FSB FYS < YD-Y,
#/FST# FYSOB < ET SAVE...
#/FLD# FZSD < ZD,
FSB FZS < ZD-Z,
#/FST# FZSOB < ET SAVE...
<
< NORMALISATION DU VECTEUR OBSERVATION :
<
LRM A,B
WORD CS3DOB < (A)=VECTEUR OBSERVATION,
WORD CS3DOB < (B)=VECTEUR OBSERVATION,
BSR APRSCA < CALCUL DU CARRE DE SA NORME,
BSR ARAC < ET PUIS DE SA NORME...
#/FST# NORMS < QUE L'ON SAUVEGARDE...
<
< CALCUL DU COSINUS ENTRE
< LE VECTEUR NORMAL ET LE
< VECTEUR D'OBSERVATION ;
< CE COSINUS, QUI EST LE
< RAPPORT DU PRODUIT SCALAIRE
< DES 2 VECTEURS AU PRODUIT
< DE LEURS NORMES, DONNE LA
< MODULATION LUMINEUSE COR-
< RESPONDANT A UNE SOURCE
< SITUEE AU POINT D'OBSERVA-
< TION :
<
LRM A,B
WORD NX < (A)=VECTEUR NORMAL,
WORD CS3DOB < (B)=VECTEUR OBSERVATION,
BSR APRSCA < ET CALCUL DE LEUR PRODUIT SCALAIRE,
FDV NORMN < QUE L'ON
FDV NORMS < NORMALISE...
BSR ATSFLO
<
< CALCUL DE LA MODULATION LUMINEUSE :
<
FMP F05 < PLACONS LE COSINUS DANS (-0.5,+0.5),
FAD F05 < PUIS DANS (0,+1)...
BSR ASFWOR < SAUVEGARDE DE L'INTENSITE DE LA MODULA-
< TION LUMINEUSE...
LABLAN: LAI XXN255-Z < (A)=NIVEAU DE GRIS MAXIMAL-1,
BSR AFLT
FMP FWORK < ET QUE L'ON MODULE SUIVANT LA NORMALE
< AU POINT COURANT,
BSR AROND < ET QU'ENFIN ON FIXE...
ADNOIR: ADRI Z,A < AFIN DE NE PAS TROUVER DE POINTS NOIRS...
<
< TESTS DE COHERENCE PAR ETUDE
< DU VOISINNAGE DEJA EXISTANT :
<
LX XS < (X)=COORDONNEE 'X',
LY YS < (Y)=COORDONNEE 'Y'.
STA FWORK1 < SAUVEGARDE DU NIVEAU CALCULE POUR LE
< POINT (XS,YS) DANS 'FWORK1',
IF XXNOIR-K,,XEIF%,
IF ATTENTION : L'INITIALISATION DE 'FWORK2' EST IDIOTE !!!
XEIF%: VAL ENDIF
STZ FWORK2 < INITIALISATION DE :
< FWORK2=SOMME DES NIVEAUX DE QUATRE VOI-
< SINS (AU PLUS) NON NOIRS.
LBI K < (B)=CUMUL DU NOMBRE DE VOISINS NON NOIRS
< DEJA TRACES.
<
< EXPLORATION DU VOISINNAGE :
<
LRM A
WYMIN: WORD YMIN < (Y)=ORDONNEE MINIMALE,
CPR A,Y < EST-ON SUR LA PREMIERE LIGNE ???
JE VISU30 < OUI, ON NE FAIT QU'INITIALISER 'LIGNE'...
LRM A < NON :
WXMIN: WORD XMIN < (A)=ABSCISSE MINIMALE,
CPR A,X < EST-ON EN PREMIERE COLONNE ???
JE VISU31 < OUI, ON NE FAIT QU'INITIALISER 'LIGNE'...
PSR X,Y < NON, SAUVEGARDE DES COORDONNEES (X,Y),
< EN FAIT, SEULE 'X' SERA MODIFIEE...
IF XXNOIR-K,,XEIF%,
IF ATTENTION : LES TESTS DE POINTS NOIRS
IF QUI VONT SUIVRE SONT IDIOTS !!!
XEIF%: VAL ENDIF
ADRI -I,X
LBY &ALIGNE < NIVEAU(X-1,Y),
JAE VISU32 < NOIR, ON L'IGNORE...
AD FWORK2 < NON NOIR,
STA FWORK2 < ON LE CUMULE,
ADRI I,B < ET ON LE COMPTE...
VISU32: EQU $
<
< NOTA :
<
< PAR LA SUITE, ON VA
< NOTER 'Y' SOUS LA FORME
< 'Y-1', EN EFFET, LES POINTS
< NON ENCORE MODIFIES DU BUF-
< FER 'LIGNE' CONTIENNENT LA
< LIGNE PRECEDENTE 'Y-1'...
<
ADRI I,X
LBY &ALIGNE < NIVEAU(X,Y-1),
JAE VISU34 < NOIR, ON L'IGNORE...
AD FWORK2 < NON NOIR,
STA FWORK2 < ON LE CUMULE,
ADRI I,B < ET ON LE COMPTE...
VISU34: EQU $
ADRI I,X
LRM A
WXMAX2: WORD XMAX < (A)=ABSCISSE MAXIMALE,
SBR X,A < EST-ON EN BOUT DE LIGNE ???
JAL VISU35 < OUI, ON ARRETE LA...
LBY &ALIGNE < NIVEAU(X+1,Y-1),
JAE VISU36 < NOIR, ON L'IGNORE...
AD FWORK2 < NON NOIR,
STA FWORK2 < ON LE CUMULE,
ADRI I,B < ET ON LE COMPTE...
VISU36: EQU $
VISU35: EQU $
PLR X,Y < RESTAURATION DES COORDONNEES (X,Y) DU
< POINT COURANT.
<
< DETERMINATION DU NIVEAU
< MOYEN AU VOISINNAGE DE (X,Y) :
<
LR B,A < (A)=NOMBRE DE VOISINS NON NOIRS REN-
< CONTRES AUTOUR DU POINT COURANT :
JAE VISU50 < IL N'Y EN A PAS, ON VA INITIALISER
< 'LIGNE'...
BSR AFLT
BSR ASFWOR < IL Y EN A AU MOINS UN, ET :
< (FWORK)=NOMBRE DE CEUX-CI...
LA FWORK2
BSR AFLT < (A,B)=SOMME DES NIVEAUX DE L'ENSEMBLE
< DES VOISINS RENCONTRES,
FDV FWORK < (A,B)=NIVEAU MOYEN,
BSR AROND < (A)=NIVEAU MOYEN ENTIER...
LR A,B < ET SAUVEGARDE DANS 'B'...
SB FWORK1 < NIVEAU MOYEN-NIVEAU(X,Y),
JAGE VISU51
NGR A,A < DONT ON PREND LA VALEUR ABSOLUE...
VISU51: EQU $
CP NSEUIL < LE NIVEAU CALCULE NIVEAU(X,Y) A-T'IL UNE
< VALEUR PROCHE DE CELLE DE LA MOYENNE DE
< SES VOISINS (EN FONCTION DE 'NSEUIL') ???
JLE VISU52 < OUI, NIVEAU(X,Y)='FWORK1' EST ACCEPTE...
STB FWORK1 < NON, LE NIVEAU MOYEN REMPLACE NIVEAU(X,Y)
< DANS 'FWORK1'...
QUIT21: QUIT XXQUIT < E R R E U R P R O G R A M M E ...
<
< GESTION DE 'LIGNE' :
<
VISU52: EQU $
VISU50: EQU $
VISU31: EQU $
VISU30: EQU $
LA FWORK1 < (A)=NIVEAU A UTILISER POUR LE TRACE DU
< POINT (X,Y) ; CE NIVEAU EST DONC
< SOIT CELUI QUI A ETE CALCULE, SOIT
< CELUI QUI RESULTE DE L'INTERPOLA-
< TION ENTRE LES VOISINS,
< (X)=XS,
< (Y)=YS.
STBY &ALIGNE < ET ON MET A JOUR (AVEC LE NIVEAU INTER-
< POLE...), OU BIEN ON INITIALISE (POUR LA
< PREMIERE LIGNE OU LES POINTS SANS VOI-
< SINS)...
<
< TRACE DU POINT :
<
BSR ASTORP < ET TRACE DU POINT (X,Y) AVEC LE
< NIVEAU (A)...
<
< CHANGEMENT DE POINT RASTER COURANT :
<
VISU6: EQU $
PLR X,Y,W < RESTAURATIONS...
<
< VALIDATION DU CALCUL FAIT :
<
LR X,A < (X)='X' DE BALAYAGE COURANT,
AD TRX < QUE L'ON TRANSLATE,
CP XS < ET ON VALIDE 'XS' :
JE VISU20 < OK...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
VISU20: EQU $
LR Y,A < (Y)='Y' DE BALAYAGE COURANT,
AD TRY < QUE L'ON TRANSLATE,
CP YS < ET ON VALIDE 'YS' :
JE VISU21 < OK...
QUIT XXQUIT < E R R E U R P R O G R A M M E ...
VISU21: EQU $
<
< BALAYAGE EN HORIZONTAL :
<
ADRI I,X < PROGRESSION DE 'X'.
LRM A
WXMAX1: WORD XMAX < (A)=COORDONNEE 'X' MAXIMALE :
SBR X,A < (X,Y) EXISTE-T'IL ???
JAGE AVISU1 < OUI...
<
< BALAYAGE VERTICAL :
<
ADRI I,Y < PROGRESSION DE 'Y'.
LRM A
WYMAX: WORD YMAX < (A)=COORDONNEE 'Y' MAXIMALE :
SBR Y,A < (X,Y) EXISTE-T'IL ???
JAGE AVISU9 < OUI...
<
< FIN DE TRACE :
<
IF XOPT01-EXIST,XOPT1,,XOPT1
LAD DEMCG
SVC < RETOUR EN ALPHA-NUMERIQUE...
XOPT1: VAL ENDIF
<
<
< E T B O U C L A G E E V E N T U E L :
<
<
DEBUT5: EQU $
QUIT XXQUIT < A T T E N T E ...
LRM C,L,K < ON REINITIALISE 'C', 'L' ET 'K' AU CAS
< D'UNE RE-ENTREE PAR UN 'ALT-MODE'...
WORD COM+DEPBAS < 'C',
WORD LOC+DEPBAS < 'L',
WORD STACK-DEPILE < 'K'.
BSR AGOTO
WORD DEBUT4 < (A)=ADRESSE D'ITERATION DU TRACE PAR
< BALAYAGE...
<
< RELAIS :
<
AVISU1: EQU $
BSR AGOTO
WORD VISU1 < BALAYAGE HORIZONTAL.
AVISU9: EQU $
BSR AGOTO
WORD VISU9 < BALAYAGE VERTICAL.
PAGE
CALL #SIP FONCTION#
PAGE
<
<
< A U C A S O U ...
<
<
FLOC: @
XWOR%1: VAL KOLF=FMASK+KOLTES=FVAL
XWOR%1: VAL KOLC=FMASK+KDP=FVAL?XWOR%1
XWOR%2: VAL KOLTED=FMASK+KOL0=FVAL
XWOR%2: VAL KOLTEF=FMASK+KOL0+KOLON=FVAL?XWOR%2
XWOR%3: VAL XWOR%2=XWOR%1-KOL0 < LONGUEUR DU SYMBOLE COURANT...
XWOR%4: VAL MSYMBI=FMASK+KOL0=FVAL
XWOR%4: VAL MSYMBL=FMASK+XWOR%3=FVAL?XWOR%4
XWOR%5: VAL XWOR%4=FCSYMT < ETAT DU SYMBOLE 'FLOC'...
XWOR%6: VAL XWOR%5=FCSIGN
XWOR%7: VAL XWOR%5(MSYMBN)MSYMBN=FCSIGN
IF XWOR%6*XWOR%7,XEIF%,,XEIF%
LOCAL
FLOC: EQU $
XEIF%: VAL ENDIF
SPU: @
XWOR%1: VAL KOLF=FMASK+KOLTES=FVAL
XWOR%1: VAL KOLC=FMASK+KDP=FVAL?XWOR%1
XWOR%2: VAL KOLTED=FMASK+KOL0=FVAL
XWOR%2: VAL KOLTEF=FMASK+KOL0+KOLON=FVAL?XWOR%2
XWOR%3: VAL XWOR%2=XWOR%1-KOL0 < LONGUEUR DU SYMBOLE COURANT...
XWOR%4: VAL MSYMBI=FMASK+KOL0=FVAL
XWOR%4: VAL MSYMBL=FMASK+XWOR%3=FVAL?XWOR%4
XWOR%5: VAL XWOR%4=FCSYMT < ETAT DU SYMBOLE 'SPU'...
XWOR%6: VAL XWOR%5=FCSIGN
XWOR%7: VAL XWOR%5(MSYMBN)MSYMBN=FCSIGN
IF XWOR%6*XWOR%7,XEIF%,,XEIF%
PROG
SPU: EQU $
#/FLD# VARU < ELEMENT NEUTRE...
RSR
XEIF%: VAL ENDIF
SPV: @
XWOR%1: VAL KOLF=FMASK+KOLTES=FVAL
XWOR%1: VAL KOLC=FMASK+KDP=FVAL?XWOR%1
XWOR%2: VAL KOLTED=FMASK+KOL0=FVAL
XWOR%2: VAL KOLTEF=FMASK+KOL0+KOLON=FVAL?XWOR%2
XWOR%3: VAL XWOR%2=XWOR%1-KOL0 < LONGUEUR DU SYMBOLE COURANT...
XWOR%4: VAL MSYMBI=FMASK+KOL0=FVAL
XWOR%4: VAL MSYMBL=FMASK+XWOR%3=FVAL?XWOR%4
XWOR%5: VAL XWOR%4=FCSYMT < ETAT DU SYMBOLE 'SPV'...
XWOR%6: VAL XWOR%5=FCSIGN
XWOR%7: VAL XWOR%5(MSYMBN)MSYMBN=FCSIGN
IF XWOR%6*XWOR%7,XEIF%,,XEIF%
PROG
SPV: EQU $
#/FLD# VARV < ELEMENT NEUTRE...
RSR
XEIF%: VAL ENDIF
SPW: @
XWOR%1: VAL KOLF=FMASK+KOLTES=FVAL
XWOR%1: VAL KOLC=FMASK+KDP=FVAL?XWOR%1
XWOR%2: VAL KOLTED=FMASK+KOL0=FVAL
XWOR%2: VAL KOLTEF=FMASK+KOL0+KOLON=FVAL?XWOR%2
XWOR%3: VAL XWOR%2=XWOR%1-KOL0 < LONGUEUR DU SYMBOLE COURANT...
XWOR%4: VAL MSYMBI=FMASK+KOL0=FVAL
XWOR%4: VAL MSYMBL=FMASK+XWOR%3=FVAL?XWOR%4
XWOR%5: VAL XWOR%4=FCSYMT < ETAT DU SYMBOLE 'SPW'...
XWOR%6: VAL XWOR%5=FCSIGN
XWOR%7: VAL XWOR%5(MSYMBN)MSYMBN=FCSIGN
IF XWOR%6*XWOR%7,XEIF%,,XEIF%
PROG
SPW: EQU $
#/FLD# F0 < ELEMENT NEUTRE...
RSR
XEIF%: VAL ENDIF
<
<
< P O U R L A C O M P A T I B I L I T E " + " :
<
<
SPX: EQU SPU
SPY: EQU SPV
SPZ: EQU SPW
PAGE
<
<
< L I S T E D E S P O I N T S D ' I N T E R S E C T I O N
< E N T R E L A D R O I T E ' D ' C O U R A N T E
< E T L A S U R F A C E ' S ' :
<
<
LPINT: EQU $ < CHAQUE ENTREE DONNE :
< LBUF3D : COORDONNEES (FXS,FYS,FZS)
< DU POINT D'INTERSECTION,
< LVARUV : COORDONNEES CURVILIGNES
< (VARU,VARV) DE CE POINT SUR LA
< SURFACE 'S'.
DZS LOPINT*NPINT
<
<
< D O N N E E S D E C O H E R E N C E :
<
<
LIGNE: EQU $ < BUFFER DE LIGNE :
DO XC512/NOCMO
BYTE XXNOIR;XXNOIR
<
<
< L I S T E D E S N O E U D S P U I S
< L I S T E D E S F A C E T T E S E T T A B L E S
< D ' I N D E X A T I O N :
<
<
IF XX*YY*LBUF4D,,,XEIF%
IF ATTENTION : LA ZONE 'BUF' IMPLANTEE EN TETE DE
IF LA 'CDA' EST TROP LONGUE !!!
XEIF%: VAL ENDIF
TABLE
PLIGX: EQU $ < LISTE DES XBUF(I,0).
DZS IMAX
TABLE
PLIGM: EQU $ < LISTE DES 'J' MAX(I).
DZS IMAX
PAGE
<
<
< Q U E L Q U E S P A T C H E S P R O V I S O I R E S :
<
<
PATCH: EQU $
$EQU ISGNFE
WORD NEXIST < NE PAS GENERER LES FACETTES "EXTERNES".
IF XOPT01-EXIST,XOPT1,,XOPT1
$EQU IWGNFI
WORD NEXIST < NE PAS TRACER LES NORMALES "INTERNES".
$EQU IWGFE
WORD NEXIST < NE PAS TRACER LES FACETTES "EXTERNES".
$EQU IWPRST
WORD NEXIST < PAS DE TRACER DES POINTS RASTERS.
$EQU IWCONV
WORD NEXIST < PAS DE SUIVI DE LA CONVERGENCE.
XOPT1: VAL ENDIF
$EQU PZ
FLOAT 1000 < POINT DE VUE SUR L'AXE 'OZ'.
IF XOPT01-EXIST,XOPT1,,XOPT1
$EQU FACTN
FLOAT 100 < FACTEUR D'ECHELLE DE LA NORMALE.
XOPT1: VAL ENDIF
$EQU LTORE+XMINU
FLOAT -3.141593 < MIN(U),
$EQU LTORE+XMILU
FLOAT 0 < MIL(U),
$EQU LTORE+XMAXU
FLOAT 3.141593 < MAX(U),
$EQU LTORE+XPERU
FLOAT 6.283185 < PERIOD(U).
$EQU LTORE+XMINV
FLOAT -1.570796 < MIN(V),
$EQU LTORE+XMILV
FLOAT 0 < MIL(V),
$EQU LTORE+XMAXV
FLOAT 1.570796 < MAX(V),
$EQU LTORE+XPERV
FLOAT 3.141593 < PERIOD(V).
$EQU CT+K
XRAYON:: VAL '50 < RAYON DE LA SPHERE...
FLOAT <XRAYON<K<K < DEFINITION DE LA PREMIERE CONSTANTE.
$EQU MTRAN+MT14
FLOAT <XC512/XXXMOY<K<K
< POSITIONNEMENT AU MILIEU DE L'ECRAN,
$EQU MTRAN+MT24
FLOAT <XL512/XXXMOY<K<K
< POSITIONNEMENT AU MILIEU DE L'ECRAN.
$EQU QUIT01
NOP < NON-CONVERGENCE : ABS($U) TROP GRAND...
$EQU QUIT02
NOP < NON-CONVERGENCE : ABS($V) TROP GRAND...
$EQU QUIT31
NOP < NON-CONVERGENCE AU-DELA DE 'MAXCO1'...
$EQU QUIT11
NOP < X(U,V) MAUVAISE SOLUTION...
$EQU QUIT12
NOP < Y(U,V) MAUVAISE SOLUTION...
$EQU QUIT13
NOP < Z(U,V) MAUVAISE SOLUTION...
$EQU QUIT41
NOP < UNDERFLOW MAX(ALPHA,BETA,GAMMA)/FREDUC...
$EQU QUIT42
NOP < UNDERFLOW MIN(ALPHA,BETA,GAMMA)/FREDUC...
$EQU LYMIN
WORD XL512/XXXMOY-XRAYON
< 'Y' DE DEPART,
$EQU LXMIN
WORD XC512/XXXMOY-XRAYON
< 'X' DE DEPART,
$EQU WXMAX1
WORD XC512/XXXMOY+XRAYON
< 'X' D'ARRIVEE,
$EQU WYMAX
WORD XL512/XXXMOY+XRAYON
< 'Y' D'ARRIVEE.
$EQU WXMIN
WORD XC512/XXXMOY-XRAYON
< 'X' MINIMAL DE LA COHERENCE HORIZONTALE,
$EQU WYMIN
WORD XL512/XXXMOY-XRAYON
< 'Y' MINIMAL DE LA COHERENCE VERTICALE.
$EQU QUIT21
NOP < INCOHERENCE DE VOISINNAGE...
$EQU WXMAX2
WORD XC512/XXXMOY+XRAYON
< 'X' D'ARRIVEE.
$EQU LABLAN
DECNIV:: VAL BIT>2 < PARCE QU'IL MANQUE 2 PLANS MEMOIRE...
LAI XXN255-Z-DECNIV < NIVEAU DE GRIS MAXIMAL RECONNU.
$EQU ADNOIR
ADRI Z+DECNIV,A < AFIN DE NE PAS AVOIR DE POINTS NOIRS.
<
< FIN DES PATCHES :
<
$EQU PATCH
PAGE
<
<
< T A B L E D E S S Y M B O L E S :
<
<
IF '00000000000@,XEIF%,,XEIF%
EST
XEIF%: VAL ENDIF
DATE
END DEBUT
Copyright © Jean-François COLONNA, 2022-2024.
Copyright © CMAP (Centre de Mathématiques APpliquées) UMR CNRS 7641 / École polytechnique, Institut Polytechnique de Paris, 2022-2024.