TEST PROGRAM.


Program TestDrawLines;
Uses fbDrawUnit, fbShapesUnit; 

var
	vColor : tColor;
	CurrentDrawPage: tDrawPage;
	aLine : tDrawObject;
	i : longint;
Begin
		CurrentDrawPage.init;
		vColor := 255;

	for i := 1 to 4 do
		begin
		aLine := NewLine(500, 500, 250*i ,0, vColor);
		DrawToPage(aLine, CurrentDrawPage);
		WriteToScreen(CurrentDrawPage);
		vColor := vColor*8 ;
		end;
end.

FRAMEBUFFER DRAW UNIT.

(*########################################################################*)

UNIT fbDrawUnit;

(*########################################################################*)
INTERFACE

USES	fbShapesUnit;

CONST	xMax = 1280 ;
		yMax = 1024 ;
        
TYPE
		tScanLine = Array[0..xMax] of tColor ;

		pDrawPage = ^tDrawPage ;
		tDrawPage = Object
			ScreenScan : Array[0..xMax, 0..yMax] of tColor;
			Background : tColor;
			Constructor init;
			Destructor destroy;
			end; { tDrawPage }

PROCEDURE DrawToPage ( aDrawObject : tDrawObject ; var aDrawPage : tDrawPage ) ;
PROCEDURE WriteToScreen ( aDrawPage : tDrawPage ) ;

(*########################################################################*)
IMPLEMENTATION

CONSTRUCTOR tDrawPage.init ;
	var thePixel, theScanLine : longint ;
	BEGIN
		for theScanLine := 0 to yMax do
	        begin
			for thePixel := 0 to xMax do ScreenScan[ thePixel, theScanLine ] := 0 ;
			end;
	END;

DESTRUCTOR tDrawPage.destroy;
	BEGIN
	END;


PROCEDURE DrawToPage( aDrawObject : tDrawObject; var aDrawPage : tDrawPage ) ;
	Var	pPixelListNow : pPixelObject ;
		PixelList : longint ;

	BEGIN
		pPixelListNow := aDrawObject.pStart ;
		for PixelList := 1 to aDrawObject.iCount do
			begin
			aDrawPage.ScreenScan[ pPixelListNow^.rPixel.x , pPixelListNow^.rPixel.y ] := pPixelListNow^.rPixel.color ;
			pPixelListNow := pPixelListNow^.pNextPixel ;
			end; { for PixelList }
	END ; { DrawToPage }


PROCEDURE WriteToScreen( aDrawPage : tDrawPage );
	Var	thePixel, theScanLine :longint ;
		Framebuffer :File ;
		aScanLine : tScanLine ;

	BEGIN
		Assign (Framebuffer,'/dev/fb0');
		Rewrite(Framebuffer, 2);
		for theScanLine:=0 to yMax do
			begin
			for thePixel := 0 to xMax do aScanLine[thePixel] := aDrawPage.ScreenScan[thePixel, theScanLine];
			BlockWrite (Framebuffer, aScanLine[1], xMax); 
			end; { for theScanLine = 0 to yMax }
		close(Framebuffer);
	END; { WriteToScreen }


(*########################################################################*)
{  Initialize Unit  }
begin
end.


FRAMEBUFFER SHAPES UNIT.

(*########################################################################*)

UNIT fbShapesUnit;

(*########################################################################*)
INTERFACE

CONST
	Blue = 255;

TYPE
	tColor = word;

	pPixel = ^tPixel;
	tPixel = Record
		x, y    : longint;					{ Pixel Address }
		color   : tColor;						{ expanded color }
		end; { tPixel }

	pPixelObject = ^tPixelObject ;			{ conforms to Linked List "NODE" ADT }
	tPixelObject = Object
		rPixel           : tPixel ;
		pNextPixel       : pPixelObject ;
		Constructor Init;
		Destructor Destroy ;
		end; { tPixelObject }

	pDrawObject = ^tDrawObject;
	tDrawObject = Object
		pStart		: pPixelObject;
		pEnd		: pPixelObject;
		iCount		: longint;
		Constructor Init;
		Destructor Destroy;
		end; { tDrawObject }

PROCEDURE EraseThisObject ( pThisDrawObject : pDrawObject ) ;

{ Shapes Creation Routines }
FUNCTION NewLine ( x0, y0, x1, y1 : longint; vColor: tColor ) : tDrawObject;
FUNCTION NewBox  ( x0, y0, x1, y1 : longint ) : tDrawObject;
FUNCTION NewCircle ( x, y, r : longint ) : tDrawObject;


(*########################################################################*)
IMPLEMENTATION

CONSTRUCTOR tPixelObject.Init ;
	BEGIN
		pNextPixel := nil ;
		rPixel.x := 0; rPixel.y := 0; rPixel.color := 255;
	END ;

DESTRUCTOR tPixelObject.Destroy ;
	BEGIN
	END ;

CONSTRUCTOR tDrawObject.Init;
	BEGIN
		pStart := nil ;
		pEnd	 := nil ;	
		iCount := 0	;
	END ;

DESTRUCTOR tDrawObject.Destroy ;
	BEGIN
	END ;


(*########################################################################*)

{ Make LINE }
        
PROCEDURE SwapEndPoints( var pt1, pt2 : tPixel );
	Var	temp : longint ;
	BEGIN
		temp    := pt2.x;
		pt2.x   := pt1.x;
		pt1.x   := temp;

		temp    := pt2.y;
		pt2.y   := pt1.y;
		pt1.y   := temp;
	END ; { SwapEndPoints }
        
        
PROCEDURE SlopeEqualsInfinity( var ThisLine : tDrawObject ; var pt1, pt2 : tPixel );
	Var	vPixel : tPixel ;	pThisPixelNow : pPixelObject ;
                
	BEGIN
		if (pt2.y < pt1.y) then SwapEndPoints(pt1, pt2);

		pThisPixelNow := ThisLine.pEnd ;

		vPixel := pt1 ;
		pThisPixelNow^.rPixel := vPixel ;
		Inc( ThisLine.iCount );

		repeat
			Inc( vPixel.y );
			pThisPixelNow^.pNextPixel := New( pPixelObject, init );
			pThisPixelNow := pThisPixelNow^.pNextPixel ;
			pThisPixelNow^.rPixel := vPixel ;
			Inc( ThisLine.iCount );
		until (vPixel.y = pt2.y);
		pThisPixelNow^.pNextPixel := nil ;
		ThisLine.pEnd := pThisPixelNow ;
	END; { SlopeEqualsInfinity }
        
        
PROCEDURE SlopeEqualsZero( var ThisLine : tDrawObject ; pt1, pt2 : tPixel  );
	Var	vPixel : tPixel ; pThisPixelNow : pPixelObject ;

	BEGIN
		if (pt2.x < pt1.x) then SwapEndPoints(pt1, pt2);

		pThisPixelNow := ThisLine.pEnd ;

		vPixel := pt1 ;
		pThisPixelNow^.rPixel := vPixel ;
		Inc( ThisLine.iCount );

		repeat
			Inc( vPixel.x );
			pThisPixelNow^.pNextPixel := New( pPixelObject, init );
			pThisPixelNow := pThisPixelNow^.pNextPixel ;
			pThisPixelNow^.rPixel := vPixel ;
			Inc( ThisLine.iCount);
		until (vPixel.x = pt2.x );
		pThisPixelNow^.pNextPixel := nil ;
		ThisLine.pEnd := pThisPixelNow ;
	END ; { SlopeEqualsZero }
        
        
PROCEDURE SlopeZeroToOne( var ThisLine : tDrawObject ; pt1, pt2 : tPixel  );
	Var	vPixel : tPixel ; pThisPixelNow : pPixelObject ; p, dx, dy, d2x, d2y : longint ;

	BEGIN { SlopeZeroToOne }
		if ( pt2.x < pt1.x ) then SwapEndPoints(pt1, pt2);
		dx := pt2.x - pt1.x ; dy := pt2.y - pt1.y ;
		d2x := 2* dx ; d2y := 2* dy ;
		p := d2y - dx ;

		pThisPixelNow := ThisLine.pEnd ;

		vPixel := pt1 ;
		pThisPixelNow^.rPixel := vPixel ;
		Inc( ThisLine.iCount );

		repeat
			Inc( vPixel.x );
			pThisPixelNow^.pNextPixel := New( pPixelObject, init );
			pThisPixelNow := pThisPixelNow^.pNextPixel ;

			if (p>0) then					{ Bresenham test condition }
				begin
				p := p + ( d2y - d2x ); 
				Inc( vPixel.y );
				end { if }
			else p := p + d2y ;

			pThisPixelNow^.rPixel := vPixel ;
			Inc( ThisLine.iCount );
		until ( vPixel.x = pt2.x );
		pThisPixelNow^.pNextPixel := nil ;
		ThisLine.pEnd := pThisPixelNow ;
	END ; { SlopeZeroToOne }
        
        
PROCEDURE SlopeGreaterThanOne( var ThisLine : tDrawObject ; pt1, pt2 : tPixel );
	Var	vPixel : tPixel ; pThisPixelNow : pPixelObject ; p, dx, dy, d2x, d2y : longint ;

	BEGIN { SlopeGreaterThanOne }
		if ( pt2.y < pt1.y ) then SwapEndPoints (pt1, pt2);
		dx := pt2.x - pt1.x ; dy := pt2.y - pt1.y ;
		d2x := 2* dx ; d2y := 2* dy ;
		p := d2x - dy;

		pThisPixelNow := ThisLine.pEnd ;

		vPixel := pt1 ;
		pThisPixelNow^.rPixel := vPixel ;
		Inc( ThisLine.iCount );

		repeat
			Inc( vPixel.y );
			pThisPixelNow^.pNextPixel := New( pPixelObject, init );
			pThisPixelNow := pThisPixelNow^.pNextPixel;

			if (p>0) then					{ Bresenham test condition } 
				begin
				p := p + ( d2x - d2y );
				Inc(vPixel.x);
				end { if }
 			else  p := p + d2x ; {changed**}

			pThisPixelNow^.rPixel := vPixel ;
			Inc( ThisLine.iCount ) ;
		until ( vPixel.y = pt2.y );
		pThisPixelNow^.pNextPixel := nil ;
		ThisLine.pEnd := pThisPixelNow ;
	END ; { SlopeGreaterThanOne }
        
        
PROCEDURE SlopeNegOneToZero (  var ThisLine : tDrawObject ; pt1, pt2 : tPixel );
	Var vPixel : tPixel ; pThisPixelNow : pPixelObject ; p, dx, dy, d2x, d2y : longint ;

	BEGIN { SlopeNegOneToZero }
		if ( pt2.x < pt1.x ) then SwapEndPoints (pt1, pt2);
		dx := pt2.x - pt1.x ; dy := pt2.y - pt1.y ;
		d2x := 2* dx ; d2y := 2* dy ;
		p := d2y + dx;

		pThisPixelNow := ThisLine.pEnd ;

		vPixel := pt1 ;
		pThisPixelNow^.rPixel := vPixel ;
		Inc( ThisLine.iCount );

		repeat
			Inc( vPixel.x );
			pThisPixelNow^.pNextPixel := New( pPixelObject, init );
			pThisPixelNow := pThisPixelNow^.pNextPixel ;

			if (p>0) then					{ Bresenham test condition }
				begin
				p := p - ( d2y + d2x );
				Dec(vPixel.y);
				end { if }
			else  p := p - d2y;

			pThisPixelNow^.rPixel := vPixel ;
			Inc( ThisLine.iCount );
		until (vPixel.x = pt2.x );
		pThisPixelNow^.pNextPixel := nil ;
		ThisLine.pEnd := pThisPixelNow ;
	END ; { SlopeNegOneToZero }
        
        
PROCEDURE SlopeLessThanNegOne (  var ThisLine : tDrawObject ; pt1, pt2 : tPixel );
	Var vPixel : tPixel ; pThisPixelNow : pPixelObject ; p, dx, dy, d2x, d2y : longint ;

	BEGIN { SlopeLessThanNegOne }

		if ( pt2.y < pt1.y ) then SwapEndPoints ( pt1, pt2 );
		dx := pt2.x - pt1.x ; dy := pt2.y - pt1.y ;
		d2x := 2* dx ; d2y := 2* dy ;
		p := d2x + dy;

		pThisPixelNow := ThisLine.pEnd ;

		vPixel := pt1 ;
		pThisPixelNow^.rPixel := vPixel ;
		Inc( ThisLine.iCount ) ;

		repeat
			Inc(vPixel.y);
			pThisPixelNow^.pNextPixel := New( pPixelObject, init );
			pThisPixelNow := pThisPixelNow^.pNextPixel ;

			if (p>0) then					{ Bresenham test condition }
				begin
				p := p - (d2x + d2y );
				Dec(vPixel.x);
				end { if }
			else p := p - d2x;

			pThisPixelNow^.rPixel := vPixel ;
			Inc( ThisLine.iCount ) ;
		until ( vPixel.y = pt2.y ) ;
		pThisPixelNow^.pNextPixel := nil ;
		ThisLine.pEnd := pThisPixelNow ;
	END ; { SlopeLessThanNegOne }


(*=========================================================*)

PROCEDURE RealSlope( var ThisLine : tDrawObject ; pt1, pt2 : tPixel );
	Var slope: real;

	BEGIN { RealSlope }
		slope := (pt2.y - pt1.y)/(pt2.x - pt1.x) ;

		If (slope > 1.0) then SlopeGreaterThanOne ( ThisLine, pt1, pt2 )
		else if (slope > 0.0) then SlopeZeroToOne ( ThisLine, pt1, pt2 )
		else if (slope < -1.0) then SlopeLessThanNegOne ( ThisLine, pt1, pt2 )
		else SlopeNegOneToZero ( ThisLine, pt1, pt2 ) ;

	END ; { RealSlope }

PROCEDURE MakeLine( var ThisLine : tDrawObject ; pt1, pt2 : tPixel );
	BEGIN { MakeLine}

		If ( pt1.x = pt2.x ) then SlopeEqualsInfinity( ThisLine, pt1, pt2 )
		else if ( pt1.y = pt2.y ) then SlopeEqualsZero( ThisLine, pt1, pt2 )
		else RealSlope( ThisLine, pt1, pt2 ) ;

	END ; { MakeLine() }


(*########################################################################*)

{ This Procedure JOINS Component Lines to make a Box }

PROCEDURE MakeBox ( var ThisBox : tDrawObject ; pt1, pt2 : tPixel ) ;
	Var Lines : tDrawObject ; vPixel1, vPixel2 : tPixel ;

	BEGIN { MakeBox }
		Lines := ThisBox;

		vPixel1 := pt1 ; vPixel2.x := pt2.x ; vPixel2.y := pt1.y ;
		MakeLine ( Lines, vPixel1, vPixel2 ) ;

		vPixel1 := vPixel2 ; vPixel2 := pt2 ;
		MakeLine ( Lines, vPixel1, vPixel2 ) ;

		vPixel1 := vPixel2 ; vPixel2.x := pt1.x ; vPixel2.y := pt2.y ;
		MakeLine ( Lines, vPixel1, vPixel2 ) ;

		vPixel1 := vPixel2 ; vPixel2 := pt1 ;
		MakeLine ( Lines, vPixel1, vPixel2 ) ;

		ThisBox := Lines ;

        END ; { MakeBox }

(*########################################################################*)

{ Make CIRCLE }

FUNCTION ReflectCircle ( FirstOctant : tDrawObject ; Center : tPixel ) : tDrawObject ;
	type Octants = ( Octant1, Octant2, Octant3, Octant4, Octant5, Octant6, Octant7, Octant8 );

	Var vPixel : tPixel ;
		i, x0, y0, x, y, dx, dy : longint ;
		pThisPixelNow, pFirstOctantIndex: pPixelObject ; ThisCircleNow : tDrawObject ;
		Octant : Octants ;


	BEGIN { Circle Reflection and Construction }
		ThisCircleNow.Init;
		x0 := Center.x ; y0 := Center.y ;

		pThisPixelNow := New( pPixelObject, init );
		ThisCircleNow.pStart := pThisPixelNow ;
		ThisCircleNow.pEnd := pThisPixelNow ;

		for Octant := Octant1 to Octant8 do
			begin { for octant }
			pFirstOctantIndex := FirstOctant.pStart ;

			for i := 1 to FirstOctant.iCount do
				begin

				x := pFirstOctantIndex^.rPixel.x ;
				y := pFirstOctantIndex^.rPixel.y ;

				CASE Octant of
					Octant1		: begin
									dx := x0 + x;
									dy := y0 + y;
									end;
					Octant2		: begin
									dx := x0 + y;
									dy := y0 + x;
									end;
					Octant3		: begin
									dx := x0 - y;
									dy := y0 + x;
									end;
					Octant4		: begin
									dx := x0 - x;
									dy := y0 + y;
									end;
					Octant5		: begin
									dx := x0 - x;
									dy := y0 - y;
									end;
					Octant6		: begin
									dx := x0 - y;
									dy := y0 - x;
									end;
					Octant7		: begin
									dx := x0 + y;
									dy := y0 - x;
									end;
					Octant8		: begin
									dx := x0 + x;
									dy := y0 - y;
									end;
					end; {Case}

				vPixel.x := dx;	vPixel.y := dy;
				pThisPixelNow^.rPixel := vPixel ;
				Inc(ThisCircleNow.iCount);

				pThisPixelNow^.pNextPixel := New( pPixelObject, init );
				pThisPixelNow := pThisPixelNow^.pNextPixel ;
				

				pFirstOctantIndex := pFirstOctantIndex^.pNextPixel ;

				end; { for count }
			end; { for octant }
		ReflectCircle := ThisCircleNow ;
	END;  { Circle Reflection }

(*=========================================================*)

PROCEDURE MakeCircle ( var ThisCircle : tDrawObject ; Center : tPixel ; Radius : longint ); 
	Var vPixel : tPixel ; pThisPixelNow : pPixelObject ; p : longint ; FirstOctant : tDrawObject;

	BEGIN
		p := 3 - 2 * Radius;

		pThisPixelNow := ThisCircle.pEnd; ;
		vPixel.y := 0; vPixel.x := Radius;
		pThisPixelNow^.rPixel := vPixel ;
		Inc( ThisCircle.iCount );

		repeat

			if (p < 0) then p := p + 4 * (vPixel.y) + 6
			else
				begin
				p := p + 4 * (vPixel.y - vPixel.x) + 10;
				Dec( vPixel.x ) ;
				end;{ else }

			pThisPixelNow^.pNextPixel := New( pPixelObject, init );
			pThisPixelNow := pThisPixelNow^.pNextPixel ;
			Inc( vPixel.y );

			pThisPixelNow^.rPixel := vPixel ;
			Inc(ThisCircle.iCount );
		until ( vPixel.y > vPixel.x );

		pThisPixelNow^.pNextPixel := nil ;
		ThisCircle.pEnd := pThisPixelNow ;

		FirstOctant := ThisCircle;
        ThisCircle := ReflectCircle ( FirstOctant, Center );			{ This Procedure JOINS Component Arcs to make a Circle }

	END; { MakeCircle }

(*########################################################################*)
{ Interface Routines }


PROCEDURE EraseThisObject( pThisDrawObject : pDrawObject );
        BEGIN
        END;

(*=========================================================*)


{ Shapes Routines }

FUNCTION NewLine ( x0, y0, x1, y1 : longint ; vColor : tColor) : tDrawObject;
	Var	ThisLine : tDrawObject ; Pixel1, Pixel2 : tPixel ;

	BEGIN
		Pixel1.x := x0 ;	Pixel1.y := y0 ;	Pixel1.color := vColor ;
		Pixel2.x := x1 ;	Pixel2.y := y1 ;	Pixel2.color := vColor ;

		ThisLine.init ;
		ThisLine.pStart := New( pPixelObject, init ); { the start pointer for the Linked List }
		ThisLine.pEnd := ThisLine.pStart ;

		MakeLine( ThisLine, pixel1, pixel2 );
		NewLine := ThisLine ;
	END ; { NewLine }


FUNCTION NewBox ( x0, y0, x1, y1 : longint ) : tDrawObject;
	Var	ThisBox : tDrawObject ;	Pixel1, Pixel2 : TPixel ;
                        
	BEGIN
		Pixel1.x := x0 ;	Pixel1.y := y0 ;
		Pixel2.x := x1 ;	Pixel2.y := y1 ;

		ThisBox.init ;
		ThisBox.pStart := New( pPixelObject, init ) ; { the start pointer for the Linked List }
		ThisBox.pEnd := ThisBox.pStart ;

		MakeBox( ThisBox, pixel1, pixel2 ) ;
		NewBox := ThisBox ;
	END ; { NewBox }


FUNCTION NewCircle( x, y, r : longint ) : tDrawObject;
	Var	ThisCircle : tDrawObject ;	Center  : tPixel ;

	BEGIN
		Center.x := x ;	Center.y := y ;

		ThisCircle.init;
		ThisCircle.pStart := New( pPixelObject, init ); { the start pointer for the Linked List }
		ThisCircle.pEnd := ThisCircle.pStart ;

		MakeCircle ( ThisCircle, Center, r ); 
		NewCircle := ThisCircle ;
	END ; { NewCircle }



{ Initialize Unit }

BEGIN

END .

{ End of Unit }