REBOL [
    Title:     "The REB"
    Author:    "Carl Sassenrath"
    Date:      9-Aug-2000
    Version:   1.12.1
    File:      %demo41.r
    Rights:    "Copyright 2000 REBOL"
]

current-version: 0.9.9
public: system/options/home/public
site: http://www.rebol.com
web-site: http://www.rebol.com
img: load-thru site/view/ukiah.jpg
dl-file: join %view/rebol [
    current-version/2 
    either current-version/3 > 1 ["0"][""] current-version/3
    either system/version/4 > 1 ["0"][""] system/version/4
    system/version/5
    either system/version/4 = 3 [".exe"][""]
]

main-styles: stylize [
    smoke image [image: none color: none effect: [multiply 80]]
    gray-glass image [image: none color: none effect: [gradmul 0x1 60.60.60 128.128.128]]
    italic text [font: [style: 'italic]]
    btn button [size: 140x26 image: img effect: [crop 0x200 140x24 colorize 50.150.50]]
    t16 text [font: [size: 16 style: 'bold]]
    t10 text [font: [size: 10]]
    hdr image [font: [size: 16 align: 'center color: 255.255.100 style: 'bold] image: none color: none effect: [colorize 100.40.20]]
    bi image [set 'edge make face/edge [size: 3x3 color: 80.80.80 effect: 'bevel]]
    backflip backdrop [effect: [flip 1x0]]
    ----- image [size: 400x5 effect: [gradient 1x0 200.0.0 0.0.0]]
]

next-site: none
new-view: none
err-msg: ""
serv-err: "Service not available"

notify: func [msg err-face] [append clear err-msg msg show err-face]

uv: func [pane] [
    clear err-msg
    if new-view [unview/only new-view]
    new-view: view/new/offset pane reb-menu/offset + (reb-menu/size + 6 * 1x0)
]

write-dir: func [path data /local dir file] [
    set [dir file] split-path path
    if not exists? public/:dir [make-dir public/:dir]
    write/binary public/:path data
]

download: func [file err-face] [
    notify join "Downloading " file err-face
    either error? try [write-dir file read/binary site/:file][
        notify join "Error downloading " file err-face
        return false
    ][
        notify join "Download complete. Look in " public err-face
        return true
    ]
]

downdoc: func [file] [download file doc-mon]

downrip: func [file err] [
    if download file err [
        change-dir public
        do file
    ]
]

download-rebol: func [err /local] [
    download dl-file err
    ;[notify join "Saved:  " public/:dl-file err true]
]

reb-menu: layout [
    size 180x480
    styles main-styles
    backtile img blue
    hdr "REB Services" 140x40
    t10 (join "Updated " system/script/header/date/date) 140x20 center
    t16 bold 255.185.85 140x20 (either current-version > system/version ["Get Beta 4.1!"][""]) [uv reb-stat] center
    pad 10
    btn "Introduction"    [uv reb-intro]
    btn "Sites and Demos" [uv reb-demos]
    btn "Update Status" [uv reb-stat]
;    btn "About Beta 4.1"  [uv reb-install]
    btn "Documentation" [uv reb-docs]
    btn "Quit" [quit]
    at 20x380
    bi img 140x80 [browse web-site]
    at 20x440
    t10 "Visit WWW.REBOL.COM" 140x20 [browse web-site] center
]

reb-intro: layout [
    styles main-styles
    size 480x480
    backflip img gray-glass 440x440
    origin 26x26
    title "Welcome to the World Wide REB..."
    -----

    text {... We joke around calling it that. Certainly,
    REBOL won't replace the web, but we do think it adds a
    whole new dimension to it.    REBOL/View shares some of the
    same principles as the web, namely that simple content
    should be simple to create.     REBOL extends that to
    include the idea that simple interactivity should also be
    simple to create.}

    text {This REB site contains all of the latest documents
    and examples for REBOL/View.  In addition we'll be adding
    a directory of other REB sites that have useful content.
    Please visit often to look for new information and
    scripts.}

    indent 20 italic {-Carl Sassenrath, REBOL at Large}
]

reb-install: layout [
    styles main-styles
    size 480x480
    backflip img gray-glass 440x440
    origin 26x26

    title "Installing REBOL/View"
    ----- 
    text (reform [{To install, simply execute the REBOL
    program that just downloaded as}
    system/options/home/public/:dl-file])
    pad 20

    title "About Beta 4.1"
    -----

    text {Near final face definitions, styles, and layout.
    See changes document for more information. }

    text "--- The REBOL Team"
]

reb-stat: layout [
    styles main-styles
    size 480x480
    backflip img gray-glass 440x440
    origin 26x26
    title "REBOL/View Status"
    -----
    t16 (join "The current release is " current-version)
    t16 (join "You are running version " [system/version/1 "." system/version/2 "." system/version/3])
    t16 red (either current-version > system/version ["Your copy is out of date."][""])
    pad 20
    t16 (reform ["This REBOL is dated" system/build/date])
    t16 (reform ["This script is dated " system/script/header/date/date])
;    t16 (date: modified? system/options/home/rebol.exe
;        reform ["REBOL installed on" date/date])
    t16 (reform ["The current date is" now/date])
    pad 20
    btn "Download New REBOL" [if download-rebol dl-mon [wait 3 uv reb-install]]
    at 26x440
    dl-mon: text bold err-msg 240.40.40 500x60
]

d1: [downdoc %view/changes-view-b41.txt]
d2: [downdoc %view/.html]
d3: [downrip %view/users.rip doc-mon]
d4: [downdoc %view/cidtutorial.html]
browsedoc: func [file] [browse web-site/:file]

reb-docs: layout [
    size 480x480
    styles main-styles
    backflip img gray-glass 440x440
    origin 26x26
    title "Browse Documents:"
    -----
    t16 "REBOL Networking - New!" [browsedoc %docs/network.html]
    t16 "REBOL/View User's Guide (Prelim)" [browsedoc %view/docs/view-users.html]
    t16 "REBOL/View Beta 4.1 Changes" [browsedoc %view/changes-view-b41.txt]
    t16 "REBOL/Core User's Guide" [browsedoc %users.html]
    t16 "REBOL/Core Word Dictionary" [browsedoc %dictionary.html]

    title "Download Documents:"
    -----
;    t16 red "Documentation for Beta 4.1 is not ready."
    t16 "REBOL/View Beta 4.1 Changes" d1
    t16 "REBOL/Core Word Database (reboldoc.r)" [downdoc %reboldoc.r]

    title "Download Scripts:"
    -----
    t16 "Entire Script Library (200+ scripts, 150KB)" [downrip %library/library.rip demo-mon]

    at 26x440
    doc-mon: text bold err-msg 240.40.40 500x60
][
    t16 "REBOL/View Release Notes" d2
    t16 "REBOL/View User's Guide"  d3
    t16 "Creating Content in REBOL/View" d4
    t16 "Get all docs and view release notes" [
        foreach blk [d1 d2 d3 d4] [do blk]
        browse public/view/notes.html
    ]
]

rebsites: [
"REBOL Forces (Many scripts)" http://www.janita.com.au/rebolforces/reb/index.r 
"FX5 (Home of REBtris Game)" http://www.fx5.de 
"Isle of Arran" http://www.ross-gill.co.uk/arran.r 
"REBOL Big Guns" http://abooks.com/rebol/bigguns.reb 
"Gels Demo" http://www.rebol.com/view/gels.r 
"Pile of Buttons Demo" http://www.rebol.com/view/buttons.r 
"REBOL Credits" http://www.rebol.com/view/credits.r 
"Simple Layout Editor" http://www.rebol.com/view/layed.r 
"Minesweeper Game" http://www.rebol.com/view/mines.r 
"FX5 direct" http://www.sievertsen.de/REBOL/WWR.r 
][
"REBOL Forces" http://www.janita.com.au/rebolforces/reb/index.r 
"FX5" http://www.fx5.de 
"Isle of Arran" http://www.ross-gill.co.uk/arran.r 
"REBOL Big Guns" http://abooks.com/rebol/bigguns.reb 
"Gels Demo" http://www.rebol.com/view/gels.r 
"Pile of Buttons Demo" http://www.rebol.com/view/buttons.r 
"REBOL Credits" http://www.rebol.com/view/credits.r 
"Simple Layout Editor" http://www.rebol.com/view/layed.r 
][
	"REBOL Forces" http://www.janita.com.au/rebolforces/reb/index.r
	"FX5" http://www.fx5.de
]

snum: 0

reb-demos: layout [
    size 480x480
    styles main-styles
    backflip img gray-glass 440x440
    origin 26x26
    title "REB Site and Demo Directory"
    -----
	across
	vx: list 300x300 [
		rs1: text 300x20 font [size: 12 style: 'bold color: black shadow: none] [
	        unview/only new-view
        	inform layout [origin 40x40 backdrop img text bold rejoin [
        		"Connecting to " rs1/text "..."]]
			either vsrc/state [
				hide-popup
				t1/text: page: read f1/text: select rebsites rs1/text
				ttsize: size-text t1
				uv src-ed
			][
				if error? try [
					either ".r" == back back tail rs1/text [
						page: read select rebsites rs1/text
						hide-popup
						do page
					][
						hide-popup
						do select rebsites rs1/text
					]
				][
					demo-mon/text: reform ["Cannot connect to:" rs1/text]
					uv reb-demos
				]
			]
		]
	] supply [
		count: count + snum
		face/text: either count * 2 > length? rebsites [""][
			pick rebsites count * 2 - 1
		]
	]
	vv: slider 16x300 to-integer vx/size/y / rs1/size/y
		[snum: vv/data - 1 show vx]

    return
	vsrc: check  text "View Source First" return
	button "Add New Site or Demo" 180x24 [inform submit-new-site] with [rate: 4 effects: [[gradient 0x1 0.0.0 0.0.200] [gradient 0x1 0.0.200 0.0.0]]]
	text "(Added Immediately)"
	return
    demo-mon: text bold err-msg 240.40.40 480x40
]

submit-new-site: layout [
	style txt text 100x24 right
	style fld field 320x24
	backdrop effect [gradient 0x1 0.0.0 0.0.100]
	title "Enter Your REB Site Information:" font [size: 16]
	across
	pad 0x20
	txt "Site name:" n: fld return
	txt "Site URL:" u: fld "http://" return
	txt "Contact email:" e: fld return
	pad 110x10 button "Submit" [
		either all [
			err: "empty site name field"
			not empty? n/text
			err: "invalid site URL"
			u/text <> "http://"
			not error? try [url: load u/text]
			url? url
			err: "invalid email address"
			not error? try [t: load e/text]
			email? t
			err: "cannot connect"
			not error? try [
				replace n/text " " "%20"
				r: read join http://demo.rebol.net/cgi-bin/newsite.r? [
					"name=" n/text "&site=" u/text "&email=" e/text
				]
			]
			append rebsites n/text
			append rebsites url
			'none = err: load r
		][
			demo-mon/text: "Updated."
			clear err-face/text
			show err-face
			hide-popup
			show [demo-mon vx]
		][
			err-face/text: reform ["Error: " err "  Try again."]
			show err-face
		]
	]
	button "Clear" [
		clear n/text
		append clear u/text "http://"
		clear e/text
		clear err-face/text
		system/view/caret: none
		system/view/focal-face: none
		show [n u e err-face]
	]
	button "Cancel" [hide-popup]
	return
	pad 110x0 err-face: text bold red 330x24
]

src-ed: layout [
    size 660x480
	space 6 across pad 0x5
	text bold "File:" f1: field 400x24
	button "Do" 60x24 [do t1/text]
	button "Close" 60x24 [uv reb-demos]
	return h1: space 0
	t1: area 600x400 with [
		color: 240.240.240 
		font: [name: font-fixed]
		feel: make feel [redraw: none]
	] para [origin: 4x4]
	s1: slider 16x400 [
		t1/para/origin/y: s1/data - 1 * ttsize/y / -400 + 2
		t1/line-list: none show t1
	]
	at h1 + 0x400 s2: slider 600x16 [
		t1/para/origin/x: s2/data - 1 * ttsize/x / -600 + 2 
		t1/line-list: none show t1
	]
]

view/new reb-menu
uv reb-demos
do-events