DataMuseum.dk

top - metrics - download

    Length: 8320 (0x2080)
    Types: TextFile
    Names: »PUFDISPL.LIB«

└─⟦456974178⟧ Bits:30002875 Pascal-bibliotek til tegning af streg-grafik på Piccoline
    └─⟦this⟧ »PUFDISPL.LIB« 

TextFile

(*INCLUDE FILE PUFDISPL.LIB *)

æ Denne fil indeholder rutiner, til fremvisning af et billede fremstillet  å
æ med PUFTEGN.                                                             å
æ Prøv f. eks. at compilere kildeteksten EXAMPLE.PAS, som includerer denne å
æ kildetekst sammen med kildeteksten PUFGSX.PAS, der indeholder de dele af å
æ GSX, som er nødvendige for at vise et billede.                           å

type
 pufstr15=stringÆ15Å;
 
PROCEDURE DISPLAY(billednavn:pufstr15); 
type
 str2=stringÆ2Å;str39=stringÆ39Å;
 bilrec=record
  kommando:byte;
  k:arrayÆ1..2Å of integer;
 end;
const
 aspekt=0.7; (* Skaermkonstant *)
var
 regs:record
  ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
 end;
 tmin,tmax,xer,yer,xspring,yspring:integer;
 fpoints,step,nutype,ox,oy,nx,ny:integer;
 chw,chh,clw,clh:integer;
 tline:str39;
 corners:arrayÆ1..1000Å of coor;
 baselin:bilrec;
 billedfil:file of bilrec;
 ll,nu,count:byte;
 ch:char;
 contour,fillgem:boolean;
 xy:arrayÆ1..37Å of coor;
 iofejl,i,txwidth,txshadow,txcolour,fcolour,lcolour:integer;
 buetal:arrayÆ1..36,1..2Å of real;

 PROCEDURE BUEINIT;
 var
  bue:integer;
 begin
  for bue:=1 to 36 do begin
   buetalÆbue,1Å:=aspekt*cos(10*bue*pi/180);
   buetalÆbue,2Å:=sin(10*bue*pi/180);
  end;
 end;
   
 PROCEDURE LINE(x1,y1,x2,y2:integer);
 begin
  xyÆ1Å.x:=x1;
  xyÆ1Å.y:=y1;
  xyÆ2Å.x:=x2;
  xyÆ2Å.y:=y2;
  POLYLINE(2,xy);
 end;

 PROCEDURE BOX(x1,y1,x2,y2:integer);
 begin
  xyÆ1Å.x:=x1;
  xyÆ1Å.y:=y1;
  xyÆ2Å.x:=x1;
  xyÆ2Å.y:=y2;
  xyÆ3Å.x:=x2;
  xyÆ3Å.y:=y2;
  xyÆ4Å.x:=x2;
  xyÆ4Å.y:=y1;
  xyÆ5Å:=xyÆ1Å;
  POLYLINE(5,xy);
 end;

 PROCEDURE RUND(x1,y1,x2,y2:integer);
 var
  bue,radius:integer;
  xt,yt,xt2,yt2:real;
 begin
  xt:=x1/aspekt;yt:=y1;xt2:=x2/aspekt;yt2:=y2;
  if sqrt(sqr(xt-xt2)+sqr(yt-yt2))>maxint then
   radius:=maxint
  else
   radius:=round(sqrt(sqr(xt-xt2)+sqr(yt-yt2)));
  if x1+radius*aspekt<=maxint then
   x2:=round(x1+radius*aspekt)
  else
   x2:=maxint;
  y2:=y1;
  xyÆ1Å.x:=x2;xyÆ1Å.y:=y2;
  for bue:=1 to 36 do begin
   xt:=x1+radius*buetalÆbue,1Å;
   yt:=y1+radius*buetalÆbue,2Å;
   if xt<=maxint then
    if xt<0 then
     xyÆ1+bueÅ.x:=0
    else
    xyÆ1+bueÅ.x:=round(xt)
   else
    xyÆ1+bueÅ.x:=maxint;
   if yt<=maxint then
    if yt<0 then
     xyÆ1+bueÅ.y:=0
    else
     xyÆ1+bueÅ.y:=round(yt)
   else
    xyÆ1+bueÅ.y:=maxint;
  end;
  POLYLINE(37,xy);
 end;

 PROCEDURE SKYGGESKRIFT(ox,oy:integer;tekst:str39);
 var
  st,p1,p2:byte;
  sx,sy:integer;
  
  PROCEDURE TEGNFLADE(vx,vy:integer;bredde:byte;indepth:boolean);
  begin
   sx:=vx;
   for p1:=1 to bredde do begin
    sy:=vy;
    for p2:=1 to bredde do begin
     GTEXT(sx,sy,tekst);
     sy:=sy-yspring;
    end;
    sx:=sx-xspring;
    if indepth then vy:=vy-yspring;
   end;
  end;
  
 begin (* SKYGGESKRIFT *)
  if txshadow>0 then begin
   TEXTCOLOR(fcolour);
   TEGNFLADE(ox+(txwidth+txshadow-1)*xspring,oy+(txwidth+txshadow-1)*yspring,txwidth,false);
   TEGNFLADE(ox+(txshadow-1)*xspring,oy+((txwidth+txshadow-2)*yspring),txshadow,true);
   TEGNFLADE(ox+(txwidth+txshadow-2)*xspring,oy+(txshadow-1)*2*yspring,txshadow,true);
   TEXTCOLOR(txcolour);
  end;
  TEGNFLADE(ox+(txwidth-1)*xspring,oy+(txwidth-1)*yspring,txwidth,false);
 end;

