( clock DAY 08.04.2001 )

"graphics"
"sincos"
"facil"
"forms"
"case"

0 value rad
0 value centX
0 value centY
variable Drawing

: type
   s>abs CurX @ CurY @ WinDrawChars
;

: bplot ( x y )
   1- dup 3 + swap
   do 
      dup 1- dup 3 + swap
      do i j plot loop
   loop drop
;

:  DrawDots ( -- )
    360 0
    do
       rad i cos* centX +
       rad i sin* centY +
       2dup plot
       i 30 mod 0= if bplot
                   else 2drop
                   then
    6 +loop
;

: DrawHours
    0
    660 300
    do
       rad 7 + i cos* centX + 2-
       rad 7 + i sin* centY + 5 -
       atScreen 1+ dup 0  <# #s #> 
       dup 2 = if -3 curX +! 
                  -1 curY +!
               then
       type
    30 +loop drop
;

api: WinDrawRectangle

: ClockFace
    DrawDots
    DrawHours
;

0 value curWin
0 value offWin

api: WinGetDrawWindow
api: WinSetDrawWindow
api: WinCopyRectangle
api: WinSetDrawMode
api: DayOfWeek
api: WinEraseWindow
api: WinDeleteWindow
api: FrmAlert
api: FrmHelp

create weekDays S" SunMonTueWedThuFriSat" S",

: WeekDay ( day mt year -- addr u )
    >r swap r>
    DayOfWeek 3 w*
    weekDays + 1+ 3
;

: toDispWin
    curWin WinSetDrawWindow drop
;

: toOffWin
    offWin WinSetDrawWindow drop
;

: Off>Disp
    offWin curWin
    screenRect >abs
    0 0 0
    WinCopyRectangle
;

: initClock
    maxx 2/ to centX
    maxy 2/ to centY
    65 to rad    
    WinGetDrawWindow to curWin
    maxx maxy CreateOffScreen
    to offWin
    toOffWin
;

-1 value prevSec

: getXY ( deg rad -- x y )
   swap 2dup cos* >r
   sin* centY +
   r> centX + swap
;

: cent!
   to centY to centX
;

: DrawHM ( x y deg n -- x y )
    1 do
        i over >r getXY
        2over WinDrawLine r>
      loop drop
;

: DrawMArrow ( min sec )
  10 / swap
  6 w* + 90 - >r
  r@ 180 + 5 getXY
  r@ rad 7 -
  getXY 2over cent!
  r@ 90 + 3 DrawHM
  r> 90 - 3 DrawHM
  80 80 cent!
  WinDrawLine
;

: DrawHArrow ( hour min )
  2/ swap
  dup 12 > if 12 - then
  30 w* + 90 - >r
  r@ 180 + 5 getXY
  r@ rad 20 -
  getXY 2over cent!
  r@ 90 + 4 DrawHM
  r> 90 - 4 DrawHM
  80 80 cent!
  WinDrawLine
;  

: PaintSecLine ( u )
   6 w* 90 - 
   dup 180 + 10 getXY
   rot rad 2+ getXY
   WinDrawLine
;

: DrawSArrow ( u )
   dup to prevSec
   PaintSecLine
;

: DrawDate ( day mt year -- )
   >r swap r>
   0 0 atScreen
   <# 0 #s [char] / hold 2drop
      0 # # [char] / hold 2drop
      0 #s #> type
;

: 3dup
   2 pick 2 pick
   2 pick
;

: DrawTime ( sec min hr -- )
   115 0 atScreen
   dup 12 > if 12 - [char] p >r
            else [char] a >r
            then
   swap rot
   <# s"   " holds r> hold 
      0 # # [char] : hold 2drop
      0 # # [char] : hold 2drop
      0 #s  #> type
;

: DrawDay ( day mt year -- )
    0 12 atScreen
    WeekDay type
;

: DrawArrows
   time&date
   5 pick prevSec =
   if 2drop 2drop 2drop exit then

   toOffWin
   WinEraseWindow
   ClockFace
   3dup DrawDay
   DrawDate 
   3dup DrawTime
   over DrawHArrow
   over DrawMArrow
   DrawSArrow
   toDispWin
   Off>Disp
;

: doMenu
   event itemid
   dup 1001 =
   if 1000 FrmAlert drop 
   then
   1002 =
   if 1000 FrmHelp then
;

: enterMainF
   event 8 + @
   FrmGetActiveForm =
   if Drawing on then
;

: ProcessEvents
  begin
    20 (ekey) dup
    case 
      WinExitEvent 
         of Drawing off endof
      WinEnterEvent 
         of enterMainF endof
      MenuEvent of doMenu endof
    endcase
    0=
  until
;

: EventLoop
  begin
    ProcessEvents
    Drawing @ if DrawArrows then
  again
;

: go
  initClock Drawing on
  1000 ShowForm
  ['] EventLoop catch
  drop offWin 0
  WinDeleteWindow
;

' go to PilotMain

s" fclock" 'abcd' build

'rsrc' 'dima' use-resource

'tFRM' 1000 CopyRes
'MBAR' 1000 CopyRes
'tSTR' 1000 CopyRes
'Talt' 1000 CopyRes
'tAIB' 1000 CopyRes
'tAIB' 1001 CopyRes