Hra ľíľala v grafickém provedení SVGA256

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategórie: KMP (Programy mladých programátorů)
zizala.pngProgram: Sbmp.pas,  Svga.pas,  Zizala.pas
Soubor exe: Zizala.exe
Potřebné: Svga256.bgi,  Zizala.bmp

Hra ľíľala v grafickém provedení SVGA256.
{ 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.