jr75312@tut.fi (Raisio Jukka Artturi) (12/11/90)
My first posting!
{ /****************************************************/ }
{ /* */ }
{ /* Hey I'm Jukka from Finnland, (I'm far from you) */ }
{ /* */ }
{ /* why T-pascal have "var" I "const" all */ }
{-----------------------------------------------------------------------}
{ }
{ I made this as reply for title "HOW TO READ VGA MEMORY ..." }
{ I suppose that this works with EGA and VGA display. (I have VGA) }
{ }
{-----------------------------------------------------------------------}
{ For Turbo Pascal only. }
PROGRAM Read_Write_EGA_VGA_256k_Card; {Guilty Jukka Raisio }
{mail jr75312.tut.fi }
USES GRAPH,
CRT;
TYPE To_gr_screen = ARRAY [0..65534] OF BYTE; {Almost all }
CONST GrScreen :^To_gr_screen =PTR($A000,0); {Grahics memory }
Color : BYTE =0;
Plane : BYTE =0; {Best way to }
Value_X : BYTE =0; {Create and }
Position : WORD =0; {initialize }
Counter : WORD =0; {variable is }
Error : BOOLEAN =FALSE; {const it. :-! }
GrDriver : INTEGER =0;
GrMode : INTEGER =0;
Str_path : STRING ='';
PROCEDURE Set_write_mask (X:BYTE); {Color p panes as binary }
BEGIN {Value of X in 0 to 15 }
PORT [$3C4] :=$02; {Writing multiple plane is easy }
PORT [$3C5] := X ; {Who want can do this in ASM }
END; {No flame about compatiply ! }
PROCEDURE Set_read_mask (X:BYTE); {Number of plane to show 0..3 }
BEGIN {Planes have to read one by one }
PORT [$3CE] :=$04; {Looks simple ... }
PORT [$3CF] := X ; {I tested my VGA comments EGA? }
END; {P.S. where is Palette ? }
BEGIN
GrDriver:=DETECT; {One way of setting up graphics }
InitGraph(GrDriver,GrMode,''); {Your EGAVGA.BGI file path }
IF GraphResult <>0 THEN BEGIN
WRITELN (' Hey gimme that EGAVGA.BGI -file !');
WRITELN (' f.ex your tp -directory');
READLN (Str_path);
GrDriver:=DETECT;
InitGraph(GrDriver,GrMode,Str_path);
IF GraphResult <>0 THEN BEGIN
WRITELN ('Can''t init graphics');
HALT;
END;
END;
FOR Color:=15 DOWNTO 0 DO BEGIN {Go thrue all colors }
Set_write_mask(Color); {Which planes in use }
FillChar(GrScreen^,SizeOf(GrScreen^),$FF); {Fill up memory }
Delay(200); {A Little delay }
FillChar(GrScreen^,SizeOf(GrScreen^),$00); {Clean up memory }
END;
Error :=FALSE; {Testing graphics memory read }
FOR Counter:=1 TO 1024 DO BEGIN {Test 4 times 1k random }
Position:=Random(20480); {Random testplace 20k }
Value_X:=Random(255)+1; {Random testvalue 1-255 }
Color:=Random(16); {Random color 0-15 }
Set_write_mask(Color);
GrScreen^[Position] :=Value_X;
{Test could be easier :-) }
FOR Plane:=0 TO 3 DO BEGIN
Set_read_mask(Plane); {Set read plane. }
IF (1 SHL Plane AND Color >0) XOR
(GrScreen^[Position] =Value_X) THEN
Error :=TRUE; {Dropping bits ? }
END;
DELAY(3); {On Screen for a while }
GrScreen^[Position] :=$00; {Line off }
END;
CloseGraph;
IF Error THEN WRITELN ('Something got wrong ?'#10)
ELSE WRITELN ('Just as it should be'#10);
END.
{-----------------------------------------------------------------------}
{ }
{ No copyright. Just let me know your best idea. Flames -> /dev/null }
{ }
{ Jukka Raisio Cards and so on will be read. }
{ Insinoorinkatu 60A16 Happy new year for you all. }
{ 33720 Tampere Waiting for tp6.0. }
{ FINNLAND Dreaming large SCSI. }
{ }
{--->8--cut here--8<-------->8--cut here--8<-------->8--cut here--8<----}
Problems I have seen meny times are graphics mouse cursor and keyboard.
Here is my second program.
---8<-------
PROGRAM Mouse_and_Keyboard_intr; {Guilty Jukka Raisio }
{mail jr75312.tut.fi }
USES DOS,CRT,Graph;
TYPE Cursor_type =ARRAY [1..32] OF WORD;
CONST Regs :REGISTERS =(AL:0;AH:0;BL:0;BH:0;
CL:0;CH:0;DL:0;DH:0);
Mouse_key :BOOLEAN =FALSE;
But1 :BOOLEAN =FALSE;
But2 :BOOLEAN =FALSE;
X :WORD =0;
Y :WORD =0;
Xprev :WORD =0;
Yprev :WORD =0;
First_loop :BOOLEAN =TRUE;
GrDriver :INTEGER =0;
GrMode :INTEGER =0;
Str_path :STRING ='';
My_cursor :Cursor_type=( {own cursor bitmap }
{Show background} $F000,$FFFF,$0FF0,$0FF0,$0FF0,$0FF0,$0FF0,$0FF0,
{1=show } $FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$0000,$000F,
{White area } $00FF,$FFFF,$F00F,$F00F,$F00F,$F00F,$F00F,$F00F,
{1=white} $F00F,$F00F,$F00F,$F00F,$F00F,$F00F,$FFFF,$FF00 );
begin
DirectVideo :=FALSE; { Slow but works with graph }
INTR($33,Regs);
IF Regs.Ah =0 THEN BEGIN
Writeln ('Mouse is dead, run mouse');
halt;
end;
GrDriver := DETECT;
InitGraph(GrDriver,GrMode,'');
IF GraphResult <>0 THEN BEGIN
WRITELN (' Hey gimme that EGAVGA.BGI -file !');
WRITELN (' f.ex your tp -directory');
READLN (Str_path);
GrDriver:=DETECT;
InitGraph(GrDriver,GrMode,Str_path);
IF GraphResult <>0 THEN BEGIN
WRITELN ('Can''t init graphics');
HALT;
END;
END;
SetColor (Yellow);
Regs.Ax :=$07; {MIN / MAX X}
Regs.Bx :=$00;
Regs.Cx :=$279;
INTR ($33,Regs);
Regs.Ax :=$08; {MIN / MAX Y}
Regs.Bx :=$00;
Regs.Cx :=$159;
INTR ($33,Regs);
Regs.Ax :=1; {Show cursor}
INTR($33,Regs);
WHILE TRUE DO BEGIN
Regs.Ax :=$1100;
INTR ($16,Regs); {Hey this is keyboard interrupt ??}
IF Regs.Flags AND $40 =0 THEN BEGIN
WRITELN;
Regs.Ax :=$1000; {f11, f12... works! }
INTR ($16,Regs);
GotoXY(01,WhereY); WRITE ('AH:',CHR (Regs.Ah));
GotoXY(11,WhereY); WRITE ('AL:',CHR (Regs.Al)); {Some }
GotoXY(21,WhereY); WRITE ('AH:', Regs.Ah ); {Keyboard}
GotoXY(31,WhereY); WRITE ('AL:', Regs.Al );
WRITE(#10);
END;
WITH Regs DO
BEGIN
Xprev :=X; {Save Previous }
Yprev :=Y;
Ax := 3;
INTR($33,Regs); {Where is my mouse ? }
X :=Cx; {Take current position }
Y :=Dx;
IF First_loop THEN BEGIN {First time ? }
First_Loop :=FALSE;
Xprev :=X;
Yprev :=Y;
END;
WRITE(#13); {Begin of line }
WRITE( Cx :5);
WRITE( Dx :7,' '); {Write position }
IF ((Bx AND $1) <> $1) AND ((Bx AND $2) <> $2) THEN
BEGIN
IF Mouse_key THEN BEGIN
IF But1 AND But2 THEN BEGIN
WRITE ('BothB'); {You can go out 2 }
DELAY (2000);
CloseGraph;
WRITELN('You pressed both mouse buttons !');
WRITELN('Are you happy... have a nice dos');
HALT
END ELSE BEGIN
IF But1 THEN BEGIN
WRITE ('LeftB');
Regs.Ax :=$09; {New picture }
Regs.Bx :=$07; { X -HOT point }
Regs.Cx :=$07; { Y -HOT point }
Regs.Dx :=OFS(My_cursor); {Pointer to bitmap }
Regs.ES :=SEG(My_cursor);
INTR ($33,Regs); {DO IT }
Regs.Ax :=1; {Show new cursor}
Intr($33,Regs);
END ELSE BEGIN
if But2 THEN BEGIN
WRITE ('RighB');
Regs.Ax :=0; {Reset}
Intr($33,Regs);
Regs.Ax :=1; {Show}
Intr($33,Regs);
END;
END;
END;
DELAY (400);
But1 :=FALSE;
But2 :=FALSE;
Mouse_key :=FALSE;
END ELSE BEGIN
WRITE('NoB ');
END;
END ELSE BEGIN
WRITE('NoB ');
IF ((Bx AND $1) = $1) AND ((Bx AND $2) = $2) THEN BEGIN
But1 :=TRUE;
But2 :=TRUE;
Mouse_key :=TRUE;
END ELSE BEGIN
IF (Bx AND $1) = $1 THEN BEGIN
But1 :=TRUE;
Mouse_key :=TRUE;
Regs.Ax :=2;
INTR($33,Regs);
PutPixel (X,Y,WHITE);
Regs.Ax :=1;
INTR($33,Regs);
END ELSE BEGIN
but2 :=TRUE;
Mouse_key :=TRUE;
Regs.Ax :=2;
INTR($33,Regs);
LINE(X,Y,Xprev,Yprev);
Regs.Ax :=1;
INTR($33,Regs);
END;
END;
END;
END;
END;
END.
{I'm not so sure how wide this spread. Let me know.}
--
********************************
No future No kredit No signature
********************************