Rebol Programming/Examples

You may try out the following examples, launching do 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.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
]