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 :
<
ABLOC0:  WORD        K               < ADRESSE DU PREMIER BLOC A LIRE.
LBLOC:   WORD        LBUFMT          < LONGUEUR DES BLOCS PHYSIQUES SUR LA
                                     < BANDE.
FIRSTX:  WORD        K               < PREMIER POINT A TRACER ('XMAX' OU 'K'),
LASTX:   WORD        XMAX            < DERNIER POINT A TRACER ('K' OU 'XMAX').
                                     < (FIRSTX,LASTX) PERMETTENT D'INVERSER
                                     < LE SENS DU BALAYAGE HORIZONTAL.
FIRSTY:  WORD        YMAX            < PREMIERE LIGNE A TRACER ('YMAX' OU 'K'),
LASTY:   WORD        K               < DERNIERE LIGNE A TRACER ('K' OU 'YMAX'),
                                     < (FIRSTY,LASTY) PERMETTENT D'INVERSER
                                     < LE SENS DU BALAYAGE VERTICAL...
IERASE:  WORD        NEXIST          < EFFACER ('EXIST'), OU NON ('NEXIST')
                                     < L'ECRAN 512...
IVIDEO:  WORD        NEXIST          < ECRIRE ('EXIST') L'IMAGE COURANTE SUR LE
                                     < DISQUE VIDEO OU PAS ('NEXIST').
