FB Low Poly Editor

User projects written in or related to FreeBASIC.
Post Reply
Pitto
Posts: 122
Joined: Nov 19, 2012 19:58

FB Low Poly Editor

Post by Pitto »

Hi all,

I wish showcase a project I'm currently working on: a graphical tool for create vector low poly images.
It currently exports as SVG file. The user has to set manually the points of the polygons.

The program interface
Image

The exported SVG file opened in Adobe Illustrator in both preview and wireframe mode
Image

Commands:
  • Mouse Left button: create point
    Mouse Right button: close polygon path
    Delete: Erase all polygons
    S: Save graphic as SVG -> output.svg
    ESC: Quit
Currently the snapping feature is on if the pointer is near to an existing point by less than 15 px

Here's the source:

Code: Select all

'Low Poly Editor by Pitto
#include "fbgfx.bi"
dim shared Debug_mode		as boolean = false
Using FB
randomize timer
#ifndef NULL
	const NULL as any ptr = 0
#endif

'define and consts______________________________________________________
#define APP_NAME 				"Low Poly Editor by Pitto"
#define APP_VERSION 			"Version 0.02"
#define SCR_W 					800	
#define SCR_H 					600
#define MIN_SNAP_DIST			15


'colors
#define C_BLACK			&h000000
#define C_WHITE			&hFFFFFF
#define C_GRAY 			&h7F7F7F
#define C_DARK_GRAY		&h202020
#define C_RED			&hFF0000
#define C_BLUE 			&h0000FF
#define C_GREEN			&h00FF00
#define C_YELLOW		&hFFFF00
#define C_CYAN 			&h00FFFF
#define C_LILIAC		&h7F00FF
#define C_ORANGE		&hFF7F00
#define C_PURPLE		&h7F007F
#define C_DARK_RED 		&h7F0000
#define C_DARK_GREEN	&h005500
#define C_DARK_BLUE		&h00007F



const PI 				as single = 3.14159f
const PI_HALF 			as single = 1.570795f
const PI_QUARTER 		as single = 0.785f

'enums__________________________________________________________________

enum proto_input_mode
	input_error = 0
	input_add_polygon = 1
	input_add_point = 2
	input_close_polygon = 3
	add_vertex = 4
	del_vertex
	add_edge 
	del_edge
	move_vertex
	set_start
	set_end
	hand
	input_erase_all
	input_export_as_svg
end enum

'types__________________________________________________________________
type point_proto
	x 			as single
	y 			as single
	next_p  	as point_proto ptr
end type

type polygon_proto
	first_point		as point_proto ptr
	centroid		as point_proto
	fill_color		as Ulong
	stroke_color	as Ulong
end type

type view_area_proto
    x 		as single
    y 		as single
    old_x 	as single
    old_y 	as single
    w 		as single
    h 		as single
    speed 	as single
    rds 	as single
	zoom 	as single
	old_zoom 	as single
end type

Type mouse_proto
    As Integer res, x, y, old_x, old_y, wheel, clip, old_wheel, diff_wheel
    as single oppo_x, oppo_y, old_oppo_x, old_oppo_y
    as boolean is_dragging
    as boolean is_lbtn_released
    as boolean is_lbtn_pressed
    as boolean is_rbtn_released
    as boolean is_rbtn_pressed
    Union
        buttons 		As Integer
        Type
            Left:1 		As Integer
            Right:1 	As Integer
            middle:1 	As Integer
        End Type
    End Union
End Type

redim polygons(0 to 0) as polygon_proto

'functions declarations
declare function _abtp 			(x1 as integer,y1 as integer,x2 as integer,y2 as integer) as single
declare function add_point		(head as point_proto ptr ptr, x as single, y as single) as point_proto ptr
declare function average_color	(rgb_values() as Ulong) as Ulong
declare function calculate_centroid (head as point_proto ptr) as point_proto
declare function dist 				(x1 as single, y1 as single, x2 as single, y2 as single) as single
declare function find_nearest_point (array() as polygon_proto, user_mouse as mouse_proto) as point_proto
declare function get_pixel_color	 (x as integer, y as integer, img_name as any ptr) as ULong

'subs declarations______________________________________________________
declare sub add_polygon			(array() as polygon_proto)
declare sub draw_centroid		(centroid as point_proto, stroke_color as Ulong)
declare sub draw_list_points	(head as point_proto ptr, x as integer, y as integer)
declare Sub export_as_svg		(array() as polygon_proto, file_name as string)
declare Sub fill_polygon		(head as point_proto ptr, ByVal c As ULong)
declare sub draw_highlighted_points(head as point_proto ptr, ByVal c As ULong, w as Ulong)
declare sub keyboard_listener	(input_mode as proto_input_mode ptr, _
								user_mouse as mouse_proto, _
								view_area as view_area_proto ptr)
declare sub mouse_listener		(user_mouse as mouse_proto ptr, _
								view_area as view_area_proto ptr)
declare Sub pop_values_in_array	(array() as integer,_
								eval as integer)
declare Sub delete_all_points	(head as point_proto ptr)


'MAIN___________________________________________________________________
DIM workpage 				AS INTEGER
workpage = 0
Dim user_mouse 				as mouse_proto
dim view_area				as view_area_proto
Dim input_mode				as proto_input_mode
dim wallp_image				as any ptr


user_mouse.is_dragging = false
user_mouse.is_lbtn_released = false
user_mouse.is_lbtn_pressed = false

view_area.x = 0
view_area.y = 0
view_area.zoom = 1.0f
view_area.old_zoom = view_area.zoom

screenres (SCR_W, SCR_H, 24)
SetMouse SCR_W\2, SCR_H\2, 0

wallp_image = imagecreate(SCR_W,SCR_H)  'create memory buffer the size of your image
bload "img/test.bmp",wallp_image         'copy from file to bitmap

dim head as point_proto ptr
input_mode = input_add_polygon

do
	if MULTIKEY (SC_Escape) then exit do
	dim c as integer
	dim nearest_point as point_proto
	dim dist_from_nearest_point as Uinteger

	User_Mouse.res = 	GetMouse( 	User_Mouse.x, User_Mouse.y, _
									User_Mouse.wheel, User_Mouse.buttons,_
									User_Mouse.clip)
								
	keyboard_listener	(@input_mode, user_mouse, @view_area)
	mouse_listener		(@user_mouse, @view_area)
	
	nearest_point = find_nearest_point(polygons(), user_mouse)
	dist_from_nearest_point = int (dist		(nearest_point.x,_
											nearest_point.y, _
											user_mouse.x, _
											user_mouse.y))
	
	select case input_mode
	
		case input_add_polygon
		
			add_polygon(polygons())
			head = polygons(Ubound(polygons)-1).first_point
			polygons(Ubound(polygons)-1).fill_color = C_GRAY
			input_mode = input_add_point
	
		case input_add_point
			
			if (user_mouse.is_lbtn_released) then
				'snapping if mouse pointer is near to existing points
				if dist_from_nearest_point < MIN_SNAP_DIST then
					polygons(Ubound(polygons)-1).first_point = _
					add_point(@head, nearest_point.x, nearest_point.y)
				else
					polygons(Ubound(polygons)-1).first_point = _
					add_point(@head, user_mouse.x, user_mouse.y)
				end if
				
				
				
				user_mouse.is_lbtn_released = false
			end if
			
			if (user_mouse.is_rbtn_released) then
				input_mode = input_close_polygon
				polygons(Ubound(polygons)-1).centroid = calculate_centroid(polygons(Ubound(polygons)-1).first_point)
				polygons(Ubound(polygons)-1).fill_color = _
				get_pixel_color	(	polygons(Ubound(polygons)-1).centroid.x, _
									polygons(Ubound(polygons)-1).centroid.y, _
									wallp_image)
				user_mouse.is_rbtn_released = false
			end if
		
		case input_close_polygon
		
			input_mode = input_add_polygon
			
		case input_erase_all
			for c = 0 to Ubound(polygons)-1
				delete_all_points (polygons(c).first_point)
			next c
			redim polygons(0 to 0)
			input_mode = input_add_polygon
			
		case input_export_as_svg
			export_as_svg(polygons(), "output.svg")
			input_mode = input_add_polygon
	end select
	
	screenlock ' Lock the screen
	screenset Workpage, Workpage xor 1 ' Swap work pages.

	cls
	
	put (0,0),wallp_image,pset 

	c=0


	for c = 0 to Ubound(polygons)-1
		'fill each polygon
		fill_polygon(polygons(c).first_point, CULng(polygons(c).fill_color))
		'draw the centroid of each polygon
		draw_centroid(polygons(c).centroid, C_GREEN)
		'draw some debug info
		draw_list_points(polygons(c).first_point, 20, 20 + c*10)
	next c
	
	'highlight line from last point to mouse
	if (polygons(0).first_point <> NULL) then
		if (polygons(Ubound(polygons)-1).first_point->next_p <> NULL) then
			line 	(polygons(Ubound(polygons)-1).first_point->x, _
					polygons(Ubound(polygons)-1).first_point->y)- _
					(User_Mouse.x, User_Mouse.y), C_WHITE
		end if
	end if
	
	'highlight nearest point to mouse

	if dist_from_nearest_point < MIN_SNAP_DIST then
		line (nearest_point.x-2, nearest_point.y-2)-step(4,4),C_GREEN,BF
	end if
	
	
	'mouse graphical cross pointer
	if (user_mouse.is_lbtn_pressed) then
		line (user_mouse.x-5, user_mouse.y-5)-step(10, 10), ,BF
	end if
	
	line (user_mouse.x-10, user_mouse.y)-(user_mouse.x+10, user_mouse.y)
	line (user_mouse.x, user_mouse.y-10)-(user_mouse.x, user_mouse.y+10)
	
	draw string (20, SCR_H - 20), APP_NAME + " " + APP_VERSION, C_WHITE
	
	workpage = 1 - Workpage ' Swap work pages.
	screenunlock
	sleep 20,1
LOOP


'free memory
dim c as integer
for c = 0 to Ubound(polygons)-1
	delete_all_points (polygons(c).first_point)
next c
deallocate(head)
redim polygons(0 to 0)

'_______________________________________________________________________


'FUNCTIONS______________________________________________________________
function _abtp (x1 as integer,y1 as integer,x2 as integer,y2 as integer) as single
	return -Atan2(y2-y1,x2-x1)
end function

function add_point(head as point_proto ptr ptr, x as single, y as single) as point_proto ptr
    dim as point_proto ptr p = callocate(sizeof(point_proto))
    p->x = x
    p->y = y
	p->next_p = *head
    *head = p
    return p
end function

'Average color function:
'given an array of rgb colors values as argument
'returns the average color using the arithmetic mean
function average_color(rgb_values() as Ulong) as Ulong
	dim as integer r, g, b, c, arraylen
	
	arraylen = UBound(rgb_values) - LBound(rgb_values) + 1
	
	r = 0 : g = 0 : b = 0

	for c = Lbound(rgb_values) to Ubound(rgb_values)
	
		'get & sum each r, g, b value
		r += rgb_values(c) shr 16
		g += rgb_values(c) shr 8 and &hFF
		b += rgb_values(c) and &hFF
		
	next c
	
	r = r \ (arraylen)
	g = g \ (arraylen)
	b = b \ (arraylen)

	return rgb(r,g,b)

end function


