2023 Nov 4
Code: Select all
'' can view multiple files at once, but only .bmp
#define file1 ".bmp"
#define file2 ".bmp"
#define file3 ".bmp"
'' you may also want to change this
#define file_dir "photos/"
/' - rave palette maker - 2023 Nov 4 - by dafhi
evolved from an initial idea to hard-code 'universal' palette
new: improved palette element selection logic
hue align (H key)
'/
'#include "ravepal_backend.bas"
/' - ravepal backend - 2023 Oct 30 - by dafhi
'/
'#include "../ui_elements.bas"
' -------- ui_elements.bas - 2023 Oct 27 - by dafhi
'
'#include once "util.bas"
' -- util.bas - 2023 Oct 30 - by dafhi
'
'#include "boilerplate.bas"
/' -- boilerplate.bas - 2023 Oct 25 - by dafhi
+ ------------------------ +
| freebasic | c++ |
+ ----------- + ---------- +
| true = -1 | true = 1 |
| 0.99 = 1 | 0.99 = 0 | .. i hope that covers it
+------------- ----------- +
'/
'' replaces int (and faster) - http://www.freebasic.net/forum/viewtopic.php?p=118633
#define flo(x) (((x)*2.0-0.5)shr 1)
' gcc make it obsolete w/ speed options mentioned by UEZ and DeltaRho
' -arch native -Wc -Ofast,-mfpmath=sse,-funroll-loops
#define sng as single
#define dbl as double
#define decl declare
#define oper operator
#define prop property
function min( a as double, b as double ) as double
return iif( a < b, a, b)
end function
function max( a as double, b as double ) as double
return iif( a > b, a, b)
end function
function clamp( in dbl, hi dbl = 1, lo dbl = 0) dbl
return min( max(in, lo), hi ) '' June 12
End Function
function bclamp( i sng ) as ubyte '' Feb 23
return min( max( i, 0), 255 )
End Function
function round( i sng, places as byte = 0) as string '' dafhi 2023 Oct 31
dim as long pow10 = 10^(places+0)
dim as string s = str( int(i*pow10+.5)/pow10 )
for i as long = 0 to len(s)-1
if s[ i ] = 46 then return left(s,i+places+1)
next
return s
end function
#macro sw( a, b, tmp )
tmp = a: a = b: b = tmp
#endmacro
function triwave( i sng ) sng
return abs( i - flo(i) - .5 ) - .25 '' by Stonemonkey
end function
function _cchsv(h sng, s sng, v sng) as ubyte
var wave_hgt = s * v
var elevate = v - wave_hgt
return 255 * (wave_hgt * clamp(triwave(h)*6 + .5) + elevate) '' 2023 Oct 25
' return 255.499 *
end function
function hsv( h sng=0, s sng=1, v sng=1 ) as ulong
return rgb( _
_cchsv( h + 0/3, s,v ), _
_cchsv( h + 2/3, s,v ), _
_cchsv( h + 1/3, s,v ) )
end function
type imagevars '2022 Mar 15 - by dafhi
'1. quick reference for ScreenInfo & ImageInfo
'2. encapsulate standard metrics
'3. convenient additional vars, subs and functions
as long w,h, bpp,bypp,pitch, rate
as string driver_name
as any ptr im
as any ptr pixels 'same address
as ulong ptr p32 '
as single wh,hh, diagonal
as integer pitchBy, wm = -1, hm = -1, u = -1, is_screen
declare sub create(w as integer=0, h as integer=0, col as ulong=&HFF000000)
declare sub bmp_load( ByRef filename As String )
'2017 Aug 17
declare sub get_info(im as any ptr=0)
declare destructor
private:
declare sub _release
as any ptr hRelease
declare sub _specialized
end type
Destructor.imagevars: _release
End Destructor
sub imagevars._release '2016 Aug 30
w=0: h=0: bpp=0: bypp=0: im=0: pixels=0
If ImageInfo(hRelease) = 0 Then ImageDestroy hRelease: hRelease = 0
End Sub
sub imagevars._specialized
wm = w - 1: wh = w/2
hm = h - 1: hh = h/2
pitchBy = pitch \ bypp: u = h*pitchBy - 1
p32 = pixels: diagonal = sqr(w*w + h*h)
End Sub
sub imagevars.get_info(im as any ptr)
if im=0 then
ScreenInfo w,h, bpp, bypp, pitch, rate, driver_name: pixels=screenptr
is_screen = -1: im=0
elseif Imageinfo(im)=0 then
ImageInfo im, w, h, bypp, pitch, pixels: bpp = bypp * 8
this.im = im: is_screen = 0
endif: hRelease = im: p32=pixels
wm=w-1: wh=w/2: pitchBy=pitch/bypp '' crashes if \ and bypp = 0
hm=h-1: hh=h/2: u = h*pitchBy - 1
end sub
sub imagevars.create(_w as integer, _h as integer, col as ulong)
if _w<1 or _h<1 then exit sub '2017 sep 1
release: get_info imagecreate(_w,_h,col)
End Sub
sub imagevars.bmp_load( ByRef filename As String ) 'modified fb example
Dim As integer filenum = FreeFile()', w,h '2017 Sep 28 .. long to integer
for i as integer = 1 to 2
If Open( filename For Binary Access Read As #filenum ) = 0 Then
dim as ushort w,h
Get #filenum, 19, w
Get #filenum, 23, h
create w, abs(h)
bload filename, im: close #filenum: exit for
endif
Close #filenum
filename = exepath & "\" & filename
next
End sub
Union UARGB
declare operator let( as ulong )
declare operator cast as ulong
declare operator cast as string
As Ulong col
As Ulong argb
Type: As UByte B,G,R,A
End Type
End Union
operator UARGB.cast as ulong
return rgb(r,g,b)
end operator
operator UARGB.let( in as ulong )
b = in
g = in shr 8
r = in shr 16
end operator
operator uARGB.cast as string
return str(r) + " " + str(g) + " " + str(b)
end operator
function qdr(a as any ptr, b as any ptr) as longint
dim as uargb ptr uara = a, uarb = b
const pow = 2
dim as longint dr = abs(uara->r - uarb->r)
dim as longint dg = abs(uara->g - uarb->g)
dim as longint db = abs(uara->b - uarb->b)
return _
(dr * 1) ^ pow +_
(dg * (1 + .10)) ^ pow +_
(db * (1 - .10)) ^ pow
End Function
' --- floyd steinberg dithering - 2023 Sep 19 - by dafhi
'
' Input: truecolor image metrics and target color (per pixel)
' output: truecolor quantized and dithered
' ---------------------
type tFloydSteinberg
as long wm,hm,pitch
as ubyte ptr r0,g0,b0
as long offa,offb,offc,offd
declare sub metrics(w as long, h as long, pitch as long, pixels as ubyte ptr)
declare sub drop_it(x as long, y as long, newcol as ulong)
private:
declare sub n(off as long, amount as long)
as long re,ge,be, r,g,b, cen
End Type
sub tFloydSteinberg.metrics(w as long, h as long, _pitch as long, pixels as ubyte ptr)
wm=w-1: hm=h-1: pitch=_pitch
b0=pixels: g0=pixels+1: r0=pixels+2
offa=4: offb=pitch+4: offc=pitch: offd=pitch-4
End Sub
sub tFloydSteinberg.n(off as long, amount as long)
r=r0[off] + (re*amount)shr 4: r0[off] = bclamp(r)
g=g0[off] + (ge*amount)shr 4: g0[off] = bclamp(g)
b=b0[off] + (be*amount)shr 4: b0[off] = bclamp(b)
End Sub
sub tFloydSteinberg.drop_it(x as long, y as long, newcol as ulong)
r=(newcol shr 16)and 255
g=(newcol shr 8)and 255
b= newcol and 255
cen=x*4 + y*pitch
re=r0[cen]-r: r0[cen]=r
ge=g0[cen]-g: g0[cen]=g
be=b0[cen]-b: b0[cen]=b
if x<wm then n offa+cen, 7 '' 2023 Sept 19
if y<hm then ''
n offb+cen, 1 ''
n offc+cen, 5
if x>0 then n offd+cen, 3
EndIf
End Sub
type thsv '' floating point members for ravepal project
as short h '' old: short
as byte s,v '' old: byte (not ubyte)
decl oper let( as ulong )
decl oper cast as ulong
decl oper cast as string
' decl prop dlt( as thsv ) sng
End type
oper thsv.cast as ulong
return hsv ( h /1530, s/255, v/255 )
end oper
oper thsv.cast as string
return "hsv "+round(h,1)+" "+round(s,1)+" "+round(v,1)
end oper
oper thsv.let( col as ulong )
static as ubyte ptr lo, mi, hi, tmp
static as uargb uar
uar = col
lo = @uar.r
mi = @uar.g
hi = @uar.b
if *lo > *hi then sw( lo, hi, tmp )
if *lo > *mi then sw( lo, mi, tmp )
if *mi > *hi then sw( mi, hi, tmp )
this.v = *hi
this.s = iif( *hi=0, 0, 255*((*hi-*lo)/*hi) )
if (*hi = uar.g) then
this.h = 510 + 255 * (uar.b - uar.r) / (*hi-*lo)
elseif *hi = uar.b then
this.h = 1020 + 255 * (uar.r - uar.g) / (*hi-*lo)
else
if uar.g>uar.b then
this.h = 0 + 255 * (uar.g - uar.b) / (*hi-*lo)
else
this.h = 1265 + 255 * (uar.r - uar.b) / (*hi-*lo)
endif
endif
end oper
'prop thsv.dlt( in as thsv ) sng
' return (in.h-h)^2+(in.s-s)^2+(in.v-v)^2
'end prop
union uptrs
as any ptr a
as ubyte ptr b
as ushort ptr sho
as ulong ptr ul
as ulongint ptr uli
As Single Ptr s
as double ptr d
End Union
' -------- boilerplate.bas
' ----- util.bas
namespace ui_elements
type rect
declare constructor
declare constructor( as short = 0, as short = 0, as short = 0, as short = 0 )
declare operator cast as string
as short x,y, w,h
declare function n( as short, as short ) as boolean
end type
constructor rect
end constructor
constructor rect( _x as short, _y as short, _w as short, _h as short )
x=_x: w=_w
y=_y: h=_h
end constructor
operator rect.cast as string
return "xy " + str(x) + " " + str(y) + " wh " + str(w) + " " + str(h)
end operator
function rect.n( a as short, b as short ) as boolean
return a>=x and b>=y and a<(x+w) and b<(y+h)
end function
type multi_rect
declare function which_elem( as short, as short ) as long
as rect rc(any)
end type
function multi_rect.which_elem( _x as short, _y as short ) as long
for i as long = 0 to ubound(rc)
if rc(i).n(_x, _y) then return i
next
return -1
end function
type rect_grid extends multi_rect
declare function which_elem overload ( as short, as short ) as long
declare property c as long
as short x, cols
as short y, rows
as short btn_w, btn_h, spacing
end type
property rect_grid.c as long
return cols * rows
end property
function rect_grid.which_elem( _x as short, _y as short ) as long
static as rect rc
for iy as long = 0 to (rows-1)
dim as long y0 = y + iy*spacing
for ix as long = 0 to (cols-1)
dim as long x0 = x + ix*spacing'
if type<rect>(x0,y0,btn_w,btn_h).n(_x, _y) then _
return iy*cols + ix
next
next
return -1
end function
sub xy_cols_rows( byref g as rect_grid, _
x as short = 10, y as short = 10, _
cols as short = 2, rows as short = 1)
g.x= x: g.cols = cols
g.y= y: g.rows = rows
end sub
sub btnsize_and_spacing( byref g as rect_grid, _
btn_w as short, btn_h as short, spacing as short )
g.btn_w = btn_w
g.btn_h = btn_h
g.spacing = spacing
end sub
end namespace
' -------- ui_elements.bas
' ---------- ravepal_backend.bas
dim shared as string pal_file: pal_file = "mypal.txt"
namespace gp_pal
enum edit_mode
all_images
single_img_variant
end enum
const btn_wh = 40
dim as long mode=1, help_shown
dim dbl help_timer, tp
sub help_screen
if help_timer <= 0 then exit sub
locate 2
if mode then
? " (help text will stay on for a while. toggle at any time with F1"
?
?
? "pick fave or press 'd' until you find something decent"
?
? "pressing 'c' will randomize less."
?
? "shift-S saves mypal.txt"
?
? "M switches mode"
else
? " click palette elements for range"
?
? " keys"
?
? "Left Right - Hue"
? "Up Down (shift) - Val (sat)"
?
? "H - hue align"
?
? "1, 2 - edit endpoint"
?
? "V - to mem"
? "R - restore"
?
? " other keys"
? "Z X - pal size"
?
? "W - swap endpoints "
?
? " acknowledgement: floyd-steinberg dithering"
endif
var dt = timer - tp: tp = timer
help_timer -= dt
end sub
sub show_help
help_timer = iif( help_timer > 0, 0, 1 )
help_timer *= iif( mode, 45, 35 )
tp = timer
help_screen
end sub
dim as imagevars buf
dim as ulong _pal(255)
dim as byte i_group
function f_palsize as long
return 2 shl i_group
end function
sub to_file( filename as string )
var f = freefile
open filename for output as f
for j as long = 0 to f_palsize - 1
dim as string q
for i as long = 5 to 0 step -1
q += hex( (_pal(j) shr i*4)and 15)
next
put #f,,q
put #f,, chr(10)
next
close f
end sub
dim as ubyte group_size(7) = {2,2,4,8,16,32,64,128}
dim as ubyte group_start(ubound(group_size))
dim as string str_pal_size
dim as string str_value
type hsv_segment
as thsv c,c1
declare property blank as boolean
end type
property hsv_segment.blank as boolean
return c.v = 0 and c1.v = 0
end property
dim as hsv_segment fave(2), mem_hsv', avg(1)
type tPicGroup extends ui_elements.multi_rect
declare sub set_rects
as imagevars im(any)
end type
sub tPicGroup.set_rects
dim as long i_im_src, i_src_inc
if mode = single_img_variant then
redim rc(ubound(fave))
else
redim rc(ubound(im))
i_src_inc = 1
endif
rc(0) = type( 1,1,im(0).w, im(0).h )
dim as long x=rc(0).x
dim as long y=rc(0).y
for i as long = 1 to ubound(rc)
if rc(i-1).h > rc(i-1).w orelse y + im(i-1).h >= buf.h then
x += rc(i-1).w+1
y = 1
else
y += rc(i-1).h+1
endif
i_im_src += i_src_inc
rc(i) = type( x, y, im(i_im_src).w, im(i_im_src).h )
next
end sub
dim as tPicGroup pic_group
sub add_bmp( file as string )
var u = ubound( pic_group.im) + 1
redim preserve pic_group.im( u )
pic_group.im(u).bmp_load file_dir + file
end sub
dim sng hsv_h(255)
dim sng hsv_s(255)
dim sng hsv_v(255)
sub grad_vsh( v0 sng = 1, s0 sng = 1, h0 sng = 0, _
_c as long = -1, v1 sng = 1, s1 sng = 1, h1 sng = 0, _
h1_abs as boolean = false, _i as long = -1, leap_frog as long = 1 )
static as long i: i = iif( _i < 0, i, _i )
static as long c = 1: c = iif( _c < 0, c, _c )
v0 /= 32
s0 /= 32
h0 /= 72
v1 /= 32
s1 /= 32
h1 /= 72
dim sng inverse = 1 / max(c-1,1)
s1 = (s1-s0)* inverse
v1 = (v1-v0)* inverse
h1 = iif( h1_abs, (h1-h0)* inverse, h1 )
for j as long = 0 to c - 1
hsv_s( j*leap_frog+i ) = s0 + j * s1
hsv_v( j*leap_frog+i ) = v0 + j * v1
hsv_h( j*leap_frog+i ) = h0 + j * h1
next
i += c
end sub
dim as long pos_a = 1
dim as long pos_b = 3
dim as long c
sub calc_selrange_size
c = pos_b + 1 - pos_a
end sub
sub pal_update( q as hsv_segment )
dim sng h = (q.c.h + 0), h1 = (q.c1.h + 0)
dim sng s = (q.c.s + 0), s1 = (q.c1.s + 0)
dim sng v = (q.c.v + 0), v1 = (q.c1.v + 0)
calc_selrange_size
var h1_abs = true
grad_vsh v,s,h, c, v1,s1, h1, h1_abs, pos_a
for i as long = pos_a to pos_b
_pal(i) = hsv( hsv_h(i), hsv_s(i), hsv_v(i) )
next
end sub
dim as ui_elements.rect_grid pal_btns
sub btn_gfx( rc as ui_elements.rect, col as long = &HFF, out_col as long = &HFF0000 )
dim as long border = 1
if border then _
line (rc.x,rc.y)-(rc.x+rc.w-2,rc.y+rc.h-2), out_col, b
line (rc.x+border,rc.y+border) - _
(rc.x+rc.w-0-border, rc.y+rc.h-0-border), col, bf
end sub
function in_selection( i as long, a as long, b as long ) as boolean
return (i >= min(a,b)) and (i <= max(a,b))
end function
sub _draw_palette
static as ui_elements.rect rc
if mode then exit sub
rc = type(0,0, pal_btns.btn_w, pal_btns.btn_w )
for y as long = 0 to pal_btns.rows-1
rc.y = pal_btns.y + y*pal_btns.spacing
for x as long = 0 to pal_btns.cols-1
rc.x = pal_btns.x + x * pal_btns.spacing
dim as long i = min( ubound(_pal), y*pal_btns.cols + x )
dim as ulong col_outline = _
iif( in_selection(i, pos_a, pos_b), _
rgb(255,255,255), rgb(30,30,30) )
btn_gfx rc, _pal(i), col_outline
next
next
end sub
dim as long img_selected
dim as tFloydSteinberg fs
const u_rc_mode_1 = 1
sub show
pic_group.set_rects
dim as long upal = f_palsize-1
dim as uptrs upr
for i_rc as long = 0 to iif(mode,u_rc_mode_1,ubound(pic_group.rc))
var rc = pic_group.rc(i_rc)
if mode and (i_rc > u_rc_mode_1) then
rc.w = 0
rc.h = 0
endif
var i_im = iif( mode, 0, i_rc )
var i_fave = iif( mode, i_rc, 0 )
pal_update fave( i_fave )
put (rc.x, rc.y), pic_group.im(i_im).im, pset
var wm = min( rc.x + rc.w-1, fs.wm)
for y as long = rc.y to min( rc.y + rc.h-1, fs.hm)
upr.a = fs.b0 + y*fs.pitch
for x as long = rc.x to wm
var i = 0
var s = qdr( @_pal(i), @upr.ul[x] )
for j as long = 1 to upal
var d = qdr( @_pal(j), @upr.ul[x] )
if d<s then s=d: i=j
Next
fs.drop_it(x,y, _pal(i))
' pset (x,y), 1-upr.ul[x]
next
next
next
if mode then
else
_draw_palette
endif
help_screen
screenlock
screenunlock
end sub
dim sng f0
const f0_start = .65
sub curve_reset
f0 = 0
end sub
sub decay_curve_progress
f0 += .16
end sub
function decay_curve sng
f0 = iif( f0 < f0_start, f0_start, f0)
static sng ret: ret = f0
return .8 + 1 / ret
end function
const vs_max = 32
sub arrays_to_thsv( byref des as thsv, i_pal as long)
des.h = hsv_h(i_pal) * 72
des.s = hsv_s(i_pal) * vs_max
des.v = hsv_v(i_pal) * vs_max
end sub
sub copy_and_tweak( byref des as hsv_segment, src as hsv_segment, _
scalar sng = 1 )
scalar *= decay_curve
var h = 16 * scalar
var vs = 4.5 * scalar
des.c.h = h*(rnd-.5)+src.c.h: des.c1.h = h*(rnd-.5)+src.c1.h
des.c.s = src.c.s + vs * (rnd - .5): des.c1.s = src.c1.s + vs * (rnd - .5)
des.c.v = src.c.v + vs * (rnd - .5): des.c1.v = src.c1.v + vs * (rnd - .5)
end sub
sub mutate( byref qq as hsv_segment )
const b = 1
qq.c.v = b+rnd*(vs_max-2*b): qq.c1.v = b+rnd*(vs_max-2*b)
qq.c.s = b+rnd*(vs_max-2*b): qq.c1.s = b+rnd*(vs_max-2*b)
qq.c.h = rnd*72: qq.c1.h = rnd*72
curve_reset
' with fave(ubound(fave)-1)
' .c.v = 0
' .c1.v = 0
' end with
end sub
sub tweak_all( src as hsv_segment )
for i as long = 0 to ubound(fave)
copy_and_tweak fave(i), src
next
end sub
sub mode_based_housekeeping
if mode then
ui_elements.btnsize_and_spacing pal_btns, 0,0,0
mem_hsv = fave(0)
tweak_all mem_hsv
else
ui_elements.btnsize_and_spacing pal_btns, btn_wh, btn_wh, btn_wh
fave(0) = mem_hsv
img_selected = 0
endif
end sub
sub mode_change
mode = 1 - mode
mode_based_housekeeping
cls
show
end sub
dim as thsv ptr uhs
function str_pal_elem as string
return " hsv " +_
round(uhs->h)+"/72 " +_
round(uhs->s)+"/"+round(vs_max) +" "+_
round(uhs->v)+"/"+round(vs_max)
end function
dim as long _i_endpoint
sub sel_segpoint_0or1( i as long )
i = iif(i, 1, 0)
_i_endpoint = i
calc_selrange_size
arrays_to_thsv mem_hsv.c, pos_a
arrays_to_thsv mem_hsv.c1, pos_b
uhs = iif(i, @mem_hsv.c1, @mem_hsv.c)
windowtitle "endpoint "+str(i) + str_pal_elem
end sub
sub _keep_hsv_minlier( i_fave as long )
/'
uses 2 (of h s v) biggest-change components
from new set
'/
mem_hsv = fave(i_fave)
if f0 <= f0_start then exit sub
static as thsv ptr a: a = @mem_hsv.c
static as thsv ptr b: b = @fave(i_fave).c
static as thsv ptr c: c = @mem_hsv.c1
static as thsv ptr d: d = @fave(i_fave).c1
static sng dh, ds, dv
dh = (abs(a->h - b->h) + abs(c->h - d->h)) / 72
ds = (abs(a->s - b->s) + abs(c->s - d->s)) / vs_max
dv = (abs(a->v - b->v) + abs(c->v - d->v)) / vs_max
dim as long i_component
dim sng dlt_min
if dh < ds then
dlt_min = dh
else
dlt_min = ds: i_component = 1
endif
if dlt_min > dv then i_component = 2
if i_component = 0 then
a->s = b->s: c->s = d->s
a->v = b->v: c->v = d->v
elseif i_component = 1 then
a->h = b->h: c->h = d->h
a->v = b->v: c->v = d->v
else
a->h = b->h: c->h = d->h
a->s = b->s: c->s = d->s
endif
end sub
function _handle_pal_click( x as long, y as long ) as long
var pal_elem_tmp = pal_btns.which_elem( x, y )
if pal_elem_tmp >= 0 then
if pal_elem_tmp < pos_a then
pos_a = pal_elem_tmp
sel_segpoint_0or1 0
elseif pal_elem_tmp > pos_b then
pos_b = pal_elem_tmp
sel_segpoint_0or1 1
elseif pal_elem_tmp = pos_a then
pos_a += -(pos_a < (f_palsize-1)) '' freebasic true = -1
elseif pal_elem_tmp = pos_b then
pos_b -= -(pos_b > group_start(i_group))
elseif abs(pal_elem_tmp - pos_a) < abs(pal_elem_tmp - pos_b) then
pos_a = pal_elem_tmp
sel_segpoint_0or1 0
else
pos_b = pal_elem_tmp
sel_segpoint_0or1 1
endif
if pos_a = pos_b then sel_segpoint_0or1 0
arrays_to_thsv mem_hsv.c, pos_a
arrays_to_thsv mem_hsv.c1, pos_b
_draw_palette
endif
return pal_elem_tmp >= 0
end function
sub handle_click( x as long, y as long )
if _handle_pal_click( x, y ) then exit sub
img_selected = pic_group.which_elem( x, y )
if img_selected >= 0 then
if mode then
_keep_hsv_minlier img_selected
tweak_all mem_hsv
else
_keep_hsv_minlier 0
windowtitle "pos "+str(pos_a)+" to "+str(pos_b)+" recorded"
endif
show
decay_curve_progress
endif
end sub
sub adjust_vsh( amt as long, modkey as boolean = false, is_hue as boolean = false )
dim as hsv_segment ptr e = @fave(0)
calc_selrange_size '' also calcs pos_a, pos_b
if (pos_a = pos_b) or (_i_endpoint = 0) then
uhs = @e->c
else
uhs = @e->c1
endif
arrays_to_thsv e->c1, pos_b
arrays_to_thsv e->c, pos_a
if is_hue then
if modkey then
e->c.h += amt
e->c1.h += amt
else
uhs->h += amt
endif
else
if modkey then
uhs->s += amt
else
uhs->v += amt
endif
endif
show
windowtitle str_pal_elem
end sub
sub hue_align
if _i_endpoint then '' pos_b
fave(0).c1.h = fave(0).c.h + (c-1)*72/c
else
fave(0).c.h = fave(0).c1.h - (c-1)*72/c
endif
show
end sub
sub depth_change( amt as long, force as long = false )
dim as long leave = iif( force, 0, mode )
if amt < 0 and i_group = 0 orelse _
amt > 0 and i_group = 5 or leave then exit sub
i_group += amt
var columns = min( f_palsize, 8 )
ui_elements.xy_cols_rows pal_btns, 350, 5, columns, f_palsize\columns
ui_elements.btnsize_and_spacing pal_btns, btn_wh, btn_wh, btn_wh
var pos_b_temp = group_start(i_group) + group_size(i_group) - 1
if pos_b_temp < pos_b then pos_b = pos_b_temp
show
str_pal_size = "pal size " + str( f_palsize )
windowtitle str_pal_size
end sub
sub _initialize
group_start(0) = 0
for i as long = 1 to ubound(group_size)
group_start(i) = group_start(i-1) + group_size(i-1)
next
mutate mem_hsv
mutate fave(0)
mode_based_housekeeping
var force = true
for i as long = 1 to iif(1, 1, ubound(group_size)-0)
depth_change 1, force
next
end sub
end namespace
#include "fbgfx.bi" '' key codes
randomize
sub Main
screenres 1100,800, 32
using gp_pal
buf.get_info
fs.metrics buf.w, buf.h, buf.pitch, buf.pixels
add_bmp file1
add_bmp file2
add_bmp file3
#if 1
locate 2,2
? "F1 for help"
sleep 1100
#endif
_initialize
#define extchar chr(255) '' L Shift, Alt, etc.
Dim e As fb.EVENT
Dim As Long x, y, buttons, res
const is_hue = true
do
res = GetMouse (x, y, , buttons)
var ctrl_or_shift = _
multikey(fb.sc_lshift) or multikey(fb.sc_control) or _
multikey(fb.sc_alt) or multikey(fb.sc_rshift)
If (ScreenEvent(@e)) Then
Select Case e.Type
case fb.EVENT_KEY_PRESS, fb.EVENT_KEY_REPEAT
select case e.scancode
case fb.SC_ESCAPE
if help_timer <= 0 then exit do
help_timer = 0
show
case fb.SC_F1
show_help
show
case fb.SC_Z
depth_change -1
case fb.SC_X
depth_change 1
case fb.SC_W
swap fave(0).c, fave(0).c1
show
case fb.SC_D
for i as long = 0 to ubound(fave)
mutate fave(i)
next
windowtitle ""
show
case fb.SC_C
for i as long = 0 to ubound(fave)
copy_and_tweak fave(i), mem_hsv
next
show
case fb.SC_H
hue_align
case fb.SC_V
mem_hsv = fave(0)
windowtitle "pos "+str(pos_a)+" to "+str(pos_b)+" recorded"
case fb.SC_R, fb.SC_B
fave(0) = mem_hsv
img_selected = 0
show
case fb.SC_M
mode_change
if help_shown then help_timer = 0
help_shown = true
case fb.SC_1
sel_segpoint_0or1 0
case fb.SC_2
sel_segpoint_0or1 1
case fb.SC_S
if ctrl_or_shift then
pal_update mem_hsv
to_file pal_file
locate 2,2
? " file saved"
?
? exepath + pal_file
endif
case fb.SC_LEFT
adjust_vsh -1, ctrl_or_shift, is_hue
case fb.SC_RIGHT
adjust_vsh 1, ctrl_or_shift, is_hue
case fb.SC_UP
adjust_vsh 1, ctrl_or_shift
case fb.SC_DOWN
adjust_vsh -1, ctrl_or_shift
end select '' e.scancode
' Case fb.EVENT_MOUSE_MOVE
' x = e.x
' y = e.y
Case fb.EVENT_MOUSE_BUTTON_PRESS
' If (e.button = fb.BUTTON_LEFT) Then
handle_click x, y
' endif
end select
endif ' screenevent
sleep 15
loop
end sub
Main