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#
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 :
<
IERASE: WORD EXIST < EFFACER ('EXIST'), OU NON ('NEXIST')
< L'ECRAN 512...
IQUIT: WORD EXIST < S'ARRETER ('EXIST') OU PAS ('NEXIST')
< APRES CHAQUE IMAGE (POINT D'ARRET).
IVIDEO: WORD NEXIST < ECRIRE ('EXIST') L'IMAGE COURANTE SUR LE
< DISQUE VIDEO OU PAS ('NEXIST').
ABLOC0: WORD K < ADRESSE DU PREMIER BLOC A LIRE.
LBLOC: WORD LBUFMT < LONGUEUR DES BLOCS PHYSIQUES SUR LA
< BANDE.
IVISD: WORD EXIST < TRACER ('EXIST') OU PAS ('NEXIST') LES
< DISQUES SYMBOLISANT LES SITES.
TXMIN: WORD NILK < AFIN DE DEFINIR LA TRANCHE D'ESPACE
TXMAX: WORD NILK < A VISUALISER : X DANS (TXMIN,TXMAX).
TYMIN: WORD NILK < AFIN DE DEFINIR LA TRANCHE D'ESPACE
TYMAX: WORD NILK < A VISUALISER : Y DANS (TYMIN,TYMAX).
TZMIN: WORD NILK < AFIN DE DEFINIR LA TRANCHE D'ESPACE
TZMAX: WORD NILK < A VISUALISER : Z DANS (TZMIN,TZMAX).
RAYON: WORD NILK < RAYON DES ETOILES.
INEW1: WORD NEXIST < MODE DE CHOIX DES COULEURS DES DISQUES
< ET DES CONNEXIONS :
< 'NEXIST' : LES CONNEXIONS SONT 2 FOIS PLU
< PLUS SOMBRES QUE LES PARTIES
< LES PLUS LUMINEUSES DES
< DISQUES, ET LES PARTIES DES
< DISQUES LES PLUS SOMBRES (AU
< BORD VONT PRATIQUEMENT JUS-
< QU'AU NOIR) ET ENFIN, LES
< CONNEXIONS UTILISENT DES
< NIVEAUX PRIS PAR LES DISQUES.
< 'EXIST' : LES COULEURS UTILISEES SONT
< PROPRES A CHAQUE PLAN 'Z' ;
< 2 PLANS PARALLELES NE PEUVENT
< UTILISER LES MEMES...
GRARDN: WORD NILK < GRAINEDU GENERATEUR ALEATOIRE...
SUPRDN: FLOAT <NILK<NILK<NILK < SUP(RDN),
INFRDN: FLOAT <NILK<NILK<NILK < INF(RDN).
GRARDM: WORD NILK < GRAINE DU GENERATEUR ALEATOIRE...
SUPRDM: FLOAT <NILK<NILK<NILK < SUP(RDM),
INFRDM: FLOAT <NILK<NILK<NILK < INF(RDM).
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
<
< RELAIS DIVERS :
<
ADEB9: WORD DEBUT9
<
< 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#
<
< VARIABLES DE MANOEUVRE :
<
FWORK1: FLOAT <NILK<NILK<NILK
FWORK2: FLOAT <NILK<NILK<NILK
<
< 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
<
< SAUVEGARDE DES COORDONNEES :
<
COORD: EQU $ < LISTE DES COORDONNEES :
SAVEX: WORD NILK
SAVEY: WORD NILK
SAVEZ: WORD NILK
PAGE0:: VAL K < PREMIERE PAGE DE LA 'CDAJ'.
RANG: WORD NILK < RANG DE LA PARTICULE COURANTE...
<
< DONNEES DE PROJECTION :
<
COST: FLOAT <NILK<NILK<NILK < COS(TETA) DONNE EN ARGUMENT,
SINT: FLOAT <NILK<NILK<NILK < SIN(TETA) CALCULE A PARTIR DE COS(TETA).
LOGX:: VAL 9 < LOG2(DIM(X)),
LOGY:: VAL 9 < LOG2(DIM(Y)),
LOGZ:: VAL 9 < LOG2(DIM(Z)).
DECX:: VAL K < AMPLIFICATEUR DE 'X',
DECY:: VAL DECX < AMPLIFICATEUR DE 'Y',
DECZ:: VAL LOGZ+I < AMPLIFICATEUR DE 'Z' (ON PREND CETTE
< VALEUR POUR SHUNTER LA PROJECTION, SINON
< IL FAUT PRENDRE 'DECX').
TRANSX: WORD NILK < TRANSLATION DE 'X',
TRANSY: WORD NILK < TRANSLATION DE 'Y' (PROJETES).
APROJ: WORD PROJ < SOUS-PROGRAMME DE PROJECTION :
< (X,Y,W) --> (X,Y).
<
< DONNEES DE TRACE D'UN DISQUE :
<
LONGX:: VAL BIT>LOGX < LONGUEUR DE L'AXE 'X',
LONGY:: VAL BIT>LOGY < LONGUEUR DE L'AXE 'Y',
LONGZ:: VAL BIT>LOGZ < LONGUEUR DE L'AXE 'Z'.
XWOR%1: VAL XXN255+I
XWOR%2: VAL BIT>LOGZ
TRN
XWOR%3: VAL XWOR%2/XWOR%1=K
NTRN
XWOR%4: VAL XWOR%1=K-LOGZ < POUR AMPLIFIER LA COORDONNEE 'Z' LORS
DECZDK:: VAL -XWOR%4 < DU TRACE DES DISQUES.
IF DECZDK-XWOR%3,XEIF%,XEIF%,
IF ATTENTION : 'DECZDK' EST TROP GRAND !!!
XEIF%: VAL ENDIF
SAVEZP: WORD NILK < POUR SAUVEGARDER LA COORDONNEE 'Z'
< AMPLIFIEE...
ACERCL: WORD CERCLE < SOUS-PROGRAMME DE TRACE.
PAGE
<
<
< L O C A L :
<
<
LOCAL
LOC: EQU $
<
< 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,
<
< 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 :
<
ARAK: WORD RAK < CALCUL D'UNE PUISSANCE REELLE QUELCONQUE.
AEXP: WORD EXPON < CALCUL D'UNE EXPONENTIELLE (BASE 'E').
<
< VARIABLES DE MANOEUVRE :
<
EXPOP: FLOAT <NILK<NILK<NILK < EXPOSANT COURANT...
<
< PARAMETRES GENERAUX DES GENERATEURS ALEATOIRES :
<
INF32: FLOAT 32768
INF64: FLOAT 65536
FWORK4: FLOAT <NILK<NILK<NILK
FWORK5: FLOAT <NILK<NILK<NILK
<
< PARAMETRES DU GENERATEUR 'RDN' :
<
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
RDN64: FLOAT <NILK<NILK<NILK < SUPRDN/65536.
RDNMIS: FLOAT <NILK<NILK<NILK < 1-(INF/SUP),
RDNPIS: FLOAT <NILK<NILK<NILK < 32768*(1+(INF/SUP)).
ASPRDN: WORD SPRDN < GENERATEUR ALEATOIRE 2D.
<
< PARAMETRES DU GENERATEUR 'RDM' :
<
RDM: WORD 4397 < NOMBRE ALEATOIRE COURANT.
RDM1: WORD 5189 < CONSTANTE
RDM2: WORD 6791 < DE CALCUL DES
RDM3:: VAL 19 < NOMBRE ALEATOIRES...
RDM4: WORD 7993 < 2EME NOMBRE ALEATOIRE COURANT.
RDM5: WORD 4021
RDM6:: VAL 23
RDM64: FLOAT <NILK<NILK<NILK < SUPRDM/65536.
RDMMIS: FLOAT <NILK<NILK<NILK < 1-(INF/SUP),
RDMPIS: FLOAT <NILK<NILK<NILK < 32768*(1+(INF/SUP)).
ASPRDM: WORD SPRDM < GENERATEUR ALEATOIRE 2D.
<
< 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,
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.
F255: FLOAT <XXN255<K<K < DERNIERE COULEUR...
<
< GESTION DU DEROULEUR :
<
LBLOC0: WORD LBUFMT < POUR VALIDER 'LBLOC'...
NVPMT:: VAL '0B < 'NVP' D'ACCES AU DEROULEUR DE BANDES.
DEMMT: BYTE NVPMT;XFMTRA < DEMANDE DE LECTURE A ACCES DIRECT.
WORD BUFMT=FCTA*NOCMO
WORD LBUFMT
WORD NILK < ADRESSE DU BLOC COURANT.
IF Z-I,,XEIF%,
IF ATTENTION : L'INITIALISATION DE 'IBUFMT' ET
IF 'ZBUFMT' SERA MAUVAISE !!!
XEIF%: VAL ENDIF
IBUFMT: WORD LBUFMT-Z+I < INDEX COURANT DU BUFFER 'MT',
ZBUFMT: WORD LBUFMT-Z+I < ET POUR FORCER LA LECTURE DU PREMIER
< BLOC DE CHAQUE IMAGE...
ABUFMT: WORD BUFMT,X < ET RELAI D'ACCES...
AGOCT: WORD GOCT < SOUS-PROGRAMME D'ACCES AU NIVEAU COURANT.
AGMOT: WORD GMOT < RECUPERATION D'UN MOT (2 OCTETS).
<
< GESTION DU DISQUE VIDEO :
<
BUFVIW: BYTE "J";KCR
XWOR%1: VAL '0000000@@@@(MOCD
XWOR%3: VAL $-BUFVIW*NOCMO
IF XWOR%1-K,XEIF%,,XEIF%
XWOR%3: VAL XWOR%3-W
XEIF%: VAL ENDIF
LBUFVW:: VAL XWOR%3 < LONGUEUR DE LA COMMANDE AU DISQUE
< VIDEO...
XWOR%2: VAL COSBT?XASSIM=FMASK(K?NVPVDK=FCINST
DEMVIW: BYTE XWOR%2;FAVW < COMMANDE DE L'ECRITURE SUR LE DISQUE
< VIDEO...
WORD BUFVIW=FCTA*NOCMO
WORD LBUFVW
BUFVIR: DZS W < BUFFER DE LECTURE DES ACQUITTEMENTS.
LBUFVR:: VAL $-BUFVIR*NOCMO
DEMVIR: BYTE XWOR%2;FAVR < LECTURE DES ACQUITTEMENTS DU DISQUE.
WORD BUFVIR=FCTA*NOCMO
WORD LBUFVR
<
< GENERATION DES SEQUENCES PERIODIQUES :
<
< ARGUMENTS :
< (KP1,KP2,KP3)=CHIFFRES (CENTAINE,DIZAINE,UNITE)
< DU PAS, SOIT LA PERIODE DU MOUVEMENT
< EXPRIMEE EN NOMBRE D'IMAGES.
< (NPERIO) =LE NOMBRE DE PERIODES A REPRESENTER.
<
NPERIO: @
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 'NPERIO'...
XWOR%6: VAL XWOR%5=FCSIGN
XWOR%7: VAL XWOR%5(MSYMBN)MSYMBN=FCSIGN
IF XWOR%6*XWOR%7,XEIF%,,XEIF%
NPERIO:: VAL K < 'NPERIO' EST ABSENT...
XEIF%: VAL ENDIF
KP1: @
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 'KP1'...
XWOR%6: VAL XWOR%5=FCSIGN
XWOR%7: VAL XWOR%5(MSYMBN)MSYMBN=FCSIGN
IF XWOR%6*XWOR%7,XEIF%,,XEIF%
KP1:: VAL K < 'KP1' EST ABSENT...
XEIF%: VAL ENDIF
KP2: @
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 'KP2'...
XWOR%6: VAL XWOR%5=FCSIGN
XWOR%7: VAL XWOR%5(MSYMBN)MSYMBN=FCSIGN
IF XWOR%6*XWOR%7,XEIF%,,XEIF%
KP2:: VAL K < 'KP2' EST ABSENT...
XEIF%: VAL ENDIF
KP3: @
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 'KP3'...
XWOR%6: VAL XWOR%5=FCSIGN
XWOR%7: VAL XWOR%5(MSYMBN)MSYMBN=FCSIGN
IF XWOR%6*XWOR%7,XEIF%,,XEIF%
KP3:: VAL K < 'KP3' EST ABSENT...
XEIF%: VAL ENDIF
MULTIS: VAL EXIST < A PRIORI, ON VA GENERER LA SEQUENCE
< PLUSIEURS FOIS...
IF NPERIO-K,XEIF%1,,XEIF%1
IF KP1-K,XEIF%2,,XEIF%2
IF KP2-K,XEIF%3,,XEIF%3
IF KP3-K,XEIF%4,,XEIF%4
MULTIS: VAL NEXIST < ET BIEN NON, LA SEQUENCE NE SERA
< GENEREE QU'UNE SEULE FOIS...
XEIF%4: VAL ENDIF
XEIF%3: VAL ENDIF
XEIF%2: VAL ENDIF
XEIF%1: VAL ENDIF
IF MULTIS-EXIST,XEIF%9,,XEIF%9
BUFVIG: BYTE "(";KCR
XWOR%1: VAL '0000000@@@@(MOCD
XWOR%3: VAL $-BUFVIG*NOCMO
IF XWOR%1-K,XEIF%,,XEIF%
XWOR%3: VAL XWOR%3-W
XEIF%: VAL ENDIF
LBUVIG:: VAL XWOR%3 < LONGUEUR DE LA COMMANDE AU DISQUE
< VIDEO...
XWOR%2: VAL COSBT?XASSIM=FMASK(K?NVPVDK=FCINST
DEMVIG: BYTE XWOR%2;FAVW < COMMANDE DE MEMORISATION DE L'ADRESSE
< DE DEBUT D'ITERATION...
WORD BUFVIG=FCTA*NOCMO
WORD LBUVIG
BUFVIN: EQU $
IF KP1-K,,XEIF%2,
BYTE "P";KP1=FCBA(MOCD;KP2=FCBA(MOCD;KP3=FCBA(MOCD;KCR
XWOR%1: VAL '0000000@@@@(MOCD
XEIF%2: VAL ENDIF
IF KP1-K,XEIF%1,,XEIF%1
IF KP2-K,,XEIF%2,
BYTE "P";KP2=FCBA(MOCD;KP3=FCBA(MOCD;KCR
XWOR%1: VAL '0000000@@@@(MOCD
XEIF%2: VAL ENDIF
IF KP2-K,XEIF%2,,XEIF%2
IF KP3-K,,XEIF%3,
BYTE "P";KP3=FCBA(MOCD;KCR
XWOR%1: VAL '0000000@@@@(MOCD
XEIF%3: VAL ENDIF
IF KP3-K,XEIF%3,,XEIF%3
IF ATTENTION (KP1,KP2,KP3) EST NUL !!!
XEIF%3: VAL ENDIF
XEIF%2: VAL ENDIF
XEIF%1: VAL ENDIF
XWOR%3: VAL $-BUFVIN*NOCMO
IF XWOR%1-K,XEIF%,,XEIF%
XWOR%3: VAL XWOR%3-W
XEIF%: VAL ENDIF
LBUVIN:: VAL XWOR%3 < LONGUEUR DE LA COMMANDE AU DISQUE
< VIDEO...
XWOR%2: VAL COSBT?XASSIM=FMASK(K?NVPVDK=FCINST
DEMVIN: BYTE XWOR%2;FAVW < COMMANDE DE MISE EN PLACE DU PAS
< VARIABLE...
WORD BUFVIN=FCTA*NOCMO
WORD LBUVIN
BUFVI1: BYTE "P";"1";KCR;NILK
XWOR%1: VAL '0000000@@@@(MOCD
XWOR%3: VAL $-BUFVI1*NOCMO
IF XWOR%1-K,XEIF%,,XEIF%
XWOR%3: VAL XWOR%3-W
XEIF%: VAL ENDIF
LBUVI1:: VAL XWOR%3 < LONGUEUR DE LA COMMANDE AU DISQUE
< VIDEO...
XWOR%2: VAL COSBT?XASSIM=FMASK(K?NVPVDK=FCINST
DEMVI1: BYTE XWOR%2;FAVW < COMMANDE DE RETOUR AU PAS UNITE...
WORD BUFVI1=FCTA*NOCMO
WORD LBUVI1
BUFVID: BYTE ")";KCR
XWOR%1: VAL '0000000@@@@(MOCD
XWOR%3: VAL $-BUFVID*NOCMO
IF XWOR%1-K,XEIF%,,XEIF%
XWOR%3: VAL XWOR%3-W
XEIF%: VAL ENDIF
LBUVID:: VAL XWOR%3 < LONGUEUR DE LA COMMANDE AU DISQUE
< VIDEO...
XWOR%2: VAL COSBT?XASSIM=FMASK(K?NVPVDK=FCINST
DEMVID: BYTE XWOR%2;FAVW < COMMANDE DE RETOUR EN DEBUT D'ITERATION.
WORD BUFVID=FCTA*NOCMO
WORD LBUVID
BUFVIC: BYTE KCR;NILK
XWOR%1: VAL '0000000@@@@(MOCD
XWOR%3: VAL $-BUFVIC*NOCMO
IF XWOR%1-K,XEIF%,,XEIF%
XWOR%3: VAL XWOR%3-W
XEIF%: VAL ENDIF
LBUVIC:: VAL XWOR%3 < LONGUEUR DE LA COMMANDE AU DISQUE
< VIDEO...
XWOR%2: VAL COSBT?XASSIM=FMASK(K?NVPVDK=FCINST
DEMVIC: BYTE XWOR%2;FAVW < COMMANDE DE PASSAGE A L'IMAGE SUIVANTE.
WORD BUFVIC=FCTA*NOCMO
WORD LBUVIC
XEIF%9: VAL ENDIF
<
<
< 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
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)...
<
<
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
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
<
<
< P I L E D E T R A V A I L :
<
<
STACK: EQU $
DZS 64
PROG
XXXVEC: VAL XXVEC3 < DEFINITION DES PROGRAMMES VECTEUR 512...
NLS
CALL #SIP VECTEUR 512#
LST
PAGE
<
<
< M A R Q U A G E D ' U N P O I N T :
<
<
< FONCTION :
< CE SOUS-PROGRAMME 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...
<
<
< ARGUMENTS :
< (A)=NIVEAU,
< (X,Y)=COORDONNEES DU POINT.
<
<
< RESULTAT :
< (A)=NIVEAU TRANSCODE.
<
<
POINT: EQU $
PSR A,B
LR A,B < (B)=NIVEAU DU TRACE.
<
< TEST DES "HORS-ECRAN" :
<
LR X,A < (A)=COORDONNEE 'X' ET VALIDATION :
JAL POINT1 < HORS-ECRAN...
CP VECTNC
JG POINT1 < HORS-ECRAN...
LR Y,A < (A)=COORDONNEE 'Y' ET VALIDATION :
JAL POINT1 < HORS-ECRAN...
CP VECTNL
JG POINT1 < HORS-ECRAN...
<
< TRANSCODAGE DU NIVEAU :
<
PSR X < SAUVEGARDE DE LA COORDONNEE 'X'...
LR B,X < (X)=NIVEAU ARGUMENT,
LBY &ALNIVO < (A)=NIVEAU TRANSCODE,
PLR X < RESTAURE :
< (X)=COORDONNEE 'X'.
<
< MARQUAGE DU POINT :
<
BSR ASTORP < MARQUAGE : (X,Y) <-- (A)...
<
< ET RETOUR :
<
POINT1: EQU $
PLR A,B
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'.
NLS
CALL #SIP UTILITAIRES#
LST
XXXPRO: VAL YYYFLO < 'YYYFLO'.
NLS
CALL #SIP UTILITAIRES#
LST
PAGE
<
<
< T R A C E D ' U N D I S Q U E :
<
<
< FONCTION :
< CE MODULE TRACE UN DISQUE EN
< DEGRADE DESTINE A REPRESENTER
< UNE SPHERE PROJETEE.
<
<
< ARGUMENTS :
< (X,Y)=CENTRE DU DISQUE.
<
<
CERCLE: EQU $
CPZ IVISD < FAUT-IL TRACER LES DISQUES ???
JE CERCL4 < NON...
<
< VOISINNAGE DU BORD DE L'ECRAN :
<
LR X,A < VALIDATION DE 'X' :
CP RAYON
JLE CERCL4 < TROP NEGATIF...
AD RAYON
CP VECTNC
JGE CERCL4 < TROP POSITIF...
LR Y,A < VALIDATION DE 'Y' :
CP RAYON
JLE CERCL4 < TROP NEGATIF...
AD RAYON
CP VECTNL
JGE CERCL4 < TROP POSITIF...
<
< INITIALISATIONS :
<
PSR X,Y
LR X,B < (B)='X' DU CENTRE,
PSR Y < SAUVEGARDE DE 'Y' DU CENTRE.
LA RAYON
SBR A,X < ON SE PLACE EN HAUT ET A GAUCHE
SBR A,Y < D'UN CARRE CIRCONSCRIT AU DISQUE.
STX VECTX1 < INITIALISATION DE L'ABSCISSE INITIALE
< DE CHAQUE LIGNE,
STY VECTY1 < INITIALISATION DE LA COORDONNEE 'Y'.
LA SAVEZ
ADRI Z,A < POUR EVITER LE NOIR...
SLRS DECZDK < AMPLIFICATION...
ADRI -Z,A < ET DESATURATION...
STA SAVEZP < SAUVEGARDE DE LA COORDONNEE 'Z'.
PLR Y < ON A :
< (B,Y)=COORDONNEES DU CENTRE.
CPZ RAYON < LE RAYON EST-IL NUL ???
JG CERCL8 < NON...
BSR APOINT < OUI, ON MARQUE LE CENTRE DU CERCLE (X,Y)
< AVEC LE NIVEAU 'SAVEZP'.
JMP CERCL9 < ET ON SORT...
CERCL8: EQU $
<
< BALAYAGE VERTICAL :
<
LX RAYON
ADR X,X
ADRI Z,X < (X)=NOMBRE DE LIGNES A BALAYER.
CERCL1: EQU $
LA VECTX1
PSR A,X < SAUVEGARDE DE L'ABSCISSE INITIALE
< DE CHAQUE LIGNE (A) ET DU NOMBRE DE
< LIGNES A TRACER (X).
<
< BALAYAGE HORIZONTAL :
<
LX RAYON
ADR X,X
ADRI Z,X < (X)=NOMBRE DE LIGNES A BALAYER.
CERCL2: EQU $
PSR B < SAUVEGARDE DE LA COORDONNEE 'X'
< DU CENTRE.
LA VECTX1 < X1,
SBR B,A < X1-XC,
BSR AFLT
#/FST# FWORK1 < X1-XC,
FMP FWORK1 < (X1-XC)**2,
BSR ASFWOR
LA VECTY1 < Y1,
SBR Y,A < Y1-YC ((XC,YC) DESIGNE LE CENTRE).
BSR AFLT
#/FST# FWORK2 < Y1-YC,
FMP FWORK2 < (Y1-YC)**2,
BSR APFWOR < (X1-XC)**2+(Y1-YC)**2,
BSR ARAC < ET CALCUL DE LA DISTANCE DU POINT
< COURANT (X1,Y1) AU CENTRE (XC,YC) :
BSR ATSFLO
BSR AROND
CP RAYON < EST-ON HORS DU DISQUE ??
JGE CERCL3 < OUI, ON IGNORE CE POINT...
SB RAYON < NON :
NGR A,A < (A)=DISTANCE DU POINT COURANT AU BORD
< DU DISQUE.
CPZ INEW1 < CHOIX DES NIVEAUX :
JE CERCL5 < 2 PLANS 'Z' PARALLELES PEUVENT UTILISER
< DES NIVEAUX COMMUNS...
IF NEXIST-K,,XEIF%,
IF ATTENTION : LE TEST CI-DESSUS EST IDIOT !!!
XEIF%: VAL ENDIF
ADRI Z,A < DANS CETTE METHODE, LES NIVEAUX SONT
< PROPRES A UN PLAN 'Z'... CE QUI PERMET
< DE LES DISTINGUER...
LR A,B < (B)=DISTANCE AU BORD DU DISQUE TELLE
< QU'ELLE NE SOIT PAS NULLE.
LA SAVEZ < Z,
SLRS DECZDK < CADRAGE,
ADR B,A < (A)=NIVEAU FONCTION DE LA DISTANCE AU
< BORD ET DU 'Z'...
< NOTA : AUTREFOIS, C'ETAIT UN 'ORR' POUR
< CONCATENER, MAIS DANS LA MESURE
< OU 'DECZDK' PEUT ETRE NUL, IL
< FAUT FAIRE UNE OPERATION ARITH-
< METIQUE...
JMP CERCL6 < VERS LE TRACE...
CERCL5: EQU $
MP SAVEZP < DANS CETTE METHODE, 2 PLANS 'Z' PEUVENT
< UTILISER LES MEMES NIVEAUX (EN FAIT SE
< RECOUVRIR...).
DV RAYON < (A)=NIVEAU(DISTANCE AU CENTRE,Z).
CERCL6: EQU $
JAG CERCL7 < OK...
ADRI Z,A < POUR EVITER LE NOIR...
CERCL7: EQU $
PSR X,Y
LX VECTX1
LY VECTY1
BSR APOINT < MARQUAGE DE (X,Y) AVEC LE NIVEAU (A).
PLR X,Y
CERCL3: EQU $
PLR B < RESTAURE L'ABSCISSE DU CENTRE,
IC VECTX1 < ET PROGRESSION SUR LA LIGNE,
JDX CERCL2 < A CONDITION DE N'ETRE POINT EN BOUT
< DE LIGNE...
PLR A,X < RESTAURE :
< (A)='VECTX1' DE DEBUT DE LIGNE,
< (X)=NOMBRE DE LIGNES A TRACER...
STA VECTX1 < ON SE PLACE EN DEBUT
IC VECTY1 < DE LA NOUVELLE LIGNE,
JDX CERCL1 < SI ELLE EXISTE...
<
< ET RETOUR :
<
CERCL9: EQU $
PLR X,Y
CERCL4: EQU $
RSR
PAGE
<
<
< P R O J E C T I O N :
<
<
< ARGUMENTS :
< (X,Y,W)=POINT TRI-DIMENSIONNEL.
<
<
< RESULTATS :
< (X,Y)=POINT PROJETE.
<
<
PROJ: EQU $
PSR A,B
LR X,A
SLRS DECX
LR A,X < AMPLIFICATION DE 'X'.
LR Y,A
SLRS DECY
LR A,Y < AMPLIFICATION DE 'Y'.
LR W,A
SLRS DECZ
FLT
PSR A,B < PRISE EN COMPTE DE 'Z' :
FMP COST
BSR AROND
AD TRANSX < ET TRANSLATION,
ADR A,X < X(PROJETE)=X+Z*COS(TETA)+TRANSX.
PLR A,B < PRISE EN COMPTE DE 'Z' :
FMP SINT
BSR AROND
SB TRANSY < ET TRANSLATION,
SBR A,Y < Y(PROJETE)=Y-Z*SIN(TETA)+TRANSY.
PLR A,B
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
<
<
< 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
<
<
< 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
<
<
< 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,GRARDN).
<
<
SPRDN: EQU $
<
< GENERATION ALEATOIRE :
<
LR X,A < (A)=COORDONNEE 'X',
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 GRARDN < D'OU F(GRARDN,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 RDNMIS < RDN*(1-(INF/SUP)),
FAD RDNPIS < RDN*(1-(INF/SUP))+32768*(1+(INF/SUP)),
FMP RDN64 < (SUP/65536)*(...).
<
< ET SORTIE :
<
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)=RDM(XS,YS,GRARDM).
<
<
SPRDM: EQU $
<
< GENERATION ALEATOIRE :
<
LR X,A < (A)=COORDONNEE 'X',
EORR B,A < ET ON SE RAMENE SUR UN MOT...
STA FWORK4 < SAVE F1(XS)...
LR Y,A < (A)=COORDONNEE 'Y',
EOR RDM1 < ??!???!
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 GRARDM < D'OU F(GRARDM,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 'RDM' A L'ECHELLE
< CALCULER L'EXPRESSION :
<
< (SUP/(-32768))*(-RDM/2+16384+(RDM/2-16384)*(INF/SUP)),
<
< QUI SE SIMPLIFIE EN :
<
< (SUP/65536)*(RDM*(1-(INF/SUP))+32768*(1+(INF/SUP))).
<
FLT < ON FLOTTE 'RDM',
FMP RDMMIS < RDM*(1-(INF/SUP)),
FAD RDMPIS < RDM*(1-(INF/SUP))+32768*(1+(INF/SUP)),
FMP RDM64 < (SUP/65536)*(...).
<
< ET SORTIE :
<
RSR
PAGE
<
<
< A C C E S A L ' O C T E T C O U R A N T :
<
<
< ARGUMENT :
< (IBUFMT)=INDEX DE L'OCTET COURANT.
<
<
< RESULTAT :
< (A)=OCTET COURANT.
<
<
GOCT: EQU $
<
< INITIALISATIONS :
<
PSR B,X
<
< TEST DE L'ETAT DU BUFFER :
<
LA IBUFMT < (A)=INDEX COURANT :
CP ZBUFMT < LE BUFFER A-T'IL ETE VIDE (OU EST-CE
< L'ETAT INITIAL) ???
JL GOCT1 < NON...
<
< CAS OU LE BUFFER EST VIDE :
<
GOCT2: EQU $
LAD DEMMT < (A)=ADRESSE DE LA DEMANDE,
SVC < QUE L'ON ENVOIE...
JE GOCT3 < OK...
QUIT XXQUIT < E R R E U R D ' A S S I G N A T I O N..
JMP GOCT2 < ET ON RE-TENTE, OU BIEN ON ARRETE S'IL
< S'AGIT D'UN 'TAPE-MARK'...
GOCT3: EQU $
IC DEMMT+ARGESC < PREPARATION DE L'ADRESSE DU BLOC SUIVANT,
ACTD XXXSIZ < RECUPERATION DE LA 'BOX'...
LR B,A < (A)=NOMBRE D'OCTETS REELS DU BLOC :
CP DEMMT+COESC < LE BUFFER EST-IL BON ???
JNE GOCT2 < NON, ON LIT L'ENREGISTREMENT SUIVANT...
LAI K < (A)=INDEX DU PREMIER OCTET.
<
< ACCES A L'OCTET COURANT :
<
GOCT1: EQU $
LR A,X < (X)=INDEX DE L'OCTET COURANT,
LBY &ABUFMT < (A)=OCTET COURANT...
ADRI I,X < ET PREPARATION DE
STX IBUFMT < L'ACCES SUIVANT...
<
< ET RETOUR :
<
PLR B,X
RSR
PAGE
<
<
< R E C U P E R A T I O N D E 2 O C T E T S :
<
<
< RESULTAT :
< (A)=UN MOT (2 OCTETS).
<
<
GMOT: EQU $
PSR B
BSR AGOCT < RECUPERATION DU PREMIER OCTET,
SWBR A,B < ET MISE DANS 'B'.
BSR AGOCT < RECUPERATION DU SECOND OCTET,
ORR B,A < ET CONCATENATION DES 2 OCTETS.
PLR B
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 < 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 $
LA ABLOC0
STA DEMMT+ARGESC < MISE EN PLACE DE L'ADRESSE DU PREMIER
< BLOC A LIRE...
DEBUT9: 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'...).
<
<
< I N I T I A L I S A T I O N S :
<
<
INIT01: EQU $
<
< GESTION DE LA BANDE :
<
INIT10: EQU $
LA LBLOC < (A)=LONGUEUR DES BLOCS PHYSIQUES SUR
< LA BANDE :
JALE INIT11 < BERKKK...
CP LBLOC0 < VALIDATION :
JLE INIT12 < OK...
INIT11: EQU $
QUIT XXQUIT < E R R E U R P A R A M E T R E ...
JMP INIT10 < ET ON RETENTE...
INIT12: EQU $
STA DEMMT+COESC < ET ON INITIALISE LA DEMANDE DE LECTURE...
STA ZBUFMT
STA IBUFMT < POUR PROVOQUER LA LECTURE DU PREMIER
< BLOC...
<
< INITIALISATION A PRIORI
< DES TRACES GRAPHIQUES :
<
LRM A,B,X,Y
WORD CORBT?BANTI=FMASK(K=FCINST
WORD MMOT
WORD K
WORD COSBT?VELODD=FMASK(K?VECTSB=FCINST
STA VECANT < PAS D'ANTI-ALIASING,
STB VEPOIN < PAS DE POINTILLE,
STX VEDECA < PAS DE DECALAGE DES NIVEAUX,
STY VECTRS < MODE 'SBT' EN LOGIQUE BINAIRE.
<
< GENERATEUR ALEATOIRE :
<
#/FLD# INFRDN < BORNE INFERIEURE ('INF'),
FDV SUPRDN < INF/SUP,
PSR A,B < ET SAVE...
FSB F1 < (INF/SUP)-1,
FNEG < 1-(INF/SUP),
#/FST# RDNMIS < RDNMIS=1-(INF/SUP).
PLR A,B < INF/SUP,
FAD F1 < 1+(INF/SUP),
FMP INF32 < 32768*(1+(INF/SUP)),
#/FST# RDNPIS < RDNPIS=32768*(1+(INF/SUP)).
#/FLD# SUPRDN < SUP,
FDV INF64 < SUP/65536,
#/FST# RDN64 < SUP64=SUP/65536.
<
< GENERATEUR ALEATOIRE :
<
#/FLD# INFRDM < BORNE INFERIEURE ('INF'),
FDV SUPRDM < INF/SUP,
PSR A,B < ET SAVE...
FSB F1 < (INF/SUP)-1,
FNEG < 1-(INF/SUP),
#/FST# RDMMIS < RDMMIS=1-(INF/SUP).
PLR A,B < INF/SUP,
FAD F1 < 1+(INF/SUP),
FMP INF32 < 32768*(1+(INF/SUP)),
#/FST# RDMPIS < RDMPIS=32768*(1+(INF/SUP)).
#/FLD# SUPRDM < SUP,
FDV INF64 < SUP/65536,
#/FST# RDM64 < SUP64=SUP/65536.
<
< DONNEES DE PROJECTION :
<
#/FLD# COST < COS(TETA),
FMP COST < COS(TETA)**2,
FSB F1
FNEG < 1-COS(TETA)**2,
BSR ARAC
#/FST# SINT < SIN(TETA).
<
< INITIALISATIONS DE L'IMAGEUR :
<
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'.
GEN69N: EQU $
<
<
< 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),
<
< PUIS :
<
< F(RHO,TETA)=A50*(EXP(F(RHO,TETA))-1),
<
< ON NOTERA QUE LA PHASE DE L'ANGLE
< 'TETA' EST UNE FONCTION DU TYPE "SPIRALE
< LOGARITHMIQUE", ET DONC INDUIT LA
< STRUCTURE SPIRALEE.
<
<
LYI K < (Y)=ORDONNEE COURANTE,
GEN100: EQU $
LXI K < (X)=ABSCISSE COURANTE.
GEN101: 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).
<
< 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 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 MAXIMUM :
<
BSR AEXP < EXP(A0*(SPIRALE+GAUSS+A3)),
FSB F1 < EXP(A0*(SPIRALE+GAUSS+A3))-1,
FMP FA50 < A50*(EXP(A0*(SPIRALE+GAUSS+A3))-1).
#/FST# CHAMP < CE QUI DONNE LE CHAMP...
<<
<< TEST :
<<
JMP TEST1 <<
FMP F255 <<
BSR AROND
ANDI 'FF <<
BSR APOINT <<
JMP GEN300 <<
TEST1: EQU $ <<
<
< GENERATION DE LA GALAXIE :
<
BSR ASPRDN < GENERATION D'UN NOMBRE ALEATOIRE :
FCAM CHAMP
JG GEN300 < RDN > CHAMP : PAS D'ETOILE...
BSR ASPRDM
BSR AROND < GENERATION D'UN
STA SAVEZ < NIVEAU ALEATOIRE...
BSR ACERCL < RDN < CHAMP : ON MARQUE UNE ETOILE...
GEN300: EQU $
<
< PASSAGE AU POINT SUIVANT :
<
PLR X,Y
ADRI I,X
LR X,A
CP VECTNC < EXISTE-T'IL ???
JG GEN201 < NON...
BSR AGOTO < OUI...
WORD GEN101 < OUI...
GEN201: EQU $
<
< NON, PASSAGE A LA LIGNE SUIVANTE :
<
ADRI I,Y
LR Y,A
CP VECTNL < EXISTE-T'ELLE ???
JG GEN200 < NON...
BSR AGOTO < OUI...
WORD GEN100 < OUI...
GEN200: EQU $
<
<
< T R A I T E M E N T D E F I N :
<
<
CPZ IQUIT < FAUT-IL S'ARRETER ???
JE GEN410 < NON...
IF EXIST-K,XEIF%,,XEIF%
IF ATTENTION : LE TEST CI-DESSUS EST IDIOT !!!
XEIF%: VAL ENDIF
QUIT XXQUIT < OUI...
GEN410: EQU $
CPZ IVIDEO < FAUT-IL ECRIRE ???
JE GEN400 < NON...
IF EXIST-K,XEIF%,,XEIF%
IF ATTENTION : LE TEST CI-DESSUS EST IDIOT !!!
XEIF%: VAL ENDIF
PSR X < OUI :
IF MULTIS-NEXIST,XEIF%,,XEIF%
LAD DEMVIW
SVC < ON ECRIT L'IMAGE COURANTE...
LAD DEMVIR
SVC < ET ON ATTEND L'ACQUITTEMENT...
XEIF%: VAL ENDIF
IF MULTIS-EXIST,XEIF%,,XEIF%
LAD DEMVIG
SVC < ON MEMORISE L'ADRESSE COURANTE...
LAD DEMVIR
SVC < ATTENTE DE L'ACQUITTEMENT...
LAD DEMVIN
SVC < ON ENVOIE LE PAS (KP1,KP2,KP3)...
LAD DEMVIR
SVC < ATTENTE DE L'ACQUITTEMENT...
LRM X
WORD NPERIO < (X)=NOMBRE D'IMAGES A ECRIRE=NOMBRE
< DE PERIODES.
GEN999: EQU $
PSR X
LAD DEMVIW
SVC < ECRITURE D'UNE IMAGE...
LAD DEMVIR
SVC < ATTENTE DE L'ACQUITTEMENT...
PLR X
JDX GEN999 < VERS L'IMAGE SUIVANTE...
LAD DEMVI1
SVC < RESTAURATION DU PAS UNITE...
LAD DEMVIR
SVC < ATTENTE DE L'ACQUITTEMENT...
LAD DEMVID
SVC < RETOUR EN DEBUT DE SEQUENCE...
LAD DEMVIR
SVC < ATTENTE DE L'ACQUITTEMENT...
LAD DEMVIC
SVC < ET PROGRESSION UNITAIRE DE L'IMAGE
< COURANTE...
LAD DEMVIR
SVC < ATTENTE DE L'ACQUITTEMENT...
XEIF%: VAL ENDIF
PLR X
GEN400: EQU $
BR ADEB9 < A L'IMAGE SUIVANTE...
<
<
< 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' 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 COST
FLOAT 0.8 < COS(TETA).
$EQU TRANSX
WORD 0 < TRANSLATION DE X(PROJETE).
$EQU TRANSY
WORD 0 < TRANSLATION DE Y(PROJETE).
$EQU RAYON
WORD 0 < RAYON DES PARTICULES.
$EQU GRARDN
WORD '1234 < GRARDN DU GENERATEUR ALEATOIRE.
$EQU SUPRDN
NTRN
FLOAT 1 < SUP(RDN).
TRN
$EQU INFRDN
NTRN
FLOAT 0 < INF(RDN).
TRN
$EQU GRARDM
WORD '5678 < GRARDM DU GENERATEUR ALEATOIRE.
$EQU SUPRDM
NTRN
FLOAT <BIT>LOGZ-Z<K<K < SUP(RDM).
TRN
$EQU INFRDM
NTRN
FLOAT <W<K<K < INF(RDM).
TRN
$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 4
$EQU FA1
FLOAT 0.8 < CONTRIBUTION DES SPIRALES.
$EQU FA2
FLOAT 0.8 < CONTRIBUTION GAUSSIENNE.
$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 0.02
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.