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-2024.
Copyright © CMAP (Centre de Mathématiques APpliquées) UMR CNRS 7641 / École polytechnique, Institut Polytechnique de Paris, 2022-2024.