Delphi & Pascal (česká wiki)
{ SVGA.PAS Copyright (c) ... } { } { Unit pro hru zizala. Rutiny pro ovladani graficke karty v modu } { SVGA 256 barev. } { } { Author: Neznamy } { Date : 19.02.2020 http://www.trsek.com } unit Svga; interface uses Crt, Dos, Graph; type RGB_entry = record R, G, B: byte; end; RGB_palette = array [0..255] of RGB_entry; var reg : registers; PathToDriver : String; { Ukl d cestu ke grafick‚mu ovladaźi } Procedure Ukonceni; Procedure GetPalette(var nova_paleta: RGB_palette); Procedure SetPalette(var nova_paleta: RGB_palette); Procedure Otevri; Procedure StatusLine(Msg : string); implementation var GraphDriver : integer; { Ovladaź grafick‚ho zaýˇzenˇ } GraphMode : integer; { Grafickě m˘d} MaxX, MaxY : word; { Maxim lnˇ rozliçenˇ obrazovky } ErrorCode : integer; { Oznamuje jak‚koli grafick‚ chyby } MaxColor : word; { Maxim lnˇ poźet barev } OldExitProc : Pointer; { Ukl d adresu procedury Exit } SVGA256 : Integer; { ¬ˇslo 256 barevn‚ho ovladaźe } type VgaInfoBlock = record VESASignature: array[0..3] of Byte; VESAVersion: Word; OEMStringPtr: Pointer; Capabilities: array[0..3] of Byte; VideoModePtr: Pointer; end; const SVGA256Modes : array[0..2] of Word = ($0102, $0104, $0106); { Hled nejvyççˇ podporovan‚ rozliçenˇ t‚to karty } function GetHighestCap(Table: Pointer; Modes: Word; Size: Integer): Integer; near; assembler; asm XOR AX,AX LES DI, Table @@1: MOV SI, Modes ADD SI, Size ADD SI, Size MOV BX, ES:[DI] CMP BX, 0FFFFH JE @@4 INC DI INC DI MOV CX,Size @@2: CMP BX,[SI] JZ @@3 DEC SI DEC SI LOOP @@2 @@3: CMP AX,CX JA @@1 MOV AX,CX JMP @@1 @@4: end; {$IFDEF DPMI} type TRealRegs = record RealEDI: Longint; RealESI: Longint; RealEBP: Longint; Reserved: Longint; RealEBX: Longint; RealEDX: Longint; RealECX: Longint; RealEAX: Longint; RealFlags: Word; RealES: Word; RealDS: Word; RealFS: Word; RealGS: Word; RealIP: Word; RealCS: Word; RealSP: Word; RealSS: Word; end; function DetectSVGA256: Integer; far; assembler; var Segment, Selector, VesaCap: Word; asm {$IFOPT G+} PUSH 0000H PUSH 0100H {$ELSE} XOR AX,AX PUSH AX INC AH PUSH AX {$ENDIF} CALL GlobalDosAlloc MOV Segment,DX MOV Selector,AX MOV DI,OFFSET RealModeRegs MOV WORD PTR [DI].TRealRegs.RealSP, 0 MOV WORD PTR [DI].TRealRegs.RealSS, 0 MOV WORD PTR [DI].TRealRegs.RealEAX, 4F00H MOV WORD PTR [DI].TRealRegs.RealES, DX MOV WORD PTR [DI].TRealRegs.RealEDI, 0 MOV AX,DS MOV ES,AX MOV AX,0300H MOV BX,0010H XOR CX,CX INT 31H MOV DI,OFFSET RealModeRegs MOV AX,grError PUSH AX CMP WORD PTR [DI].TRealRegs.RealEAX,004FH JNZ @@Exit POP AX MOV ES,Selector XOR DI,DI CMP ES:[DI].VgaInfoBlock.VESASignature.Word[0], 'EV' JNZ @@Exit CMP ES:[DI].VgaInfoBlock.VESASignature.Word[2], 'AS' JNZ @@Exit MOV AX,0000 MOV CX,1 INT 31H MOV VesaCap,AX MOV DX,ES:[DI].VgaInfoBlock.VideoModePtr.Word[2] MOV CX,4 XOR AX,AX @@Convert: SHL DX,1 RCL AX,1 LOOP @@Convert ADD DX,ES:[DI].VgaInfoBlock.VideoModePtr.Word[0] ADC AX,0 MOV CX,AX MOV BX,VesaCap MOV AX,0007H INT 31H INC AX XOR CX,CX MOV DX,0FFFFH INT 31H MOV ES,BX PUSH ES PUSH DI {$IFOPT G+} PUSH OFFSET SVGA256Modes PUSH 0003H {$ELSE} MOV SI, OFFSET SVGA256Modes PUSH SI MOV AX, 5 PUSH AX {$ENDIF} CALL GetHighestCap PUSH AX MOV BX,VesaCap MOV AX,0001H INT 31H @@Exit: PUSH Selector CALL GlobalDosFree POP AX end; {$ELSE} function DetectSVGA256: Integer; far; assembler; var VesaInfo: array[0..255] of Byte; asm MOV AX,SS MOV ES,AX LEA DI,VesaInfo MOV AX,4F00H INT 10H CMP AX,004FH MOV AX,grError JNZ @@Exit CMP ES:[DI].VgaInfoBlock.VESASignature.Word[0], 'EV' JNZ @@Exit CMP ES:[DI].VgaInfoBlock.VESASignature.Word[2], 'AS' JNZ @@Exit LES DI,ES:[DI].VgaInfoBlock.VideoModePtr PUSH ES PUSH DI MOV AX, OFFSET SVGA256Modes PUSH AX MOV AX,3 PUSH AX CALL GetHighestCap @@Exit: end; {$ENDIF} {$F+} procedure Ukonceni; begin ExitProc := OldExitProc; { Obnovˇ adresu procedury Exit } CloseGraph; { Vypne grafickě syst‚m } end; { Ukonźenˇ } {$F-} procedure SetPalette (var nova_paleta: RGB_palette); begin with reg do begin ah := $10; al := $12; bx := 0; cx := 256; dx := ofs(nova_paleta); es := seg(nova_paleta); end; intr($10, reg); end; procedure GetPalette (var nova_paleta: RGB_palette); begin with reg do begin ah := $10; al := $17; bx := 0; cx := 255; dx := ofs(nova_paleta); es := seg(nova_paleta); end; intr($10, reg); end; procedure Otevri; { Inicializuje grafiku a oznamuje chyby, kter‚ mohou nastat } var InGraphicsMode : boolean; { Flags initialization of graphics mode } begin { when using Crt and graphics, turn off Crt's memory-mapped writes } DirectVideo := False; OldExitProc := ExitProc; { save previous exit proc } ExitProc := @Ukonceni; { insert our exit proc in chain } repeat SVGA256 := InstallUserDriver('SVGA256', @DetectSVGA256); {$IFDEF Use8514} { check for Use8514 $DEFINE } GraphDriver := IBM8514; GraphMode := IBM8514Hi; {$ELSE} GraphDriver := Detect; { pou§ij autodetekci } {$ENDIF} InitGraph(GraphDriver, GraphMode, PathToDriver); ErrorCode := GraphResult; { Naźte informace o chyb ch } if ErrorCode <> grOK then { Chyba? } begin Writeln('Graphics error: ', GraphErrorMsg(ErrorCode)); if ErrorCode = grFileNotFound then { Nemohu najˇt soubor s ovladaźem } begin Writeln('Napiste prosim celou cestu k ovladaci svga256.bgi'); WriteLn('<Ctrl-Break> pro ukonceni : '); Readln(PathToDriver); Writeln; end else Halt(1); { NŘjak‚ dalźˇ chyby: Ukonźi } end; until ErrorCode = grOK; MaxColor := GetMaxColor; { Naźˇt maxim lnˇ poźet kreslˇcˇch barev } MaxX := GetMaxX; { Naźˇt max. rozliçenˇ } MaxY := GetMaxY; end; { Otevri } procedure StatusLine(Msg : string); { Zobrazˇ spodnˇ ý dku s textem } begin SetTextStyle(DefaultFont, HorizDir, 1); SetTextJustify(CenterText, TopText); SetLineStyle(SolidLn, 0, NormWidth); SetFillStyle(EmptyFill, 0); Bar(0, MaxY-(TextHeight('M')+4), MaxX, MaxY); { Pýepˇçe starou ý dku } Rectangle(0, MaxY-(TextHeight('M')+4), MaxX, MaxY); OutTextXY(MaxX div 2, MaxY-(TextHeight('M')+2), Msg); end; { StatusLine } BEGIN END.