Bitmap/Bézier curves/Quadratic: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added PicoLisp)
(Added BBC BASIC)
Line 54: Line 54:


</pre>
</pre>
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
[[Image:bezierquad_bbc.gif|right]]
<lang bbcbasic> Width% = 200
Height% = 200
REM Set window size:
VDU 23,22,Width%;Height%;8,16,16,128
REM Draw quadratic Bézier curve:
PROCbezierquad(10,100, 250,270, 150,20, 20, 0,0,0)
END
DEF PROCbezierquad(x1,y1,x2,y2,x3,y3,n%,r%,g%,b%)
LOCAL i%, t, t1, a, b, c, p{()}
DIM p{(n%) x%,y%}
FOR i% = 0 TO n%
t = i% / n%
t1 = 1 - t
a = t1^2
b = 2 * t * t1
c = t^2
p{(i%)}.x% = INT(a * x1 + b * x2 + c * x3 + 0.5)
p{(i%)}.y% = INT(a * y1 + b * y2 + c * y3 + 0.5)
NEXT
FOR i% = 0 TO n%-1
PROCbresenham(p{(i%)}.x%,p{(i%)}.y%,p{(i%+1)}.x%,p{(i%+1)}.y%, \
\ r%,g%,b%)
NEXT
ENDPROC
DEF PROCbresenham(x1%,y1%,x2%,y2%,r%,g%,b%)
LOCAL dx%, dy%, sx%, sy%, e
dx% = ABS(x2% - x1%) : sx% = SGN(x2% - x1%)
dy% = ABS(y2% - y1%) : sy% = SGN(y2% - y1%)
IF dx% < dy% e = dx% / 2 ELSE e = dy% / 2
REPEAT
PROCsetpixel(x1%,y1%,r%,g%,b%)
IF x1% = x2% IF y1% = y2% EXIT REPEAT
IF dx% > dy% THEN
x1% += sx% : e -= dy% : IF e < 0 e += dx% : y1% += sy%
ELSE
y1% += sy% : e -= dx% : IF e < 0 e += dy% : x1% += sx%
ENDIF
UNTIL FALSE
ENDPROC
DEF PROCsetpixel(x%,y%,r%,g%,b%)
COLOUR 1,r%,g%,b%
GCOL 1
LINE x%*2,y%*2,x%*2,y%*2
ENDPROC</lang>

=={{header|C}}==
=={{header|C}}==



Revision as of 15:22, 28 October 2012

Task
Bitmap/Bézier curves/Quadratic
You are encouraged to solve this task according to the task description, using any language you may know.

Using the data storage type defined on this page for raster images, and the draw_line function defined in this one, draw a quadratic bezier curves (definition on Wikipedia).


Ada

<lang ada>procedure Quadratic_Bezier

         (  Picture    : in out Image;
            P1, P2, P3 : Point;
            Color      : Pixel;
            N          : Positive := 20
         )  is
  Points : array (0..N) of Point;

begin

  for I in Points'Range loop
     declare
        T : constant Float := Float (I) / Float (N);
        A : constant Float := (1.0 - T)**2;
        B : constant Float := 2.0 * T * (1.0 - T);
        C : constant Float := T**2;
     begin
        Points (I).X := Positive (A * Float (P1.X) + B * Float (P2.X) + C * Float (P3.X));
        Points (I).Y := Positive (A * Float (P1.Y) + B * Float (P2.Y) + C * Float (P3.Y));
     end;
  end loop;
  for I in Points'First..Points'Last - 1 loop
     Line (Picture, Points (I), Points (I + 1), Color);
  end loop;

end Quadratic_Bezier;</lang> The following test <lang ada> X : Image (1..16, 1..16); begin

  Fill (X, White);
  Quadratic_Bezier (X, (8, 2), (13, 8), (2, 15), Black);
  Print (X);</lang>

should produce;


              H
             H
             H
            H
           H
          HH
 HH      H
  HH  HHH
    HH






BBC BASIC

