|
|
|
Démo - Source CodeTest rebol plug-in |
|
REBOL [Title: "Demo Submission" Version: 1.0.0 Author: "Carl Sassenrath"]
dev-name: ""
dev-pass: ""
demo-name: ""
demo-size: 0x0
demo-file: none
demo-path: none
file-list: []
txt-wide: 520
system/options/binary-base: 64
safe-name: func [name] [
name: lowercase copy name
replace/all name " " "-"
]
post-demo: func ['cmd args] [
result: attempt [
cmd: mold/only reduce [cmd reduce args]
;?? cmd
cmd: compress cmd
read/custom http://www.rebol.net/cgi-bin/projects/post-demo.r reduce ['post cmd]
]
if not result [alert "An error occurred trying to send data to the server." return false]
if find result "script error" [alert result quit]
;?? result
load result
]
;print post-demo purge [] halt
missing?: func [face] [empty? trim get-face face]
panels: [
;-- Logon panel:
[
if exists? %user-name.r [
info: load %user-name.r
set-face f-name info/1
set-face f-email info/2
set-face r-ip info/3 = 'true
set-face r-pass not get-face r-ip
]
]
[
across
h2 "To submit a demo..." return
text txt-wide {Before you can submit a demo you need an account.
Enter a logon name (new or old) and an email address (optional,
but required to contact you if necessary):} return
lab 50 "Name:" f-name: field 180
lab 50 "Email:" f-email: field return
pad 0x8
h2 "To confirm that it is you..." return
text txt-wide {
So that only you can make changes to your scripts, you
will need to provide validation. Enter a password below
(DO NOT use your system password), or if you use a fixed
IP address, we will accept that as validation.
} return
indent 30 r-pass: radio-line bold "Provide password:" on
f-pass: field 120 return
indent 30 r-ip: radio-line bold "Use my IP address (no password needed)" return
text txt-wide {When you click "Next" below, you will be validated.}
]
[
if missing? f-name [alert "A name is required." return false]
if all [get-face r-pass empty? get-face f-pass] [alert "A password or IP is needed." return false]
dev-name: get-face f-name
dev-pass: either get-face r-pass [get-face f-pass]['ip]
flash "Confirming user..."
ok: post-demo logon [dev-name dev-pass]
unview
if not ok [return false]
either ok/1 = 'ok [
save %user-name.r reduce [dev-name get-face f-email get-face r-ip]
prior-demos: ok/2
true
] [alert "Invalid name or password. Try again." false]
]
;-- Demo info:
[
if missing? f-author [set-face f-author get-face f-name]
clear f-apps/data
foreach demo prior-demos [append f-apps/data demo/title]
f-apps/update
]
[
across
h2 "Demo information needed:" return
p-1: text 400 {Provide a short title for the demo (as it appears on the demo page).
If this is an update, click the title from the "prior demos" list.} return
lab "Title:" f-title: field return
text 400 {Who is the author? Please give proper credit to who wrote the demo.} return
lab "Author:" f-author: field return
text 400 {What is the size of the demo window (within the browser page)?} return
lab "Width:" f-wide: field 60
lab 50 "Height:" f-high: field 60 return
text 400 {Provide a short one line description of the demo:} return
f-info: field 400 return
below return
space 0 pad 20
text white coal 120 bold "Your Prior Demos"
f-apps: text-list 120x240 [
foreach demo prior-demos [
if value = demo/title [
set-face f-title demo/title
set-face f-author demo/author
set-face f-wide demo/area/x
set-face f-high demo/area/y
set-face f-info demo/info
demo-file: join demo/file %.r
break
]
]
]
]
[
if missing? f-title [alert "A title is required." return false]
if missing? f-author [alert "An author is required." return false]
if missing? f-wide [alert "A width is required." return false]
if missing? f-high [alert "A height is required." return false]
if error? try [
demo-size: load join get-face f-wide ["x" get-face f-high]
if not pair? demo-size [cause-error]
][alert "Invalid size (width and or height) value" return false]
if missing? f-info [alert "Short description is required." return false]
demo-name: safe-name get-face f-title
]
;-- File info:
[
set-face f-url dirize join http://www.rebol.net/plugin/demos/ demo-name
if demo-file [set-face f-file demo-file]
]
[
across
h2 "Demo script and file details:" return
text txt-wide {Specify the REBOL script file name used for your demo:} return
lab "Script:" btn "Find File" [
demo-path: request-file/only/keep
if demo-path [
if not script? demo-path [alert reform ["Not a valid REBOL script:" demo-path] exit]
set-face f-file demo-file: second split-path demo-path
]
]
f-file: info silver return
text txt-wide {If additional files are needed, specify them here. They will
be uploaded to our server for use by your script.} return
indent 35
f-list: text-list 180x70
b1: btn 75 "Add File" [
value: request-file/keep
if value [
foreach file value [
tmp: second split-path file
if not find file-list tmp [
repend file-list [tmp file]
append f-list/data tmp
show f-list/update
]
]
]
]
at b1/offset + 0x30
btn 75 "Remove File" [
remove find f-list/data get-face f-list
remove/part find file-list get-face f-list 2
show f-list/update
]
return
text txt-wide bold red / 2 {Be sure to modify your script to refer to the correct URL
path used by these additional files (if used). The URL will be:} return
f-url: info txt-wide silver return
]
[
if not demo-path [demo-path: demo-file]
if not demo-file [alert "Script file is required." return false]
true
]
;-- Upload data:
[
f-done/color: 200.0.0
set-face f-done "Uploading..."
file-data: copy []
if not exists? demo-path [alert reform [demo-path "was not found"] exit]
repend file-data [demo-file read/binary demo-path]
foreach [name file] file-list [repend file-data [name read/binary file]]
ok: post-demo upload [
'user dev-name
'pass dev-pass
'email get-face f-email
'title get-face f-title
'author get-face f-author
'size demo-size
'info get-face f-info
'files file-data
]
f-done/color: 0.0.0
set-face f-done either ok/1 = 'ok [
set-face f-detail trim/lines {Your submission has been accepted and will
be reviewed for publication on the demo page soon. Thanks!}
"Upload accepted"
][
set-face f-detail trim/lines {Something is wrong. Check that you are not
using a demo title or file name that has already been used by
someone else.}
form ok
]
]
[
across
h2 "Demo is being updated..." return
text txt-wide {Do not close this window until the indicator below shows that
the upload is complete.} return
indent 30
f-done: text 200 white 200.0.0 bold return
f-detail: text as-pair txt-wide 50 return
text bold blue underline "View list of new demos." [browse http://www.rebol.net/plugin/demos/new-demos/index.html]
]
[quit]
]
form-size: 0x0
panes: []
befores: []
afters: []
foreach [before panel after] panels [
append panes panel: layout panel
panel/offset: 0x0
panel/color: none
form-size: max form-size panel/size
append befores does before
append afters does after
]
this-panel: none
pick-panel: func [n] [
if pick panes n [
this-panel: max 1 min n length? panes
b-panel/pane: pick panes n
show b-panel
do pick befores n
show b-panel
]
]
do-panel: does [
if do pick afters this-panel [
pick-panel this-panel + 1
]
]
out: layout [
vh1 "REBOL Plugin Demo Submission"
b-panel: box form-size frame coal 1x1 with [color: none]
across
pad form-size/x - 140
btn-cancel 65 "Back" [pick-panel this-panel - 1]
btn-enter 65 "Next" [do-panel]
]
pick-panel 1
out/effect: reduce ['gradient 0x1 water + 60 tan + 20]
view out |
