Flag generator.

This commit is contained in:
Feufochmar 2020-05-01 19:24:31 +02:00
parent 7b441bfe44
commit 9f97e7b571
8 changed files with 1637 additions and 1 deletions

View File

@ -14,7 +14,8 @@
"src/pages/other-generators.rkt"
"src/pages/arnytron.rkt"
"src/pages/floraverse.rkt"
"src/pages/yggdrasil.rkt")
"src/pages/yggdrasil.rkt"
"src/pages/flag.rkt")
; Website
(define *website*
(website
@ -41,6 +42,11 @@
("About" weblet pages:yggdrasil-about)
("Raw" weblet pages:yggdrasil-raw-image)
)
; Flag generator
("FlagGenerator" weblet pages:flag
("About" weblet pages:flag-about)
("RawFlag" weblet pages:flag-raw)
)
; Other generators
("Generators" weblet pages:other-generators
("ColorScheme" weblet pages:color-scheme-generator)
@ -70,6 +76,9 @@
("Yggdrasil" "/Yggdrasil" #t
("About the Yggdrasil generator" "/Yggdrasil/About" #f)
)
("Flag Generator" "/FlagGenerator" #f
("About the flag generator" "/FlagGenerator/About" #f)
)
("Miscellaneous Generators" "/Generators" #f
("Color Scheme" "/Generators/ColorScheme" #f)
("Pictogrammic Adventurer" "/Generators/PictogrammicAdventurer" #t)

54
src/generators/flag.rkt Normal file
View File

@ -0,0 +1,54 @@
#lang racket/base
; A flag generator
(require
"flag/division.rkt"
"flag/palette.rkt"
"../graphics/vectorial.rkt"
"../graphics/color.rkt"
"../base-generation/random.rkt")
(provide
flag-generate)
; Colors used in flags
; Metals / Light colors
(define metal-colors
(list
(hsl-color 0 0 95) ;; Argent <=> White
(hsl-color 50 95 55) ;; Or <=> Yellow
(hsl-color 200 95 80) ;; Celeste <=> Light blue
(hsl-color 10 95 80) ;; Carnation <=> Light red / skin
(hsl-color 275 95 80) ;; Lavender <=> Light purple
(hsl-color 130 95 80) ;; Mint <=> Light green
(hsl-color 50 75 75) ;; Buff <=> Light brown / beige
(hsl-color 330 95 80) ;; Pink <=> Pink
))
; Tinctures / Dark colors
(define tincture-colors
(list
(hsl-color 225 85 40) ;; Azure <=> Blue
(hsl-color 0 85 50) ;; Gules <=> Red
(hsl-color 350 75 30) ;; Sanguine <=> Dark red
(hsl-color 310 45 40) ;; Purpure <=> Purple
(hsl-color 210 15 40) ;; Cendrée <=> Grey
(hsl-color 0 0 0) ;; Sable <=> Black
(hsl-color 110 75 30) ;; Vert <=> Green
(hsl-color 30 90 50) ;; Orangé <=> Orange
(hsl-color 20 75 30) ;; Tenné <=> Brown
))
; The only thing needed is the width
(define (flag-generate width)
; 4 pairs of colors are needed
(define palette (palette-generate 4 tincture-colors metal-colors))
; Decide on the dimensions - ratio width:height can be 3:2 or 2:1
(define height (* width (random:from-vector (vector 1/2 2/3))))
; Return a vector image
(vector-image
#:width width
#:height height
(field-division width height palette)))

View File

@ -0,0 +1,683 @@
#lang racket/base
; Functions to draw charges / emblems
; Each method takes 4 parameters:
; - the width and height of the area on which the charge is drawn
; - the charge color and field color on which the charge is drawn
(require
racket/math
"../../graphics/vectorial.rkt"
"../../base-generation/random.rkt"
"../../base-generation/distribution.rkt")
; Two kind of charges are distinguished here.
; The small charges are simple symbols and try to fill the area.
; The large charges have positions for additional small charges on them.
(provide
large-charge
small-charge)
; Small charges
; Circle
(define (small:circle width height charge-color field-color)
(define radius (/ (min width height) 2))
(circle
#:center (point (/ width 2) (/ height 2))
#:radius radius
#:attributes (at-fill-color charge-color)))
; Ring - a circle with a circle inside
(define (small:ring width height charge-color field-color)
(define radius (/ (min width height) 2))
(group
(circle
#:center (point (/ width 2) (/ height 2))
#:radius radius
#:attributes (at-fill-color charge-color))
(circle
#:center (point (/ width 2) (/ height 2))
#:radius (/ radius 2)
#:attributes (at-fill-color field-color))))
; Star maker
; This function takes the number of points and returns a small charge function
; The heavy? parameters indicates if the star should generate heavy branches or thin branches
(define (star-maker nb-points heavy?)
(lambda (width height charge-color field-color)
(define radius (/ (min width height) 2))
(define center (point (/ width 2) (/ height 2)))
(define a (/ pi nb-points))
(define ratio
(cond
((eq? 3 nb-points) 1/3)
((and (not (eq? 4 nb-points)) heavy?)
(/ (sqrt (+ 1 (expt (tan a) 2)))
(+ 1 (* (tan a) (tan (* 2 a))))))
(#t (/ 1 (+ 1 (* 2 (cos a)))))
))
(star
#:nb-points nb-points
#:radius radius
#:center center
#:ratio ratio
#:attributes (at-fill-color charge-color))))
; Definitions of star charges
(define small:star-3 (star-maker 3 #f))
(define small:star-4 (star-maker 4 #f))
(define small:star-5 (star-maker 5 #f))
(define small:star-6 (star-maker 6 #f))
(define small:star-thin-7 (star-maker 7 #f))
(define small:star-heavy-7 (star-maker 7 #t))
(define small:star-thin-8 (star-maker 8 #f))
(define small:star-heavy-8 (star-maker 8 #t))
(define small:star-thin-9 (star-maker 9 #f))
(define small:star-heavy-9 (star-maker 9 #t))
(define small:star-thin-10 (star-maker 10 #f))
(define small:star-heavy-10 (star-maker 10 #t))
(define small:star-thin-12 (star-maker 12 #f))
(define small:star-heavy-12 (star-maker 12 #t))
(define small:star-thin-20 (star-maker 20 #f))
; Greek cross (+)
(define (small:greek-cross width height charge-color field-color)
(define cross-size (min width height))
(define cross-width (/ cross-size 3))
(group
(rectangle
#:width cross-width
#:height cross-size
#:top-left (point (/ (- width cross-width) 2) (/ (- height cross-size) 2))
#:attributes (at-fill-color charge-color))
(rectangle
#:width cross-size
#:height cross-width
#:top-left (point (/ (- width cross-size) 2) (/ (- height cross-width) 2))
#:attributes (at-fill-color charge-color))
))
; St. Andrew cross / small saltire (x)
(define (small:andrew-cross width height charge-color field-color)
(define cross-size (min width height))
(define r (/ cross-size 4))
(define offset-x (/ (- width cross-size) 2))
(define offset-y (/ (- height cross-size) 2))
(polygon
#:attributes (at-fill-color charge-color)
(point (+ r offset-x) offset-y)
(point (/ width 2) (+ offset-y r))
(point (+ (/ width 2) r) offset-y)
(point (+ cross-size offset-x) (+ offset-y r))
(point (+ (/ width 2) r) (/ height 2))
(point (+ cross-size offset-x) (+ (/ height 2) r))
(point (+ (/ width 2) r) (+ cross-size offset-y))
(point (/ width 2) (+ (/ height 2) r))
(point (+ r offset-x) (+ cross-size offset-y))
(point offset-x (+ (/ height 2) r))
(point (+ r offset-x) (/ height 2))
(point offset-x (+ offset-y r))))
; Crescent
; The crescent is 33 width, 40 height and a group is used to scale it to the right size
(define (small:crescent width height charge-color field-color)
(define area-scaling (min (/ width 40) (/ height 40)))
(define area-translation (point (/ (- width (* 40 area-scaling)) 2) (/ (- height (* 40 area-scaling)) 2)))
(group
#:attributes
(at-transforms
(translate area-translation)
(scale area-scaling)
(translate (point 3.5 0)))
(path
#:attributes (at-fill-color charge-color)
(move-to (point 33 5))
(arc-to
#:radius-point (point 20 20)
#:x-axis-rotation 0
#:large-arc? #t
#:sweep? #f
#:end (point 33 35))
(arc-to
#:radius-point (point 16 16)
#:x-axis-rotation 0
#:large-arc? #t
#:sweep? #t
#:end (point 33 5))
(close-path))))
; Apply a random rotation to a small:charge
(define (small:rotate width height charge)
(define angle (random:from-vector (vector 0 45 90 135 180 225 270 315)))
(define center (point (/ width 2) (/ height 2)))
(group
#:attributes (at-rotate angle center)
charge))
; Draw a small charge
(define (small-charge width height charge-color field-color)
; List of function and if they can be rotated
(define func+rotate?
(vector
(cons small:circle #f) (cons small:ring #f)
(cons small:star-3 #t) (cons small:star-4 #t) (cons small:star-5 #t) (cons small:star-6 #t)
(cons small:star-thin-7 #t) (cons small:star-heavy-7 #t) (cons small:star-thin-8 #t) (cons small:star-heavy-8 #t)
(cons small:star-thin-9 #t) (cons small:star-heavy-9 #t) (cons small:star-thin-10 #t) (cons small:star-heavy-10 #t)
(cons small:star-thin-12 #t) (cons small:star-heavy-12 #t) (cons small:star-thin-20 #t)
(cons small:greek-cross #f) (cons small:andrew-cross #f)
(cons small:crescent #t)
))
(define choice (random:from-vector func+rotate?))
(define charge ((car choice) width height charge-color field-color))
(if (cdr choice)
(small:rotate width height charge)
charge))
;;;;;;
; Large charges
; Large charges have variations that are applied above the pattern
; The variation signature depends on the pattern
; Common variation: nothing more (empty group)
(define (large:variation:no-more . args)
(group))
; Cross
; Inner cross variation
(define (large:cross:inner-cross
width height charge-color field-color cross-width)
(define inner-cross-width (/ cross-width 3))
(group
(rectangle
#:width inner-cross-width
#:height height
#:top-left (point (/ (- width inner-cross-width) 2) 0)
#:attributes (at-fill-color field-color))
(rectangle
#:width width
#:height inner-cross-width
#:top-left (point 0 (/ (- height inner-cross-width) 2))
#:attributes (at-fill-color field-color))))
; Small inner charge, located at the crossing of the rectangles
(define (large:cross:small-inner-charge
width height charge-color field-color cross-width)
(group
#:attributes (at-translate (point (/ (- width cross-width) 2) (/ (- height cross-width) 2)))
(small-charge cross-width cross-width field-color charge-color)))
; Big inner charge, inside a rectangle centered on the cross
(define (large:cross:big-inner-charge
width height charge-color field-color cross-width)
(define size-rect (* cross-width 2.5))
(define size-bonus (* cross-width 2))
(group
(rectangle
#:width size-rect
#:height size-rect
#:top-left (point (/ (- width size-rect) 2) (/ (- height size-rect) 2))
#:attributes (at-fill-color charge-color))
(group
#:attributes (at-translate (point (/ (- width size-bonus) 2) (/ (- height size-bonus) 2)))
(small-charge size-bonus size-bonus field-color charge-color))))
; One outer charge, in one of the quadrants defined by the cross
(define (large:cross:one-outer-charge
width height charge-color field-color cross-width)
(define area-width (/ (- width cross-width) 4))
(define area-height (/ (- height cross-width) 4))
(define possible-position
(vector
(point (/ area-width 2) (/ area-height 2))
(point (/ (+ width cross-width area-width) 2) (/ area-height 2))
(point (/ area-width 2) (/ (+ height cross-width area-height) 2))
(point (/ (+ width cross-width area-width) 2) (/ (+ height cross-width area-height) 2))))
(define position (random:from-vector possible-position))
(group
#:attributes (at-translate position)
(small-charge area-width area-height charge-color field-color)))
; Four outer charges, one in every quadrant defined by the cross
(define (large:cross:four-outer-charges
width height charge-color field-color cross-width)
(define area-width (/ (- width cross-width) 4))
(define area-height (/ (- height cross-width) 4))
(define same-charge? (random:boolean))
(define first-charge (small-charge area-width area-height charge-color field-color))
(define translations
(list
(point (/ area-width 2) (/ area-height 2))
(point (/ (+ width cross-width area-width) 2) (/ area-height 2))
(point (/ area-width 2) (/ (+ height cross-width area-height) 2))
(point (/ (+ width cross-width area-width) 2) (/ (+ height cross-width area-height) 2))))
(apply group
(map
(lambda (tr)
(group
#:attributes (at-translate tr)
(if same-charge?
first-charge
(small-charge area-width area-height charge-color field-color))))
translations)))
; Cross charge
; Distribution of variations
(define large:cross:variation-distribution
(distribution
(cons large:variation:no-more 5)
(cons large:cross:inner-cross 1)
(cons large:cross:small-inner-charge 1)
(cons large:cross:big-inner-charge 1)
(cons large:cross:one-outer-charge 1)
(cons large:cross:four-outer-charges 1)))
;
(define (large:cross width height charge-color field-color)
(define variation (distribution-generate large:cross:variation-distribution))
(define cross-width (* 2/10 (min width height)))
(group
; Main pattern
(rectangle
#:width cross-width
#:height height
#:top-left (point (/ (- width cross-width) 2) 0)
#:attributes (at-fill-color charge-color))
(rectangle
#:width width
#:height cross-width
#:top-left (point 0 (/ (- height cross-width) 2))
#:attributes (at-fill-color charge-color))
; Variation
(variation width height charge-color field-color cross-width)))
; Lozenge
; Inner charge variation, a small charge located insize the lozenge
(define (large:lozenge:inner-charge
width height charge-color field-color offset)
(define wref (- width offset offset))
(define href (- height offset offset))
(define lc (/ (* wref href) (+ wref href)))
(group
#:attributes (at-translate (point (/ (- width lc) 2) (/ (- height lc) 2)))
(small-charge lc lc field-color charge-color)))
; Lozenge charge
; Distribution of variations
(define large:lozenge:variation-distribution
(distribution
(cons large:variation:no-more 2)
(cons large:lozenge:inner-charge 1)))
;
(define (large:lozenge width height charge-color field-color)
(define variation (distribution-generate large:lozenge:variation-distribution))
(define lref (min width height))
(define offset (if (random:boolean) (* lref 1/10) 0))
(group
; Main pattern
(polygon
#:attributes (at-fill-color charge-color)
(point offset (/ height 2))
(point (/ width 2) offset)
(point (- width offset) (/ height 2))
(point (/ width 2) (- height offset)))
; Variation
(variation width height charge-color field-color offset)))
; Fess (horizontal bar)
; Inner pattern variation - a rectangle inside the rectangle
(define (large:fess:inner-pattern
width height charge-color field-color fess-size)
(define inner-size (* fess-size (random:from-vector (vector 1/2 1/3 1/4))))
(rectangle
#:width width
#:height inner-size
#:top-left (point 0 (/ (- height inner-size) 2))
#:attributes (at-fill-color field-color)))
; Inner charge - a small charge inside the rectangle
(define (large:fess:inner-charge
width height charge-color field-color fess-size)
(define offset (* fess-size 1/10))
(group
#:attributes (at-translate (point offset (+ offset (/ (- height fess-size) 2))))
(small-charge (- width (* 2 offset)) (- fess-size (* 2 offset)) field-color charge-color)))
; Surrounding charge - add a thinner rectangle next to each side of the pattern
(define (large:fess:surrounding-pattern
width height charge-color field-color fess-size)
(define pattern-size (* height 1/20))
(group
(rectangle
#:width width
#:height pattern-size
#:top-left (point 0 (- (/ height 2) (/ fess-size 2) (* 2 pattern-size)))
#:attributes (at-fill-color charge-color))
(rectangle
#:width width
#:height pattern-size
#:top-left (point 0 (+ (/ height 2) (/ fess-size 2) pattern-size))
#:attributes (at-fill-color charge-color))))
; Fess charge
; Distribution of variations
(define large:fess:variation-distribution
(distribution
(cons large:variation:no-more 3)
(cons large:fess:inner-pattern 1)
(cons large:fess:inner-charge 1)
(cons large:fess:surrounding-pattern 1)))
;
(define (large:fess width height charge-color field-color)
(define variation (distribution-generate large:fess:variation-distribution))
(define ratio (random:from-vector (vector 1/5 1/4 1/3 1/2)))
(define size (* height ratio))
(group
(rectangle
#:width width
#:height size
#:top-left (point 0 (/ (- height size) 2))
#:attributes (at-fill-color charge-color))
(variation width height charge-color field-color size)))
; Pale (vertical bar)
; Inner pattern variation - a rectangle inside the rectangle
(define (large:pale:inner-pattern
width height charge-color field-color pale-size)
(define inner-size (* pale-size (random:from-vector (vector 1/2 1/3 1/4))))
(rectangle
#:width inner-size
#:height height
#:top-left (point (/ (- width inner-size) 2) 0)
#:attributes (at-fill-color field-color)))
; Inner charge - a small charge inside the rectangle
(define (large:pale:inner-charge
width height charge-color field-color pale-size)
(define offset (* pale-size 1/10))
(group
#:attributes (at-translate (point (+ offset (/ (- width pale-size) 2)) offset))
(small-charge (- pale-size (* 2 offset)) (- height (* 2 offset)) field-color charge-color)))
; Surrounding charge - add a thinner rectangle next to each side of the pattern
(define (large:pale:surrounding-pattern
width height charge-color field-color pale-size)
(define pattern-size (* width 1/20))
(group
(rectangle
#:width pattern-size
#:height height
#:top-left (point (- (/ width 2) (/ pale-size 2) (* 2 pattern-size)) 0)
#:attributes (at-fill-color charge-color))
(rectangle
#:width pattern-size
#:height height
#:top-left (point (+ (/ width 2) (/ pale-size 2) pattern-size) 0)
#:attributes (at-fill-color charge-color))))
; Pale charge
; Distribution of variations
(define large:pale:variation-distribution
(distribution
(cons large:variation:no-more 3)
(cons large:pale:inner-pattern 1)
(cons large:pale:inner-charge 1)
(cons large:pale:surrounding-pattern 1)))
;
(define (large:pale width height charge-color field-color)
(define variation (distribution-generate large:pale:variation-distribution))
(define ratio (random:from-vector (vector 1/5 1/4 1/3 1/2)))
(define size (* width ratio))
(group
(rectangle
#:width size
#:height height
#:top-left (point (/ (- width size) 2) 0)
#:attributes (at-fill-color charge-color))
(variation width height charge-color field-color size)))
; Disc
; Variation - filled with a small charge
(define (large:disc:charged
width height charge-color field-color radius)
(group
#:attributes
(at-translate
(point
(- (/ width 2) (* radius (/ 1 (sqrt 2))))
(- (/ height 2) (* radius (/ 1 (sqrt 2))))))
(small-charge (* radius (sqrt 2)) (* radius (sqrt 2)) field-color charge-color)))
; Disc charge
; Distribution of variations
(define large:disc:variation-distribution
(distribution
(cons large:variation:no-more 1)
(cons large:disc:charged 2)))
;
(define (large:disc width height charge-color field-color)
(define variation (distribution-generate large:disc:variation-distribution))
(define radius (* (min width height) 1/3))
(group
(circle
#:center (point (/ width 2) (/ height 2))
#:radius radius
#:attributes (at-fill-color charge-color))
(variation width height charge-color field-color radius)))
; Border
; Inner charge variation - a small charge located insize the bordered area
(define (large:border:inner-charge
width height charge-color field-color border-width)
(group
#:attributes (at-translate (point (* 2 border-width) (* 2 border-width)))
(small-charge (- width (* 4 border-width)) (- height (* 4 border-width)) charge-color field-color)))
; Border charge
; Distribution of variations
(define large:border:variation-distribution
(distribution
(cons large:variation:no-more 2)
(cons large:border:inner-charge 1)))
;
(define (large:border width height charge-color field-color)
(define variation (distribution-generate large:border:variation-distribution))
(define border-width (* 1/10 (min width height)))
(group
; Main pattern
(rectangle
#:width width
#:height border-width
#:attributes (at-fill-color charge-color))
(rectangle
#:width border-width
#:height height
#:attributes (at-fill-color charge-color))
(rectangle
#:width width
#:height border-width
#:top-left (point 0 (- height border-width))
#:attributes (at-fill-color charge-color))
(rectangle
#:width border-width
#:height height
#:top-left (point (- width border-width) 0)
#:attributes (at-fill-color charge-color))
; Variation
(variation width height charge-color field-color border-width)))
; Saltire
; Note: the 1/2-character parameters are:
; - w: width of the area
; - h: height of the area
; - sw: saltire width
; - rw: width of the rectangle generating the saltire (by moving it from one corner to the opposite)
; - rh: height of the rectangle generating the saltire
; Inner saltire variation - a saltire inside the saltire
(define (large:saltire:inner-saltire
w h charge-color field-color
sw rw rh)
(polygon
#:attributes (at-fill-color charge-color)
(point 0 0) (point (/ rw 2) 0) (point (/ w 2) (- (/ h 2) (/ rh 2))) (point (- w (/ rw 2)) 0)
(point w 0) (point w (/ rh 2)) (point (+ (/ w 2) (/ rw 2)) (/ h 2)) (point w (- h (/ rh 2)))
(point w h) (point (- w (/ rw 2)) h) (point (/ w 2) (+ (/ h 2) (/ rh 2))) (point (/ rw 2) h)
(point 0 h) (point 0 (- h (/ rh 2))) (point (- (/ w 2) (/ rw 2)) (/ h 2)) (point 0 (/ rh 2))
))
; Small inner charge - a charge at the center of the saltire
(define (large:saltire:small-inner-charge
w h charge-color field-color
sw rw rh)
(define ratio 9/10)
(group
#:attributes (at-translate (point (- (/ w 2) (* ratio rw)) (- (/ h 2) (* ratio rh))))
(small-charge (* ratio 2 rw) (* ratio 2 rh) field-color charge-color)))
; Cross inner charge - several identical charges inside the saltire
(define (large:saltire:cross-inner-charge
w h charge-color field-color
sw rw rh)
(define charge (small-charge rw rh field-color charge-color))
(define theta (atan (/ h w)))
(define D (sqrt (+ (* w w) (* h h))))
(define (draw n lst)
(define offset-x (* n (cos theta) 1/6 D))
(define offset-y (* n (sin theta) 1/6 D))
(if (<= n 0)
lst
(draw (- n 1)
(append
(list
(group
#:attributes
(at-translate
(point (- offset-x (/ rw 2))
(- offset-y (/ rh 2))))
charge)
(group
#:attributes
(at-translate
(point (- offset-x (/ rw 2))
(- h offset-y (/ rh 2))))
charge))
lst))))
(apply group (draw 5 (list))))
; One outer charge - a charge in one of the sectors defined by the saltire
(define (large:saltire:one-outer-charge
w h charge-color field-color
sw rw rh)
; Size of the charge
(define nw (/ (* rw (- h (* rh 2))) (* rh 2)))
(define nh (/ (* rh (- w (* rw 2))) (* rw 2)))
(define e 1/10)
(define area-width-dexter (/ (* (- 1 e) nw h) (+ nw h)))
(define area-width-chief (/ (* (- 1 e) nh w) (+ nh w)))
(define area-width (min area-width-dexter area-width-chief))
; Translation
(define translation
(random:from-vector
(vector
(point (- (/ w 2) (/ area-width 2)) (* e nh))
(point (* e nw) (- (/ h 2) (/ area-width 2)))
(point (- (/ w 2) (/ area-width 2)) (- h (* e nh) area-width))
(point (- w (* e nw) area-width) (- (/ h 2) (/ area-width 2))))))
;
(group
#:attributes (at-translate translation)
(small-charge area-width area-width charge-color field-color)))
; Four outer charges - one in each sector define by the saltire
(define (large:saltire:four-outer-charges
w h charge-color field-color
sw rw rh)
; Size of the charge
(define nw (/ (* rw (- h (* rh 2))) (* rh 2)))
(define nh (/ (* rh (- w (* rw 2))) (* rw 2)))
(define e 1/10)
(define area-width-dexter (/ (* (- 1 e) nw h) (+ nw h)))
(define area-width-chief (/ (* (- 1 e) nh w) (+ nh w)))
(define area-width (min area-width-dexter area-width-chief))
; Translation
(define translations
(list
(point (- (/ w 2) (/ area-width 2)) (* e nh))
(point (* e nw) (- (/ h 2) (/ area-width 2)))
(point (- (/ w 2) (/ area-width 2)) (- h (* e nh) area-width))
(point (- w (* e nw) area-width) (- (/ h 2) (/ area-width 2)))))
; Charges
(define same-charge? (random:boolean))
(define first-charge (small-charge area-width area-width charge-color field-color))
;
(apply group
(map
(lambda (tr)
(group
#:attributes (at-translate tr)
(if same-charge?
first-charge
(small-charge area-width area-width charge-color field-color))))
translations)))
; Saltire charge
; Distribution of variations
(define large:saltire:variation-distribution
(distribution
(cons large:variation:no-more 5)
(cons large:saltire:inner-saltire 1)
(cons large:saltire:small-inner-charge 1)
(cons large:saltire:cross-inner-charge 1)
(cons large:saltire:one-outer-charge 1)
(cons large:saltire:four-outer-charges 1)))
;
(define (large:saltire w h charge-color field-color)
(define variation (distribution-generate large:saltire:variation-distribution))
; Saltire parameters
(define sw (* 2/10 (min w h)))
(define r (/ sw (sqrt (+ (* w w) (* h h)))))
(define rw (* r w))
(define rh (* r h))
;
(group
; Pattern
(polygon
#:attributes (at-fill-color charge-color)
(point 0 0) (point rw 0) (point (/ w 2) (- (/ h 2) rh)) (point (- w rw) 0)
(point w 0) (point w rh) (point (+ (/ w 2) rw) (/ h 2)) (point w (- h rh))
(point w h) (point (- w rw) h) (point (/ w 2) (+ (/ h 2) rh)) (point rw h)
(point 0 h) (point 0 (- h rh)) (point (- (/ w 2) rw) (/ h 2)) (point 0 rh))
; Variation
(variation w h charge-color field-color sw rw rh)))
; Small charge alone
(define (large:single-small width height charge-color field-color)
(define scaling (random:from-vector (vector 4/10 6/10 8/10)))
(group
#:attributes
(at-transforms
(translate (point (/ (* (- 1 scaling) width) 2) (/ (* (- 1 scaling) height) 2)))
(scale scaling))
(small-charge width height charge-color field-color)))
; Distribution of large charges
(define large-charge:distribution
(distribution
(cons large:single-small 6)
(cons large:cross 3)
(cons large:lozenge 2)
(cons large:fess 1)
(cons large:pale 1)
(cons large:disc 1)
(cons large:border 1)
(cons large:saltire 1)))
; Choose a large charge at random
(define (large-charge width height charge-color field-color)
((distribution-generate large-charge:distribution)
width height charge-color field-color))

View File

@ -0,0 +1,740 @@
#lang racket/base
; Functions to divide a flag into sectors
(require
"../../graphics/vectorial.rkt"
"../../base-generation/random.rkt"
"../../base-generation/distribution.rkt"
"charge.rkt"
"palette.rkt")
(provide
field-division)
; Each division takes 3 parameters: a width, a height and a palette
; Each division can have a variation of overlays that place charges on the flag
; Common overlay: no overlay
(define (division:overlay:none . args)
(group))
; Common overlay: single charge over the flag
; The 1st color of the palette is used
(define (division:overlay:charge width height palette)
(large-charge
width
height
(palette-secondary palette 0)
(palette-main palette 0)))
; Common overlay: fess on chief (1/3 of flag)
; The 4th color of the palette is used
(define (division:overlay:fess-chief width height palette)
(group
(rectangle
#:width width
#:height (/ height 3)
#:attributes (at-fill-color (palette-main palette 3)))
(large-charge
width
(/ height 3)
(palette-secondary palette 3)
(palette-main palette 3))))
; Common overlay: fess on base
; The 4th color of the palette is used
(define (division:overlay:fess-base width height palette)
(group
#:attributes (at-translate (point 0 (* 2/3 height)))
(division:overlay:fess-chief width height palette)))
; Common overlay: pale on "chief" (left side)
; The 4th color of the palette is used
(define (division:overlay:pale-chief width height palette)
(group
(rectangle
#:width (/ width 3)
#:height height
#:attributes (at-fill-color (palette-main palette 3)))
(large-charge
(/ width 3)
height
(palette-secondary palette 3)
(palette-main palette 3))))
; Common overlay: pale on "base" (right side)
; The 4th color of the palette is used
(define (division:overlay:pale-base width height palette)
(group
#:attributes (at-translate (point (* 2/3 width) 0))
(division:overlay:pale-chief width height palette)))
; Common overlay: pairle (triangle) on left
; The 4th color of the palette is used. Only a small charge can be put here.
(define (division:overlay:pairle-left width height palette)
(define l (* width (random:from-vector (vector 1 1/2 1/3))))
(define has-charge? (random:boolean))
(group
(polygon
#:attributes (at-fill-color (palette-main palette 3))
(point 0 0)
(point 0 height)
(point l (/ height 2)))
(cond
( has-charge?
(define e 1/10)
(define r (/ (* l height (- 1 e)) (+ l height)))
(group
#:attributes (at-translate (point (* e l) (/ (- height r) 2)))
(small-charge
r r
(palette-secondary palette 3)
(palette-main palette 3))))
( #t
(group)))))
; Common overlay: pairle (triangle) on right
; The 4th color of the palette is used. Only a small charge can be put here.
(define (division:overlay:pairle-right width height palette)
(define l (* width (random:from-vector (vector 1 1/2 1/3))))
(define has-charge? (random:boolean))
(group
(polygon
#:attributes (at-fill-color (palette-main palette 3))
(point width 0)
(point width height)
(point (- width l) (/ height 2)))
(cond
( has-charge?
(define e 1/10)
(define r (/ (* l height (- 1 e)) (+ l height)))
(group
#:attributes (at-translate (point (- width r (* e l)) (/ (- height r) 2)))
(small-charge
r r
(palette-secondary palette 3)
(palette-main palette 3))))
( #t
(group)))))
; Common overlay: pairle (triangle) on top
; The 4th color of the palette is used. Only a small charge can be put here.
(define (division:overlay:pairle-top width height palette)
(define l (* height (random:from-vector (vector 1 1/2 1/3))))
(define has-charge? (random:boolean))
(group
(polygon
#:attributes (at-fill-color (palette-main palette 3))
(point 0 0)
(point width 0)
(point (/ width 2) l))
(cond
( has-charge?
(define e 1/10)
(define r (/ (* l width (- 1 e)) (+ l width)))
(group
#:attributes (at-translate (point (/ (- width r) 2) (* e l)))
(small-charge
r r
(palette-secondary palette 3)
(palette-main palette 3))))
( #t
(group)))))
; Common overlay: pairle (triangle) on bottom
; The 4th color of the palette is used. Only a small charge can be put here.
(define (division:overlay:pairle-bottom width height palette)
(define l (* height (random:from-vector (vector 1 1/2 1/3))))
(define has-charge? (random:boolean))
(group
(polygon
#:attributes (at-fill-color (palette-main palette 3))
(point 0 height)
(point width height)
(point (/ width 2) (- height l)))
(cond
( has-charge?
(define e 1/10)
(define r (/ (* l width (- 1 e)) (+ l width)))
(group
#:attributes (at-translate (point (/ (- width r) 2) (- height r (* e l))))
(small-charge
r r
(palette-secondary palette 3)
(palette-main palette 3))))
( #t
(group)))))
; Plain division: the field is of a single color
; Distribution of overlays
(define division:plain:overlay-distribution
(distribution
(cons division:overlay:none 1)
(cons division:overlay:charge 15)
(cons division:overlay:fess-chief 1)
(cons division:overlay:fess-base 1)
(cons division:overlay:pale-chief 1)
(cons division:overlay:pale-base 1)
(cons division:overlay:pairle-left 1)
(cons division:overlay:pairle-right 1)
(cons division:overlay:pairle-top 1)
(cons division:overlay:pairle-bottom 1)
))
;
(define (division:plain width height palette)
(define overlay (distribution-generate division:plain:overlay-distribution))
(group
(rectangle
#:width width
#:height height
#:attributes (at-fill-color (palette-main palette 0)))
(overlay width height palette)))
; Per fess - Bicolor horizontal
; Chief overlay
; The 1st color of the palette is used
(define (division:fess:chief width height palette)
(large-charge
width (/ height 2)
(palette-secondary palette 0)
(palette-main palette 0)))
; Base overlay
; The 2nd color of the palette is used
(define (division:fess:base width height palette)
(group
#:attributes (at-translate (point 0 (/ height 2)))
(large-charge
width (/ height 2)
(palette-secondary palette 1)
(palette-main palette 1))))
; Base + chief overlay
(define (division:fess:chief+base width height palette)
(group
(division:fess:chief width height palette)
(division:fess:base width height palette)))
; Per fess division
; Distribution of overlays - case 1: base and chief share the same kind of main lightness: a charge on the whole flag is possible
(define division:fess:overlay-distribution:same-main-light
(distribution
(cons division:overlay:none 3)
(cons division:overlay:charge 3)
(cons division:overlay:pale-chief 1)
(cons division:overlay:pale-base 1)
(cons division:overlay:pairle-left 1)
(cons division:overlay:pairle-right 1)
(cons division:fess:chief 1)
(cons division:fess:base 1)
(cons division:fess:chief+base 1)))
; Distribution of overlays - case 2: base and chief don't share the same kind of main lightness
(define division:fess:overlay-distribution:different-main-light
(distribution
(cons division:overlay:none 3)
(cons division:overlay:pale-chief 1)
(cons division:overlay:pale-base 1)
(cons division:overlay:pairle-left 1)
(cons division:overlay:pairle-right 1)
(cons division:fess:chief 1)
(cons division:fess:base 1)
(cons division:fess:chief+base 1)))
;
(define (division:fess width height palette)
(define same-main-color? (eq? (palette-main-dark? palette 0) (palette-main-dark? palette 1)))
(define overlay (distribution-generate
(if same-main-color?
division:fess:overlay-distribution:same-main-light
division:fess:overlay-distribution:different-main-light)))
(group
; base
(rectangle
#:width width
#:height height
#:attributes (at-fill-color (palette-main palette 1)))
; chief
(rectangle
#:width width
#:height (/ height 2)
#:attributes (at-fill-color (palette-main palette 0)))
; Overlay
(overlay width height palette)))
; Per pale - Bicolor vertical
; "Chief" overlay (left side)
; The 1st color of the palette is used
(define (division:pale:chief width height palette)
(large-charge
(/ width 2) height
(palette-secondary palette 0)
(palette-main palette 0)))
; "Base" overlay (right side)
; The 2nd color of the palette is used
(define (division:pale:base width height palette)
(group
#:attributes (at-translate (point (/ width 2) 0))
(large-charge
(/ width 2) 0
(palette-secondary palette 1)
(palette-main palette 1))))
; Base + chief overlay
(define (division:pale:chief+base width height palette)
(group
(division:pale:chief width height palette)
(division:pale:base width height palette)))
; Per pale division
; Distribution of overlays - case 1: base and chief share the same kind of main lightness: a charge on the whole flag is possible
(define division:pale:overlay-distribution:same-main-light
(distribution
(cons division:overlay:none 3)
(cons division:overlay:charge 3)
(cons division:overlay:fess-chief 1)
(cons division:overlay:fess-base 1)
(cons division:overlay:pairle-top 1)
(cons division:overlay:pairle-bottom 1)
(cons division:pale:chief 1)
(cons division:pale:base 1)
(cons division:pale:chief+base 1)))
; Distribution of overlays - case 2: base and chief don't share the same kind of main lightness
(define division:pale:overlay-distribution:different-main-light
(distribution
(cons division:overlay:none 3)
(cons division:overlay:fess-chief 1)
(cons division:overlay:fess-base 1)
(cons division:overlay:pairle-top 1)
(cons division:overlay:pairle-bottom 1)
(cons division:pale:chief 1)
(cons division:pale:base 1)
(cons division:pale:chief+base 1)))
;
(define (division:pale width height palette)
(define same-main-color? (eq? (palette-main-dark? palette 0) (palette-main-dark? palette 1)))
(define overlay (distribution-generate
(if same-main-color?
division:pale:overlay-distribution:same-main-light
division:pale:overlay-distribution:different-main-light)))
(group
; "base" (right side)
(rectangle
#:width width
#:height height
#:attributes (at-fill-color (palette-main palette 1)))
; "chief" (left side)
(rectangle
#:width (/ width 2)
#:height height
#:attributes (at-fill-color (palette-main palette 0)))
; Overlay
(overlay width height palette)))
; Tierced per fess - tricolor horizontal
; Chief overlay
; The 1st color of the palette is used
(define (division:tierced-fess:chief width height palette)
(large-charge
width (/ height 3)
(palette-secondary palette 0)
(palette-main palette 0)))
; Middle overlay
; The 2nd color of the palette is used
(define (division:tierced-fess:middle width height palette)
(group
#:attributes (at-translate (point 0 (/ height 3)))
(large-charge
width (/ height 3)
(palette-secondary palette 1)
(palette-main palette 1))))
; Base overlay
; The 3rd color of the palette is used
(define (division:tierced-fess:base width height palette)
(group
#:attributes (at-translate (point 0 (* height 2/3)))
(large-charge
width (/ height 3)
(palette-secondary palette 2)
(palette-main palette 2))))
; Chief + Middle + Base overlay
(define (division:tierced-fess:chief-middle-base width height palette)
(group
(division:tierced-fess:chief width height palette)
(division:tierced-fess:middle width height palette)
(division:tierced-fess:base width height palette)))
; Chief + Middle overlay
(define (division:tierced-fess:chief-middle width height palette)
(group
(division:tierced-fess:chief width height palette)
(division:tierced-fess:middle width height palette)))
; Chief + Base overlay
(define (division:tierced-fess:chief-base width height palette)
(group
(division:tierced-fess:chief width height palette)
(division:tierced-fess:base width height palette)))
; Middle + Base overlay
(define (division:tierced-fess:middle-base width height palette)
(group
(division:tierced-fess:middle width height palette)
(division:tierced-fess:base width height palette)))
; Single charge on chief + middle
; Use the 2nd color of the palette
(define (division:tierced-fess:single-chief-middle width height palette)
(large-charge
width (* height 2/3)
(palette-secondary palette 1)
(palette-main palette 1)))
; Single charge on middle + base
; Use the 2nd color of the palette
(define (division:tierced-fess:single-middle-base width height palette)
(group
#:attributes (at-translate (point 0 (/ height 3)))
(large-charge
width (* height 2/3)
(palette-secondary palette 1)
(palette-main palette 1))))
; Tierced per fess division
; Distributions: 4 cases
; 1st case: All the areas have the same main lightness
(define division:tierced-fess:overlay-distribution:all-main-light
(distribution
(cons division:overlay:none 6)
(cons division:overlay:charge 6)
(cons division:overlay:pale-chief 1)
(cons division:overlay:pale-base 1)
(cons division:overlay:pairle-left 1)
(cons division:overlay:pairle-right 1)
(cons division:tierced-fess:chief 3)
(cons division:tierced-fess:middle 6)
(cons division:tierced-fess:base 3)
(cons division:tierced-fess:chief-middle-base 1)
(cons division:tierced-fess:chief-middle 1)
(cons division:tierced-fess:chief-base 1)
(cons division:tierced-fess:middle-base 1)
(cons division:tierced-fess:single-chief-middle 3)
(cons division:tierced-fess:single-middle-base 3)
))
; 2nd case: Chief and middle have the same main lightness
(define division:tierced-fess:overlay-distribution:chief-middle-main-light
(distribution
(cons division:overlay:none 6)
(cons division:overlay:pale-chief 1)
(cons division:overlay:pale-base 1)
(cons division:overlay:pairle-left 1)
(cons division:overlay:pairle-right 1)
(cons division:tierced-fess:chief 3)
(cons division:tierced-fess:middle 6)
(cons division:tierced-fess:base 3)
(cons division:tierced-fess:chief-middle-base 1)
(cons division:tierced-fess:chief-middle 1)
(cons division:tierced-fess:chief-base 1)
(cons division:tierced-fess:middle-base 1)
(cons division:tierced-fess:single-chief-middle 3)
))
; 3rd case: Middle and base have the same main lightness
(define division:tierced-fess:overlay-distribution:middle-base-main-light
(distribution
(cons division:overlay:none 6)
(cons division:overlay:pale-chief 1)
(cons division:overlay:pale-base 1)
(cons division:overlay:pairle-left 1)
(cons division:overlay:pairle-right 1)
(cons division:tierced-fess:chief 3)
(cons division:tierced-fess:middle 6)
(cons division:tierced-fess:base 3)
(cons division:tierced-fess:chief-middle-base 1)
(cons division:tierced-fess:chief-middle 1)
(cons division:tierced-fess:chief-base 1)
(cons division:tierced-fess:middle-base 1)
(cons division:tierced-fess:single-middle-base 3)
))
; 4th case: the other cases
(define division:tierced-fess:overlay-distribution:none-main-light
(distribution
(cons division:overlay:none 6)
(cons division:overlay:pale-chief 1)
(cons division:overlay:pale-base 1)
(cons division:overlay:pairle-left 1)
(cons division:overlay:pairle-right 1)
(cons division:tierced-fess:chief 3)
(cons division:tierced-fess:middle 6)
(cons division:tierced-fess:base 3)
(cons division:tierced-fess:chief-middle-base 1)
(cons division:tierced-fess:chief-middle 1)
(cons division:tierced-fess:chief-base 1)
(cons division:tierced-fess:middle-base 1)
))
;
(define (division:tierced-fess width height palette)
(define overlay
(distribution-generate
(cond
((and (eq? (palette-main-dark? palette 0) (palette-main-dark? palette 1))
(eq? (palette-main-dark? palette 1) (palette-main-dark? palette 2)))
division:tierced-fess:overlay-distribution:all-main-light)
((eq? (palette-main-dark? palette 0) (palette-main-dark? palette 1))
division:tierced-fess:overlay-distribution:chief-middle-main-light)
((eq? (palette-main-dark? palette 1) (palette-main-dark? palette 2))
division:tierced-fess:overlay-distribution:middle-base-main-light)
(#t
division:tierced-fess:overlay-distribution:none-main-light))))
(group
; base
(rectangle
#:width width
#:height height
#:attributes (at-fill-color (palette-main palette 2)))
; middle
(rectangle
#:width width
#:height (* height 2/3)
#:attributes (at-fill-color (palette-main palette 1)))
; chief
(rectangle
#:width width
#:height (/ height 3)
#:attributes (at-fill-color (palette-main palette 0)))
; Overlay
(overlay width height palette)))
; Tierced per pale - tricolor vertical
; "Chief" overlay (left side)
; The 1st color of the palette is used
(define (division:tierced-pale:chief width height palette)
(large-charge
(/ width 3) height
(palette-secondary palette 0)
(palette-main palette 0)))
; Middle overlay
; The 2nd color of the palette is used
(define (division:tierced-pale:middle width height palette)
(group
#:attributes (at-translate (point (/ width 3) 0))
(large-charge
(/ width 3) height
(palette-secondary palette 1)
(palette-main palette 1))))
; "Base" overlay (right side)
; The 3rd color of the palette is used
(define (division:tierced-pale:base width height palette)
(group
#:attributes (at-translate (point (* width 2/3) 0))
(large-charge
(/ width 3) height
(palette-secondary palette 2)
(palette-main palette 2))))
; Chief + Middle + Base overlay
(define (division:tierced-pale:chief-middle-base width height palette)
(group
(division:tierced-pale:chief width height palette)
(division:tierced-pale:middle width height palette)
(division:tierced-pale:base width height palette)))
; Chief + Middle overlay
(define (division:tierced-pale:chief-middle width height palette)
(group
(division:tierced-pale:chief width height palette)
(division:tierced-pale:middle width height palette)))
; Chief + Base overlay
(define (division:tierced-pale:chief-base width height palette)
(group
(division:tierced-pale:chief width height palette)
(division:tierced-pale:base width height palette)))
; Middle + Base overlay
(define (division:tierced-pale:middle-base width height palette)
(group
(division:tierced-pale:middle width height palette)
(division:tierced-pale:base width height palette)))
; Single charge on chief + middle
; Use the 2nd color of the palette
(define (division:tierced-pale:single-chief-middle width height palette)
(large-charge
(* width 2/3) height
(palette-secondary palette 1)
(palette-main palette 1)))
; Single charge on middle + base
; Use the 2nd color of the palette
(define (division:tierced-pale:single-middle-base width height palette)
(group
#:attributes (at-translate (point (/ width 3) 0))
(large-charge
(* width 2/3) height
(palette-secondary palette 1)
(palette-main palette 1))))
; Tierced per pale division
; Overlay distributions: 4 cases
; 1st case: All the areas have the same main lightness
(define division:tierced-pale:overlay-distribution:all-main-light
(distribution
(cons division:overlay:none 6)
(cons division:overlay:charge 6)
(cons division:overlay:fess-chief 1)
(cons division:overlay:fess-base 1)
(cons division:overlay:pairle-top 1)
(cons division:overlay:pairle-bottom 1)
(cons division:tierced-pale:chief 3)
(cons division:tierced-pale:middle 6)
(cons division:tierced-pale:base 3)
(cons division:tierced-pale:chief-middle-base 1)
(cons division:tierced-pale:chief-middle 1)
(cons division:tierced-pale:chief-base 1)
(cons division:tierced-pale:middle-base 1)
(cons division:tierced-pale:single-chief-middle 3)
(cons division:tierced-pale:single-middle-base 3)
))
; 2nd case: Chief and middle have the same main lightness
(define division:tierced-pale:overlay-distribution:chief-middle-main-light
(distribution
(cons division:overlay:none 6)
(cons division:overlay:fess-chief 1)
(cons division:overlay:fess-base 1)
(cons division:overlay:pairle-top 1)
(cons division:overlay:pairle-bottom 1)
(cons division:tierced-pale:chief 3)
(cons division:tierced-pale:middle 6)
(cons division:tierced-pale:base 3)
(cons division:tierced-pale:chief-middle-base 1)
(cons division:tierced-pale:chief-middle 1)
(cons division:tierced-pale:chief-base 1)
(cons division:tierced-pale:middle-base 1)
(cons division:tierced-pale:single-chief-middle 3)
))
; 3rd case: Middle and base have the same main lightness
(define division:tierced-pale:overlay-distribution:middle-base-main-light
(distribution
(cons division:overlay:none 6)
(cons division:overlay:fess-chief 1)
(cons division:overlay:fess-base 1)
(cons division:overlay:pairle-top 1)
(cons division:overlay:pairle-bottom 1)
(cons division:tierced-pale:chief 3)
(cons division:tierced-pale:middle 6)
(cons division:tierced-pale:base 3)
(cons division:tierced-pale:chief-middle-base 1)
(cons division:tierced-pale:chief-middle 1)
(cons division:tierced-pale:chief-base 1)
(cons division:tierced-pale:middle-base 1)
(cons division:tierced-pale:single-middle-base 3)
))
; 4th case: the other cases
(define division:tierced-pale:overlay-distribution:none-main-light
(distribution
(cons division:overlay:none 6)
(cons division:overlay:fess-chief 1)
(cons division:overlay:fess-base 1)
(cons division:overlay:pairle-top 1)
(cons division:overlay:pairle-bottom 1)
(cons division:tierced-pale:chief 3)
(cons division:tierced-pale:middle 6)
(cons division:tierced-pale:base 3)
(cons division:tierced-pale:chief-middle-base 1)
(cons division:tierced-pale:chief-middle 1)
(cons division:tierced-pale:chief-base 1)
(cons division:tierced-pale:middle-base 1)
))
;
(define (division:tierced-pale width height palette)
(define overlay
(distribution-generate
(cond
((and (eq? (palette-main-dark? palette 0) (palette-main-dark? palette 1))
(eq? (palette-main-dark? palette 1) (palette-main-dark? palette 2)))
division:tierced-pale:overlay-distribution:all-main-light)
((eq? (palette-main-dark? palette 0) (palette-main-dark? palette 1))
division:tierced-pale:overlay-distribution:chief-middle-main-light)
((eq? (palette-main-dark? palette 1) (palette-main-dark? palette 2))
division:tierced-pale:overlay-distribution:middle-base-main-light)
(#t
division:tierced-pale:overlay-distribution:none-main-light))))
(group
; base
(rectangle
#:width width
#:height height
#:attributes (at-fill-color (palette-main palette 2)))
; middle
(rectangle
#:width (* width 2/3)
#:height height
#:attributes (at-fill-color (palette-main palette 1)))
; chief
(rectangle
#:width (/ width 3)
#:height height
#:attributes (at-fill-color (palette-main palette 0)))
; Overlay
(overlay width height palette)))
; Horizontal stripes
; This one does not have specific overlays
; Overlay distributions
(define division:horizontal-stripes:overlay-distribution
(distribution
(cons division:overlay:none 1)
(cons division:overlay:pale-chief 3)
(cons division:overlay:pale-base 3)
(cons division:overlay:pairle-left 3)
(cons division:overlay:pairle-right 3)
))
;
(define (division:horizontal-stripes width height palette)
(define overlay (distribution-generate division:horizontal-stripes:overlay-distribution))
(define nb-charge-stripes (+ 1 (random 6))) ; Number of stripes using the charge colors => between 3 stripes and 13 stripes
(define stripe-height (/ height (+ 1 (* 2 nb-charge-stripes))))
(group
; Stripes with field color
(rectangle
#:width width
#:height height
#:attributes (at-fill-color (palette-main palette 0)))
; Stripes with charge color
(apply group
(build-list
nb-charge-stripes
(lambda (i)
(rectangle
#:width width
#:height stripe-height
#:top-left (point 0 (* stripe-height (+ 1 (* 2 i))))
#:attributes (at-fill-color (palette-secondary palette 0))))))
; Overlay
(overlay width height palette)))
; Field division
; Distribution of divisions
(define field-division:distribution
(distribution
(cons division:plain 9)
(cons division:fess 3)
(cons division:pale 3)
(cons division:tierced-fess 2)
(cons division:tierced-pale 2)
(cons division:horizontal-stripes 1)
))
;
(define (field-division width height palette)
((distribution-generate field-division:distribution)
width height palette))

View File

@ -0,0 +1,50 @@
#lang racket/base
; Functions to generate a palette of colors for use in flag generation
(require
"../../base-generation/random.rkt")
(provide
; Palette structure accessors
palette-main palette-secondary palette-main-dark?
; Palette generation
palette-generate)
; Palette slot structure
; Contains 2 colors (a dark and a light) and a boolean indicating which one is the main color
(struct palette-slot
(light
dark
main-dark?))
; A palette is a vector of palette slots - no need for new structure
; Get the main color
(define (palette-main palette index)
(define slot (vector-ref palette index))
(if (palette-slot-main-dark? slot)
(palette-slot-dark slot)
(palette-slot-light slot)))
; Get the secondary color
(define (palette-secondary palette index)
(define slot (vector-ref palette index))
(if (palette-slot-main-dark? slot)
(palette-slot-light slot)
(palette-slot-dark slot)))
; Get the information if the main is dark or light
(define (palette-main-dark? palette index)
(palette-slot-main-dark?
(vector-ref palette index)))
; Generate a palette from a list of dark colors and a list of light colors
(define (palette-generate nb-colors dark-colors light-colors)
(define darks (random:sublist dark-colors nb-colors))
(define lights (random:sublist light-colors nb-colors))
(list->vector
(map
(lambda (d l)
(palette-slot l d (random:boolean)))
darks
lights)))

77
src/pages/flag.rkt Normal file
View File

@ -0,0 +1,77 @@
#lang racket/base
; Flag generator pages
(require
xml
"templates.rkt"
"../webcontainer/weblets.rkt"
"../generators/flag.rkt"
"../graphics/vectorial.rkt")
(provide
pages:flag
pages:flag-raw
pages:flag-about)
; Raw page
(define pages:flag-raw
(raw-data-weblet
#:content-type #"image/svg+xml;charset=utf-8"
#:body
(lambda (param)
(string->bytes/utf-8
(xexpr->string
(vectorial->sxml-svg (flag-generate 600))))))) ; flag width: 600
; Flag page
(define pages:flag
(pages:template
#:title "Flag Generator"
#:author "feuforeve.fr"
#:stylesheets '("/css/flag.css")
#:scripts '("/scripts/flag.js")
#:on-load "getFlag();"
#:content
'(article
(section
(p (button ((onclick "getFlag();")) "New flag"))
(section ((id "flag")))
(p (a ((id "download") (download "flag.svg")) "Save flag"))
(p "The generated flags are released under the "
(a ((href "http://creativecommons.org/publicdomain/zero/1.0/"))
"Creative Commons CC0 1.0 Universal (CC0 1.0) Public Domain Dedication") "."))
)))
; About page
(define pages:flag-about
(pages:template
#:title "About the flag generator"
#:author "Feufochmar"
#:date "2020-05-01"
#:content
'(article
(h3 "The generator")
(p "The generator generates flags as svg images and display them on the generator page. "
"The flags can be saved with the link provided below them.")
(h3 "Generation process")
(p "The generator first chooses a set of color couples to use (a dark color and a light color). "
"Then it chooses the main division of the flag (plain color, bicolor or tricolor, horizontal or vertical, ...). "
"It terminates by choosing an overlay that adds elements like stars or crosses on the flag. "
"The choice of overlay depends on the division. ")
(p "The generator uses a rule when combining colors: light colors are placed above dark color (and vice-versa)."
"This is inspired by a heraldic rule regarding how colors are combined: "
"no metal (light color) on metal nor tincture (dark color) on tincture. "
"The generator draws inspiration from heraldry and there are indeed many heraldic references "
"inside the source code. ")
(h3 "Why not providing a flag editor ?")
(p "Maybe as a future feature. I need to design an intermediary format that describes a flag before being able to provide an editor. "
"Currently, the generator directly outputs geometric shapes when generating the flag. ")
(p "There exists websites allowing you to design flags. For instance "
(a ((href "http://flag-designer.appspot.com/")) "Scrontch's Flag Designer") ".")
(h3 "Licence of the generated flags")
(p "Since I don't care at all about what you do with the generated flags, "
"the generated flags are released under the "
(a ((href "http://creativecommons.org/publicdomain/zero/1.0/"))
"Creative Commons CC0 1.0 Universal (CC0 1.0) Public Domain Dedication") ". "
"You can still put a link to the generator or credit me if you want. ")
)))

10
static/css/flag.css Normal file
View File

@ -0,0 +1,10 @@
#flag {
border-style: solid;
border-width: thin;
border-radius: 0px;
width: 600px;
}
svg {
display: block;
}

13
static/scripts/flag.js Normal file
View File

@ -0,0 +1,13 @@
function getFlag() {
document.getElementById('flag').innerHTML = '';
document.getElementById('download').href = '';
var request = new XMLHttpRequest();
request.onreadystatechange = function() {
if (request.readyState == 4 && request.status == 200) {
document.getElementById('flag').innerHTML = request.responseText;
document.getElementById('download').href = 'data:image/svg+xml,' + encodeURIComponent(request.responseText)
}
};
request.open('GET', '/FlagGenerator/RawFlag', true);
request.send();
}