home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
MBUG
/
MBUG013.ARC
/
WCURVE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1979-12-31
|
5KB
|
187 lines
program W_CURVE(COLOUR);
{ Demonstration program in Turbo Pascal
for the MicroBee by Bob Burt
Program to set up PCG on the MicroBee for
LORES graphics and PLOT between any pair
of x,y coordinates, assuming a screen with
80 x 24 format. This version operates with
a plot routine which utilises integer type
variables to speed up the plotting, and a
real variable for the x coordinate when
the value exceeds 128
x coordinate range: 0 to 159
y coordinate range: 0 to 71
0,0 at top left of screen
IMPORTANT : Compiler switch A must be set
to negative for the RECURSIVE procedures
and MAIN code ONLY !
This is a colour version, using procedures
developed for the MicroBee }
const
w0 = 160; h0 = 64;
title = '*** W Curves ***';
var
i,n : byte;
h,t1,t2,w,x,y,x0,y0 : integer;
{$C-}
{$I normal.pro}
{$I lores80.pro}
{$I draw.pro}
{$I ploti2.pro}
{$I colinit.pro}
{$A-}
procedure B(i : byte); forward;
procedure C(i : byte); forward;
procedure D(i : byte); forward;
procedure A(i : byte);
label 9,19;
begin if i > 0 then
begin
if i > 1 then begin
A(i - 1); goto 9
end;
t1 := x+w; plot(x,y,t1,y); x := t1; goto 19;
9: t2 := y-h; plot(x,y,x,t2); y := t2;
t1 := x+w; plot(x,y,t1,y); x := t1; B(i - 1);
t1 := x+w; plot(x,y,t1,y); x := t1; D(i - 1);
t1 := x+w; plot(x,y,t1,y); x := t1;
t2 := y+h; plot(x,y,x,t2); y := t2; A(i - 1);
19:end
end; {A(i)}
procedure B;
label 9,19;
begin if i > 0 then
begin
if i > 1 then begin
B(i - 1); goto 9
end;
t2 := y-h; plot(x,y,x,t2); y := t2; goto 19;
9: t1 := x-w; plot(x,y,t1,y); x := t1;
t2 := y-h; plot(x,y,x,t2); y := t2; C(i - 1);
t2 := y-h; plot(x,y,x,t2); y := t2; A(i - 1);
t2 := y-h; plot(x,y,x,t2); y := t2;
t1 := x+w; plot(x,y,t1,y); x := t1; B(i - 1);
19:end
end; {B(i)}
procedure C;
label 9,19;
begin if i > 0 then
begin
if i > 1 then begin
C(i - 1); goto 9
end;
t1 := x-w; plot(x,y,t1,y); x := t1; goto 19;
9: t2 := y+h; plot(x,y,x,t2); y := t2;
t1 := x-w; plot(x,y,t1,y); x := t1; D(i - 1);
t1 := x-w; plot(x,y,t1,y); x := t1; B(i - 1);
t1 := x-w; plot(x,y,t1,y); x := t1;
t2 := y-h; plot(x,y,x,t2); y := t2; C(i - 1);
19:end
end; {C(i)}
procedure D;
label 9,19;
begin if i > 0 then
begin
if i > 1 then begin
D(i - 1); goto 9
end;
t2 := y+h; plot(x,y,x,t2); y := t2; goto 19;
9: t1 := x+w; plot(x,y,t1,y); x := t1;
t2 := y+h; plot(x,y,x,t2); y := t2; A(i - 1);
t2 := y+h; plot(x,y,x,t2); y := t2; C(i - 1);
t2 := y+h; plot(x,y,x,t2); y := t2;
t1 := x-w; plot(x,y,t1,y); x := t1; D(i - 1);
19:end
end; {D(i)}
procedure set_col;
const
next_line = $50;
var
col_ram,left,right : integer;
line,loc,colour : byte;
begin
port[8] := 78; {colour RAM on, RGB full}
left := $F800; right := $F84F; colour := 0;
for col_ram := left to right do
mem[col_ram] := 4; {line 1, red on black}
for col_ram := left + next_line*21 to right + next_line*21 do
mem[col_ram] := 4;
for line := 2 to 21 do
begin
mem[left + next_line] := 4; {left side }
mem[right + next_line] := 4; {right side}
colour := colour + 1;
if colour = 16 then colour := 1; {avoid black on black!}
for loc := 1 to 78 do
mem[left + next_line + loc] := colour;
left := left + next_line; right := right + next_line
end; {for line}
port[8] := 14; {PCG ram on, RGB full}
end; {procedure set_col}
begin {main}
clrscr;
colinit; {initialise colour procedure}
color(3,3,0);
gotoxy(29,8);
write(title);
repeat
gotoxy(14,12); color(4,6,0);
write(^G,'What order of Curve do you require (1 to 4 only) : ');
readln(n)
until (n > 0) and (n < 5);
gotoxy(49,24); {establish cursor position clear of graphics}
set_col; {set up colour RAM values}
i := 0; h := h0 div 2; w := w0 div 2;
x := 3*w div 2; y := 3*h div 2;
lores80;
plot(1,0,159,0); {plot frame}
plot(1,64,159,64);
plot(1,1,1,63);
plot(159,1,159,63);
repeat
i := i + 1;
h := h div 2; w := w div 2;
x := x - 3*w div 2; y := y + h div 2;
A(i); t2 := y-h; plot(x,y,x,t2); y := t2;
t1 := x+w; plot(x,y,t1,y); x := t1;
B(i); t1 := x-w; plot(x,y,t1,y); x := t1;
t2 := y-h; plot(x,y,x,t2); y := t2;
C(i); t2 := y+h; plot(x,y,x,t2); y := t2;
t1 := x-w; plot(x,y,t1,y); x := t1;
D(i); t1 := x+w; plot(x,y,t1,y); x := t1;
t2 := y+h; plot(x,y,x,t2); y := t2
until i = n;
color(6,1,7);
gotoxy(33,24);
write(title);
repeat until keypressed;
clrscr; {replace chr(128) with chr(32)}
normal;
writeln(^G)
end. {main}