Merge pull request #16 from robocup-logistics/thofmann/auto-scoring

Require Order ID in prepare msg and score automatically

src/games/rcll/facts.clp

@@ -71,6 +71,7 @@
 
   (slot ds-gate (type INTEGER))
   (slot ds-last-gate (type INTEGER))
+  (slot ds-order (type INTEGER))
 
   (slot ss-operation (type SYMBOL) (allowed-values STORE RETRIEVE))
   (multislot ss-slot (type INTEGER) (cardinality 3 3)) ; meaning defined in llsf_msgs.SSSlot
@@ -215,11 +216,19 @@
   (multislot period (type INTEGER) (cardinality 2 2))
 )  
 
+(deffunction gen-int-id ()
+  "Generate a unique uint that can be used as an ID."
+  (bind ?id-string (str-cat (gensym*)))
+  (return (string-to-field (sub-string 4 (length$ ?id-string) ?id-string)))
+)
+
 (deftemplate product-delivered
+  (slot id (type INTEGER) (default-dynamic (gen-int-id)))
   (slot game-time (type FLOAT))
 	(slot order (type INTEGER) (default 0))
   (slot team (type SYMBOL) (allowed-values nil CYAN MAGENTA))
 	(slot delivery-gate (type INTEGER))
+  (slot confirmed (type SYMBOL) (allowed-values FALSE TRUE) (default FALSE))
   (slot base-color (type SYMBOL) (allowed-values BASE_RED BASE_SILVER BASE_BLACK))
   (multislot ring-colors (type SYMBOL) (cardinality 0 3)
 	     (allowed-values RING_BLUE RING_GREEN RING_ORANGE RING_YELLOW))

src/games/rcll/game.clp

@@ -325,6 +325,12 @@
   (game-print-points-team MAGENTA)
 )
 
+(deffunction game-summary ()
+  (game-print-points)
+  (assert (attention-message (text "Game Over") (time 60)))
+  (printout t "===  Game Over  ===" crlf)
+)
+
 (defrule game-over
   ?gs <- (gamestate (refbox-mode STANDALONE) (phase PRODUCTION) (state RUNNING)
 		    (over-time FALSE) (points ?p-cyan ?p-magenta&:(<> ?p-cyan ?p-magenta))
@@ -357,7 +363,18 @@
   (delayed-do-for-all-facts ((?machine machine)) TRUE
     (modify ?machine (desired-lights RED-BLINK))
   )
-  (game-print-points)
-  (assert (attention-message (text "Game Over") (time 60)))
-  (printout t "===  Game Over  ===" crlf)
+  (if (any-factp ((?pd product-delivered)) TRUE) then
+    (assert (attention-message (text "Game ended, please confirm deliveries!")))
+    (assert (postgame-for-unconfirmed-deliveries))
+  else
+    (game-summary)
+  )
+)
+
+(defrule game-postgame-no-unconfirmed-deliveries
+  ?w <- (postgame-for-unconfirmed-deliveries)
+  (not (product-delivered))
+  =>
+  (retract ?w)
+  (game-summary)
 )

src/games/rcll/net.clp

@@ -440,6 +440,7 @@
 	  (case DS then
 	    (bind ?pm (pb-create "llsf_msgs.PrepareInstructionDS"))
 	    (pb-set-field ?pm "gate" (fact-slot-value ?mf ds-gate))
+	    (pb-set-field ?pm "order_id" (fact-slot-value ?mf ds-order))
             (pb-set-field ?m "instruction_ds" ?pm)
 	  )
 	  (case SS then
@@ -580,6 +581,19 @@
   (pb-destroy ?s)
 )
 
+(deffunction net-create-UnconfirmedDelivery (?id ?team ?time)
+  (bind ?msg (pb-create "llsf_msgs.UnconfirmedDelivery"))
+  (pb-set-field ?msg "id" ?id)
+  (pb-set-field ?msg "team" ?team)
+  (bind ?delivery-time (pb-field-value ?msg "delivery_time"))
+  (if (eq (type ?delivery-time) EXTERNAL-ADDRESS) then
+    (bind ?gt (time-from-sec ?time))
+    (pb-set-field ?delivery-time "sec" (nth$ 1 ?gt))
+    (pb-set-field ?delivery-time "nsec" (integer (* (nth$ 2 ?gt) 1000)))
+    (pb-set-field ?msg "delivery_time" ?delivery-time) ; destroys ?delivery-time!
+  )
+  (return ?msg)
+)
 
 (deffunction net-create-Order (?order-fact)
   (bind ?o (pb-create "llsf_msgs.Order"))
@@ -603,6 +617,13 @@
   (pb-set-field ?o "delivery_period_end"
 		(nth$ 2 (fact-slot-value ?order-fact delivery-period)))
 
+  (do-for-all-facts
+    ((?delivery product-delivered))
+    (and (eq ?delivery:confirmed FALSE) (eq ?delivery:order (fact-slot-value ?order-fact id)))
+
+    (bind ?d (net-create-UnconfirmedDelivery ?delivery:id ?delivery:team ?delivery:game-time))
+    (pb-add-list ?o "unconfirmed_deliveries" ?d)
+  )
   (return ?o)
 )