--
--  Button
--  Copyright (C) 2007  University of Kent
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation, either
--  version 2 of the License, or (at your option) any later version.
--
--  This library 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
--  Lesser General Public License for more details.
--
--  You should have received a copy of the GNU Lesser General Public
--  License along with this library.  If not, see
--  <http://www.gnu.org/licenses/>.
--

--** @module button

#INCLUDE "occSDL.module"
#INCLUDE "occGL.module"
#INCLUDE "course.module"

#INCLUDE "font2.occ"
#INCLUDE "button.inc"

--CHAN TYPE INPUT.CT
--  MOBILE RECORD
--    CHAN INPUT c?:
--:
--
--CHAN TYPE BOOL.CT
--  MOBILE RECORD
--    CHAN BOOL c?:
--:

-- Button PROC, takes mouse input, outputs when it was clicked, has configure
-- channel and says which button number it is.  Currently only 0-4 allowed.
PROC button(CHAN INPUT in?, CHAN CLICK click!, CHAN BUTTONCFG configure?, VAL INT xPosition, yPosition,
    VAL INT font.offsetx, CHAN BOOL sync?, VAL INT button.width, button.height)
  INITIAL BOOL enabled IS TRUE:
  INITIAL BOOL run IS TRUE:
  INITIAL BOOL clicked IS FALSE:
  VAL INT bordersize IS 2:
  VAL INT buttonsize.x IS button.width - (bordersize * 2):
  VAL INT buttonsize.y IS button.height - (bordersize * 2):
  VAL INT offsetx IS (xPosition * button.width) + bordersize:
  VAL INT offsety IS (yPosition * button.height) + bordersize:
  INITIAL REAL32 R, B, G IS 0.0, 0.5, 1.0:
  --VAL []BYTE default IS "Default":
  INITIAL MOBILE []BYTE label IS "Empty":
  --Assign default label
  SEQ
    --label := MOBILE[SIZE default]BYTE
    --SEQ i = 0 FOR SIZE default
    --  label[i] := default[i]
    WHILE run
      ALT
        -- Configuration handler
        configure ? CASE
          enable
            enabled := TRUE
          disable
            enabled := FALSE
          name;  label
            SKIP
          colour; R; B; G
            SKIP
        -- Input handler
        BYTE dummy:
        INT16 xpos, ypos:
        in ? CASE
          -- Not using keyboard input for anything at the mo
          kyb; dummy
            SKIP 
          mousedown; dummy; xpos; ypos
            IF
              NOT enabled
                SKIP
              ((xpos > (INT16 offsetx)) AND (xpos < (INT16 (offsetx + buttonsize.x)))) AND ((ypos > (INT16 offsety)) AND (ypos < (INT16 (offsety + buttonsize.y))))
                SEQ
                  click ! CLONE label
              TRUE 
                SKIP
          mouseup; dummy; xpos; ypos
            clicked := FALSE
        sync ?? run
          SEQ
            -- Start sync (extended rendevous)
            -- Redraw button 
            IF
              NOT enabled
                glColor3f(0.2,0.2,0.2)
              clicked 
                SEQ
                  glColor3f((1.0 - R),(1.0 -  B), (1.0 -  G))
              TRUE
                glColor3f(R, B, G)
            glRecti(offsetx, offsety, offsetx + buttonsize.x, offsety + buttonsize.y)
            -- Draw text in centre of button
            --FIXME: CHANGE THE WAY THE TEXT COLOR WORKS!
            glColor3f((1.0 - R),(1.0 -  B), (1.0 -  G))
            -- The 9 is the width of each character.  15 is the height of each character
            glRasterPos2i(offsetx + ((buttonsize.x / 2) - (((SIZE label) * 9)/2)), offsety + ((buttonsize.y/2) + (15/2)))
            printString(label, font.offsetx)
:

-- This ensures all buttons are ready to go before rendering. serialises all
-- button rendering.
PROC sync([][]CHAN BOOL sync!, CHAN BYTE quit?, VAL INT buttons.x, buttons.y)
  BOOL dummy:
  --VAL INT buttons.x IS (SIZE syncstart):
  --VAL INT buttons.y IS (SIZE syncstart[0]):
  INITIAL BOOL run IS TRUE:
  TIMER tim:
  INT t:
  --serialises all render operations.
  PROC dosync()
    SEQ i = 0 FOR buttons.x 
      SEQ j = 0 FOR buttons.y 
        SEQ
          sync[i][j] ! run
  :

  SEQ
    WHILE run
      SEQ
        tim ? t
        ALT 
          BYTE blah:
          quit ? blah
            run := FALSE
          tim ? AFTER t PLUS 15000 --Tell the buttons to redraw.
            SEQ
              --tvm.debug.str("syncstart")
              dosync()
              --tvm.debug.str("-> syncend*n*c")
        --synching done, means drawing done, can draw to screen
        SDL.GL.SwapBuffers()
        glClear(GL.COLOR.BUFFER.BIT)
    -- Make sure all the buttons get the quit signal
    dosync()
    SDL.Quit()
