To draw

USAGE

   TO-DRAW src dst

DESCRIPTION

(undocumented) (I suppose that it converts DRAW dialect to command! @angerangel )

TO-DRAW is a function value.

ARGUMENTS

• src (block!)
• dst (block!)

#SOURCE

to-draw: make function! [  [
    src [block!]
    dst [block!]
    /local
    cmd args a t draw-arg
][
    parse reduce/only src draw-words [
        some [
            set cmd draw-command (
                args: make draw-types []
                draw-arg: either word? cmd [
                    all [
                        draw-args/(cmd)
                        copy draw-args/(cmd)
                    ]
                ] [
                    none
                ]
                all [draw-arg append draw-arg [| none! (any-arg?: true)] ]
            )
            any [(any-arg?: false) set a draw-arg (
                    all [
                        not none? a
                        append select args t: type?/word a a
                        unless any-arg? [
                            remove/part find draw-arg t 2
                        ]
                    ]
                )] (
                append dst reduce switch/default cmd [
                    anti-alias [  ['anti-alias args/logic!/1] ]
                    arc [  [
                            'arc
                            args/pair!/1
                            args/pair!/2
                            any [args/integer!/1 args/decimal!/1]
                            any [args/integer!/2 args/decimal!/2]
                            any [args/word!/1 'opened]
                        ] ]
                    arrow [  ['arrow args/pair!/1 args/tuple!/1] ]
                    box [  ['box args/pair!/1 any [args/pair!/2 100x100] any [args/integer!/1 args/decimal!/1 0] ]]
                    circle [  [
                            'circle
                            any [args/pair!/1 50x50]
                            as-pair a: any [args/integer!/1 args/decimal!/1 50] any [args/integer!/2 args/decimal!/2 a]
                        ] ]
                    clip [
                        either args/logic!/1 = false [  ['clip 0x0 10000x10000] ] [  ['clip args/pair!/1 args/pair!/2] ]
                    ]
                    curve [  ['curve args/pair!/1 args/pair!/2 args/pair!/3 args/pair!/4] ]
                    ellipse [  ['ellipse args/pair!/1 args/pair!/2] ]
                    fill-pen [  ['fill-pen either a: any [args/tuple!/1 args/image!/1 args/logic!/1] [a] [false] ]]
                    fill-rule [  ['fill-rule args/word!/1] ]
                    gamma [  ['gamma any [args/integer!/1 args/decimal!/1] ]]
                    grad-pen [  [
                            'grad-pen
                            any [args/word!/1 'linear]
                            any [args/word!/2 'normal]
                            any [args/pair!/1 0x0]
                            as-pair any [args/integer!/1 args/decimal!/1 0] any [args/integer!/2 args/decimal!/2 100]
                            any [args/integer!/3 args/decimal!/3 0]
                            any [args/pair!/3 1x1]
                            args/block!
                        ] ]
                    image [  ['image args/image!/1 any [all [args/pair!/2 args/pair!] any [args/pair!/1 0x0] ]] ]
                    image-filter [  [
                            'image-filter
                            any [args/word!/1 'nearest]
                            any [args/word!/2 'resize]
                            any [args/integer!/1 args/decimal!/1]
                        ] ]
                    image-options [  ['image-options args/tuple!/1 any [args/word!/1 'no-border] ]]
                    image-pattern [  [
                            'image-pattern any [args/word!/1 'normal] any [args/pair!/1 0x0] any [args/pair!/2 0x0]
                        ] ]
                    line [  ['line args/pair!] ]
                    line-cap [  ['line-cap args/word!/1] ]
                    line-join [  ['line-join args/word!/1] ]
                    line-pattern [  ['line-pattern args/tuple!/1 any [args/decimal! args/integer!] ]]
                    line-width [  ['line-width any [args/integer!/1 args/decimal!/1 1] any [args/word!/1 'variable] ]]
                    invert-matrix [  ['invert-matrix] ]
                    matrix [  ['matrix args/block!/1] ]
                    pen [  ['pen either a: any [args/tuple!/1 args/image!/1 args/logic!/1] [a] [false] ]]
                    polygon [  ['polygon args/pair!] ]
                    push [  ['push to-draw args/block! copy [] ]]
                    reset-matrix [  ['reset-matrix] ]
                    rotate [  ['rotate any [args/integer!/1 args/decimal!/1] ]]
                    scale [  ['scale args/pair!/1] ]
                    shape [  ['shape to-shape args/block! copy [] ]]
                    skew [  ['skew args/pair!/1] ]
                    spline [  ['spline args/pair! any [args/integer!/1 0] any [args/word!/1 'opened] ]]
                    text [  [
                            'text
                            any [args/pair!/1 0x0]
                            args/pair!/2
                            any [args/word!/1 'raster]
                            to-text args/block! copy []
                        ] ]
                    transform [  [
                            'transform
                            any [args/integer!/1 args/decimal!/1 0]
                            any [args/pair!/1 0x0]
                            any [as-pair a: any [args/integer!/2 args/decimal!/2 1] any [args/integer!/3 args/decimal!/3 a] ]
                            any [args/pair!/2 0x0]
                        ] ]
                    translate [  ['translate args/pair!/1] ]
                    triangle [  [
                            'triangle
                            args/pair!/1
                            any [args/pair!/2 100x100]
                            any [args/pair!/3 as-pair args/pair!/1/x any [args/pair!/2/y 100] ]
                            args/tuple!/1
                            args/tuple!/2
                            args/tuple!/3
                            any [args/integer!/1 args/decimal!/1 0]
                        ] ]
                ] [  [] ]
            )
            | end
            | a: (
                do make error! reform ["TO-DRAW - syntax error at:" copy/part mold/only at src index? a 50 "..."]
            )
        ]
    ]
    bind/only dst ext-draw
] ]