[ALLY] View/swis
From: cyphre:volny:cz at: 4-Oct-2000 11:59
This is a multi-part message in MIME format...
------------=_970653573-20028-0
Content-Type: text/plain; charset=windows-1250
Content-Disposition: inline
Content-Transfer-Encoding: 7bit
Hello to all REBOL fans,
last weekend I spent few hours experimenting with REBOL/view because I wanted to make
our CHESSTER site (http://i.am/chesster) also in VIEW(f*** HTML ;)) so here is included
my result - "Small WIndow System"
It's only version 0.0.4 but maybe you will find it useful.
Thanks goes to REBOLek<[weirddream--volny--cz]> for nice gfx-buttons and for good ideas.
see ya...
Cyphre
[cyphre--volny--cz]
------------=_970653573-20028-0
Content-Type: text/x-rebol; name="C:\!a\swis.r"
Content-Disposition: inline; filename="C:\!a\swis.r"
Content-Transfer-Encoding: 7bit
REBOL [
Title: "Small WIndow System in Rebol/View "
Date: 4-Oct-2000
Version: 0.0.4
file: %swis.r
author: "[cyphre--volny--cz][weirddream--volny--cz]"
history: ["has to be written"]
]
inactive-win-color: 170.170.170
active-win-color: white
;;; window area
window-area: make face [
offset: -2x17
feel: make feel [
redraw: func [
face [object!]
action [word!]
offset [pair!]
][
face/size: to-pair reduce [face/parent-face/size/1 face/parent-face/size/2 - 19]
]
]
]
;..
;;; titlebar
win-titlebar: make face [
offset: 18x-1
color: active-win-color
; effect: [gradcol 1x0 green white ]
feel: make feel [
redraw: func [
face [object!]
action [word!]
offset [pair!]
][
face/text: to-string face/parent-face/title
face/size: to-pair reduce [face/parent-face/size/1 - 39 20]
]
engage: func [
face [object!] action [word!] event [event!]
/local iid
][
if find [down] action [
pos: event/offset
iid: last screen-face/pane
either not iid/id = face/parent-face/id [
remove (find screen-face/pane face/parent-face/id)
remove (find screen-face/pane face/parent-face/self)
face/color: active-win-color
deactivate-win
insert tail screen-face/pane reduce [face/parent-face/id face/parent-face/self]
show screen-face
][
if all [
(length? get-win-list) = 1
not face/color = active-win-color
][
face/color: active-win-color
show screen-face
]
]
]
if find [over away] action [
face/parent-face/offset: face/parent-face/offset + event/offset - pos
show face/parent-face
]
]
]
]
;..
;;; gadgets
hide-gadget: make face [
size: 20x20
color: 0.0.0
image: do decompress debase/base {eJzLTcxOVcjMTUxPVVSINjSvMD
RXUK7mMjCwAELyyFHNo5pHNRPWTBrggjFcTF1MSbEZqhmijRgS3Roi/YzddXg0E/
YOVs3EhgIXqRrQNJOqDaEej7MxDcUZz/gBdndhjWeINOGYx5NIhlCuIlpbbSwA1D
Zh5fsGAAA=} 64
feel: make feel [
redraw: func [
face [object!]
action [word!]
offset [pair!]
][
face/offset: to-pair reduce [face/parent-face/size/1 - face/size/1 - 2 -1]
]
engage: func [
face [object!] action [word!] event [event!]
][
if find [down] action [
either face/parent-face/old-win-size <> 20 [
face/parent-face/size/2: face/parent-face/old-win-size
face/parent-face/old-win-size: 20
][
face/parent-face/old-win-size: face/parent-face/size/2
face/parent-face/size/2: 20
]
show face/parent-face
]
]
]
]
size-gadget: make face [
size: 20x20
color: 0.0.0
image: do decompress debase/base {eJzLTcxOVcjMTUxPVVSINjSvMD
RXUK7mMjCwAELyyJGgGQJcTF1MaWUzMkDYQ0U/gwAX8faQYTMmoHaA4bOBiv
GMAFykBhJJ8YzLCxTZDNVM2AZcstSJZ2L8SVE8owOSAowozcR6gdJ4xqUIAh
yBAE+AEXYeLjVooU3lwmCwaeaqjQUAGqJfR/sGAAA=} 64
feel: make feel [
redraw: func [
face [object!]
action [word!]
offset [pair!]
][
face/offset: face/parent-face/size - face/size - 2
]
engage: func [
face [object!] action [word!] event [event!]
][
if find [down] action [
pos: event/offset
]
if find [over away] action [
if all [
(face/parent-face/size/1 + event/offset/1 - pos/1) > 70
(face/parent-face/size/2 + event/offset/2 - pos/2) > 50
][
face/parent-face/size: face/parent-face/size + event/offset - pos
show face/parent-face
]
]
]
]
]
close-gadget: make face [
offset: -1x-1
size: 20x20
color: 0.0.0
image: do decompress debase/base {eJzLTcxOVcjMTUxPVVSINjSvMD
RXUK7mMjCwAELyyEGvGRm4AQEZNhOlGRMgNBB0NmFtaJqJtQ1ZPRcpGkjWjM9FZI
Q2AnDBTCLVz0TZjA9wkRJIJMczPi+QnTGgzsYFaBJgiNghO4WRnLbRAUlRRbJmfC
4a0MLAEQgMDFxMXUwpDG0yNVMtY9BYM1dtLAD8mWKH+wYAAA==} 64
feel: make feel [
engage: func [
face [object!] action [word!] event [event!]
][
if find [down] action [
hide face/parent-face
remove (find screen-face/pane face/parent-face/id)
remove (find screen-face/pane face/parent-face/self)
]
]
]
]
;..
;;; window
window: func [
name [word!]
inside [block!]
backdrop [image! block!]
/siz
win-size
/pos
win-pos
/center
/local result
][
win-id: to-lit-word join "win" random 10000
result: [win-id make face [
id: win-id
title: name
if pos [offset: win-pos]
pane: reduce [
'wa
make window-area [
image: backdrop
effect: [fit]
pane: either (length? inside) = 0 [none][
either siz [layout/offset/size inside 0x0 win-size][layout/offset inside 0x0]
]
]
'cg
make close-gadget []
if (length? inside) = 0 ['sg make size-gadget [] ]
'wt
make win-titlebar []
'hg
make hide-gadget[]
]
either (length? inside) > 0 [size: to-pair reduce [first get in (get in select pane 'wa
'pane) 'size (second get in (get in select pane 'wa 'pane) 'size) + 20]][size: 190x120]
if center [ offset: (screen-face/size - size) / 2 ]
old-win-size: 20
]]
result
]
;..
get-win-list: func [
/local p list
] [
list: copy []
foreach p screen-face/pane [
if word? p [
append list p
]
]
list
]
close-win: func [
win-id
][
hide win-root
remove (find screen-face/pane win-id)
remove (find screen-face/pane win-root/self)
]
win-obj: func [
win-id
][
return select screen-face/pane win-id
]
deactivate-win: func [] [
if (length? get-win-list) > 0 [
active-win: win-obj (last get-win-list)
set in (select active-win/pane 'wt) 'color inactive-win-color
]
]
either exists? %bay.jpg [
bay: load %bay.jpg
][
view layout [
backdrop red
title "Only for trully REBOLers!"
h2 "You're not one of them -" white
h3 "order your legendary %bay.jpg today;)" white
]
quit
]
view screen-face: layout/size [
backdrop bay 60.90.150
; effect [fit gradcol 0x1 70.50.30]
title join "SWIS (small window system) v." system/script/header/version
button "welcome" [
deactivate-win
tux-page: 1
append screen-face/pane reduce window/center 'welcome [
backdrop effect [fit gradcol 2x2 70.50.30] ;70.70.60
title "Welcome to SWIS"
tux: text 180x80 {small window system by RUR}
button "more..." 50x20 [
switch tux-page [
1 [tux/text: {main code by Cyphre <[cyphre--volny--cz]>, gfx + add. code Rebolek <[weirddream--volny--cz]>,
written in 2000} tux-page: 2]
2 [tux/text: {SWIS has basic windowing functionality based on VIEW.} tux-page: 3 ]
3 [tux/text: {You can resize windows, close or hide them. You can remove them or make
new windows.} tux-page: 4]
4 [tux/text: {You can use VID dialect for creating window layout} tux-page: 1]
]
show tux
]
] []
show screen-face
]
button "resizeable window" [
deactivate-win
append screen-face/pane reduce window 'beautiful-picture-of-bay [] load %bay.jpg
show screen-face
]
button "feedback!" [
deactivate-win
append screen-face/pane reduce window 'marconni [
backdrop 0.0.0
text "Write your comment!"
aa: area 250x100
across
snd: button "Send" 50x20 [
send [[cyphre--volny--cz][weirddream--volny--cz]] join "SWIS auto-comment^/" aa/text
win-root: cl/parent-face/parent-face/parent-face close-win win-root/id
append screen-face/pane reduce window/center 'thanks [
backdrop 0.0.0
effect [gradcol 0x1 150.150.255]
h1 "Thank you for your comment!" 255.255.127
across
tab
cl: button "close me!" [win-root: cl/parent-face/parent-face/parent-face close-win win-root/id]
;this should be improved
] [] show screen-face
]
cl: button "Cancel" 50x20 [win-root: cl/parent-face/parent-face/parent-face close-win
win-root/id] ;this should be improved
] []
show screen-face
]
button "shutdown" [
deactivate-win
append screen-face/pane reduce window/center 'Shutdown [
backdrop effect [fit gradcol 2x2 70.50.30] ;70.70.60
h2 "Sure to shutdown SWIS?" 255.255.100
across
pad 40
button "OK" 50x20 [unview/all quit]
close: button "Cancel" 50x20 [win-root: close/parent-face/parent-face/parent-face close-win
win-root/id] ;this should be improved
] []
show screen-face
]
text 250.250.250 "Created on 50MHz Amigas (one killer 68060 and one mega-death 68030)"
] 512x384
------------=_970653573-20028-0--