PROCEDURE PALETTE(klatnr,nufarve:integer);
var
 oldfarve,pil,red,green,blue:integer;
begin
 red:=0;green:=0;blue:=0;
 for pil:=1 to 4 do begin
  oldfarve:=nufarve;
  nufarve:=nufarve div 2;
  if (oldfarve-2*nufarve=1) then begin
   if pil=1 then blue:=1;
   if pil=2 then green:=1;
   if pil=3 then red:=1;
   if pil=4 then
    if red=1 then
     red:=red+500
    else
     if green=1 then
      green:=green+500
     else
      if blue=1 then blue:=blue+500;
  end;
 end;
 SETCOLOR(klatnr,red,green,blue);
end;

PROCEDURE SETUP;
begin
 fillgem:=false;contour:=false;
 txwidth:=1;txshadow:=0;txcolour:=1;fcolour:=1;lcolour:=1;
 step:=0;fpoints:=0;
 PALETTE(0,0);
 PALETTE(1,4);
 PALETTE(2,2);
 PALETTE(3,1);
 LINECOLOR(1);LINETYPE(1);FILLCOLOR(1);FILLTYPE(1);
 TEXTCOLOR(1);CHARUPVEC(0);CHARHEIGHT(tmin*yspring,chw,chh,clw,clh);
end;
 
 PROCEDURE DRAWTO;
 begin
  nx:=baselin.kÆ1Å;ny:=baselin.kÆ2Å;
  LINE(ox,oy,nx,ny);
  if fillgem then begin
   fpoints:=fpoints+1;
   cornersÆfpointsÅ.x:=nx;cornersÆfpointsÅ.y:=ny;
  end;
  ox:=nx;oy:=ny;
 end;
 
 FUNCTION DSCRAMB(bnr:byte):str2;
 begin
  DSCRAMB:=chr(hi(baselin.kÆbnrÅ))+chr(lo(baselin.kÆbnrÅ));
 end;

