(* Cycle numerical results in range unless inhibited *)

datatype production = Produce | Inhibit
datatype comparison = EQ | GT | LT

(* need to define a type class and instances for compare operation *)
fun compare x y = if x = y then EQ else if x > y then GT else LT

val eq_production : eq production =
  mkEq (fn (x: production) (y: production) =>
     case (x, y) of (Produce, Produce) => True
                  | (Inhibit, Inhibit) => True
                  | _ => False)

val show_production : show production =
  mkShow (fn p : production => case p of Produce => "Produce"
                                       | Inhibit => "Inhibit")

val minNum = 0
val maxNum = 59
val stepNum = 1
val timeInterval = 1
(* use deciseconds, or 100 ms *)
val unitMultiplier = 100

fun setCell (runOn: source production) (cell: source int) (acc: int)
  : transaction unit =
  runOn' <- get runOn;
  (* does not work due to non-transactional type *)
  (* Produce && set cell acc *)
  if runOn' = Produce then set cell acc else return ()
  (* also valid, but a bit more verbose... *)
  (* case runOn' of Inhibit => return () | Produce => set cell acc *)

fun periodicSequenceAcc (cell: source int) (from: int) (to: int) (acc: int)
  (step: int) (tStep: int) (runOn: source production) : transaction unit =
  runOn' <- get runOn;
  setCell runOn cell acc;
  sleep (tStep * unitMultiplier);
  case (runOn', compare from to, compare acc to) of
    (Inhibit, _, _) => periodicSequenceAcc cell from to acc step tStep runOn
  | (_, EQ, _) => periodicSequenceAcc cell from to acc step tStep runOn
  | (_, LT, EQ) => periodicSequenceAcc cell from to from step tStep runOn
  | (_, LT, _) =>
   periodicSequenceAcc cell from to (acc + step) step tStep runOn
  | (_, GT, EQ) => periodicSequenceAcc cell from to from step tStep runOn
  | (_, GT, _) =>
   periodicSequenceAcc cell from to (acc - step) step tStep runOn

(* advances sequence, then sleeps for a certain number of time units *)
fun periodicSequence (cell: source int) (from: int) (to: int) (step: int)
  (tStep: int) (runOn: source production) : transaction unit =
  case (compare from to, compare tStep 0) of
    (LT, GT) => periodicSequenceAcc cell from to from step tStep runOn
  | (GT, LT) => periodicSequenceAcc cell from to from step tStep runOn
   (* infinite loop is OK here, because this runs over time *)
  | (_, EQ) => periodicSequenceAcc cell from from from step tStep runOn
  | _ => error <xml>invalid sequence defined</xml>

fun main () =
  result <- source (0 : int);
  runOn <- source (Produce : production);

  return <xml><head>
    <title>Cycle numbers from {[show minNum]} to {[show maxNum]}:</title></head>
    <body onload={spawn
      (periodicSequence result minNum maxNum stepNum timeInterval runOn)}>
      <p>status: <dyn signal={runOn' <- signal runOn;
                              return <xml>{[show runOn']}</xml>}/></p>
      <dyn signal={cur <- signal result; return <xml>{[show cur]}</xml>}/>
      <p><button value="Pause Number Generation"
        onclick={fn _ => set runOn Inhibit}/></p>
      <p><button value="Resume Number Generation"
        onclick={fn _ => set runOn Produce}/></p>
        (* we lack a way to toggle production types, so this does not work *)
(*
      <p><button value="Toggle Pause"
        onclick={fn _ => runOn' <- get runOn;
                 set runOn (not runOn')}/></p>
*)
    </body>
    </xml>
