Rebol Programming/Examples
Tools
General
Sister projects
In other projects
You may try out the following examples, launchingdo followed by one of the link below:
or copy and paste in the console the code of the following examples:
REBOL [Title: "Calculator"Version: 1.2.2Purpose: {Simple numeric calculator.}]auto-clear: truecalculate: does [if error? try [text-box/text: form do text-box/text][text-box/text: "Error"text-box/color: red]auto-clear: trueshow text-box]clear-box: does [clear text-box/texttext-box/color: snowauto-clear: falseshow text-box]calculator: layout [ style btn btn 40x24style kc btn red [clear-box]style k= btn [calculate]style k btn [if auto-clear [clear-box]append text-box/text face/textshow text-box]origin 10 space 4backeffect base-effecttext-box: field "0" 172x24 bold snow right feel nonepad 4acrosskc "C" keycode [#"C" #"c" page-down]k "(" #"(" k ")" #")" k " / " #"/" return k "7" #"7" k "8" #"8" k "9" #"9" k " * " #"*" return k "4" #"4" k "5" #"5" k "6" #"6" k " - " #"-" return k "1" #"1" k "2" #"2" k "3" #"3" k " + " #"+" return k "0" #"0" k "-" k "." #"."k= green "=" keycode [#"=" #"^m"] returnkey keycode [#"^(ESC)" #"^q"] [quit]]view center-face calculatorREBOL [title: "REBtris"author: "Frank Sievertsen"version: 1.0.2date: 2-Apr-2001 ;30-Jul-2000copyright: "Freeware"]rebtris: context [field-size: 10x20stone-size: 20x20stones: {xxxxxxx xxxxxxxx xxx xx xxxxxxxx}walls: nonelay: nonepan: nonestone: noneakt-falling: nonestoning: nonepause: nopoints: 0points-pane: nonelevel: 1preview: nonestart-button: nonenew-start: func [/local ex col rnd] [if not empty? preview/pane [hide preview/pane/1 insert pan/pane akt-falling: preview/pane/1 clear preview/pane ]insert preview/pane make pick walls random length? walls []preview/pane/1/parent-face: previewex: preview/pane/1/panecol: poke 200.200.200 random 3 0col: poke col random 3 0forall ex [change ex make first ex compose/deep [effect: [gradient 1x1 (col) (col / 2)]]]preview/pane/1/rotate/norotpreview/pane/1/offset: preview/size - preview/pane/1/size / 2if not akt-falling [new-start exit]akt-falling/parent-face: panakt-falling/offset: field-size * 1x0 / 2 - 1x0 * stone/sizepoints: points + levelshow [points-pane preview pan akt-falling]]init: func [/local ex] [walls: copy/deep [[]]akt-column: akt-row: 1layout [stone: image (stone-size) 200.200.0 effect [gradient 1x1 200.200.0 100.100.0]]if not parse/all stones [newline tabs some [end-up | no-stone | one-stone | new-row | new-wall]][make error! [user message "parse error"]]forall walls [layout [ex: box 100x100 with [old-pos: nonerotate: func [/norot /local minx miny maxx maxy] [foreach face pane [if not norot [face/offset: reverse face/offset * -1x1]if none? minx [minx: face/offset/xminy: face/offset/y]minx: min minx face/offset/xminy: min miny face/offset/y]maxx: maxy: 0foreach face pane [face/offset/x: face/offset/x - minxface/offset/y: face/offset/y - minymaxx: max maxx face/offset/xmaxy: max maxy face/offset/y]size: stone/size + to-pair reduce [maxx maxy]]poses: func [/local out] [out: make block! length? paneforeach face pane [append out offset + face/offset + face/size]out]legal?: func [/local val out] [out: make block! length? paneforeach val out: poses [if any [val/x > pan/size/xval/y > pan/size/yval/x < stone/size/xval/y < stone/size/yfind stoning val] [restore-posreturn false]]save-posout]del-line: func [num /local pos changed maxy] [foreach pos poses [either pos/y = num [remove panechanged: yes] [if pos/y < num [changed: yes pane/1/offset/y: pane/1/offset/y + stone/size/y]pane: next pane]]pane: head paneif changed [maxy: 0foreach p pane [maxy: max maxy p/offset/y]size/y: maxy + stone/size/yshow self]]save-pos: func [] [old-pos: make block! 2 + length? panerepend/only old-pos [offset size]foreach face pane [repend/only old-pos [face/offset]]]restore-pos: func [/local pos] [if not old-pos [exit]set [offset size] first old-pospos: next old-posforeach face pane [face/offset: pos/1/1pos: next pos]]]]ex/pane: copy []foreach pos first walls [append ex/pane make stone [offset: pos - 1x1 * stone/size]]change walls exstoning: copy []]walls: head wallslay: layout [backdrop effect [gradient 1x1 100.100.100 0.0.0]panel 0.0.0 effect [gradient 0x1 100.0.0 0.80.0] edge [color: gray size: 1x1] [size (field-size * stone/size)sens: sensor 1x1 rate 2 feel [engage: func [face action event /local tmp] [switch action [time [if pause [exit]if akt-falling [akt-falling/offset: akt-falling/offset + (stone/size * 0x1)if not akt-falling/legal? [show akt-fallingappend stoning tmp: akt-falling/legal?check-linesnew-startif not akt-falling/legal? [akt-falling: none start-button/text: "Start" show start-button]eat-queueexit]show akt-falling]]]]]]returnbanner "REBtris"vh1 "Frank Sievertsen" with [font: [size: 12]]panel 0.0.0 [size (stone/size * 5x4)]style button button with [effect: [gradient 1x1 180.180.100 100.100.100]]start-button: button "Start" [either akt-falling[start-button/text: "Start" show start-button akt-falling: none][sens/rate: 2 show sens start-button/text: "Stop" show start-button pause: no points: 0 if points-pane [show points-pane] clear pan/pane clear stoning show pan new-start]]button "Pause" [pause: not pause]vh1 "Level:"level-pane: banner "888" feel [redraw: func [face] [face/text: to-string level]] with [font: [align: 'left]]vh1 "Points:"points-pane: banner "88888888" feel [redraw: func [face /local mem tmp] [mem: [1]if mem/1 < (tmp: to-integer points / 1000) [level: level + 1 show level-pane sens/rate: level + 1 show sens]mem/1: tmpface/text: to-string points]] with [font: [align: 'left]]]lay/feel: make lay/feel [detect: func [face event] [if event/type = 'down [system/view/focal-face: none]event]]pan: lay/pane/2if not pan/pane [pan/pane: copy []]preview: lay/pane/5if not preview/pane [preview/pane: copy []]remove find pan/pane sensinsert lay/pane sens]check-lines: func [/local lines full tmp pos] [lines: head insert/dup make block! field-size/y 0 field-size/yfull: copy []foreach e stoning [e: e / stone/sizepoke lines e/y tmp: (pick lines e/y) + 1if tmp = field-size/x [append full e/y]]sort fullforeach e full [foreach face pan/pane [face/del-line e * stone/size/y]pos: pan/paneforall pos [while [all [not tail? pos empty? pos/1/pane]][hide pos/1 remove pos]]points: 100 + pointsshow points-pane]clear stoningforeach face pan/pane [append stoning face/poses]]akt-column: akt-row: 1tabs: [some "^(tab)"]end-up: [newline tab end]no-stone: [" "(akt-column: akt-column + 1)]one-stone: ["x"(append/only last walls to-pair reduce [akt-column akt-row])(akt-column: akt-column + 1)]new-row: [newline tabs(akt-row: akt-row + 1)(akt-column: 1)]new-wall: [newline newline tabs(akt-row: akt-column: 1)(append/only walls copy [])]eat-queue: func [/local port] [port: open [scheme: 'event]while [wait [port 0]] [error? try [first port]]close port]]insert-event-func func [face event] bind [if all [event/type = 'keynot system/view/focal-facefind [up down left right #"p"] event/keyakt-falling(not pause) or (event/key = #"p")] [switch event/key [left[akt-falling/offset: akt-falling/offset - (stone/size * 1x0)]right[akt-falling/offset: akt-falling/offset + (stone/size * 1x0)]down[akt-falling/offset: akt-falling/offset + (stone/size * 0x1)]up[akt-falling/rotate]#"p"[pause: not pause]]akt-falling/legal?show akt-fallingreturn none]event] in rebtris 'selfif any [not system/script/args empty? form system/script/args] [random/seed nowrebtris/initview rebtris/lay]