-- TSTPARARR.OCC
-- Test of nested replicated PAR, etc.

--           Thermal  Conduction  in  2  dimensions
--
--
--  This program simulates the process of thermal conduction on a
--  metal plate. The plate is subdivided into a rectangular number of areas :-
--  (Plate.Width ^2). Eg 3 by 3:
--
--                   B2
--              .
--              : A   B   C        The  temperatures at  the  centre of these
--              :                  areas (A through H and * )  are constantly
--       B1     : D   E   F   B2   monitored and displayed. The  area  marked
--              :                  * has  a heat source  at  its  centre. The
--              : G   *   H        boundaries  marked : and .... connect with
--              :...........       a large heat sink at temperature base.temp
--                                 boundary  shown open is perfectly  lagged.
--                   B1
--
--  There are only three main processes used in the program, all of which are
--  replicated as many times as necessary.
--
--  Temp.Calc - simulates behaviour at the regions A through H
--
--  each takes temperature information from the processes immediately to the
--  left, right, above and below it, and uses these to calculate the
--  temperature at the centre of the region. Nine channels are used by
--  Temp.Calc, one each for input and output from all four directions, and a
--  result channel to send the present temperature to the Result.Handler
--
--  Boundary1 - : an infinite heat sink at base.temp
--
--  which constantly outputs base.temp to its adjacent area
--
--  Boundary2 - a perfect insulator allowing no escape of heat
--
--  which reads the temperature of its adjacent area, and sends this value
--  back next time.
--
--
--  The Heat.Source is a single process, substituted for one of the
--  Temp.Calc processes, which reads the temperatures of its
--  surrounding areas, then ignores these and outputs a temperature one degree
--  higher than its previous value.
--
--  To put the present temperature values on the screen, the Result.Handler
--  reads all the result channels from the Temp.Calc's and Heat.Source and
--  puts them on the screen at sensible x, y positions.
--  The Result.Handler effectively drives the whole system as it scans all
--  the processes in a predefined order, (omitting any which have died).
--
--
--  To stop the program, press any key. This causes a 'stop' message to
--  propagate from the Heat.Source to all the other processes in
--  the program, killing any processes it hits; a dead
--  process is indicated by the word 'dead' on the screen.

DEF stop = TRUE,  -- used to switch off a process. It is -1 (or all 1's in
                  -- binary) so it is distinct and unique.

    Plate.Width = 5,   --    C H A N G E     T H E S E     T O    A L T E R
    Plate.Height = 3,
    Source.X = 1,      --    P L A T E   D I M E N S I O N S   A N D
    Source.Y = 1,      --    H E A T   S O U R C E    P O S I T I O N
    base.temp = 50,    --    Starting Temperature

    -- *****************************************************************

    Twice.Width = 2 * Plate.Width,
    Twice.Height = 2 * Plate.Height,
    Rectangle = Plate.Width * Plate.Height,
    Twice.Rectangle = 2 * Rectangle,
    str.tag = 1, int.tag = 2 :

PROC Heat.Source ( CHAN up.in, down.in, left.in, right.in,
                        up.out, down.out, left.out, right.out,
                        result ) =

-- This process raises the temperature at that point at a constant rate
-- until a single keystroke kills it

  VAR inc, running, Val :
  CHAN keyboard AT 2:
  SEQ
    running := TRUE
    inc := 0
    WHILE running
      SEQ
        ALT
          keyboard ? ANY
            SEQ
              running := FALSE
              Val := stop

          running & SKIP
            Val := base.temp + inc

        SEQ
          SEQ
            down.in ? ANY
            down.out ! Val
          SEQ
            left.in ? ANY
            left.out ! Val
          SEQ
            up.out ! Val
            up.in ? ANY
          SEQ
            right.out ! Val
            right.in ? ANY

        inc := inc + 1

        result ! Val :