:

-- Multiplexes input from SDL out to all the button PROC's
PROC mplexinput(CHAN INPUT in?, [][]CHAN INPUT out!, CHAN BYTE sync.quit!, control.quit!, VAL INT buttons.x, buttons.y)
  --VAL INT buttons.x IS (SIZE out):
  --VAL INT buttons.y IS (SIZE out[0]):
  BYTE tmp:
  INT16 x, y:
  INITIAL BOOL run IS TRUE:
  WHILE run
    in ? CASE
      kyb ; tmp
        SEQ
          PAR i = 0 FOR buttons.x 
            PAR j = 0 FOR buttons.y
              out[i][j] ! kyb; tmp
          IF
            tmp = 'q'
              SEQ
                sync.quit ! tmp
                control.quit ! tmp
                run := FALSE
            TRUE
              SKIP
      mousedown ; tmp; x; y
        PAR i = 0 FOR buttons.x
          PAR j = 0 FOR buttons.y
            out[i][j] ! mousedown; tmp; x; y 
      mouseup ; tmp; x; y
        PAR i = 0 FOR buttons.x
          PAR j = 0 FOR buttons.y
            out[i][j] ! mouseup; tmp; x; y 
:

-- Reads and interprets the events arriving from SDL.
-- Sends them out down the input channel.
PROC eventmonitor(CHAN INPUT input!)
  SDL.Event event:
  SDL.KeyboardEvent keyevent:
  TIMER tim:
  INT wait:
  VAL INT delay IS 15000:
  SDL.keysym keyinfo:
  BYTE type:
  INT re:
  INITIAL BOOL quit IS FALSE:
  SEQ
    new.SDL.Event(event)
    WHILE NOT quit
      SEQ 
        tim ? wait
        tim ? AFTER wait PLUS delay
        SDL.PollEvent(event, re)
        IF
          re > 0
            SEQ
              SDL.Event.type.get(event, type)
              IF 
                -- If someone hits the little X in the corner of the window 
                -- or does alt+f4 kinda thing
                (INT type) = SDL.QUIT
                  SEQ
                    quit := TRUE
                    input ! kyb; 'q'
                (INT type) = SDL.KEYDOWN
                  INT key:
                  SEQ
                    keyevent := (SDL.KeyboardEvent event)
                    SDL.KeyboardEvent.keysym.get(keyevent, keyinfo)
                    SDL.keysym.sym.get(keyinfo, key)
                    --FIXME for ctrl and alt etc...
                    input ! kyb; (BYTE key)
                    IF
                      (BYTE key) = 'q'
                        SEQ
                          quit := TRUE
                      TRUE
                        SKIP
                (INT type) = SDL.KEYUP
                  SKIP 
                INT16 xpos, ypos:
                BYTE button:
                SDL.MouseButtonEvent click:
                (INT type) = SDL.MOUSEBUTTONDOWN
                  SEQ
                    click := (SDL.MouseButtonEvent event)
                    SDL.MouseButtonEvent.x.get(click, xpos)
                    SDL.MouseButtonEvent.y.get(click, ypos)
                    SDL.MouseButtonEvent.button.get(click, button)
                    input ! mousedown; button; xpos; ypos
                INT16 xpos, ypos:
                BYTE button:
                SDL.MouseButtonEvent click:
                (INT type) = SDL.MOUSEBUTTONUP
                  SEQ
                    click := (SDL.MouseButtonEvent event)
                    SDL.MouseButtonEvent.x.get(click, xpos)
                    SDL.MouseButtonEvent.y.get(click, ypos)
                    SDL.MouseButtonEvent.button.get(click, button)
                    input ! mouseup; button; xpos; ypos
                TRUE
                  SKIP
          TRUE 
            SKIP
    -- cleanup, remove pointer to event handler
    delete.SDL.Event(event)
:

PROC setup.gfx(CHAN BYTE scr!, RESULT INT font.offset, VAL INT sizex, sizey)
  INT result:
  SDL.Surface surface:
  VAL INT err.const IS 100:
  INITIAL INT width, height IS sizex, sizey:
  SEQ
    occ.SDL.Init(SDL.INIT.VIDEO, result)
    IF
      result <> 0
        [err.const]BYTE err.str:
        INT err.len:
        --CLAIM scr!
        SEQ
          out.string("SDL initialisation failed: ", 0, scr!)
          occ.SDL.GetError(err.str, err.const, err.len)
          out.string([err.str FOR err.len], 0, scr!)
          out.string("*c*n", 0, scr!)
      TRUE
        INT re:
        SEQ
          SDL.GL.SetAttribute(SDL.GL.RED.SIZE, 5, re)
          SDL.GL.SetAttribute(SDL.GL.GREEN.SIZE, 5, re)
          SDL.GL.SetAttribute(SDL.GL.BLUE.SIZE, 5, re)
          SDL.GL.SetAttribute(SDL.GL.DOUBLEBUFFER, 1, re)
          SDL.SetVideoMode(width, height, 16, SDL.OPENGL, surface)
          IF
            (INT surface) = 0
              [100]BYTE err.str:
              INT err.len:
              --CLAIM scr!
              SEQ
                out.string("GL initialisation failed: ", 0, scr!)
                occ.SDL.GetError(err.str, err.const, err.len)
                out.string([err.str FOR err.len], 0, scr!)
                out.string("*c*n", 0, scr!)
            TRUE
              SEQ
                --Setup opengl for rendering.
                glShadeModel(GL.FLAT)
                glViewport(0, 0, width, height)
                glMatrixMode(GL.PROJECTION)
                glLoadIdentity()
                glOrtho(0.00, (REAL64 TRUNC width), (REAL64 TRUNC height), 0.00, -1.0, 1.0)
                glMatrixMode(GL.MODELVIEW)
                glLoadIdentity()
                glClearColor(0.0, 0.0, 0.0, 0.0)
                glClear(GL.COLOR.BUFFER.BIT)
                glFlush()
                --Setup the fonts
                makeRasterFont(font.offset)