function calculate_centroid (head as point_proto ptr) as point_proto

	'some part of this function is a
	'translation from a C implementation by squeamish ossifrage
	'https://stackoverflow.com/questions/19766485/how-to-calculate-centroid-of-polygon-in-c

	dim centroid as point_proto
	dim as single a, cx, cy, t
    dim as integer i, i1

	redim preserve 	x(0 to 0) as Long
	redim preserve 	y(0 to 0) as Long

	i = 0
   
	while head <> NULL
		if (head->next_p <> NULL) then
			x(i) = head->x
			y(i) = head->y
			redim preserve x(0 to  Ubound(x)+1)
			redim preserve y(0 to  Ubound(y)+1)
		end if
		head = head->next_p
		i+=1
	wend

	'this is the translated part

	'First calculate the polygon's signed area A
	a = 0.0
	i1 = 1

	for i = 0 to (Ubound(x)-1) step 1

		a += x(i) * y(i1) - x(i1) * y(i)
		i1 = (i1 + 1) mod (Ubound(x))

	next i

	a *= 0.5

	' Now calculate the centroid coordinates Cx and Cy */
	cx = cy = 0.0
	i1 = 1

	for i = 0 to (Ubound(x)-1) step 1

		t = x(i)*y(i1) - x(i1)*y(i)
		cx += (x(i)+x(i1)) * t
		cy += (y(i)+y(i1)) * t
		i1 = (i1 + 1) mod (Ubound(x))
		
	next i

	cx = cx / (6.0 * a)
	cy = cy / (6.0 * a)

	centroid.x = cx
	centroid.y = cy

	return centroid

end function

function dist (x1 as single, y1 as single, x2 as single, y2 as single) as single
    return Sqr(((x1-x2)*(x1-x2))+((y1-y2)*(y1-y2)))
end function

function find_nearest_point (array() as polygon_proto, user_mouse as mouse_proto) as point_proto
	dim as integer i, min_dist, temp_dist
	dim as point_proto ptr head
	dim nearest as point_proto
	min_dist = 1000000
	
	for i = 0  to Ubound(array)-1
		head = array(i).first_point
		while head <> NULL
			temp_dist = dist(head->x, head->y, user_mouse.x, user_mouse.y)
			if temp_dist < min_dist then
				min_dist = temp_dist
				nearest = *head
			end if
			head = head->next_p
		wend
	next i

	return nearest

end function

function get_pixel_color (x as integer, y as integer, img_name as any ptr) as ULong
	dim as uinteger r,b,g,p

	p = point(x, y, img_name)  'get pixel value at coordinate x, y

    return (p)

end function




'SUBS
sub add_polygon(array() as polygon_proto)
	array(Ubound(array)).first_point = callocate(sizeof(point_proto))
	
	redim preserve array(Lbound(array) to Ubound(array)+1)
end sub

sub draw_centroid(centroid as point_proto, stroke_color as Ulong)
	line (centroid.x - 2, centroid.y)-step(4,0), stroke_color
	line (centroid.x, centroid.y -2)-step(0,4), stroke_color
end sub

Sub export_as_svg (array() as polygon_proto, file_name as string)

	Dim i as integer
	Dim head as point_proto ptr
	Dim ff As UByte
	ff = FreeFile
	Open file_name for output As #ff

	'SVG file header info
	
	
	Print #ff, "<?xml version='1.0' standalone='no'?>"
	Print #ff, "<!DOCTYPE svg PUBLIC '-//W3C//DTD SVG 1.1//EN' 'http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd'>"
	Print #ff, "<svg width='800px' height='600px' version='1.1' xmlns='http://www.w3.org/2000/svg'>"
	Print #ff, "<desc>" + APP_NAME + APP_VERSION + " - Export file</desc>"

	for i = 0 to Ubound(array)-1
	
		Print #ff, "<polygon fill='#" + _
					hex(array(i).fill_color shr 16 and &hFF) + _
					hex(array(i).fill_color shr 8 and &hFF) +_
					hex(array(i).fill_color and &hFF) + "'"
		Print #ff, "points='"
		
		head = array(i).first_point
		
		'ignore first one pointer values since it's only a link to data
		while head->next_p <> NULL
		
			Print #ff, str(head->x) + "," + str(head->y) + " "
			head = head->next_p
			
		wend
		
		Print #ff, "' />"
		
	next i

	Print #ff, "</svg>"
	Close #ff

end sub

Sub fill_polygon(head as point_proto ptr, ByVal c As ULong)
   'translation of a c snippet by Angad
   'source of c code:
   'http://code-heaven.blogspot.it/2009/10/simple-c-program-for-scan-line-polygon.html
   
   ' Thanks to MrSwiss for the corrections on the below code for 64/32 compiler
   redim preserve 	a(0 to 0, 0 to 1) as Long
   Dim As Long      i, j, k, dy, dx, x, y, temp
  
   
   i = 0
   while head <> NULL
		if (head->next_p <> NULL) then
			a(i, 0) = head->x
			a(i, 1) = head->y
			redim preserve a(0 to  Ubound(a)+1, 0 to 1)
		end if
		head = head->next_p
		i+=1
	wend
   
   Dim As Long      xi(0 to Ubound(a, 1))
   Dim As Single    slope(0 to Ubound(a, 1))
   'join first and last vertex
   a(Ubound(a, 1), 0) = a(0, 0)
   a(Ubound(a, 1), 1) = a(0, 1)

   For i = 0 To Ubound(a, 1) - 1

		dy = a(i+1, 1) - a(i, 1)
      dx = a(i+1, 0) - a(i, 0)

      If (dy = 0) Then slope(i) = 1.0
      If (dx = 0) Then slope(i) = 0.0

      If (dy <> 0) AndAlso (dx <> 0) Then slope(i) = dx / dy
   Next i

   For y = 0 to SCR_H - 1
      k = 0
      ' using FB's short-cut operators (which C doesn't have!)
      For i = 0 to Ubound(a, 1) - 1
         If (a(i, 1) <= y AndAlso a(i+1, 1) > y) OrElse _
             (a(i, 1) > y AndAlso a(i+1, 1) <= y) Then
            xi(k) = CLng(a(i, 0) + slope(i) * (y - a(i, 1)))
            k += 1
         End If
      Next i

      For j = 0 to k - 2
         'Arrange x-intersections in order
         For i = 0 To k - 2
            If (xi(i) > xi(i + 1)) Then
               temp = xi(i)
               xi(i) = xi(i + 1)
               xi(i + 1) = temp
            End If
         Next i
      Next j
      'line filling
      For i = 0 To k - 2 Step 2
         Line (xi(i), y)-(xi(i + 1) + 1, y), c
      Next i
   Next y
End Sub

sub keyboard_listener(	input_mode as proto_input_mode ptr, _
						user_mouse as mouse_proto, _
						view_area as view_area_proto ptr)
	
	'static old_input_mode as proto_input_mode = add_vertex
	dim e As EVENT
	If (ScreenEvent(@e)) Then
		Select Case e.type
		Case EVENT_KEY_RELEASE
			'switch Debug mode ON/OFF___________________________________
			If (e.scancode = SC_D) Then
				if Debug_mode then
					Debug_mode = false
				else
					Debug_mode = true
				end if
			end if
			If (e.scancode = SC_DELETE) Then
					*input_mode = input_erase_all
			end if
		End Select
	End If
	
	'this is for the hand ovverride tool
	'if multikey (SC_SPACE) then
		'*input_mode = hand
	'else
		'*input_mode = old_input_mode
	'end if
	if multikey (SC_S) then *input_mode = input_export_as_svg
	
	'if multikey (SC_E) then *input_mode = add_edge
	'if multikey (SC_M) then *input_mode = move_vertex
	'if multikey (SC_D) then *input_mode = del_edge
	
	''this is for the hand ovverride tool
	'if *input_mode <> hand then
		'old_input_mode = *input_mode
	'end if
	
end sub

sub draw_list_points(head as point_proto ptr, x as integer, y as integer)
	dim as integer c = 0
	
	while (head <> NULL)
		draw string (x + c*60, y), ">" +str(hex(head)), C_DARK_GRAY	
		head = head->next_p
		c += 1
	wend
end sub

Sub delete_all_points	(head as point_proto ptr)
	dim temp as point_proto ptr
	while (head <> NULL)
		temp = Head
		head = temp->next_p
		deallocate(temp)
	wend
end sub

sub mouse_listener(user_mouse as mouse_proto ptr, view_area as view_area_proto ptr)
	static old_is_lbtn_pressed as boolean = false
	static old_is_rbtn_pressed as boolean = false
	static as integer old_x, old_y
	static store_xy as boolean = false
	
	if User_Mouse->old_wheel < User_Mouse->wheel and view_area->zoom < 8 then
		view_area->zoom *= 1.1f
	end if
	if User_Mouse->old_wheel > User_Mouse->wheel and view_area->zoom > 0.25 then
		view_area->zoom *= 0.9f
	end if
	
	'recognize if the left button has been pressed
	if User_Mouse->buttons and 1 then
		User_Mouse->is_lbtn_pressed = true
	else
		User_Mouse->is_lbtn_pressed = false
	end if
	
	'recognize if the right button has been pressed
	if User_Mouse->buttons and 2 then
		User_Mouse->is_rbtn_pressed = true
	else
		User_Mouse->is_rbtn_pressed = false
	end if
	
	'recognize if the left button has been released
	if old_is_lbtn_pressed = false and User_Mouse->is_lbtn_pressed and store_xy = false then 
		store_xy = true
	end if
	
	if store_xy then
		user_mouse->old_x = user_mouse->x
		user_mouse->old_y = user_mouse->y
		store_xy = false
	end if
	
	'recognize if the left button has been released
	if old_is_lbtn_pressed and User_Mouse->is_lbtn_pressed = false then 
		User_Mouse->is_lbtn_released = true
	end if
	
	'recognize if the right button has been released
	if old_is_rbtn_pressed and User_Mouse->is_rbtn_pressed = false then 
		User_Mouse->is_rbtn_released = true
	end if
	
	'recognize drag
	if (User_Mouse->is_lbtn_pressed) and CBool((old_x <> user_mouse->x) or (old_y <> user_mouse->y)) then
		user_mouse->is_dragging = true
		'cuspid node
		if multikey(SC_ALT) then
			user_mouse->oppo_x = user_mouse->old_oppo_x
			user_mouse->oppo_y = user_mouse->old_oppo_y
		'normal node
		else
			user_mouse->oppo_x = User_Mouse->old_x - _
						cos (_abtp (User_Mouse->old_x, User_Mouse->old_y, User_Mouse->x, User_Mouse->y)) * _
						(dist(User_Mouse->old_x, User_Mouse->old_y, User_Mouse->x, User_Mouse->y))
			user_mouse->oppo_y = User_Mouse->old_y - _
						-sin(_abtp (User_Mouse->old_x, User_Mouse->old_y, User_Mouse->x, User_Mouse->y)) * _
						(dist(User_Mouse->old_x, User_Mouse->old_y, User_Mouse->x, User_Mouse->y))
			user_mouse->old_oppo_x = user_mouse->oppo_x
			user_mouse->old_oppo_y = user_mouse->oppo_y
		end if			
		
	else
		user_mouse->is_dragging = false
	end if
	   'store the old wheel state
	User_Mouse->old_wheel = User_Mouse->wheel
	'store the old state of left button
	old_is_lbtn_pressed = User_Mouse->is_lbtn_pressed
	'store the old state of left button
	old_is_rbtn_pressed = User_Mouse->is_rbtn_pressed

end sub


sub pop_values_in_array(array() as integer, eval as integer)
	'given a monodimensional re-dimmable array, pops all the data
	'that are equal to eval and resizes the array
	dim as integer i, j
	
	'transverse whole array, if the array(i) value
	'matches the eval, shift non-eval values of the array on the left.
	for i = Lbound(array) to Ubound(array)
		if array(i) = eval then 
			for j = (i + 1) to Ubound(array)
				if array(j) <> eval then
					swap array(j), array (i)
					exit for
				end if 
			next j
		end if
	next i
	
	'find new first eval value location
	for i = Lbound(array) to Ubound(array)
		if array(i) = eval then 
			exit for
		end if
	next i
	
	'redim the array
	redim preserve array(Lbound(array) to i-1) as integer
	
end sub

Here's the exported SVG file: Mona Lisa SVG
Please, be kind to my Mona Lisa, it's my first artwork in poly art :)

In order to work properly, create a 800x600 pixel BMP 24bpp file named "test.bmp" into "img" directory, or simply put into it the "Mona Lisa"

The program uses a resizable array to store polygons. Each index uses a single linked list to store points data of each polygon.
Scanline algorithm is used to fill polygon. While closing the path of a polygon, automatically the program pick-up the background color on the centroid of the polygon.

Todo list:
  • zoom
    snapping on / off
    snapping on paths, not only points
    select multiple polygons
    delete any existing polygons
    slicing existing polygons
    custom colors
    undos
    save, not only svg export
    fun :)