PROC Temp.Calc (CHAN up.in, down.in, left.in, right.in, up.out, down.out,
                     left.out, right.out, result, VALUE hotspot) =

  -- Takes temperature readings of the regions up down left and right, works
  -- out its new temperature, then outputs this to up down left and right.
  -- If it receives a switch off message, it sends switch off messages to its
  -- living neighbours (i.e all those who havent just sent it a switch off
  -- message) and then dies.

  IF
    hotspot
      Heat.Source(up.in, down.in, left.in, right.in, up.out, down.out,
                       left.out, right.out, result)
    TRUE

      VAR new.temp, old.temp, running, dying :
      VAR temp.up, temp.down, temp.left, temp.right :
      VAR alive.up, alive.down, alive.left, alive.right :

      PROC talk(VALUE up.right, CHAN way.in, way.out, VAR alive, temp)=
        -- note the need always to talk up or right before down or left
        IF
          alive
            SEQ
              IF
                up.right
                  SEQ
                    way.out ! new.temp
                    way.in ? temp
                TRUE
                  SEQ
                    way.in ? temp
                    way.out ! new.temp
              IF
                temp = stop
                  alive := FALSE
                TRUE
                  temp := temp - old.temp     -- delta temp
          TRUE
            SKIP:

      SEQ
        alive.up := TRUE
        alive.down := TRUE
        alive.left := TRUE
        alive.right := TRUE
        running := TRUE
        dying := FALSE
        old.temp := base.temp             -- Set start conditions
        new.temp := base.temp
        WHILE running
          SEQ
            -- send either temperature or stop to all living neighbours
            talk(FALSE,down.in,down.out,alive.down,temp.down)
            talk(FALSE,left.in,left.out,alive.left,temp.left)
            talk(TRUE,up.in,up.out,alive.up,temp.up)
            talk(TRUE,right.in,right.out,alive.right,temp.right)

            IF
              dying
                running := FALSE
              TRUE
                dying := NOT (alive.up/\alive.down/\alive.left/\alive.right)
            IF
              (running AND (NOT dying))
                new.temp := old.temp + ((temp.up + temp.down + temp.left + temp.right) >>3) -- incr by half average delta
              TRUE
                new.temp := stop

            -- and send either temperature or stop to Result.Handler
            IF
              running
                result    ! new.temp
              TRUE
                SKIP
            old.temp := new.temp :

PROC Boundary1( CHAN in, out ) =
  -- left or bottom boundary
  VAR input.flux, running :
  SEQ
    running := TRUE
    WHILE running
      SEQ
        SEQ
          out ! base.temp                   -- stays at this value
          in ? input.flux
        IF
          input.flux = stop
            running := FALSE
          TRUE
            SKIP :


PROC Boundary2( CHAN in, out ) =
  -- top or right boundary
  VAR input.flux, temp, running :
  SEQ
    running := TRUE
    input.flux := base.temp
      -- initial condition on this wall, thereafter a perfect insulator
    WHILE running
      SEQ
        SEQ
          in ? temp
          out ! input.flux
        input.flux:=temp
        IF
          input.flux = stop
            running := FALSE
          TRUE
            SKIP :


PROC Result.Handler ( CHAN result.input[], screen.path) =

  -- takes all inputs from the Temp.Calc's, puts them in a sensible
  -- x y position on screen. If Temp.Calc switches off then we output 'dead'
  -- and remember not to input again on that channel
  -- A message is sent down the screen.path only if a value needs to be
  -- changed.

  VAR temp[ Rectangle ], alive.list[ Rectangle ],
      last.temp[ Rectangle ] , running:

  SEQ
    SEQ i = [ 0 FOR Rectangle ]
      SEQ
        alive.list[ i ] := TRUE
        last.temp[ i ] := 0
    running := TRUE
    WHILE running
      VAR rPW,crPW:
      SEQ
        rPW := 0                          -- read alive values by rows
        SEQ row = [ 0 FOR Plate.Height ]
          SEQ
            SEQ col = [ 0 FOR Plate.Width ]
              SEQ
                crPW := rPW + col
                IF
                  alive.list[crPW]
                    SEQ
                      result.input[crPW] ? temp[crPW]
                      IF
                        temp[crPW] = stop
                          SEQ
                            screen.path ! col; row; str.tag; 4;'d';'e';'a';'d'
                            alive.list[crPW] := FALSE
                            last.temp[crPW] := stop
                        temp[crPW] <> last.temp[crPW]
                          SEQ
                            last.temp[crPW] := temp[crPW]
                            screen.path ! col; row; int.tag; temp[crPW]
                        TRUE
                          SKIP
                  TRUE
                    SKIP
            rPW := rPW + Plate.Width

        running := FALSE --  and it stays false if all inputs have died
        SEQ i = [ 0 FOR Rectangle ]
          running := running \/ alive.list[i]
        IF
          running
            SKIP
          TRUE
            screen.path ! -1 : -- turn off screen mixer

