*--------------------------------------------------------------------*
*   A sample desk accessory for Prospero Fortran                     *
*   This accessory displays an analogue clock face                   *
*                                                                    *
*   Do NOT run CLOCKDA.PRG from the Workbench or the GEM Desktop -   *
*   once linked it should be renamed CLOCKDA.ACC, and copied to a    *
*   boot disk. Next time the Atari is booted using that disk, this   *
*   accessory will install itself, and can be run by selecting the   *
*   item "Analog clock" from the Desk menu                           *
*                                                                    *
*   See also the note in READ.ME about debugging Desk accessories    *
*                                                                    *
*   Author: R K Chapman                                              *
*   Date  : 28 August 1987                                           *
*--------------------------------------------------------------------*

      PROGRAM clockda

      IMPLICIT none
      INTEGER*4 ap_id, m_id
      INTEGER*2 work_in(0:10), work_out(0:56), message(0:7)
      CHARACTER*20 my_menu_item        ! must be in a variable
      CHARACTER*10 my_window_title     ! ditto
      INTEGER*4 cx, cy, cw, ch         ! Window's total area
      LOGICAL*1 on_screen              ! is the window open ?
      INTEGER*4 event, events
      INTEGER*4 i, dummy

      COMMON    /workstation/ my_window, workstation, aspect,
     -                        wx, wy, ww, wh
      INTEGER*4 my_window              ! Window handle
      INTEGER*4 workstation            ! Workstation handle
      INTEGER*4 wx, wy, ww, wh         ! Window's work area
      REAL*4    aspect
  
      INCLUDE 'GEMFUNCS'
      INCLUDE 'GEMCONST'

      CALL appl_init
      ap_id = AESret()
      workstation = graf_handle(dummy, dummy, dummy, dummy)
      DO 10 i = 0, 8
10      work_in(i) = 1
      work_in(9) = 0             ! fill colour is 0 (white)
      work_in(10) = 2            ! raster coords
      CALL v_opnvwk(work_in, workstation, work_out)
      aspect = float(work_out(3))/work_out(4)
      my_menu_item = '  Analog clock'//char(0)
      m_id = menu_register(ap_id, my_menu_item)
      events = MU_MESAG
      on_screen = .false.
      cx = 20
      cy = 40
      cw = 100
      ch = nint(100*aspect) ! Initial window work area position/size
      CALL wind_calc(.false., NAME .OR. CLOSER .OR. MOVER,
     -               cx, cy, cw, ch, cx, cy, cw, ch)
20    CONTINUE
        event = evnt_multi(events,
     -                     1, 1, 1,
     -                     .false., 0, 0, 0, 0,
     -                     .false., 0, 0, 0, 0,
     -                     message, 1950,
     -                     dummy, dummy, dummy, dummy, dummy, dummy)
        IF ((event .AND. MU_MESAG) .ne. 0) THEN

          IF ((message(0) .eq. WM_TOPPED) .OR.
     -        (message(0) .eq. AC_OPEN)) THEN
            IF (on_screen) THEN
*             Move window to top
              CALL wind_set(my_window, WF_TOP, 0, 0, 0, 0)
              CALL graf_mouse(0, 0)
            ELSE
*             Open a window
              CALL graf_mouse(0, 0)
              my_window = wind_create(CLOSER .OR. NAME .OR. MOVER,
     -                                cx, cy, cw, ch)
              IF (my_window .gt. 0) THEN
                my_window_title = 'Clock'//char(0)
                CALL wind_title(my_window, my_window_title)
                CALL wind_open(my_window, cx, cy, cw, ch)
                CALL wind_get(my_window, WF_WXYWH, wx, wy, ww, wh)
                on_screen = .true.
              END IF  
            END IF

          ELSE IF (message(0) .eq. AC_CLOSE) THEN
*           window handle no longer valid
            on_screen = .false.

          ELSE IF (message(0) .eq. WM_CLOSED) THEN
            IF (on_screen) THEN
*             Close window
              CALL wind_close(my_window)
              CALL wind_delete(my_window)
              on_screen = .false.
            END IF

          ELSE IF (message(0) .eq. WM_MOVED) THEN
*           Move the window
            IF (message(3) .eq. my_window) THEN
              cx = message(4)
              cy = message(5)
              cw = message(6)
              ch = message(7)
              CALL wind_set(my_window, WF_CXYWH,
     -                      cx, cy, cw, ch)
              CALL wind_get(my_window, WF_WXYWH,
     -                      wx, wy, ww, wh)
            END IF

          ELSE IF (message(0) .eq. WM_REDRAW) THEN
            IF (message(3) .eq. my_window) CALL redraw
          END IF
        END IF

        IF ((events .AND. MU_TIMER) .ne. 0) THEN
          IF (on_screen) CALL redraw
        END IF

        IF (on_screen) THEN
          events = MU_TIMER .OR. MU_MESAG
        ELSE
          events = MU_MESAG
        END IF

      GOTO 20                           ! Repeat indefinitely
      END

*-------------------------------------------------------------
*  redraw draws the clock face to the visible portion of the 
*  window
*-------------------------------------------------------------
 
      SUBROUTINE redraw
      IMPLICIT none
      INTEGER*2 rect(0:3)
      INTEGER*4 rx, ry, rw, rh
      INTEGER*4 hours, mins, secs, huns

      COMMON    /workstation/ my_window, workstation, aspect,
     -                        wx, wy, ww, wh
      INTEGER*4 my_window, workstation, wx, wy, ww, wh
      REAL*4    aspect

      INCLUDE 'GEMCONST'
  
      CALL wind_update(beg_update)
      CALL wind_get(my_window, WF_FIRSTXYWH, rx, ry, rw, rh)
10    CONTINUE
      IF (rw+rh .ne. 0) THEN
        rect(0) = rx
        rect(1) = ry
        rect(2) = rx+rw-1
        rect(3) = ry+rh-1
        CALL vs_clip(workstation, .true., rect)
        CALL time(hours, mins, secs, huns)
        CALL graf_mouse(256, 0)                ! hide mouse
        CALL vr_recfl(workstation, rect)
        CALL v_arc(workstation, wx + ww/2, wy + wh/2, ww/2, 0, 3600)
        rect(0) = wx + ww/2
        rect(1) = wy + wh/2
        CALL plot_polar(rect, mod(hours, 12)*300 + mins*5, 30)
        CALL plot_polar(rect, mins*60 + secs, 40)
        CALL plot_polar(rect, secs*60, 50)
        CALL graf_mouse(257, 0)                ! Show mouse
        CALL wind_get(my_window, WF_NEXTXYWH, rx, ry, rw, rh)
        GOTO 10
      END IF
      CALL wind_update(end_update)
      END

*---------------------------------------------------------
*  plot_polar draws a line from the cetre of the window's
*  work area, with the given angle and length
*---------------------------------------------------------

      SUBROUTINE plot_polar(rect, angle, radius)
      IMPLICIT none
      INTEGER*4 angle, radius
      INTEGER*2 rect(0:3)
      REAL*4 rangle

      COMMON    /workstation/ my_window, workstation, aspect,
     -                        wx, wy, ww, wh
      INTEGER*4 my_window, workstation, wx, wy, ww, wh
      REAL*4    aspect
  
      angle = 900 - angle
      IF (angle .lt. 0) angle = angle+3600
      rangle = angle * 3.1415927/1800
      rect(2) = rect(0) + nint(radius*cos(rangle))
      rect(3) = rect(1) - nint(radius*sin(rangle)*aspect)
      CALL v_pline(workstation, 2, rect)
      END
    


