PROGRAM MYFILL_DEMO

!VAR SP%

!$INTEGER

CONST IMAGE_WIDTH=320,IMAGE_HEIGHT=200

DIM STACK[6000,1]

FUNCTION QUEUE_COUNT(X)
   QUEUE_COUNT=SP
END FUNCTION

!$INCLUDE="PC.LIB"

PROCEDURE QUEUE_INIT
   SP=0
END PROCEDURE

PROCEDURE QUEUE_POP(->XX,YY)
    XX=STACK[SP,0]
    YY=STACK[SP,1]
    SP=SP-1
END PROCEDURE

PROCEDURE QUEUE_PUSH(XX,YY)
   SP=SP+1
   STACK[SP,0]=XX
   STACK[SP,1]=YY
END PROCEDURE

PROCEDURE FLOOD_FILL(XSTART,YSTART,COLORE_PRIMA,COLORE_RIEMP)
  LOCAL XEST,XWEST,YNORD,YSUD,X,Y
  QUEUE_INIT
  QUEUE_PUSH(XSTART,YSTART)
  WHILE (QUEUE_COUNT(0)>0) DO
    QUEUE_POP(->X,Y)
    XWEST=X
    XEST=X

    IF Y>0 THEN
      YNORD=Y-1
    ELSE
      YNORD=-1
    END IF

    IF Y<IMAGE_HEIGHT-1 THEN
      YSUD=Y+1
    ELSE
      YSUD=-1
    END IF

    LOOP
       POINT(XEST+1,Y->ZC%)
       EXIT IF NOT((XEST<IMAGE_WIDTH-1) AND (ZC%=COLORE_PRIMA))
       XEST=XEST+1
    END LOOP

    LOOP
       POINT(XWEST-1,Y->ZC%)
       EXIT IF NOT((XWEST>0) AND (ZC%=COLORE_PRIMA))
       XWEST=XWEST-1
    END LOOP

    FOR X=XWEST TO XEST DO
      PSET(X,Y,COLORE_RIEMP)
      POINT(X,YNORD->ZC%)
      IF YNORD>=0 AND ZC%=COLORE_PRIMA THEN
          QUEUE_PUSH(X,YNORD)
      END IF
      POINT(X,YSUD->ZC%)
      IF YSUD>=0 AND ZC%=COLORE_PRIMA THEN
          QUEUE_PUSH(X,YSUD)
      END IF
    END FOR
  END WHILE
END PROCEDURE ! Flood_Fill

BEGIN
   SCREEN(1)
   CIRCLE(100,100,75,2)
   CIRCLE(120,120,20,2)
   CIRCLE(80,80,15,2)
   CIRCLE(120,80,10,2)
   FLOOD_FILL(100,100,0,1)
END PROGRAM


>file="test.png";
>A=loadrgb(file); ...
>insrgb(A);
>function floodfill (A0,i,j,color,dist) ...
$  A=A0;
$  R=getred(A); G=getgreen(A); B=getblue(A);
$  d=sqrt((R-R[i,j])^2+(G-G[i,j])^2+(B-B[i,j])^2);
$  n=rows(A); m=cols(A);
$  V=zeros(n,m);
$  S=zeros(n*m,2); sn=0;
$  A[i,j]=color; V[i,j]=1;
$  repeat;
$    if fill(A,i+1,j,n,m,d,dist,V,S,sn,color) then i=i+1; continue;
$    elseif fill(A,i,j+1,n,m,d,dist,V,S,sn,color) then j=j+1; continue;
$    elseif fill(A,i-1,j,n,m,d,dist,V,S,sn,color) then i=i-1; continue;
$    elseif fill(A,i,j-1,n,m,d,dist,V,S,sn,color) then j=j-1; continue;
$    endif;
$    sn=sn-1; if sn==0 then break; endif;
$    i=S[sn,1]; j=S[sn,2];
$  end;
$  return A;
$endfunction
>function fill (A,i,j,n,m,d,dist,V,S,%sn,color) ...
$  if i<1 or i>n or j<1 or j>n then return 0; endif;
$  if V[i,j] || d[i,j]>dist then A[i,j]=color; return 0; endif;
$  V[i,j]=1;
$  A[i,j]=color;
$  %sn=%sn+1;
$  S[%sn]=[i,j];
$  return 1;
$endfunction
>B=floodfill(A,10,240,rgb(0.5,0,0),0.5);
>B=floodfill(B,10,10,rgb(0.5,0,0),0.5);
>B=floodfill(B,150,60,rgb(0,0.5,0),0.5);
>B=floodfill(B,200,200,rgb(0,0,0.5),0.5);
>insrgb(B);


#DEFINE WM_LBUTTONDOWN 513
#DEFINE WM_CLOSE 16

FBSLSETTEXT(ME, "Before Flood Fill") ' Set form caption
FBSLSETFORMCOLOR(ME, RGB(0, 255, 255)) ' Cyan: persistent background color
FBSL.GETDC(ME) ' Use volatile FBSL.GETDC below to avoid extra assignments

RESIZE(ME, 0, 0, 220, 220)
CENTER(ME)
SHOW(ME)

DIM Breadth AS INTEGER, Height AS INTEGER
FBSL.GETCLIENTRECT(ME, 0, 0, Breadth, Height)

DrawCircles() ' Initialize circles

BEGIN EVENTS
	SELECT CASE CBMSG
		CASE WM_LBUTTONDOWN: FillCircles() ' Flood fill circles
		CASE WM_CLOSE: FBSL.RELEASEDC(ME, FBSL.GETDC) ' Clean up
	END SELECT
END EVENTS

SUB FillCircles()
	FILL(FBSL.GETDC, Breadth / 2, Height / 2, &HFFFF) ' Yellow: flood fill using intrinsics
	FOR DIM x = 0 TO Breadth / 2 ' Red: flood fill iteratively
		FOR DIM y = 0 TO Height / 2
			IF NOT POINT(FBSL.GETDC, x, y) THEN PSET(FBSL.GETDC, x, y, &HFF)
		NEXT
	NEXT
	FBSLSETTEXT(ME, "After Flood Fill") ' Reset form caption
END SUB

SUB DrawCircles() ' Concatenate function calls
	CIRCLE(FBSL.GETDC, Breadth / 2, Height / 2, 85, &HFFFFFF, 0, 360, 1, TRUE) _ ' White
	(FBSL.GETDC, Breadth / 3, Height / 3, 30, 0, 0, 360, 1, TRUE) ' Black
END SUB


: third 2 pick ;
: 3dup  third third third ;
: 4dup  2over 2over ;

: flood ( color x y bmp -- )
  3dup [email protected] >r  ( R: color to fill )
  4dup b!
  third 0 > if
    rot 1- -rot
    3dup [email protected] [email protected] = if recurse then
    rot 1+ -rot
  then
  third 1+ over bwidth < if
    rot 1+ -rot
    3dup [email protected] [email protected] = if recurse then
    rot 1- -rot
  then
  over 0 > if
    swap 1- swap
    3dup [email protected] [email protected] = if recurse then
    swap 1+ swap
  then
  over 1+ over bheight < if
    swap 1+ swap
    3dup [email protected] [email protected] = if recurse then
    swap 1- swap
  then
  r> drop ;


module RCImageArea
  use RCImageBasic
  use RCImagePrimitive
  implicit none

  real, parameter, private :: matchdistance = 0.2

  private :: northsouth, eastwest

contains

  subroutine northsouth(img, p0, tcolor, fcolor)
    type(rgbimage), intent(inout) :: img
    type(point), intent(in) :: p0
    type(rgb), intent(in) :: tcolor, fcolor

    integer :: npy, spy, y
    type(rgb) :: pc

    npy = p0%y - 1
    do
       if ( inside_image(img, p0%x, npy) ) then
          call get_pixel(img, p0%x, npy, pc)
          if ( ((pc .dist. tcolor) > matchdistance ) .or. ( pc == fcolor ) ) exit
       else
          exit
       end if
       npy = npy - 1
    end do
    npy = npy + 1
    spy = p0%y + 1
    do
       if ( inside_image(img, p0%x, spy) ) then
          call get_pixel(img, p0%x, spy, pc)
          if ( ((pc .dist. tcolor) > matchdistance ) .or. ( pc == fcolor ) ) exit
       else
          exit
       end if
       spy = spy + 1
    end do
    spy = spy - 1
    call draw_line(img, point(p0%x, spy), point(p0%x, npy), fcolor)

    do y = min(spy, npy), max(spy, npy)
       if ( y == p0%y ) cycle
       call eastwest(img, point(p0%x, y), tcolor, fcolor)
    end do

  end subroutine northsouth

  subroutine eastwest(img, p0, tcolor, fcolor)
    type(rgbimage), intent(inout) :: img
    type(point), intent(in) :: p0
    type(rgb), intent(in) :: tcolor, fcolor

    integer :: npx, spx, x
    type(rgb) :: pc

    npx = p0%x - 1
    do
       if ( inside_image(img, npx, p0%y) ) then
          call get_pixel(img, npx, p0%y, pc)
          if ( ((pc .dist. tcolor) > matchdistance ) .or. ( pc == fcolor ) ) exit
       else
          exit
       end if
       npx = npx - 1
    end do
    npx = npx + 1
    spx = p0%x + 1
    do
       if ( inside_image(img, spx, p0%y) ) then
          call get_pixel(img, spx, p0%y, pc)
          if ( ((pc .dist. tcolor) > matchdistance ) .or. ( pc == fcolor ) ) exit
       else
          exit
       end if
       spx = spx + 1
    end do
    spx = spx - 1
    call draw_line(img, point(spx, p0%y), point(npx, p0%y), fcolor)

    do x = min(spx, npx), max(spx, npx)
       if ( x == p0%x ) cycle
       call northsouth(img, point(x, p0%y), tcolor, fcolor)
    end do

  end subroutine eastwest

  subroutine floodfill(img, p0, tcolor, fcolor)
    type(rgbimage), intent(inout) :: img
    type(point), intent(in) :: p0
    type(rgb), intent(in) :: tcolor, fcolor

    type(rgb) :: pcolor

    if ( .not. inside_image(img, p0%x, p0%y) ) return
    call get_pixel(img, p0%x, p0%y, pcolor)
    if ( (pcolor .dist. tcolor) > matchdistance ) return

    call northsouth(img, p0, tcolor, fcolor)
    call eastwest(img, p0, tcolor, fcolor)
  end subroutine floodfill

end module RCImageArea


' version 04-11-2016
' compile with: fbc -s console

' the flood_fill needs to know the boundries of the window/screen
' without them the routine start to check outside the window
' this leads to crashes (out of stack)
' the Line routine has clipping it will not draw outside the window

Sub flood_fill(x As Integer, y As Integer, target As UInteger, fill_color As UInteger)

    Dim As Long x_max, y_max
    ScreenInfo x_max, y_max

    ' 0, 0 is top left corner
    If Point(x,y) <> target Then Exit Sub

    Dim As Long l = x, r = x

    While Point(l -1, y) = target AndAlso l -1 > -1
        l = l -1
    Wend

    While Point(r +1, y) = target AndAlso r +1 < x_max
        r = r +1
    Wend

    Line (l,y) - (r,y), fill_color

    For x = l To r
        If y +1 < y_max Then flood_fill(x, y +1, target, fill_color)
        If y -1 >    -1 Then flood_fill(x, y -1, target, fill_color)
    Next

End Sub

' ------=< MAIN >=------

Dim As ULong i, col, x, y

ScreenRes 400, 400, 32
Randomize Timer

For i As ULong = 1 To 5
    Circle(Rnd * 400 ,Rnd * 400), i * 40, Rnd * &hFFFFFF
Next

' hit a key to end or close window
Do
    x = Rnd * 400
    y = Rnd * 400
    col = Point(x, y)
    flood_fill(x, y, col, Rnd * &hFFFFFF )
    Sleep 2000
    If InKey <> "" OrElse InKey = Chr(255) + "k" Then End
Loop


package raster

func (b *Bitmap) Flood(x, y int, repl Pixel) {
    targ, _ := b.GetPx(x, y)
    var ff func(x, y int)
    ff = func(x, y int) {
        p, ok := b.GetPx(x, y)
        if ok && p.R == targ.R && p.G == targ.G && p.B == targ.B {
            b.SetPx(x, y, repl)
            ff(x-1, y)
            ff(x+1, y)
            ff(x, y-1)
            ff(x, y+1)
        }
    }
    ff(x, y)
}


import Data.Array.ST
import Data.STRef
import Control.Monad
import Control.Monad.ST
import Bitmap

-- Implementation of a stack in the ST monad
pushST :: STStack s a -> a -> ST s ()
pushST s e = do
    s2 <- readSTRef s
    writeSTRef s (e : s2)

popST :: STStack s a -> ST s (Stack a)
popST s = do
    s2 <- readSTRef s
    writeSTRef s $ tail s2
    return $ take 1 s2

isNotEmptySTStack :: STStack s a -> ST s Bool
isNotEmptySTStack s = do
    s2 <- readSTRef s
    return $ not $ null s2

emptySTStack :: ST s (STStack s a)
emptySTStack = newSTRef []

consumeSTStack :: STStack s a -> (a -> ST s ()) -> ST s ()
consumeSTStack s f = do
    check <- isNotEmptySTStack s
    when check $ do
        e <- popST s
        f $ head e
        consumeSTStack s f

type Spanning s = STRef s (Bool, Bool)

setSpanLeft :: Spanning s -> Bool -> ST s ()
setSpanLeft s v = do
    (_, r) <- readSTRef s
    writeSTRef s (v, r)

setSpanRight :: Spanning s -> Bool -> ST s ()
setSpanRight s v = do
    (l, _) <- readSTRef s
    writeSTRef s (l, v)

setSpanNone :: Spanning s -> ST s ()
setSpanNone s = writeSTRef s (False, False)

