
(********************************************************************)
(*                                                                  *)
(*  shisen.sd7    Shisen game                                       *)
(*  Copyright (C) 2005, 2007, 2012, 2013, 2020  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 "text.s7i";
  include "draw.s7i";
  include "pic_util.s7i";
  include "keybd.s7i";
  include "dialog.s7i";
  include "time.s7i";
  include "duration.s7i";
  include "pic32.s7i";
  include "vecfont10.s7i";
  include "pixmap_file.s7i";


var text: screen is STD_NULL;

const integer: UPPER_BORDER is 64;
const integer: LEFT_BORDER is 64;
const integer: CARD_SIZE is 64;
const integer: CARD_BORDER is 4;
const integer: WINDOW_WIDTH is (CARD_SIZE + 2 * CARD_BORDER) * 12 + 2 * LEFT_BORDER;
const integer: WINDOW_HEIGHT is (CARD_SIZE + 2 * CARD_BORDER) * 8 + 2 * UPPER_BORDER;
const integer: FIELD_SIZE is CARD_SIZE + 2 * CARD_BORDER;
const integer: HALF_FIELD is FIELD_SIZE div 2;
const integer: FRAME_THICKNESS is 3;
const integer: FIELD_LINES is 8;
const integer: FIELD_COLUMNS is 12;
const integer: COMPUTER_HIT_XPOS is 8;
const integer: PLAYER_HIT_XPOS is UPPER_BORDER + FIELD_LINES * FIELD_SIZE + FIELD_SIZE + 8;

var array PRIMITIVE_WINDOW: digit_pixmap is 0 times PRIMITIVE_WINDOW.value;

const type: cardType is new struct
    var array string: picture is 0 times "";
    var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
    var integer: number is 0;
  end struct;

const type: visibleType is new enum
    normal, marked, removed
  end enum;

const type: fieldType is new struct
    var integer: cardNumber is 0;
    var visibleType: visible is normal;
    var boolean: selected is FALSE;
  end struct;

var integer: playerHits is 0;
var integer: computerHits is 0;


const array string: big_bush_pic is [](
  "     G G  GG  G  G   G G        ",
  "      GG   G  G G    GGGGG      ",
  "       G    G GG    gg G   G  G ",
  "    GGGGG    GGG G gg  G   G GG ",
  " G     Ggg G  gg Ggg   G   gg   ",
  " GG   G  ggG  gg gg   gG  ggGG  ",
  "   G      gg  ggggG  gg  gg     ",
  " G  GGGGggggg ggg   gg  ggggGGGG",
  "  G  G      bbbb    bbggg       ",
  "GGGG   G  G  bbb   bbgg G    GG ",
  "   gg   GG G  bb  bb  G   G  G  ",
  " GGGgg   G  ggbb bb G   G GggGGG",
  "     gg  gG  gbbbb  G gg  gg    ",
  "  G   gg g bb bbb   ggg  ggggGG ",
  " GGG   gbg  bbbb  G gg  gg G    ",
  "    G   bg   bbb G  g  gg   G   ",
  "  G  G   gb   bbbb  bbbb  G    G",
  "   g  g  gbb  bbb   bbbg  G  GG ",
  "GGGgggggbb bb bb  G bb    gg G  ",
  "       bbb  bbbb  GbbggGG ggg   ",
  "  G  GGGbb  Gbbb  bb      ggGGG ",
  "   G     bb   bb bbggGG  gg     ",
  "    gg G  bb  bbbb      ggggGGGG",
  " GGggggG GGbb bbb      gggg     ",
  "   G  gg    bbbb   G  bb  GGGG  ",
  "  G    ggG   bbb  G  bb    G    ",
  "     G  gg  G bbgg  bb          ",
  "  GGgggggbb  Gbbg  bbbggggGGGG  ",
  "    G     bb  bb  bb   G        ",
  "       GGGGbb bb bb     G       ",
  "            bbbbbbGGGG          ",
  "             bbbb               ");


const array string: large_gem_pic is [](
  "                                ",
  "                                ",
  "     RRRRRR          RRRRRR     ",
  "   RRRRRRRRRR      RRRRRRRRRR   ",
  "  RRRrrrrrrRRR    RRRrrrrrrRRR  ",
  " RRrrrrrrrrrrRR  RRrrrrrrrrrrRR ",
  " RRrrrrrrrrrrrRRRRrrrrrrrrrrrRR ",
  "RRrrrrrrrrrrrrrRRrrrrrrrrrrrrrRR",
  "RRrrrrrrrrrrrrrrrrrrrrrrrrrrrrRR",
  "RRrrrrrrrrrrrrrrrrrrrrrrrrrrrrRR",
  "RRrrrrrrrrrrrrrrrrrrrrrrrrrrrrRR",
  "RRrrrrrrrrrrrrrrrrrrrrrrrrrrrrRR",
  "RRrrrrrrrrrrrrrrrrrrrrrrrrrrrrRR",
  "RRrrrrrrrrrrrrrrrrrrrrrrrrrrrrRR",
  "RRrrrrrrrrrrrrrrrrrrrrrrrrrrrrRR",
  " RRrrrrrrrrrrrrrrrrrrrrrrrrrrRR ",
  " RRrrrrrrrrrrrrrrrrrrrrrrrrrrRR ",
  "  RRrrrrrrrrrrrrrrrrrrrrrrrrRR  ",
  "   RRrrrrrrrrrrrrrrrrrrrrrrRR   ",
  "    RRrrrrrrrrrrrrrrrrrrrrRR    ",
  "     RRrrrrrrrrrrrrrrrrrrRR     ",
  "      RRrrrrrrrrrrrrrrrrRR      ",
  "       RRrrrrrrrrrrrrrrRR       ",
  "        RRrrrrrrrrrrrrRR        ",
  "         RRrrrrrrrrrrRR         ",
  "          RRrrrrrrrrRR          ",
  "           RRrrrrrrRR           ",
  "            RRrrrrRR            ",
  "             RRrrRR             ",
  "              RRRR              ",
  "               RR               ",
  "                                ");


const array string: fairy_pic is [](
  "      xxxxx                   YYYY                   xxxxx      ",
  "    xxxcccxxx               YYYYYYYY               xxxcccxxx    ",
  "   xxcccccccxx             YYYYYYYYYY             xxcccccccxx   ",
  "  xxcccccccccxx           YYYYYYYYYYYY           xxcccccccccxx  ",
  "  xcccccccccccxx          YYYWWWWWWYYY          xxcccccccccccx  ",
  "  xccccccccccccxx        YYYWWWWWWWWYYY        xxccccccccccccx  ",
  "  xxccccccccccccxx       YYYWBBWWBBWYYY       xxccccccccccccxx  ",
  "   xcccccccccccccxx      YYYWWWWWWWWYYY      xxcccccccccccccx   ",
  "   xxcccccccccccccxx     YYYWWWWWWWWYYY     xxcccccccccccccxx   ",
  "    xxxccccccccccccxx    YYYWWOWWOWWYYY    xxccccccccccccxxx    ",
  "   xxcccccBccccBccccxx   YYYWWWOOWWWYYY   xxcccccccccccccccxx   ",
  "   xcccccccBccBccccccxx     XWWWWWWX     xxcccccccccccccccccx   ",
  "  xxccccccccccccccccccxx     XWWWWX     xxccccccccccccccccccxx  ",
  "  xccccccBBcWWcBBccccccxxXXXXXWWWWXXXXXxxccccccccccccccccccccx  ",
  "  xcccccccccWWccccccccccxWWWWWWWWWWWWWWxcccccccccccccccccccccx  ",
  "  xxccccccBcRRcBcccccccWWWWWWWWWWWWWWWWWWcccccccccccccccccccxx  ",
  "   xcccccBccRRccBcccccWWWWWWWWWWWWWWWWWWWWccccccccccccccccccx   ",
  "   xxcccccccRRcccccccWWWWWRRRWWWWWWRRRWWWWWccccccccccccccccxx   ",
  "    xxxcccccRRccccccWWWWWRRRRRWWWWRRRRRWWWWWcccccccccccccxxx    ",
  "   xxcccccccRRcccccWWWWWRRRRRRRWWRRRRRRRWWWWWccccccccccccccxx   ",
  "   xccccccccRRccccWWWWWcRRRRRRRWWRRRRRRRcWWWWWccccccccccccccx   ",
  "  xxccccccccRRcccWWWWWccRRRRRRRWWRRRRRRRccWWWWWcccccccccccccxx  ",
  "  xcccccccccRRccWWWWWcccxRRRRRWWWWRRRRRxcccWWWWWcccccccccccccx  ",
  "  xcccccccccRRcWWWWWcccxxcRRRWWWWWWRRRcxxcccWWWWWccccccccccccx  ",
  "  xxccccccccRRWWWWWcccxx  XWWWWWWWWWWX  xxcccWWWWWccccccccccxx  ",
  "   xcccccccWWWWWWWcccxx   XWWWWWWWWWWX   xxcccWWWWWWWWccccccx   ",
  "   xxcccccWWWWWWWcccxx    XWWWWWWWWWWX    xxcccWWWWWWccccccxx   ",
  "    xxxcccWWWWWWcccxx     XWWWWYYWWWWX     xxcccWWWWWWcccxxx    ",
  "   xxcccccWWWWWcccxx     XWWWWWYYWWWWWX     xxccWWWWWWWccccxx   ",
  "   xcccccccWWWcccxx      XWWWWWWWWWWWWX      xxccWWWWWccccccx   ",
  "  xxccccccccccccxx      XWWWWWWWWWWWWWWX      xxccWWccccccccxx  ",
  "  xccccccccccccxx      XRRRRRRRRRRRRRRRRX      xxccccccccccccx  ",
  "  xcccccccccccxx       XWWRRRRRRRRRRRRWWX       xxcccccccccccx  ",
  "  xxcccccccccxx       XWWWWWRRRRRRRRWWWWWX       xxcccccccccxx  ",
  "   xxcccccccxx        XWWWWWWRRRRRRWWWWWWX        xxcccccccxx   ",
  "    xxxcccxxx         XWWWWWWWRRRRWWWWWWWX         xxxcccxxx    ",
  "      xxxxx           XWWWWWWWRRRRWWWWWWWX           xxxxx      ",
  "                      XWWWWWWWWRRWWWWWWWWX                      ",
  "                       XWWWWWWWRRWWWWWWWX                       ",
  "                       XWWWWWWWXXWWWWWWWX                       ",
  "                        XWWWWWWXXWWWWWWX                        ",
  "                        XWWWWWWXXWWWWWWX                        ",
  "                        XWWWWWWXXWWWWWWX                        ",
  "                        XWWWWWWXXWWWWWWX                        ",
  "                         XWWWWWXXWWWWWX                         ",
  "                         XWWWWWXXWWWWWX                         ",
  "                         XWWWWWXXWWWWWX                         ",
  "                         XWWWWWXXWWWWWX                         ",
  "                         XWWWWWXXWWWWWX                         ",
  "                         XWWWWWXXWWWWWX                         ",
  "                          XWWWWXXWWWWX                          ",
  "                          XWWWWXXWWWWX                          ",
  "                          XWWWWXXWWWWX                          ",
  "                          XWWWWXXWWWWX                          ",
  "                          XWWWWXXWWWWX                          ",
  "                          XWWWWXXWWWWX                          ",
  "                          XWWWWXXWWWWX                          ",
  "                          XWWWWXXWWWWX                          ",
  "                          XWWWWXXWWWWX                          ",
  "                          XWWWWXXWWWWX                          ",
  "                          XWWWWXXWWWWX                          ",
  "                         XWWWWWXXWWWWWX                         ",
  "                        XWWWWWWXXWWWWWWX                        ",
  "                        XWWWWWWX WWWWWWX                        ");


const array string: computer_pic is [](
  "ccccccccccccccccccc                                 YYYYY       ",
  "ccccccccccccccccccc                                YYYYYYY      ",
  "cc               cc                               YYYYYYYY      ",
  "cc WWW  R R  WWW cc                               YYYYYYYYY     ",
  "cc  W  RRRRR WWW cc                               YYYYYYYYY     ",
  "cc  W  RRRRR  W  cc                               XWWWYYYYY     ",
  "cc  W   RRR  WWW cc                                cWWYYYYY     ",
  "cc  W   RRR   W  cc                              XWWWWYYYYY     ",
  "cc WWW   R   W W cc                              XWWWWRYYYY     ",
  "cc               cc                               XWWWYYYYY     ",
  "cc ccccccccccc   cc                                OWWYYYYY     ",
  "cc WWWWWWWWWWW   cc                               XWWWWWX       ",
  "cc W         W   cc                                XWWWX        ",
  "cc W WWWW WW W   cc                                XWWWX        ",
  "cc W         W   cc                                RRRRR  GGG   ",
  "cc W   ccccccccc cc                                RRRRR GGGG   ",
  "cc W W WWWWWWWWW cc                                RRRRRRGGGG   ",
  "cc W   W       W cc                               RRRRRRRGGGG cc",
  "cc WWWWW  RRGG W cc                              RRRRRRRRGGGG cc",
  "cc     W RRRR  W cc                             RRRRRRRRRGGGGccc",
  "cc     W  RR   W cc                             RRRRRRRRRGGGGccc",
  "cc     WWWWWWWWW cc                             RRRRRRRRRGGGGccc",
  "cc               cc                              RRRRRRRRGGGGccc",
  "ccccccccccccccccccc                               RRRRRRRGGGG cc",
  "ccccccccccccccccccc                               RRRRRRRGGGG cc",
  "       xxxxx      R   G  R                       RRRRRRRRGGGG cc",
  "       xxxxx       R  G R                        RRRRRRRRGGGG cc",
  "       xxxxx        R GR                        RRRRRRRRR GGG cc",
  "xxxxxxxxxxxxxxxxxxx BBBB                     RRRRRRRRRRRR     cc",
  "xxxxxxxxxxxWWWWWWxx BBBB        XXXXX     RRRRRRRRRRRRRRR     cc",
  "xxWWxxxxxxxxxxxxxxx BBBB  cccc XWWWWWXXRRRRRRRRRR  RRRRRR     cc",
  "xxWWxxxxxxxWWWWWWxx BBBB  cccccccWWWWWWRRRRRRR     RRRRRR     cc",
  "xxxxxxxxxxxxxxxxxxx BBBB  cccccccccWWWWRRRR        GGGGGG     cc",
  "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb        GGGGGG     cc",
  "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb        BBBBBBB    cc",
  "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb       BBBBBBBB    cc",
  "  bbbb                  bbbb                  BBBBBBBBBBBBB   cc",
  "  bbbb                  bbbb              BBBBBBBBBBBBBBBBB   cc",
  "  bbbb                  bbbb          BBBBBBBBBBBBBBBBBBBBB   cc",
  "  bbbb                  bbbb       BBBBBBBBBBBBBBBBBBBBBBBB   cc",
  "  bbbb                  bbbb      BBBBBBBBBBBBBBBBBBBBBBBB    cc",
  "  bbbb                  bbbb     BBBBBBBBBBBBBBBBBBBBBBBBB    cc",
  "  bbbb                  bbbb     BBBBBBBBBBBBBBBBBBBBBBBB     cc",
  "  bbbb                  bbbb     BBBBBBBBBBBBBBBBBBBBBB       cc",
  "  bbbb                  bbbb     BBBBBBGGGGGGGGGGGGGGGGGGGGG  cc",
  "  bbbb            X     bbbb     BBBBBGGGGGGGGGGGGGGGGGGGGGGG cc",
  "  bbbb      X    XWX    bbbb     BBBBBGGGGGGGGGGGGGGGGGGGGGGG cc",
  "  bbbb     XWX  XWWX    bbbb     BBBBBGGGGGGGGGGGGGGGGGGGGGGG cc",
  "  bbbb     XWWXXWWWX    bbbb     BBBBB          ccc  cccccc  ccc",
  "  bbbb    XWWWXWWWWX    bbbb     BBBBB          ccc ccccccccccc ",
  "  bbbb    xxxxxxxxxx    bbbb     BBBBB          ccc cccccccccc  ",
  "  bbbb    WxWxWxWxWx    bbbb     BBBBB          ccc             ",
  "  bbbb    xxxWxxxWxx    bbbb     BBBBB          ccc             ",
  "  bbbb    WxWxWxWxWx    bbbb     BBBBB          ccc             ",
  "  bbbb    xWxxxWxxxW    bbbb     BBBBB          ccc             ",
  "  bbbb    WxWxWxWxWx    bbbb     BBBBB          ccc             ",
  "  bbbb    xxxWxxxWxx    bbbb     BBBBB          ccc             ",
  "  bbbb    WxWxWxWxWx    bbbb     BBBBB          ccc             ",
  "  bbbb    xWxxxWxxxW    bbbb     BBBBB   ccccccccccccccccc      ",
  "  bbbb    WxWxWxWxWx    bbbb     BBBBB ccccccccccccccccccccc    ",
  "  bbbb    xxxWxxxWxx    bbbb     BBBBB ccccccccccccccccccccc    ",
  "  bbbb    WxWxWxWxWx    bbbb  RRRRRRRR bbb      bbb      bbb    ",
  "  bbbb    xWxxxWxxxW    bbbb RRRRRRRRR bbb      bbb      bbb    ",
  "  bbbb    xxxxxxxxxx    bbbb RRRRRRRRR bbb      bbb      bbb    ");


const array string: sea_pic is [](
  "cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc",
  "cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc",
  "cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc",
  "cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc",
  "cccccccccccccccccccccccccccccccccccccccccccccccOOOOOOOcccccccccc",
  "cccccccccccccccccccccccccccccccccccccccccccccOOOOOOOOOOOcccccccc",
  "cccccccccccccccccccccccccccccccccccccccccccOOOOOOOOOOOOOOOcccccc",
  "ccccccccccccccccccccccccccccccccccccccccccOOOOOOOOOOOOOOOOOccccc",
  "cccccccccccccccccccccccccccccccccccccccccOOOOOOOOOOOOOOOOOOOcccc",
  "cccccccccccccccccccccccccccccccccccccccccOOOOOOOOOOOOOOOOOOOcccc",
  "ccccccccccccccccccccccccccccccccccccccccOOOOOOOOOOOOOOOOOOOOOccc",
  "ccccccccccccccccccccccccccccccccccccccccOOOOOOOOOOOOOOOOOOOOOccc",
  "ccccccccccccccccccccccccccccccccccccccccOOOOOOOOOOOOOOOOOOOOOccc",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBOOOOBOOOOOBOOOOOBOOOOBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBOOOOOBOOOOOBOOOOOBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBOOOBOOOBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "BWWBBWWBBWWBBWWBBWWBBWWBBWWBBWWBBWWBBWWBBWWBBWWBBWWBBWWBBWWBBWWB",
  "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
  "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY",
  "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY",
  "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY",
  "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY",
  "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY",
  "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY",
  "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYRRRRRYYYYYYYYYYYYYYYYYYYYYYYYYYY",
  "YYYYYbbbbbbYYYYYYYYYYYYYYYYYYYWRRRRWWWWYYYYYYYYYYYYYYYYYYYYYYYYY",
  "YYbbbbbbbbbYYYYYYYYYYYYYYYYYYWWRRRWWWWWWWYYYYYYYYYYYYYYYYYYYYYYY",
  "YbbbbWWWWWWYYYYYWWWRWWWWWWWWWWWRRWWWWWWWWWWYYYYYYYYYYYYYYYYYYYYY",
  "YbbbWWBWWWWWYYWWWWxRWWWWWWWWWWWRWWWWWWWWWWWWWYYYYYYYYYYYYYWWWYYY",
  "bbbbWWBWWOWWWWWWWWWWxxWWWWWWWWWRWWWWWWWWWWWWWWWYYYYYYWWWWWWWWWYY",
  "bbbbWWWWWWOWWWWWWWWWWWxxWWWWWWWRWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWY",
  "bbbbWWBWWOWWWWWWWWWWWWWWxxWWWWWRWWWWWWWWWWWWWWWWWWWWWWWWYYYYWWWY",
  "YbbbWWBWWWWWYYWWWRRRWWWWWWxxWWWRRWWWWWWWWWWWWWWWWWWWYYYYYYYYYWWW",
  "YbbbbWWWWWWYYYYYRRRRRWWWWWWWYYYYYYYYYYYYYYYYYYWWWWYYYYYYYYYYYYRW",
  "YGbbbbbbbbbGGGGGGRRRRRGGWWWWWWGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGY",
  "GGGGGGGGGGGGGGGGGGGGGGGGGGWWWWWWGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG",
  "GGGGGGGGGGGGGGGGGGWWWWWWWWWWWWWWGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG",
  "GGGGGGGGGGGGGGGWWWWWWWWWWWWWWWWWGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG",
  "GGGGGGGGGGGWWWWWWWWWWWWWWWWWWWWGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG",
  "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY",
  "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY",
  "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY",
  "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY");


const array string: zero is [](
  "                ",
  "                ",
  "   xBBBBBBBBBc  ",
  "  xBBc     xBBc ",
  "  xBc       xBc ",
  "  xBc       xBc ",
  "  xBc       xBc ",
  "  xBc       xBc ",
  "  xBc     xBBBc ",
  "  xBc    xBBBBc ",
  "  xBc    xBBBBc ",
  "  xBc    xBBBBc ",
  "  xBc    xBBBBc ",
  "  xBBc   xBBBBc ",
  "   xBBBBBBBBBc  ",
  "                ");


const array string: one is [](
  "                ",
  "                ",
  "     xBBBBc     ",
  "        xBc     ",
  "        xBc     ",
  "        xBc     ",
  "        xBc     ",
  "        xBc     ",
  "      xBBBc     ",
  "     xBBBBc     ",
  "     xBBBBc     ",
  "     xBBBBc     ",
  "     xBBBBc     ",
  "     xBBBBc     ",
  "  xBBBBBBBBBBc  ",
  "                ");


const array string: two is [](
  "                ",
  "                ",
  "   xBBBBBBBBBc  ",
  "  xBBc     xBBc ",
  "  xBc       xBc ",
  "            xBc ",
  "            xBc ",
  "            xBc ",
  "   xBBBBBBBBBc  ",
  "  xBBBBc        ",
  "  xBBBBc        ",
  "  xBBBBc        ",
  "  xBBBBc        ",
  "  xBBBBc        ",
  "  xBBBBBBBBBBBc ",
  "                ");


const array string: three is [](
  "                ",
  "                ",
  "   xBBBBBBBBBc  ",
  "  xBBc     xBBc ",
  "  xBc       xBc ",
  "            xBc ",
  "            xBc ",
  "            xBc ",
  "   xBBBBBBBBBc  ",
  "         xBBBBc ",
  "         xBBBBc ",
  "         xBBBBc ",
  "  xBc    xBBBBc ",
  "  xBBc   xBBBBc ",
  "   xBBBBBBBBBc  ",
  "                ");


const array string: four is [](
  "                ",
  "                ",
  "  xBc           ",
  "  xBc           ",
  "  xBc           ",
  "  xBc           ",
  "  xBc    xBc    ",
  "  xBc    xBc    ",
  "  xBBBBBBBBBBBc ",
  "      xBBBBc    ",
  "      xBBBBc    ",
  "      xBBBBc    ",
  "      xBBBBc    ",
  "      xBBBBc    ",
  "      xBBBBc    ",
  "                ");

const array string: five is [](
  "                ",
  "                ",
  "  xBBBBBBBBBBBc ",
  "  xBc           ",
  "  xBc           ",
  "  xBc           ",
  "  xBc           ",
  "  xBc           ",
  "  xBBBBBBBBBBc  ",
  "         xBBBBc ",
  "         xBBBBc ",
  "         xBBBBc ",
  "  xBc    xBBBBc ",
  "  xBBc   xBBBBc ",
  "   xBBBBBBBBBc  ",
  "                ");


const array string: six is [](
  "                ",
  "                ",
  "   xBBBBBBBBBc  ",
  "  xBBc     xBBc ",
  "  xBc       xBc ",
  "  xBc           ",
  "  xBc           ",
  "  xBc           ",
  "  xBBBBBBBBBBc  ",
  "  xBc    xBBBBc ",
  "  xBc    xBBBBc ",
  "  xBc    xBBBBc ",
  "  xBc    xBBBBc ",
  "  xBBc   xBBBBc ",
  "   xBBBBBBBBBc  ",
  "                ");


const array string: seven is [](
  "                ",
  "                ",
  "  xBBBBBBBBBBBc ",
  "            xBc ",
  "            xBc ",
  "            xBc ",
  "            xBc ",
  "           xBBc ",
  "      xBBBBBBc  ",
  "     xBBBBc     ",
  "     xBBBBc     ",
  "     xBBBBc     ",
  "     xBBBBc     ",
  "     xBBBBc     ",
  "     xBBBBc     ",
  "                ");


const array string: eight is [](
  "                ",
  "                ",
  "   xBBBBBBBBBc  ",
  "  xBBc     xBBc ",
  "  xBc       xBc ",
  "  xBc       xBc ",
  "  xBc       xBc ",
  "  xBc       xBc ",
  "   xBBBBBBBBBc  ",
  "  xBc    xBBBBc ",
  "  xBc    xBBBBc ",
  "  xBc    xBBBBc ",
  "  xBc    xBBBBc ",
  "  xBBc   xBBBBc ",
  "   xBBBBBBBBBc  ",
  "                ");


const array string: nine is [](
  "                ",
  "                ",
  "   xBBBBBBBBBc  ",
  "  xBBc     xBBc ",
  "  xBc       xBc ",
  "  xBc       xBc ",
  "  xBc       xBc ",
  "  xBc       xBc ",
  "   xBBBBBBBBBBc ",
  "         xBBBBc ",
  "         xBBBBc ",
  "         xBBBBc ",
  "  xBc    xBBBBc ",
  "  xBBc   xBBBBc ",
  "   xBBBBBBBBBc  ",
  "                ");


const func cardType: genCard (in array string: pattern) is func
  result
    var cardType: aCard is cardType.value;
  begin
    aCard.picture := pattern;
  end func;


var array cardType: cards is [](
    genCard(fairy_pic),
    genCard(computer_pic),
    genCard(sea_pic),
    genCard(big_bush_pic),
    genCard(crown_pic),
    genCard(fountain_pic),
    genCard(harp_pic),
    genCard(snake_pic),
    genCard(lamp_pic),
    genCard(scepter_pic),
    genCard(book_pic),
    genCard(hourglass_pic),
    genCard(large_gem_pic),
    genCard(magic_wand_pic),
    genCard(sword_pic),
    genCard(key_pic),
    genCard(glasses_pic),
    genCard(helmet_pic),
    genCard(flask_pic),
    genCard(crystal_ball_pic),
    genCard(necklace_pic),
    genCard(holy_cross_pic),
    genCard(diamond_pic),
    genCard(silver_bars_pic)
  );

var array array fieldType: field is 0 times 0 times fieldType.value;


const proc: draw (in integer: xPos, in integer: yPos,
    inout cardType: aCard) is func
  begin
    if aCard.pixmap = PRIMITIVE_WINDOW.value then
      rect(xPos, yPos, CARD_SIZE, CARD_SIZE, white);
      drawPattern(curr_win, xPos, yPos, aCard.picture, CARD_SIZE div length(aCard.picture), black);
      aCard.pixmap := getPixmap(xPos, yPos, CARD_SIZE, CARD_SIZE);
    else
      put(xPos, yPos, aCard.pixmap, PSET);
    end if;
  end func;


const proc: put (inout cardType: aCard, in integer: line, in integer: column) is func
  begin
    draw(LEFT_BORDER + CARD_BORDER + FIELD_SIZE * pred(column),
        UPPER_BORDER + CARD_BORDER + FIELD_SIZE * pred(line), aCard);
  end func;


const proc: show (in integer: line, in integer: column) is func
  begin
    put(cards[field[line][column].cardNumber], line, column);
    field[line][column].visible := normal;
  end func;


const proc: mark (in integer: line, in integer: column) is func
  begin
    if field[line][column].visible = normal then
      rect(LEFT_BORDER + FIELD_SIZE * pred(column),
          UPPER_BORDER + FIELD_SIZE * pred(line),
          CARD_SIZE + 2 * CARD_BORDER, FRAME_THICKNESS, light_red);
      rect(LEFT_BORDER + FIELD_SIZE * pred(column),
          UPPER_BORDER + FIELD_SIZE * pred(line),
          FRAME_THICKNESS, CARD_SIZE + 2 * CARD_BORDER, light_red);
      rect(LEFT_BORDER + FIELD_SIZE * column - FRAME_THICKNESS,
          UPPER_BORDER + FIELD_SIZE * pred(line),
          FRAME_THICKNESS, CARD_SIZE + 2 * CARD_BORDER, light_red);
      rect(LEFT_BORDER + FIELD_SIZE * pred(column),
          UPPER_BORDER + FIELD_SIZE * line - FRAME_THICKNESS,
          CARD_SIZE + 2 * CARD_BORDER, FRAME_THICKNESS, light_red);
      field[line][column].visible := marked;
      field[line][column].selected := TRUE;
    end if;
  end func;


const proc: unmark (in integer: line, in integer: column) is func
  begin
    if field[line][column].visible = marked then
      rect(LEFT_BORDER + FIELD_SIZE * pred(column),
          UPPER_BORDER + FIELD_SIZE * pred(line),
          CARD_SIZE + 2 * CARD_BORDER, FRAME_THICKNESS, white);
      rect(LEFT_BORDER + FIELD_SIZE * pred(column),
          UPPER_BORDER + FIELD_SIZE * pred(line),
          FRAME_THICKNESS, CARD_SIZE + 2 * CARD_BORDER, white);
      rect(LEFT_BORDER + FIELD_SIZE * column - FRAME_THICKNESS,
          UPPER_BORDER + FIELD_SIZE * pred(line),
          FRAME_THICKNESS, CARD_SIZE + 2 * CARD_BORDER, white);
      rect(LEFT_BORDER + FIELD_SIZE * pred(column),
          UPPER_BORDER + FIELD_SIZE * line - FRAME_THICKNESS,
          CARD_SIZE + 2 * CARD_BORDER, FRAME_THICKNESS, white);
      field[line][column].visible := normal;
      field[line][column].selected := FALSE;
    end if;
  end func;


const proc: remove (in integer: line, in integer: column) is func
  begin
    if field[line][column].visible <> removed then
      rect(LEFT_BORDER + CARD_BORDER + FIELD_SIZE * pred(column),
          UPPER_BORDER + CARD_BORDER + FIELD_SIZE * pred(line), CARD_SIZE, CARD_SIZE, white);
      field[line][column].visible := removed;
    end if;
  end func;


const proc: unmarkAll is func
  local
    var integer: line is 0;
    var integer: column is 0;
  begin
    for line range 1 to length(field) do
      for column range 1 to length(field[line]) do
        unmark(line, column);
      end for;
    end for;
  end func;


const func integer: countCards is func
  result
    var integer: count is 0;
  local
    var integer: line is 0;
    var integer: column is 0;
  begin
    for line range 1 to length(field) do
      for column range 1 to length(field[line]) do
        if field[line][column].visible <> removed then
          incr(count);
        end if;
      end for;
    end for;
  end func;


const proc: showHit (in integer: cardNumber, in var integer: yPos, in var integer: hits) is func
  begin
    if hits >= 20 then
      hits -:= 20;
      yPos +:= 64 + 8;
    end if;
    line(200 + 128 + 8 + 32 * hits,     yPos, 0, 64, white);
    draw(200 + 128 + 8 + 32 * hits + 1, yPos, cards[cardNumber]);
    line(200 + 128 + 8 + 32 * hits + 5, yPos, 0, 64, white);
    draw(200 + 128 + 8 + 32 * hits + 6, yPos, cards[cardNumber]);
  end func;


const proc: horizontal (in integer: line, in integer: column1, in integer: column2,
    in color: currColor) is func
  begin
    if currColor <> black then
      rectTo(LEFT_BORDER + HALF_FIELD + FIELD_SIZE * pred(column1),
          UPPER_BORDER + HALF_FIELD+ FIELD_SIZE * pred(line) - 2,
          LEFT_BORDER + HALF_FIELD + FIELD_SIZE * pred(column2),
          UPPER_BORDER + HALF_FIELD+ FIELD_SIZE * pred(line) + 2, currColor);
    end if;
  end func;


const proc: vertical (in integer: column, in integer: line1, in integer: line2,
    in color: currColor) is func
  begin
    if currColor <> black then
      rectTo(LEFT_BORDER + HALF_FIELD + FIELD_SIZE * pred(column) - 2,
          UPPER_BORDER + HALF_FIELD+ FIELD_SIZE * pred(line1),
          LEFT_BORDER + HALF_FIELD + FIELD_SIZE * pred(column) + 2,
          UPPER_BORDER + HALF_FIELD+ FIELD_SIZE * pred(line2), currColor);
    end if;
  end func;


const func boolean: line_free (in integer: line, in integer: column1, in integer: column2) is func
  result
    var boolean: isFree is FALSE;
  local
    var integer: column is 0;
  begin
    column := column1;
    while column <= column2 and field[line][column].visible = removed do
      incr(column);
    end while;
    if column > column2 then
      isFree := TRUE;
    end if;
  end func;


const func boolean: column_free (in integer: column, in integer: line1, in integer: line2) is func
  result
    var boolean: isFree is FALSE;
  local
    var integer: line is 0;
  begin
    line := line1;
    while line <= line2 and field[line][column].visible = removed do
      incr(line);
    end while;
    if line > line2 then
      isFree := TRUE;
    end if;
  end func;


const proc: upper_way (in integer: line1, in integer: column1, in integer: column2,
    in color: currColor, inout boolean: found_way) is func
  local
    var integer: line is 0;
  begin
    line := pred(line1);
    while not found_way and line >= 1 and
        field[line][column1].visible = removed and
        field[line][column2].visible = removed do
      if line_free(line, succ(column1), pred(column2)) then
        vertical(column1, line, line1, currColor);
        vertical(column2, line, line1, currColor);
        horizontal(line, column1, column2, currColor);
        found_way := TRUE;
      else
        decr(line);
      end if;
    end while;
    if line = 0 then
      vertical(column1, line, line1, currColor);
      vertical(column2, line, line1, currColor);
      horizontal(line, column1, column2, currColor);
      found_way := TRUE;
    end if;
  end func;


const proc: lower_way (in integer: line1, in integer: column1, in integer: column2,
    in color: currColor, inout boolean: found_way) is func
  local
    var integer: line is 0;
  begin
    line := succ(line1);
    while not found_way and line <= length(field) and
        field[line][column1].visible = removed and
        field[line][column2].visible = removed do
      if line_free(line, succ(column1), pred(column2)) then
        vertical(column1, line1, line, currColor);
        vertical(column2, line1, line, currColor);
        horizontal(line, column1, column2, currColor);
        found_way := TRUE;
      else
        incr(line);
      end if;
    end while;
    if line > length(field) then
      vertical(column1, line1, line, currColor);
      vertical(column2, line1, line, currColor);
      horizontal(line, column1, column2, currColor);
      found_way := TRUE;
    end if;
  end func;


const proc: left_way (in integer: column1, in integer: line1, in integer: line2,
    in color: currColor, inout boolean: found_way) is func
  local
    var integer: column is 0;
  begin
    column := pred(column1);
    while not found_way and column >= 1 and
        field[line1][column].visible = removed and
        field[line2][column].visible = removed do
      if column_free(column, succ(line1), pred(line2)) then
        horizontal(line1, column, column1, currColor);
        horizontal(line2, column, column1, currColor);
        vertical(column, line1, line2, currColor);
        found_way := TRUE;
      else
        decr(column);
      end if;
    end while;
    if column = 0 then
      horizontal(line1, column, column1, currColor);
      horizontal(line2, column, column1, currColor);
      vertical(column, line1, line2, currColor);
      found_way := TRUE;
    end if;
  end func;


const proc: right_way (in integer: column1, in integer: line1, in integer: line2,
    in color: currColor, inout boolean: found_way) is func
  local
    var integer: column is 0;
  begin
    column := succ(column1);
    while not found_way and column <= length(field[1]) and
        field[line1][column].visible = removed and
        field[line2][column].visible = removed do
      if column_free(column, succ(line1), pred(line2)) then
        horizontal(line1, column1, column, currColor);
        horizontal(line2, column1, column, currColor);
        vertical(column, line1, line2, currColor);
        found_way := TRUE;
      else
        incr(column);
      end if;
    end while;
    if column > length(field[1]) then
      horizontal(line1, column1, column, currColor);
      horizontal(line2, column1, column, currColor);
      vertical(column, line1, line2, currColor);
      found_way := TRUE;
    end if;
  end func;


const proc: way_down_right (in integer: line1, in integer: column1,
    in integer: line2, in integer: column2,
    in color: currColor, inout boolean: found_way) is func
  local
    var integer: line is 0;
  begin
    line := succ(line1);
    while not found_way and line < line2 do
      if column_free(column1, succ(line1), line) and
          column_free(column2, line, pred(line2)) and
          line_free(line, succ(column1), pred(column2)) then
        vertical(column1, line1, line, currColor);
        vertical(column2, line, line2, currColor);
        horizontal(line, column1, column2, currColor);
        found_way := TRUE;
      else
        incr(line);
      end if;
    end while;
  end func;


const proc: way_right_down (in integer: line1, in integer: column1,
    in integer: line2, in integer: column2,
    in color: currColor, inout boolean: found_way) is func
  local
    var integer: column is 0;
  begin
    column := succ(column1);
    while not found_way and column < column2 do
      if line_free(line1, succ(column1), column) and
          line_free(line2, column, pred(column2)) and
          column_free(column, succ(line1), pred(line2)) then
        horizontal(line1, column1, column, currColor);
        horizontal(line2, column, column2, currColor);
        vertical(column, line1, line2, currColor);
        found_way := TRUE;
      else
        incr(column);
      end if;
    end while;
  end func;


const proc: way_down_left (in integer: line1, in integer: column1,
    in integer: line2, in integer: column2,
    in color: currColor, inout boolean: found_way) is func
  local
    var integer: line is 0;
  begin
    line := succ(line1);
    while not found_way and line < line2 do
      if column_free(column1, succ(line1), line) and
          column_free(column2, line, pred(line2)) and
          line_free(line, succ(column2), pred(column1)) then
        vertical(column1, line1, line, currColor);
        vertical(column2, line, line2, currColor);
        horizontal(line, column2, column1, currColor);
        found_way := TRUE;
      else
        incr(line);
      end if;
    end while;
  end func;


const proc: way_left_down (in integer: line1, in integer: column1,
    in integer: line2, in integer: column2,
    in color: currColor, inout boolean: found_way) is func
  local
    var integer: column is 0;
  begin
    column := succ(column2);
    while not found_way and column < column1 do
      if line_free(line1, column, pred(column1)) and
          line_free(line2, succ(column2), column) and
          column_free(column, succ(line1), pred(line2)) then
        horizontal(line1, column, column1, currColor);
        horizontal(line2, column2, column, currColor);
        vertical(column, line1, line2, currColor);
        found_way := TRUE;
      else
        incr(column);
      end if;
    end while;
  end func;


const func boolean: find_way (in var integer: line1, in var integer: column1,
    in var integer: line2, in var integer: column2, in color: currColor) is func
  result
    var boolean: found_way is FALSE;
  local
    var integer: line is 0;
    var integer: column is 0;
  begin
    if line1 = line2 then
      if column2 < column1 then
        column := column1;
        column1 := column2;
        column2 := column;
      end if;
      if line_free(line1, succ(column1), pred(column2)) then
        horizontal(line1, column1, column2, currColor);
        found_way := TRUE;
      else
        upper_way(line1, column1, column2, currColor, found_way);
        lower_way(line1, column1, column2, currColor, found_way);
      end if;
    elsif column1 = column2 then
      if line2 < line1 then
        line := line1;
        line1 := line2;
        line2 := line;
      end if;
      if column_free(column1, succ(line1), pred(line2)) then
        vertical(column1, line1, line2, currColor);
        found_way := TRUE;
      else
        left_way(column1, line1, line2, currColor, found_way);
        right_way(column1, line1, line2, currColor, found_way);
      end if;
    elsif line1 < line2 and column1 < column2 or
        line1 > line2 and column1 > column2 then
      if line1 > line2 and column1 > column2 then
        line := line1;
        line1 := line2;
        line2 := line;
        column := column1;
        column1 := column2;
        column2 := column;
      end if;
      if line_free(line1, succ(column1), column2) and
          column_free(column2, succ(line1), pred(line2)) then
        horizontal(line1, column1, column2, currColor);
        vertical(column2, line1, line2, currColor);
        found_way := TRUE;
      elsif column_free(column1, succ(line1), line2) and
          line_free(line2, succ(column1), pred(column2)) then
        vertical(column1, line1, line2, currColor);
        horizontal(line2, column1, column2, currColor);
        found_way := TRUE;
      else
        way_down_right(line1, column1, line2, column2, currColor, found_way);
        way_right_down(line1, column1, line2, column2, currColor, found_way);
        if not found_way and column_free(column2, line1, pred(line2)) then
          upper_way(line1, column1, column2, currColor, found_way);
          if found_way then
            vertical(column2, line1, line2, currColor);
          end if;
        end if;
        if not found_way and column_free(column1, succ(line1), line2) then
          lower_way(line2, column1, column2, currColor, found_way);
          if found_way then
            vertical(column1, line1, line2, currColor);
          end if;
        end if;
        if not found_way and line_free(line2, column1, pred(column2)) then
          left_way(column1, line1, line2, currColor, found_way);
          if found_way then
            horizontal(line2, column1, column2, currColor);
          end if;
        end if;
        if not found_way and line_free(line1, succ(column1), column2) then
          right_way(column2, line1, line2, currColor, found_way);
          if found_way then
            horizontal(line1, column1, column2, currColor);
          end if;
        end if;
      end if;
    elsif line1 < line2 and column1 > column2 or
        line1 > line2 and column1 < column2 then
      if line1 > line2 and column1 < column2 then
        line := line1;
        line1 := line2;
        line2 := line;
        column := column1;
        column1 := column2;
        column2 := column;
      end if;
      if line_free(line1, column2, pred(column1)) and
          column_free(column2, succ(line1), pred(line2)) then
        horizontal(line1, column2, column1, currColor);
        vertical(column2, line1, line2, currColor);
        found_way := TRUE;
      elsif column_free(column1, succ(line1), line2) and
          line_free(line2, succ(column2), pred(column1)) then
        vertical(column1, line1, line2, currColor);
        horizontal(line2, column2, column1, currColor);
        found_way := TRUE;
      else
        way_down_left(line1, column1, line2, column2, currColor, found_way);
        way_left_down(line1, column1, line2, column2, currColor, found_way);
        if not found_way and column_free(column2, line1, pred(line2)) then
          upper_way(line1, column2, column1, currColor, found_way);
          if found_way then
            vertical(column2, line1, line2, currColor);
          end if;
        end if;
        if not found_way and column_free(column1, succ(line1), line2) then
          lower_way(line2, column2, column1, currColor, found_way);
          if found_way then
            vertical(column1, line1, line2, currColor);
          end if;
        end if;
        if not found_way and line_free(line1, column2, pred(column1)) then
          left_way(column2, line1, line2, currColor, found_way);
          if found_way then
            horizontal(line1, column2, column1, currColor);
          end if;
        end if;
        if not found_way and line_free(line2, succ(column2), column1) then
          right_way(column1, line1, line2, currColor, found_way);
          if found_way then
            horizontal(line2, column2, column1, currColor);
          end if;
        end if;
      end if;
    end if;
  end func;


const proc: readHelpCommand (inout char: command) is func
  local
    var boolean: doQuit is FALSE;
  begin
    DRAW_FLUSH;
    command := upper(getc(KEYBOARD));
    while command = KEY_ESC do
      bossMode(doQuit);
      if doQuit then
        command := 'Q';
      else
        command := upper(getc(KEYBOARD));
      end if;
    end while;
  end func;


const proc: help (inout char: command) is func
  local
    var integer: line1 is 0;
    var integer: column1 is 0;
    var integer: line2 is 0;
    var integer: column2 is 0;
    var boolean: found is FALSE;
  begin
    for line1 range 1 to FIELD_LINES do
      for column1 range 1 to FIELD_COLUMNS do
        if not found and field[line1][column1].visible = normal then
          for column2 range succ(column1) to length(field[line1]) do
            if not found and
                field[line1][column2].visible = normal and
                field[line1][column1].cardNumber =
                field[line1][column2].cardNumber then
              if find_way(line1, column1, line1, column2, light_red) then
                mark(line1, column1);
                mark(line1, column2);
                readHelpCommand(command);
                if command <> 'H' then
                  found := TRUE;
                end if;
                ignore(find_way(line1, column1, line1, column2, white));
                unmark(line1, column1);
                unmark(line1, column2);
                if command in {KEY_NL} then
                  remove(line1, column1);
                  remove(line1, column2);
                  (* showHit(field[line1][column1].cardNumber, PLAYER_HIT_XPOS, playerHits); *)
                  incr(playerHits);
                else
                  show(line1, column1);
                  show(line1, column2);
                end if;
              end if;
            end if;
          end for;
          for line2 range succ(line1) to length(field) do
            for column2 range 1 to length(field[line1]) do
              if not found and
                  field[line2][column2].visible = normal and
                  field[line1][column1].cardNumber =
                  field[line2][column2].cardNumber then
                if find_way(line1, column1, line2, column2, light_red) then
                  mark(line1, column1);
                  mark(line2, column2);
                  readHelpCommand(command);
                  if command <> 'H' then
                    found := TRUE;
                  end if;
                  ignore(find_way(line1, column1, line2, column2, white));
                  unmark(line1, column1);
                  unmark(line2, column2);
                  if command in {KEY_NL} then
                    remove(line1, column1);
                    remove(line2, column2);
                    (* showHit(field[line1][column1].cardNumber, PLAYER_HIT_XPOS, playerHits); *)
                    incr(playerHits);
                  else
                    show(line1, column1);
                    show(line2, column2);
                  end if;
                end if;
              end if;
            end for;
          end for;
        end if;
      end for;
    end for;
    if command <> 'Q' and command <> KEY_CLOSE and command <> KEY_ESC then
      command := KEY_NONE;
    end if;
  end func;


const proc: playerMove (inout integer: line1, inout integer: column1,
    inout integer: line2, inout integer: column2, inout char: command) is func
  local
    var integer: openCards is 0;
    var integer: line is 0;
    var integer: column is 0;
    var boolean: moveFinished is FALSE;
  begin
    repeat
      command := upper(getc(KEYBOARD));
      if command = 'H' then
        help(command);
        if command = 'Q' or command = KEY_CLOSE then
          moveFinished := TRUE;
        elsif command = KEY_ESC then
          bossMode(moveFinished);
          if moveFinished then
            command := 'Q';
          end if;
        end if;
      elsif command = KEY_ESC then
        bossMode(moveFinished);
        if moveFinished then
          command := 'Q';
        end if;
      elsif command <> KEY_MOUSE1 then
        moveFinished := TRUE;
      else
        line := getypos(KEYBOARD);
        column := getxpos(KEYBOARD);
        if line >= UPPER_BORDER and column >= LEFT_BORDER then
          line := (line - UPPER_BORDER) div FIELD_SIZE + 1;
          column := (column - LEFT_BORDER) div FIELD_SIZE + 1;
          if line >= 1 and line <= length(field) and
              column >= 1 and column <= length(field[line]) then
            if field[line][column].visible = normal then
              if openCards = 0 then
                mark(line, column);
                incr(openCards);
                line1 := line;
                column1 := column;
              elsif openCards = 1 and
                  field[line1][column1].cardNumber = field[line][column].cardNumber and
                  find_way(line1, column1, line, column, light_red) then
                mark(line, column);
                line2 := line;
                column2 := column;
                moveFinished := TRUE;
              end if;
            elsif field[line][column].visible = marked then
              unmark(line, column);
              decr(openCards);
            end if;
          end if;
        end if;
      end if;
    until moveFinished;
  end func;


const proc: playerTurn (inout char: command) is func
  local
    var integer: line1 is 0;
    var integer: column1 is 0;
    var integer: line2 is 0;
    var integer: column2 is 0;
    var boolean: onTurn is TRUE;
    var integer: number is 0;
  begin
    while countCards > 0 and onTurn do
      playerMove(line1, column1, line2, column2, command);
      if command <> KEY_MOUSE1 then
        unmarkAll;
        onTurn := FALSE;
      elsif field[line1][column1].cardNumber =
          field[line2][column2].cardNumber then
        DRAW_FLUSH;
        number := 0;
        while not keypressed(KEYBOARD) and number <= 5 do
          wait(100000 . MICRO_SECONDS);
          incr(number);
        end while;
        ignore(find_way(line1, column1, line2, column2, white));
        unmark(line1, column1);
        unmark(line2, column2);
        remove(line1, column1);
        remove(line2, column2);
        (* showHit(field[line1][column1].cardNumber, PLAYER_HIT_XPOS, playerHits); *)
        incr(playerHits);
      else
        unmark(line1, column1);
        unmark(line2, column2);
        onTurn := FALSE;
      end if;
    end while;
  end func;


const func boolean: solvable is func
  result
    var boolean: isSolvable is FALSE;
  local
    var integer: line1 is 0;
    var integer: column1 is 0;
    var integer: line2 is 0;
    var integer: column2 is 0;
    var boolean: searching is TRUE;
    var integer: pairs_present is 0;
  begin
    pairs_present := FIELD_LINES * FIELD_COLUMNS div 2;
    repeat
      searching := TRUE;
      for line1 range 1 to FIELD_LINES do
        if searching then
          for column1 range 1 to FIELD_COLUMNS do
            if searching and field[line1][column1].visible = normal then
              for column2 range succ(column1) to length(field[line1]) do
                if searching and
                    field[line1][column2].visible = normal and
                    field[line1][column1].cardNumber =
                    field[line1][column2].cardNumber then
                  if find_way(line1, column1, line1, column2, black) then
                    field[line1][column1].visible := removed;
                    field[line1][column2].visible := removed;
                    decr(pairs_present);
                    searching := FALSE;
                  end if;
                end if;
              end for;
              for line2 range succ(line1) to length(field) do
                if searching then
                  for column2 range 1 to length(field[line1]) do
                    if searching and
                        field[line2][column2].visible = normal and
                        field[line1][column1].cardNumber =
                        field[line2][column2].cardNumber then
                      if find_way(line1, column1, line2, column2, black) then
                        field[line1][column1].visible := removed;
                        field[line2][column2].visible := removed;
                        decr(pairs_present);
                        searching := FALSE;
                      end if;
                    end if;
                  end for;
                end if;
              end for;
            end if;
          end for;
        end if;
      end for;
    until searching;
    isSolvable := pairs_present = 0;
  end func;


const proc: dealCards is func
  local
    const integer: NUMBER_OF_CARDS is FIELD_LINES * FIELD_COLUMNS div 4;
    var integer: line is 0;
    var integer: column is 0;
    var integer: cardNumber is 0;
  begin
    repeat
      for cardNumber range 1 to NUMBER_OF_CARDS do
        cards[cardNumber].number := 0;
      end for;
      field := FIELD_LINES times FIELD_COLUMNS times fieldType.value;
      for line range 1 to FIELD_LINES do
        for column range 1 to FIELD_COLUMNS do
          repeat
            cardNumber := rand(1, NUMBER_OF_CARDS);
          until cards[cardNumber].number < 4;
          field[line][column].cardNumber := cardNumber;
          incr(cards[cardNumber].number);
        end for;
      end for;
    until solvable;
    for line range 1 to FIELD_LINES do
      for column range 1 to FIELD_COLUMNS do
        field[line][column].visible := normal;
        show(line, column);
        DRAW_FLUSH;
      end for;
    end for;
  end func;


const proc: writeCentered (inout text: screen, in integer: yPos, in string: stri) is func
  begin
    setPosXY(screen, (WINDOW_WIDTH - width(vecFont10, stri)) div 2, yPos);
    writeln(screen, stri);
  end func;


const proc: main is func
  local
    var char: command is ' ';
  begin
    screen(WINDOW_WIDTH, WINDOW_HEIGHT);
    setCloseAction(curr_win, RETURN_KEY);
    clear(curr_win, white);
    KEYBOARD := GRAPH_KEYBOARD;
    screen := openPixmapFontFile(curr_win);
    setFont(screen, vecFont10);
    color(screen, black, white);
    writeCentered(screen, 22, "S H I S E N");
    writeCentered(screen, 38, "Copyright (C) 2005, 2007, 2012, 2013, 2020  Thomas Mertes");
    writeCentered(screen, 54, "This program is free software under the terms of the GNU General Public License");
    writeCentered(screen, 652, "Shisen is written in the Seed7 programming language");
    writeCentered(screen, 668, "Homepage:    http://seed7.sourceforge.net");
    DRAW_FLUSH;
    digit_pixmap := [0](
      createPixmap(zero,  2, black),
      createPixmap(one,   2, black),
      createPixmap(two,   2, black),
      createPixmap(three, 2, black),
      createPixmap(four,  2, black),
      createPixmap(five,  2, black),
      createPixmap(six,   2, black),
      createPixmap(seven, 2, black),
      createPixmap(eight, 2, black),
      createPixmap(nine,  2, black));

    dealCards;
    writeCentered(screen, 696, "Press any key to start game");
    command := upper(getc(KEYBOARD));
    if command <> KEY_ESC then
      rect(0, 0, WINDOW_WIDTH, UPPER_BORDER, white);
      rect(0, WINDOW_HEIGHT - UPPER_BORDER, WINDOW_WIDTH, UPPER_BORDER, white);
      while command <> 'Q' and command <> KEY_CLOSE do
        repeat
          playerTurn(command);
        until countCards = 0 or command = 'N' or command = 'Q' or command = KEY_CLOSE;
        if command <> 'N' and command <> 'Q' and command <> KEY_CLOSE then
          command := upper(getc(KEYBOARD));
        end if;
        if command <> 'Q' and command <> KEY_CLOSE then
          dealCards;
        end if;
      end while;
    end if;
  end func;
