R/annoter.R

In SARP.moodle: XML Output Functions for Easy Creation of Moodle Questions

## —————————————————————————————————————————————————————————————————
## Création de XML Moodle avec R
## Emmanuel Curis — juin 2015
##
## Question de type « annoter une image »
##   (construite sur la base d'une question « cloze »)
## —————————————————————————————————————————————————————————————————
## HISTORIQUE
##   18 juin    2024 : création du fichier
##
##   26 juillet 2024 : première version avec un fichier image
##
##   29 juillet 2024 : nom du fichier image créé plus cohérent
##                     harmonisation des noms de la data.frame renvoyée
##                     le titre de la question est correctement transmis
##
##   31 juillet 2024 : ébauche pour avoir les réponses en plusieurs colonnes
##
##    8 août    2024 : essais de champs superposés à l'image
## —————————————————————————————————————————————————————————————————

## —————————————————————————————————————————————————————————————————
##
##                           Annoter une image
##      (version avec éléments numérotés sur l'image et texte libre)
## 
## —————————————————————————————————————————————————————————————————

annoter_image.moodle <- function( texte, titre = "Annoter la figure...",
                                  f.creer_figure,
                                  fichier.image,
                                  legendes, 
                                  x.numeros, y.numeros, 
                                  numeros = if ( superposer ) rep( "", length( legendes ) ) else 1:length( legendes ),
                                  superposer = all( !missing( x.numeros ),
                                                    !missing( y.numeros ) ),
                                  description.image = NULL, n.colonnes = 1,
                                  commentaire.global = NA, penalite = NA, note.question = NA,
                                  idnum = NA, temps, tags = NULL,
                                  fichier.xml = get( "fichier.xml", envir = SARP.Moodle.env ),
                                  ... )
{
    ## Contrôles
    if ( all( missing( f.creer_figure ),
              missing( fichier.image  ) ) ) {
        erreur( -1, annoter_image.moodle,
                "Il faut indiquer soit un fichier contenant l'image,",
                " soit une fonction pour la cr\u00e9er" )
    }
    if ( all( !missing( f.creer_figure ),
              !missing( fichier.image  ) ) ) {
        erreur( -1, annoter_image.moodle,
                "Il faut indiquer soit un fichier contenant l'image,",
                " soit une fonction pour la cr\u00e9er,",
                " mais pas les deux" )
    }
    
    ## On crée l'image de fond
    if ( !missing( f.creer_figure ) ) {
        ## On crée l'image
        fichier.image <- tempfile( "ai_", fileext = ".png" )
        png( fichier.image, width = 600, height = 400 )

        ## On appelle la fonction pour le dessin
        ##   Elle doit renvoyer une data.frame avec au moins $X, $Y, $Textes
        ##                      ou NULL éventuellement
        marques <- f.creer_figure( ... )

        if ( !is.null( marques ) ) {
            ## Normalisation des noms
            marques <- normaliser.nom( marques, "N",
                                       c( "Numero", "Num\u00e9ro", "Number" ) )
            marques <- normaliser.nom( marques, "Legendes",
                                       c( "R\u00e9ponse", "Reponse",
                                          "L\u00e9gende", "L\u00e9gendes",
                                          "Answer", "Texte" ) )
            
            ## On ajoute les numéros, s'ils n'existent pas
            if ( !hasName( marques, "N" ) ) {
                if ( superposer ) {
                    marques$N <- rep( "", nrow( marques ) )
                } else {
                    marques$N <- 1:nrow( marques )
                }
            }

            ## print( marques )

            ## On récupère les textes à afficher
            legendes <- as.character( marques$Legendes )
            numeros  <- as.character( marques$N )
            if ( superposer ) {
                ## On prépare les positions
                x.numeros <- grconvertX( marques$X, from = "user", to = "device" )
                y.numeros <- grconvertY( marques$Y, from = "user", to = "device" )
            }
        }

        ## On termine l'image
        dev.off()
    }

    ## On vérifie que le fichier avec l'image existe bien
    if ( FALSE == file.exists( fichier.image ) ) {
        erreur( 102, "annoter_image.moodle",
                "Fichier d'image de fond inexistant !",
                " [", fichier.image, "]" )
    }

    ## Le nombre de réponses voulues
    n.champs <- length( legendes )

    ## On crée le texte préparatoire
    texte.intro <- paste0( texte, "<br />\n" )
    if ( !superposer ) {
        texte.intro <- paste0( texte.intro,
                               lier_image.moodle( nom.image = fichier.image,
                                                  description = description.image, 
                                                  interne = TRUE ) )
    }

    ## On ajoute l'indication de temps éventuelle
    if ( !missing( temps ) ) {
        texte.intro <- paste0( texte.intro, "<br />\n",
                               temps_necessaire.moodle( temps ) )
    }

    if ( superposer ) {
        dim <- magick::image_info( magick::image_read( fichier.image ) )
        texte.intro <- paste0( texte.intro,
                               "<div style=\"background-image:",
                               " url(&quot;@@PLUGINFILE@@/", 
                               basename( fichier.image ), "&quot;);",
                               " background-color: Red;",
                               " background-repeat: no-repeat;",
                               " position: relative;",
                               " width: ", dim$width, "px;",
                               " height: ", dim$height, "px;",
                               "\">" )
    } else {
        ## Un filet pour séparer les champs de réponse
        texte.intro <- paste0( texte.intro, "<br >\n",
                               "<hr />\n" )
    }

    ## Au besoin : tableau pour la mise en forme
    if ( ( n.colonnes > 1 ) && ( !superposer ) ) {
        texte.intro <- paste0( texte.intro,
                               "<table style=\"border: none;\">",
                               "<tr>", "<td>" )
        n.par_case <- n.champs %/% n.colonnes
        if ( n.champs %% n.colonnes > 0 ) {
            n.par_case <- n.par_case + 1
        }
    }
    
    ## Les champs de réponses
    textes.avant <- c( ifelse( nchar( numeros[ 1 ] ) > 0,
                               paste0( "<b>", numeros[ 1 ], "</b>&nbsp;: " ),
                               "" ),
                       ifelse( nchar( numeros[ -1 ] ) > 0,
                               paste0( if ( !superposer ) "<br />\n",
                                       "<b>", numeros[ -1 ], "</b>&nbsp;: " ),
                               "" ) )
    if ( ( n.colonnes > 1 ) && ( !superposer ) ) {
        idx <- ( 1:(n.colonnes - 1 ) ) * n.par_case + 1
        textes.avant[ idx ] <- paste0( "</td><td>",
                                       gsub( "^<br />", "", 
                                             textes.avant[ idx ] ) )
    } else if ( superposer ) {
        if ( any( length( x.numeros ) != length( legendes ),
                  length( y.numeros ) != length( legendes ) ) ) {
            erreur( 8745, "annoter_image.moodle",
                    "Incoh\u00e9rence de nombre d'informations",
                    " entre les positions et les l\u00e9gendes;" )
        }
        textes.avant <- paste0( c( "", rep( "</div>", n.champs - 1 ) ),
                                "<div style=\"position: absolute;",
                                " top:", y.numeros, "px;",
                                " left:", x.numeros, "px;",
                                "\">", textes.avant )
    }
    reponses <- legendes
    types <- rep( "SHORTANSWER", n.champs )

    ## Le texte final
    texte.final <- ""
    if ( ( n.colonnes > 1 ) && ( !superposer ) ) {
        texte.final <- paste0( texte.final,
                               "</td>", "</tr>",
                               "</table>" )
    } else if ( superposer ) {
        texte.final <- paste0( texte.final,
                               " </div>",
                               "</div>" )
    }

    
    ## On crée la question
    ## print( texte.intro )
    question_libre.moodle( texte.intro, textes.avant, texte.final = texte.final,
                           reponses = reponses, types = types,
                           commentaire.global = commentaire.global,
                           penalite = penalite, note.question = note.question,
                           idnum = idnum, tags = tags,
                           fichier.xml = fichier.xml, titre = titre )
}