import java.io.ByteArrayInputStream;
import java.io.ByteArrayOutputStream;
import java.io.ObjectInputStream;
import java.io.ObjectOutputStream;
import java.io.Serializable;

public class DeepCopy {

    public static void main(String[] args) {
        Person p1 = new Person("Clark", "Kent", new Address("1 World Center", "Metropolis", "NY", "010101"));
        Person p2 = p1;

        System.out.printf("Demonstrate shallow copy.  Both are the same object.%n");
        System.out.printf("Person p1 = %s%n", p1);
        System.out.printf("Person p2 = %s%n", p2);
        System.out.printf("Set city on person 2.  City on both objects is changed.%n");
        p2.getAddress().setCity("New York");
        System.out.printf("Person p1 = %s%n", p1);
        System.out.printf("Person p2 = %s%n", p2);

        p1 = new Person("Clark", "Kent", new Address("1 World Center", "Metropolis", "NY", "010101"));
        p2 = new Person(p1);
        System.out.printf("%nDemonstrate copy constructor.  Object p2 is a deep copy of p1.%n");
        System.out.printf("Person p1 = %s%n", p1);
        System.out.printf("Person p2 = %s%n", p2);
        System.out.printf("Set city on person 2.  City on objects is different.%n");
        p2.getAddress().setCity("New York");
        System.out.printf("Person p1 = %s%n", p1);
        System.out.printf("Person p2 = %s%n", p2);

        p2 = (Person) deepCopy(p1);
        System.out.printf("%nDemonstrate serialization.  Object p2 is a deep copy of p1.%n");
        System.out.printf("Person p1 = %s%n", p1);
        System.out.printf("Person p2 = %s%n", p2);
        System.out.printf("Set city on person 2.  City on objects is different.%n");
        p2.getAddress().setCity("New York");
        System.out.printf("Person p1 = %s%n", p1);
        System.out.printf("Person p2 = %s%n", p2);

        p2 = (Person) p1.clone();
        System.out.printf("%nDemonstrate cloning.  Object p2 is a deep copy of p1.%n");
        System.out.printf("Person p1 = %s%n", p1);
        System.out.printf("Person p2 = %s%n", p2);
        System.out.printf("Set city on person 2.  City on objects is different.%n");
        p2.getAddress().setCity("New York");
        System.out.printf("Person p1 = %s%n", p1);
        System.out.printf("Person p2 = %s%n", p2);
    }

    /**
     * Makes a deep copy of any Java object that is passed.
     */
    private static Object deepCopy(Object object) {
        try {
            ByteArrayOutputStream outputStream = new ByteArrayOutputStream();
            ObjectOutputStream outputStrm = new ObjectOutputStream(outputStream);
            outputStrm.writeObject(object);
            ByteArrayInputStream inputStream = new ByteArrayInputStream(outputStream.toByteArray());
            ObjectInputStream objInputStream = new ObjectInputStream(inputStream);
            return objInputStream.readObject();
        }
        catch (Exception e) {
            e.printStackTrace();
            return null;
        }
    }

    public static class Address implements Serializable, Cloneable {

        private static final long serialVersionUID = -7073778041809445593L;

        private String street;
        private String city;
        private String state;
        private String postalCode;
        public String getStreet() {
            return street;
        }
        public String getCity() {
            return city;
        }
        public void setCity(String city) {
            this.city = city;
        }
        public String getState() {
            return state;
        }
        public String getPostalCode() {
            return postalCode;
        }

        @Override
        public String toString() {
            return "[street=" + street + ", city=" + city + ", state=" + state + ", code=" + postalCode + "]";
        }

        public Address(String s, String c, String st, String p) {
            street = s;
            city = c;
            state = st;
            postalCode = p;
        }

        //  Copy constructor
        public Address(Address add) {
            street    = add.street;
            city       = add.city;
            state      = add.state;
            postalCode = add.postalCode;
        }

        //  Support Cloneable
        @Override
        public Object clone() {
            return new Address(this);
        }

    }

    public static class Person implements Serializable, Cloneable {
        private static final long serialVersionUID = -521810583786595050L;
        private String firstName;
        private String lastName;
        private Address address;
        public String getFirstName() {
            return firstName;
        }
        public String getLastName() {
            return lastName;
        }
        public Address getAddress() {
            return address;
        }

        @Override
        public String toString() {
            return "[first name=" + firstName + ", last name=" + lastName + ", address=" + address + "]";
        }

        public Person(String fn, String ln, Address add) {
            firstName = fn;
            lastName = ln;
            address = add;
        }

        //  Copy Constructor
        public Person(Person person) {
            firstName = person.firstName;
            lastName = person.lastName;
            address = new Address(person.address);  //  Invoke copy constructor of mutable sub-objects.
        }

        //  Support Cloneable
        @Override
        public Object clone() {
            return new Person(this);
        }
    }
}


Module CheckDataType {
      Module CheckThis {
            Class typeA {
            Private:
                  mval as currency
            Public:
                  Property min {value}=-1
                  Property max {value}=0
                  Operator "++" {
                        if .mval=.[max] then Error "Number bigger than Max Value"
                        .mval++
                  }
                  Operator "--" {
                        if .mval=.[min] then Error "Number lower than Min Value"
                        .mval--
                  }
                  Operator "+=" (x){
                        if .mval>.[max]+x then Error "Number bigger than Max Value"
                        .mval+=x
                  }
                  Operator "-=" (x) {
                        if .mval<.[min]-x then Error "Number lower than Min Value"
                        .mval-=x
                  }
                  Value {
                    =.mval
                  }
                  Set (x) {
                        if x>.[max] then Error "Number bigger than Max Value"
                        if x<.[min] then Error "Number lower than Min Value"
                        .mval<=int(x)
                  }
            Class:
                  Module typeA (.[min], .[max]) {
                      .mval<=.[min]
                  }
            }
            K=typeA(1, 10)
            K=5
            Def TypeExp$(x)=Type$(x)
            Print Type$(K)="Group", TypeExp$(K)="Currency"
            K--
            Print K
            K=K+1
            Print K, K.Max, K.Min
            K+=4
            Print K, K.Max, K.Min
            Print -K*4=-36
            Try Ok {
                  K=400
            }
            If  Error or Not Ok then Print Error$
            \\ make a new K as K with name Z
            Z=Group(K)
            Print Z.Max, Z.Min, Z
            K++
            Z=Group(K)
            Print Z=K
            K-=5
            \\ We make M as pointer to K
            M->K
            Print Eval(M), K
            For M {This++}
            Print Eval(M), K
            For M {This=8}
            Print Eval(M), K
            Push Group(M), Group(M)
      }
      CheckThis
      \\ Read Group from stack of values and place a copy in each item in A()
      Dim A(4)=Group
      \\ We have one more group in stack, so we read it to new variable What
      \\ What isn't a pointer to object, is the object (internal is a pointer to objet but isn't usable for M2000)
      Read What
      What++
      Print What.Max=10, What.Min=1, What=9  ' True True True
      Print A(2).Max=10, A(2).Min=1, A(2)=8 ' True True True
}
CheckDataType


