include win32lib.ew
without warning

sequence deck, cards
deck = {1, 2, 3, 4, 5}
cards = {"Ten", "Jack", "Queen", "King", "Ace"}
integer ready, picked, myscore, yourscore, cheat
ready = 0
myscore = 0
yourscore = 0
cheat = 0

----

constant
msg0 = "...dealing cards.", 
msg1 = "...draw a card ( 1 to 4 )", 
msg2 = "You Lose  : )", 
msg3 = "You Win  !!", 

MyWin    = create( Window, "Card-Trix-2", 0, 10, 10, 300, 320, 0 ), 
yours    = create( LText, "You", MyWin, 5, 10, 100, 20, 0 ), 
mine     = create( RText, "Me", MyWin, 180, 10, 100, 20, 0 ), 
menuBar  = create( Menu, "&Program", MyWin, 0, 0, 0, 0, 0 ), 
menuCheat = create( MenuItem, "&Cheat", menuBar, 0, 0, 0, 0, 0 ), 
menuOut  = create( MenuItem, "E&xit", menuBar, 0, 0, 0, 0, 0 ), 
statBar  = create( StatusBar, "", MyWin, 0, 0, 0, 0, 0 ), 
deckPix  = create( Pixmap, "", 0, 0, 0, 421, 71, 0 ), 
dealPix  = create( Pixmap, "", 0, 0, 0, 131, 98, 0 ), 
playPix  = create( Pixmap, "", 0, 0, 0, 149, 98, 0 ), 

myTimer  = 1,
myTimer2 = 2
----

sequence temp_wins = { MyWin, yours, mine } -- fix a snag
for i=1 to length(temp_wins) do
	setWindowBackColor( temp_wins[i], Green )
end for

setFont( yours, "System", 0, 0 )
setFont( mine, "System", 0, 0 )
setPixmap( deckPix, loadBitmapFromFile( ".\\Bin\\cardtrix.bmp" ) )

----

function shuffle( sequence s )
integer r
object temp
  for i = length( s ) to 1 by -1 do
    r = rand( i )
    temp = s[r]
    s[r] = s[i]
    s[i] = temp
  end for
  return s
end function

----

procedure green( )
  setPenColor( dealPix, Green )
  drawRectangle( dealPix, 1, 0, 0, 131, 98 )
  copyBlt( MyWin, 80, 140, dealPix )
  setPenColor( playPix, Green )
  drawRectangle( playPix, 1, 0, 0, 149, 98 )
  copyBlt( MyWin, 70, 35, playPix )
end procedure

----

-- play pop.wav every time a card is drawn
procedure sound_off( )
  object jk
  jk = playSound( ".\\Bin\\pop.wav" )
end procedure

----

function anything_but( integer x )
integer r
  r = rand( 3 )
  if r >= x then r += 1 end if
  return r
end function

----

procedure play( integer picked )
integer pos, rnd, you, me
  if ready = 1 then
    ready = 0
    setText( statBar, "...you drew the " & cards[deck[picked]] )
    you = deck[picked]
    pos = deck[picked]*70
    bitBlt( playPix, 0, 0, deckPix, pos, 0, 71, 98, SrcCopy )
    copyBlt( MyWin, 70, 35, playPix )
    sound_off( )
    sleep( 1 )
    rnd = anything_but( picked )
    me = deck[rnd]
    pos = deck[rnd]*70
    bitBlt( playPix, 78, 0, deckPix, pos, 0, 71, 98, SrcCopy )
    copyBlt( MyWin, 70, 35, playPix )
    sound_off( )
    sleep( 2 )
    if me > you then
      setText( statBar, msg2 )
      myscore += 1
      setText( mine, "Me " & sprintf( "%d", myscore ) )
    else
      setText( statBar, msg3 )
      yourscore += 1
      setText( yours, "You " & sprintf( "%d", yourscore ) )
    end if
    sleep( 3 )
    green( )
    deck = shuffle( deck )
    setTimer( MyWin, myTimer, 500 )
  end if
end procedure

----

procedure start_up( atom self, atom event, sequence params )
  green( )
  deck = shuffle( deck )
  setText( statBar, msg0 )
  setTimer( MyWin, myTimer, 500 )
