fp2/week6/mart/GuessWhat.icl

   1 module GuessWhat
   2
   3 /* Instructions:
   4
   5 (1) copy this main file (GuessWhat.icl), QA_shapes.(d/i)cl, and QA.(d/i)cl in the folder:
   6     {iTasks-SDK}\Experiments\SVG_tests\
   7
   8 (2) create a new project and set de environment to 'iTasks'
   9
  10 (3) Bring-Up-To-Date and start generated application
  11
  12 (4) Open a browser and navigate to localhost.
  13     The application creates a task that randomly selects a number of image-name pairs and asks the user to
  14     give the right name to the right image. Once this is done correctly, the task terminates, otherwise the
  15     user can try again.
  16
  17 (5) Create a new set of QA-shapes. You can choose one of the following:
  18     (i)  Dutch traffic signs. See attached document:
  19          Reglement-verkeersregels-en-verkeersteke.pdf, appendix 1, hoofdstuk A upto L.
  20
  21          Implement **at least 15** traffic signs. In your solution, clearly indicate at each traffic sign
  22          which one you have implemented (use the numbers in the right-most column in the above document).
  23
  24
  25     (ii) European flags. See the following wikipedia page:
  26          http://nl.wikipedia.org/wiki/Lijst_van_vlaggen_van_Europa
  27
  28          Implement **at least 15** flags. In your solution, clearly indicate at each flag which one you
  29          have implemented by the name of the nation or organization.
  30 */
  31
  32 import iTasks                                                   // de algemene iTask API
  33 import iTasks.API.Extensions.SVG.SVGlet // specialiseer task editors
  34 from   Data.List import zipWith
  35
  36 import QA_shapes                                                // the QA elements that have to be guessed
  37
  38 nr_of_qas :== 10
  39
  40 Start :: *World -> *World
  41 Start world = startEngine [publish "/" (WebApp []) (\_ -> play queries)] world
  42
  43 play :: [QA] -> Task String
  44 play []
  45         = viewInformation "missing queries" [] "No queries are available"
  46 play qas
  47         =             sequence "throw dice" (repeatn (nr_of_qas + length qas) (get randomInt))
  48           >>= \nrs -> let (nrs1,nrs2)   = splitAt nr_of_qas nrs
  49                           shuffled_qas  = shuffle nrs2 qas
  50                           (qs,as)               = unzip (take nr_of_qas shuffled_qas)
  51                           sas                   = shuffle nrs1 as
  52                        in keep_guessing qs as sas
  53
  54 keep_guessing :: [Image ()] [String] [String] -> Task String
  55 keep_guessing qs as sas
  56         =             allTasks [guess i q sas \\ q <- qs & i <- [1 ..]]
  57           >>* [ OnAction (Action "Check" []) (hasValue (check_answers qs as sas))
  58               , OnAction ActionQuit          (always   (return "Goodbye"))
  59               ]
  60
  61 check_answers :: [Image ()] [String] [String] [String] -> Task String
  62 check_answers qs as sas nas
  63 | ok == nr_of_qas
  64         = viewInformation "Tada!" [] "Congratulations! All correct!"
  65 | otherwise
  66         = (viewInformation "Ouch!" [] ("Too bad: there are " <+++ nr_of_qas - ok <+++ " mistakes.")
  67               ||-
  68            allTasks [  ((show_image i q <<@ ArrangeHorizontal)
  69                             ||-
  70                         (viewInformation "isn't" [] a <<@ ArrangeHorizontal)
  71                        ) <<@ ArrangeHorizontal
  72                     \\ wrong <- zipWith (<>) as nas
  73                      & q     <- qs
  74                      & a     <- nas
  75                      & i     <- [1 ..]
  76                      | wrong
  77                     ]
  78           ) >>* [ OnAction (Action "Try again" []) (always (keep_guessing qs as sas))
  79                 , OnAction ActionQuit              (always (return "Goodbye"))
  80                 ]
  81 where
  82         ok = length [() \\ a <- as & b <- nas | a == b]
  83
  84 show_image :: Int (Image ()) -> Task ()
  85 show_image i q = viewInformation ("image " <+++ i) [imageView (\_ _ -> q) (\_ _ -> Nothing)] ()
  86
  87 guess :: Int (Image ()) [String] -> Task String
  88 guess i q sas
  89         = ( (show_image i q <<@ ArrangeHorizontal)
  90            ||-
  91         (enterChoice "is:" [ChooseWith (ChooseFromComboBox id)] sas <<@ ArrangeHorizontal)
  92       ) <<@ ArrangeHorizontal
  93
  94 shuffle :: [Int] [a] -> [a]
  95 shuffle rnrs as
  96         = fst (unzip (sortBy (\(_,r1) (_,r2) -> r1 < r2) (zip2 as rnrs)))