Game snake in VGA256 mode
Delphi & Pascal (èeská wiki)
Category: KMP (Club of young programmers)
Program: Sbmp.pas, Svga.pas, Zizala.pas
File exe: Zizala.exe
need: Svga256.bgi, Zizala.bmp
Program: Sbmp.pas, Svga.pas, Zizala.pasFile exe: Zizala.exe
need: Svga256.bgi, Zizala.bmp
Game snake in VGA256 mode.
{ 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.