FB Low Poly Editor

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

FB Low Poly Editor

Postby Pitto » Nov 01, 2017 23:11

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: 7659
Joined: May 28, 2005 3:28

Re: FB Low Poly Editor

Postby D.J.Peters » Nov 02, 2017 5:03

nice idea.

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

Re: FB Low Poly Editor

Postby Pitto » Nov 03, 2017 23:20

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: 107
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Postby Pitto » Nov 11, 2017 22:16

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: 7659
Joined: May 28, 2005 3:28

Re: FB Low Poly Editor

Postby D.J.Peters » Nov 12, 2017 7:53

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: 107
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Postby Pitto » Nov 12, 2017 9:44

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: 107
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Postby Pitto » Nov 20, 2017 21:34

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: 107
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Postby Pitto » Dec 02, 2017 17:43

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: 107
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Postby Pitto » Dec 09, 2017 15:11

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: 107
Joined: Nov 19, 2012 19:58

Re: FB Low Poly Editor

Postby Pitto » Oct 05, 2018 15:47

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

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 2 guests