$ 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 "cronos27.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);
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
flushGraphic;
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);
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);
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 := clickedYPos(KEYBOARD);
column := clickedXPos(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
flushGraphic;
number := 0;
while not inputReady(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);
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);
flushGraphic;
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);
selectInput(curr_win, KEY_CLOSE, TRUE);
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");
flushGraphic;
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
setFont(screen, cronos27);
setPos(screen, 9, 9);
writeln(screen, "Congratulation");
command := upper(getc(KEYBOARD));
end if;
if command <> 'Q' and command <> KEY_CLOSE then
dealCards;
end if;
end while;
end if;
end func;