Add color picker and line dashes

This commit is contained in:
No Time To Play 2023-09-18 06:31:32 +00:00
parent 9c4f93bbd6
commit 174c5f163e
3 changed files with 49 additions and 15 deletions

View File

@ -1,5 +1,12 @@
# Genoa Banner Creator project news
## [1.0 beta] - 2023-09-18
### Added
* color picker
* line dashes
## [0.6 alpha] - 2023-09-16
### Added

View File

@ -6,7 +6,7 @@ Rationale: I make vector art by hand (see the Pocket Guide to Writing SVG, by Jo
## Availability
As of September 2023, Genoa is at a very early alpha stage: incomplete, poorly documented and probably buggy. Use at your own risk. System requirements:
As of mid-September 2023, Genoa is in beta. It proved stable so far, but could use more testing. Please back up your data. System requirements:
- to run from source, Tcl/Tk 8.6 with tklib
- screen resolution:

View File

@ -30,7 +30,7 @@ namespace import getstring::*
set window_title "Genoa Banner Creator"
set about_text "Tool to Generate Original Art\nv0.6 alpha (16 Sep 2023)"
set about_text "Tool to Generate Original Art\nv1.0 beta (18 Sep 2023)"
set credits_text "Made by No Time To Play\nMIT License"
set site_link "https://notimetoplay.org/graphics/genoa/"
@ -41,6 +41,7 @@ set drawing(fill) ""
set drawing(font) "Times"
set drawing(size) "10"
set drawing(width) 1
set drawing(dash) ""
set d_list {}
@ -80,7 +81,8 @@ proc line {x1 y1 x2 y2} {
lappend d_list [dict create type "line" \
coords [list $x1 $y1 $x2 $y2] \
x1 $x1 y1 $y1 x2 $x2 y2 $y2 \
-outline $drawing(color) -width $drawing(width)]
-outline $drawing(color) -width $drawing(width) \
-dash $drawing(dash)]
}
proc box {x y w h} {
@ -89,7 +91,7 @@ proc box {x y w h} {
coords [list $x $y [+ $x $w] [+ $y $h]] \
x $x y $y width $w height $h \
-outline $drawing(color) -width $drawing(width) \
-fill $drawing(fill)]
-fill $drawing(fill) -dash $drawing(dash)]
}
proc circle {cx cy r} {
@ -98,7 +100,7 @@ proc circle {cx cy r} {
lappend d_list [dict create type "oval" coords $coords \
cx $cx cy $cy rx $r ry $r \
-outline $drawing(color) -width $drawing(width) \
-fill $drawing(fill)]
-fill $drawing(fill) -dash $drawing(dash)]
}
proc oval {cx cy rx ry} {
@ -107,7 +109,7 @@ proc oval {cx cy rx ry} {
lappend d_list [dict create type oval coords $coords \
cx $cx cy $cy rx $rx ry $ry \
-outline $drawing(color) -width $drawing(width) \
-fill $drawing(fill)]
-fill $drawing(fill) -dash $drawing(dash)]
}
proc make_text {x y t} {
@ -122,7 +124,7 @@ proc polygon args {
global d_list drawing
lappend d_list [dict create type "polygon" coords $args \
-outline $drawing(color) -width $drawing(width) \
-fill $drawing(fill)]
-fill $drawing(fill) -dash $drawing(dash)]
}
proc color c {
@ -150,6 +152,11 @@ proc size s {
set drawing(size) $s
}
proc dash args {
global drawing
set drawing(dash) $args
}
proc viewport {x y w h} {
global meta overlay
set meta(viewBox) "$x $y $w $h"
@ -167,6 +174,7 @@ runner alias polygon polygon
runner alias color color
runner alias fill fill
runner alias width width
runner alias dash dash
runner alias font set_font
runner alias size size
runner alias viewport viewport
@ -419,6 +427,8 @@ $m add command -label "Smaller font" -under 0 -accel "Ctrl -" \
$m add command -label "Reset font" -under 0 -accel "Ctrl-0" \
-command {font_size reset $editor}
$m add separator
$m add command -label "Color picker" -command pick_color \
-underline 9 -accelerator "Ctrl-K"
if {[llength [info commands "console"]] > 0} {
$m add command -label "Console" -command {console show} \
-underline 5 -accelerator "Ctrl-L"
@ -731,6 +741,7 @@ proc reset_drawing {} {
set drawing(font) "Times"
set drawing(size) "10"
set drawing(width) 1
set drawing(dash) ""
}
proc do_render {} {
@ -773,18 +784,24 @@ proc shape2canvas {shape canvas} {
switch [dict get $shape type] {
"line" {
set width [int [dict get $shape -width]]
$canvas create line $coords -width $width \
set dash [lmap i [dict get $shape -dash] {int $i}]
$canvas create line $coords \
-width $width -dash $dash \
-fill [dict get $shape -outline]
}
"box" {
set width [int [dict get $shape -width]]
$canvas create rectangle $coords -width $width \
set dash [lmap i [dict get $shape -dash] {int $i}]
$canvas create rectangle $coords \
-width $width -dash $dash \
-outline [dict get $shape -outline] \
-fill [dict get $shape -fill]
}
"oval" {
set width [int [dict get $shape -width]]
$canvas create oval $coords -width $width \
set dash [lmap i [dict get $shape -dash] {int $i}]
$canvas create oval $coords \
-width $width -dash $dash \
-outline [dict get $shape -outline] \
-fill [dict get $shape -fill]
}
@ -796,7 +813,9 @@ proc shape2canvas {shape canvas} {
}
"polygon" {
set width [int [dict get $shape -width]]
$canvas create polygon $coords -width $width \
set dash [lmap i [dict get $shape -dash] {int $i}]
$canvas create polygon $coords \
-width $width -dash $dash \
-outline [dict get $shape -outline] \
-fill [dict get $shape -fill]
}
@ -856,21 +875,21 @@ proc shape2svg shape {
"line" {
set stroke [dict get $shape -outline]
if {$stroke == ""} { set stroke "transparent" }
return "<line x1='[dict get $shape x1]' y1='[dict get $shape y1]' x2='[dict get $shape x2]' y2='[dict get $shape y2]' stroke='$stroke' stroke-width='[dict get $shape -width]'/>"
return "<line x1='[dict get $shape x1]' y1='[dict get $shape y1]' x2='[dict get $shape x2]' y2='[dict get $shape y2]' stroke='$stroke' stroke-width='[dict get $shape -width]' stroke-dasharray='[dict get $shape -dash]'/>"
}
"box" {
set fill [dict get $shape -fill]
if {$fill == ""} { set fill "transparent" }
set stroke [dict get $shape -outline]
if {$stroke == ""} { set stroke "transparent" }
return "<rect x='[dict get $shape x]' y='[dict get $shape y]' width='[dict get $shape width]' height='[dict get $shape height]' fill='$fill' stroke='[dict get $shape -outline]' stroke-width='[dict get $shape -width]'/>"
return "<rect x='[dict get $shape x]' y='[dict get $shape y]' width='[dict get $shape width]' height='[dict get $shape height]' fill='$fill' stroke='[dict get $shape -outline]' stroke-width='[dict get $shape -width]' stroke-dasharray='[dict get $shape -dash]'/>"
}
"oval" {
set fill [dict get $shape -fill]
if {$fill == ""} { set fill "transparent" }
set stroke [dict get $shape -outline]
if {$stroke == ""} { set stroke "transparent" }
return "<ellipse cx='[dict get $shape cx]' cy='[dict get $shape cy]' rx='[dict get $shape rx]' ry='[dict get $shape ry]' fill='$fill' stroke='$stroke' stroke-width='[dict get $shape -width]'/>"
return "<ellipse cx='[dict get $shape cx]' cy='[dict get $shape cy]' rx='[dict get $shape rx]' ry='[dict get $shape ry]' fill='$fill' stroke='$stroke' stroke-width='[dict get $shape -width]' stroke-dasharray='[dict get $shape -dash]'/>"
}
"text" {
set fill [dict get $shape -fill]
@ -883,7 +902,7 @@ proc shape2svg shape {
if {$fill == ""} { set fill "transparent" }
set stroke [dict get $shape -outline]
if {$stroke == ""} { set stroke "transparent" }
return "<polygon points='[dict get $shape coords]' fill='$fill' stroke='[dict get $shape -outline]' stroke-width='[dict get $shape -width]'/>"
return "<polygon points='[dict get $shape coords]' fill='$fill' stroke='[dict get $shape -outline]' stroke-width='[dict get $shape -width]' stroke-dasharray='[dict get $shape -dash]'/>"
}
default { error "Unknown shape." }
}
@ -902,6 +921,14 @@ proc toggle_lines widget {
}
}
proc pick_color {} {
global window_title drawing editor
set choice [tk_chooseColor -parent . \
-title $window_title \
-initialcolor $drawing(color)]
$editor insert "insert" \"$choice\"
}
proc alert message {
global window_title
tk_messageBox -parent . \