:
--* Sets up and configures the button network.  This is the only proc that should be run in this library by a user.
-- @param click this is the click notification channel. Buttons send down these channels when they are clicked.
-- @param configure these are the button configuration channels - they can be used for changing channel color, text, etc..
-- @param scr generally one would pass the error (err) channel as a parameter here so that the library can notify the user
-- in case graphics initialisation goes wrong.
-- @param cntrl.quit this channel should be checked as it carries quit signals (like when someone closes the application window)
-- @param size.x the window size in the X direction (nr of pixels)
-- @param size.y the window size in the Y direction (nr of pixels)
-- to the program.  This allows a clean shutdown of the network.
PROC setup.button.window([][]CHAN CLICK click!, [][]CHAN BUTTONCFG configure?, CHAN BYTE scr!, CHAN BYTE cntrl.quit!, VAL INT size.x, size.y)
  VAL INT max.buttons IS 100:
  -- Holds all inputs
  CHAN INPUT event:
  CHAN BYTE sync.quit:
  VAL INT nr.of.buttons.x IS (SIZE configure):
  VAL INT nr.of.buttons.y IS (SIZE configure[0]):
  -- This nastiness is needed because otherwise we can't create arrays of channels dynamically
  -- INITIAL MOBILE [][]INPUT.CT? tobuttons.c IS MOBILE [nr.of.buttons.x][nr.of.buttons.y]INPUT.CT?:
  -- INITIAL MOBILE [][]INPUT.CT! tobuttons.s IS MOBILE [nr.of.buttons.x][nr.of.buttons.y]INPUT.CT!:
  -- INITIAL MOBILE [][]BOOL.CT? syncstart.c IS MOBILE [nr.of.buttons.x][nr.of.buttons.y]BOOL.CT?:
  -- INITIAL MOBILE [][]BOOL.CT! syncstart.s IS MOBILE [nr.of.buttons.x][nr.of.buttons.y]BOOL.CT!:
  -- INITIAL MOBILE [][]BOOL.CT? syncend.c IS MOBILE [nr.of.buttons.x][nr.of.buttons.y]BOOL.CT?:
  -- INITIAL MOBILE [][]BOOL.CT! syncend.s IS MOBILE [nr.of.buttons.x][nr.of.buttons.y]BOOL.CT!:
  [max.buttons][max.buttons]CHAN INPUT tobuttons:
  [max.buttons][max.buttons]CHAN BOOL syncchan:
  INT font.offset:
  SEQ
    SETAFF(0)
    setup.gfx(scr!, font.offset, size.x, size.y)
    -- Setup all the chans not using this, too ugly
    --SEQ i = 0 FOR nr.of.buttons.x
    --  SEQ j = 0 FOR nr.of.buttons.y
    --    SEQ
    --      tobuttons.c,  tobuttons.s := MOBILE INPUT.CT
    --      syncstart.c,  syncstart.s := MOBILE BOOL.CT
    --      syncend.c,  syncend.s := MOBILE BOOL.CT
    PAR
      -- Start the eventmonitor
      eventmonitor(event!)
      -- Start the mplexor that feeds inputs out to individual buttons
      mplexinput(event?, tobuttons!, sync.quit!, cntrl.quit!, nr.of.buttons.x, nr.of.buttons.y)
      -- Start the the button process
      -- Up to five buttons can be created using this framework
      INITIAL INT button.size.x, button.size.y IS (size.x/nr.of.buttons.x), (size.y/nr.of.buttons.y):
      PAR i = 0 FOR nr.of.buttons.x
        PAR j = 0 FOR nr.of.buttons.y 
          button(tobuttons[i][j]?, click[i][j]!, configure[i][j]?, i, j, font.offset, syncchan[i][j]?, button.size.x, button.size.y)
        -- This could probably be replaced by a barrier or two..
      sync(syncchan!, sync.quit?, nr.of.buttons.x, nr.of.buttons.y)
:

