DataMuseum.dk

top - metrics - download

    Length: 4224 (0x1080)
    Types: TextFile
    Names: »GRAFIK2.PAS«

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

TextFile

PROGRAM GRAFIK;(*$A+*)
const
  hpix=640; vpix=240;
var
  radius,x1,y1,x2,y2,v,c1,c2,vinkel,spring: integer;
  xmin,xmax,xskiver,zmin,zmax,zskiver: integer;
  hx,hz,xstep,zstep,xoff,xfakt,yoff,ysub,yfakt: real;
  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);
begin
  if (xnu>=0) and (xnu<hpix) and (ynu>=0) and (ynu<vpix) then
    write(@27,'+',chr(ynu div 256),chr(ynu mod 256),chr(xnu div 256),
    chr(xnu mod 256));
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;
  retning2,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
          retning2:=nuy1; nux1:=nux1-signdx;
          repeat
            nux1:=nux1+signdx;
            setpix(nux1,round(retning2));
            retning2:=retning2+deltay;
          until nux1=nux2;
        end else
        begin
          retning2:=nux1; nuy1:=nuy1-signdy;
          repeat
            nuy1:=nuy1+signdy;
            setpix(round(retning2),nuy1);
            retning2:=retning2+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);
var
  t: integer;
begin
  v:=0; t:=0;
  vrad:=v*3.14159265/180;
  x1:=round(c1+radius*cos(vrad));
  y1:=round(c2+(radius*sin(vrad))/2);
  repeat
    v:=v+vinkel; t:=t+1;
    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;
  until t=spring;
end;

begin (* GRAFIK *)
  gotoxy(0,0);clreos;
  cirkel(300,109,200);
  gotoxy(0,0);clreos;
  korder(300,109,200,130,36);
  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(0,0);clreos;
  xmin:=-25; xmax:=25; xskiver:=50; zmin:=-25; zmax:=25; zskiver:=20;
  yoff:=227; ysub:=8; yfakt:=0.9;
  xstep:=(xmax-xmin)/xskiver; zstep:=(zmax-zmin)/zskiver;
  hz:=zmin-zstep;
  repeat
    yoff:=yoff-ysub; ysub:=ysub*yfakt;
    hz:=hz+zstep; hx:=xmin;
    y1:=round(yoff-(3*50*exp(-0.015*(sqr(hx)+sqr(hz)))));
    xoff:=545-2.5*y1; xfakt:=(240-xoff)/27;
    x1:=240+round(xoff+xfakt*hx);
    repeat
      hx:=hx+xstep;
      x2:=240+round(xoff+xfakt*hx);
      y2:=round(yoff-(3*50*exp(-0.015*(sqr(hx)+sqr(hz)))));
      linjestykke(x1,y1,x2,y2);
      x1:=x2; y1:=y2;
    until hx>=xmax;
  until hz>=zmax;
  gotoxy(0,0); write('TRYK EN TAST ');
  tast:=key;
  gotoxy(0,0); clreos;
end.
«eof»