Pexeso game in pascal

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Category: Source in Pascal

Program: Pexeso.pas
File exe: Pexeso.exe
need: Menu.mnu,  Menu.tpu,  Mys2.pas,  Egavga.bgi

An excellent program which enables to play the game similar to Pexeso (internationally known game as "Memory"), a card game where you have to find two coresponding cards usually of the same picture, in its graphic version. It contains the routines for operating the mouse, selecting from the menu, shuffling of the cards, checking the accuracy and other operations neccessary for the undisturbed running of the game. I'm not the author of it but some changes were done by me.
{ MYS2.PAS                  Copyright (c) TrSek alias Zdeno Sekerak }
{ Unit pre mys.pas                                                  }
{                                                                   }
{ Datum:08.06.1996                             http://www.trsek.com }
 
unit mys2;
interface
uses dos;
type  g_kurzor = array [ 0 .. 1, 0 .. 15 ] of word; {graficky mysi kurzor}
const int_mysky = 51;
const leve_tlacitko = 0;
      prave_tlacitko = 1;
      prostredni_tlacitko = 2;
 
var r:registers;
 
 
procedure reset_mys;
procedure show_mys;
procedure cancel_mys;
procedure window_mys(x1,y1,x2,y2:integer);
procedure where_is_mys(var x,y:integer);
procedure set_mys(x,y:integer);
function right:boolean;
function left:boolean;
function middle:boolean;
procedure graphical_mys ( hsx, hsy : integer; var c );
procedure set_arrow;
procedure set_clock;
procedure set_reverse_clock;
procedure set_cross;
procedure set_reverse_cross;
procedure set_otaznik;
procedure relative_position_mys ( var x, y : integer );
procedure mickey_mouse ( x, y : word );
procedure hide_mys_in ( x1, x2, y1, y2 : word );
procedure cli;
inline($fa);
procedure sti;
inline($fb);
procedure double_speed_mys ( k : word );
procedure reset_stisku;
 
implementation
 
 
const k_sipka : g_kurzor = ( ( $3fff, $1fff, $0fff, $07ff,
                               $03ff, $01ff, $00ff, $007f,
                               $003f, $001f, $001f, $00ff,
                               $30ff, $f87f, $f87f, $fc7f ),
 
                             ( $0000, $4000, $6000, $7000,
                               $7800, $7c00, $7e00, $7f00,
                               $7f80, $7fc0, $7c00, $4600,
                               $0600, $0300, $0300, $0000 ) );
      x_sipka = 0; y_sipka = 0; { 'hot spot' }
 
{*************************}
{***        kriz       ***}
{*************************}
 
const k_kriz : g_kurzor = ( ( $ffff, $ffff, $ffff, $ffff,
                              $ffff, $ffff, $ffff, $ffff,
                              $ffff, $ffff, $ffff, $ffff,
                              $ffff, $ffff, $ffff, $ffff ),
 
                            ( $0100, $0100, $0100, $0100,
                              $0100, $0000, $0000, $f93e,
                              $0000, $0000, $0100, $0100,
                              $0100, $0100, $0100, $0000 ) );
      x_kriz = 7; y_kriz = 7; { 'hot spot' }
 
{*************************}
{***      x-kriz       ***}
{*************************}
 
const k_xkriz : g_kurzor = ( ( $ffff, $ffff, $ffff, $ffff,
                               $ffff, $ffff, $ffff, $ffff,
                               $ffff, $ffff, $ffff, $ffff,
                               $ffff, $ffff, $ffff, $ffff ),
 
                             ( $0000, $4004, $2008, $1010,
                               $0820, $0000, $0000, $0100,
                               $0000, $0000, $0820, $1010,
                               $2008, $4004, $0000, $0000 ) );
      x_xkriz = 7; y_xkriz = 7; { 'hot spot' }
 
{*************************}
{***      hodinky      ***}
{*************************}
 
const k_hodinky : g_kurzor = ( ( $f839, $e008, $c004, $8003,
                                 $8003, $0001, $0001, $0001,
                                 $0001, $0001, $8003, $8003,
                                 $c007, $e00f, $f83f, $ffff ),
 
                               ( $07c6, $1ff7, $383b, $600c,
                                 $600c, $c006, $c006, $df06,
                                 $c106, $c106, $610c, $610c,
                                 $3838, $1ff0, $07c0, $0000 ) );
      x_hodinky = 8; y_hodinky = 8; { 'hot spot' }
 
{*********************************}
{***     inverzni hodinky      ***}
{*********************************}
 
const k_ihodinky : g_kurzor = ( ( $f839, $e008, $c004, $8003,
                                  $8003, $0001, $0001, $0001,
                                  $0001, $0001, $8003, $8003,
                                  $c007, $e00f, $f83f, $ffff ),
 
                                ( $0000, $0000, $07c0, $1ff0,
                                  $1ff0, $3ff8, $3ff8, $20f8,
                                  $3ef8, $3ef8, $1ef0, $1ef0,
                                  $07c0, $0000, $0000, $0000 ) );
 
{************************}
{***     otaznĄk      ***}
{************************}
 
const k_otaznik : g_kurzor =  ( ( $ffff, $c0ff, $807f, $987f,
                                  $fc7f, $f87f, $e0ff, $c3ff,
                                  $c7ff, $c7ff, $c7ff, $ffff,
                                  $c7ff, $c7ff, $c7ff, $ffff ),
 
                                ( $0000, $3e00, $6700, $0300,
                                  $0300, $0600, $1800, $3000,
                                  $3000, $3000, $0000, $0000,
                                  $3000, $3000, $0000, $0000 ) );
      x_otaznik = 5; y_otaznik = 5; { 'hot spot' }
 
 
procedure reset_mys;
begin
r.ax:=$0000;
intr($33,r);
end;
 
procedure show_mys;
begin
r.ax:=$0001;
intr($33,r);
end;
 
procedure cancel_mys;
begin
r.ax:=$0002;
intr($33,r);
end;
 
procedure window_mys(x1,y1,x2,y2:integer);
begin
r.ax:=$0007;
r.cx:=x1;
r.dx:=x2;
intr($33,r);
r.ax:=$0008;
r.cx:=y1;
r.dx:=y2;
intr($33,r);
end;
 
procedure where_is_mys(var x,y:integer);
begin
r.ax:=$0003;
intr($33,r);
x:=r.cx;
y:=r.dx;
end;
 
procedure set_mys(x,y:integer);
begin
r.ax:=$0004;
r.cx:=x;
r.dx:=y;
intr($33,r);
end;
 
function left:boolean;
begin
r.ax:=$0005;
r.bx:=0;
intr($33,r);
if (r.ax and 1)=1 then begin left:=true; r.bx:=3; end
                       else  left:=false;
end;
 
function right:boolean;
begin
r.ax:=$0005;
r.bx:=1;
intr($33,r);
if (r.ax and 2)=2 then begin right:=true; r.bx:=3; end
                       else  right:=false;
end;
 
function middle:boolean;
begin
r.ax:=$0005;
r.bx:=2;
intr($33,r);
if (r.ax and 4)=4 then middle:=true
                       else  middle:=false;
end;
 
procedure graphical_mys ( hsx, hsy : integer; var c );
var r : registers;
begin
 r.ax:=9; r.bx:=word(hsx);
 r.cx:=word(hsy); r.dx:=ofs(c); r.es:=seg(c);
 intr(int_mysky,r);
end; { nastav_g_kurzor }
 
procedure set_arrow;
begin
 graphical_mys(x_sipka,y_sipka,k_sipka);
end; { nastav_sipku }
 
procedure set_clock;
begin
 graphical_mys(x_hodinky,y_hodinky,k_hodinky);
end; { nastav_hodinky }
 
procedure set_reverse_clock;
begin
 graphical_mys(x_hodinky,y_hodinky,k_ihodinky);
end; { nastav_ihodinky }
 
procedure set_cross;
begin
 graphical_mys(x_kriz,y_kriz,k_kriz);
end; { nastav_kriz }
 
procedure set_reverse_cross;
begin
 graphical_mys(x_xkriz,y_xkriz,k_xkriz);
end; { nastav_kriz }
 
procedure set_otaznik;
begin
 graphical_mys(x_otaznik,y_otaznik,k_otaznik);
end; { nastav_otaznik }
 
{*****************************************}
{***      relativni pozice mysky       ***}
{*****************************************}
procedure volani_mysky ( sluzba : byte; var par1, par2, par3, par4 : word );
var  r : registers;
begin
 r.ax:=sluzba; r.bx:=par2;
 r.cx:=par3; r.dx:=par4;
 intr(int_mysky,r);
 par1:=r.ax; par2:=r.bx;
 par3:=r.cx; par4:=r.dx;
end; { volani_mysky }
 
 
procedure relative_position_mys ( var x, y : integer );
var d : word;
    xx : word absolute x;
    yy : word absolute y;
begin
 volani_mysky(11,d,d,xx,yy);
end; { relativni_pozice_mysky }
 
{*****************************************}
{***           mickey/mouse            ***}
{*****************************************}
 
procedure mickey_mouse ( x, y : word );
var d : word;
begin
 volani_mysky(15,d,d,x,y);
end; { mickey_mouse }
 
{*************************************************}
{***       skryti mysky v zadane oblasti       ***}
{*************************************************}
 
procedure hide_mys_in ( x1, x2, y1, y2 : word );
var r : registers;
begin
 r.ax:=16;
 r.cx:=x1; r.si:=x2;
 r.dx:=y1; r.di:=y2;
 intr(int_mysky,r);
end; { schovej_mysku_v }
 
{*******************************************}
{***      dvojnasobna rychlost mysky     ***}
{*******************************************}
 
procedure double_speed_mys ( k : word );
var d : word;
begin
 volani_mysky(19,d,d,d,k);
end; { dvoj_rychlost_mysky }
 
 
procedure reset_stisku;
var d : word;
procedure stisk_mysky ( co : word; var kolik, x, y : word );
var tl : word;
begin
 kolik:=co;
 volani_mysky(5,tl,kolik,x,y);
end; { stisk_mysky }
procedure pusteni_mysky ( co : word; var kolik, x, y : word );
var tl : word;
begin
 kolik:=co;
 volani_mysky(6,tl,kolik,x,y);
end; { pusteni_mysky }
 
begin
 stisk_mysky(leve_tlacitko,d,d,d);
 pusteni_mysky(leve_tlacitko,d,d,d);
 stisk_mysky(prave_tlacitko,d,d,d);
 pusteni_mysky(prave_tlacitko,d,d,d);
end; { reset_stisku }
 
 
begin
end.