IQUIT:   WORD        NEXIST          < S'ARRETER ('EXIST') OU PAS ('NEXIST')
                                     < APRES CHAQUE IMAGE (POINT D'ARRET).
PASIXY:  WORD        W               < DEFINITION DE L'IMAGE :
                                     < 1 : 512*512,
                                     < 2 : 256*256.
ICAMER:  WORD        NEXIST          < ECRIRE ('EXIST') L'IMAGE COURANTE SUR LE
                                     < DISQUE CAMER OU PAS ('NEXIST').
NCAMER:  WORD        NILK            < NOMBRE D'IMAGES CAMERA A ENREGISTRER
                                     < PAR IMAGE NUMERIQUE.
<
< 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#
<
< 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
<
< 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...
ANIVO:   WORD        NIVO            < SOUS-PROGRAMME D'ACCES AU NIVEAU COURANT.
<
< 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
<
< DONNEES DE BALAYAGE :
<
PASIX:   WORD        NILK            < BALAYAGE HORIZONTAL,
PASIY:   WORD        NILK            < BALAYAGE VERTICAL.
<
< DONNEES DE PILOTAGE D'UNE CAMERA :
<
COPY:    BYTE        NVPOUT;FAVWD    < ECRITURE DIRECTE SUR LA VISU
                                     < EN VUE DE FAIRE UN HARD-COPY.
         BYTE        '1B;'17;'8D;'1D < CTRL-SHIFT-K, CTRL-W, R/C, GS.
                                     < AVEC LE BIT0=1 DESTINE AUX
                                     < FIN DE MESSAGE DES EMISSIONS SUR
                                     < LES LIGNES BOUCLEES VI1/VI2.
SLEEP:   BYTE        K;FONDOR        < DEMANDE DE TEMPORISATION POUR
                                     < FAIRE UNE COPY.
         WORD        NILK
         WORD        4               < 4 SECONDES DE TEMPORISATION
                                     < POUR FAIRE UN HARD-COPY.
         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
         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
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 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         $
<
< 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 :
<
         BSR         ASTORP          < MARQUAGE : (X,Y) <-- (A)...
<
< ET RETOUR :
<
         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#
         PAGE
<
<
<        A C C E S   A U   N I V E A U   C O U R A N T  :
<
<
<        ARGUMENT :
<                    (IBUFMT)=INDEX DE L'OCTET COURANT.
<
<
<        RESULTAT :
<                    (A)=OCTET COURANT.
<
<
NIVO:    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          NIVO1           < NON...
<
< CAS OU LE BUFFER EST VIDE :
<
NIVO2:   EQU         $
         LAD         DEMMT           < (A)=ADRESSE DE LA DEMANDE,
         SVC                         < QUE L'ON ENVOIE...
         JE          NIVO3           < OK...
         QUIT        XXQUIT          < E R R E U R   D ' A S S I G N A T I O N..
         JMP         NIVO2           < ET ON RE-TENTE, OU BIEN ON ARRETE S'IL
                                     < S'AGIT D'UN 'TAPE-MARK'...
NIVO3:   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         NIVO2           < NON, ON LIT L'ENREGISTREMENT SUIVANT...
         LAI         K               < (A)=INDEX DU PREMIER OCTET.
<
< ACCES A L'OCTET COURANT :
<
NIVO1:   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
<
<
<        P O I N T   D ' E N T R E E  :
<
<
DEBUT:   EQU         $
<
< INITIALISATION DES REGISTRES :
<
         LRM         C,K
         WORD        COM+DEPBAS      < POSITIONNEMENT DE 'C',
         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...
<
< BALAYAGE HORIZONTAL :
<
         LBI         +I              < (B)=BALAYAGE VERS LA DROITE A PRIORI...
         LA          FIRSTX          < (A)=PREMIER POINT,
         CP          LASTX           < EST-IL AVANT LE DERNIER ???
         JL          INIT22          < OUI, ON VA A DROITE A PRIORI...
         NGR         B,B             < NON, ON VA A GAUCHE, ON INVERSE (B)...
INIT22:  EQU         $
INIT25:  EQU         $
         LA          PASIXY          < (A)=DEFINITION DE L'IAMGE :
         CPI         W               < 512*512 ???
         JE          INIT23          < OUI, (B) EST BON...
         CPI         W+W             < 256*256 ???
         JE          INIT24          < OUI...
         QUIT        XXQUIT          < E R R E U R   P A R A M E T R E ...
         JMP         INIT25          < ET ON RETESTE...
INIT24:  EQU         $
         ADR         B,B             < ET ON DOUBLE DONC LE PAS DE PARCOURS...
INIT23:  EQU         $
         STB         PASIX           < MISE EN PLACE DU PAS DE BALAYAGE
                                     < HORIZONTAL...
<
< BALAYAGE VERTICAL :
<
         LBI         +I              < (B)=BALAYAGE VERS LE BAS A PRIORI...
         LA          FIRSTY          < (A)=PREMIERE LIGNE,
         CP          LASTY           < EST-ELLE AVANT LA DERNIERE ???
         JL          INIT02          < OUI, ON DESCEND, (B) EST BON...
         NGR         B,B             < NON, ON MONTE, ON INVERSE (B)...
INIT02:  EQU         $
INIT05:  EQU         $
         LA          PASIXY          < (A)=DEFINITION DE L'IAMGE :
         CPI         W               < 512*512 ???
         JE          INIT03          < OUI, (B) EST BON...
         CPI         W+W             < 256*256 ???
         JE          INIT04          < OUI...
         QUIT        XXQUIT          < E R R E U R   P A R A M E T R E ...
         JMP         INIT05          < ET ON RETESTE...
INIT04:  EQU         $
         ADR         B,B             < ET ON DOUBLE DONC LE PAS DE PARCOURS...
INIT03:  EQU         $
         STB         PASIY           < MISE EN PLACE DU PAS DE BALAYAGE
                                     < VERTICAL...
<
<
<        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'.
<
< RECUPERATION DE L'IMAGE :
<
GEN69N:  EQU         $
         LY          FIRSTY          < (Y)=COORDONNEE 'Y'...
GEN01:   EQU         $
         LX          FIRSTX          < (X)=COORDONNEE 'X'...
GEN02:   EQU         $
         BSR         ANIVO           < (A)=NIVEAU DU POINT (X,Y),
         BSR         APOINT          < ET ON MARQUE LE POINT (X,Y)...
         LB          PASIXY          < (B)=DEFINITION DE L'IAMGE :
         XR          A,B             < (A)=DEFINITION DE L'IMAGE,
                                     < (A)=NIVEAU DU POINT...
         CPI         W               < 512*512 ???
         XR          A,B             < RESTAURE (A) ET (B)...
         JE          GEN07           < OUI, 512*512...
         PSR         X,Y             < NON, 256*256 :
         ADRI        I,X
         BSR         APOINT          < MARQUAGE DE (X+1,Y),
         CPZ         PASIY           < MONTE-T'ON OU DESCEND-ON ???
         JL          GEN05           < ON DESCEND...
         ADRI        I,Y             < ON MONTE...
         JMP         GEN06
GEN05:   EQU         $
         ADRI        -I,Y            < ON DESCEND...
GEN06:   EQU         $
         BSR         APOINT          < MARQUAGE DE (X+1,Y+-1),
         ADRI        -I,X
         BSR         APOINT          < MARQUAGE DE (X,Y+-1).
         PLR         X,Y             < ET RESTAURATION DE (X,Y)...
GEN07:   EQU         $
         LA          PASIX           < (A)=PAS DE BALAYAGE HORIZONTAL,
         ADR         A,X             < PASSAGE A UN AUTRE POINT,
         LR          X,A
         CPZ         PASIX           < VA-T'ON A DROITE OU A GAUCHE ???
         JL          GEN13           < A GAUCHE...
         CP          LASTX           < A DROITE, A-T'ON FINI ???
         JLE         GEN02           < NON...
         JMP         GEN14           < OUI...
GEN13:   EQU         $
         CP          LASTX           < A GAUCHE, A-T'ON FINI ???
         JGE         GEN02           < NON...
GEN14:   EQU         $               < OUI, C'EST FINI...
         LA          PASIY           < (A)=PAS DE BALAYAGE VERTICAL,
         ADR         A,Y             < PASSAGE A LA LIGNE SUIVANTE,
         LR          Y,A
         CPZ         PASIY           < MONTE-T'ON OU DESCEND-T'ON ???
         JL          GEN03           < ON DESCEND...
         CP          LASTY           < ON MONTE, A-T'ON FINI ???
         JLE         GEN01           < NON...
         JMP         GEN04           < OUI...
GEN03:   EQU         $
         CP          LASTY           < ON DESCEND, A-T'ON FINI ???
         JGE         GEN01           < NON...
GEN04:   EQU         $               < OUI, C'EST FINI...
<
< NON, TRAITEMENT DE FIN...
<
         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         $
         CPZ         ICAMER          < FAUT-IL FILMER ???
         JE          GEN470          < NON...
         IF          EXIST-K,XEIF%,,XEIF%
         IF          ATTENTION : LE TEST CI-DESSUS EST IDIOT !!!
XEIF%:   VAL         ENDIF
         PSR         X               < OUI :
         LX          NCAMER          < (X)=NOMBRE D'IMAGES A FILMER...
GEN471:  EQU         $
         PSR         X
         LAD         COPY
         SVC                         < ENVOI DE LA COMMANDE HARD-COPY.
         LAD         SLEEP
         SVC                         < ET ON ATTEND LA FIN DE LA PRISE DE VUE...
         PLR         X
         JDX         GEN471
         PLR         X
GEN470:  EQU         $
         BSR         AGOTO
         WORD        DEBUT9          < 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,K             < ON REINITIALISE 'C' ET 'K' AU CAS
                                     < D'UNE RE-ENTREE PAR UN 'ALT-MODE'...
         WORD        COM+DEPBAS      < 'C',
         WORD        STACK-DEPILE    < 'K'.
         BSR         AGOTO
         WORD        DEBUT4          < (A)=ADRESSE D'ITERATION SUR ALT-MODE...
         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.