Any feedback always welcome. Thanks in advance.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: FB Low Poly Editor

Post by D.J.Peters »

nice idea.

Joshy
Pitto
Posts: 122
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Post by Pitto »

Hi Joshy,

thanks for feedback. I've used a very useful function of yours (ImageScale) in this little program.

Here's an improved version. Added pan & zoom (spacebar to pan; mouse wheel to zoom in/out), snapping on/off by pressing shift key, Wireframe on/off by pressing "W" key.

Code: Select all

'Low Poly Editor by Pitto

'This program is free software; you can redistribute it and/or
'modify it under the terms of the GNU General Public License
'as published by the Free Software Foundation; either version 2
'of the License, or (at your option) any later version.
'
'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'GNU General Public License for more details.
'
'You should have received a copy of the GNU General Public License
'along with this program; if not, write to the Free Software
'Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
'Also add information on how to contact you by electronic and paper mail.

'#######################################################################

' Compiling instructions: fbc -w all -exx "%f"

#include "fbgfx.bi"

dim shared Debug_mode		as boolean = false
Using FB
randomize timer

#ifndef NULL
	const NULL as any ptr = 0
#endif

#ifndef getPixelAddress
    #define getPixelAddress(img,row,col) cast(any ptr,img) + _
        sizeof(FB.IMAGE) + (img)->pitch * (row) + (img)->bpp * (col)
#endif

'define and consts______________________________________________________
#define APP_NAME 				"Low Poly Editor by Pitto"
#define APP_VERSION 			"Version 0.03"
#define SCR_W 					800	
#define SCR_H 					600
#define MIN_SNAP_DIST			15


'colors
#define C_BLACK			&h000000
#define C_WHITE			&hFFFFFF
#define C_GRAY 			&h7F7F7F
#define C_DARK_GRAY		&h202020
#define C_RED			&hFF0000
#define C_BLUE 			&h0000FF
#define C_GREEN			&h00FF00
#define C_YELLOW		&hFFFF00
#define C_CYAN 			&h00FFFF
#define C_LILIAC		&h7F00FF
#define C_ORANGE		&hFF7F00
#define C_PURPLE		&h7F007F
#define C_DARK_RED 		&h7F0000
#define C_DARK_GREEN	&h005500
#define C_DARK_BLUE		&h00007F

'enums__________________________________________________________________

enum proto_input_mode
	input_error = 0
	input_add_polygon = 1
	input_add_point = 2
	input_close_polygon = 3
	input_hand
	add_vertex
	del_vertex
	add_edge 
	del_edge
	move_vertex
	set_start
	set_end
	
	input_erase_all
	input_export_as_svg
end enum

'types__________________________________________________________________
type point_proto
	x 			as single
	y 			as single
	next_p  	as point_proto ptr
end type

type polygon_proto
	first_point		as point_proto ptr
	centroid		as point_proto
	fill_color		as Ulong
	stroke_color	as Ulong
end type

type view_area_proto
    x 		as single
    y 		as single
    old_x 	as single
    old_y 	as single
    w 		as single
    h 		as single
    speed 	as single
    rds 	as single
	zoom 	as single
	old_zoom 	as single
end type

Type mouse_proto
    As Integer 		res, x, y, old_x, old_y, wheel, clip, _
					old_wheel, diff_wheel, abs_x, abs_y
    as single 		oppo_x, oppo_y, old_oppo_x, old_oppo_y
    as boolean is_dragging
    as boolean is_lbtn_released
    as boolean is_lbtn_pressed
    as boolean is_rbtn_released
    as boolean is_rbtn_pressed
    Union
        buttons 		As Integer
        Type
            Left:1 		As Integer
            Right:1 	As Integer
            middle:1 	As Integer
        End Type
    End Union
End Type

Type settings_proto
	is_snap_active as boolean
	is_hand_active as boolean
	is_centroid_visible as boolean
	is_wireframe_visible as boolean
	wireframe_color as Ulong
end type

type FIXED as long ' 12:20

redim polygons(0 to 0) as polygon_proto

'functions declarations
declare function _abtp 			(x1 as integer,y1 as integer,x2 as integer,y2 as integer) as single
declare function add_point		(head as point_proto ptr ptr, x as single, y as single) as point_proto ptr
declare function average_color	(rgb_values() as Ulong) as Ulong
declare function calculate_centroid (head as point_proto ptr) as point_proto
declare function dist 				(x1 as single, y1 as single, x2 as single, y2 as single) as single
declare function find_nearest_point (array() as polygon_proto, user_mouse as mouse_proto, view_area as view_area_proto) as point_proto
declare function get_pixel_color	 (x as integer, y as integer, img_name as any ptr) as ULong
'fbGFXAddon by D.J. Peters  
declare function ImageScale		(byval s as fb.Image ptr, _
								byval w as integer, _
								byval h as integer) as fb.Image ptr
'Bmp load by noop
declare function Load_bmp( ByRef filename As Const String ) As Any Ptr

'subs declarations______________________________________________________
declare sub add_polygon			(array() as polygon_proto)
declare sub draw_centroid		(centroid as point_proto, stroke_color as Ulong, view_area as view_area_proto)
declare sub draw_list_points	(head as point_proto ptr, x as integer, y as integer)
declare Sub export_as_svg		(array() as polygon_proto, file_name as string)
declare Sub fill_polygon		(head as point_proto ptr, ByVal c As ULong, view_area as view_area_proto, settings as settings_proto)
declare sub draw_highlighted_points(head as point_proto ptr, ByVal c As ULong, w as Ulong)
declare sub keyboard_listener	(input_mode as proto_input_mode ptr, _
								user_mouse as mouse_proto, _
								view_area as view_area_proto ptr, _
								settings as settings_proto ptr)
declare sub mouse_listener		(user_mouse as mouse_proto ptr, _
								view_area as view_area_proto ptr)
declare Sub pop_values_in_array	(array() as integer,_
								eval as integer)
declare Sub delete_all_points	(head as point_proto ptr)


'MAIN___________________________________________________________________
DIM workpage 				AS INTEGER
workpage = 0
Dim user_mouse 				as mouse_proto
dim view_area				as view_area_proto
Dim input_mode				as proto_input_mode
dim wallp_image				as any ptr


user_mouse.is_dragging = false
user_mouse.is_lbtn_released = false
user_mouse.is_lbtn_pressed = false

view_area.x = 0
view_area.y = 0
view_area.zoom = 1.0f
view_area.old_zoom = view_area.zoom

dim settings as settings_proto
settings.is_snap_active = true
settings.is_hand_active = false
settings.is_centroid_visible = true
settings.is_wireframe_visible = true
settings.wireframe_color = C_WHITE

screenres (SCR_W, SCR_H, 24)
SetMouse SCR_W\2, SCR_H\2, 0

dim as FB.Image ptr wallp_img = Load_bmp( "img/test.bmp" )
dim as fb.image ptr wallp_img_resized = ImageScale	(wallp_img,_
													wallp_img->width*view_area.zoom, _
													wallp_img->height*view_area.zoom)

dim head as point_proto ptr
input_mode = input_add_polygon

do
	if MULTIKEY (SC_Escape) then exit do
	dim c as integer
	dim nearest_point as point_proto
	dim dist_from_nearest_point as Uinteger
	dim scalechange as single

	User_Mouse.res = 	GetMouse( 	User_Mouse.x, User_Mouse.y, _
									User_Mouse.wheel, User_Mouse.buttons,_
									User_Mouse.clip)
								
	keyboard_listener	(@input_mode, user_mouse, @view_area, @settings)
	mouse_listener		(@user_mouse, @view_area)
	
	nearest_point = find_nearest_point(polygons(), user_mouse, view_area)
	dist_from_nearest_point = int (dist		(nearest_point.x,_
											nearest_point.y, _
											user_mouse.abs_x, _
											user_mouse.abs_y))
											
	'zoom in / out 
	if (view_area.old_zoom <> view_area.zoom) then
		wallp_img_resized = ImageScale (wallp_img,_
								wallp_img->width*view_area.zoom, _
								wallp_img->height*view_area.zoom)
								
		scalechange = view_area.zoom - view_area.old_zoom
		view_area.x += -(user_mouse.abs_x * scalechange)
		view_area.y += -(user_mouse.abs_y * scalechange)
	end if
	view_area.old_zoom = view_area.zoom

	
	if settings.is_hand_active then
		input_mode = input_hand
	end if
	
	select case input_mode
	
		case input_hand
			'####################### HAND TOOL #########################
			if (user_mouse.is_dragging) then
				line (user_mouse.x, user_mouse.y)-(user_mouse.old_X, user_mouse.old_y)
				view_area.x = view_area.old_x + (user_mouse.x - user_mouse.old_x)
				view_area.y = view_area.old_y + (user_mouse.y - user_mouse.old_y)
			else
				view_area.old_x = view_area.x
				view_area.old_y = view_area.y
			end if
			user_mouse.is_lbtn_released = false
			if not settings.is_hand_active then
				input_mode = input_add_polygon
			end if
	
		case input_add_polygon
		
			add_polygon(polygons())
			head = polygons(Ubound(polygons)-1).first_point
			polygons(Ubound(polygons)-1).fill_color = C_GRAY
			input_mode = input_add_point
	
		case input_add_point
			
			if (user_mouse.is_lbtn_released) then
				'snapping if mouse pointer is near to existing points
				if Cbool(dist_from_nearest_point < MIN_SNAP_DIST/view_area.zoom) and _
					settings.is_snap_active then
					polygons(Ubound(polygons)-1).first_point = _
					add_point(@head, nearest_point.x, nearest_point.y)
				else
					polygons(Ubound(polygons)-1).first_point = _
					add_point(@head, user_mouse.abs_x, user_mouse.abs_y)
				end if

				user_mouse.is_lbtn_released = false
			end if
			
			if (user_mouse.is_rbtn_released) then
				input_mode = input_close_polygon
				polygons(Ubound(polygons)-1).centroid = calculate_centroid(polygons(Ubound(polygons)-1).first_point)
				polygons(Ubound(polygons)-1).fill_color = _
				get_pixel_color	(	int(polygons(Ubound(polygons)-1).centroid.x * view_area.zoom), _
									int(polygons(Ubound(polygons)-1).centroid.y * view_area.zoom), _
									wallp_img_resized)
				user_mouse.is_rbtn_released = false
			end if
		
		case input_close_polygon
		
			input_mode = input_add_polygon
			
		case input_erase_all
			for c = 0 to Ubound(polygons)-1
				delete_all_points (polygons(c).first_point)
			next c
			redim polygons(0 to 0)
			input_mode = input_add_polygon
			
		case input_export_as_svg
			export_as_svg(polygons(), "output.svg")
			input_mode = input_add_polygon
	end select
	
	screenlock ' Lock the screen
	screenset Workpage, Workpage xor 1 ' Swap work pages.

	cls
	
	put (view_area.x,view_area.y),wallp_img_resized,pset 

	c=0


	for c = 0 to Ubound(polygons)-1
		'fill each polygon
		fill_polygon(polygons(c).first_point, CULng(polygons(c).fill_color), view_area, settings)
		'draw the centroid of each polygon
		if (settings.is_centroid_visible) then
			draw_centroid(polygons(c).centroid, C_GREEN, view_area)
		end if
		'draw some debug info
		if (Debug_mode) then
			draw_list_points(polygons(c).first_point, 20, 20 + c*10)
		end if
	next c
	
	'highlight line from last point to mouse
	if (polygons(0).first_point <> NULL) then
		if (polygons(Ubound(polygons)-1).first_point->next_p <> NULL) then
			line 	(polygons(Ubound(polygons)-1).first_point->x*view_area.zoom + view_area.x, _
					polygons(Ubound(polygons)-1).first_point->y*view_area.zoom + view_area.y)- _
					(User_Mouse.x, User_Mouse.y), C_WHITE
		end if
	end if
	
	'highlight nearest point to mouse, skip if Left or right shift key is down
	if 	Cbool(dist_from_nearest_point < MIN_SNAP_DIST / view_area.zoom) and _
		settings.is_snap_active then
		line (	nearest_point.x*view_area.zoom + view_area.x -2, _
				nearest_point.y*view_area.zoom + view_area.y -2)-step(4,4),C_GREEN,BF
	end if
	'line (0,0)-step(50,50), _
	'get_pixel_color	( user_mouse.abs_x * view_area.zoom, user_mouse.abs_y* view_area.zoom, wallp_img_resized) ,BF
	
	'mouse graphical cross pointer
	if (user_mouse.is_lbtn_pressed) then
		line (user_mouse.x-5, user_mouse.y-5)-step(10, 10), C_ORANGE, BF
	end if
	
	line (user_mouse.x-5, user_mouse.y-1)-step(10, 2), C_BLACK, BF
	line (user_mouse.x-1, user_mouse.y-5)-step(2, 10), C_BLACK, BF
		
	line (user_mouse.x-10, user_mouse.y)-(user_mouse.x+10, user_mouse.y)
	line (user_mouse.x, user_mouse.y-10)-(user_mouse.x, user_mouse.y+10)
	
	draw string (20, SCR_H - 40), "absolute x " + str(user_mouse.abs_x) + ", y " + str(user_mouse.abs_y)
	draw string (20, SCR_H - 30), "mouse x " + str(user_mouse.x) + ", y " + str(user_mouse.y)
	draw string (20, SCR_H - 20), APP_NAME + " " + APP_VERSION, C_BLACK
	draw string (19, SCR_H - 21), APP_NAME + " " + APP_VERSION, C_WHITE
	
	workpage = 1 - Workpage ' Swap work pages.
	screenunlock
	sleep 20,1