floodFillScanlineStack :: Color c => Image s c -> Pixel -> c -> ST s (Image s c)
floodFillScanlineStack b coords newC = do
    stack <- emptySTStack -- new empty stack holding pixels to fill
    spans <- newSTRef (False, False) -- keep track of spans in scanWhileX
    fFSS b stack coords newC spans -- function loop
    return b
    where
        fFSS b st c newC p = do
            oldC <- getPix b c
            unless (oldC == newC) $ do
                pushST st c -- store the coordinates in the stack
                (w, h) <- dimensions b
                consumeSTStack st (scanWhileY b p oldC >=>
                    scanWhileX b st p oldC newC (w, h))

        -- take a buffer, the span record, the color of the Color the fill is
        -- started from, a coordinate from the stack, and returns the coord
        -- of the next point to be filled in the same column
        scanWhileY b p oldC coords@(Pixel (x, y)) =
            if y >= 0
            then do
                z <- getPix b coords
                if z == oldC
                then scanWhileY b p oldC (Pixel (x, y - 1))
                else do
                    setSpanNone p
                    return (Pixel (x, y + 1))
            else do
                setSpanNone p
                return (Pixel (x, y + 1))

        -- take a buffer, a stack, a span record, the old and new color, the
        -- height and width of the buffer, and a coordinate.
        -- paint the point with the new color, check if the fill must expand
        -- to the left or right or both, and store those coordinates in the
        -- stack for subsequent filling
        scanWhileX b st p oldC newC (w, h) coords@(Pixel (x, y)) =
            when (y < h) $ do
                z <- getPix b coords
                when (z == oldC) $ do
                    setPix b coords newC
                    (spanLeft, spanRight) <- readSTRef p
                    when (not spanLeft && x > 0) $ do
                        z2 <- getPix b (Pixel (x - 1, y))
                        when (z2 == oldC) $ do
                            pushST st (Pixel (x - 1, y))
                            setSpanLeft p True
                    when (spanLeft && x > 0) $ do
                        z3 <- getPix b (Pixel (x - 1, y))
                        when (z3 /= oldC) $
                            setSpanLeft p False
                    when (not spanRight && x < (w - 1)) $ do
                        z4 <- getPix b (Pixel (x + 1, y))
                        when (z4 == oldC) $ do
                            pushST st (Pixel (x + 1, y))
                            setSpanRight p True
                    when (spanRight && x < (w - 1)) $ do
                        z5 <- getPix b (Pixel (x + 1, y))
                        when (z5 /= oldC) $
                            setSpanRight p False
                    scanWhileX b st p oldC newC (w, h) (Pixel (x, y + 1))


WINDOW(WINdowhandle=wh, BaCkcolor=0, TItle="Rosetta test image")

WRITE(WIN=wh, DeCoRation="EL=14, BC=14") ! color 14 == bright yellow

RGB(128, 100, 0, 25) ! define color nr 25 as 128/255 red, 100/255 green, 0 blue
WRITE(WIN=wh, DeCoRation="L=1/4, R=1/2, T=1/4, B=1/2, EL=25, BC=25")

WINDOW(Kill=wh)


