home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
mbug
/
mbug022.arc
/
GRAPHIC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1979-12-31
|
18KB
|
409 lines
{original code by
Eric Reaburn 6 November 1985 7:20 pm
modified for speed by D Breeze 20/may/86
}
{$A+}
procedure RestorePCG;
begin
inline ($3e/$01/ { ld a,01 }
$d3/$0b/ { out (0b),a }
$21/>$f000/ { ld hl,f000h }
$11/>$f800/ { ld de,f800h }
$7e/ { ld a,(hl) }
$2f/ { cpl }
$12/ { ld (de),a }
$13/ { inc de }
$23/ { inc hl }
$cb/$5c/ { bit 3,h }
$28/<-9/ { jr z,*-9 }
$3e/$00/ { ld a,0 }
$d3/$0b); { out (0b),a }
end; {RestorePCG}
PROCEDURE LORES;
begin
inline($21/>$f800/ { ld hl,f800h }
$0e/$80/ { ld c,80h }
$59/ { l1: ld e,c }
$16/$03/ { ld d,3 }
$af/ { l2: xor a }
$cb/$43/ { bit 0,e }
$28/<+2/ { jr z,l3 }
$f6/$f0/ { or 0f0h }
$cb/$4b/ { l3: bit 1,e }
$28/<+2/ { jr z,l4 }
$f6/$0f/ { or 0fh }
$c5/ { l4: push bc }
$4f/ { ld c,a }
$3e/01/ { ld a,1 }
$ba/ { cp d }
$79/ { ld a,c }
$c1/ { pop bc }
$28/<+4/ { jr z,l5 }
$06/$04/ { ld b,4 }
$18/<+2/ { jr l6 }
$06/$07/ { l5: ld b,7 }
$77/ { l6: ld (hl),a }
$23/ { inc hl }
$10/<-4/ { djnz l6 }
$cb/$0b/ { rrc e }
$cb/$0b/ { rrc e }
$15/ { dec d }
$20/<-39/ { jr nz,l2 }
$77/ { ld (hl),a }
$23/ { inc hl }
$0c/ { inc c }
$3e/$c0/ { ld a,c0 }
$b9/ { cp c }
$20/<-50); { jr nz,l1 }
end;
{____________________________________________________________________________}
PROCEDURE DOT(draw:boolean;X1,Y1:byte);
VAR
X3,Y3:byte;
a,B:BYTE;
screenloc,I:INTEGER;
BEGIN
{X3:=modd(X1,2)}
inline($06/08/ { ld b,8 }
$3a/x1/ { ld a,(x1) }
$5f/ { ld e,a }
$3e/02/ { ld a,2 }
$4f/ { ld c,a }
$af/ { xor a }
$cb/$13/ { l1: rl e }
$17/ { rla }
$91/ { sub c }
$30/<+1/ { jr nc,l2 }
$81/ { add a,c }
$10/<-9/ { l2: djnz l1 }
$32/x3/ { ld (x3),a }
{Y3:=modd(Y1,3)}
$06/08/ { ld b,8 }
$3a/y1/ { ld a,(y1) }
$5f/ { ld e,a }
$3e/03/ { ld a,3 }
$4f/ { ld c,a }
$af/ { xor a }
$cb/$13/ { l1: rl e }
$17/ { rla }
$91/ { sub c }
$30/<+1/ { jr nc,l2 }
$81/ { add a,c }
$10/<-9/ { l2: djnz l1 }
$32/y3/ { ld (y3),a }
{y1=y1/8}
$06/08/ { ld b,8 }
$3a/x1/ { ld a,(x1) }
$5f/ { ld e,a }
$3e/02/ { ld a,2 }
$4f/ { ld c,a }
$af/ { xor a }
$cb/$13/ { l1: rl e }
$17/ { rla }
$91/ { sub c }
$30/<+1/ { jr nc,l2 }
$81/ { add a,c }
$10/<-9/ { l2: djnz l1 }
$7b/ { ld a,e }
$17/ { rla }
$2f/ { cpl }
$32/x1/ { ld (x1),a }
{y1=y1/8}
$06/08/ { ld b,8 }
$3a/y1/ { ld a,(y1) }
$5f/ { ld e,a }
$3e/03/ { ld a,3 }
$4f/ { ld c,a }
$af/ { xor a }
$cb/$13/ { l1: rl e }
$17/ { rla }
$91/ { sub c }
$30/<+1/ { jr nc,l2 }
$81/ { add a,c }
$10/<-9/ { l2: djnz l1 }
$7b/ { ld a,e }
$17/ { rla }
$2f/ { cpl }
{set dot}
$21/>$f000/ { ld hl,f000 }
$47/ { ld b,a }
$04/ { inc b }
$11/>$0050/ { ld de,0050 }
$18/<+1/ { jr lp2 }
$19/ {lp1 add hl,de }
$10/<-3/ {lp2 djnz lp1 }
$16/00/ { ld d,0 }
$3a/x1/ { ld a,(x1) }
$5f/ { ld e,a }
$19/ { add hl,de }
$22/screenloc/ { ld (hl),hl }
$7e/ { ld a,(hl) }
$32/a/ { ld (a),a }
$fe/128/ { cp 128 }
$fa/>*+8/ { jp m,p1 }
$fe/128+63/ { cp 128+63 }
$3e/<+4/ { jr c,p1 }
$18/<+5/ { jr l2 }
$3e/128/ { p1 ld a,128 }
$32/a/ { ld (a),a }
$3a/y3/ { p2 ld a,(y3) }
$47/ { ld b,a }
$04/ { inc b }
$3a/x3/ { ld a,(x3) }
$3c/ { inc a }
$18/<+4/ { jr l2 }
$cb/$27/ { l1 sla a }
$cb/$27/ { sla a }
$10/<-6/ { l2 djnz l1 }
$32/b/ { ld (b),a }
$3a/draw/ { ld a,(draw) }
$fe/$01/ { cp 1 }
$28/<+11/ { jr z,lor }
$3a/b/ { ld a,(b) }
$2f/ { cpl }
$47/ { ld b,a }
$3a/a/ { ld a,(a) }
$a0/ { and b }
$18/<+8/ { jr fin }
$3a/b/ {lor ld a,(b) }
$47/ { ld b,a }
$3a/a/ { ld a,(a) }
$b0/ { or b }
$2a/screenloc/ {fin ld hl,(hl) }
$77); { ld (hl),a }
END;
(*IF draw THEN A:=(A OR B) ELSE A:=(A AND (255-B));*)
{____________________________________________________________________________}
function point(x1,y1:byte):boolean;
VAR
temp:boolean;
a,b,X3,Y3:byte;
begin
{X3:=modd(X1,2)}
inline($06/08/ { ld b,8 }
$3a/x1/ { ld a,(x1) }
$5f/ { ld e,a }
$3e/02/ { ld a,2 }
$4f/ { ld c,a }
$af/ { xor a }
$cb/$13/ { l1: rl e }
$17/ { rla }
$91/ { sub c }
$30/<+1/ { jr nc,l2 }
$81/ { add a,c }
$10/<-9/ { l2: djnz l1 }
$32/x3/ { ld (x3),a }
{Y3:=modd(Y1,3)}
$06/08/ { ld b,8 }
$3a/y1/ { ld a,(y1) }
$5f/ { ld e,a }
$3e/03/ { ld a,3 }
$4f/ { ld c,a }
$af/ { xor a }
$cb/$13/ { l1: rl e }
$17/ { rla }
$91/ { sub c }
$30/<+1/ { jr nc,l2 }
$81/ { add a,c }
$10/<-9/ { l2: djnz l1 }
$32/y3/ { ld (y3),a }
{y1=y1/8}
$06/08/ { ld b,8 }
$3a/x1/ { ld a,(x1) }
$5f/ { ld e,a }
$3e/02/ { ld a,2 }
$4f/ { ld c,a }
$af/ { xor a }
$cb/$13/ { l1: rl e }
$17/ { rla }
$91/ { sub c }
$30/<+1/ { jr nc,l2 }
$81/ { add a,c }
$10/<-9/ { l2: djnz l1 }
$7b/ { ld a,e }
$17/ { rla }
$2f/ { cpl }
$32/x1/ { ld (x1),a }
{y1=y1/8}
$06/08/ { ld b,8 }
$3a/y1/ { ld a,(y1) }
$5f/ { ld e,a }
$3e/03/ { ld a,3 }
$4f/ { ld c,a }
$af/ { xor a }
$cb/$13/ { l1: rl e }
$17/ { rla }
$91/ { sub c }
$30/<+1/ { jr nc,l2 }
$81/ { add a,c }
$10/<-9/ { l2: djnz l1 }
$7b/ { ld a,e }
$17/ { rla }
$2f/ { cpl }
{set dot}
$21/>$f000/ { ld hl,f000 }
$47/ { ld b,a }
$04/ { inc b }
$11/>$0050/ { ld de,0050 }
$18/<+1/ { jr lp2 }
$19/ {lp1 add hl,de }
$10/<-3/ {lp2 djnz lp1 }
$16/00/ { ld d,0 }
$3a/x1/ { ld a,(x1) }
$5f/ { ld e,a }
$19/ { add hl,de }
$7e/ { ld a,(hl) }
$32/a/ { ld (a),a }
$fe/128/ { cp 128 }
$fa/>*+8/ { jp m,p1 }
$fe/128+63/ { cp 128+63 }
$3e/<+4/ { jr c,p1 }
$18/<+5/ { jr l2 }
$3e/128/ { p1 ld a,128 }
$32/a/ { ld (a),a }
$3a/y3/ { p2 ld a,(y3) }
$47/ { ld b,a }
$04/ { inc b }
$3a/x3/ { ld a,(x3) }
$3c/ { inc a }
$18/<+4/ { jr l2 }
$cb/$27/ { l1 sla a }
$cb/$27/ { sla a }
$10/<-6/ { l2 djnz l1 }
$32/b); { ld (b),a }
if (a and b)=0 then point:=false else point:=true;
END;
{____________________________________________________________________________}
procedure Swap (var a,b:byte);
var
temp:byte;
begin
temp := a; a := b; b := temp;
end; {Swap}
{____________________________________________________________________________}
procedure Line (draw:boolean; x1,y1,x2,y2:byte);
{If "draw" is true, then draw a line from (x1,y1) to (x2,y2); else erase a
line from (x1,y1) to (x2,y2).}
var
x,y:byte;
xreal,yreal,incx,incy:real;
lx,ly:integer;
equiv:boolean;
begin
lx := x2 - x1; ly := y2 - y1; {length horizontal; length vertical}
if (lx <> 0) or (ly <> 0)
then begin {only if BOTH lx AND ly aren't zero}
if (lx <> 0) xor (ly <> 0)
then begin {only if EITHER lx OR ly is zero}
if lx = 0
then begin {vertical line}
if ly < 0
then Swap(y1,y2);
for y:=y1 to y2 do
dot(draw,x1,y);
end
else begin {horizontal line}
if lx < 0
then Swap(x1,x2);
for x:=x1 to x2 do
dot(draw,x,y1);
end;
end
else begin {NEITHER ly NOR lx are zero}
if ((lx < 0) and (ly < 0)) or ((lx > 0) and (ly > 0))
then equiv := true {if equivalent in sign, i.e. diagonal sloping from top left to bottom right}
else equiv := false; {else it's a diagonal sloping from bottom left to top right}
if abs(lx) >= abs(ly)
then begin {horizontal length => vertical length}
incy := abs(ly / lx);
if lx < 0
then begin {swap coordinates}
Swap(x1,x2); Swap(y1,y2);
end;
yreal := y1;
for x:=x1 to x2 do
begin
dot(draw,x,round(yreal));
if equiv then yreal := yreal + incy
else yreal := yreal - incy;
end;
end
else begin {vertical length > horizontal length}
incx := abs(lx / ly);
if ly < 0
then begin
Swap(x1,x2); Swap(y1,y2);
end;
xreal := x1;
for y:=y1 to y2 do
begin
dot(draw,round(xreal),y);
if equiv then xreal := xreal + incx
else xreal := xreal - incx;
end;
end;
end;
end
else dot(draw,x1,y1);
end; {Line}
{____________________________________________________________________________}
{____________________________________________________________________________}
procedure Arc (draw:boolean; centrex,centrey:integer; xradius,yradius:byte;
startangle,finishangle:real);
var
theta,inc:real;
x,y:integer;
begin
if (startangle >= 0) and (finishangle > startangle)
then begin
inc := 1 / ((xradius shl 1) + yradius);
theta := startangle;
repeat
y := round(sin(theta) * yradius); x := round(cos(theta) * xradius);
dot(draw,centrex+x,centrey-y);
theta := theta + inc;
until theta > finishangle;
end;
end; {Arc}
{____________________________________________________________________________}
procedure Box (draw:boolean; x,y,lx,ly:byte);
{If "draw" is true draw a box, else erase it. (x,y) are coordinates of the
upper left corner of the box, "lx" is width of the box, "ly" is height of the
box.}
begin
line(draw,x,y,x+lx,y);
line(draw,x,y,x,y+ly);
line(draw,x+lx,y,x+lx,y+ly);
line(draw,x,y+ly,x+lx,y+ly);
end; {Box}
{____________________________________________________________________________}
function Rad (degrees:integer) :real;
{Convert "degrees" to radians.}
begin
Rad := (degrees / 180) * pi;
end; {Rad}
