[Back to ANSI SWAG index] [Back to Main SWAG index] [Original]
{
Well, this was NOT written by me, but the author is darn cool. I have a
question for you.. I'm trying to make a *simple* SB16 DMA player, using those
darned end-transfer interrupts. I am pretty good in TP, but all the info I've
recieved about this has been too varied. People also like to use those crappy
drivers. Any advice? Anyways, here's a program for ya..
-Jason Randall-
}
USES crt,dos;
Label Jm1;
CONST
FF = #12;
ESC = #27;
type
rgbtype = record
red,green,blue:byte;
end;
rgbarray=array [0..255] of rgbtype;
var
USERFILE:String;
InFile :File of Char;
XX:INTEGER;
rgbpal,fadepal:rgbarray;
ii:word;
c:char;
count: Byte;
Ch : CHAR;
i , FGcolor, BGcolor, CursorX, CursorY : INTEGER;
escape_mode, lightcolor : BOOLEAN;
escape_number : BYTE;
escape_register : ARRAY [1..50] OF BYTE;
escape_str : STRING [80];
AnsiFile : TEXT;
(* FADES ROUTINES *)
procedure setcolor(col,r,g,b:byte);
begin
port[$3c8]:=col;
port[$3c9]:=r;
port[$3c9]:=g;
port[$3c9]:=b;
end;
procedure getcolor(col:byte;var r,g,b:byte);
begin
port[$3c7]:=col;
r:=port[$3c9];
g:=port[$3c9];
b:=port[$3c9];
end;
procedure fadein(var fadepal : rgbarray; col1, col2 ,dly: byte);
var
lcv,
lcv2 : integer;
tpal : rgbarray;
begin
for lcv := col1 to col2 do
begin
TPal[lcv].red := 0;
TPal[lcv].green := 0;
TPal[lcv].blue := 0;
end;
for lcv := 0 to 63 do
begin
for lcv2:=col1 to col2 do
begin
if fadepal[lcv2].red > TPal[lcv2].red then
TPal[lcv2].red := TPal[lcv2].red + 1;
if fadepal[lcv2].green > TPal[lcv2].green then
TPal[lcv2].green := TPal[lcv2].green + 1;
if fadepal[lcv2].blue > TPal[lcv2].blue then
TPal[lcv2].blue := TPal[lcv2].blue+1;
setcolor(lcv2, TPal[lcv2].red, TPal[lcv2].green,
TPal[lcv2].blue);
end;
delay(dly);
end;
end;
procedure fadeout(var fadepal : rgbarray; col1, col2 ,dly: byte);
var
lcv,
lcv2 : integer;
TPal : rgbarray;
begin
for lcv := col1 to col2 do
begin
TPal[lcv].red := 0;
TPal[lcv].green := 0;
TPal[lcv].blue := 0;
end;
for lcv := 0 to 63 do
begin
for lcv2 := col1 to col2 do
begin
if fadepal[lcv2].red > TPal[lcv2].red then
fadepal[lcv2].red := fadepal[lcv2].red - 1;
if fadepal[lcv2].green > TPal[lcv2].green then
fadepal[lcv2].green := fadepal[lcv2].green - 1;
if fadepal[lcv2].blue > TPal[lcv2].blue then
fadepal[lcv2].blue := fadepal[lcv2].blue - 1;
setcolor(lcv2, fadepal[lcv2].red, fadepal[lcv2].green,
fadepal[lcv2].blue);
end;
delay(dly);
end;
end;
(****************************************************************************)
(* PROCESS ESCAPE *)
(****************************************************************************)
PROCEDURE
wrt ( c : CHAR );
BEGIN
CASE c OF
FF : CLRSCR;
ELSE WRITE (c);
END;
END;
PROCEDURE
set_graphics;
VAR
i : INTEGER;
FG, BG : INTEGER;
BEGIN
FG := FGcolor;
BG := BGcolor;
FOR i := 1 TO escape_number DO BEGIN
CASE escape_register [i] OF
0 : lightcolor := FALSE;
1 : lightcolor := TRUE;
5 : FG := FG + blink;
7 : BEGIN
FG := BG;
BG := FG;
END;
30 : FG := black;
30 : FG := black;
31 : FG := red;
32 : FG := green;
33 : FG := brown;
34 : FG := blue;
35 : FG := magenta;
36 : FG := cyan;
37 : FG := white;
40 : BG := black;
41 : BG := red;
42 : BG := green;
43 : BG := yellow;
44 : BG := blue;
45 : BG := magenta;
46 : BG := cyan;
47 : BG := white;
ELSE
;
END;
END;
IF (lightcolor) AND (fg < 8) THEN
fg := fg + 8;
IF (lightcolor = FALSE) AND (fg > 7) THEN
fg := fg - 8;
TEXTCOLOR ( FG );
TEXTBACKGROUND ( BG );
escape_mode := FALSE;
END;
PROCEDURE MoveUp;
BEGIN
IF escape_register [1] < 1 THEN
escape_register [1] := 1;
GOTOXY (WHEREX, WHEREY - (Escape_Register [1]) );
END;
PROCEDURE MoveDown;
BEGIN
IF escape_register [1] < 1 THEN
escape_register [1] := 1;
GOTOXY (WHEREX, WHEREY + (Escape_Register [1]) );
END;
PROCEDURE MoveForeward;
BEGIN
IF escape_register [1] < 1 THEN
escape_register [1] := 1;
GOTOXY (WHEREX + (Escape_Register [1]), WHEREY);
END;
PROCEDURE MoveBackward;
BEGIN
IF escape_register [1] < 1 THEN
escape_register [1] := 1;
GOTOXY (WHEREX - (Escape_Register [1]), WHEREY);
END;
PROCEDURE SaveCursorPos;
BEGIN
CursorX := WHEREX;
CursorY := WHEREY;
END;
PROCEDURE RestoreCursorPos;
BEGIN
GOTOXY (CursorX, CursorY);
END;
PROCEDURE addr_cursor;
BEGIN
CASE escape_number OF
0 : BEGIN
escape_register [1] := 1;
escape_register [2] := 1;
END;
1 : escape_register [2] := 1;
ELSE
;
END;
IF escape_register [1] = 25 THEN
GOTOXY (escape_register [2], 24)
ELSE
GOTOXY (escape_register [2], escape_register [1]);
escape_mode := FALSE;
END;
PROCEDURE clear_scr;
BEGIN
IF ( escape_number = 1 ) AND ( escape_register [1] = 2 ) THEN
CLRSCR;
escape_mode := FALSE;
END;
PROCEDURE clear_line;
BEGIN
IF ( escape_number = 1 ) AND ( escape_register [1] = 0 ) THEN
CLREOL;
escape_mode := FALSE;
END;
PROCEDURE process_escape ( c : CHAR );
VAR
i : INTEGER;
ch : CHAR;
BEGIN
c := UPCASE (c);
CASE c OF
'['
: EXIT;
'F', 'H'
: BEGIN
addr_cursor;
Escape_mode := FALSE;
EXIT;
END;
'J' : BEGIN
clear_scr;
Escape_mode := FALSE;
EXIT;
END;
'K' : BEGIN
clear_line;
Escape_mode := FALSE;
EXIT;
END;
'M' : BEGIN
set_graphics;
Escape_mode := FALSE;
EXIT;
END;
'S' : BEGIN
SaveCursorPos;
Escape_mode := FALSE;
EXIT;
END;
'U' : BEGIN
RestoreCursorPos;
Escape_Mode := FALSE;
EXIT;
END;
'A' : BEGIN
MoveUp;
Escape_mode := FALSE;
EXIT;
END;
'B' : BEGIN
MoveDown;
Escape_mode := FALSE;
EXIT;
END;
'C' : BEGIN
MoveForeward;
Escape_mode := FALSE;
EXIT;
END;
'D' : BEGIN
MoveBackward;
Escape_mode := FALSE;
EXIT;
END;
END;
ch := UPCASE ( c );
escape_str := escape_str + ch;
IF ch IN [ 'A'..'G', 'L'..'P' ] THEN EXIT;
IF ch IN [ '0'..'9' ] THEN BEGIN
escape_register [escape_number] := (escape_register [escape_number] *
10) + ORD ( ch ) - ORD ( '0' );
EXIT;
END;
CASE ch OF
';', ',' : BEGIN
escape_number := escape_number + 1;
escape_register [escape_number] := 0;
END;
'T', '#', '+', '-', '>', '<', '.'
: ;
ELSE
escape_mode := FALSE;
FOR i := 1 TO LENGTH ( escape_str ) DO
wrt ( escape_str [i] );
END;
END;
(**************************************************************************)
(* SCREEN HANDLER *)
(**************************************************************************)
PROCEDURE scrwrite ( c : CHAR );
VAR
i : INTEGER;
BEGIN
IF c = ESC THEN BEGIN
IF escape_mode THEN BEGIN
FOR i := 1 TO LENGTH ( escape_str ) DO
wrt ( escape_str [i] );
END;
escape_str := '';
escape_number := 1;
escape_register [escape_number] := 0;
escape_mode := TRUE;
END
ELSE
IF escape_mode THEN
process_escape (c)
ELSE
wrt ( c );
END;
Procedure Set50Lines;
Begin
Asm
mov ax, $1202
mov bl, $30
int $10 {set 400 scan lines}
mov ax, 3
int $10 {set Text mode}
mov ax, $1112
mov bl, 0
int $10 {load 8x8 font to page 0 block}
end;
end;
BEGIN
for II:=0 to 255 do
getcolor(II,fadepal[II].red,fadepal[II].green,fadepal[II].blue);
rgbpal:=fadepal;
fadeout(fadepal,0,127,0);
fadepal:=rgbpal;
ClrScr;
fadein(fadepal,0,127,10);
Write ('Do you want 50 lines mode?');
ch:=Readkey;
c := UPCASE (ch);
CASE c OF
'N'
: goto JM1;
'Y'
: BEGIN
asm; Mov AH,00; Mov AL,$3; Int 10h; End;
Set50Lines;
clrScr;
Set50Lines;
END;
End;
Jm1:
USERFILE:=PARAMSTR(1); {('Test.Ans');}
Escape_Str := '';
FGColor := White;BGColor := BLACK;
Escape_Mode := TRUE;
CLRSCR;
ASSIGN (AnsiFile, USERFILE);
RESET (AnsiFile);
WHILE NOT EOF (AnsiFile) DO
BEGIN
READ (AnsiFile, ch);
DELAY (0);
ScrWrite (Ch);
END;
END.
[Back to ANSI SWAG index] [Back to Main SWAG index] [Original]