<lang bbcbasic> Width% = 200

     Height% = 200
     
     REM Set window size:
     VDU 23,22,Width%;Height%;8,16,16,128
     
     REM Draw quadratic Bézier curve:
     PROCbezierquad(10,100, 250,270, 150,20, 20, 0,0,0)
     END
     
     DEF PROCbezierquad(x1,y1,x2,y2,x3,y3,n%,r%,g%,b%)
     LOCAL i%, t, t1, a, b, c, p{()}
     DIM p{(n%) x%,y%}
     
     FOR i% = 0 TO n%
       t = i% / n%
       t1 = 1 - t
       a = t1^2
       b = 2 * t * t1
       c = t^2
       p{(i%)}.x% = INT(a * x1 + b * x2 + c * x3 + 0.5)
       p{(i%)}.y% = INT(a * y1 + b * y2 + c * y3 + 0.5)
     NEXT
     
     FOR i% = 0 TO n%-1
       PROCbresenham(p{(i%)}.x%,p{(i%)}.y%,p{(i%+1)}.x%,p{(i%+1)}.y%, \
       \             r%,g%,b%)
     NEXT
     ENDPROC
     
     DEF PROCbresenham(x1%,y1%,x2%,y2%,r%,g%,b%)
     LOCAL dx%, dy%, sx%, sy%, e
     dx% = ABS(x2% - x1%) : sx% = SGN(x2% - x1%)
     dy% = ABS(y2% - y1%) : sy% = SGN(y2% - y1%)
     IF dx% < dy% e = dx% / 2 ELSE e = dy% / 2
     REPEAT
       PROCsetpixel(x1%,y1%,r%,g%,b%)
       IF x1% = x2% IF y1% = y2% EXIT REPEAT
       IF dx% > dy% THEN
         x1% += sx% : e -= dy% : IF e < 0 e += dx% : y1% += sy%
       ELSE
         y1% += sy% : e -= dx% : IF e < 0 e += dy% : x1% += sx%
       ENDIF
     UNTIL FALSE
     ENDPROC
     
     DEF PROCsetpixel(x%,y%,r%,g%,b%)
     COLOUR 1,r%,g%,b%
     GCOL 1
     LINE x%*2,y%*2,x%*2,y%*2
     ENDPROC</lang>

C

Interface (to be added to all other to make the final imglib.h):

<lang c>void quad_bezier(

       image img,
       unsigned int x1, unsigned int y1,
       unsigned int x2, unsigned int y2,
       unsigned int x3, unsigned int y3,
       color_component r,
       color_component g,
       color_component b );</lang>

Implementation:

<lang c>#include <math.h>

/* number of segments for the curve */

  1. define N_SEG 20
  1. define plot(x, y) put_pixel_clip(img, x, y, r, g, b)
  2. define line(x0,y0,x1,y1) draw_line(img, x0,y0,x1,y1, r,g,b)

void quad_bezier(

       image img,
       unsigned int x1, unsigned int y1,
       unsigned int x2, unsigned int y2,
       unsigned int x3, unsigned int y3,
       color_component r,
       color_component g,
       color_component b )

{

   unsigned int i;
   double pts[N_SEG+1][2];
   for (i=0; i <= N_SEG; ++i)
   {
       double t = (double)i / (double)N_SEG;
       double a = pow((1.0 - t), 2.0);
       double b = 2.0 * t * (1.0 - t);
       double c = pow(t, 2.0);
       double x = a * x1 + b * x2 + c * x3;
       double y = a * y1 + b * y2 + c * y3;
       pts[i][0] = x;
       pts[i][1] = y;
   }

  1. if 0
   /* draw only points */
   for (i=0; i <= N_SEG; ++i)
   {
       plot( pts[i][0],
             pts[i][1] );
   }
  1. else
   /* draw segments */
   for (i=0; i < N_SEG; ++i)
   {
       int j = i + 1;
       line( pts[i][0], pts[i][1],
             pts[j][0], pts[j][1] );
   }
  1. endif

}

  1. undef plot
  2. undef line</lang>

Factor

