
(********************************************************************)
(*                                                                  *)
(*  carddemo.sd7  Demonstate the playing cards of the french deck   *)
(*  Copyright (C) 2006, 2010, 2013  Thomas Mertes                   *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program is distributed in the hope that it will be useful, *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
(*  GNU General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU General Public       *)
(*  License along with this program; if not, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ include "seed7_05.s7i";
  include "float.s7i";
  include "draw.s7i";
  include "keybd.s7i";
  include "cards.s7i";
  include "image.s7i";
  include "time.s7i";
  include "duration.s7i";
  include "dialog.s7i";


const integer: PICTURE_SCALE is 1;


const type: cardType is sub baseImage struct
    var cardSuit: suit is cardSuit.value;
    var cardRank: rank is cardRank.value;
  end struct;


const type: imageHashType is hash [PRIMITIVE_WINDOW] image;


var imageHashType: imageHash is imageHashType.value;


const proc: put (in integer: xPos, in integer: yPos,
    in cardSuit: suit, in cardRank: rank) is func
  local
    var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
    var cardType: aCard is cardType.value;
    var image: anImage is image.value;
  begin
    pixmap := cardPixmap(suit, rank, PICTURE_SCALE);
    aCard.suit := suit;
    aCard.rank := rank;
    aCard.name := str(rank) <& " of " <& str(suit);
    aCard.window := openSubWindow(curr_win, xPos, yPos, width(pixmap), height(pixmap));
    put(aCard.window, 0, 0, pixmap, PSET);
    anImage := toInterface(aCard);
    imageHash @:= [window(anImage)] anImage;
  end func;


const proc: move (inout image: anImage) is func
  local
    var integer: deltaX is 0;
    var integer: deltaY is 0;
    var integer: newXpos is 0;
    var integer: newYpos is 0;
  begin
    deltaX := pointerXPos(curr_win) - xPos(anImage);
    deltaY := pointerYPos(curr_win) - yPos(anImage);
    repeat
      newXpos := pointerXPos(curr_win) - deltaX;
      newYpos := pointerYPos(curr_win) - deltaY;
      if newXpos <> xPos(anImage) or newYpos <> yPos(anImage) then
        setPos(anImage, newXpos, newYpos);
        DRAW_FLUSH;
      end if;
      wait(30000 . MICRO_SECONDS);
    until keypressed(KEYBOARD) or
        not (buttonPressed(KEYBOARD, KEY_MOUSE1) or
             buttonPressed(KEYBOARD, KEY_MOUSE2) or
             buttonPressed(KEYBOARD, KEY_MOUSE3));
  end func;


const func image: select_card is func
  result
    var image: anImage is image.value;
  local
    var integer: xPos is 0;
    var integer: yPos is 0;
    var PRIMITIVE_WINDOW: win is PRIMITIVE_WINDOW.value;
  begin
    xPos := getxpos(KEYBOARD);
    yPos := getypos(KEYBOARD);
    win := buttonWindow(KEYBOARD);
    if win in imageHash then
      anImage := imageHash[win];
      # writeln(str(anImage));
    end if;
  end func;


const proc: main is func
  local
    var char: command is ' ';
    var image: anImage is image.value;
  begin
    screen(980 * PICTURE_SCALE, 405 * PICTURE_SCALE);
    clear(curr_win, white);
    (* screen := open(curr_win, 16); *)
    KEYBOARD := GRAPH_KEYBOARD;
    put(  4,   4, spades,   ace);
    put( 79,   4, spades,   king);
    put(154,   4, spades,   queen);
    put(229,   4, spades,   jack);
    put(304,   4, spades,   ten);
    put(379,   4, spades,   nine);
    put(454,   4, spades,   eight);
    put(529,   4, spades,   seven);
    put(604,   4, spades,   six);
    put(679,   4, spades,   five);
    put(754,   4, spades,   four);
    put(829,   4, spades,   three);
    put(904,   4, spades,   two);
    put(  4, 104, hearts,   ace);
    put( 79, 104, hearts,   king);
    put(154, 104, hearts,   queen);
    put(229, 104, hearts,   jack);
    put(304, 104, hearts,   ten);
    put(379, 104, hearts,   nine);
    put(454, 104, hearts,   eight);
    put(529, 104, hearts,   seven);
    put(604, 104, hearts,   six);
    put(679, 104, hearts,   five);
    put(754, 104, hearts,   four);
    put(829, 104, hearts,   three);
    put(904, 104, hearts,   two);
    put(  4, 204, diamonds, ace);
    put( 79, 204, diamonds, king);
    put(154, 204, diamonds, queen);
    put(229, 204, diamonds, jack);
    put(304, 204, diamonds, ten);
    put(379, 204, diamonds, nine);
    put(454, 204, diamonds, eight);
    put(529, 204, diamonds, seven);
    put(604, 204, diamonds, six);
    put(679, 204, diamonds, five);
    put(754, 204, diamonds, four);
    put(829, 204, diamonds, three);
    put(904, 204, diamonds, two);
    put(  4, 304, clubs,    ace);
    put( 79, 304, clubs,    king);
    put(154, 304, clubs,    queen);
    put(229, 304, clubs,    jack);
    put(304, 304, clubs,    ten);
    put(379, 304, clubs,    nine);
    put(454, 304, clubs,    eight);
    put(529, 304, clubs,    seven);
    put(604, 304, clubs,    six);
    put(679, 304, clubs,    five);
    put(754, 304, clubs,    four);
    put(829, 304, clubs,    three);
    put(904, 304, clubs,    two);
    DRAW_FLUSH;
    command := getc(KEYBOARD);
    while command in {KEY_MOUSE1, KEY_MOUSE2, KEY_MOUSE3} do
      anImage := select_card;
      if anImage <> image.value then
        if command = KEY_MOUSE2 then
          toTop(anImage);
          DRAW_FLUSH;
        elsif command = KEY_MOUSE3 then
          toBottom(anImage);
          DRAW_FLUSH;
        end if;
        move(anImage);
      end if;
      command := getc(KEYBOARD);
    end while;
  end func;
