DATE
         PROG
         TRN
<
<
<        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  :
<
<
XXXVEC:  VAL         XUNDEF          < AFIN DE NE DEFINIR QUE LES 'XXVEC'...
         CALL        #SIP VECTEUR 512#
XXXVEC:  VAL         XXVEC1          < DEFINITION DES CONSTANTES IMAGE/VECTEUR.
         CALL        #SIP VECTEUR 512#
<
< CONSTANTES DES IMAGES (256,256) :
<
ORDI::   VAL                     "@" < TYPE DE L'ORDINATEUR...
         CALL        #SIP IMAGE 256#
NMOTL::  VAL         CNMPL           < NOMBRE DE MOTS PAR LIGNE D'IMAGE (256).
NPOL::   VAL         NMOTL*NBITMO    < NOMBRE DE POINTS PAR LIGNE,
NLIG::   VAL         LIMAG/NMOTL     < NOMBRE DE LIGNES PAR IMAGE (256,256).
NPOLM1:: VAL         NPOL-Z          < ABSCISSE MAXIMALE.
NLIGM1:: VAL         NLIG-Z          < ORDONNEE MAXIMALE.
TV1::    MOT         O               < PREMIERE IMAGE (256,256),
TV2::    MOT         '5000           < DEUXIEME IMAGE (256,256).
NCOOL::  VAL         XNCOOL          < NOMBRE DE COULEURS PRIMAIRES,
NIVMX7:: VAL         BIT>NCOOL-N     < NIVEAU MAXIMAL EN (256,256)...
<
<
<        D E F I N I T I O N   D E S   E S P A C E S  :
<
<
DIMGRA:: VAL         3               < ON TRACE DANS L'ESPACE EUCLIDIEN
                                     < A 3 DIMENSIONS...
DIMGR2:: VAL         DIMGRA-I        < ET UNE DIMENSION DE MOINS...
         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
<
< BUFFER BANDE :
<
LBUFMT: @
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 'LBUFMT'...
XWOR%6:  VAL         XWOR%5=FCSIGN
XWOR%7:  VAL         XWOR%5(MSYMBN)MSYMBN=FCSIGN
         IF          XWOR%6*XWOR%7,XEIF%,,XEIF%
LBUFMT:: VAL         4096
XEIF%:   VAL         ENDIF
BUFMT:   EQU         $
         DZS         LBUFMT/NOCMO
<
<
<        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'...
<
< INDICATEURS DE CONTROLE :
<
ITEXT:   WORD        EXIST           < GENERER UNE TEXTURE 2D ('EXIST') OU
                                     < UNE MONTAGNE 3D VUE D'AVION ('NEXIST').
AMPLIR:  FLOAT       <NILK<NILK<NILK < AMPLIFICATEUR DU RESULTAT FINAL.
MOYENE:  FLOAT       <NILK<NILK<NILK < VALEUR MOYENEE DU RESULTAT FINAL.
MAXREC:: VAL         100             < VALEUR MAXIMALE DE 'NRECUR'...
MRECUR:  WORD        NILK            < NOMBRE DE RECURSIONS MAXIMAL LORS DE LA
                                     < SOMMATION DES FONCTION ALEATOIRES.
NPM:     WORD        NILK            < NOMBRE DE POINTS DES SPIRALES GENEREES
                                     < A PARTIR DES IMAGES 'TV1'/'TV2'.
EXPOP:   FLOAT       <NILK<NILK<NILK < EXPOSANT DE CALCUL DES EXPONENTIELLES.
ALPHA:   FLOAT       <NILK<NILK<NILK < FACTEUR DE TENTATIVE D'ELIMINATION DES
                                     < PICS "VISUELS" PAR FILTRAGE...
PASIX0:  WORD        NILK            < PAS SUR OX,
PASIY0:  WORD        NILK            < PAS SUR OY.
GRAINE:  WORD        NILK            < GRAINE DE 'RDN'...
SUPRDN:  WORD        NILK            < SUP(RDN),
INFRDN:  WORD        NILK            < INF(RDN).
MAXNIV:  WORD        NILK            < MAXIMUM DES NIVEAUX TRACES,
MINNIV:  WORD        NILK            < MINIMUM DES NIVEAUX TRACES.
TRONIV:  WORD        NEXIST          < TRONQUER BRUTALEMENT ('EXIST') OU UTILI-
                                     < SER UNE FONCTION EN DENTS DE SCIE
                                     < ('NEXIST') POUR LES VALEURS DU CHAMP...
IERASE:  WORD        NEXIST          < EFFACER ('EXIST'), OU NON ('NEXIST')
                                     < L'ECRAN 512...
IOMBRE:  WORD        EXIST           < TRACER ('EXIST') OU PAS ('NEXIST') LES
                                     < OMBRES PORTEES...
NPENOM:  WORD        NILK            < LARGEUR DE LA ZONE DE PENOMBRE (DOIT
                                     < ETRE STRICTEMENT POSITIVE) ; SI LA VALEUR
                                     < EST 1, IL N'Y EN A PAS...
IMODUL:  WORD        NEXIST          < MARQUER UN NOUVEAU CHAMP ('NEXIST') OU
                                     < "MODULER" UN CHAMP PRE-EXISTANT, A CON-
                                     < DITION QUE CELUI-CI SOIT DEFINI PAR DES
                                     < NIVEAUX CONTENUS DANS LE SEGMENT :
                                     < (BORINF,BORSUP)=(NI,XXN255/ND+NI).
TRDNX:   WORD        K               < TRANSLATION EN 'X' DU CHAMP RDN,
TRDNY:   WORD        K               < TRANSLATION EN 'Y' DU CHAMP RDN.
IBANDE:  WORD        NEXIST          < CHOIX DU MODE D'"SORTIE" DE LA FONCTION :
                                     < 'NEXIST' : ON GENERE UNE IMAGE,
                                     < 'EXIST'  : ON GENERE UNE BANDE.
ABLOC0:  WORD        K               < NUMERO DU PREMIER BLOC A LIRE SUR LA
                                     < BANDE MAGNETIQUE.
PONGAL:  FLOAT       <NILK<NILK<NILK < PONDERATION DU CHAMP GALAXIE SPIRALE.
PONFRA:  FLOAT       <NILK<NILK<NILK < PONDERATION DU CHAMP FRACTAL (NUAGES).
FA50:    FLOAT       <NILK<NILK<NILK
FA0:     FLOAT       <NILK<NILK<NILK
FA1:     FLOAT       <NILK<NILK<NILK
FA11:    FLOAT       <NILK<NILK<NILK
FA12:    FLOAT       <NILK<NILK<NILK
FA21:    FLOAT       <NILK<NILK<NILK
FA22:    FLOAT       <NILK<NILK<NILK
FA31:    FLOAT       <NILK<NILK<NILK
FA23:    FLOAT       <NILK<NILK<NILK
FA13:    FLOAT       <NILK<NILK<NILK
FA2:     FLOAT       <NILK<NILK<NILK
FA41:    FLOAT       <NILK<NILK<NILK
FA3:     FLOAT       <NILK<NILK<NILK
NEXP:    WORD        NILK            < EXPOSANT D'ACCENTUATION DES MAXIMA.
         IF          XOPT01-EXIST,XOPT1,,XOPT1
XOPT1:   VAL         ENDIF
<
< CONSTANTES FLOTTANTES DE BASE :
<
F0:      FLOAT       <K<K<K          < REMISE A ZERO FLOTTANTE...
F1:      FLOAT       <W<K<K          < L'UNITE EN FLOTTANT...
XXXLOC:  VAL         YYYFLO          < 'YYYFLO'.
         CALL        #SIP UTILITAIRES#
APWORK:  EQU         APFWOR          < POUR LA COMPATIBILITE AVEC LES OVERLAYS
                                     < DE " +" (CF. 'SIO...').
<
< POINT COURANT :
<
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.
COORDX:: VAL         XS-CS2D         < INDEX DE LA COORDONNEE 'X',
COORDY:: VAL         YS-CS2D         < INDEX DE LA COORDONNEE 'Y'.
<
< DEMANDE DE TEMPORISATION
< APRES EFFACEMENT :
<
TEMPO:   BYTE        NVPSER;FONDOR
         WORD        NILK            < INUTILE...
         WORD        XXXMOY          < 2 PETITES SECONDES...
XXXLOC:  VAL         YYYGOT          < 'YYYGOT'.
         CALL        #SIP UTILITAIRES#
XXXVEC:  VAL         XXVEC2          < DEFINITION DES DONNEES DU VECTEUR 512...
         CALL        #SIP VECTEUR 512#
APOINT:  WORD        POINT           < SOUS-PROGRAMME DE MARQUAGE D'UN POINT
                                     < DE COORDONNEES (X), DONT LE NIVEAU EST
                                     < CALCULE VIA LA TABLE 'LNIVO'.
ALNIVO:  WORD        LNIVO,X         < TABLE DE CORRESPONDANCE DES NIVEAUX POUR
                                     < LE SOUS-PROGRAMME 'POINT'.
<
< ACCES AUX REGISTRES DE CONTROLE :
<
ACTRL1:  WORD        RCTRL1
ACTRL2:  WORD        RCTRL2
<
< CALCUL D'UN PRODUIT SCALAIRE :
<
APRSCA:  WORD        PRSCA           < SOUS-PROGRAMME DE CALCUL D'UN PRODUIT
                                     < SCALAIRE DE 2 VECTEURS 3D...
<
< POINT TRI-DIMENSIONNEL COURANT :
<
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-DIMGRA,,XEIF%,
         IF          ATTENTION : INCOHERENCE DANS LES
         IF          DIMENSIONS DE L'ESPACE DE TRACE GRAPHIQUE !!!
XEIF%:   VAL         ENDIF
<
< DEFINITION DE LA NORMALE :
<
CN3D:    EQU         $               < DEBUT DES COORDONNEES DE LA NORMALE :
FXN:     FLOAT       <NILK<NILK<NILK < X(N),
FYN:     FLOAT       <NILK<NILK<NILK < Y(N),
FZN:     FLOAT       <W+W<K<K        < Z(N) : VAUT 2 (1+1) CAR LE VECTEUR
                                     <        NORMAL EST EN FAIT LA SOMME DE
                                     <        DEUX VECTEURS NORMAUX VOISINS...
<
< DEFINITION DE LA SOURCE LUMINEUSE :
<
CL3D:    EQU         $               < DEBUT DES COORDONNEES DE LA SOURCE 'L' :
FXL:     FLOAT       <NILK<NILK<NILK < X(L),
FYL:     FLOAT       <NILK<NILK<NILK < Y(L),
FZL:     FLOAT       <NILK<NILK<NILK < Z(L).
<
< BUFFER DES LIGNES CONSECUTIVES :
<
ALIGP2:  WORD        LIGP2,X         < RELAI VERS LA LIGNE SUIVANTE-SUIVANTE,
ALIGP1:  WORD        LIGP1,X         < RELAI VERS LA LIGNE SUIVANTE,
ALIG:    WORD        LIG,X           < RELAI VERS LA LIGNE COURANTE,
ALIGM1:  WORD        LIGM1,X         < RELAI VERS LA LIGNE PRECEDENTE.
<
< POUR CALCULER L'ECLAIRAGE :
<
FNIVC:   FLOAT       <NILK<NILK<NILK < NIVEAU MAXIMAL COURANT (VAUT 'FNIVMX'
                                     < OU 'FNIVMX' MOINS UNE FRACTION DE
                                     < 'FNIVOM' SUIVANT L'OMBRAGE...).
FNIVMX:  FLOAT       <XXN255<K<K
         NTRN
FNIVOM:  FLOAT       <-XXN255/XXXMOY<K<K
         TRN
FPENOM:  FLOAT       <NILK<NILK<NILK < BAISSE MAXIMALE DU NIVEAU D'ECLAIRAGE
                                     < DANS LA ZONE D'OMBRE : 'FPENOM' DONNE EN
                                     < FAIT L'INVERSE DE 'FNIVOM/NPENOM'.
<
< POUR CALCULER LA FONCTION
< EN DENTS DE SCIE :
<
F255:    WORD        XXN255
F511:    WORD        NIV256+NIV256-Z
<
< VARIABLES MONTAGNEUSES :
<
GXS:     FLOAT       <NILK<NILK<NILK < COORDONNEES ABSOLUES
GYS:     FLOAT       <NILK<NILK<NILK <                      DU POINT COURANT.
FCUMR:   FLOAT       <NILK<NILK<NILK < SIGMA DES FONCTIONS ALEATOIRES
                                     < SCALANTES.
FPOND:   FLOAT       <NILK<NILK<NILK < POUR LES PONDERER...
FPOND0:  FLOAT       <NILK<NILK<NILK < VALEUR INITIALE DE LA PONDERATION :
                                     < FPOND0=RAC(PASIX*PASIY).
RENORM:  FLOAT       <NILK<NILK<NILK < DONNE LE SIGMA DES 'FPOND' SCALANTS
                                     < DIVISE PAR 'FPOND0', ET PERMET DE CAL-
                                     < CULER LA FONCTION ALEATOIRE DANS UN
                                     < SEGMENT PREDETERMINE, ET QUI EST :
                                     < (INFRDN*AMPLI*AMPLIR,SUPRDN*AMPLI*AMPLIR)
<
< RELAIS MONTAGNEUX :
<
AFONCT:  WORD        FONCT           < CALCUL DE LA FONCTION COURANTE.
<
< DEFINITION DE LA GRILLE :
<
NRECUR:  WORD        NILK            < NOMBRE COURANT DE RECURSIONS...
PASIX:   WORD        NILK            < PAS SUR 'OX',
PASIY:   WORD        NILK            < PAS SUR 'OY'.
FPASIX:  FLOAT       <NILK<NILK<NILK < DE MEME
FPASIY:  FLOAT       <NILK<NILK<NILK <         EN FLOTTANT...
XNOEUD:  WORD        NILK            < X(NOEUD HAUT-GAUCHE) DE LA MAILLE,
YNOEUD:  WORD        NILK            < Y(NOEUD HAUT-GAUCHE) DE LA MAILLE.
AFNIV1:  FLOAT       <NILK<NILK<NILK
AFNIV2:  FLOAT       <NILK<NILK<NILK
AFNIV3:  FLOAT       <NILK<NILK<NILK
AFNIV4:  FLOAT       <NILK<NILK<NILK
KITER:   WORD        NILK            < COMPTAGE DES RECURSIONS...
<
< CONSTANTES DE CALCUL
< DES OMBRES PORTEES :
<
PRAYON:  FLOAT       <NILK<NILK<NILK < PENTE DE LA DROITE "RAYON LUMINEUX"
                                     < ALLANT DE LA SOURCE LUMINEUSE AU POINT
                                     < DE COTE MAXIMALE COURANT, EN FAISANT LES
                                     < HYPOTHESES SUIVANTES :
                                     < 1 - ON TRACE DE DROITE A GAUCHE,
                                     < 2 - ON SUPPOSE CE RAYON LUMINEUX CONTENU
                                     < DANS LE PLAN DE PROJECTION (Z=0)...
                                     < ENFIN, ON A :
                                     < PRAYON=(YMAX-ZL)/(XMAX-XL).
         PAGE
<
<
<        L O C A L  :
<
<
         LOCAL
LOC:     EQU         $
<
< PARAMETRES DU GENERATEUR ALEATOIRE :
<
RDN:     WORD        4397            < NOMBRE ALEATOIRE COURANT.
RDN1:    WORD        5189            < CONSTANTE
RDN2:    WORD        6791            < DE CALCUL DES
RDN3::   VAL         19              < NOMBRE ALEATOIRES...
RDN4:    WORD        7993            < 2EME NOMBRE ALEATOIRE COURANT.
RDN5:    WORD        4021
RDN6::   VAL         23
POINTS:  WORD        16807
INF32:   FLOAT       32768
INF64:   FLOAT       65536
FWORK4:  FLOAT       <NILK<NILK<NILK
FWORK5:  FLOAT       <NILK<NILK<NILK
HINCU:   FLOAT       <NILK<NILK<NILK < POUR
HINCV:   FLOAT       <NILK<NILK<NILK <      L'INTERPOLATION...
FSUP:    FLOAT       <NILK<NILK<NILK < 'SUPRDN' EN FLOTTANT,
FINF:    FLOAT       <NILK<NILK<NILK < 'INFRDN' EN FLOTTANT.
SUP64:   FLOAT       <NILK<NILK<NILK < SUP/65536,
UNMIS:   FLOAT       <NILK<NILK<NILK < 1-(INF/SUP),
UNPIS:   FLOAT       <NILK<NILK<NILK < 32768*(1+(INF/SUP)).
AMPLI:   FLOAT       <NILK<NILK<NILK < AMPLIFICATEUR DU SIGMA DES 'FPOND'
                                     < CALCULE A PARTIR DE 'NRECUR'.
XAMPLI:: VAL         31              < POUR CALCULER 'KAMPLI'...
KAMPLI:  FLOAT       <XAMPLI-I<K<K   < POUR CALCULER 'AMPLI' A PARTIR DE
                                     < 'NRECUR'...
<
< POUR LE CALCUL DU LOGARITHME :
<
POLLO1:  FLOAT       <NILK<NILK<NILK < VARAIBLE DE MANOEUVRE...
POLLO2:  FLOAT       <NILK<NILK<NILK
POLLO3:  FLOAT       <NILK<NILK<NILK
POLLO4:  FLOAT       0.7071067       < RACINE(2)/2.
POLLO5:  FLOAT       1.2920088       < COEFFICIENTS
POLLO6:  FLOAT       2.6398577       <              DU
POLLO7:  FLOAT       1.656763        <                 DEVELOPPEMENT.
POLLO8:  EQU         F05             < CONSTANTE 1/2.
POLLO9:  FLOAT       0.6931472       < LN(2).
<
< POUR LE CALCUL DE L'EXPONENTIELLE :
<
POLEX1:  EQU         POLLO1          < VARIABLE DE MANOEUVRE...
POLEX2:  EQU         POLLO2
POLEX3:  EQU         POLLO3
POLEX4:  FLOAT       1.442695        < LOG2(E).
POLEX5:  WORD        NILK            < RELEVE DE L'EXPOSANT
POLEX6:  EQU         F1              < 1.0
POLEX7:  FLOAT       2               < 2.
POLEX8:  FLOAT       87.417488       < COEFFICIENTS
POLEX9:  FLOAT       0.0346573       <              DU
POLEY0:  FLOAT       -17830.91       <                 DEVELOPPEMENT.
POLEY1:  FLOAT       9.9545955
SIGNE:   WORD        NILK            < POUR DETERMINER LE SIGNE DE X**Y...
<
< POUR CALCULER
< LES EXPOSANTS :
<
XXMASK:: VAL         MOCG
XX7F::   VAL         '7F             < MAXIMUM POSITIF,
XX80::   VAL         -'80            < MIMIMUM NEGATIF.
<
< RELAIS DE SOUS-PROGRAMMES :
<
ASPRDN:  WORD        SPRDN           < GENERATEUR ALEATOIRE DONNANT RDN(XS,YS).
ARAK:    WORD        RAK             < CALCUL DE LA PUISSANCE P/(2**Q) D'UN
                                     < NOMBRE...
<
< 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).
<
< DONNEES DE CALCUL DE 'ARCTG' :
<
ATGT1:   FLOAT       <NILK<NILK<NILK < ZONE DE TRAVAIL NUMERO 1,
ATGT2:   FLOAT       <NILK<NILK<NILK < ZONE DE TRAVAIL NUMERO 2,
ATGT3:   FLOAT       <NILK<NILK<NILK < ZONE DE TRAVAIL NUMERO 3.
ATGSDX:  WORD        NILK            < INDICATEUR "SIGNE DE X ARGUMENT":
                                     < = 0 : POSITIF OU NUL;
                                     < < 0 : NEGATIF.
