initial framework added
[fp1415-soccerfun.git] / src / StdReferee / RefereeCoach_Slalom_Assignment.icl
diff --git a/src/StdReferee/RefereeCoach_Slalom_Assignment.icl b/src/StdReferee/RefereeCoach_Slalom_Assignment.icl
new file mode 100644 (file)
index 0000000..1fabe4b
--- /dev/null
@@ -0,0 +1,126 @@
+implementation module RefereeCoach_Slalom_Assignment\r
+\r
+import Referee\r
+\r
+RefereeCoach_Slalom                            :: !FootballField -> Referee\r
+RefereeCoach_Slalom field              = { name  = "RefereeCoach_Slalom"\r
+                                                                 , brain = { memory    = mkMemory\r
+                                                                           , ai                = randomlessRefereeAI (brain field)\r
+                                                                           }\r
+                                                                 , refActionPics               = []\r
+                                                                 }\r
+\r
+::     Stage                                           = Begin | Slalom | Kick | End Success\r
+instance == Stage where                        == Begin    Begin               = True\r
+                                                               == Slalom   Slalom              = True\r
+                                                               == Kick     Kick                = True\r
+                                                               == (End s1) (End s2)    = s1 == s2\r
+                                                               == _        _                   = False\r
+\r
+::     Memory                                          = { positions   :: ![Position]          // all positions of student player, in reverse order\r
+                                                                 , stage               :: !Stage                       // the current stage of the training\r
+                                                                 , home                :: Home                         // home of student player, determined at Begin\r
+                                                                 }\r
+\r
+mkMemory                                               :: Memory\r
+mkMemory                                               = { positions   = []\r
+                                                                 , stage               = Begin\r
+                                                                 , home                = undef\r
+                                                                 }\r
+\r
+slalom                                                 :: Memory -> Memory\r
+slalom memory                                  = {memory & stage = Slalom}\r
+\r
+after_kick                                             :: Memory -> Memory\r
+after_kick memory                              = {memory & stage = Kick}\r
+\r
+fail                                                   :: Memory -> Memory\r
+fail memory                                            = {memory & stage = End Fail}\r
+\r
+ok                                                             :: Memory -> Memory\r
+ok memory                                              = {memory & stage = End Success}\r
+\r
+position                                               :: Position Memory -> Memory\r
+position p memory                              = {memory & positions = [p:memory.positions]}\r
+\r
+knownHome                                              :: Home Memory -> Memory\r
+knownHome home memory                  = {memory & home = home}\r
+\r
+brain                                                  :: !FootballField !(!RefereeInput,!Memory) -> (!RefereeOutput,!Memory)\r
+//     Assignment has started. Check teams and determine home of student player.\r
+brain field ({RefereeInput | team1,team2},memory=:{stage = Begin})\r
+| not ok_teams                                 = ([TellMessage "Wrong teams selected."],fail memory)\r
+| otherwise                                            = ([DirectFreeKick home ball],position student.pos (slalom (knownHome home memory)))\r
+where\r
+       (ok_teams,home)                         = case (team1,team2) of\r
+                                                                       ([p],[_,_:_])                   = (True, West)\r
+                                                                       ([_,_:_],[p])                   = (True, East)\r
+                                                                       otherwise                               = (False,undef)\r
+       student                                         = if (home == West) (hd team1) (hd team2)\r
+       west_ball_pos                           = {zero & px = scale -0.5 field.flength + penalty_area_depth}\r
+       ball                                            = if (home == West) (mirror field west_ball_pos) west_ball_pos\r
+//     Assignment has ended. Stop training session.\r
+brain _ (_,memory=:{stage = End how})\r
+                                                               = ([TellMessage msg, GameOver],memory)\r
+where\r
+       msg                                                     = if (how == Success) "Well done! Move on to next exercise."\r
+                                                                                     "Improve your assignment and try again."\r
+//     Assignment is in slalom or kicking stage.\r
+brain field ({RefereeInput | playingTime=time, theBall=ballState, team1, team2}, memory=:{home,positions,stage})\r
+| time <= zero                                 = ([TellMessage "Out of time."],fail memory)                                                    // time's up\r
+| ballIsFree ballState && ballIsOut field ball                                                                                                                 // ball is out\r
+       # ball_pos                                      = ball.ballPos.pxy\r
+       # (north,south)                         = goal_poles field\r
+       | not (isbetween ball_pos.py south north)                                                                                                                       // student did not kick ball in goal\r
+                                                               = ([TellMessage "You should play the ball in the goal."],fail memory)\r
+       | home == West && ball_pos.px < scale -0.5 field.flength + m 1.0 || \r
+         home == East && ball_pos.px > scale  0.5 field.flength - m 1.0                                                                        // student kicked ball in wrong goal\r
+                                                               = ([TellMessage "You should play the ball in the other goal."],fail memory)\r
+       | otherwise                                     = ([ContinueGame],ok memory)                                                                                    // student ended exercise correctly\r
+| isMoved action\r
+       | compare_pos student.pos last_pos                                                                                                                                      // student is moving in wrong direction\r
+                                                               = ([TellMessage "You're moving in the wrong direction."],fail memory)\r
+       | any (\other -> dist other student < m 0.5) others                                                                                                     // student moves too close to opponents\r
+                                                               = ([TellMessage "Don't move so close to opponents."],fail memory)\r
+       | not up_and_down                       = ([TellMessage "You're not doing a slalom."],fail memory)                              // student is not doing slalom\r
+       | otherwise                                     = ([ContinueGame],memory)\r
+| isKickedBall action\r
+       | stage == Kick                         = ([TellMessage "Don't kick the ball twice."],fail memory)                              // kick the ball only once\r
+       | otherwise                                     = ([ContinueGame],after_kick memory)\r
+| otherwise                                            = ([TellMessage ("Illegal action. Perform only Move and KickBall. You did: " <+++ typeOfAction action)],fail memory)\r
+where\r
+       ball                                            = getFootball ballState (team1 ++ team2)\r
+       (student,others)                        = if (home == West) (hd team1,team2) (hd team2,team1)\r
+       action                                          = fromJust student.effect\r
+       last_pos                                        = hd positions\r
+       new_positions                           = [student.pos : positions]\r
+       compare_px                                      = if (home == West) < >\r
+       compare_pos pos1 pos2           = compare_px pos1.px pos2.px\r
+       close_px    pos1 pos2           = abs (pos1.px - pos2.px) <= m 1.0\r
+       line_up_others                          = sortBy compare_pos (map (\{Footballer | pos} -> pos) others)\r
+       close_encounters                        = takeWhile (not o isEmpty) [filter (close_px other_pos) new_positions \\ other_pos <- line_up_others]\r
+       up_and_down                                     = isAlternating \r
+                                                                 [  map (\studentpos -> studentpos.py < other_pos.py) close_encounter\r
+                                                                 \\ close_encounter <- close_encounters\r
+                                                                  & other_pos       <- line_up_others\r
+                                                                 ]\r
+\r
+ballIsOut                                              :: !FootballField !Football -> Bool\r
+ballIsOut field ball                   = not (point_in_rectangle ({px = scale -0.5 field.flength, py = scale -0.5 field.fwidth}\r
+                                                                                         ,{px = scale  0.5 field.flength, py = scale  0.5 field.fwidth}\r
+                                                                                         ) ball.ballPos.pxy)\r
+\r
+typeOfAction                                   :: !FootballerEffect -> String\r
+typeOfAction (Moved _ _)               = "Move"\r
+typeOfAction (GainedBall _)            = "GainBall"\r
+typeOfAction (KickedBall _)            = "KickBall"\r
+typeOfAction (HeadedBall _)            = "HeadBall"\r
+typeOfAction (Feinted _)               = "Feint"\r
+typeOfAction (Tackled _ _ _)   = "Tackle"\r
+typeOfAction (CaughtBall _)            = "Catch"\r
+\r
+isAlternating                                  :: [[a]] -> Bool | Eq, ~ a\r
+isAlternating sequences                        = isEmpty sequences || all isSingleton singletons && map hd singletons == take n (iterate ~ (hd (hd singletons)))\r
+where\r
+       singletons                                      = map removeDup sequences\r
+       n                                                       = length sequences\r