/*REXX program that implements various   List Manager   functions.      */
/*┌────────────────────────────────────────────────────────────────────┐
┌─┘                    Functions of the  List Manager                  └─┐
│                                                                        │
│ @init      ─── initializes the List.                                   │
│                                                                        │
│ @size      ─── returns the size of the List  [could be  0  (zero)].    │
│                                                                        │
│ @show      ─── shows (displays) the complete List.                     │
│ @show k,1  ─── shows (displays) the  Kth  item.                        │
│ @show k,m  ─── shows (displays)   M  items,  starting with  Kth  item. │
│ @show ,,─1 ─── shows (displays) the complete List backwards.           │
│                                                                        │
│ @get  k    ─── returns the  Kth  item.                                 │
│ @get  k,m  ─── returns the  M  items  starting with the  Kth  item.    │
│                                                                        │
│ @put  x    ─── adds the  X  items to the  end  (tail) of the List.     │
│ @put  x,0  ─── adds the  X  items to the start (head) of the List.     │
│ @put  x,k  ─── adds the  X  items to before of the  Kth  item.         │
│                                                                        │
│ @del  k    ─── deletes the item  K.                                    │
│ @del  k,m  ─── deletes the   M  items  starting with item  K.          │
└─┐                                                                    ┌─┘
  └────────────────────────────────────────────────────────────────────┘*/
call sy 'initializing the list.'           ; call @init
call sy 'building list: Was it a cat I saw'; call @put 'Was it a cat I saw'
call sy 'displaying list size.'            ; say 'list size='@size()
call sy 'forward list'                     ; call @show
call sy 'backward list'                    ; call @show ,,-1
call sy 'showing 4th item'                 ; call @show 4,1
call sy 'showing 6th & 6th items'          ; call @show 5,2
call sy 'adding item before item 4: black' ; call @put 'black',4
call sy 'showing list'                     ; call @show
call sy 'adding to tail: there, in the ...'; call @put 'there, in the shadows, stalking its prey (and next meal).'
call sy 'showing list'                     ; call @show
call sy 'adding to head: Oy!'              ; call @put  'Oy!',0
call sy 'showing list'                     ; call @show
exit                                   /*stick a fork in it, we're done.*/
/*──────────────────────────────────subroutines─────────────────────────*/
p:       return word(arg(1),1)
sy:      say; say left('',30) "───" arg(1) '───'; return
@hasopt: arg o; return pos(o,opt)\==0
@size:   return $.#
@init:   $.@=''; $.#=0; return 0
@adjust: $.@=space($.@); $.#=words($.@); return 0

@parms:  arg opt
         if @hasopt('k') then k=min($.#+1,max(1,p(k 1)))
         if @hasopt('m') then m=p(m 1)
         if @hasopt('d') then dir=p(dir 1)
         return

@show:   procedure expose $.;   parse arg k,m,dir
         if dir==-1 & k=='' then k=$.#
         m=p(m $.#);
         call @parms 'kmd'
         say @get(k,m,dir);
         return 0

@get:    procedure expose $.;   arg k,m,dir,_
         call @parms 'kmd'
                             do j=k for m by dir while j>0 & j<=$.#
                             _=_ subword($.@,j,1)
                             end   /*j*/
         return strip(_)

@put:    procedure expose $.;   parse arg x,k
         k=p(k $.#+1)
         call @parms 'k'
         $.@=subword($.@,1,max(0,k-1)) x subword($.@,k)
         call @adjust
         return 0

@del:    procedure expose $.;   arg k,m
         call @parms 'km'
         _=subword($.@,k,k-1) subword($.@,k+m)
         $.@=_
         call @adjust
         return


# Project : Doubly-linked list/Traversal

trav = [123, 789, 456]
travfor = sort(trav)
see "Traverse forwards:" + nl
see travfor
see nl
travback = reverse(travfor)
see "Traverse backwards:" + nl
see travback
see nl


class DListNode
  def get_tail
    # parent class (ListNode) includes Enumerable, so the find method is available to us
    self.find {|node| node.succ.nil?}
  end

  def each_previous(&b)
    yield self
    self.prev.each_previous(&b) if self.prev
  end
end

head = DListNode.from_array([:a, :b, :c])
head.each {|node| p node.value}
head.get_tail.each_previous {|node| p node.value}


class item(init_data)
  {
    variable next,
             previous,
             data := init_data;
  };

function prepend(tail, new_data)
  {
    immutable result := item(new_data);
    result.next := tail;
    result.previous := null;
    if (tail != null)
        tail.previous := result;;
    return result;
  };

variable my_list := null;
my_list := prepend(my_list, "R");
my_list := prepend(my_list, "o");
my_list := prepend(my_list, "s");
my_list := prepend(my_list, "e");
my_list := prepend(my_list, "t");
my_list := prepend(my_list, "t");
my_list := prepend(my_list, "a");

"Items in the list going forward:"!
variable follow := my_list;
while (true)
  {
    follow.data!
    if (follow.next == null)
        break;;
  }
step
    follow := follow.next;;

"Items in the list going backward:"!
while (follow != null)
    follow.data!
step
    follow := follow.previous;;


import java.util

object DoublyLinkedListTraversal extends App {

  private val ll = new util.LinkedList[String]

  private def traverse(iter: util.Iterator[String]) =
    while (iter.hasNext) iter.next

  traverse(ll.iterator)
  traverse(ll.descendingIterator)
}


# Modify the List class to add the iterator methods
oo::define List {
    method foreach {varName script} {
        upvar 1 $varName v
        for {set node [self]} {$node ne ""} {set node [$node next]} {
            set v [$node value]
            uplevel 1 $script
        }
    }
    method revforeach {varName script} {
        upvar 1 $varName v
        for {set node [self]} {$node ne ""} {set node [$node previous]} {
            set v [$node value]
            uplevel 1 $script
        }
    }
}

# Demonstrating...
set first [List new a [List new b [List new c [set last [List new d]]]]]
puts "Forward..."
$first foreach char { puts $char }
puts "Backward..."
$last revforeach char { puts $char }


import "/llist" for DLinkedList
import "/fmt" for Fmt

// create a new doubly-linked list and add the first 50 positive integers to it
var dll = DLinkedList.new(1..50)

// traverse the doubly-linked list from head to tail
for (i in dll) {
    Fmt.write("$4d ", i)
    if (i % 10 == 0) System.print()
}
System.print()
// traverse the doubly-linked list from tail to head
for (i in dll.reversed) {
    Fmt.write("$4d ", i)
    if (i % 10 == 1) System.print()
}


class Node{
   fcn init(_value,_prev=Void,_next=Void)
      { var value=_value, prev=_prev, next=_next; }
   fcn toString{ value.toString() }
   fcn append(value){
      b,c := Node(value,self,next),next;
      next=b;
      if(c) c.prev=b;
      b
   }
}


DEFINE PTR="CARD"

TYPE ListNode=[
  BYTE data
  PTR prv,nxt]


type Link;
type Link_Access is access Link;
type Link is record
  Next : Link_Access := null;
  Prev : Link_Access := null;
  Data : Integer;
end record;


# -*- coding: utf-8 -*- #
CO REQUIRES:
  MODE OBJVALUE = ~ # Mode/type of actual obj to be queued #
END CO

MODE OBJLINK = STRUCT(
  REF OBJLINK next,
  REF OBJLINK prev,
  OBJVALUE value # ... etc. required #
);

PROC obj link new = REF OBJLINK: HEAP OBJLINK;

PROC obj link free = (REF OBJLINK free)VOID:
   prev OF free := next OF free := obj queue empty # give the garbage collector a big hint #


    % record type to hold an element of a doubly linked list of integers      %
    record DListIElement ( reference(DListIElement) prev
                         ; integer iValue
                         ; reference(DListIElement) next
                         );
    % additional record types would be required for other element types       %


/* ARM assembly Raspberry PI  */

/* structure Node Doublylinked List*/
    .struct  0
NDlist_next:                    @ next element
    .struct  NDlist_next + 4
NDlist_prev:                    @ previous element
    .struct  NDlist_prev + 4
NDlist_value:                   @ element value or key
    .struct  NDlist_value + 4
NDlist_fin:


Lbl LINK
r₂→{r₁}ʳ
0→{r₁+2}ʳ
0→{r₁+4}ʳ
r₁
Return

Lbl NEXT
{r₁+2}ʳ
Return

Lbl PREV
{r₁+4}ʳ
Return

Lbl VALUE
{r₁}ʳ
Return


struct Node
{
  struct Node *next;
  struct Node *prev;
  void  *data;
};


class Link
{
    public int Item { get; set; }
    public Link Prev { get; set; }
    public Link Next { get; set; }

    //A constructor is not neccessary, but could be useful
    public Link(int item, Link prev = null, Link next = null) {
        Item = item;
        Prev = prev;
        Next = next;
    }
}


template <typename T>
struct Node
{
    Node* next;
    Node* prev;
    T data;
};


(defrecord Node [prev next data])

(defn new-node [prev next data]
  (Node. (ref prev) (ref next) data))


(defstruct dlist head tail)
(defstruct dlink content prev next)


struct Node(T) {
    T data;
    typeof(this)* prev, next;
}

void main() {
    alias N = Node!int;
    N* n = new N(10);
}


struct Node(T) {

type

    pList = ^List ;

    list = record
       data : pointer ;
       prev : pList ;
       next : pList ;
    end;

}


def makeElement(var value, var next, var prev) {
    def element {
        to setValue(v) { value := v }
        to getValue() { return value }

        to setNext(n) { next := n }
        to getNext() { return next }

        to setPrev(p) { prev := p }
        to getPrev() { return prev }
    }

    return element
}


new( Data ) -> erlang:spawn( fun() -> loop( Data, noprevious, nonext ) end ).


type 'a DLElm = {
    mutable prev: 'a DLElm option
    data: 'a
    mutable next: 'a DLElm option
}


type node
   real :: data
   type(node), pointer :: next => null(), previous => null()
end type node
!
! . . . .
!
type( node ), target :: head


type node
    nxt as node ptr
    prv as node ptr
    dat as any ptr   'points to any kind of data; user's responsibility
                     'to keep track of what's actually in it
end type


type dlNode struct {
    string
    next, prev *dlNode
}


data DList a = Leaf | Node (DList a) a (DList a)

updateLeft _ Leaf = Leaf
updateLeft Leaf (Node _ v r) = Node Leaf v r
updateLeft new@(Node nl _ _) (Node _ v r) = current
    where current = Node prev v r
          prev = updateLeft nl new

updateRight _ Leaf = Leaf
updateRight Leaf (Node l v _) = Node l v Leaf
updateRight new@(Node _ _ nr) (Node l v _) = current
    where current = Node l v next
          next = updateRight nr new


class DoubleLink (value, prev_link, next_link)
  initially (value, prev_link, next_link)
    self.value := value
    self.prev_link := prev_link    # links are 'null' if not given
    self.next_link := next_link
end


coclass'DoublyLinkedListElement'
create=:3 :0
  this=:coname''
  'predecessor successor data'=:y
  successor__predecessor=: predecessor__successor=: this
)


public class Node<T> {
   private T element;
   private Node<T> next, prev;

   public Node<T>(){
      next = prev = element = null;
   }

   public Node<T>(Node<T> n, Node<T> p, T elem){
      next = n;
      prev = p;
      element = elem;
   }

   public void setNext(Node<T> n){
      next = n;
   }

   public Node<T> getNext(){
      return next;
   }

   public void setElem(T elem){
      element = elem;
   }

   public T getElem(){
      return element;
   }

   public void setNext(Node<T> n){
      next = n;
   }

   public Node<T> setPrev(Node<T> p){
      prev = p;
   }

   public getPrev(){
      return prev;
   }
}


function DoublyLinkedList(value, next, prev) {
    this._value = value;
    this._next = next;
    this._prev = prev;
}
// from LinkedList, inherit: value(), next(), traverse(), print()
DoublyLinkedList.prototype = new LinkedList();

DoublyLinkedList.prototype.prev = function() {
    if (arguments.length == 1)
        this._prev = arguments[0];
    else
        return this._prev;
}

function createDoublyLinkedListFromArray(ary) {
    var node, prev, head = new DoublyLinkedList(ary[0], null, null);
    prev = head;
    for (var i = 1; i < ary.length; i++) {
        node = new DoublyLinkedList(ary[i], null, prev);
        prev.next(node);
        prev = node;
    }
    return head;
}

var head = createDoublyLinkedListFromArray([10,20,30,40]);


abstract type AbstractNode{T} end

struct EmptyNode{T} <: AbstractNode{T} end
mutable struct Node{T} <: AbstractNode{T}
    value::T
    pred::AbstractNode{T}
    succ::AbstractNode{T}
end


// version 1.1.2

class Node<T: Number>(var data: T, var prev: Node<T>? = null, var next: Node<T>? = null) {
    override fun toString(): String {
        val sb = StringBuilder(this.data.toString())
        var node = this.next
        while (node != null) {
            sb.append(" -> ", node.data.toString())
            node = node.next
        }
        return sb.toString()
    }
}

fun main(args: Array<String>) {
    val n1 = Node(1)
    val n2 = Node(2, n1)
    n1.next = n2
    val n3 = Node(3, n2)
    n2.next = n3
    println(n1)
    println(n2)
    println(n3)
}


local node = { data=data, prev=nil, next=nil }


TYPE
  Link = POINTER TO LinkRcd;
  LinkRcd = RECORD
    Prev, Next: Link;
    Data: INTEGER
  END;


type
  Node[T] = ref TNode[T]

  TNode[T] = object
    next, prev: Node[T]
    data: T


MODULE Box;
TYPE
        Object* = POINTER TO ObjectDesc;
	ObjectDesc* = (* ABSTRACT *) RECORD
	END;

        (* ... *)
END Box.

MODULE Collections;
TYPE
	Node* = POINTER TO NodeDesc;
	NodeDesc* = (* ABSTRACT *) RECORD
		prev-,next-: Node;
                value-: Box.Object;
	END;

        (* ... *)
END Collections.


class ListNode {
  @value : Base;
  @next : ListNode;
  @previous: ListNode;

  New(value : Base) {
    @value := value;
  }

  method : public : Set(value : Base) ~ Nil {
    @value := value;
  }

  method : public : Get() ~ Base {
    return @value;
  }

  method : public : SetNext(next :  Collection.ListNode) ~ Nil {
    @next := next;
  }

  method : public : GetNext() ~ ListNode {
    return @next;
  }

  method : public : SetPrevious(previous :  Collection.ListNode) ~ Nil {
    @previous := previous;
  }

  method : public : GetPrevious() ~ ListNode {
    return @previous;
  }
}


type 'a dlink = {
  mutable data: 'a;
  mutable next: 'a dlink option;
  mutable prev: 'a dlink option;
}

