home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PAS_0693 / B-SPLINE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-30  |  3KB  |  94 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 319 of 434
  3. From : Sean Palmer                         1:104/123.0          08 Jun 93  00:00
  4. To   : All
  5. Subj : fun with B-Splines
  6. ────────────────────────────────────────────────────────────────────────────────
  7. I was just toying around with a B-Spline curve routine I got out of an
  8. old issue of BYTE, and thought it was pretty neat. I changed it to use
  9. fixed point fractions instead of reals, and optimized it some...
  10.  
  11. Try it! Play with it! Tell me what you think...
  12.  
  13. I was going to make it write my name on the screen in cursive but I'm
  14. too lazy... 8)
  15.  
  16. If anyone has seen a faster B-Spline routine, let me know.}
  17.  
  18. {by Sean Palmer}
  19. {public domain}
  20.  
  21. var color:byte;
  22. procedure plot(x,y:word);begin
  23.  mem[$A000:y*320+x]:=color;
  24.  end;
  25.  
  26. type
  27.  coord=record x,y:word; end;
  28.  CurveDataRec=array[0..65521 div sizeof(coord)]of coord;
  29.  
  30. function fracMul(f,f2:word):word;Inline(
  31.   $58/                   {pop ax}
  32.   $5B/                   {pop bx}
  33.   $F7/$E3/               {mul bx}
  34.   $89/$D0);              {mov ax,dx}
  35.  
  36. function mul(f,f2:word):longint;inline(
  37.   $58/                   {pop ax}
  38.   $5B/                   {pop bx}
  39.   $F7/$E3);              {mul bx}
  40.  
  41.  
  42. const nSteps=1 shl 8;  {about 8 for smoothness (dots), 4 for speed (lines)}
  43.  
  44. procedure drawBSpline(var d0:coord;nPoints:word);
  45.  const nsa=$10000 div 6; nsb=$20000 div 3;
  46.  const step=$10000 div nSteps;
  47.  var
  48.   i,xx,yy:word;
  49.   t1,t2,t3:word;
  50.   c1,c2,c3,c4:word;
  51.   d:curveDataRec absolute d0;
  52. begin
  53.  t1:=0; color:=32+2;
  54.  for i:=0 to nPoints-4 do begin
  55.  
  56. {algorithm converted from Steve Enns' original Basic subroutine}
  57.  
  58.   repeat
  59.    t2:=fracMul(t1,t1); t3:=fracMul(t2,t1);
  60.    c1:=(integer(t2-t1)div 2)+nsa-fracmul(nsa,t3);
  61.    c2:=(t3 shr 1)+nsb-t2;
  62.    c3:=((t2+t1-t3)shr 1)+nsa;
  63.    c4:=fracmul(nsa,t3);
  64.    xx:=(mul(c1,d[i].x)+mul(c2,d[i+1].x)
  65.        +mul(c3,d[i+2].x)+mul(c4,d[i+3].x))shr 16;
  66.    yy:=(mul(c1,d[i].y)+mul(c2,d[i+1].y)
  67.        +mul(c3,d[i+2].y)+mul(c4,d[i+3].y))shr 16;
  68.    plot(xx,yy);
  69.    inc(t1,step);
  70.    until t1=0;  {this is why nSteps must be even power of 2}
  71.   inc(color);
  72.   end;
  73.  end;
  74.  
  75. const pts=24; {number of points} {chose this because of colors}
  76.  
  77. var c:array[-1..2+pts]of coord;
  78. var i:integer;
  79. begin
  80.  asm mov ax,$13; int $10; end;  {init vga/mcga graphics}
  81.  randomize;
  82.  for i:=1 to pts do with c[i] do begin
  83.  {x:=i*(319 div pts);}    {for precision demo}
  84.   x:=random(320);               {for fun demo}
  85.   y:=random(200);
  86.   end;
  87. {for i:=1 to pts div 2 do c[i*2+1].y:=c[i*2].y;}    {fit closer}
  88.  for i:=1 to pts do with c[i] do begin color:=i+32; plot(x,y); end;
  89. {replicate end points so curves fit to input}
  90.  c[-1]:=c[1]; c[0]:=c[1]; c[pts+1]:=c[pts]; c[pts+2]:=c[pts];
  91.  drawBSpline(c[-1],pts+4);
  92.  readln;
  93.  asm mov ax,3; int $10; end;  {text mode again}
  94.  end.