
(********************************************************************)
(*                                                                  *)
(*  carddemo.sd7  Demonstate the playing cards of the french deck   *)
(*  Copyright (C) 2006, 2010  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 "time.s7i";
  include "duration.s7i";
  include "dialog.s7i";


const integer: PICTURE_SCALE is 1;


const type: suitType is new enum
    clubs, diamonds, hearts, spades
  end enum;

const func string: str (in suitType: suit) is
  return [] ("clubs", "diamonds", "hearts", "spades") [succ(ord(suit))];


const type: rankType is new enum
    two, three, four, five, six, seven, eight, nine, ten, jack, queen, king, ace
  end enum;

const func string: str (in rankType: rank) is
  return [] ("two", "three", "four", "five", "six", "seven",
             "eight", "nine", "ten", "jack", "queen", "king", "ace") [succ(ord(rank))];


const type: imageType is sub object interface;

const func integer: width (in imageType param) is DYNAMIC;
const func integer: height (in imageType param) is DYNAMIC;
const func integer: xPos (in imageType param) is DYNAMIC;
const func integer: yPos (in imageType param) is DYNAMIC;
const func PRIMITIVE_WINDOW: window (in imageType param) is DYNAMIC;
const proc: setPos (inout imageType param, in integer param, in integer param) is DYNAMIC;
const func string: str (in imageType param) is DYNAMIC;

enable_output(imageType);


const type: cardType is new struct
    var suitType: suit is suitType.value;
    var rankType: rank is rankType.value;
    var PRIMITIVE_WINDOW: window is PRIMITIVE_WINDOW.value;
  end struct;


type_implements_interface(cardType, imageType);


const imageType: (attr imageType) . value is cardType.value;


const func integer: width (in cardType: aCard) is
  return width(aCard.window);


const func integer: height (in cardType: aCard) is
  return height(aCard.window);


const func integer: xPos (in cardType: aCard) is
  return xPos(aCard.window);


const func integer: yPos (in cardType: aCard) is
  return yPos(aCard.window);


const func PRIMITIVE_WINDOW: window (in cardType: aCard) is
  return aCard.window;


const proc: setPos (inout cardType: aCard, in integer: xPos, in integer: yPos) is func
  begin
    setPos(aCard.window, xPos, yPos);
  end func;


const func string: str (in cardType: aCard) is
  return str(aCard.rank) & " of " & str(aCard.suit);


const func cardType: malloc (ref cardType: aCard) is func
  result
    var cardType: result is cardType.value;
  begin
    result := aCard;
  end func;


const type: imageHashType is hash [PRIMITIVE_WINDOW] imageType;


var imageHashType: imageHash is imageHashType.value;


const proc: put (in integer: xPos, in integer: yPos, in PRIMITIVE_WINDOW: pixmap,
    in suitType: suit, in rankType: rank) is func
  local
    var cardType: aCard is cardType.value;
    var imageType: anImage is imageType.value;
  begin
    aCard.suit := suit;
    aCard.rank := rank;
    aCard.window := openSubWindow(curr_win, xPos, yPos, width(pixmap), height(pixmap));
    put(aCard.window, 0, 0, pixmap, PSET);
    anImage := malloc(aCard);
    imageHash @:= [window(anImage)] anImage;
  end func;


const proc: move (inout imageType: 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(window(anImage));
    deltaY := pointerYPos(curr_win) - yPos(window(anImage));
    repeat
      newXpos := pointerXPos(curr_win) - deltaX;
      newYpos := pointerYPos(curr_win) - deltaY;
      if newXpos <> xPos(anImage) or newYpos <> yPos(anImage) then
        setPos(window(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 imageType: select_card is func
  result
    var imageType: result is imageType.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
      result := imageHash[win];
    end if;
  end func;


const proc: main is func
  local
    var char: command is ' ';
    var imageType: anImage is imageType.value;
  begin
    screen(980 * PICTURE_SCALE, 405 * PICTURE_SCALE);
    clear(curr_win, white);
    (* screen := open(curr_win, 16); *)
    KEYBOARD := GRAPH_KEYBOARD;
    initCardPixmaps(PICTURE_SCALE);
    put(  4,   4, ace_of_spades,     spades,   ace);
    put( 79,   4, king_of_spades,    spades,   king);
    put(154,   4, queen_of_spades,   spades,   queen);
    put(229,   4, jack_of_spades,    spades,   jack);
    put(304,   4, ten_of_spades,     spades,   ten);
    put(379,   4, nine_of_spades,    spades,   nine);
    put(454,   4, eight_of_spades,   spades,   eight);
    put(529,   4, seven_of_spades,   spades,   seven);
    put(604,   4, six_of_spades,     spades,   six);
    put(679,   4, five_of_spades,    spades,   five);
    put(754,   4, four_of_spades,    spades,   four);
    put(829,   4, three_of_spades,   spades,   three);
    put(904,   4, two_of_spades,     spades,   two);
    put(  4, 104, ace_of_hearts,     hearts,   ace);
    put( 79, 104, king_of_hearts,    hearts,   king);
    put(154, 104, queen_of_hearts,   hearts,   queen);
    put(229, 104, jack_of_hearts,    hearts,   jack);
    put(304, 104, ten_of_hearts,     hearts,   ten);
    put(379, 104, nine_of_hearts,    hearts,   nine);
    put(454, 104, eight_of_hearts,   hearts,   eight);
    put(529, 104, seven_of_hearts,   hearts,   seven);
    put(604, 104, six_of_hearts,     hearts,   six);
    put(679, 104, five_of_hearts,    hearts,   five);
    put(754, 104, four_of_hearts,    hearts,   four);
    put(829, 104, three_of_hearts,   hearts,   three);
    put(904, 104, two_of_hearts,     hearts,   two);
    put(  4, 204, ace_of_diamonds,   diamonds, ace);
    put( 79, 204, king_of_diamonds,  diamonds, king);
    put(154, 204, queen_of_diamonds, diamonds, queen);
    put(229, 204, jack_of_diamonds,  diamonds, jack);
    put(304, 204, ten_of_diamonds,   diamonds, ten);
    put(379, 204, nine_of_diamonds,  diamonds, nine);
    put(454, 204, eight_of_diamonds, diamonds, eight);
    put(529, 204, seven_of_diamonds, diamonds, seven);
    put(604, 204, six_of_diamonds,   diamonds, six);
    put(679, 204, five_of_diamonds,  diamonds, five);
    put(754, 204, four_of_diamonds,  diamonds, four);
    put(829, 204, three_of_diamonds, diamonds, three);
    put(904, 204, two_of_diamonds,   diamonds, two);
    put(  4, 304, ace_of_clubs,      clubs,    ace);
    put( 79, 304, king_of_clubs,     clubs,    king);
    put(154, 304, queen_of_clubs,    clubs,    queen);
    put(229, 304, jack_of_clubs,     clubs,    jack);
    put(304, 304, ten_of_clubs,      clubs,    ten);
    put(379, 304, nine_of_clubs,     clubs,    nine);
    put(454, 304, eight_of_clubs,    clubs,    eight);
    put(529, 304, seven_of_clubs,    clubs,    seven);
    put(604, 304, six_of_clubs,      clubs,    six);
    put(679, 304, five_of_clubs,     clubs,    five);
    put(754, 304, four_of_clubs,     clubs,    four);
    put(829, 304, three_of_clubs,    clubs,    three);
    put(904, 304, two_of_clubs,      clubs,    two);
    DRAW_FLUSH;
    command := getc(KEYBOARD);
    while command in {KEY_MOUSE1, KEY_MOUSE2, KEY_MOUSE3} do
      anImage := select_card;
      if anImage <> imageType.value then
        if command = KEY_MOUSE2 then
          toTop(window(anImage));
          DRAW_FLUSH;
        elsif command = KEY_MOUSE3 then
          toBottom(window(anImage));
          DRAW_FLUSH;
        end if;
        move(anImage);
      end if;
      command := getc(KEYBOARD);
    end while;
  end func;
