\ VP-events
\ Event-handling
\
\ $Id: VP-events.txt,v 1.2 2000/11/12 03:22:18 kris_johnson Exp $

\ Copyright 2000
\ Kristopher D. Johnson
\ 
\ See LICENSE-JacksOrBetter for the
\ conditions under which you may
\ use, redistribute, or modify this 
\ code, or create derived works.

docneeds VP-ui
docneeds VP-statsui

.( VP-events... )

\ This variable is set to TRUE at the
\ beginning of the event loop. If it
\ is set FALSE, the event loop will exit
variable ExitFlag

: confirm-new? ( -- f )
  GameOver? if true exit then
  altConfirmNew FrmAlert btnYes =
;

: do-new ( -- )
  confirm-new? not if exit then
  new-game
  refresh-form
;

: do-draw ( -- )
  checks>hold
  all-held? not if show-discard then
  draw
  refresh-form
  LastScore @ if
    show-scoring
  then
;

: do-deal ( -- )
  GameOver? if
    error-sound exit
  then
  Dealt? if
    do-draw exit
  then
  NewGame? not if
    show-shuffle
  then
  reset-hold checks>hold
  deal
  refresh-form
;

\ Handle a menu command or
\ button click
: do-command ( cmd -- cmd )
  dup cmdAbout = if
    about-box exit
  then
  dup cmdHelp = if
    show-help exit
  then
  dup cmdDeal = if
    do-deal exit
  then
  dup cmdNew = if
    do-new exit
  then
  dup cmdStatistics = if
    show-stats exit
  then
  dup cmdExit = if
    true ExitFlag ! exit
  then
;

\ Handle a menu event
: do-menu-event ( -- )
  event >abs itemid
  do-command drop
;

\ When card button clicked,
\ toggle corresponding checkbox 
: do-hand-button ( controlID -- )
  Dealt? not if
    drop error-sound exit
  then
  HandButtonID>index
  HoldCheckID toggle-check
;

\ Handle a control-select event
: do-ctl-select-event ( -- )
  event >abs itemid
  dup HandButtonID? if
    do-hand-button exit
  then
  dup HoldCheckID? if
    drop exit
  then
  do-command drop
;

\ Dispatch event to appropriate
\ handler
: do-event ( ekey -- ekey )
  dup menuEvent = if
    do-menu-event exit
  then
  dup ctlSelectEvent = if
    do-ctl-select-event exit
  then
  dup nilEvent = if
    refresh-clock-if-time-changed
    exit
  then
;

\ Event loop
: handle-events ( -- )
  0 ExitFlag !
  begin
    ekey do-event drop
  ExitFlag @ until
;
