DataMuseum.dk

top - metrics - download

    Length: 3584 (0xe00)
    Types: TextFile
    Names: »GRAFIK.PAS«

└─⟦a36acda55⟧ Bits:30004633 DEMO af COMAL og Pascal samt Butlers grafikfunktioner
    └─⟦this⟧ »GRAFIK.PAS« 

TextFile

PROGRAM GRAFIK;(*$A+*)
const
  hpix=640; vpix=240;
var
  radius,x1,y1,x2,y2,v,c1,c2,vinkel,spring: integer;
  vrad: real;
  tast: byte;
  
FUNCTION key: byte;
begin
  repeat until keypress;
  key:=bdosb(6,255);
end;

FUNCTION esc: boolean;
begin
  if keypress then esc:=(bdosb(6,255)=27) else esc:=false;
end;

PROCEDURE setpix(xnu,ynu: integer);
var
  ok: boolean;
  xk1,xk2,yk1,yk2: byte;
begin
  ok:=(xnu>=0) and (xnu<hpix) and (ynu>=0) and (ynu<vpix);
  if ok then
  begin
    xk1:=xnu div 256; xk2:=xnu mod 256; yk1:=ynu div 256; yk2:=ynu mod 256;
    write(@27,'+',chr(yk1),chr(yk2),chr(xk1),chr(xk2));
  end;
end;

PROCEDURE linjestykke(x1,y1,x2,y2: integer);
var
  nux1,nuy1,nux2,nuy2: integer;
  dx,dy,absdx,absdy,signdx,signdy,count,trin: integer;
  onscreen: boolean;
  trappe,deltax,deltay: real;
begin
    onscreen:=false;
    if (((x1>=0) and (x1<hpix)) or ((x2>=0) and (x2<hpix))) then
      if (((y1>=0) and (y1<=vpix)) or ((y2>=0) and (y2<vpix))) then
        onscreen:=true;
    if onscreen then
    begin
      nux1:=x1; nuy1:=y1; nux2:=x2; nuy2:=y2;
      dx:=nux2-nux1; dy:=nuy2-nuy1;
      absdx:=abs(dx); absdy:=abs(dy);
      if x2>=x1 then signdx:=1 else signdx:=-1;
      if y2>=y1 then signdy:=1 else signdy:=-1;
      if dx<>0 then deltay:=(y2-y1)/abs(x2-x1);
      if dy<>0 then deltax:=(x2-x1)/abs(y2-y1);
      if (dx=0) or (dy=0) then
        if (dx=0) and (dy=0) then
          setpix(nux1,nuy1)
        else
          if dx<>0 then
            if dx>0 then
              for count:=nux1 to nux2 do setpix(count,nuy1)
            else
              for count:=nux1 downto nux2 do setpix(count,nuy1)
          else
            if dy>0 then
              for count:=nuy1 to nuy2 do setpix(nux1,count)
            else
              for count:=nuy1 downto nuy2 do setpix(nux1,count)
      else
        if absdx>absdy then
        begin
          trappe:=nuy1; nux1:=nux1-signdx;
          repeat
            nux1:=nux1+signdx;
            setpix(nux1,round(trappe));
            trappe:=trappe+deltay;
          until nux1=nux2;
        end else
        begin
          trappe:=nux1; nuy1:=nuy1-signdy;
          repeat
            nuy1:=nuy1+signdy;
            setpix(round(trappe),nuy1);
            trappe:=trappe+deltax;
          until nuy1=nuy2;
        end;
    end;
end;

PROCEDURE cirkel(c1,c2,radius: integer);
begin
  x1:=round(c1+radius*cos(0));
  y1:=round(c2+radius*sin(0));
  for v:=1 to 360 do
  begin
    vrad:=v*3.14159265/180;
    x2:=round(c1+radius*cos(vrad));
    y2:=round(c2+(radius*sin(vrad))/2);
    linjestykke(x1,y1,x2,y2);
    x1:=x2; y1:=y2;
  end;
end;

PROCEDURE korder(c1,c2,radius,vinkel,spring: integer);
begin
  v:=0;
  repeat
    v:=v+spring;
    vrad:=v*3.14159265/180;
    x1:=round(c1+radius*cos(vrad));
    y1:=round(c2+(radius*sin(vrad))/2);
    vrad:=(v+vinkel)*3.14159265/180;
    x2:=round(c1+radius*cos(vrad));
    y2:=round(c2+(radius*sin(vrad))/2);
    linjestykke(x1,y1,x2,y2);
  until v>=360;
end;

begin (* GRAFIK *)
  gotoxy(0,0);clreos;
  cirkel(300,109,200);
  gotoxy(50,0); write('TRYK EN TAST ');
  tast:=key;
  gotoxy(0,0);clreos;
  korder(300,109,200,130,10);
  gotoxy(50,0); write('TRYK EN TAST ');
  tast:=key;
  gotoxy(0,0);clreos;
  x1:=0; x2:=0; y1:=0; y2:=210;
  repeat
    linjestykke(x1,y1,x2,y2);
    x2:=x2+20; y1:=y1+7;
  until y1>210;
  gotoxy(50,0); write('TRYK EN TAST ');
  tast:=key;
  gotoxy(0,0);clreos;
end.
«eof»