EOT #SIX ESPACE#
XEBUG: VAL 5 < LONGUEUR DE 'DEBUG'...
XRROR: VAL 5 < LONGUEUR DE 'ERROR'...
PAGE
<
<
< T R A C E D ' U N C E R C L E :
<
<
< ARGUMENTS :
< 'A'=ADRESSE D'UNE TABLE D'ARGUMENTS CONTENANT
< LE RAYON 'RHO' ET LES COORDONNEES DU CENTRE
< (X,Y,Z), LE TOUT EN FLOTTANT.
<
<
<
X: VAL 0
Y: VAL 1
Z: VAL 2
XX: VAL X*2
YY: VAL Y*2
ZZ: VAL Z*2
ZZZX0: VAL XX < X(CENTRE)
ZZZY0: VAL YY < Y(CENTRE)
ZZZZ0: VAL ZZ < Z(CENTRE)
ZZZRHO: VAL DIMM < RAYON.
< CE SOUS-PROGRAMME CALCULE L'EQUATION DU
< CERCLE EN COORDONNEES POLAIRES, LA CONVERTIT
< ENSUITE EN CARTESIENNES, PUIS EN FAIT LE
< TRACE...
<
<
FTEST:: VAL 'F700 < FONCTION DE TEST D'UN SYMBOLE.
CART @
IF 4=FTEST,XWOR%,,XWOR%
EOT #SI CART#
XWOR%: VAL 0
SQRT @
IF 4=FTEST,XWOR%,,XWOR%
EOT #SI SQRT#
XWOR%: VAL 0
DEBUG @
IF XEBUG=FTEST,,XWOR%,
EOT #SI TG#
XWOR%: VAL 0
ERROR @
IF XRROR=FTEST,,XWOR%9,
PAGE
<
<
< C A L C U L D ' U N S I N U S E T D ' U N C O S I N U S :
<
<
< ARGUMENT :
< A=ADRESSE D'UNE TABLE DE 4 MOTS CONTENANT
< L'ANGLE TETA, PUIS A LA SUITE LE RESUL-
< TAT CIN(TETA).
<
<
DSEC
ARGCIN: EQU $
YYTETA: DZS 2 < ANGLE TETA ARGUMENT,
YYCINU: DZS 2 < RESULTAT CIN(TETA).
LOCAL
CINLOC: EQU $
YY2322: FLOAT 506
YY2120: FLOAT 420
YY1918: FLOAT 342
YY1716: FLOAT 272
YY1514: FLOAT 210
YY1312: FLOAT 156
YY1110: FLOAT 110
YY0908: FLOAT 72
YY0706: FLOAT 42
YY0504: FLOAT 20
YY0302: FLOAT 6
YYPI: FLOAT 3.1415926
YY2PI: FLOAT 6.2831853
YYPI2: FLOAT 1.5707963
YY3PI2: FLOAT 4.7123889
YYTETB: DZS 2 < TETA ARGUMENT TRANSLATE...
YYTETC: DZS 2 < TETA ARGUMENT TRANSLATE AU CARRE.
YY0001: FLOAT 1
YYACIN: WORD CIN < PROGRAMME DE CALCUL DU CINUS.
PROG
USE W,ARGCIN
<
<
< C A L C U L D U S I N U S :
<
<
CIN: EQU $
PSR A,B,L,W
LRM L
WORD CINLOC+'80 < BASE L,
LR A,W < BASE W SUR L'ARGUMENT.
<
< TRANSLATION DE TETA :
<
FLD YYTETA
FDV YY2PI < TETA/(2*PI).
FIX
FLT
FSB YYTETA
FNEG < TETA MODULO 2*PI.
FCAM YYPI2
JLE CIN1 < 0<=TETB<=(PI/2).
FSB YYPI < TETB <-- TETB-PI.
FCAM YYPI2
JLE CIN2 < (PI/2)<TETB<=(3*PI/2).
FSB YYPI < TETB <-- TETB-PI.
FNEG
CIN2: EQU $
FNEG
CIN1: EQU $
FST YYTETB < ET VOILA LE TETA TRANSLATE...
FMP YYTETB
FST YYTETC < TETC=TETB*TETB.
<
< CALCUL DE LA SERIE :
<
FNEG
FDV YY1514
FAD YY0001
FMP YYTETC
FDV YY1312
FSB YY0001
FMP YYTETC
FDV YY1110
FAD YY0001
FMP YYTETC
FDV YY0908
FSB YY0001
FMP YYTETC
FDV YY0706
FAD YY0001
FMP YYTETC
FDV YY0504
FSB YY0001
FMP YYTETC
FDV YY0302
FAD YY0001
FMP YYTETB
FST YYCINU < ET VOILA LE TRAVAIL...
FABS
FCAM YY0001 < VALIDATION DU RESULTAT...
JLE CIN3 < OK, INFERIEUR A 1...
WORD '1E16 < ????
CIN3: EQU $
PLR A,B,L,W
RSR
<
<
< C A L C U L D U C O S I N U S :
<
<
COS: EQU $
PSR A,B,L,W
LRM L
WORD CINLOC+'80 < BASE L,
LR A,W < W BASE LES ARGUMENTS.
FLD YYTETA
PSR A,B < SAUVEGARDE DU TETA ARGUMENT.
FLD YYPI2
FSB YYTETA < (PI/2)-TETA.
FST YYTETA < NOUVEL ARGUMENT :
LR W,A < A=ADRESSE ARGUMENT.
BSR YYACIN < CALCUL DE CIN((PI/2)-TETA)=COS(TETA).
PLR A,B
FST YYTETA < RESTAURATION DU TETA...
PLR A,B,L,W
RSR
PAGE
<
<
< P A S S A G E P O L A I R E - C A R T E S I E N :
<
<
< ARGUMENT :
< A=ADRESSE D'UNE TABLE DEFINI EN DSEC.
<
<
XWOR%9: VAL 0
DSEC
ARGCAR: EQU $
YYRHO: DZS 2 < RAYON POLAIRE,
YYTET: DZS 2 < TETA EN RADIANS,
YYFLX: DZS 2 < RESULTAT X,
YYFLY: DZS 2 < RESULTAT Y.
PROG
ERROR @
IF XRROR=FTEST,,XWOR%9,
LOCAL
CARLOC: EQU $
YYARG: DZS 4 < ARGUMENT POUR LE CINUS...
YYBCIN: WORD CIN < SOUS-PROGRAMME DU CINUS,
YYBCOS: WORD COS < SOUS-PROGRAMME DU COCINUS.
PROG
USE W,ARGCAR
KART: EQU $
PSR A,B,L,W
LRM L
WORD CARLOC+'80 < BASE L,
LR A,W < W BASE LES ARGUMENTS.
FLD YYTET
XWOR%: VAL YYTETA-ARGCIN
FST YYARG+XWOR% < TRANSMISSION DE TETA.
LAD YYARG < A=ADRESSE ARGUMENT.
BSR YYBCIN < CALCUL DU CINUS,
XWOR%: VAL YYCINU-ARGCIN
FLD YYARG+XWOR% < RECUPERATION DU CINUS...
FMP YYRHO
FST YYFLY < Y=RHO*CIN(TETA).
LAD YYARG < A=ADRESSE ARGUMENT.
BSR YYBCOS < CALCUL DU COCINUS,
XWOR%: VAL YYCINU-ARGCIN
FLD YYARG+XWOR% < RECUPERATION DU COCINUS...
FMP YYRHO
FST YYFLX < X=RHO*COS(TETA).
PLR A,B,L,W
RSR
XWOR%9: VAL 0
SIN @
IF 3=FTEST,XWOR%,,XWOR%
EOT #SI SIN#
XWOR%: VAL 0
XWORK: VAL SIN-ZERO
XASIN: EQU ZERO+XWORK
COS @
IF 3=FTEST,XWOR%,,XWOR%
EOT #SI COS#
XWOR%: VAL 0
XWORK: VAL COS-ZERO
XACOS: EQU ZERO+XWORK
<
< TABLE DE STOCKAGE D'UN SOUS-ENSEMBLE DES COORDONNEES
< DES POINTS D'UN CERCLE.
<
NC: VAL 12
NC: VAL NC*2+1 < NOMBRE MAXIMUM DE CERCLES (IMPAIR).
XPAS: VAL 2 < ON PRENDRA UN PAS SUR 2 SUR CHAQUE
< CERCLE POUR GENERER LES MERIDIENS.
XNPS: VAL 15 < NOMBRE DE MERIDIENS.
NP:: VAL XPAS*XNPS < NOMBRE MAXIMUM DE POINTS PAR CERCLE.
BETA:: VAL 30 < PARAMETRE D'ECHANTILLONNAGE DES POINTS.
ZZTAB: EQU $
NLS
DO NC*NP
DZS 6
LST
ZZTABF: EQU $
<
<
< L O C A L :
<
<
DEBUG @
IF XEBUG=FTEST,,XWOR%9,
TABLE
LMX: VAL 1>6
MX: DZS LMX
XWOR%9: VAL 0
LOCAL
ZZZ300: EQU $
ZZLTAB: WORD ZZTABF-ZZTAB < LONGUEUR-MOTS DE 'ZZTAB'.
ZZZ301: DZS 2*DIMM < TABLE DE GENERATION DES CHAINES DE
< DEPLACEMENT GRAPHIQUE.
ZZZ302: DZS 8 < LISTE DES ARUMENTS A 'CART'...
ZZSAVZ: DZS 2 < SAUVEGARDE DE Z PAR 'CERCLE'.
ERROR @
IF XRROR=FTEST,,XWOR%9,
YZZ302: DZS 8 < LISTE DES ARGUMENTS A 'KART'...
XWOR%9: VAL 0
ZZZ311: VAL 0 < RHO EN FLOTTANT,
ZZZ312: VAL 2 < TETA EN FLOTTANT,
ZZZ313: VAL 4 < X EN FLOTTANT,
ZZZ314: VAL 6 < Y EN FLOTTANT.
ZZZ303: EQU FZERO < ZERO FLOTTANT.
ZZZ304: FLOAT 0
< NOMBRE DE PAS SUR UN CERCLE.
IZZ304: WORD NP < NOMBRE DE POINTS SUR UN CERCLE.
ZZZ306: FLOAT 0
< PAS D'INCREMENTATION DE TETA.
ZZZ305: WORD '6403;'87EE < 2*PI
ACART: WORD CART < SOUS-PROGRAMME DE CONVERSION...
ERROR @
IF XRROR=FTEST,,XWOR%9,
AKART: WORD KART < PASSAGE POLAIRE --> CARTESIEN.
DEUX: FLOAT 2
XWOR%9: VAL 0
ASQRT: WORD SQRT < SOUS-PROGRAMME RACINE CARRE.
ZZZ320: ASCI "A$" < DEBUT DE CHAINE DE SEGMENT,
ZZZ321: ASCI "B$" < FIN DE CHAINE DE SEGMENTS.
ZZZ322: ASCI "OR$"
<
ZZBETA: WORD BETA < PARAMETRE D'ECHANTILLONNAGE.
ZZNCER: WORD 0 < NUMERO DU CERCLE COURANT.
ZZNC: WORD NC < NOMBRE MAXIMUM DE CERCLES.
ZZPAS: WORD XPAS < PAS D'ECHANTILLONNAGE.
ZZ6: WORD 6 < SIX...
ZZAXT: WORD ZZTAB-1,X < RELAI INDEXE SUR 'ZZTAB'.
AZZCP: WORD ZZCP < CALCUL DU PAS D'ECHANTILLONNAGE ET
< RAZ DE 'ZZTAB'.
AZZSTK: WORD ZZSTK < STOCKAGE DES COORDONNEES D'UN POINT
< DANS 'ZZTAB'.
ACERCL: WORD CERCLE < S/P DE TRACE D'UN CERCLE.
<
< DONNEES CONCERNANT LA GENERATION D'UNE FAMILLE DE CERCLES.
<
COEFA: VAL 2 < COEFFICIENT A DE L'HYPERBOLE.
COEFB: VAL 1 < COEFFICIENT B DE L'HYPERBOLE.
COEFC: VAL 40 < COEFFICIENT C DE L'HYPERBOLE.
DELTAZ: VAL 16 < PAS DE VARIATION DE Z0.
<
ZZVIZ0: WORD -NC/2*DELTAZ < VALEUR INITIALE DE Z0.
ZZVCZ0: DZS 2 < VALEUR COURANTE DE Z0 EN FIXE.
ZZA2: DZS 2 < COEFFICIENT A AU CARRE, FLOTTANT.
ZZC2: DZS 2 < COEFFICIENT C AU CARRE, FLOTTANT.
ZZB: DZS 2 < COEFFICIENT B, FLOTTANT.
ZZZ02: DZS 2 < Z0 COURANT AU CARRE, FLOTTANT.
ZZTFL: DZS 5 < ZONE DE TRAVAIL, ECHANGE DE PARAMETRES
< AVEC LE S/P 'SQRT'.
<
ZZZ401: DZS DIMM+2 < DESCRIPTEUR DE CERCLE POUR LE S/P
< 'CERCLE'
ZZZ402: ASCI "TE2$"
<
< ANGLE DE ROTATION POUR CALCUL DE LA MATRICE DE TRANSFORMATION.
<
TETROT: FLOAT 0.0
DEBUG @
IF XEBUG=FTEST,,XWOR%9,
ZZZ500: DZS 4 < POUR 'TG'.
ATG: WORD TG < CALCUL D'UNE TANGENTE...
ZZZ360: FLOAT 360
AMX: WORD MX,X
DEM: WORD '0202
WORD MX-ZERO*2;0
RC: WORD '6D00
DRC: WORD '0202;RC-ZERO*2;1
DIX: FLOAT 1000
INDIC: WORD 0
XWOR%9: VAL 0
<
<
<
< P R O G R A M M E :
<
<
PROG
CERCLE: EQU $
PSR A,B,X,Y
PSR C,L,W
LRM L
WORD ZZZ300+'80 < INITIALISATION DE LA BASE L.
LR A,W < W=ADRESSE DES ARGUMENTS...
<
< CALCUL (EVENTUEL, C'EST-A-DIRE SEULEMENT AU PREMIER APPEL DE
< CE S/P CERCLE), DU PAS D'ECHANTILLONNAGE DES POINTS DES CERCLES
< EN VUE DE LEUR STOCKAGE DANS 'ZZTAB'.
<
LA ZZNCER < PREMIER CERCLE ? (!)
JANE ZZCER1
BSR AZZCP < C'EST LE PREMIER CERCLE, ALLONS
< CALCULER LE PAS D'ECHANTILLONNAGE
< ET RAZER 'ZZTAB'.
ZZCER1: EQU $
<
< CALCUL DU PAS D'INCREMENTATION DE TETA :
<
LA IZZ304
FLT
FST ZZZ304
FLD ZZZ305 < 2*PI.
FDV ZZZ304 < 2*PI/NOMBRE DE PAS.
FST ZZZ306
<
< SAUVONS Z QUI DOIT RESTER CONSTANT.
<
FLD ZZZZ0,W
FST ZZSAVZ
<
< CALCUL DU PREMIER POINT :
<
FLD ZZZ303 < ZERO FLOTTANT.
FST ZZZ301+XX < ORIGINE...
FST ZZZ301+YY
FST ZZZ301+ZZ
LAD ZZZ322
BSR AINTA < MISE A L'ORIGINE...
FLD ZZZX0,W
FAD ZZZRHO,W
FST ZZZ301+DIMM+XX < X=X0+RHO.
FLD ZZZY0,W
FST ZZZ301+DIMM+YY < Y=Y0.
FLD ZZSAVZ < Z EST CONSTANT.
FST ZZZ301+DIMM+ZZ
LAD ZZZ301+DIMM
LR W,B < SAVE W.
LRM W
WORD ZZMAT < ADRESSE MATRICE.
BSR AZZTRS < TRANSFORMATION MATRICIELLE.
BSR AMCVA < INTERPRETEUR ('A' EST BON!)
LR B,W < RECUP W.
PSR X
LAD ZZZ301
LR A,B
LAD ZZZ301+DIMM
LXI DIMM
MOVE < CHANGEMENT D'ORIGINE...
PLR X
LAD ZZZ320
BSR AINTA < DEBUT DE CHAINE DE SEGMENTS.
<
< INITIALISATIONS :
<
FLD ZZZ303 < ZERO...
FST ZZZ302+ZZZ312 < INITIALISATION DE TETA.
FLD ZZZRHO,W
FST ZZZ302+ZZZ311 < INITIALISATION DE RHO.
ERROR @
IF XRROR=FTEST,,XWOR%9,
FST YZZ302+ZZZ311
XWOR%9: VAL 0
<
< BOUCLE DE PARCOURS DU CERCLE :
<
LX IZZ304 < X=NOMBRE DE POINTS.
ZZZ330: EQU $
FLD ZZZ302+ZZZ312
FAD ZZZ306
FST ZZZ302+ZZZ312 < PROGRESSION DE TETA.
ERROR @
IF XRROR=FTEST,,XWOR%9,
FST YZZ302+ZZZ312
LAD YZZ302
BSR AKART
XWOR%9: VAL 0
FLD ZZZ302+ZZZ312 < ACCES A TETA :
FSB ZZZ305 < TETA-2*PI,
FABS < ABS(TETA-2*PI),
FDV FAROND
FCAM ZZZ306 < NUL A EPSILON PRES ???
JGE ZZZ370 < NON...
FLD ZZZ303 < OUI, ON PREND 0 A FIN QUE
FST ZZZ302+ZZZ312 < LE CERCLE SE REFERME...
ZZZ370: EQU $
LAD ZZZ302 < A=ADRESSE DE LA LISTE ARGUMENTS.
BSR ACART < CONVERSION POLAIRE --> CARTESIENNE.
ERROR @
IF XRROR=FTEST,,XWOR%9,
FLD ZZZ302+ZZZ313
FAD YZZ302+ZZZ313
FDV DEUX
FST ZZZ302+ZZZ313 < MOYENNE DES X.
FLD ZZZ302+ZZZ314
FAD YZZ302+ZZZ314
FDV DEUX
FST ZZZ302+ZZZ314 < MOYENNE DES Y.
XWOR%9: VAL 0
DEBUG @
IF XEBUG=FTEST,,XWOR%9,
<
< VERIFICATION THEOREME :
<
FLD ZZZ302+ZZZ313
FMP ZZZ302+ZZZ313
FST FLW1
FLD ZZZ302+ZZZ314
FMP ZZZ302+ZZZ314
FAD FLW1
FST FLW1
LA ZZZRHO,W
MP ZZZRHO,W
LR B,A
FLT
FSB FLW1
FCAZ
JE ZZZ337
ZZZ337: EQU $
FMP DIX
FIX
JAE ZZZ338
CPZ INDIC
JNE ZZZ338 < AUTRES FOIS...
JMP ZZ4307
RZZ330: JMP ZZZ330
ZZ4307: EQU $
PSR A,B,X
LBI ">"
LR A,X
JAG ZZ4301
LBI "<"
NGR X,X
ZZ4301: EQU $
STX DEM+2
LRM A
WORD LMX-1
ANDR A,X
LR B,A
PSR X,Y
LYI 0
ZZ4303: EQU $
XR X,Y
STBY &AMX
XR X,Y
ADRI 1,Y
JDX ZZ4303
PLR X,Y
LAD CG
SVC 0
LAD DEM
ZZ4302: EQU $
PSR X
SVC 0
PLR X
JDX ZZ4302
LAD OG
SVC 0
PLR A,B,X
ZZZ338: EQU $
XWOR%9: VAL 0
DEBUG @
IF XEBUG=FTEST,,XWOR%9,
<
< VALIDATIONS DES TANGENTES :
<
LA ZZZ301+DIM+X
FLT
FST FLW1
LA ZZZ301+DIM+Y
FLT
FDV FLW1
FST FLW1 < Y/X.
< C'EST AUSSI TG(TETA) DESSINE.
FLD ZZZ302+ZZZ312 < TETA PRESUME.
FST ZZZ500+0
LAD ZZZ500
BSR ATG
FLD ZZZ500+2 < TG(TETA) PRESUME.
FSB FLW1 < ERREUR SUR LES TANGENTES...
FIX
JAE ZZZ339 < OK...
CPZ INDIC
JNE ZZZ339 < AUTRES FOIS...
PSR A
FLD ZZZ302+ZZZ312
FMP ZZZ360 < *360,
FDV ZZZ305 < CONVERSION EN DEGRES.
FIX
LR A,B
PLR A
PSR A,B,X
LBI "+"
LR A,X
JAG ZZ3301
LBI "-"
NGR X,X
ZZ3301: EQU $
STX DEM+2
LRM A
WORD LMX-1
ANDR A,X
LR B,A
PSR X,Y
LYI 0
ZZ3303: EQU $
XR X,Y
STBY &AMX
XR X,Y
ADRI 1,Y
JDX ZZ3303
PLR X,Y
LAD CG
SVC 0
LAD DEM
ZZ3302: EQU $
PSR X
SVC 0
PLR X
JDX ZZ3302
LAD OG
SVC 0
PLR A,B,X
ZZZ339: EQU $
XWOR%9: VAL 0
XTRAV: VAL YYFLX-ARGCAR
YTRAV: VAL YYFLY-ARGCAR
FLD ZZZ302+XTRAV < X CALCULE PAR 'CART'
FST ZZZ301+DIMM+XX
FLD ZZZ302+YTRAV < Y CALCULE PAR 'CART'
FST ZZZ301+DIMM+YY
FLD ZZSAVZ < Z.
FST ZZZ301+DIMM+ZZ
LAD ZZZ301+DIMM
LR W,B < SAVE W.
LRM W
WORD ZZMAT < ADRESSE MATRICE.
BSR AZZTRS < TRANSFORMATION DES COORDONNEES.
BSR AMCVA < INTERPRETEUR ('A' EST BON!).
LR B,W < RECUP W.
BSR AZZSTK < STOCKAGE (EVENTUEL) DES COORDONNEES
< DU POINT COURANT DANS 'ZZTAB'.
LAD ZZZ321
BSR AINTA < FIN DE CHAINE DE SEGMENTS...
PSR X
LAD ZZZ301
LR A,B < B=ADRESSE DE L'ORIGINE,
LAD ZZZ301+DIMM < A=ADRESSE DE L'EXTREMITE,
LXI DIMM < X=LONGUEUR.
MOVE < CHAINAGE DES SEGMENTS...
PLR X
DEBUG @
IF XEBUG=FTEST,XWOR%,,XWOR%
JDX ZZZ330 < AU POINT SUIVANT...
XWOR%: VAL 0
IF XEBUG=FTEST,,XWOR%,
JDX RZZ330 < AU POINT SUIVANT...
XWOR%: VAL 0
IC ZZNCER < PROGRESSION NUMERO DE CERCLE.
PLR C,L,W
PLR A,B,X,Y
RSR
ZZCP: EQU $
<
< C A L C U L D U P A S D ' E C H A N T I L L O N N A G E
<
< E T R A Z D E ' Z Z T A B '.
<
PSR A,B,X
<
< RAZ DE 'ZZTAB.
<
LX ZZLTAB < LONGUEUR MOT DE 'ZZTAB'.
ZZCP3: EQU $
STZ &ZZAXT
JDX ZZCP3
<
PLR A,B,X
RSR
ZZSTK: EQU $
<
< S T O C K A G E ( E V E N T U E L ) D E S C O O R D O N N E E S
<
< ( X , Y , Z ) D U P O I N T C O U R A N T D U C E R C L E
<
< C O U R A N T.
<
< ARGUMENTS:
< 'X'=NUMERO DU POINT COURANT (DE N A 1).
< 'ZZNCER'=NUMERO DU CERCLE COURANT (DE 0 A NC-1)
<
< LES COORDONNEES NE SONT STOCKEES QUE SI LE NUMERO DU POINT
< COURANT EST DIVISIBLE PAR 'ZZPAS'.
<
PSR A,B,X
LB IZZ304
SBR X,B < B=NUMERO DU POINT (DE 0 A N-1).
LAI 0
DV ZZPAS
CPZR B
JNE ZZSTK1 < PAS DE STOCKAGE.
<
< ICI ON A : 'A'=NUMERO DU POINT ECHANTILLONNE (DE 0 A IZZ304/ZZPAS-1)
< 'ZZNCER'=NUMERO CERCLE COURANT (DE 0 A 'NC'-1).
<
< CALCUL DE L'ADRESSE DE STOCKAGE =6*('A'*NC+'ZZNCER'), ET STOCKAGE.
<
MP ZZNC
LR B,A
AD ZZNCER
MP ZZ6
LRM A
WORD ZZTAB
ADR A,B < RECEPTEUR.
LAD ZZZ301+DIMM < EMETTEUR.
LXI DIMM < 6 MOTS (X,Y,Z).
MOVE
ZZSTK1: EQU $
PLR A,B,X
RSR
PAGE
<
<
< P R O G R A M M E D E T R A C E :
<
<
PROG
GRAPH: EQU $
USE L,ZZZ300+'80
LRM C,L,K
WORD COM+'80
WORD ZZZ300+'80
WORD PILE-1
<
< CALCUL D'UNE MATRICE DE TRANSFORMATION A APPLIQUER AU COORDONNEES
< (X,Y,Z) DES POINTS QUE L'ON CALCULERA.
<
FLD TETROT < TETA ROTATION
LYI XX/2 < OU YY/2, OU ZZ/2 :
< AXE DE ROTATION.
BSR AZZCMT < CALCUL DE LA MATRICE.
<
<
< TRACE D'UNE FAMILLE DE CERCLES DE RAYON 'RHO' LE CENTRE EN ETANT
< (X0,Y0,Z0) AVEC:
< X0=Y0=0
< Z0= Z0 COURANT.
<
< LE CALCUL DU Z0 COURANT ET DU RAYON RHO EST FAIT DE LA
< FACON SUIVANTE:
< - ON PART DE L'EQUATION D'UNE HYPERBOLE:
< ( X**2 / B**2 ) - ( Z**2 / A**2 ) = C**2
< - Z VARIE DE (-NC/2*DELTAZ) A (+NC/2*DELTAZ) PAR PAS DE DELTAZ
< - RHO = B * ( C**2 + ( Z**2 / A**2 ) ) ** (1 / 2 )
< - A, B, C ET DELTAZ SONT DES PARAMETRES RESPECTIVEMENT :
< 'COEFA', 'COEFB', 'COEFC', 'DELTAZ'.
<
<
< INITIALISATIONS.
<
LAD ZZZ402
BSR AINTA
<
FLD ZZZ303 < ZERO FLOTTANT.
FST ZZZ401+XX < X0 INITIAL.
FST ZZZ401+YY < Y0 INITIAL.
LA ZZVIZ0 < VALEUR INITIALE Z0.
STA ZZVCZ0 < VALEUR COURANTE Z0.
<
LAI COEFA
FLT
FST ZZA2
FMP ZZA2
FST ZZA2 < COEFFICIENT A AU CARRE, FLOTTANT.
<
LAI COEFC
FLT
FST ZZC2
FMP ZZC2
FST ZZC2 < CEFFICIENT C AU CARRE, FLOTTANT.
<
LAI COEFB
FLT
FST ZZB < COEFFICIENT B, FLOTTANT.
<
LXI NC < NOMBRE DE CERCLES A GENERER.
TOUR3: EQU $
<
< BOUCLE DE GENERATION DES CERCLES.
<
PSR X
<
< CALCUL DE RHO = B * ( C**2 + ( Z**2 / A**2 ) ) ** (1/2)
<
LA ZZVCZ0 < Z0 COURANT ENTIER.
FLT
FST ZZZ401+ZZ < POUR 'CERCLE'.
FST ZZZ02
FMP ZZZ02
FST ZZZ02 < Z0 AU CARRE, FLOTTANT.
FDV ZZA2 < SUR COEF A AU CARRE.
FAD ZZC2 < + COEF C AU CARRE.
FST ZZTFL < POUR LE S/P 'SQRT'.
LAD ZZTFL < POUR 'SQRT'.
BSR ASQRT < RACINE CARREE.
LA ZZTFL+4 < CODE RETOUR.
JAE TOUR4 < OK.
WORD '1E16 < ERREUR SQRT.
TOUR4: EQU $
FLD ZZTFL+2 < RACINE CARREE.
FMP ZZB < * COEFB.
FST ZZZ401+ZZZRHO < RAYON DU CERCLE.
<
LAD ZZZ401 < POUR 'CERCLE'
BSR ACERCL < GENERATION DU CERCLE.
<
LA ZZVCZ0 < Z0 COURANT ENTIER.
ADRI DELTAZ,A
STA ZZVCZ0 < NOUVEAU Z0.
<
PLR X
DEBUG @
IF XEBUG=FTEST,,XWOR%9,
XWOR%9: VAL 0
JDX TOUR3 < AU SUIVANT.
<
< TRACE DES SEGMENTS RELIANT LES CERCLES, A PARTIR DE LA TABLE
< 'ZZTAB' CONTENANT LES COORDONNEES DE POINTS ECHANTILLONNES.
<
LB IZZ304
LAI 0
DV ZZPAS < NOMBRE DE POINTS ECHANTILLONNES
< PAR CERCLE
LR A,X
LR A,Y
TOUR1: EQU $
<
< AUTANT DE FOIS QU'IL Y A DE POINTS "ECHANTILLONNES" PAR CERCLE
<
PSR X
LR Y,A
SBR X,A
MP ZZNC
LR B,A
MP ZZ6
LRM W
WORD ZZTAB
ADR B,W < 'W' BASE LA BONNE "LIGNE" DE 'ZZTAB'.
LAD ZZZ322
BSR AINTA < MISE A L'ORIGINE.
<
FLD XX,W
FST ZZZ301+DIMM+XX
FLD YY,W
FST ZZZ301+DIMM+YY
FLD ZZ,W
FST ZZZ301+DIMM+ZZ
LAD ZZZ301+DIMM
BSR AMCVA < INTERPRETEUR.
LAD ZZZ320 < PRIMITIVE A.
BSR AINTA
<
LXI NC-1
<
< AUTANT DE FOIS QU'IL Y A DE CERCLES ... -1, FAIRE 'B'.
<
TOUR2: EQU $
PSR X
ADRI DIMM,W < COORDONNEES DU POINT SUIVANT.
LAD 0,W
BSR AMCVA < INTERPRETEUR.
LAD ZZZ321 < PRIMITIVE 'B'.
BSR AINTA < INTERPRETATION.
<
PLR X
JDX TOUR2 < AU POINT SUIVANT.
<
PLR X
JDX TOUR1 < A LA SERIE DE POINTS SUIVANTE.
<
WORD '1E16
JMP $-1
END
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.