---------------------------------------------------------------------------
--
--      bar.occ -- animated fair ALTing
--      Copyright (C) 2000 Fred Barnes
--	Some fixes/mods Oct 2001, Peter Welch
--
--      This program is free software; you can redistribute it and/or modify
--      it under the terms of the GNU General Public License as published by
--      the Free Software Foundation; either version 2 of the License, or
--      (at your option) any later version.
--
--      This program is distributed in the hope that it will be useful,
--      but WITHOUT ANY WARRANTY; without even the implied warranty of
--      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--      GNU General Public License for more details.
--
--      You should have received a copy of the GNU General Public License
--      along with this program; if not, write to the Free Software
--      Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
--

#USE "course.lib"
#INCLUDE "consts.inc"
#INCLUDE "semaphore.inc"
#INCLUDE "barrier.inc"

--{{{  O.REQ protocol
PROTOCOL O.REQ
  CASE
    movecursor; BYTE; BYTE
    string; INT::[]BYTE
    number; INT
    thirsty; INT
    happy; INT
    sad; INT
    blank
    cls
    bar.blank
    bar.happy
    terminate
:
--}}}

--{{{  constants

VAL alt.mode IS 0:              -- 0 = normal ALT, 1 = fairer, 2 = decent

VAL INT num.punters IS 24:

VAL INT drunk.pints IS 8:
VAL INT limit.pints IS 15:

VAL BYTE bar.left IS 1:
VAL BYTE punter.left IS 14:
VAL BYTE punter.top IS 2:
VAL BYTE punter.right IS 30:
VAL BYTE punter.bcount IS 35:
VAL BYTE barkeep.x IS 6:

VAL []BYTE punter.blank IS "   ":
VAL [][]BYTE punter.happy IS [":-)", "%-]", "X-|"]:
VAL [][]BYTE punter.thirsty IS [":-O", "%-P", "X-|"]:
VAL [][]BYTE punter.sad IS [":-(", "%-[", "X-|"]:
VAL []BYTE barkeep.blank IS "    ":
VAL []BYTE barkeep.happy IS "=:-]":

VAL INT time.const IS 500000:
VAL INT speed.const IS 20000:
VAL INT bar.delay IS 200000:
VAL INT bar.anim.delay IS 20000:

--}}}

--{{{  PROC draw.bar (CHAN OF O.REQ out, SEMAPHORE sem.out)
PROC draw.bar (CHAN OF O.REQ out, SEMAPHORE sem.out)
  VAL []BYTE bar.end IS "----------||":
  VAL []BYTE bar.bit IS "          ||":
  VAL []BYTE help IS "keys: 0 = normal alt,  1 = fairer alt,  2 = fair alt":
  SEQ
    claim.semaphore (sem.out)
    out ! cls
    out ! movecursor; 1; 1
    out ! string; (SIZE bar.end)::bar.end
    SEQ i = INT punter.top FOR INT num.punters
      SEQ
        out ! movecursor; 1; BYTE i
        out ! string; (SIZE bar.bit)::bar.bit
    out ! movecursor; 1; (BYTE num.punters) + punter.top
    out ! string; (SIZE bar.end)::bar.end
    out ! movecursor; 1; ((BYTE num.punters) + punter.top) + 2
    out ! string; (SIZE help)::help
    release.semaphore (sem.out)
:
--}}}

--{{{  INT FUNCTION seconds (VAL INT time)
INT FUNCTION seconds (VAL INT time)
  INT res:
  VALOF
    res := (time * time.const)
    RESULT res
:
--}}}

--{{{  PROC punter (VAL BYTE me, CHAN OF BYTE request, response, CHAN OF O.REQ out, SEMAPHORE sem.out)
PROC punter (VAL BYTE me, CHAN OF BYTE request, response, CHAN OF O.REQ out, SEMAPHORE sem.out)
  BYTE my.x, my.y:
  INT num.pints:
  INT rseed, t:
  TIMER tim:
  BOOL dead:
  INT state:            -- 0=fine, 1=drunk 2=dead
  SEQ
    --{{{  Initialise
    num.pints := 0
    my.x := punter.right
    my.y := me + punter.top
    claim.semaphore (sem.out)
    out ! movecursor; punter.bcount; my.y
    out ! number; num.pints
    release.semaphore (sem.out)
    dead := FALSE
    state := 0
    --}}}
    --{{{  Set random seed
    tim ? rseed
    IF
      rseed < 0
        rseed := (-rseed)
      rseed = 0
        rseed := 1
      TRUE
        SKIP
    --}}}
    --{{{  Main loop
    WHILE (NOT dead)
      INT tdelay:
      SEQ
        --{{{  Think
        SEQ
          claim.semaphore (sem.out)
          out ! movecursor; my.x; my.y
          out ! happy; state
          release.semaphore (sem.out)
          tdelay, rseed := random (4, rseed)
          tim ? t
          tim ? AFTER (t PLUS seconds (tdelay+1))
        --}}}
        --{{{  Get thirsty and go to the bar
        SEQ i = 0 FOR INT (punter.right - punter.left)
          SEQ
            claim.semaphore (sem.out)
            out ! movecursor; my.x; my.y
            out ! blank
            my.x := (my.x - 1)
            out ! movecursor; my.x; my.y
            out ! thirsty; state
            release.semaphore (sem.out)
            tim ? t
            tim ? AFTER (t PLUS speed.const)
        --}}}
        --{{{  Get unhappy and order drink
        SEQ
          claim.semaphore (sem.out)
          out ! movecursor; my.x; my.y
          out ! sad; state
          release.semaphore (sem.out)
          request ! me
          BYTE any:
          response ? any
        --}}}
        --{{{  Update beer count and move back to the right
        SEQ
          num.pints := num.pints + 1
          IF
            num.pints = limit.pints
              state, dead := 2, TRUE
            num.pints >= drunk.pints
              state := 1
            TRUE
              SKIP
          claim.semaphore (sem.out)
          out ! movecursor; punter.bcount; my.y
          out ! number; num.pints
          release.semaphore (sem.out)
          SEQ i = 0 FOR INT (punter.right - punter.left)
            SEQ
              claim.semaphore (sem.out)
              out ! movecursor; my.x; my.y
              out ! blank
              my.x := (my.x + 1)
              out ! movecursor; my.x; my.y
              out ! happy; state
              release.semaphore (sem.out)
              tim ? t
              tim ? AFTER (t PLUS speed.const)
        --}}}
    --}}}
:
--}}}

