REBOL [
	Title: "Simple Rich Text renderer"
	Purpose: {
		Defines the render-rich-text function, that is able to render
		simple rich text in a face.
	}
	Author: ["Gabriele Santilli" "Romano Paolo Tenca"]
	EMail: giesse@rebol.it
	File: %render-rich-text.r
	License: {
Copyright (c) 2004, Gabriele Santilli, Romano Paolo Tenca
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:

* Redistributions of source code must retain the above copyright
  notice, this list of conditions and the following disclaimer.

* Redistributions in binary form must reproduce the above
  copyright notice, this list of conditions and the following
  disclaimer in the documentation and/or other materials provided
  with the distribution.

* The name of Gabriele Santilli and Romano Paolo Tenca may not be
  used to endorse or promote products derived from this software
  without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
	}
	Date: 16-Apr-2004
	Version: 1.6.0 ; majorv.minorv.status
				   ; status: 0: unfinished; 1: testing; 2: stable
	History: [
		15-Jan-2004 1.1.0 "History start"
		15-Jan-2004 1.2.0 "First working version with *bold*, /italic/, _underline_ and link->url"
		16-Jan-2004 1.3.0 "No more needs to make face twice, it wasn't resetting pane."
		26-Feb-2004 1.4.0 "Added documentation"
		15-Apr-2004 1.5.0 "Changed space calculation"
		16-Apr-2004 1.6.0 {
			changed again space calculation
			now invisible subfaces are no more rendered,
			now subfaces are merged when possible,
			calc of sizes fixed for edge,
			many subfaces fields cleared,
			subface/style can be: link | bold | underline | none,
			original text is saved in face/data,
			added /link-colors, if not used, colors are kept from font/colors or from a default value
			now is used a blank-face for subfaces
			now para is shared between subfaces
		} Romano
		16-Apr-2004 1.7.0 {changed again space calculation, added wrap?: false}
	]
	Library: [
		level: 'intermediate
		platform: 'all
		type: 'function
		domain: [text gui vid]
		tested-under: [view 1.2.8.3.1 on "WindowsXP"]
		support: none
		license: 'bsd
		see-also: none
	]
]

; comment the following line if you are using autodoc.r
;#do [document: func [text] [none]]

#do [document {
===Simple rich text renderer (render-rich-text.r)

This script defines the RENDER-RICH-TEXT function. It parses the text
in a face for some simple rich text markup, and creates a number of
faces in the face pane rendering the rich text.

This function is very simple and unoptimized.

From 1.6 words are grouped if possible and faces not visible are not
rendered.

---RENDER-RICH-TEXT

To use this function, just pass it a face. It will parse face/text
for style markup and create new faces in face/pane. The face is also
used as a prototype for the created faces. A common use for this
function is defining a rich text style,
	Style Text+ Text with [
		append init [
			render-rich-text self
		]
	]

This function understands the following markup:
	_underlined_   for an underlined word
	/italic/       for an italic word
	*bold*         for a bold word
	link->url      for a link ("link" is displayed, and clicking on it
				   BROWSE is called for "url")

Since this uses PARSE to split the text into words, it is possible to
use double quotes (") to group words (will be rendered as a single face),
for example for links with spaces:
	"Click here->http://www.rebol.it/"

From 1.6 the refinement /link-colors permit to define 2 color for links,
else is used font/colors or a default value.

From 1.6 faces not visible are not rendered and words with identical styles
on the same line are rendered as one face.
}]

set-face-style:   func [face style' /colors c] [
	face/font: make face/font [
		style: either block? style [union style style'] [style']
		if c [
			color: first colors: reduce c
		]
	]
]
render-rich-text: func [
		"Render rich text in a face"
		face [object!]
		/link-colors "Block of colors used for link" cols [block!]
		/local text pos space word' kind url old area fake par
	] [
		par: make face/para [origin: margin: 0x0 wrap?: false]
		any [cols all [face/font/colors cols: face/font/colors] cols: [0.0.255 96.96.255]]
		face/data: face/text
		text: parse/all face/text " "
		face/text: none
		face/pane: make block! 2 + length? text
		pos: face/para/origin
		space: 2 * size-text fake: make face [
			edge: none
			para: par
			text: "  "
			size: 1x1
		]
		fake/text: " "
		space: first space - (3 * size-text fake)
		area: face/size - face/para/origin - face/para/margin
		foreach word text [
			parse word [
				copy word' to "->" 2 skip copy url to end (
					either url [kind: 'link url: to url! url][make error! "Missing url"]
				)
				| "*" copy word' to "*" skip end (kind: 'bold)
				| "/" copy word' to "/" skip end (kind: 'italic)
				| "_" copy word' to "_" skip end (kind: 'underline)
				| copy word' to end (kind: none)
			]
			if word' [
				make blank-face [
					text: word'
					style: kind
					color: face/color
					font: make face/font []
					para: par
					offset: pos
					switch kind [
						link [
							set-face-style/colors self [underline] cols
							feel: svv/vid-feel/hot
							action: func [face value] compose [browse (url)]
						]
						bold [set-face-style self [bold]]
						italic [set-face-style self [italic]]
						underline [set-face-style self [underline]]
					]
					size: 1x1
					size: size-text self
					if pos/x + size/x > area/x [
						pos/y: pos/y + size/y
						pos/x: face/para/origin/x
						offset: pos
					]
					pos/x: pos/x + size/x + space
					if pos/y <= area/y [
						either all [
							old
							old/style = style
							style <> 'link
							old/offset/y = offset/y
						][
							insert insert tail old/text " " text
							size: size-text old
							old/size/x: size/x
							pos/x: old/offset/x + size/x + space
						][
							insert tail face/pane old: self
						]
					]
				]
			]
			if pos/y > area/y [break]
		]
		face/size: face/para/margin + second span? face/pane
	]

example: [
	view layout [
		Style Text+ Text with [
			append init [
				render-rich-text/link-colors self reduce [blue green]
			]
		]
		k: Text+ 200x20 {Simple text Simple *text* with /link/ to Rebol.it->http://www.rebol.it/} [
			print mold face/data
		]
	]
	dump-face k
	halt
]