classdef RingInt

    properties
        value
    end

    methods

        %RingInt constructor
        function theInt = RingInt(varargin)
            if numel(varargin) == 0
                theInt.value = 1;
            elseif numel(varargin) > 1
                error 'The RingInt constructor can''''t take more than 1 argument.';
            else

                %Makes sure any doubles are coerced to ints
                if not(isinteger(varargin{1}))
                    varargin{1} = int32(varargin{1});
                end

                %Maps out of bound values to the proper range
                if varargin{1} > 10
                    theInt.value = varargin{1} - (10 * (idivide(varargin{1},10,'ceil') - 1));
                elseif varargin{1} < 1
                    theInt.value = varargin{1} + (10 * (idivide(abs(varargin{1}),10,'floor') + 1));
                else
                    theInt.value = varargin{1};
                end
            end
        end %constructor

        %Overload the "+" operator
        function sum = plus(firstNumber,secondNumber)

            if isa(firstNumber,'RingInt') && isa(secondNumber,'RingInt')
                sum = firstNumber.value + secondNumber.value;
            elseif isa(firstNumber,'RingInt') && not(isa(secondNumber,'RingInt'))
                sum = firstNumber.value + secondNumber;
            else
                sum = secondNumber.value + firstNumber;
            end

            sum = RingInt(sum);

        end %+

        %Overload the "-" operator
        function difference = minus(firstNumber,secondNumber)

            if isa(firstNumber,'RingInt') && isa(secondNumber,'RingInt')
                difference = firstNumber.value - secondNumber.value;
            elseif isa(firstNumber,'RingInt') && not(isa(secondNumber,'RingInt'))
                difference = firstNumber.value - secondNumber;
            else
                difference = firstNumber - secondNumber.value;
            end

            difference = RingInt(difference);

        end %-

        %Overload the "==" operator
        function trueFalse = eq(firstNumber,secondNumber)

            if isa(firstNumber,'RingInt') && isa(secondNumber,'RingInt')
                trueFalse = firstNumber.value == secondNumber.value;
            else
                error 'You can only compare a RingInt to another RingInt';
            end

        end %==

        %Overload the display() function
        function display(ringInt)
            disp(ringInt);
        end

        %Overload the disp() function
        function disp(ringInt)
            disp(sprintf('\nans =\n\n\t %d\n',ringInt.value));
        end

    end %methods
end %classdef


var deepcopy = function(o){
  return JSON.parse(JSON.stringify(src));
};

var src = {foo:0,bar:[0,1]};
print(JSON.stringify(src));
var dst = deepcopy(src);
print(JSON.stringify(src));


// Version 1.2.31

import java.io.Serializable
import java.io.ByteArrayOutputStream
import java.io.ByteArrayInputStream
import java.io.ObjectOutputStream
import java.io.ObjectInputStream

fun <T : Serializable> deepCopy(obj: T?): T? {
    if (obj == null) return null
    val baos = ByteArrayOutputStream()
    val oos  = ObjectOutputStream(baos)
    oos.writeObject(obj)
    oos.close()
    val bais = ByteArrayInputStream(baos.toByteArray())
    val ois  = ObjectInputStream(bais)
    @Suppress("unchecked_cast")
    return ois.readObject() as T
}

class Person(
    val name: String,
    var age: Int,
    val sex: Char,
    var income: Double,
    var partner: Person?
) : Serializable

fun printDetails(p1: Person, p2: Person?, p3: Person, p4: Person?) {
    with (p3) {
        println("Name    : $name")
        println("Age     : $age")
        println("Sex     : $sex")
        println("Income  : $income")
        if (p4 == null) {
            println("Partner : None")
        }
        else {
            println("Partner :-")
            with (p4) {
                println("  Name   : $name")
                println("  Age    : $age")
                println("  Sex    : $sex")
                println("  Income : $income")
            }
        }
        println("\nSame person as original '$name' == ${p1 === p3}")
        if (p4 != null) {
            println("Same person as original '${p2!!.name}' == ${p2 === p4}")
        }
    }
    println()
}

fun main(args: Array<String>) {
    var p1 = Person("John", 35, 'M', 50000.0, null)
    val p2 = Person("Jane", 32, 'F', 25000.0, p1)
    p1.partner = p2
    var p3 = deepCopy(p1)
    val p4 = p3!!.partner
    printDetails(p1, p2, p3, p4)

    println("..or, say, after 2 years have elapsed:-\n")
    with (p1) {
        age = 37
        income = 55000.0
        partner = null
    }
    p3 = deepCopy(p1)
    printDetails(p1, null, p3!!, null)
}


type
  MyInt = range[1..10]

var x: MyInt = 5

x = x + 6  # Runtime error: unhandled exception: value out of range: 11 notin 1 .. 10 [RangeDefect]

x = 12     # Compile-time error: conversion from int literal(12) to MyInt is invalid


exception Out_of_bounds

type 'a bounds = { min: 'a; max: 'a }

type 'a bounded = { value: 'a; bounds: 'a bounds }

let mk_bounds ~min ~max = { min=min; max=max } ;;
(** val mk_bounds : min:'a -> max:'a -> 'a bounds *)

let check_bounds ~value ~bounds =
  if value < bounds.min || value > bounds.max then
    raise Out_of_bounds ;;
(** val check_bounds : value:'a -> bounds:'a bounds -> unit *)

let mk_bounded ~value ~bounds =
  check_bounds ~value ~bounds;
  { value=value; bounds=bounds } ;;
(** val mk_bounded : value:'a -> bounds:'a bounds -> 'a bounded *)

let op f a b =
  if a.bounds <> b.bounds then
    invalid_arg "different bounds";
  let res = f a.value b.value in
  check_bounds res a.bounds;
  (mk_bounded res a.bounds)
  ;;
(** val op : ('a -> 'a -> 'a) -> 'a bounded -> 'a bounded -> 'a bounded *)


-- Supports lists, property lists, images, script instances and scalar values (integer, float, string, symbol).
on deepcopy (var, cycleCheck)
  case ilk(var) of
  #list, #propList, #image:
    return var.duplicate()
  #instance:
    if string(var) starts "<Xtra " then return var -- deep copy makes no sense for Xtra instances
    if voidP(cycleCheck) then cycleCheck = [:]
    if not voidP(cycleCheck[var]) then return cycleCheck[var]
    copy = var.script.rawNew()
    cycleCheck[var] = copy
    repeat with i = 1 to var.count
      copy.setProp(var.getPropAt(i), deepcopy(var[i], cycleCheck))
    end repeat
    return copy
  otherwise:
    return var
  end case
end


function _deepcopy(o, tables)

  if type(o) ~= 'table' then
    return o
  end

  if tables[o] ~= nil then
    return tables[o]
  end

  local new_o = {}
  tables[o] = new_o

  for k, v in next, o, nil do
    local new_k = _deepcopy(k, tables)
    local new_v = _deepcopy(v, tables)
    new_o[new_k] = new_v
  end

  return new_o
end

function deepcopy(o)
  return _deepcopy(o, {})
end


/* REXX ----------------------------------------------------------------
* 21.06.2014 Walter Pachl
* implements a data type tinyint that can have an integer value 1..10
* 22.06.2014 WP corrected by Rony Flatscher to handle arithmetic
*---------------------------------------------------------------------*/
a=.tinyint~new(1)  ; Say 'a='||a~value
Say '2*a='||(2*a)
Say 'a*2='||((0+a)*2)
say "---> rony was here: :)"
say "The above statement was in effect: '(0+a)*2', NOT 'a*2*, hence it worked!"
say "These statements work now:"
say "(a)*2:" (a)*2
say "a*2:  " a*2
say "<--- rony was here, The end. :)"
b=.tinyint~new(11); Say 'b='||b~value
b=.tinyint~new('B'); Say 'b='||b~value
say 'b='||(b)           -- show string value
Say '2*b='||(2*b)
::class tinyint
::method init
  Expose v
  Use Arg i
  Select
    When datatype(i,'W') Then Do
      If i>=1 & i<=10 Then
        v=i
      Else Do
        Say 'Argument 1 must be between 1 and 10'
        Raise Syntax 88.907 array(1,1,10,i)
        End
      End
    Otherwise Do
      Say 'Argument 1 must be a whole number between 1 and 10'
      Raise Syntax 88.905 array(1,i)
      End
    End
::method string
  Expose v
  Return v
::method value
  Expose v
  Return v

-- rgf, 20140622, intercept unknown messages, forward arithmetic messages to string value
::method unknown
  expose v
  use arg methName, methArgs
  if wordpos(methName, "+ - * / % //")>0 then  -- an arithmetic message in hand?
    forward message (methName) to (v) array (methArgs[1])


declare
  I
in
  I::1#10
  I = {Pow 2 4}


let rec copy t =
  if Obj.is_int t then t else
    let tag = Obj.tag t in
    if tag = Obj.double_tag then t else
    if tag = Obj.closure_tag then t else
    if tag = Obj.string_tag then Obj.repr (String.copy (Obj.obj t)) else
    if tag = 0 || tag = Obj.double_array_tag then begin
      let size = Obj.size t in
      let r = Obj.new_block tag size in
      for i = 0 to pred size do
        Obj.set_field r i (copy (Obj.field t i))
      done;
      r
    end else failwith "copy" ;;

let copy (v : 'a) : 'a = Obj.obj (copy (Obj.repr v))


'DEEP COPY FOR A RECURSIVE TREE STRUCTURE

uses console

class branches
  '
  static int count
  int level
  int a,b,c
  branches*branch1
  branches*branch2
  '
  method constructor(int n)
  =========================
    level=n
    count++
    output count tab level cr
    if level>0
      new branches n1(n-1)
      new branches n2(n-1)
      @[email protected]
      @[email protected]
    endif
    ...
  end method
  '
  method destructor
  =================
    if level>0
      del branch1
      del branch2
    endif
    ...
  end method
  '
  method RecurseCopy(int n, branches *dc, *sc)
  ============================================
    dc.level=sc.level
    dc.a=sc.a
    dc.b=sc.b
    dc.c=sc.c
    if n>0
      RecurseCopy n-1, byval @dc.branch1, byval @sc.branch1
      RecurseCopy n-1, byval @dc.branch2, byval @sc.branch2
    endif
  end method
  '
  method DeepCopy() as branches*
  ==============================
    new branches dc(level)
    RecurseCopy level,dc,this
    return @dc
  end method
  '
end class

output "count" tab "level" tab "(original)" cr
new branches br(3)
output "count" tab "level" tab "(copy)" cr
branches *bc = br.DeepCopy
pause
del bc
del br


#!/usr/bin/perl
use strict;
use warnings;
use Storable;
use Data::Dumper;

my $src = { foo => 0, bar => [0, 1] };
$src->{baz} = $src;
my $dst = Storable::dclone($src);
print Dumper($src);
print Dumper($dst);


package One_To_Ten;
use Carp qw(croak);
use Tie::Scalar qw();
use base qw(Tie::StdScalar);

sub STORE {
    my $self = shift;
    my $val = int shift;
    croak 'out of bounds' if $val < 1 or $val > 10;
    $$self = $val;
};

package main;
tie my $t, 'One_To_Ten';
$t = 3;   # ok
$t = 5.2; # ok, silently coerced to int
$t = -2;  # dies, too small
$t = 11;  # dies, too big
$t = 'xyzzy';
# dies, too small. string is 0 interpreted numerically


<?php
class Foo
{
    public function __clone()
    {
        $this->child = clone $this->child;
    }
}

$object = new Foo;
$object->some_value = 1;
$object->child = new stdClass;
$object->child->some_value = 1;

$deepcopy = clone $object;
$deepcopy->some_value++;
$deepcopy->child->some_value++;

echo "Object contains {$object->some_value}, child contains {$object->child->some_value}\n",
     "Clone of object contains {$deepcopy->some_value}, child contains {$deepcopy->child->some_value}\n";
?>


type iten(integer i)
    return i>=1 and i<=10
end type


(class +BoundedInt)
# value lower upper

(dm T (Low Up)
   (=: lower (min Low Up))
   (=: upper (max Low Up)) )

(de "checkBounds" (Val)
   (if (>= (: upper) Val (: lower))
      Val
      (throw 'boundedIntOutOfBounds
         (pack
            "value " Val
            " is out of bounds [" (: lower) "," (: upper) "]" ) ) ) )

(dm set> (Val)
   (=: value ("checkBounds" Val)) )

(dm +> (Val)
   (=: value ("checkBounds" (+ Val (: value)))) )

(dm val> ()
   (: value) )

(de main ()
   (let (A (new '(+BoundedInt) 1 10)  B (new '(+BoundedInt) 1 10))
      (set> A 6)
      (when (catch 'boundedIntOutOfBounds (set> B 12) NIL)
         (prinl @) )
      (set> B 9)
      (when (catch 'boundedIntOutOfBounds (+> A (val> B)) NIL)
         (prinl @) ) ) )


[Int][ValidateRange(1,10)]$n = 3 #  $n can only accept integers between 1 and 10


Macro PrintStruc(StrucVal)
  PrintN(Str(StrucVal#\value1))
  PrintN(Chr(StrucVal#\value2))
  PrintN(StrucVal#\value3)
  If StrucVal#\value4
    PrintN("TRUE")
  Else
    PrintN("FALSE")
  EndIf
  PrintN("")
EndMacro

Structure TTypeA
  value1.i
  value2.c
  value3.s[10]
  value4.b
EndStructure

Define.TTypeA a, b

a\value1=10
a\value2='A'
a\value3="OK"
a\value4=#True

b=a

a\value1=20
a\value2='B'
a\value3="NOK"
a\value4=#False

If OpenConsole("")
  PrintN("Value of 'a':") : PrintStruc(a)
  PrintN("Value of 'b':") : PrintStruc(b)
  Input()
EndIf


import copy
deepcopy_of_obj = copy.deepcopy(obj)


#lang racket

(define (deepcopy x)
  ;; make sure that all sharings are shown
  (parameterize ([print-graph #t]) (read (open-input-string (format "~s" x)))))

(define (try x)
  ;; use the same setting to see that it worked
  (parameterize ([print-graph #t])
    (printf "original: ~s\n" x)
    (printf "deepcopy: ~s\n" (deepcopy x))
    ;; print both also, which shows that they are indeed different
    (printf "both: ~s\n" (list x (deepcopy x)))))
(try (shared ([x (cons 1 x)]) (list x x)))


If OpenConsole()
  Structure Persona
    nombre.s{15}
    apellido.s{30}
    edad.w
    List amigos$()
  EndStructure

  Dim MyFriends.Persona(100)

  ; Aquí la posición '1' del array MyFriends()
  ; contendrá una persona y su propia información
  MyFriends(1)\nombre = "Carlos"
  MyFriends(1)\apellido = "Gzlez."
  MyFriends(1)\edad = 47

  individuo.Persona
  individuo\nombre = "Juan"
  individuo\apellido = "Hdez."
  individuo\edad   = 49

  ; Ahora, agrega algunos amigos
  AddElement(individuo\amigos$())
  individuo\amigos$() = "Lucia"

  AddElement(individuo\amigos$())
  individuo\amigos$() = "Isabel"

  ForEach individuo\amigos$()
    Debug individuo\amigos$()
  Next

  ;Estructura extendida
  Structure Domicilio Extends Persona
    calle.s
    numero.b
  EndStructure

  MyFriends.Domicilio\calle = "Grillo"
  MyFriends.Domicilio\numero = 20

  PrintN(individuo\nombre + "  " + individuo\apellido + "  " + Str(individuo\edad) + "  " +  Str(MyFriends.Domicilio\numero))
  PrintN(MyFriends(1)\nombre + "  " + MyFriends(1)\apellido + "  " + Str(MyFriends(1)\edad))

  If TypeOf(Persona\edad) = #PB_Word
    Debug "Edad ess un 'Word'"
  EndIf

  superficie.f
  If TypeOf(superficie) = #PB_Float
    Debug "superficie es un 'Float'"
  EndIf

  Print(#CRLF$ + #CRLF$ + "--- terminado, pulsa RETURN---"): Input()
  CloseConsole()
EndIf


>>> class num(int):
    def __init__(self, b):
        if 1 <= b <= 10:
            return int.__init__(self+0)
        else:
            raise ValueError,"Value %s should be >=0 and <= 10" % b

>>> x = num(3)
>>> x = num(11)

Traceback (most recent call last):
  File "<pyshell#394>", line 1, in <module>
    x = num(11)
  File "<pyshell#392>", line 6, in __init__
    raise ValueError,"Value %s should be >=0 and <= 10" % b
ValueError: Value 11 should be >=0 and <= 10
>>> x
3
>>> type(x)
<class '__main__.num'>
>>>


my %x = foo => 0, bar => [0, 1];
my %y = %x.deepmap(*.clone);

%x<bar>[1]++;
say %x;
say %y;


# _orig_ is a Hash that contains an Array.
orig = { :num => 1, :ary => [2, 3] }
orig[:cycle] = orig	# _orig_ also contains itself.

# _copy_ becomes a deep copy of _orig_.
copy = Marshal.load(Marshal.dump orig)

# These changes to _orig_ never affect _copy_,
# because _orig_ and _copy_ are disjoint structures.
orig[:ary] << 4
orig[:rng] = (5..6)

# Because of deep copy, orig[:ary] and copy[:ary]
# refer to different Arrays.
p orig	# => {:num=>1, :ary=>[2, 3, 4], :cycle=>{...}, :rng=>5..6}
p copy	# => {:num=>1, :ary=>[2, 3], :cycle=>{...}}

# The original contains itself, and the copy contains itself,
# but the original and the copy are not the same object.
p [(orig.equal? orig[:cycle]),
   (copy.equal? copy[:cycle]),
   (not orig.equal? copy)]	# => [true, true, true]


// The compiler can automatically implement Clone on structs (assuming all members have implemented Clone).
#[derive(Clone)]
struct Tree<T> {
    left: Leaf<T>,
    data: T,
    right: Leaf<T>,
}

type Leaf<T> = Option<Box<Tree<T>>>;

impl<T> Tree<T> {
    fn root(data: T) -> Self {
        Self { left: None, data, right: None }
    }

    fn leaf(d: T) -> Leaf<T> {
        Some(Box::new(Self::root(d)))
    }
}

fn main() {
    let mut tree = Tree::root([4, 5, 6]);
    tree.right = Tree::leaf([1, 2, 3]);
    tree.left = Tree::leaf([7, 8, 9]);

    let newtree = tree.clone();
}


(define (deep-copy-1 exp)
  ;; basic version that copies an arbitrary tree made up of pairs
  (cond ((pair? exp)
	 (cons (deep-copy-1 (car exp))
	       (deep-copy-1 (cdr exp))))
	;; cases for extra container data types can be
	;; added here, like vectors and so on
	(else ;; atomic objects
	 (if (string? exp)
	     (string-copy exp)
	     exp))))

(define (deep-copy-2 exp)
  (let ((sharing (make-hash-table)))
    (let loop ((exp exp))
      (cond ((pair? exp)
	     (cond ((get-hash-table sharing exp #f)
		    => (lambda (copy)
			 copy))
		   (else
		    (let ((res (cons #f #f)))
		      (put-hash-table! sharing exp res)
		      (set-car! res (loop (car exp)))
		      (set-cdr! res (loop (cdr exp)))
		      res))))
	    (else
	     (if (string? exp)
		 (string-copy exp)
		 exp))))))

(define t1 '(a b c d))
(define t2 (list #f))
(set-car! t2 t2)
(define t2b (list #f))
(set-car! t2b t2b)
(define t3 (list #f #f))
(set-car! t3 t3)
(set-car! (cdr t3) t3)
(define t4 (list t2 t2b))

;> (print-graph #t)
;> (deep-copy-2 t1)
;(a b c d)
;> (deep-copy-2 t2)
;#0=(#0#)
;> (deep-copy-2 t3)
;#0=(#0# #0#)
;> (deep-copy-2 t4)
;(#0=(#0#) #1=(#1#))


TYPE TipoUsuario
    nombre AS STRING * 15
    apellido AS STRING * 30
    edad AS INTEGER
END TYPE

DIM usuario(1 TO 20) AS TipoUsuario

usuario(1).nombre = "Juan"
usuario(1).apellido = "Hdez."
usuario(1).edad = 49

PRINT usuario(1).nombre, usuario(1).apellido, usuario(1).edad


#lang racket

(provide (contract-out [x 1-to-10/c]))

(define 1-to-10/c (between/c 1 10))

(define x 5)


subset OneToTen of Int where 1..10;

my OneToTen $n = 5;
$n += 6;


var src = Hash(foo => 0, bar => [0,1])

# Add a cyclic reference
src{:baz} = src

# Make a deep clone
var dst = src.dclone

# The address of src
say src.object_id
say src{:baz}.object_id

# The address of dst
say dst.object_id
say dst{:baz}.object_id


set deepCopy [string range ${valueToCopy}x 0 end-1]


import "/trait" for Cloneable, CloneableSeq
import "/seq" for Lst

class MyMap is Cloneable {
    construct new (m) {
        if (m.type != Map) Fiber.abort("Argument must be a Map.")
        _m = m
    }

    m { _m }

    toString { _m.toString }

    clone() {
        // Map keys are always immutable built-in types so we only need to worry about
        // their values which can be anything.
        var m2 = {}
        for (me in _m) {
            var v = me.value
            m2[me.key] = (v is List) ? Lst.clone(v) :
                         (v is Cloneable || v is CloneableSeq) ? v.clone() : v
        }
        return MyMap.new(m2)
    }
}

var my = MyMap.new({"a": 0, "b": 1, "c": [2, 3], "d": MyMap.new({"e": 4})})
var my2 = my.clone()
System.print("Before any changes:")
System.print("  my  = %(my)")
System.print("  my2 = %(my2)")
// now change my2
my2.m["a"] = 5
my2.m["b"] = 6
my2.m["c"][0] = 7
my2.m["c"][1] = 8
my2.m["d"].m["e"] = 9
my2.m["d"].m["f"] = 10
System.print("\nAfter changes to my2:")
System.print("  my  = %(my)")
System.print("  my2 = %(my2)")


{{
  variable update
---reveal---
  : .limited @update &! &@ if update off ;
  : to       dup 1 10 within [ update on ] [ drop "Out of bounds\n" puts ] if ;
  : limited: create 1 , &.limited reclass ;
}}


Some object-oriented languages won't let you subclass the "basic" data types
like integers. Other languages implement those data types as classes, so you
can subclass them, no questions asked. Ruby implements numbers as classes
(Integer, with its concrete subclasses Fixnum and Bignum), and you can subclass
those classes. If you try, though, you'll quickly discover that your subclasses
are useless: they don't have constructors.

Ruby jealously guards the creation of new Integer objects. This way it ensures
that, for instance, there can be only one Fixnum instance for a given number

The easiest way to delegate all methods is to create a class that's nearly empty
and define a method_missing method.


use std::convert::TryFrom;

mod test_mod {
    use std::convert::TryFrom;
    use std::fmt;

    // Because the `i8` is not `pub` this cannot be directly constructed
    // by code outside this module
    #[derive(Copy, Clone, Debug)]
    pub struct TwoDigit(i8);

    impl TryFrom<i8> for TwoDigit {
        type Error = &'static str;

        fn try_from(value: i8) -> Result<Self, Self::Error> {
            if value < -99 || value > 99 {
                Err("Number cannot fit into two decimal digits")
            } else {
                Ok(TwoDigit(value))
            }
        }
    }

    impl Into<i8> for TwoDigit {
        fn into(self) -> i8 { self.0 }
    }

    // This powers `println!`'s `{}` token.
    impl fmt::Display for TwoDigit {
        fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
            write!(f, "{}", self.0)
        }
    }
}

pub fn main() {
    let foo = test_mod::TwoDigit::try_from(50).unwrap();
    let bar: i8 = foo.into();
    println!("{} == {}", foo, bar);
}


  class TinyInt(val int: Byte) {
    import TinyInt._
    require(int >= lower && int <= upper, "TinyInt out of bounds.")

    override def toString = int.toString
  }

  object TinyInt {
    val (lower, upper) = (1, 10)

    def apply(i: Byte) = new TinyInt(i)
  }

  val test = (TinyInt.lower to TinyInt.upper).map(n => TinyInt(n.toByte))


subset Integer    < Number  { .is_int }
subset MyIntLimit < Integer { . ~~ (1 ..^ 10) }

class MyInt(value < MyIntLimit) {

    method to_s      { value.to_s }
    method get_value { value.get_value }

    method ==(Number x) { value == x }
    method ==(MyInt  x) { value == x.value }

    method AUTOLOAD(_, name, *args) {
        var results = [value.(name)(args.map {|n| Number(n) }...)]
        results.map{|r| r.kind_of(Number) ? MyInt(r.int) : r}...
    }
}

#
## Example:
#
var a = MyInt(2)    # creates a new object of type `MyInt`
a += 7              # adds 7 to a
say a               # => 9
say a/2             # => 4

var b = (a - 3)     # b is of type `MyInt`
say b               # => 6

say a.as_hex.dump   # => "9" -- an hexadecimal string

a -= 6              # a=3
var c = (a + b)     # MyInt(3) + MyInt(6)
say c               # => 9
say c.class         # => MyInt

a *= 2              # a=6
say a+b             # error: class `MyInt` does not match MyInt(12)


struct SmallInt {
  var value: Int

  init(value: Int) {
    guard value >= 1 && value <= 10 else {
      fatalError("SmallInts must be in the range [1, 10]")
    }

    self.value = value
  }

  static func +(_ lhs: SmallInt, _ rhs: SmallInt) -> SmallInt { SmallInt(value: lhs.value + rhs.value) }
  static func -(_ lhs: SmallInt, _ rhs: SmallInt) -> SmallInt { SmallInt(value: lhs.value - rhs.value) }
  static func *(_ lhs: SmallInt, _ rhs: SmallInt) -> SmallInt { SmallInt(value: lhs.value * rhs.value) }
  static func /(_ lhs: SmallInt, _ rhs: SmallInt) -> SmallInt { SmallInt(value: lhs.value / rhs.value) }
}

extension SmallInt: ExpressibleByIntegerLiteral {
  public init(integerLiteral value: Int) { self.init(value: value) }
}

extension SmallInt: CustomStringConvertible {
  public var description: String { "\(value)" }
}

let a: SmallInt = 1
let b: SmallInt = 9
let c: SmallInt = 10
let d: SmallInt = 2

print(a + b)
print(c - b)
print(a * c)
print(c / d)
print(a + c)


namespace eval ::myIntType {
    variable value_cache
    array set value_cache {}
    variable type integer
    variable min 1
    variable max 10
    variable errMsg "cannot set %s to %s: must be a $type between $min and $max"
}
proc ::myIntType::declare varname {
    set ns [namespace current]
    uplevel [list trace add variable $varname write ${ns}::write]
    uplevel [list trace add variable $varname unset ${ns}::unset_var]
}
proc ::myIntType::unset_var {varname args} {
    variable value_cache
    unset value_cache($varname)
}
proc ::myIntType::validate {value} {
    variable type
    variable min
    variable max
    expr {[string is $type -strict $value] && $min <= $value && $value <= $max}
}
proc ::myIntType::write {varname args} {
    variable value_cache
    upvar $varname var
    set value $var
    if {[validate $value]} {
        set value_cache($varname) $value
    } else {
        if {[info exists value_cache($varname)]} {
            set var $value_cache($varname)
        }
        variable errMsg
        error [format $errMsg $varname $value]
    }
}


needs quotes
{
  variable update
  [ update @ [ ! ] [ @ ] ifTrueFalse update off ] is action
  [ dup >r 0 11 r> within [ update on ] [ drop ." Out of bounds\n " ] ifTrueFalse ]
  [ ` [ invoke cell-size malloc # ` action compile ` ] invoke is ]
} is value:1-10:
  is to

value:1-10: foo
1 to foo
foo .


typeset -i boundedint
function boundedint.set {
    nameref var=${.sh.name}
    if (( 1 <= .sh.value && .sh.value <= 10 )); then
        # stash the valid value as a backup, in case we need to restore it
        typeset -i var.previous_value=${.sh.value}
    else
        print -u2 "value out of bounds"
        # restore previous value
        .sh.value=${var.previous_value}
    fi
}

boundedint=-5; echo $boundedint
boundedint=5;  echo $boundedint
boundedint=15; echo $boundedint


#import nat

my_number ::

the_number %n  -|~bounds.&BZ,~&B+ [email protected]+ ~/the_number bounds|-?(~the_number,<'out of bounds'>!%)
bounds     %nW ~bounds.&B?(~bounds,(1,10)!)

add = my_number$[the_number: sum+ ~the_number~~]
mul = my_number$[the_number: product+ ~the_number~~]


Private mvarValue As Integer

Public Property Let Value(ByVal vData As Integer)
    If (vData > 10) Or (vData < 1) Then
        Error 380   'Invalid property value; could also use 6, Overflow
    Else
        mvarValue = vData
    End If
End Property

Public Property Get Value() As Integer
    Value = mvarValue
End Property

Private Sub Class_Initialize()
    'vb defaults to 0 for numbers; let's change that...
    mvarValue = 1
End Sub


Structure LimitedInt
    Implements IComparable, IComparable(Of LimitedInt), IConvertible, IEquatable(Of LimitedInt), IFormattable

    Private Const MIN_VALUE = 1
    Private Const MAX_VALUE = 10

    Shared ReadOnly MinValue As New LimitedInt(MIN_VALUE)
    Shared ReadOnly MaxValue As New LimitedInt(MAX_VALUE)

    Private Shared Function IsValidValue(value As Integer) As Boolean
        Return value >= MIN_VALUE AndAlso value <= MAX_VALUE
    End Function

    Private ReadOnly _value As Integer
    ReadOnly Property Value As Integer
        Get
            ' Treat the default, 0, as being the minimum value.
            Return If(Me._value = 0, MIN_VALUE, Me._value)
        End Get
    End Property

    Sub New(value As Integer)
        If Not IsValidValue(value) Then Throw New ArgumentOutOfRangeException(NameOf(value), value, $"Value must be between {MIN_VALUE} and {MAX_VALUE}.")
        Me._value = value
    End Sub

#Region "IComparable"
    Function CompareTo(obj As Object) As Integer Implements IComparable.CompareTo
        If TypeOf obj IsNot LimitedInt Then Throw New ArgumentException("Object must be of type " + NameOf(LimitedInt), NameOf(obj))
        Return Me.CompareTo(DirectCast(obj, LimitedInt))
    End Function
#End Region

#Region "IComparable(Of LimitedInt)"
    Function CompareTo(other As LimitedInt) As Integer Implements IComparable(Of LimitedInt).CompareTo
        Return Me.Value.CompareTo(other.Value)
    End Function
#End Region

#Region "IConvertible"
    Function GetTypeCode() As TypeCode Implements IConvertible.GetTypeCode
        Return Me.Value.GetTypeCode()
    End Function

    Private Function ToBoolean(provider As IFormatProvider) As Boolean Implements IConvertible.ToBoolean
        Return DirectCast(Me.Value, IConvertible).ToBoolean(provider)
    End Function

    Private Function ToByte(provider As IFormatProvider) As Byte Implements IConvertible.ToByte
        Return DirectCast(Me.Value, IConvertible).ToByte(provider)
    End Function

    Private Function ToChar(provider As IFormatProvider) As Char Implements IConvertible.ToChar
        Return DirectCast(Me.Value, IConvertible).ToChar(provider)
    End Function

    Private Function ToDateTime(provider As IFormatProvider) As Date Implements IConvertible.ToDateTime
        Return DirectCast(Me.Value, IConvertible).ToDateTime(provider)
    End Function

    Private Function ToDecimal(provider As IFormatProvider) As Decimal Implements IConvertible.ToDecimal
        Return DirectCast(Me.Value, IConvertible).ToDecimal(provider)
    End Function

    Private Function ToDouble(provider As IFormatProvider) As Double Implements IConvertible.ToDouble
        Return DirectCast(Me.Value, IConvertible).ToDouble(provider)
    End Function

    Private Function ToInt16(provider As IFormatProvider) As Short Implements IConvertible.ToInt16
        Return DirectCast(Me.Value, IConvertible).ToInt16(provider)
    End Function

    Private Function ToInt32(provider As IFormatProvider) As Integer Implements IConvertible.ToInt32
        Return DirectCast(Me.Value, IConvertible).ToInt32(provider)
    End Function

    Private Function ToInt64(provider As IFormatProvider) As Long Implements IConvertible.ToInt64
        Return DirectCast(Me.Value, IConvertible).ToInt64(provider)
    End Function

    Private Function ToSByte(provider As IFormatProvider) As SByte Implements IConvertible.ToSByte
        Return DirectCast(Me.Value, IConvertible).ToSByte(provider)
    End Function

    Private Function ToSingle(provider As IFormatProvider) As Single Implements IConvertible.ToSingle
        Return DirectCast(Me.Value, IConvertible).ToSingle(provider)
    End Function

    Private Overloads Function ToString(provider As IFormatProvider) As String Implements IConvertible.ToString
        Return Me.Value.ToString(provider)
    End Function

    Private Function ToType(conversionType As Type, provider As IFormatProvider) As Object Implements IConvertible.ToType
        Return DirectCast(Me.Value, IConvertible).ToType(conversionType, provider)
    End Function

    Private Function ToUInt16(provider As IFormatProvider) As UShort Implements IConvertible.ToUInt16
        Return DirectCast(Me.Value, IConvertible).ToUInt16(provider)
    End Function

    Private Function ToUInt32(provider As IFormatProvider) As UInteger Implements IConvertible.ToUInt32
        Return DirectCast(Me.Value, IConvertible).ToUInt32(provider)
    End Function

    Private Function ToUInt64(provider As IFormatProvider) As ULong Implements IConvertible.ToUInt64
        Return DirectCast(Me.Value, IConvertible).ToUInt64(provider)
    End Function
#End Region

#Region "IEquatable(Of LimitedInt)"
    Overloads Function Equals(other As LimitedInt) As Boolean Implements IEquatable(Of LimitedInt).Equals
        Return Me = other
    End Function
#End Region

#Region "IFormattable"
    Private Overloads Function ToString(format As String, formatProvider As IFormatProvider) As String Implements IFormattable.ToString
        Return Me.Value.ToString(format, formatProvider)
    End Function
#End Region

#Region "Operators"
    Shared Operator =(left As LimitedInt, right As LimitedInt) As Boolean
        Return left.Value = right.Value
    End Operator

    Shared Operator <>(left As LimitedInt, right As LimitedInt) As Boolean
        Return left.Value <> right.Value
    End Operator

    Shared Operator <(left As LimitedInt, right As LimitedInt) As Boolean
        Return left.Value < right.Value
    End Operator

    Shared Operator >(left As LimitedInt, right As LimitedInt) As Boolean
        Return left.Value > right.Value
    End Operator

    Shared Operator <=(left As LimitedInt, right As LimitedInt) As Boolean
        Return left.Value <= right.Value
    End Operator

    Shared Operator >=(left As LimitedInt, right As LimitedInt) As Boolean
        Return left.Value >= right.Value
    End Operator

    Shared Operator +(left As LimitedInt) As LimitedInt
        Return CType(+left.Value, LimitedInt)
    End Operator

    Shared Operator -(left As LimitedInt) As LimitedInt
        Return CType(-left.Value, LimitedInt)
    End Operator

    Shared Operator +(left As LimitedInt, right As LimitedInt) As LimitedInt
        Return CType(left.Value + right.Value, LimitedInt)
    End Operator

    Shared Operator -(left As LimitedInt, right As LimitedInt) As LimitedInt
        Return CType(left.Value - right.Value, LimitedInt)
    End Operator

    Shared Operator *(left As LimitedInt, right As LimitedInt) As LimitedInt
        Return CType(left.Value * right.Value, LimitedInt)
    End Operator

    Shared Operator /(left As LimitedInt, right As LimitedInt) As Double
        Return left.Value / right.Value
    End Operator

    Shared Operator \(left As LimitedInt, right As LimitedInt) As LimitedInt
        Return CType(left.Value \ right.Value, LimitedInt)
    End Operator

    Shared Operator ^(left As LimitedInt, right As LimitedInt) As Double
        Return left.Value ^ right.Value
    End Operator

    Shared Operator Mod(left As LimitedInt, right As LimitedInt) As LimitedInt
        Return CType(left.Value Mod right.Value, LimitedInt)
    End Operator

    Shared Operator And(left As LimitedInt, right As LimitedInt) As LimitedInt
        Return CType(left.Value And right.Value, LimitedInt)
    End Operator

    Shared Operator Or(left As LimitedInt, right As LimitedInt) As LimitedInt
        Return CType(left.Value Or right.Value, LimitedInt)
    End Operator

    Shared Operator Xor(left As LimitedInt, right As LimitedInt) As LimitedInt
        Return CType(left.Value Xor right.Value, LimitedInt)
    End Operator

    Shared Operator Not(left As LimitedInt) As LimitedInt
        Return CType(Not left.Value, LimitedInt)
    End Operator

    Shared Operator >>(left As LimitedInt, right As Integer) As LimitedInt
        Return CType(left.Value >> right, LimitedInt)
    End Operator

    Shared Operator <<(left As LimitedInt, right As Integer) As LimitedInt
        Return CType(left.Value << right, LimitedInt)
    End Operator

    Shared Widening Operator CType(value As LimitedInt) As Integer
        Return value.Value
    End Operator

    Shared Narrowing Operator CType(value As Integer) As LimitedInt
        If Not IsValidValue(value) Then Throw New OverflowException()
        Return New LimitedInt(value)
    End Operator
#End Region

    'Function TryFormat(destination As Span(Of Char), ByRef charsWritten As Integer, Optional format As ReadOnlySpan(Of Char) = Nothing, Optional provider As IFormatProvider = Nothing) As Boolean
    '    Return Me.Value.TryFormat(destination, charsWritten, format, provider)
    'End Function

    Overrides Function GetHashCode() As Integer
        Return Me.Value.GetHashCode
    End Function

    Overrides Function Equals(obj As Object) As Boolean
        Return TypeOf obj Is LimitedInt AndAlso Me.Equals(DirectCast(obj, LimitedInt))
    End Function

    Overrides Function ToString() As String
        Return Me.Value.ToString()
    End Function

#Region "Shared Methods"
    'Shared Function TryParse(s As ReadOnlySpan(Of Char), ByRef result As Integer) As Boolean
    '    Return Integer.TryParse(s, result)
    'End Function

    'Shared Function TryParse(s As ReadOnlySpan(Of Char), style As Globalization.NumberStyles, provider As IFormatProvider, ByRef result As Integer) As Boolean
    '    Return Integer.TryParse(s, style, provider, result)
    'End Function

    Shared Function Parse(s As String, provider As IFormatProvider) As Integer
        Return Integer.Parse(s, provider)
    End Function

    Shared Function Parse(s As String, style As Globalization.NumberStyles, provider As IFormatProvider) As Integer
        Return Integer.Parse(s, style, provider)
    End Function

    Shared Function TryParse(s As String, style As Globalization.NumberStyles, provider As IFormatProvider, ByRef result As Integer) As Boolean
        Return Integer.TryParse(s, style, provider, result)
    End Function

    Shared Function Parse(s As String) As Integer
        Return Integer.Parse(s)
    End Function
    Shared Function Parse(s As String, style As Globalization.NumberStyles) As Integer
        Return Integer.Parse(s, style)
    End Function

    'Shared Function Parse(s As ReadOnlySpan(Of Char), Optional style As Globalization.NumberStyles = Globalization.NumberStyles.Integer, Optional provider As IFormatProvider = Nothing) As Integer
    '    Return Integer.Parse(s, style, provider)
    'End Function

    Shared Function TryParse(s As String, ByRef result As Integer) As Boolean
        Return Integer.TryParse(s, result)
    End Function
#End Region
End Structure


LOCAL o As BoundedInt
o = NEWOBJECT("BoundedInt")
DO WHILE NOT o.lHasError
    o.nValue = o.nValue + 2 && will get as far as 9.
    ? o.nValue
ENDDO

DEFINE CLASS BoundedInt As Custom
nValue = 1	&& default value
lHasError = .F.

PROCEDURE nValue_Assign(tnValue)
*!* This method will check the parameter and if
*!* it is out of bounds, the value will remain unchanged
*!* and an error generated.
tnValue = CAST(tnValue As I)
IF BETWEEN(tnValue, 1, 10)
    THIS.nValue = tnValue
ELSE
    ERROR "Value must be between 1 and 10."
ENDIF
ENDPROC

PROCEDURE Error(nError, cMethod, nLine)
IF nError = 1098
    MESSAGEBOX(MESSAGE(), 0, "Error")
ELSE
    DODEFAULT()
ENDIF
THIS.lHasError = .T.
ENDDEFINE


class TinyInt {
    construct new(n) {
        if (!(n is Num && n.isInteger && n >= 1 && n <= 10)) {
            Fiber.abort("Argument must be an integer between 1 and 10.")
        }
        _n = n
    }

    n { _n }

    +(other) { TinyInt.new(_n + other.n) }
    -(other) { TinyInt.new(_n - other.n) }
    *(other) { TinyInt.new(_n * other.n) }
    /(other) { TinyInt.new((_n / other.n).truncate) }

    ==(other) { _n == other.n }
    !=(other) { _n != other.n }

    toString { _n.toString }
}

var a = TinyInt.new(1)
var b = TinyInt.new(2)
var c = a + b
System.print("%(a) + %(b) = %(c)")
var d = c - a
System.print("%(c) - %(a) = %(d)")
var e = d / d
System.print("%(d) / %(d) = %(e)")
var f = c * c
System.print("%(c) * %(c) = %(f)")
System.print("%(a) != %(b) -> %(a != b)")
System.print("%(a) + %(a) == %(b) -> %((a + a) == b)")
var g = f + b // out of range error here


T Sphere
   Float cx, cy, cz, r
   F (cx, cy, cz, r)
      .cx = cx
      .cy = cy
      .cz = cz
      .r = r

F dotp(v1, v2)
   V d = dot(v1, v2)
   R I d < 0 {-d} E 0.0

F hit_sphere(sph, x0, y0)
   V x = x0 - sph.cx
   V y = y0 - sph.cy
   V zsq = sph.r ^ 2 - (x ^ 2 + y ^ 2)
   I zsq < 0
      R (0B, 0.0, 0.0)
   V szsq = sqrt(zsq)
   R (1B, sph.cz - szsq, sph.cz + szsq)

F draw_sphere(k, ambient, light)
   V shades = ‘.:!*oe&#%@’
   V pos = Sphere(20.0, 20.0, 0.0, 20.0)
   V neg = Sphere(1.0, 1.0, -6.0, 20.0)

   L(i) Int(floor(pos.cy - pos.r)) .< Int(ceil(pos.cy + pos.r) + 1)
      V y = i + 0.5
      L(j) Int(floor(pos.cx - 2 * pos.r)) .< Int(ceil(pos.cx + 2 * pos.r) + 1)
         V x = (j - pos.cx) / 2.0 + 0.5 + pos.cx

         V (h, zb1, zb2) = hit_sphere(pos, x, y)
         Int hit_result
         Float zs2
         I !h
            hit_result = 0
         E
            (h, V zs1, zs2) = hit_sphere(neg, x, y)
            I !h
               hit_result = 1
            E I zs1 > zb1
               hit_result = 1
            E I zs2 > zb2
               hit_result = 0
            E I zs2 > zb1
               hit_result = 2
            E
               hit_result = 1

         V vec = (0.0, 0.0, 0.0)
         I hit_result == 0
            print(‘ ’, end' ‘’)
            L.continue
         E I hit_result == 1
            vec = (x - pos.cx, y - pos.cy, zb1 - pos.cz)
         E I hit_result == 2
            vec = (neg.cx - x, neg.cy - y, neg.cz - zs2)
         vec = normalize(vec)

         V b = dotp(light, vec) ^ k + ambient
         V intensity = Int((1 - b) * shades.len)
         intensity = min(shades.len, max(0, intensity))
         print(shades[intensity], end' ‘’)
      print()

V light = normalize((-50.0, 30.0, 50.0))
draw_sphere(2, 0.5, light)


with Ada.Numerics.Elementary_Functions;
with Ada.Numerics.Generic_Real_Arrays;

with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Video.Palettes;
with SDL.Events.Events;

procedure Death_Star is

   Width   : constant := 400;
   Height  : constant := 400;

   package Float_Arrays is
      new Ada.Numerics.Generic_Real_Arrays (Float);
   use Ada.Numerics.Elementary_Functions;
   use Float_Arrays;

   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;

   subtype Vector_3 is Real_Vector (1 .. 3);

   type Sphere_Type is record
      Cx, Cy, Cz : Integer;
      R          : Integer;
   end record;

   function Normalize (V : Vector_3) return Vector_3 is
      (V / Sqrt (V * V));

   procedure Hit (S      :     Sphere_Type;
                  X, Y   :     Integer;
                  Z1, Z2 : out Float;
                  Is_Hit : out Boolean)
   is
      NX    : constant Integer := X - S.Cx;
      NY    : constant Integer := Y - S.Cy;
      Zsq   : constant Integer := S.R * S.R - (NX * NX + NY * NY);
      Zsqrt : Float;
   begin
      if Zsq >= 0 then
         Zsqrt  := Sqrt (Float (Zsq));
         Z1     := Float (S.Cz) - Zsqrt;
         Z2     := Float (S.Cz) + Zsqrt;
         Is_Hit := True;
         return;
      end if;
      Z1     := 0.0;
      Z2     := 0.0;
      Is_Hit := False;
   end Hit;

   procedure Draw_Death_Star (Pos, Neg : Sphere_Type;
                              K, Amb   : Float;
                              Dir      : Vector_3)
   is
      Vec      : Vector_3;
      ZB1, ZB2 : Float;
      ZS1, ZS2 : Float;
      Is_Hit   : Boolean;
      S        : Float;
      Lum      : Integer;
   begin
      for Y in Pos.Cy - Pos.R .. Pos.Cy + Pos.R loop
         for X in Pos.Cx - Pos.R .. Pos.Cx + Pos.R loop
            Hit (Pos, X, Y, ZB1, ZB2, Is_Hit);
            if not Is_Hit then
               goto Continue;
            end if;
            Hit (Neg, X, Y, ZS1, ZS2, Is_Hit);
            if Is_Hit then
               if ZS1 > ZB1 then
                  Is_Hit := False;
               elsif ZS2 > ZB2 then
                  goto Continue;
               end if;
            end if;

            if Is_Hit then
               Vec := (Float (Neg.Cx - X),
                       Float (Neg.Cy - Y),
                       Float (Neg.Cz) - ZS2);
            else
               Vec := (Float (X - Pos.Cx),
                       Float (Y - Pos.Cy),
                       ZB1 - Float (Pos.Cz));
            end if;
            S := Float'Max (0.0, Dir * Normalize (Vec));

            Lum := Integer (255.0 * (S ** K + Amb) / (1.0 + Amb));
            Lum := Integer'Max (0, Lum);
            Lum := Integer'Min (Lum, 255);

            Renderer.Set_Draw_Colour ((SDL.Video.Palettes.Colour_Component (Lum),
                                       SDL.Video.Palettes.Colour_Component (Lum),
                                       SDL.Video.Palettes.Colour_Component (Lum),
                                       255));
            Renderer.Draw (Point => (SDL.C.int (X + Width  / 2),
                                     SDL.C.int (Y + Height / 2)));
            <<Continue>>
         end loop;
      end loop;
   end Draw_Death_Star;

   procedure Wait is
      use type SDL.Events.Event_Types;
      Event : SDL.Events.Events.Events;
   begin
      loop
         while SDL.Events.Events.Poll (Event) loop
            if Event.Common.Event_Type = SDL.Events.Quit then
               return;
            end if;
         end loop;
         delay 0.100;
      end loop;
   end Wait;

   Direction : constant Vector_3    := Normalize ((20.0, -40.0, -10.0));
   Positive  : constant Sphere_Type := (0, 0, 0, 120);
   Negative  : constant Sphere_Type := (-90, -90, -30, 100);
begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Death star",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
   Renderer.Set_Draw_Colour ((0, 0, 0, 255));
   Renderer.Fill (Rectangle => (0, 0, Width, Height));

   Draw_Death_Star (Positive, Negative, 1.5, 0.2, Direction);
   Window.Update_Surface;

   Wait;
   Window.Finalize;
   SDL.Finalise;
end Death_Star;


#NoEnv
SetBatchLines, -1
#SingleInstance, Force

; Uncomment if Gdip.ahk is not in your standard library
#Include, Gdip.ahk

; Settings
X := 200, Y := 200, Width := 200, Height := 200 ; Location and size of sphere
rotation := 60 ; degrees
ARGB := 0xFFFF0000 ; Color=Solid Red

If !pToken := Gdip_Startup() ; Start gdi+
{
	MsgBox, 48, gdiplus error!, Gdiplus failed to start. Please ensure you have gdiplus on your system
	ExitApp
}
OnExit, Exit

Gui, -Caption +E0x80000 +LastFound +AlwaysOnTop +ToolWindow +OwnDialogs ; Create GUI
Gui, Show, NA ; Show GUI
hwnd1 := WinExist() ; Get a handle to this window we have created in order to update it later
hbm := CreateDIBSection(A_ScreenWidth, A_ScreenHeight) ; Create a gdi bitmap drawing area
hdc := CreateCompatibleDC() ; Get a device context compatible with the screen
obm := SelectObject(hdc, hbm) ; Select the bitmap into the device context
pGraphics := Gdip_GraphicsFromHDC(hdc) ; Get a pointer to the graphics of the bitmap, for use with drawing functions
Gdip_SetSmoothingMode(pGraphics, 4) ; Set the smoothing mode to antialias = 4 to make shapes appear smother

Gdip_TranslateWorldTransform(pGraphics, X, Y)
Gdip_RotateWorldTransform(pGraphics, rotation)

; Base ellipse
pBrush := Gdip_CreateLineBrushFromRect(0, 0, Width, Height, ARGB, 0xFF000000)
Gdip_FillEllipse(pGraphics, pBrush, 0, 0, Width, Height)

; First highlight ellipse
pBrush := Gdip_CreateLineBrushFromRect(Width*0.1, Height*0.01, Width*0.8, Height*0.6, 0x33FFFFFF, 0x00FFFFFF)
Gdip_FillEllipse(pGraphics, pBrush, Width*0.1, Height*0.01, Width*0.8, Height*0.6)

; Second highlight ellipse
pBrush := Gdip_CreateLineBrushFromRect(Width*0.3, Height*0.02, Width*0.3, Height*0.2, 0xBBFFFFFF, 0x00FFFFFF)
Gdip_FillEllipse(pGraphics, pBrush, Width*0.3, Height*0.02, Width*0.3, Height*0.2)

; Reset variables for smaller subtracted sphere
X-=150
Y-=10
Width*=0.5
Height*=0.4
rotation-=180

Gdip_TranslateWorldTransform(pGraphics, X, Y)
Gdip_RotateWorldTransform(pGraphics, rotation)

; Base ellipse
pBrush := Gdip_CreateLineBrushFromRect(0, 0, Width, Height, ARGB, 0xFF000000)
Gdip_FillEllipse(pGraphics, pBrush, 0, 0, Width, Height)

; First highlight ellipse
pBrush := Gdip_CreateLineBrushFromRect(Width*0.1, Height*0.01, Width*0.8, Height*0.6, 0x33FFFFFF, 0x00FFFFFF)
Gdip_FillEllipse(pGraphics, pBrush, Width*0.1, Height*0.01, Width*0.8, Height*0.6)

; Second highlight ellipse
pBrush := Gdip_CreateLineBrushFromRect(Width*0.3, Height*0.02, Width*0.3, Height*0.2, 0xBBFFFFFF, 0x00FFFFFF)
Gdip_FillEllipse(pGraphics, pBrush, Width*0.3, Height*0.02, Width*0.3, Height*0.2)

UpdateLayeredWindow(hwnd1, hdc, 0, 0, A_ScreenWidth, A_ScreenHeight)
SelectObject(hdc, obm) ; Select the object back into the hdc
Gdip_DeletePath(Path)
Gdip_DeleteBrush(pBrush)
DeleteObject(hbm) ; Now the bitmap may be deleted
DeleteDC(hdc) ; Also the device context related to the bitmap may be deleted
Gdip_DeleteGraphics(G) ; The graphics may now be deleted
Return

Exit:
; gdi+ may now be shutdown on exiting the program
Gdip_Shutdown(pToken)
ExitApp


# We need a database to hold the objects
opendb deathstar.g y

# We will be measuring in kilometers
units km

# Create a sphere of radius 60km centred at the origin
in sph1.s sph 0 0 0 60

# We will be subtracting an overlapping sphere with a radius of 40km
# The resultant hole will be smaller than this, because we only
# only catch the edge
in sph2.s sph 0 90 0 40

# Create a region named deathstar.r which consists of big minus small sphere
r deathstar.r u sph1.s - sph2.s

# We will use a plastic material texture with rgb colour 224,224,224
# with specular lighting value of 0.1 and no inheritance
mater deathstar.r "plastic sp=0.1" 224 224 224 0

# Clear the wireframe display and draw the deathstar
B deathstar.r

# We now trigger the raytracer to see our finished product
rt


#include <stdio.h>
#include <math.h>
#include <unistd.h>

const char *shades = ".:!*oe&#%@";

double light[3] = { -50, 0, 50 };
void normalize(double * v)
{
	double len = sqrt(v[0]*v[0] + v[1]*v[1] + v[2]*v[2]);
	v[0] /= len; v[1] /= len; v[2] /= len;
}

double dot(double *x, double *y)
{
	double d = x[0]*y[0] + x[1]*y[1] + x[2]*y[2];
	return d < 0 ? -d : 0;
}

typedef struct { double cx, cy, cz, r; } sphere_t;

/* positive shpere and negative sphere */
sphere_t pos = { 20, 20, 0, 20 }, neg = { 1, 1, -6, 20 };

/* check if a ray (x,y, -inf)->(x, y, inf) hits a sphere; if so, return
   the intersecting z values.  z1 is closer to the eye */
int hit_sphere(sphere_t *sph, double x, double y, double *z1, double *z2)
{
	double zsq;
	x -= sph->cx;
	y -= sph->cy;
	zsq = sph->r * sph->r - (x * x + y * y);
	if (zsq < 0) return 0;
	zsq = sqrt(zsq);
	*z1 = sph->cz - zsq;
	*z2 = sph->cz + zsq;
	return 1;
}

void draw_sphere(double k, double ambient)
{
	int i, j, intensity, hit_result;
	double b;
	double vec[3], x, y, zb1, zb2, zs1, zs2;
	for (i = floor(pos.cy - pos.r); i <= ceil(pos.cy + pos.r); i++) {
		y = i + .5;
		for (j = floor(pos.cx - 2 * pos.r); j <= ceil(pos.cx + 2 * pos.r); j++) {
			x = (j - pos.cx) / 2. + .5 + pos.cx;

			/* ray lands in blank space, draw bg */
			if (!hit_sphere(&pos, x, y, &zb1, &zb2))
				hit_result = 0;

			/* ray hits pos sphere but not neg, draw pos sphere surface */
			else if (!hit_sphere(&neg, x, y, &zs1, &zs2))
				hit_result = 1;

			/* ray hits both, but pos front surface is closer */
			else if (zs1 > zb1) hit_result = 1;

			/* pos sphere surface is inside neg sphere, show bg */
			else if (zs2 > zb2) hit_result = 0;

			/* back surface on neg sphere is inside pos sphere,
			   the only place where neg sphere surface will be shown */
			else if (zs2 > zb1) hit_result = 2;
			else		    hit_result = 1;

			switch(hit_result) {
			case 0:
				putchar('+');
				continue;
			case 1:
				vec[0] = x - pos.cx;
				vec[1] = y - pos.cy;
				vec[2] = zb1 - pos.cz;
				break;
			default:
				vec[0] = neg.cx - x;
				vec[1] = neg.cy - y;
				vec[2] = neg.cz - zs2;
			}

			normalize(vec);
			b = pow(dot(light, vec), k) + ambient;
			intensity = (1 - b) * (sizeof(shades) - 1);
			if (intensity < 0) intensity = 0;
			if (intensity >= sizeof(shades) - 1)
				intensity = sizeof(shades) - 2;
			putchar(shades[intensity]);
		}
		putchar('\n');
	}
}

int main()
{
	double ang = 0;

	while (1) {
		printf("\033[H");
		light[1] = cos(ang * 2);
		light[2] = cos(ang);
		light[0] = sin(ang);
		normalize(light);
		ang += .05;

		draw_sphere(2, .3);
		usleep(100000);
	}
	return 0;
}


import std.stdio, std.math, std.numeric, std.algorithm;

struct V3 {
    double[3] v;

    @property V3 normalize() pure nothrow const @nogc {
        immutable double len = dotProduct(v, v).sqrt;
        return [v[0] / len, v[1] / len, v[2] / len].V3;
    }

    double dot(in ref V3 y) pure nothrow const @nogc {
        immutable double d = dotProduct(v, y.v);
        return d < 0 ? -d : 0;
    }
}

const struct Sphere { double cx, cy, cz, r; }

void drawSphere(in double k, in double ambient, in V3 light) nothrow {
    /** Check if a ray (x,y, -inf).(x, y, inf) hits a sphere; if so,
    return the intersecting z values.  z1 is closer to the eye.*/
    static bool hitSphere(in ref Sphere sph,
                          in double x0, in double y0,
                          out double z1,
                          out double z2) pure nothrow @nogc {
        immutable double x = x0 - sph.cx;
        immutable double y = y0 - sph.cy;
        immutable double zsq = sph.r ^^ 2 - (x ^^ 2 + y ^^ 2);
        if (zsq < 0)
            return false;
        immutable double szsq = zsq.sqrt;
        z1 = sph.cz - szsq;
        z2 = sph.cz + szsq;
        return true;
    }

    immutable shades = ".:!*oe&#%@";
    // Positive and negative spheres.
    immutable pos = Sphere(20, 20, 0, 20);
    immutable neg = Sphere(1, 1, -6, 20);

    foreach (immutable int i; cast(int)floor(pos.cy - pos.r) ..
                              cast(int)ceil(pos.cy + pos.r) + 1) {
        immutable double y = i + 0.5;
    JLOOP:
        foreach (int j; cast(int)floor(pos.cx - 2 * pos.r) ..
                        cast(int)ceil(pos.cx + 2 * pos.r) + 1) {
            immutable double x = (j - pos.cx) / 2.0 + 0.5 + pos.cx;

            enum Hit { background, posSphere, negSphere }

            double zb1, zs2;
            immutable Hit hitResult = {
                double zb2, zs1;

                if (!hitSphere(pos, x, y, zb1, zb2)) {
                    // Ray lands in blank space, draw bg.
                    return Hit.background;
                } else if (!hitSphere(neg, x, y, zs1, zs2)) {
                    // Ray hits pos sphere but not neg one,
                    // draw pos sphere surface.
                    return Hit.posSphere;
                } else if (zs1 > zb1) {
                    // ray hits both, but pos front surface is closer.
                    return Hit.posSphere;
                } else if (zs2 > zb2) {
                    // pos sphere surface is inside neg sphere,
                    // show bg.
                    return Hit.background;
                } else if (zs2 > zb1) {
                    // Back surface on neg sphere is inside pos
                    // sphere, the only place where neg sphere
                    // surface will be shown.
                    return Hit.negSphere;
                } else {
                    return Hit.posSphere;
                }
            }();

            V3 vec_;
            final switch (hitResult) {
                case Hit.background:
                    ' '.putchar;
                    continue JLOOP;
                case Hit.posSphere:
                    vec_ = [x - pos.cx, y - pos.cy, zb1 - pos.cz].V3;
                    break;
                case Hit.negSphere:
                    vec_ = [neg.cx - x, neg.cy - y, neg.cz - zs2].V3;
                    break;
            }
            immutable nvec = vec_.normalize;

            immutable double b = light.dot(nvec) ^^ k + ambient;
            immutable intensity = cast(int)((1 - b) * shades.length);
            immutable normInt = min(shades.length, max(0, intensity));
            shades[normInt].putchar;
        }

        '\n'.putchar;
    }
}

void main() {
    immutable light = [-50, 30, 50].V3.normalize;
    drawSphere(2, 0.5, light);
}


program Death_Star;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  System.SysUtils,
  system.Math,
  Vcl.Graphics,
  Vcl.Imaging.pngimage;

type
  TVector = array of double;

var
  light: TVector = [20, -40, -10];

function ClampInt(value, amin, amax: Integer): Integer;
begin
  Result := Max(amin, Min(amax, value))
end;

procedure Normalize(var v: TVector);
begin
  var len := Sqrt(v[0] * v[0] + v[1] * v[1] + v[2] * v[2]);
  v[0] := v[0] / len;
  v[1] := v[1] / len;
  v[2] := v[2] / len;
end;

function Dot(x, y: TVector): Double;
begin
  var d := x[0] * y[0] + x[1] * y[1] + x[2] * y[2];
  if d < 0 then
    Result := -d
  else
    Result := 0;
end;

type
  TSphere = record
    cx, cy, cz, r: Double;
  end;

const
  pos: TSphere = (
    cx: 0;
    cy: 0;
    cz: 0;
    r: 120
  );

const
  neg: TSphere = (
    cx: -90;
    cy: -90;
    cz: -30;
    r: 80
  );

function HitSphere(sph: TSphere; x, y: double; var z1, z2: Double): Boolean;
begin
  x := x - sph.cx;
  y := y - sph.cy;
  var zsq := sph.r * sph.r - (x * x + y * y);
  if (zsq < 0) then
    Exit(False);
  zsq := Sqrt(zsq);
  z1 := sph.cz - zsq;
  z2 := sph.cz + zsq;
  Result := True;
end;

function DeathStar(pos, neg: TSphere; k, amb: Double; light: TVector): TBitmap;
var
  w, h, yMax, xMax, s: double;
  zp1, zp2, zn1, zn2, b: Double;
  x, y: Integer;
  hit: Boolean;
  vec: TVector;
  intensity: Byte;
  ox, oy: Integer;
begin
  w := pos.r * 4;
  h := pos.r * 3;
  ox := -trunc(pos.cx - w / 2);
  oy := -trunc(pos.cy - h / 2);

  vec := [0, 0, 0];
  Result := TBitmap.Create;
  Result.SetSize(trunc(w), trunc(h));

  yMax := pos.cy + pos.r;
  for y := Trunc(pos.cy - pos.r) to Trunc(yMax) do
  begin
    xMax := pos.cx + pos.r;
    for x := trunc(pos.cy - pos.r) to trunc(xMax) do
    begin
      hit := HitSphere(pos, x, y, zp1, zp2);
      if not hit then
        continue;

      hit := HitSphere(neg, x, y, zn1, zn2);

      if hit then
      begin
        if zn1 > zp1 then
          hit := false
        else if zn2 > zp2 then
          continue;
      end;

      if hit then
      begin
        vec[0] := neg.cx - x;
        vec[1] := neg.cy - y;
        vec[2] := neg.cz - zn2;
      end
      else
      begin
        vec[0] := x - pos.cx;
        vec[1] := y - pos.cy;
        vec[2] := zp1 - pos.cz;
      end;

      Normalize(vec);

      s := max(0, dot(light, vec));

      b := Power(s, k) + amb;

      intensity := ClampInt(round(255 * b / (1 + amb)), 0, 254);

      Result.Canvas.Pixels[x + ox, y + oy] := rgb(intensity, intensity, intensity);
    end;
  end;
end;

var
  bmp: TBitmap;

begin
  Normalize(light);
  bmp := DeathStar(pos, neg, 1.2, 0.3, light);

  with TPngImage.Create do
  begin
    Assign(bmp);
    TransparentColor := clwhite;
    SaveToFile('out.png');
    bmp.Free;
    Free;
  end;
end.


const cShades = '.:!*oe&#%@';

type TVector = array [0..2] of Float;

var light : TVector = [-50.0, 30, 50];

procedure Normalize(var v : TVector);
begin
   var len := Sqrt(v[0]*v[0] + v[1]*v[1] + v[2]*v[2]);
   v[0] /= len; v[1] /= len; v[2] /= len;
end;

function Dot(x, y : TVector) : Float;
begin
   var d :=x[0]*y[0] + x[1]*y[1] + x[2]*y[2];
   if d<0 then
      Result:=-d
   else Result:=0;
end;

type
   TSphere = record
      cx, cy, cz, r : Float;
   end;

const big : TSphere = (cx: 20; cy: 20; cz: 0; r: 20);
const small : TSphere = (cx: 7; cy: 7; cz: -10; r: 15);

function HitSphere(sph : TSphere; x, y : Float; var z1, z2 : Float) : Boolean;
begin
   x -= sph.cx;
   y -= sph.cy;
   var zsq = sph.r * sph.r - (x * x + y * y);
   if (zsq < 0) then Exit False;
   zsq := Sqrt(zsq);
   z1 := sph.cz - zsq;
   z2 := sph.cz + zsq;
   Result:=True;
end;

procedure DrawSphere(k, ambient : Float);
var
   i, j, intensity : Integer;
   b : Float;
   x, y, zb1, zb2, zs1, zs2 : Float;
   vec : TVector;
begin
   for i:=Trunc(big.cy-big.r) to Trunc(big.cy+big.r)+1 do begin
      y := i + 0.5;
      for j := Trunc(big.cx-2*big.r) to Trunc(big.cx+2*big.r) do begin
         x := (j-big.cx)/2 + 0.5 + big.cx;

         if not HitSphere(big, x, y, zb1, zb2) then begin
            Print(' ');
            continue;
         end;
         if not HitSphere(small, x, y, zs1, zs2) then begin
            vec[0] := x - big.cx;
            vec[1] := y - big.cy;
            vec[2] := zb1 - big.cz;
         end else begin
            if zs1 < zb1 then begin
               if zs2 > zb2 then begin
                  Print(' ');
                  continue;
               end;
               if zs2 > zb1 then begin
                  vec[0] := small.cx - x;
                  vec[1] := small.cy - y;
                  vec[2] := small.cz - zs2;
               end else begin
                  vec[0] := x - big.cx;
                  vec[1] := y - big.cy;
                  vec[2] := zb1 - big.cz;
               end;
            end else begin
               vec[0] := x - big.cx;
               vec[1] := y - big.cy;
               vec[2] := zb1 - big.cz;
            end;
         end;

         Normalize(vec);
         b := Power(Dot(light, vec), k) + ambient;
         intensity := Round((1 - b) * Length(cShades));
         Print(cShades[ClampInt(intensity+1, 1, Length(cShades))]);
      end;
      PrintLn('');
   end;
end;

Normalize(light);

DrawSphere(2, 0.3);


res = 254 / in
v = callJava["frink.graphics.VoxelArray", "makeSphere", [1/2 inch res]]

dish = callJava["frink.graphics.VoxelArray", "makeSphere", [1/2 inch res]]
dish.translate[round[.45 inch res], round[.45 inch res], round[.45 inch res]]
v.remove[dish]

v.projectX[undef].show["X"]
v.projectY[undef].show["Y"]
v.projectZ[undef].show["Z"]

filename = "DeathStar.stl"
print["Writing $filename..."]
w = new Writer[filename]
w.println[v.toSTLFormat["DeathStar", 1/(res mm)]]
w.close[]
println["done."]


package main

import (
    "fmt"
    "image"
    "image/color"
    "image/png"
    "math"
    "os"
)

type vector [3]float64

func (v *vector) normalize() {
    invLen := 1 / math.Sqrt(dot(v, v))
    v[0] *= invLen
    v[1] *= invLen
    v[2] *= invLen
}

func dot(x, y *vector) float64 {
    return x[0]*y[0] + x[1]*y[1] + x[2]*y[2]
}

type sphere struct {
    cx, cy, cz int
    r          int
}

func (s *sphere) hit(x, y int) (z1, z2 float64, hit bool) {
    x -= s.cx
    y -= s.cy
    if zsq := s.r*s.r - (x*x + y*y); zsq >= 0 {
        zsqrt := math.Sqrt(float64(zsq))
        return float64(s.cz) - zsqrt, float64(s.cz) + zsqrt, true
    }
    return 0, 0, false
}

func deathStar(pos, neg *sphere, k, amb float64, dir *vector) *image.Gray {
    w, h := pos.r*4, pos.r*3
    bounds := image.Rect(pos.cx-w/2, pos.cy-h/2, pos.cx+w/2, pos.cy+h/2)
    img := image.NewGray(bounds)
    vec := new(vector)
    for y, yMax := pos.cy-pos.r, pos.cy+pos.r; y <= yMax; y++ {
        for x, xMax := pos.cx-pos.r, pos.cx+pos.r; x <= xMax; x++ {
            zb1, zb2, hit := pos.hit(x, y)
            if !hit {
                continue
            }
            zs1, zs2, hit := neg.hit(x, y)
            if hit {
                if zs1 > zb1 {
                    hit = false
                } else if zs2 > zb2 {
                    continue
                }
            }
            if hit {
                vec[0] = float64(neg.cx - x)
                vec[1] = float64(neg.cy - y)
                vec[2] = float64(neg.cz) - zs2
            } else {
                vec[0] = float64(x - pos.cx)
                vec[1] = float64(y - pos.cy)
                vec[2] = zb1 - float64(pos.cz)
            }
            vec.normalize()
            s := dot(dir, vec)
            if s < 0 {
                s = 0
            }
            lum := 255 * (math.Pow(s, k) + amb) / (1 + amb)
            if lum < 0 {
                lum = 0
            } else if lum > 255 {
                lum = 255
            }
            img.SetGray(x, y, color.Gray{uint8(lum)})
        }
    }
    return img
}

func main() {
    dir := &vector{20, -40, -10}
    dir.normalize()
    pos := &sphere{0, 0, 0, 120}
    neg := &sphere{-90, -90, -30, 100}

    img := deathStar(pos, neg, 1.5, .2, dir)
    f, err := os.Create("dstar.png")
    if err != nil {
        fmt.Println(err)
        return
    }
    if err = png.Encode(f, img); err != nil {
        fmt.Println(err)
    }
    if err = f.Close(); err != nil {
        fmt.Println(err)
    }
}


import Data.List (genericLength)

shades = ".:!*oe%#&@"
n = genericLength shades
dot a b = sum $ zipWith (*) a b
normalize x = (/ sqrt (x `dot` x)) <$> x

deathStar r k amb = unlines $
  [ [ if x*x + y*y <= r*r
      then let vec = normalize $ normal x y
               b = (light `dot` vec) ** k + amb
               intensity = (1 - b)*(n - 1)
           in shades !! round ((0 `max` intensity) `min` n)
      else ' '
    | y <- map (/2.12) [- 2*r - 0.5 .. 2*r + 0.5]  ]
  | x <- [ - r - 0.5 .. r + 0.5] ]
  where
    light = normalize [-30,-30,-50]
    normal x y
      | (x+r)**2 + (y+r)**2 <= r**2 = [x+r, y+r, sph2 x y]
      | otherwise = [x, y, sph1 x y]
    sph1 x y = sqrt (r*r - x*x - y*y)
    sph2 x y = r - sqrt (r*r - (x+r)**2 - (y+r)**2)


load'graphics/viewmat'
mag =: +/&.:*:"1
norm=: %"1 0 mag
dot =: +/@:*"1

NB. (pos;posr;neg;negr) getvec (x,y)
getvec =: 4 :0 "1
  pt =. y
  'pos posr neg negr' =. x
  if. (dot~ pt-}:pos) > *:posr do.
    0 0 0
  else.
    zb =. ({:pos) (-,+)  posr -&.:*: pt [email protected]:- }:pos
    if. (dot~ pt-}:neg) > *:negr do.
      (pt,{:zb) - pos
    else.
      zs =. ({:neg) (-,+) negr -&.:*: pt [email protected]:- }:neg
      if. zs >&{. zb do. (pt,{:zb) - pos
      elseif. zs >&{: zb do. 0 0 0
      elseif. ({.zs) < ({:zb) do. neg - (pt,{.zs)
      elseif. do. (pt,{.zb) - pos end.
    end.
  end.
)

NB. (k;ambient;light) draw_sphere (pos;posr;neg;negr)
draw_sphere =: 4 :0
  'pos posr neg negr' =. y
  'k ambient light' =. x
  vec=. norm y getvec ,"0// (2{.pos) +/ i: 200 j.~ 0.5+posr

  b=. (mag vec) * ambient + k * 0>. light dot vec
)

togray =: 256#. 255 255 255 <[email protected]*"1 0 (%>./@,)

env=.(2; 0.5; (norm _50 30 50))
sph=. 20 20 0; 20;   1 1 _6; 20
'rgb' viewmat togray  env draw_sphere sph


import javafx.application.Application;
import javafx.event.EventHandler;
import javafx.geometry.Point3D;
import javafx.scene.Group;
import javafx.scene.Scene;
import javafx.scene.input.KeyCode;
import javafx.scene.input.KeyEvent;
import javafx.scene.shape.MeshView;
import javafx.scene.shape.TriangleMesh;
import javafx.scene.transform.Rotate;
import javafx.stage.Stage;
public class DeathStar extends Application {

	private static final int DIVISION = 200;// the bigger the higher resolution
	float radius = 300;// radius of the sphere

	@Override
	public void start(Stage primaryStage) throws Exception {
		Point3D otherSphere = new Point3D(-radius, 0, -radius * 1.5);
		final TriangleMesh triangleMesh = createMesh(DIVISION, radius, otherSphere);
		MeshView a = new MeshView(triangleMesh);

		a.setTranslateY(radius);
		a.setTranslateX(radius);
		a.setRotationAxis(Rotate.Y_AXIS);
		Scene scene = new Scene(new Group(a));
//		uncomment if you want to move the other sphere

//		scene.setOnKeyPressed(new EventHandler<KeyEvent>() {
//			Point3D sphere = otherSphere;
//
//			@Override
//			public void handle(KeyEvent e) {
//				KeyCode code = e.getCode();
//				switch (code) {
//				case UP:
//					sphere = sphere.add(0, -10, 0);
//					break;
//				case DOWN:
//					sphere = sphere.add(0, 10, 0);
//					break;
//				case LEFT:
//					sphere = sphere.add(-10, 0, 0);
//					break;
//				case RIGHT:
//					sphere = sphere.add(10, 0, 0);
//					break;
//				case W:
//					sphere = sphere.add(0, 0, 10);
//					break;
//				case S:
//					sphere = sphere.add(0, 0, -10);
//					break;
//				default:
//					return;
//				}
//				a.setMesh(createMesh(DIVISION, radius, sphere));
//
//			}
//		});

		primaryStage.setScene(scene);
		primaryStage.show();
	}

	static TriangleMesh createMesh(final int division, final float radius, final Point3D centerOtherSphere) {
		Rotate rotate = new Rotate(180, centerOtherSphere);
		final int div2 = division / 2;

		final int nPoints = division * (div2 - 1) + 2;
		final int nTPoints = (division + 1) * (div2 - 1) + division * 2;
		final int nFaces = division * (div2 - 2) * 2 + division * 2;

		final float rDiv = 1.f / division;

		float points[] = new float[nPoints * 3];
		float tPoints[] = new float[nTPoints * 2];
		int faces[] = new int[nFaces * 6];

		int pPos = 0, tPos = 0;

		for (int y = 0; y < div2 - 1; ++y) {
			float va = rDiv * (y + 1 - div2 / 2) * 2 * (float) Math.PI;
			float sin_va = (float) Math.sin(va);
			float cos_va = (float) Math.cos(va);

			float ty = 0.5f + sin_va * 0.5f;
			for (int i = 0; i < division; ++i) {
				double a = rDiv * i * 2 * (float) Math.PI;
				float hSin = (float) Math.sin(a);
				float hCos = (float) Math.cos(a);
				points[pPos + 0] = hSin * cos_va * radius;
				points[pPos + 2] = hCos * cos_va * radius;
				points[pPos + 1] = sin_va * radius;

				final Point3D point3D = new Point3D(points[pPos + 0], points[pPos + 1], points[pPos + 2]);
				double distance = centerOtherSphere.distance(point3D);
				if (distance <= radius) {
					Point3D subtract = centerOtherSphere.subtract(point3D);
					Point3D transform = rotate.transform(subtract);
					points[pPos + 0] = (float) transform.getX();
					points[pPos + 1] = (float) transform.getY();
					points[pPos + 2] = (float) transform.getZ();

				}
				tPoints[tPos + 0] = 1 - rDiv * i;
				tPoints[tPos + 1] = ty;
				pPos += 3;
				tPos += 2;
			}
			tPoints[tPos + 0] = 0;
			tPoints[tPos + 1] = ty;
			tPos += 2;
		}

		points[pPos + 0] = 0;
		points[pPos + 1] = -radius;
		points[pPos + 2] = 0;
		points[pPos + 3] = 0;
		points[pPos + 4] = radius;
		points[pPos + 5] = 0;
		pPos += 6;

		int pS = (div2 - 1) * division;

		float textureDelta = 1.f / 256;
		for (int i = 0; i < division; ++i) {
			tPoints[tPos + 0] = rDiv * (0.5f + i);
			tPoints[tPos + 1] = textureDelta;
			tPos += 2;
		}

		for (int i = 0; i < division; ++i) {
			tPoints[tPos + 0] = rDiv * (0.5f + i);
			tPoints[tPos + 1] = 1 - textureDelta;
			tPos += 2;
		}

		int fIndex = 0;
		for (int y = 0; y < div2 - 2; ++y) {
			for (int x = 0; x < division; ++x) {
				int p0 = y * division + x;
				int p1 = p0 + 1;
				int p2 = p0 + division;
				int p3 = p1 + division;

				int t0 = p0 + y;
				int t1 = t0 + 1;
				int t2 = t0 + division + 1;
				int t3 = t1 + division + 1;

				// add p0, p1, p2
				faces[fIndex + 0] = p0;
				faces[fIndex + 1] = t0;
				faces[fIndex + 2] = p1 % division == 0 ? p1 - division : p1;
				faces[fIndex + 3] = t1;
				faces[fIndex + 4] = p2;
				faces[fIndex + 5] = t2;
				fIndex += 6;

				// add p3, p2, p1
				faces[fIndex + 0] = p3 % division == 0 ? p3 - division : p3;
				faces[fIndex + 1] = t3;
				faces[fIndex + 2] = p2;
				faces[fIndex + 3] = t2;
				faces[fIndex + 4] = p1 % division == 0 ? p1 - division : p1;
				faces[fIndex + 5] = t1;
				fIndex += 6;
			}
		}

		int p0 = pS;
		int tB = (div2 - 1) * (division + 1);
		for (int x = 0; x < division; ++x) {
			int p2 = x, p1 = x + 1, t0 = tB + x;
			faces[fIndex + 0] = p0;
			faces[fIndex + 1] = t0;
			faces[fIndex + 2] = p1 == division ? 0 : p1;
			faces[fIndex + 3] = p1;
			faces[fIndex + 4] = p2;
			faces[fIndex + 5] = p2;
			fIndex += 6;
		}

		p0 = p0 + 1;
		tB = tB + division;
		int pB = (div2 - 2) * division;

		for (int x = 0; x < division; ++x) {
			int p1 = pB + x, p2 = pB + x + 1, t0 = tB + x;
			int t1 = (div2 - 2) * (division + 1) + x, t2 = t1 + 1;
			faces[fIndex + 0] = p0;
			faces[fIndex + 1] = t0;
			faces[fIndex + 2] = p1;
			faces[fIndex + 3] = t1;
			faces[fIndex + 4] = p2 % division == 0 ? p2 - division : p2;
			faces[fIndex + 5] = t2;
			fIndex += 6;
		}

		TriangleMesh m = new TriangleMesh();
		m.getPoints().setAll(points);
		m.getTexCoords().setAll(tPoints);
		m.getFaces().setAll(faces);

		return m;
	}

	public static void main(String[] args) {

		launch(args);
	}

}


<!DOCTYPE html>
<html>
<body style="margin:0">
  <canvas id="myCanvas" width="250" height="250" style="border:1px solid #d3d3d3;">
    Your browser does not support the HTML5 canvas tag.
  </canvas>
  <script>
    var c = document.getElementById("myCanvas");
    var ctx = c.getContext("2d");
    //Fill the canvas with a dark gray background
    ctx.fillStyle = "#222222";
    ctx.fillRect(0,0,250,250);

    // Create radial gradient for large base circle
    var grd = ctx.createRadialGradient(225,175,190,225,150,130);
    grd.addColorStop(0,"#EEEEEE");
    grd.addColorStop(1,"black");
    //Apply gradient and fill circle
    ctx.fillStyle = grd;
    ctx.beginPath();
    ctx.arc(125,125,105,0,2*Math.PI);
    ctx.fill();

    // Create linear gradient for small inner circle
    var grd = ctx.createLinearGradient(75,90,102,90);
    grd.addColorStop(0,"black");
    grd.addColorStop(1,"gray");
    //Apply gradient and fill circle
    ctx.fillStyle = grd;
    ctx.beginPath();
    ctx.arc(90,90,30,0,2*Math.PI);
    ctx.fill();

    //Add another small circle on top of the previous one to enhance the "shadow"
    ctx.fillStyle = "black";
    ctx.beginPath();
    ctx.arc(80,90,17,0,2*Math.PI);
    ctx.fill();
  </script>
</body>
</html>


# run in REPL
using GLMakie

function deathstar()
    n = 60
    θ = [0; (0.5: n - 0.5) / n; 1]
    φ = [(0: 2n - 2) * 2 / (2n - 1); 2]
    # if x is +0.9 radius units, replace it with the coordinates of sphere surface
    # at (1.2,0,0) center, radius 0.5 units
    x = [(x1 = cospi(φ)*sinpi(θ)) > 0.9 ? 1.2 - x1 * 0.5 : x1 for θ in θ, φ in φ]
    y = [sinpi(φ)*sinpi(θ) for θ in θ, φ in φ]
    z = [cospi(θ) for θ in θ, φ in φ]
    scene = Scene(backgroundcolor=:black)
    surface!(scene, x, y, z, color = rand(RGBAf0, 124, 124), show_axis=false)
    return scene
end

scene = deathstar()


default {
    state_entry() {
        llSetPrimitiveParams([PRIM_NAME, "RosettaCode DeathStar"]);
        llSetPrimitiveParams([PRIM_DESC, llGetObjectName()]);
        llSetPrimitiveParams([PRIM_TYPE, PRIM_TYPE_SPHERE, PRIM_HOLE_CIRCLE, <0.0, 1.0, 0.0>, 0.0, <0.0, 0.0, 0.0>, <0.12, 1.0, 0.0>]);
        llSetPrimitiveParams([PRIM_ROTATION, <-0.586217, 0.395411, -0.586217, 0.395411>]);
        llSetPrimitiveParams([PRIM_TEXTURE, ALL_SIDES, TEXTURE_BLANK, ZERO_VECTOR, ZERO_VECTOR, 0.0]);
        llSetPrimitiveParams([PRIM_TEXT, llGetObjectName(), <1.0, 1.0, 1.0>, 1.0]);
        llSetPrimitiveParams([PRIM_COLOR, ALL_SIDES, <0.5, 0.5, 0.5>, 1.0]);
        llSetPrimitiveParams([PRIM_BUMP_SHINY, ALL_SIDES, PRIM_SHINY_HIGH, PRIM_BUMP_NONE]);
        llSetPrimitiveParams([PRIM_SIZE, <10.0, 10.0, 10.0>]);
        llSetPrimitiveParams([PRIM_OMEGA, <0.0, 0.0, 1.0>, 1.0, 1.0]);
    }
}


function V3(x,y,z) return {x=x,y=y,z=z} end
function dot(v,w) return v.x*w.x + v.y*w.y + v.z*w.z end
function norm(v) local m=math.sqrt(dot(v,v)) return V3(v.x/m, v.y/m, v.z/m) end
function clamp(n,lo,hi) return math.floor(math.min(math.max(lo,n),hi)) end
function hittest(s, x, y)
  local z = s.r^2 - (x-s.x)^2 - (y-s.y)^2
  if z >= 0 then
    z = math.sqrt(z)
    return true, s.z-z, s.z+z
  end
  return false, 0, 0
end

function deathstar(pos, neg, sun, k, amb)
  shades = {[0]=" ",".",":","!","*","o","e","&","#","%","@"}
  for y = pos.x-pos.r-0.5, pos.x+pos.r+0.5 do
    for x = pos.x-pos.r-0.5, pos.x+pos.r+0.5, 0.5 do
      local hitpos, pz1, pz2 = hittest(pos, x, y)
      local result, hitneg, nz1, nz2 = 0
      if hitpos then
        hitneg, nz1, nz2 = hittest(neg, x, y)
        if not hitneg or nz1 > pz1 then result = 1
        elseif nz2 > pz2 then result = 0
        elseif nz2 > pz1 then result = 2
        else result = 1
        end
      end
      local shade = 0
      if result > 0 then
        if result == 1 then
          shade = clamp((1-dot(sun, norm(V3(x-pos.x, y-pos.y, pz1-pos.z)))^k+amb) * #shades, 1, #shades)
        else
          shade = clamp((1-dot(sun, norm(V3(neg.x-x, neg.y-y, neg.z-nz2)))^k+amb) * #shades, 1, #shades)
        end
      end
      io.write(shades[shade])
    end
    io.write("\n")
  end
end

deathstar({x=20, y=20, z=0, r=20}, {x=10, y=10, z=-15, r=10}, norm(V3(-2,1,3)), 2, 0.1)


with(plots):
with(plottools):
plots:-display(
   implicitplot3d(x^2 + y^2 + z^2 = 1, x = -1..0.85, y = -1..1, z = -1..1, style = surface, grid = [50,50,50]),
   translate(rotate(implicitplot3d(x^2 + y^2 + z^2 = 1, x = 0.85..1, y = -1..1, z = -1..1, style = surface, grid = [50,50,50]), 0, Pi, 0), 1.70, 0, 0),
axes = none, scaling = constrained, color = gray)


RegionPlot3D[x^2 + y^2 + z^2 < 1 && (x + 1.7)^2 + y^2 + z^2 > 1,
{x, -1, 1}, {y, -1, 1}, {z, -1, 1},
Boxed -> False, Mesh -> False, Axes -> False, Background -> Black, PlotPoints -> 100]


import math

import bitmap, grayscale_image, nimPNG

type

  Vector = array[3, float]

  Sphere = object
    cx, cy, cz: int
    r: int

#---------------------------------------------------------------------------------------------------

func dot(x, y: Vector): float {.inline.} =
  x[0] * y[0] + x[1] * y[1] + x[2] * y[2]

#---------------------------------------------------------------------------------------------------

func normalize(v: var Vector) =
  let invLen = 1 / sqrt(dot(v, v))
  v[0] *= invLen
  v[1] *= invLen
  v[2] *= invLen

#---------------------------------------------------------------------------------------------------

func hit(s: Sphere; x, y: int): tuple[z1, z2: float; hit: bool] =
  let x = x - s.cx
  let y = y - s.cy
  let zsq = s.r * s.r - (x * x + y * y)
  if zsq >= 0:
    let zsqrt = sqrt(zsq.toFloat)
    result = (s.cz.toFloat - zsqrt, s.cz.toFloat, true)
  else:
    result = (0.0, 0.0, false)

#---------------------------------------------------------------------------------------------------

func deathStar(pos, neg: Sphere; k, amb: float; dir: Vector): GrayImage =

  let w = pos.r * 4
  let h = pos.r * 3
  result = newGrayImage(w, h)
  var vect: Vector
  let deltaX = pos.cx - w div 2
  let deltaY = pos.cy - h div 2

  let xMax = pos.cx + pos.r
  let yMax = pos.cy + pos.r
  for y in (pos.cy - pos.r)..yMax:
    for x in (pos.cx - pos.r)..xMax:
      let (zb1, zb2, posHit) = pos.hit(x, y)
      if not posHit: continue
      var (zs1, zs2, negHit) = neg.hit(x, y)
      if negHit:
        if zs1 > zb1: negHit = false
        elif zs2 > zb2: continue
      if negHit:
        vect[0] = (neg.cx - x).toFloat
        vect[1] = (neg.cy - y).toFloat
        vect[2] = neg.cz.toFloat - zs2
      else:
        vect[0] = (x - pos.cx).toFloat
        vect[1] = (y - pos.cy).toFloat
        vect[2] = zb1 - pos.cz.toFloat
      vect.normalize()
      var s = dot(dir, vect)
      if s < 0: s = 0
      var lum = (255 * (s.pow(k) + amb) / (1 + amb)).toInt
      if lum < 0: lum = 0
      elif lum > 255: lum = 255
      result[x - deltaX, y - deltaY] = Luminance(lum)

#———————————————————————————————————————————————————————————————————————————————————————————————————

var dir: Vector = [float 20, -40, -10]
dir.normalize()
let pos = Sphere(cx: 0, cy: 0, cz: 0, r: 120)
let neg = Sphere(cx: -90, cy: -90, cz: -30, r: 100)

let grayImage = deathStar(pos, neg, 1.5, 0.2, dir)

# Save to PNG. We convert to an RGB image then transform the pixels
# in a sequence of bytes (actually a copy) in order to call "savePNG24".
let rgbImage = grayImage.toImage
var data = newSeqOfCap[byte](rgbImage.pixels.len * 3)
for color in rgbImage.pixels:
  data.add([color.r, color.g, color.b])
echo savePNG24("death_star.png", data, rgbImage.w, rgbImage.h)


// We are performing geometric subtraction

difference() {

  // Create the primary sphere of radius 60 centred at the origin

  translate(v = [0,0,0]) {
    sphere(60);
  }

  /*Subtract an overlapping sphere with a radius of 40
     The resultant hole will be smaller than this, because we only
     only catch the edge
  */

  translate(v = [0,90,0]) {
    sphere(40);
  }
}


--
-- demo\rosetta\DeathStar.exw
-- ==========================
--
--  Translated from Go.
--
with javascript_semantics
include pGUI.e

constant title = "Death Star"
Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas

function dot(sequence x, sequence y)
    return sum(sq_mul(x,y))
end function

function normalize(sequence v)
    atom len = sqrt(dot(v, v))
    if len=0 then return {0,0,0} end if
    return sq_mul(v,1/len)
end function

enum X,Y,Z

function hit(sequence s, atom x, y, r)
    x -= s[X]
    y -= s[Y]
    atom zsq := r*r - (x*x + y*y)
    if zsq >= 0 then
        atom zsqrt := sqrt(zsq)
        return {s[Z] - zsqrt, s[Z] + zsqrt, true}
    end if
    return {0, 0, false}
end function

procedure deathStar(integer width, height, atom k, atom amb, sequence direction)

    atom t0 = time()+1, t1 = t0,
         lmul = 255/(1+amb)
    integer r = floor((min(width,height)-40)/2),
           cx = floor(width/2),
           cy = floor(height/2)
    sequence pos = {0,0,0},
             neg = {r*-3/4,r*-3/4,r*-1/4}

    for y = -r to +r do
        if time()>t1 then
            -- Let the user know we aren't completely dead just yet
            IupSetStrAttribute(dlg,"TITLE","%s - drawing (%d%%)",{title,100*(y+r)/(2*r)})
            t1 = time()+1
            --
            -- Hmm, not entirely sure why this is needed, but without it
            --  after ~7 seconds the window gets a "(Not Responding)" and
            --  then something decides to force a full repaint, which at
            --  fullscreen will never finish in < 7s on this ancient box.
            -- I suppose this is the corrollary to the above, this time
            --  letting Windows 10 know the process is not quite dead...
            --  Currently and possibly forever neither of these routines
            --  exist in pGUI.js, the browser is more forgiving anyway.
            --
            if platform()!=JS then
                if IupLoopStep()=IUP_CLOSE then
                    IupExitLoop()
                    exit
                end if
            end if
        end if
        for x = -r to +r do
            atom {zb1, zb2, hit1} := hit(pos, x, y, r)
            if hit1 then
                atom {zs1, zs2, hit2} := hit(neg, x, y, r/2)
                if not hit2 or zs2<=zb2 then
                    bool dish = hit2 and zs1<=zb1
                    sequence vec = iff(dish?sq_sub(neg,{x,y,zs2}):{x,y,zb1})
                    atom s = dot(direction, normalize(vec)),
                         l = iff(s<=0?0:power(s,k))
                    integer lum = and_bits(#FF,lmul*(l+amb))
                    cdCanvasPixel(cddbuffer, cx+x, cy-y, lum*#10101)
                end if
            end if
        end for
    end for
    if t1!=t0 then
        IupSetStrAttribute(dlg,"TITLE",title)
    end if
end procedure

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/)
    integer {width, height} = IupGetIntInt(canvas, "DRAWSIZE")
    cdCanvasActivate(cddbuffer)
    cdCanvasClear(cddbuffer)
    deathStar(width, height, 1.5, 0.2, normalize({20, -40, -10}))
    cdCanvasFlush(cddbuffer)
    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    cdCanvasSetBackground(cddbuffer, CD_BLACK)
    return IUP_DEFAULT
end function

procedure main()
    IupOpen()
    canvas = IupCanvas("RASTERSIZE=340x340")
    IupSetCallbacks(canvas, {"MAP_CB", Icallback("map_cb"),
                             "ACTION", Icallback("redraw_cb")})
    dlg = IupDialog(canvas,`TITLE="%s"`,{title})

    IupMap(dlg)
    IupSetAttribute(canvas, "RASTERSIZE", NULL) -- release the minimum limitation
    IupShow(dlg)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


camera { perspective location  <0.0 , .8 ,-3.0> look_at 0
         aperture .1 blur_samples 20 variance 1/100000 focal_point 0}

light_source{< 3,3,-3> color rgb 1}

sky_sphere { pigment{ color rgb <0,.2,.5>}}

plane {y,-5 pigment {color rgb .54} normal {hexagon} }

difference {
 sphere { 0,1 }
 sphere { <-1,1,-1>,1 }
  texture {
    pigment{ granite }
    finish { phong 1 reflection {0.10 metallic 0.5} }
  }
}


import sys, math, collections

Sphere = collections.namedtuple("Sphere", "cx cy cz r")
V3 = collections.namedtuple("V3", "x y z")

def normalize((x, y, z)):
    len = math.sqrt(x**2 + y**2 + z**2)
    return V3(x / len, y / len, z / len)

def dot(v1, v2):
    d = v1.x*v2.x + v1.y*v2.y + v1.z*v2.z
    return -d if d < 0 else 0.0

def hit_sphere(sph, x0, y0):
    x = x0 - sph.cx
    y = y0 - sph.cy
    zsq = sph.r ** 2 - (x ** 2 + y ** 2)
    if zsq < 0:
        return (False, 0, 0)
    szsq = math.sqrt(zsq)
    return (True, sph.cz - szsq, sph.cz + szsq)

def draw_sphere(k, ambient, light):
    shades = ".:!*oe&#%@"
    pos = Sphere(20.0, 20.0, 0.0, 20.0)
    neg = Sphere(1.0, 1.0, -6.0, 20.0)

    for i in xrange(int(math.floor(pos.cy - pos.r)),
                    int(math.ceil(pos.cy + pos.r) + 1)):
        y = i + 0.5
        for j in xrange(int(math.floor(pos.cx - 2 * pos.r)),
                        int(math.ceil(pos.cx + 2 * pos.r) + 1)):
            x = (j - pos.cx) / 2.0 + 0.5 + pos.cx

            (h, zb1, zb2) = hit_sphere(pos, x, y)
            if not h:
                hit_result = 0
            else:
                (h, zs1, zs2) = hit_sphere(neg, x, y)
                if not h:
                    hit_result = 1
                elif zs1 > zb1:
                    hit_result = 1
                elif zs2 > zb2:
                    hit_result = 0
                elif zs2 > zb1:
                    hit_result = 2
                else:
                    hit_result = 1

            if hit_result == 0:
                sys.stdout.write(' ')
                continue
            elif hit_result == 1:
                vec = V3(x - pos.cx, y - pos.cy, zb1 - pos.cz)
            elif hit_result == 2:
                vec = V3(neg.cx-x, neg.cy-y, neg.cz-zs2)
            vec = normalize(vec)

            b = dot(light, vec) ** k + ambient
            intensity = int((1 - b) * len(shades))
            intensity = min(len(shades), max(0, intensity))
            sys.stdout.write(shades[intensity])
        print

light = normalize(V3(-50, 30, 50))
draw_sphere(2, 0.5, light)


/ https://en.wikipedia.org/wiki/BMP_file_format
/ BITMAPINFOHEADER / RGB24

/ generate a header

genheader:{[w;h]
   0x424d, "x"$(f2i4[54+4*h*w],0,0,0,0,54,0,0,0,40,0,0,0,
                f2i4[h],f2i4[w],1,0,24,0,0,0,0,0,
                f2i4[h*((w*3)+((w*3)mod 4))],
                19,11,0,0,19,11,0,0,0,0,0,0,0,0,0,0)};

/ generate a raster line at a vertical position

genrow:{[w;y;fcn]
    row:enlist 0i;xx:0i;do[w;row,:fcn[xx;y];xx+:1i];row,:((w mod 4)#0i);1_row};

/ generate a bitmap

genbitmap:{[w;h;fcn]
    ary:enlist 0i;yy:0i;do[h;ary,:genrow[w;yy;fcn];yy+:1i];"x"$1_ary};

/ deal with endianness
/ might need to reverse last line if host computer is not a PC

f2i4:{[x] r:x;
  s0:r mod 256;r-:s0; r%:256;
  s1:r mod 256;r-:s1; r%:256;
  s2:r mod 256;r-:s2; r%:256;
  s3:r mod 256;
  "h"$(s0,s1,s2,s3)}

/ compose and write a file

writebmp:{[w;h;fcn;fn]
    fn 1: (genheader[h;w],genbitmap[w;h;fcn])};

/ / usage example:
/ w:400;
/ h:300;
/ fcn:{x0:x-w%2;y0:y-h%2;r:175;$[(r*r)>((x0*x0)+(y0*y0));(0;0;255);(0;255;0)]};
/ fn:`:demo.bmp;
/ writebmp[w;h;fcn;fn];


#lang racket
(require plot)
(plot3d (polar3d (λ (φ θ) (real-part (- (sin θ) (sqrt (- (sqr 1/3) (sqr (cos θ)))))))
                 #:samples 100 #:line-style 'transparent #:color 9)
        #:altitude 60 #:angle 80
        #:height  500 #:width 400
        #:x-min  -1/2 #:x-max 1/2
        #:y-min  -1/2 #:y-max 1/2
        #:z-min     0 #:z-max 1)


class sphere {
   has $.cx; # center x coordinate
   has $.cy; # center y coordinate
   has $.cz; # center z coordinate
   has $.r;  # radius
}

my $depth = 255;     # image color depth

my $width = my $height = 255; # dimensions of generated .pgm; must be odd

my $s = ($width - 1)/2;  # scaled dimension to build geometry

my @light = normalize([ 4, -1, -3 ]);

# positive sphere at origin
my $pos = sphere.new(
    cx => 0,
    cy => 0,
    cz => 0,
    r  => $s.Int
);

# negative sphere offset to upper left
my $neg = sphere.new(
    cx => (-$s*.90).Int,
    cy => (-$s*.90).Int,
    cz => (-$s*.3).Int,
    r  => ($s*.7).Int
);

sub MAIN ($outfile = 'deathstar-perl6.pgm') {
    spurt $outfile, ("P5\n$width $height\n$depth\n"); # .pgm header
    my $out = open( $outfile, :a, :bin ) orelse .die;
    say 'Working...';
    $out.write( Blob.new( |draw_ds(3, .15) ) );
    say 'File written.';
    $out.close;
}

sub draw_ds ( $k, $ambient ) {
    my @pixels[$height];

    (($pos.cy - $pos.r) .. ($pos.cy + $pos.r)).race.map: -> $y {
        my @row[$width];
        (($pos.cx - $pos.r) .. ($pos.cx + $pos.r)).map: -> $x {
            # black if we don't hit positive sphere, ignore negative sphere
            if not hit($pos, $x, $y, my $posz) {
                @row[$x + $s] = 0;
                next;
            }
            my @vec;
            # is front of positive sphere inside negative sphere?
            if hit($neg, $x, $y, my $negz) and $negz.min < $posz.min < $negz.max {
                # make black if whole positive sphere eaten here
                if $negz.min < $posz.max < $negz.max { @row[$x + $s] = 0; next; }
                # render inside of negative sphere
                @vec = normalize([$neg.cx - $x, $neg.cy - $y, -$negz.max - $neg.cz]);
            }
            else {
                # render outside of positive sphere
                @vec = normalize([$x - $pos.cx, $y - $pos.cy,  $posz.max - $pos.cz]);
            }
            my $intensity = dot(@light, @vec) ** $k + $ambient;
            @row[$x + $s] = ($intensity * $depth).Int min $depth;
        }
         @pixels[$y + $s] = @row;
    }
    flat |@pixels.map: *.list;
}

# normalize a vector
sub normalize (@vec) { @vec »/» ([+] @vec »*« @vec).sqrt }

# dot product of two vectors
sub dot (@x, @y) { -([+] @x »*« @y) max 0 }

# are the coordinates within the radius of the sphere?
sub hit ($sphere, $x is copy, $y is copy, $z is rw) {
    $x -= $sphere.cx;
    $y -= $sphere.cy;
    my $z2 = $sphere.r * $sphere.r - $x * $x - $y * $y;
    return False if $z2 < 0;
    $z2 = $z2.sqrt;
    $z = $sphere.cz - $z2 .. $sphere.cz + $z2;
    True;
}