##lookin ..Shapes

/** Populate a namespace hierarchy.
 **/
##push W
##push X
##push Y
##push Z
a: 1
##pop Z
##pop Y
##pop X
##pop W


/** Alias with absolute expansion, placed in the global namespace
 **/
##alias K = ..W..X..Y

/** The alias can be accessed using a relative identifier.
 **/
{
  res: [Debug..locate (resolved_identifier_string K..Z..a)]
  IO..•stdout << `Resolving ´ << [Debug..sourceof res] << ` within ´ << (resolved_identifier_string @@) << `: ´ << res << "{n}
}


##push W

/** Alias with relative expansion
 ** The expansion is resolved relative to the current namespace (here ..W)
 **/
##alias L = X..Y

/** Expand the alias from a nested namespace.
 **/
##push R
{
  res: [Debug..locate (resolved_identifier_string L..Z..a)]
  IO..•stdout << `Resolving ´ << [Debug..sourceof res] << ` within ´ << (resolved_identifier_string @@) << `: ´ << res << "{n}
}
##pop R

##pop W


##push W

/** Expand the alias from the same namespace opened again.
 **/
{
  res: [Debug..locate (resolved_identifier_string L..Z..a)]
  IO..•stdout << `Resolving ´ << [Debug..sourceof res] << ` within ´ << (resolved_identifier_string @@) << `: ´ << res << "{n}
}

##pop W


/** Namespace aliases are only followed for the first namespace name in a namespace path.
 ** This is to allow an extension to use aliases for its own convenience, without the risk that
 ** users of the extension create dependencies to these aliases.
 **
 ** This wouldn't work:
 **/
|**{
|**  res: [Debug..locate (resolved_identifier_string W..L..Z..a)]
|**  IO..•stdout << `Resolving ´ << [Debug..sourceof res] << ` within ´ << (resolved_identifier_string @@) << `: ´ << res << "{n}
|**}

Resolving K..Z..a within ..: ..W..X..Y..Z..a
Resolving L..Z..a within ..W..R..: ..W..X..Y..Z..a
Resolving L..Z..a within ..W..: ..W..X..Y..Z..a

/** This example demonstrates private namespaces.
 **/

/** Pushing a named namespace sets up a new unique private namespace: **/
##push A

/** Open the private namespace a first time: **/
##push -
x: 1 /** Implementation detail of A. **/
/** Source code reflection of the private namespace shows a namespace identifier in
 ** the form of a unique number:
 **/
Shapes..IO..•stdout << `Current namespace: ´ << (resolved_identifier_string @@) << "{n}
##pop -

/** Access implementation detail from the private namespace using relative identifier
 ** with empty namespace path:
 **/
Shapes..IO..•stdout << (resolved_identifier_string x) << "{n}

/** Open the private namespace a second time: **/
##push -
Shapes..IO..•stdout << `Current namespace: ´ << (resolved_identifier_string @@) << "{n}
/** The private variable x is still in scope here. **/
Shapes..IO..•stdout << (resolved_identifier_string x) << "{n}
/** Implement some functions in the private namespace. **/
foo: \ y → x + y
bar: \ y → x - y
baz: \ y → x * y
##pop -

/** Expose the functions foo and bar from the private namespace by
 ** providing bindings in the normal namespace:
 **/
": foo /** Refers to binding in private namespace; this is not a circular refrence. **/
b: bar /** Expose bar under a different name. **/
baz: - /** Special syntax for exposing private namespace variable of the same name. **/

/** Verify that the private namespace has precedence over the normal namespace: **/
Shapes..IO..•stdout << (resolved_identifier_string foo) << "{n}

##pop A

/** One cannot access the private binding here; something like A..x won't work. **/

