REBOL [
    Title: "Custom type: complex!"
    Purpose: {
        To provide an example custom type
    }
    Author: "Gabriele Santilli"
    EMail: giesse@rebol.it
    File: %complex.r
    License: {
Copyright (C) 2003  Gabriele Santilli

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

http://www.gnu.org/copyleft/gpl.html
    }
    Date: 15-Oct-2004
    Version: 1.2.0 ; majorv.minorv.status
                   ; status: 0: unfinished; 1: testing; 2: stable
    History: [
        15-Oct-2004 1.1.0 "History start"
        15-Oct-2004 1.2.0 "First version"
    ]
]

; define custom actions here
define-action 'angle [
    "Returns the angle of a complex! in polar coordinates"
    value [object!]
]

complex?: func [value [any-type!]] ['complex! = type?* get/any 'value]

; type definition

define-type 'complex! [
    x: y: 0
    r: does [abs* self]
    theta: does [angle self]
] [
    ; type actions. please support all standard actions (possibly throwing an error)
    
    add' ; action name
    ;[
    ;    "Returns the result of adding two values." [catch] 
    ;    value1 [number! pair! char! money! date! time! tuple! object!] 
    ;    value2 [number! pair! char! money! date! time! tuple! object!]
    ;]
    [ ] ; local words for this action
    [
        if not complex? value2 [
            value2: to* complex! value2
        ]
        make value1 [x: x + value2/x y: y + value2/y]
    ]
    
    subtract'
    ;[
    ;    {Returns the second value subtracted from the first.} [catch] 
    ;    value1 [number! pair! char! money! date! time! tuple! object!] 
    ;    value2 [number! pair! char! money! date! time! tuple! object!]
    ;]
    [ ]
    [
        if not complex? value2 [
            value2: to* complex! value2
        ]
        make value1 [x: x - value2/x y: y - value2/y]
    ]
    
    multiply'
    ;[
    ;    "Returns the first value multiplied by the second." [catch] 
    ;    value1 [number! pair! char! money! time! tuple! object!] 
    ;    value2 [number! pair! char! money! time! tuple! object!]
    ;]
    [ ]
    [
        if not complex? value2 [
            value2: to* complex! value2
        ]
        make value1 [x: x * value2/x - (y * value2/y)  y: value1/x * value2/y + (y * value2/x)]
    ]
    
    divide'
    ;[
    ;    "Returns the first value divided by the second." [catch] 
    ;    value1 [number! pair! char! money! time! tuple! object!] 
    ;    value2 [number! pair! char! money! time! tuple! object!]
    ;]
    [r1 r2 t1 t2]
    [
        if not complex? value2 [
            value2: to* complex! value2
        ]
        r1: abs* value1
        r2: abs* value2
        t1: angle value1
        t2: angle value2
        r1: r1 / r2
        t1: t1 - t2
        make value1 [x: r1 * cosine t1  y: r1 * sine t1]
    ]
    
    remainder'
    ;[
    ;    {Returns the remainder of first value divided by second.} [catch] 
    ;    value1 [number! pair! char! money! time! tuple! object!] 
    ;    value2 [number! pair! char! money! time! tuple! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :value1]
    ]
    
    power'
    ;[
    ;    {Returns the first number raised to the second number.} [catch] 
    ;    number [number! object!] 
    ;    exponent [number! object!]
    ;]
    [rr t]
    [
        if not number? exponent [throw make error! reduce ['script 'invalid-arg exponent]]
        rr: abs* number
        t: angle number
        rr: rr ** exponent
        t: t * exponent
        make number [x: rr * cosine t  y: rr * sine t]
    ]
    
    and~'
    ;[
    ;    "Returns the first value ANDed with the second." [catch] 
    ;    value1 [logic! number! char! tuple! binary! image! object!] 
    ;    value2 [logic! number! char! tuple! binary! image! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :value1]
    ]
    
    or~'
    ;[
    ;    "Returns the first value ORed with the second." [catch] 
    ;    value1 [logic! number! char! tuple! binary! image! object!] 
    ;    value2 [logic! number! char! tuple! binary! image! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :value1]
    ]
    
    xor~'
    ;[
    ;    {Returns the first value exclusive ORed with the second.} [catch] 
    ;    value1 [logic! number! char! tuple! binary! image! object!] 
    ;    value2 [logic! number! char! tuple! binary! image! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :value1]
    ]
    
    same?'
    ;[
    ;    "Returns TRUE if the values are identical." [catch] 
    ;    value1 
    ;    value2
    ;]
    [ ]
    [
        equal?* value1 :value2
    ]
    
    equal?'
    ;[
    ;    "Returns TRUE if the values are equal." [catch] 
    ;    value1 value2
    ;]
    [ ]
    [
        if not complex? :value2 [
            value2: to* complex! :value2
        ]
        all [value1/x = value2/x  value1/y = value2/y]
    ]
    
    strict-equal?'
    ;[
    ;    {Returns TRUE if the values are equal and of the same datatype.} [catch] 
    ;    value1 value2
    ;]
    [ ]
    [
        all [complex? :value2  value1/x = value2/x  value1/y = value2/y]
    ]
    
    not-equal?'
    ;[
    ;    "Returns TRUE if the values are not equal." [catch] 
    ;    value1 value2
    ;]
    [ ]
    [
        if not complex? :value2 [
            value2: to* complex! :value2
        ]
        any [value1/x <> value2/x  value1/y <> value2/y]
    ]
    
    strict-not-equal?'
    ;[
    ;    {Returns TRUE if the values are not equal and not of the same datatype.} [catch] 
    ;    value1 value2
    ;]
    [ ]
    [
        any [not complex? :value2  value1/x <> value2/x  value1/y <> value2/y]
    ]
    
    greater?'
    ;[
    ;    {Returns TRUE if the first value is greater than the second value.} [catch] 
    ;    value1 value2
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :value1]
    ]
    
    lesser?'
    ;[
    ;    {Returns TRUE if the first value is less than the second value.} [catch] 
    ;    value1 value2
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :value1]
    ]
    
    greater-or-equal?'
    ;[
    ;    {Returns TRUE if the first value is greater than or equal to the second value.} [catch] 
    ;    value1 value2
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :value1]
    ]
    
    lesser-or-equal?'
    ;[
    ;    {Returns TRUE if the first value is less than or equal to the second value.} [catch] 
    ;    value1 value2
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :value1]
    ]
    
    negate'
    ;[
    ;    "Changes the sign of a number." [catch] 
    ;    number [number! pair! money! time! bitset! object!]
    ;]
    [ ]
    [
        make number [x: - x  y: - y]
    ]
    
    complement'
    ;[
    ;    "Returns the one's complement value." [catch] 
    ;    value [logic! number! char! tuple! bitset! object!]
    ;]
    [ ]
    [
        make number [x: - x  y: - y]
    ]
    
    random'
    ;[
    ;    "Returns a random value of the same datatype." [catch] 
    ;    value "Maximum value of result" 
    ;    /seed "Restart or randomize" 
    ;    /secure "Returns a cryptographically secure random number." 
    ;    /only "Return single value from series."
    ;]
    [ ]
    [
        if seed [throw make error! reduce ['script 'invalid-arg :value]]
        either secure [
            make value [x: random/secure x  y: random/secure y]
        ] [
            make value [x: random x  y: random y]
        ]
    ]
    
    odd?'
    ;[
    ;    "Returns TRUE if the number is odd." [catch] 
    ;    number [number! char! date! money! time! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :number]
    ]
    
    even?'
    ;[
    ;    "Returns TRUE if the number is even." [catch] 
    ;    number [number! char! date! money! time! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :number]
    ]
    
    negative?'
    ;[
    ;    "Returns TRUE if the number is negative." [catch] 
    ;    number [number! char! money! time! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :number]
    ]
    
    positive?'
    ;[
    ;    "Returns TRUE if the value is positive." [catch] 
    ;    number [number! char! money! time! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :number]
    ]
    
    zero?'
    ;[
    ;    "Returns TRUE if the number is zero." [catch] 
    ;    number [number! pair! char! money! time! tuple! object!]
    ;]
    [ ]
    [
        all [zero? number/x  zero? number/y]
    ]
    
    head'
    ;[
    ;    "Returns the series at its head." [catch] 
    ;    series [series! port! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    tail'
    ;[
    ;    {Returns the series at the position after the last value.} [catch] 
    ;    series [series! port! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    head?'
    ;[
    ;    "Returns TRUE if a series is at its head." [catch] 
    ;    series [series! port! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    tail?'
    ;[
    ;    "Returns TRUE if a series is at its tail." [catch] 
    ;    series [series! port! bitset! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    next'
    ;[
    ;    "Returns the series at its next position." [catch] 
    ;    series [series! port! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    back'
    ;[
    ;    "Returns the series at its previous position." [catch] 
    ;    series [series! port! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    skip'
    ;[
    ;    {Returns the series forward or backward from the current position.} [catch] 
    ;    series [series! port! object!] 
    ;    offset [number! logic! pair!] "Can be positive, negative, or zero."
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    at'
    ;[
    ;    "Returns the series at the specified index." [catch] 
    ;    series [series! port! object!] 
    ;    index [number! logic! pair!] "Can be positive, negative, or zero."
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    index?'
    ;[
    ;    {Returns the index number of the current position in the series.} [catch] 
    ;    series [series! port! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    length?'
    ;[
    ;    {Returns the length of the series from the current position.} [catch] 
    ;    series [series! port! tuple! bitset! struct! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    pick'
    ;[
    ;    {Returns the value at the specified position in a series.} [catch] 
    ;    series [series! pair! event! money! date! time! object! port! tuple! any-function!] 
    ;    index [number! logic! pair!]
    ;]
    [ ]
    [
        if not integer? index [throw make error! reduce ['script 'invalid-arg :index]]
        if not find [1 2] index [throw make error! [script past-end]]
        get in series pick [x y] index
    ]
    
    last'
    ;[
    ;    "Returns the last value of a series." [catch] 
    ;    series [series! port! tuple! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    find'
    ;[
    ;    {Finds a value in a series and returns the series at the start of it.} [catch] 
    ;    series [series! port! bitset! object!] 
    ;    value [any-type!] 
    ;    /part "Limits the search to a given length or position." 
    ;    range [number! series! port! object!] 
    ;    /only "Treats a series value as a single value." 
    ;    /case "Characters are case-sensitive." 
    ;    /any "Enables the * and ? wildcards." 
    ;    /with "Allows custom wildcards." 
    ;    wild [string!] "Specifies alternates for * and ?" 
    ;    /skip "Treat the series as records of fixed size" 
    ;    size [integer!] 
    ;    /match {Performs comparison and returns the tail of the match.} 
    ;    /tail "Returns the end of the string." 
    ;    /last "Backwards from end of string." 
    ;    /reverse "Backwards from the current position."
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    select'
    ;[
    ;    {Finds a value in the series and returns the value or series after it.} [catch] 
    ;    series [series! port! object!] 
    ;    value [any-type!] 
    ;    /part "Limits the search to a given length or position." 
    ;    range [number! series! port! object!] 
    ;    /only "Treats a series value as a single value." 
    ;    /case "Characters are case-sensitive." 
    ;    /any "Enables the * and ? wildcards." 
    ;    /with "Allows custom wildcards." 
    ;    wild [string!] "Specifies alternates for * and ?" 
    ;    /skip "Treat the series as records of fixed size" 
    ;    size [integer!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    make'
    ;[
    ;    "Constructs and returns a new value." [catch] 
    ;    type [any-type!] "The datatype or example value." 
    ;    spec [any-type!] "The attributes of the new value."
    ;]
    [ ]
    [
        switch/default type?* :spec [
            block! [make type [x: any [pick spec 1 0] y: any [pick spec 2 0]]]
            decimal! [make type [x: spec y: 0]]
            integer! [make type [x: spec y: 0]]
            none! [make type [x: y: 0]]
            pair! [make type [x: spec/x y: spec/y]]
            complex! [make spec [ ]]
        ] [
            throw make error! reduce ['script 'invalid-arg :spec]
        ]
    ]
    
    copy'
    ;[
    ;    "Returns a copy of a value." [catch] 
    ;    value [series! port! bitset! object!] "Usually a series" 
    ;    /part "Limits to a given length or position." 
    ;    range [number! series! port! pair! object!] 
    ;    /deep "Also copies series values within the block."
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :value]
    ]
    
    insert'
    ;[
    ;    {Inserts a value into a series and returns the series after the insert.} [catch] 
    ;    series [series! port! bitset! object!] "Series at point to insert" 
    ;    value [any-type!] "The value to insert" 
    ;    /part "Limits to a given length or position." 
    ;    range [number! series! port! pair! object!] 
    ;    /only "Inserts a series as a series." 
    ;    /dup "Duplicates the insert a specified number of times." 
    ;    count [number! pair!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    remove'
    ;[
    ;    {Removes value(s) from a series and returns after the remove.} [catch] 
    ;    series [series! port! bitset! none! object!] 
    ;    /part "Removes to a given length or position." 
    ;    range [number! series! port! pair! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    change'
    ;[
    ;    {Changes a value in a series and returns the series after the change.} [catch] 
    ;    series [series! port! object!] "Series at point to change" 
    ;    value [any-type!] "The new value" 
    ;    /part {Limits the amount to change to a given length or position.} 
    ;    range [number! series! port! pair! object!] 
    ;    /only "Changes a series as a series." 
    ;    /dup "Duplicates the change a specified number of times." 
    ;    count [number! pair!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    poke'
    ;[
    ;    {Returns value after changing its data at the given index. (See manual)} [catch] 
    ;    value [series! money! date! time! object! port! tuple!] 
    ;    index [number! logic! pair!] 
    ;    data "new value"
    ;]
    [ ]
    [
        if not integer? index [throw make error! reduce ['script 'invalid-arg :index]]
        if not find [1 2] index [throw make error! [script past-end]]
        if not number? :data [throw make error! reduce ['script 'invalid-arg :data]]
        set in value pick [x y] index data
    ]
    
    clear'
    ;[
    ;    {Removes all values from the current index to the tail. Returns at tail.} [catch] 
    ;    series [series! port! bitset! none! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    trim'
    ;[
    ;    {Removes whitespace from a string. Default removes from head and tail.} [catch] 
    ;    series [series! port! object!] 
    ;    /head "Removes only from the head." 
    ;    /tail "Removes only from the tail." 
    ;    /auto "Auto indents lines relative to first line." 
    ;    /lines "Removes all line breaks and extra spaces." 
    ;    /all "Removes all whitespace." 
    ;    /with str [char! string!] "Same as /all, but removes characters in 'str'."
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    sort'
    ;[
    ;    "Sorts a series." [catch] 
    ;    series [series! port! object!] 
    ;    /case "Case sensitive sort." 
    ;    /skip "Treat the series as records of fixed size." 
    ;    size [integer!] "Size of each record." 
    ;    /compare "Comparator offset, block or function." 
    ;    comparator [integer! block! function!] 
    ;    /part "Sort only part of a series." 
    ;    length [integer!] "Length of series to sort." 
    ;    /all "Compare all fields" 
    ;    /reverse "Reverse sort order"
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]
    
    min'
    ;[
    ;    "Returns the lesser of the two values." [catch] 
    ;    value1 [number! pair! char! money! date! time! tuple! series! object!] 
    ;    value2 [number! pair! char! money! date! time! tuple! series! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :value1]
    ]
    
    max'
    ;[
    ;    "Returns the greater of the two values." [catch] 
    ;    value1 [number! pair! char! money! date! time! tuple! series! object!] 
    ;    value2 [number! pair! char! money! date! time! tuple! series! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :value1]
    ]
    
    abs'
    ;[
    ;    "Returns the absolute value." [catch] 
    ;    value [number! pair! money! time! object!]
    ;]
    [ ]
    [
        square-root (value/x * value/x) + (value/y * value/y)
    ]
    
    empty?'
    ;[
    ;    "Returns TRUE if a series is at its tail." [catch] 
    ;    series [series! port! bitset! object!]
    ;]
    [ ]
    [
        throw make error! reduce ['script 'invalid-arg :series]
    ]

    angle'
    ;[
    ;    "Returns the angle of a complex! in polar coordinates"
    ;    value [object!]
    ;]
    [ ]
    [
        if zero?* value [return 0]
        either 0 = value/x [
            either value/y > 0 [
                90
            ] [
                -90
            ]
        ] [
            either value/x < 0 [
                180 + arctangent value/y / value/x
            ] [
                arctangent value/y / value/x
            ]
        ]
    ]
]

define-conversion 'block! 'complex! [] [make type [x: any [pick spec 1 0] y: any [pick spec 2 0]]]
define-conversion 'complex! 'block! [] [reduce [spec/x spec/y]]
define-conversion 'decimal! 'complex! [] [make type [x: spec y: 0]]
define-conversion 'integer! 'complex! [] [make type [x: spec y: 0]]
define-conversion 'none! 'complex! [] [make type [x: y: 0]]
define-conversion 'complex! 'none! [] [none]
define-conversion 'pair! 'complex! [] [make type [x: spec/x y: spec/y]]
define-conversion 'complex! 'pair! [] [as-pair spec/x spec/y]
define-conversion 'complex! 'complex! [] [make spec [ ]]