Some code is shared with the cubic bezier task, but I put it here again to make it simple (hoping the two version don't diverge) Same remark as with cubic bezier, the points could go into a sequence to simplify stack shuffling <lang factor>USING: arrays kernel locals math math.functions

rosettacode.raster.storage sequences ;

IN: rosettacode.raster.line

! This gives a function

(quadratic-bezier) ( P0 P1 P2 -- bezier )
   [ :> x 
       1 x - sq P0 n*v
       2 1 x - x * * P1 n*v
       x sq P2 n*v
       v+ v+ ] ; inline

! Same code from the cubic bezier task

t-interval ( x -- interval )
   [ iota ] keep 1 - [ / ] curry map ;
points-to-lines ( seq -- seq )
   dup rest [ 2array ] 2map ;
draw-lines ( {R,G,B} points image -- )
   [ [ first2 ] dip draw-line ] curry with each ;
bezier-lines ( {R,G,B} P0 P1 P2 image -- )
   100 t-interval P0 P1 P2 (quadratic-bezier) map
   points-to-lines
   {R,G,B} swap image draw-lines ;

</lang>

Fortran

Works with: Fortran version 90 and later

(This subroutine must be inside the RCImagePrimitive module, see here)

<lang fortran>subroutine quad_bezier(img, p1, p2, p3, color)

 type(rgbimage), intent(inout) :: img
 type(point), intent(in) :: p1, p2, p3
 type(rgb), intent(in) :: color
 integer :: i, j
 real :: pts(0:N_SEG,0:1), t, a, b, c, x, y
 do i = 0, N_SEG
    t = real(i) / real(N_SEG)
    a = (1.0 - t)**2.0
    b = 2.0 * t * (1.0 - t)
    c = t**2.0
    x = a * p1%x + b * p2%x + c * p3%x 
    y = a * p1%y + b * p2%y + c * p3%y 
    pts(i,0) = x
    pts(i,1) = y
 end do
 do i = 0, N_SEG-1
    j = i + 1
    call draw_line(img, point(pts(i,0), pts(i,1)), &
                   point(pts(j,0), pts(j,1)), color)
 end do

end subroutine quad_bezier</lang>

Go

Translation of: C

<lang go>package raster

const b2Seg = 20

func (b *Bitmap) Bézier2(x1, y1, x2, y2, x3, y3 int, p Pixel) {

   var px, py [b2Seg + 1]int
   fx1, fy1 := float64(x1), float64(y1)
   fx2, fy2 := float64(x2), float64(y2)
   fx3, fy3 := float64(x3), float64(y3)
   for i := range px {
       c := float64(i) / b2Seg
       a := 1 - c
       a, b, c := a*a, 2 * c * a, c*c
       px[i] = int(a*fx1 + b*fx2 + c*fx3)
       py[i] = int(a*fy1 + b*fy2 + c*fy3)
   }
   x0, y0 := px[0], py[0]
   for i := 1; i <= b2Seg; i++ {
       x1, y1 := px[i], py[i]
       b.Line(x0, y0, x1, y1, p)
       x0, y0 = x1, y1
   }

}

func (b *Bitmap) Bézier2Rgb(x1, y1, x2, y2, x3, y3 int, c Rgb) {

   b.Bézier2(x1, y1, x2, y2, x3, y3, c.Pixel())

}</lang> Demonstration program:

<lang go>package main

import (

   "fmt"
   "raster"

)

func main() {

   b := raster.NewBitmap(400, 300)
   b.FillRgb(0xdfffef)
   b.Bézier2Rgb(20, 150, 500, -100, 300, 280, raster.Rgb(0x3f8fef))
   if err := b.WritePpmFile("bez2.ppm"); err != nil {
       fmt.Println(err)
   }

}</lang>

Haskell

<lang haskell>{-# LANGUAGE

   FlexibleInstances, TypeSynonymInstances,
   ViewPatterns #-}

import Bitmap import Bitmap.Line import Control.Monad import Control.Monad.ST

type Point = (Double, Double) fromPixel (Pixel (x, y)) = (toEnum x, toEnum y) toPixel (x, y) = Pixel (round x, round y)

pmap :: (Double -> Double) -> Point -> Point pmap f (x, y) = (f x, f y)

onCoordinates :: (Double -> Double -> Double) -> Point -> Point -> Point onCoordinates f (xa, ya) (xb, yb) = (f xa xb, f ya yb)

instance Num Point where

   (+) = onCoordinates (+)
   (-) = onCoordinates (-)
   (*) = onCoordinates (*)
   negate = pmap negate
   abs = pmap abs
   signum = pmap signum
   fromInteger i = (i', i')
     where i' = fromInteger i

bézier :: Color c =>

   Image s c -> Pixel -> Pixel -> Pixel -> c -> Int ->
   ST s ()

bézier

 i
 (fromPixel -> p1) (fromPixel -> p2) (fromPixel -> p3)
 c samples =
   zipWithM_ f ts (tail ts)
 where ts = map (/ top) [0 .. top]
         where top = toEnum $ samples - 1
       curvePoint t =
           pt (t' ^^ 2) p1 +
           pt (2 * t * t') p2 +
           pt (t ^^ 2) p3
         where t' = 1 - t
               pt n p = pmap (*n) p
       f (curvePoint -> p1) (curvePoint -> p2) =
           line i (toPixel p1) (toPixel p2) c</lang>

J

See Cubic bezier curves for a generalized solution.

Mathematica

<lang Mathematica>pts = {{0, 0}, {1, -1}, {2, 1}}; Graphics[{BSplineCurve[pts], Green, Line[pts], Red, Point[pts]}]</lang>

OCaml

<lang ocaml>let quad_bezier ~img ~color

       ~p1:(_x1, _y1)
       ~p2:(_x2, _y2)
       ~p3:(_x3, _y3) =
 let (x1, y1, x2, y2, x3, y3) =
   (float _x1, float _y1, float _x2, float _y2, float _x3, float _y3)
 in
 let bz t =
   let a = (1.0 -. t) ** 2.0
   and b = 2.0 *. t *. (1.0 -. t)
   and c = t ** 2.0
   in
   let x = a *. x1 +. b *. x2 +. c *. x3
   and y = a *. y1 +. b *. y2 +. c *. y3
   in
   (int_of_float x, int_of_float y)
 in
 let rec loop _t acc =
   if _t > 20 then acc else
   begin
     let t = (float _t) /. 20.0 in
     let x, y = bz t in
     loop (succ _t) ((x,y)::acc)
   end
 in
 let pts = loop 0 [] in
 (*
 (* draw only points *)
 List.iter (fun (x, y) -> put_pixel img color x y) pts;
 *)
 (* draw segments *)
 let line = draw_line ~img ~color in
 let by_pair li f =
   ignore (List.fold_left (fun prev x -> f prev x; x) (List.hd li) (List.tl li))
 in
 by_pair pts (fun p0 p1 -> line ~p0 ~p1);
</lang>

PicoLisp

This uses the 'brez' line drawing function from Bitmap/Bresenham's line algorithm#PicoLisp. <lang PicoLisp>(scl 6)

(de quadBezier (Img N X1 Y1 X2 Y2 X3 Y3)

  (let (R (* N N)  X X1  Y Y1  DX 0  DY 0)
     (for I N
        (let (J (- N I)  A (*/ 1.0 J J R)  B (*/ 2.0 I J R)  C (*/ 1.0 I I R))
           (brez Img X Y
              (setq DX (- (+ (*/ A X1 1.0) (*/ B X2 1.0) (*/ C X3 1.0)) X))
              (setq DY (- (+ (*/ A Y1 1.0) (*/ B Y2 1.0) (*/ C Y3 1.0)) Y)) )
           (inc 'X DX)
           (inc 'Y DY) ) ) ) )</lang>

Test: <lang PicoLisp>(let Img (make (do 200 (link (need 300 0)))) # Create image 300 x 200

  (quadBezier Img 12 20 100 300 -80 260 180)
  (out "img.pbm"                                  # Write to bitmap file
     (prinl "P1")
     (prinl 300 " " 200)
     (mapc prinl Img) ) )

(call 'display "img.pbm")</lang>

PureBasic

<lang PureBasic>Procedure quad_bezier(img, p1x, p1y, p2x, p2y, p3x, p3y, Color, n_seg)

 Protected i
 Protected.f T, t1, a, b, c, d
 Dim pts.POINT(n_seg)
 
 For i = 0 To n_seg
   T = i / n_seg
   t1 = 1.0 - T
   a = Pow(t1, 2)
   b = 2.0 * T * t1
   c = Pow(T, 2)
   pts(i)\x = a * p1x + b * p2x + c * p3x
   pts(i)\y = a * p1y + b * p2y + c * p3y
 Next
 
 StartDrawing(ImageOutput(img))
   FrontColor(Color)
   For i = 0 To n_seg - 1
     BresenhamLine(pts(i)\x, pts(i)\y, pts(i + 1)\x, pts(i + 1)\y)
   Next
 StopDrawing()

EndProcedure

Define w, h, img w = 200: h = 200: img = 1 CreateImage(img, w, h) ;img is internal id of the image

OpenWindow(0, 0, 0, w, h,"Bezier curve, quadratic", #PB_Window_SystemMenu) quad_bezier(1, 80,20, 130,80, 20,150, RGB(255, 255, 255), 20) ImageGadget(0, 0, 0, w, h, ImageID(1))

Define event Repeat

 event = WaitWindowEvent()

Until event = #PB_Event_CloseWindow </lang>

Python

See Cubic bezier curves#Python for a generalized solution.

R

See Cubic bezier curves#R for a generalized solution.

Ruby

See Cubic bezier curves#Ruby for a generalized solution.

Tcl

See Cubic bezier curves#Tcl for a generalized solution.

TI-89 BASIC

Note: This example does not use a user-defined image type, since that would be particularly impractical, but rather draws on the calculator's graph screen, which has essentially the same operations as an implementation of Basic bitmap storage would, except for being black-and-white.

<lang ti89b>Define cubic(p1,p2,p3,segs) = Prgm

 Local i,t,u,prev,pt
 0 → pt
 For i,1,segs+1
   (i-1.0)/segs → t   © Decimal to avoid slow exact arithetic
   (1-t) → u
   pt → prev
   u^2*p1 + 2*t*u*p2 + t^2*p3 → pt
   If i>1 Then
     PxlLine floor(prev[1,1]), floor(prev[1,2]), floor(pt[1,1]), floor(pt[1,2])
   EndIf
 EndFor

EndPrgm</lang>

Vedit macro language

This implementation uses de Casteljau's algorithm to recursively split the Bezier curve into two smaller segments until the segment is short enough to be approximated with a straight line. The advantage of this method is that only integer calculations are needed, and the most complex operations are addition and shift right. (I have used multiplication and division here for clarity.)

Constant recursion depth is used here. Recursion depth of 5 seems to give accurate enough result in most situations. In real world implementations, some adaptive method is often used to decide when to stop recursion.

<lang vedit>// Daw a Cubic bezier curve // #20, #30 = Start point // #21, #31 = Control point 1 // #22, #32 = Control point 2 // #23, #33 = end point // #40 = depth of recursion

CUBIC_BEZIER:

if (#40 > 0) {

   #24 = (#20+#21)/2;              #34 = (#30+#31)/2
   #26 = (#22+#23)/2;              #36 = (#32+#33)/2
   #27 = (#20+#21*2+#22)/4;        #37 = (#30+#31*2+#32)/4
   #28 = (#21+#22*2+#23)/4;        #38 = (#31+#32*2+#33)/4
   #29 = (#20+#21*3+#22*3+#23)/8;  #39 = (#30+#31*3+#32*3+#33)/8
   Num_Push(20,40)
       #21 = #24; #31 = #34    // control 1
       #22 = #27; #32 = #37    // control 2
       #23 = #29; #33 = #39    // end point
       #40--
       Call("CUBIC_BEZIER")    // Draw "left" part
   Num_Pop(20,40)
   Num_Push(20,40)
       #20 = #29; #30 = #39    // start point
       #21 = #28; #31 = #38    // control 1
       #22 = #26; #32 = #36    // control 2
       #40--
       Call("CUBIC_BEZIER")    // Draw "right" part
   Num_Pop(20,40)

} else {

   #1=#20; #2=#30; #3=#23; #4=#33
   Call("DRAW_LINE")

} return</lang>