/** Pushing the same named namespace again sets up a new unique private namespace: **/
##push A
##push -
Shapes..IO..•stdout << `Current namespace: ´ << (resolved_identifier_string @@) << "{n}
/** The variable x is not in scope here, since this is a different private namespace. **/
/** The foo in the other private namespace is no longer in scope: **/
Shapes..IO..•stdout << (resolved_identifier_string foo) << "{n}
##pop -
/** Neither is x in scope here. **/
##pop A

/** The exposed bindings can still be accessed in the normal namespace: **/
Shapes..IO..•stdout << (resolved_identifier_string A..baz) << "{n}

Current namespace: ..A..8..
..A..8..x
Current namespace: ..A..8..
..A..8..x
..A..8..foo
Current namespace: ..A..9..
..A..foo
..A..baz

/** This example demonstrates encapsulation namespaces.
 **/

##push A
w: 4

/** Open an encapsulation namespace: **/
##push ^^
/** The variable w is not in scope here. **/
/** Introduce a binding in the encapsulated namespace (also creating a binding in A): **/
x: 1
/** Open a namespace inside the encapsulation namespace: **/
##push B
y: 2
x: 3 /** Shadowing binding. **/
/** Use a local reference to refer to the shadowed binding: **/
Shapes..IO..•stdout << ^^x << "{n}
##pop B
##pop ^^

/** Open another encapsulation namespace: **/
##push ^^
/** The variable x is not in scope here, since this is a different encapsulation namespace.
 ** However, it would cause a conflict if x was introduced here as well, as there is already
 ** a binding for x in A.
 **
 ** Similarly, it is not possible to open a namespace called B here.
 **/
##pop ^^

##pop A

/** The encapsulation namespace isn't seen from the outside: **/
Shapes..IO..•stdout << (resolved_identifier_string A..x) << "{n}
Shapes..IO..•stdout << (resolved_identifier_string A..B..y) << "{n}
z: A..x + A..B..y

1
..A..x
..A..B..y

/** This is an encapsulated module. **/
##push ^^


/** === Public interface === **/


/** [hypot x y] gives the length of the hypothenuse of a right-angled triangle with
 ** catheti x and y.
 **/
hypot: -


/** [hypot3D x y z] is the 3D analog of hypot.
 **/
hypot3D: hypot3D_impl


/** === End of public interface === **/


/** === Implementation === **/
##push -


hypot: \­ x y → [Numeric..Math..sqrt x * x + y * y]


hypot3D_impl: \­ x y z → [Numeric..Math..sqrt x * x + y * y + z * z]


##pop -

##pop ^^

##lookin ..Shapes
##lookin ..Shapes..Graphics

{
  pth: Geometry..@defaultunit:5mm | (0cm,0cm)>(^)--(^)<(1cm,0cm^45°)>(^)--(^)<(2cm,0cm)
  sl: [pth 1]
  IO..•page << Traits..@stroking:Traits..RGB..RED | [Graphics..stroke sl.p--(+ ~4mm*sl.rT)]
        << [Graphics..stroke pth head:Graphics..ShapesArrow]
}

{
  pth: Geometry..@defaultunit:1%C | (0cm,~1cm)>(^)--(^)<(1cm,~1cm^~45°)>(^)--(^)<(2cm,~1cm)
  sl: [pth 1]
  IO..•page << Traits..@stroking:Traits..RGB..RED | [Graphics..stroke sl.p--(+ ~4mm*sl.rT)]
        << [Graphics..stroke pth head:Graphics..ShapesArrow]

}

{
  pth: Geometry..@defaultunit:1%F | (0cm,~9mm)>(5mm^0°)--(5mm^~90°)<(1cm,~0.5cm ^ )>(10mm^)--(5mm^~90°)<(0cm,~1mm)
  sl: [pth 1]
  IO..•page << Traits..@stroking:Traits..RGB..RED | [Graphics..stroke sl.p--(+ ~4mm*sl.rT)]
        << [Graphics..stroke pth head:Graphics..ShapesArrow]

}

/** This feature example is named after the reminding concept from Scheme.
 ** Anyway, "values" refers to the possibility of returning multiple values from a function.  However,
 ** this is not done the way it is in Scheme, where a bunch of values can only be returned through
 ** certain continuations.  Here, multiple values are combined in one value which we denote a "structure"
 ** (which can be given a composite type) and special constructs are used to use a structure in function calls or to
 ** bind the contained values to variables.
 **/

##lookin ..Shapes

/** In the first example, some values are simply put in a certain order.
 **/
{
  multi: \ x → (>  x  x+1  x+2  <)

  user: \ a1 a2 a3 →  100*a1 + 10*a2 + a3

  /** Note the special syntax used to call a function with the values expanded:
   **/
  IO..•stdout << user [] <>[multi 5] << "{n}
}

/** In the next example, some values are simply put in a certain order, and we combine this
 ** with an evaluated cut.
 **/
{
  multi: \ x → (>  x  a3:x+1  a2:x+2  <)

  user: \ a1 a2 a3 a4 →  1000*a4 + 100*a1 + 10*a2 + a3

  IO..•stdout << user [...] <>[multi 5] [] 9<< "{n}
}


/** Here, we show how to also pass states to a function, and also that the structure with values need
 ** not be returned from a function, but can be created anywhere.  Also, it is shown how named parts
 ** can be accessed using field access notation.
 **/
{
  bunch: (>  6  a3:7  a2:8  <)

  user: \ •dst a1 a2 a3 →
    {
      •dst << 100*a1 + 10*a2 + a3 << "{n}
    }
  [(user [...] <>bunch)  IO..•stdout ]

  /** The following syntax might be supported in the future.  For now,
   ** it is considered a risk of ambiguity to mix the two forms of
   ** function application.
   **/
|**  [user IO..•stdout <>bunch]

  IO..•stdout << `Field access:  a2 = ´ << bunch.a2 << "{n}
  /** By the way, parts that are not named cannot be accessed in a similar way.  However,
   ** note that we can always to this:
   **/
  IO..•stdout << `The first argument is:  a1 = ´ << ( \ a1 a2 a3 → a1 ) [] <>bunch << "{n}
  /** ... but note that this requires that we know the names of the named parts of <bunch>, for
   ** otherwise there will be an error when the function is applied.
   **/
}


/** Like in (lambda args <body>) construct in Scheme, we can define a function that gets just a structure as argument.
 ** There's also a construct that corresponds to (lambda (<arglist> . moreargs) <body>).
 ** In Shapes, the construct is called a "sink".  Note that functions with a sink may be tricky from a type system point
 ** of view, so code that wish to be type-compilant should not use sinks.
 **/
{
  foo: \ •out <> args →
  {
    •out << `a = ´ << args.a << `, b = ´ << args.b << "{n}
  }

  [foo IO..•stdout b:2 a:1]

  bar: \ •out a <> args →
  {
    •out << `a = ´ << a << `, b = ´ << args.b << `, c = ´ << args.c << "{n}
  }

  [bar IO..•stdout 0 c:2 b:1]


  /** Sinks themselves cannot be passed as a named argument.  Hence, the name of the sink can be used without
   ** confusion:
   **/

  boo: \ •out <> args →
  {
    •out << `args = ´ << args.args << "{n}
  }

  [boo IO..•stdout args:7]
}

/** Next, we turn to how parts of a structure can conveniently be given names in the local scope.
 ** The semantics remind a little bit of function calls, but are actually rather different.
 **/
{

  {
    /** We begin with a structure with only ordered parts.
     **/
    bunch: (>  6  7  8  <)

    {
      /** Just like in a function call, we can receive the parts of a structure by order:
       **/
      (< x y z >): bunch
      IO..•stdout << `x = ´ << x << `, y = ´ << y << `, z = ´ << z << "{n}
    }

    {
      /** It is an error to not take care of all ordered parts.  The following would result in an error.
       **/
|**      (< x y >): bunch

      /** Unless we have a sink!
       **/
      (< x y <> rest >): bunch
      (< z >): rest
      IO..•stdout << `From the sink, z = ´ << z << "{n}
    }

    {
      /** On the other hand, we can provide defaults if there are not enough ordered parts:
       **/
      (< x y z w:14 >): bunch

      IO..•stdout << `w = ´ << w << "{n}
    }

  }

  {
    /** When it comes to named parts of a structure, there are some differences to the semantics of calling
     ** a function.  First, it is not required that all named parts are received.  This makes it possible to
     ** extract only the parts of a structure with are useful, and avoids cluttering the destination scope with
     ** variables of no use.
     ** Second, the variables being introduced in the current scope are generally named different from the
     ** names bound to the values in the structure.
     **/
    bunch: (>  a1:6  a3:7  a2:8  <)

    {
      /** Here is a typical extraction of two named parts.  Note that without the dot before the names
       ** that refer to parts of the structure, this would be the syntax that specifies a default values.
       **/
      (<
        x:.a1
        y:.a2
      >): bunch

      IO..•stdout << `x = ´ << x << `, y = ´ << y << "{n}
    }

    {
      /** To receive the parts by their own names, the following syntax may be thought of (and implemented)
       ** as a low level syntax sugar.
       **/
      (< a2:." a3:." >): bunch
      IO..•stdout << `a2 = ´ << a2 << `, a3 = ´ << a3 << "{n}
    }

    {
      /** Defaults can be provided.
       **/
      def: 1000
      (< a2:." a4:.":def >): bunch
      IO..•stdout << `a2 = ´ << a2 << `, a4 = ´ << a4 << "{n}
    }
  }

  {
    /** Ordered and named parts can be used at the same time, as shown by these examples.  However, it sould
     ** be noted that they cannot interact, so there are no fancy combinations to be explained here.
     **/

    bunch: (>  6  a3:7  a2:8  <)

    {
      (<  x  y:.a2  a3:."  >): bunch
      IO..•stdout << `x = ´ << x << `, y = ´ << y << `, a3 = ´ << a3 << "{n}
    }

    {
      (<  x  y:1000 >): bunch
      IO..•stdout << `x = ´ << x << `, y = ´ << y << "{n}
    }

  }

}


/** Let us also have a look at the <unlist> function here.
 **/
{
  /** To see the relevance of discussing <unlist> here, note that we may define a Scheme-like <apply>
   ** function like this:
   **/
  apply: \ fun args → ( fun [] <>[Data..unlist args] )

  IO..•stdout << `Using apply to compute the sum of two values: ´ << [apply (+) [Data..list 4 5]] << "{n}

  /** Let us now verify that it is the inverse of <list> in the following senses:
   **/
  lst: [Data..list 1 2 3]
  showList: \ lst → [lst.foldl \ p e → ( p + ( String..newString << `(´ << e << `)´ ) ) `´]
  IO..•stdout << [showList lst] << ` vs ´ << [showList ( Data..list [] <>[Data..unlist lst] )] << "{n}

  struct: (> 'a 'b 'c <)
  showStruct: \ struct → (( \ x y z → ( String..newString << `(´ << x << `)´ << `(´ << y << `)´ << `(´ << z << `)´ )) [] <>struct)
  IO..•stdout << [showStruct struct] << ` vs ´ << [showStruct [Data..unlist ( Data..list [] <>struct )]] << "{n}
}

567
9576
687
Field access:  a2 = 8
The first argument is:  a1 = 6
a = 2, b = 1
a = 0, b = 2, c = 1
args = 7
x = 6, y = 7, z = 8
From the sink, z = 8
w = 14
x = 6, y = 8
a2 = 8, a3 = 7
a2 = 8, a4 = 1000
x = 7, y = 8, a3 = 7
x = 7, y = 8
Using apply to compute the sum of two values: 9
(1)(2)(3) vs (1)(2)(3)
('a)('b)('c) vs ('a)('b)('c)

##lookin ..Shapes

a: 1
{
  a: 2
  {
    a: 4
    IO..•stdout << `a0 = ´ << a << "{n}
    IO..•stdout << `a1 = ´ << ../a << "{n}
    IO..•stdout << `a2 = ´ << ../../a << "{n}
    IO..•stdout << `a1+a2 = ´ << ../(a+../a) << "{n}
  }
}

{
  odd: \ n → [if n = 0 false [even n-1]]
  even: \ n → [if n = 0 true [odd n-1]]
  IO..•stdout << `Is 0 odd? --> ´ << [odd 0] << "{n}
  IO..•stdout << `Is 4 even? --> ´ << [even 4] << "{n}
}

a0 = 4
a1 = 2
a2 = 1
a1+a2 = 3
Is 0 odd? --> false
Is 4 even? --> true

##lookin ..Shapes

/**
 ** First, let's have a look at some basic use of dynamic binding.
 ** If the first parameter after the name of the variable is the special <identity> function it is optimized away by the kernel.
 ** The second parameter after the name is the default value, and is not sent through the filter.
 **/

dynamic @a identity 8
f: \ b → @a + b
IO..•stdout << [f 2] << "{n}
IO..•stdout << @a:6 | [f 2] << "{n}
IO..•stdout << [f 2] << "{n}

/**
 ** Note that the default value is delayed, so we can require that a dynamic variable must be bound by the user.
 ** This is also nice to know if the default expression would be expensive to compute but rarely used.
 ** Another application would be to detect whether the default value is ever used.
 **
 ** However, the filter is evaluated immediately -- this simplifies the kernel business.
 **/

dynamic @a_noDefault identity [error `Dynamic variable has no default binding.´]
IO..•stdout << @a_noDefault:9 | @a_noDefault << ` No error, see?´ << "{n}

dynamic @a_logDefault identity [Debug..log_before `The default value was used.´+"{n} ~9]
IO..•stdout << @a_logDefault << ` Check out the debug log!´ << "{n}


/**
 ** Next, we turn to dynamic expressions.
 **/

dynamic @c identity 10
dynamic @b identity dynamic @a + 5

  @a: dynamic @c * 4
& @c: 20
|
{
  IO..•stdout << `@b: ´ << @b << "{n}
}


/**
 ** The rest of this file illustrates how to replace part of a dynamic bindings value by using the &| operator.
 ** The typical application of this would be to define a set of bindings for the text state, and then define a variation
 ** by changing just some of the parameters.  However, since this example is meant to be text-oriented we use a silly
 ** mix of meaningless bindings instead.
 **/
b0: Traits..@width:3mm & @a:20 & @b:21 & Traits..@stroking:[Traits..gray 0.5]
b1: Traits..@width:1mm & @b:11 & @c:12

/**
 ** Note that b0 & b1 would be illegal, since they both provide bindings for Traits..@width and @b.
 **/

/**
 ** Combine b0 and b1 with priority to the bindings in b1:
 **/
b01: Debug..locate [] b0 &| b1

b01
|
{
  IO..•stdout << [Debug..sourceof b01] << ` :´ << "{n}
  IO..•stdout << `@a: ´ << @a << "{n}
  IO..•stdout << `@b: ´ << @b << "{n}
  IO..•stdout << `@c: ´ << @c << "{n}
  IO..•stdout << `Traits..@width: ´ << Traits..@width << "{n}
  IO..•stdout << `Traits..@stroking: ´ << Traits..@stroking << "{n}
}

/**
 ** Combine b0 and b1 with priority to the bindings in b0:
 **/