begin (* DISPLAY *)
 OPENWS(1);
 tmin:=wsptsoutÆ1Å.y;
 tmax:=wsptsoutÆ2Å.y;
 tmin:=tmin div 128;
 tmax:=tmax div 128;
 xer:=wsintoutÆ1Å;
 yer:=wsintoutÆ2Å;
 xspring:=round(maxint/xer);
 yspring:=round(maxint/yer);
 BUEINIT;
 assign(billedfil,billednavn+'.PUF');
 (* Set file attribut UNLOCKED *)
 memÆseg(billedfil):ofs(billedfil)+17Å:=memÆseg(billedfil):ofs(billedfil)+17Å+128;
 (*$I-*)
 reset(billedfil);
 if iores=0 then begin
  SETUP;  
  while not eof(billedfil) do begin
   step:=step+1;
   read(billedfil,baselin);
   nutype:=baselin.kommando;
   case nutype of
    0:begin (*PALETTE*)
      PALETTE(baselin.kÆ1Å,baselin.kÆ2Å);
     end;
    1:begin (*LINECOLOUR*)
      lcolour:=baselin.kÆ1Å;
      LINECOLOR(lcolour);
     end;
    2:begin (*FILLCOLOUR*)
      fcolour:=baselin.kÆ1Å; 
      FILLCOLOR(fcolour);
     end;
    3:begin (*TEGNCOLOUR*)
      txcolour:=baselin.kÆ1Å;
      TEXTCOLOR(txcolour);
     end;
    5:begin (*LINJETYPE*)
      LINETYPE(baselin.kÆ1Å);
     end;
    6:begin (*FILLTYPE*)
      FILLTYPE(baselin.kÆ1Å);
      FILLSTYLE(baselin.kÆ2Å);
     end;
    7:begin (*TEGNTYPE*)
      CHARUPVEC(hi(baselin.kÆ1Å)*50);
      CHARHEIGHT(lo(baselin.kÆ1Å)*yspring,chw,chh,clw,clh);
      txwidth:=hi(baselin.kÆ2Å);
      txshadow:=lo(baselin.kÆ2Å);
     end;
    20:begin (*STARTPOINT*)
      ox:=baselin.kÆ1Å;oy:=baselin.kÆ2Å;
      if fillgem then begin
       fpoints:=1;
       cornersÆfpointsÅ.x:=ox;cornersÆfpointsÅ.y:=oy;
      end;
     end;
    21:DRAWTO;
    30,40,50:begin (*POLYGON/BOX/CIRKEL - BEGYND*)
      fillgem:=(baselin.kÆ1Å=1);
      contour:=(fillgem and (baselin.kÆ2Å=1));
     end;
    31:begin (*POLYGONSLUT*)
      if fillgem then begin
       POLYFILL(fpoints,corners);
       if contour then POLYLINE(fpoints,corners);
       fillgem:=false;contour:=false;fpoints:=0;
      end;
     end;
    41:begin (*BOXSLUT*)
      nx:=baselin.kÆ1Å;ny:=baselin.kÆ2Å;
      BOX(ox,oy,nx,ny);
      if fillgem then begin
       POLYFILL(5,xy);
       if contour then POLYLINE(5,xy);
       fillgem:=false;contour:=false;
      end;
      ox:=nx;oy:=ny;
     end;
    51:begin (*CIRKELSLUT*)
      nx:=baselin.kÆ1Å;ny:=baselin.kÆ2Å;
      RUND(ox,oy,nx,ny);
      if fillgem then begin
       POLYFILL(37,xy);
       if contour then POLYLINE(37,xy);
       fillgem:=false;contour:=false;
      end;
      ox:=nx;oy:=ny;
     end;
    60,70:begin (*SKRIV TEKST og KOMMENTAR *)
      ox:=baselin.kÆ1Å;oy:=baselin.kÆ2Å;
      step:=step+1;
      read(billedfil,baselin);
      ll:=baselin.kommando;
      tline:=DSCRAMB(1)+DSCRAMB(2);
      nu:=4;
      while (nu<ll) and not eof(billedfil) do begin
       step:=step+1;
       read(billedfil,baselin);
       tline:=tline+chr(baselin.kommando)+DSCRAMB(1)+DSCRAMB(2);
       nu:=len(tline);
      end;
      if nutype=60 then begin
       tline:=copy(tline,1,ll);
       if txwidth>1 then
        SKYGGESKRIFT(ox,oy,tline)
       else
        GTEXT(ox,oy,tline);
      end;
     end;
    61,71:begin (* SLUT TEKST og SLUT KOMMENTAR *)
     end;
    99:CLEARWS; (* RYD SKÆRM *)
    100:begin   (* PAUSE *)
     write(@7);
     if baselin.kÆ1Å=1 then begin
      gotoxy(0,23);write('PAUSE - TRYK EN TAST');
      read(kbd,ch);
      gotoxy(0,23);write('                    ');
     end else begin
      (* Her udnyttes en evt. pausevaerdi ikke!!!! *)
      (* Hvis dette ønskes, findes vaerdien her i baselin.kÆ2Å *)
      read(kbd,ch);
     end;
    end;
   end;
  end;  
  regs.cx:=16;
  regs.ds:=seg(billedfil);
  regs.dx:=ofs(billedfil)+12;
  swint(224,regs); (* close(billedfil); *)
 end;
 (*$I+*)
end; (* DISPLAY *)
«eof»