Procédures | Cast3M

* @HISTOGR  PROCEDUR  BP208322  19/08/23    21:15:01     10289          
************************************************************************
* NOM         : @HISTOGR
* DESCRIPTION : Création/Tracé de données sous forme d'histogramme
************************************************************************
* HISTORIQUE :  2/05/2012 : JCARDO : création de la procédure
* HISTORIQUE : 22/08/2019 : BP 
* HISTORIQUE :
************************************************************************
* Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
* en cas de modification de ce sous-programme afin de faciliter
* la maintenance !
************************************************************************
* ENTRÉES :: LVAL1*'LISTREEL' = données à tracer
*            TOPT1/'TABLE'    = mise en forme des barres du graphique
*            LSOR1/'LOGIQUE'  = renvoyer des objets en sortie ?
* SORTIES :: EVOHIS/'EVOLUTION' = courbes à transmettre à DESS
*            TABHIS/'TABLE'     = options de format à transmettre à DESS
************************************************************************
* SYNTAXE (GIBIANE) :
*
*         (EVOHIS TABHIS) = @HISTOGR LVAL1 (TOPT1) (LSOR1)
*
************************************************************************
 
DEBP @HISTOGR LVAL1*'LISTREEL' TOPT1/'TABLE' LSOR1/'LOGIQUE' ;
 
EVO1 = VIDE 'EVOLUTIO' ;
 
* ==========================================
* RÉCUPÉRATION ET VÉRIFICATION DES ARGUMENTS
* ==========================================
 
NVAL1 = DIME LVAL1 ;
SI (NVAL1 EGA 0) ;
    QUIT @HISTO ;
FINS ;
 
* Renvoyer une EVOLUTION et une TABLE en sortie ?
BSOR1 = FAUX ;
SI (EXIS LSOR1) ;
    BSOR1 = LSOR1 ;
FINS ;
 
* Parcours de la table d'options TOPT1
* ----------------------------------------------------------------
* 'COUL' [MOT ou LISTMOTS] = Couleur(s) des barres  (défaut='DEFA')
* 'NOMS' [TABLE]           = Noms des barres        (défaut=aucun)
* 'LARG' [LISTREEL]        = Largeurs des barres    (défaut=0.8)
* 'ESPA' [FLOTTANT]        = Espace entre 2 barres  (défaut=0.2)
* 'HPOS' [FLOTTANT]        = Décalage horizontal    (défaut=0.)
* 'INVE' [LOGIQUE]         = De droite à gauche ?   (défaut=FAUX)
* 'DESS' [MOT]             = Options passées à DESS (défaut=' ')
* ----------------------------------------------------------------
SI (NON (EXIS TOPT1)) ;
    TOPT1 = TABL ;
FINS ;
 
* COUL
* ---------------------------------------------------------------------
LCOUL = MOTS 'DEFA' 'BLEU' 'ROUG' 'ROSE' 'VERT' 'TURQ' 'JAUN' 'BLAN'
             'NOIR' 'VIOL' 'ORAN' 'AZUR' 'OCEA' 'CYAN' 'OLIV' 'GRIS' ;
COUMULT = FAUX ;
LCOU1 = MOTS 'DEFA' ;
SI (EXIS TOPT1 'COUL') ;
    SI (EGA (TYPE (TOPT1 . 'COUL')) 'MOT') ;
        LCOU1 = MOTS (TOPT1 . 'COUL') ;
    SINON ;
        SI (EGA (TYPE (TOPT1 . 'COUL')) 'LISTMOTS') ;
            COUMULT = VRAI ;
            LCOU1 = TOPT1 . 'COUL' ;
        SINON ;
            MESS 'Indice "COUL" : type d objet incorrect' ;
            QUIT @HISTO ;
        FINS ;
    FINS ;
FINS ;
 
* NOMS
* ---------------------------------------------------------------------
BNOM1 = FAUX ;
SI (EXIS TOPT1 'NOMS') ;
    SI (EGA (TYPE (TOPT1 . 'NOMS')) 'TABLE') ;
        TNOM1 = TOPT1 . 'NOMS' ;
        BNOM1 = VRAI ;
    SINON ;
        MESS 'Indice "NOMS" : type d objet incorrect' ;
        QUIT @HISTO ;
    FINS ;
FINS ;
 