b10: Debug..locate [] b1 &| b0

b10
|
{
  IO..•stdout << [Debug..sourceof b10] << ` :´ << "{n}
  IO..•stdout << `@a: ´ << @a << "{n}
  IO..•stdout << `@b: ´ << @b << "{n}
  IO..•stdout << `@c: ´ << @c << "{n}
  IO..•stdout << `Traits..@width: ´ << Traits..@width << "{n}
  IO..•stdout << `Traits..@stroking: ´ << Traits..@stroking << "{n}
}

10
8
10
9 No error, see?
~9 Check out the debug log!
@b: 85
b0 &| b1 :
@a: 20
@b: 11
@c: 12
Traits..@width: 0.1cm
Traits..@stroking: [gray 0.5]
b1 &| b0 :
@a: 20
@b: 21
@c: 12
Traits..@width: 0.3cm
Traits..@stroking: [gray 0.5]

##preamble \usepackage{amsmath}
##preamble \usepackage{fancybox}

##lookin ..Shapes

IO..•page << [Graphics..TeX `
\fbox{\begin{Beqnarray*}
&\begin{aligned}
  x &= 1 \\
  y &= 2      % This is a comment!
\end{aligned}
\end{Beqnarray*}}
´]

##lookin ..Shapes

lst: [Data..list 1 2 3 4 5 6]

IO..•stdout << 10 + [lst.foldsr (\ e p •dst → { •dst << e << ` ´  p })
                    20 IO..•stdout]
        << ` OK!´ << "{n}

IO..•stdout << 10 + (escape_continuation leave
      [lst.foldsr (\ e p •dst → [if e = 4 (escape_continue leave e) { •dst << e << ` ´  p }])
            20 IO..•stdout])
        << ` OK!´ << "{n}

6 5 4 3 2 1 30 OK!
1 2 3 14 OK!

##lookin ..Shapes
##lookin ..Shapes..Geometry

h: 2cm   |** This is half the height of our path
w: 1cm   |** This is the width of our path
r: 4mm   |** This is a corner radius

/**
 ** Construct a path as follows:
 ** Start at (0,h) and make a horizontal line to the x-coordinate (w-r).  Make an (approximately) circular arc
 ** to the point located r to the right and r down.  Make a vertical line to the y-coordinate (~h+r).  Finally,
 ** make a smooth spline without inflexion that ends horizontally at (0,~h).
 **
 ** Then stroke the path joined with its reverse mirrored in the y-axis.
 **/
pth: @defaultunit:1%c | (0,h)--(w-r,(+0m))>(^)--(^)<(+(r,~r))--((+0m),~h+r)>(^)--(^0°)<(0,~h)

IO..•page << [Graphics..stroke pth--[[scale x:~1] [reverse pth]]]


/**
 ** Allow for some space around the path we want to see!
 **/
IO..•page << [Graphics..stroke [rectangle (~1.5*w,~1.5*h) (1.5*w,1.5*h)]]

##lookin ..Shapes
##lookin ..Shapes..Control

/** This is what the standard implementation of <cond> looks like (or at least
 ** it did look like this at one point).  It uses forced immediate evaluation.
 **/
|** cond: \ <>cases →
|**   (escape_continuation return
|**     {
|**       ![(list []<>cases).foldr
|**          \ e p → [if e.car (escape_continue return e.cdr) p]
|**          void]
|**       ![error `No matching cond clause.´]
|**     })

