-- UI widgets for LOVE components

#INCLUDE "course.module"

#INCLUDE "love.inc"
#INCLUDE "trace.inc"
#USE "vectorutils"
#USE "lib"

PROC copy.events (CHAN VEC.EVENT in?, out!)
  WHILE TRUE
    VEC.EVENT ve:
    SEQ
      in ? ve
      out ! ve
:

PROC dump.events (CHAN VEC.EVENT in?)
  WHILE TRUE
    VEC.EVENT ve:
    in ? ve
:

PROC copy.graphics (CHAN MOBILE []VEC.ENTRY in?, out!)
  WHILE TRUE
    MOBILE []VEC.ENTRY v:
    SEQ
      in ? v
      out ! v
:

PROC widget.events (CHAN VEC.EVENT in?, out!, e!, VAL REAL32 x, y, w, h)
  WHILE TRUE
    VEC.EVENT ve:
    SEQ
      C.trace ("waiting for event")
      in ? ve
      C.trace ("got event")
      IF
        (ve[x] >= x) AND (ve[x] <= (x + w)) AND (ve[y] >= y) AND (ve[y] <= (y + h))
          e ! ve
        TRUE
          out ! ve
      C.trace ("routed event")
:

PROC widget.graphics (CHAN MOBILE []VEC.ENTRY in?, out!, g?, VAL REAL32 x, y, w, h)
  INITIAL MOBILE []VEC.ENTRY remote.ve IS MOBILE [0]VEC.ENTRY:
  INITIAL MOBILE []VEC.ENTRY local.ve IS MOBILE [0]VEC.ENTRY:
  WHILE TRUE
    PROC merge ()
      INITIAL MOBILE []VEC.ENTRY v IS MOBILE[((SIZE remote.ve) + (SIZE local.ve)) + 3]VEC.ENTRY:
      INITIAL INT n IS 0:
      SEQ
        C.trace ("merging")
        vec.include (v, n, remote.ve)
        vec.scale (v, n, x, y, w, h)
        vec.include (v, n, local.ve)
        vec.unscale (v, n)
        vec.stop (v, n)
        out ! v
    :
    SEQ
      C.trace ("waiting for graphics")
      ALT
        g ? local.ve
          merge ()
        in ? remote.ve
          merge ()
:

PROC value.widget (CHAN VEC.EVENT e.in?, e.out!, CHAN MOBILE []VEC.ENTRY g.in?, g.out!, VAL REAL32 x, y, w, h, init, CHAN REAL32 out!)
  CHAN VEC.EVENT e:
  CHAN MOBILE []VEC.ENTRY g:
  PAR
    widget.events (e.in?, e.out!, e!, x, y, w, h)
    widget.graphics (g.in?, g.out!, g?, x, y, w, h)
    INITIAL REAL32 value IS init:
    WHILE TRUE
      INITIAL MOBILE []VEC.ENTRY v IS MOBILE [4]VEC.ENTRY:
      INITIAL INT n IS 0:
      VEC.EVENT ve:
      PROC disp (MOBILE []VEC.ENTRY v, INT n)
        SEQ
          vec.colour (v, n, 0.8, 0.8, 1.0, 1.0)
          vec.rect (v, n, 0.0, 0.0, 1.0, 1.0)
          vec.real32 (v, n, 0.0, 0.1, 0.4, value)
      :
      SEQ
        out ! value
        disp (v, n)
        vec.stop (v, n)
        g ! v
        e ? ve
        CASE ve[type]
          EV.KEYDOWN
            --{{{  read new value
            INITIAL BOOL running IS TRUE:
            VAL INT SIZ IS 8:
            INITIAL [SIZ]BYTE buf IS [i = 0 FOR SIZ | ' ']:
            PROC key (VAL INT i)
              IF
                i <= #7F
                  VAL BYTE b IS BYTE i:
                  CASE b
                    '*c'
                      REAL64 nv:
                      BOOL ok:
                      INT start:
                      SEQ
                        IF
                          IF i = 0 FOR SIZ
                            buf[i] <> ' '
                              start := i
                          TRUE
                            start := 0
                        ok, nv := parse.real64 ([buf FROM start])
                        IF
                          ok
                            value := REAL32 ROUND nv
                          TRUE
                            SKIP
                        running := FALSE
                    8
                      SEQ
                        SEQ i = 1 FOR SIZ - 1
                          buf[SIZ - i] := buf[(SIZ - i) - 1]
                        buf[0] := ' '
                    '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '-', '.'
                      SEQ
                        SEQ i = 0 FOR SIZ - 1
                          buf[i] := buf[i + 1]
                        buf[SIZ - 1] := b
                    ELSE
                      C.trace.i ("unknown key in entry: ", INT b)
                TRUE
                  SKIP
            :
            SEQ
              key (ve[button])
              WHILE running
                INITIAL MOBILE []VEC.ENTRY v IS MOBILE [6]VEC.ENTRY:
                INITIAL INT n IS 0:
                SEQ
                  disp (v, n)
                  vec.colour (v, n, 1.0, 0.5, 0.5, 1.0)
                  vec.text (v, n, 0.0, 0.5, 0.4, buf)
                  vec.stop (v, n)
                  g ! v
                  e ? ve
                  CASE ve[type]
                    EV.KEYDOWN
                      key (ve[button])
                    ELSE
                      SKIP
            --}}}
          ELSE
            SKIP
:

PROC fader.widget (CHAN VEC.EVENT e.in?, e.out!, CHAN MOBILE []VEC.ENTRY g.in?, g.out!, VAL REAL32 x, y, w, h, init, CHAN REAL32 out!)
  CHAN VEC.EVENT e:
  CHAN MOBILE []VEC.ENTRY g:
  PAR
    widget.events (e.in?, e.out!, e!, x, y, w, h)
    widget.graphics (g.in?, g.out!, g?, x, y, w, h)
    INITIAL REAL32 value IS init:
    WHILE TRUE
      INITIAL MOBILE []VEC.ENTRY v IS MOBILE [5]VEC.ENTRY:
      INITIAL INT n IS 0:
      VEC.EVENT ve:
      SEQ
        out ! value
        vec.colour (v, n, 1.0, 0.7, 0.7, 1.0)
        vec.fillrect (v, n, 0.0, 0.0, value, 1.0)
        vec.colour (v, n, 0.4, 0.4, 0.4, 1.0)
        vec.fillrect (v, n, value, 0.0, 1.0 - value, 1.0)
        vec.stop (v, n)
        g ! v
        e ? ve
        CASE ve[type]
          EV.KEYDOWN
            CASE ve[button]
              '0', '1', '2', '3', '4', '5', '6', '7', '8', '9'
                value := (REAL32 ROUND (ve[button] - '0')) / 10.0
              '-'
                value := 1.0
              ELSE
                SKIP
          ELSE
            SKIP
: