#### Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

#### Categories

Welcome to the new platform of Programmers Heaven! We apologize for the inconvenience caused, if you visited us from a broken link of the previous version. The main reason to move to a new platform is to provide more effective and collaborative experience to you all. Please feel free to experience the new platform and use it's exciting features. Contact us for any issue that you need to get clarified. We are more than happy to help you.

# Graphic help

Posts: 3Member
I made a simple animation. I would like to color the inside of the circles that are moving. Can anyone tell me what function to use?
Here is the code:
[code]Program MovingCirclesBondWithLine;
Uses crt,graph;
begin randomize;
gd:=detect; d:='down'; c:='under';
InitGraph(gm,gd,'');

a:=GetMaxX div 2-200; b:= GetMaxY div 2; a1:=a+400; b1:=b; radius:=20;

repeat
{1}
if (i=0) and (d='down') and (c='under') then repeat inc(i,1); d:='up'; c:='under';
Line(GetMaxX div 2, GetMaxY div 2, a, b);
Line(GetMaxX div 2, GetMaxY div 2, a1, b1);
Delay(i div 4); ClearDevice; until i=200;

{2}
if (i=200) and (d='up') and (c='under') then repeat dec(i,1); d:='up'; c:='above';
Line(GetMaxX div 2, GetMaxY div 2, a, b);
Line(GetMaxX div 2, GetMaxY div 2, a1, b1);
Delay(15); ClearDevice; until i=0;

{3}
if (i=0) and (d='up') and (c='above') then repeat inc(i,1); d:='down'; c:='above';
Line(GetMaxX div 2, GetMaxY div 2, a, b);
Line(GetMaxX div 2, GetMaxY div 2, a1, b1);
Delay(i div 4); ClearDevice; until i=200;

{4}
if (i=200) and (d='down') and (c='above') then repeat dec(i,1); d:='down'; c:='under';
Line(GetMaxX div 2, GetMaxY div 2, a, b);
Line(GetMaxX div 2, GetMaxY div 2, a1, b1);
Delay(15); ClearDevice; until i=0;

until keypressed;

CloseGraph;
end.[/code]

I know its massive and probably i could have used procedures and functions but i am still a beginner. I would like to eliminate the blinking thing if possible and to color the circles(from inside).
· ·
«1

• Posts: 9Member
I have some tips for you:
1. Use at every repeat until ... or KEYPRESSED, cuz you have to wait until the program ends.
2. Use at the beginning SetFillStyle(1,Color);
and after every Circle FloodFill(a+1,b+1,White);
this will blink, cuz you use so many ClearDevice. Never use that!. its beter if you draw with white and after that with black, and than with white again to new place.
· ·
• Posts: 3Member
Thanks for your help. But i am curious what did you meant with

1. Use at every repeat until ... or KEYPRESSED, cuz you have to wait until the program ends. ?
· ·
• Posts: 268Member
BGI routines are quite slow, you won't get far... One way would be to use [b]setactivepage[/b] + [b]setvisualpage[/b] commands. The idea is to write always in the background then show the result when is necessary. Commands like [b]floodfill[/b] will slow things further down...
Here's a program to show how to code a simple animation. Smooth animation ( fps set to screen refresh rate ), scrolling background. Uses a different method to draw filled circles to avoid the recursive floodfill (slow).
· ·
• Posts: 268Member
Screenshot
· ·
• Posts: 9Member
if (i=0) and (d='down') and (c='under') then repeat inc(i,1); d:='up'; c:='under';
SetFillStyle(1,Red);
FloodFill(a,b,White);
Line(GetMaxX div 2, GetMaxY div 2, a, b);
Line(GetMaxX div 2, GetMaxY div 2, a1, b1);
FloodFill(a1+1,b1+1,White);
Delay(i div 4); ClearDevice; until (i=200)or keypressed;
you have a lot of repeat...until. and if you use at every section keypressed, you can stop the program at any time, else you have to wait until the cycle ends.
· ·
• Posts: 9Member
Yes it's really nice and fast if you write in assembly, but it's harder and not everyone know assembly lang.
· ·
• Posts: 29Member
Wow ! I tried animation before with GRAPH commands, but this blows it away. What I wanted to do, is to write a game, but the results always turned me off, now I see hope. It is clear that ASSEMBLY is the key, the problem is that I'm almost a total n00b :( in this matter. Could you write like a tutorial, specially on game design, please ?
· ·
• Posts: 757Member
Haven't used this in a while but I wrote/compiled it years and years ago. It is mostly in assembly and does many graphics routines fast. I have to give credit for some of this stuff to Asphixia Trainers where I learned alot about graphics programming. Google it for more info.

Here is a sample of how to use it:
[code]
USES Crt, Dos, Graphics;
VAR
X1, Y1, X2, Y2 : Integer;
Color1, Color2 : Byte;

Begin
{ These are imaginary screens. We draw everything to them, then copy them to the real screen to avoid flicker. We can have up to 4. }
If GetVideoPages(2) <> 2 Then
Begin
WriteLn(' Not enough memory for 2 pages (128k of memory needed)');
Halt;
End;
InitVGA; { Gets us into graphics mode }

{ First we will draw random rectangles the old style way FLICKER! }
Repeat
{ Create our four points for a random rectangle }
X1 := Random(ScreenWidth);
Y1 := Random(ScreenHeight);
X2 := Random(ScreenWidth-X1);
Y2 := Random(ScreenHeight-Y1);
{ Color1 is border, Color2 is fill color }
Color1 := Random(15);
Color2 := Random(15);

{ Draw it! Set method to 0 for normal. Other numbers are supposed to do see-through type effects. }
FillRectangle(X1, Y1, X2, Y2, Color1, Color2, 0, [b]VGA[/b]);

Until Keypressed;

{ AND NOW with Virtual screens! NO FLICKER! }
CLRVID(VAddr1, 0); { Clear Video Page # 1 to black (color 0) }
Repeat
{ Create our four points for a random rectangle }
X1 := Random(ScreenWidth);
Y1 := Random(ScreenHeight);
X2 := Random(ScreenWidth-X1);
Y2 := Random(ScreenHeight-Y1);
{ Color1 is border, Color2 is fill color }
Color1 := Random(15);
Color2 := Random(15);

{ Draw it! Set method to 0 for normal. Other numbers are supposed to do see-through type effects. }
FillRRectangle(X1, Y1, X2, Y2, Color1, Color2, 0, [b]VAddr1[/b]);

{ Copies our virtual screen onto our real screen so we actually see it }
Until Keypressed;
CloseGraphics;
End.
[/code]

and here it is ([b]Make sure to save it as GRAPHICS.PAS[/b]):
[code]
{\$N+,G+}
UNIT Graphics;

INTERFACE

USES Dos, Crt;
PROCEDURE InitVGA;
PROCEDURE InitSVGA(Mode : Word);
PROCEDURE CloseGraphics;
PROCEDURE WaitRetrace;
PROCEDURE CLRVID(Where : Word;Color : Byte);
FUNCTION GetVideoPages(NumPages : Byte) : Byte;
PROCEDURE DisposeVideoPages;
PROCEDURE CopyPage(Source,Dest : Word);
PROCEDURE PutPixel(X,Y : LongInt;Color, Method : Byte;Where : Word);
PROCEDURE PutPixelW(X,Y : LongInt;Color : Byte;Where : Word);
PROCEDURE Line(X1,Y1,X2,Y2 : Integer;Color : Byte;Method : Byte;Where : Word);
PROCEDURE VLine(Y1,Y2,X : Integer;Color : Byte;Method : Byte;Where : Word);
PROCEDURE HLine(X1,X2,Y : Integer;Color : Byte;Method : Byte;Where : Word);
PROCEDURE Rectangle(X1, Y1, X2, Y2 : Integer;Color : Byte;Method : Byte;Where : Word);
PROCEDURE RRectangle(X1, Y1, X2, Y2 : Integer;Color : Byte;Method : Byte;Where : Word);
PROCEDURE FillRectangle(X1, Y1, X2, Y2 : Integer;Color, Fill : Byte;Method : Byte;Where : Word);
PROCEDURE FillRRectangle(X1, Y1, X2, Y2 : Integer;Color, Fill : Byte;Method : Byte;Where : Word);
PROCEDURE Circle(X, Y, Rad : Word; Color, Method : Byte; Where : Word);
PROCEDURE FillCircle(X, Y, Rad : Word; Color, Fill, Method : Byte;Where : Word);
PROCEDURE SetColor(Color, R, G, B : Byte);
PROCEDURE GetColor(Color : Byte; VAR R, G, B : Byte);
PROCEDURE WriteText(X,Y : Integer; S : String; Color : Byte;Size : Byte;Method : Byte;Where : Word);
FUNCTION Sqrt(Num : Double) : Real;

CONST
VGA = \$A000;

TYPE
VPage = Array[0..63999] Of Byte;
VPagePtr = ^VPage;

VAR
VirScr1,
VirScr2,
VirScr3,
VirScr4 : VPagePtr;
ScrHeight,
ScrWidth : Word;
SinLook : Array[0..255] Of Real;
CosLook : Array[0..255] Of Real;

IMPLEMENTATION

VAR
CharSet : Array[0..255,0..15] Of Byte;
OldBank : Byte;
NumVidPages : Byte;
F : File;
FontSeg,
FontOfs : Word;

PROCEDURE InitVGA; Assembler;
ASM
Mov Ax, 13h
Int 10h
Mov ScrWidth, 320
Mov ScrHeight, 200
END;

PROCEDURE InitSVGA; Assembler;
ASM
Mov Ax, \$4F02
Mov Bx, Mode
Int 10h
Cmp Mode, 100h
Jb @Error
Ja @Check640x480
Mov ScrWidth, 640
Mov ScrHeight, 400
Jmp @Error
@Check640x480:
Cmp Mode, 102h
Ja @Check800x600
Mov ScrWidth, 640
Mov ScrHeight, 480
Jmp @Error
@Check800x600:
Cmp Mode, 104h
Ja @Check1024x768
Mov ScrWidth, 800
Mov ScrHeight, 600
Jmp @Error
@Check1024x768:
Mov ScrWidth, 1024
Mov ScrHeight, 768
Jmp @Error
@Error:
END;

PROCEDURE CloseGraphics; Assembler;
ASM
Mov Ax, 03h
Int 10h
END;

PROCEDURE WaitRetrace; Assembler;
ASM
Mov dx,3DAh
@l1:
In al,dx
And al,08h
Jnz @l1
@l2:
In al,dx
And al,08h
Jz @l2
END;

PROCEDURE CLRVID; Assembler;
ASM
Mov Di, Where
Mov Es, Di
Xor Di, Di
Mov Al, Color
Mov Ah, Al
Mov Cx, 32000
REP STOSW
END;

FUNCTION GetVideoPages;
Begin
If MaxAvail < 64000 Then Begin GetVideoPages := 0; Exit; End;
If (MaxAvail > 256000) and (NumPages >= 4) Then
Begin
NumVidPages := 4;
End ELSE
If (MaxAvail > 192000) and (NumPages >= 3) Then
Begin
NumVidPages := 3;
End ELSE
If (MaxAvail > 128000) and (NumPages >= 2) Then
Begin
NumVidPages := 2;
End ELSE
If (MaxAvail > 64000) and (NumPages >= 1) Then
Begin
NumVidPages := 1;
End;
GetVideoPages := NumVidPages;
End;

PROCEDURE DisposeVideoPages;
Begin
If NumVidPages > 3 Then Dispose(VirScr4);
If NumVidPages > 2 Then Dispose(VirScr3);
If NumVidPages > 1 Then Dispose(VirScr2);
If NumVidPages > 0 Then Dispose(VirScr1);
End;

PROCEDURE CopyPage; Assembler;
ASM
Push Ds
Cld
Mov Si, Source
Mov Ds, Si
Xor Si, Si
Mov Di, Dest
Mov Es, Di
Xor Di, Di
Mov Cx, 32000
@Transfer:
LODSW
STOSW
Loop @Transfer
Pop Ds
END;

PROCEDURE PutPixel(X,Y : LongInt;Color, Method : Byte;Where : Word);
VAR Bank : Word;
Begin
If ScrWidth <= 320 Then
Begin
If Method = 0 Then
Mem[Where:X+Y*ScrWidth] := Color
ELSE If Method = 1 Then
Mem[Where:X+Y*ScrWidth] := Mem[Where:X+Y*ScrWidth] XOR Color
ELSE If Method = 2 Then
Mem[Where:X+Y*ScrWidth] := Mem[Where:X+Y*ScrWidth] + Color
ELSE
Mem[Where:X+Y*ScrWidth] := Mem[Where:X+Y*ScrWidth] - Color;
End
ELSE
Begin
Bank := (Y*ScrWidth+X) Shr 16;
If OldBank <> Bank Then
Begin
ASM
Mov Ax, \$4f05
Xor Bh, Bh
Mov Dx, Bank
Int \$10
END;
OldBank := Bank;
End;
If Method = 0 Then
Mem[Where:X+Y*ScrWidth-(Bank Shl 16)] := Color
ELSE If Method = 1 Then
Mem[Where:X+Y*ScrWidth-(Bank Shl 16)] := Mem[Where:X+Y*ScrWidth-(Bank Shl 16)] XOR Color
ELSE If Method = 2 Then
Mem[Where:X+Y*ScrWidth-(Bank Shl 16)] := Mem[Where:X+Y*ScrWidth-(Bank Shl 16)] + Color
ELSE
Mem[Where:X+Y*ScrWidth-(Bank Shl 16)] := Mem[Where:X+Y*ScrWidth-(Bank Shl 16)] - Color;
End;
End;

PROCEDURE PutPixelW(X,Y : LongInt;Color : Byte;Where : Word);
Begin
MemW[Where:X+Y*ScrWidth] := Color+Color SHL 8;
End;

PROCEDURE Line(X1,Y1,X2,Y2 : Integer;Color : Byte;Method : Byte;Where : Word);
{ This draws a solid line from X1,Y1 to X2,Y2 in COLOR }
FUNCTION SGN(X1 : Real) : Integer;
Begin
if X1>0 then SGN := 1;
if X1<0 then SGN := -1;
if X1=0 then SGN := 0;
End;
VAR
i, s,
d1x, d1y, d2x, d2y,
u, v, m, n : Integer;
Begin
u:= X2 - X1;
v:= Y2 - Y1;
d1x:= SGN(u);
d1y:= SGN(v);
d2x:= SGN(u);
d2y:= 0;
m:= ABS(u);
n := ABS(v);
If NOT(M > N) Then
Begin
d2x := 0 ;
d2y := SGN(v);
m := ABS(v);
n := ABS(u);
End;
s := m SHR 1;
For i := 0 to m Do
Begin
If (X1 >= 0) and (X1 < 320) and (Y1 >= 0) and (Y1 < 200) then
PutPixel(X1,Y1,Color,Method,Where);
s := s + n;
If NOT(s < m) Then
Begin
s := s - m;
X1:= X1 + d1x;
Y1 := Y1 + d1y;
End
ELSE
Begin
X1 := X1 + d2x;
Y1 := Y1 + d2y;
End;
End;
End;

PROCEDURE VLine(Y1,Y2,X : Integer;Color : Byte;Method : Byte;Where : Word); Assembler;
ASM
Mov Bx, Where
Mov Es, Bx
Mov Al, Color
Mov Cx, X
Mov Dx, Y1
@YCOORDINATE:
Push Ax
Push Dx
Mov Ax, Dx
Mul ScrWidth
Mov Bx, Ax
Pop Dx
Pop Ax
Cmp Method, 1
Jb @Normal
Ja @Subtract
Jmp @Continue
@Subtract:
Sub ES:[Bx], Al
Jmp @Continue
@Normal:
Mov [ES:Bx], Al
@Continue:
INC Dx
CMP Dx, Y2
JNA @YCOORDINATE
END;

PROCEDURE HLine(X1,X2,Y : Integer;Color : Byte;Method : Byte;Where : Word); Assembler;
ASM
Mov Bx, Where
Mov Es, Bx
Mov Cx, X1
Mov Dx, Y
Mov Ax, Dx
Mul ScrWidth
Mov Bx, Ax
Mov Al, Color
@XCOORDINATE:
Push Bx
Cmp Method, 1
Jb @Normal
Ja @Subtract
Jmp @Continue
@Subtract:
Sub ES:[Bx], Al
Jmp @Continue
@Normal:
Mov ES:[Bx], Al
@Continue:
Inc Cx
Pop Bx
Cmp Cx, X2
Jna @XCOORDINATE
END;

PROCEDURE Rectangle(X1, Y1, X2, Y2 : Integer;Color : Byte;Method : Byte;Where : Word);
Begin
VLine(Y1,Y2,X1,Color,Method,Where);
VLine(Y1,Y2,X2,Color,Method,Where);
HLine(X1+1,X2-1,Y1,Color,Method,Where);
HLine(X1+1,X2-1,Y2,Color,Method,Where);
End;

PROCEDURE RRectangle(X1, Y1, X2, Y2 : Integer;Color : Byte;Method : Byte;Where : Word);
Begin
VLine(Y1+1,Y2-1,X1,Color,Method,Where);
VLine(Y1+1,Y2-1,X2,Color,Method,Where);
HLine(X1+1,X2-1,Y1,Color,Method,Where);
HLine(X1+1,X2-1,Y2,Color,Method,Where);
End;

PROCEDURE FillRectangle(X1, Y1, X2, Y2 : Integer;Color, Fill : Byte;Method : Byte;Where : Word);
VAR
X, Y : Integer;
Begin
If (Method = 1) or (Method = 3) Then
Rectangle(X1,Y1,X2,Y2,Color,1,Where)
ELSE If (Method = 4) or (Method = 6) Then
Rectangle(X1,Y1,X2,Y2,Color,2,Where)
ELSE If (Method = 2) or (Method = 5) Then
Rectangle(X1,Y1,X2,Y2,Color,0,Where);
If (Method = 5) or (Method = 6) Then Method := 2;
If (Method = 1) or (Method = 4) Then Method := 0;
For X := X1+1 to X2-1 Do
VLine(Y1+1,Y2-1,X,Fill,Method,Where);
End;

PROCEDURE FillRRectangle(X1, Y1, X2, Y2 : Integer;Color, Fill : Byte;Method : Byte;Where : Word);
VAR
X, Y : Integer;
Begin
If (Method = 1) or (Method = 3) Then
RRectangle(X1,Y1,X2,Y2,Color,1,Where)
ELSE If (Method = 4) or (Method = 6) Then
RRectangle(X1,Y1,X2,Y2,Color,2,Where)
ELSE If (Method = 2) or (Method = 5) Then
RRectangle(X1,Y1,X2,Y2,Color,0,Where)
ELSE
RRectangle(X1,Y1,X2,Y2,Color,0,Where);
If (Method = 5) or (Method = 6) Then Method := 2;
If (Method = 1) or (Method = 4) Then Method := 0;
For X := X1+1 to X2-1 Do
VLine(Y1+1,Y2-1,X,Fill,Method,Where);
End;

PROCEDURE Circle(X, Y, Rad : Word; Color, Method : Byte; Where : Word);
VAR
W : Byte;
Z : Real;
Z2 : Real;

Begin
For W := 0 to 255 Do
Begin
PutPixel(X+Round(Z-Z2),Y+Round(Z+Z2),Color,Method,Where);
End;
End;

PROCEDURE FillCircle(X, Y, Rad : Word; Color, Fill, Method : Byte;Where : Word);
VAR
W : Byte;
W2 : Integer;
Z : Real;
Z2 : Real;

Begin
For W := 0 to 255 Do
Begin
Begin
For W2 := 0-Round(Z+Z2) to Round(Z+Z2) Do
PutPixel(X+W2,Y+Round(Z-Z2),Fill,Method,Where);
End;
PutPixel(X+Round(Z+Z2),Y+Round(Z-Z2),Color,Method,Where);
End;
End;

PROCEDURE SetColor(Color, R, G, B : Byte); Assembler;
ASM
Mov Dx, 3c8h
Mov Al, Color
Out Dx, Al
Inc Dx
Mov Al, R
Out Dx, Al
Mov Al, G
Out Dx, Al
Mov Al, B
Out Dx, Al
END;

PROCEDURE GetColor(Color : Byte; VAR R, G, B : Byte);
Begin
Port[\$3c7] := Color;
R := Port[\$3c9];
G := Port[\$3c9];
B := Port[\$3c9];
End;

{PROCEDURE GetColor(Color : Byte; VAR R, G, B : Byte); Assembler;
ASM
Mov Dx, 3c7h
Mov Al, Color
Out Dx, Al
Mov Dx, 3c9h
In
END;}

PROCEDURE WriteText(X,Y : Integer; S : String; Color : Byte;Size : Byte;Method : Byte;Where : Word);
CONST
Mask : Array[0..7] Of Byte = (1,2,4,8,16,32,64,128);
VAR
C, C1, C2 : Byte;
Begin
{
for i:=1 to length(txt) do
for j:=0 to 15 do
for k:=0 to 7 do
if ((mem[fseg:fofs+ord(txt[i])*16+j] shl k) and 128) <> 0 then
begin
mem[\$a000:(y+j+1)*320+(i*8)+x+k+1]:=0;
mem[\$a000:(y+j)*320+(i*8)+x+k]:=70-j-k+random(2*dither);
end;
}
If Size = 0 Then Size := 1;
If Length(S) = 0 Then Exit;
For C := 0 to Length(S)-1 Do
For C2 := 0 to 15*Size Do
For C1 := 0 to 7*Size Do
If Mem[FontSeg:FontOfs + ORD(S[C+1])*16+C2 DIV Size] AND Mask[C1 DIV Size] <> 0 Then
If Method = 0 Then
Mem[Where:(X+C1+C*8*Size)+(Y+C2)*320] := Color
ELSE If Method = 1 Then
Mem[Where:(X+C1+C*8*Size)+(Y+C2)*320] := Mem[Where:(X+C1+C*8)+(Y+C2)*320] XOR Color
ELSE If Method = 2 Then
Mem[Where:(X+C1+C*8*Size)+(Y+C2)*320] := Mem[Where:(X+C1+C*8)+(Y+C2)*320] OR Color
ELSE If Method = 3 Then
Mem[Where:(X+C1+C*8*Size)+(Y+C2)*320] := Mem[Where:(X+C1+C*8)+(Y+C2)*320] AND Color
ELSE If Method = 4 Then
Mem[Where:(X+C1+C*8*Size)+(Y+C2)*320] := Mem[Where:(X+C1+C*8)+(Y+C2)*320]+Color;
End;

FUNCTION Sqrt(Num : Double) : Real; {23 Clock Ticks, CRT.TPU uses 27}
CONST CG : Double = 1.0;
VAR NewGuess : Double;
Begin
While (ABS(CG-NewGuess) > 0.00005) Do
Begin
CG := NewGuess;
NewGuess := 0.5*(CG+Num/CG)
End;
Sqrt := NewGuess;
End;

Begin
{ Assign(F,'GAMEFONT.FNT');Reset(F,1);
Close(F);}
{ asm
Mov Ax, \$1130
Mov Bh, \$06
Int \$10
Mov FontSeg, Es
Mov FontOfs, Bp
end;}
For OldBank := 0 to 255 Do
Begin
SinLook[OldBank] := Sin(2*PI*OldBank/256);
CosLook[OldBank] := Cos(2*PI*OldBank/256);
End;
End.
[/code]

I had an updated version of this, but not sure where. I would recommed changing the virtual screens from VAddr1, VAddr2, VAddr3, VAddr4 to an array: VAddr[1..4] Of Word; and VirScr1, VirScr2, ... to VirScr[1..4] Of VPagePtr;
Easier to work with when coding.
There could be other little bugs in here. Like I said I haven't used it in quite a while.
· ·
• Posts: 268Member
There are quite a few tutorials about game design and assembly on the net if you google, I don't have the time to get into these, specially if they are already written. Time permitting I may write a platform game demo and post it here if there is enough interest... The code posted here by Phat Nat and myself should be enough to get you started.
· ·
• Posts: 29Member
Thank you mates ! You are great help ! I have 2 questions though... how to scroll the screen in other directions and why PUTIMAGE doesn't work with these programs ?