Mad Pascal: Circles

[Gury]

Hi, here are two examples incorporating core and alternative circle routines written in Mad Pascal. Just for fun! How about putting your circle examples here, maybe new circle masterpieces and algorithms?

 

 

Example 1:

//
// Graphics 8 Circles Demonstration
// by Bostjan Gorisek 2015
//
// Developed in Mad-Pascal by Tebe / Madteam
//

// Alternative circle routine
procedure CircleEx(x : Word; y, r : Byte);
var
  a, c : Word;
begin
  c := 0; a := r - 1;
  while r >= c do begin
    PutPixel(x+c, y+r);
    PutPixel(x+c, y-r);
    PutPixel(x-c, y-r);
    PutPixel(x-c, y+r);
    PutPixel(x+r, y+c);
    PutPixel(x+r, y-c);
    PutPixel(x-r, y-c);
    PutPixel(x-r, y+c);
    Inc(c);
    a := a + 1 - c - c;
    if (a and $8000) <> 0 then begin
      Dec(r);
      a := a + r + r;
    end;
  end;
end;

// Graphics mode 8 with text window
procedure InitGraph8;
begin
asm
{	mwa #320 @command.mWidth
	mva #192 @command.mHeight
};
asm
{	stx @sp
	ldy #08
	ldx #$60
  lda #%00010000
	@graphics
	ldx @sp
};
end;

var
  i : Word;
begin
  InitGraph8;
  Poke(710, 0); Poke(712, 0);
  Poke(752,1);
  SetColor(1);
  WriteLn('1... Core circle first, alt. one next');
  Circle(30,20,20);
  CircleEx(72,20,20);
  Line(0,42,319,42);
  WriteLn('Press any key to continue!');
  repeat until KeyPressed;
  WriteLn('2... Core circle first, alt. one next');  
  Circle(40,74,30);
  CircleEx(120,74,30);
  WriteLn('Press any key to continue!');  
  repeat until keypressed;
  WriteLn('3... Core circle first, alt. one next');
  for i := 0 to 23 do begin
    Circle(70+i,100+i,20+i);
  end;
  for i := 0 to 23 do begin
    CircleEx(164+i,100+i,20+i);
  end;
  repeat until keypressed;  
end.

Example 2:

//
// Graphics 8 Circles Demonstration
// by Bostjan Gorisek 2015
//
// Developed in Mad-Pascal by Tebe / Madteam
//

// Alternative circle routine
procedure CircleEx(x : Word; y, r : Byte);
var
  a, c : Word;
begin
  c := 0; a := r - 1;
  while r >= c do begin
    PutPixel(x+c, y+r);
    PutPixel(x+c, y-r);
    PutPixel(x-c, y-r);
    PutPixel(x-c, y+r);
    PutPixel(x+r, y+c);
    PutPixel(x+r, y-c);
    PutPixel(x-r, y-c);
    PutPixel(x-r, y+c);
    Inc(c);
    a := a + 1 - c - c;
    if (a and $8000) <> 0 then begin
      Dec(r);
      a := a + r + r;
    end;
  end;
end;

// Graphics mode 8 with text window
procedure InitGraph8;
begin
asm
{	mwa #320 @command.mWidth
	mva #192 @command.mHeight
};
asm
{	stx @sp
	ldy #08
	ldx #$60
  lda #%00010000
	@graphics
	ldx @sp
};
end;

var
  i : Word;
begin
  InitGraph8;
  Poke(710, 0); Poke(712, 0);
  Poke(752,1);
  SetColor(1);  
  WriteLn('           Visual effect :)');
  for i := 0 to 18 do begin
    CircleEx(87+i,60+i,20+i*2);
    CircleEx(193+i,60+i,20+i*2);
  end;
  repeat until keypressed;  
end.

I modified InitGraph routine to invoke text window in graphics mode 8, which is disables in core graph.pas library.

 

 

circles.zip

[tebe]

good example, thx

 

p.s.

http://www.freepascal.org/docs-html/rtl/graph/initgraph.html

 

InitGraph - this function should be extended by an additional parameter

[funkheld]

Hello, wonderful Grafik.

 

Can you Grafik7 with text ?

 

thanks

[phaeron]

The graphics library in this application is doing a strange CIO call to S: with the command PUT RECORD ($09) and a length of 0 in order to write a byte from the A register to plot a pixel. This breaks under the current version of AltirraOS, which I can fix, but shouldn't this be using PUT CHARACTERS ($0B) instead? The special case behavior for length=0 is a documented in the OS Manual for PUT CHARACTERS, but not for PUT RECORD. Arguably, this is a bug in CIO, because according the documentation it should be writing an EOL instead.

[tebe]

mads/examples/libraries/graph_os/lib

 

authors: Slawomir 'SERO' Ritter, Jakub Cebula, Winfried Hofacker