[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{$G+}
{- FUEGO.PAS
Fuego - Flames
----------------
tlaure@lsa.lsa.com.uy
Tomas Laurenzo - 1997
Montevideo - Uruguay
----------------------------------------------------------------------------
DISCLAIMER: Same as usual, use it at your own risk.
COPYRIGHT: Use it freely, just remember _I_ coded it :)
DESCRIPTION:
This is a simple flames routine, with two fades at the end
I do use some routines that i've collected for quite awhile.
I think most of'em are from the SWAG files, and from the Asphyxia VGA
Trainer by Denthor... which helped me a lot, (not very long :) time ago.
Sorry, it's not optimized, but as long as it uses no ASM (appart from
plotting dots and the palette stuff, wich is not "Fire code"), it's really
easy to follow the code.
Once the program is running, with the keys '4','5','1' and '2', you can
move the limits of the fire.
Any comments, suggestions, whatever, _please_ mail.
Sal£,
Tom.
^`§:;,.,;:§'^`§:;,.,;:§'^`§:;,.,;:§'^`§:;,.,;:§'^`§:;,.,;:§'^`§:;,.,;:§'^`§:;,.
}
PROGRAM Fuego;
USES
Crt;
CONST Alt = 100; { The line from where we start redrawing the screen }
VGA = $A000;
TYPE
Tcolor = RECORD { Las componentes RGB de un color}
R,G,B : Byte;
END;
Tpaleta = ARRAY [0..255] of Tcolor;
VAR Y,
X : Word;
Scr : ARRAY [0..319, Alt-1..199] OF BYTE; { This will store the colors }
MinX, { of every dot in the screen }
MaxX : Word; { The limits of the fire }
Sigue : Boolean;
Tecla : Char;
{............................................................................}
PROCEDURE Retraso; Assembler; { Waits for the vertical retrace }
ASM
mov dx,3DAh
@@1:
in al,dx
and al,08h
jnz @@1
@@2:
in al,dx
and al,08h
jz @@2
END;
{............................................................................}
PROCEDURE SeteaColor (Col : Byte; Color : Tcolor);
{ Sets a color of the palette}
VAR R,G,B : Byte;
BEGIN
R := Color.R;
G := Color.G;
B := Color.B;
ASM
mov dx,3c8h
mov al,[col]
out dx,al
inc dx
mov al,[r]
out dx,al
mov al,[g]
out dx,al
mov al,[b]
out dx,al
END;
END;
{............................................................................}
PROCEDURE CargaColor (Col : Byte; VAR Color : Tcolor);
{ Loads a color from the palette }
VAR
rr,gg,bb : Byte;
BEGIN
ASM
mov dx,3c7h
mov al,col
out dx,al
add dx,2
in al,dx
mov [rr],al
in al,dx
mov [gg],al
in al,dx
mov [bb],al
END;
Color.r := rr;
Color.g := gg;
Color.b := bb;
END;
{............................................................................}
PROCEDURE FadeOut (Ret : Boolean); { Fades the screen out }
VAR I : Byte;
ColTemp : tColor;
Paleta : tPaleta;
FUNCTION Hay : Boolean;
VAR I : Byte;
ColTemp : tColor;
Paleta : tPaleta;
H : Boolean;
BEGIN
FOR I := 0 TO 255 DO CargaColor (I,Paleta[I]);
H := False;
FOR I := 0 TO 255 DO BEGIN
IF Paleta[I].R > 0 THEN H := True;
IF Paleta[I].G > 0 THEN H := True;
IF Paleta[I].B > 0 THEN H := True;
IF H = True THEN Exit;
END;
Hay := H;
END;
BEGIN
WHILE Hay DO BEGIN
FOR I := 0 TO 255 DO CargaColor (I,Paleta[I]);
FOR I := 0 TO 255 DO BEGIN
IF Paleta[I].R > 0 THEN Dec (Paleta[I].R);
IF Paleta[I].G > 0 THEN Dec (Paleta[I].G);
IF Paleta[I].B > 0 THEN Dec (Paleta[I].B);
END;
FOR I := 255 DownTO 0 DO SeteaColor (I,Paleta[I]);
IF Ret = True THEN Retraso;
END;
END;
{............................................................................}
PROCEDURE FadeWhite (Ret : Boolean); { Fade the screens to white }
VAR J,
I : Byte;
ColTemp : tColor;
Paleta : tPaleta;
BEGIN
FOR J := 0 TO 64 DO BEGIN
FOR I := 0 TO 255 DO CargaColor (I,Paleta[I]);
FOR I := 0 TO 255 DO BEGIN
IF Paleta[I].R < 63 THEN Inc (Paleta[I].R)
ELSE Paleta[I].R := 63;
IF Paleta[I].G < 63 THEN Inc (Paleta[I].G)
ELSE Paleta[I].G := 63;
IF Paleta[I].B < 63 THEN Inc (Paleta[I].B)
ELSE Paleta[I].B := 63;
END;
FOR I := 255 DownTO 0 DO SeteaColor (I,Paleta[I]);
IF Ret = True THEN Retraso;
END;
END;
{............................................................................}
PROCEDURE Cls (Col : Byte; Where:word); assembler; { Clears the screen }
ASM { to the color #col }
push es
mov cx, 32000;
mov es,[where]
xor di,di
mov al,[col]
mov ah,al
rep stosw
pop es
END;
{............................................................................}
PROCEDURE Modo13h; Assembler; { Goes into 13h VGA mode }
ASM
MOV AX, 13h
INT 10h
END;
{............................................................................}
{ Plots a dot to the screen }
PROCEDURE PutDot (X,Y : Integer; Color : Byte; SegDes:word); assembler;
ASM
cmp X,0
jl @@END
cmp Y,0
jl @@END
cmp X,319
jg @@END
cmp Y,199
jg @@END
mov ax,SegDes
mov es,ax
mov al,Color
mov di,Y
mov bx,X
mov dx,di
xchg dh,dl
shl di,6
add di,dx
add di,bx
mov es:[di],al
@@END:
END;
{............................................................................}
PROCEDURE Promedio; { Averages the screen dots }
VAR X, Y : Word;
BEGIN
FOR X := MinX+1 TO MaxX-1 DO FOR Y := Alt TO 199 DO
Scr [X,Y] := (Scr[X,Y+1] + Scr [X,Y+1] + Scr[X+1,Y+1] + Scr [X-1,Y-1]) div 4
END;
{............................................................................}
PROCEDURE Escribo; { This plots the dots to the screen }
VAR X, Y : Word;
BEGIN
FOR X := MinX TO MaxX DO FOR Y := Alt TO 198 DO IF Scr[X,Y] > 0 THEN PutDot (X,Y,Scr[X,Y],VGA);
END;
{............................................................................}
PROCEDURE CreoPaleta; { Creates the palette }
VAR Paleta : tPaleta;
ColTemp : tColor;
I : Byte;
BEGIN
FOR I := 1 TO 64 DO BEGIN
ColTemp.R := I;
ColTemp.G := 0;
ColTemp.B := 0;
Paleta[I] := ColTemp;
END;
FOR I := 64 TO 128 DO BEGIN
ColTemp.R := 255;
ColTemp.G := I;
ColTemp.B := 0;
Paleta[I] := ColTemp;
END;
FOR I := 118 TO 150 DO BEGIN
ColTemp.R := 255;
ColTemp.G := 128;
ColTemp.B := 0;
Paleta[I] := ColTemp;
END;
FOR I := 1 TO 150 DO SeteaColor (I,Paleta[I])
END;
{............................................................................}
{ Main }
BEGIN
Modo13h;
CreoPaleta;
Cls (0,VGA);
MinX := 0;
MaxX := 319;
Sigue := True;
FOR X := MinX TO MaxX DO BEGIN { Initialize the Scr array to 0 }
FOR Y := Alt-1 TO 199 DO BEGIN
Scr [X,Y] := 0;
END;
END;
WHILE Sigue DO BEGIN
FOR X := MinX TO MaxX DO Scr [X,199] := Random (100)+40; { The first line }
Promedio;
Escribo;
IF KeyPressed THEN BEGIN
Tecla := ReadKey;
CASE Tecla OF
'4' : IF (MaxX > 0) AND (MaxX > MinX+10) THEN BEGIN
Dec (MaxX,10);
FOR X := MaxX to 319 DO
FOR Y := Alt-1 to 199 DO PutDot (X,Y,0,VGA);
END;
'5' : IF MaxX < 319 THEN Inc (MaxX,10);
'1' : IF MinX > 0 THEN Dec (MinX,10);
'2' : IF (MinX < 319) AND (MinX < MaxX-10) THEN BEGIN
Inc (MinX,10);
FOR X := 0 to MinX DO
FOR Y := Alt-1 to 199 DO PutDot (X,Y,0,VGA);
END;
ELSE Sigue := False;
END;
END;
END;
FadeWhite (True);
Cls (53,VGA);
FadeOut (True);
END.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]