(***************************************************************************)
(* Tento program demonstruje zaklady pouzivani mysi. Obsahuje procedury    *)
(* a funkce pro praci s mysi, nektere jsou pouzity v hlavnim programu      *)
(* (inicializace mysi, nastaveni oblasti, ve ktere je mysi dovoleno        *)
(* se pohybovat, nastaveni pozice mysi, zjisteni stavu mysi - zde pouze    *)
(* jeji pozice na obrazovce a vypsani, zjisteni stisknuti leveho tlacitka).*)
(* Program lze ukoncit stisknutim jakekoliv klavesy.                       *)
(* Pozice mysi je mapovana do textoveho rezimu tak, ze cislo v pixelech    *)
(* je prevedeno na znaky. Jeden znak ma delku i sirku 8 pixelu, proto      *)
(* se pouziva deleni prip. nasobeni cislem 8. Souradnice jsou od 0.        *)
(***************************************************************************)

program mys;

uses
  dos;

type
  TTlacitkaMysi = (t_leve, t_prave, t_prostredni);
  TSTlacitkaMysi = set of TTlacitkaMysi;

var
  JeMys:   boolean;         { jestlize je funkcni ovladac mysi, je zde true }
  PocetTl: byte;            { pocet tlacitek mysi - 1, 2 nebo 3 }

  pozice_x, pozice_y: byte;   { pozice mysi na obrazovce }
  s_tlacitka: TSTlacitkaMysi; { ktera tlacitka jsou stlacena (zde nema vyznam) }
  pocet: word;                { pomocna promenna }


procedure ZapniKurzorMysi;
{ zobrazi kurzor mysi }
var r: Registers;
begin
  if JeMys then begin
    r.ax := 1;         { sluzba cislo 1 v preruseni cislo 33h }
    Intr($33, r);
  end;
end;

procedure VypniKurzorMysi;
{ kurzor mysi zmizi z obrazovky }
var r: Registers;
begin
  if JeMys then begin
    r.ax := 2;         { sluzba cislo 2 v preruseni cislo 33h }
    Intr($33, r);
  end;
end;

procedure InicializujMys;
{ resetuje mys, nastavi vsechny promenne, zobrazi kurzor mysi }
var r: Registers;
begin
  r.ax := 0;          { inicializace mysi, sluzba 0 preruseni 33h }
  Intr($33, r);
  if (r.ax = 0) then begin
    JeMys   := false; { pokud je AX=0, potom neni pritomen ovladac mysi }
    PocetTl := 0;
  end else begin
    JeMys := true;
    PocetTl := r.bx;  { v BX je pocet tlacitek mysi }
    ZapniKurzorMysi;
  end;
end;

procedure UklidMys;
{ tuto proceduru volame pred ukoncenim programu, resetuje mys }
var r: Registers;
begin
  r.ax := 0;          { reset mysi }
  Intr($33, r);
end;

function StavMysi(var stisknuto: TSTlacitkaMysi; var x,y: byte): boolean;
{ zda jsou jednotliva tlacitka stisknuta a kde je kurzor mysi,
  pokud se mys pohnula, vraci true, jinak false }
var
  r: Registers;
  px, py: byte;
begin
  if JeMys then begin
    px := x;
    py := y;
    stisknuto := [];
    r.ax := 3;       { sluzba cislo 3 v preruseni 33h }
    Intr($33, r);
    with r do begin  { v registru bx je urceno, ktera tlacitka jsou stisknuta }
      if (bx and 1)>0 then stisknuto := stisknuto + [t_leve];
      if (bx and 2)>0 then stisknuto := stisknuto + [t_prave];
      if (bx and 4)>0 then stisknuto := stisknuto + [t_prostredni];
      x := cx div 8; { v registru cx je horizontalni pozice mysi }
      y := dx div 8; { v registru dx je vertikalni pozice mysi }
    end;
    StavMysi := (px <> x) or (py <> y);
  end else StavMysi := false;
end;

procedure NastavPoziciMysi(x,y: byte);
{ presune mys na zadane souradnice, ve Windows nefunguje }
var r: Registers;
begin
  if JeMys then begin
    r.ax := 4;     { sluzba cislo 4 preruseni cislo 33h }
    r.cx := x * 8; { do registru cx a dx dame pozici mysi, kam ... }
    r.dx := y * 8; { ... ji chceme presunout }
    Intr($33, r);
  end;
end;

function StisknutoTlacitko(ktere: TTlacitkaMysi; var pocet: word; var x,y: byte): boolean;
{ pokud bylo od posledniho volani teto funkce stisknuto zadane tlacitko,
  vraci true, jinak false; v parametru pocet je pocet stisknuti od posledniho
  volani, v parametrech x, y pozice mysi na obrazovce pri tomto stisknuti }