* LARG
* ---------------------------------------------------------------------
LLAR1 = PROG NVAL1*0.8 ;
SI (EXIS TOPT1 'LARG') ;
    SI (EGA (TYPE (TOPT1 . 'LARG')) 'LISTREEL') ;
        LLAR1 = TOPT1 . 'LARG' ;
        SI (NEG (DIME LLAR1) NVAL1) ;
            MESS 'Indice "LARG" : liste de longueur incorrecte' ;
            QUIT @HISTO ;
        FINS ;
    SINON ;
        MESS 'Indice "LARG" : type d objet incorrect' ;
        QUIT @HISTO ;
    FINS ;
FINS ;
 
* ESPA
* ---------------------------------------------------------------------
ESPA1 = 0.2 ;
SI (EXIS TOPT1 'ESPA') ;
    SI (EGA (TYPE (TOPT1 . 'ESPA')) 'FLOTTANT') ;
        ESPA1 = ABS TOPT1 . 'ESPA' ;
    SINON ;
        MESS 'Indice "ESPA" : type d objet incorrect' ;
        QUIT @HISTO ;
    FINS ;
FINS ;
 
* HPOS
* ---------------------------------------------------------------------
HPOS1 = 0. ;
SI (EXIS TOPT1 'HPOS') ;
    SI (EGA (TYPE (TOPT1 . 'HPOS')) 'FLOTTANT') ;
        HPOS1 = TOPT1 . 'HPOS' ;
    SINON ;
        MESS 'Indice "HPOS" : type d objet incorrect' ;
        QUIT @HISTO ;
    FINS ;
FINS ;
 
* INVE
* ---------------------------------------------------------------------
DIR1 = 1. ;
SI (EXIS TOPT1 'INVE') ;
    SI (EGA (TYPE (TOPT1 . 'INVE')) 'LOGIQUE') ;
        SI (EGA (TOPT1 . 'INVE') VRAI) ;
            DIR1 = -1. ;
        FINS ;
    SINON ;
        MESS 'Indice "INVE" : type d objet incorrect' ;
        QUIT @HISTO ;
    FINS ;
FINS ;
 
* DESS
* ---------------------------------------------------------------------
BDES1 = FAUX ;
MDES1 = ' ' ;
SI (EXIS TOPT1 'DESS') ;
    SI (EGA (TYPE (TOPT1 . 'DESS')) 'MOT') ;
        BDES1 = VRAI ;
        MDES1 = TOPT1 . 'DESS' ;
    SINON ;
        MESS 'Indice "DESS" : type d objet incorrect' ;
        QUIT @HISTO ;
    FINS ;
FINS ;
 
 
* ============================
* FABRICATION DE L'HISTOGRAMME
* ============================
 
EVOHIS TABHIS = VIDE 'EVOLUTIO' 'TABLE' ;
TABHIS . 'TITRE' = TABL ;
 
XPOS = DIR1*HPOS1 ;
REPE BLOHIS NVAL1 ;
 
*   Récupération des paramètres de la barre
    VAL1 = EXTR LVAL1 &BLOHIS ;
    LAR1 = EXTR LLAR1 &BLOHIS ;
    MCOU1 = EXTR LCOU1 ((@MOD (&BLOHIS - 1) (DIME LCOU1)) + 1) ;
    NOM1 = CHAI &BLOHIS ;
    SI (BNOM1) ;
        SI (EXIS TNOM1 &BLOHIS) ;
            NOM1 = CHAI TNOM1 . &BLOHIS ;
        FINS ;
    FINS ;
 
*   Création des listes LX et LY
    LX = PROG ;
    LY = PROG ;
    SI (ESPA1 > 0.) ;
        XPOS = XPOS + (0.5*DIR1*ESPA1) ;
    FINS ;
    LX = LX ET XPOS ;
    LY = LY ET VAL1 ;
    XPOS = XPOS + (DIR1*LAR1) ;
    LX = LX ET XPOS ;
    LY = LY ET VAL1 ;
    SI (ESPA1 > 0.) ;
        XPOS = XPOS + (0.5*DIR1*ESPA1) ;
    FINS ;
 
*   Mise à jour de EVOHIS et TABHIS
    EVO1 = EVOL MCOU1 'MANU' 'TYPE' 'HIST' 'LEGE' NOM1 LX LY ;
    EVOHIS = EVOHIS ET EVO1 ;
    TABHIS . 'TITRE' . &BLOHIS = CHAI NOM1 ;
    TABHIS . &BLOHIS = MOT 'REMP' ;
 
FIN BLOHIS ;
 
 
* ===================
* FIN DE LA PROCEDURE
* ===================
 
SI (BDES1) ;
    DESS EVOHIS TABHIS (TEXT MDES1) ;
FINS ;
 
SI (BSOR1) ;
    RESP EVOHIS TABHIS ;
FINS ;
 
FINP ;