{ 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= 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.