let dlink_of_list li =
  let f prev_dlink x =
    let dlink = {
      data = x;
      prev = None;
      next = prev_dlink }
    in
    begin match prev_dlink with
    | None -> ()
    | Some prev_dlink ->
        prev_dlink.prev <- Some dlink
    end;
    Some dlink
  in
  List.fold_left f None (List.rev li)
;;

let list_of_dlink =
  let rec aux acc = function
  | None -> List.rev acc
  | Some{ data = d;
          prev = _;
          next = next } -> aux (d::acc) next
  in
  aux []
;;

let iter_forward_dlink f =
  let rec aux = function
  | None -> ()
  | Some{ data = d;
          prev = _;
          next = next } -> f d; aux next
  in
  aux
;;


Object Class new: DNode(value, mutable prev, mutable next)


fun {CreateNewNode Value}
   node(prev:{NewCell _}
	next:{NewCell _}
	value:Value)
end


type link_ptr = ^link;
     data_ptr = ^data; (* presumes that type 'data' is defined above *)
     link = record
              prev: link_ptr;
              next: link_ptr;
              data: data_ptr;
            end;


my %node = (
     data => 'say what',
     next => \%foo_node,
     prev => \%bar_node,
);
$node{next} = \%quux_node;  # mutable


enum NEXT,PREV,DATA
type slnode(object x)
    return (sequence(x) and length(x)=DATA and <i>udt</i>(x[DATA]) and integer(x[NEXT] and integer(x[PREV]))
end type


define structure
   1 Node,
      2 value        fixed decimal,
      2 back_pointer handle(Node),
      2 fwd_pointer  handle(Node);

P = NEW(: Node :); /* Creates a node, and lets P point at it.       */
get (P => value);  /* Reads in a value to the node we just created. */

/* Assuming that back_pointer and fwd_pointer point at other nodes, */
/* we can say ...                                                   */
P = P => fwd_pointer; /* P now points at the next node.             */
...
P = P => back_pointer; /* P now points at the previous node.        */


uses objectclass;
define :class Link;
    slot next = [];
    slot prev = [];
    slot data = [];
enddefine;


Structure node
  *prev.node
  *next.node
  value.i
EndStructure


class Node(object):
     def __init__(self, data = None, prev = None, next = None):
         self.prev = prev
         self.next = next
         self.data = data
     def __str__(self):
         return str(self.data)
     def __repr__(self):
         return repr(self.data)
     def iter_forward(self):
         c = self
         while c != None:
             yield c
             c = c.next
     def iter_backward(self):
         c = self
         while c != None:
             yield c
             c = c.prev


(define-struct dlist (head tail) #:mutable)
(define-struct dlink (content prev next) #:mutable)


role DLElem[::T] {
    has DLElem[T] $.prev is rw;
    has DLElem[T] $.next is rw;
    has T $.payload = T;

    method pre-insert(T $payload) {
        die "Can't insert before beginning" unless $!prev;
        my $elem = ::?CLASS.new(:$payload);
        $!prev.next = $elem;
        $elem.prev = $!prev;
        $elem.next = self;
        $!prev = $elem;
        $elem;
    }

    method post-insert(T $payload) {
        die "Can't insert after end" unless $!next;
        my $elem = ::?CLASS.new(:$payload);
        $!next.prev = $elem;
        $elem.next = $!next;
        $elem.prev = self;
        $!next = $elem;
        $elem;
    }

    method delete {
        die "Can't delete a sentinel" unless $!prev and $!next;
        $!next.prev = $!prev;
        $!prev.next = $!next;   # conveniently returns next element
    }
}


       ╔═════════════════════════════════════════════════════════════════════════╗
       ║        ☼☼☼☼☼☼☼☼☼☼☼ Functions of the  List Manager ☼☼☼☼☼☼☼☼☼☼☼           ║
       ║   @init      ─── initializes the List.                                  ║
       ║                                                                         ║
       ║   @size      ─── returns the size of the List  [could be a  0  (zero)]. ║
       ║                                                                         ║
       ║   @show      ─── shows (displays) the complete List.                    ║
       ║   @show k,1  ─── shows (displays) the  Kth  item.                       ║
       ║   @show k,m  ─── shows (displays)  M  items,  starting with  Kth  item. ║
       ║   @show ,,─1 ─── shows (displays) the complete List backwards.          ║
       ║                                                                         ║
       ║   @get  k    ─── returns the  Kth  item.                                ║
       ║   @get  k,m  ─── returns the  M  items  starting with the  Kth  item.   ║
       ║                                                                         ║
       ║   @put  x    ─── adds the  X  items to the  end  (tail) of the List.    ║
       ║   @put  x,0  ─── adds the  X  items to the start (head) of the List.    ║
       ║   @put  x,k  ─── adds the  X  items to before of the  Kth  item.        ║
       ║                                                                         ║
       ║   @del  k    ─── deletes the item  K.                                   ║
       ║   @del  k,m  ─── deletes the   M  items  starting with item  K.         ║
       ╚═════════════════════════════════════════════════════════════════════════╝


class DListNode < ListNode
  attr_accessor :prev
  # accessors :succ and :value are inherited

  def initialize(value, prev=nil, succ=nil)
    @value = value
    @prev = prev
    @prev.succ = self if prev
    @succ = succ
    @succ.prev = self if succ
  end

  def self.from_values(*ary)
    ary << (f = ary.pop)
    ary.map! {|i| new i }
    ary.inject(f) {|p, c| p.succ = c; c.prev = p; c }
  end
end

list = DListNode.from_values 1,2,3,4


use std::collections::LinkedList;
fn main() {
     // Doubly linked list containing 32-bit integers
     let list = LinkedList::<i32>::new();
}


var node = Hash.new(
     data => 'say what',
     next => foo_node,
     prev => bar_node,
);

node{:next} = quux_node;  # mutable


typealias NodePtr<T> = UnsafeMutablePointer<Node<T>>

class Node<T> {
  var value: T
  fileprivate var prev: NodePtr<T>?
  fileprivate var next: NodePtr<T>?

  init(value: T, prev: NodePtr<T>? = nil, next: NodePtr<T>? = nil) {
    self.value = value
    self.prev = prev
    self.next = next
  }
}


oo::class create List {
    variable content next prev
    constructor {value {list ""}} {
        set content $value
        set next $list
        set prev ""
        if {$next ne ""} {
            $next previous [self]
        }
    }
    method value args {
        set content {*}$args
    }
    method next args {
        set next {*}$args
    }
    method previous args {
        set prev {*}$args
    }
}


Public Class Node(Of T)
   Public Value As T
   Public [Next] As Node(Of T)
   Public Previous As Node(Of T)
End Class


import "/llist" for DNode

var dn1 = DNode.new(1)
var dn2 = DNode.new(2)
dn1.next = dn2
dn1.prev = null
dn2.prev = dn1
dn2.next = null
System.print(["node 1", "data = %(dn1.data)", "prev = %(dn1.prev)", "next = %(dn1.next)"])
System.print(["node 2", "data = %(dn2.data)", "prev = %(dn2.prev)", "next = %(dn2.next)"])


class Node{
   fcn init(_value,_prev=Void,_next=Void)
      { var value=_value, prev=_prev, next=_next; }
   fcn toString{ value.toString() }
}


V shades = [‘.’, ‘:’, ‘!’, ‘*’, ‘o’, ‘e’, ‘&’, ‘#’, ‘%’, ‘@’]

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

F draw_sphere(r, k, ambient, light)
   L(i) Int(floor(-r)) .< Int(ceil(r) + 1)
      V x = i + 0.5
      V line = ‘’

      L(j) Int(floor(-2 * r)) .< Int(ceil(2 * r) + 1)
         V y = j / 2 + 0.5
         I x * x + y * y <= r * r
            V vec = normalize((x, y, sqrt(r * r - x * x - y * y)))
            V b = dotp(light, vec) ^ k + ambient
            V intensity = Int((1 - b) * (:shades.len - 1))
            line ‘’= I intensity C 0 .< :shades.len {:shades[intensity]} E :shades[0]
         E
            line ‘’= ‘ ’

      print(line)

V light = normalize((30.0, 30.0, -50.0))
draw_sphere(20, 4, 0.1, light)
draw_sphere(10, 2, 0.4, light)


with Glib;                use Glib;
with Cairo;               use Cairo;
with Cairo.Png;           use Cairo.Png;
with Cairo.Pattern;       use Cairo.Pattern;
with Cairo.Image_Surface; use Cairo.Image_Surface;
with Ada.Numerics;

procedure Sphere is
   subtype Dub is Glib.Gdouble;

   Surface    : Cairo_Surface;
   Cr         : Cairo_Context;
   Pat        : Cairo_Pattern;
   Status_Out : Cairo_Status;
   M_Pi       : constant Dub := Dub (Ada.Numerics.Pi);

begin
   Surface := Create (Cairo_Format_ARGB32, 512, 512);
   Cr      := Create (Surface);
   Pat     :=
      Cairo.Pattern.Create_Radial (230.4, 204.8, 51.1, 204.8, 204.8, 256.0);
   Cairo.Pattern.Add_Color_Stop_Rgba (Pat, 0.0, 1.0, 1.0, 1.0, 1.0);
   Cairo.Pattern.Add_Color_Stop_Rgba (Pat, 1.0, 0.0, 0.0, 0.0, 1.0);
   Cairo.Set_Source (Cr, Pat);
   Cairo.Arc (Cr, 256.0, 256.0, 153.6, 0.0, 2.0 * M_Pi);
   Cairo.Fill (Cr);
   Cairo.Pattern.Destroy (Pat);
   Status_Out := Write_To_Png (Surface, "SphereAda.png");
   pragma Assert (Status_Out = Cairo_Status_Success);
end Sphere;


F cline(n, x, y, cde)
   print(String(cde[0]).rjust(n + 1)‘’
               (cde[1] * (9 * x - 1))‘’
               cde[0]‘’
               (I cde.len > 2 {String(cde[2]).rjust(y + 1)} E ‘’))

F cuboid(x, y, z)
   cline(y + 1, x, 0, ‘+-’)
   L(i) 1 .. y
      cline(y - i + 1, x, i - 1, ‘/ |’)
   cline(0, x, y, ‘+-|’)
   L 0 .. 4 * z - y - 3
      cline(0, x, y, ‘| |’)
   cline(0, x, y, ‘| +’)
   L(i) (y - 1 .. 0).step(-1)
      cline(0, x, i, ‘| /’)
   cline(0, x, 0, "+-\n")

cuboid(2, 3, 4)
cuboid(1, 1, 1)
cuboid(6, 2, 1)


begin
    % draw a sphere                                                                         %
    % returns the next integer larger than x or x if x is an integer                        %
    integer procedure ceil( real value x ) ;
    begin
        integer tmp;
        tmp := truncate( x );
        if tmp not = x then tmp + 1 else tmp
    end ciel ;
    % returns the absolute value of the dot product of x and y or 0 if it is not negative   %
    real procedure dot( real array x, y ( * ) ) ;
    begin
        real tmp;
        tmp := x( 1 ) * y( 1 ) + x( 2 ) * y( 2 ) + x( 3 ) * y( 3 );
        if tmp < 0 then - tmp else 0
    end dot ;
    % normalises the vector v                                                               %
    procedure normalize( real array v ( * ) ) ;
    begin
        real tmp;
        tmp := sqrt( v( 1 ) * v( 1 ) + v( 2 ) * v( 2 ) + v( 3 ) * v( 3 ) );
        for i := 1 until 3 do v( i ) := v( i ) / tmp
    end normalize ;
    % draws a sphere using ASCII art                                                        %
    procedure drawSphere( real       value radius
                        ; integer    value k
                        ; real       value ambient
                        ; real       array light    ( * )
                        ; string(10) value shades
                        ) ;
    begin
        real array  vec ( 1 :: 3 );
        integer     intensity, maxShades;
        real        diameter, r2;
        maxShades   := 9;
        diameter    :=      2 * radius;
        r2          := radius * radius;
        for i := entier( - radius ) until ceil( radius ) do begin
            real         x, x2;
            integer      linePos;
            string(256)  line;
            linePos := 0;
            x       := i + 0.5;
            x2      := x * x;
            line    := "";
            for j := entier( - diameter ) until ceil( diameter ) do begin
                real y, y2;
                y  := j / 2 + 0.5;
                y2 := y * y;
                if x2 + y2 <= r2 then begin
                    real     b, dp;
                    vec( 1 )  := x;
                    vec( 2 )  := y;
                    vec( 3 )  := sqrt( r2 - x2 - y2 );
                    normalize( vec );
                    dp        := dot( light, vec );
                    b         := dp;
                    for p := 2 until k do b := b * dp;
                    b         := b + ambient;
                    intensity := round( ( 1 - b ) * maxShades );
                    if intensity < 0         then intensity := 0;
                    if intensity > maxShades then intensity := maxShades;
                    line( linePos // 1 ) := shades( intensity // 1 );
                    end
                else line( linePos // 1 ) := " "
                ;
                if linePos < 255 then linePos := linePos + 1
            end for_j ;
            write( s_w := 0, line( 0 // 1 ) );
            for c := 1 until if linePos > 255 then 255 else linePos - 1 do writeon( s_w := 0, line( c // 1 ) )
        end for_i
    end drawSphere ;
    % test drawSphere                                                                       %
    begin
        real array light ( 1 :: 3 );
        integer     maxShades;
        light( 1 )  :=  30;
        light( 2 )  :=  30;
        light( 3 )  := -59;
        normalize( light );
        drawSphere( 20, 4, 0.1, light, ".:!*oe#%&@" );
        drawSphere( 10, 2, 0.4, light, ".:!*oe#%&@" )
    end test
end.


PROC DrawCuboid(CARD x,y BYTE w,h,d)
  BYTE wsize=[10],hsize=[10],dsize=[5]
  BYTE i

  FOR i=0 TO w
  DO
    Plot(x+i*wsize,y+h*hsize)
    DrawTo(x+i*wsize,y)
    DrawTo(x+i*wsize+d*dsize,y-d*dsize)
  OD
  FOR i=0 TO h
  DO
    Plot(x,y+i*hsize)
    DrawTo(x+w*wsize,y+i*hsize)
    DrawTo(x+w*wsize+d*dsize,y+i*hsize-d*dsize)
  OD
  FOR i=1 TO d
  DO
    Plot(x+i*dsize,y-i*dsize)
    DrawTo(x+w*wsize+i*dsize,y-i*dsize)
    DrawTo(x+w*wsize+i*dsize,y+h*hsize-i*dsize)
  OD
RETURN

PROC Main()
  BYTE CH=$02FC,COLOR1=$02C5,COLOR2=$02C6

  Graphics(8+16)
  COLOR1=$0C
  COLOR2=$02
  Color=1

  DrawCuboid(60,45,2,3,4)
  DrawCuboid(130,40,2,4,3)
  DrawCuboid(205,50,3,2,4)
  DrawCuboid(55,120,3,4,2)
  DrawCuboid(120,130,4,2,3)
  DrawCuboid(200,125,4,3,2)

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN


with Ada.Text_IO;

procedure Main is
   type Char_Matrix is
     array (Positive range <>, Positive range <>) of Character;

   function Create_Cuboid
     (Width, Height, Depth : Positive)
      return                 Char_Matrix
   is
      Result : Char_Matrix (1 .. Height + Depth + 3,
         1 .. 2 * Width + Depth + 3) := (others => (others => ' '));
   begin
      -- points
      Result (1, 1)                                      := '+';
      Result (Height + 2, 1)                             := '+';
      Result (1, 2 * Width + 2)                          := '+';
      Result (Height + 2, 2 * Width + 2)                 := '+';
      Result (Height + Depth + 3, Depth + 2)             := '+';
      Result (Depth + 2, 2 * Width + Depth + 3)          := '+';
      Result (Height + Depth + 3, 2 * Width + Depth + 3) := '+';
      -- width lines
      for I in 1 .. 2 * Width loop
         Result (1, I + 1)                          := '-';
         Result (Height + 2, I + 1)                 := '-';
         Result (Height + Depth + 3, Depth + I + 2) := '-';
      end loop;
      -- height lines
      for I in 1 .. Height loop
         Result (I + 1, 1)                             := '|';
         Result (I + 1, 2 * Width + 2)                 := '|';
         Result (Depth + I + 2, 2 * Width + Depth + 3) := '|';
      end loop;
      -- depth lines
      for I in 1 .. Depth loop
         Result (Height + 2 + I, 1 + I)             := '/';
         Result (1 + I, 2 * Width + 2 + I)          := '/';
         Result (Height + 2 + I, 2 * Width + 2 + I) := '/';
      end loop;
      return Result;
   end Create_Cuboid;

   procedure Print_Cuboid (Width, Height, Depth : Positive) is
      Cuboid : Char_Matrix := Create_Cuboid (Width, Height, Depth);
   begin
      for Row in reverse Cuboid'Range (1) loop
         for Col in Cuboid'Range (2) loop
            Ada.Text_IO.Put (Cuboid (Row, Col));
         end loop;
         Ada.Text_IO.New_Line;
      end loop;
   end Print_Cuboid;
begin
   Print_Cuboid (2, 3, 4);
end Main;


(*
** Solution to Draw_a_sphere.dats
*)

(* ****** ****** *)
//
#include
"share/atspre_define.hats" // defines some names
#include
"share/atspre_staload.hats" // for targeting C
#include
"share/HATS/atspre_staload_libats_ML.hats" // for ...
#include
"share/HATS/atslib_staload_libats_libc.hats" // for libc
//
(* ****** ****** *)

extern
fun
Draw_a_sphere
(
  R: double, k: double, ambient: double
) : void // end of [Draw_a_sphere]

(* ****** ****** *)

implement
Draw_a_sphere
(
  R: double, k: double, ambient: double
) = let
    fun normalize(v0: double, v1: double, v2: double): (double, double, double) = let
        val len = sqrt(v0*v0+v1*v1+v2*v2)
    in
        (v0/len, v1/len, v2/len)
    end // end of [normalize]

    fun dot(v0: double, v1: double, v2: double, x0: double, x1: double, x2: double): double = let
        val d = v0*x0+v1*x1+v2*x2
        val sgn = gcompare_val_val<double> (d, 0.0)
    in
        if sgn < 0 then ~d else 0.0
    end // end of [dot]

    fun print_char(i: int): void =
        if i = 0 then print!(".") else
        if i = 1 then print!(":") else
        if i = 2 then print!("!") else
        if i = 3 then print!("*") else
        if i = 4 then print!("o") else
        if i = 5 then print!("e") else
        if i = 6 then print!("&") else
        if i = 7 then print!("#") else
        if i = 8 then print!("%") else
        if i = 9 then print!("@") else print!(" ")

    val i_start = floor(~R)
    val i_end = ceil(R)
    val j_start = floor(~2 * R)
    val j_end = ceil(2 * R)
    val (l0, l1, l2) = normalize(30.0, 30.0, ~50.0)

    fun loopj(j: int, j_end: int, x: double): void = let
        val y = j / 2.0 + 0.5;
        val sgn = gcompare_val_val<double> (x*x + y*y, R*R)
        val (v0, v1, v2) = normalize(x, y, sqrt(R*R - x*x - y*y))
        val b = pow(dot(l0, l1, l2, v0, v1, v2), k) + ambient
        val intensity = 9.0 - 9.0*b
        val sgn2 = gcompare_val_val<double> (intensity, 0.0)
        val sgn3 = gcompare_val_val<double> (intensity, 9.0)
    in
    (   if sgn > 0 then print_char(10) else
        if sgn2 < 0 then print_char(0) else
        if sgn3 >= 0 then print_char(8) else
        print_char(g0float2int(intensity));
        if j < j_end then loopj(j+1, j_end, x)
    )
    end // end of [loopj]

    fun loopi(i: int, i_end: int, j: int, j_end: int): void = let
        val x = i + 0.5
        val () = loopj(j, j_end, x)
        val () = println!()
    in
        if i < i_end then loopi(i+1, i_end, j, j_end)
    end // end of [loopi]

in
    loopi(g0float2int(i_start), g0float2int(i_end), g0float2int(j_start), g0float2int(j_end))
end

(* ****** ****** *)

implement
main0() = () where
{
  val () = DrawSphere(20.0, 4.0, .1)
  val () = DrawSphere(10.0, 2.0, .4)
} (* end of [main0] *)

(* ****** ****** *)


#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 := -30 ; 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)

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


cline: function [n,a,b,cde][
    print (pad to :string first cde n+1) ++
          (repeat to :string cde\1 dec 9*a)++
          (to :string cde\0)++
          (2 < size cde)? -> pad to :string cde\2 b+1 -> ""
]

cuboid: function [x,y,z][
    cline y+1 x 0 "+-"
    loop 1..y 'i -> cline 1+y-i x i-1 "/ |"
    cline 0 x y "+-|"
    loop 0..((4*z)-y)-3 'i -> cline 0 x y "| |"
    cline 0 x y "| +"
    loop (y-1)..0 'i -> cline 0 x i "| /"
    cline 0 x 0 "+-\n"
]

cuboid 2 3 4
cuboid 1 1 1
cuboid 6 2 1


Angle := 45
C := 0.01745329252
W := 200
H := 300
L := 400
LX := L * Cos(Angle * C), LY := L * Sin(Angle * C)

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

A := 50, B := 650, WinWidth := 700, WinHeight := 700
TopX := (A_ScreenWidth - WinWidth) //2, TopY := (A_ScreenHeight - WinHeight) //2

Gui, 1: -Caption +E0x80000 +LastFound +AlwaysOnTop +ToolWindow +OwnDialogs
Gui, 1: Show, NA
hwnd1 := WinExist(), hbm := CreateDIBSection(WinWidth, WinHeight), hdc := CreateCompatibleDC()
	, obm := SelectObject(hdc, hbm), G := Gdip_GraphicsFromHDC(hdc), Gdip_SetSmoothingMode(G, 4)

Points := A "," B "|" A+W "," B "|" A+W "," B-H "|" A "," B-H
	, DrawFace(Points, 0xff0066ff, G)

Points := A+W "," B "|" A+W+LX "," B-LY "|" A+W+LX "," B-LY-H "|" A+W "," B-H
	, DrawFace(Points, 0xff00d400, G)

Points := A "," B-H "|" A+W "," B-H "|" A+W+LX "," B-LY-H "|" A+LX "," B-LY-H
	, DrawFace(Points, 0xffd40055, G)

UpdateLayeredWindow(hwnd1, hdc, TopX, TopY, WinWidth, WinHeight)

SelectObject(hdc, obm), DeleteObject(hbm), DeleteDC(hdc)
	, Gdip_DeleteGraphics(G)
return

DrawFace(Points, Color, G) {
	pBrush := Gdip_BrushCreateSolid(Color)
		, Gdip_FillPolygon(G, pBrush, Points, 1)
		, Gdip_DeleteBrush(pBrush)
	return
}

Esc::
Exit:
Gdip_Shutdown(pToken)
ExitApp


# syntax: GAWK -f DRAW_A_SPHERE.AWK
# converted from VBSCRIPT
BEGIN {
    draw_sphere(20,4,0.1)
    draw_sphere(10,2,0.4)
    exit(0)
}
function draw_sphere(radius,k,ambient, b,i,intensity,j,leng_shades,light,line,shades,vec,x,y) {
    leng_shades = split0(".:!*oe&#%@",shades,"")
    split("30,30,-50",light,",")
    normalize(light)
    for (i=int(-radius); i<=ceil(radius); i++) {
      x = i + 0.5
      line = ""
      for (j=int(-2*radius); j<=ceil(2*radius); j++) {
        y = j / 2 + 0.5
        if (x*x + y*y <= radius*radius) {
          vec[1] = x
          vec[2] = y
          vec[3] = sqrt(radius*radius - x*x - y*y)
          normalize(vec)
          b = dot(light,vec) ^ k + ambient
          intensity = int((1-b) * leng_shades)
          if (intensity < 0) {
            intensity = 0
          }
          if (intensity >= leng_shades) {
            intensity = leng_shades
          }
          line = line shades[intensity]
        }
        else {
          line = line " "
        }
      }
      printf("%s\n",line)
    }
}
function ceil(x,  tmp) {
    tmp = int(x)
    return (tmp != x) ? tmp+1 : tmp
}
function dot(x,y,  tmp) {
    tmp = x[1]*y[1] + x[2]*y[2] + x[3]*y[3]
    return (tmp < 0) ? -tmp : 0
}
function normalize(v,  tmp) {
    tmp = sqrt(v[1]*v[1] + v[2]*v[2] + v[3]*v[3])
    v[1] /= tmp
    v[2] /= tmp
    v[3] /= tmp
}
function split0(str,array,fs,  arr,i,n) { # same as split except indices start at zero
    n = split(str,arr,fs)
    for (i=1; i<=n; i++) {
      array[i-1] = arr[i]
    }
    return(n)
}


# syntax: GAWK -f DRAW_A_CUBOID.AWK [-v x=?] [-v y=?] [-v z=?]
# example: GAWK -f DRAW_A_CUBOID.AWK -v x=12 -v y=4 -v z=6
# converted from VBSCRIPT
BEGIN {
    init_sides()
    draw_cuboid(2,3,4)
    draw_cuboid(1,1,1)
    draw_cuboid(6,2,1)
    exit (errors == 0) ? 0 : 1
}
function draw_cuboid(nx,ny,nz,  esf,i,i_max,j,j_max,lx,ly,lz) {
    esf = errors # errors so far
    if (nx !~ /^[0-9]+$/ || nx <= 0) { error(nx,ny,nz,1) }
    if (ny !~ /^[0-9]+$/ || ny <= 0) { error(nx,ny,nz,2) }
    if (nz !~ /^[0-9]+$/ || nz <= 0) { error(nx,ny,nz,3) }
    if (errors > esf) { return }
    lx = x * nx
    ly = y * ny
    lz = z * nz
# define the array size
    i_max = ly + lz
    j_max = lx + ly
    delete arr
    printf("%s %s %s (%d rows x %d columns)\n",nx,ny,nz,i_max+1,j_max+1)
# draw lines
    for (i=0; i<=nz-1; i++) { draw_line(lx,0,z*i,"-") }
    for (i=0; i<=ny; i++)   { draw_line(lx,y*i,lz+y*i,"-") }
    for (i=0; i<=nx-1; i++) { draw_line(lz,x*i,0,"|") }
    for (i=0; i<=ny; i++)   { draw_line(lz,lx+y*i,y*i,"|") }
    for (i=0; i<=nz-1; i++) { draw_line(ly,lx,z*i,"/") }
    for (i=0; i<=nx; i++)   { draw_line(ly,x*i,lz,"/") }
# output the cuboid
    for (i=i_max; i>=0; i--) {
      for (j=0; j<=j_max; j++) {
        printf("%1s",arr[i,j])
      }
      printf("\n")
    }
}
function draw_line(n,x,y,c,  dx,dy,i,xi,yi) {
    if      (c == "-") { dx = 1 ; dy = 0 }
    else if (c == "|") { dx = 0 ; dy = 1 }
    else if (c == "/") { dx = 1 ; dy = 1 }
    for (i=0; i<=n; i++) {
      xi = x + i * dx
      yi = y + i * dy
      arr[yi,xi] = (arr[yi,xi] ~ /^ ?$/) ? c : "+"
    }
}
function error(x,y,z,arg) {
    printf("error: '%s,%s,%s' argument %d is invalid\n",x,y,z,arg)
    errors++
}
function init_sides() {
# to change the defaults on the command line use: -v x=? -v y=? -v z=?
    if (x+0 < 2) { x = 6 } # top
    if (y+0 < 2) { y = 2 } # right
    if (z+0 < 2) { z = 3 } # front
}


clg
color white
rect 0,0,graphwidth, graphheight
for n = 1 to 100
	color rgb(2*n,2*n,2*n)
	circle 150-2*n/3,150-n/2,150-n
next n


:: Draw a Sphere Task from Rosetta Code
:: Batch File Implementation

@echo off
rem -------------- define arithmetic "functions"
rem more info: https://www.dostips.com/forum/viewtopic.php?f=3&t=6744

rem integer sqrt arithmetic function by Aacini and penpen
rem source: https://www.dostips.com/forum/viewtopic.php?f=3&t=5819&start=30#p44016
set "sqrt(N)=( M=(N),j=M/(11*1024)+40, j=(M/j+j)>>1, j=(M/j+j)>>1, j=(M/j+j)>>1, j=(M/j+j)>>1, j=(M/j+j)>>1, j+=(M-j*j)>>31 )"

rem -------------- define batch file macros with parameters appended
rem more info: https://www.dostips.com/forum/viewtopic.php?f=3&t=2518
setlocal disabledelayedexpansion	% == required for macro ==%
(set \n=^^^
%== this creates escaped line feed for macro ==%
)

rem normalize macro
rem argument: v
set normalize=for %%# in (1 2) do if %%#==2 (  %\n%
   for /f "tokens=1" %%a in ("!args!") do set "v=%%a"  %\n%
   set /a "length_sqrd=!v![0]*!v![0]+!v![1]*!v![1]+!v![2]*!v![2]"  %\n%
   set /a "length=%sqrt(N):N=!length_sqrd!%"  %== sqrt(N) applied ==%  %\n%
   set /a "!v![0]*=100", "!v![1]*=100", "!v![2]*=100"  %== normalized elements mult. by 100 ==%  %\n%
   set /a "!v![0]/=length", "!v![1]/=length", "!v![2]/=length"  %\n%
) else set args=

rem dot macro
rem arguments: s t outputvar
set dot=for %%# in (1 2) do if %%#==2 (  %\n%
   for /f "tokens=1,2,3" %%a in ("!args!") do (  %\n%
      set "s=%%a"  %\n%
      set "t=%%b"  %\n%
      set "outputvar=%%c"  %\n%
   )  %\n%
   set /a "d=!s![0]*!t![0]+!s![1]*!t![1]+!s![2]*!t![2]"  %\n%
   if !d! lss 0 (set /a "!outputvar!=-d") else (set "!outputvar!=0")  %\n%
) else set args=

rem -------------- define pseudo-arrays
set "shades[0]=."
set "shades[1]=:"
set "shades[2]=!"
set "shades[3]=*"
set "shades[4]=o"
set "shades[5]=e"
set "shades[6]=&"
set "shades[7]=#"
set "shades[8]=%%"
set "shades[9]=@"
set "num_shades=9"  %== start at 0 ==%

set "light[0]=30" & set "light[1]=30" & set "light[2]=-50"

rem -------------- main thing: execute drawSphere
setlocal enabledelayedexpansion
%normalize% light  %== normalize macro applied ==%
call :drawSphere 20 1
exit /b 0

rem -------------- the function to draw the sphere
rem arguments: R ambient
:drawSphere
rem initialize variables from arguments
set /a "R=%1", "negR=-R", "twiceR=R*2", "twiceNegR=negR*2"
set /a "sqrdR=R*R*100*100"  %== R*R is mult. by 100*100 ==%
set "k=2"  %== k is hardcoded to 2 ==%
set "ambient=%3"
rem start draw line-by-line
for /l %%i in (%negR%, 1, %R%) do (
   set /a "x=100*%%i+(100/2)"  %== x is mult. by 100 ==%
   set "line="
   for /l %%j in (%twiceNegR%, 1, %twiceR%) do (
      set /a "y=(100/2)*%%j+(100/2)"  %== y is mult. by 100 ==%
      set /a "pythag = x*x + y*y"
      if !pythag! lss !sqrdR! (
         set /a "vec[0]=x"
         set /a "vec[1]=y"
         set /a "vec[2]=sqrdR-pythag"
         set /a "vec[2]=%sqrt(N):N=!vec[2]!%"  %== sqrt(N) applied ==%
         %normalize% vec  %== normalize macro applied ==%
         %dot% light vec dot_out  %== dot macro applied ==%
         rem since both light and vec are normalized to 100,
         rem then dot_out is scaled up by 100*100 now.
         set /a "dot_out/=100"  %== scale-down to 100*[actual] to prevent overflow before exponentiation ==%
         set "scaleup=1"  %== after exponentiation, b would be scaleup*[actual] ==%
         set "b=1"
         for /l %%? in (1,1,%k%) do set /a "b*=dot_out","scaleup*=100" %== exponentiation ==%
         set /a "b+=ambient*scaleup/10"  %== add ambient/10 to b ==%
         set /a "b/=scaleup/100"  %== scale-down to 100*[actual] ==%
         set /a "intensity=(100-b)*num_shades"
         set /a "intensity/=100"  %== final scale-down ==%
         if !intensity! lss 0 set "intensity=0"
         if !intensity! gtr %num_shades% set "intensity=%num_shades%"
         for %%c in (!intensity!) do set "line=!line!!shades[%%c]!"
      ) else (
         set "line=!line! "
      )
   )
   echo(!line!
)
goto :EOF


      ORIGIN 100, 100
      PROCcuboid(200, 300, 400)
      END

      DEF PROCcuboid(x, y, z)
      MOVE 0, 0 : MOVE 0, y
      GCOL 1 : PLOT 117, x, y
      GCOL 2 : PLOT 117, x + z * 0.4, y + z * 0.4
      GCOL 4 : PLOT 117, x + z * 0.4, z * 0.4
      ENDPROC


opendb balls.g y            # Create a database to hold our shapes
units cm                     # Set the unit of measure
in ball.s sph 0 0 0 3  # Create a sphere of radius 3 cm named ball.s with its centre at 0,0,0


opendb cuboid.g y            # Create a database to hold our shapes
units cm                     # Set the unit of measure
in cuboid.s rpp 0 2 0 3 0 4  # Create a 2 x 3 x 4 cuboid named cuboid.s


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <math.h>

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

double light[3] = { 30, 30, -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;
}

void draw_sphere(double R, double k, double ambient)
{
        int i, j, intensity;
        double b;
        double vec[3], x, y;
        for (i = floor(-R); i <= ceil(R); i++) {
                x = i + .5;
                for (j = floor(-2 * R); j <= ceil(2 * R); j++) {
                        y = j / 2. + .5;
                        if (x * x + y * y <= R * R) {
                                vec[0] = x;
                                vec[1] = y;
                                vec[2] = sqrt(R * R - x * x - y * y);
                                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]);
                        } else
                                putchar(' ');
                }
                putchar('\n');
        }
}

int main()
{
        normalize(light);
        draw_sphere(20, 4, .1);
        draw_sphere(10, 2, .4);

        return 0;
}


using System;
using System.Drawing;
using System.Drawing.Drawing2D;
using System.Windows.Forms;

namespace Cuboid
{
    public partial class Form1 : Form
    {
        double[][] nodes = {
            new double[] {-1, -1, -1}, new double[] {-1, -1, 1}, new double[] {-1, 1, -1},
            new double[] {-1, 1, 1}, new double[] {1, -1, -1}, new double[] {1, -1, 1},
            new double[] {1, 1, -1}, new double[] {1, 1, 1} };

        int[][] edges = {
            new int[] {0, 1}, new int[] {1, 3}, new int[] {3, 2}, new int[] {2, 0}, new int[] {4, 5},
            new int[] {5, 7}, new int[] {7, 6}, new int[] {6, 4}, new int[] {0, 4}, new int[] {1, 5},
            new int[] {2, 6}, new int[] {3, 7}};

        private int mouseX;
        private int prevMouseX;
        private int prevMouseY;
        private int mouseY;

        public Form1()
        {
            Width = Height = 640;
            StartPosition = FormStartPosition.CenterScreen;
            SetStyle(
                ControlStyles.AllPaintingInWmPaint |
                ControlStyles.UserPaint |
                ControlStyles.DoubleBuffer,
                true);

            MouseMove += (s, e) =>
            {
                prevMouseX = mouseX;
                prevMouseY = mouseY;
                mouseX = e.X;
                mouseY = e.Y;

                double incrX = (mouseX - prevMouseX) * 0.01;
                double incrY = (mouseY - prevMouseY) * 0.01;

                RotateCuboid(incrX, incrY);
                Refresh();
            };

            MouseDown += (s, e) =>
            {
                mouseX = e.X;
                mouseY = e.Y;
            };

            Scale(80, 120, 160);
            RotateCuboid(Math.PI / 5, Math.PI / 9);
        }

        private void RotateCuboid(double angleX, double angleY)
        {
            double sinX = Math.Sin(angleX);
            double cosX = Math.Cos(angleX);

            double sinY = Math.Sin(angleY);
            double cosY = Math.Cos(angleY);

            foreach (var node in nodes)
            {
                double x = node[0];
                double y = node[1];
                double z = node[2];

                node[0] = x * cosX - z * sinX;
                node[2] = z * cosX + x * sinX;

                z = node[2];

                node[1] = y * cosY - z * sinY;
                node[2] = z * cosY + y * sinY;
            }
        }

        private void Scale(int v1, int v2, int v3)
        {
            foreach (var item in nodes)
            {
                item[0] *= v1;
                item[1] *= v2;
                item[2] *= v3;
            }
        }

        protected override void OnPaint(PaintEventArgs args)
        {
            var g = args.Graphics;
            g.SmoothingMode = SmoothingMode.HighQuality;
            g.Clear(Color.White);

            g.TranslateTransform(Width / 2, Height / 2);

            foreach (var edge in edges)
            {
                double[] xy1 = nodes[edge[0]];
                double[] xy2 = nodes[edge[1]];
                g.DrawLine(Pens.Black, (int)Math.Round(xy1[0]), (int)Math.Round(xy1[1]),
                        (int)Math.Round(xy2[0]), (int)Math.Round(xy2[1]));
            }

            foreach (var node in nodes)
            {
                g.FillEllipse(Brushes.Black, (int)Math.Round(node[0]) - 4,
                    (int)Math.Round(node[1]) - 4, 8, 8);
            }
        }
    }
}


using System;

namespace Sphere {
    internal class Program {
        private const string Shades = ".:!*oe%&#@";
        private static readonly double[] Light = {30, 30, -50};

        private static void Normalize(double[] v) {
            double len = Math.Sqrt(v[0]*v[0] + v[1]*v[1] + v[2]*v[2]);
            v[0] /= len;
            v[1] /= len;
            v[2] /= len;
        }

        private static 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;
        }

        public static void DrawSphere(double r, double k, double ambient) {
            var vec = new double[3];
            for(var i = (int)Math.Floor(-r); i <= (int)Math.Ceiling(r); i++) {
                double x = i + .5;
                for(var j = (int)Math.Floor(-2*r); j <= (int)Math.Ceiling(2*r); j++) {
                    double y = j/2.0 + .5;
                    if(x*x + y*y <= r*r) {
                        vec[0] = x;
                        vec[1] = y;
                        vec[2] = Math.Sqrt(r*r - x*x - y*y);
                        Normalize(vec);
                        double b = Math.Pow(Dot(Light, vec), k) + ambient;
                        int intensity = (b <= 0)
                                            ? Shades.Length - 2
                                            : (int)Math.Max((1 - b)*(Shades.Length - 1), 0);
                        Console.Write(Shades[intensity]);
                    }
                    else
                        Console.Write(' ');
                }
                Console.WriteLine();
            }
        }

        private static void Main() {
            Normalize(Light);
            DrawSphere(6, 4, .1);
            DrawSphere(10, 2, .4);
            Console.ReadKey();
        }
    }
}


#include<graphics.h>
#include<iostream>

int main()
{
    int k;
    initwindow(1500,810,"Rosetta Cuboid");

    do{
       std::cout<<"Enter ratio of sides ( 0 or -ve to exit) : ";
       std::cin>>k;

       if(k>0){
                bar3d(100, 100, 100 + 2*k, 100 + 4*k, 3*k, 1);
       }
       }while(k>0);

    return 0;
}


(use 'quil.core)

(def w 500)
(def h 400)

(defn setup []
  (background 0))

(defn draw []
  (push-matrix)
  (translate (/ w 2) (/ h 2) 0)
  (rotate-x 0.7)
  (rotate-z 0.5)
  (box 100 150 200)  ; 2x3x4 relative dimensions
  (pop-matrix))

(defsketch main
  :title "cuboid"
  :setup setup
  :size [w h]
  :draw draw
  :renderer :opengl)


// Based on https://www.cairographics.org/samples/gradient/

#include <QImage>
#include <QPainter>

int main() {
    const QColor black(0, 0, 0);
    const QColor white(255, 255, 255);

    const int size = 300;
    const double diameter = 0.6 * size;

    QImage image(size, size, QImage::Format_RGB32);
    QPainter painter(&image);
    painter.setRenderHint(QPainter::Antialiasing);

    QLinearGradient linearGradient(0, 0, 0, size);
    linearGradient.setColorAt(0, white);
    linearGradient.setColorAt(1, black);

    QBrush brush(linearGradient);
    painter.fillRect(QRect(0, 0, size, size), brush);

    QPointF point1(0.4 * size, 0.4 * size);
    QPointF point2(0.45 * size, 0.4 * size);
    QRadialGradient radialGradient(point1, size * 0.5, point2, size * 0.1);
    radialGradient.setColorAt(0, white);
    radialGradient.setColorAt(1, black);

    QBrush brush2(radialGradient);
    painter.setPen(Qt::NoPen);
    painter.setBrush(brush2);
    painter.drawEllipse(QRectF((size - diameter)/2, (size - diameter)/2, diameter, diameter));

    image.save("sphere.png");
    return 0;
}


import std.stdio, std.array;

void printCuboid(in int dx, in int dy, in int dz) {
    static cline(in int n, in int dx, in int dy, in string cde) {
        writef("%*s", n+1, cde[0 .. 1]);
        write(cde[1 .. 2].replicate(9*dx - 1));
        write(cde[0]);
        writefln("%*s", dy+1, cde[2 .. $]);
    }

    cline(dy+1, dx, 0, "+-");
    foreach (i; 1 .. dy+1)
        cline(dy-i+1, dx, i-1, "/ |");
    cline(0, dx, dy, "+-|");
    foreach (_; 0 .. 4*dz - dy - 2)
        cline(0, dx, dy, "| |");
    cline(0, dx, dy, "| +");
    foreach_reverse (i; 0 .. dy)
        cline(0, dx, i, "| /");
    cline(0, dx, 0, "+-\n");
}

void main() {
    printCuboid(2, 3, 4);
    printCuboid(1, 1, 1);
    printCuboid(6, 2, 1);
}


(use 'quil.core)

(def w 500)
(def h 400)

(defn setup []
  (background 0))

(defn draw []
  (push-matrix)
  (translate 250 200 0)
  (sphere 100)
  (pop-matrix))

(defsketch main
  :title "sphere"
  :setup setup
  :size [w h]
  :draw draw
  :renderer :opengl)


;; * Loading the cairo bindings
(eval-when (:compile-toplevel :load-toplevel)
  (ql:quickload '("cl-cairo2" "cl-cairo2-xlib")))

;; * The package definition
(defpackage :sphere
  (:use :common-lisp :cl-cairo2))
(in-package :sphere)

(defparameter *context* nil)
(defparameter *size* 400)
(defparameter *middle* (/ *size* 2))

;; Opening a display and draw a sphere
(let ((width *size*)
      (height *size*))
  ;; Draw to a X-Window
  (setf *context*
        (create-xlib-image-context width height :window-name "Sphere"))
  ;; Clear the whole canvas with gray
  (rectangle 0 0 width height)
  (set-source-rgb 127 127 127)
  (fill-path)
  ;; Draw a the sphere as circa with a radial pattern
  (with-patterns ((pat (create-radial-pattern (* 0.9 *middle*) (* 0.8 *middle*) (* 0.2 *middle*)
                                              (* 0.8 *middle*) (* 0.8 *middle*) *middle*)))
    (pattern-add-color-stop-rgba pat 0 1 1 1 1)
    (pattern-add-color-stop-rgba pat 1 0 0 0 1)
    (set-source pat)
    (arc *middle* *middle* 180 0 (* 2 pi))
    (fill-path))
  ;; Draw to a png file
  (with-png-file ("sphere.png" :rgb24 width height)
    ;; Clear the whole canvas with gray
    (rectangle 0 0 width height)
    (set-source-rgb 127 127 127)
    (fill-path)
    ;; Draw a the sphere as circa with a radial pattern
    (with-patterns ((pat (create-radial-pattern (* 0.9 *middle*) (* 0.8 *middle*) (* 0.2 *middle*)
                                                (* 0.8 *middle*) (* 0.8 *middle*) *middle*)))
      (pattern-add-color-stop-rgba pat 0 1 1 1 1)
      (pattern-add-color-stop-rgba pat 1 0 0 0 1)
      (set-source pat)
      (arc *middle* *middle* 180 0 (* 2 pi))
      (fill-path))))


program Draw_a_cuboid;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

procedure cubLine(n, dx, dy: Integer; cde: string);
var
  i: integer;
begin
  write(format('%' + (n + 1).ToString + 's', [cde.Substring(0, 1)]));

  for i := 9 * dx - 1 downto 1 do
    Write(cde.Substring(1, 1));

  Write(cde.Substring(0, 1));
  Writeln(cde.Substring(2, cde.Length).PadLeft(dy + 1));
end;

procedure cuboid(dx, dy, dz: integer);
var
  i: integer;
begin
  Writeln(Format('cuboid %d %d %d:', [dx, dy, dz]));

  cubLine(dy + 1, dx, 0, '+-');

  for i := 1 to dy do
    cubLine(dy - i + 1, dx, i - 1, '/ |');

  cubLine(0, dx, dy, '+-|');

  for i := 4 * dz - dy - 2 downto 1 do
    cubLine(0, dx, dy, '| |');

  cubLine(0, dx, dy, '| +');

  for i := 1 to dy do
    cubLine(0, dx, dy - i, '| /');

  cubLine(0, dx, 0, '+-');
  Writeln;
end;

begin
  cuboid(2, 3, 4);
  cuboid(1, 1, 1);
  cuboid(6, 2, 1);

  readln;
end.


startshape SPHERE

shape SPHERE {
	CIRCLE[]
	SPHERE[x 0.1% y 0.1%s 0.99 0.99 b 0.05]
}


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

alias V3 = double[3];
immutable light = normalize([30.0, 30.0, -50.0]);

V3 normalize(V3 v) pure @nogc {
    v[] /= dotProduct(v, v) ^^ 0.5;
    return v;
}

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

void drawSphere(in double R, in double k, in double ambient) @nogc {
    enum shades = ".:!*oe&#%@";
    foreach (immutable i; cast(int)floor(-R) .. cast(int)ceil(R) + 1) {
        immutable double x = i + 0.5;
        foreach (immutable j; cast(int)floor(-2 * R) ..
                              cast(int)ceil(2 * R) + 1) {
            immutable double y = j / 2. + 0.5;
            if (x ^^ 2 + y ^^ 2 <= R ^^ 2) {
                immutable vec = [x, y, (R^^2 - x^^2 - y^^2) ^^ 0.5]
                                .normalize;
                immutable double b = dot(light, vec) ^^ k + ambient;
                int intensity = cast(int)((1 - b) * (shades.length-1));
                intensity = min(shades.length - 1, max(intensity, 0));
                shades[intensity].putchar;
            } else
                ' '.putchar;
        }
        '\n'.putchar;
    }
}

void main() {
    drawSphere(20, 4, 0.1);
    drawSphere(10, 2, 0.4);
}


defmodule Cuboid do
  @x 6
  @y 2
  @z 3
  @dir %{-: {1,0}, |: {0,1}, /: {1,1}}

  def draw(nx, ny, nz) do
    IO.puts "cuboid #{nx} #{ny} #{nz}:"
    {x, y, z} = {@x*nx, @y*ny, @z*nz}
    area = Map.new
    area = Enum.reduce(0..nz-1, area, fn i,acc -> draw_line(acc, x,      0,   @z*i, :-) end)
    area = Enum.reduce(0..ny,   area, fn i,acc -> draw_line(acc, x,   @y*i, [email protected]*i, :-) end)
    area = Enum.reduce(0..nx-1, area, fn i,acc -> draw_line(acc, z,   @x*i,      0, :|) end)
    area = Enum.reduce(0..ny,   area, fn i,acc -> draw_line(acc, z, [email protected]*i,   @y*i, :|) end)
    area = Enum.reduce(0..nz-1, area, fn i,acc -> draw_line(acc, y,      x,   @z*i, :/) end)
    area = Enum.reduce(0..nx,   area, fn i,acc -> draw_line(acc, y,   @x*i,      z, :/) end)
    Enum.each(y+z..0, fn j ->
      IO.puts Enum.map_join(0..x+y, fn i -> Map.get(area, {i,j}, " ") end)
    end)
  end

  defp draw_line(area, n, sx, sy, c) do
    {dx, dy} = Map.get(@dir, c)
    draw_line(area, n, sx, sy, c, dx, dy)
  end

  defp draw_line(area, n, _, _, _, _, _) when n<0, do: area
  defp draw_line(area, n, i, j, c, dx, dy) do
    Map.update(area, {i,j}, c, fn _ -> :+ end)
    |> draw_line(n-1, i+dx, j+dy, c, dx, dy)
  end
end

Cuboid.draw(2,3,4)
Cuboid.draw(1,1,1)
Cuboid.draw(2,4,1)
Cuboid.draw(4,2,1)


USING: classes.struct kernel raylib.ffi ;

640 480 "cuboid" init-window

S{ Camera3D
    { position S{ Vector3 f 4.5 4.5 4.5 } }
    { target S{ Vector3 f 0 0 0 } }
    { up S{ Vector3 f 0 1 0 } }
    { fovy 45.0 }
    { type 0 }
}

60 set-target-fps

[ window-should-close ] [
    begin-drawing
        BLACK clear-background dup
        begin-mode-3d
            S{ Vector3 f 0 0 0 } 2 3 4 LIME draw-cube-wires
        end-mode-3d
    end-drawing
] until drop close-window


program DrawASphere;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Math;

type
  TDouble3  = array[0..2] of Double;
  TChar10 = array[0..9] of Char;

var
  shades: TChar10 = ('.', ':', '!', '*', 'o', 'e', '&', '#', '%', '@');
  light: TDouble3 = (30, 30, -50 );

  procedure normalize(var v: TDouble3);
  var
    len: Double;
  begin
    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: TDouble3): Double;
  begin
    Result:= x[0]*y[0] + x[1]*y[1] + x[2]*y[2];
    Result:= IfThen(Result < 0, -Result, 0 );
  end;

  procedure drawSphere(R, k, ambient: Double);
  var
    vec: TDouble3;
    x, y, b: Double;
    i, j,
    intensity: Integer;
  begin
    for i:= Floor(-R) to Ceil(R) do
    begin
      x := i + 0.5;
      for j:= Floor(-2*R) to Ceil(2 * R) do
      begin
        y:= j / 2 + 0.5;
        if(x * x + y * y <= R * R) then
        begin
          vec[0]:= x;
          vec[1]:= y;
          vec[2]:= sqrt(R * R - x * x - y * y);
          normalize(vec);
          b:= Power(dot(light, vec), k) + ambient;
          intensity:= IfThen(b <= 0,
                             Length(shades) - 2,
                             Trunc(max( (1 - b) * (Length(shades) - 1), 0 )));
          Write(shades[intensity]);
        end
        else
          Write(' ');
      end;
      Writeln;
    end;
  end;

begin
  normalize(light);
  drawSphere(19, 4, 0.1);
  drawSphere(10, 2, 0.4);
  Readln;
end.


#include once "GL/gl.bi"
#include once "GL/glu.bi"

dim rquad as single

screen 18, 16, , 2

glViewport 0, 0, 640, 480                      '' Reset The Current Viewport
glMatrixMode GL_PROJECTION                     '' Select The Projection Matrix
glLoadIdentity                                 '' Reset The Projection Matrix
gluPerspective 45.0, 640.0/480.0, 0.1, 100.0   '' Calculate The Aspect Ratio Of The Window
glMatrixMode GL_MODELVIEW                      '' Select The Modelview Matrix
glLoadIdentity                                 '' Reset The Modelview Matrix
glShadeModel GL_SMOOTH                         '' Enable Smooth Shading
glClearColor 0.0, 0.0, 0.0, 0.5                '' Black Background
glClearDepth 1.0                               '' Depth Buffer Setup
glEnable GL_DEPTH_TEST                         '' Enables Depth Testing
glDepthFunc GL_LEQUAL                          '' The Type Of Depth Testing To Do
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST    '' Really Nice Perspective Calculations
do
	glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT      '' Clear Screen And Depth Buffer
	glLoadIdentity                                          '' Reset The Current Modelview Matrix

	glLoadIdentity                                          '' Reset The Current Modelview Matrix
	glTranslatef 0.0, 0.0, -7.0                             '' Move Right 1.5 Into The Screen 7.0
	glRotatef rquad,1.0, 1.0, 1.0                           '' Rotate The Quad On The X axis ( NEW )

	glBegin GL_QUADS                                        '' Draw A Quad
    glColor3f 0.0, 1.0, 0.0                              '' Set The Color To Blue
    glVertex3f 1.0, 1.5, -2.0                            '' Top Right Of The Quad (Top)
    glVertex3f -1.0, 1.5, -2.0                           '' Top Left Of The Quad (Top)
    glVertex3f -1.0, 1.5, 2.0                            '' Bottom Left Of The Quad (Top)
    glVertex3f 1.0, 1.5, 2.0                             '' Bottom Right Of The Quad (Top)

    glColor3f 1.0, 0.5, 0.0                              '' Set The Color To Orange
    glVertex3f 1.0, -1.5, 2.0                            '' Top Right Of The Quad (Bottom)
    glVertex3f -1.0, -1.5, 2.0                           '' Top Left Of The Quad (Bottom)
    glVertex3f -1.0, -1.5, -2.0                          '' Bottom Left Of The Quad (Bottom)
    glVertex3f 1.0, -1.5, -2.0                           '' Bottom Right Of The Quad (Bottom)

    glColor3f 1.0, 0.0, 0.0                              '' Set The Color To Red
    glVertex3f 1.0, 1.5, 2.0                             '' Top Right Of The Quad (Front)
    glVertex3f -1.0, 1.5, 2.0                            '' Top Left Of The Quad (Front)
    glVertex3f -1.0, -1.5, 2.0                           '' Bottom Left Of The Quad (Front)
    glVertex3f 1.0, -1.5, 2.0                            '' Bottom Right Of The Quad (Front)

    glColor3f 1.0, 1.0, 0.0                              '' Set The Color To Yellow
    glVertex3f 1.0, -1.5, -2.0                           '' Top Right Of The Quad (Back)
    glVertex3f -1.0, -1.5, -2.0                          '' Top Left Of The Quad (Back)
    glVertex3f -1.0, 1.5, -2.0                           '' Bottom Left Of The Quad (Back)
    glVertex3f 1.0, 1.5, -2.0                            '' Bottom Right Of The Quad (Back)

    glColor3f 0.0, 0.0, 1.0                              '' Set The Color To Blue
    glVertex3f -1.0, 1.5, 2.0                            '' Top Right Of The Quad (Left)
    glVertex3f -1.0, 1.5, -2.0                           '' Top Left Of The Quad (Left)
    glVertex3f -1.0, -1.5, -2.0                          '' Bottom Left Of The Quad (Left)
    glVertex3f -1.0, -1.5, 2.0                           '' Bottom Right Of The Quad (Left)

    glColor3f 1.0, 0.0, 1.0                              '' Set The Color To Violet
    glVertex3f 1.0, 1.5, -2.0                            '' Top Right Of The Quad (Right)
    glVertex3f 1.0, 1.5, 2.0                             '' Top Left Of The Quad (Right)
    glVertex3f 1.0, -1.5, 2.0                            '' Bottom Left Of The Quad (Right)
    glVertex3f 1.0, -1.5, -2.0                           '' Bottom Right Of The Quad (Right)
    glEnd                                                   '' Done Drawing The Quad

	rquad -= 0.15

	flip
loop while inkey = ""


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

var
   light : TFloat3 = [ 30, 30, -50 ];

procedure normalize(var v : TFloat3);
var
   len: Float;
begin
    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 : TFloat3) : Float;
begin
    Result := x[0]*y[0] + x[1]*y[1] + x[2]*y[2];
    if Result<0 then
       Result:=-Result
    else Result:=0;
end;

procedure drawSphere(R, k, ambient : Float);
var
   vec : TFloat3;
   x, y, b : Float;
   i, j, size, intensity : Integer;
begin
   size:=Trunc(Ceil(R)-Floor(-R)+1);
   PrintLn('P2');
   PrintLn(IntToStr(size)+' '+IntToStr(size));
   PrintLn('255');
   for i := Floor(-R) to Ceil(R) do begin
      x := i + 0.5;
      for j := Floor(-R) to Ceil(R) do begin
         y := j + 0.5;
         if (x * x + y * y <= R * R) then begin
            vec[0] := x;
            vec[1] := y;
            vec[2] := sqrt(R * R - x * x - y * y);
            normalize(vec);
            b := Power(dot(light, vec), k) + ambient;
            intensity := ClampInt( Round(b*255), 0, 255);
            Print(intensity);
            Print(' ')
         end else Print('0 ');
      end;
      PrintLn('');
   end;
end;

normalize(light);
drawSphere(19, 4, 0.1);


res = 254 / in
s = 1/2 inch res
v = callJava["frink.graphics.VoxelArray", "cube", [-s, s, -s, s, -s, s, true]]

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

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


package main

import "fmt"

func cuboid(dx, dy, dz int) {
    fmt.Printf("cuboid %d %d %d:\n", dx, dy, dz)
    cubLine(dy+1, dx, 0, "+-")
    for i := 1; i <= dy; i++ {
        cubLine(dy-i+1, dx, i-1, "/ |")
    }
    cubLine(0, dx, dy, "+-|")
    for i := 4*dz - dy - 2; i > 0; i-- {
        cubLine(0, dx, dy, "| |")
    }
    cubLine(0, dx, dy, "| +")
    for i := 1; i <= dy; i++ {
        cubLine(0, dx, dy-i, "| /")
    }
    cubLine(0, dx, 0, "+-\n")
}

func cubLine(n, dx, dy int, cde string) {
    fmt.Printf("%*s", n+1, cde[:1])
    for d := 9*dx - 1; d > 0; d-- {
        fmt.Print(cde[1:2])
    }
    fmt.Print(cde[:1])
    fmt.Printf("%*s\n", dy+1, cde[2:])
}

func main() {
    cuboid(2, 3, 4)
    cuboid(1, 1, 1)
    cuboid(6, 2, 1)
}


; Draw a sphere

(defun normalize (v)
  "Normalize a vector."
  (setq invlen (/ 1.0 (sqrt (dot v v))))
  (mapcar (lambda (x) (* invlen x)) v))

(defun dot (v1 v2)
  "Dot product of two vectors."
  (+ (* (car v1) (car v2))
     (* (cadr v1) (cadr v2))
     (* (caddr v1) (caddr v2))))

(defun make-array (size)
  "Create an empty array with size*size elements."
  (setq m-array (make-vector size nil))
  (dotimes (i size)
    (setf (aref m-array i) (make-vector size 0)))
  m-array)

(defun pic-lines (arr size)
  "Turn array into a string."
  (setq all "")
  (dotimes (y size)
    (setq line "")
    (dotimes (x size)
      (setq line (concat line (format "%i \n" (elt (elt arr y) x)))))
    (setq all (concat all line "\n")))
  all)

(defun pic-show (arr size)
  "Convert size*size array to grayscale PBM image and show it."
  (insert-image (create-image (concat (format "P2
%i %i 255\n" size size) (pic-lines arr size)) 'pbm t)))

(defun sphere (size k amb dir)
  "Draw a sphere."
  (let ((arr (make-array size))
        (ndir (normalize dir))
        (r (/ size 2)))
    (dotimes (yp size)
      (dotimes (xp size)
        (setq x (- xp r))
        (setq y (- yp r))
        (setq z (- (* r r) (* x x) (* y y)))
        (if (>= z 0)
          (let* ((vec (normalize (list x y (sqrt z))))
                 (s (max 0 (dot vec ndir)))
                 (lum (max 0 (min 255 (* 255 (+ amb (expt s k))
                                                    (/ (1+ amb)))))))
            (setf (elt (elt arr yp) xp) lum)))))
    (pic-show arr size)))

(sphere 200 1.5 0.2 '(-30 -30 50))


import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT

-- Draw a cuboid.  Its vertices are those of a unit cube, which is then scaled
-- to the required dimensions.  We only specify the visible faces, each of
-- which is composed of two triangles.  The faces are rotated into position and
-- rendered with a perspective transformation.

type Fl = GLfloat

cuboid :: IO ()
cuboid = do
  color red   ; render front
  color green ; render side
  color blue  ; render top

red,green,blue :: Color4 GLfloat
red   = Color4 1 0 0 1
green = Color4 0 1 0 1
blue  = Color4 0 0 1 1

render :: [(Fl, Fl, Fl)] -> IO ()
render = renderPrimitive TriangleStrip . mapM_ toVertex
  where toVertex (x,y,z) = vertex $ Vertex3 x y z

front,side,top :: [(Fl,Fl,Fl)]
front = vertices [0,1,2,3]
side  = vertices [4,1,5,3]
top   = vertices [3,2,5,6]

vertices :: [Int] -> [(Fl,Fl,Fl)]
vertices = map (verts !!)

verts :: [(Fl,Fl,Fl)]
verts = [(0,0,1), (1,0,1), (0,1,1), (1,1,1), (1,0,0), (1,1,0), (0,1,0)]

transform :: IO ()
transform = do
  translate $ Vector3 0 0 (-10 :: Fl)
  rotate (-14) $ Vector3 0 0 (1 :: Fl)
  rotate (-30) $ Vector3 0 1 (0 :: Fl)
  rotate   25  $ Vector3 1 0 (0 :: Fl)
  scale 2 3 (4 :: Fl)
  translate $ Vector3 (-0.5) (-0.5) (-0.5 :: Fl)

display :: IO ()
display = do
  clear [ColorBuffer]
  perspective 40 1 1 (15 :: GLdouble)
  transform
  cuboid
  flush

main :: IO ()
main = do
  let name = "Cuboid"
  initialize name []
  createWindow name
  displayCallback $= display
  mainLoop


PROGRAM SPHERE

CONST SHADES$=".:!*oe&#%@"

DIM LIGHT[2],X[2],Y[2],V[2],VEC[2]

PROCEDURE DOT(X[],Y[]->D)
        D=X[0]*Y[0]+X[1]*Y[1]+X[2]*Y[2]
        IF D<0 THEN D=-D ELSE D=0 END IF
END PROCEDURE

PROCEDURE NORMALIZE(V[]->V[])
        LUNG=SQR(V[0]*V[0]+V[1]*V[1]+V[2]*V[2])
        V[0]=V[0]/LUNG
        V[1]=V[1]/LUNG
        V[2]=V[2]/LUNG
END PROCEDURE

PROCEDURE PDRAW(R,K,AMBIENT)
        FOR I=INT(-R) TO INT(R) DO
                X=I+0.5
                FOR J=INT(-2*R) TO INT(2*R) DO
                        Y=J/2+0.5
                        IF (X*X+Y*Y<=R*R) THEN
                                VEC[0]=X
                                VEC[1]=Y
                                VEC[2]=SQR(R*R-X*X-Y*Y)
                                NORMALIZE(VEC[]->VEC[])
                                DOT(LIGHT[],VEC[]->D)
                                B=D^K+AMBIENT
                                INTENSITY%=(1-B)*(LEN(SHADES$)-1)
                                IF (INTENSITY%<0) THEN INTENSITY%=0 END IF
                                IF (INTENSITY%>=LEN(SHADES$)-1) THEN
                                        INTENSITY%=LEN(SHADES$)-2
                                END IF
                                PRINT(#1,MID$(SHADES$,INTENSITY%+1,1);)
                           ELSE
                                PRINT(#1,(" ");)
                        END IF
                END FOR
                PRINT(#1,)
        END FOR
END PROCEDURE

BEGIN
    LIGHT[]=(30,30,-50)
    OPEN("O",1,"SPHERE.PRN")
       NORMALIZE(LIGHT[]->LIGHT[])
       PDRAW(10,2,0.4)

       PRINT(#1,STRING$(79,"="))
       PDRAW(20,4,0.1)
    CLOSE(1)
END PROGRAM


USING: classes.struct kernel raylib.ffi ;

640 480 "sphere" init-window

S{ Camera3D
    { position S{ Vector3 f 4.5 4.5 4.5 } }
    { target S{ Vector3 f 0 0 0 } }
    { up S{ Vector3 f 0 1 0 } }
    { fovy 45.0 }
    { type 0 }
}

60 set-target-fps

[ window-should-close ] [
    begin-drawing
        BLACK clear-background dup
        begin-mode-3d
            S{ Vector3 f 0 0 0 } 2 20 20 LIME draw-sphere-wires
        end-mode-3d
    end-drawing
] until drop close-window


import java.awt.*;
import java.awt.event.*;
import static java.lang.Math.*;
import javax.swing.*;

public class Cuboid extends JPanel {
    double[][] nodes = {{-1, -1, -1}, {-1, -1, 1}, {-1, 1, -1}, {-1, 1, 1},
    {1, -1, -1}, {1, -1, 1}, {1, 1, -1}, {1, 1, 1}};

    int[][] edges = {{0, 1}, {1, 3}, {3, 2}, {2, 0}, {4, 5}, {5, 7}, {7, 6},
    {6, 4}, {0, 4}, {1, 5}, {2, 6}, {3, 7}};

    int mouseX, prevMouseX, mouseY, prevMouseY;

    public Cuboid() {
        setPreferredSize(new Dimension(640, 640));
        setBackground(Color.white);

        scale(80, 120, 160);
        rotateCube(PI / 5, PI / 9);

        addMouseListener(new MouseAdapter() {
            @Override
            public void mousePressed(MouseEvent e) {
                mouseX = e.getX();
                mouseY = e.getY();
            }
        });

        addMouseMotionListener(new MouseAdapter() {
            @Override
            public void mouseDragged(MouseEvent e) {
                prevMouseX = mouseX;
                prevMouseY = mouseY;
                mouseX = e.getX();
                mouseY = e.getY();

                double incrX = (mouseX - prevMouseX) * 0.01;
                double incrY = (mouseY - prevMouseY) * 0.01;

                rotateCube(incrX, incrY);
                repaint();
            }
        });
    }

    private void scale(double sx, double sy, double sz) {
        for (double[] node : nodes) {
            node[0] *= sx;
            node[1] *= sy;
            node[2] *= sz;
        }
    }

    private void rotateCube(double angleX, double angleY) {
        double sinX = sin(angleX);
        double cosX = cos(angleX);

        double sinY = sin(angleY);
        double cosY = cos(angleY);

        for (double[] node : nodes) {
            double x = node[0];
            double y = node[1];
            double z = node[2];

            node[0] = x * cosX - z * sinX;
            node[2] = z * cosX + x * sinX;

            z = node[2];

            node[1] = y * cosY - z * sinY;
            node[2] = z * cosY + y * sinY;
        }
    }

    void drawCube(Graphics2D g) {
        g.translate(getWidth() / 2, getHeight() / 2);

        for (int[] edge : edges) {
            double[] xy1 = nodes[edge[0]];
            double[] xy2 = nodes[edge[1]];
            g.drawLine((int) round(xy1[0]), (int) round(xy1[1]),
                    (int) round(xy2[0]), (int) round(xy2[1]));
        }

        for (double[] node : nodes) {
            g.fillOval((int) round(node[0]) - 4, (int) round(node[1]) - 4, 8, 8);
        }
    }

    @Override
    public void paintComponent(Graphics gg) {
        super.paintComponent(gg);
        Graphics2D g = (Graphics2D) gg;
        g.setRenderingHint(RenderingHints.KEY_ANTIALIASING,
                RenderingHints.VALUE_ANTIALIAS_ON);

        drawCube(g);
    }

    public static void main(String[] args) {
        SwingUtilities.invokeLater(() -> {
            JFrame f = new JFrame();
            f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
            f.setTitle("Cuboid");
            f.setResizable(false);
            f.add(new Cuboid(), BorderLayout.CENTER);
            f.pack();
            f.setLocationRelativeTo(null);
            f.setVisible(true);
        });
    }
}


: 3dup 2 pick 2 pick 2 pick ;

: sqrt ( u -- sqrt )            ( Babylonian method                 )
  dup 2/                        ( first square root guess is half   )
  dup 0= if drop exit then      ( sqrt[0]=0, sqrt[1]=1              )
  begin dup >r 2dup / r> + 2/   ( stack: square old-guess new-guess )
  2dup > while                  ( as long as guess is decreasing    )
  nip repeat                    ( forget old-guess and repeat       )
  drop nip ;

: normalize ( x1 y1 z1 -- x1' y1' z1' )    ( normalise down to 1000 )
  3dup dup * rot dup * rot dup * + + sqrt 1000 / >r        ( length )
  [email protected] / rot [email protected] / rot r> / rot ;

: r2-y2-x2 ( x y r -- z2 ) dup * swap dup * - swap dup * - ;

: shade ( u -- c ) C" @#&eo%*!:. " + [email protected] ;

: map-to-shade ( u -- u )   0 shade * 1000 /    1 max    0 shade min ;

: dot-light ( x y z -- i )      ( hard coded light vector z, y, x   )
  -770 *    rot 461 *    rot 461 *    + +
  0 min 1000 / ;

: intensity ( x y z -- u )  dot-light dup * 1000 /   map-to-shade ;

: pixel ( x y r -- c )
  3dup r2-y2-x2 dup 0> if                              ( if in disk )
    sqrt nip    normalize intensity shade        ( z=sqrt[r2-x2-y2] )
  else 2drop 2drop bl                                  ( else blank )
  then ;

: draw ( r -- )    ( r x1000 )
1000 * dup dup negate do
   cr
   dup dup negate do
      dup I 500 + J 500 + rot pixel emit
   500 +loop
1000 +loop drop ;

20 draw
10 draw


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

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

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


<!DOCTYPE html>
<html lang="en">

<head>
    <meta charset="UTF-8">
    <style>
        canvas {
            background-color: black;
        }
    </style>
</head>
<body>
    <canvas></canvas>
    <script>
        var canvas = document.querySelector("canvas");
        canvas.width = window.innerWidth;
        canvas.height = window.innerHeight;

        var g = canvas.getContext("2d");

        canvas.addEventListener("mousemove", function (event) {
            prevMouseX = mouseX;
            prevMouseY = mouseY;
            mouseX = event.x;
            mouseY = event.y;

            var incrX = (mouseX - prevMouseX) * 0.01;
            var incrY = (mouseY - prevMouseY) * 0.01;

            rotateCuboid(incrX, incrY);
            drawCuboid();
        });

        var nodes = [[-1, -1, -1], [-1, -1, 1], [-1, 1, -1], [-1, 1, 1],
        [1, -1, -1], [1, -1, 1], [1, 1, -1], [1, 1, 1]];

        var edges = [[0, 1], [1, 3], [3, 2], [2, 0], [4, 5], [5, 7], [7, 6],
        [6, 4], [0, 4], [1, 5], [2, 6], [3, 7]];

        var mouseX = 0, prevMouseX, mouseY = 0, prevMouseY;

        function scale(factor0, factor1, factor2) {
            nodes.forEach(function (node) {
                node[0] *= factor0;
                node[1] *= factor1;
                node[2] *= factor2;
            });
        }

        function rotateCuboid(angleX, angleY) {

            var sinX = Math.sin(angleX);
            var cosX = Math.cos(angleX);

            var sinY = Math.sin(angleY);
            var cosY = Math.cos(angleY);

            nodes.forEach(function (node) {
                var x = node[0];
                var y = node[1];
                var z = node[2];

                node[0] = x * cosX - z * sinX;
                node[2] = z * cosX + x * sinX;

                z = node[2];

                node[1] = y * cosY - z * sinY;
                node[2] = z * cosY + y * sinY;
            });
        }

        function drawCuboid() {
            g.save();

            g.clearRect(0, 0, canvas.width, canvas.height);
            g.translate(canvas.width / 2, canvas.height / 2);
            g.strokeStyle = "#FFFFFF";
            g.beginPath();

            edges.forEach(function (edge) {
                var p1 = nodes[edge[0]];
                var p2 = nodes[edge[1]];
                g.moveTo(p1[0], p1[1]);
                g.lineTo(p2[0], p2[1]);
            });

            g.closePath();
            g.stroke();

            g.restore();
        }

        scale(80, 120, 160);
        rotateCuboid(Math.PI / 5, Math.PI / 9);
    </script>

</body>
</html>


include "Tlbx agl.incl"
include "Tlbx glut.incl"

output file "Rotating Sphere"

local fn SphereDraw
'~'1
begin globals
dim as double  sRotation // 'static' var
end globals

// Speed of rotation
sRotation += 2.9
glMatrixMode( _GLMODELVIEW )

glLoadIdentity()

// Position parameters: x axis, y axis, z axis
// Set to center of screen:
glTranslated( 0.0, 0.0, 0.0 )

// Rotation (wobble) parameters: angle, x, y
glRotated( sRotation, -0.45, -0.8, -0.6 )

// Set color of sphere's wireframe
glColor3d( 1.0, 0.0, 0.3 )

// Set width of sphere's wireframe lines
glLineWidth( 1.5 )

// Apply above to GLUT's built-in sphere wireframe
// Size & frame parameters: radius, slices, stack
fn glutWireSphere( 0.8, 25, 25 )

end fn

// main program
dim as GLint           attrib(2)
dim as CGrafPtr        port
dim as AGLPixelFormat  fmt
dim as AGLContext      glContext
dim as EventRecord     ev
dim as GLboolean       yesOK

// Make a window
window 1, @"Rotating Sphere", (0,0) - (500,500)

// Minimal setup of OpenGL
attrib(0) = _AGLRGBA
attrib(1) = _AGLDOUBLEBUFFER
attrib(2) = _AGLNONE

fmt = fn aglChoosePixelFormat( 0, 0, attrib(0) )
glContext = fn aglCreateContext( fmt, 0 )
aglDestroyPixelFormat( fmt )

// Set the FB window as port for drawing
port = window( _wndPort )
yesOK = fn aglSetDrawable( glContext, port )
yesOK = fn aglSetCurrentContext( glContext )

// Background color: red, green, blue, alpha
glClearColor( 0.0, 0.0, 0.0, 0.0 )

// 60/s HandleEvents Trigger
poke long event - 8, 1
do
// Clear window
glClear( _GLCOLORBUFFERBIT )
// Run animation
fn SphereDraw
aglSwapBuffers( glContext )
HandleEvents
until gFBquit


package main

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

type vector [3]float64

func normalize(v *vector) {
    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]
}

func drawSphere(r int, k, amb float64, dir *vector) *image.Gray {
    w, h := r*4, r*3
    img := image.NewGray(image.Rect(-w/2, -h/2, w/2, h/2))
    vec := new(vector)
    for x := -r; x < r; x++ {
        for y := -r; y < r; y++ {
            if z := r*r - x*x - y*y; z >= 0 {
                vec[0] = float64(x)
                vec[1] = float64(y)
                vec[2] = math.Sqrt(float64(z))
                normalize(vec)
                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{-30, -30, 50}
    normalize(dir)
    img := drawSphere(200, 1.5, .2, dir)
    f, err := os.Create("sphere.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)
    }
}


_pr(t::Dict, x::Int, y::Int, z::Int) = join((rstrip(join(t[(n, m)] for n in range(0, 3+x+z))) for m in reverse(range(0, 3+y+z))), "\n")

function cuboid(x::Int, y::Int, z::Int)
    t = Dict((n, m) => " " for n in range(0, 3 + x + z), m in range(0, 3 + y + z))
    xrow = vcat("+", collect("$(i % 10)" for i in range(0, x)), "+")
    for (i, ch) in enumerate(xrow) t[(i, 0)] = t[(i, 1+y)] = t[(1+z+i, 2+y+z)] = ch end
    yrow = vcat("+", collect("$(j % 10)" for j in range(0, y)), "+")
    for (j, ch) in enumerate(yrow) t[(0, j)] = t[(x+1, j)] = t[(2+x+z, 1+z+j)] = ch end
    zdep = vcat("+", collect("$(k % 10)" for k in range(0, y)), "+")
    for (k, ch) in enumerate(xrow) t[(k, 1+y+k)] = t[(1+x+k, 1+y+k)] = t[(1+x+k, k)] = ch end

    return _pr(t, x, y, z)
end

for (x, y, z) in [(2, 3, 4), (3, 4, 2), (4, 2, 3), (5, 5, 6)]
    println("\nCUBOID($x, $y, $z)\n")
    println(cuboid(x, y, z))
end


// version 1.1

import java.awt.*
import java.awt.event.MouseAdapter
import java.awt.event.MouseEvent
import javax.swing.*

class Cuboid: JPanel() {
    private val nodes = arrayOf(
        doubleArrayOf(-1.0, -1.0, -1.0),
        doubleArrayOf(-1.0, -1.0,  1.0),
        doubleArrayOf(-1.0,  1.0, -1.0),
        doubleArrayOf(-1.0,  1.0,  1.0),
        doubleArrayOf( 1.0, -1.0, -1.0),
        doubleArrayOf( 1.0, -1.0,  1.0),
        doubleArrayOf( 1.0,  1.0, -1.0),
        doubleArrayOf( 1.0,  1.0,  1.0)
    )
    private val edges = arrayOf(
        intArrayOf(0, 1),
        intArrayOf(1, 3),
        intArrayOf(3, 2),
        intArrayOf(2, 0),
        intArrayOf(4, 5),
        intArrayOf(5, 7),
        intArrayOf(7, 6),
        intArrayOf(6, 4),
        intArrayOf(0, 4),
        intArrayOf(1, 5),
        intArrayOf(2, 6),
        intArrayOf(3, 7)
    )

    private var mouseX: Int = 0
    private var prevMouseX: Int = 0
    private var mouseY: Int = 0
    private var prevMouseY: Int = 0

    init {
        preferredSize = Dimension(640, 640)
        background = Color.white
        scale(80.0, 120.0, 160.0)
        rotateCube(Math.PI / 5.0, Math.PI / 9.0)
        addMouseListener(object: MouseAdapter() {
            override fun mousePressed(e: MouseEvent) {
                mouseX = e.x
                mouseY = e.y
            }
        })

        addMouseMotionListener(object: MouseAdapter() {
            override fun mouseDragged(e: MouseEvent) {
                prevMouseX = mouseX
                prevMouseY = mouseY
                mouseX = e.x
                mouseY = e.y
                val incrX = (mouseX - prevMouseX) * 0.01
                val incrY = (mouseY - prevMouseY) * 0.01
                rotateCube(incrX, incrY)
                repaint()
            }
        })
    }

    private fun scale(sx: Double, sy: Double, sz: Double) {
        for (node in nodes) {
            node[0] *= sx
            node[1] *= sy
            node[2] *= sz
        }
    }

    private fun rotateCube(angleX: Double, angleY: Double) {
        val sinX = Math.sin(angleX)
        val cosX = Math.cos(angleX)
        val sinY = Math.sin(angleY)
        val cosY = Math.cos(angleY)
        for (node in nodes) {
            val x = node[0]
            val y = node[1]
            var z = node[2]
            node[0] = x * cosX - z * sinX
            node[2] = z * cosX + x * sinX
            z = node[2]
            node[1] = y * cosY - z * sinY
            node[2] = z * cosY + y * sinY
        }
    }

    private fun drawCube(g: Graphics2D) {
        g.translate(width / 2, height / 2)
        for (edge in edges) {
            val xy1 = nodes[edge[0]]
            val xy2 = nodes[edge[1]]
            g.drawLine(Math.round(xy1[0]).toInt(), Math.round(xy1[1]).toInt(),
                       Math.round(xy2[0]).toInt(), Math.round(xy2[1]).toInt())
        }
        for (node in nodes) {
            g.fillOval(Math.round(node[0]).toInt() - 4, Math.round(node[1]).toInt() - 4, 8, 8)
        }
    }

    override public fun paintComponent(gg: Graphics) {
        super.paintComponent(gg)
        val g = gg as Graphics2D
        g.setRenderingHint(RenderingHints.KEY_ANTIALIASING, RenderingHints.VALUE_ANTIALIAS_ON)
        g.color = Color.blue
        drawCube(g)
    }
}

fun main(args: Array<String>) {
    SwingUtilities.invokeLater {
        val f = JFrame()
        f.defaultCloseOperation = JFrame.EXIT_ON_CLOSE
        f.title = "Cuboid"
        f.isResizable = false
        f.add(Cuboid(), BorderLayout.CENTER)
        f.pack()
        f.setLocationRelativeTo(null)
        f.isVisible = true
    }
}


import Graphics.Rendering.OpenGL.GL
import Graphics.UI.GLUT.Objects
import Graphics.UI.GLUT

setProjection :: IO ()
setProjection = do
  matrixMode $= Projection
  ortho (-1) 1 (-1) 1 0 (-1)

grey1,grey9,red,white :: Color4 GLfloat
grey1 = Color4 0.1 0.1 0.1 1
grey9 = Color4 0.9 0.9 0.9 1
red   = Color4 1   0   0   1
white = Color4 1   1   1   1

setLights :: IO ()
setLights = do
  let l = Light 0
  ambient  l $= grey1
  diffuse  l $= white
  specular l $= white
  position l $= Vertex4 (-4) 4 3 (0 :: GLfloat)
  light    l $= Enabled
  lighting   $= Enabled

setMaterial :: IO ()
setMaterial = do
  materialAmbient   Front $= grey1
  materialDiffuse   Front $= red
  materialSpecular  Front $= grey9
  materialShininess Front $= (32 :: GLfloat)

display :: IO()
display = do
  clear [ColorBuffer]
  renderObject Solid $ Sphere' 0.8 64 64
  swapBuffers

main :: IO()
main = do
  _ <- getArgsAndInitialize
  _ <- createWindow "Sphere"
  clearColor $= Color4 0.0 0.0 0.0 0.0
  setProjection
  setLights
  setMaterial
  displayCallback $= display
  mainLoop


Call cuboid 1,3,4

End

Sub cuboid width, height, depth
    wd=width*7+2: hi=height*3: dp=depth
    For i=1 To wd-2
        w$=w$+"-":h$=h$+" "
    Next
    w$="+"+w$+"+":d$="/"+h$+"/":h$="|"+h$+"|"
    px=dp+2:py=1:Locate dp+2,py:Print w$;
    For i=2 To hi+1
        Locate wd+dp+1,i:Print"|";
    Next
    Locate wd+dp+1, i: Print "+";
    For i=dp+1 To 1 Step -1
        py=py+1:Locate i,py:Print d$;
    Next
    For i=1 To dp
        Locate wd+(dp+1)-i,hi+d+2+i:Print "/";
    Next
    Locate 1, dp+2: Print w$;
    For i=dp+3 To hi+dp+2
        Locate 1,i:Print h$;
    Next
    Locate 1, dp+hi+3: Print w$
End Sub


to cuboid :l1 :l2 :l3
cs perspective ;making the room ready to use
setxyz :l1   0    0
setxyz :l1 :l2    0
setxyz   0 :l2    0
setxyz   0   0    0
setxyz :l1   0    0
setxyz :l1   0 -:l3
setxyz :l1 :l2 -:l3
setxyz :l1 :l2    0
setxyz   0 :l2    0
setxyz   0 :l2 -:l3
setxyz :l1 :l2 -:l3
end


procedure main()
W := open("Demo", "gl", "size=400,400", "bg=black") | stop("can't open window!")
WAttrib(W, "slices=40", "rings=40", "light0=on, ambient white; diffuse gold; specular gold; position 5, 0, 0" )
Fg(W, "emission blue")
DrawSphere(W, 0, 0, -5, 1)
Event(W)
end


Studio
 > Demos...
  > opengl simple... [ok]
    > sphere [Run]


vector vSCALE = <2.0, 3.0, 4.0>;
default {
    state_entry() {
        llSetScale(vSCALE);
    }
}


-- needed for actual task
cube.scale = function(self, sx, sy, sz)
  for i,v in ipairs(self.verts) do
    v[1], v[2], v[3] = v[1]*sx, v[2]*sy, v[3]*sz
  end
end
-- only needed for output
-- (to size it for screen, given a limited camera)
cube.translate = function(self, tx, ty, tz)
  for i,v in ipairs(self.verts) do
    v[1], v[2], v[3] = v[1]+tx, v[2]+ty, v[3]+tz
  end
end


public class Sphere{
    static char[] shades = {'.', ':', '!', '*', 'o', 'e', '&', '#', '%', '@'};

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

    private static 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;
    }

    public static void drawSphere(double R, double k, double ambient){
        double[] vec = new double[3];
        for(int i = (int)Math.floor(-R); i <= (int)Math.ceil(R); i++){
            double x = i + .5;
            for(int j = (int)Math.floor(-2 * R); j <= (int)Math.ceil(2 * R); j++){
                double y = j / 2. + .5;
                if(x * x + y * y <= R * R) {
                    vec[0] = x;
                    vec[1] = y;
                    vec[2] = Math.sqrt(R * R - x * x - y * y);
                    normalize(vec);
                    double b = Math.pow(dot(light, vec), k) + ambient;
                    int intensity = (b <= 0) ?
                                shades.length - 2 :
                                (int)Math.max((1 - b) * (shades.length - 1), 0);
                    System.out.print(shades[intensity]);
                } else
                    System.out.print(' ');
            }
            System.out.println();
        }
    }

    public static void main(String[] args){
        normalize(light);
        drawSphere(20, 4, .1);
        drawSphere(10, 2, .4);
    }
}


plots:-display(plottools:-parallelepiped([2, 0, 0], [0, 0, 4], [0, 3, 0]), orientation = [45, 60])


load(draw)$

draw3d(xu_grid=100, yv_grid=100, surface_hide=true,
   palette=gray, enhanced3d=[x - z / 4 - y / 4, x, y, z],
   implicit(max(abs(x / 4), abs(y / 6), abs(z / 8)) = 1,
   x,-10,10,y,-10,10,z,-10,10))$


<!DOCTYPE html>

<meta charset="utf-8">
<title>Draw a sphere</title>

R=<input type="range" id="R" name="R" min="5" max="500" value="200" step="5" onchange="document.getElementById('lR').innerHTML=gR=parseFloat(this.value);draw_sphere(gR,gk,gambient)">
200

k=<input type="range" id="k" name="k" min="0" max="10" value="4" step=".25" onchange="document.getElementById('lk').innerHTML=gk=parseFloat(this.value);draw_sphere(gR,gk,gambient)">
4

ambient=<input type="range" id="ambient" name="ambient" min="0" max="1" value=".2" step=".05" onchange="document.getElementById('lambient').innerHTML=gambient=parseFloat(this.value);draw_sphere(gR,gk,gambient)">
0.2

<canvas id="c">Unsupportive browser...</canvas>


import strutils

proc cline(n, x, y: int, cde: string) =
  echo cde[0..0].align n+1,
    repeat(cde[1], 9*x-1),
    cde[0],
    if cde.len > 2: cde[2..2].align y+1 else: ""

proc cuboid(x, y, z: int) =
  cline y+1, x, 0, "+-"
  for i in 1..y: cline y-i+1, x, i-1, "/ |"
  cline 0, x, y, "+-|"
  for i in 0..4*z-y-3: cline 0, x, y, "| |"
  cline 0, x, y, "| +"
  for i in countdown(y-1, 0): cline 0, x, i, "| /"
  cline 0, x, 0, "+-\n"

cuboid 2, 3, 4
cuboid 1, 1, 1
cuboid 6, 2, 1


// This will produce a simple cuboid
cube([2,3,4]);


  % Title "Cuboid 2x3x4"
  '% Animated
  % PlaceCentral
  uses ConsoleG

  sub main
  ========
  cls 0.0, 0.2, 0.7
  shading
  scale 3
  pushstate
    GoldMaterial.act
    static float ang=45
    rotateX ang
    rotateY ang
    scale 2,3,4
    go cube
  popstate
  end sub

  EndScript


def svg:
  "<svg width='100%' height='100%' version='1.1'
    xmlns='http://www.w3.org/2000/svg'
    xmlns:xlink='http://www.w3.org/1999/xlink'>" ;

# A radial gradient to make a circle look like a sphere.
# "colors" should be [startColor, intermediateColor, endColor]
# or null for ["white", "teal", "black"]
def sphericalGradient(id; colors):
  "<defs>
        <radialGradient id = '\(id)' cx = '30%' cy = '30%' r = '100%' fx='10%' fy='10%' >
            <stop stop-color = '\(colors[0]//"white")' offset =   '0%'/>
            <stop stop-color = '\(colors[1]//"teal")'  offset =  '50%'/>
            <stop stop-color = '\(colors[1]//"black")' offset = '100%'/>
        </radialGradient>
    </defs>" ;

def sphere(cx; cy; r; gradientId):
   "<circle fill='url(#\(gradientId))' cx='\(cx)' cy='\(cy)' r='\(r)' />" ;


function draw_sphere(r, k, ambient, light)
    shades = ('.', ':', '!', '*', 'o', 'e', '&', '#', '%', '@')
    for i in floor(Int, -r):ceil(Int, r)
        x = i + 0.5
        line = IOBuffer()
        for j in floor(Int, -2r):ceil(2r)
            y = j / 2 + 0.5
            if x ^ 2 + y ^ 2 ≤ r ^ 2
                v = normalize([x, y, sqrt(r ^ 2 - x ^ 2 - y ^ 2)])
                b = dot(light, v) ^ k + ambient
                intensity = ceil(Int, (1 - b) * (length(shades) - 1))
                if intensity < 1
                    intensity = 1 end
                if intensity > length(shades)
                    intensity = length(shades) end
                print(shades[intensity])
            else
                print(' ')
            end
        end
        println()
    end
end

light = normalize([30, 30, -50])
draw_sphere(20, 4, 0.1, light)
draw_sphere(10, 2, 0.4, light)