LOOP


'free memory
dim c as integer
for c = 0 to Ubound(polygons)-1
	delete_all_points (polygons(c).first_point)
next c
deallocate(head)
redim polygons(0 to 0)

'destroy bitmaps from memory
ImageDestroy wallp_img
ImageDestroy wallp_img_resized

'_______________________________________________________________________

'FUNCTIONS______________________________________________________________
function _abtp (x1 as integer,y1 as integer,x2 as integer,y2 as integer) as single
	return -Atan2(y2-y1,x2-x1)
end function

function add_point(head as point_proto ptr ptr, x as single, y as single) as point_proto ptr
    dim as point_proto ptr p = callocate(sizeof(point_proto))
    p->x = x
    p->y = y
	p->next_p = *head
    *head = p
    return p
end function

'Average color function:
'given an array of rgb colors values as argument
'returns the average color using the arithmetic mean
function average_color(rgb_values() as Ulong) as Ulong
	dim as integer r, g, b, c, arraylen
	
	arraylen = UBound(rgb_values) - LBound(rgb_values) + 1
	
	r = 0 : g = 0 : b = 0

	for c = Lbound(rgb_values) to Ubound(rgb_values)
	
		'get & sum each r, g, b value
		r += rgb_values(c) shr 16
		g += rgb_values(c) shr 8 and &hFF
		b += rgb_values(c) and &hFF
		
	next c
	
	r = r \ (arraylen)
	g = g \ (arraylen)
	b = b \ (arraylen)

	return rgb(r,g,b)

end function


function calculate_centroid (head as point_proto ptr) as point_proto

	'some part of this function is a
	'translation from a C implementation by squeamish ossifrage
	'https://stackoverflow.com/questions/19766485/how-to-calculate-centroid-of-polygon-in-c

	dim centroid as point_proto
	dim as single a, cx, cy, t
    dim as integer i, i1

	redim preserve 	x(0 to 0) as Long
	redim preserve 	y(0 to 0) as Long

	i = 0
   
	while head <> NULL
		if (head->next_p <> NULL) then
			x(i) = head->x
			y(i) = head->y
			redim preserve x(0 to  Ubound(x)+1)
			redim preserve y(0 to  Ubound(y)+1)
		end if
		head = head->next_p
		i+=1
	wend

	'this is the translated part

	'First calculate the polygon's signed area A
	a = 0.0
	i1 = 1

	for i = 0 to (Ubound(x)-1) step 1

		a += x(i) * y(i1) - x(i1) * y(i)
		i1 = (i1 + 1) mod (Ubound(x))

	next i

	a *= 0.5

	' Now calculate the centroid coordinates Cx and Cy */
	cx = cy = 0.0
	i1 = 1

	for i = 0 to (Ubound(x)-1) step 1

		t = x(i)*y(i1) - x(i1)*y(i)
		cx += (x(i)+x(i1)) * t
		cy += (y(i)+y(i1)) * t
		i1 = (i1 + 1) mod (Ubound(x))
		
	next i

	cx = cx / (6.0 * a)
	cy = cy / (6.0 * a)

	centroid.x = cx
	centroid.y = cy

	return centroid

end function

function dist (x1 as single, y1 as single, x2 as single, y2 as single) as single
    return Sqr(((x1-x2)*(x1-x2))+((y1-y2)*(y1-y2)))
end function

function find_nearest_point (array() as polygon_proto, user_mouse as mouse_proto, view_area as view_area_proto) as point_proto
	dim as integer i, min_dist, temp_dist
	dim as point_proto ptr head
	dim nearest as point_proto
	min_dist = 1000000
	
	for i = 0  to Ubound(array)-1
		head = array(i).first_point
		while head <> NULL
			temp_dist = dist	(head->x, _
								head->y,_
								user_mouse.abs_x, user_mouse.abs_y)
			if temp_dist < min_dist then
				min_dist = temp_dist
				nearest = *head
			end if
			head = head->next_p
		wend
	next i

	return nearest

end function

function get_pixel_color (x as integer, y as integer, img_name as any ptr) as ULong
	dim p as Uinteger 
	p = point(x,y, img_name)
	return p
	
end function


'fbGFXAddon by D.J. Peters
function ImageScale(byval s as fb.Image ptr, _
                    byval w as integer, _
                    byval h as integer) as fb.Image ptr
  #macro SCALELOOP()
  for ty = 0 to t->height-1
    ' address of the row
    pr=ps+(y shr 20)*sp
    x=0 ' first column
    for tx = 0 to t->width-1
      *pt=pr[x shr 20]
      pt+=1 ' next column
      x+=xs ' add xstep value
    next
    pt+=tp ' next row
    y+=ys ' add ystep value
  next
  #endmacro
  ' no source image
  if s        =0 then return 0
  ' source widh or height legal ?
  if s->width <1 then return 0
  if s->height<1 then return 0
  ' target min size ok ?
  if w<2 then w=1
  if h<2 then h=1
  ' create new scaled image
  dim as fb.Image ptr t=ImageCreate(w,h,RGB(0,0,0))
  ' x and y steps in fixed point 12:20
  dim as FIXED xs=&H100000*(s->width /t->width ) ' [x] [S]tep
  dim as FIXED ys=&H100000*(s->height/t->height) ' [y] [S]tep
  dim as integer x,y,ty,tx
  select case as const s->bpp
  case 1 ' color palette
    dim as ubyte    ptr ps=cptr(ubyte ptr,s)+32 ' [p]ixel   [s]ource
    dim as uinteger     sp=s->pitch             ' [s]ource  [p]itch
    dim as ubyte    ptr pt=cptr(ubyte ptr,t)+32 ' [p]ixel   [t]arget
    dim as uinteger     tp=t->pitch - t->width  ' [t]arget  [p]itch
    dim as ubyte    ptr pr                      ' [p]ointer [r]ow
    SCALELOOP()
  case 2 ' 15/16 bit
    dim as ushort   ptr ps=cptr(ushort ptr,s)+16
    dim as uinteger     sp=(s->pitch shr 1)
    dim as ushort   ptr pt=cptr(ushort ptr,t)+16
    dim as uinteger     tp=(t->pitch shr 1) - t->width
    dim as ushort   ptr pr
    SCALELOOP()
  case 4 ' 24/32 bit
    dim as ulong    ptr ps=cptr(uinteger ptr,s)+8
    dim as uinteger     sp=(s->pitch shr 2)
    dim as ulong    ptr pt=cptr(uinteger ptr,t)+8
    dim as uinteger     tp=(t->pitch shr 2) - t->width
    dim as ulong    ptr pr
    SCALELOOP()
  end select
  return t
  #undef SCALELOOP
end function

