echologie
/
TeacherCorner
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

On avance

Browse Source
pull/1/head
Optimal Sup-Spé 3 years ago
parent 599c3aab48
commit 3a3a3df71e
1 changed files with 177 additions and 49 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 226
      src/GenerateurH5P.elm

226
src/GenerateurH5P.elm
Unescape View File

@ -1,28 +1,24 @@
module GenerateurH5P exposing (..)
import Array as A
import Browser exposing (Document)
import Debug
import Dict
import Element exposing (..)
import Element.Background as Background
import Element.Border as Border
import Element.Events exposing (..)
import Element.Font as Font
import Element.Input as Input
import Element.Input exposing (labelHidden, multiline, placeholder)
import File.Download
import Html exposing (Attribute, Html, button, div, iframe, input, p, section, textarea)
import Json.Decode as D
import Json.Encode as E
import List as L
import Parser.Advanced as P exposing (..)
import Random as R
import Random.Extra as REx
import Random.List
import Set
import String as S
import Style exposing (..)
import Tuple
import Tuple exposing (pair)
import UUID exposing (UUID)
@ -30,6 +26,31 @@ titre =
"Générateur d'archives H5P"
{-
.--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--.
/ .. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \.. \
\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/ /
\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /
/ /\/ /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /`' /\/ /\
/ /\ \/`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'\ \/\ \
\ \/\ \ /\ \/ /
\/ /\ \ ████████╗███████╗ █████╗ / /\/ /
/ /\/ / ╚══██╔══╝██╔════╝██╔══██╗ \ \/ /\
/ /\ \/ ██║ █████╗ ███████║ \ \/\ \
\ \/\ \ ██║ ██╔══╝ ██╔══██║ /\ \/ /
\/ /\ \ ██║ ███████╗██║ ██║ / /\/ /
/ /\/ / ╚═╝ ╚══════╝╚═╝ ╚═╝ \ \/ /\
/ /\ \/ \ \/\ \
\ \/\ \.--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--..--./\ \/ /
\/ /\/ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ ../ /\/ /
/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\/ /\
/ /\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \/\ \
\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `'\ `' /
`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'`--'
-}
todo =
Debug.todo "Cette fonctionnalité est en cours de développement"
@ -54,7 +75,8 @@ init : Model
init =
{ source = ""
, generatedContent =
"Copiez-Collez votre contenu à gauche pour voir apparaître le contenu du fichier content.json"
"""Copiez-Collez votre contenu à gauche pour voir
apparaître le contenu du fichier content.json"""
}
@ -99,7 +121,7 @@ update msg model =
S.join "\n\n" << L.map (h5pEncode 2)
generator =
R.map (Tuple.pair source) h5pGenerator
R.map (pair source) h5pGenerator
in
( model
, R.generate NewContent generator
@ -140,7 +162,7 @@ view model =
, width fill
, scrollbars
]
[ Input.multiline
[ multiline
[ height fill
, width fill
, clip
@ -155,10 +177,10 @@ view model =
}
]
{ onChange = Generate
, label = Input.labelHidden "Structure du contenu"
, label = labelHidden "Structure du contenu"
, placeholder =
Just <|
Input.placeholder [] <|
placeholder [] <|
text "Structure du contenu"
, text = model.source
, spellcheck = True
@ -511,13 +533,20 @@ encodedBranchingScenarioStartScreen branchingScenarioStartScreen =
encodedBranchingScenarioContent : BranchingScenarioContent -> E.Value
encodedBranchingScenarioContent branchingScenarioContent =
E.object
E.object <|
[ ( "contentBehaviour", E.string branchingScenarioContent.contentBehaviour )
, ( "feedback", encodedBranchingScenarioContentFeedback branchingScenarioContent.feedback )
, ( "forceContentFinished", E.string branchingScenarioContent.forceContentFinished )
, ( "showContentTitle", E.bool branchingScenarioContent.showContentTitle )
, ( "type", encodedBranchingScenarioContentType branchingScenarioContent.type_ )
]
++ (case branchingScenarioContent.nextContentId of
Just id ->
[ ( "nextContentId", E.int id ) ]
Nothing ->
[]
)
encodedBranchingScenarioContentFeedback : BranchingScenarioContentFeedback -> E.Value
@ -1076,12 +1105,18 @@ encodedCoursePresentationOverrideSocialTwitterShare coursePresentationOverrideSo
encodedCoursePresentationPresentation : CoursePresentationPresentation -> E.Value
encodedCoursePresentationPresentation coursePresentationPresentation =
E.object
[ ( "globalBackgroundSelector", encodedCoursePresentationPresentationGlobalBackgroundSelector coursePresentationPresentation.globalBackgroundSelector )
[ ( "globalBackgroundSelector"
, encodedCoursePresentationPresentationGlobalBackgroundSelector
coursePresentationPresentation.globalBackgroundSelector
)
, ( "keywordListAlwaysShow", E.bool coursePresentationPresentation.keywordListAlwaysShow )
, ( "keywordListAutoHide", E.bool coursePresentationPresentation.keywordListAutoHide )
, ( "keywordListEnabled", E.bool coursePresentationPresentation.keywordListEnabled )
, ( "keywordListOpacity", E.int coursePresentationPresentation.keywordListOpacity )
, ( "slides", E.list encodedCoursePresentationPresentationSlides coursePresentationPresentation.slides )
, ( "slides"
, E.list encodedCoursePresentationPresentationSlides
coursePresentationPresentation.slides
)
]
@ -1096,7 +1131,10 @@ encodedCoursePresentationPresentationSlides : CoursePresentationPresentationSlid
encodedCoursePresentationPresentationSlides coursePresentationPresentationSlides =
E.object
[ ( "elements", E.list (\_ -> E.null) coursePresentationPresentationSlides.elements )
, ( "slideBackgroundSelector", encodedCoursePresentationPresentationSlidesSlideBackgroundSelector coursePresentationPresentationSlides.slideBackgroundSelector )
, ( "slideBackgroundSelector"
, encodedCoursePresentationPresentationSlidesSlideBackgroundSelector
coursePresentationPresentationSlides.slideBackgroundSelector
)
]
@ -1414,17 +1452,19 @@ nouveauTrueFalse =
type Context
= PreambleContext
| RootContext
| UnknownContext
| BranchingScenarioContext
| BranchingQuestionContext
| BranchingQuestionAlternativeContext
| CoursePresentationContext
| TrueFalseContext
| InteractiveVideoContext
parser =
succeed (L.map toH5p)
|. preambleParser
|= inContext RootContext (contentsParser RootContext 1)
|= inContext RootContext (blocs RootContext 1)
|. end EndOfFile
@ -1446,8 +1486,101 @@ contentsParser context depth =
}
blocs context depth =
sequence
{ start = Token "" GenericProblem
, separator = Token "" GenericProblem
, end = Token "" GenericProblem
, spaces = succeed ()
, item = bloc context depth
, trailing = Optional
}
bloc context depth =
succeed pair
|. stars depth
|= star
|. mySpaces
|= oneOf
[ succeed BranchingScenarioContext
|. keyword (Token "BranchingScenario" GenericProblem)
, succeed CoursePresentationContext
|. keyword (Token "CoursePresentation" GenericProblem)
, succeed TrueFalseContext
|. keyword (Token "TrueFalse" GenericProblem)
, succeed InteractiveVideoContext
|. keyword (Token "InteractiveVideo" GenericProblem)
, succeed UnknownContext
]
|. mySpaces
|> andThen (blocHelp context depth)
blocHelp context depth ( maybeStar, subContext ) =
if maybeStar then
problem InconsistantStructure
else
case ( context, subContext ) of
( RootContext, BranchingScenarioContext ) ->
blocHelpHelp BranchingScenarioContext depth
( RootContext, CoursePresentationContext ) ->
blocHelpHelp CoursePresentationContext depth
( RootContext, TrueFalseContext ) ->
blocHelpHelp TrueFalseContext depth
( BranchingScenarioContext, CoursePresentationContext ) ->
blocHelpHelp CoursePresentationContext depth
( BranchingScenarioContext, UnknownContext ) ->
blocHelpHelp BranchingQuestionContext depth
( BranchingQuestionContext, UnknownContext ) ->
blocHelpHelp BranchingQuestionAlternativeContext depth
( CoursePresentationContext, TrueFalseContext ) ->
blocHelpHelp TrueFalseContext depth
( BranchingQuestionAlternativeContext, CoursePresentationContext ) ->
blocHelpHelp CoursePresentationContext depth
( BranchingQuestionAlternativeContext, UnknownContext ) ->
blocHelpHelp BranchingQuestionContext depth
( _, BranchingScenarioContext ) ->
problem (Problem "Un BranchingScenario doit se trouver à la racine")
( _, CoursePresentationContext ) ->
problem (Problem """Un CoursePresentation doit se trouver à la racine,
sous un BranchingScenario ou dans une alternative de BranchingQuestion""")
( _, TrueFalseContext ) ->
problem (Problem "Un TrueFalse doit se trouver à la racine ou dans un CoursePresentation")
( _, InteractiveVideoContext ) ->
problem <| UnknownContentType "InteractiveVideoContext"
_ ->
problem <| UnknownContentType ""
blocHelpHelp context depth =
let
f endOfLine contentList =
H5pTree context endOfLine contentList
in
inContext context <|
succeed f
|= tillEndOfLine
|. whileNoStarOnFirstColumnOrEndOfFile
|= blocs context (depth + 1)
contentParser context depth =
succeed Tuple.pair
succeed pair
|. stars depth
|= star
|. mySpaces
@ -1487,7 +1620,8 @@ contentParser context depth =
contentParserHelp CoursePresentationContext depth ""
( "CoursePresentation", _ ) ->
problem (Problem "Un CoursePresentation doit se trouver à la racine, sous un BranchingScenario ou dans une alternative de BranchingQuestion")
problem (Problem """Un CoursePresentation doit se trouver à la racine,
sous un BranchingScenario ou dans une alternative de BranchingQuestion""")
( "TrueFalse", RootContext ) ->
contentParserHelp TrueFalseContext depth ""
@ -1855,6 +1989,12 @@ showContextHelp depth ccc =
TrueFalseContext ->
f "TrueFalse\n"
InteractiveVideoContext ->
f "InteractiveVideo\n"
_ ->
""
{-
@ -1915,18 +2055,15 @@ toH5p tree =
R.constant <| TrueFalseH5P nouveauTrueFalse
toBranchingScenarioContentTypeParams : H5pTree -> R.Generator BranchingScenarioContentTypeParams
toBranchingScenarioContentTypeParams tree =
case tree of
H5pTree CoursePresentationContext title subTrees ->
R.constant <|
CoursePresentationBranchingScenarioContentTypeParams (new coursePresentationField)
_ ->
R.constant <| CoursePresentationBranchingScenarioContentTypeParams (new coursePresentationField)
--toBranchingScenarioContentTypeParams : H5pTree -> R.Generator BranchingScenarioContentTypeParams
--toBranchingScenarioContentTypeParams tree =
-- case tree of
-- H5pTree CoursePresentationContext title subTrees ->
-- R.constant <|
-- CoursePresentationBranchingScenarioContentTypeParams (new coursePresentationField)
-- _ ->
-- R.constant <| CoursePresentationBranchingScenarioContentTypeParams (new coursePresentationField)
{- fromBranchingScenarioSubTrees state trees =
case trees of
[] ->
@ -1998,15 +2135,14 @@ fromBranchingScenario state trees =
|> with2 typeField paramsField params
|> with2 typeField subContentIdField (UUID.toString uuid)
-- À vérifier
|> with nextContentIdField (Just (state.lastIdUsed + 1))
|> with nextContentIdField (Just state.lastIdUsed)
newState =
case tree of
H5pTree BranchingQuestionContext question subTrees ->
let
content =
-- Ordre à revoir
R.map2 L.append state.content newContent.content
R.map2 L.append newContent.content state.content
newContent =
fromBranchingQuestion
@ -2024,9 +2160,6 @@ fromBranchingScenario state trees =
H5pTree CoursePresentationContext title subTrees ->
let
content =
R.map2 (::) newContent state.content
newContent =
buildContent
coursePresentationBuilder
@ -2036,23 +2169,16 @@ fromBranchingScenario state trees =
subTrees
in
{ state
| content = content
| content = R.map2 (::) newContent state.content
, lastIdUsed = state.lastIdUsed + 1
}
_ ->
let
content =
R.constant []
--state.content
-- |> todo
--|> R.map ((::) (toBranchingScenarioContentTypeParams tree))
lastIdUsed =
state.lastIdUsed + 1
in
{ state
| content = content
| --state.content
-- |> todo
--|> R.map ((::) (toBranchingScenarioContentTypeParams tree))
content = R.constant []
, lastIdUsed = state.lastIdUsed + 1
}
in
@ -2105,7 +2231,7 @@ fromBranchingQuestion state trees =
params =
BranchingQuestionBranchingScenarioContentTypeParams
{ alternatives = state.alternatives
{ alternatives = L.reverse state.alternatives
, question = state.question
}
@ -2118,7 +2244,9 @@ fromBranchingQuestion state trees =
|> with2 typeField subContentIdField (UUID.toString uuid)
content =
R.map2 (::) branchingQuestion state.content
state.content
|> R.map2 (::) branchingQuestion
|> R.map L.reverse
in
{ content = content
, lastIdUsed = state.lastIdUsed

Write Preview
Loading…
Cancel
Save