--{{{  PROC punters ([]CHAN OF BYTE req, rsp, CHAN OF O.REQ d.chan, SEMAPHORE d.sem,
PROC punters ([]CHAN OF BYTE req, rsp, CHAN OF O.REQ d.chan, SEMAPHORE d.sem,
              CHAN OF BOOL kill.keyboard, kill.bar)

  #PRAGMA SHARED d.sem
  #PRAGMA SHARED d.chan

  SEQ

    PAR i = 0 FOR num.punters
      punter (BYTE i, req[i], rsp[i], d.chan, d.sem)

    kill.keyboard ! TRUE           -- kill off the others
    kill.bar ! TRUE                -- carefully ...
    claim.semaphore (d.sem)        -- in the right ...
    d.chan ! terminate             -- order!
    release.semaphore (d.sem)

:
--}}}

--{{{  PROC display (CHAN OF O.REQ in, CHAN OF BYTE out)
PROC display (CHAN OF O.REQ in, CHAN OF BYTE out)
  [256]BYTE str:
  INITIAL BOOL running IS TRUE:
  WHILE running
    SEQ
      in ? CASE
        BYTE x, y:
        movecursor; x; y
          cursor.x.y (x, y, out)
        INT len:
        string; len::str
          out.string ([str FOR len], 0, out)
        INT n:
        number; n
          out.int (n, 0, out)
        blank
          out.string (punter.blank, 0, out)
        INT s:
        happy; s
          SEQ
            out.string (punter.happy[s], 0, out)
            out ! '*c'
        INT s:
        thirsty; s
          SEQ
            out.string (punter.thirsty[s], 0, out)
            out ! '*c'
        INT s:
        sad; s
          SEQ
            out.string (punter.sad[s], 0, out)
            out ! '*c'
        cls
          SEQ
            out ! ESCAPE
            out.string ("[2J", 0, out)
        bar.blank
          SEQ
            out.string (barkeep.blank, 0, out)
            out ! '*c'
        bar.happy
          SEQ
            out.string (barkeep.happy, 0, out)
            out ! '*c'
        terminate
          SEQ
            running := FALSE
            cursor.x.y (0, BYTE (num.punters + 3), out)
      out ! FLUSH
:
--}}}

--{{{  PROC bar.brain ([]CHAN OF BYTE in, CHAN OF BYTE out,
PROC bar.brain ([]CHAN OF BYTE in, CHAN OF BYTE out,
                CHAN OF INT mode.change, CHAN OF BOOL terminate)
  VAL INT s IS SIZE in:
  INITIAL INT local.alt.mode IS alt.mode:
  INITIAL INT favourite IS 0:
  INITIAL BOOL running IS TRUE:
  WHILE running
    CASE local.alt.mode
      0
        PRI ALT
          BOOL any:
          terminate ? any
            running := FALSE
          mode.change ? local.alt.mode
            SKIP
          PRI ALT i = 0 FOR s
            BYTE any:
            in[i] ? any
              out ! any
      1
        PRI ALT
          BOOL any:
          terminate ? any
            running := FALSE
          mode.change ? local.alt.mode
            SKIP
          PRI ALT j = favourite FOR s
            VAL INT X IS (j \ s):
            BYTE any:
            in[X] ? any
              SEQ
                out ! any
                favourite := ((favourite + 1) \ s)
      2
        PRI ALT
          BOOL any:
          terminate ? any
            running := FALSE
          mode.change ? local.alt.mode
            SKIP
          PRI ALT i = favourite FOR s
            VAL INT X IS (i \ s):
            BYTE any:
            in[X] ? any
              SEQ
                out ! any
                favourite := (X + 1)
:
--}}}

--{{{  PROC bar.body (CHAN OF BYTE in, []CHAN OF BYTE responses, CHAN OF O.REQ out, SEMAPHORE out.sem, CHAN OF BOOL terminate)
PROC bar.body (CHAN OF BYTE in, []CHAN OF BYTE responses, CHAN OF O.REQ out, SEMAPHORE out.sem, CHAN OF BOOL terminate)

  PROC barkeep.from.to (VAL BYTE start.y, end.y)
    TIMER tim:
    INT t:
    SEQ
      tim ? t
      tim ? AFTER (t PLUS bar.anim.delay)
      claim.semaphore (out.sem)
      out ! movecursor; barkeep.x; start.y
      out ! bar.blank
      out ! movecursor; barkeep.x; end.y
      out ! bar.happy
      release.semaphore (out.sem)
  :

  INITIAL BYTE barkeep.y IS punter.top:
  INITIAL BOOL running IS TRUE:
  INITIAL BOOL serving IS TRUE:
  TIMER tim:
  INT t:
  SEQ
    claim.semaphore (out.sem)
    out ! movecursor; barkeep.x; barkeep.y
    out ! bar.happy
    release.semaphore (out.sem)
    WHILE running
      PRI ALT
        BOOL any:
        terminate ? any
          running := FALSE
        #PRAGMA DEFINED t
        (NOT serving) & tim ? AFTER (t PLUS bar.delay)
          serving := TRUE
        BYTE n:
        serving & in ? n
          BYTE new.y:
          SEQ
            new.y := (n + punter.top)
            IF
              new.y < barkeep.y
                SEQ i = 0 FOR INT (barkeep.y - new.y)
                  VAL BYTE bi IS BYTE i:
                  barkeep.from.to (barkeep.y - bi,
                                   barkeep.y - (bi + 1))
              new.y > barkeep.y
                SEQ i = INT barkeep.y FOR INT (new.y - barkeep.y)
                  VAL BYTE bi IS BYTE i:
                  barkeep.from.to (bi, bi + 1)
              TRUE
                SKIP
            barkeep.y := new.y
            responses[INT n] ! 0
            serving := FALSE
            tim ? t
:
--}}}

--{{{  PROC bar.tender ([]CHAN OF BYTE req, rsp, CHAN OF INT mode.change,
PROC bar.tender ([]CHAN OF BYTE req, rsp, CHAN OF INT mode.change,
                 CHAN OF O.REQ d.chan, SEMAPHORE d.sem, CHAN OF BOOL kill)
  CHAN OF BYTE spinal.chord:
  CHAN OF BOOL kill.brain, kill.body:
  PAR
    --{{{  terminator
    BOOL any:
    SEQ
      kill ? any
      kill.brain ! any    -- order is
      kill.body ! any     -- important
    --}}}
    bar.brain (req, spinal.chord, mode.change, kill.brain)
    bar.body (spinal.chord, rsp, d.chan, d.sem, kill.body)
:
--}}}

--{{{  PROC keyboard (CHAN OF BYTE in, CHAN OF INT out, CHAN OF BOOL terminate)
PROC keyboard (CHAN OF BYTE in, CHAN OF INT out, CHAN OF BOOL terminate)
  INITIAL BOOL running IS TRUE:
  WHILE running
    PRI ALT
      BOOL any:
      terminate ? any
        running := FALSE
      BYTE ch:
      in ? ch
        IF
          (ch >= '0') AND (ch <= '2')
            out ! ((INT ch) - (INT '0'))
          TRUE
            SKIP
:
--}}}

--{{{  PROC terminator (CHAN OF O.REQ out, SEMAPHORE out.sem, BARRIER sync)
PROC terminator (CHAN OF O.REQ out, SEMAPHORE out.sem, BARRIER sync)
  SEQ
    synchronise.barrier (sync)
    claim.semaphore (out.sem)
    out ! terminate
    release.semaphore (out.sem)
:
--}}}

--{{{  PROC bar (CHAN OF BYTE kyb, scr, err)
PROC bar (CHAN OF BYTE kyb, scr, err)

  CHAN OF O.REQ d.chan:
  #PRAGMA SHARED d.chan
  SEMAPHORE d.sem:
  #PRAGMA SHARED d.sem
  [num.punters]CHAN OF BYTE req:
  [num.punters]CHAN OF BYTE rsp:
  CHAN OF INT mode.change:
  CHAN OF BOOL kill.keyboard:
  CHAN OF BOOL kill.bar:
  SEQ
    initialise.semaphore (d.sem, 1)
    PAR
      display (d.chan, scr)
      SEQ
        draw.bar (d.chan, d.sem)
        PAR
          punters (req, rsp, d.chan, d.sem, kill.keyboard, kill.bar)
          keyboard (kyb, mode.change, kill.keyboard)
          bar.tender (req, rsp, mode.change, d.chan, d.sem, kill.bar)
:
--}}}