ATGPSC:  FLOAT       0.0548862       < TG(PI/12).
ATGPS2:  FLOAT       1.5707963       < PI/2.
ATGPS3:  FLOAT       1.0471975       < PI/3.
ATGPS6:  FLOAT       0.5235988       < PI/6.
ATGUN:   EQU         F1
ATGR3:   FLOAT       1.7320508       < RACINE(3).
ATGP1:   FLOAT       0.6031058       < COEFFICIENTS
ATGP2:   FLOAT       0.0516045       <              (P1,P2,P3,P4)
ATGP3:   FLOAT       0.5591371       <                            DU
ATGP4:   FLOAT       1.4087812       <                               POLYNOME.
AARCTG:  WORD        ARCTG           < SOUS-PROGRAMME DE CALCUL.
PI:      FLOAT       3.1415927       < PI,
<
< RELAIS DE SOUS-PROGRAMMES :
<
AEXP:    WORD        EXPON           < CALCUL D'UNE EXPONENTIELLE (BASE 'E').
<
< VARIABLES DE MANOEUVRE :
<
<
< DONNEES DE CALCUL DU
< CHAMP F(RHO,TETA) :
<
CHAMP:   FLOAT       <NILK<NILK<NILK < VALEUR DU CHAMP F(RHO,TETA).
RHO:     FLOAT       <NILK<NILK<NILK < RAYON POLAIRE,
RHO1:    FLOAT       <NILK<NILK<NILK < RAYON POLAIRE NORMALISE DANS (0,1).
DIAMET:  FLOAT       <NILK<NILK<NILK < DISTANCE(ORIGINE,CENTRE SPIRALE).
TETA:    FLOAT       <NILK<NILK<NILK < ANGLE POLAIRE.
ZR:      FLOAT       <NILK<NILK<NILK < ABSCISSE FLOTTANTE DU POINT COURANT,
ZI:      FLOAT       <NILK<NILK<NILK < ORDONNEE FLOTTANTE DU POINT COURANT.
XCENTR:  FLOAT       <NILK<NILK<NILK < ABSCISSE DU CENTRE DU CHAMP,
YCENTR:  FLOAT       <NILK<NILK<NILK < ORDONNEE DU CENTRE DU CHAMP.
AFIELD:  WORD        FIELD           < CALCUL DU CHAMP SPIRALE...
<
< VARAIBLES DE MANOEUVRE :
<
FWORK1:  FLOAT       <NILK<NILK<NILK
FWORK2:  FLOAT       <NILK<NILK<NILK
<
< POUR LE CALCUL D'UNE
< INTENSITE LUMINEUSE :
<
AINTEN:  WORD        INTEN           < SOUS-PROGRAMME DE CALCUL DE L'INTENSITE
                                     < LUMINEUSE AU POINT COURANT.
NIVBAS:: VAL         1               < NIVEAU MINIMAL...
FNIVBA:  FLOAT       <NIVBAS<K<K     < POUR ELIMINER LA GENERATION DE POINTS
                                     < NOIRS...
<
< RELAIS D'ACCES AUX LISTES
< DE DESCRIPTION DU MAILLAGE :
<
ALPASX:  WORD        LPASX,X         < RELAI D'ACCES A 'PASIX' FLOTTANT,
ALPSIX:  WORD        LPSIX,X         < RELAI D'ACCES A 'PASIX' ENTIER.
ALPASY:  WORD        LPASY,X         < RELAI D'ACCES A 'PASIY' FLOTTANT,
ALPSIY:  WORD        LPSIY,X         < RELAI D'ACCES A 'PASIY' ENTIER.
ALPOND:  WORD        LPOND,X         < RELAI D'ACCES A 'FPOND'.
<
< POUR ACCEDER AUX IMAGES :
<
SAVER:   WORD        NILK            < SAUVEGARDE D'UN MOT DE LA TRAME
                                     < RESIDENTE ROUGE,
SAVEV:   WORD        NILK            < DE MEME POUR LE VERT,
SAVEB:   WORD        NILK            < DE MEME POUR LE BLEU.
MCDAR:   EQU         SAVER           < SAUVEGARDE D'UN MOT DE LA TRAME
                                     < SCRATCH ROUGE,
MCDAV:   EQU         SAVEV           < DE MEME POUR LE VERT,
MCDAB:   EQU         SAVEB           < DE MEME POUR LE BLEU.
XCTCDA:  WORD        NILK            < CONSTANTE DE TRANSLATION PERMETTANT
                                     < D'ATTEINDRE INDIFFEREMMENT 'TV1' OU
                                     < 'TV2'...
CTCDA:   WORD        TV2-TV1         < POUR ATTEINDRE 'TV2'...
<
< DEFINITION DE L'ACCELERATEUR
< DES ACCES A 'TV1' ET 'TV2' :
<
ASHPR:  @
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 'ASHPR'...
XWOR%6:  VAL         XWOR%5=FCSIGN
XWOR%7:  VAL         XWOR%5(MSYMBN)MSYMBN=FCSIGN
         IF          XWOR%6*XWOR%7,XEIF%,,XEIF%
ASHPR::  VAL         123             < ON SE DONNE UN NOMBRE PREMIER...
XEIF%:   VAL         ENDIF
LASHT:   WORD        ASHPR           < POUR FAIRE DES CALCULS MODULO 'ASHPR'.
SAVYX:   BYTE        NILK;NILK       < POUR MEMORISER UN COUPLE (Y,X).
INOC::   VAL         -EXIST          < ETAT INOCCUPE D'UNE ENTREE DE LA TABLE.
ASHT1::  MOT         O               < POUR ACCEDER A LA PARTIE (Y,X) DE LA
                                     < TABLE,
ASHT2::  MOT         ASHT1+ASHPR     < POUR ACCEDER A LA PARTIE TV1/TV2/NIVEAU
                                     < DE LA TABLE.
<
< DEFINITION DE LA SPIRALE
< DE CALCUL D'UN SIGMA(X,Y) :
<
PASQ:    WORD        NILK            < PAS DE PARCOURS DE LA SPIRALE,
DELTAX:  WORD        NILK            < VECTEUR TRANSLATION
DELTAY:  WORD        NILK            <                     COMPLEXE COURANT.
LB:      WORD        NILK            < LONGUEUR DES
LB0:     WORD        NILK            <              BRANCHES DE LA SPIRALE.
NP:      WORD        NILK            < NOMBRE DE POINT COURANT,
FNPM:    FLOAT       <NILK<NILK<NILK < NOMBRE DE POINTS FLOTTANT DE LA SPIRALE.
<
< SIGMA(X,Y) SUR UNE SPIRALE :
<
F2::     FLOAT       <XXXMOY<K<K
F4::     FLOAT       <XXXMOY*XXXMOY<K<K
CUMUL:   WORD        NILK            < SIGMA(NIVEAU(X,Y)).
ASPIRL:  WORD        SPIRAL          < SOUS-PROGRAMME DE CALCUL DE 'CUMUL'...
<
< PARTICIPATIONS RELATIVES DE
< LA GENERATION ALEATOIRE ET
< DE LA SOMMATION SUR UNE
< SPIRALE CENTREE EN (256,256) :
<
PONRDN:  FLOAT       <NILK<NILK<NILK < CONTRIBUTION DE LA GENERATION ALEATOIRE,
PONSPI:  FLOAT       <NILK<NILK<NILK < CONTRIBUTION DES SPIRALES.
<
< DONNEES DE "MODULATION"
< D'UN CHAMP PRE-EXISTANT :
<
NI:     @
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 'NI'...
XWOR%6:  VAL         XWOR%5=FCSIGN
XWOR%7:  VAL         XWOR%5(MSYMBN)MSYMBN=FCSIGN
         IF          XWOR%6*XWOR%7,XEIF%,,XEIF%
NI::     VAL         XXNOIR          < LE NIVEAU INITIAL SERA LE NIVEAU NOIR.
XEIF%:   VAL         ENDIF
ND:     @
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 'ND'...
XWOR%6:  VAL         XWOR%5=FCSIGN
XWOR%7:  VAL         XWOR%5(MSYMBN)MSYMBN=FCSIGN
         IF          XWOR%6*XWOR%7,XEIF%,,XEIF%
ND::     VAL         W               < PAS DE DIVISEUR DES NIVEAUX...
XEIF%:   VAL         ENDIF
BORINF:  WORD        NI              < BORNE INFERIEUR DES NIVEAUX MARQUES,
         NTRN
BORSUP:  WORD        XXN255/ND+NI    < BORNE SUPERIEURE DES NIVEAUX MARQUES.
         TRN