DEF EndBuffer=-3:
CHAN  screen AT 1:

PROC str.to.screen(VALUE s[])=
  SEQ
    SEQ i=[1 FOR s[BYTE 0]]
      screen!s[BYTE i]
    screen!EndBuffer :

PROC Screen.Handler(VALUE scr.type.char, CHAN path.in) =

  DEF VT100=1:
  DEF VT52=2:
  DEF TVI920=3:
  DEF ESC = 27:
  VAR screen.type:
  VAR sgoto,clrscr:

  PROC init.screen(VALUE x)=
    SEQ
      IF
        x='1'
          screen.type:=VT100
        x='2'
          screen.type:=VT52
        x='3'
          screen.type:=TVI920
        TRUE
          screen.type:=0
      IF
        screen.type=VT100
          screen ! ESC; '<'                    --set ANSI mode
        screen.type=TVI920
          SEQ
            clrscr:='Y'
            sgoto:='='
        screen.type=VT52
          SEQ
            clrscr:='J'
            sgoto:='Y'
        TRUE
          SKIP :

  PROC clear.screen=
    SEQ
      IF
        (screen.type=VT52) OR (screen.type=TVI920)
          screen ! ESC;clrscr
        screen.type=VT100
          screen ! ESC; '['; 'J'       --clear to end of screen
        TRUE
          SEQ i=[0 FOR 24]
            screen ! '*C';'*N'
      screen ! EndBuffer :

  PROC number (VALUE n) =
    --converts numbers upto 999 into ASCII strings
    DEF pwrs = TABLE[BYTE 100, 10]:
    VAR v,d,p:
    SEQ
      p:=FALSE
      v:=n
      IF
        v < 0
          SEQ
            v:=-v
            screen ! '-'
        TRUE
          SEQ
      SEQ i = [0 FOR 2]
        SEQ
          d:=v/pwrs[BYTE i]
          v:=v\pwrs[BYTE i]
          p:=(d <> 0) OR p
          IF
            p
              screen ! d+'0'
            TRUE
              SEQ
      screen ! v+'0':

  PROC goto.xy(VALUE x,y)=
    IF
      (screen.type=TVI920) OR (screen.type=VT52)
        screen ! ESC; sgoto; y+' '; x+' ';EndBuffer
      (screen.type=VT100)
        SEQ
          screen ! ESC; '['
          number(y+1)
          screen ! ';'
          number(x+1)
          screen ! 'H'
      TRUE
        screen ! '*C';'*N';EndBuffer :

  DEF fw=4,
    Height = 24, Width = 80,
    Init.X = (Width - (fw * Plate.Width)) / 2,
    Init.Y = (Height- (Plate.Height)) / 2:

  PROC Convert.Array.To.Screen( VAR X, Y ) =
    SEQ
      X := Init.X + (fw * X)
      Y := Init.Y + (Y) :

  PROC Convert.To.String( VALUE num, VAR string[] ) =
    VAR negflag, i, number :
    SEQ
      IF
        num < 0
          SEQ
            number := -num
            negflag := TRUE
        TRUE
          SEQ
            number := num
            negflag := FALSE

      string[ BYTE 0 ] := fw -- maximum fieldwidth of number
      SEQ i = [ 1 FOR fw ]
        string[ BYTE i ] := ' '
      i := 1
      WHILE number > 0
        SEQ
          string[ BYTE (fw+1) - i ] := (number \ 10) + '0'
          number := number / 10
          i := i + 1
      IF
        negflag
          string[ BYTE (fw+1) - i ] := '-'
        TRUE
          SKIP :

  VAR Screen.Str[ BYTE 25 ],
      running :
  SEQ
    init.screen(scr.type.char)
    goto.xy(0,0)
    clear.screen
    goto.xy(0,23)
    str.to.screen("Thermal conduction demonstration ")
    Convert.To.String(Plate.Width,Screen.Str)
    str.to.screen(Screen.Str)
    str.to.screen(" by ")
    Convert.To.String(Plate.Height,Screen.Str)
    str.to.screen(Screen.Str)
    str.to.screen(" array.")

    running := TRUE
    WHILE running
      VAR Xpos, Ypos:
      SEQ
        path.in ? Xpos
        IF
          Xpos < 0
            SEQ
              goto.xy(0,0)
              running := FALSE
          TRUE
            VAR valtype,num,Count:
            SEQ
              path.in ? Ypos
              Convert.Array.To.Screen( Xpos, Ypos )
              goto.xy( Xpos, Ypos )
              path.in ? valtype
              IF
                valtype=str.tag
                  SEQ
                    path.in ? Count -- length of string, ie BYTE 0
                    Screen.Str[ BYTE 0 ] := Count
                    SEQ j = [ 1 FOR Count ]
                      path.in ? Screen.Str[ BYTE j ]
                    str.to.screen( Screen.Str )
                valtype=int.tag
                  SEQ
                    path.in ? num
                    Convert.To.String( num, Screen.Str )
                    str.to.screen( Screen.Str )
              SKIP:

