Analog clock in FTN95

    module clock
      use mswin
      implicit none

      integer :: width = 240, height = 240
      character (len=2), parameter :: hours(0:11) = &
        (/'03','02','01','12','11','10','09','08','07','06','05','04'/)

      contains

        integer function draw_func()
          integer :: i, resize
          integer :: radius
          integer :: xcenter, ycenter
          integer :: angsecs, angmins, anghours
          integer :: s, m, h
          integer :: cx, cy ! point on a circle
          integer :: handx(5), handy(5)
          character (len=8) :: time@, time

          resize=clearwin_info@('GRAPHICS_RESIZING')
          if(resize.EQ.1) then
            width = clearwin_info@('GRAPHICS_WIDTH')
            height = clearwin_info@('GRAPHICS_DEPTH')
          end if

          if(width.GT.height) then
            radius = height
          else
            radius = width
          end if

          radius = radius / 2 - 8

          time = time@()

          read(time(1:2),*) h
          read(time(4:5),*) m
          read(time(7:8),*) s

          xcenter = width/2
          ycenter = height/2

          angsecs = 90 - s * 6
          angmins = 90 - m * 6
          anghours = 90 - (h * 5 + m / 10) * 6

          ! Draw clock frame
          call draw_filled_ellipse@(xcenter,ycenter,radius,radius,rgb@(255,255,255))
          call draw_ellipse@(xcenter,ycenter,radius+1,radius+1,rgb@(0,0,0))
          call draw_filled_ellipse@(xcenter,ycenter,3,3,rgb@(0,0,0))

          ! Draw second and minute dots
          do i = 0, 59, 1
            call circlept(xcenter, ycenter, int(radius * 0.95), i * (360 / 60))
            call draw_filled_ellipse@(cx,cy,1,1, rgb@(0,0,0))
          end do

          ! Draw hour dots
          call size_in_pixels@(14,14)
          call bold_font@(1)
          do i = 0, 11, 1
            call circlept(xcenter, ycenter, int(radius * 0.95), i * (360 / 12))
            call draw_filled_ellipse@(cx,cy,2,2, rgb@(0,0,0))
            call circlept(xcenter-12, ycenter+7, int(radius * 0.80), i * (360 / 12))
            call draw_characters@(hours(i),cx,cy,rgb@(0,0,0))
          end do

          ! draw hands
          handx(1) = xcenter; handy(1) = ycenter
          call circlept(xcenter, ycenter, int(radius * 0.25), angsecs-3)
          handx(2) = cx; handy(2) = cy
          call circlept(xcenter, ycenter, int(radius * 0.90), angsecs)
          handx(3) = cx; handy(3) = cy
          call circlept(xcenter, ycenter, int(radius * 0.25), angsecs+3)
          handx(4) = cx; handy(4) = cy
          handx(5) = xcenter; handy(5) = ycenter
          call draw_filled_polygon@(handx,handy,5,rgb@(0,0,0))
          call circlept(xcenter, ycenter, int(radius * 0.25), angmins-8)
          handx(2) = cx; handy(2) = cy
          call circlept(xcenter, ycenter, int(radius * 0.85), angmins)
          handx(3) = cx; handy(3) = cy
          call circlept(xcenter, ycenter, int(radius * 0.25), angmins+8)
          handx(4) = cx; handy(4) = cy
          call draw_filled_polygon@(handx,handy,5,rgb@(0,0,0))
          call circlept(xcenter, ycenter, int(radius * 0.25), anghours-10)
          handx(2) = cx; handy(2) = cy
          call circlept(xcenter, ycenter, int(radius * 0.65), anghours)
          handx(3) = cx; handy(3) = cy
          call circlept(xcenter, ycenter, int(radius * 0.25), anghours+10)
          handx(4) = cx; handy(4) = cy
          call draw_filled_polygon@(handx,handy,5,rgb@(0,0,0))


          draw_func=1

          contains

            subroutine circlept(x, y, r, deg)
              integer, intent(in) :: x, y, r, deg
              real :: rad

              rad = deg * 3.14159 / 180
              cx = x + Cos(rad) * r
              cy = y - Sin(rad) * r
            end subroutine circlept

        end function draw_func

    end module clock


    winapp
      use clock
      implicit none

      integer :: i

      i=winio@('%ww[no_border,no_maxbox]&')
      i=winio@('%ca[FTN95 Clock]&')
      i=winio@('%pv%^gr[user_resize,grey,rgb_colours]&',width,height,draw_func)
      i=winio@('%dl', 1.0D0, draw_func)
    end