AXN255:  WORD        XXN255          < POUR FAIRE UNE REGLE DE TROIS...
<
<
<        C O N S T A N T E   M A G I Q U E  :
<
<
MAGIK::  VAL         7               < CONSTANTE MAGIQUE...
         IF          K*MAGIK/BASE16(K=FCREST-K,,XEIF%,
         IF          ATTENTION : IL FAUT MAGIK(K)=K POUR
         IF          SIMPLIFIER LES CHOSES EN BASE 16 !!!
XEIF%:   VAL         ENDIF
XWOR%3:  VAL         MAGIK           < CONSTANTE MAGIQUE...
XWOR%7:  VAL         K               < INITIALISATION DU CUMUL...
         NTRN
         DO          BASE16
XWOR%7:  VAL K=FCDO*XWOR%3/BASE16(K=FCREST?COSBT=FMASK(K?XWOR%7=FCINST
XWOR%8:  VAL         K               < INITIALISATION DU CUMUL...
         DO          BASE16
XWOR%8:  VAL K=FCDO?COSBT=FMASK(K?XWOR%8=FCINST
         TRN
         IF          XWOR%7-XWOR%8,,XEIF%,
         IF          ATTENTION : LA CONSTANTE MAGIQUE 'MAGIK'
         IF          N'OPERE PAS UNE PERMUTATION DES 16 CHIFFRES
         IF          DE 0 A F !!!
XEIF%:   VAL         ENDIF
         IF          K*MAGIK/BASE10(K=FCREST-K,,XEIF%,
         IF          ATTENTION : IL FAUT MAGIK(K)=K POUR
         IF          SIMPLIFIER LES CHOSES EN BASE 10 !!!
XEIF%:   VAL         ENDIF
XWOR%3:  VAL         MAGIK           < CONSTANTE MAGIQUE...
XWOR%7:  VAL         K               < INITIALISATION DU CUMUL...
         NTRN
         DO          BASE10
XWOR%7:  VAL K=FCDO*XWOR%3/BASE10(K=FCREST?COSBT=FMASK(K?XWOR%7=FCINST
XWOR%8:  VAL         K               < INITIALISATION DU CUMUL...
         DO          BASE10
XWOR%8:  VAL K=FCDO?COSBT=FMASK(K?XWOR%8=FCINST
         TRN
         IF          XWOR%7-XWOR%8,,XEIF%,
         IF          ATTENTION : LA CONSTANTE MAGIQUE 'MAGIK'
         IF          N'OPERE PAS UNE PERMUTATION DES 10 CHIFFRES
         IF          DE 0 A 9 !!!
XEIF%:   VAL         ENDIF
AMAGIK:  WORD        MAGIK
<
< GESTION DU DEROULEUR :
<
NVPMT::  VAL         '0B             < 'NVP' D'ACCES AU DEROULEUR DE BANDES.
DEMMT:   BYTE        NVPMT;XFMTWA    < DEMANDE D'ECRITURE A ACCES DIRECT.
         WORD        BUFMT=FCTA*NOCMO
         WORD        LBUFMT
         WORD        NILK            < ADRESSE DU BLOC COURANT.
DEMMTM:  BYTE        NVPMT;XFMTTM    < DEMANDE D'ECRITURE D'UN 'TAPE-MARK'.
IBUFMT:  WORD        LBUFMT-Z+I      < INDEX COURANT DU BUFFER 'MT',
ZBUFMT:  WORD        LBUFMT-Z+I      < POUR LES TESTS "BUFFER PLEIN"...
ABUFMT:  WORD        BUFMT,X         < ET RELAI D'ACCES...
         PAGE
<
<
<        T A B L E   A   A C C E S   A L E A T O I R E  :
<
<
ASHT:    EQU         $
         DO          ASHPR
         BYTE        NILK;NILK       < COUPLES (Y,X).
         IF          INOC-K,XEIF%,,
         IF          ATTENTION : LA VALEUR DE 'INOC' EST INACCEPTABLE !!!
XEIF%:   VAL         ENDIF
         DO          ASHPR
         WORD        INOC            < ETAT INOCCUPE.
         PAGE
<
<
<        T A B L E   D E   T R A N S C O D A G E   D E S   N I V E A U X  :
<
<
<        ARGUMENTS D'ASSEMBLAGE :
<                    ND=DIVISEUR DES NIVEAUX DE 'LNIVO' (0 OU 2),
<                    NI=TRANSLATION DES NIVEAUX DE 'LNIVO' (0 OU 128)...
<
<
LNIVO:   EQU         $
         NTRN
XWOR%1:  VAL         NIV256+NOCMO-E/NOCMO
XWOR%2:  VAL         NIV256/NOCMO(K=FCREST
         TRN
XWOR%3:  VAL         NIV256+XWOR%2
                                     < INCREMENT DES OCTETS GAUCHES,
XWOR%4:  VAL         XWOR%3+NOCMO-Z
                                     < INCREMENT DES OCTETS DROITS.
         NTRN
<*******************************************************************************
         DO          XWOR%1
   BYTE K=FCDO)MFFFF+N-Z*NOCMO+XWOR%3/ND+NI;K=FCDO)MFFFF+N-Z*NOCMO+XWOR%4/ND+NI
XWOR%5:  VAL         '0000000@@@@    < RECUPERATION DU DERNIER MOT,
<*******************************************************************************
         TRN
         IF          XWOR%2-K,,XEIF%,
XWOR%5:  VAL         XWOR%5(MOCG     < DANS LE CAS D'UNE TABLE DE LONGUEUR
                                     < IMPAIRE, ON EFFACE LE DERNIER OCTET
                                     < GENERE,
         $EQU        $-D             < ON REVIENT D'UN MOT EN ARRIERE,
         WORD        XWOR%5          < ET ON REGENERE LE DERNIER MOT...
XEIF%:   VAL         ENDIF
         PAGE
<
<
<        L I S T E S   D E   D E S C R I P T I O N
<                    D U   M A I L L A G E  :
<
<
LPASX:   EQU         $
         NLS
         DO          MAXREC
         FLOAT       <NILK<NILK<NILK < 'PASIX'.
         LST
LPSIX:   EQU         $
         NLS
         DO          MAXREC
         WORD        NILK
         LST
LPASY:   EQU         $
         NLS
         DO          MAXREC
         FLOAT       <NILK<NILK<NILK < 'PASIY'.
         LST
LPSIY:   EQU         $
         NLS
         DO          MAXREC
         WORD        NILK
         LST
LPOND:   EQU         $
         NLS
         DO          MAXREC
         FLOAT       <NILK<NILK<NILK < 'FPOND'.
         LST
         PAGE
<
<
<        B U F F E R   D E   T R O I S   L I G N E S   C O N S E C U T I V E S
<
<
LIGP2:   EQU         $
         NLS
         DO          XC512
         FLOAT       <NILK<NILK<NILK < LIGNE SUIVANTE-SUIVANTE.
         LST
LIGP1:   EQU         $
         NLS
         DO          XC512
         FLOAT       <NILK<NILK<NILK < LIGNE SUIVANTE.
         LST
LIG:     EQU         $
         NLS
         DO          XC512
         FLOAT       <NILK<NILK<NILK < LIGNE COURANTE.
         LST
LIGM1:   EQU         $
         NLS
         DO          XC512
         FLOAT       <NILK<NILK<NILK < LIGNE PRECEDENTE.
         LST
         PAGE
<
<
<        P I L E   D E   T R A V A I L  :
<
<
STACK:   EQU         $
         DZS         64
         PROG
         NLS
XXXVEC:  VAL         XXVEC3          < DEFINITION DES PROGRAMMES VECTEUR 512...
         CALL        #SIP VECTEUR 512#
         PAGE
<
<
<        M A R Q U A G E   D ' U N   P O I N T  :
<
<
<        FONCTION :
<                      CE SOUS-PROGRAMME A DEUX MODES
<                    DE FONCTIONNEMENT, SUIVANT LA
<                    VALEUR DU MODE DE CONTROLE 'IMODUL' :
<
<                    1 - (IMODUL)='NEXIST' : IL MARQUE
<                    LE POINT ARGUMENT (X,Y) AVEC
<                    COMME NIVEAU, LE NIVEAU ARGU-
<                    MENT (A) TRANSCODE VIA LA TA-
<                    BLE 'LNIVO', CE QUI PERMET PAR
<                    EXEMPLE LA SUPERPOSITION DE
<                    PLUSIEURS IMAGES, EN FAISANT
<                    QUE LEURS TABLES 'LNIVO' SOIENT
<                    COMPLEMENTAIRES...
<
<                    2 - (IMODUL)='EXIST' : IL RECUPERE
<                    LE NIVEAU PRE-EXISTANT DU POINT DE
<                    COORDONNEES (X,Y) ; SI CELUI-CI EST
<                    HORS DU SEGMENT (NI,XXN255/ND+NI),
<                    IL EST INCHANGE, SINON, IL EST RE-
<                    ECRIT "MODULE" PAR NIVEAU/XXN255,
<                    OU 'NIVEAU' DESIGNE LE NIVEAU ARGU-
<                    MENT DU SOUS-PROGRAMME.
<
<
<        ARGUMENTS :
<                    (A)=NIVEAU,
<                    (X,Y)=COORDONNEES DU POINT.
<
<
<        RESULTAT :
<                    (A)=NIVEAU TRANSCODE, OU NIVEAU PRE-EXISTANT,
<                    (B) EST DETRUIT !!!
<
<
POINT:   EQU         $
<
< DISCRIMINATION ENTRE LE
< MARQUAGE D'UN NOUVEAU
< CHAMP ET LA "MODULATION"
< D'UN CHAMP PRE-EXISTANT :
<
         IF          NEXIST-K,,XEIF%,
         IF          ATTENTION : LE TEST CI-DESSOUS EST IDIOT !!!
XEIF%:   VAL         ENDIF
         CPZ         IMODUL          < EST-CE LA "MODULATION" D'UN CHAMP PRE-
                                     < EXISTANT ???
         JE          POINT1          < NON, LE MARQUAGE D'UN NOUVEAU CHAMP...
<
< CAS DE LA "MODULATION"
< D'UN CHAMP PRE-EXISTANT :
<
         STA         FWORK           < SAUVEGARDE DU NIVEAU DE "MODULATION"
                                     < QUI EST DANS (XXNOIR,XXN255).
         BSR         ALOADP          < (A)=NIVEAU(X,Y) PRE-EXISTANT :
         CP          BORINF          < EST-ON DANS LES NIVEAUX A MARQUER ???
         JL          POINT2          < NON, ON IGNORE LE POINT (X,Y)...
         CP          BORSUP          < EST-ON DANS LES NIVEAUX A MARQUER ???
         JG          POINT2          < NON, ON IGNORE LE POINT (X,Y)...
         SB          BORINF          < OUI, ON SE RAMENE A L'ORIGINE,
         MP          FWORK           < ET ON "MODULE" PAR LE
         DV          AXN255          <                       NIVEAU ARGUMENT,
         AD          BORINF          < PUIS, ON RE-TRANSLATE :
                                     < (A)=NIVEAU "MODULE"...
         JMP         POINT3          < VERS LE MARQUAGE, SANS TRANSCODAGE BIEN
                                     < ENTENDU, PUISQUE LA REGLE DE TROIS CI-
                                     < DESSUS NOUS A FAIT RESTER DANS LE
                                     < SEGMENT (BORINF,BORSUP) QUI ETAIT CELUI
                                     < AUQUEL APPARTENAIT AUSSI LE NIVEAU
                                     < ANTERIEUR DU POINT (X,Y)...
<
< CAS DU MARQUAGE D'UN
< NOUVEAU CHAMP :
<
POINT1:  EQU         $
<
< TRANSCODAGE DU NIVEAU :
<
         PSR         X               < SAUVEGARDE DE LA COORDONNEE 'X'...
         LR          A,X             < (X)=NIVEAU ARGUMENT,
         LBY         &ALNIVO         < (A)=NIVEAU TRANSCODE,
         PLR         X               < RESTAURE :
                                     < (X)=COORDONNEE 'X'.
<
< MARQUAGE DU POINT :
<
POINT3:  EQU         $
         BSR         ASTORP          < MARQUAGE : (X,Y) <-- (A)...
<
< ET RETOUR :
<
POINT2:  EQU         $
         RSR
         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
XXXPRO:  VAL         YYYGOT          < 'YYYGOT'.
         CALL        #SIP UTILITAIRES#
XXXPRO:  VAL         YYYFLO          < 'YYYFLO'.
         CALL        #SIP UTILITAIRES#
         LST
         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         L,W             < SAUVEGARDE DE 2 BASES ; MAIS 'C' NE DOIT
                                     < PAS ETRE UTILISEE A CAUSE DU BLOC FLOT-
                                     < TANT...
         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),
         #/FST#      FWORK           < ET SAVE...
         #/FLD#      VECT1Y,L        < Y(1),
         FMP         VECT2Y,W        < Y(1)*Y(2),
         FAD         FWORK           < X(1)*X(2)+Y(1)*Y(2),
         #/FST#      FWORK
                                     < ET SAVE...
         #/FLD#      VECT1Z,L        < Z(1),
         FMP         VECT2Z,W        < Z(1)*Z(2),
         FAD         FWORK           < (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 RETOUR :
<
         PLR         L,W
         RSR
         PAGE
<
<
<        G E N E R A T E U R   R E D O N N A N T   T O U J O U R S
<        L E   M E M E   V E C T E U R   A L E A T O I R E   E N
<        U N   P O I N T   D O N N E  :
<
<
<        ARGUMENT :
<                    (X,Y)=COORDONNEES DU POINT COURANT.
<
<
<        RESULTAT :
<                    (A,B)=RDN(XS,YS,KITER,GRAINE).
<
<
SPRDN:   EQU         $
<
< GENERATION ALEATOIRE :
<
         LR          X,A             < (A)=COORDONNEE 'X',
         MP          KITER           < ON UTILISE 'KITER' AFIN DE FAIRE
                                     < VARIER LA GENERATION ALEATOIRE A (X,Y)
                                     < CONSTANT SUIVANT LE NIVEAU DE RECUR-
                                     < SIVITE...
         EORR        B,A             < ET ON SE RAMENE SUR UN MOT...
         STA         FWORK4          < SAVE F1(XS)...
         LR          Y,A             < (A)=COORDONNEE 'Y',
         EOR         RDN1            < ??!???!
         STA         FWORK5          < SAVE F2(YS)...
         MP          FWORK4          < ET ON CONSTRUIT
         XR          A,B             < UNE FONCTION UNIQUE
         AD          FWORK5          < DU NOEUD COURANT,
         SB          FWORK4          < TELLE QUE :
                                     < F(X,Y)#F(Y,X),
                                     < F(X,Y)=X*Y+Y-X.
         EORR        B,A
         MP          GRAINE          < D'OU F(GRAINE,KITER,X,Y), TELLE QUE :
                                     < F(X,Y)#F(Y,X) AFIN D'EVITER UNE SYMETRIE
                                     < PAR RAPPORT A UNE DIAGONALE...
         EORR        B,A
         MP          AMAGIK          < DONT ON FAIT UN "SHUFFLING"...
         EORR        B,A             < ON CUMULE LES 2 MOTS,
<
< MISE A L'ECHELLE :
<
<
<        NOTA :
<                      ON DOIT POUR METTRE LA
<                    VALEUR 'RDN' A L'ECHELLE
<                    CALCULER L'EXPRESSION :
<
<                    (SUP/(-32768))*(-RDN/2+16384+(RDN/2-16384)*(INF/SUP)),
<
<                    QUI SE SIMPLIFIE EN :
<
<                    (SUP/65536)*(RDN*(1-(INF/SUP))+32768*(1+(INF/SUP))).
<
         FLT                         < ON FLOTTE 'RDN',
         FMP         UNMIS           < RDN*(1-(INF/SUP)),
         FAD         UNPIS           < RDN*(1-(INF/SUP))+32768*(1+(INF/SUP)),
         FMP         SUP64           < (SUP/65536)*(...).
<
< ET SORTIE :
<
         RSR
         PAGE
<
<
<        S O M M A T I O N   S U R   U N E   S P I R A L E
<        C E N T R E E   S U R   ( X S , Y S )   D E S
<        N I V E A U X   D E   S E S   P O I N T S  :
<
<
<        ARGUMENT :
<                    (X,Y)=COORDONNEES DANS L'ESPACE (256,256).
<
<
<        RESULTAT :
<                    (A,B)=CUMUL CENTRE SUR LE POINT ARGUMENT (X,Y).
<
<
SPIRAL:  EQU         $
<
< INITIALISATION DE LA SPIRALE :
<
         PSR         X,Y             < SAUVEGARDE DU POINT (X,Y).
         STZ         CUMUL           < CUMUL <-- 0.
         STZ         NP              < NP=NOMBRE DE POINTS TRAITES.
         LA          PASQ
         STA         DELTAX          < DELTAX <-- +1,
         STZ         DELTAY          < DELTAY <-- 0.
         LAI         W
         STA         LB0             < INITIALISATION DE LA LONGUEUR DU
                                     < PREMIER BRAS DE LA SPIRALE.
<
< PARCOURS D'UN BRAS :
<
SPIRL1:  EQU         $
         LA          LB0
         STA         LB              < LONGUEUR DU BRAS COURANT.
<
< TRAITEMENT DU POINT COURANT :
<
SPIRL2:  EQU         $
         IC          NP              < COMPTAGE DES POINTS TRAITES :
         LA          NP
         CP          NPM             < FINI ???
         JG          SPIRL3          < OUI...
         LR          X,A             < NON, TEST DE LA COORDONNEE 'X' :
         JAL         SPIRL4          < LE POINT EST HORS-ECRAN...
         CPI         NPOLM1
         JG          SPIRL4          < HORS-ECRAN...
         LR          Y,A             < TEST DE LA COORDONNEE 'Y' :
         JAL         SPIRL4          < HORS-ECRAN...
         CPI         NLIGM1
         JG          SPIRL4          < HORS-ECRAN...
<
< ACCES AU NIVEAU DU POINT (X,Y) :
<
         PSR         X,Y             < SAUVEGARDE DU POINT COURANT...
<
< TENTATIVE D'ACCELERATION :
<
         SWBR        Y,B
         ORR         X,B             < (B)=(Y,X),
         STB         SAVYX           < ET SAUVEGARDE...
         RBT         NBITMO          < SUPRESSION DU BIT DE SIGNE DE 'B' AFIN
                                     < QUE LE RESTE SOIT POSITIF OU NUL,
         LRM         W
         WORD        ASHT            < (W)=ADRESSE DE LA TABLE D'ACCELERATION.
         LAI         K
         DV          LASHT           < (B)=COUPLE (Y,X) MODULO 'ASHPR',
         ADR         B,W             < CE QUI DONNE DANS 'W' L'ADRESSE D'UNE
                                     < ENTREE :
         LA          ASHT1,W
         CP          SAVYX           < L'ENTREE COURANTE CONTIENT-ELLE (Y,X) ???
         JNE         SPIRL6          < NON, IL FAUT ACCEDER REELLEMENT A 'TV1'/
                                     < 'TV2'...
         LA          ASHT2,W         < OUI, MAIS
         EOR         XCTCDA          < ON VA ANSI REGARDER SIMULTANEMENT SI
                                     < L'ENTREE EST OCCUPEE, ET SI OUI, S'IL
                                     < Y A COINCIDENCE AVEC 'TV1'/'TV2'...
         JAL         SPIRL6          < ET BIEN NON, CE N'EST PAS (X,Y)...
         CPI         NIVMX7          < ALORS ???
         JLE         SPIRL7          < ON A TROUVE (X,Y), ET 'TV1'/'TV2' EST
                                     < LE MEME, ALORS :
                                     < (A)=NIVEAU(X,Y)...
<
< ACCES REEL AU POINT (X,Y) :
<
SPIRL6:  EQU         $
         LR          X,A
         LBI         K
XWOR%1:  VAL         NBITMO=K
         SCLD        NBITMO-XWOR%1   < (B)=NUMERO DU MOT DANS LA LIGNE,
         SLRS        NBITMO-XWOR%1
         LXI         NBITMO-BIT
         SBR         A,X             < (X)=DECALAGE D'ACCES AUX BITS,
         PSR         X
         XR          Y,B
         SLLD        NMOTL=K+NBITMO
         ORR         Y,A             < (A)=NUMERO DU MOT DANS LA TRAME.
         AD          XCTCDA          < POUR PERMETTRE UN ACCES A TV1/TV2...
         LRM         B,X,Y
         WORD        MCDAR
         WORD        D*W
         WORD        LIMAG           < (Y)=POUR PASSER D'UNE COULEUR A L'AUTRE.
         RCDA
                                     < ACCES AU MOT ROUGE,
         LRM         B,X
         WORD        MCDAV
         WORD        D*W
         ADR         Y,A
         RCDA
                                     < ACCES AU MOT VERT,
         LRM         B,X
         WORD        MCDAB
         WORD        D*W
         ADR         Y,A
         RCDA
                                     < ACCES AU MOT BLEU.
         PLR         X               < RESTAURATION DU DECALAGE,
         LA          MCDAR
         SLRS        L,X
         SLRD        BIT             < RECUPERATION D'UN BIT ROUGE,
         LA          MCDAV
         SLRS        L,X
         SLRD        BIT             < RECUPERATION D'UN BIT VERT,
         LA          MCDAB
         SLRS        L,X
         ANDI        BIT             < RECUPERATION D'UN BIT BLEU,
         SLLD        NCOOL-BIT       < (A)=NIVEAU DE GRIS DU POINT.
<
< MEMORISATION DE (X,Y) :
<
         OR          XCTCDA          < (A)='TV1'/'TV2',NIVEAU(X,Y) :
         IF          TV1?TV2(NIVMX7,,XEIF%,
         IF          ATTENTION : LA CONCATENATION 'TV1'/'TV2' ET NIVEAU
         IF          EST IMPOSSIBLE !!!
XEIF%:   VAL         ENDIF
         STA         ASHT2,W         < MEMORISATION DE LA TRANSLATION ET DU
                                     < NIVEAU,
         ANDI        NIVMX7          < ET RESTAURATION DU NIVEAU(X,Y)...
         LB          SAVYX
         STB         ASHT1,W         < ET MEMORISATION DE (X,Y)...
<
< RESTAURATION DU POINT
< COURANT ET CUMUL :
<
SPIRL7:  EQU         $
         PLR         X,Y
         AD          CUMUL           < ET
         STA         CUMUL           < CUMULE...
<
< PARCOURS DE LA SPIRALE :
<
SPIRL4:  EQU         $
         LA          DELTAX          < CHANGEMENT DE
         ADR         A,X
         LA          DELTAY          < POINT COURANT (X,Y).
         ADR         A,Y
         DC          LB              < DECOMPTAGE DES POINTS SUR LA BRANCHE :
         JG          SPIRL2          < OK, IL EN RESTE...
         CPZ         DELTAX          < NON, ON EST AU BOUT, FAUT-IL AUGMENTER
                                     < LA LONGUEUR COURANTE DES BRANCHES ???
         JNE         SPIRL5          < NON (DX#0) ...
         IC          LB0             < OUI (DX=0) ...
SPIRL5:  EQU         $
         LA          DELTAY          < ON FAIT SUBIR AU NOMBRE COMPLEXE
         NGR         A,A             < (DX,DY) UNE ROTATION DE PI/2, SOIT
         LB          DELTAX          < UNE MULTIPLICATION PAR LA MATRICE
                                     < (0,-1,1,0)...
         STA         DELTAX          < DELTAX=-DELTAY,
         STB         DELTAY          < DELTAY=DELTAX.
         JMP         SPIRL1          < VERS LA BRANCHE SUIVANTE
<
< GENERATION DU POINT (X,Y) :
<
SPIRL3:  EQU         $
         PLR         X,Y             < RESTAURATION DU POINT COURANT (X,Y).
<
< NORMALISATION DU CUMUL :
<
         LA          CUMUL
         FLT
         FDV         FNPM
         RSR
         PAGE
<
<
<        C A L C U L   D E   L A   S O M M E   P O N D E R E E
<        D E S   F O N C T I O N S   A L E A O I R E S  :
<
<
<        ARGUMENT :
<                    (A,B)=POINT COURANT.
<
<
<        RESULTAT :
<                    (A,B)=((MOYENE)+(AMPLI)*F(XS,YS))*(CONTRIBUTION ALEATOIRE)+
<                          (F(SIGMA(NIVEAU(X,Y)))*(CONTRIBUTION DES SPIRALES).
<
<
FONCT:   EQU         $
         PSR         X,Y             < SAUVEGARDES...
<
< FLOTTAGE DU POINT COURANT :
<
         LR          X,A             < COORDONNEE 'X' :
         AD          TRDNX           < TRANSLATION EN 'X' DU GENERATEUR,
         STA         XS
         FLT
         #/FST#      GXS             < COORDONNEE 'XS' DU POINT COURANT.
         LR          Y,A             < COORDONNEE 'Y' :
         AD          TRDNY           < TRANSLATION EN 'Y' DU GENERATEUR,
         STA         YS
         FLT
         #/FST#      GYS             < COORDONNEE 'YS' DU POINT COURANT.
<
< DISCRIMINATION DES
< CONTRIBUTIONS ALEATOIRES
< ET DES SPIRALES :
<
         #/FLD#      PONRDN          < (A,B)=PONDERATION ALEATOIRE :
         FCAZ                        < EXISTE-T'ELLE ???
         JNE         FONCT1          < OUI, ALLONS LA CALCULER...
         BSR         AGOTO
         WORD        FONCT6          < NON, ALLONS VERS LA CONTRIBUTION DES
                                     < SPIRALES, EN NOTANT QUE L'ON A :
                                     < (A,B)=0...
<
<
<        C O N T R I B U T I O N   A L E A T O I R E  :
<
<
FONCT1:  EQU         $
<
<
<        G E N E R A T I O N   D ' U N E   S O M M A T I O N
<        R E C U R S I V E   D E   F O N C T I O N S
<        A L E A T O I R E S   " D E C R O I S S A N T E S "  :
<
<
         #/FLD#      F0
         #/FST#      FCUMR           < INITIALISATION DU CUMUL DES FONCTIONS
                                     < ALEATOIRES SCALANTES...
<
< ITERATION POUR CHAQUE
< FONCTION ALEATOIRE :
<
         STZ         KITER           < INITIALISATION DES RECURSIONS...
         LXI         K               < (X)=INDEX DES RECURSIONS...
FONCT5:  EQU         $
         IC          KITER           < COMPTAGE DES RECURSIONS...
<
< INITIALISATION DU MAILLAGE :
<
         LA          &ALPSIX
         STA         PASIX           < 'PASIX' ENTIER,
         LA          &ALPSIY
         STA         PASIY           < 'PASIY' ENTIER.
         PSR         X
         ADR         X,X             < PASSAGE A UN INDEX FLOTTANT...
         FLD         &ALPASX
         #/FST#      FPASIX          < 'PASIX' FLOTTANT,
         FLD         &ALPASY
         #/FST#      FPASIY          < 'PASIY' FLOTTANT.
         FLD         &ALPOND
         #/FST#      FPOND           < 'FPOND'.
<
< RECHERCHE DU NOEUD
< VOISIN PAR "DEFAUT" :
<
         LA          XS
         SARD        NBITMO
         DV          PASIX
         MP          PASIX
         LR          B,X             < X(NOEUD HAUT-GAUCHE) DE LA MAILLE
                                     < COURANTE,
         LA          YS
         SARD        NBITMO
         DV          PASIY
         MP          PASIY
         LR          B,Y             < Y(NOEUD HAUT-GAUCHE) DE LA MAILLE
                                     < COURANTE.
         LA          XS
         CPR         A,X             < EST-ON EN UN NOEUD ???
         JNE         FONCT3          < NON...
         LA          YS              < PEUT-ETRE :
         CPR         A,Y             < EST-ON EN UN NOEUD ???
         JNE         FONCT3          < NON, INTERPOLONS...
<
< CAS OU LE POINT (XS,YS)
< COURANT EST UN NOEUD :
<
         BSR         ASPRDN          < LE POINT COURANT EST UN NOEUD...
         JMP         FONCT4          < VERS L'ACCES A LA VALEUR DU NOEUD...
<
< CAS OU LE POINT (XS,YS)
< COURANT N'EST PAS UN NOEUD :
<
FONCT3:  EQU         $
         NGR         X,A             < ABSCISSE DU NOEUD "HAUT-GAUCHE"...
         FLT
         FAD         GXS             < X-XNOEUD,
         FDV         FPASIX          < (X-XNOEUD)/PASIX,
         #/FST#      HINCU           < DISTANCE NORMALISEE A 1 LE LONG DE OX,
                                     < DU POINT COURANT AU NOEUD DE LA MAILLE.
         NGR         Y,A             < ORDONNEE DU NOEUD "HAUT-GAUCHE"...
         FLT
         FAD         GYS             < Y-YNOEUD,
         FDV         FPASIY          < (Y-YNOEUD)/PASIY,
         #/FST#      HINCV           < DISTANCE NORMALISEE A 1 LE LONG DE OY,
                                     < DU POINT COURANT AU NOEUD DE LA MAILLE.
         BSR         ASPRDN
         #/FST#      AFNIV1          < NIVEAU(XNOEUD,YNOEUD),
         LA          PASIX
         ADR         A,X
         BSR         ASPRDN
         #/FST#      AFNIV2          < NIVEAU(XNOEUD+PASIX,YNOEUD),
         LA          PASIY
         ADR         A,Y
         BSR         ASPRDN
         #/FST#      AFNIV3          < NIVEAU(XNOEUD+PASIX,YNOEUD+PASIY),
         LA          PASIX
         SBR         A,X
         BSR         ASPRDN
         #/FST#      AFNIV4          < NIVEAU(XNOEUD,YNOEUD+PASIY).
<
< INTERPOLATION ENTRE LES
< QUATRE SOMMETS D'UN CARRE
< PORTANT LES VALEURS (NIV1,
< NIV2,NIV3,NIV4), LES COOR-
< DONNEES DU POINT DANS LE
< CARRE ETANT (HINCU,HINCV) :
<
<
<        NOTA :
<                      ON DOIT INTERPOLER ENTRE
<                    LES NIVEAUX (N1,N2,N3,N4) SUR
<                    LES SOMMETS ((1-U,1-V),(U,1-V),(U,V),(1-U,V)),
<                    CE QUI CONDUIT A CALCULER LA
<                    FORMULE :
<
<                    (1-U)*(1-V)*N1+U*(1-V)*N2+U*V*N3+(1-U)*V*N4,
<
<                    QUI SE REECRIT, EN SUPPOSANT U#0 :
<
<                    (1-V)*((1-U)*N1+U*N2)+V*(U*N3+(1-U)*N4),
<
<                    SOIT :
<
<                    U*(1-V)*(N2+((1-U)/U)*N1)+U*V*(N3+((1-U)/U)*N4),
<
<                    ET ENFIN (SI U#0) :
<
<                    U*((1-V)*(N2+((1-U)/U)*N1)+V*(N3+((1-U)/U)*N4)).
<
<                    OU (SI V#0) :
<
<                    V*((1-U)*(N4+((1-V)/V)*N1)+U*(N3+((1-V)/V)*N2)).
<
         FCMZ        HINCU           < 'U' EST-IL NUL ???
         JNE         FONCT8          < NON, ON PEUT DIVISER PAR LUI...
         FCMZ        HINCV           < 'V' EST-IL NUL ???
         JNE         FONCT9          < NON, ON PEUT DIVISER PAR LUI...
         QUIT        XXQUIT          < E R R E U R   P R O G R A M M E ...
         JMP         FONCT7          < ET ON SORT...
<
< CAS OU 'V' EST NON NUL :
<
FONCT9:  EQU         $
         #/FLD#      F1              < 1,
         FSB         HINCU           < 1-U,
         #/FST#      FWORK1          < W1=1-U.
         #/FLD#      F1              < 1,
         FSB         HINCV           < 1-V,
         FDV         HINCV           < (1-V)/V,
         PSR         A,B             < ET SAVE...
         FMP         AFNIV1          < ((1-V)/V)*N1,
         FAD         AFNIV4          < N4+((1-V)/V)*N1,
         FMP         FWORK1          < (1-U)*(N4+((1-V)/V)*N1,
         #/FST#      FWORK           < ET SAVE...
         PLR         A,B             < (1-V)/V,
         FMP         AFNIV2          < ((1-V)/V)*N2,
         FAD         AFNIV3          < N3+((1-V)/V)*N2,
         FMP         HINCU           < U*(N3+((1-V)/V)*N2),
         FAD         FWORK           < (1-U)*(N4+((1-V)/V)*N1)
                                     < +U*(N3+((1-V)/V)*N2),
         FMP         HINCV           < V*(...).
         JMP         FONCT7          < ET L'INTERPOLATION EST FINIE...
<
< CAS OU 'U' EST NON NUL :
<
FONCT8:  EQU         $
         #/FLD#      F1              < 1,
         FSB         HINCV           < 1-V,
         #/FST#      FWORK1          < W1=1-V.
         #/FLD#      F1              < 1,
         FSB         HINCU           < 1-U,
         FDV         HINCU           < (1-U)/U,
         PSR         A,B             < ET SAVE...
         FMP         AFNIV1          < ((1-U)/U)*N1,
         FAD         AFNIV2          < N2+((1-U)/U)*N1,
         FMP         FWORK1          < (1-V)*(N2+((1-U)/U)*N1,
         #/FST#      FWORK           < ET SAVE...
         PLR         A,B             < (1-U)/U,
         FMP         AFNIV4          < ((1-U)/U)*N4,
         FAD         AFNIV3          < N3+((1-U)/U)*N4,
         FMP         HINCV           < V*(N3+((1-U)/U)*N4),
         FAD         FWORK           < (1-V)*(N2+((1-U)/U)*N1)
                                     < +V*(N3+((1-U)/U)*N4),
         FMP         HINCU           < U*(...).
<
< FIN DE L'INTERPOLATION :
<
FONCT7:  EQU         $
<
< RESTAURATION DE (XS,YS) :
<
FONCT4:  EQU         $
         PLR         X
<
< CALCUL RECURSIF DE LA FONCTION :
<
         FMP         FPOND           < ET ON PONDERE PAR LES 'FPOND'
                                     < AFIN D'OBTENIR DES VALEURS ALEATOIRES
                                     < DECROISSANTES STATISTIQUEMENT...
                                     < NOTA : ON NE DIVISE PLUS PAR 'FPOND0',
                                     < CAR LA DEFINITION DE 'RENORM' INCLUE
                                     < SON INVERSE, ET DONC : FPOND0/FPOND0=1...
         FAD         FCUMR           < QUE L'ON CUMULE,
         #/FST#      FCUMR           < ON A AINSI EN CHAQUE POINT UNE SOMME
                                     < DE FONCTION ALEATOIRE DONT LA FREQUENCE
                                     < AUGMENTE PROGRESSIVEMENT PAR REDUCTION
                                     < DE LA MAILLE, MAIS DONT L'AMPLITUDE
                                     < DIMINUE STATISTIQUEMENT...
<
< PASSAGE A LA COMPOSANTE SUIVANTE :
<
         ADRI        I,X             < PROGRESSION DE L'INDEX DE RECURSION...
         LR          X,A
         CP          NRECUR          < EST-CE FINI ???
         JGE         FONCT2          < OUI, ON ARRETE LA...
         BSR         AGOTO
         WORD        FONCT5          < NON, ON CONTINUE...
FONCT2:  EQU         $
<
< FIN DE RECURSION :
<
         #/FLD#      FCUMR           < ET ON RENVOIE LA SOMME DES
                                     < FONCTIONS ALEATOIRES...
         FDV         RENORM          < ET ON MULTIPLIE PAR 'AMPLI', 'AMPLIR',
                                     < ET ON DIVISE PAR LE SIGMA DES 'FPOND'...
<
< CALCUL FINAL DE LA
< CONTRIBUTION ALEATOIRE :
<
         FAD         MOYENE          < ET TRANSLATION.
         FMP         PONRDN          < ET PONDERATION PAR LA CONTRIBUTION
                                     < ALEATOIRE...
FONCT6:  EQU         $
<
< TEST DE LA CONTRIBUTION
< DES SPIRALES (256,256) :
<
         FCMZ        PONSPI          < LES SPIRALES SONT-ELLES LA ???
         JE          FONCT0          < NON, (A,B) DONNE LA FONCTION...
<
<
<        C O N T R I B U T I O N   D E S   S P I R A L E S  :
<
<
         PSR         A,B             < SAUVEGARDE DE LA CONTRIBUTION ALEATOIRE.
<
< TEST DE LA POSITION
< DU POINT COURANT (XS,YS)
< DE LA MAILLE (512,512)
< PAR RAPPORT A LA MAILLE
< DES SPIRALES 2*(256,256) :
<
         LA          XS              < (A)=ABSCISSE '512',
         SLRS        XC512/NPOL=K
         LR          A,X             < (X)=ABSCISSE '256'.
         JC          FONC01          < ELLE NE "TOMBE PAS JUSTE"...
         LA          YS              < (A)=ORDONNEE '512',
         SB          VECTNL
         NGR         A,A             < EN EFFET, LES AXES 'Y' '512' ET '256'
                                     < SONT INVERSES...
         SLRS        XL512/NLIG=K
         LR          A,Y             < (Y)=ORDONNEE '256'.
         JC          FONC02          < ELLE NE "TOMBE PAS JUSTE", ET LE POINT
                                     < '512' EST SUR SUR UNE HORIZONTALE ENTRE
                                     < DEUX POINTS '256'...
<
< CAS D'UN POINT '512'
< COINCIDANT AVEC UN
< POINT '256' :
<
         BSR         ASPIRL          < (A,B)=SIGMA(NIVEAU(X,Y)).
         FMP         F4              < ET ON LE QUADRUPLE :
                                     < (A,B)=4*SIGMA(NIVEAU(X,Y)).
         JMP         FONC09          < VERS LA SORTIE...
<
< CAS D'UN POINT '512'
< ENTRE DEUX POINTS '256'
< SUR UNE VERTICALE :
<
FONC02:  EQU         $
         BSR         ASPIRL          < (A,B)=SIGMA(NIVEAU(X,Y)),
         #/FST#      FWORK           < ET SAVE...
         ADRI        I,Y
         BSR         ASPIRL          < (A,B)=SIGMA(NIVEAU(X,Y+1)).
         FAD         FWORK           < (A,B)=SIGMA(NIVEAU(X,Y))+
                                     <       SIGMA(NIVEAU(X,Y+1)).
         FMP         F2              < ET ON LE DOUBLE :
                                     < (A,B)=2*(SIGMA(NIVEAU(X,Y))+
                                     <          SIGMA(NIVEAU(X,Y+1))).
         JMP         FONC09          < VERS LA SORTIE...
<
< AUTRES CAS :
<
FONC01:  EQU         $
         LA          YS              < (A)=ORDONNEE '512' :
         SB          VECTNL
         NGR         A,A             < EN EFFET, LES AXES 'Y' '512' ET '256'
                                     < SONT INVERSES...
         SLRS        XL512/NLIG=K
         LR          A,Y             < (Y)=ORDONNEE '256'.
         JC          FONC03          < ELLE NE "TOMBE PAS JUSTE", ET LE POINT
                                     < '512' ET AU CENTRE D'UN CARRE DE QUATRE
                                     < POINTS '256'...
<
< CAS D'UN POINT '512'
< ENTRE DEUX POINTS '256'
< SUR UNE HORIZONTALE :
<
         BSR         ASPIRL          < (A,B)=SIGMA(NIVEAU(X,Y)),
         #/FST#      FWORK           < ET SAVE...
         ADRI        I,X
         BSR         ASPIRL          < (A,B)=SIGMA(NIVEAU(X+1,Y)).
         FAD         FWORK           < (A,B)=SIGMA(NIVEAU(X,Y))+
                                     <       SIGMA(NIVEAU(X+1,Y)).
         FMP         F2              < ET ON LE DOUBLE :
                                     < (A,B)=2*(SIGMA(NIVEAU(X,Y))+
                                     <          SIGMA(NIVEAU(X+1,Y))).
         JMP         FONC09          < VERS LA SORTIE...
<
< CAS D'UN POINT '512' AU
< CENTRE D'UN CARRE FAIT
< DE QUATRE POINTS '256' :
<
FONC03:  EQU         $
         BSR         ASPIRL          < (A,B)=SIGMA(NIVEAU(X,Y)),
         #/FST#      FWORK1
         ADRI        I,X
         BSR         ASPIRL          < (A,B)=SIGMA(NIVEAU(X+1,Y)),
         #/FST#      FWORK2
         ADRI        I,Y
         BSR         ASPIRL          < (A,B)=SIGMA(NIVEAU(X+1,Y+1)),
         #/FST#      FWORK
         ADRI        -I,X
         BSR         ASPIRL          < (A,B)=SIGMA(NIVEAU(X,Y+1)).
         FAD         FWORK
         FAD         FWORK2
         FAD         FWORK1          < (A,B)=SIGMA(NIVEAU(X,Y))+
                                     <       SIGMA(NIVEAU(X+1,Y))+
                                     <       SIGMA(NIVEAU(X+1,Y+1))+
                                     <       SIGMA(NIVEAU(X,Y+1)).
<
< PONDERATION "SPIRALE" :
<
FONC09:  EQU         $
         FMP         PONSPI          < ET CONTRIBUTION DES SPIRALES...
<
<
<        C A L C U L   D E   L A   F O N C T I O N   C O U R A N T E  :
<
<
         #/FST#      FWORK           < SAUVEGARDE TEMPORAIRE...
         PLR         A,B             < (A,B)=CONTRIBUTION ALEATOIRE,
         FAD         FWORK           < (A,B)=CONTRIBUTION ALEATOIRE+
                                     <       CONTRIBUTION DES SPIRALES.
FONCT0:  EQU         $
<
< PONDERATION :
<
         FMP         PONFRA
<
< RETOUR :
<
         PLR         X,Y
         RSR
         PAGE
<
<
<        G E N E R A T I O N   D U   C H A M P   F ( R H O , T E T A )  :
<
<
<        DEFINITION :
<                      LE CHAMP F(RHO,TETA) CONTIENT TROIS
<                    COMPOSANTES : LA PREMIERE CORRESPOND
<                    A UNE SPIRALE A 'A21' BRANCHES, LA
<                    SECONDE A UNE TACHE GAUSSIENNE CENTREE,
<                    ET ENFIN, LA TROISIEME A UN NIVEAU
<                    CONSTANT ; ON A :
<
<        F(RHO,TETA)=A0*(A1*((A11+A12*SIN(A21*TETA+A22*EXP(A31*RHO)+A23))/A13
<                        A2*EXP(A41*RHO*RHO)+
<                        A3),
<                    OU EN FAIT LA FONCTION SIN(ALPHA) EST :
<        SIN(ALPHA) =(1-R1)*1+R1*SIN(ALPHA),
<                    OU 'R1' DESIGNE LE 'RHO' DANS (0,1)...
<
<                    PUIS :
<
<        F(RHO,TETA)=A50*(F(RHO,TETA)**NEXP),
<
<                      ON NOTERA QUE LA PHASE DE L'ANGLE
<                    'TETA' EST UNE FONCTION DU TYPE "SPIRALE
<                    LOGARITHMIQUE", ET DONC INDUIT LA
<                    STRUCTURE SPIRALEE.
<
<
<        ARGUMENT :
<                    (X,Y)=POINT COURANT.
<
<
<        RESULTAT :
<                    (CHAMP)=VALEUR DU CHAMP EN (X,Y)...
<
<
FIELD:   EQU         $
         PSR         X,Y
<
< PASSAGE AUX COORDONNEES CENTREES :
<
         LR          X,A             < ABSCISSE :
         FLT
         FSB         XCENTR
         #/FST#      ZR              < ABSCISSE FLOTTANTE CENTREE...
         LR          Y,A             < ORDONNEE :
         FLT
         FSB         YCENTR
         #/FST#      ZI              < ORDONNEE FLOTTANTE CENTREE...
<
< CALCUL DU RAYON POLAIRE :
<
         FMP         ZI              < ZI**2,
         #/FST#      FWORK
         #/FLD#      ZR              < ZR,
         FMP         ZR              < ZR**2,
         FAD         FWORK           < ZR**2+ZI**2,
         BSR         ARAC
         #/FST#      RHO             < RAYON POLAIRE (RHO).
         FDV         DIAMET          < ET ON LE NORMALISE :
         FCAM        F1
         JLE         GEN86
         FLD         F1              < ON SEUIL...
GEN86:   EQU         $
         #/FST#      RHO1            < RHO1=RHO DANS (0,1).
<
< CALCUL DE L'ANGLE POLAIRE :
<
         FCMZ        ZR              < LA TANGENTE NE SERAIT-ELLE PAS INFINIE ??
         JNE         GEN81           < NON...
         #/FLD#      ATGPS2          < OUI, L'ARGUMENT VAUT DONC +/- PI/2.
         FCMZ        ZI              < "+" OU "-" ???
         JGE         GEN82           < +PI/2.
         FNEG                        < -PI/2,
         FAD         DEUXPI          < OU 3*PI/2...
         JMP         GEN82           < VERS LE CALCUL DU NIVEAU...
GEN81:   EQU         $
         #/FLD#      ZI              < 'ZR' N'EST PAS NUL,
         FDV         ZR              < ON CALCULE DONC LA TANGENTE DE L'ARGUMENT
         FABS                        < AFIN DE CALCULER L'ARC-TANGENTE DANS
                                     < LE SEGMENT (0,PI/2)...
         BSR         AARCTG          < PUIS L'ARC-TANGENTE.
         FCMZ        ZR
         JGE         GEN83
         FCMZ        ZI
         JGE         GEN84
         FAD         PI              < ZR<0 ET ZI<0   : PI+ARCTG...
         JMP         GEN89
GEN84:   EQU         $
         FSB         PI
         FNEG                        < ZR<0 ET ZI>=0  : PI-ARCTG...
         JMP         GEN89
GEN83:   EQU         $
         FCMZ        ZI
         JGE         GEN85
         FSB         DEUXPI
         FNEG                        < ZR>=0 ET ZI<0  : 2*PI-ARCTG...
         JMP         GEN89
GEN85:   EQU         $               < ZR>=0 ET ZI>=0 : ARCTG...
GEN89:   EQU         $
GEN82:   EQU         $
         #/FST#      TETA            < ANGLE POLAIRE (TETA).
<
< CALCUL DE LA PHASE "SPIRALEE" :
<
         #/FLD#      RHO             < RHO,
         FMP         FA31            < A31*RHO,
         BSR         AEXP            < EXP(A31*RHO),
         FMP         FA22            < A22*EXP(A31*RHO).
<
< CALCUL DE L'ANGLE :
<
         FAD         FA23            < A22*EXP(A31*RHO)+A23,
         #/FST#      FWORK
         #/FLD#      TETA            < TETA,
         FMP         FA21            < A21*TETA,
         FAD         FWORK           < A21*TETA+A22*EXP(A31*RHO)+A23, ANGLE
                                     < QUE L'ON VA NOTER 'ALPHA'.
<
< CALCUL DE LA CONTRIBUTION
< "SPIRALEE" :
<
         BSR         ASIN            < SIN(ALPHA),
         FMP         RHO1            < R1*SIN(ALPHA),
         FAD         F1              < 1+R1*SIN(ALPHA),
         FSB         RHO1            < (1-R1)*1+R1*SIN(ALPHA), ET AINSI ON
                                     < ELIMINE LE POINT CRITIQUE AU CENTRE DE
                                     < LA SPIRALE.
         FMP         FA12            < A12*SIN(ALPHA),
         FAD         FA11            < A11+A12*SIN(ALPHA),
         FDV         FA13            < (A11+A12*SIN(ALPHA))/A13,
         FMP         FA1             < A1*(A11+A12*SIN(ALPHA))/A13, QUE L'ON
                                     < VA NOTER "SPIRALE".
         #/FST#      FWORK
<
< CALCUL DE LA CONTRIBUTION
< "GAUSSIENNE" :
<
         #/FLD#      RHO             < RHO,
         FMP         RHO             < RHO*RHO,
         FMP         FA41            < A41*RHO*RHO,
         BSR         AEXP            < EXP(A41*RHO*RHO),
         FMP         FA2             < A2*EXP(A41*RHO*RHO), QUE L'ON
                                     < NOTE "GAUSS".
<
< CALCUL DU CHAMP F(RHO,TETA) :
<
         FAD         FWORK           < SPIRALE+GAUSS,
         FAD         FA3             < SPIRALE+GAUSS+A3,
         FMP         FA0             < A0*(SPIRALE+GAUSS+A3),
<
< ACCENTUATION DES MAXIMA :
<
         #/FST#      FWORK           < SAVE F(RHO,TETA),
         #/FLD#      F1              < INITIALISATION DU CUMUL,
         LX          NEXP            < (X)=EXPOSANT,
GEN87:   EQU         $
         FMP         FWORK           < ET CALCUL DE F(RHO,TETA)**NEXP...
         JDX         GEN87
         FMP         FA50            < A50*((A0*(SPIRALE+GAUSS+A3))**NEXP).
<
< PONDERATION :
<
         FMP         PONGAL
         #/FST#      CHAMP           < CE QUI DONNE LE CHAMP...
<
< RETOUR :
<
         PLR         X,Y             < RESTAURATIONS DES COORDONNEES...
         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
<
<
<        C A L C U L   D E   L A   F O N C T I O N   ' A R C T G '  :
<
<
<        ARGUMENT:
<                    (A,B)=VALEUR ARGUMENT.
<
<
<        RESULTAT:
<                    (A,B)='ARCTG' DE L'ARGUMENT EN RADIANS.
<
<
ARCTG:   EQU         $
<
< SAUVEGARDES ET INITIALISATIONS.
<
         PSR         X,L
         STZ         ATGSDX          < ARGUMENT 'X' POSITIF OU NUL A PRIORI.
         FCAZ
         JGE         ARCTG1
         DC          ATGSDX          < ARGUMENT 'X' NEGATIF.
ARCTG1:  EQU         $
         FABS                        < U = ABS(X).
         FCAM        ATGUN
         JGE         ARCTG2
<
< U < 1 : J RECOIT 0.
<
         LXI         K
         JMP         ARCTG3
ARCTG2:  EQU         $
<
< U >= 1 : J RECOIT 2 ET U RECOIT 1/U.
<
         LXI         W+W             < J = 2.
         FST         ATGT1
         FLD         ATGUN
         FDV         ATGT1           < U = 1/U.
ARCTG3:  EQU         $
         FCAM        ATGPSC          < COMPARER U A TG(PI/12).
         JG          ARCTG4
<
< U <= TG(PI/12) : J RECOIT J+2.
<
         ADRI        I+I,X           < J = J + 2.
         JMP         ARCTG5
ARCTG4:  EQU         $
<
< U > TG(PI/12) : J RECOIT J+1 ET
< U RECOIT  (U * RACINE(3) - 1) / (RACINE(3) + U).
<
         ADRI        I,X             < J = J + 1.
         FST         ATGT1
         FMP         ATGR3
         FSB         ATGUN
         PSR         A,B
         FLD         ATGR3
         FAD         ATGT1
         FST         ATGT1
         PLR         A,B
         FDV         ATGT1           < U=(U*RACINE(3)-1)/(RACINE(3)+U).
ARCTG5:  EQU         $
<
< FORMER Y = U * P(U ** 2) LES COEFFICIENTS DU POLYNOME ETANT ATGP1, ATGP2
< ATGP3 ET ATGP4. ON CALCULE :
< Y = U * (P1 - P2 * U ** 2 + (P3 / (P4 + U ** 2)).
<
         FST         ATGT1           < TRAV1 = U.
         FMP         ATGT1
         FST         ATGT3           < TRAV3 = U ** 2.
         FAD         ATGP4
         FST         ATGT2
         FLD         ATGP3
         FDV         ATGT2
         FAD         ATGP1
         PSR         A,B
         FLD         ATGP2
         FMP         ATGT3
         FST         ATGT3
         PLR         A,B
         FSB         ATGT3           < Y = P(U ** 2).
         FMP         ATGT1           < Y = U * P( U ** 2).
         FST         ATGT1           < TRAV1 = U * P (U ** 2).
<
< BRANCHEMENT SELON VALEUR DE J (REGISTRE 'X').
<
         ADRI        -I-I,X
         CPZR        X
         JE          ARCTG6
         JL          ARCTG7
         ADRI        -I,X
         CPZR        X
         JE          ARCTG8
<
< FAIRE Y = PI / 2 - Y.
<
         FLD         ATGPS2
         JMP         ARCTG9
ARCTG8:  EQU         $
<
< FAIRE Y = PI / 3 - Y.
<
         FLD         ATGPS3
ARCTG9:  EQU         $
         FSB         ATGT1           < - Y.
         JMP         ARCTG6
ARCTG7:  EQU         $
<
< FAIRE Y = PI / 6 + Y.
<
         FAD         ATGPS6
ARCTG6:  EQU         $
<
< AFFECTER A Y LE SIGNE DU X ARGUMENT.
<
         CPZ         ATGSDX          < SIGNE DU X ARGUMENT.
         JL          ARCTGA
<
< X ARGUMENT POSITIF OU NUL, IL FAUT QUE Y LE SOIT.
<
         FCAZ
         JGE         ARCTGB
         FNEG
         JMP         ARCTGB
ARCTGA:  EQU         $
<
< X ARGUMENT NEGATIF, IL FAUT QUE Y LE SOIT.
<
         FCAZ
         JL          ARCTGB
         FNEG
ARCTGB:  EQU         $
<
< RESTAURATIONS ET FIN...
<
         PLR         X,L
         RSR
         PAGE
<
<
<        E X P O N E N T I E L L E  :
<
<
EXPON:   EQU         $
         PSR         Y
         STZ         SIGNE           < "+" A PRIORI...
         JMP         EXP             < VERS LE CALCUL DE L'EXPONENTIELLE...
         PAGE
<
<
<        C A L C U L   D ' U N E   P U I S S A N C E
<        Q U E L C O N Q U E   R E E L L E   ' P '  :
<
<
<        ARGUMENT :
<                    (A,B)=NOMBRE 'N' ARGUMENT,
<
<
<        RESULTAT :
<                    (A,B)='N' A LA PUISSANCE P.
<
<
RAK:     EQU         $
         PSR         Y
<
<
<        L O G   N E P E R I E N  :
<
<
LOGN:    EQU         $
         STZ         SIGNE           < =0 : SIGNE "+" A PRIORI...
         FCAZ
         JGE         LOGN1           < POSITIF...
         IC          SIGNE           < =1 : SIGNE "-"...
LOGN1:   EQU         $
         LR          A,Y
         FABS
         ANDI        XXMASK
         #/FST#      POLLO3
         FAD         POLLO4
         #/FST#      POLLO2
         LR          Y,A
         SWBR        A
         SARS        XXMASK=K
         FLT
         #/FST#      POLLO1
         #/FLD#      POLLO3
         FSB         POLLO4
         FDV         POLLO2
         #/FST#      POLLO3
         FMP         POLLO3
         FNEG
         FAD         POLLO7
         #/FST#      POLLO2
         #/FLD#      POLLO6
         FDV         POLLO2
         FAD         POLLO5
         FMP         POLLO3
         FSB         POLLO8
         FAD         POLLO1
         FMP         POLLO9
<
<
<        G E S T I O N   D U   S I G N E   D E   L ' E X P O S A N T  :
<
<
         PSR         A,B             < SAVE LE 'LOG'...
         #/FLD#      EXPOP
         FABS
         BSR         AROND           < ON PREND LA PARTIE ENTIERE (PAR EXCES
                                     < OU PAR DEFAUT) DE LA VALEUR ABSOLUE DE
                                     < L'EXPOSANT...
         TBT         NBITMO-B        < QUELLE EST SA PARITE ???
         JC          RAK1            < IMPAIRE, 'SIGNE' RESTE TEL QUEL...
         STZ         SIGNE           < PAIRE : ON FORCE "+" (SIGNE INCHANGE)...
RAK1:    EQU         $
         PLR         A,B             < RESTAURATION DU LOG,
         FMP         EXPOP           < ET ON CALCULE P*LOG...
<
<
<        E X P O N E N T I E L L E  :
<
<
EXP:     EQU         $
         FMP         POLEX4
         #/FST#      POLEX3
         FIX
         STA         POLEX5
         FLT
         FCAM        POLEX3
         JNV         EXPON3
         #/FLD#      POLEX6
         #/FST#      POLEX3
         JMP         EXPON5
EXPON3:  EQU         $
         CPZ         POLEX3
         JGE         EXPON4
         DC          POLEX5
         LA          POLEX5
         FLT
EXPON4:  EQU         $
         FSB         POLEX3
         FNEG
         #/FST#      POLEX2
         FMP         POLEX2
         #/FST#      POLEX1
         FAD         POLEX8
         #/FST#      POLEX3
         #/FLD#      POLEY0
         FDV         POLEX3
         FAD         POLEX1
         FMP         POLEX9
         FAD         POLEY1
         FSB         POLEX2
         #/FST#      POLEX3
         #/FLD#      POLEX7
         FMP         POLEX2
         FDV         POLEX3
         FAD         POLEX6
         #/FST#      POLEX3
EXPON5:  EQU         $
         SWBR        A
         SARS        XXMASK=K
         AD          POLEX5
         CPI         XX7F
         JG          $               < E R R E U R   P R O G R A M M E ...
         CPI         XX80
         JGE         EXPON6
         #/FLD#      F0              < ON PREND LE MINIMUM...
         JMP         EXPON7
EXPON6:  EQU         $
XWOR%1:  VAL         XXMASK=K
XWOR%1:  VAL         -XWOR%1
         ANDI        XXMASK>XWOR%1
         STA         POLEX5
         LA          POLEX3
         ANDI        XXMASK
         AD          POLEX5
EXPON7:  EQU         $
         CPZ         SIGNE           < PRISE EN COMPTE DU SIGNE SIMULE :
         JE          EXP1            < POSITIF, ON LAISSE LE RESULTAT TEL QUEL..
         FNEG                        < NEGATIF, ON INVERSE...
EXP1:    EQU         $
         BSR         ATSFLO
         PLR         Y
         RSR
         PAGE
<
<
<        C A L C U L   D ' U N E   I N T E N S I T E   L U M I N E U S E  :
<
<
<        FONCTION :
<                      ETANT DONNE LE POINT COURANT,
<                    ET SA NORMALE, CE SOUS-PROGRAM-
<                    ME CALCULE EN FONCTION DE LA
<                    SOURCE LUMINEUSE L'INTENSITE
<                    A ATTRIBUER AU POINT COURANT.
<
<
<        ARGUMENTS :
<                    (X)=COORDONNEE 'X' (PERMET D'INDEXER LE 'Z'...),
<                    (FXN,FYN,FZN)=COORDONNEES DU VECTEUR NORMAL,
<                    (FXL,FYL,FZL)=COORDONNEES DE LA SOURCE LUMINEUSE.
<
<
<        RESULTAT :
<                    (A,B)=INTENSITE LUMINEUSE.
<
<
INTEN:   EQU         $
<
< INITIALISATIONS :
<
         PSR         X               < SAUVEGARDE DE LA COORDONNEE 'X'...
         ADR         X,X             < ET PASSAGE A UN INDEX FLOTTANT...
<
< NORME DE LA NORMALE :
<
         LRM         A,B
         WORD        CN3D            < (A)=ADRESSE DE LA NORMALE,
         WORD        CN3D            < (B)=ADRESSE DE LA NORMALE,
         BSR         APRSCA          < ET CALCUL DU CARRE DE SA NORME,
         #/FST#      FWORK1          < (FWORK1)=NORME(X(N),Y(N),Z(N))**2,
<
< RECHERCHE DE Z(A) :
<
         FLD         &ALIG           < Z(A),
         PLR         X               < (X)=COORDONNEE 'X'...
<
< CALCUL DU RAYON LUMINEUX :
<
         FSB         FZL             < Z(A)-Z(L),
         FNEG
         #/FST#      FZS             < (FZS)=Z(L)-Z(A).
         LR          Y,A             < Y(A),
         FLT
         FSB         FYL             < Y(A)-Y(L),
         FNEG
         #/FST#      FYS             < (FYS)=Y(L)-Y(A).
         LR          X,A             < X(A),
         FLT
         FSB         FXL             < X(A)-X(L),
         FNEG
         #/FST#      FXS             < (FXS)=X(L)-X(A).
<
< NORME DU RAYON LUMINEUX :
<
         LRM         A,B
         WORD        CS3D            < (A)=ADRESSE DU RAYON LUMINEUX,
         WORD        CS3D            < (B)=ADRESSE DU RAYON LUMINEUX,
         BSR         APRSCA          < ET CALCUL DU CARRE DE SA NORME,
         FMP         FWORK1          < CALCUL DU CARRE DU PRODUIT DU MODULE
                                     < DE LA NORMALE ET DU RAYON LUMINEUX,
         BSR         ARAC
         #/FST#      FWORK1          < (FWORK1)=PRODUIT DE LA NORME DE LA NOR-
                                     <          MALE ET DE LA NORME DU RAYON
                                     <          LUMINEUX.
<
< CALCUL DE L'ANGLE ENTRE LE
< NORMALE ET LE RAYON LUMINEUX :
<
         LRM         A,B
         WORD        CN3D            < (A)=ADRESSE DE LA NORMALE,
         WORD        CS3D            < (B)=ADRESSE DU RAYON LUMINEUX,
         BSR         APRSCA          < (A,B)=PRODUIT SCALAIRE DE LA NORMALE,
                                     <       ET DU RAYON LUMINEUX,
         FDV         FWORK1          < (A,B)=COS(TETA), OU 'TETA' DESIGNE
                                     <       L'ANGLE ENTRE LA NORMALE ET LE
                                     <       RAYON LUMINEUX.
<
< CALCUL DE L'INTENSITE
< LUMINEUSE AU POINT COURANT :
<
         FAD         F1              < (A,B)=1+COS(TETA),
         FMP         F05             < (A,B)=(1+COS(TETA))/2,
                                     <       SOIT UN NOMBRE DANS (0,1)...
         FMP         FNIVC           < (A,B)=NIVEAU FLOTTANT A DONNER AU POINT
                                     <       COURANT.
         FCAM        FNIVBA          < NE VA-T'ON PAS CREER UN POINT NOIR ???
         JGE         GEN33           < NON, OK...
         #/FLD#      FNIVBA          < OUI, ON LE "SATURE"...
GEN33:   EQU         $
<
< ET RETOUR :
<
         BSR         ATSFLO
         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',
         WORD        LOC+DEPBAS      < POSITIONNEMENT 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'...
<
<
<        E N T R Y   D E   R E B O U C L A G E  :
<
<
DEBUT4:  EQU         $
<
< MODIFICATION A PRIORI DU 'PRESC' :
<
         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'...).
<
< INITIALISATION DU GESTIONNAIRE
< DE BANDES MAGNETIQUES (A PRIORI) :
<
         LA          ABLOC0
         JAL         INIT20          < ON FERA DU SEQUENTIEL STRICT...
         STA         DEMMT+ARGESC    < ADRESSE DU PREMIER BLOC A LIRE,
INIT20:  EQU         $
         STZ         IBUFMT          < POUR FORCER LA PREMIERE LECTURE...
<
< INITIALISATION DES
< DIFFERENTS BUFFERS :
<
         LX          VECTNC          < (X)=INDEX DES INITIALISATIONS...
         ADR         X,X             < PASSAGE A UN INDEX FLOTTANT...
         IF          DFLOT-W-W,,XEIF%,
         IF          ATTENTION : CE QUI PRECEDE EST IDIOT !!!
XEIF%:   VAL         ENDIF
         #/FLD#      F0              < (A,B)=VALEUR D'INITIALISATION DES
                                     <       BUFFERS DE LIGNE...
INIT02:  EQU         $
         FST         &ALIGP2         < INITIALISATION
         FST         &ALIGP1         <                DES
         FST         &ALIG           <                    BUFFERS
         FST         &ALIGM1         <                            DE LIGNE...
         ADRI        -I*DFLOT,X      < ET REGRESSION,
         CPZR        X               < EST-CE FINI ???
         JGE         INIT02          < NON...
<
<
<        I N I T I A L I S A T I O N S  :
<
<
INIT01:  EQU         $
<
< GENERATEUR ALEATOIRE :
<
         LA          SUPRDN
         FLT
         #/FST#      FSUP            < BORNE SUPERIEURE ('SUP'),
         LA          INFRDN
         FLT
         #/FST#      FINF            < BORNE INFERIEURE ('INF'),
         FDV         FSUP            < INF/SUP,
         PSR         A,B             < ET SAVE...
         FSB         F1              < (INF/SUP)-1,
         FNEG                        < 1-(INF/SUP),
         #/FST#      UNMIS           < UNMIS=1-(INF/SUP).
         PLR         A,B             < INF/SUP,
         FAD         F1              < 1+(INF/SUP),
         FMP         INF32           < 32768*(1+(INF/SUP)),
         #/FST#      UNPIS           < UNPIS=32768*(1+(INF/SUP)).
         #/FLD#      FSUP            < SUP,
         FDV         INF64           < SUP/65536,
         #/FST#      SUP64           < SUP64=SUP/65536.
<
< INITIALISATION DES
< CALCULS DE SPIRALES :
<
         LA          NPM
         FLT
         #/FST#      FNPM            < FLOTTAGE DE 'NPM'...
<
< PAS INITIAUX DU MAILLAGE :
<
         LA          PASIX0          < VALEUR INITIALE DE 'PASIX' :
         JALE        $               < ???
         STA         PASIX           < PAS EN 'X',
         FLT
         #/FST#      FWORK           < ET SAUVEGARDE...
         LA          PASIY0          < VALEUR INITIALE DE 'PASIY' :
         JALE        $               < ???
         STA         PASIY           < ET PAS EN 'Y'...
         FLT
         FMP         FWORK           < CALCUL DE PASIX*PASIY*K*K CE QUI DONNE
                                     < L'AIRE DE LA MAILLE ELEMENTAIRE...
         BSR         ARAC
         #/FST#      FPOND0          < LA PONDERATION INITIALE DES FONCTIONS
                                     < ALEATOIRES EST EN FAIT LA TAILLE DE LA
                                     < MAILLE...
<
< VALIDATION DES DEMANDES
< D'OMBRES PORTEES :
<
         IF          NEXIST-K,,XEIF%,
         IF          ATTENTION : LE TEST SUIVANT EST MAUVAIS !!!
XEIF%:   VAL         ENDIF
         CPZ         IOMBRE          < A-T'ON DEMANDE LES OMBRES PORTEES ???
         JE          GEN500          < NON, RIEN A VALIDER...
GEN501:  EQU         $
         FCMZ        FYL             < OUI, DANS CE CAS, ON FAIT LES HYPOTHESES
                                     < SUIVANTES :
                                     < 1 - ON TRACE DE DROITE A GAUCHE,
                                     < 2 - LA SOURCE LUMINEUSE 'S' EST A DROITE
                                     < DE LA MONTAGNE (XL > XMAX), PUISQU'ON
                                     < TRACE DE DROITE A GAUCHE, ET DANS LE
                                     < PLAN DE PROJECTION (YL=0) POUR SIMPLIFIER
                                     < LES CALCULS (EN FAIT ON VA MEME LA SUP-
                                     < POSER A L'INFINI, EN IGNORANT SZLTEMATI-
                                     < QUEMENT LA TROISIEME COORDONNEE DU RAYON
                                     < LUMINEUX...).
         JNE         GEN502          < ERREUR : 'YL' EST NON NUL !!!
         #/FLD#      FXL
         BSR         AROND
         CP          VECTNC
         JG          GEN500          < OK, LA SOURCE LUMINEUSE EST A DROITE DE
                                     < LA MONTAGNE...
GEN502:  EQU         $
         QUIT        XXQUIT          < ERREUR SUR LA SOURCE LUMINEUSE, ON
                                     < REDEMANDE LES PARAMETRES...
         JMP         GEN501          < ET ON REVALIDE...
GEN500:  EQU         $
         #/FLD#      FNIVMX
         #/FST#      FNIVC           < ON INITIALISE A PRIORI 'FNIVC' POUR
                                     < LE CAS OU L'OMBRAGE N'EST PAS DEMANDE...
GEN541:  EQU         $
         LA          NPENOM          < (A)=LARGEUR DE LA ZONE DE PENOMBRE :
         JAG         GEN540          < OK, ELLE EST STRICTEMENT POSITIVE...
         QUIT        XXQUIT          < E R R E U R ...
         JMP         GEN541          < ET ON RE-VALIDE...
GEN540:  EQU         $
         FLT
         FDV         FNIVOM
         #/FST#      FPENOM          < FPENOM=NPENOM/FNIVOM.
<
<
<        I N I T I A L I S A T I O N   D E S   M A I L L A G E S  :
<
<
GEN200:  EQU         $
         LA          MRECUR          < VALIDATION DE 'MRECUR' :
         JALE        GEN201          < MAUVAIS...
         CPI         MAXREC          < ALORS ???
         JLE         GEN202          < OK...
GEN201:  EQU         $
         QUIT        XXQUIT          < E R R E U R   U T I L I S A T E U R ...
         JMP         GEN200          < ET ON RE-VALIDE...
GEN202:  EQU         $
<
< INITIALISATIONS :
<
         LA          PASIX
         FLT
         #/FST#      FPASIX          < 'PASIX',
         LA          PASIY
         FLT
         #/FST#      FPASIY          < 'PASIY'.
         #/FLD#      FPOND0
         #/FST#      FPOND           < 'FPOND'.
<
< REDUCTION RECURSIVE DU MAILLAGE :
<
         LXI         K               < (X)=INDEX DE RECURSION...
GEN210:  EQU         $
         PSR         X
         LR          X,Y             < (Y)=INDEX ENTIER,
         ADR         X,X             < PASSAGE A UN INDEX FLOTTANT...
         #/FLD#      FPOND
         FST         &ALPOND         < 'LPOND',
         BSR         ARAK            < EXPONENTIATION,
         #/FST#      FPOND           < ET REDUCTION...
         #/FLD#      FPASIX
         FST         &ALPASX         < 'PASIX' FLOTTANT,
         PSR         A,B,X
         LR          Y,X
         BSR         AROND
         STA         &ALPSIX         < 'PASIX' ENTIER.
         PLR         A,B,X
         BSR         ARAK            < EXPONENTIATION,
         #/FST#      FPASIX          < ET REDUCTION...
         #/FLD#      FPASIY
         FST         &ALPASY         < 'PASIY' FLOTTANT,
         PSR         A,B,X
         LR          Y,X
         BSR         AROND
         STA         &ALPSIY         < 'PASIY' ENTIER.
         PLR         A,B,X
         BSR         ARAK            < EXPONENTIATION,
         #/FST#      FPASIY          < ET REDUCTION...
         FAD         FPASIX
         BSR         AROND           < (A)=PASIX+PASIY,
         PLR         X               < RESTAURE L'INDEX DE RECURSION...
         ADRI        I,X             < PASSAGE A LA RECURSION SUIVANTE...
         CPI         W+W             < EST-ON ARRIVE A UNE MAILLE IRREDUCTIBLE,
                                     < SOIT ELEMENTAIRE (1*1) ???
         JE          GEN220          < OUI, ON ARRETE LA...
         LR          X,A             < NON,
         CP          MRECUR          < MAIS A-T'ON ATTEINT LE MAXIMUM ???
         JL          GEN210          < NON, ON CONTINUE...
GEN220:  EQU         $
         STX         NRECUR          < MISE EN PLACE DU 'NRECUR' A UTILISER...
<
< CALCUL DU FACTEUR DE
< RENORMALISATION DE LA
< FONCTION ALEATOIRE :
<
         LR          X,A             < (A)='NRECUR',
         FLT                         < QUE L'ON FLOTTE...
         FAD         KAMPLI
         FSB         F1
         FDV         KAMPLI
         #/FST#      AMPLI           < (AMPLI)=(NRECUR+30)/31...
         #/FLD#      F0              < INITIALISATION DU SIGMA DES 'FPOND',
GEN410:  EQU         $
         PSR         X
         ADRI        -IJIJDX,X
         ADR         X,X             < PASSAGE A UN INDEX FLOTTANT...
         FAD         &ALPOND         < CALCUL DE SIGMA(FPOND),
         PLR         X
         JDX         GEN410          < AU SUIVANT...
         FDV         AMPLI
         FDV         AMPLIR
         #/FST#      RENORM          < RENORM=SIGMA(FPOND)/(AMPLI*AMPLIR).
<
< POUR NORMALISER 'RHO' :
<
         #/FLD#      XCENTR
         FMP         XCENTR
         #/FST#      FWORK
         #/FLD#      YCENTR
         FMP         YCENTR
         FAD         FWORK
         BSR         ARAC
         #/FST#      DIAMET          < LA CONSTANTE DE NORMALISATION DU RAYOON
                                     < POLAIRE 'RHO' EST D(O,C)...
<
<
<        G E N E R A T I O N   D E   L ' I M A G E  :
<
<
GEN69:   EQU         $
         CPZ         IERASE          < FAUT-IL EFFACER ???
         JE          GEN69N          < NON...
         IF          NEXIST-K,,XEIF%,
         IF          ATTENTION : LE TEST CI-DESSUS EST IDIOT !!!
XEIF%:   VAL         ENDIF
<
< EFFACEMENT DE L'ECRAN :
<
XWOR%1:  VAL         NIV256=K
         IF          BIT>XWOR%1-NIV256,,XWOR%,
         IF          ATTENTION : LE CALCUL DU MASQUE SELECTANT TOUS
         IF          LES PLANS EST ABSURDE !!!
XWOR%:   VAL         ENDIF
         LAI         NIV256-MASK)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...
         LAD         TEMPO
         SVC                         < ET ON FAIT UN PETIT DODO...
         LAI         XCTRL1
         STA         MCDAJ
         LA          ACTRL1
         BSR         APWCDA          < INITIALISATION DE 'CTRL1'.
         LAI         XCTRL2
         STA         MCDAJ
         LA          ACTRL2
         BSR         APWCDA          < INITIALISATION DE 'CTRL2'.
<
< INITIALISATION DES
< CONDITIONS DE TRACE :
<
GEN69N:  EQU         $
<
<
<        G E N E R A T I O N   D U   C H A M P   A L E A T O I R E  :
<
<
         LYI         K               < (Y)=COORDONNEE 'Y'.
GEN01:   EQU         $
         LXI         K               < (X)=COORDONNEE 'X'.
GEN02:   EQU         $
         BSR         AFIELD          < CALCUL DANS 'CHAMP' DU CHAMP GALACTIQUE
                                     < PONDERE.
         BSR         AFONCT          < CALCUL DANS (A,B) DE LA SOMME
                                     < PONDEREE DES FONCTIONS ALEATOIRES,
                                     < ASSOCIEE AU POINT COURANT (X,Y)
                                     < SANS OUBLIER LA CONTRIBUTION DES
                                     < SPIRALES...
         FAD         CHAMP           < SOMMATION DU CHAMP GALACTIQUE ET DU
                                     < CHMAP FRACTAL.
         IF          DFLOT-XXXMOY,,XEIF%,
         IF          ATTENTION : LES 'ADR' VONT MERDER !!!
XEIF%:   VAL         ENDIF
         PSR         X
         ADR         X,X             < PASSAGE A UNE INDEX FLOTTANT...
         FST         &ALIGP2         < ET ON MEMORISE Z(X,Y) DANS LA LIGNE
                                     < SUIVANTE-SUIVANTE...
         PLR         X
         ADRI        I,X             < PROGRESSION SUR LA LIGNE :
         LR          X,A
         CP          VECTNC          < EST-ON AU BOUT ???
         JLE         GEN02           < NON...
<
<
<        T E N T A T I V E   D ' E L I M I N A T I O N
<        D E S   P I C S   P A R   F I L T R A G E  :
<
<
<        FONCTION :
<                      CONSIDERONS 3 POINTS SUC-
<                    CESSIFS : A(X-I), M(X), B(X+I).
<                    POUR CHAQUE POINT M(X), ON VA
<                    TESTER :
<
<                    SI : Z(M(X)) > Z(A(X-I)) ET Z(M(X)) > Z(B(X+I)),
<                    ALORS : Z(M(X)) <-- ALPHA*(Z(A(X-I))+Z(B(X+I)))/2+
<                                        (1-ALPHA)*Z(M(X)),
<
<                      PUIS, CONSIDERONS 3 POINTS SUC-
<                    CESSIFS : A(Y), M(Y+I), B(Y+I+I).
<                    POUR CHAQUE POINT M(Y+I), ON VA
<                    TESTER :
<
<                    SI : Z(M(Y+I)) > Z(A(Y)) ET Z(M(Y+I)) > Z(B(Y+I+I)),
<                    ALORS : Z(M(Y+I)) <-- ALPHA*(Z(A(Y))+Z(B(Y+I+I)))/2+
<                                          (1-ALPHA)*Z(M(Y+I)),
<
<                    C'EST-A-DIRE QUE SI LE POINT 'M'
<                    EST AU-DESSUS DE 'A' ET 'B', CE
<                    QUI GENERE UN PLI, ALORS ON REDES-
<                    CEND 'M'...
<                      ENFIN, ON FAIT DE MEME, EN
<                    TESTANT 'M' PAR RAPPORT A LA
<                    POSITION EN-DESSOUS DE "A" ET
<                    "B", AUQUEL CAS ON LE REMONTE...
<
<
         #/FLD#      F1
         FSB         ALPHA
         #/FST#      FWORK1          < (FWORK1)=1-ALPHA.
         #/FLD#      ALPHA
         FMP         F05
         #/FST#      FWORK2          < (FWORK2)=ALPHA/2.
<
< TRAITEMENT LE LONG DE 'X' :
<
         LXI         W               < ON NE COMMENCE PAS SUR LE PREMIER POINT..
GEN120:  EQU         $
         PSR         X
         ADR         X,X             < PASSAGE A UN INDEX FLOTTANT...
         FLD         &ALIGP2         < Z(M(X)),
         ADRI        -DFLOT,X
         FCAM        &ALIGP2         < COMPARAISON A Z(A(X-I)) :
         JL          GEN122          < OK, 'M' EST AU-DESSOUS DE 'A'...
         ADRI        DFLOT+DFLOT,X   < 'M' EST AU-DESSUS DE 'A',
         FCAM        &ALIGP2         < COMPARAISON A Z(B(X+I)) :
         JL          GEN121          < OK, 'M' EST AU-DESSOUS DE 'B' ET AU-
                                     < DESSUS DE 'A'...
GEN124:  EQU         $               < CAS OU 'M' EST AU-DESSUS DE 'A' ET 'B',
                                     < OU BIEN AU-DESSOUS DE 'A' ET 'B'...
         FMP         FWORK1          < Z(M(X))*(1-ALPHA),
         #/FST#      FWORK           < ET SAUVEGARDE...
         FLD         &ALIGP2         < Z(B(X+I)),
         ADRI        -DFLOT-DFLOT,X
         FAD         &ALIGP2         < Z(A(X-I))+Z(B(X+I)),
         FMP         FWORK2          < ALPHA*(Z(A(X-I))+Z(B(X+I)))/2,
         FAD         FWORK           < +(1-ALPHA)*Z(M(X)),
         ADRI        DFLOT,X
         FST         &ALIGP2         < D'OU LE NOUVEAU Z(M(X))...
         JMP         GEN121          < VERS LE POINT SUIVANT...
GEN122:  EQU         $
         ADRI        DFLOT+DFLOT,X
         FCAM        &ALIGP2         < COMPARAISON A Z(B(X+I)) :
         JL          GEN124          < 'M' EST AU-DESSOUS DE 'B' (ET DE 'A'...).
GEN121:  EQU         $
         PLR         X               < RESTAURE LA COORDONNEE 'X',
         ADRI        I,X             < PASSAGE AU POINT SUIVANT,
         LR          X,A
         CP          VECTNC          < S'IL EXISTE...
         JL          GEN120          < OUI, MAIS ON NE TRAITE PAS LE DERNIER
                                     < POINT...
<
< DISCRIMINATION DE LA PREMIERE
< ET DE LA DEUXIEME LIGNE :
<
         LR          Y,A             < (A)=ORDONNEE COURANTE :
         CPI         W               < EST-ON SUR LA PREMIERE OU SUR LA
                                     < DEUXIEME LIGNE ???
         JLE         GEN300          < OUI, IL FAUT AU MOINS 3 LIGNES POUR
                                     < POUVOIR FILTRER, ON ATTEND DONC...
<
< TRAITEMENT LE LONG DE 'Y' :
<
         LXI         K               < ON COMMENCE SUR LE PREMIER POINT...
GEN130:  EQU         $
         PSR         X
         ADR         X,X             < PASSAGE A UN INDEX FLOTTANT...
         FLD         &ALIGP1         < Z(M(Y+I)),
         FCAM        &ALIG           < COMPARAISON A Z(A(Y)) :
         JL          GEN132          < OK, 'M' EST AU-DESSOUS DE 'A'...
         FCAM        &ALIGP2         < COMPARAISON A Z(B(Y+I+I)) :
         JL          GEN131          < OK, 'M' EST AU-DESSOUS DE 'B' ET AU-
                                     < DESSUS DE 'A'...
GEN134:  EQU         $               < CAS OU 'M' EST AU-DESSUS DE 'A' ET 'B',
                                     < OU BIEN AU-DESSOUS DE 'A' ET 'B'...
         FMP         FWORK1          < Z(M(Y+I))*(1-ALPHA),
         #/FST#      FWORK           < ET SAUVEGARDE...
         FLD         &ALIGP2         < Z(B(Y+I+I)),
         FAD         &ALIG           < Z(A(Y))+Z(B(Y+I+I)),
         FMP         FWORK2          < ALPHA*(Z(A(Y))+Z(B(Y+I+I)))/2,
         FAD         FWORK           < +(1-ALPHA)*Z(M(Y+I)),
         FST         &ALIGP1         < D'OU LE NOUVEAU Z(M(Y+I))...
         JMP         GEN131          < VERS LE POINT SUIVANT...
GEN132:  EQU         $
         FCAM        &ALIGP2         < COMPARAISON A Z(B(Y+I+I)) :
         JL          GEN134          < 'M' EST AU DESSOUS DE 'B' (ET DE 'A'...).
GEN131:  EQU         $
         PLR         X               < RESTAURE LA COORDONNEE 'X',
         ADRI        I,X             < PASSAGE AU POINT SUIVANT,
         LR          X,A
         CP          VECTNC          < S'IL EXISTE...
         JLE         GEN130          < OUI...
GEN300:  EQU         $
         CPZ         IBANDE          < EN FAIT DOIT-ON ECRIRE UNE BANDE ???
         JE          GEN90           < NON...
<
< OUI, GENERATION D'UNE BANDE :
<
         PSR         A,X
         LXI         K               < (X)=COORDONNEE 'X',
GEN94:   EQU         $
         PSR         X
         ADR         X,X             < PASSAGE A UN INDEX FLOTTANT...
         FLD         &ALIG
         BSR         AROND           < (A)=NIVEAU(X).
         LX          IBUFMT          < (X)=INDEX DE L'OCTET COURANT,
         STBY        &ABUFMT         < (A)=OCTET COURANT...
         ADRI        I,X             < ET PREPARATION DE
         STX         IBUFMT          <                   L'ACCES SUIVANT...
<
< TEST DE L'ETAT DU BUFFER :
<
         LR          X,A             < (A)=INDEX COURANT :
         CP          ZBUFMT          < LE BUFFER A-T'IL ETE VIDE (OU EST-CE
                                     < L'ETAT INITIAL) ???
         JL          GEN91           < NON...
<
< CAS OU LE BUFFER EST PLEIN :
<
GEN92:   EQU         $
         LAD         DEMMT           < (A)=ADRESSE DE LA DEMANDE,
         SVC                         < QUE L'ON ENVOIE...
         JE          GEN93           < OK...
         QUIT        XXQUIT          < E R R E U R   D ' A S S I G N A T I O N..
         JMP         GEN92           < ET ON RE-TENTE...
GEN93:   EQU         $
         IC          DEMMT+ARGESC    < PREPARATION DE L'ADRESSE DU BLOC SUIVANT,
         STZ         IBUFMT          < (A)=INDEX DU PREMIER OCTET.
GEN91:   EQU         $
         PLR         X
         ADRI        I,X             < PROGRESSION DE 'X',
         LR          X,A
         CP          VECTNC          < EST-CE FINI ???
         JLE         GEN94           < NON...
         PLR         A,X
GEN90:   EQU         $
<
< DISCRIMINATION DE LA PREMIERE, DE LA
< DEUXIEME ET DE LA TROISIEME LIGNE :
<
         LR          Y,A             < (A)=ORDONNEE COURANTE :
         CPI         W+W             < EST-ON SUR LA PREMIERE, LA DEU-
                                     < XIEME OU LA TROISIEME LIGNE ???
         JG          GEN21           < NON, ON PEUT GENERER LE RELIEF...
         BSR         AGOTO
         WORD        GEN50           < OUI, ATTENDONS LA LIGNE SUIVANTE...
                                     < (MAIS ROTATION DES BUFFERS DE LIGNE
                                     < MALGRE TOUT...)
GEN21:   EQU         $
<
<
<        G E N E R A T I O N   D U   R E L I E F  :
<
<
         STZ         PRAYON          < AU DEBUT DE CHAQUE NOUVELLE LIGNE, ON
                                     < ATTRIBUE A 'PRAYON' UNE VALEUR IMPOS-
                                     < SIBLE EN FLOTTANT...
                                     < ET CE AFIN DE FORCER SON CALCUL...
         LX          VECTNC          < ON COMMENCE SUR LE PREMIER POINT, MAIS
                                     < ATTENTION, ON NE FINIT PAS SUR LE PREMIER
                                     < AFIN DE POUVOIR SYSTEMATIQUEMENT TRAITER
                                     < UN TRIANGLE DU TYPE :
                                     < (A(X,Y),B(X-I,Y),C(X,Y-I)).
GEN30:   EQU         $
         PSR         X
         ADR         X,X             < PASSAGE A UN INDEX FLOTTANT...
         FLD         &ALIG
         PLR         X
         BSR         AROND           < (A)=NIVEAU DU POINT COURANT (X,Y),
                                     <     OU ALTITUDE DE CELUI-CI SUIVANT QUE
                                     <     L'ON TRACE UNE TEXTURE, OU BIEN UNE
                                     <     MONTAGNE VUE D'AVION...
         CPZ         ITEXT           < EST-CE UNE TEXTURE 2D OU 3D ???
         JE          GEN310          < CAS D'UNE MONTAGNE VUE D'AVION...
         IF          NEXIST-K,,XEIF%,
         IF          ATTENTION : LE TEST CI-DESSUS EST IDIOT !!!
XEIF%:   VAL         ENDIF
<
<
<        C A S   D ' U N E   T E X T U R E   2 D  :
<
<
         IF          EXIST-K,XEIF%,,XEIF%
         IF          ATTENTION : LE TEST QUI SUIT EST IDIOT !!!
XEIF%:   VAL         ENDIF
         CPZ         TRONIV          < DOIT-ON TRONQUER BRUTALEMENT ???
         JNE         GEN400          < OUI...
<
< CAS DE LA FONCTION
< EN DENTS DE SCIE :
<
GEN401:  EQU         $
         JAGE        GEN402
         NGR         A,A             < ABS(NIVEAU),
GEN402:  EQU         $
         CP          F255
         JLE         GEN400          < ON DOIT ETRE DANS (0,255)...
         SB          F511            < SINON, ON S'Y RAMENE...
         JMP         GEN401          < ET ON ATTEND DE S'ETRE STABILISER...
<
< TRONCAGE :
<
GEN400:  EQU         $
         CP          MINNIV          < ET VALIDATION :
         JL          GEN314          < TROP PETIT : ON TRONQUE INFERIEUREMENT...
         CP          MAXNIV          < ET VALIDATION :
         JG          GEN315          < TROP GRAND : ON TRONQUE SUPERIEUREMENT...
GEN311:  EQU         $
         BSR         AGOTO
         WORD        GEN312          < VERS LE MARQUAGE DE (X,Y) AVEC (A).
GEN314:  EQU         $
         LA          MINNIV          < (A)=NIVEAU PLANCHER,
         JMP         GEN311          < VERS SON MARQUAGE...
GEN315:  EQU         $
         LA          MAXNIV          < (A)=NIVEAU PLAFOND,
         JMP         GEN311          < VERS SON MARQUAGE...
<
<
<        C A S   D ' U N E   M O N T A G N E   V U E   D ' A V I O N  :
<
<
GEN310:  EQU         $
<
< TEST DES OMBRE PORTEES :
<
         IF          NEXIST-K,,XEIF%,
         IF          ATTENTION : LE TEST CI-DESSOUS EST IDIOT !!!
XEIF%:   VAL         ENDIF
         CPZ         IOMBRE          < L'OMBRAGE EST-IL DEMANDE ???
         JE          GEN520          < NON, RIEN A FAIRE...
         CPZ         PRAYON          < OUI, ALORS EST-ON EN DEBUT DE LIGNE ???
         JE          GEN512          < OUI, IL FAUT INITIALISER 'PRAYON'...
<
< TEST DE VISIBILITE DU
< POINT COURANT DEPUIS
< LA SOUCE LUMINEUSE :
<
         PSR         A               < SAUVEGARDE DE L'ORDONNEE DU "HAUT" DU
                                     < VECTEUR COURANT, NOTEE 'YC'.
         LR          X,A             < ABSCISSE, NOTEE 'XC',
         FLT
         FSB         FXL             < XC-XL,
         FMP         PRAYON          < ((YH-ZL)/(XH-XL))*(XC-XL),
         FAD         FZL             < ZL+((YH-ZL)/(XH-XL))*(XC-XL), CE QUI
                                     < DONNE LE SEUIL DE VISIBILITE DEPUIS LA
                                     < SOURCE LUMINEUSE,
         FIX
         LR          A,B             < (B)=PLUS PETITE ORDONNEE "HAUTE" D'UN
                                     <     VECTEUR QUE L'ON VOIT DEPUIS 'S',
         PLR         A               < (A)=ORDONNEE "HAUTE" DU VECTEUR COURANT,
         CPR         B,A             < ALORS LE VECTEUR COURANT EST-IL VU
                                     < DEPUIS LA SOURCE LUMINEUSE ???
         JLE         GEN510          < (A) <= (B) : NON, IL EST EN DESSOUS DU
                                     < SEUIL DE VISIBILITE...
<
< CAS OU L'ON EST VISIBLE
< DEPUIS LA SOURCE LUMINEUSE,
< OU BIEN DE LA PREMIERE
< FOIS :
<
GEN512:  EQU         $
         PSR         A               < RE-SAUVEGARDE DE L'ORDONNEE "HAUTE"...
         LR          X,A             < ABSCISSE (NOTEE 'XH') DU VECTEUR "MAXI-
                                     < MAL" COURANT, C'EST-A-DIRE VU DEPUIS LA
                                     < SOURCE LUMINEUSE, SACHANT QUE L'ON TRACE
                                     < DE DROITE A GAUCHE...
         FLT
         FSB         FXL             < XH-XL,
         #/FST#      FWORK           < ET SAVE...
         PLR         A               < YH,
         FLT
         FSB         FZL             < YH-ZL,
         FDV         FWORK           < (YH-ZL)/(XH-XL),
         #/FST#      PRAYON          < PRAYON=(YH-ZL)/(XL-XH).
         #/FLD#      FNIVMX          < (A,B)=NIVEAU LUMINEUX MAXIMAL PUIQU'ON
                                     <       EST VU, DONC AU SOLEIL...
         JMP         GEN511          < VERS LA MISE EN PLACE DE 'FNIVC'...
<
< CAS OU L'ON EST INVISIBLE
< DEPUIS LA SOURCE LUMINEUSE :
<
GEN510:  EQU         $
         SBR         B,A
         NGR         A,A             < (A)=DISTANCE D'INVISIBILITE (STRICTE-
                                     <     MENT POSITIVE).
         CP          NPENOM          < EST-ON DANS LA PENOMBRE ???
         JL          GEN533          < OUI, IL FAUT INTERPOLER POUR OBTENIR
                                     < LE NIVEAU MAXIMAL...
         #/FLD#      FNIVOM          < NON, OU BIEN ON NE CALCULE PAS LA
                                     < PENOMBRE :
                                     < (A,B)=VALEUR DU DECREMENT DU NIVEAU
                                     <       MAXIMAL D'ECLAIRAGE POUR PASSER
                                     <       DANS LA ZONE D'OMBRE...
         JMP         GEN534
GEN533:  EQU         $
         FLT                         < (A,B)=DISTANCE D'INVISIBILITE,
         FDV         FPENOM          < (A,B)=VALEUR ABSOLUE DU DECREMENT DU
                                     <       NIVEAU MAXIMAL D'ECLAIRAGE DANS LA
                                     <       LA ZONE DE PENOMBRE COURANTE...
GEN534:  EQU         $
         FAD         FNIVMX          < (A,B)=NIVEAU LUMINEUX MAXIMAL DE LA
                                     <       ZONE D'OMBRE OU DE PENOMBRE DANS
                                     <       LAQUELLE ON SE SITUE...
<
< MISE EN PLACE DE 'FNIVC' :
<
GEN511:  EQU         $
         #/FST#      FNIVC
GEN520:  EQU         $
<
< GENERATION DE LA NORMALE "HAUTE" :
<
<
<        CALCUL :
<                      ON CONSIDERE LA FACETTE TRIANGULAIRE :
<                    (A(X,Y,Z(A)),B(X-I,Y,Z(B)),C(X,Y-I,Z(C))),
<                    ELLE DEFINIT UN PLAN D'EQUATION :
<
<                                    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
<
<                    SOIT, PAR DEFINITION :
<
<                                    I  X-XA  Y-YA  Z-ZA  I
<                                    I   -1     0   ZB-ZA I = 0
<                                    I    0    -1   ZC-ZA I
<
<                    LA NORMALE DE CETTE FACETTE EST
<                    DONC LE VECTEUR DE COORDONNEES :
<
<                                    ((ZB-ZA),(ZC-ZA),1).
<
         PSR         X
         ADR         X,X             < PASSAGE A UN INDEX FLOTTANT...
         ADRI        -DFLOT,X
         FLD         &ALIG           < Z(B),
         ADRI        DFLOT,X
         FSB         &ALIG           < Z(B)-Z(A),
         #/FST#      FXN             < X(N)=Z(B)-Z(A).
         FLD         &ALIGM1         < Z(C),
         FSB         &ALIG           < Z(C)-Z(A),
         #/FST#      FYN             < Y(N)=Z(C)-Z(A).
                                     < NOTA : Z(N) VAUT TOUJOURS 2...
<
< PASSAGE DU RESEAU TRIANGULAIRE
< AU RESEAU CARRE DE BASE :
<
<
<        CALCUL :
<                      ON CONSIDERE LA FACETTE TRIANGULAIRE :
<                    (D(X-I,Y-I,Z(D)),B(X-I,Y,Z(B)),C(X,Y-I,Z(C))),
<                    ELLE DEFINIT UN PLAN D'EQUATION :
<
<                                    I  X-XD  Y-YD  Z-ZD  I
<                                    I  XB-XD YB-YD ZB-ZD I = 0
<                                    I  XC-XD YC-YD ZC-ZD I
<
<                    SOIT, PAR DEFINITION :
<
<                                    I  X-XD  Y-YD  Z-ZD  I
<                                    I    0     1   ZB-ZD I = 0
<                                    I    1     0   ZC-ZD I
<
<                    LA NORMALE DE CETTE FACETTE EST
<                    DONC LE VECTEUR DE COORDONNEES :
<
<                                    ((ZC-ZD),(ZB-ZD),-1),
<
<                    OU EN INVERSANT L'ORIENTATION :
<
<                                    (-(ZC-ZD),-(ZB-ZD),1).
<
<                      ENFIN, ON FAIT LA MOYENNE ENTRE
<                    CETTE NORMALE (-(ZB-ZD),-(ZC-ZD),1),
<                    ET LA NORMALE CALCULEE PRECEDEMMENT...
<
         FLD         &ALIGM1         < Z(C),
         ADRI        -DFLOT,X
         FSB         &ALIGM1         < Z(C)-Z(D),
         FSB         FXN             < -X(N)+(Z(C)-Z(D)),
         FNEG
         #/FST#      FXN             < CE QUI DONNE X(N) SUR LA MAILLE CARREE.
         FLD         &ALIG           < Z(B),
         FSB         &ALIGM1         < Z(B)-Z(D),
         FSB         FYN             < -Y(N)+(Z(B)-Z(D)),
         FNEG
         #/FST#      FYN             < CE QUI DONNE Y(N) SUR LA MAILLE CARREE.
                                     < NOTA : Z(N) VAUT TOUJOURS 2...
         ADRI        DFLOT,X         < ET RETOUR SUR LE POINT 'A'...
<
< CALCUL DE L'INTENSITE LUMINEUSE "HAUTE" :
<
         PLR         X               < RESTAURATION DE LA COORDONNEE 'X'...
         BSR         AINTEN          < (A,B)=INTENSITE LUMINEUSE "HAUTE",
<
< MARQUAGE DU POINT (X,Y) :
<
         BSR         AROND           < (A)=NIVEAU VU D'AVION...
GEN312:  EQU         $
         CPZ         IBANDE          < EN FAIT DOIT-ON ECRIRE UNE BANDE ???
         JNE         GEN80           < OUI, PAS D'IMAGE...
<
< OUI, ON GENERE UNE IMAGE :
<
         BSR         APOINT          < MARQUAGE DU POINT (X,Y) AVEC LE
                                     < NIVEAU (A)...
GEN80:   EQU         $
GEN713:  EQU         $
<
< PASSAGE AU POINT SUIVANT :
<
GEN32:   EQU         $
         ADRI        -I,X            < REGRESSION DE L'ABSCISSSE,
         LR          X,A
         CPI         W               < EST-ON EN DEBUT DE LIGNE ???
                                     < ET CE AFIN DE POUVOIR TRAITER DES TRIAN-
                                     < GLES DU TYPE :
                                     < (A(X,Y),B(X-I,Y),C(X,Y-I))...
         JL          GEN31           < OUI, ON ABANDONNE...
         BSR         AGOTO
         WORD        GEN30           < NON, ON CONTINUE LE TRACE...
GEN31:   EQU         $
<
< "ROTATION" DES BUFFERS DE LIGNES :
<
GEN50:   EQU         $
         LA          ALIGM1          < LIGNE PRECEDENTE,
         XM          ALIGP2          < QUI EST ECRASEE...
         XM          ALIGP1          < LA LIGNE SUIVANTE-SUIVANTE DEVIENT LA
                                     < LIGNE SUIVANTE,
         XM          ALIG            < LA LIGNE SUIVANTE DEVIENT LA LIGNE
                                     < COURANTE,
         STA         ALIGM1          < ET LA LIGNE COURANTE DEVIENT LA LIGNE
                                     < PRECEDENTE...
<
<
<        P O U R S U I T E   D E   L A   G E N E R A T I O N  :
<
<
GEN20:   EQU         $
         ADRI        I,Y             < PASSAGE A LA LIGNE SUIVANTE :
         LR          Y,A
         CP          VECTNL          < EST-ON AU BOUT DE L'IMAGE ???
         JG          GEN40           < OUI, C'EST FINI...
         BSR         AGOTO
         WORD        GEN01           < NON...
GEN40:   EQU         $
         BSR         ATSFLO
         CPZ         IBANDE          < A-T'ON GENERE UNE BANDE ???
         JE          GEN41           < NON...
         LAD         DEMMTM
         SVC                         < OUI, ON ECRIT UN 'TAPE-MARK'...
GEN41:   EQU         $
<
<
<        E N T R Y   A L T - M O D E  :
<
<
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 SUR ALT-MODE...
         PAGE
<
<
<        U P D A T E S  :
<
<
         $EQU        AMPLIR
         FLOAT       1.5             < AMPLIFICATEUR DE LA FONCTION.
         $EQU        MOYENE
         FLOAT       <NIV256/XXXMOY<K<K
                                     < VALEUR MOYENNE DE LA FONCTION.
         $EQU        EXPOP
         FLOAT       0.9             < EXPOSANT DE DECROISSANCE DE PONDERATION.
         $EQU        PASIX0
         WORD        200             < PAS INITIAL SUR 'OX'.
         $EQU        PASIY0
         WORD        200             < PAS INITIAL SUR 'OY'.
         $EQU        MRECUR
         WORD        32              < PROFONDEUR MAXIMALE DE RECURENCE.
         $EQU        GRAINE
         WORD        4660            < GRAINE DU GENERATEUR ALEATOIRE.
         $EQU        SUPRDN
         NTRN
         WORD        XXN255/XXXMOY   < SUP(RDN).
         TRN
         $EQU        INFRDN
         NTRN
         WORD        -XXN255/XXXMOY  < INF(RDN).
         TRN
         $EQU        MAXNIV
         WORD        XXN255          < NIVEAU MAXIMAL AUTORISE...
         $EQU        MINNIV
         WORD        XXNOIR          < NIVEAU MINIMAL AUTORISE...
         $EQU        FXL
         FLOAT       1000            < X(SOURCE LUMINEUSE).	
         $EQU        FYL
         FLOAT       0               < Y(SOURCE LUMINEUSE).
         $EQU        FZL
         FLOAT       400             < Z(SOURCE LUMINEUSE).
         $EQU        ALPHA
         FLOAT       0.5             < CONSTANTE D'ELIMINATION DES PICS.
         $EQU        PASQ
         WORD        W               < PAS DE PARCOURS DE LA SPIRALE,
         $EQU        NPM
         WORD        15              < NOMBRE DE POINTS DE CHAQUE SPIRALE.
         $EQU        XCTCDA
         WORD        TV1             < POUR ATTEINDRE L'IMAGE 'TV1'...
         $EQU        PONRDN
         FLOAT       <W<K<K          < CONTRIBUTION DE LA GENERATION ALEATOIRE,
         $EQU        PONSPI
         FLOAT       <K<K<K          < CONTRIBUTION DES SPIRALES.
         $EQU        PONFRA
         FLOAT       0.5             < PONDERATION DU CHAMP FRACTAL.
         $EQU        PONGAL
         FLOAT       0.5             < PONDERATION DU CHAMP GALACTIQUE.
         $EQU        XCENTR
         FLOAT       <XMAX+Z/XXXMOY<K<K
                                     < ABSCISSE DU CENTRE DU CHAMP,
         $EQU        YCENTR
         FLOAT       <YMAX+Z/XXXMOY<K<K
                                     < ORDONNEE DU CENTRE DU CHAMP.
         $EQU        FA0
         FLOAT       1.0
         $EQU        FA1
         FLOAT       1.0             < CONTRIBUTION DES SPIRALES.
         $EQU        FA2
         FLOAT       0.0             < CONTRIBUTION GAUSSIENNE : ATTENTION, IL
                                     < FAUT POUR EVITER LES ENNUIS :
                                     < SPIRALE+GAUSS=A1+A2=1.0+0.0=1 !!!
         $EQU        FA3
         FLOAT       0
         $EQU        FA11
         FLOAT       1
         $EQU        FA12
         FLOAT       1
         $EQU        FA13
         FLOAT       2
         $EQU        FA41
         FLOAT       -64.E-6         < CE QUI EST EN GROS 4*(1/256)**2...
         $EQU        FA21
         FLOAT       2               < NOMBRE DE BRAS DE LA SPIRALE.
         $EQU        FA22
         FLOAT       1
         $EQU        FA31
         FLOAT       4.E-3           < CE QUI EST EN GROS 1/256...
         $EQU        FA23
         FLOAT       0
         $EQU        FA50
         FLOAT       260.0
         $EQU        NEXP
         WORD        16              < EXPOSANT D'ACCENTUATION DES MAXIMA.
         $EQU        NPENOM
         WORD        12              < LARGEUR DE LA ZONE DE PENOMBRE.
         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-2022.
Copyright © CMAP (Centre de Mathématiques APpliquées) UMR CNRS 7641 / École polytechnique, Institut Polytechnique de Paris, 2022-2022.