Rebol Programming/Examples

You may try out the following examples, launching do followed by one of the link below: http://www.rebol.com/view/demos/clock.r http://www.rebol.com/view/demos/retro-clock.r http://www.rebol.com/view/demos/easy-vid.r http://www.rebol.com/view/demos/effect-lab.r http://www.rebol.com/view/demos/emailer.r http://www.rebol.com/view/demos/feedback.r http://www.rebol.com/view/demos/gel.r http://www.rebol.com/view/demos/rebodex.r http://www.rebol.com/view/demos/vball-vid.r http://www.rebol.com/view/demos/paint.r http://www.rebol.com/view/demos/splash.r http://www.rebol.com/view/demos/bubbles.r http://www.rebol.com/view/demos/warp-image.r http://www.rebol.com/view/demos/particles.r http://www.rebol.com/view/demos/tiger.r http://www.rebol.com/view/demos/tiger-boom.r http://www.rebol.com/view/demos/imagination.r http://www.rebol.com/view/demos/pointillize.r http://www.rebol.com/view/demos/rzoom.r http://www.rebol.com/view/demos/spiral.r http://www.rebol.com/view/demos/reb-circle.r http://www.rebol.com/view/demos/gismo.r http://www.rebol.com/rebgui-demo.r http://www.rebol.com/scripts/pongo.r or copy and paste in the console the code of the following examples: REBOL [ Title: "Calculator" Version: 1.2.2 Purpose: {Simple numeric calculator.} ] auto-clear: true calculate: does [ if error? try [text-box/text: form do text-box/text][ text-box/text: "Error" text-box/color: red ] auto-clear: true show text-box ] clear-box: does [ clear text-box/text text-box/color: snow auto-clear: false show text-box ] calculator: layout [ style btn btn 40x24 style kc btn red [clear-box] style k= btn [calculate] style k btn [ if auto-clear [clear-box] append text-box/text face/text show text-box ] origin 10 space 4 backeffect base-effect text-box: field "0" 172x24 bold snow right feel none pad 4 across kc "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"] return key keycode [#"^(ESC)" #"^q"] [quit] ] view center-face calculator REBOL [ title: "REBtris" author: "Frank Sievertsen" version: 1.0.2 date: 2-Apr-2001 ;30-Jul-2000 copyright: "Freeware" ] rebtris: context [ field-size: 10x20 stone-size: 20x20 stones: { xxxx xxx x xxx x xxx x xx xx xx xx xx xx } walls: none lay: none pan: none stone: none akt-falling: none stoning: none pause: no points: 0 points-pane: none level: 1 preview: none start-button: none new-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: preview ex: preview/pane/1/pane col: poke 200.200.200 random 3 0 col: poke col random 3 0 forall ex [ change ex make first ex compose/deep [effect: [gradient 1x1 (col) (col / 2)]] ] preview/pane/1/rotate/norot preview/pane/1/offset: preview/size - preview/pane/1/size / 2 if not akt-falling [new-start exit] akt-falling/parent-face: pan akt-falling/offset: field-size * 1x0 / 2 - 1x0 * stone/size points: points + level show [points-pane preview pan akt-falling] ] init: func [/local ex] [ walls: copy/deep [[]] akt-column: akt-row: 1 layout [ 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: none rotate: 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/x miny: face/offset/y ] minx: min minx face/offset/x miny: min miny face/offset/y ] maxx: maxy: 0 foreach face pane [ face/offset/x: face/offset/x - minx face/offset/y: face/offset/y - miny maxx: max maxx face/offset/x maxy: max maxy face/offset/y ] size: stone/size + to-pair reduce [maxx maxy] ] poses: func [/local out] [ out: make block! length? pane foreach face pane [ append out offset + face/offset + face/size ] out ] legal?: func [/local val out] [ out: make block! length? pane foreach val out: poses [ if any [ val/x > pan/size/x val/y > pan/size/y val/x < stone/size/x val/y < stone/size/y find stoning val ] [ restore-pos return false ] ] save-pos out ] del-line: func [num /local pos changed maxy] [ foreach pos poses [ either pos/y = num [ remove pane changed: yes ] [ if pos/y < num [changed: yes pane/1/offset/y: pane/1/offset/y + stone/size/y] pane: next pane ] ] pane: head pane if changed [ maxy: 0 foreach p pane [ maxy: max maxy p/offset/y ] size/y: maxy + stone/size/y show self ] ] save-pos: func [] [ old-pos: make block! 2 + length? pane repend/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-pos pos: next old-pos foreach face pane [ face/offset: pos/1/1 pos: next pos ] ] ] ] ex/pane: copy [] foreach pos first walls [ append ex/pane make stone [offset: pos - 1x1 * stone/size] ] change walls ex stoning: copy [] ] walls: head walls lay: 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-falling append stoning tmp: akt-falling/legal? check-lines new-start if not akt-falling/legal? [akt-falling: none start-button/text: "Start" show start-button] eat-queue exit ] show akt-falling ] ] ] ] ] ] return banner "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: tmp face/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/2 if not pan/pane [pan/pane: copy []] preview: lay/pane/5 if not preview/pane [preview/pane: copy []] remove find pan/pane sens insert lay/pane sens ] check-lines: func [/local lines full tmp pos] [ lines: head insert/dup make block! field-size/y 0 field-size/y full: copy [] foreach e stoning [ e: e / stone/size poke lines e/y tmp: (pick lines e/y) + 1 if tmp = field-size/x [append full e/y] ] sort full foreach e full [ foreach face pan/pane [ face/del-line e * stone/size/y ] pos: pan/pane forall pos [ while [all [not tail? pos empty? pos/1/pane]] [hide pos/1 remove pos] ] points: 100 + points show points-pane ] clear stoning foreach face pan/pane [ append stoning face/poses ] ] akt-column: akt-row: 1 tabs: [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 = 'key not system/view/focal-face find [up down left right #"p"] event/key akt-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-falling return none ] event ] in rebtris 'self if any [not system/script/args empty? form system/script/args] [ random/seed now rebtris/init view rebtris/lay ]