end procedure
setHandler( MyWin, w32HOpen, routine_id( "start_up" ) )

----

-- delay routine
procedure stall( atom x )
  atom delay
  delay=time( )
  while time( ) < delay + x do
  end while
end procedure

--

procedure do_deal( atom self, atom event, sequence params )
   atom timerId = params[1]
  if timerId = 1 then
    killTimer( MyWin, myTimer )
    setTimer( MyWin, myTimer2, 2500 )
    setText( statBar, msg0 )
    if cheat = 0 then
      for i = 0 to 3 do
        -- give visual cue, as well as sound
        bitBlt( dealPix, i*20, 0, deckPix, 0, 0, 71, 98, SrcCopy ) --**
        copyBlt( MyWin, 80, 140, dealPix )                    --**
        bitBlt( dealPix, i*20, 0, deckPix, 0, 0, 71, 98, PatInvert )
        copyBlt( MyWin, 80, 140, dealPix )
        sound_off( )
        stall( .1 )
        bitBlt( dealPix, i*20, 0, deckPix, 0, 0, 71, 98, SrcCopy )
        copyBlt( MyWin, 80, 140, dealPix )
        stall( .4 )
      end for
    else
      -- don't bother with visual cue here, but, 
      -- show first card to 'cheat'...
      bitBlt( dealPix, 0, 0, deckPix, deck[1]*70, 0, 71, 98, SrcCopy )
      copyBlt( MyWin, 80, 140, dealPix )
      stall( .5 )
      for i = 0 to 3 do
        sound_off( )
        bitBlt( dealPix, i*20, 0, deckPix, 0, 0, 71, 98, SrcCopy )
        copyBlt( MyWin, 80, 140, dealPix )
        stall( .5 )
      end for
    end if
  elsif timerId = 2 then
    killTimer( MyWin, myTimer2 )
    ready = 1
    setText( statBar, msg1 )
  end if
end procedure
setHandler( MyWin, w32HTimer, routine_id( "do_deal" ) )

----

procedure kill_timers( )
  killTimer( MyWin, myTimer )
  killTimer( MyWin, myTimer2 )
end procedure

----

procedure cheat_deal( atom self, atom event, sequence params )
  kill_timers( )
  ready=0
  if cheat = 0 then cheat = 1 else cheat = 0 end if
  green( )
  do_deal( 0, 0, {1} )
end procedure
setHandler( menuCheat, w32HClick, routine_id( "cheat_deal" ) )

----

procedure pick( atom self, atom event, sequence params )
  atom key = params[1]
  if key > 48 and key < 53 then
    picked = key - 48
    play( picked )
  end if
end procedure
setHandler( MyWin, w32HKeyDown, routine_id( "pick" ) )

----

procedure on_bitmap( atom self, atom event, sequence params )
atom x = params[2]
atom y = params[3]
integer picked
  if event = LeftDown then
    if x > 80 then       -- left x co-ordinate of 'total'
      if x < 210 then    -- right x co-ordinate of 'total'
        if y > 141 and y < 237 then  -- y co-ordinates of 'total'
          picked = 0
          for i = 80 to 140 by 20 do -- 'overlapped' zones
            -- leave a 'dead' zone between cards !
            if x > i+1 and x < i + ( 20 - 1 ) then
              picked = floor( ( i - 80 ) / 20 ) + 1
            end if
          end for
          if x > 140 and x < 210   -- 'remainder' of last card
            then picked = 4
          end if
          if picked != 0 and ready = 1 then
            play( picked )
          end if
        end if
      end if
    end if
  end if
end procedure
setHandler( MyWin, w32HMouse, routine_id( "on_bitmap" ) )

----

procedure re_paint( atom self, atom event, sequence params )
  copyBlt( MyWin, 80, 140, dealPix )
  copyBlt( MyWin, 70, 35, playPix )
end procedure
setHandler( MyWin, w32HPaint, routine_id( "re_paint" ) )

----

procedure quit( atom self, atom event, sequence params )
  closeWindow( MyWin )
end procedure
setHandler( menuOut, w32HClick, routine_id( "quit" ) )

----

WinMain( MyWin, Normal )