Function Load_bmp( ByRef filename As Const String ) As Any Ptr
	'Bmp load by noop
	'http://www.freebasic.net/forum/viewtopic.php?t=24586
    Dim As Long filenum, bmpwidth, bmpheight
    Dim As Any Ptr img

    '' open BMP file
    filenum = FreeFile()
    If Open( filename For Binary Access Read As #filenum ) <> 0 Then Return NULL

        '' retrieve BMP dimensions
        Get #filenum, 19, bmpwidth
        Get #filenum, 23, bmpheight

    Close #filenum

    '' create image with BMP dimensions
    img = ImageCreate( bmpwidth, Abs(bmpheight) )

    If img = NULL Then Return NULL

    '' load BMP file into image buffer
    If BLoad( filename, img ) <> 0 Then ImageDestroy( img ): Return NULL

    Return img

End Function

'SUBS
sub add_polygon(array() as polygon_proto)
	array(Ubound(array)).first_point = callocate(sizeof(point_proto))
	
	redim preserve array(Lbound(array) to Ubound(array)+1)
end sub

sub draw_centroid(centroid as point_proto, stroke_color as Ulong, view_area as view_area_proto)
	dim as integer x_offset, y_offset
	x_offset = centroid.x * view_area.zoom + view_area.x 
	y_offset = centroid.y * view_area.zoom + view_area.y 
	line (x_offset - 2,  y_offset)-step(4,0), stroke_color
	line (x_offset,  y_offset - 2)-step(0,4), stroke_color
end sub

Sub export_as_svg (array() as polygon_proto, file_name as string)

	Dim i as integer
	Dim head as point_proto ptr
	Dim ff As UByte
	ff = FreeFile
	Open file_name for output As #ff

	'SVG file header info
	
	Print #ff, "<?xml version='1.0' standalone='no'?>"
	Print #ff, "<!DOCTYPE svg PUBLIC '-//W3C//DTD SVG 1.1//EN' 'http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd'>"
	Print #ff, "<svg width='800px' height='600px' version='1.1' xmlns='http://www.w3.org/2000/svg'>"
	Print #ff, "<desc>" + APP_NAME + APP_VERSION + " - Export file</desc>"

	for i = 0 to Ubound(array)-1
	
		Print #ff, "<polygon fill='#" + _
					hex(array(i).fill_color shr 16 and &hFF) + _
					hex(array(i).fill_color shr 8 and &hFF) +_
					hex(array(i).fill_color and &hFF) + "'"
		Print #ff, "points='"
		
		head = array(i).first_point
		
		'ignore first one pointer values since it's only a link to data
		while head->next_p <> NULL
		
			Print #ff, str(head->x) + "," + str(head->y) + " "
			head = head->next_p
			
		wend
		
		Print #ff, "' />"
		
	next i

	Print #ff, "</svg>"
	Close #ff

end sub

Sub fill_polygon(head as point_proto ptr, ByVal c As ULong, view_area as view_area_proto, settings as settings_proto)
   'translation of a c snippet by Angad
   'source of c code:
   'http://code-heaven.blogspot.it/2009/10/simple-c-program-for-scan-line-polygon.html
   
   ' Thanks to MrSwiss for the corrections on the below code for 64/32 compiler
   redim preserve 	a(0 to 0, 0 to 1) as Long
   Dim As Long      i, j, k, dy, dx, x, y, temp
  
   
   i = 0
   while head <> NULL
		if (head->next_p <> NULL) then
			a(i, 0) = head->x*view_area.zoom + view_area.x
			a(i, 1) = head->y*view_area.zoom + view_area.y
			redim preserve a(0 to  Ubound(a)+1, 0 to 1)
		end if
		head = head->next_p
		i+=1
	wend
   
   Dim As Long      xi(0 to Ubound(a, 1))
   Dim As Single    slope(0 to Ubound(a, 1))
   'join first and last vertex
   a(Ubound(a, 1), 0) = a(0, 0)
   a(Ubound(a, 1), 1) = a(0, 1)

   For i = 0 To Ubound(a, 1) - 1
		
		
	dy = a(i+1, 1) - a(i, 1)
      dx = a(i+1, 0) - a(i, 0)

      If (dy = 0) Then slope(i) = 1.0
      If (dx = 0) Then slope(i) = 0.0

      If (dy <> 0) AndAlso (dx <> 0) Then slope(i) = dx / dy
    
   Next i

   For y = 0 to SCR_H - 1
      k = 0
      ' using FB's short-cut operators (which C doesn't have!)
      For i = 0 to Ubound(a, 1) - 1
         If (a(i, 1) <= y AndAlso a(i+1, 1) > y) OrElse _
             (a(i, 1) > y AndAlso a(i+1, 1) <= y) Then
            xi(k) = CLng(a(i, 0) + slope(i) * (y - a(i, 1)))
            k += 1
         End If
      Next i

      For j = 0 to k - 2
         'Arrange x-intersections in order
         For i = 0 To k - 2
            If (xi(i) > xi(i + 1)) Then
               temp = xi(i)
               xi(i) = xi(i + 1)
               xi(i + 1) = temp
            End If
         Next i
      Next j
      'line filling
      For i = 0 To k - 2 Step 2
         Line (xi(i), y)-(xi(i + 1) + 1, y), c
      Next i

   Next y
   
           'draw wireframe
      if (settings.is_wireframe_visible) then
		For i = 0 To Ubound(a, 1) - 1
			line(a(i+1, 0),a(i+1, 1))-(a(i, 0),a(i, 1)),C_WHITE
		next i
		end if
End Sub

sub keyboard_listener(	input_mode as proto_input_mode ptr, _
						user_mouse as mouse_proto, _
						view_area as view_area_proto ptr,_
						settings as settings_proto ptr)
	
	dim e As EVENT
	If (ScreenEvent(@e)) Then
		Select Case e.type
		Case EVENT_KEY_RELEASE
			'switch Debug mode ON/OFF___________________________________
			If (e.scancode = SC_D) Then
				Debug_mode = not Debug_mode
			end if
			If (e.scancode = SC_C) Then
				settings->is_centroid_visible = not settings->is_centroid_visible
			end if
			If (e.scancode = SC_W) Then
				settings->is_wireframe_visible = not settings->is_wireframe_visible
			end if
			
		End Select
	End If
	
	'this is for the hand ovverride tool
	if multikey (SC_SPACE) then
		settings->is_hand_active = true
	else
		settings->is_hand_active = false
	end if
	if multikey (SC_S) then *input_mode = input_export_as_svg
	If (multikey(SC_DELETE)) Then *input_mode = input_erase_all

	if ((multikey(SC_LSHIFT)) or (multikey(SC_LSHIFT))) then
		settings->is_snap_active = false
	else
		settings->is_snap_active = true
	end if

	
end sub

sub draw_list_points(head as point_proto ptr, x as integer, y as integer)
	dim as integer c = 0
	
	while (head <> NULL)
		draw string (x + c*60, y), ">" +str(hex(head)), C_DARK_GRAY	
		head = head->next_p
		c += 1
	wend
end sub

Sub delete_all_points	(head as point_proto ptr)
	dim temp as point_proto ptr
	while (head <> NULL)
		temp = Head
		head = temp->next_p
		deallocate(temp)
	wend
end sub

sub mouse_listener(user_mouse as mouse_proto ptr, view_area as view_area_proto ptr)
	static old_is_lbtn_pressed as boolean = false
	static old_is_rbtn_pressed as boolean = false
	static as integer old_x, old_y
	static store_xy as boolean = false
	dim as integer scalechange
	
	user_mouse->abs_x = int(user_mouse->x / view_area->zoom + (-view_area->x / view_area->zoom))
	user_mouse->abs_y = int(user_mouse->y / view_area->zoom + (-view_area->y / view_area->zoom))
	
	if User_Mouse->old_wheel < User_Mouse->wheel and view_area->zoom < 4 then
      view_area->zoom *= 2.0f
      'view_area->x -= Int(user_mouse->abs_x)\int(view_area->zoom)
      'view_area->y -= Int(user_mouse->abs_y)\int(view_area->zoom)
   end if
   if User_Mouse->old_wheel > User_Mouse->wheel and view_area->zoom > 0.25 then
      view_area->zoom *= 0.5f
      'view_area->x = Int(user_mouse->abs_x)\2
      'view_area->y = Int(user_mouse->abs_y)\2
   end if
   

	'recognize if the left button has been pressed
	if User_Mouse->buttons and 1 then
		User_Mouse->is_lbtn_pressed = true
	else
		User_Mouse->is_lbtn_pressed = false
	end if
	
	'recognize if the right button has been pressed
	if User_Mouse->buttons and 2 then
		User_Mouse->is_rbtn_pressed = true
	else
		User_Mouse->is_rbtn_pressed = false
	end if
	
	'recognize if the left button has been released
	if old_is_lbtn_pressed = false and User_Mouse->is_lbtn_pressed and store_xy = false then 
		store_xy = true
	end if
	
	if store_xy then
		user_mouse->old_x = user_mouse->x
		user_mouse->old_y = user_mouse->y
		store_xy = false
	end if
	
	'recognize if the left button has been released
	if old_is_lbtn_pressed and User_Mouse->is_lbtn_pressed = false then 
		User_Mouse->is_lbtn_released = true
	end if
	
	'recognize if the right button has been released
	if old_is_rbtn_pressed and User_Mouse->is_rbtn_pressed = false then 
		User_Mouse->is_rbtn_released = true
	end if
	
	'recognize drag
	if (User_Mouse->is_lbtn_pressed) and CBool((old_x <> user_mouse->x) or (old_y <> user_mouse->y)) then
		user_mouse->is_dragging = true
		'cuspid node
		if multikey(SC_ALT) then
			user_mouse->oppo_x = user_mouse->old_oppo_x
			user_mouse->oppo_y = user_mouse->old_oppo_y
		'normal node
		else
			user_mouse->oppo_x = User_Mouse->old_x - _
						cos (_abtp (User_Mouse->old_x, User_Mouse->old_y, User_Mouse->x, User_Mouse->y)) * _
						(dist(User_Mouse->old_x, User_Mouse->old_y, User_Mouse->x, User_Mouse->y))
			user_mouse->oppo_y = User_Mouse->old_y - _
						-sin(_abtp (User_Mouse->old_x, User_Mouse->old_y, User_Mouse->x, User_Mouse->y)) * _
						(dist(User_Mouse->old_x, User_Mouse->old_y, User_Mouse->x, User_Mouse->y))
			user_mouse->old_oppo_x = user_mouse->oppo_x
			user_mouse->old_oppo_y = user_mouse->oppo_y
		end if			
		
	else
		user_mouse->is_dragging = false
	end if
	   'store the old wheel state
	User_Mouse->old_wheel = User_Mouse->wheel
	'store the old state of left button
	old_is_lbtn_pressed = User_Mouse->is_lbtn_pressed
	'store the old state of left button
	old_is_rbtn_pressed = User_Mouse->is_rbtn_pressed
	
	
end sub


sub pop_values_in_array(array() as integer, eval as integer)
	'given a monodimensional re-dimmable array, pops all the data
	'that are equal to eval and resizes the array
	dim as integer i, j
	
	'transverse whole array, if the array(i) value
	'matches the eval, shift non-eval values of the array on the left.
	for i = Lbound(array) to Ubound(array)
		if array(i) = eval then 
			for j = (i + 1) to Ubound(array)
				if array(j) <> eval then
					swap array(j), array (i)
					exit for
				end if 
			next j
		end if
	next i
	
	'find new first eval value location
	for i = Lbound(array) to Ubound(array)
		if array(i) = eval then 
			exit for
		end if
	next i
	
	'redim the array
	redim preserve array(Lbound(array) to i-1) as integer
	
end sub


Image
Original source of image: https://commons.wikimedia.org/wiki/File ... 080622.jpg - CC BY-SA 3.0

Here's the exported SVG file… I've to fix a bit the color picker function.

A youtube video of FB Low Poly Editor in action: https://youtu.be/u3yrOPnQ04Q
Pitto
Posts: 122
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Post by Pitto »

The version 0.04 is ready.
Now it's possible to snap on vertices and edges, show/hide the background bitmap.
Image

Here's a video of this version in action:
https://youtu.be/ZYylH-ybPUg

Code: Select all

'Low Poly Editor by Pitto

'This program is free software; you can redistribute it and/or
'modify it under the terms of the GNU General Public License
'as published by the Free Software Foundation; either version 2
'of the License, or (at your option) any later version.
'
'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'GNU General Public License for more details.
'
'You should have received a copy of the GNU General Public License
'along with this program; if not, write to the Free Software
'Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
'Also add information on how to contact you by electronic and paper mail.

'#######################################################################

' Compiling instructions: fbc -w all -exx "%f"

#include "fbgfx.bi"

dim shared Debug_mode		as boolean = false
Using FB
randomize timer

#ifndef NULL
	const NULL as any ptr = 0
#endif

#ifndef getPixelAddress
    #define getPixelAddress(img,row,col) cast(any ptr,img) + _
        sizeof(FB.IMAGE) + (img)->pitch * (row) + (img)->bpp * (col)
#endif

'define and consts______________________________________________________
#define APP_NAME 				"Low Poly Editor by Pitto"
#define APP_VERSION 			"Version 0.04"
#define SCR_W 					1024		
#define SCR_H 					768
#define MIN_SNAP_DIST			15
#define MIN_EDGE_SNAP_DIST		20


'colors
#define C_BLACK			&h000000
#define C_WHITE			&hFFFFFF
#define C_GRAY 			&h7F7F7F
#define C_DARK_GRAY		&h202020
#define C_RED			&hFF0000
#define C_BLUE 			&h0000FF
#define C_GREEN			&h00FF00
#define C_YELLOW		&hFFFF00
#define C_CYAN 			&h00FFFF
#define C_LILIAC		&h7F00FF
#define C_ORANGE		&hFF7F00
#define C_PURPLE		&h7F007F
#define C_DARK_RED 		&h7F0000
#define C_DARK_GREEN	&h005500
#define C_DARK_BLUE		&h00007F

'enums__________________________________________________________________

enum proto_input_mode
	input_error = 0
	input_add_polygon = 1
	input_add_point = 2
	input_close_polygon = 3
	input_hand
	add_vertex
	del_vertex
	add_edge 
	del_edge
	move_vertex
	set_start
	set_end
	
	input_erase_all
	input_export_as_svg
end enum

'types__________________________________________________________________
type point_proto
	x 			as single
	y 			as single
	next_p  	as point_proto ptr
end type

type temp_point_proto
	x 				as single
	y 				as single
	distance		as single
end type

type segment_proto
	as single x1,y1,x2,y2
end type

type polygon_proto
	first_point		as point_proto ptr
	centroid		as point_proto
	fill_color		as Ulong
	stroke_color	as Ulong
end type

type view_area_proto
    x 		as single
    y 		as single
    old_x 	as single
    old_y 	as single
    w 		as single
    h 		as single
    speed 	as single
    rds 	as single
	zoom 	as single
	old_zoom 	as single
end type

Type mouse_proto
    As Integer 		res, x, y, old_x, old_y, wheel, clip, _
					old_wheel, diff_wheel, abs_x, abs_y
    as single 		oppo_x, oppo_y, old_oppo_x, old_oppo_y
    as boolean is_dragging
    as boolean is_lbtn_released
    as boolean is_lbtn_pressed
    as boolean is_rbtn_released
    as boolean is_rbtn_pressed
    Union
        buttons 		As Integer
        Type
            Left:1 		As Integer
            Right:1 	As Integer
            middle:1 	As Integer
        End Type
    End Union
End Type

Type settings_proto
	is_snap_active as boolean
	is_hand_active as boolean
	is_centroid_visible as boolean
	is_wireframe_visible as boolean
	is_bitmap_visible as boolean
	wireframe_color as Ulong
end type

type FIXED as long ' 12:20

redim polygons(0 to 0) as polygon_proto

'functions declarations
declare function _abtp 			(x1 as integer,y1 as integer,x2 as integer,y2 as integer) as single
declare function add_point		(head as point_proto ptr ptr, x as single, y as single) as point_proto ptr
declare function average_color	(rgb_values() as Ulong) as Ulong
declare function calculate_centroid (head as point_proto ptr) as point_proto
declare function dist 				(x1 as single, y1 as single, x2 as single, y2 as single) as single
declare function find_nearest_point (array() as polygon_proto, user_mouse as mouse_proto, view_area as view_area_proto) as temp_point_proto
declare function get_pixel_color	 (x as integer, y as integer, img_name as any ptr) as ULong
'fbGFXAddon by D.J. Peters  
declare function ImageScale		(byval s as fb.Image ptr, _
								byval w as integer, _
								byval h as integer) as fb.Image ptr
								
declare function pDistance		(x as single, y as single, _
						x1 as single, y1 as single, _
						x2 as single, y2 as single,_
						view_area as view_area_proto) as temp_point_proto

'Bmp load by noop
declare function Load_bmp( ByRef filename As Const String ) As Any Ptr

'subs declarations______________________________________________________
declare sub add_polygon			(array() as polygon_proto)
declare sub draw_centroid		(centroid as point_proto, stroke_color as Ulong, view_area as view_area_proto)
declare sub draw_list_points	(head as point_proto ptr, x as integer, y as integer)
declare Sub export_as_svg		(array() as polygon_proto, file_name as string)
declare Sub fill_polygon		(head as point_proto ptr, ByVal c As ULong, view_area as view_area_proto, settings as settings_proto)
declare sub draw_highlighted_points(head as point_proto ptr, ByVal c As ULong, w as Ulong)
declare sub keyboard_listener	(input_mode as proto_input_mode ptr, _
								user_mouse as mouse_proto, _
								view_area as view_area_proto ptr, _
								settings as settings_proto ptr)
declare sub mouse_listener		(user_mouse as mouse_proto ptr, _
								view_area as view_area_proto ptr)
declare Sub pop_values_in_array	(array() as integer,_
								eval as integer)
declare Sub delete_all_points	(head as point_proto ptr)
declare sub quicksort(array() as temp_point_proto, _left as integer, _right as integer )


'MAIN___________________________________________________________________
DIM workpage 				AS INTEGER
workpage = 0
Dim user_mouse 				as mouse_proto
dim view_area				as view_area_proto
Dim input_mode				as proto_input_mode
dim wallp_image				as any ptr

user_mouse.is_dragging = false
user_mouse.is_lbtn_released = false
user_mouse.is_lbtn_pressed = false

view_area.x = 0
view_area.y = 0
view_area.zoom = 1.0f
view_area.old_zoom = view_area.zoom

dim settings as settings_proto
settings.is_snap_active = true
settings.is_hand_active = false
settings.is_bitmap_visible = true
settings.is_centroid_visible = true
settings.is_wireframe_visible = true
settings.wireframe_color = C_WHITE

screenres (SCR_W, SCR_H, 24)
SetMouse SCR_W\2, SCR_H\2, 0

dim as FB.Image ptr wallp_img = Load_bmp( "img/test.bmp" )
dim as fb.image ptr wallp_img_resized = ImageScale	(wallp_img,_
													wallp_img->width*view_area.zoom, _
													wallp_img->height*view_area.zoom)

dim head as point_proto ptr
input_mode = input_add_polygon

do
	if MULTIKEY (SC_Escape) then exit do
	dim c as integer
	dim nearest_point as temp_point_proto
	dim dist_from_nearest_point as Uinteger
	dim scalechange as single

	User_Mouse.res = 	GetMouse( 	User_Mouse.x, User_Mouse.y, _
									User_Mouse.wheel, User_Mouse.buttons,_
									User_Mouse.clip)
								
	keyboard_listener	(@input_mode, user_mouse, @view_area, @settings)
	mouse_listener		(@user_mouse, @view_area)
	
	nearest_point = find_nearest_point(polygons(), user_mouse, view_area)
	dist_from_nearest_point = int (dist		(nearest_point.x,_
											nearest_point.y, _
											user_mouse.abs_x, _
											user_mouse.abs_y))
											
	'zoom in / out 
	if (view_area.old_zoom <> view_area.zoom) then
		wallp_img_resized = ImageScale (wallp_img,_
								wallp_img->width*view_area.zoom, _
								wallp_img->height*view_area.zoom)
								
		scalechange = view_area.zoom - view_area.old_zoom
		view_area.x += -(user_mouse.abs_x * scalechange)
		view_area.y += -(user_mouse.abs_y * scalechange)
	end if
	view_area.old_zoom = view_area.zoom

	
	if settings.is_hand_active then
		input_mode = input_hand
	end if
	
	select case input_mode
	
		case input_hand
			'####################### HAND TOOL #########################
			if (user_mouse.is_dragging) then
				line (user_mouse.x, user_mouse.y)-(user_mouse.old_X, user_mouse.old_y)
				view_area.x = view_area.old_x + (user_mouse.x - user_mouse.old_x)
				view_area.y = view_area.old_y + (user_mouse.y - user_mouse.old_y)
			else
				view_area.old_x = view_area.x
				view_area.old_y = view_area.y
			end if
			user_mouse.is_lbtn_released = false
			if not settings.is_hand_active then
				input_mode = input_add_polygon
			end if
	
		case input_add_polygon
		
			add_polygon(polygons())
			head = polygons(Ubound(polygons)-1).first_point
			polygons(Ubound(polygons)-1).fill_color = C_GRAY
			input_mode = input_add_point
	
		case input_add_point
			
			if (user_mouse.is_lbtn_released) then
				'snapping if mouse pointer is near to existing points
				if Cbool(dist_from_nearest_point < MIN_SNAP_DIST/view_area.zoom) and _
					settings.is_snap_active then
					polygons(Ubound(polygons)-1).first_point = _
					add_point(@head, nearest_point.x, nearest_point.y)
				else
					polygons(Ubound(polygons)-1).first_point = _
					add_point(@head, user_mouse.abs_x, user_mouse.abs_y)
				end if

				user_mouse.is_lbtn_released = false
			end if
			
			if (user_mouse.is_rbtn_released) then
				input_mode = input_close_polygon
				polygons(Ubound(polygons)-1).centroid = calculate_centroid(polygons(Ubound(polygons)-1).first_point)
				polygons(Ubound(polygons)-1).fill_color = _
				get_pixel_color	(	int(polygons(Ubound(polygons)-1).centroid.x * view_area.zoom), _
									int(polygons(Ubound(polygons)-1).centroid.y * view_area.zoom), _
									wallp_img_resized)
				user_mouse.is_rbtn_released = false
			end if
		
		case input_close_polygon
		
			input_mode = input_add_polygon
			
		case input_erase_all
			for c = 0 to Ubound(polygons)-1
				delete_all_points (polygons(c).first_point)
			next c
			redim polygons(0 to 0)
			input_mode = input_add_polygon
			
		case input_export_as_svg
			export_as_svg(polygons(), "output.svg")
			input_mode = input_add_polygon
	end select
	
	screenlock ' Lock the screen
	screenset Workpage, Workpage xor 1 ' Swap work pages.

	cls
	
	if (settings.is_bitmap_visible) then
		put (view_area.x,view_area.y),wallp_img_resized,pset
	end if

	c=0


	for c = 0 to Ubound(polygons)-1
		'fill each polygon
		fill_polygon(polygons(c).first_point, CULng(polygons(c).fill_color), view_area, settings)
		'draw the centroid of each polygon
		if (settings.is_centroid_visible) then
			draw_centroid(polygons(c).centroid, C_GREEN, view_area)
		end if
		'draw some debug info
		if (Debug_mode) then
			draw_list_points(polygons(c).first_point, 20, 20 + c*20)
		end if
	next c
	
	'highlight line from last point to mouse
	if (polygons(0).first_point <> NULL) then
		if (polygons(Ubound(polygons)-1).first_point->next_p <> NULL) then
			line 	(polygons(Ubound(polygons)-1).first_point->x*view_area.zoom + view_area.x, _
					polygons(Ubound(polygons)-1).first_point->y*view_area.zoom + view_area.y)- _
					(User_Mouse.x, User_Mouse.y), C_WHITE
		end if
	end if
	
	'highlight nearest point to mouse, skip if Left or right shift key is down
	if 	Cbool(dist_from_nearest_point < MIN_SNAP_DIST / view_area.zoom) and _
		settings.is_snap_active then
		circle (	nearest_point.x*view_area.zoom + view_area.x, _
					nearest_point.y*view_area.zoom + view_area.y), 4, C_GREEN, ,,,F
		line (user_mouse.x-5, user_mouse.y-5)-STEP(10,10), C_DARK_GREEN, B
		line (user_mouse.x-6, user_mouse.y-6)-STEP(12,12), C_GREEN, B
	end if

	'mouse graphical cross pointer
	if (user_mouse.is_lbtn_pressed) then
		line (user_mouse.x-5, user_mouse.y-5)-step(10, 10), C_ORANGE, BF
	end if
	
	line (user_mouse.x-5, user_mouse.y-1)-step(10, 2), C_BLACK, BF
	line (user_mouse.x-1, user_mouse.y-5)-step(2, 10), C_BLACK, BF
		
	line (user_mouse.x-10, user_mouse.y)-(user_mouse.x+10, user_mouse.y)
	line (user_mouse.x, user_mouse.y-10)-(user_mouse.x, user_mouse.y+10)
	
	draw string (20, SCR_H - 40), "absolute x " + str(user_mouse.abs_x) + ", y " + str(user_mouse.abs_y)
	draw string (20, SCR_H - 30), "mouse x " + str(user_mouse.x) + ", y " + str(user_mouse.y)
	draw string (20, SCR_H - 20), APP_NAME + " " + APP_VERSION, C_BLACK
	draw string (19, SCR_H - 21), APP_NAME + " " + APP_VERSION, C_WHITE
	
	workpage = 1 - Workpage ' Swap work pages.
	screenunlock
	sleep 20,1
LOOP


'free memory
dim c as integer
for c = 0 to Ubound(polygons)-1
	delete_all_points (polygons(c).first_point)
next c
deallocate(head)
redim polygons(0 to 0)

'destroy bitmaps from memory
ImageDestroy wallp_img
ImageDestroy wallp_img_resized

'_______________________________________________________________________

'FUNCTIONS______________________________________________________________
function _abtp (x1 as integer,y1 as integer,x2 as integer,y2 as integer) as single
	return -Atan2(y2-y1,x2-x1)
end function

function add_point(head as point_proto ptr ptr, x as single, y as single) as point_proto ptr
    dim as point_proto ptr p = callocate(sizeof(point_proto))
    p->x = x
    p->y = y
	p->next_p = *head
    *head = p
    return p
end function

'Average color function:
'given an array of rgb colors values as argument
'returns the average color using the arithmetic mean
function average_color(rgb_values() as Ulong) as Ulong
	dim as integer r, g, b, c, arraylen
	
	arraylen = UBound(rgb_values) - LBound(rgb_values) + 1
	
	r = 0 : g = 0 : b = 0

	for c = Lbound(rgb_values) to Ubound(rgb_values)
	
		'get & sum each r, g, b value
		r += rgb_values(c) shr 16
		g += rgb_values(c) shr 8 and &hFF
		b += rgb_values(c) and &hFF
		
	next c
	
	r = r \ (arraylen)
	g = g \ (arraylen)
	b = b \ (arraylen)

	return rgb(r,g,b)

end function


function calculate_centroid (head as point_proto ptr) as point_proto

	'some part of this function is a
	'translation from a C implementation by squeamish ossifrage
	'https://stackoverflow.com/questions/19766485/how-to-calculate-centroid-of-polygon-in-c

	dim centroid as point_proto
	dim as single a, cx, cy, t
    dim as integer i, i1

	redim preserve 	x(0 to 0) as Long
	redim preserve 	y(0 to 0) as Long

	i = 0
   
	while head <> NULL
		if (head->next_p <> NULL) then
			x(i) = head->x
			y(i) = head->y
			redim preserve x(0 to  Ubound(x)+1)
			redim preserve y(0 to  Ubound(y)+1)
		end if
		head = head->next_p
		i+=1
	wend

	'this is the translated part

	'First calculate the polygon's signed area A
	a = 0.0
	i1 = 1

	for i = 0 to (Ubound(x)-1) step 1

		a += x(i) * y(i1) - x(i1) * y(i)
		i1 = (i1 + 1) mod (Ubound(x))

	next i

	a *= 0.5

	' Now calculate the centroid coordinates Cx and Cy */
	cx = cy = 0.0
	i1 = 1

	for i = 0 to (Ubound(x)-1) step 1

		t = x(i)*y(i1) - x(i1)*y(i)
		cx += (x(i)+x(i1)) * t
		cy += (y(i)+y(i1)) * t
		i1 = (i1 + 1) mod (Ubound(x))
		
	next i

	cx = cx / (6.0 * a)
	cy = cy / (6.0 * a)

	centroid.x = cx
	centroid.y = cy

	return centroid

end function

function dist (x1 as single, y1 as single, x2 as single, y2 as single) as single
    return Sqr(((x1-x2)*(x1-x2))+((y1-y2)*(y1-y2)))
end function

function find_nearest_point (array() as polygon_proto, user_mouse as mouse_proto, view_area as view_area_proto) as temp_point_proto
	dim as integer i, j, min_dist, temp_dist, k
	dim as point_proto ptr head

	'store all segments of all polygons in an array
	'and find the distance of line to pointer for each
	redim preserve segments(0 to 0) as segment_proto
	dim close_point as point_proto

	for j = 0 to Ubound(array) - 1

		if (array(j).first_point) <> NULL then
			head = array(j).first_point
			close_point.x = head->x
			close_point.y = head->y
		else
			continue for
		end if

		while head->next_p <> NULL

			segments(i).x1 = head->x
			segments(i).y1 = head->y

			if (head->next_p->next_p <> NULL) then
				segments(i).x2 = head->next_p->x
				segments(i).y2 = head->next_p->y
			else
				'join last segment to the beginning of the path
				segments(i).x2 = close_point.x
				segments(i).y2 = close_point.y
			end if
				
			redim preserve segments(0 to (Ubound(segments)+1))
			i+=1
			head = head->next_p
			
		wend
		
	next j
	
	redim preserve nearest_points(0 to (Ubound(segments)+1)) as temp_point_proto
	
	for i = 0 to Ubound(nearest_points)-1
		nearest_points(i) = pDistance	(user_mouse.abs_x, user_mouse.abs_y, _
								segments(i).x1, _
								segments(i).y1, _
								segments(i).x2, _
								segments(i).y2, _
								view_area)
	next i
	
	quicksort (nearest_points(), Lbound(nearest_points), Ubound(nearest_points))
	
	if UBound(nearest_points) > 0 then
		return nearest_points(1)
	else
		return nearest_points(0)
	end if

end function

function get_pixel_color (x as integer, y as integer, img_name as any ptr) as ULong
	dim p as Uinteger 
	p = point(x,y, img_name)
	return p
	
end function


'fbGFXAddon by D.J. Peters
function ImageScale(byval s as fb.Image ptr, _
                    byval w as integer, _
                    byval h as integer) as fb.Image ptr
  #macro SCALELOOP()
  for ty = 0 to t->height-1
    ' address of the row
    pr=ps+(y shr 20)*sp
    x=0 ' first column
    for tx = 0 to t->width-1
      *pt=pr[x shr 20]
      pt+=1 ' next column
      x+=xs ' add xstep value
    next
    pt+=tp ' next row
    y+=ys ' add ystep value
  next
  #endmacro
  ' no source image
  if s        =0 then return 0
  ' source widh or height legal ?
  if s->width <1 then return 0
  if s->height<1 then return 0
  ' target min size ok ?
  if w<2 then w=1
  if h<2 then h=1
  ' create new scaled image
  dim as fb.Image ptr t=ImageCreate(w,h,RGB(0,0,0))
  ' x and y steps in fixed point 12:20
  dim as FIXED xs=&H100000*(s->width /t->width ) ' [x] [S]tep
  dim as FIXED ys=&H100000*(s->height/t->height) ' [y] [S]tep
  dim as integer x,y,ty,tx
  select case as const s->bpp
  case 1 ' color palette
    dim as ubyte    ptr ps=cptr(ubyte ptr,s)+32 ' [p]ixel   [s]ource
    dim as uinteger     sp=s->pitch             ' [s]ource  [p]itch
    dim as ubyte    ptr pt=cptr(ubyte ptr,t)+32 ' [p]ixel   [t]arget
    dim as uinteger     tp=t->pitch - t->width  ' [t]arget  [p]itch
    dim as ubyte    ptr pr                      ' [p]ointer [r]ow
    SCALELOOP()
  case 2 ' 15/16 bit
    dim as ushort   ptr ps=cptr(ushort ptr,s)+16
    dim as uinteger     sp=(s->pitch shr 1)
    dim as ushort   ptr pt=cptr(ushort ptr,t)+16
    dim as uinteger     tp=(t->pitch shr 1) - t->width
    dim as ushort   ptr pr
    SCALELOOP()
  case 4 ' 24/32 bit
    dim as ulong    ptr ps=cptr(uinteger ptr,s)+8
    dim as uinteger     sp=(s->pitch shr 2)
    dim as ulong    ptr pt=cptr(uinteger ptr,t)+8
    dim as uinteger     tp=(t->pitch shr 2) - t->width
    dim as ulong    ptr pr
    SCALELOOP()
  end select
  return t
  #undef SCALELOOP
end function

Function Load_bmp( ByRef filename As Const String ) As Any Ptr
	'Bmp load by noop
	'http://www.freebasic.net/forum/viewtopic.php?t=24586
    Dim As Long filenum, bmpwidth, bmpheight
    Dim As Any Ptr img

    '' open BMP file
    filenum = FreeFile()
    If Open( filename For Binary Access Read As #filenum ) <> 0 Then Return NULL

        '' retrieve BMP dimensions
        Get #filenum, 19, bmpwidth
        Get #filenum, 23, bmpheight

    Close #filenum

    '' create image with BMP dimensions
    img = ImageCreate( bmpwidth, Abs(bmpheight) )

    If img = NULL Then Return NULL

    '' load BMP file into image buffer
    If BLoad( filename, img ) <> 0 Then ImageDestroy( img ): Return NULL

    Return img

End Function

'SUBS
sub add_polygon(array() as polygon_proto)
	array(Ubound(array)).first_point = callocate(sizeof(point_proto))
	
	redim preserve array(Lbound(array) to Ubound(array)+1)
end sub

sub draw_centroid(centroid as point_proto, stroke_color as Ulong, view_area as view_area_proto)
	dim as integer x_offset, y_offset
	x_offset = centroid.x * view_area.zoom + view_area.x 
	y_offset = centroid.y * view_area.zoom + view_area.y 
	line (x_offset - 2,  y_offset)-step(4,0), stroke_color
	line (x_offset,  y_offset - 2)-step(0,4), stroke_color
end sub

Sub export_as_svg (array() as polygon_proto, file_name as string)

	Dim i as integer
	Dim head as point_proto ptr
	Dim ff As UByte
	ff = FreeFile
	Open file_name for output As #ff

	'SVG file header info
	
	Print #ff, "<?xml version='1.0' standalone='no'?>"
	Print #ff, "<!DOCTYPE svg PUBLIC '-//W3C//DTD SVG 1.1//EN' 'http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd'>"
	Print #ff, "<svg width='800px' height='600px' version='1.1' xmlns='http://www.w3.org/2000/svg'>"
	Print #ff, "<desc>" + APP_NAME + APP_VERSION + " - Export file</desc>"

	for i = 0 to Ubound(array)-1
	
		Print #ff, "<polygon fill='#" + _
					hex(array(i).fill_color shr 16 and &hFF) + _
					hex(array(i).fill_color shr 8 and &hFF) +_
					hex(array(i).fill_color and &hFF) + "'"
		Print #ff, "points='"
		
		head = array(i).first_point
		
		'ignore first one pointer values since it's only a link to data
		while head->next_p <> NULL
		
			Print #ff, str(head->x) + "," + str(head->y) + " "
			head = head->next_p
			
		wend
		
		Print #ff, "' />"
		
	next i

	Print #ff, "</svg>"
	Close #ff

end sub

Sub fill_polygon(head as point_proto ptr, ByVal c As ULong, view_area as view_area_proto, settings as settings_proto)
   'translation of a c snippet by Angad
   'source of c code:
   'http://code-heaven.blogspot.it/2009/10/simple-c-program-for-scan-line-polygon.html
   
   ' Thanks to MrSwiss for the corrections on the below code for 64/32 compiler
   redim preserve 	a(0 to 0, 0 to 1) as Long
   Dim As Long      i, j, k, dy, dx, x, y, temp
  
   
   i = 0
   while head <> NULL
		if (head->next_p <> NULL) then
			a(i, 0) = head->x*view_area.zoom + view_area.x
			a(i, 1) = head->y*view_area.zoom + view_area.y
			redim preserve a(0 to  Ubound(a)+1, 0 to 1)
		end if
		head = head->next_p
		i+=1
	wend
   
   Dim As Long      xi(0 to Ubound(a, 1))
   Dim As Single    slope(0 to Ubound(a, 1))
   'join first and last vertex
   a(Ubound(a, 1), 0) = a(0, 0)
   a(Ubound(a, 1), 1) = a(0, 1)

   For i = 0 To Ubound(a, 1) - 1
		
		
	dy = a(i+1, 1) - a(i, 1)
      dx = a(i+1, 0) - a(i, 0)

      If (dy = 0) Then slope(i) = 1.0
      If (dx = 0) Then slope(i) = 0.0

      If (dy <> 0) AndAlso (dx <> 0) Then slope(i) = dx / dy
    
   Next i

   For y = 0 to SCR_H - 1
      k = 0
      ' using FB's short-cut operators (which C doesn't have!)
      For i = 0 to Ubound(a, 1) - 1
         If (a(i, 1) <= y AndAlso a(i+1, 1) > y) OrElse _
             (a(i, 1) > y AndAlso a(i+1, 1) <= y) Then
            xi(k) = CLng(a(i, 0) + slope(i) * (y - a(i, 1)))
            k += 1
         End If
      Next i

      For j = 0 to k - 2
         'Arrange x-intersections in order
         For i = 0 To k - 2
            If (xi(i) > xi(i + 1)) Then
               temp = xi(i)
               xi(i) = xi(i + 1)
               xi(i + 1) = temp
            End If
         Next i
      Next j
      'line filling
      For i = 0 To k - 2 Step 2
         Line (xi(i), y)-(xi(i + 1) + 1, y), c
      Next i

   Next y
   
           'draw wireframe
      if (settings.is_wireframe_visible) then
		For i = 0 To Ubound(a, 1) - 1
			line(a(i+1, 0),a(i+1, 1))-(a(i, 0),a(i, 1)),C_WHITE
		next i
		end if
End Sub

sub keyboard_listener(	input_mode as proto_input_mode ptr, _
						user_mouse as mouse_proto, _
						view_area as view_area_proto ptr,_
						settings as settings_proto ptr)
	
	dim e As EVENT
	If (ScreenEvent(@e)) Then
		Select Case e.type
		Case EVENT_KEY_RELEASE
			'switch Debug mode ON/OFF___________________________________
			If (e.scancode = SC_D) Then
				Debug_mode = not Debug_mode
			end if
			If (e.scancode = SC_C) Then
				settings->is_centroid_visible = not settings->is_centroid_visible
			end if
			If (e.scancode = SC_W) Then
				settings->is_wireframe_visible = not settings->is_wireframe_visible
			end if
			If (e.scancode = SC_B) Then
				settings->is_bitmap_visible = not settings->is_bitmap_visible 
			end if
			
		End Select
	End If
	
	'this is for the hand ovverride tool
	if multikey (SC_SPACE) then
		settings->is_hand_active = true
	else
		settings->is_hand_active = false
	end if
	if multikey (SC_S) then *input_mode = input_export_as_svg
	If (multikey(SC_DELETE)) Then *input_mode = input_erase_all

	if ((multikey(SC_LSHIFT)) or (multikey(SC_LSHIFT))) then
		settings->is_snap_active = false
	else
		settings->is_snap_active = true
	end if

	
end sub

sub draw_list_points(head as point_proto ptr, x as integer, y as integer)
	dim as integer c = 0
	
	while (head <> NULL)
		draw string (x + c*100, y), ">" +str(hex(head)), C_DARK_GRAY	
		draw string (x + c*100, y+8), " " + str(int(head->x)) + "," + str(int(head->y)), C_DARK_GRAY	
		head = head->next_p
		c += 1
	wend
end sub

Sub delete_all_points	(head as point_proto ptr)
	dim temp as point_proto ptr
	while (head <> NULL)
		temp = Head
		head = temp->next_p
		deallocate(temp)
	wend
end sub

sub mouse_listener(user_mouse as mouse_proto ptr, view_area as view_area_proto ptr)
	static old_is_lbtn_pressed as boolean = false
	static old_is_rbtn_pressed as boolean = false
	static as integer old_x, old_y
	static store_xy as boolean = false
	dim as integer scalechange
	
	user_mouse->abs_x = int(user_mouse->x / view_area->zoom + (-view_area->x / view_area->zoom))
	user_mouse->abs_y = int(user_mouse->y / view_area->zoom + (-view_area->y / view_area->zoom))
	
	if User_Mouse->old_wheel < User_Mouse->wheel and view_area->zoom < 4 then
      view_area->zoom *= 2.0f
      'view_area->x -= Int(user_mouse->abs_x)\int(view_area->zoom)
      'view_area->y -= Int(user_mouse->abs_y)\int(view_area->zoom)
   end if
   if User_Mouse->old_wheel > User_Mouse->wheel and view_area->zoom > 0.25 then
      view_area->zoom *= 0.5f
      'view_area->x = Int(user_mouse->abs_x)\2
      'view_area->y = Int(user_mouse->abs_y)\2
   end if
   

	'recognize if the left button has been pressed
	if User_Mouse->buttons and 1 then
		User_Mouse->is_lbtn_pressed = true
	else
		User_Mouse->is_lbtn_pressed = false
	end if
	
	'recognize if the right button has been pressed
	if User_Mouse->buttons and 2 then
		User_Mouse->is_rbtn_pressed = true
	else
		User_Mouse->is_rbtn_pressed = false
	end if
	
	'recognize if the left button has been released
	if old_is_lbtn_pressed = false and User_Mouse->is_lbtn_pressed and store_xy = false then 
		store_xy = true
	end if
	
	if store_xy then
		user_mouse->old_x = user_mouse->x
		user_mouse->old_y = user_mouse->y
		store_xy = false
	end if
	
	'recognize if the left button has been released
	if old_is_lbtn_pressed and User_Mouse->is_lbtn_pressed = false then 
		User_Mouse->is_lbtn_released = true
	end if
	
	'recognize if the right button has been released
	if old_is_rbtn_pressed and User_Mouse->is_rbtn_pressed = false then 
		User_Mouse->is_rbtn_released = true
	end if
	
	'recognize drag
	if (User_Mouse->is_lbtn_pressed) and CBool((old_x <> user_mouse->x) or (old_y <> user_mouse->y)) then
		user_mouse->is_dragging = true
		'cuspid node
		if multikey(SC_ALT) then
			user_mouse->oppo_x = user_mouse->old_oppo_x
			user_mouse->oppo_y = user_mouse->old_oppo_y
		'normal node
		else
			user_mouse->oppo_x = User_Mouse->old_x - _
						cos (_abtp (User_Mouse->old_x, User_Mouse->old_y, User_Mouse->x, User_Mouse->y)) * _
						(dist(User_Mouse->old_x, User_Mouse->old_y, User_Mouse->x, User_Mouse->y))
			user_mouse->oppo_y = User_Mouse->old_y - _
						-sin(_abtp (User_Mouse->old_x, User_Mouse->old_y, User_Mouse->x, User_Mouse->y)) * _
						(dist(User_Mouse->old_x, User_Mouse->old_y, User_Mouse->x, User_Mouse->y))
			user_mouse->old_oppo_x = user_mouse->oppo_x
			user_mouse->old_oppo_y = user_mouse->oppo_y
		end if			
		
	else
		user_mouse->is_dragging = false
	end if
	   'store the old wheel state
	User_Mouse->old_wheel = User_Mouse->wheel
	'store the old state of left button
	old_is_lbtn_pressed = User_Mouse->is_lbtn_pressed
	'store the old state of left button
	old_is_rbtn_pressed = User_Mouse->is_rbtn_pressed
	
	
end sub


sub pop_values_in_array(array() as integer, eval as integer)
	'given a monodimensional re-dimmable array, pops all the data
	'that are equal to eval and resizes the array
	dim as integer i, j
	
	'transverse whole array, if the array(i) value
	'matches the eval, shift non-eval values of the array on the left.
	for i = Lbound(array) to Ubound(array)
		if array(i) = eval then 
			for j = (i + 1) to Ubound(array)
				if array(j) <> eval then
					swap array(j), array (i)
					exit for
				end if 
			next j
		end if
	next i
	
	'find new first eval value location
	for i = Lbound(array) to Ubound(array)
		if array(i) = eval then 
			exit for
		end if
	next i
	
	'redim the array
	redim preserve array(Lbound(array) to i-1) as integer
	
end sub


sub quicksort(array() as temp_point_proto, _left as integer, _right as integer )
	dim as integer i, j
	dim as single x, y
	
	i = _left
	j = _right
	
	x = array((_left + _right)\2).distance
	
	do
		while ((array(i).distance < x) and (i < _right))
			i +=1
		wend
		
		while ((x < array(j).distance) and (j > _left))
			j -=1
		wend
		
		if (i <=j) then
			'y = array(i)
			swap array(i), array (j)
			'array(j) = y
			i += 1
			j -= 1
		end if
		
	loop while (i <= j)
	
	if (_left < j) then quicksort (array(), _left, j)
	if (i < _right) then quicksort (array(), i, _right)

end sub


function pDistance		(x as single, y as single, _
						x1 as single, y1 as single, _
						x2 as single, y2 as single, _
						view_area as view_area_proto) as temp_point_proto
	'translated from https://stackoverflow.com/questions/849211/
	'shortest-distance-between-a-point-and-a-line-segment
	
	dim as single A, B, C, D, xx, yy, dot, len_sq, param
	dim nearest_point as temp_point_proto
	
	A = x - x1
	B = y - y1
	C = x2 - x1
	D = y2 - y1

	dot = A * C + B * D
	len_sq = C * C + D * D
	param = -1
	
	if (len_sq <> 0) then 'in case of 0 length line
      param = dot / len_sq
    end if
	
	if (param < 0) then 
		nearest_point.x = x1
		nearest_point.y = y1
	elseif (param > 1) then
		nearest_point.x = x2
		nearest_point.y = y2
	else
		nearest_point.x = x1 + param * C
		nearest_point.y = y1 + param * D
	end if
	
	'snapping to the edge of the segment
	if dist(x1, y1, x, y) < MIN_EDGE_SNAP_DIST / view_area.zoom then
		nearest_point.x = x1
		nearest_point.y = y1
		nearest_point.distance = dist (x1, y1,x, y)
	elseif dist(x2, y2, x, y) < MIN_EDGE_SNAP_DIST / view_area.zoom then
		nearest_point.x = x2
		nearest_point.y = y2
		nearest_point.distance = dist (x2, y2,x, y)
	'snapping along the segment
	else
		nearest_point.distance = dist (x, y,nearest_point.x, nearest_point.y)
	end if
	
	return nearest_point
	
	
	
end function



Any feedback is welcome
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: FB Low Poly Editor

Post by D.J.Peters »

After you create a triangle the midlevalue of the colors from the 3 points a,b,c looks to random for me.

I would scan and add all colors inside the triangle:

nColors = scan_triangle(image, a,b,c, all_colors)

final_color = all_colors / nColors

How ever good job so far.

Joshy
Pitto
Posts: 122
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Post by Pitto »

Hi Joshy,
thanks for the tip.
The color is actually picked from centroid of each polygon. But it could be a little random (i.e. an image with some noise), or outside the polygon surface (concave polygon).
I wish implement, in order to pick a middle color, a point on polygon algorithm (pretty similar to the scanline algorithm) and this little function I've wrote sometimes ago for this purpouse: viewtopic.php?f=7&t=25907
I've to optimize the whole program for speed.
Pitto
Posts: 122
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Post by Pitto »

Uploaded sources on Github
https://github.com/Pitto/Fb_Low_Poly_Editor

Image

SVG file of this image: http://www.pitto.cloud/img/butterfly.svg

Here's a summary of commands
CANC delete editing path
S - save as .lpe file (overwrites output.lpe file - see file structure from http://www.pitto.cloud/img/butterfly.lpe)
W - wireframe show/hide
B - bitmap show/hide
Q -points show/hide
E - Export as SVG (overwrites output.svg file)
SPACE - Pan
Mouse wheel - Zoom
Left Click - Add a point to the editing
Right Cligk - Close editing path
ESC - Quit (unsaved changes will be lost)

Todo:
Implement a lot of features :)

Any feedback is always welcome…
Pitto
Posts: 122
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Post by Pitto »

0.0.7 version available on github: https://github.com/Pitto/Fb_Low_Poly_Editor

Image

Video: https://youtu.be/C49d8YCqiig

New features:
fixed wrong color while saving in both SVG and .lpe files
V - Selection Tool
CANC - Delete selected polygons
S - Save .lpe file (`output.lpe`) <- warning, if file already exists will be overwritter
CTRL + L - load .lpe file
CTRL + R - Fill with random polygons

I'll update it with a on-screen help as soon as possible.
Pitto
Posts: 122
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Post by Pitto »

0.08 Version
https://github.com/Pitto/Fb_Low_Poly_Editor

Video of this version in action:
https://youtu.be/aNIl1qud9YY

Image

New features:
  • · Speed optimization
    · F1 - On screen Help
    · While closing any polygon, the polygon's color is the average rgb value of the whole polygon's area
Pitto
Posts: 122
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Post by Pitto »

Hi all,

I'm still working on this project, I've added some new features (ver. 0.10):
  • it's now possible to select single or multiple node, move or delete it.
Here's a video of this version in action:
https://youtu.be/3XbM6r8CgjQ
Post Reply