Program BIOSCOPY Version 3

{ P_BIOS.PAS                                                         }
{                                                                    }
{ Soucast programu BIOSCOPY na kopirovani vadnych souboru z diskety  }
{ do aktualniho adresare.                                            }
{                                                                    }
{ Datum:21.06.2002                              http://www.trsek.com }
 
{$D-,E-,G+,I-,L-,N-,P+,Q-,R-,S-,T-,V-,Y- exe}
Unit P_Bios;
{
word v pameti n,v => w := n + v SHL 8;
x,y zacinaji od 0
 
Preruseni kurzoru
 
_VypniKurzor; nebo _ZapniKurzor;
...
_Kurzor(JeKurzor);
 
}
 
{Ptr.PAS}
 
{Vzorov˜ pŠĄklad pro funkci Ptr.}
 
{var P: ^Byte;
begin
  P := Ptr($40, $49);
  Writeln('Aktu lnĄm video re‘imem je ', P^);
end.}
 
 
Interface
Var
   PSloupcu : ^Word;
   PRadku,PScan{word?},PRezim:^Byte;
   PTime:^LongInt;
   MysX   	: Word;
   MysY   	: Word;
   MysCode	: Byte; {znak pod mysi}
   MysBarva	: Byte; {puvodni barva pod mysi}
Const
   Stranka: Byte = 0;  		{diky inicializaci vzdy v kodu}
   JeKurzor:Boolean = True;{diky inicializaci vzdy v kodu}
 
 
 {Nepouzite procedury nebudou v kodu!!!!}
 
{Paleta}
Procedure Blikani(Povolit:Boolean); {ega/vga}
Procedure SetTextPalette(num{0..15},r{0..3},g{0..3},b{0..3}:Byte); {ega/vga}
Procedure GetTextPalette(num{0..15}:Byte; var r{0..3},g{0..3},b{0..3}:Byte); {vga}
Procedure SetPalNumCol(num{0..15},col:Byte); {ega/vga}
Function  GetPalNum(num{0..15}:Byte):Byte;   {vga}
 
{Mouse}
Function  _MouseX:Word;
Function  _MouseY:Word;
Function  _LButton:Boolean;
Function  _RButton:Boolean;
Procedure _SmazMys;
Procedure _UkazMys;
Procedure _MoveMys;
 
{Kurzor}
Procedure _Kurzor(Zapnout:Boolean);  {meni JeKurzor}
Procedure _VypniKurzor; {JeKurzor nemeni}
Procedure _ZapniKurzor; {JeKurzor nemeni}
Function  WhereX:Byte;
Function  WhereY:Byte;
Procedure _Locate(x,y:Byte); {= GotoXY(x+1,y+1)}
 
{Text}
Procedure _PisACode(Barva,Znak:Byte); {Write pismena s kodem:znak a attributem:barva}
Procedure _PisXYACode(x,y,Barva,Znak:Byte);
Procedure _PisXYAString(x,y,Barva:Byte;Text:String); {vodorovne}
 
Procedure _CtiXYACode(x,y:Byte;Var Barva,Znak:Byte); {zjisti pismeno na obrazovce}
 
 
Procedure _Roluj(a:ShortInt); {Scrolluje nahoru|dolu obrazovou stranku:0}
Procedure _Font8x8;
Procedure _AktStr(a:Byte); {nastavi aktualni(viditelnou) stranku}
Procedure _Opis(ZdrojovaStranka,CilovaStranka:Byte);
 
{PC Speaker}
Procedure Sound(Hz:Word);
Procedure NoSound;
 
{Keyboard}
Function  KeyPressed:Boolean;
Function	 ReadKey:Char;
Procedure Pause;
 
{Time}
Procedure Delay(MS:Word);
Procedure DelayPeriod(Period: Word);
Procedure InitInterval(cas:word);
Procedure StopInterval;
 
{   Asm
      Push ds
      Push bp
      Pop bp
      Pop ds
   End;}
 
Implementation
Const ScanCode:Byte=0;
Var
SW97,SW66:Byte;
 
 
 
 
Procedure Blikani(Povolit:Boolean); {ega/vga} assembler;
Asm
	Mov	ah,$10
   Mov	al,$03
   Mov	bl,Povolit
   Int 10h
End;
 
 
Procedure SetTextPalette(num,r,g,b:Byte); {ega/vga}
Var
	Col:Byte;
Begin
   {ega, ne cga!}
   Col :=(r shr 1) shl 2 + (r and 1) shl 5 +
			(g shr 1) shl 1 + (g and 1) shl 4 +
         (b shr 1)       + (b and 1) shl 3;
   SetPalNumCol(num,col);
End;
 
 
Procedure GetTextPalette(num{0..15}:Byte; var r{0..3},g{0..3},b{0..3}:Byte); {vga}
Var
	Col:Byte;
Begin
	Col := GetPalNum(num);
   r := (Col And 4) Shr 1 + (Col And 32) Shr 5;
   g := (Col And 2)       + (Col And 16) Shr 4;
   b := (Col And 1) Shl 1 + (Col And  8) Shr 3;
End;
 
 
Procedure SetPalNumCol(num,col:Byte); Assembler; {ega/vga}
Asm
	{ah=10,al=0}
   mov	ax,$1000
   mov	bl,num
   mov	bh,col
   Int 10h
End;
 
 
Function GetPalNum(num:Byte):Byte; Assembler; {vga}
Asm
	{ah=10,al=0}
   mov	ax,$1007
   mov	bl,num
   Int	10h
   mov	al,bh
End;
 
 
 
Function _MouseX: word; assembler; asm mov ax,3; int $33; mov ax,cx; end;
 
Function _MouseY: word; assembler; asm mov ax,3; int $33; mov ax,dx; end;
 
Function _LButton: Boolean; assembler; asm mov ax,3; int $33; and bx,1; mov ax,bx;end;
 
Function _RButton: Boolean; assembler; asm mov ax,3; int $33; and bx,2;  mov ax,bx; shr ax, 1 end;
 
 
Procedure _SmazMys;
Begin
   _PisXYACode(MysX,MysY,MysBarva,MysCode);
End;
 
Procedure _UkazMys;
Begin
   _CtiXYACode(MysX,MysY,MysBarva,MysCode);
	_PisXYACode(MysX,MysY,38,MysCode);
End;
 
Procedure _MoveMys;
Var x,y:Word;
Begin
   IF PSloupcu^ < 80 Then
   Begin
		X := _MouseX Div 16;
	   IF PRadku^ > 24 Then Y := _MouseY Div 4 Else Y := _MouseY div 8;
   End
   Else
   Begin
      X := _MouseX Div 8;
      IF PRadku^ > 24 Then Y := _MouseY Div 4 Else Y := _MouseY div 8;
   End;
   {u > 24 to skace _MouseY po 8 a tak preskakuje o pismeno (v horni casti dvojpismena)}
   IF Not ((X = MysX) And (Y = MysY)) Then
   Begin
	   _SmazMys;
      MysX := x;
	   MysY := y;
	   _UkazMys;
   End;
End;
 
 
Procedure _Font8x8;
begin
   Asm
      push ds
      push bp
      mov ah, 17
      mov al, 18
      mov bl,  0
      int 10h
      pop bp
      pop ds
   End;
end;
 
 
 
Procedure _VypniKurzor; Assembler;
Asm
	mov ah,1
   mov cx,17*256+16
	Int 10h
End;
 
Procedure _ZapniKurzor; Assembler;
Asm
	mov ah,1
   mov cx,5*256+6
	Int 10h
End;
 
Procedure _Kurzor(Zapnout:Boolean);
Begin
   IF Zapnout then _ZapniKurzor Else _VypniKurzor;
   JeKurzor := Zapnout;
End;
 
 
 
Function WhereX:Byte; Assembler;
ASM
	mov ah,3
   mov bh,Stranka
   int 10h
   mov al,dl
END;
 
 
Function WhereY:Byte; Assembler;
ASM
	mov ah,3
   mov bh,Stranka
   int 10h
   mov al,dh
END;
 
 
Procedure _Locate(x,y:Byte);
{0=<x<=79,0=<y<=24}
begin
   asm
      Push ds
      Push bp
      Mov ah,02 {Cislo sluzby}
      Mov dl, x
      Mov dh, y
      Mov bh, Stranka
      Int 10h
      Pop bp
      Pop ds
   End;
end;
 
 
Procedure _Roluj(a:ShortInt);
Var ra :Word;
Begin
   IF a < 0 Then ra := 6*256 - a
	Else ra := 7*256 + a;
   Asm
      mov ax, ra
	   mov bh, 7
      mov ch, 0
      mov cl, 0
      mov dh, 49
      mov dl, 79
      Int 10h
   End;
End;
 
 
Procedure _PisACode(Barva,Znak:Byte);
Begin
   Asm
      Push ds
      Push bp
      Mov ah,09     {Cislo sluzby}
      Mov al, Znak  {ASCII kod}
      Mov bh, Stranka
      Mov bl, Barva {Atribut}
      Mov cx, 1     {Kolikrat}
      Int 10h
      Pop bp
      Pop ds
   End;
End;
 
 
Procedure _PisXYACode(x,y,Barva,Znak:Byte);
Begin
   asm
      push ds
      push bp
 
      mov ah, 02h     {cislo sluzby}
      mov dl, x
      mov dh, y
      mov bh, Stranka {locate}
      int 10h
 
      mov ah, 09h     {cislo sluzby}
      mov al, znak    {ASCII kod}
      {mov bh, Stranka   {Stranka}
      mov bl, barva   {atribut}
      mov cx, 1       {kolikrat}
      Int 10h
 
      pop bp
      pop ds
   End;
End;
 
 
Procedure _PisXYAString(x,y,Barva:Byte;Text:String); {vodorovne}
Var
Sum:Word;
TSeg,TOfs:Word;
Begin
   Sum := Length(Text);
   TSeg := Seg(Text);
   TOfs := Ofs(Text)+1;
   Asm
      Push Bp
 
      mov ah, 13h			{Cislo sluzby}
      mov al, 1         {- AL -}
                        {bit 0 = 0 - kurzor neni presouvan
                               = 1 - je presouvan
                         bit 1 = 0 - retezec obsahuje pouze znaky
                               = 1 - obsahuje i atributy}
      mov bl, Barva     {Atribut znaku pri AL = xxxxxx0?}
      mov bh, Stranka	{Stranka}
      mov dh, y
      mov dl, x
      mov cx, Sum			{Delka(bez atributu)}
      mov es, TSeg
      mov bp, TOfs
      int 10h
 
      Pop Bp
   End;
End;
 
 
 
Procedure _CtiXYACode(x,y:Byte;Var Barva,Znak:Byte);
Var z,b:Byte;
Begin
   _Locate(X,Y);
   ASM
	   Mov ah,$08
	   Mov bh,Stranka
	   Int $10
      Mov Z,al
      Mov B,ah
   end;
   Znak := Z;
   Barva:= B;
End;
 
 
Procedure _AktStr(a:Byte);
Begin
   Asm
      Push ds
      Push bp
      Mov ah, 05h {cislo sluzby}
      Mov al, a   {stranka}
      Int 10h
      Pop bp
      Pop ds
   End;
End;
 
 
Procedure _Opis(ZdrojovaStranka,CilovaStranka:Byte);
Var
	Puvodni,x,y,Barva,Znak:Byte;
Begin
   Puvodni := Stranka;
   For x := 0 To PSloupcu^ Do
   For y := 0 To PRadku^   Do
   Begin
      Stranka := ZdrojovaStranka;
   	_CtiXYACode(x,y,Barva,Znak);
      Stranka := CilovaStranka;
		_PisXYACode(x,y,Barva,Znak);
	End;
   Stranka := Puvodni;
End;
 
 
{Function KeyPressed:Boolean;
Begin
	KeyPressed := Mem[$0040:$001C] <> Mem[$0040:$001A];
End;
 
 
Function ReadKey:Char;
Var
   TextBuffer:array[30..61] of byte absolute $0040:$001E;
Begin
   Repeat Until KeyPressed;
   Mem[$0040:$001C] := Mem[$0040:$001C] - 2;
   ReadKey := CHR(TextBuffer[Mem[$0040:$001C]]);
End;
 
Procedure  Delay(MS: Word);
Begin
End;}
 
{; Start sound generator
 
ScanCode	DB	?}
 
Procedure Sound(Hz:Word); Assembler;
Asm
	MOV	BX,Hz
	MOV	AX,34DDH
	MOV	DX,0012H	{dx := 18; dx*2^16+ax = 1193181 Hz}
	CMP	DX,BX
	JNC	@Exit	   {if Hz < 18 then goto exit}
	DIV	BX	      {ax := (dx*2^16+ax) div bx;  dx := (dx*s^16+ax) mod bx}
	MOV	BX,AX
	IN	AL,61H	   {al := port[$61=97];}
	TEST	AL,3	   {jsou dolni 2 bity zaple?}
	JNZ	@Hraje   {kdyz speaker uz hraje skoc}
 
	OR	AL,3	      {nastav dolni 2 bity}
	OUT	61H,AL	{zapni zvuk}
	MOV	AL,0B6H
	OUT	43H,AL	{citac 2 je nastaven na: cteni/zapis 2 bytu, mod 3, binarne}
@Hraje:           {nastaveni frekvence}
   MOV	AL,BL	   {al := bl dolni byte}
	OUT	42H,AL	{port[$42] := al}
	MOV	AL,BH	   {al := bh horni byte}
	OUT	42H,AL	{port[$42] := al}
@Exit:
End;
 
 
Procedure NoSound; Assembler;
Asm
	IN 	AL,61H   {al := port[$61]}
	AND	AL,0FCH  {vynuluj dolni 2 bity}
	OUT	61H,AL	{Port[$61=97] := al}
End;
 
 
 
Function KeyPressed:Boolean; Assembler;
Asm
	CMP	ScanCode,0     {ZF := ((ScanCode AND 0) = 0)}
	JNE	@@1            {IF Not ZF 0 Then GOTO 1}
	MOV	AH,1           {AH := 1, INT 16h cte ale nevyjme z bufferu}
   INT	16H				{AL := ASCII kod znaku; AH := SCAN kod znaku; ZF = NeniStisk}
	MOV	AL,0           {AL := 0}
	JE		@@2				{IF ZF THEN GOTO 2}
@@1:MOV	AL,1				{AL := 1}
@@2:							{KeyPressed := AL}
End;
 
 
Function ReadKey:Char; Assembler;
Asm
	MOV	AL,ScanCode		{AL := ScanCode}
	MOV	ScanCode,0		{ScanCode := 0}
	OR		AL,AL				{ZF := ((AL OR AL) = 0)}
	JNE	@@1				{IF Not ZF THEN GOTO 1 Byla stisknuta klavesa s kodem 0, napr. F1}
	XOR	AH,AH				{AH := 0, INT 16h pak cte znak z klavesnice}
	INT	16H				{AL := ASCII kod znaku; AH := SCAN kod znaku}
	OR		AL,AL				{ZF := ((AL OR AL) = 0)}
	JNE	@@1				{IF Not ZF Then GOTO 1}
	MOV	ScanCode,AH		{ScanCode := AH ulozeno pro pristi pouziti}
	OR		AH,AH				{ZF := ((AH OR AH) = 0)}
	JNE	@@1				{IF Not ZF Then GOTO 1}
	MOV	AL,'C'-64		{AL := 3}
@@1:							{ReadKey := AL}
End;
 
 
 
Procedure Pause;
Begin
   While KeyPressed do ReadKey;
   Repeat Until KeyPressed;
   While KeyPressed do ReadKey;
End;
 
 
 
Procedure Delay(MS: Word);
{1193180 Hz / 1000 = 1193}
Var
X,TOld,TNew:LongInt;
COld,CNew:Word;
	Function CtiCitac:Word; Assembler;
	Asm
	   mov al,0D2h       ;{zpetne cteni citace 0}
	   out 43h,al
	   in al,40h	      ;{nizsi}
	   xchg al,ah
	   in al,40h	      ;{vyssi}
	   xchg al,ah
	End;
Begin
X    := 1193;
X    := X*MS + CtiCitac;
CNew := X mod 65536;
TNew := PTime^ + X div 65536;
Repeat
   TOld := PTime^;
   COld := CtiCitac;
Until (TNew < TOld) Or ((TNew = TOld) And (CNew <= COld));
End;
 
 
Procedure DelayPeriod(Period:Word);
Var T:LongInt;
Begin
	T := PTime^ + Period;
   While T >= PTime^ do;
End;
 
 
Procedure InitInterval(cas:word); Assembler;
{cas [sek] = cas/1193180}
Asm
{ulozeni rezimu citace 2}
   mov al,232
   out $43,al
   in  al,$42
   and al,$3f
   or  al,128
   mov SW66,al
{nastaveni citace 2 do modu 0 a cteni/zapis 2 bytu}
   mov al,176
   out $43,al
{ulozeni zvuku}
   in  al,$61
   mov SW97,al
{zapnuti gate}
   or  al,1
{vypnuti zvuku}
   and al,$fd
   out $61,al
{nastaveni hodnoty citace}
   mov ax,cas
	out $42,al
   mov al,ah
   out $42,al
End;
 
 
Procedure StopInterval; Assembler;
Asm
{zpetne cteni citace 2}
@1:
   mov al,232
   out $43,al
   in  al,$42
   and al,128
	jz  @1
{puvodni nastaveni citace 2}
   mov al,SW66
   out $43,al
{zapnuti zvuku}
   mov al,SW97
   out $61,al
End;
 
 
 
 
 
Begin
   {pocet sloupcu v textovem modu:  1..Sloupcu}
   PSloupcu := Ptr(Seg0040,$004A);
   {pocet radku v textovem modu: 0..Radku}
   PRadku  	:= Ptr(Seg0040,$0084);
   {video rezim}
   PRezim   := Ptr(Seg0040,$0049);
   {test ctrl,shift,alt...}
   PScan		:= Ptr(Seg0040,$0017);
   {cas}
   PTime    := Ptr(Seg0040,$006c);
 _Kurzor(True);
 _AktStr(Stranka);
End.