var r: Registers;
begin
  if JeMys then with r do begin
    ax := 5;         { sluzba cislo 5 preruseni cislo 33h }
    bx := ord(ktere);{ do bx dame urceni tlacitka, jehoz stav chceme zjistit }
    Intr($33, r);
    if bx=0 then StisknutoTlacitko := false
    else begin
      pocet := bx;   { v bx je pocet stisknuti od posledniho volani teto funkce }
      x := cx div 8; { v cx a dx je pozice mysi pri stisknuti tohoto tlacitka }
      y := dx div 8;
      StisknutoTlacitko := true;
    end;
  end else StisknutoTlacitko := false;
end;

function UvolnenoTlacitko(ktere: TTlacitkaMysi; var pocet: word; var x,y: byte): boolean;
{ pokud bylo od posledniho volani teto funkce uvolneno zadane tlacitko,
  vraci true, jinak false; v parametru pocet je pocet uvolneni od posledniho
  volani, v parametrech x, y pozice mysi na obrazovce pri tomto uvolneni,
  parametry jsou podobne jako u predchozi funkce }
var r: Registers;
begin
  if JeMys then with r do begin
    ax := 6;
    bx := ord(ktere);
    Intr($33, r);
    if bx=0 then UvolnenoTlacitko := false
    else begin
      pocet := bx;
      x := cx div 8;
      y := dx div 8;
      UvolnenoTlacitko := true;
    end;
  end else UvolnenoTlacitko := false;
end;

procedure HorizRozsahSouradnic(min_x, max_x: byte);
{ nastaveni horizontalniho rozsahu souradnic - kam bude mysi dovoleno
  se pohybovat }
var r: Registers;
begin
  if JeMys then with r do begin
    ax := 7;         { sluzba cislo 7 preruseni cislo 33h }
    cx := min_x * 8; { do cx a dx ulozime minimalni a maximalni hranici }
    dx := max_x * 8;
    Intr($33, r);
  end;
end;

procedure VertRozsahSouradnic(min_y, max_y: byte);
{ nastaveni vertikalniho rozsahu souradnic - kam bude mysi dovoleno
  se pohybovat }
var r: Registers;
begin
  if JeMys then with r do begin
    ax := 8;
    cx := min_y * 8;
    dx := max_y * 8;
    Intr($33, r);
  end;
end;


(***************************************************************************)
(*     pomocne funkce a procedury, pouze pro prezentovani pouziti mysi     *)
(***************************************************************************)

procedure SchovejKurzor;
{ odstrani z obrazovky textovy kurzor }
var r: Registers;
begin
  with r do begin
    ah := 2;
    bh := 0;
    dh := 25;
    dl := 0;
  end;
  Intr($10, r);
end;

function StisknutaKlavesa: boolean;
{ zjisti, zda je v bufferu klavesnice nejaka klavesa, tedy zda byla
  jiz nejaka klavesa stisknuta }
var r: Registers;
begin
  r.ah := $11;
  Intr($16, r);
  StisknutaKlavesa := (r.Flags and $40)=0;
end;

procedure PresunTextKurzor(x,y: byte);
{ presune textovy kurzor na zadane souradnice }
var r: Registers;
begin
  with r do begin
    ah := 2;
    bh := 0;
    dh := y;
    dl := x;
  end;
  Intr($10, r);
end;

procedure VypisSouradniceMysi;
{ vypise souradnice uschovane v promennych pozice_x a pozice_y }
begin
  if JeMys then begin
    PresunTextKurzor(0,0);
    write('[', pozice_x:3, ',' , pozice_y:3, ']');
    SchovejKurzor;
  end;
end;

procedure PisZnak(x,y: byte; znak: char; b_text, b_pozadi: byte);
{ vypise na zadanou pozici znak v urcite barve textu a pozadi }
var r: Registers;
begin
  PresunTextKurzor(x,y);
  with r do begin
    ah := 9;
    al := ord(znak);
    bh := 0;
    cx := 1;
    bl := (b_pozadi shl 4) + b_text;
  end;
  Intr($10, r);
  SchovejKurzor;
end;

procedure UklidObrazovku;
{ resetuje textovy rezim, tedy predevsim vymaze obsah obrazovky }
var r: Registers;
begin
  r.ah := 0;
  r.al := 3;
  Intr($10, r);
end;

begin  { main }
  UklidObrazovku;
  InicializujMys;

  if JeMys then begin
    HorizRozsahSouradnic(0,70);
    VertRozsahSouradnic (5,20);
    pozice_x := 0;
    pozice_y := 5;
    NastavPoziciMysi(pozice_x, pozice_y);
    VypisSouradniceMysi;

    repeat
      if StavMysi(s_tlacitka, pozice_x, pozice_y) then begin
        VypniKurzorMysi;
        VypisSouradniceMysi;
        ZapniKurzorMysi;
      end;
      if StisknutoTlacitko(t_leve, pocet, pozice_x, pozice_y) then begin
        VypniKurzorMysi;
        PisZnak(pozice_x, pozice_y, #176, 14, 1);
        ZapniKurzorMysi;
      end;
    until StisknutaKlavesa;
    UklidMys;
  end;
  UklidObrazovku;
end.