IO..•stdout
  << `cond: ´
  << [cond [Data..cons 1=0 `Doesn't happen, but not evaluated anyway.´]
           [Data..cons 1=0 [error 'bad `(while testing cond)´ `This should never be evaluated (false case)!´]]
           [Data..cons 1=1 `This is the correct answer.´]
           [Data..cons 1=1 [error 'bad `(while testing cond)´ `This should never be evaluated (after true case)!´]]
           [Data..cons true `This is the default, in case no other case is true.´]]
  << "{n}


purecond: \ <>cases →
 {
   tmp: [(Data..list []<>cases).foldr
            \ e p → [if [typeof p] = Data..Type..§Void
                        [if e.car e p]
                        p]
            void]
   [if [typeof tmp] = Data..Type..§Void
       [error 'misc VARNAME `No matching cond clause.´]
       tmp.cdr]
  }

IO..•stdout
  << `purecond: ´
  << [purecond [Data..cons 1=0 `Doesn't happen, but not evaluated anyway.´]
               [Data..cons 1=0 [error 'bad `(while testing purecond)´ `This should never be evaluated (false case)!´]]
               [Data..cons 1=1 `This is the correct answer.´]
               [Data..cons 1=1 [error 'bad `(while testing purecond)´ `This should never be evaluated (after true case)!´]]
               [Data..cons true `This is the default, in case no other case is true.´]]
  << "{n}

cond: This is the correct answer.
purecond: This is the correct answer.