git » fp-git.git » commit ed8bbc9

diff --git a/poprecog/record/Compile.txt b/poprecog/record/Compile.txt
new file mode 100644
index 0000000..67b71d2
--- /dev/null
+++ b/poprecog/record/Compile.txt
@@ -0,0 +1,6 @@
+Before compiling set this :
+
+Target : Real mode
+Options / Compiler : enable 286 instructions
+
+Mean file : record.pas
\ No newline at end of file
diff --git a/poprecog/record/GRAPH13H.PAS b/poprecog/record/GRAPH13H.PAS
new file mode 100644
index 0000000..48721c2
--- /dev/null
+++ b/poprecog/record/GRAPH13H.PAS
@@ -0,0 +1,1394 @@
+UNIT GRAPH13H;
+
+{
+############################################
+Biblioteka do trybu 13h
+(rozdzielczosc : 320 x 200 ; max. 256 r\xf3\xbfnych kolor\xf3w)
+
+Autor : Piotr Kochanek
+WWW   : www.pop2.princed.com.ar
+
+Obsluguje :
+* Bufor Wirtualny
+* Obrazki (mozliwosc ladowania z BMP)
+* Palete kolorow
+* Czcionke wbudowana w program
+* Czcionke wczytywana z pliku
+* Efekty graficzne (wygaszanie ekranu, rozjasnianie ekranu ird.)
+
+Wiekszosc procedur jest napisana obiektowo
+############################################
+}
+
+INTERFACE
+ USES
+   CRT;
+ TYPE
+   { // Bufor }
+   TBufor
+     = ARRAY [0..63999] OF byte;
+   { // Obrazek }
+   TImage
+     = OBJECT
+         Use       : Boolean; { Czy obrazek jest uzywany }
+         Width     : Word;    { Szerokosc obrazka }
+         Height    : Word;    { Wysokosc obrazka }
+         Size      : Word;    { Rozmiar obrazka }
+         Handler   : ^TBufor;     { Wskaznik do obrazka w pamieci }
+         { // Tworzy nowy obrazek }
+         PROCEDURE NewImage (x,y : word);
+         { // Kladzie piksel na obrazek }
+         PROCEDURE PutPix (x,y : integer ; c : byte);
+         { // Pobiera pixel z obrazka }
+         FUNCTION  GetPix (x,y : integer ; c : byte) : byte;
+         { // Kopiuje inny obrazek }
+         PROCEDURE CopyImage (Image : TImage);
+         { // Rysuje obrazek na buforze }
+         PROCEDURE XY  ( x,y : integer );
+         { // Rysunek przezroczysty }
+         PROCEDURE XYV (X,Y : integer);
+         { // Rysuje obrazek na buforze ( kolor przezroczysty ) }
+         PROCEDURE XYT ( x,y : integer; TransparentColor : byte);
+         { // NIEUZYWANE }
+         FUNCTION  LoadAFG     (sciezka,nazwa : string) : Boolean;
+         { // Laduje plik BMP (mozna takze automatycznie ustawic palete tego pliku) }
+{!!!}{           FUNCTION  OldLoadBMP (sciezka : string) : Boolean;}
+         FUNCTION  LoadBMP (FileName : string ; LoadPalette : Boolean) : Boolean;
+         { // Usuwa obrazek z pamieci }
+         PROCEDURE Unload;
+       END;
+   { // Czcionka }
+   TFontData
+     = ARRAY [0..255,0..15] OF byte;
+   TFont
+     = OBJECT
+         Use  : Boolean;
+         Font : ^TFontData;
+         { // Laduje czcionke z pliku }
+         FUNCTION  Load (NazwaPliku : string) : boolean;
+         { // Usuwa czionke z pamieci }
+         PROCEDURE Unload;
+         { // Kladzie pojedynczy znak }
+         PROCEDURE Ch (X,Y : Word ; Znak : Char ; Color, Shadow : Byte);
+
+         PROCEDURE ChA (X,Y : Word ; Znak : Char ; Color, Shadow : Byte);
+         { // ??? }
+         PROCEDURE ColorChar (X,Y : Word ; Znak : Char ; Color,Shadow : Byte);
+         { // Podaje dlugosc danego znaku }
+         FUNCTION  Weidth (Znak : Char) : Byte;
+         { // Podaje dlugosc danego tekstu }
+         FUNCTION  StrLength (Tekst : String) : Word;
+         { // Wyswietla napis na buforze }
+         PROCEDURE XY (X,Y : Word ; Tekst : String ; C,S : Byte);
+         { // Wczytuje tekst od u\xbfytkownika }
+         FUNCTION  Read (PolX,PolY : Integer ; Var Tekst : String ; Max,C,B : Byte) : String;
+       END;
+   { // Naglowek BMP }
+   THandleBMP
+     = RECORD
+         FType           : Word;
+         FSize           : Longint;
+         FReserved1      : Word;
+         FReserved2      : Word;
+         FFirstPixel     : Longint;
+         FInfoSize       : Longint;
+         FWidth          : Longint;
+         FHeight         : Longint;
+         FPlanes         : Word;
+         FBitPerPixel    : Word;
+         FCompression    : Longint;
+         FImageSize      : Longint;
+         FDPIWidth       : Longint;
+         FDPIHeight      : Longint;
+         FColorUsed      : Longint;
+         FImportantColor : Longint;
+       END;
+   { // Palety }
+   TPalette
+     = ARRAY [0..255] OF
+       RECORD
+         R : Byte;
+         G : Byte;
+         B : Byte;
+       END;
+   TPaletteBMP
+     = ARRAY [0..255] OF
+       RECORD
+         B : Byte;
+         G : Byte;
+         R : Byte;
+         N : Byte;
+       END;
+CONST
+  GetMaxX       = 319;
+  GetMaxY       = 199;
+VAR
+  Screen         : Pointer;
+  Bufor          : ^TBufor;
+  DefaultPalette : TPalette;
+  Plik           : File;
+  X              : Word;
+  Y              : Word;
+  I              : Integer;
+
+ { ### Glowne funkcje do wlanczania / wylanczania trybu 13h ### }
+
+ { // Wlacz tryb 13h }
+ PROCEDURE Load13h;
+ { // Wylacz tryb 13h }
+ PROCEDURE Unload13h;
+ { // Aktualny tryb }
+ FUNCTION  GetVideoMode : Byte;
+ { // Ustawia wybrany tryb }
+ PROCEDURE SetVideoMode( Mode : Byte );
+ { // Ustawia Bufor }
+ PROCEDURE SetBufor (Adres : Pointer);
+ { // Funkcja wyprowadza adres aktualnie uzywanego buforu }
+ FUNCTION  GetBufor : Pointer;
+
+ { ### Obsluga palety w 13h ### }
+
+ { // Zapisz aktualna palete }
+ PROCEDURE SavePalette (var Palette : TPalette);
+ { // Zaladuj palete }
+ PROCEDURE LoadPalette (Palette : TPalette);
+ { // ??? }
+ FUNCTION  GetAverageColor(nr : byte) : byte;
+ { // Ustal kolor palety}
+ PROCEDURE SetColor(numer, r, g, b : byte);
+ { // Pobierz kolor palety }
+ PROCEDURE GetColors(numer : byte; var r, g, b : byte);
+ { // ??? }
+ FUNCTION  GetColor(numer : byte ; color : char) : byte;
+ { // Znajduje kolor w aktualnej palecie najbardziej pasujacy do szukanego }
+ FUNCTION  Color (r,g,b : byte) : byte;
+
+ { ### Funkcje do obslugi pixeli ### }
+
+ { // Rysuje pixel na buforze }
+ PROCEDURE PutPixel(x,y : integer ; c : byte);
+ { // Rysuje pixel na ekranie }
+ PROCEDURE FPutPixel(x,y : integer ; c : byte);
+ { // Pobiera pixel z buforu }
+ FUNCTION  GetPixel(x,y : integer) : byte;
+ { // Pobiera pixel z ekranu }
+ FUNCTION  FGetPixel(x,y : integer) : byte;
+
+ { ### Figury geometryczne ### }
+
+ { // Rysuje linie }
+ PROCEDURE Line (x1,y1,x2,y2 : word; c : byte);
+ { // Rysuje linie pozioma }
+ PROCEDURE LineAcross(x,y,leng : integer ; color : byte);
+ { // Rysuje linie pionowa }
+ PROCEDURE LineDown(x,y,leng : integer ; color : byte);
+ { // Rysuje prostokat }
+ PROCEDURE Rectangle(x1,y1,x2,y2 : integer ; color : byte);
+ { // Rysuje wypelniony prostokat }
+ PROCEDURE RectangleFilled(x1,y1,x2,y2 : integer ; color : byte);
+ { // Rysuje kolo }
+ PROCEDURE Circle(X,Y,R : Longint; color: Byte);
+
+ { ### Obsluga czcionki systemowej ### }
+
+ { ### Dodatkowe procedury do obrazkow ### }
+
+ { // Laduje palete z pliku BMP }
+ PROCEDURE LoadBMPPalette (sciezka : string);
+
+ { ### Przenoszenie bufora na ekran ### }
+
+ { // Czeka na powrot pionowy }
+ PROCEDURE WaitForStopWriting;
+ { // Kopiuje bufor }
+ PROCEDURE CopyBufor (BuforIn,BuforOut : Pointer);
+ { // Kopiuje bufor na ekran usuwajac 'mruganie ekranu' }
+ PROCEDURE ShowBufor (BuforIn : Pointer);
+ { // Jezeli trwa powrot pionowy to wyswietla ekran }
+ PROCEDURE TryShowBufor (BuforIn : Pointer);
+
+ { ### Efekty ### }
+
+ { // Czysci bufor na wybrany kolor }
+ PROCEDURE Clr13h (color : byte);
+ { // Ustawia kolor czarnobialy }
+ PROCEDURE BlackWhite;
+ { // Odwraca kolory }
+ PROCEDURE RetreatColors;
+ { // Wygasza ekran }
+ PROCEDURE WygasEkran (przerwa : byte);
+ { // Rozjasnia ekran }
+ PROCEDURE RozjasnijEkran (paleta_k : TPalette ; przerwa : Byte);
+ { // Rozmazuje ekran }
+ PROCEDURE Blur;
+
+ { ### Procedury pomocnicze ### }
+
+ { // Zmienia palete bmp na rgb }
+ PROCEDURE PaletteBMPToRGB (PaletteBMP : TPaletteBMP ; Var Palette : TPalette);
+ { // Zmienia palete rgb na bmp }
+ PROCEDURE PaletteRGBtoBMP (Palette : TPalette ; Var PaletteBMP : TPaletteBMP);
+
+IMPLEMENTATION
+
+PROCEDURE SetBufor (Adres : Pointer);
+BEGIN
+  Bufor := Adres;
+END;
+
+FUNCTION GetBufor : Pointer;
+BEGIN
+  GetBufor := Bufor;
+END;
+
+FUNCTION GetVideoMode : Byte;
+VAR
+  tempVMode : Byte;
+BEGIN
+  ASM
+    mov ah,$0f
+    int $10
+    mov tempvmode,al
+  END;
+  GetVideoMode := tempVMode;
+END;
+
+PROCEDURE SetVideoMode( Mode : Byte );
+BEGIN
+ ASM
+   mov ah, Mode;
+   int $10
+ END;
+END;
+
+PROCEDURE Load13h;
+BEGIN
+ ASM
+   mov ax, 13h;
+   int 10h;
+ END;
+ Clr13h (0);
+ SavePalette (DefaultPalette);
+END;
+
+PROCEDURE Unload13h;
+BEGIN
+ ASM
+   mov ax, 3h;
+   int 10h;
+ END;
+END;
+
+PROCEDURE SavePalette (var Palette : TPalette);
+VAR r,g,b : byte;
+BEGIN
+ FOR x := 0 TO 255 DO
+ BEGIN
+   GetColors(x,r,g,b);
+   palette [x].r := r;
+   palette [x].g := g;
+   palette [x].b := b;
+ END;
+END;
+
+PROCEDURE LoadPalette (Palette : TPalette);
+BEGIN
+ FOR x := 0 TO 255 DO
+ BEGIN
+   SetColor(x,palette [x].r,palette [x].g,palette [x].b);
+ END;
+END;
+
+FUNCTION GetAverageColor(nr : byte) : byte;
+Var
+ r,g,b : byte;
+BEGIN
+ GetColors(nr,r,g,b);
+ GetAverageColor := (r + g + b) div 3;
+END;
+
+PROCEDURE SetColor(numer, r, g, b : byte);
+BEGIN
+ port[$3c8] := numer;
+ port[$3c9] := r;
+ port[$3c9] := g;
+ port[$3c9] := b;
+END;
+
+PROCEDURE GetColors(numer : byte; var r, g, b : byte);
+BEGIN
+ port[$3c7] := numer;
+ r := port[$3c9];
+ g := port[$3c9];
+ b := port[$3c9];
+END;
+
+FUNCTION GetColor(numer : byte ; color : char) : byte;
+var r,g,b : byte;
+BEGIN
+  GetColors(numer,r,g,b);
+  IF color = 'r' THEN GetColor := r;
+  IF color = 'g' THEN GetColor := g;
+  IF color = 'b' THEN GetColor := b;
+END;
+
+PROCEDURE PutPixel(x,y : integer ; c : byte); Assembler;
+ASM
+ cmp x, 0
+ jl @end
+ cmp y, 0
+ jl @end
+ cmp x, 319
+ jg @end
+ cmp y, 199
+ jg @end
+ mov ax, y
+ mov di, ax
+ shl ax, 8
+ shl di, 6
+ add di, ax
+ add di, x
+ les ax, bufor  {???}
+ mov al, c
+ mov byte ptr es:[di], al
+ @end:
+END;
+{ exit;
+
+ IF (X <= GetMaxX) and (Y <= GetMaxY) and (X >= 0) and (Y  >= 0) THEN
+ BUFOR^ [320 * y + x] := c;
+END;}
+
+PROCEDURE FPutPixel(x,y : integer ; c : byte); assembler;
+ASM
+ mov ax, $a000
+ mov es, ax
+
+ mov dx, y
+ mov di, x
+ xchg dh, dl
+ add di, dx
+ shr dx, 2
+ add di, dx
+
+ mov al, c
+ mov es:[di], al
+END;
+
+FUNCTION GetPixel(x,y : integer) : byte;
+BEGIN
+ GetPixel := BUFOR^[320 * y + x];
+END;
+
+FUNCTION FGetPixel(x,y : integer) : byte; assembler;
+ASM
+ mov ax, $a000
+ mov es, ax
+
+ mov dx, y
+ mov di, x
+ xchg dh, dl
+ add di, dx
+ shr dx, 2
+ add di, dx
+
+ mov al, es:[di]
+END;
+
+PROCEDURE Line (x1,y1,x2,y2 : word; c : byte);
+
+FUNCTION sgn(a:real):integer;
+BEGIN
+  if a > 0 then sgn := +1;
+  if a < 0 then sgn := -1;
+  if a = 0 then sgn := 0;
+END;
+
+VAR
+  s : real;
+  u,i,v,d1x,d1y,d2x,d2y,m,n : integer;
+BEGIN
+ u := x2 - x1;
+ v := y2 - y1;
+ d1x := SGN (u);
+ d1y := SGN (v);
+ d2x := SGN (u);
+ d2y := 0;
+ m := ABS (u);
+ n := ABS (v);
+ IF M <= N then
+ BEGIN
+   d2x := 0 ;
+   d2y := SGN (v);
+   m := ABS (v);
+   n := ABS (u);
+ END;
+ s := INT (m / 2);
+ FOR i := 0 TO m DO
+ BEGIN
+   PutPixel (x1,y1,c);
+   s := s + n;
+   IF s >= m THEN
+   BEGIN
+     s := s - m;
+     x1 := x1 + d1x;
+     y1 := y1 + d1y;
+   END
+   ELSE
+   BEGIN
+     x1 := x1 + d2x;
+     y1 := y1 + d2y;
+   END;
+ END;
+END;
+
+PROCEDURE lineacross(x,y,leng : integer ; color : byte);
+ BEGIN
+  FOR x := x to x + leng - 1 do PutPixel(x,y,color);
+ END;
+
+PROCEDURE linedown(x,y,leng : integer ; color : byte);
+ BEGIN
+  FOR y := y to y + leng - 1 do PutPixel(x,y,color);
+ END;
+
+PROCEDURE Rectangle(x1,y1,x2,y2 : integer ; color : byte);
+ BEGIN
+  FOR x := x1 to x2 do
+   BEGIN
+    PutPixel(x,y1,color);
+    PutPixel(x,y2,color);
+   END;
+  FOR y := y1 to y2 do
+   BEGIN
+    PutPixel(x1,y,color);
+    PutPixel(x2,y,color);
+   END;
+ END;
+
+PROCEDURE RectangleFilled(x1,y1,x2,y2 : integer ; color : byte);
+BEGIN
+ FOR x := x1 to x2 do
+  FOR y := y1 to y2 do
+   PutPixel(x,y,color);
+END;
+
+PROCEDURE Circle(X,Y,R : longint; color: byte);
+Var Xl,Yl : LongInt;
+BEGIN
+  IF R=0 THEN
+  BEGIN
+    PutPixel(X,Y,color);
+    Exit;
+  END;
+  Xl := 0;
+  Yl := R;
+  R := R*R+1;
+  Repeat
+    PutPixel(X+Xl,Y+Yl,color);
+    PutPixel(X-Xl,Y+Yl,color);
+    PutPixel(X+Xl,Y-Yl,color);
+    PutPixel(X-Xl,Y-Yl,color);
+    IF Xl*Xl+Yl*Yl >= R THEN Dec(Yl)
+    Else Inc(Xl);
+  Until Yl = 0;
+  PutPixel(X+Xl,Y+Yl,color);
+  PutPixel(X-Xl,Y+Yl,color);
+  PutPixel(X+Xl,Y-Yl,color);
+  PutPixel(X-Xl,Y-Yl,color);
+END;
+
+{PROCEDURE kopiuj(BUFOR1,BUFOR2:pointer);assembler;
+asm
+push ds
+mov cx, 16000
+lds si, BUFOR1
+les di, BUFOR2
+cld
+db $F3, $66, $A5
+pop ds
+end;}
+
+PROCEDURE WaitForStopWriting; Assembler;
+ASM
+  mov dx, 3dah
+  @wait:
+  in al, dx
+  test al, 00001000b
+  jnz @wait
+  @end:
+  in al, dx
+  test al, 00001000b
+  jz @end
+END;
+
+
+PROCEDURE CopyBufor (BuforIn,BuforOut : Pointer);Assembler;
+{var
+ p : pointer;
+{ p := mem[$a000:0];}
+{ IF (not UseBUFOR) THEN exit;}
+
+{ kopiuj (BUFOR,mem [$a000:0]);
+ Move(BUFOR^,mem[$a000:0],64000);}
+ASM
+ push ds
+ lds si,buforin
+ les di,buforout
+ cld
+ mov cx,32000
+ rep movsw
+ pop ds
+END;
+
+PROCEDURE ShowBufor (BuforIn : Pointer); ASSEMBLER;
+ASM
+ mov dx, 3dah
+ @wait:
+ in al, dx
+ test al, 00001000b
+ jnz @wait
+ @end:
+ in al, dx
+ test al, 00001000b
+ jz @end
+
+ push ds
+ lds si,buforin
+ mov ax, $A000
+ mov es, ax
+ mov di, 0
+ cld
+ mov cx,32000
+ rep movsw
+ pop ds
+END;
+
+PROCEDURE TryShowBufor (BuforIn : Pointer); ASSEMBLER;
+ASM
+ mov dx, 3dah
+{ @wait:}
+ in al, dx
+ test al, 00001000b
+ {jnz}jz @exit
+{ @end:
+ in al, dx
+ test al, 00001000b
+ jz @exit}
+
+ push ds
+ lds si,buforin
+ mov ax, $A000
+ mov es, ax
+ mov di, 0
+ cld
+ mov cx,32000
+ rep movsw
+ pop ds
+
+ @exit:
+END;
+
+FUNCTION TFont.Load (NazwaPliku : string) : boolean;
+Begin
+ Load := False;
+ If (Use) then Unload;
+
+ Assign (Plik,NazwaPliku);
+ {$I-}
+ Reset (Plik,1);
+ {$I+}
+ If (IOResult <> 0) then Exit;
+ New (Font);
+ BlockRead (Plik,Font^,SizeOf (Font^));
+ Close (Plik);
+
+ Use := True;
+ Load := True;
+End;
+
+PROCEDURE TFont.Unload;
+Begin
+ If (not Use) then Exit;
+ Dispose (Font);
+ Use := False;
+End;
+
+PROCEDURE TFont.Ch (X,Y : Word ; Znak : Char ; Color, Shadow : Byte);
+var
+ MaskaBitowa  : Byte;
+ LicznikY     : Byte;
+ LicznikBitow : Byte;
+Begin
+ If (not Use) then exit;
+ For LicznikY := 0 to 15 do
+ Begin
+   MaskaBitowa := $80; { 80h = 10000000b }
+   For LicznikBitow := 7 downto 0 do
+   Begin
+     If ((Font^ [Ord (Znak),LicznikY] and MaskaBitowa) = MaskaBitowa)
+      then
+      Begin
+        If (Color <> Shadow) then
+          PutPixel (X + LicznikBitow + 1,Y + LicznikY + 1,Shadow);
+        PutPixel (X + LicznikBitow,Y + LicznikY,Color);
+      End;
+     MaskaBitowa := MaskaBitowa shr 1;
+   End;
+ End;
+End;
+
+PROCEDURE TFont.ChA (X,Y : Word ; Znak : Char ; Color, Shadow : Byte); Assembler;
+ASM
+  {czy czcionka jest zaladowana}
+  mov ax, use
+  cmp ax, 0
+  jz @end
+  {glowna petla - od 15 do 0}
+  mov cx, 16
+  @petla:
+  push cx
+  mov ax, 10000000b
+  mov cx, 8
+  @petla2:
+  loop @petla2
+  pop cx
+  loop @petla
+  {koniec procedury}
+  @end:
+END;
+
+PROCEDURE TFont.ColorChar (X,Y : Word ; Znak : Char ; Color,Shadow : Byte);
+var
+ MaskaBitowa  : Byte;
+ LicznikY     : Byte;
+ LicznikBitow : Byte;
+ ActualColor  : Byte;
+Begin
+ If (not Use) then exit;
+ ActualColor := Color;
+ For LicznikY := 0 to 15 do
+ Begin
+   MaskaBitowa := $80; { 80h = 10000000b }
+   For LicznikBitow := 7 downto 0 do
+   Begin
+      If ((Font^ [Ord (Znak),LicznikY] and MaskaBitowa) = MaskaBitowa)
+      then
+      Begin
+        If (Color <> Shadow) then
+          PutPixel (X + LicznikBitow + 1,Y + LicznikY + 1,Shadow);
+        PutPixel (X + LicznikBitow,Y + LicznikY,ActualColor);
+      End;
+     MaskaBitowa := MaskaBitowa shr 1;
+   End;
+   Dec (ActualColor);
+ End;
+End;
+
+FUNCTION TFont.Weidth (Znak : Char) : Byte;
+var
+ X,Y,Leng,MaskaBitowa : Byte;
+Begin
+ Leng := 0;
+ For Y := 0 to 15 do
+ Begin
+   MaskaBitowa := $01;
+   For X := 0 to 7 do
+   Begin
+     If ((Font^ [Ord (Znak),Y] and MaskaBitowa) = MaskaBitowa) then
+     Begin
+       If (X > Leng) then Leng := X;
+     End;
+     MaskaBitowa := MaskaBitowa shl 1;
+   End;
+ End;
+ Weidth := Leng + 1;
+End;
+
+FUNCTION TFont.StrLength (Tekst : String) : Word;
+var
+ Licznik : Byte;
+ Dlugosc : Word;
+Begin
+ Dlugosc := 0;
+ For licznik := 1 to length (Tekst) do
+ Begin
+   Inc (Dlugosc,Weidth (Tekst [licznik]) + 1);
+   If (Tekst [Licznik] = #32) then Inc (Dlugosc,2);
+ End;
+ StrLength := Dlugosc;
+End;
+
+PROCEDURE TFont.XY (X,Y : Word ; Tekst : String ; C,S : Byte);
+var
+ Licznik : Byte;
+Begin
+ For Licznik := 1 to Length (Tekst) do
+ Begin
+   Ch (X,Y,Tekst [Licznik],C,S);
+   If (Tekst [Licznik] = #32) then Inc (X,2);
+   Inc (X,Weidth (Tekst [Licznik]) + 1);
+ End;
+End;
+
+{!!! - procedura zostaje ze wzgledu na algorytm dzialania}
+FUNCTION TFont.Read (PolX,PolY : Integer ; Var Tekst : String ; Max,C,B : Byte) : String;
+VAR
+ Kl       : Char;
+ Ilosc    : Byte;
+ OldBufor : Pointer;
+BEGIN
+ Ilosc := Length (Tekst);
+ OldBufor := GetBufor;
+ SetBufor (Screen);
+ RectangleFilled (PolX,PolY + 1,PolX + 2 + (Max * 8),PolY + 17,B);
+ REPEAT
+   RectangleFilled (PolX + 2 + StrLength (Tekst),PolY + 1,PolX + 2 + (Max * 8),PolY + 17,B);
+   XY (PolX + 2,PolY,Tekst,C,C);
+   If (Keypressed) then Kl := Readkey else Kl := #1;
+   If (Kl = #0) THEN Readkey
+   Else If (Kl = #8) THEN
+   BEGIN
+     IF (Ilosc > 0) THEN
+     BEGIN
+       delete(tekst,length(tekst),1);
+       dec(ilosc);
+     END;
+   END
+   ELSE
+   BEGIN
+     IF (ord(kl) < 32) or (ord(kl) > 255) THEN continue;
+     IF ilosc >= max THEN continue;
+     inc(ilosc);
+     tekst := tekst + kl;
+   END;
+ UNTIL (Kl = #13);
+ SetBufor (OldBufor);
+END;
+
+        {  EFFECTS  }
+
+PROCEDURE Clr13h (color : byte); Assembler;
+ASM
+  les di, Bufor;
+  mov ah, color
+  mov al, ah
+  mov cx, 32000
+  cld
+  rep stosw
+END;
+
+PROCEDURE BlackWhite;
+BEGIN
+ FOR x := 0 to 255 do
+ BEGIN
+   y := (GetColor(x,'r') + GetColor(x,'g') + GetColor(x,'b') div 3);
+   SetColor(x,y,y,y);
+ END;
+END;
+
+PROCEDURE RetreatColors;
+Var
+ r,g,b : byte;
+BEGIN
+ FOR x := 0 to 255 do
+ BEGIN
+   GetColors(x,r,g,b);
+   r := not r;
+   g := not g;
+   b := not b;
+   SetColor(x,r,g,b);
+ END;
+END;
+
+     { ADDITIONAL PROCEDURES }
+
+{FUNCTION _Color (R,G,B : Byte) : Byte;
+Var
+  licznik           : byte;
+  roznica           : word;
+  r2,g2,b2          : byte;
+  najlepsza_roznica : word;
+  najlepszy_kolor   : byte;
+BEGIN
+ ASM
+   mov najlepsza_roznica, 1000
+   mov cx, 256
+   @petla:
+     push cx
+     dec cx
+
+     mov roznica, 0
+
+     mov dx, 3c7h
+     mov ax, cx
+     out dx, ax
+     mov dx, 3c9h
+     in al, dx
+     mov r2, al
+     in al, dx
+     mov g2, al
+     in al, dx
+     mov b2, al
+
+     mov al, r
+     cmp al, r2
+     jb @nextr
+       mov ax, roznica
+       xor bx, bx
+       mov bh, r
+       add ax, bx
+       xor bx, bx
+       mov bh, r2
+       sub ax, bx
+       add roznica, ax
+       jmp @nextr2
+     @nextr:
+       mov ax, roznica
+       xor bx, bx
+       mov bh, r2
+       add ax, bx
+       xor bx, bx
+       mov bh, r
+       sub ax, bx
+       add roznica, ax
+     @nextr2:
+
+     mov al, g
+     cmp al, g2
+     jb @nextg
+       mov ax, roznica
+       xor bx, bx
+       mov bh, g
+       add ax, bx
+       xor bx, bx
+       mov bh, g2
+       sub ax, bx
+       add roznica, ax
+       jmp @nextg2
+     @nextg:
+       mov ax, roznica
+       xor bx, bx
+       mov bh, g2
+       add ax, bx
+       xor bx, bx
+       mov bh, g
+       sub ax, bx
+       add roznica, ax
+     @nextg2:
+
+     mov al, b
+     cmp al, b2
+     jb @nextb
+       mov ax, roznica
+       xor bx, bx
+       mov bh, b
+       add ax, bx
+       xor bx, bx
+       mov bh, b2
+       sub ax, bx
+       add roznica, ax
+       jmp @nextb2
+     @nextb:
+       mov ax, roznica
+       xor bx, bx
+       mov bh, b2
+       add ax, bx
+       xor bx, bx
+       mov bh, b
+       sub ax, bx
+       add roznica, ax
+     @nextb2:
+
+     mov ax, roznica
+     cmp ax, najlepsza_roznica
+     jae @next
+       mov ax, roznica
+       mov najlepsza_roznica, ax
+       mov ax, cx
+       mov najlepszy_kolor, ah
+     @next:
+
+     pop cx
+   dec cx
+   cmp cx, 0
+   jne @petla
+ END;
+ _Color := najlepszy_kolor;
+END;}
+
+FUNCTION Color (r,g,b : byte) : byte;
+Var
+  licznik           : byte;
+  roznica           : word;
+  r2,g2,b2          : byte;
+  najlepsza_roznica : word;
+  najlepszy_kolor   : byte;
+BEGIN
+ najlepsza_roznica := 1000;
+ FOR licznik := 0 to 255 do
+ BEGIN
+  roznica := 0;
+  GetColors (licznik,r2,g2,b2);
+  IF (r >= r2)
+   THEN roznica := roznica + r - r2
+   else roznica := roznica + r2 - r;
+  IF (g >= g2)
+   THEN roznica := roznica + g - g2
+   else roznica := roznica + g2 - g;
+  IF (b >= b2)
+   THEN roznica := roznica + b - b2
+   else roznica := roznica + b2 - b;
+  IF roznica < najlepsza_roznica THEN
+   BEGIN
+    najlepsza_roznica := roznica;
+    najlepszy_kolor   := licznik;
+   END;
+ END;
+ Color := najlepszy_kolor;
+END;
+
+(* EFEKTY GRAFICZNE *)
+
+PROCEDURE WygasEkran (przerwa : byte);
+var licznik1,licznik2 : byte;
+    wzorzec : record
+               R,G,B :Byte;
+              END;
+BEGIN
+ FOR licznik2 := 0 to 63 do
+ BEGIN
+  FOR licznik1 := 0 to 255 do
+  BEGIN
+   GetColors (licznik1,wzorzec.r,wzorzec.g,wzorzec.b);
+   IF (wzorzec.r > 0) THEN dec (wzorzec.r);
+   IF (wzorzec.g > 0) THEN dec (wzorzec.g);
+   IF (wzorzec.b > 0) THEN dec (wzorzec.b);
+   SetColor (licznik1,wzorzec.r,wzorzec.g,wzorzec.b);
+  END;
+  IF (przerwa <> 0) THEN Delay (przerwa);
+ END;
+END;
+
+PROCEDURE RozjasnijEkran (paleta_k : TPalette ; przerwa : Byte);
+VAR
+ licznik1, licznik2 : Byte;
+ wzorzec : record
+            R,G,B : Byte;
+           END;
+BEGIN
+ FOR licznik2 := 0 to 63 do
+ BEGIN
+  FOR licznik1 := 0 to 255 do
+  BEGIN
+   GetColors (licznik1,wzorzec.r,wzorzec.g,wzorzec.b);
+   IF (wzorzec.r < paleta_k [licznik1].r) THEN Inc (wzorzec.r);
+   IF (wzorzec.g < paleta_k [licznik1].g) THEN Inc (wzorzec.g);
+   IF (wzorzec.b < paleta_k [licznik1].b) THEN Inc (wzorzec.b);
+   SetColor (licznik1,wzorzec.r,wzorzec.g,wzorzec.b);
+  END;
+  IF (przerwa <> 0) THEN delay (przerwa);
+ END;
+END;
+
+{PROCEDURE Blur;
+Begin
+  For x := 0 to 319 do
+  For y := 0 to 199 do
+    PutPixel (x,y,GetPixel (x - 1 + random (3),y - 1 + random (3)));
+End;}
+
+PROCEDURE Blur;
+VAR
+  c : integer;
+BEGIN
+ for x:= 0 to 319 do
+ for y:= 0 to 198 do
+ begin
+   c:=(BUFOR^[320*y+x]+BUFOR^[320*(y+1)+x+1]+BUFOR^[320*y+1+x]+BUFOR^[320*(y+1)+x]) div 4;
+   BUFOR^[320*y+x]:=c;
+ end;
+END;
+
+(* OBRAZY *)
+
+PROCEDURE TImage.NewImage (x,y : word);
+Begin
+ If (Use) then Unload;
+ Size := x * y;
+ Width := x;
+ Height := y;
+ GetMem (Handler,Size);
+ For I := 0 to Size - 1 do Handler^ [I] := 0;
+End;
+
+PROCEDURE TImage.PutPix (x,y : integer ; c : byte);
+Begin
+ If (Use) and (x > 0) and (y > 0) and
+    (x < Width) and (y < Height)
+  then Handler^ [((y - 1) * Width) + (x - 1)] := C;
+End;
+
+FUNCTION TImage.GetPix (x,y : integer ; c : byte) : byte;
+Begin
+ If (Use) and (x > 0) and (y > 0) and
+    (x < Width) and (y < Height)
+  then GetPix := Handler^ [((y - 1) * Width) + (x - 1)]
+  else GetPix := 0;
+End;
+
+PROCEDURE TImage.CopyImage (Image : TImage);
+Var
+ W : Word;
+Begin
+ If (not Image.Use) then Exit;
+ If (Use) then Unload;
+ GetMem (Handler,Image.Size);
+ Size := Image.Size;
+ Width := Image.Width;
+ Height := Image.Height;
+ For w := 0 to Size - 1 do Handler^ [w] := Image.Handler^ [w];
+ Use := True;
+End;
+
+FUNCTION TImage.LoadAFG (sciezka,nazwa : string) : Boolean;
+VAR
+ plik : file;
+ nagl : record
+          typ : string [3];
+          ver : string [3];
+          images : word;
+        END;
+ fnagl : record
+            adres : longint;
+            nazwa : string [10];
+            rozmiar : word;
+            szerokosc : word;
+            wysokosc : word;
+          END;
+BEGIN
+ LoadAFG := false;
+ If (Use) then Unload;
+ assign (plik,sciezka);
+ {$I-}
+ reset  (plik, 1);
+ {$I+}
+ IF (IOResult <> 0) THEN exit;
+
+ BlockRead (plik, nagl, 10);
+ IF (nagl.typ <> 'AFG') or (nagl.ver <> '1.0') THEN
+ BEGIN
+   close (plik);
+   exit;
+ END;
+
+ Repeat
+  BlockRead (plik,fnagl,sizeof (fnagl));
+ Until (fnagl.nazwa = nazwa) or (FilePos (plik) - 1 >= (nagl.images * 21) + 10);
+
+ IF (FilePos (plik) - 1 >= (nagl.images * 21) + 10) THEN
+ BEGIN
+   close (plik);
+   exit;
+ END;
+
+ Getmem (Handler, fnagl.rozmiar);
+ Seek (plik,fnagl.adres);
+
+ writeln (fnagl.rozmiar);
+ writeln (FilePos (plik));
+ writeln (FileSize (plik));
+
+ Size := Fnagl.Rozmiar;
+ Width := Fnagl.Szerokosc;
+ Height := Fnagl.Wysokosc;
+
+ BlockRead (plik,Handler^ [0],fnagl.rozmiar);
+
+ close  (plik);
+ Use := True;
+ LoadAFG := true;
+END;
+
+{FUNCTION TImage.OldLoadBMP (sciezka : string) : Boolean;
+VAR
+ plik : file;
+ naglowek : naglowek_BMP;
+ licznik, wynik : word;
+ licznik_odczytu : word;
+BEGIN
+ OldLoadBMP := False;
+ If (Use) then Unload;
+ assign (plik, sciezka);
+ {$I-}
+{ reset  (plik, 1);
+ {$I+}
+{ If (IOResult <> 0) then exit;
+ licznik := sizeof (naglowek_BMP);
+ blockread (plik, naglowek, licznik, wynik);
+ seek   (plik, 1078);
+ Width := naglowek.szerokosc_obrazu;
+ Height  := naglowek.wysokosc_obrazu;
+ Size   := naglowek.szerokosc_obrazu * naglowek.wysokosc_obrazu;
+ IF (maxavail < Size) THEN
+  BEGIN
+   close (plik);
+   exit;
+  END;
+ getmem (Handler, Size);
+ licznik := naglowek.szerokosc_obrazu;
+
+ FOR licznik_odczytu := naglowek.wysokosc_obrazu - 1 downto 0 do
+ BEGIN
+  blockread (plik, Handler^ [(licznik_odczytu) * (Width)], licznik, wynik);
+  IF Width MOD 4 <> 0 THEN Seek(plik,FilePos (plik) + (4 - Width MOD 4));
+ END;
+
+ close (plik);
+ Use := True;
+ OldLoadBMP := True;
+END;}
+
+PROCEDURE PaletteBMPToRGB (PaletteBMP : TPaletteBMP ; Var Palette : TPalette);
+BEGIN
+   FOR I := 0 to 255 do
+   BEGIN
+     Palette [I]. R := PaletteBMP [I]. R shr 2;
+     Palette [I]. G := PaletteBMP [I]. G shr 2;
+     Palette [I]. B := PaletteBMP [I]. B shr 2;
+   END;
+END;
+
+PROCEDURE PaletteRGBtoBMP (Palette : TPalette ; Var PaletteBMP : TPaletteBMP);
+BEGIN
+   FOR I := 0 to 255 do
+   BEGIN
+     PaletteBMP [I]. R := Palette [I]. R shl 2;
+     PaletteBMP [I]. G := Palette [I]. G shl 2;
+     PaletteBMP [I]. B := Palette [I]. B shl 2;
+   END;
+END;
+
+FUNCTION LoadHandleBMP (FileName : String; Var HandleBMP : THandleBMP) : Boolean;
+BEGIN
+  LoadHandleBMP := FALSE;
+  Assign (Plik, FileName);
+  {$I-}
+  Reset (Plik, 1);
+  {$I+}
+  If (IOResult <> 0) then EXIT;
+  BlockRead (Plik, HandleBMP, SizeOf (HandleBMP));
+  Close (Plik);
+
+{  UNLOAD13H;
+    Writeln ('HandleBMP. FWidth = ',HandleBMP. FWidth);
+    Writeln ('HandleBMP. FHeight = ',HandleBMP. FHeight);
+    Writeln ('HandleBMP. FBitPerPixel = ',HandleBMP. FBitPerPixel);
+    Writeln ('HandleBMP. FCompression = ',HandleBMP. FCompression);
+    ReadLn;
+  LOAD13H;}
+
+  If (HandleBMP. FWidth > 320) then EXIT;
+  If (HandleBMP. FHeight > 200) then EXIT;
+  If (HandleBMP. FBitPerPixel <> 8) and
+     (HandleBMP. FBitPerPixel <> 24) then EXIT;
+  If (HandleBMP. FCompression <> 0) then EXIT;
+  LoadHandleBMP := TRUE;
+END;
+
+FUNCTION TImage.LoadBMP (FileName : string ; LoadPalette : Boolean) : Boolean;
+VAR
+ HandleBMP : THandleBMP;
+ Palette : TPalette;
+ PaletteBMP : TPaletteBMP;
+ Temp : Array [0 .. (320 * 3) - 1] of Byte;
+ I2 : Integer;
+BEGIN
+ LoadBMP := FALSE;
+ If (NOT LoadHandleBMP (FileName,HandleBMP)) then EXIT;
+ If (Use) then Unload;
+ Assign (Plik, FileName);
+ {$I-}
+ Reset  (Plik, 1);
+ {$I+}
+ If (IOResult <> 0) then EXIT;
+ Width := HandleBMP. FWidth;
+ Height  := HandleBMP. FHeight;
+ Size   := Width * Height;
+ IF (MaxAvail < Size) THEN
+ BEGIN
+   Close (Plik);
+   EXIT;
+ END;
+ CASE HandleBMP. FBitPerPixel OF
+ 8  : BEGIN
+        GetMem (Handler,Size);
+        IF (LoadPalette) THEN
+        BEGIN
+          Seek (Plik, 54);
+          BlockRead (Plik,PaletteBMP,1024);
+          PaletteBMPToRGB (PaletteBMP,Palette);
+        END;
+        Seek (Plik, 1078);
+        FOR I := Height - 1 downto 0 do
+        BEGIN
+          BlockRead (Plik, Handler^ [I * Width], Width);
+          IF (Width MOD 4) <> 0 THEN Seek (Plik,FilePos (Plik) + (4 - Width MOD 4));
+        END;
+      END;
+   ELSE
+   BEGIN
+     Close (plik);
+     EXIT;
+   END;
+ END;
+ Close (plik);
+ Use := True;
+ LoadBMP := True;
+END;
+
+PROCEDURE LoadBMPPalette (sciezka : string);
+VAR
+ plik : file;
+ paleta_BMP : array [0..255] of record
+                                 b : byte;
+                                 g : byte;
+                                 r : byte;
+                                 z : byte;
+                                END;
+ licznik,wynik : word;
+BEGIN
+ assign (plik, sciezka);
+ reset  (plik, 1);
+ seek   (plik, sizeof (THandleBMP));
+ licznik := sizeof (paleta_BMP);
+ blockread (plik, paleta_BMP, licznik, wynik);
+ port [$3c8] := 0;
+ FOR licznik := 0 to 255 do
+ BEGIN
+  port[$3c9] := paleta_BMP [licznik].r shr 2;
+  port[$3c9] := paleta_BMP [licznik].g shr 2;
+  port[$3c9] := paleta_BMP [licznik].b shr 2;
+ END;
+ close (plik);
+END;
+
+PROCEDURE TImage.XY (X,Y : integer);
+VAR
+ LicznikX,LicznikY : word;
+ { dodatkowe zmienne do asma }
+ PrzesBuforu,PrzesEkranu : word;
+BEGIN
+{ ASM
+
+   mov ax, use
+   cmp ax, 0
+   jne @end
+
+   mov ax, y
+   mov przesekranu, 320
+   mul przesekranu
+   mov przesekranu, ax
+   mov ax, x
+   add przesekranu, ax
+
+   mov przesbuforu, 0
+
+   mov cx, height
+   @petla:
+     push cx
+     push ds
+
+     mov ax, height
+     sub ax, cx
+
+     les di, bufor
+     add di, przesbuforu
+
+     mov ax, seg handler
+     mov ds, ax
+     mov si, offset handler
+     add si, przesekranu
+
+     mov cx, width
+
+     cld
+     rep movsb
+
+     add przesekranu, 320
+     sub przesekranu, width
+
+     pop cx
+     pop ds
+   loop @petla
+
+   @end:
+ END;
+ EXIT;}
+
+ If (not Use) then Exit;
+ FOR LicznikY := 0 to Height - 1 do
+ FOR LicznikX := 0 to Width - 1 do
+ BEGIN
+   PutPixel (X + LicznikX,Y + LicznikY,Handler^ [(LicznikY * (Width)) + LicznikX]);
+ END;
+END;
+
+PROCEDURE TImage.XYV (X,Y : integer);
+VAR
+ LicznikX,LicznikY : word;
+ { dodatkowe zmienne do asma }
+ PrzesBuforu,PrzesEkranu : word;
+ Visible : Boolean;
+BEGIN
+ If (not Use) then Exit;
+ FOR LicznikY := 0 to Height - 1 do
+ FOR LicznikX := 0 to Width - 1 do
+ BEGIN
+   If (Visible) then
+   Begin
+     PutPixel (X + LicznikX,Y + LicznikY,Handler^ [(LicznikY * (Width)) + LicznikX]);
+     Visible := False
+   End
+   Else
+     Visible := True;
+   If (Width mod 2 = 0) and (LicznikX = Width - 1) then
+   If (Visible) then Visible := False else Visible := True;
+ END;
+END;
+
+PROCEDURE TImage.XYT (x,y : integer ; TransparentColor : byte);
+ VAR
+  LicznikX,LicznikY : longint;
+BEGIN
+ If (not Use) then Exit;
+ FOR LicznikY := 0 to Height - 1 do
+ FOR LicznikX := 0 to Width - 1 do
+ BEGIN
+   If (Handler^ [(LicznikY * (Width)) + LicznikX] <> TransparentColor) then
+     PutPixel (X + LicznikX,Y + LicznikY,Handler^ [(LicznikY * (Width)) + LicznikX]);
+ END;
+END;
+
+PROCEDURE TImage.Unload;
+BEGIN
+ If (not Use) then Exit;
+ FreeMem (Handler,Size);
+ Width := 0;
+ Height  := 0;
+ Size   := 0;
+ Use := False;
+END;
+
+{
+###############################
+Koniec modulu M_13H.
+Masz jakies uwagi lub pytania ?
+Pisz : pt_k@wp.pl
+###############################
+}
+
+BEGIN
+ Screen := Ptr ($A000,0);
+ SetBufor (Screen);
+END.
\ No newline at end of file
diff --git a/poprecog/record/M_XMS.PAS b/poprecog/record/M_XMS.PAS
new file mode 100644
index 0000000..0947516
--- /dev/null
+++ b/poprecog/record/M_XMS.PAS
@@ -0,0 +1,215 @@
+(*
+  XMS library
+  
+  Author   : Piotr Kochanek
+  WWW site : www.pop2.princed.com.ar
+*)
+
+UNIT M_XMS;
+
+INTERFACE
+Var
+ XMSError : Byte;
+
+{ // Czy pamiec XMS istnieje ? }
+FUNCTION XMSFind : Boolean;
+{ // Funkcja zwraca adres programu XMM }
+FUNCTION XMSGetAddress : Pointer;
+{ // Zwraca wersje sterownika XMM }
+FUNCTION XMSVersion : Word;
+{ // Funkcja inicjujaca modul i spraqdzajaca czy wszystko OK }
+FUNCTION XMSSetup : Boolean;
+{ // Funkcja zwraca ilosc wolnej pamieci XMS w KB }
+FUNCTION XMSMemAvail : Word;
+{ // Funkcja zwraca wielkosc najwiekszego bloku pamieci XMS w KB }
+FUNCTION XMSMaxAvail : Word;
+{ // Funkcja alokuje pamiec XMS }
+FUNCTION XMSGetMem (Var Handler : Word ; Size : Word) : Boolean;
+{ // Zmienia rozmiar pamieci XMS pod wybranym uchwytem }
+FUNCTION XMSReGetMem (Handler : Word ; Size : Word) : Boolean;
+{ // Funkcja usuwa pamiec XMS }
+FUNCTION XMSFreeMem (Handler : Word) : Boolean;
+{ // Funkcja kopiuje bajty do/z pamieci XMS }
+FUNCTION XMSMoveMem (SrcHandler : Word ; SrcOffset : Pointer ;
+                     DstHandler : Word ; DstOffset : Pointer ; Size : Longint) : Boolean;
+
+IMPLEMENTATION
+VAR
+ { // Adres sterownika pamieci XMS }
+ XMSAddress : Pointer;
+ { // Rekord potrzebny przy przesylaniu pamieci }
+ XMSBlockInfo :
+   RECORD
+     Length : Longint;
+     SourceHandler : Word;
+     SourceOffset : Pointer;
+     DestinationHandler : Word;
+     DestinationOffset : Pointer;
+   END;
+
+(*
+  Funkcja sprawdza czy istnieje pamiec XMS
+*)
+FUNCTION XMSFind : Boolean;
+BEGIN
+ ASM
+   mov ax, $4300
+   int $2f
+   mov @result, FALSE
+   cmp al, $80
+   jne @end
+   mov @result, TRUE
+   @end:
+ END;
+END;
+
+(*
+  Zwraca adres sterownika pamieci XMS
+*)
+FUNCTION XMSGetAddress : Pointer;
+VAR
+ XMSSeg : Word;
+ XMSOfs : Word;
+BEGIN
+ ASM
+   mov ax, $4310
+   int $2f
+   mov XMSSeg, es
+   mov XMSOfs, bx
+ END;
+ XMSGetAddress := Ptr (XMSSeg,XMSOfs);
+END;
+
+(*
+  Zwraca wersje sterownika pamieci XMS
+*)
+FUNCTION XMSVersion : Word;
+BEGIN
+ ASM
+   mov ax, $0000
+   call [XMSAddress]
+   mov @result, ax
+ END;
+END;
+
+(*
+  Sprawdza czy mozna uzywac pamiec XMS
+*)
+FUNCTION XMSSetup : Boolean;
+BEGIN
+ XMSSetup := TRUE;
+ IF (XMSFind)
+   THEN XMSAddress := XMSGetAddress
+   ELSE XMSSetup := FALSE;
+END;
+
+(*
+  Zwraca ilosc wolnej pamieci XMS w KB
+*)
+FUNCTION XMSMemAvail : Word;
+BEGIN
+ ASM
+   mov ax, $0800
+   call [XMSAddress]
+   mov @result, dx
+ END;
+END;
+
+(*
+  Zwraca wielkosc najwiekszego wolnego bloku w KB
+*)
+FUNCTION XMSMaxAvail : Word;
+BEGIN
+ ASM
+   mov ax, $0800
+   call [XMSAddress]
+   mov @result, ax
+ END;
+END;
+
+FUNCTION XMSGetMem (Var Handler : Word ; Size : Word) : Boolean;
+BEGIN
+ ASM
+   mov @result, TRUE
+   mov ax, $0900
+   mov dx, Size
+   call [XMSAddress]
+   les di, Handler
+   mov [es:di], dx
+   cmp ax, 1
+   je @end
+   mov XMSError, bl
+   mov @result, FALSE
+   @end:
+ END;
+END;
+
+FUNCTION XMSReGetMem (Handler : Word ; Size : Word) : Boolean;
+BEGIN
+ ASM
+   mov @result, TRUE
+   mov ax, $0f00
+   mov bx, Size
+   mov dx, Handler
+   call [XMSAddress]
+   cmp al, 1
+   je @end
+   mov XMSError, bl
+   mov @result, FALSE
+   @end:
+ END;
+END;
+
+FUNCTION XMSFreeMem (Handler : Word) : Boolean;
+BEGIN
+ ASM
+   mov @result, TRUE
+   mov ax, $0a00
+   mov dx, Handler
+   call [XMSAddress]
+   cmp ax, 1
+   je @end
+   mov XMSError, bl
+   mov @result, FALSE
+   @end:
+ END;
+END;
+
+FUNCTION XMSMoveMem (SrcHandler : Word ; SrcOffset : Pointer ;
+                     DstHandler : Word ; DstOffset : Pointer ; Size : Longint) : Boolean;
+BEGIN
+ WITH XMSBlockInfo DO
+ BEGIN
+   Length := Size;
+   SourceHandler := SrcHandler;
+   SourceOffset := SrcOffset;
+   DestinationHandler := DstHandler;
+   DestinationOffset := DstOffset;
+ END;
+ ASM
+   mov @result, TRUE
+   mov ax, seg XMSBlockInfo
+   mov ds, ax
+   mov si, offset XMSBlockInfo
+   mov ax, $0b00
+   call [XMSAddress]
+   cmp ax, 1
+   je @end
+   mov XMSError, bl
+   mov @result, FALSE
+   @end:
+ END;
+END;
+
+FUNCTION XMSGetError (Error : Byte) : String;
+VAR
+ ErrorInfo : String;
+BEGIN
+ CASE Error OF
+  $80 : ErrorInfo := '';
+ END;
+END;
+
+BEGIN
+
+END.
diff --git a/poprecog/record/READ.TXT b/poprecog/record/READ.TXT
new file mode 100644
index 0000000..5f74fa2
--- /dev/null
+++ b/poprecog/record/READ.TXT
@@ -0,0 +1,36 @@
+RECORD README FILE
+
+Q : What can I do with this program ?
+A : This program can capture tha animation from a game. After finish the game, it create as many bmp files as there was recorded frames.
+
+
+Q : What should i have, to create own animation (for example in gif file) ?
+A : You should have :
+    - game (which You want to record) :)
+    - record program (that You have downloaded) :)
+    - any program that can link *.bmp files into one file (gif, avi etc.). For example Animation Shop in Paint Shop Pro.
+    - that's all :).
+    Next question please ...
+
+
+Q : What kinds of game (or programs) can i record ?
+A : This program can record only games (or programs) that are running in 13h mode.
+    What's 13h mode ? This is very old graphic mode that have 320 * 200 resolution and displays 256 colors max.
+    Some of games that are running in that mode are : Prince of Persia 1 & 2, Liero, Dangerous Dave and much, much more :)
+
+
+Q : How to record game ?
+A : It's very easy. Create in notepad file start.bat which has : "record game.exe parameters". Game.exe is the name of file to execute. Parameters are optional. For example, if you want to record Prince of Persia 1 with cheats, write in this file : "record prince.exe magahit". After that, run this file. The game should start. 
+The function keys are :
+F11 - Start recording
+F12 - Stop recording
+F10 - Single screenshot
+F9  - View Bufor Status
+After finish playing, confirm to save bmp files. This can take few minutes.
+
+Q : After few minutes (or seconds) i hear recurrent, noisy voices from PC Speaker.
+A : Your recording bufor is overcrowded or You have running program that it isn't in 13h mode.
+
+
+Q : When i run record program, it's display an error, that i haven't mouse !
+A : Don't run the program in the DOS mode :)
\ No newline at end of file
diff --git a/poprecog/record/record.pas b/poprecog/record/record.pas
new file mode 100644
index 0000000..366f20a
--- /dev/null
+++ b/poprecog/record/record.pas
@@ -0,0 +1,420 @@
+(*
+  RECORDer source file
+
+  Author   : Piotr Kochanek
+  WWW site : www.pop2.princed.com.ar
+
+  This software can capture an animation from 13h games (320 * 200 and 256 colors).
+  After finish playing the game, it create as many bmp files as there was recorded frames.
+  Then, with for example Animation Shop (Paint Shop Pro), You can link this files into one file (gif, avi, etc).
+*)
+
+PROGRAM SCREEN_RECORDER;
+
+USES
+ CRT, {!!!}
+ DOS,
+ HEAPMAN,
+ GRAPH13H,
+ M_XMS;
+VAR
+ OPT :
+   RECORD
+     ProgramPath : String;
+     ProgramParameters : String;
+     StartAtBegin : Boolean;
+     {SkipSecFrame : Boolean;}
+
+     UseMouse : Boolean;
+     UseF9F12 : Boolean;
+     UseCtrl : Boolean;
+
+     UsePCSpeaker : Boolean;
+     DelDuplicateFrames : Boolean;
+     FilePrefix : String;
+   END;
+
+{ MButton : Byte;
+ MLButton : Byte;
+ MTime : Word;}
+
+ KPress : Byte;
+ LKPress : Byte;
+ AltPressed : Boolean;
+ MButton : Byte;
+ MouseButtonPressed : Boolean;
+
+ B : Byte;
+ REC : Byte;
+ W : Word;
+ I,
+ J : Integer;
+ Bool : Boolean;
+ AnimationHandle : array [0..19] of Word;
+ ActualBufor : Byte;
+ FramePalette : TPalette;
+ FramePaletteBMP : TPaletteBMP;
+ Old1Ch : Pointer;
+ ActualFrame : Longint;
+ ActualSaveFrame : Longint;
+ ActualXMSFrame : Longint;
+ MaxFrames : Longint;
+ TotalFrames : Longint;
+ OutputFile : File;
+ BMPHandle : THandleBMP;
+ FileName : String;
+ Line : Array [0..319] of Byte;
+ Line2 : Array [0..319] of Byte;
+ STOP : BOOLEAN;
+ Tmp : Longint;
+ Nr : Longint;
+
+PROCEDURE ERROR (Description : String ; HaltProgram : Boolean);
+BEGIN
+  If (HaltProgram) then
+  Begin
+    Writeln ('ERROR : ' + Description);
+    Halt;
+  End
+  Else
+  Begin
+    Writeln ('WARNING : ' + Description);
+    Writeln;
+  End;
+END;
+
+PROCEDURE S (Snd, Del : Word);
+BEGIN
+  If (OPT. UsePCSpeaker) then
+  Begin
+    Sound (Snd);
+    Delay (Del);
+    NoSound;
+  End;
+END;
+
+FUNCTION IntToStr (liczba : longint) : string;
+VAR
+ tekst : string;
+BEGIN
+ str (liczba,tekst);
+ IntToStr := tekst;
+END;
+
+FUNCTION YN (Text : string) : BOOLEAN;
+VAR Kl : Char;
+BEGIN
+  While (Keypressed) do Readkey;
+  YN := FALSE;
+  Write (Text,' (Y/N)? ');
+  REPEAT
+    Kl := Readkey;
+  UNTIL (Kl = #121) OR (Kl = #89) OR (Kl = #13) OR (Kl = #110) OR (Kl = #78) OR (Kl = #27);
+  IF (Kl = #121) OR (Kl = #89) OR (Kl = #13) THEN
+  BEGIN
+    Writeln ('Y');
+    YN := TRUE;
+  END
+  ELSE
+    Writeln ('N');
+END;
+
+PROCEDURE ProgramEnd;
+BEGIN
+  For I := 0 to 19 do
+  Begin
+    If (I * 1035 >= MaxFrames) then Exit;
+    If (not XMSFreeMem (AnimationHandle [I])) then Error ('Error while freeing XMS memory',False);
+  End;
+
+  Halt;
+END;
+
+PROCEDURE PrerareToRecord;
+BEGIN
+  Writeln ('13h Screen Recorder version 2.0 beta [2003/12/23]');
+  Writeln ('Copyright by Peter_K { asm3@o2.pl }');
+  Writeln ('Check for the latest version at www.princed.com.ar');
+  Writeln;
+  Writeln ('! Before do anything please read READ.txt file !');
+  Writeln;
+
+(* checking for XMS Memory *)
+  If (NOT XMSSetup) then Error ('XMS not found',True);
+  If (XMSMemAvail < 1000) then Error ('To little XMS memory',True);
+  If (XMSMemAvail < 6000) then Error ('You haven"t too much XMS memory',False);
+
+  For I := 0 to 19 do
+  Begin
+    Tmp := XMSMemAvail;
+    If (NOT XMSGetMem (AnimationHandle [I],Tmp)) then Break;
+    MaxFrames := MaxFrames + ((1024 * Tmp) div 64768) - 1; { = 1 GB }
+  End;
+
+(* info about memory *)
+  Writeln ('Size of XMS bufor  : ',MaxFrames,' [frames]');
+  Writeln ('Max recording time : ',MaxFrames div 1110,' min. ( ',MaxFrames div 18,' sec. ).');
+  Writeln;
+
+(* setting additional options *)
+  {OPT. SkipSecFrame := True;}
+  OPT. StartAtBegin := False;
+  OPT. UsePCSpeaker := True;
+  OPT. DelDuplicateFrames := False;
+
+{  If (YN ('Advenced settings ?')) then
+  Begin}
+  Write('Type program name to exec (with .exe !) : ');
+  Readln(OPT. ProgramPath);
+  Write('Type program parameters: ');
+  Readln(OPT. ProgramParameters);
+  Write('Type prefix for BMP files (maximum 3 signs): ');
+  Readln(OPT. FilePrefix);
+  OPT. UseMouse := YN ('Use mouse?');
+  OPT. UseF9F12 := YN ('Use keys F9 - F12?');
+  OPT. UseCtrl := YN ('Use ctrl key?');
+  {OPT. SkipSecFrame := FALSE;{YN ('Skip seconds frames - 2x more time and increase speed');}
+  OPT. StartAtBegin := YN ('Start recording at beginning');
+  OPT. UsePCSpeaker := YN ('Use PC Speaker');
+  OPT. DelDuplicateFrames := YN ('Delete duplicate frames');
+{  End;}
+  If (OPT. StartAtBegin) Then
+    REC := 2
+  Else
+    REC := 0;
+END;
+
+PROCEDURE SaveScreen; INTERRUPT;
+BEGIN
+  If (STOP) or (GetVideoMode <> $13) or (TotalFrames >= MaxFrames) then Begin S (200,100); Exit; End;
+
+  STOP := TRUE;
+
+  If (REC = 1) Then Rec := 0;
+
+  If ((OPT. UseF9F12) OR (OPT. UseCtrl)) Then
+  Begin
+    {LKPress := KPress;}
+    KPress := port[$60];
+    If (KPress = $57) then Rec := 2;
+    If (KPress = $58) then Rec := 0;
+    {If (LKPress = 56) then Rec := False;}
+    If (KPress = 56) then
+    BEGIN
+      if (NOT AltPressed) then Rec := 1;
+      AltPressed := TRUE;
+    END
+    ELSE
+      AltPressed := FALSE;
+    If (KPress = $43) then
+    Begin
+      Graph13h.RectangleFilled (200,0,300,5,Graph13h.Color (63,63,63));
+      Case REC Of
+        0 : Graph13h.RectangleFilled (200,0,200 + ((TotalFrames * 100) div MaxFrames),5,Graph13h.Color (63,0,0));
+        1 : Graph13h.RectangleFilled (200,0,200 + ((TotalFrames * 100) div MaxFrames),5,Graph13h.Color (0,63,0));
+        2 : Graph13h.RectangleFilled (200,0,200 + ((TotalFrames * 100) div MaxFrames),5,Graph13h.Color (0,63,0));
+      End;
+    End;
+  End;
+
+{  If (OPT. UseMouse) then
+  Begin
+    MLButton := MButton;
+    MButton := MouseButton;
+    If (MButton = 1) Then
+    Begin
+      If (NOT MouseButtonPressed) Rec := 1;
+      MouseButtonPressed := TRUE;
+    End
+    Else
+      MouseButtonPressed := FALSE:
+    If (MButton = 2) Then Rec := 1;
+    If (MButton = 4) AND (MLButton <> 4) Then Rec := True;
+    If (MLButton = 4) AND (MButton <> 1) Then Rec := False;
+  End;}
+
+  ActualBufor := TotalFrames div 1035;
+  ActualXMSFrame := TotalFrames mod 1035;
+
+  IF (REC > 0) THEN
+  BEGIN
+    {If (TotalFrames mod 20 = 0) Then Begin S (600,2); End;}
+    SavePalette (FramePalette);
+    XMSMoveMem (0,@FramePalette,AnimationHandle [ActualBufor],Pointer (ActualXMSFrame * 64768),768);
+    XMSMoveMem (0,Screen,AnimationHandle [ActualBufor],Pointer ((ActualXMSFrame * 64768) + 768),64000);
+    Inc (TotalFrames);
+    Inc (ActualXMSFrame);
+  END;
+
+{  If (NOT REC) OR (MouseButton = 2) then
+  Begin
+    Graph13h.RectangleFilled (200,0,300,5,Graph13h.Color (63,63,63));
+    Graph13h.RectangleFilled (200,0,200 + ((TotalFrames * 100) div MaxFrames),5,Graph13h.Color (0,63,0));
+    Graph13h.RectangleFilled (200 + TotalFrames mod 100,0,201 + (TotalFrames mod 100),5,Graph13h.Color (63,0,0));
+  End;}
+
+  Inc (Nr);
+
+  STOP := FALSE;
+END;
+
+PROCEDURE ExecuteProgram;
+BEGIN
+  Writeln ('Hit any key to execute program ...');
+  While (Keypressed) do Readkey;
+  Readkey;
+
+  GetIntVec ($1C,Old1Ch);
+  SetIntVec ($1C,@SaveScreen);
+
+  If (Execute (OPT.ProgramPath,OPT.ProgramParameters) <> 0) then
+  Begin
+    SetIntVec ($1C,Old1Ch);
+    Error ('Cannot execute file ' + OPT. ProgramPath,False);
+    ProgramEnd;
+  End;
+
+  SetIntVec ($1C,Old1Ch);
+
+  Writeln ('Recording finished succesfull');
+  Writeln ('Total frames         : ',TotalFrames);
+  Writeln ('BMPs size after save : ',(TotalFrames * 65078) div 1048576,' MB');
+  Writeln;
+END;
+
+{PROCEDURE ViewAnimation;
+BEGIN
+  If (TotalFrames = 0) then Exit;
+  Load13h;
+  SetBufor (Bufor);
+  ActualFrame := 0;
+  REPEAT
+    If (OPT.SavePalette) then
+    Begin
+      XMSMoveMem (AnimationHandle,Pointer (ActualFrame * 64768),0,@FramePalette,SizeOf (FramePalette));
+      LoadPalette (FramePalette);
+    End;
+    XMSMoveMem (AnimationHandle,Pointer ((ActualFrame * 64768) + SizeOf (FramePalette)),0,Bufor,64000);
+    ShowBufor (Bufor);
+    Inc (ActualFrame);
+    Delay (100);
+    If (OPT.LoopAnimation) and (ActualFrame = TotalFrames) then ActualFrame := 0;
+  UNTIL (ActualFrame = TotalFrames) OR (Keypressed);
+  Unload13h;
+END;}
+
+PROCEDURE SaveAnimation;
+VAR
+  LastBufor : Byte;
+  LastXMSFrame : Longint;
+BEGIN
+  {If (NOT YN ('Save bitmaps files')) Then If (YN ('Are You SURE')) Then Exit;
+  OPT. DelDuplicateFrames := YN ('Delete duplicate frames');}
+
+  {$I-}
+  MkDir ('frames');
+  {$I+}
+  If (IOResult <> 0) then begin end;
+
+  New (Bufor);
+
+  BMPHandle.FType := $4D42;
+  BMPHandle.FSize := 65078;
+  BMPHandle.FReserved1 := 0;
+  BMPHandle.FReserved2 := 0;
+  BMPHandle.FFirstPixel := 1078;
+  BMPHandle.FInfoSize := 40;
+  BMPHandle.FWidth := 320;
+  BMPHandle.FHeight := 200;
+  BMPHandle.FPlanes := 1;
+  BMPHandle.FBitPerPixel := 8;
+  BMPHandle.FCompression := 0;
+  BMPHandle.FImageSize := 64000;
+  BMPHandle.FDPIWidth := 3937;
+  BMPHandle.FDPIHeight := 3937;
+  BMPHandle.FColorUsed := 0;
+  BMPHandle.FImportantColor := 0;
+
+  ActualSaveFrame := 0;
+  For ActualFrame := 0 to (TotalFrames - 1) do
+  Begin
+    { for skipping the same frames }
+    LastBufor := ActualBufor;
+    LastXMSFrame := ActualXMSFrame;
+    { ... }
+    ActualBufor := ActualFrame div 1035;
+    ActualXMSFrame := ActualFrame mod 1035;
+
+    { for skipping the same frames }
+    If (OPT. DelDuplicateFrames) and (ActualFrame > 0) then
+    Begin
+      Bool := False;
+      For I := 0 to 199 do
+      Begin
+        XMSMoveMem (AnimationHandle [LastBufor],Pointer ((LastXMSFrame * 64768) + (I * 320) + SizeOf (FramePalette)),
+                    0,Addr (Line),320);
+        XMSMoveMem (AnimationHandle [ActualBufor],Pointer ((ActualXMSFrame * 64768) + (I * 320) + SizeOf (FramePalette)),
+                    0,Addr (Line2),320);
+        For J := 0 to 319 do
+        If (Line [J] <> Line2 [J]) then
+        Begin
+          Bool := True;
+          Break;
+        End;
+        If (Bool) then Break;
+      End;
+      If (NOT Bool) then
+        Continue;
+    End;
+    { ... }
+
+    Inc(ActualSaveFrame);
+    FileName := IntToStr (ActualSaveFrame);
+    While (Length (FileName) < 5) do FileName := '0' + FileName;
+    FileName := OPT.FilePrefix + FileName + '.bmp';
+    Assign (OutputFile,{OPT.SaveDir} + 'frames\' + FileName);
+    {$I-}
+    Rewrite (OutputFile, 1);
+    {$I+}
+    If (IOResult <> 0) then
+    Begin
+      Error ('Cannot save file ' + {OPT.SaveDir}'frames' + '\' + FileName,False);
+      Continue;
+    End;
+
+{    BlockRead (InputFile, FramePalette, 768);}
+    XMSMoveMem (AnimationHandle [ActualBufor],Pointer (ActualXMSFrame * 64768),0,@FramePalette,SizeOf (FramePalette));
+    PaletteRGBToBMP (FramePalette,FramePaletteBMP);
+
+{    BlockRead (InputFile, Bufor^, 64000);}
+    XMSMoveMem (AnimationHandle [ActualBufor],Pointer ((ActualXMSFrame * 64768) + SizeOf (FramePalette)),0,Bufor,64000);
+
+    BlockWrite (OutputFile,BMPHandle,SizeOf (BMPHandle));
+    BlockWrite (OutputFile,FramePaletteBMP,SizeOf (FramePaletteBMP));
+    FOR W:= 199 DOWNTO 0 DO
+    BEGIN
+      Move(Bufor^ [W * 320],Line,320);
+      BlockWrite(OutputFile,Line,320);
+    END;
+
+    Close (OutputFile);
+
+    GoToXY (1,WhereY);
+    Write (((ActualFrame + 1) * 100) div TotalFrames,'%, ( ',ActualFrame + 1,' frames )          ');
+  End;
+  Dispose (Bufor);
+
+  Writeln;
+  Writeln;
+  Writeln ('Frames now are stored in "frames" dir.');
+END;
+
+BEGIN
+  PrerareToRecord;
+
+  ExecuteProgram;
+
+  If (TotalFrames > 0) then SaveAnimation;
+
+  ProgramEnd;
+END.
\ No newline at end of file