REBOL [
Title: "Freeze"
Date: 3-Jul-2002
Name: Freeze
Version: 1.0.0
File: %Freeze.r
Author: "Andrew Martin"
Purpose: "Freezes an object sea."
Email: Al.Bri@xtra.co.nz
Web: http://valley.150m.com
Category: [util db file 5]
Acknowledgements: "Romano Paolo Tenca"
]
make object! [
Magic: '. ; This must be the same as the 'Melt function!
Find-Same: func [Series [series!] Value [any-type!]] [
while [
all [
found? Series: find/only/case Series :Value
not same? first Series :Value
]
][
Series: next Series
]
Series
]
Freeze-Value: function [Sea [block!] Fish] [Path Value Index] [
if all [
not lit-path? :Fish
not path? :Fish
any [
function? :Fish
object? :Fish
series? :Fish
]
] [
Path: make path! reduce [Magic]
Value: either series? :Fish [head :Fish] [:Fish]
either found? Index: Find-Same Sea :Value [
Index: index? Index
] [
append/only Sea :Value
Index: length? Sea
]
append :Path Index
if all [
series? :Fish
1 < Index: index? Fish
] [
append/only :Path Index
]
Fish: :Path
]
:Fish
]
set 'Freeze function ["Freezes Object Sea" Sea [block!]] [Block Object] [
foreach Fish Sea [
switch type?/word :Fish [
block! [
Block: Fish
forall Block [
Block/1: Freeze-Value Sea pick Block 1
]
]
object! [
Object: Fish
foreach Word next first Object [
set in Object Word Freeze-Value Sea get in Object Word
]
]
]
]
Sea ; At this point, the 'Sea has become ice. :)
]
]