program KeyboardHandler;
{$X+,F+}
{ Program demonstrujici osetreni preruseni od klavesnice.
  Process Keyboard naznacuje transformaci pozicniho kodu klavesy na znak.
  Dale jsou spusteny dva procesy (Process1 resp. Process2), ktere ctou
  klavesnici (standardni funkci ReadKey) a kopiruji znak na vystup. Tyto
  procesu se prepinaji stiskem dane klavesy ('1' resp. '2') a synchronizuji
  se pres synchronni schranku prazdnych zprav (Synchro). Pro ulozeni a
  obnovu kontextu procesu (poloha kurzoru, barva textu atd.) jsou pouzity
  procedury ProcessEntry a ProcessExit, ktere se volaji pri pridelovani
  a odebirani procesoru procesum Process1 a Process2. }

{ Pro spravny preklad je nutne nastavit DEFINE = DOS }

uses Kernel, Dos, Crt;

var KeyBuffer: MailBox;
    Key09Buff: InterruptMailBox;
    Synchro:   SyncMailBox;
    Ch: Char;

procedure MyInt09;           { Sejmuti a ulozeni pozicniho kodu klavesy }
var Key: Byte;
begin
     Key := Port[$60];
     SendInterrupt(Key09Buff, Key, 1);
end {MyInt09};

{$S-,F+}
procedure Int09;
begin
     InterruptEntry;
     MyInt09;
     InterruptExit;
end {Int09};
{$S+}

{
Osetreni softwareoveho preruseni Int16. Procedura modifikuje cinnost
standardnich funkci ReadKey a KeyPressed.
}
procedure Int16(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: word); interrupt;
begin
     case Hi(AX) of
          0: begin                                                  { ReadKey }
                  Choice(1, KeyBuffer, AX, 2);
                  Receive;
             end;
          1: if Empty(KeyBuffer) then Flags := Flags or FZero    { KeyPressed }
                                 else Flags := Flags and not FZero;
          { dalsi funkce nejsou implementovany }
     end;
end {Int16};

procedure Keyboard;       { Transformace pozicniho kodu klavesy na znak }
var Key: Byte;
    Code: Word;
begin
     Start('Process', 1024, 100, 100); Exit;
     repeat
           Choice(1, Key09Buff, Key, 1);
           if Receive=1 then;
           if Full(KeyBuffer)                      { Schranka je plna ? }
           then begin Sound(500); Delay(20); NoSound; end
           else begin
                    Code := Key;       { Zde by bylo vlastni zpracovani }
                    Send(KeyBuffer, Code, 2);
               end;
     until false;
end {Keyboard};

procedure MakeWindow(Ident: IdentType; Left, Top, Right, Bottom: Word);
type Pos = (LeftTop, RightTop, Horizontal, Vertical, LeftBottom, RightBottom);
const Frame: array [Pos] of char = 'ɻͺȼ';
var I: Integer;
begin
     Window(1, 1, 80, 25);
     GotoXY(Left, Top); Write(Frame[LeftTop]);
     for I := Left+1 to Right-1 do Write(Frame[Horizontal]);
     Write(Frame[RightTop]);
     for I := Top+1 to Bottom-1 do
     begin
          GotoXY(Left, I); Write(Frame[Vertical]);
          GotoXY(Right, I); Write(Frame[Vertical]);
     end;
     GotoXY(Left, Bottom); Write(Frame[LeftBottom]);
     for I := Left+1 to Right-1 do Write(Frame[Horizontal]);
     Write(Frame[RightBottom]);
     GotoXY((Left+Right-Length(Ident)) div 2, Top);
     Write(' ', Ident, ' ');
     Window(Left+1, Top+1, Right-1, Bottom-1);
     ClrScr;
end {MakeWindow};


procedure Process(Ident: IdentType; Key: Char; Left, Top, Right, Bottom: Word;
                  Attr: Word);
var CursorX, CursorY: Integer;

procedure ProcessEntry;
begin
     Window(Left+1, Top+1, Right-1, Bottom-1);
     TextAttr := Attr;
     GotoXY(CursorX, CursorY);
end {ProcessEntry};

procedure ProcessExit;
begin
     CursorX := WhereX;
     CursorY := WhereY;
end {ProcessExit};

begin
     Start(Ident, 1024, 100, 100); Exit;
     SetEntryProc(@ProcessEntry);
     SetExitProc(@ProcessExit);
     TextAttr := Attr;
     MakeWindow(Ident, Left, Top, Right, Bottom);
     repeat
           Ch := ReadKey;
           if Ch=Key then      { Pri stisku dane klavesy se rizeni preda }
           begin                                       { druhemu procesu }
                SendEmpty(Synchro);
                ChoiceEmpty(1, Synchro);
                Receive;
           end;
           if ord(Ch) and $80 = 0
           then Writeln(' Stisknuta klavesa: ', Ord(Ch))
           else Writeln(' Uvolnena klavesa: ', Ord(Ch) and $7F);
     until Ch = #1;                                       { Klavesa ESC }
     Abort('*');                               { Ukonceni vsech procesu }
end {Process};


procedure Run;

begin                                                     
     Start('Run', 1024, 200, 255); Exit;
                                                          { Klavesa '2' }
     Process('Process1', #3, 5, 2, 35, 19, Blue shl 4 + Yellow);

     ChoiceEmpty(1, Synchro);
     Receive;
                                                          { Klavesa '1' }
     Process('Process2', #2, 40, 2, 70, 19, Red shl 4 + White);
end;


var Old09, Old16: Pointer;
    Flags: Word absolute $40:17;

procedure MyTerminate;
begin
     SetIntVec($16, Old16);
     Flags := Flags and $00F0;
end {MyTerminate};

begin {Main}
     UserTerminate := MyTerminate;
     GetIntVec($16, Old16);
     SetIntVec($16, @Int16);
     StartMain(0, 0);
                                                { Inicializace schranek }
     InitStatMailBox(Key09Buff, 'Key09', 1, 20, Normal);
     InitStatMailBox(KeyBuffer, 'Keyboard', 2, 16, Normal);
     InitSyncMailBox(Synchro, 'Synchro', Normal);

     InitInterruptStack(1, 510);               { Inicializace preruseni }
     SetInterruptHandler(9, Int09, Key09Buff);

     Keyboard;
     TextAttr := Green;
     ClrScr;
     GotoXY(1, 21);
Writeln('         Program demonstrujici osetreni preruseni od klavesnice.');
Writeln('     Jsou spusteny dva procesy, z nichz vzdy pouze jeden je aktivni.');
Writeln('  Aktivni proces cte  pozicni kod klaves a vypisuje jej do sveho okna.');
Write  (
'Procesy se aktivizuji stiskem klaves <1> resp. <2>. Ukonceni klavesou<ESC>');


     Run;
     TerminateMain;
end {Main}.