NB. finds and labels contiguous areas with the same numbers
NB. ref: http://www.jsoftware.com/pipermail/general/2005-August/023886.html
findcontig=: (|."1@|:@:>. (* * 1&(|.!.0)))^:4^:_@(* >:@[email protected]$)

NB.*getFloodpoints v Returns points to fill given starting point (x) and image (y)
getFloodpoints=: [: 4&[email protected]$. [ (] = getPixels) [: findcontig ] -:"1 getPixels

NB.*floodFill v Floods area, defined by point and color (x), of image (y)
NB. x is: 2-item list of (y x) ; (color)
floodFill=: (1&({::)@[ ;~ 0&({::)@[ getFloodpoints ]) setPixels ]


import java.awt.Color;
import java.awt.Point;
import java.awt.image.BufferedImage;
import java.util.Deque;
import java.util.LinkedList;

public class FloodFill {
  public void floodFill(BufferedImage image, Point node, Color targetColor, Color replacementColor) {
    int width = image.getWidth();
    int height = image.getHeight();
    int target = targetColor.getRGB();
    int replacement = replacementColor.getRGB();
    if (target != replacement) {
      Deque<Point> queue = new LinkedList<Point>();
      do {
        int x = node.x;
        int y = node.y;
        while (x > 0 && image.getRGB(x - 1, y) == target) {
          x--;
        }
        boolean spanUp = false;
        boolean spanDown = false;
        while (x < width && image.getRGB(x, y) == target) {
          image.setRGB(x, y, replacement);
          if (!spanUp && y > 0 && image.getRGB(x, y - 1) == target) {
            queue.add(new Point(x, y - 1));
            spanUp = true;
          } else if (spanUp && y > 0 && image.getRGB(x, y - 1) != target) {
            spanUp = false;
          }
          if (!spanDown && y < height - 1 && image.getRGB(x, y + 1) == target) {
            queue.add(new Point(x, y + 1));
            spanDown = true;
          } else if (spanDown && y < height - 1 && image.getRGB(x, y + 1) != target) {
            spanDown = false;
          }
          x++;
        }
      } while ((node = queue.pollFirst()) != null);
    }
  }
}


using Images, FileIO

function floodfill!(img::Matrix{<:Color}, initnode::CartesianIndex{2}, target::Color, replace::Color)
    img[initnode] != target && return img
    # constants
    north = CartesianIndex(-1,  0)
    south = CartesianIndex( 1,  0)
    east  = CartesianIndex( 0,  1)
    west  = CartesianIndex( 0, -1)

    queue = [initnode]
    while !isempty(queue)
        node = pop!(queue)
        if img[node] == target
            wnode = node
            enode = node + east
        end
        # Move west until color of node does not match target color
        while checkbounds(Bool, img, wnode) && img[wnode] == target
            img[wnode] = replace
            if checkbounds(Bool, img, wnode + north) && img[wnode + north] == target
                push!(queue, wnode + north)
            end
            if checkbounds(Bool, img, wnode + south) && img[wnode + south] == target
                push!(queue, wnode + south)
            end
            wnode += west
        end
        # Move east until color of node does not match target color
        while checkbounds(Bool, img, enode) && img[enode] == target
            img[enode] = replace
            if checkbounds(Bool, img, enode + north) && img[enode + north] == target
                push!(queue, enode + north)
            end
            if checkbounds(Bool, img, enode + south) && img[enode + south] == target
                push!(queue, enode + south)
            end
            enode += east
        end
    end
    return img
end

img = Gray{Bool}.(load("data/unfilledcircle.png"))
floodfill!(img, CartesianIndex(100, 100), Gray(false), Gray(true))
save("data/filledcircle.png", img)


// version 1.1.4-3

import java.awt.Color
import java.awt.Point
import java.awt.image.BufferedImage
import java.util.LinkedList
import java.io.File
import javax.imageio.ImageIO
import javax.swing.JOptionPane
import javax.swing.JLabel
import javax.swing.ImageIcon

fun floodFill(image: BufferedImage, node: Point, targetColor: Color, replColor: Color) {
    val target = targetColor.getRGB()
    val replacement = replColor.getRGB()
    if (target == replacement) return
    val width = image.width
    val height = image.height
    val queue = LinkedList<Point>()
    var nnode: Point? = node

    do {
        var x = nnode!!.x
        val y = nnode.y
        while (x > 0 && image.getRGB(x - 1, y) == target) x--
        var spanUp = false
        var spanDown = false

        while (x < width && image.getRGB(x, y) == target) {
            image.setRGB(x, y, replacement)

            if (!spanUp && y > 0 && image.getRGB(x, y - 1) == target) {
                queue.add(Point(x, y - 1))
                spanUp = true
            }
            else if (spanUp && y > 0 && image.getRGB(x, y - 1) != target) {
                spanUp = false
            }

            if (!spanDown && y < height - 1 && image.getRGB(x, y + 1) == target) {
                queue.add(Point(x, y + 1))
                spanDown = true
            }
            else if (spanDown && y < height - 1 && image.getRGB(x, y + 1) != target) {
                spanDown = false
            }
            x++
        }
        nnode = queue.pollFirst()
    }
    while (nnode != null)
}

fun main(args: Array<String>) {
   val image = ImageIO.read(File("Unfilledcirc.png"))
   floodFill(image, Point(50, 50), Color.white, Color.yellow)
   val title = "Floodfilledcirc.png"
   ImageIO.write(image, "png", File(title))
   JOptionPane.showMessageDialog(null, JLabel(ImageIcon(image)), title, JOptionPane.PLAIN_MESSAGE)
}


'This example requires the Windows API
NoMainWin
WindowWidth = 267.5
WindowHeight = 292.5
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)

Global hDC : hDC = GetDC(0)
Struct point, x As long, y As long
Struct RGB, Red As long, Green As long, Blue As long
Struct rect, left As long, top As long, right As long, bottom As long

StyleBits #main.gbox, 0, _WS_BORDER, 0, 0
GraphicBox #main.gbox, 2.5, 2.5, 253, 252

Open "Flood Fill - Click a Color" For Window As #main
Print #main, "TrapClose quit"
Print #main.gbox, "Down; Fill Black; Place 125 125; BackColor White; " _
                  + "CircleFilled 115; Place 105 105; BackColor Black; CircleFilled 50; Flush"
Print #main.gbox, "When leftButtonUp gBoxClick"
Print #main.gbox, "Size 1"
Wait

    Sub quit handle$
        Call ReleaseDC 0, hDC
        Close #main
        End
    End Sub

    Sub gBoxClick handle$, MouseX, MouseY
        result = GetCursorPos()
        targetRGB = GetPixel(hDC, point.x.struct, point.y.struct)
        ColorDialog "", replacementColor$
        If replacementColor$ = "" Then Exit Sub
        Print #main.gbox, "Color " + Word$(replacementColor$, 1) + " " + Word$(replacementColor$, 2) + " " + Word$(replacementColor$, 3)
        result = FloodFill(MouseX, MouseY, targetRGB)
        Print #main.gbox, "DelSegment FloodFill"
        Print #main.gbox, "GetBMP FloodFill 0 0 500 500; CLS; DrawBMP FloodFill 0 0; Flush FloodFill"
        Notice "Complete!"
        UnLoadBMP "FloodFill"
    End Sub

    Sub ReleaseDC hWnd, hDC
        CallDLL #user32,"ReleaseDC", hWnd As uLong, hDC As uLong, ret As Long
    End Sub

    Function GetDC(hWnd)
        CallDLL #user32, "GetDC", hWnd As uLong, GetDC As uLong
    End Function

    Function GetCursorPos()
        CallDLL #user32, "GetCursorPos", point As struct, GetCursorPos As uLong
    End Function

    Function GetPixel(hDC, x, y)
        CallDLL #gdi32, "GetPixel", hDC As uLong, x As long, y As long, GetPixel As long
    End Function

    Function getLongRGB(RGB.Blue)
        getLongRGB = (RGB.Blue * (256 * 256))
    End Function

    Function GetWindowRect(hWnd)
        'Get ClientRectangle
        CallDLL #user32, "GetWindowRect", hWnd As ulong, rect As struct, GetWindowRect As ulong
    End Function

    Function FloodFill(mouseXX, mouseYY, targetColor)
        Scan
        result = GetWindowRect(Hwnd(#main.gbox))
        X = Int(mouseXX + rect.left.struct)
        Y = Int(mouseYY + rect.top.struct)
        If (GetPixel(hDC, X, Y) <> targetColor) Then
            Exit Function
        Else
            CLS
            Print str$(mouseXX) + "   " + str$(mouseYY)
            Print #main.gbox, "Set " + str$(mouseXX) + " " + str$(mouseYY)
        End If
        If (mouseXX > 0) And (mouseXX < 253) Then
            result = FloodFill((mouseXX - 1), mouseYY, targetColor)
            result = FloodFill((mouseXX + 1), mouseYY, targetColor)
        End If
        If (mouseYY > 0) And (mouseYY < 252) Then
            result = FloodFill(mouseXX, (mouseYY + 1), targetColor)
            result = FloodFill(mouseXX, (mouseYY - 1), targetColor)
        End If
    End Function


$ magick unfilledcirc.png -depth 8 unfilledcirc.ppm


createMask[img_, pos_, tol_] :=
            RegionBinarize[img, Image[SparseArray[pos -> 1, ImageDimensions[img]]], tol];
floodFill[img_Image, pos_List, tol_Real, color_List] :=
            ImageCompose[
                 SetAlphaChannel[ImageSubtract[img, createMask[img, pos, tol]], 1],
                 SetAlphaChannel[Image[ConstantArray[color, ImageDimensions[img]]],
                                 Dilation[createMask[img, pos, tol],1]
                                ]
                        ]


import bitmap

proc floodFill*(img: Image; initPoint: Point; targetColor, replaceColor: Color) =

  var stack: seq[Point]
  let width = img.w
  let height = img.h

  if img[initPoint.x, initPoint.y] != targetColor:
    return

  stack.add(initPoint)

  while stack.len > 0:
    var w, e: Point
    let pt = stack.pop()
    if img[pt.x, pt.y] == targetColor:
      w = pt
      e = if pt.x + 1 < width: (pt.x + 1, pt.y) else: pt
    else:
      continue  # Already processed.

    # Move west until color of node does not match "targetColor".
    while w.x >= 0 and img[w.x, w.y] == targetColor:
      img[w.x, w.y] = replaceColor
      if w.y + 1 < height and img[w.x, w.y + 1] == targetColor:
        stack.add((w.x, w.y + 1))
      if w.y - 1 >= 0 and img[w.x, w.y - 1] == targetColor:
        stack.add((w.x, w.y - 1))
      dec w.x

    # Move east until color of node does not match "targetColor".
    while e.x < width and img[e.x, e.y] == targetColor:
      img[e.x, e.y] = replaceColor
      if e.y + 1 < height and img[e.x, e.y + 1] == targetColor:
        stack.add((e.x, e.y + 1))
      if e.y - 1 >= 0 and img[e.x, e.y - 1] == targetColor:
        stack.add((e.x, e.y - 1))
      inc e.x

#———————————————————————————————————————————————————————————————————————————————————————————————————

when isMainModule:

  import ppm_read, ppm_write

  var img = readPPM("Unfilledcirc.ppm")
  img.floodFill((30, 122), White, color(255, 0, 0))
  img.writePPM("Unfilledcirc_red.ppm")


program FloodFillTest;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Winapi.Windows,
  System.SysUtils,
  System.Generics.Collections,
  vcl.Graphics;

procedure FloodFill(bmp: tBitmap; pt: TPoint; targetColor: TColor;
  replacementColor: TColor);
var
  q: TQueue<TPoint>;
  n, w, e: TPoint;
begin
  q := TQueue<TPoint>.Create;

  q.Enqueue(pt);

  while (q.Count > 0) do
  begin
    n := q.Dequeue;
    if bmp.Canvas.Pixels[n.X, n.Y] <> targetColor then
      Continue;

    w := n;
    e := TPoint.Create(n.X + 1, n.Y);

    while ((w.X >= 0) and (bmp.Canvas.Pixels[w.X, w.Y] = targetColor)) do
    begin
      bmp.Canvas.Pixels[w.X, w.Y] := replacementColor;
      if ((w.Y > 0) and (bmp.Canvas.Pixels[w.X, w.Y - 1] = targetColor)) then
        q.Enqueue(TPoint.Create(w.X, w.Y - 1));
      if ((w.Y < bmp.Height - 1) and (bmp.Canvas.Pixels[w.X, w.Y + 1] = targetColor)) then
        q.Enqueue(TPoint.Create(w.X, w.Y + 1));
      dec(w.X);
    end;

    while ((e.X <= bmp.Width - 1) and (bmp.Canvas.Pixels[e.X, e.Y] = targetColor)) do
    begin
      bmp.Canvas.Pixels[e.X, e.Y] := replacementColor;
      if ((e.Y > 0) and (bmp.Canvas.Pixels[e.X, e.Y - 1] = targetColor)) then
        q.Enqueue(TPoint.Create(e.X, e.Y - 1));

      if ((e.Y < bmp.Height - 1) and (bmp.Canvas.Pixels[e.X, e.Y + 1] = targetColor)) then
        q.Enqueue(TPoint.Create(e.X, e.Y + 1));
      inc(e.X);
    end;
  end;
  q.Free;
end;

var
  bmp: TBitmap;

begin
  bmp := TBitmap.Create;
  try
    bmp.LoadFromFile('Unfilledcirc.bmp');
    FloodFill(bmp, TPoint.Create(200, 200), clWhite, clRed);
    FloodFill(bmp, TPoint.Create(100, 100), clBlack, clBlue);
    bmp.SaveToFile('Filledcirc.bmp');
  finally
    bmp.Free;
  end;

end.


#! /usr/bin/perl

use strict;
use Image::Imlib2;

my $img = Image::Imlib2->load("Unfilledcirc.jpg");
$img->set_color(0, 255, 0, 255);
$img->fill(100,100);
$img->save("filledcirc.jpg");
exit 0;


-- demo\rosetta\Bitmap_FloodFill.exw  (runnable version)
include ppm.e -- blue, green, read_ppm(), write_ppm() (covers above requirements)

function ff(sequence img, integer x, y, colour, target)
    if  x>=1 and x<=length(img)
    and y>=1 and y<=length(img[x])
    and img[x][y]=target then
        img[x][y] = colour
        img = ff(img,x-1,y,colour,target)
        img = ff(img,x+1,y,colour,target)
        img = ff(img,x,y-1,colour,target)
        img = ff(img,x,y+1,colour,target)
    end if
    return img
end function

function FloodFill(sequence img, integer x, y, colour)
    integer target = img[x][y]
    return ff(img,x,y,colour,target)
end function

sequence img = read_ppm("Circle.ppm")
img = FloodFill(img, 200, 100, blue)
write_ppm("FloodIn.ppm",img)
img = FloodFill(img, 10, 10, green)
write_ppm("FloodOut.ppm",img)


(de ppmFloodFill (Ppm X Y Color)
   (let Target (get Ppm Y X)
      (recur (X Y)
         (when (= Target (get Ppm Y X))
            (set (nth Ppm Y X) Color)
            (recurse (dec X) Y)
            (recurse (inc X) Y)
            (recurse X (dec Y))
            (recurse X (inc Y)) ) ) )
   Ppm )


fill: procedure (x, y, fill_color) recursive; /* 12 May 2010 */
   declare (x, y) fixed binary;
   declare fill_color bit (24) aligned;

   if x <= lbound(image, 2) | x >= hbound(image, 2) then return;
   if y <= lbound(image, 1) | y >= hbound(image, 1) then return;

   pixel_color = image (x,y); /* Obtain the color of the current pixel. */
   if pixel_color ^= area_color then return;
      /* the pixel has already been filled with fill_color, */
      /* or we are not within the area to be filled.        */
   image(x, y) = fill_color; /* color the desired area. */

   pixel_color = image (x,y-1); /* Obtain the color of the pixel to the north. */
   if pixel_color = area_color then call fill (x, y-1, fill_color);

   pixel_color = image (x-1,y); /* Obtain the color of the pixel to the west. */
   if pixel_color = area_color then call fill (x-1, y, fill_color);

   pixel_color = image (x+1,y); /* Obtain the color of the pixel to the east. */
   if pixel_color = area_color then call fill (x+1, y, fill_color);

   pixel_color = image (x,y+1); /* Obtain the color of the pixel to the south. */
   if pixel_color = area_color then call fill (x, y+1, fill_color);

end fill;


import java.awt.Point;
import java.util.Queue;
import java.util.LinkedList;

PImage img;
int tolerance;
color fill_color;
boolean allowed;

void setup() {
  size(600, 400);
  img = loadImage("image.png");
  fill_color = color(250, 0, 0);
  fill(0, 0, 100);
  tolerance = 15;
  image(img, 0, 0, width, height);
  textSize(18);
  text("Tolerance = "+tolerance+"  (Use mouse wheel to change)", 100, height-30);
  text("Right click to reset", 100, height-10);
}

void draw() {
  if (allowed) {
    image(img, 0, 0, width, height);
    text("Tolerance = "+tolerance+"  (Use mouse wheel to change)", 100, height-30);
    text("Right click to reset", 100, height-10);
    allowed = false;
  }
}

void mousePressed() {
  if (mouseButton == RIGHT) {
    img = loadImage("image.png");
  } else {
    img.loadPixels();
    flood(mouseX, mouseY);
    img.updatePixels();
    allowed = true;
  }
}

void mouseWheel(MouseEvent event) {
  float e = event.getCount();
  tolerance += 2*e;
  if (tolerance > 128) tolerance = 128;
  if (tolerance < 0) tolerance = 0;
  allowed = true;
}

void flood(int x, int y) {
  color target_color = img.pixels[pixel_position(mouseX, mouseY)];
  if (target_color != fill_color) {
    Queue<Point> queue = new LinkedList<Point>();
    queue.add(new Point(x, y));
    while (!queue.isEmpty()) {
      Point p = queue.remove();
      if (check(p.x, p.y, target_color)) {
        queue.add(new Point(p.x, p.y-1));
        queue.add(new Point(p.x, p.y+1));
        queue.add(new Point(p.x-1, p.y));
        queue.add(new Point(p.x+1, p.y));
      }
    }
  }
}

int pixel_position(int x, int y) {
  return x + (y * img.width);
}

boolean check(int x, int y, color target_color) {
  if (x < 0 || y < 0 || y >= img.height || x >= img.width) return false;
  int pp = img.pixels[pixel_position(x, y)];
  boolean test_tolerance = (abs(green(target_color)-green(pp)) < tolerance
                         && abs(  red(target_color)-  red(pp)) < tolerance
                         && abs( blue(target_color)- blue(pp)) < tolerance);
  if (!test_tolerance) return false;
  img.pixels[pixel_position(x, y)] = fill_color;
  return true;
}


FillArea(0,0,-1,$ff)
; Fills an Area in red


import Image
def FloodFill( fileName, initNode, targetColor, replaceColor ):
   img = Image.open( fileName )
   pix = img.load()
   xsize, ysize = img.size
   Q = []
   if pix[ initNode[0], initNode[1] ] != targetColor:
      return img
   Q.append( initNode )
   while Q != []:
      node = Q.pop(0)
      if pix[ node[0], node[1] ] == targetColor:
         W = list( node )
         if node[0] + 1 < xsize:
            E = list( [ node[0] + 1, node[1] ] )
         else:
            E = list( node )
      # Move west until color of node does not match targetColor
      while pix[ W[0], W[1] ] == targetColor:
         pix[ W[0], W[1] ] = replaceColor
         if W[1] + 1 < ysize:
            if pix[ W[0], W[1] + 1 ] == targetColor:
               Q.append( [ W[0], W[1] + 1 ] )
         if W[1] - 1 >= 0:
            if pix[ W[0], W[1] - 1 ] == targetColor:
               Q.append( [ W[0], W[1] - 1 ] )
         if W[0] - 1 >= 0:
            W[0] = W[0] - 1
         else:
            break
      # Move east until color of node does not match targetColor
      while pix[ E[0], E[1] ] == targetColor:
         pix[ E[0], E[1] ] = replaceColor
         if E[1] + 1 < ysize:
            if pix[ E[0], E[1] + 1 ] == targetColor:
               Q.append( [ E[0], E[1] + 1 ] )
         if E[1] - 1 >= 0:
            if pix[ E[0], E[1] - 1 ] == targetColor:
               Q.append( [ E[0], E[1] -1 ] )
         if E[0] + 1 < xsize:
            E[0] = E[0] + 1
         else:
            break
      return img


library(png)
img <- readPNG("Unfilledcirc.png")
M <- img[ , , 1]
M <- ifelse(M < 0.5, 0, 1)
image(M, col = c(1, 0))

# https://en.wikipedia.org/wiki/Flood_fill
floodfill <- function(row, col, tcol, rcol) {
  if (tcol == rcol) return()
  if (M[row, col] != tcol) return()
  M[row, col] <<- rcol
  floodfill(row - 1, col    , tcol, rcol) # south
  floodfill(row + 1, col    , tcol, rcol) # north
  floodfill(row    , col - 1, tcol, rcol) # west
  floodfill(row    , col + 1, tcol, rcol) # east
  return("filling completed")
}

options(expressions = 10000)
startrow <- 100; startcol <- 100
floodfill(startrow, startcol, 0, 2)

image(M, col = c(1, 0, 2))


#lang racket

(require racket/draw)

;; flood-fill: bitmap<%> number number color color -> void
;; An example of flood filling a bitmap.
;;
;; We'll use a raw, byte-oriented interface here for demonstration
;; purposes.  Racket does provide get-pixel and set-pixel functions
;; which work on color% structures rather than bytes, but it's useful
;; to see that the byte approach works as well.
(define (flood-fill bm start-x start-y target-color replacement-color)
  ;; The main loop.
  ;; http://en.wikipedia.org/wiki/Flood_fill
  (define (iter x y)
    (when (and (in-bounds? x y) (target-color-at? x y))
      (replace-color-at! x y)
      (iter (add1 x) y)
      (iter (sub1 x) y)
      (iter x (add1 y))
      (iter x (sub1 y))))

  ;; With auxillary definitions below:
  (define width (send bm get-width))
  (define height (send bm get-height))

  (define buffer (make-bytes (* width height 4)))
  (send bm get-argb-pixels 0 0 width height buffer)

  (define-values (target-red target-green target-blue)
    (values (send target-color red)
            (send target-color green)
            (send target-color blue)))

  (define-values (replacement-red replacement-green replacement-blue)
    (values (send replacement-color red)
            (send replacement-color green)
            (send replacement-color blue)))

  (define (offset-at x y) (* 4 (+ (* y width) x)))

  (define (target-color-at? x y)
    (define offset (offset-at x y))
    (and (= (bytes-ref buffer (+ offset 1)) target-red)
         (= (bytes-ref buffer (+ offset 2)) target-green)
         (= (bytes-ref buffer (+ offset 3)) target-blue)))

  (define (replace-color-at! x y)
    (define offset (offset-at x y))
    (bytes-set! buffer (+ offset 1) replacement-red)
    (bytes-set! buffer (+ offset 2) replacement-green)
    (bytes-set! buffer (+ offset 3) replacement-blue))

  (define (in-bounds? x y)
    (and (<= 0 x) (< x width) (<= 0 y) (< y height)))

  ;; Finally, let's do the fill, and then store the
  ;; result back into the bitmap:
  (iter start-x start-y)
  (send bm set-argb-pixels 0 0 width height buffer))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Example: flood fill a hole shape.
(define bm (make-bitmap 100 100))
(define dc (send bm make-dc))

;; We intentionally set the smoothing of the dc to
;; aligned so that there are no gaps in the shape for the
;; flood to leak through.
(send dc set-smoothing 'aligned)
(send dc draw-rectangle 10 10 80 80)
(send dc draw-rounded-rectangle 20 20 50 50)
;; In DrRacket, we can print the bm to look at it graphically,
;; before the flood fill:
bm

(flood-fill bm 50 50
            (send the-color-database find-color "white")
            (send the-color-database find-color "DarkSeaGreen"))
;; ... and after:
bm


class Pixel { has Int ($.R, $.G, $.B) }
class Bitmap {
    has Int ($.width, $.height);
    has Pixel @.data;

    method pixel(
	    $i where ^$!width,
	    $j where ^$!height
	    --> Pixel
      ) is rw { @!data[$i + $j * $!width] }
}

role PPM {
    method P6 returns Blob {
	"P6\n{self.width} {self.height}\n255\n".encode('ascii')
	~ Blob.new: flat map { .R, .G, .B }, self.data
    }
}

sub load-ppm ( $ppm ) {
    my $fh    = $ppm.IO.open( :enc('ISO-8859-1') );
    my $type  = $fh.get;
    my ($width, $height) = $fh.get.split: ' ';
    my $depth = $fh.get;
    Bitmap.new( width => $width.Int, height => $height.Int,
      data => ( $fh.slurp.ords.rotor(3).map:
        { Pixel.new(R => $_[0], G => $_[1], B => $_[2]) } )
    )
}

sub color-distance (Pixel $c1, Pixel $c2) {
    sqrt( ( ($c1.R - $c2.R)² + ($c1.G - $c2.G)² + ($c1.B - $c2.B)² ) / ( 255 * sqrt(3) ) );
}

sub flood ($img, $x, $y, $c1) {
    my $c2 = $img.pixel($x, $y);
    my $max-distance = 10;
    my @queue;
    my %checked;
    check($x, $y);
    for @queue -> [$x, $y] {
        $img.pixel($x, $y) = $c1.clone;
    }

    sub check ($x, $y) {
        my $c3 = $img.pixel($x, $y);

        if color-distance($c2, $c3) < $max-distance {
            @queue.push: [$x,$y];
            @queue.elems;
            %checked{"$x,$y"} = 1;
            check($x - 1, $y) if $x > 0               and %checked{"{$x - 1},$y"}:!exists;
            check($x + 1, $y) if $x < $img.width - 1  and %checked{"{$x + 1},$y"}:!exists;
            check($x, $y - 1) if $y > 0               and %checked{"$x,{$y - 1}"}:!exists;
            check($x, $y + 1) if $y < $img.height - 1 and %checked{"$x,{$y + 1}"}:!exists;
        }
    }
}

my $infile = './Unfilled-Circle.ppm';

my Bitmap $b = load-ppm( $infile ) but PPM;

flood($b, 5,     5, Pixel.new(:255R, :0G, :0B));
flood($b, 5,   125, Pixel.new(:255R, :0G, :0B));
flood($b, 125,   5, Pixel.new(:255R, :0G, :0B));
flood($b, 125, 125, Pixel.new(:255R, :0G, :0B));
flood($b, 50,   50, Pixel.new(:0R, :0G, :255B));

my $outfile = open('./Bitmap-flood-perl6.ppm', :w, :bin);

$outfile.write: $b.P6;


/*REXX program  demonstrates a  method  to  perform a  flood fill  of an area.          */
black= '000000000000000000000000'b               /*define the black color  (using bits).*/
red  = '000000000000000011111111'b               /*   "    "   red    "       "     "   */
green= '000000001111111100000000'b               /*   "    "  green   "       "     "   */
white= '111111111111111111111111'b               /*   "    "  white   "       "     "   */
                                                 /*image is defined to the test image.  */
hx= 125;          hy= 125                        /*define limits  (X,Y)  for the image. */
area= white;      call fill 125,  25, red        /*fill the white area in red.          */
area= black;      call fill 125, 125, green      /*fill the center orb in green.        */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fill: procedure expose image. hx hy area;  parse arg x,y,fill_color   /*obtain the args.*/
      if x<1 | x>hx | y<1 | y>hy   then return   /*X or Y  are outside of the image area*/
      pixel= image.x.y                           /*obtain the color of the  X,Y  pixel. */
      if pixel \== area  then return             /*the pixel has already been filled    */
                                                 /*with the  fill_color,  or we are not */
                                                 /*within the area to be filled.        */
      image.x.y= fill_color                      /*color desired area with fill_color.  */
      pixel= @(x  , y-1);   if pixel==area  then call fill x  , y-1, fill_color  /*north*/
      pixel= @(x-1, y  );   if pixel==area  then call fill x-1, y  , fill_color  /*west */
      pixel= @(x+1, y  );   if pixel==area  then call fill x+1, y  , fill_color  /*east */
      pixel= @(x  , y+1);   if pixel==area  then call fill x  , y+1, fill_color  /*south*/
      return
/*──────────────────────────────────────────────────────────────────────────────────────*/
@:    parse arg $x,$y;      return image.$x.$y   /*return with color of the  X,Y  pixel.*/


# frozen_string_literal: true

require_relative 'raster_graphics'

class RGBColour
  def ==(other)
    values == other.values
  end
end

class Pixmap
  def flood_fill(pixel, new_colour)
    current_colour = self[pixel.x, pixel.y]
    queue = Queue.new
    queue.enq(pixel)
    until queue.empty?
      p = queue.pop
      next unless self[p.x, p.y] == current_colour

      west = find_border(p, current_colour, :west)
      east = find_border(p, current_colour, :east)
      draw_line(west, east, new_colour)
      q = west
      while q.x <= east.x
        %i[north south].each do |direction|
          n = neighbour(q, direction)
          queue.enq(n) if self[n.x, n.y] == current_colour
        end
        q = neighbour(q, :east)
      end
    end
  end

  def neighbour(pixel, direction)
    case direction
    when :north then Pixel[pixel.x, pixel.y - 1]
    when :south then Pixel[pixel.x, pixel.y + 1]
    when :east  then Pixel[pixel.x + 1, pixel.y]
    when :west  then Pixel[pixel.x - 1, pixel.y]
    end
  end

  def find_border(pixel, colour, direction)
    nextp = neighbour(pixel, direction)
    while self[nextp.x, nextp.y] == colour
      pixel = nextp
      nextp = neighbour(pixel, direction)
    end
    pixel
  end
end

bitmap = Pixmap.new(300, 300)
bitmap.draw_circle(Pixel[149, 149], 120, RGBColour::BLACK)
bitmap.draw_circle(Pixel[200, 100], 40, RGBColour::BLACK)
bitmap.flood_fill(Pixel[140, 160], RGBColour::BLUE)
bitmap.save_as_png('flood_fill.png')


/* Naive Rust implementation of RosettaCode's Bitmap/Flood fill excercise.
 *
 * For the sake of simplicity this code reads PPM files (format specification can be found here: http://netpbm.sourceforge.net/doc/ppm.html ).
 * The program assumes that the image has been created by GIMP in PPM ASCII mode and panics at any error.
 *
 * Also this program expects the input file to be in the same directory as the executable and named
 * "input.ppm" and outputs a file in the same directory under the name "output.ppm".
 *
 */

use std::fs::File; // Used for creating/opening files.
use std::io::{BufReader, BufRead, Write}; // Used for reading/writing files.

fn read_image(filename: String) -> Vec<Vec<(u8,u8,u8)>> {
    let file = File::open(filename).unwrap();
    let reader = BufReader::new(file);
    let mut lines = reader.lines();

    let _ = lines.next().unwrap(); // Skip P3 signature.
    let _ = lines.next().unwrap(); // Skip GIMP comment.

    let dimensions: (usize, usize) = {
        let line = lines.next().unwrap().unwrap();
        let values = line.split_whitespace().collect::<Vec<&str>>();

        // We turn the &str vector that holds the width & height of the image into an usize tuplet.
        (values[0].parse::<usize>().unwrap(),values[1].parse::<usize>().unwrap())
    };

    let _ = lines.next().unwrap(); // Skip maximum color value (we assume 255).

    let mut image_data = Vec::with_capacity(dimensions.1);

    for y in 0..dimensions.1 {
        image_data.push(Vec::new());
        for _ in 0..dimensions.0 {
            // We read the R, G and B components and put them in the image_data vector.
            image_data[y].push((lines.next().unwrap().unwrap().parse::<u8>().unwrap(),
                                lines.next().unwrap().unwrap().parse::<u8>().unwrap(),
                                lines.next().unwrap().unwrap().parse::<u8>().unwrap()));
        }
    }

    image_data
}

fn write_image(image_data: Vec<Vec<(u8,u8,u8)>>) {
    let mut file = File::create(format!("./output.ppm")).unwrap();

    // Signature, then width and height, then 255 as max color value.
    write!(file, "P3\n{} {}\n255\n", image_data.len(), image_data[0].len()).unwrap();

    for row in &image_data {
        // For performance reasons, we reserve a String with the necessary length for a line and
        // fill that up before writing it to the file.

        let mut line = String::with_capacity(row.len()*6); // 6 = r(space)g(space)b(space)
        for (r,g,b) in row {

            // &* is used to turn a String into a &str as needed by push_str.
            line.push_str(&*format!("{} {} {} ", r,g,b));
        }

        write!(file, "{}", line).unwrap();
    }

}

fn flood_fill(x: usize, y: usize, target: &(u8,u8,u8), replacement: &(u8,u8,u8), image_data: &mut Vec<Vec<(u8,u8,u8)>>) {
    if &image_data[y][x] == target {
        image_data[y][x] = *replacement;

        if y > 0 {flood_fill(x,y-1, &target, &replacement, image_data);}
        if x > 0 {flood_fill(x-1,y, &target, &replacement, image_data);}
        if y < image_data.len()-1 {flood_fill(x,y+1, &target, &replacement, image_data);}
        if x < image_data[0].len()-1 {flood_fill(x+1,y, &target, &replacement, image_data);}
    }
}

fn main() {
    let mut data = read_image(String::from("./input.ppm"));

    flood_fill(1,50, &(255,255,255), &(0,255,0), &mut data); // Fill the big white circle with green.
    flood_fill(40,35, &(0,0,0), &(255,0,0), &mut data); // Fill the small black circle with red.

    write_image(data);

}


import java.awt.Color
import scala.collection.mutable

object Flood {
  def floodFillStack(bm:RgbBitmap, x: Int, y: Int, targetColor: Color): Unit = {
    // validate
    if (bm.getPixel(x,y) == targetColor) return

    // vars
    val oldColor = bm.getPixel(x,y)
    val pixels = new mutable.Stack[(Int,Int)]

    // candy coating methods
    def paint(fx: Int, fy:Int) = bm.setPixel(fx,fy,targetColor)
    def old(cx: Int, cy: Int): Boolean = bm.getPixel(cx,cy) == oldColor
    def push(px: Int, py: Int) = pixels.push((px,py))

    // starting point
    push(x,y)

    // work
    while (pixels.nonEmpty) {
      val (x, y) = pixels.pop()
      var y1 = y
      while (y1 >= 0 && old(x, y1)) y1 -= 1
      y1 += 1
      var spanLeft = false
      var spanRight = false
      while (y1 < bm.height && old(x, y1)) {
        paint(x,y1)
        if (x > 0 && spanLeft != old(x-1,y1)) {
          if (old(x - 1, y1)) push(x - 1, y1)
          spanLeft = !spanLeft
        }
        if (x < bm.width - 1 && spanRight != old(x+1,y1)) {
          if (old(x + 1, y1)) push(x + 1, y1)
          spanRight = !spanRight
        }
        y1 += 1
      }
    }
  }
}


(* For simplicity, we're going to fill black-and-white images. Nothing
 * fundamental would change if we used more colors. *)
datatype color = Black | White
(* Represent an image as a 2D mutable array of pixels, since flood-fill
 * is naturally an imperative algorithm. *)
type image = color array array

(* Helper functions to construct images for testing. Map 0 -> White
 * and 1 -> Black so we can write images concisely as lists. *)
fun intToColor 0 = White
  | intToColor _ = Black

fun listToImage (LL : int list list) : image =
    Array.tabulate(List.length LL,
     fn i => Array.tabulate (List.length (hd LL),
       fn j => intToColor(List.nth(List.nth(LL,i),j))))

(* Is the given pixel within the image ? *)
fun inBounds (img : image) ((x,y) : int * int) : bool =
    x >= 0 andalso y >= 0 andalso y < Array.length img
    andalso x < Array.length (Array.sub(img, y))

(* Return an option containing the neighbors we should explore next, if any.*)
fun neighbors (img : image) (c : color) ((x,y) : int * int) : (int * int) list option =
    if inBounds img (x,y) andalso Array.sub(Array.sub(img,y),x) <> c
    then SOME [(x-1,y),(x+1,y),(x,y-1),(x,y+1)]
    else NONE

(* Update the given pixel of the image. *)
fun setPixel (img : image) ((x,y) : int * int) (c : color) : unit =
    Array.update (Array.sub(img,y),x,c)

(* Recursive fill around the given point using the given color. *)
fun fill (img : image) (c : color) ((x,y) : int * int) : unit =
    case neighbors img c (x,y) of
        SOME xys => (setPixel img (x,y) c; List.app (fill img c) xys)
      | NONE => ()

val test = listToImage
[[0,0,1,1,0,1,0],
 [1,0,1,0,1,0,0],
 [1,0,0,0,0,0,1],
 [0,1,0,0,0,1,0],
 [1,0,0,0,0,0,1],
 [0,0,1,1,1,0,0],
 [0,1,0,0,0,1,0]]

(* Fill the image with black starting at the center. *)
val () = fill test Black (3,3)


package require Tcl 8.5
package require Tk
package require struct::queue

proc floodFill {img colour point} {
    set new [colour2rgb $colour]
    set old [getPixel $img $point]
    struct::queue Q
    Q put $point
    while {[Q size] > 0} {
        set p [Q get]
        if {[getPixel $img $p] eq $old} {
            set w [findBorder $img $p $old west]
            set e [findBorder $img $p $old east]
            drawLine $img $new $w $e
            set q $w
            while {[x $q] <= [x $e]} {
                set n [neighbour $q north]
                if {[getPixel $img $n] eq $old} {Q put $n}
                set s [neighbour $q south]
                if {[getPixel $img $s] eq $old} {Q put $s}
                set q [neighbour $q east]
            }
        }
    }
    Q destroy
}

proc findBorder {img p colour dir} {
    set lookahead [neighbour $p $dir]
    while {[getPixel $img $lookahead] eq $colour} {
        set p $lookahead
        set lookahead [neighbour $p $dir]
    }
    return $p
}

proc x p {lindex $p 0}
proc y p {lindex $p 1}

proc neighbour {p dir} {
    lassign $p x y
    switch -exact -- $dir {
        west  {return [list [incr x -1] $y]}
        east  {return [list [incr x] $y]}
        north {return [list $x [incr y -1]]}
        south {return [list $x [incr y]]}
    }
}

proc colour2rgb {color_name} {
    foreach part [winfo rgb . $color_name] {
        append colour [format %02x [expr {$part >> 8}]]
    }
    return #$colour
}

set img [newImage 70 50]
fill $img white

drawLine $img blue {0 0} {0 25}
drawLine $img blue {0 25} {35 25}
drawLine $img blue {35 25} {35 0}
drawLine $img blue {35 0} {0 0}
floodFill $img yellow {3 3}

drawCircle $img black {35 25} 24
drawCircle $img black {35 25} 10
floodFill $img orange {34 5}
floodFill $img red {36 5}

toplevel .flood
label .flood.l -image $img
pack .flood.l


import "graphics" for Canvas, ImageData, Color
import "dome" for Window
import "input" for Keyboard

class Bitmap {
    construct new(name, size) {
        Window.title = name
        Window.resize(size, size)
        Canvas.resize(size, size)
        size = size / 2
        _bmp = ImageData.create(name, size, size)
        _size = size
        _flooded = false
    }

    init() {
        var s = _size
        var hs = s / 2
        var qs = s / 4
        fill(0, 0, s, s, Color.yellow)
        fill(qs, qs, 3 * qs, 3 * qs, Color.red)
        fill(qs * 1.5, qs * 1.5, qs * 2.5, qs * 2.5, Color.white)
        _bmp.draw(hs, hs)
    }

    fill(s, t, w, h, col) {
        for (x in s...w) {
            for (y in t...h) pset(x, y, col)
        }
    }

    flood(x, y, repl) {
        var target = pget(x, y)
        var ff // recursive closure
        ff = Fn.new { |x, y|
            if (x >= 0 && x < _bmp.width && y >= 0 && y < _bmp.height) {
                var p = pget(x, y)
                if (p.r == target.r && p.g == target.g && p.b == target.b) {
                    pset(x, y, repl)
                    ff.call(x-1, y)
                    ff.call(x+1, y)
                    ff.call(x, y-1)
                    ff.call(x, y+1)
                }
            }
        }
        ff.call(x, y)
    }

    pset(x, y, col) { _bmp.pset(x, y, col) }

    pget(x, y) { _bmp.pget(x, y) }

    update() {
        var hs = _size / 2
        var qs = _size / 4
        if (!_flooded && Keyboard.isKeyDown("up")) {
           flood(qs, qs, Color.blue)
           _bmp.draw(hs, hs)
           _flooded = true
        } else if (_flooded && Keyboard.isKeyDown("down")) {
           flood(qs, qs, Color.red)
           _bmp.draw(hs, hs)
           _flooded = false
        }
    }

    draw(alpha) {}
}

var Game = Bitmap.new("Bitmap - flood fill", 600)


include c:\cxpl\codes;

proc    Flood(X, Y, C, C0);     \Fill an area of color C0 with color C
int     X, Y,   \seed coordinate (where to start)
        C, C0;  \color to fill with and color to replace
def     S=8000; \size of queue (must be an even number)
int     Q(S),   \queue (FIFO)
        F, E;   \fill and empty indexes

        proc    EnQ(X, Y);      \Enqueue coordinate
        int     X, Y;
        [Q(F):= X;
        F:= F+1;
        Q(F):= Y;
        F:= F+1;
        if F >= S then F:= 0;
        ];      \EnQ

        proc    DeQ;            \Dequeue coordinate
        [X:= Q(E);
        E:= E+1;
        Y:= Q(E);
        E:= E+1;
        if E >= S then E:= 0;
        ];      \DeQ

[F:= 0;  E:= 0;
EnQ(X, Y);
while E # F do
        [DeQ;
        if ReadPix(X, Y) = C0 then
                [Point(X, Y, C);
                EnQ(X+1, Y);    \enqueue adjacent pixels
                EnQ(X-1, Y);
                EnQ(X, Y+1);
                EnQ(X, Y-1);
                ];
        ];
];      \Flood

def     Size = 30.0;
int     X, Y;
real    Ang, Dist;
[SetVid($101);                  \set 640x480 graphics with 256 colors

Ang:= 0.0;                      \draw some flower petals
repeat  Dist:= Size*(Cos(Ang*3.0) - 1.0);
        X:= fix(Dist*Cos(Ang));
        Y:= fix(Dist*Sin(Ang));
        Point(X+320, 240-Y, $F);
        Ang:= Ang + 0.001;      \draw dots close together to prevent leaks
until   Ang >= 2.0*3.14159;

Flood(330, 240, $2A, 0);        \color the petals
Flood(310, 230, $2C, 0);
Flood(310, 250, $2E, 0);

if ChIn(1) then [];             \wait for keystroke
SetVid(3);                      \restore normal text mode
]


fcn flood(pixmap, x,y, repl){  // slow!
   targ,h,w:=pixmap[x,y], pixmap.h,pixmap.w;
   stack:=List(T(x,y));
   while(stack){
      x,y:=stack.pop();
      if((0<=y<h) and (0<=x<w)){
	 p:=pixmap[x,y];
	 if(p==targ){
	    pixmap[x,y]=repl;
	    stack.append( T(x-1,y), T(x+1,y), T(x, y-1), T(x, y+1) );
	 }
      }
   }
}


T Colour
   Byte r, g, b

   F (r, g, b)
      .r = r
      .g = g
      .b = b

   F ==(other)
      R .r == other.r & .g == other.g & .b == other.b

V black = Colour(0, 0, 0)
V white = Colour(255, 255, 255)

T Bitmap
   Int width, height
   Colour background
   [[Colour]] map

   F (width = 40, height = 40, background = white)
      assert(width > 0 & height > 0)
      .width = width
      .height = height
      .background = background
      .map = (0 .< height).map(h -> (0 .< @width).map(w -> @@background))

   F fillrect(x, y, width, height, colour = black)
      assert(x >= 0 & y >= 0 & width > 0 & height > 0)
      L(h) 0 .< height
         L(w) 0 .< width
            .map[y + h][x + w] = colour

   F chardisplay()
      V txt = .map.map(row -> row.map(bit -> (I bit == @@.background {‘ ’} E ‘@’)).join(‘’))
      txt = txt.map(row -> ‘|’row‘|’)
      txt.insert(0, ‘+’(‘-’ * .width)‘+’)
      txt.append(‘+’(‘-’ * .width)‘+’)
      print(reversed(txt).join("\n"))

   F set(x, y, colour = black)
      .map[y][x] = colour

   F get(x, y)
      R .map[y][x]

   F line(x0, y0, x1, y1)
      ‘Bresenham's line algorithm’
      V dx = abs(x1 - x0)
      V dy = abs(y1 - y0)
      V (x, y) = (x0, y0)
      V sx = I x0 > x1 {-1} E 1
      V sy = I y0 > y1 {-1} E 1
      I dx > dy
         V err = dx / 2.0
         L x != x1
            .set(x, y)
            err -= dy
            I err < 0
               y += sy
               err += dx
            x += sx
      E
         V err = dy / 2.0
         L y != y1
            .set(x, y)
            err -= dx
            I err < 0
               x += sx
               err += dy
            y += sy
      .set(x, y)

V bitmap = Bitmap(17, 17)
L(x0, y0, x1, y1) ((1, 8, 8, 16), (8, 16, 16, 8), (16, 8, 8, 1), (8, 1, 1, 8))
   bitmap.line(x0, y0, x1, y1)
bitmap.chardisplay()


*        Bitmap/Bresenham's line algorithm - 13/05/2019
BRESENH  CSECT
         USING  BRESENH,R13        base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R10,DATAXY         @dataxy
         LA     R8,1               p=1
     DO WHILE=(C,R8,LE,=A(POINTS)) do p=1 to points
         L      R6,0(R10)            x=dataxy((p-1)*2+1)
         L      R7,4(R10)            y=dataxy((p-1)*2+2)
       IF     C,R8,EQ,=F'1' THEN     if p=1 then
         ST     R6,MINX                minx=x
         ST     R6,MAXX                maxx=x
         ST     R7,MINY                miny=y
         ST     R7,MAXY                maxy=y
       ENDIF    ,                    endif
       IF     C,R6,LT,MINX THEN      if x<minx then
         ST     R6,MINX                minx=x
       ENDIF    ,                    endif
       IF     C,R6,GT,MAXX THEN      if x>maxx then
         ST     R6,MAXX                maxx=x
       ENDIF    ,                    endif
       IF     C,R7,LT,MINY THEN      if y<miny then
         ST     R7,MINY                miny=y
       ENDIF    ,                    endif
       IF     C,R7,GT,MAXY THEN      if y>maxy then
         ST     R7,MAXY                maxy=y
       ENDIF    ,                    endif
         LA     R10,8(R10)           @dataxy+=8
         LA     R8,1(R8)             p++
     ENDDO      ,                  enddo p
         L      R1,MINX            minx
         S      R1,=A(BORDER*2)    -border*2
         ST     R1,MINX            minx=minx-border*2
         L      R1,MAXX            maxx
         A      R1,=A(BORDER*2)    +border*2
         ST     R1,MAXX            maxx=maxx+border*2
         L      R1,MINY            miny
         S      R1,=A(BORDER)      -border
         ST     R1,MINY            miny=miny-border
         L      R1,MAXY            maxy
         A      R1,=A(BORDER)      +border
         ST     R1,MAXY            maxy=maxy+border
         L      R1,MINX            minx
         LCR    R1,R1              -
         A      R1,=F'1'           +1
         ST     R1,OX              ox=-minx+1
         L      R1,MINY            miny
         LCR    R1,R1              -
         A      R1,=F'1'           +1
         ST     R1,OY              oy=-miny+1
         LA     R1,HMAPX           hbound(map,1)
         S      R1,OX              wx=hbound(map,1)-ox
       IF     C,R1,LT,MAXX THEN    if maxx>wx then
         ST     R1,MAXX              maxx=wx
       ENDIF    ,                  endif
         LA     R1,HMAPY           hbound(map,2)
         S      R1,OY              wy=hbound(map,2)-oy
       IF     C,R1,LT,MAXY THEN    if maxy>wy then
         ST     R1,MAXY              maxy=wy
       ENDIF    ,                  endif
         L      R6,MINX            x=minx
       DO WHILE=(C,R6,LE,MAXX)     do x=minx to maxx
         L      R1,OY                oy
         BCTR   R1,0                 1
         MH     R1,=AL2(HMAPX)       dim(x)
         AR     R1,R6                x
         A      R1,OX                ox
         LA     R1,MAP-1(R1)         map(0+oy,x+ox)
         MVC    0(1,R1),=C'-'        map(0+oy,x+ox)='-'
         A      R6,=F'1'             x++
       ENDDO    ,                  enddo x
         L      R7,MINY            y=miny
       DO WHILE=(C,R7,LE,MAXY)     do y=miny to maxy
         LR     R1,R7                y
         A      R1,OY                +oy
         BCTR   R1,0                 -1
         MH     R1,=AL2(HMAPX)       *dim(x)
         A      R1,OX                +ox
         LA     R1,MAP-1(R1)         @map(y+oy,0+ox)
         MVC    0(1,R1),=C'|'        map(y+oy,0+ox)='|'
         A      R7,=F'1'             y++
       ENDDO    ,                  enddo y
         L      R1,OY              +oy
         BCTR   R1,0               -1
         MH     R1,=AL2(HMAPX)     *dim(x)
         A      R1,OX              +ox
         LA     R1,MAP-1(R1)       @map(0+oy,0+ox)
         MVC    0(1,R1),=C'+'      map(0+oy,0+ox)='+'
         LA     R10,POINTS         points
         BCTR   R10,0              pn=points-1
         LA     R9,DATAXY          @dataxy
         LA     R8,1               p=1
       DO WHILE=(CR,R8,LE,R10)     do p=1 to points-1
         L      R6,0(R9)             x=dataxy((p-1)*2+1)
         L      R7,4(R9)             y=dataxy((p-1)*2+2)
         L      R4,8(R9)             xf=dataxy(p*2+1)
         L      R5,12(R9)            yf=dataxy(p*2+2)
         LR     R2,R4                xf
         SR     R2,R6                -x
         LPR    R2,R2                abs()
         ST     R2,DX                dx=abs(xf-x)
         LR     R2,R5                xf
         SR     R2,R7                -y
         LPR    R2,R2                abs()
         ST     R2,DY                dy=abs(yf-y)
       IF    CR,R6,LT,R4 THEN        if x<xf then
         MVC    SX,=F'1'               sx=+1
       ELSE     ,                    else
         MVC    SX,=F'-1'              sx=-1
       ENDIF    ,                    endif
       IF    CR,R7,LT,R5 THEN        if y<yf then
         MVC    SY,=F'1'               sy=+1
       ELSE     ,                    else
         MVC    SY,=F'-1'              sy=-1
       ENDIF    ,                    endif
         L      R2,DX                dx
         S      R2,DY                -dy
         ST     R2,ERR               err=dx-dy
LOOP     EQU    *                    loop forever
         LR     R1,R7                  y
         A      R1,OY                  +oy
         BCTR   R1,0                   -1
         MH     R1,=AL2(HMAPX)         *dim(x)
         AR     R1,R6                  +x
         A      R1,OX                  +ox
         LA     R1,MAP-1(R1)           @map(y+oy,x+ox)
         MVC    0(1,R1),=C'X'          map(y+oy,x+ox)='X'
         CR     R6,R4                  if x=xf
         BNE    STAYDO                 ~
         CR     R7,R5                  if y=yf
         BE     EXITLOOP               if x=xf and y=yf then leave loop
STAYDO   L      R0,ERR                 err
         A      R0,ERR                 err+err
         ST     R0,ERR2                err2=err+err
         L      R0,DY                  dy
         LCR    R0,R0                  -dy
       IF     C,R0,LT,ERR2 THEN        if err2>-dy then
         A      R0,ERR                   -dy+err
         ST     R0,ERR                   err=err-dy
         A      R6,SX                    x=x+sx
       ENDIF    ,                      endif
         L      R0,DX                  dx
       IF     C,R0,GT,ERR2 THEN        if err2<dx then
         L      R0,ERR                   err
         A      R0,DX                    +dx
         ST     R0,ERR                   err=err+dx
         A      R7,SY                    y=y+sy
       ENDIF    ,                      endif
         B      LOOP                 endloop
EXITLOOP LA     R9,8(R9)             @dataxy+=2
         LA     R8,1(R8)             p++
       ENDDO    ,                  enddo p
         LA     R9,MAP+(HMAPX*HMAPY)-HMAPX  @map
         L      R7,MAXY            y=maxy
       DO WHILE=(C,R7,GE,MINY)     do y=maxy to miny by -1
         MVC    PG(HMAPX),0(R9)      output map(x,*)
         XPRNT  PG,L'PG              print buffer
         S      R9,=A(HMAPX)         @pg
         S      R7,=F'1'             y--
       ENDDO    ,                  enddo y
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling sav
BORDER   EQU    2                  border size
POINTS   EQU    (MAP-DATAXY)/L'DATAXY/2
HMAPX    EQU    24                 dim(map,1)
HMAPY    EQU    20                 dim(map,2)
DATAXY   DC     F'1',F'8',F'8',F'16',F'16',F'8',F'8',F'1',F'1',F'8'
MAP      DC     (HMAPX*HMAPY)CL1'.'    map(hmapx,hmapy)
OX       DS     F
OY       DS     F
MINX     DS     F
MAXX     DS     F
MINY     DS     F
MAXY     DS     F
DX       DS     F
DY       DS     F
SX       DS     F
SY       DS     F
ERR      DS     F
ERR2     DS     F
PG       DC     CL80' '            buffer
         REGEQU
         END    BRESENH


INCLUDE "H6:RGBLINE.ACT" ;from task Bresenham's line algorithm

RGB black,yellow,violet,blue

PROC DrawImage(RgbImage POINTER img BYTE x,y)
  RGB POINTER ptr
  BYTE i,j

  ptr=img.data
  FOR j=0 TO img.h-1
  DO
    FOR i=0 TO img.w-1
    DO
      IF RgbEqual(ptr,yellow) THEN
        Color=1
      ELSEIF RgbEqual(ptr,violet) THEN
        Color=2
      ELSEIF RgbEqual(ptr,blue) THEN
        Color=3
      ELSE
        Color=0
      FI
      Plot(x+i,y+j)
      ptr==+RGBSIZE
    OD
  OD
RETURN

PROC Main()
  RgbImage img
  BYTE CH=$02FC,width=[81],height=[51],st=[5]
  BYTE ARRAY ptr(12393)
  BYTE c,i,n
  INT x,y,nx,ny
  RGB POINTER col

  Graphics(7+16)
  SetColor(0,13,12) ;yellow
  SetColor(1,4,8)   ;violet
  SetColor(2,8,6)   ;blue
  SetColor(4,0,0)   ;black

  RgbBlack(black)
  RgbYellow(yellow)
  RgbViolet(violet)
  RgbBlue(blue)

  InitRgbImage(img,width,height,ptr)
  FillRgbImage(img,black)

  nx=width/st ny=height/st
  FOR n=0 TO 2*nx+2*ny-1
  DO
    IF n MOD 3=0 THEN col=yellow
    ELSEIF n MOD 3=1 THEN col=violet
    ELSE col=blue FI

    IF n<nx THEN
      x=n*st y=0
    ELSEIF n<nx+ny THEN
      x=width-1 y=(n-nx)*st
    ELSEIF n<2*nx+ny THEN
      x=width-1-(n-nx-ny)*st y=height-1
    ELSE
      x=0 y=height-1-(n-2*nx-ny)*st
    FI
    RgbLine(img,width/2,height/2,x,y,col)
  OD

  DrawImage(img,(160-width)/2,(96-height)/2)

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN


procedure Line (Picture : in out Image; Start, Stop : Point; Color : Pixel) is
   DX  : constant Float := abs Float (Stop.X - Start.X);
   DY  : constant Float := abs Float (Stop.Y - Start.Y);
   Err : Float;
   X   : Positive := Start.X;
   Y   : Positive := Start.Y;
   Step_X : Integer := 1;
   Step_Y : Integer := 1;
begin
   if Start.X > Stop.X then
      Step_X := -1;
   end if;
   if Start.Y > Stop.Y then
      Step_Y := -1;
   end if;
   if DX > DY then
      Err := DX / 2.0;
      while X /= Stop.X loop
         Picture (X, Y) := Color;
         Err := Err - DY;
         if Err < 0.0 then
            Y := Y + Step_Y;
            Err := Err + DX;
         end if;
         X := X + Step_X;
      end loop;
   else
      Err := DY / 2.0;
      while Y /= Stop.Y loop
         Picture (X, Y) := Color;
         Err := Err - DX;
         if Err < 0.0 then
            X := X + Step_X;
            Err := Err + DY;
         end if;
         Y := Y + Step_Y;
      end loop;
   end if;
   Picture (X, Y) := Color; -- Ensure dots to be drawn
end Line;


# -*- coding: utf-8 -*- #

line OF class image := (REF IMAGE picture, POINT start, stop, PIXEL color)VOID:
BEGIN
   REAL dx = ABS (x OF stop - x OF start),
        dy = ABS (y OF stop - y OF start);
   REAL err;
   POINT here := start,
         step := (1, 1);
   IF x OF start > x OF stop THEN
      x OF step := -1
   FI;
   IF y OF start > y OF stop THEN
      y OF step := -1
   FI;
   IF dx > dy THEN
      err := dx / 2;
      WHILE x OF here /= x OF stop DO
         picture[x OF here, y OF here] := color;
         err -:= dy;
         IF err < 0 THEN
            y OF here +:= y OF step;
            err +:= dx
         FI;
         x OF here +:= x OF step
      OD
   ELSE
      err := dy / 2;
      WHILE y OF here /= y OF stop DO
         picture[x OF here, y OF here] := color;
         err -:= dx;
         IF err < 0 THEN
            x OF here +:= x OF step;
            err +:= dy
         FI;
         y OF here +:= y OF step
      OD
   FI;
   picture[x OF here, y OF here] := color # ensure dots to be drawn #
END # line #;

SKIP


.486
IDEAL
;---------------------------------------------
; case: DeltaY is bigger than DeltaX
; input: p1X p1Y,
; 		 p2X p2Y,
;		 Color -> variable
; output: line on the screen
;---------------------------------------------
Macro DrawLine2DDY p1X, p1Y, p2X, p2Y
	local l1, lp, nxt
	mov dx, 1
	mov ax, [p1X]
	cmp ax, [p2X]
	jbe l1
	neg dx ; turn delta to -1
l1:
	mov ax, [p2Y]
	shr ax, 1 ; div by 2
	mov [TempW], ax
	mov ax, [p1X]
	mov [pointX], ax
	mov ax, [p1Y]
	mov [pointY], ax
	mov bx, [p2Y]
	sub bx, [p1Y]
	absolute bx
	mov cx, [p2X]
	sub cx, [p1X]
	absolute cx
	mov ax, [p2Y]
lp:
	pusha
	call PIXEL
	popa
	inc [pointY]
	cmp [TempW], 0
	jge nxt
	add [TempW], bx ; bx = (p2Y - p1Y) = deltay
	add [pointX], dx ; dx = delta
nxt:
	sub [TempW], cx ; cx = abs(p2X - p1X) = daltax
	cmp [pointY], ax ; ax = p2Y
	jne lp
	call PIXEL
ENDM DrawLine2DDY
;---------------------------------------------
; case: DeltaX is bigger than DeltaY
; input: p1X p1Y,
; 		 p2X p2Y,
;		 Color -> variable
; output: line on the screen
;---------------------------------------------
Macro DrawLine2DDX p1X, p1Y, p2X, p2Y
	local l1, lp, nxt
	mov dx, 1
	mov ax, [p1Y]
	cmp ax, [p2Y]
	jbe l1
	neg dx ; turn delta to -1
l1:
	mov ax, [p2X]
	shr ax, 1 ; div by 2
	mov [TempW], ax
	mov ax, [p1X]
	mov [pointX], ax
	mov ax, [p1Y]
	mov [pointY], ax
	mov bx, [p2X]
	sub bx, [p1X]
	absolute bx
	mov cx, [p2Y]
	sub cx, [p1Y]
	absolute cx
	mov ax, [p2X]
lp:
	pusha
	call PIXEL
	popa
	inc [pointX]
	cmp [TempW], 0
	jge nxt
	add [TempW], bx ; bx = abs(p2X - p1X) = deltax
	add [pointY], dx ; dx = delta
nxt:
	sub [TempW], cx ; cx = abs(p2Y - p1Y) = deltay
	cmp [pointX], ax ; ax = p2X
	jne lp
	call PIXEL
ENDM DrawLine2DDX
Macro absolute a
	local l1
	cmp a, 0
	jge l1
	neg a
l1:
Endm
    MODEL small
    STACK 256
    DATASEG
    TempW dw ?
    pointX dw ?
    pointY dw ?
    point1X dw ?
    point1Y dw ?
    point2X dw ?
    point2Y dw ?
    Color db ?
    CODESEG
start:
        mov ax, @data
        mov ds, ax

	mov ax, 13h
	int 10h ; set graphic mode

	mov [Color], 61
	mov [point1X], 300
	mov [point2X], 6
	mov [point1Y], 122
	mov [point2Y], 88
	call DrawLine2D

	mov ah, 00h
	int 16h
exit:
	mov ax,03h
	int 10h ; set text mode

        mov ax, 4C00h
        int 21h
; procedures
;---------------------------------------------
; input: point1X point1Y,
; 		 point2X point2Y,
;		 Color
; output: line on the screen
;---------------------------------------------
PROC DrawLine2D
	mov cx, [point1X]
	sub cx, [point2X]
	absolute cx
	mov bx, [point1Y]
	sub bx, [point2Y]
	absolute bx
	cmp cx, bx
	jae DrawLine2Dp1 ; deltaX > deltaY
	mov ax, [point1X]
	mov bx, [point2X]
	mov cx, [point1Y]
	mov dx, [point2Y]
	cmp cx, dx
	jbe DrawLine2DpNxt1 ; point1Y <= point2Y
	xchg ax, bx
	xchg cx, dx
DrawLine2DpNxt1:
	mov [point1X], ax
	mov [point2X], bx
	mov [point1Y], cx
	mov [point2Y], dx
	DrawLine2DDY point1X, point1Y, point2X, point2Y
	ret
DrawLine2Dp1:
	mov ax, [point1X]
	mov bx, [point2X]
	mov cx, [point1Y]
	mov dx, [point2Y]
	cmp ax, bx
	jbe DrawLine2DpNxt2 ; point1X <= point2X
	xchg ax, bx
	xchg cx, dx
DrawLine2DpNxt2:
	mov [point1X], ax
	mov [point2X], bx
	mov [point1Y], cx
	mov [point2Y], dx
	DrawLine2DDX point1X, point1Y, point2X, point2Y
	ret
ENDP DrawLine2D
;-----------------------------------------------
; input: pointX pointY,
;           Color
; output: point on the screen
;-----------------------------------------------
PROC PIXEL
	mov bh,0h
	mov cx,[pointX]
	mov dx,[pointY]
	mov al,[Color]
	mov ah,0Ch
	int 10h
	ret
ENDP PIXEL
END start


Blue := Color(0,0,255)
White := Color(255,255,255)
Bitmap := Bitmap(100,100,Blue) ;create a 100*100 blue bitmap
Line(Bitmap,White,5,10,60,80) ;draw a white line from (5,10) to (60,80)
Bitmap.Write("Line.ppm") ;write the bitmap to file

Line(ByRef Bitmap,ByRef Color,PosX1,PosY1,PosX2,PosY2)
{
 DeltaX := Abs(PosX2 - PosX1), DeltaY := -Abs(PosY2 - PosY1) ;calculate deltas
 StepX := ((PosX1 < PosX2) ? 1 : -1), StepY := ((PosY1 < PosY2) ? 1 : -1) ;calculate steps
 ErrorValue := DeltaX + DeltaY ;calculate error value
 Loop ;loop over the pixel values
 {
  Bitmap[PosX1,PosX2] := Color
  If (PosX1 = PosX2 && PosY1 = PosY2)
   Break
  Temp1 := ErrorValue << 1, ((Temp1 > DeltaY) ? (ErrorValue += DeltaY, PosX1 += StepX) : ""), ((Temp1 < DeltaX) ? (ErrorValue += DeltaX, PosY1 += StepY) : "") ;move forward
 }
}


Local $var = drawBresenhamLine(2, 3, 2, 6)

Func drawBresenhamLine($iX0, $iY0, $iX1, $iY1)
	Local $iDx = Abs($iX1 - $iX0)
	Local $iSx = $iX0 < $iX1 ? 1 : -1
	Local $iDy = Abs($iY1 - $iY0)
	Local $iSy = $iY0 < $iY1 ? 1 : -1
	Local $iErr = ($iDx > $iDy ? $iDx : -$iDy) / 2, $e2

	While $iX0 <= $iX1
		ConsoleWrite("plot( $x=" & $iX0 & ", $y=" & $iY0 & " )" & @LF)
		If ($iX0 = $iX1) And ($iY0 = $iY1) Then Return
		$e2 = $iErr
		If ($e2 > -$iDx) Then
			$iErr -= $iDy
			$iX0 += $iSx
		EndIf
		If ($e2 < $iDy) Then
			$iErr += $iDx
			$iY0 += $iSy
		EndIf
	WEnd
EndFunc   ;==>drawBresenhamLine


#! /bin/bash

function line {
  x0=$1
  y0=$2
  x1=$3
  y1=$4

  if (( x0 > x1 ))
  then
    (( dx = x0 - x1 ))
    (( sx = -1 ))
  else
    (( dx = x1 - x0 ))
    (( sx = 1 ))
  fi

  if (( y0 > y1 ))
  then
    (( dy = y0 - y1 ))
    (( sy = -1 ))
  else
    (( dy = y1 - y0 ))
    (( sy = 1 ))
  fi

  if (( dx > dy ))
  then
    (( err = dx ))
  else
    (( err = -dy ))
  fi
  (( err /= 2 ))
  (( e2 = 0 ))

  while :
  do
    echo -en "\e[${y0};${x0}H#\e[K"
    (( x0 == x1 && y0 == y1 )) && return
    (( e2 = err ))
    if (( e2 > -dx ))
    then
      (( err -= dy ))
      ((  x0 += sx ))
    fi
    if (( e2 < dy ))
    then
      (( err += dx ))
      ((  y0 += sy ))
    fi
  done
}

# Draw a full screen diamond
COLS=$( tput cols )
LINS=$( tput lines )
LINS=$((LINS-1))
clear
line $((COLS/2)) 1 $((COLS/4)) $((LINS/2))
line $((COLS/4)) $((LINS/2)) $((COLS/2)) $LINS
line $((COLS/2)) $LINS $((COLS/4*3)) $((LINS/2))
line $((COLS/4*3)) $((LINS/2)) $((COLS/2)) 1
echo -e "\e[${LINS}H"


 1500 REM === DRAW a LINE. Ported from C version
 1510 REM Inputs are X1, Y1, X2, Y2: Destroys value of X1, Y1
 1520 DX = ABS(X2 - X1):SX = -1:IF X1 < X2 THEN SX = 1
 1530 DY = ABS(Y2 - Y1):SY = -1:IF Y1 < Y2 THEN SY = 1
 1540 ER = -DY:IF DX > DY THEN ER = DX
 1550 ER = INT(ER / 2)
 1560 PLOT X1,Y1:REM This command may differ depending ON BASIC dialect
 1570 IF X1 = X2 AND Y1 = Y2 THEN RETURN
 1580 E2 = ER
 1590 IF E2 > -DX THEN ER = ER - DY:X1 = X1 + SX
 1600 IF E2 < DY THEN ER = ER + DX:Y1 = Y1 + SY
 1610 GOTO 1560


@echo off
setlocal enabledelayedexpansion

set width=87
set height=51

mode %width%,%height%

set "grid="
set /a resolution=height*width
for /l %%i in (1,1,%resolution%) do (
	set "grid=!grid! "
)
call :line 1 1 5 5
call :line 9 30 60 7
call :line 9 30 60 50
call :line 52 50 32 1
echo:%grid%
pause>nul
exit

:line
	set x1=%1
	set y1=%2
	set x2=%3
	set y2=%4

	set /a dx=x2-x1
	set /a dy=y2-y1

	::Clipping done to avoid overflow

	if %dx% neq 0 set /a o=y1 - ( x1 * dy / dx )
	if %x1% leq %x2% (
		if %x1% geq %width% goto :eof
		if %x2% lss 0 goto :eof

		if %x1% lss 0 (
			if %dx% neq 0 set y1=%o%
			set x1=0
		)
		if %x2% geq %width% (
			set /a x2= width - 1
			if %dx% neq 0 set /a "y2= x2 * dy / dx + o"
		)
	) else (
		if %x2% geq %width% goto :eof
		if %x1% lss 0 goto :eof

		if %x2% lss 0 (
			if %dx% neq 0 set y2=%o%
			set x2=0
		)
		if %x1% geq %width% (
			set /a x1=width - 1
			if %dx% neq 0 set /a "y1= x1 * dy / dx + o"
		)
	)
	if %y1% leq %y2% (
		if %y1% geq %height% goto :eof
		if %y2% lss 0 goto :eof

		if %y1% lss 0 (
			set y1=0
			if %dx% neq 0 set /a x1= - o * dx /dy
		)
		if %y2% geq %height% (
			set /a y2=height-1
			if %dx% neq 0 set /a "x2= (y2 - o) * dx /dy"
		)
	) else (
		if %y2% geq %height% goto :eof
		if %y1% lss 0 goto :eof

		if %y2% lss 0 (
			set y2=0
			if %dx% neq 0 set /a "x2= - o * dx /dy"
		)
		if %y1% geq %height% (
			set /a y1=height-1
			if %dx% neq 0 set /a "x1= (y1 - o) * dx /dy"
		)
	)

	:: Start of Bresenham's algorithm

	set stepy=1
	set stepx=1

	set /a dx=x2-x1
	set /a dy=y2-y1

	if %dy% lss 0 set /a "dy=-dy","stepy=-1"
	if %dx% lss 0 set /a "dx=-dx","stepx=-1"

	set /a "dy <<= 1"
	set /a "dx <<= 1"

	if %dx% gtr %dy% (
		set /a "fraction=dy-(dx>>1)"
		set /a "cursor=y1*width + x1"
		for /l %%x in (%x1%,%stepx%,%x2%) do (
			set /a cursorP=cursor+1
			for /f "tokens=1-2" %%g in ("!cursor! !cursorP!") do set "grid=!grid:~0,%%g!Û!grid:~%%h!"
			if !fraction! geq 0 (
				set /a y1+=stepy
				set /a cursor+=stepy*width
				set /a fraction-=dx
			)
			set /a fraction+=dy
			set /a cursor+=stepx
		)
	) else (
		set /a "fraction=dx-(dy>>1)"
		set /a "cursor=y1*width + x1"
		for /l %%y in (%y1%,%stepy%,%y2%) do (
			set /a cursorP=cursor+1
			for /f "tokens=1-2" %%g in ("!cursor! !cursorP!") do set "grid=!grid:~0,%%g!Û!grid:~%%h!"
			if !fraction! geq 0 (
				set /a x1+=stepx
				set /a cursor+=stepx
				set /a fraction-=dy
			)
			set /a fraction+=dx
			set /a cursor+=width*stepy
		)
	)
	goto :eof


      Width% = 200
      Height% = 200

      REM Set window size:
      VDU 23,22,Width%;Height%;8,16,16,128

      REM Draw lines:
      PROCbresenham(50,100,100,190,0,0,0)
      PROCbresenham(100,190,150,100,0,0,0)
      PROCbresenham(150,100,100,10,0,0,0)
      PROCbresenham(100,10,50,100,0,0,0)
      END

      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


void line(int x0, int y0, int x1, int y1) {

  int dx = abs(x1-x0), sx = x0<x1 ? 1 : -1;
  int dy = abs(y1-y0), sy = y0<y1 ? 1 : -1;
  int err = (dx>dy ? dx : -dy)/2, e2;

  for(;;){
    setPixel(x0,y0);
    if (x0==x1 && y0==y1) break;
    e2 = err;
    if (e2 >-dx) { err -= dy; x0 += sx; }
    if (e2 < dy) { err += dx; y0 += sy; }
  }
}


using System;
using System.Drawing;
using System.Drawing.Imaging;
static class Program
{
    static void Main()
    {
        new Bitmap(200, 200)
            .DrawLine(0, 0, 199, 199, Color.Black).DrawLine(199,0,0,199,Color.Black)
            .DrawLine(50, 75, 150, 125, Color.Blue).DrawLine(150, 75, 50, 125, Color.Blue)
            .Save("line.png", ImageFormat.Png);
    }
    static Bitmap DrawLine(this Bitmap bitmap, int x0, int y0, int x1, int y1, Color color)
    {
        int dx = Math.Abs(x1 - x0), sx = x0 < x1 ? 1 : -1;
        int dy = Math.Abs(y1 - y0), sy = y0 < y1 ? 1 : -1;
        int err = (dx > dy ? dx : -dy) / 2, e2;
        for(;;) {
            bitmap.SetPixel(x0, y0, color);
            if (x0 == x1 && y0 == y1) break;
            e2 = err;
            if (e2 > -dx) { err -= dy; x0 += sx; }
            if (e2 < dy) { err += dx; y0 += sy; }
        }
        return bitmap;
    }
}


void Line( float x1, float y1, float x2, float y2, const Color& color )
{
        // Bresenham's line algorithm
  const bool steep = (fabs(y2 - y1) > fabs(x2 - x1));
  if(steep)
  {
    std::swap(x1, y1);
    std::swap(x2, y2);
  }

  if(x1 > x2)
  {
    std::swap(x1, x2);
    std::swap(y1, y2);
  }

  const float dx = x2 - x1;
  const float dy = fabs(y2 - y1);

  float error = dx / 2.0f;
  const int ystep = (y1 < y2) ? 1 : -1;
  int y = (int)y1;

  const int maxX = (int)x2;

  for(int x=(int)x1; x<=maxX; x++)
  {
    if(steep)
    {
        SetPixel(y,x, color);
    }
    else
    {
        SetPixel(x,y, color);
    }

    error -= dy;
    if(error < 0)
    {
        y += ystep;
        error += dx;
    }
  }
}


(defn draw-line
  "Draw a line from x1,y1 to x2,y2 using Bresenham's, to a java BufferedImage in the colour of pixel."
  [buffer x1 y1 x2 y2 pixel]
  (let [dist-x (Math/abs (- x1 x2))
   dist-y (Math/abs (- y1 y2))
   steep (> dist-y dist-x)]
    (let [[x1 y1 x2 y2] (if steep [y1 x1 y2 x2] [x1 y1 x2 y2])]
      (let [[x1 y1 x2 y2] (if (> x1 x2) [x2 y2 x1 y1] [x1 y1 x2 y2])]
  (let  [delta-x (- x2 x1)
     delta-y (Math/abs (- y1 y2))
     y-step (if (< y1 y2) 1 -1)]

    (let [plot (if steep
       #(.setRGB buffer (int %1) (int %2) pixel)
       #(.setRGB buffer (int %2) (int %1) pixel))]

      (loop [x x1 y y1 error (Math/floor (/ delta-x 2)) ]
        (plot x y)
        (if (< x x2)
    ; Rather then rebind error, test that it is less than delta-y rather than zero
    (if (< error delta-y)
      (recur (inc x) (+ y y-step) (+ error (- delta-x delta-y)))
      (recur (inc x) y            (- error delta-y)))))))))))


drawBresenhamLine = (x0, y0, x1, y1) ->
  dx = Math.abs(x1 - x0)
  sx = if x0 < x1 then 1 else -1
  dy = Math.abs(y1 - y0)
  sy = if y0 < y1 then 1 else -1
  err = (if dx>dy then dx else -dy) / 2

  loop
    setPixel(x0, y0)
    break if x0 == x1 && y0 == y1
    e2 = err
    if e2 > -dx
      err -= dy
      x0 += sx
    if e2 < dy
      err += dx
      y0 += sy
  null


   10 rem bresenham line algorihm
   20 rem translated from purebasic
   30 x0=10 : rem start x co-ord
   40 y0=15 : rem start y co-ord
   50 x1=30 : rem end x co-ord
   60 y1=20 : rem end y co-ord
   70 se=0 :  rem 0 = steep 1 = !steep
   80 ns=25 : rem num segments
   90 dim pt(ns,2) : rem points in line
  100 sc=1024 : rem start of screen memory
  110 sw=40   : rem screen width
  120 sh=25   : rem screen height
  130 pc=42   : rem plot character '*'
  140 gosub 1000
  150 end
 1000 rem plot line
 1010 if abs(y1-y0)>abs(x1-x0) then se=1:tp=y0:y0=x0:x0=tp:tp=y1:y1=x1:x1=tp
 1020 if x0>x1 then tp=x1:x1=x0:x0=tp:tp=y1:y1=y0:y0=tp
 1030 dx=x1-x0
 1040 dy=abs(y1-y0)
 1050 er=dx/2
 1060 y=y0
 1070 ys=-1
 1080 if y0<y1 then ys = 1
 1090 for x=x0 to x1
 1100 if se=1 then p0=y: p1=x:gosub 2000:goto 1120
 1110 p0=x: p1=y: gosub 2000
 1120 er=er-dy
 1130 if er<0 then y=y+ys:er=er+dx
 1140 next x
 1150 return
 2000 rem plot individual point
 2010 rem p0 == plot point x
 2020 rem p1 == plot point y
 2030 sl=p0+(p1*sw)
 2040 rem make sure we dont write beyond screen memory
 2050 if sl<(sw*sh) then poke sc+sl,pc
 2060 return


(defun draw-line (buffer x1 y1 x2 y2 pixel)
  (declare (type rgb-pixel-buffer buffer))
  (declare (type integer x1 y1 x2 y2))
  (declare (type rgb-pixel pixel))
  (let* ((dist-x (abs (- x1 x2)))
         (dist-y (abs (- y1 y2)))
         (steep (> dist-y dist-x)))
    (when steep
      (psetf x1 y1 y1 x1
             x2 y2 y2 x2))
    (when (> x1 x2)
      (psetf x1 x2 x2 x1
             y1 y2 y2 y1))
    (let* ((delta-x (- x2 x1))
           (delta-y (abs (- y1 y2)))
           (error (floor delta-x 2))
           (y-step (if (< y1 y2) 1 -1))
           (y y1))
      (loop
        :for x :upfrom x1 :to x2
        :do (if steep
                (setf (rgb-pixel buffer x y) pixel)
                (setf (rgb-pixel buffer y x) pixel))
            (setf error (- error delta-y))
            (when (< error 0)
              (incf y y-step)
              (incf error delta-x))))
    buffer))


module bitmap_bresenhams_line_algorithm;

import std.algorithm, std.math, bitmap;

void drawLine(Color)(Image!Color img,
                        size_t x1,    size_t y1,
                     in size_t x2, in size_t y2,
                     in Color color)
pure nothrow @nogc {
    immutable int dx = x2 - x1;
    immutable int ix = (dx > 0) - (dx < 0);
    immutable size_t dx2 = abs(dx) * 2;
    int dy = y2 - y1;
    immutable int iy = (dy > 0) - (dy < 0);
    immutable size_t dy2 = abs(dy) * 2;
    img[x1, y1] = color;

    if (dx2 >= dy2) {
        int error = dy2 - (dx2 / 2);
        while (x1 != x2) {
            if (error >= 0 && (error || (ix > 0))) {
                error -= dx2;
                y1 += iy;
            }

            error += dy2;
            x1 += ix;
            img[x1, y1] = color;
        }
    } else {
        int error = dx2 - (dy2 / 2);
        while (y1 != y2) {
            if (error >= 0 && (error || (iy > 0))) {
                error -= dy2;
                x1 += ix;
            }

            error += dx2;
            y1 += iy;
            img[x1, y1] = color;
        }
    }
}

version (bitmap_bresenhams_line_algorithm_main) {
    void main() {
        auto img = new Image!RGB(25, 22);
        img.drawLine(5, 5, 15, 20, RGB.white);
        img.drawLine(3, 20, 10, 12, RGB.white);
        img.textualShow();
    }
}


procedure drawLine (bitmap : TBitmap; xStart, yStart, xEnd, yEnd : integer; color : TAlphaColor);
// Bresenham's Line Algorithm.  Byte, March 1988, pp. 249-253.
// Modified from http://www.efg2.com/Lab/Library/Delphi/Graphics/Bresenham.txt and tested.
var
      a, b       :  integer;  // displacements in x and y
      d          :  integer;  // decision variable
      diag_inc   :  integer;  // d's increment for diagonal steps
      dx_diag    :  integer;  // diagonal x step for next pixel
      dx_nondiag :  integer;  // nondiagonal x step for next pixel
      dy_diag    :  integer;  // diagonal y step for next pixel
      dy_nondiag :  integer;  // nondiagonal y step for next pixel
      i          :  integer;  // loop index
      nondiag_inc:  integer;  // d's increment for nondiagonal steps
      swap       :  integer;  // temporary variable for swap
      x,y        :  integer;  // current x and y coordinates
begin
    x := xStart;              // line starting point}
    y := yStart;
    // Determine drawing direction and step to the next pixel.
    a := xEnd - xStart;       // difference in x dimension
    b := yEnd - yStart;       // difference in y dimension
    // Determine whether end point lies to right or left of start point.
    if a < 0 then             // drawing towards smaller x values?
       begin
       a := -a;               // make 'a' positive
       dx_diag := -1
       end
    else
       dx_diag := 1;

    // Determine whether end point lies above or below start point.
    if b < 0 then             // drawing towards smaller x values?
       begin
       b := -b;               // make 'a' positive
       dy_diag := -1
       end
    else
       dy_diag := 1;
    // Identify octant containing end point.
    if a < b then
       begin
       swap := a;
       a := b;
       b := swap;
       dx_nondiag := 0;
       dy_nondiag := dy_diag
       end
    else
       begin
       dx_nondiag := dx_diag;
       dy_nondiag := 0
       end;
    d := b + b - a;           // initial value for d is 2*b - a
    nondiag_inc := b + b;     // set initial d increment values
    diag_inc    := b + b - a - a;
    for i := 0 to a do
        begin   /// draw the a+1 pixels
        drawPixel (bitmap, x, y, color);
        if d < 0 then            // is midpoint above the line?
           begin                 // step nondiagonally
           x := x + dx_nondiag;
           y := y + dy_nondiag;
           d := d + nondiag_inc  // update decision variable
           end
        else
           begin                 // midpoint is above the line; step diagonally}
           x := x + dx_diag;
           y := y + dy_diag;
           d := d + diag_inc
           end;
    end;
end;


def swap(&left, &right) { # From [[Generic swap]]
  def t := left
  left := right
  right := t
}

def drawLine(image, var x0, var y0, var x1, var y1, color) {
    def steep := (y1 - y0).abs() > (x1 - x0).abs()
    if (steep) {
        swap(&x0, &y0)
        swap(&x1, &y1)
    }
    if (x0 > x1) {
        swap(&x0, &x1)
        swap(&y0, &y1)
    }
    def deltax := x1 - x0
    def deltay := (y1 - y0).abs()
    def ystep := if (y0 < y1) { 1 } else { -1 }
    var error := deltax // 2
    var y := y0
    for x in x0..x1 {
        if (steep) { image[y, x] := color } else { image[x, y] := color }
        error -= deltay
        if (error < 0) {
            y += ystep
            error += deltax
        }
    }
}


-- Brensenham Line Algorithm

type alias Position =
  {x: Int, y: Int}

type alias BresenhamStatics =
  { finish : Position
  , sx : Int
  , sy : Int
  , dx : Float
  , dy : Float
  }

line : Position -> Position -> List Position
line p q =
  let
    dx = (toFloat << abs) (q.x - p.x)
    dy = (toFloat << abs) (q.y - p.y)

    sx = if p.x < q.x then 1 else -1
    sy = if p.y < q.y then 1 else -1

    error =
      (if dx > dy then dx else -dy) / 2

    statics =
      BresenhamStatics q sx sy dx dy
  in
  bresenhamLineLoop statics error p []

bresenhamLineLoop : BresenhamStatics -> Float -> Position -> List Position -> List Position
bresenhamLineLoop statics error p positions =
  let
    positions_ = p :: positions
    {sx, sy, dx, dy, finish} = statics
  in
  if (p.x == finish.x) && (p.y == finish.y) then
    positions_
  else
    let
      (dErrX, x) =
        if error > -dx then (-dy, sx + p.x)
        else (0, p.x)

      (dErrY, y) =
        if error < dy then (dx, sy + p.y)
        else (0, p.y)

      error_ = error + dErrX + dErrY
    in
      bresenhamLineLoop statics error_ (Position x y) positions_


build_path({Sx, Sy}, {Tx, Ty}) ->
  if
    Tx < Sx -> StepX = -1;
    true -> StepX = 1
  end,
  if
    Ty < Sy -> StepY = -1;
    true -> StepY = 1
  end,

  Dx = abs((Tx-Sx)*2),
  Dy = abs((Ty-Sy)*2),

  if
    Dy > Dx -> Path = through_y({Sx, Sy}, {Tx, Ty}, {StepX, StepY}, {Dx, Dy}, Dx*2-Dy, []);
    true -> Path = through_x({Sx, Sy}, {Tx, Ty}, {StepX, StepY}, {Dx, Dy}, Dy*2-Dx, [])
  end,

  lists:reverse(Path).

through_x({Tx, _}, {Tx, _}, _, _, _, P) -> P;
through_x({Sx, Sy}, {Tx, Ty}, {StepX, StepY}, {Dx, Dy}, F0, P) when F0 >= 0 ->
  Ny = Sy + StepY,
  F1 = F0 - Dx,
  Nx = Sx + StepX,
        F2 = F1 + Dy,
  through_x({Nx, Ny}, {Tx, Ty}, {StepX, StepY}, {Dx, Dy}, F2, [{Nx, Ny}|P]);
through_x({Sx, Sy}, {Tx, Ty}, {StepX, StepY}, {Dx, Dy}, F0, P) when F0 < 0 ->
  Ny = Sy,
  Nx = Sx + StepX,
        F2 = F0 + Dy,
  through_x({Nx, Ny}, {Tx, Ty}, {StepX, StepY}, {Dx, Dy}, F2, [{Nx, Ny}|P]).

through_y({_, Ty}, {_, Ty}, _, _, _, P) -> P;
through_y({Sx, Sy}, {Tx, Ty}, {StepX, StepY}, {Dx, Dy}, F0, P) when F0 >= 0 ->
  Nx = Sx + StepX,
  F1 = F0 - Dy,
  Ny = Sy + StepY,
        F2 = F1 + Dx,
  through_y({Nx, Ny}, {Tx, Ty}, {StepX, StepY}, {Dx, Dy}, F2, [{Nx, Ny}|P]);
through_y({Sx, Sy}, {Tx, Ty}, {StepX, StepY}, {Dx, Dy}, F0, P) when F0 < 0 ->
  Nx = Sx,
  Ny = Sy + StepY,
        F2 = F0 + Dx,
  through_y({Nx, Ny}, {Tx, Ty}, {StepX, StepY}, {Dx, Dy}, F2, [{Nx, Ny}|P]).


PROGRAM BRESENHAM

!$INCLUDE="PC.LIB"

PROCEDURE BRESENHAM
! === Draw a line using graphic coordinates
! Inputs are X1, Y1, X2, Y2: Destroys value of X1, Y1
dx=ABS(x2-x1) sx=-1
IF x1<x2 THEN sx=1
dy=ABS(y2-y1) sy=-1
IF y1<y2 THEN sy=1
er=-dy
IF dx>dy THEN er=dx
er=INT(er/2)
LOOP
   PSET(x1,y1,1)
   EXIT IF x1=x2 AND y1=y2
   e2=er
   IF e2>-dx THEN er=er-dy x1=x1+sx
   IF e2<dy THEN er=er+dx y1=y1+sy
END LOOP
END PROCEDURE

BEGIN
  SCREEN(2)
  INPUT(x1,y1,x2,y2)
  BRESENHAM
  GET(A$)
  SCREEN(0)
END PROGRAM


include std/console.e
include std/graphics.e
include std/math.e

-- the new_image function and related code in the 25 or so
-- lines below are from http://rosettacode.org/wiki/Basic_bitmap_storage#Euphoria
-- as of friday, march 2, 2012

-- Some color constants:
constant
    black = #000000,
    white = #FFFFFF,
    red =   #FF0000,
    green = #00FF00,
    blue =  #0000FF

-- Create new image filled with some color
function new_image(integer width, integer height, atom fill_color)
    return repeat(repeat(fill_color,height),width)
end function

--grid used for drawing lines in this program
sequence screenData = new_image(16,16,black)

--the line algorithm
function bresLine(sequence screenData, integer x0, integer y0, integer x1, integer y1, integer color)

    integer deltaX = abs(x1 - x0), deltaY = abs(y1 - y0)
    integer stepX, stepY, lineError, error2

    if x0 < x1 then
        stepX = 1
        else
        stepX = -1
    end if

    if y0 < y1 then
        stepY = 1
        else
        stepY = -1
    end if

    if deltaX > deltaY then
        lineError = deltaX
        else
        lineError = -deltaY
    end if

    lineError = round(lineError / 2, 1)

    while 1 do

        screenData[x0][y0] = color

        if (x0 = x1 and y0 = y1) then
            exit
        end if

        error2 = lineError

        if error2 > -deltaX then
            lineError -= deltaY
            x0 += stepX
        end if
        if error2 < deltaY then
            lineError += deltaX
            y0 += stepY
        end if
    end while
    return screenData -- return modified version of the screenData sequence
end function

--prevents console output wrapping to next line if it is too big for the screen
wrap(0)
--outer diamond
screenData = bresLine(screenData,8,1,16,8,white)
screenData = bresLine(screenData,16,8,8,16,white)
screenData = bresLine(screenData,8,16,1,8,white)
screenData = bresLine(screenData,1,8,8,1,white)
--inner diamond
screenData = bresLine(screenData,8,4,12,8,white)
screenData = bresLine(screenData,12,8,8,12,white)
screenData = bresLine(screenData,8,12,4,8,white)
screenData = bresLine(screenData,4,8,8,4,white)
-- center lines drawing from left to right, and the next from right to left.
screenData = bresLine(screenData,7,7,9,7,white)
screenData = bresLine(screenData,9,9,7,9,white)
--center dot
screenData = bresLine(screenData,8,8,8,8,white)

--print to the standard console output
for i = 1 to 16 do
    puts(1,"\n")
    for j = 1 to 16 do
            if screenData[j][i] = black then
                printf(1, "%s", ".")
            else
                printf(1, "%s", "#")
            end if
    end for
end for

puts(1,"\n\n")
any_key()

--/*
--output was edited to replace the color's hex digits for clearer output graphics.
--to output all the hex digits, use printf(1,"%06x", screenData[j][i])
--to output 'shortened' hex digits, use :
--printf(1, "%x", ( abs( ( (screenData[j][i] / #FFFFF) - 1 ) ) - 1 ) )
--and
--printf(1,"%x", abs( ( (screenData[j][i] / #FFFFF) - 1 ) ) )
--
--,respectively in the last if check.
--*/


let inline bresenham fill (x0, y0) (x1, y1) =
  let steep = abs(y1 - y0) > abs(x1 - x0)
  let x0, y0, x1, y1 =
    if steep then y0, x0, y1, x1 else x0, y0, x1, y1
  let x0, y0, x1, y1 =
    if x0 > x1 then x1, y1, x0, y0 else x0, y0, x1, y1
  let dx, dy = x1 - x0, abs(y1 - y0)
  let s = if y0 < y1 then 1 else -1
  let rec loop e x y =
    if x <= x1 then
      if steep then fill y x else fill x y
      if e < dy then
        loop (e-dy+dx) (x+1) (y+s)
      else
        loop (e-dy) (x+1) y
  loop (dx/2) x0 y0


USING: accessors arrays kernel locals math math.functions
math.ranges math.vectors rosettacode.raster.display
rosettacode.raster.storage sequences ui.gadgets ;
IN: rosettacode.raster.line

:: line-points ( pt1 pt2 -- points )
    pt1 first2 :> y0! :> x0!
    pt2 first2 :> y1! :> x1!
    y1 y0 - abs x1 x0 - abs > :> steep
    steep [
        y0 x0 y0! x0!
        y1 x1 y1! x1!
    ] when
    x0 x1 > [
        x0 x1 x0! x1!
        y0 y1 y0! y1!
    ] when
    x1 x0 - :> deltax
    y1 y0 - abs :> deltay
    0 :> current-error!
    deltay deltax / abs :> deltaerr
    0 :> ystep!
    y0 :> y!
    y0 y1 < [ 1 ystep! ] [ -1 ystep! ] if
    x0 x1 1 <range> [
        y steep [ swap ] when 2array
        current-error deltaerr + current-error!
        current-error 0.5 >= [
            ystep y + y!
            current-error 1 - current-error!
        ] when
    ] { } map-as ;

! Needs rosettacode.raster.storage for the set-pixel function and to create the image
: draw-line ( {R,G,B} pt1 pt2 image -- )
    [ line-points ] dip
    [ set-pixel ] curry with each ;


#DEFINE WM_LBUTTONDOWN 513
#DEFINE WM_CLOSE 16

FBSLSETTEXT(ME, "Bresenham") ' Set form caption
FBSLSETFORMCOLOR(ME, RGB(0, 255, 255)) ' Cyan: set persistent background color
DRAWWIDTH(5) ' Adjust point size
FBSL.GETDC(ME) ' Use volatile FBSL.GETDC below to avoid extra assignments

RESIZE(ME, 0, 0, 200, 235)
CENTER(ME)
SHOW(ME)

BEGIN EVENTS
  SELECT CASE CBMSG
    CASE WM_LBUTTONDOWN: Rhombus() ' Draw
    CASE WM_CLOSE: FBSL.RELEASEDC(ME, FBSL.GETDC) ' Clean up
  END SELECT
END EVENTS

SUB Rhombus()
  Bresenham(50, 100, 100, 190)(100, 190, 150, 100)(150, 100, 100, 10)(100, 10, 50, 100)

  SUB Bresenham(x0, y0, x1, y1)
    DIM dx = ABS(x0 - x1), sx = SGN(x0 - x1)
    DIM dy = ABS(y0 - y1), sy = SGN(y0 - y1)
    DIM tmp, er = IIF(dx > dy, dx, -dy) / 2

    WHILE NOT (x0 = x1 ANDALSO y0 = y1)
      PSET(FBSL.GETDC, x0, y0, &HFF) ' Red: Windows stores colors in BGR order
      tmp = er
      IF tmp > -dx THEN: er = er - dy: x0 = x0 + sx: END IF
      IF tmp < +dy THEN: er = er + dx: y0 = y0 + sy: END IF
    WEND
  END SUB
END SUB


defer steep         \ noop or swap
defer ystep         \ 1+ or 1-

: line ( x0 y0 x1 y1 color bmp -- )
  { color bmp }
  rot swap
  ( x0 x1 y0 y1 )
  2dup  - abs >r
  2over - abs r> <
  if         ['] swap \ swap use of x and y
  else 2swap ['] noop
  then       is steep
  ( y0 y1 x0 x1 )
  2dup >
  if swap 2swap swap  \ ensure x1 > x0
  else    2swap
  then
  ( x0 x1 y0 y1 )
  2dup >
  if   ['] 1-
  else ['] 1+
  then is ystep
  over - abs    { y deltay }
  swap 2dup - dup { deltax }
  2/ rot 1+ rot
  ( error x1+1 x0 )
  do  color i y steep bmp b!
      deltay -
      dup 0<
      if   y ystep to y
           deltax +
      then
  loop
  drop ;

5 5 bitmap value test
0 test bfill
1 0 4 1 red test line
4 1 3 4 red test line
3 4 0 3 red test line
0 3 1 0 red test line
test bshow cr
 **
 * **
*   *
** *
  **
ok


module RCImagePrimitive
  use RCImageBasic

  implicit none

  type point
     integer :: x, y
  end type point

  private :: swapcoord

contains

  subroutine swapcoord(p1, p2)
    integer, intent(inout) :: p1, p2
    integer :: t

    t = p2
    p2 = p1
    p1 = t
  end subroutine swapcoord

  subroutine draw_line(img, from, to, color)
    type(rgbimage), intent(inout) :: img
    type(point), intent(in) :: from, to
    type(rgb), intent(in) :: color

    type(point) :: rfrom, rto
    integer :: dx, dy, error, ystep, x, y
    logical :: steep

    rfrom = from
    rto = to
    steep = (abs(rto%y - rfrom%y) > abs(rto%x - rfrom%x))
    if ( steep ) then
       call swapcoord(rfrom%x, rfrom%y)
       call swapcoord(rto%x, rto%y)
    end if
    if ( rfrom%x > rto%x ) then
       call swapcoord(rfrom%x, rto%x)
       call swapcoord(rfrom%y, rto%y)
    end if

    dx = rto%x - rfrom%x
    dy = abs(rto%y - rfrom%y)
    error = dx / 2
    y = rfrom%y

    if ( rfrom%y < rto%y ) then
       ystep = 1
    else
       ystep = -1
    end if

    do x = rfrom%x, rto%x
       if ( steep ) then
          call put_pixel(img, y, x, color)
       else
          call put_pixel(img, x, y, color)
       end if
       error = error - dy
       if ( error < 0 ) then
          y = y + ystep
          error = error + dx
       end if
    end do

  end subroutine draw_line

end module RCImagePrimitive


' version 16-09-2015
' compile with: fbc -s console
' OR compile with: fbc -s gui

' Ported from the C version
Sub Br_line(x0 As Integer, y0 As Integer, x1 As Integer, y1 As Integer, Col As Integer = &HFFFFFF)

    Dim As Integer dx = Abs(x1 - x0), dy = Abs(y1 - y0)
    Dim As Integer sx = IIf(x0 < x1, 1, -1)
    Dim As Integer sy = IIf(y0 < y1, 1, -1)
    Dim As Integer er = IIf(dx > dy, dx, -dy) \ 2, e2

    Do
        PSet(x0, y0), col
        If (x0 = x1) And (y0 = y1) Then Exit Do
        e2 = er
        If e2 > -dx Then Er -= dy : x0 += sx
        If e2 <  dy Then Er += dx : y0 += sy
    Loop

End Sub

' ------=< MAIN >=------

Dim As Double x0, y0, x1, y1

ScreenRes 400, 400, 32
WindowTitle" Press key to end demo"
Randomize Timer

Do
    Cls
    For a As Integer = 1 To 20
        Br_line(Rnd*380+10, Rnd*380+10, Rnd*380+10, Rnd*380+10, Rnd*&hFFFFFF)
    Next
    Sleep 2000
Loop Until InKey <> "" ' loop until a key is pressed

End


package raster

// Line draws line by Bresenham's algorithm.
func (b *Bitmap) Line(x0, y0, x1, y1 int, p Pixel) {
    // implemented straight from WP pseudocode
    dx := x1 - x0
    if dx < 0 {
        dx = -dx
    }
    dy := y1 - y0
    if dy < 0 {
        dy = -dy
    }
    var sx, sy int
    if x0 < x1 {
        sx = 1
    } else {
        sx = -1
    }
    if y0 < y1 {
        sy = 1
    } else {
        sy = -1
    }
    err := dx - dy

    for {
        b.SetPx(x0, y0, p)
        if x0 == x1 && y0 == y1 {
            break
        }
        e2 := 2 * err
        if e2 > -dy {
            err -= dy
            x0 += sx
        }
        if e2 < dx {
            err += dx
            y0 += sy
        }
    }
}

func (b *Bitmap) LineRgb(x0, y0, x1, y1 int, c Rgb) {
    b.Line(x0, y0, x1, y1, c.Pixel())
}