CHAN output.path :               -- Connects Result.Handler to Screen.Handler

--  Channels for horizontal and vertical communication
--  Horizontal channels are numbered in right/left pairs
--  down the columns of the array.
--  Vertical channels are numbered in down/up pairs
--  along the rows of the array.
--  Result channels from the active sites are numbered along the rows.

CHAN H.Comm[ Twice.Rectangle + Twice.Height ],
     V.Comm[ Twice.Rectangle + Twice.Width ],
     result[ Rectangle ] :

CHAN keyboard AT 2:
VAR ch:

SEQ
  str.to.screen("Terminal type is VT100/VT52/TVI920/? (1/2/3/4) ")
  keyboard ? ch                   -- must be done before going PAR
  screen ! ch; EndBuffer

  PAR
    Screen.Handler( ch, output.path)             -- slave of Result.Handler
    Result.Handler( result, output.path )

    PAR row = [ 0 FOR Plate.Height ]
      Boundary1(H.Comm[(row + row) + 1],
                  H.Comm[row + row])                -- left hand side

    PAR col = [ 0 FOR Plate.Width ]                 -- for each vertical column
      PAR
        Boundary2(V.Comm[col + col + 1],
                  V.Comm[col + col])                  -- top side

        PROC spot(VALUE up,down,left,right,res,hot)=
          -- this is a device to pass the megachecker and also
          -- to keep the parameter lists small enough for genact!
          Temp.Calc(V.Comm[up],
            V.Comm[down + 1],
            H.Comm[left],
            H.Comm[right + 1],
            V.Comm[up + 1],
            V.Comm[down],
            H.Comm[left + 1],
            H.Comm[right],
            result[res],
            hot ):

        PAR row = [0 FOR Plate.Height ]
          spot((Twice.Width*row)+col+col,
               (Twice.Width*(row+1))+col+col,
               (Twice.Height*col)+row+row,
               (Twice.Height*(col+1))+row+row,
               (Plate.Width*row)+col,
               (row=Source.Y) AND (col=Source.X))      -- middle

        Boundary1(V.Comm[Twice.Rectangle + col + col],
                  V.Comm[Twice.Rectangle + col + col + 1])  --bottom

    PAR row = [ 0 FOR Plate.Height ]
      Boundary2(H.Comm[Twice.Rectangle + row + row],
                H.Comm[Twice.Rectangle + row + row + 1]) --right hand side

  str.to.screen("The End")