package  {

    import flash.display.Graphics;
    import flash.display.Shape;
    import flash.display.Sprite;
    import flash.events.Event;
    import flash.events.TimerEvent;
    import flash.utils.Timer;

    public class Clock extends Sprite {

        // Changes of hands (in degrees) per second
        private static const HOUR_HAND_CHANGE:Number = 1 / 120;  // 360 / (60 * 60 * 12)
        private static const MINUTE_HAND_CHANGE:Number = 0.1;      // 360 / (60 * 60)
        private static const SECOND_HAND_CHANGE:Number = 6;        // 360 / 60

        private var _timer:Timer;

        private var _hHand:Shape;
        private var _mHand:Shape;
        private var _sHand:Shape;

        public function Clock() {
            if ( stage ) _init();
            else addEventListener(Event.ADDED_TO_STAGE, _init);
        }

        private function _init(e:Event = null):void {

            var i:uint;

            var base:Shape = new Shape(), hHand:Shape = new Shape(), mHand:Shape = new Shape();
            var sHand:Shape = new Shape(), hub:Shape = new Shape();

            var size:Number = 500;
            var c:Number = size / 2;
            x = 30;
            y = 30;

            var baseGraphics:Graphics = base.graphics;

            baseGraphics.lineStyle(5, 0xEE0000);
            baseGraphics.beginFill(0xFFDDDD);
            baseGraphics.drawCircle(c, c, c);

            var uAngle:Number = Math.PI / 30;

            var markerStart:Number = c - 30;
            var markerEnd:Number = c - 15;

            var markerX1:Number, markerY1:Number, markerX2:Number, markerY2:Number;
            var angle:Number, angleSin:Number, angleCos:Number;

            baseGraphics.endFill();

            var isMajorMarker:Boolean = true;

            for ( i = 0; i < 60; i++ ) {
                // Draw the markers

                angle = uAngle * i;
                angleSin = Math.sin(angle);
                angleCos = Math.cos(angle);

                markerX1 = c + markerStart * angleCos;
                markerY1 = c + markerStart * angleSin;
                markerX2 = c + markerEnd * angleCos;
                markerY2 = c + markerEnd * angleSin;

                if ( i % 5 == 0 ) {
                    baseGraphics.lineStyle(3, 0x000080);
                    isMajorMarker = true;
                }
                else if ( isMajorMarker ) {
                    baseGraphics.lineStyle(1, 0x000080);
                    isMajorMarker = false;
                }

                baseGraphics.moveTo(markerX1, markerY1);
                baseGraphics.lineTo(markerX2, markerY2);
            }

            addChild(base);

            sHand.graphics.lineStyle(2, 0x00BB00);
            sHand.graphics.moveTo(0, 0);
            sHand.graphics.lineTo(0, 40 - c);
            sHand.x = sHand.y = c;

            mHand.graphics.lineStyle(8, 0x444444);
            mHand.graphics.moveTo(0, 0);
            mHand.graphics.lineTo(0, 50 - c);
            mHand.x = mHand.y = c;

            hHand.graphics.lineStyle(8, 0x777777);
            hHand.graphics.moveTo(0, 0);
            hHand.graphics.lineTo(0, 120 - c);
            hHand.x = hHand.y = c;

            hub.graphics.lineStyle(4, 0x664444);
            hub.graphics.beginFill(0xCC9999);
            hub.graphics.drawCircle(c, c, 5);

            _hHand = hHand;
            _mHand = mHand;
            _sHand = sHand;

            addChild(mHand);
            addChild(hHand);
            addChild(sHand);
            addChild(hub);

            var date:Date = new Date();

            // Since millisecond precision is not needed, round it up to the nearest second.
            var seconds:Number = date.seconds + ((date.milliseconds > 500) ? 1 : 0);
            var minutes:Number = date.minutes + seconds / 60;
            var hours:Number = (date.hours + minutes / 60) % 12;

            sHand.rotation = seconds * 6;
            mHand.rotation = minutes * 6;
            hHand.rotation = hours * 30;

            _timer = new Timer(1000);  // 1 second = 1000 ms
            _timer.addEventListener(TimerEvent.TIMER, _onTimerTick);
            _timer.start();

        }

        private function _onTimerTick(e:TimerEvent):void {
            _hHand.rotation += HOUR_HAND_CHANGE;
            _mHand.rotation += MINUTE_HAND_CHANGE;
            _sHand.rotation += SECOND_HAND_CHANGE;
        }

    }

}


\\ Simple "cuboid". Try different parameters of this Cuboid() function.
\\ 4/11/16 aev
Cuboid(a,b,c,u=10)={
my(dx,dy,ttl="Cuboid AxBxC: ",size=200,da=a*u,db=b*u,dc=c*u);
print(" *** ",ttl,a,"x",b,"x",c,"; u=",u);
plotinit(0);
plotscale(0, 0,size, 0,size);
plotcolor(0,7); \\grey
plotmove(0, 0,0);
plotrline(0,dc,da\2); plotrline(0,db,0); plotrline(0,-db,0);
plotrline(0,0,da);
plotcolor(0,2); \\black
plotmove(0, db,da);
plotrline(0,0,-da); plotrline(0,-db,0);
plotrline(0,0,da); plotrline(0,db,0);
plotrline(0,dc,da\2); plotrline(0,-db,0); plotrline(0,-dc,-da\2);
plotmove(0, db,0);
plotrline(0,dc,da\2); plotrline(0,0,da);
plotdraw([0,size,size]);
}

{\\ Executing:
Cuboid(2,3,4,20); \\Cuboid1.png
Cuboid(5,3,1,20); \\Cuboid2.png
}


// version 1.0.6

const val shades = ".:!*oe&#%@"
val light  = doubleArrayOf(30.0, 30.0, -50.0)

fun normalize(v: DoubleArray) {
    val len = Math.sqrt(v[0] * v[0] + v[1] * v[1] + v[2] * v[2])
    v[0] /= len; v[1] /= len; v[2] /= len
}

fun dot(x: DoubleArray, y: DoubleArray): Double {
    val d = x[0] * y[0] + x[1] * y[1] + x[2] * y[2]
    return if (d < 0.0) -d else 0.0
}

fun drawSphere(r: Double, k: Double, ambient: Double) {
    val vec = DoubleArray(3)
    var intensity: Int
    var b : Double
    var x: Double
    var y: Double
    for (i in Math.floor(-r).toInt() .. Math.ceil(r).toInt()) {
        x = i + 0.5
        for (j in Math.floor(-2.0 * r).toInt() .. Math.ceil(2.0 * r).toInt()) {
            y = j / 2.0 + 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)
                b = Math.pow(dot(light, vec), k) + ambient
                intensity = ((1.0 - b) * (shades.length - 1)).toInt()
                if (intensity < 0) intensity = 0
                if (intensity >= shades.length - 1) intensity = shades.length - 2
                print(shades[intensity])
            }
            else print(' ')
        }
        println()
    }
}

fun main(args: Array<String>) {
    normalize(light)
    drawSphere(20.0, 4.0, 0.1)
    drawSphere(10.0, 2.0, 0.4)
}


with Ada.Numerics.Elementary_Functions;
with Ada.Calendar.Formatting;
with Ada.Calendar.Time_Zones;

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

procedure Draw_A_Clock is
   use Ada.Calendar;
   use Ada.Calendar.Formatting;
   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;
   Event    : SDL.Events.Events.Events;
   Offset   : Time_Zones.Time_Offset;

   procedure Draw_Clock (Stamp : Time)
   is
      use SDL.C;
      use Ada.Numerics.Elementary_Functions;
      Radi : constant array (0 .. 59) of int := (0 | 15 | 30 | 45 => 2,
                                                 5 | 10 | 20 | 25 | 35 | 40 | 50 | 55 => 1,
                                                 others => 0);
      Diam : constant array (0 .. 59) of int := (0 | 15 | 30 | 45 => 5,
                                                 5 | 10 | 20 | 25 | 35 | 40 | 50 | 55 => 3,
                                                 others => 1);
      Width  : constant int   := Window.Get_Surface.Size.Width;
      Height : constant int   := Window.Get_Surface.Size.Height;
      Radius : constant Float := Float (int'Min (Width, Height));
      R_1    : constant Float := 0.48 * Radius;
      R_2    : constant Float := 0.35 * Radius;
      R_3    : constant Float := 0.45 * Radius;
      R_4    : constant Float := 0.47 * Radius;
      Hour   : constant Hour_Number   := Formatting.Hour   (Stamp, Offset);
      Minute : constant Minute_Number := Formatting.Minute (Stamp, Offset);
      Second : constant Second_Number := Formatting.Second (Stamp);

      function To_X (A : Float; R : Float) return int is
         (Width / 2 + int (R * Sin (A, 60.0)));

      function To_Y (A : Float; R : Float) return int is
         (Height / 2 - int (R * Cos (A, 60.0)));

   begin
      SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
      Renderer.Set_Draw_Colour ((0, 0, 150, 255));
      Renderer.Fill (Rectangle => (0, 0, Width, Height));
      Renderer.Set_Draw_Colour ((200, 200, 200, 255));
      for A in 0 .. 59 loop
         Renderer.Fill (Rectangle => (To_X (Float (A), R_1) - Radi (A),
                                      To_Y (Float (A), R_1) - Radi (A), Diam (A), Diam (A)));
      end loop;
      Renderer.Set_Draw_Colour ((200, 200, 0, 255));
      Renderer.Draw (Line => ((Width / 2, Height / 2),
                              (To_X (5.0 * (Float (Hour) + Float (Minute) / 60.0), R_2),
                               To_Y (5.0 * (Float (Hour) + Float (Minute) / 60.0), R_2))));
      Renderer.Draw (Line => ((Width / 2, Height / 2),
                              (To_X (Float (Minute) + Float (Second) / 60.0, R_3),
                               To_Y (Float (Minute) + Float (Second) / 60.0, R_3))));
      Renderer.Set_Draw_Colour ((220, 0, 0, 255));
      Renderer.Draw (Line => ((Width / 2, Height / 2),
                              (To_X (Float (Second), R_4),
                               To_Y (Float (Second), R_4))));
      Renderer.Fill (Rectangle => (Width / 2 - 3, Height / 2 - 3, 7, 7));
   end Draw_Clock;

   function Poll_Quit return Boolean is
      use type SDL.Events.Event_Types;
   begin
      while SDL.Events.Events.Poll (Event) loop
         if Event.Common.Event_Type = SDL.Events.Quit then
            return True;
         end if;
      end loop;
      return False;
   end Poll_Quit;

begin
   Offset := Time_Zones.UTC_Time_Offset;

   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Draw a clock",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(300, 300),
                                    Flags    => SDL.Video.Windows.Resizable);
   loop
      Draw_Clock (Clock);
      Window.Update_Surface;
      delay 0.200;
      exit when Poll_Quit;
   end loop;

   Window.Finalize;
   SDL.Finalise;
end Draw_A_Clock;


program Cuboid_Demo(output);

procedure DoCuboid(sWidth, sHeight, Depth: integer);
  const
    widthScale  = 4;
    heightScale = 3;
  type
    TPage = array of array of char;
  var
    Cuboid: TPage;
    i, j: integer;
    Width, Height: integer;
    totalWidth, totalHeight: integer;
  begin
    Width  := widthScale  * sWidth;
    Height := heightScale * sHeight;
    totalWidth  := 2 * Width + Depth + 3;
    totalHeight := Height + Depth + 3;
    setlength (Cuboid, totalHeight + 1);
    for i := 1 to totalHeight do
      setlength (Cuboid[i], totalwidth + 1);
    // points
    for i := low(Cuboid) to high(Cuboid) do
      for j := low(Cuboid[i]) to high(Cuboid[i]) do
        Cuboid[i,j] := ' ';
    Cuboid [1, 1]                      := '+';
    Cuboid [Height + 2, 1]             := '+';
    Cuboid [1, 2 * Width + 2]          := '+';
    Cuboid [Height + 2, 2 * Width + 2] := '+';
    Cuboid [totalHeight, Depth + 2]    := '+';
    Cuboid [Depth + 2, totalWidth]     := '+';
    Cuboid [totalHeight, totalWidth]   := '+';
    // width lines
    for I := 1 to 2 * Width do
    begin
       Cuboid [1, I + 1]                   := '-';
       Cuboid [Height + 2, I + 1]          := '-';
       Cuboid [totalHeight, Depth + I + 2] := '-';
    end;
    // height lines
    for I := 1 to Height do
    begin
       Cuboid [I + 1, 1]                  := '|';
       Cuboid [I + 1, 2 * Width + 2]      := '|';
       Cuboid [Depth + I + 2, totalWidth] := '|';
    end;
    // depth lines
    for I := 1 to Depth do
    begin
       Cuboid [Height + 2 + I, 1 + I]             := '/';
       Cuboid [1 + I, 2 * Width + 2 + I]          := '/';
       Cuboid [Height + 2 + I, 2 * Width + 2 + I] := '/';
    end;
    for i := high(Cuboid) downto 1 do
    begin
      for j := 1 to high(Cuboid[i]) do
        write (Cuboid[i,j]);
      writeln;
    end;
  end;

begin
  writeln('1, 1, 1:');
  DoCuboid(1, 1, 1);
  writeln('2, 3, 4:');
  DoCuboid(2, 3, 4);
  writeln('6, 2, 1:');
  DoCuboid(6, 2, 1);
end.


----------------------------------------
-- Draw a circle
-- @param {image} img
-- @param {integer} x
-- @param {integer} y
-- @param {integer} r
-- @param {integer} lineSize
-- @param {color} drawColor
----------------------------------------
on circle (img, x, y, r, lineSize, drawColor)
  props = [:]
  props[#shapeType] = #oval
  props[#lineSize] = lineSize
  props[#color] = drawColor
  img.draw(x-r, y-r, x+r, y+r, props)
end


to sphere :r
cs perspective ht ;making the room ready to use
repeat 180 [polystart circle :r polyend down 1]
polyview
end


; gdi+ ahk analogue clock example written by derRaphael
; Parts based on examples from Tic's GDI+ Tutorials and of course on his GDIP.ahk

; This code has been licensed under the terms of EUPL 1.0

#SingleInstance, Force
#NoEnv
SetBatchLines, -1

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

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

SysGet, MonitorPrimary, MonitorPrimary
SysGet, WA, MonitorWorkArea, %MonitorPrimary%
WAWidth := WARight-WALeft
WAHeight := WABottom-WATop

Gui, 1: -Caption +E0x80000 +LastFound +AlwaysOnTop +ToolWindow +OwnDialogs
Gui, 1: Show, NA
hwnd1 := WinExist()

ClockDiameter := 180
Width := Height := ClockDiameter + 2         ; make width and height slightly bigger to avoid cut away edges
CenterX := CenterY := floor(ClockDiameter/2) ; Center x

; Prepare our pGraphic so we have a 'canvas' to work upon
   hbm := CreateDIBSection(Width, Height), hdc := CreateCompatibleDC()
   obm := SelectObject(hdc, hbm), G := Gdip_GraphicsFromHDC(hdc)
   Gdip_SetSmoothingMode(G, 4)

; Draw outer circle
   Diameter := ClockDiameter
   pBrush := Gdip_BrushCreateSolid(0x66008000)
   Gdip_FillEllipse(G, pBrush, CenterX-(Diameter//2), CenterY-(Diameter//2),Diameter, Diameter)
   Gdip_DeleteBrush(pBrush)

; Draw inner circle
   Diameter := ceil(ClockDiameter - ClockDiameter*0.08)  ; inner circle is 8 % smaller than clock's diameter
   pBrush := Gdip_BrushCreateSolid(0x80008000)
   Gdip_FillEllipse(G, pBrush, CenterX-(Diameter//2), CenterY-(Diameter//2),Diameter, Diameter)
   Gdip_DeleteBrush(pBrush)

; Draw Second Marks
   R1 := Diameter//2-1                        ; outer position
   R2 := Diameter//2-1-ceil(Diameter//2*0.05) ; inner position
   Items := 60                                ; we have 60 seconds
   pPen := Gdip_CreatePen(0xff00a000, floor((ClockDiameter/100)*1.2)) ; 1.2 % of total diameter is our pen width
   GoSub, DrawClockMarks
   Gdip_DeletePen(pPen)

; Draw Hour Marks
   R1 := Diameter//2-1                       ; outer position
   R2 := Diameter//2-1-ceil(Diameter//2*0.1) ; inner position
   Items := 12                               ; we have 12 hours
   pPen := Gdip_CreatePen(0xc0008000, ceil((ClockDiameter//100)*2.3)) ; 2.3 % of total diameter is our pen width
   GoSub, DrawClockMarks
   Gdip_DeletePen(pPen)

   ; The OnMessage will let us drag the clock
   OnMessage(0x201, "WM_LBUTTONDOWN")
   UpdateLayeredWindow(hwnd1, hdc, WALeft+((WAWidth-Width)//2), WATop+((WAHeight-Height)//2), Width, Height)
   SetTimer, sec, 1000

sec:
; prepare to empty previously drawn stuff
   Gdip_SetSmoothingMode(G, 1)   ; turn off aliasing
   Gdip_SetCompositingMode(G, 1) ; set to overdraw

; delete previous graphic and redraw background
   Diameter := ceil(ClockDiameter - ClockDiameter*0.18)  ; 18 % less than clock's outer diameter

   ; delete whatever has been drawn here
   pBrush := Gdip_BrushCreateSolid(0x00000000) ; fully transparent brush 'eraser'
   Gdip_FillEllipse(G, pBrush, CenterX-(Diameter//2), CenterY-(Diameter//2),Diameter, Diameter)
   Gdip_DeleteBrush(pBrush)

   Gdip_SetCompositingMode(G, 0) ; switch off overdraw
   pBrush := Gdip_BrushCreateSolid(0x66008000)
   Gdip_FillEllipse(G, pBrush, CenterX-(Diameter//2), CenterY-(Diameter//2),Diameter, Diameter)
   Gdip_DeleteBrush(pBrush)
   pBrush := Gdip_BrushCreateSolid(0x80008000)
   Gdip_FillEllipse(G, pBrush, CenterX-(Diameter//2), CenterY-(Diameter//2),Diameter, Diameter)
   Gdip_DeleteBrush(pBrush)

; Draw HoursPointer
   Gdip_SetSmoothingMode(G, 4)   ; turn on antialiasing
   t := A_Hour*360//12 + (A_Min*360//60)//12 +90
   R1 := ClockDiameter//2-ceil((ClockDiameter//2)*0.5) ; outer position
   pPen := Gdip_CreatePen(0xa0008000, floor((ClockDiameter/100)*3.5))
   Gdip_DrawLine(G, pPen, CenterX, CenterY
      , ceil(CenterX - (R1 * Cos(t * Atan(1) * 4 / 180)))
      , ceil(CenterY - (R1 * Sin(t * Atan(1) * 4 / 180))))
   Gdip_DeletePen(pPen)

; Draw MinutesPointer
   t := A_Min*360//60+90
   R1 := ClockDiameter//2-ceil((ClockDiameter//2)*0.25) ; outer position
   pPen := Gdip_CreatePen(0xa0008000, floor((ClockDiameter/100)*2.7))
   Gdip_DrawLine(G, pPen, CenterX, CenterY
      , ceil(CenterX - (R1 * Cos(t * Atan(1) * 4 / 180)))
      , ceil(CenterY - (R1 * Sin(t * Atan(1) * 4 / 180))))
   Gdip_DeletePen(pPen)

; Draw SecondsPointer
   t := A_Sec*360//60+90
   R1 := ClockDiameter//2-ceil((ClockDiameter//2)*0.2) ; outer position
   pPen := Gdip_CreatePen(0xa000FF00, floor((ClockDiameter/100)*1.2))
   Gdip_DrawLine(G, pPen, CenterX, CenterY
      , ceil(CenterX - (R1 * Cos(t * Atan(1) * 4 / 180)))
      , ceil(CenterY - (R1 * Sin(t * Atan(1) * 4 / 180))))
   Gdip_DeletePen(pPen)

   UpdateLayeredWindow(hwnd1, hdc) ;, xPos, yPos, ClockDiameter, ClockDiameter)
return

DrawClockMarks:
   Loop, % Items
      Gdip_DrawLine(G, pPen
         , CenterX - ceil(R1 * Cos(((a_index-1)*360//Items) * Atan(1) * 4 / 180))
         , CenterY - ceil(R1 * Sin(((a_index-1)*360//Items) * Atan(1) * 4 / 180))
         , CenterX - ceil(R2 * Cos(((a_index-1)*360//Items) * Atan(1) * 4 / 180))
         , CenterY - ceil(R2 * Sin(((a_index-1)*360//Items) * Atan(1) * 4 / 180)) )
return

WM_LBUTTONDOWN() {
   PostMessage, 0xA1, 2
   return
}

esc::
Exit:
   SelectObject(hdc, obm)
   DeleteObject(hbm)
   DeleteDC(hdc)
   Gdip_DeleteGraphics(G)
   Gdip_Shutdown(pToken)
   ExitApp
Return


require ("math")

shades = {'.', ':', '!', '*', 'o', 'e', '&', '#', '%', '@'}

function normalize (vec)
    len = math.sqrt(vec[1]^2 + vec[2]^2 + vec[3]^2)
    return {vec[1]/len, vec[2]/len, vec[3]/len}
end

light = normalize{30, 30, -50}

function dot (vec1, vec2)
    d = vec1[1]*vec2[1] + vec1[2]*vec2[2] + vec1[3]*vec2[3]
    return d < 0 and -d or 0
end

function draw_sphere (radius, k, ambient)
    for i = math.floor(-radius),-math.floor(-radius) do
        x = i + .5
        local line = ''
        for j = math.floor(-2*radius),-math.floor(-2*radius) do
            y = j / 2 + .5
            if x^2 + y^2 <= radius^2 then
                vec = normalize{x, y, math.sqrt(radius^2 - x^2 - y^2)}
                b = dot(light,vec) ^ k + ambient
                intensity = math.floor ((1 - b) * #shades)
                line = line .. (shades[intensity] or shades[1])
            else
                line = line .. ' '
            end
        end
        print (line)
    end
end

draw_sphere (20, 4, 0.1)
draw_sphere (10, 2, 0.4)


--
-- demo\rosetta\draw_cuboid.exw
-- ============================
--
-- Author Pete Lomax, August 2015
--  Translated from XPL0.
--  Ported to pGUI August 2017
--
--  Press space to toggle auto-rotate on and off,
--        cursor keys to rotate manually, and
--        +/- to zoom in/out.
--
--  Note this uses simple orthogonal projection;
--            there is no perspective here!
--            (For that see DrawRotatingCube.exw)
--
with javascript_semantics
include pGUI.e

constant title = "Draw Cuboid"
Ihandle dlg, canvas, hTimer
cdCanvas cd_canvas

-- arrays: 3D coordinates of vertices
sequence x = {-2.0, +2.0, +2.0, -2.0,  -2.0, +2.0, +2.0, -2.0},
         y = {-1.5, -1.5, +1.5, +1.5,  -1.5, -1.5, +1.5, +1.5},
         z = {-1.0, -1.0, -1.0, -1.0,  +1.0, +1.0, +1.0, +1.0}

constant segments = {{1,2}, {2,3}, {3,4}, {4,1}, {5,6}, {6,7},
                     {7,8}, {8,5}, {1,5}, {2,6}, {3,7}, {4,8}}

atom Size = 50.0,       -- drawing size
     Sz = 0.008,        -- tumbling speeds
     Sx =-0.013,        -- ""
     Sy = 0.005,        -- ""
     S = 2

procedure draw_cube(integer cx, cy)
    -- {cx,cy} is the centre point of the canvas
    integer farthest = largest(z,true)
    for s=1 to length(segments) do
        integer {va,vb} = segments[s],
                  bNear = not find(farthest,segments[s])
        cdCanvasSetForeground(cd_canvas, iff(bNear?CD_RED:CD_BLUE))
        cdCanvasSetLineStyle(cd_canvas, iff(bNear?CD_CONTINUOUS:CD_DASHED))
        atom x1 = x[va]*Size+cx,
             y1 = y[va]*Size+cy,
             x2 = x[vb]*Size+cx,
             y2 = y[vb]*Size+cy
        cdCanvasLine(cd_canvas,x1,y1,x2,y2)
    end for
end procedure

function canvas_action_cb(Ihandle canvas)
    cdCanvasActivate(cd_canvas)
    cdCanvasClear(cd_canvas)
    integer {w, h} = IupGetIntInt(canvas, "DRAWSIZE")
    draw_cube(floor(w/2),floor(h/2))
    cdCanvasFlush(cd_canvas)
    return IUP_DEFAULT
end function

function canvas_map_cb(Ihandle canvas)
    IupGLMakeCurrent(canvas)
    if platform()=JS then
        cd_canvas = cdCreateCanvas(CD_IUP, canvas)
    else
        atom res = IupGetDouble(NULL, "SCREENDPI")/25.4
        cd_canvas = cdCreateCanvas(CD_GL, "10x10 %g", {res})
    end if
--  cdCanvasSetBackground(cd_canvas, CD_PARCHMENT)
    cdCanvasSetBackground(cd_canvas, CD_BLACK)
    return IUP_DEFAULT
end function

function canvas_unmap_cb(Ihandle canvas)
    cdKillCanvas(cd_canvas)
    return IUP_DEFAULT
end function

function canvas_resize_cb(Ihandle /*canvas*/)
    integer {canvas_width, canvas_height} = IupGetIntInt(canvas, "DRAWSIZE")
    atom res = IupGetDouble(NULL, "SCREENDPI")/25.4
    cdCanvasSetAttribute(cd_canvas, "SIZE", "%dx%d %g", {canvas_width, canvas_height, res})
    return IUP_DEFAULT
end function

function key_cb(Ihandle /*ih*/, atom c)
    if c=K_ESC then
        return IUP_CLOSE
    elsif c=K_UP then
        for i=1 to 8 do
            y[i] += z[i]*Sx*S   -- rotate vertices in Y-Z plane
            z[i] -= y[i]*Sx*S
        end for
    elsif c=K_DOWN then
        for i=1 to 8 do
            y[i] -= z[i]*Sx*S   -- rotate vertices in Y-Z plane
            z[i] += y[i]*Sx*S
        end for
    elsif c=K_LEFT then
        for i=1 to 8 do
            x[i] += z[i]*Sy*S   -- rotate vertices in X-Z plane
            z[i] -= x[i]*Sy*S
        end for
    elsif c=K_RIGHT then
        for i=1 to 8 do
            x[i] -= z[i]*Sy*S   -- rotate vertices in X-Z plane
            z[i] += x[i]*Sy*S
        end for
    elsif c='+' then
        Size = min(500,Size+5)
    elsif c='-' then
        Size = max( 10,Size-5)
    elsif c=' ' then
        IupSetInt(hTimer,"RUN",not IupGetInt(hTimer,"RUN"))
    end if
    IupUpdate(canvas)
    return IUP_CONTINUE
end function

function timer_cb(Ihandle /*ih*/)
    for i=1 to 8 do
        x[i] = x[i]+y[i]*Sz*S   -- rotate vertices in X-Y plane
        y[i] = y[i]-x[i]*Sz*S
        y[i] = y[i]+z[i]*Sx*S   -- rotate vertices in Y-Z plane
        z[i] = z[i]-y[i]*Sx*S
        x[i] = x[i]+z[i]*Sy*S   -- rotate vertices in X-Z plane
        z[i] = z[i]-x[i]*Sy*S
    end for
    IupUpdate(canvas)
    return IUP_IGNORE
end function

procedure main()
    IupOpen()
    canvas = IupGLCanvas("RASTERSIZE=640x480")
    IupSetCallbacks(canvas, {"ACTION", Icallback("canvas_action_cb"),
                             "MAP_CB", Icallback("canvas_map_cb"),
                             "UNMAP_CB", Icallback("canvas_unmap_cb"),
                             "RESIZE_CB", Icallback("canvas_resize_cb")})
--  dlg = IupDialog(IupVbox({canvas}),`TITLE="%s"`,{title})
    dlg = IupDialog(canvas,`TITLE="%s"`,{title})
    IupSetCallback(dlg, "KEY_CB",  Icallback("key_cb"))
    IupShow(dlg)
    IupSetAttribute(canvas, "RASTERSIZE", NULL)
    hTimer = IupTimer(Icallback("timer_cb"), 40)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


Module CheckIt {
      Er$="Pset is a new statement"
      If Version<9.4 Then Error Er$
      If Version=9.4 then If revision<26 then Error Er$
      Form 60, 40
      Cls 0 ' Black
      Gradient 0,1
      Pen 14 ' Yellow
      Set Fast !
      Refresh 500
      Module Sphere (R as long, X0 as long, Y0 as long, fun){
            R2 = R * R
            Def Long X, Y, D2
            Let Scale=twipsx/R*13.5
            For Y = -R To R  step twipsx  {
            Move X0-R, Y+Y0
            For X = -R To R step twipsy  {
                  D2 = X **2 + Y **2
                  IF R2>D2 THEN Pset Fun(Max.Data(Min.Data((Sqrt(R2 - D2) - ( X + Y) / 2 )*Scale ,255),0))
                  Step twipsx
            }
            }
      }
      Blue=lambda (c)->{
            c1=c/4+192
            =Color(c,c,c1)
      }
      Blue1=lambda (c)->{
            c1=c/4+Random(150,192)
            =Color(c,c,c1)
      }
      Mystery=lambda m=1 (c)->{
            c1=c/4+m
            m+=10
            if m>192 then m=1
            =Color(c,c,c1)
      }
      Mystery2=lambda m=1, p=true  (c)->{
            c1=c/4+m
           if p then m+=10
           Else m=-10
            if m>192 then m-=10 : p=false
            If m<0 then m+=10: p=true
            =Color(c,c,c1)
      }
      Buffer Alfa as byte*8
      Trans =lambda  Alfa (c) -> {
            Return Alfa, 0:=-point as long
            Return Alfa, 4:=-color(c,c, c/4+192) as long
            for i=0 to 2: Return Alfa, i:=(Eval(Alfa, i)+Eval(Alfa, i+4))/2: Next i
            =-Eval(Alfa, 0 as long)
      }
      Sphere 2400, 9000,7000, Blue
      Sphere 800, 6000, 7000, Blue1
      Sphere 1200, 5000,5000, Mystery
      Sphere 1200, 10000,6000, Mystery2
      Sphere 1200, 8000,5000, trans
}
Checkit


plots[display](plottools[sphere](), axes = none, style = surface);


xp=320:yp=95:size=150
CIRCLE (xp,yp),size,,,,.5
lasth=0:lastm=0:lasts=0
hs=.25*size:ms=.45*size:ss=ms
pi=3.141592

FOR i=1 TO 12
  w=2*i*pi/12
  CIRCLE (xp+size*SIN(w),yp+size/2*COS(w)),size/15
NEXT

ON TIMER(1) GOSUB Clock
TIMER ON

loop: GOTO loop

Clock:
  t$=TIME$
  h=VAL(MID$(t$,1,2))
  m=VAL(MID$(t$,4,2))
  s=VAL(MID$(t$,7,2))
  LOCATE 1,1:PRINT t$
  LINE (xp,yp)-(xp+2*hs*SIN(lasth),yp-hs*COS(lasth)),0
  LINE (xp,yp)-(xp+2*ms*SIN(lastm),yp-ms*COS(lastm)),0
  LINE (xp,yp)-(xp+2*ss*SIN(lasts),yp-ss*COS(lasts)),0
  lasth=2*pi*(h/12+m/720)
  lastm=2*pi*m/60
  lasts=2*pi*s/60
  LINE (xp,yp)-(xp+2*hs*SIN(lasth),yp-hs*COS(lasth)),1
  LINE (xp,yp)-(xp+2*ms*SIN(lastm),yp-ms*COS(lastm)),1
  LINE (xp,yp)-(xp+2*ss*SIN(lasts),yp-ss*COS(lasts)),2
  RETURN


::Draw a Clock Task from Rosetta Code Wiki
::Batch File Implementation
::
::Directly open the Batch File...
@echo off & mode 44,8
title Sample Batch Clock
setlocal enabledelayedexpansion
chcp 65001

	::Set the characters...
set "#0_1=█████"
set "#0_2=█   █"
set "#0_3=█   █"
set "#0_4=█   █"
set "#0_5=█████"

set "#1_1=    █"
set "#1_2=    █"
set "#1_3=    █"
set "#1_4=    █"
set "#1_5=    █"

set "#2_1=█████"
set "#2_2=    █"
set "#2_3=█████"
set "#2_4=█    "
set "#2_5=█████"

set "#3_1=█████"
set "#3_2=    █"
set "#3_3=█████"
set "#3_4=    █"
set "#3_5=█████"

set "#4_1=█   █"
set "#4_2=█   █"
set "#4_3=█████"
set "#4_4=    █"
set "#4_5=    █"

set "#5_1=█████"
set "#5_2=█    "
set "#5_3=█████"
set "#5_4=    █"
set "#5_5=█████"

set "#6_1=█████"
set "#6_2=█    "
set "#6_3=█████"
set "#6_4=█   █"
set "#6_5=█████"

set "#7_1=█████"
set "#7_2=    █"
set "#7_3=    █"
set "#7_4=    █"
set "#7_5=    █"

set "#8_1=█████"
set "#8_2=█   █"
set "#8_3=█████"
set "#8_4=█   █"
set "#8_5=█████"

set "#9_1=█████"
set "#9_2=█   █"
set "#9_3=█████"
set "#9_4=    █"
set "#9_5=█████"

set "#C_1= "
set "#C_2=█"
set "#C_3= "
set "#C_4=█"
set "#C_5= "

:clock_loop
	::Clear display [leaving a whitespace]...
for /l %%C in (1,1,5) do set "display%%C= "

	::Get current time [all spaces will be replaced to zero]...
	::Also, all colons will be replaced to "C" because colon has a function in variables...
set "curr_time=%time: =0%"
set "curr_time=%curr_time::=C%"

	::Process the numbers to display [we will now use the formats we SET above]...
for /l %%T in (0,1,7) do (
	::Check for each number and colons...
	for %%N in (0 1 2 3 4 5 6 7 8 9 C) do (
		if "!curr_time:~%%T,1!"=="%%N" (
			::Now, barbeque each formatted char in 5 rows...
			for /l %%D in (1,1,5) do set "display%%D=!display%%D!!#%%N_%%D! "
		)
	)
)

	::Refresh the clock...
cls
echo.
echo.[%display1%]
echo.[%display2%]
echo.[%display3%]
echo.[%display4%]
echo.[%display5%]
echo.
timeout /t 1 /nobreak >nul
goto :clock_loop


(de cuboid (DX DY DZ)
   (cubLine (inc DY) "+" DX "-" 0)
   (for I DY
      (cubLine (- DY I -1) "/" DX " " (dec I) "|") )
   (cubLine 0 "+" DX "-" DY "|")
   (do (- (* 4 DZ) DY 2)
      (cubLine 0 "|" DX " " DY "|") )
   (cubLine 0 "|" DX " " DY "+")
   (for I DY
      (cubLine 0 "|" DX " " (- DY I) "/") )
   (cubLine 0 "+" DX "-" 0) )

(de cubLine (N C DX D DY E)
   (space N)
   (prin C)
   (do (dec (* 9 DX)) (prin D))
   (prin C)
   (space DY)
   (prinl E) )


camera { perspective location <2.6,2.2,-4.2> look_at <0,-.5,0>
       aperture .05 blur_samples 100 variance 1/100000 focal_point <2,1,-2>}

light_source{< 60,20,-20> color rgb 2}

sky_sphere { pigment{ gradient z color_map{[0 rgb 0.3][.1 rgb <.7,.8,1>][1 rgb .2]} }}

box { <0,0,0> <3,2,4>
  texture {
    pigment{ agate }
    normal { checker }
    finish { reflection {0.20 metallic 0.2} }
  }
  translate <-1,-.5,-2>
}


size(500, 500, P3D);
background(0);
// position
translate(width/2, height/2, -width/2);
rotateZ(radians(15));
rotateY(radians(-30));
rotateX(radians(-25));
// optional fill and lighting colors
noStroke();
fill(192, 255, 192);
pointLight(255, 255, 255, 400, -400, 400);
// draw box
box(200, 300, 400);


#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <time.h>
#include <sys/time.h>

#define PI 3.14159265
const char * shades = " .:-*ca&#%@";

/* distance of (x, y) from line segment (0, 0)->(x0, y0) */
double dist(double x, double y, double x0, double y0) {
	double l = (x * x0 + y * y0) / (x0 * x0 + y0 * y0);

	if (l > 1) {
		x -= x0;
		y -= y0;
	} else if (l >= 0) {
		x -= l * x0;
		y -= l * y0;
	}
	return sqrt(x * x + y * y);
}

enum { sec = 0, min, hur }; // for subscripts

void draw(int size)
{
#	define for_i for(int i = 0; i < size; i++)
#	define for_j for(int j = 0; j < size * 2; j++)

	double angle, cx = size / 2.;
	double sx[3], sy[3], sw[3];
	double fade[] = { 1, .35, .35 }; /* opacity of each arm */
	struct timeval tv;
	struct tm *t;

	/* set width of each arm */
	sw[sec] = size * .02;
	sw[min] = size * .03;
	sw[hur] = size * .05;

every_second:
	gettimeofday(&tv, 0);
	t = localtime(&tv.tv_sec);

	angle = t->tm_sec * PI / 30;
	sy[sec] = -cx * cos(angle);
	sx[sec] =  cx * sin(angle);

	angle = (t->tm_min + t->tm_sec / 60.) / 30 * PI;
	sy[min] = -cx * cos(angle) * .8;
	sx[min] =  cx * sin(angle) * .8;

	angle = (t->tm_hour + t->tm_min / 60.) / 6 * PI;
	sy[hur] = -cx * cos(angle) * .6;
	sx[hur] =  cx * sin(angle) * .6;

	printf("\033[s"); /* save cursor position */
	for_i {
		printf("\033[%d;0H", i);  /* goto row i, col 0 */
		double y = i - cx;
		for_j {
			double x = (j - 2 * cx) / 2;

			int pix = 0;
			/* calcs how far the "pixel" is from each arm and set
			 * shade, with some anti-aliasing.  It's ghetto, but much
			 * easier than a real scanline conversion.
			 */
			for (int k = hur; k >= sec; k--) {
				double d = dist(x, y, sx[k], sy[k]);
				if (d < sw[k] - .5)
					pix = 10 * fade[k];
				else if (d < sw[k] + .5)
					pix = (5 + (sw[k] - d) * 10) * fade[k];
			}
			putchar(shades[pix]);
		}
	}
	printf("\033[u"); /* restore cursor pos so you can bg the job -- value unclear */

	fflush(stdout);
	sleep(1); /* sleep 1 can at times miss a second, but will catch up next update */
	goto every_second;
}

int main(int argc, char *argv[])
{
	int s;
	if (argc <= 1 || (s = atoi(argv[1])) <= 0) s = 20;
	draw(s);
	return 0;
}


cuboid(D1,D2,D3) :-
	W is D1 * 50,
	H is D2 * 50,
	D is D3 * 50,

	new(C, window(cuboid)),

	% compute the size of the window
	Width is W + ceiling(sqrt(H * 48)) + 50,
	Height is H +  ceiling(sqrt(H * 48)) + 50,
	send(C, size, new(_,size(Width,Height))),

	%compute the top-left corner of the front face of the cuboid
	PX is 25,
	PY is 25 + ceiling(sqrt(H * 48)),

	% colors of the faces
	new(C1, colour(@default, 65535, 0, 0)),
	new(C2, colour(@default, 0, 65535, 0)),
	new(C3, colour(@default, 0, 0, 65535)),

	% the front face
	new(B1, box(W, H)),
	send(B1, fill_pattern, C1),
	send(C, display,B1, point(PX, PY)),

	% the top face
	new(B2, hpara(point(PX,PY), W, D, C2)),
	send(C, display, B2),

	% the left face
	PX1 is PX + W,
	new(B3, vpara(point(PX1,PY), H, D, C3)),
	send(C, display, B3),

	send(C, open).

:- pce_begin_class(hpara, path, "drawing of a horizontal parallelogram").

initialise(P, Pos, Width, Height, Color) :->
	send(P, send_super, initialise),
	send(P, append, Pos),
	H is ceiling(sqrt(Height * 48)),
	get(Pos, x, X),
	get(Pos, y, Y),
	X1 is X + H,
	Y1 is Y - H,
	send(P, append, point(X1, Y1)),
	X2 is X1 + Width,
	send(P, append, point(X2, Y1)),
	X3 is X2 - H,
	send(P, append, point(X3, Pos?y)),
	send(P, append, Pos),
	send(P, fill_pattern, Color).

:- pce_end_class.

:- pce_begin_class(vpara, path, "drawing of a vertical parallelogram").

initialise(P, Pos, Height, Depth, Color) :->
	send(P, send_super, initialise),
	send(P, append, Pos),
	H is ceiling(sqrt(Depth * 48)),
	get(Pos, x, X),
	get(Pos, y, Y),
	X1 is X + H,
	Y1 is Y - H,
	send(P, append, point(X1, Y1)),
	Y2 is Y1 + Height,
	send(P, append, point(X1, Y2)),
	Y3 is Y2 + H,
	send(P, append, point(X, Y3)),
	send(P, append, Pos),
	send(P, fill_pattern, Color).

:- pce_end_class.


/* Two solutions */
plot3d(1, [theta, 0, %pi], [phi, 0, 2 * %pi],
[transform_xy, spherical_to_xyz], [grid, 30, 60],
[box, false], [legend, false])$

load(draw)$
draw3d(xu_grid=30, yv_grid=60, surface_hide=true,
   parametric_surface(cos(phi)*sin(theta),
                      sin(phi)*sin(theta),
                      cos(theta),
                      theta, 0, %pi, phi, 0, 2 * %pi))$


import math

type Point = tuple[x,y,z: float]

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

proc normalize(x, y, z: float): Point =
  let len = sqrt(x*x + y*y + z*z)
  (x / len, y / len, z / len)

proc dot(a, b: Point): float =
  result = max(0, - a.x*b.x - a.y*b.y - a.z*b.z)

let light = normalize(30.0, 30.0, -50.0)

proc drawSphere(r: int; k, ambient: float) =
  for i in -r .. r:
    let x = i.float + 0.5
    for j in -2*r .. 2*r:
      let y = j.float / 2.0 + 0.5
      if x*x + y*y <= float r*r:
        let
          v = normalize(x, y, sqrt(float(r*r) - x*x - y*y))
          b = pow(dot(light, v), k) + ambient
          i = clamp(int((1.0 - b) * shades.high.float), 0, shades.high)
        stdout.write shades[i]
      else: stdout.write ' '
    stdout.write "\n"

drawSphere 20, 4.0, 0.1
drawSphere 10, 2.0, 0.4


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

public class Clock : Form
{
    static readonly float degrees06 = (float)Math.PI / 30;
    static readonly float degrees30 = degrees06 * 5;
    static readonly float degrees90 = degrees30 * 3;

    readonly int margin = 20;

    private Point p0;

    public Clock()
    {
        Size = new Size(500, 500);
        StartPosition = FormStartPosition.CenterScreen;
        Resize += (sender, args) => ResetSize();
        ResetSize();
        var timer = new Timer() { Interval = 1000, Enabled = true };
        timer.Tick += (sender, e) => Refresh();
        DoubleBuffered = true;
    }

    private void ResetSize()
    {
        p0 = new Point(ClientRectangle.Width / 2, ClientRectangle.Height / 2);
        Refresh();
    }

    protected override void OnPaint(PaintEventArgs e)
    {
        base.OnPaint(e);
        e.Graphics.SmoothingMode = SmoothingMode.AntiAlias;

        drawFace(e.Graphics);

        var time = DateTime.Now;
        int second = time.Second;
        int minute = time.Minute;
        int hour = time.Hour;

        float angle = degrees90 - (degrees06 * second);
        DrawHand(e.Graphics, Pens.Red, angle, 0.95);

        float minsecs = (minute + second / 60.0F);
        angle = degrees90 - (degrees06 * minsecs);
        DrawHand(e.Graphics, Pens.Black, angle, 0.9);

        float hourmins = (hour + minsecs / 60.0F);
        angle = degrees90 - (degrees30 * hourmins);
        DrawHand(e.Graphics, Pens.Black, angle, 0.6);
    }

    private void drawFace(Graphics g)
    {
        int radius = Math.Min(p0.X, p0.Y) - margin;
        g.FillEllipse(Brushes.White, p0.X - radius, p0.Y - radius, radius * 2, radius * 2);

        for (int h = 0; h < 12; h++)
            DrawHand(g, Pens.LightGray, h * degrees30, -0.05);

        for (int m = 0; m < 60; m++)
            DrawHand(g, Pens.LightGray, m * degrees06, -0.025);
    }

    private void DrawHand(Graphics g, Pen pen, float angle, double size)
    {
        int radius = Math.Min(p0.X, p0.Y) - margin;

        int x0 = p0.X + (size > 0 ? 0 : Convert.ToInt32(radius * (1 + size) * Math.Cos(angle)));
        int y0 = p0.Y + (size > 0 ? 0 : Convert.ToInt32(radius * (1 + size) * Math.Sin(-angle)));

        int x1 = p0.X + Convert.ToInt32(radius * (size > 0 ? size : 1) * Math.Cos(angle));
        int y1 = p0.Y + Convert.ToInt32(radius * (size > 0 ? size : 1) * Math.Sin(-angle));

        g.DrawLine(pen, x0, y0, x1, y1);
    }

    [STAThread]
    static void Main()
    {
        Application.Run(new Clock());
    }
}


#N canvas 1 51 450 300 10;
#X obj 66 67 gemwin;
#X obj 239 148 cuboid 2 3 4;
#X obj 239 46 gemhead;
#X obj 239 68 scale 0.3;
#X msg 66 45 lighting 1 \, create \, 1;
#X obj 61 118 gemhead;
#X obj 61 140 world_light;
#X msg 294 90 1;
#X obj 239 90 t a b;
#X obj 239 118 accumrotate;
#X connect 2 0 3 0;
#X connect 3 0 8 0;
#X connect 4 0 0 0;
#X connect 5 0 6 0;
#X connect 7 0 9 1;
#X connect 7 0 9 2;
#X connect 7 0 9 3;
#X connect 8 0 9 0;
#X connect 8 1 7 0;
#X connect 9 0 1 0;


Procedure Draw_a_Cuboid(Window, X,Y,Z)
  w=WindowWidth(Window)
  h=WindowHeight(Window)
  diag.f=1.9
  If Not (w And h): ProcedureReturn: EndIf
  xscale.f = w/(x+z/diag)*0.98
  yscale.f = h/(y+z/diag)*0.98
  If xscale<yscale
    Scale.f = xscale
  Else
    Scale = yscale
  EndIf
  x*Scale: Y*Scale: Z*Scale
  CreateImage(0,w,h)
  If StartDrawing(ImageOutput(0))
    c= RGB(250, 40, 5)

    ;- Calculate the cones in the Cuboid
    xk = w/50     : yk = h/50
    x0 = Z/2 + xk : y0 = yk
    x1 = x0 + X   : y1 = y0
    x2 = xk       : y2 = y0 + Z/2
    x3 = x2 + X   : y3 = y2
    x4 = x2       : y4 = y2 + Y
    x5 = x4 + X   : y5 = y4
    x6 = x5 + Z/2 : y6 = y5 - Z/2

    ;- Draw it
    LineXY(x0,y0,x1,y1,c)
    LineXY(x0,y0,x2,y2,c)
    LineXY(x2,y2,x3,y3,c)
    LineXY(x1,y1,x3,y3,c)
    LineXY(x2,y2,x4,y4,c)
    LineXY(x4,y4,x5,y5,c)
    LineXY(x5,y5,x4,y4,c)
    LineXY(x5,y5,x6,y6,c)
    LineXY(x5,y5,x3,y3,c)
    LineXY(x6,y6,x1,y1,c)

    ;- Fill the areas
    FillArea(x,y,-1,RGB(255, 0, 0))
    FillArea(x,y-z/2,-1,RGB(0, 0, 255))
    FillArea(x+z/2,y,-1,RGB(0, 255, 0))
    StopDrawing()
  EndIf
  ;- Update the graphic
  ImageGadget(0,0,0,w,h,ImageID(0))
EndProcedure

#WFlags = #PB_Window_SystemMenu|#PB_Window_SizeGadget
#title  = "PureBasic Cuboid"
MyWin = OpenWindow(#PB_Any, 0, 0, 200, 250, #title, #WFlags)

Repeat
  WEvent = WaitWindowEvent()
  If WEvent = #PB_Event_SizeWindow
    Draw_a_Cuboid(MyWin, 2, 3, 4)
  EndIf
Until WEvent = #PB_Event_CloseWindow

;-  Save the image?
UsePNGImageEncoder()
respons = MessageRequester("Question","Save the image?",#PB_MessageRequester_YesNo)
If respons=#PB_MessageRequester_Yes
  SaveImage(0, SaveFileRequester("","","",0),#PB_ImagePlugin_PNG,9)
EndIf


(import (lib gl))
(import (OpenGL version-1-0))

; init
(glClearColor 0.3 0.3 0.3 1)
(glPolygonMode GL_FRONT_AND_BACK GL_FILL)

(define quadric (gluNewQuadric))

; draw loop
(gl:set-renderer (lambda (mouse)
   (glClear GL_COLOR_BUFFER_BIT)

   (glColor3f 0.7 0.7 0.7)
   (gluSphere quadric 0.4 32 10)
))


// This will produce a sphere of radius 5
sphere(5);


#include <windows.h>
#include <string>
#include <math.h>

//--------------------------------------------------------------------------------------------------
using namespace std;

//--------------------------------------------------------------------------------------------------
const int BMP_SIZE = 300, MY_TIMER = 987654, CENTER = BMP_SIZE >> 1, SEC_LEN = CENTER - 20,
          MIN_LEN = SEC_LEN - 20, HOUR_LEN = MIN_LEN - 20;
const float PI = 3.1415926536f;

//--------------------------------------------------------------------------------------------------
class vector2
{
public:
    vector2() { x = y = 0; }
    vector2( int a, int b ) { x = a; y = b; }
    void set( int a, int b ) { x = a; y = b; }
    void rotate( float angle_r )
    {
	float _x = static_cast<float>( x ),
	      _y = static_cast<float>( y ),
	       s = sinf( angle_r ),
	       c = cosf( angle_r ),
	       a = _x * c - _y * s,
	       b = _x * s + _y * c;

	x = static_cast<int>( a );
	y = static_cast<int>( b );
    }
    int x, y;
};
//--------------------------------------------------------------------------------------------------
class myBitmap
{
public:
    myBitmap() : pen( NULL ), brush( NULL ), clr( 0 ), wid( 1 ) {}
    ~myBitmap()
    {
	DeleteObject( pen );
	DeleteObject( brush );
	DeleteDC( hdc );
	DeleteObject( bmp );
    }

    bool create( int w, int h )
    {
	BITMAPINFO    bi;
	ZeroMemory( &bi, sizeof( bi ) );
	bi.bmiHeader.biSize        = sizeof( bi.bmiHeader );
	bi.bmiHeader.biBitCount    = sizeof( DWORD ) * 8;
	bi.bmiHeader.biCompression = BI_RGB;
	bi.bmiHeader.biPlanes      = 1;
	bi.bmiHeader.biWidth       =  w;
	bi.bmiHeader.biHeight      = -h;

	HDC dc = GetDC( GetConsoleWindow() );
	bmp = CreateDIBSection( dc, &bi, DIB_RGB_COLORS, &pBits, NULL, 0 );
	if( !bmp ) return false;

	hdc = CreateCompatibleDC( dc );
	SelectObject( hdc, bmp );
	ReleaseDC( GetConsoleWindow(), dc );

	width = w; height = h;
	return true;
    }

    void clear( BYTE clr = 0 )
    {
	memset( pBits, clr, width * height * sizeof( DWORD ) );
    }

    void setBrushColor( DWORD bClr )
    {
	if( brush ) DeleteObject( brush );
	brush = CreateSolidBrush( bClr );
	SelectObject( hdc, brush );
    }

    void setPenColor( DWORD c )
    {
	clr = c;
	createPen();
    }

    void setPenWidth( int w )
    {
	wid = w;
	createPen();
    }

    void saveBitmap( string path )
    {
	BITMAPFILEHEADER fileheader;
	BITMAPINFO       infoheader;
	BITMAP           bitmap;
	DWORD            wb;

	GetObject( bmp, sizeof( bitmap ), &bitmap );
	DWORD* dwpBits = new DWORD[bitmap.bmWidth * bitmap.bmHeight];

        ZeroMemory( dwpBits, bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD ) );
	ZeroMemory( &infoheader, sizeof( BITMAPINFO ) );
	ZeroMemory( &fileheader, sizeof( BITMAPFILEHEADER ) );

	infoheader.bmiHeader.biBitCount = sizeof( DWORD ) * 8;
	infoheader.bmiHeader.biCompression = BI_RGB;
	infoheader.bmiHeader.biPlanes = 1;
	infoheader.bmiHeader.biSize = sizeof( infoheader.bmiHeader );
	infoheader.bmiHeader.biHeight = bitmap.bmHeight;
	infoheader.bmiHeader.biWidth = bitmap.bmWidth;
	infoheader.bmiHeader.biSizeImage = bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD );

	fileheader.bfType    = 0x4D42;
	fileheader.bfOffBits = sizeof( infoheader.bmiHeader ) + sizeof( BITMAPFILEHEADER );
	fileheader.bfSize    = fileheader.bfOffBits + infoheader.bmiHeader.biSizeImage;

	GetDIBits( hdc, bmp, 0, height, ( LPVOID )dwpBits, &infoheader, DIB_RGB_COLORS );

	HANDLE file = CreateFile( path.c_str(), GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL );
	WriteFile( file, &fileheader, sizeof( BITMAPFILEHEADER ), &wb, NULL );
	WriteFile( file, &infoheader.bmiHeader, sizeof( infoheader.bmiHeader ), &wb, NULL );
	WriteFile( file, dwpBits, bitmap.bmWidth * bitmap.bmHeight * 4, &wb, NULL );
	CloseHandle( file );

	delete [] dwpBits;
    }

    HDC getDC() const     { return hdc; }
    int getWidth() const  { return width; }
    int getHeight() const { return height; }

private:
    void createPen()
    {
	if( pen ) DeleteObject( pen );
	pen = CreatePen( PS_SOLID, wid, clr );
	SelectObject( hdc, pen );
    }

    HBITMAP bmp;
    HDC     hdc;
    HPEN    pen;
    HBRUSH  brush;
    void    *pBits;
    int     width, height, wid;
    DWORD   clr;
};
//--------------------------------------------------------------------------------------------------
class clock
{
public:
    clock()
    {
	_bmp.create( BMP_SIZE, BMP_SIZE );
	_bmp.clear( 100 );
	_bmp.setPenWidth( 2 );
	_ang = DegToRadian( 6 );
    }

    void setNow()
    {
	GetLocalTime( &_sysTime );
	draw();
    }

    float DegToRadian( float degree ) { return degree * ( PI / 180.0f ); }

    void setHWND( HWND hwnd ) { _hwnd = hwnd; }

private:
    void drawTicks( HDC dc )
    {
	vector2 line;
	_bmp.setPenWidth( 1 );
	for( int x = 0; x < 60; x++ )
	{
	    line.set( 0, 50 );
	    line.rotate( static_cast<float>( x + 30 ) * _ang );
	    MoveToEx( dc, CENTER - static_cast<int>( 2.5f * static_cast<float>( line.x ) ), CENTER - static_cast<int>( 2.5f * static_cast<float>( line.y ) ), NULL );
	    LineTo( dc, CENTER - static_cast<int>( 2.81f * static_cast<float>( line.x ) ), CENTER - static_cast<int>( 2.81f * static_cast<float>( line.y ) ) );
	}

	_bmp.setPenWidth( 3 );
	for( int x = 0; x < 60; x += 5 )
	{
	    line.set( 0, 50 );
	    line.rotate( static_cast<float>( x + 30 ) * _ang );
	    MoveToEx( dc, CENTER - static_cast<int>( 2.5f * static_cast<float>( line.x ) ), CENTER - static_cast<int>( 2.5f * static_cast<float>( line.y ) ), NULL );
	    LineTo( dc, CENTER - static_cast<int>( 2.81f * static_cast<float>( line.x ) ), CENTER - static_cast<int>( 2.81f * static_cast<float>( line.y ) ) );
	}
    }

    void drawHands( HDC dc )
    {
	float hp = DegToRadian( ( 30.0f * static_cast<float>( _sysTime.wMinute ) ) / 60.0f );
	int h = ( _sysTime.wHour > 12 ? _sysTime.wHour - 12 : _sysTime.wHour ) * 5;

	_bmp.setPenWidth( 3 );
	_bmp.setPenColor( RGB( 0, 0, 255 ) );
	drawHand( dc, HOUR_LEN, ( _ang * static_cast<float>( 30 + h ) ) + hp );

	_bmp.setPenColor( RGB( 0, 128, 0 ) );
	drawHand( dc, MIN_LEN, _ang * static_cast<float>( 30 + _sysTime.wMinute ) );

	_bmp.setPenWidth( 2 );
	_bmp.setPenColor( RGB( 255, 0, 0 ) );
	drawHand( dc, SEC_LEN, _ang * static_cast<float>( 30 + _sysTime.wSecond ) );
    }

    void drawHand( HDC dc, int len, float ang )
    {
	vector2 line;
	line.set( 0, len );
	line.rotate( ang );
	MoveToEx( dc, CENTER, CENTER, NULL );
	LineTo( dc, line.x + CENTER, line.y + CENTER );
    }

    void draw()
    {
	HDC dc = _bmp.getDC();

	_bmp.setBrushColor( RGB( 250, 250, 250 ) );
	Ellipse( dc, 0, 0, BMP_SIZE, BMP_SIZE );
	_bmp.setBrushColor( RGB( 230, 230, 230 ) );
	Ellipse( dc, 10, 10, BMP_SIZE - 10, BMP_SIZE - 10 );

	drawTicks( dc );
	drawHands( dc );

	_bmp.setPenColor( 0 ); _bmp.setBrushColor( 0 );
	Ellipse( dc, CENTER - 5, CENTER - 5, CENTER + 5, CENTER + 5 );

	_wdc = GetDC( _hwnd );
	BitBlt( _wdc, 0, 0, BMP_SIZE, BMP_SIZE, dc, 0, 0, SRCCOPY );
	ReleaseDC( _hwnd, _wdc );
    }

    myBitmap   _bmp;
    HWND       _hwnd;
    HDC        _wdc;
    SYSTEMTIME _sysTime;
    float      _ang;
};
//--------------------------------------------------------------------------------------------------
class wnd
{
public:
    wnd() { _inst = this; }
    int wnd::Run( HINSTANCE hInst )
    {
	_hInst = hInst;
	_hwnd = InitAll();
	SetTimer( _hwnd, MY_TIMER, 1000, NULL );
	_clock.setHWND( _hwnd );

	ShowWindow( _hwnd, SW_SHOW );
	UpdateWindow( _hwnd );

	MSG msg;
	ZeroMemory( &msg, sizeof( msg ) );
	while( msg.message != WM_QUIT )
	{
	    if( PeekMessage( &msg, NULL, 0, 0, PM_REMOVE ) != 0 )
	    {
		TranslateMessage( &msg );
		DispatchMessage( &msg );
	    }
	}
	return UnregisterClass( "_MY_CLOCK_", _hInst );
    }
private:
    void wnd::doPaint( HDC dc ) { _clock.setNow(); }
    void wnd::doTimer()         { _clock.setNow(); }
    static int WINAPI wnd::WndProc( HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam )
    {
	switch( msg )
	{
	    case WM_DESTROY: PostQuitMessage( 0 ); break;
	    case WM_PAINT:
	    {
		PAINTSTRUCT ps;
		HDC dc = BeginPaint( hWnd, &ps );
		_inst->doPaint( dc );
		EndPaint( hWnd, &ps );
		return 0;
	    }
	    case WM_TIMER: _inst->doTimer(); break;
	    default:
		return DefWindowProc( hWnd, msg, wParam, lParam );
	}
	return 0;
    }

    HWND InitAll()
    {
	WNDCLASSEX wcex;
	ZeroMemory( &wcex, sizeof( wcex ) );
	wcex.cbSize           = sizeof( WNDCLASSEX );
	wcex.style           = CS_HREDRAW | CS_VREDRAW;
	wcex.lpfnWndProc   = ( WNDPROC )WndProc;
	wcex.hInstance     = _hInst;
	wcex.hCursor       = LoadCursor( NULL, IDC_ARROW );
	wcex.hbrBackground = ( HBRUSH )( COLOR_WINDOW + 1 );
	wcex.lpszClassName = "_MY_CLOCK_";

	RegisterClassEx( &wcex );

	RECT rc = { 0, 0, BMP_SIZE, BMP_SIZE };
	AdjustWindowRect( &rc, WS_SYSMENU | WS_CAPTION, FALSE );
	int w = rc.right - rc.left, h = rc.bottom - rc.top;
	return CreateWindow( "_MY_CLOCK_", ".: Clock -- PJorente :.", WS_SYSMENU, CW_USEDEFAULT, 0, w, h, NULL, NULL, _hInst, NULL );
    }

    static wnd* _inst;
    HINSTANCE  _hInst;
    HWND       _hwnd;
    clock      _clock;
};
wnd* wnd::_inst = 0;
//--------------------------------------------------------------------------------------------------
int APIENTRY _tWinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance, LPTSTR lpCmdLine, int nCmdShow )
{
    wnd myWnd;
    return myWnd.Run( hInstance );
}
//--------------------------------------------------------------------------------------------------


DEFINE MAXSIZE="20"

INT ARRAY
  xStack(MAXSIZE),yStack(MAXSIZE),
  dxStack(MAXSIZE),dyStack(MAXSIZE)
BYTE ARRAY
  dirStack(MAXSIZE),
  depthStack(MAXSIZE),stageStack(MAXSIZE)
BYTE stacksize=[0]

BYTE FUNC IsEmpty()
  IF stacksize=0 THEN RETURN (1) FI
RETURN (0)

BYTE FUNC IsFull()
  IF stacksize=MAXSIZE THEN RETURN (1) FI
RETURN (0)

PROC Push(INT x,y,dx,dy BYTE dir,depth,stage)
  IF IsFull() THEN Break() FI
  xStack(stacksize)=x yStack(stacksize)=y
  dxStack(stacksize)=dx dyStack(stacksize)=dy
  dirStack(stacksize)=dir
  depthStack(stacksize)=depth
  stageStack(stackSize)=stage
  stacksize==+1
RETURN

PROC Pop(INT POINTER x,y,dx,dy BYTE POINTER dir,depth,stage)
  IF IsEmpty() THEN Break() FI
  stacksize==-1
  x^=xStack(stacksize) y^=yStack(stacksize)
  dx^=dxStack(stacksize) dy^=dyStack(stacksize)
  dir^=dirStack(stacksize)
  depth^=depthStack(stacksize)
  stage^=stageStack(stacksize)
RETURN

PROC DrawDragon(INT x,y,dx,dy BYTE depth)
  BYTE dir,stage
  INT nx,ny,dx2,dy2,tmp

  Push(x,y,dx,dy,1,depth,0)

  WHILE IsEmpty()=0
  DO
    Pop(@x,@y,@dx,@dy,@dir,@depth,@stage)
    IF depth=0 THEN
      Plot(x,y) DrawTo(x+dx,y+dy)
    ELSE
      IF stage<2 THEN
        Push(x,y,dx,dy,dir,depth,stage+1)
      FI
      nx=dx/2 ny=dy/2
      dx2=nx-ny dy2=nx+ny
      IF stage=0 THEN
        IF dir THEN
          Push(x,y,dx2,dy2,1,depth-1,0)
        ELSE
          Push(x,y,dy2,-dx2,1,depth-1,0)
        FI
      ELSEIF stage=1 THEN
        IF dir THEN
          tmp=-dx2 ;to avoid the compiler error
          Push(x+dx2,y+dy2,dy2,tmp,0,depth-1,0)
        ELSE
          Push(x+dy2,y-dx2,dx2,dy2,0,depth-1,0)
        FI
      FI
    FI
  OD
RETURN

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

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

  DrawDragon(104,72,128,0,12)

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


with Ada.Text_Io; use Ada.Text_Io;

generic
   SortName : in String;
   type DataType is (<>);
   type SortArrayType is array (Integer range <>) of DataType;
   with procedure Sort (SortArray : in out SortArrayType;
                        Comp, Write, Ex : in out Natural);

package Instrument is
   -- This generic package essentially accomplishes turning the sort
   --  procedures into first-class functions for this limited purpose.
   --  Obviously it doesn't change the way that Ada works with them;
   --  the same thing would have been much more straightforward to
   --  program in a language that had true first-class functions

   package Dur_Io is new Fixed_Io(Duration);

   procedure TimeSort (Arr : in out SortArrayType);

   procedure Put;

   procedure Put (File : in out File_Type);

end Instrument;


def _pr(t, x, y, z):
    txt = '\n'.join(''.join(t[(n,m)] for n in range(3+x+z)).rstrip()
                    for m in reversed(range(3+y+z)))
    return txt

def cuboid(x,y,z):
    t = {(n,m):' ' for n in range(3+x+z) for m in range(3+y+z)}
    xrow = ['+'] + ['%i' % (i % 10) for i in range(x)] + ['+']
    for i,ch in enumerate(xrow):
        t[(i,0)] = t[(i,1+y)] = t[(1+z+i,2+y+z)] = ch
    if _debug: print(_pr(t, x, y, z))
    ycol = ['+'] + ['%i' % (j % 10) for j in range(y)] + ['+']
    for j,ch in enumerate(ycol):
        t[(0,j)] = t[(x+1,j)] = t[(2+x+z,1+z+j)] = ch
    zdepth = ['+'] + ['%i' % (k % 10) for k in range(z)] + ['+']
    if _debug: print(_pr(t, x, y, z))
    for k,ch in enumerate(zdepth):
        t[(k,1+y+k)] = t[(1+x+k,1+y+k)] = t[(1+x+k,k)] = ch

    return _pr(t, x, y, z)

_debug = False
if __name__ == '__main__':
    for dim in ((2,3,4), (3,4,2), (4,2,3)):
        print("CUBOID%r" % (dim,), cuboid(*dim), sep='\n')


  % Title "Sphere"
  '% Animated
  % PlaceCentral
  uses ConsoleG

  sub main
  ========
  cls 0.0, 0.2, 0.7
  shading
  scale 10
  pushstate
    GoldMaterial.act
    go sphere
  popstate
  end sub

  EndScript


use strict;
use warnings;

my $x = my $y = 255;
$x |= 1; # must be odd
my $depth = 255;

my $light = Vector->new(rand, rand, rand)->normalized;

print "P2\n$x $y\n$depth\n";

my ($r, $ambient) = (($x - 1)/2, 0);
my ($r2) = $r ** 2;
{
    for my $x (-$r .. $r) {
	my $x2 = $x**2;
	for my $y (-$r .. $r) {
	    my $y2 = $y**2;
	    my $pixel = 0;
	    if ($x2 + $y2 < $r2) {
		my $v = Vector->new($x, $y, sqrt($r2 - $x2 - $y2))->normalized;
		my $I = $light . $v + $ambient;
		$I = $I < 0 ? 0 : $I > 1 ? 1 : $I;
		$pixel = int($I * $depth);
	    }
	    print $pixel;
	    print $y == $r ? "\n" : " ";
	}
    }
}

package Vector {
    sub new {
	my $class = shift;
	bless ref($_[0]) eq 'Array' ? $_[0] : [ @_ ], $class;
    }
    sub normalized {
	my $this = shift;
	my $norm = sqrt($this . $this);
	ref($this)->new( map $_/$norm, @$this );
    }
    use overload q{.} => sub {
	my ($a, $b) = @_;
	my $sum = 0;
	for (0 .. @$a - 1) {
	    $sum += $a->[$_] * $b->[$_]
	}
	return $sum;
    },
    q{""} => sub { sprintf "Vector:[%s]", join ' ', @{shift()} };
}


startshape START

TIME_IN_SECONDS = 60

shape START {
	SECOND_HAND[r (TIME_IN_SECONDS*-6)]
	CIRCLE[s 50 50]
}

shape SECOND_HAND
{
	TRIANGLE [[z 1 s 1 30 y 0.26 b 1]]
}


unit main;

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Forms,
  Vcl.ExtCtrls;

type
  TClock = class(TForm)
    tmrTimer: TTimer;
    procedure FormResize(Sender: TObject);
    procedure tmrTimerTimer(Sender: TObject);
  private
    { Private declarations }
    const
      degrees06 = PI / 30;
      degrees30 = degrees06 * 5;
      degrees90 = degrees30 * 3;
      margin = 20;
    var
      p0: TPoint;
      MinP0XY: Integer;
    class function IfThen(Condition: Boolean; TrueValue, FalseValue: Integer):
      Integer; overload; static;
    class function IfThen(Condition: Boolean; TrueValue, FalseValue: Double):
      Double; overload; static;
    procedure Paint; override;
    procedure DrawHand(Color: TColor; Angle, Size: Double; aWidth: Integer = 2);
    procedure DrawFace;
    procedure DrawCenter;
    procedure DrawNumbers(Angle: Double; Value: Integer);
  public
    { Public declarations }
  end;

var
  Clock: TClock;

implementation

{$R *.dfm}

{ TClock }

procedure TClock.DrawCenter;
var
  radius: Integer;
begin
  radius := 6;
  with Canvas do
  begin
    pen.Color := clNone;
    Brush.Color := clBlack;
    Ellipse(p0.x - radius, p0.y - radius, p0.x + radius, p0.y + radius);
  end;
end;

procedure TClock.DrawFace;
var
  radius, h, m: Integer;
begin
  radius := MinP0XY - margin;
  with Canvas do
  begin
    Pen.Color := clBlack;
    Pen.Width := 2;
    Brush.Color := clWhite;
    Ellipse(p0.x - radius, p0.y - radius, p0.x + radius, p0.y + radius);
    for m := 0 to 59 do
      DrawHand(clGray, m * degrees06, -0.08, 2);

    for h := 0 to 11 do
    begin
      DrawHand(clBlack, h * degrees30, -0.09, 3);
      DrawNumbers((h + 3) * degrees30, 12 - h);
    end;
  end;
end;

procedure TClock.DrawHand(Color: TColor; Angle, Size: Double; aWidth: Integer = 2);
var
  radius, x0, y0, x1, y1: Integer;
begin
  radius := MinP0XY - margin;

  x0 := p0.X + (IfThen(Size > 0, 0, Round(radius * (Size + 1) * cos(Angle))));
  y0 := p0.Y + (IfThen(Size > 0, 0, Round(radius * (Size + 1) * sin(-Angle))));

  x1 := p0.X + round(radius * IfThen(Size > 0, Size, 1) * cos(Angle));
  y1 := p0.y + round(radius * IfThen(Size > 0, Size, 1) * sin(-Angle));

  with Canvas do
  begin
    Pen.Color := Color;
    pen.Width := aWidth;
    MoveTo(x0, y0);
    LineTo(x1, y1);
  end;
end;

procedure TClock.DrawNumbers(Angle: Double; Value: Integer);
var
  radius, x0, y0, x1, y1, h, w: Integer;
  Size: Double;
  s: string;
begin
  radius := MinP0XY - margin;
  Size := 0.85;
  s := (Value).ToString;

  x1 := p0.X + round(radius * Size * cos(Angle));
  y1 := p0.y + round(radius * Size * sin(-Angle));

  with Canvas do
  begin
    radius := 5;
    Font.Size := 12;
    w := TextWidth(s);
    h := TextHeight(s);

    x0 := x1 - (w div 2);
    y0 := y1 - (h div 2);

    TextOut(x0, y0, s);
  end;
end;

procedure TClock.FormResize(Sender: TObject);
begin
  p0 := Tpoint.create(ClientRect.CenterPoint);
  MinP0XY := p0.x;
  if MinP0XY > p0.Y then
    MinP0XY := p0.y;
  Refresh();
end;

class function TClock.IfThen(Condition: Boolean; TrueValue, FalseValue: Double): Double;
begin
  if Condition then
    exit(TrueValue);
  exit(FalseValue);
end;

class function TClock.IfThen(Condition: Boolean; TrueValue, FalseValue: Integer): Integer;
begin
  if Condition then
    exit(TrueValue);
  exit(FalseValue);
end;

procedure TClock.Paint;
var
  t: TDateTime;
  second, minute, hour: Integer;
  angle, minsecs, hourmins: Double;
begin
  inherited;

  t := time;
  second := trunc(Frac(t * 24 * 60) * 60);
  minute := trunc(Frac(t * 24) * 60);
  hour := trunc(t * 24);

  DrawFace;

  angle := degrees90 - (degrees06 * second);
  DrawHand(clred, angle, 0.95, 3);

  minsecs := (minute + second / 60.0);

  angle := degrees90 - (degrees06 * minsecs);
  DrawHand(clGreen, angle, 0.8, 4);

  hourmins := (hour + minsecs / 60.0);
  angle := degrees90 - (degrees30 * hourmins);
  DrawHand(clBlue, angle, 0.6, 5);

  DrawCenter;

  Caption := Format('%.2d:%.2d:%.2d', [hour, minute, second]);
end;

procedure TClock.tmrTimerTimer(Sender: TObject);
begin
  Refresh;
end;

end.


# -*- coding: utf-8 -*- #

STRUCT (REAL x, y, heading, BOOL pen down) turtle;

PROC turtle init = VOID: (
  draw erase (window);
  turtle := (0.5, 0.5, 0, TRUE);
  draw move (window, x OF turtle, y OF turtle);
  draw colour name(window, "white")
);

PROC turtle left = (REAL left turn)VOID:
  heading OF turtle +:= left turn;

PROC turtle right = (REAL right turn)VOID:
  heading OF turtle -:= right turn;

PROC turtle forward = (REAL distance)VOID:(
  x OF turtle +:= distance * cos(heading OF turtle) / width * height;
  y OF turtle +:= distance * sin(heading OF turtle);
  IF pen down OF turtle THEN
    draw line
  ELSE
    draw move
  FI (window, x OF turtle, y OF turtle)
);

SKIP


DIM SHARED angle AS DOUBLE

SUB turn (degrees AS DOUBLE)
    angle = angle + degrees*3.14159265/180
END SUB

SUB forward (length AS DOUBLE)
    LINE - STEP (COS(angle)*length, SIN(angle)*length), 7
END SUB

SUB dragon (length AS DOUBLE, split AS INTEGER, d AS DOUBLE)
    IF split=0 THEN
        forward length
    ELSE
	turn d*45
	dragon length/1.4142136, split-1, 1
	turn -d*90
	dragon length/1.4142136, split-1, -1
	turn d*45
    END IF
END SUB

' Main program

SCREEN 12
angle = 0
PSET (150,180), 0
dragon 400, 12, 1
SLEEP


f: function [x :integer, y :integer][
    ;; description: « takes two integers and adds them up
    ;; options: [
    ;;      double: « also multiply by two
    ;; ]
    ;; returns: :integer

    result: x+y
    if not? null? attr 'double -> result: result * 2
    return result
]

info'f


;
; Function: example_add
; Description:
;     Adds two or three numbers (see [url=http://en.wikipedia.org/Number]Number [/url])
; Syntax: example_add(number1, number2[, number3=0])
; Parameters:
;		number1 - First number to add.
;		number2 - Second number to add.
;		number3 - (Optional) Third number to add. You can just omit this parameter.
; Return Value:
;		sum of parameters
; Example:
;		MsgBox % example_add(example_add(2, 3, 4), 5)
;
example_add(number1, number2, number3=0){
    return number1 + number2 + number3
}


/**
 * \brief Perform addition on \p a and \p b.
 *
 * \param a One of the numbers to be added.
 * \param b Another number to be added.
 * \return The sum of \p a and \p b.
 * \code
 *     int sum = add(1, 2);
 * \endcode
 */
int add(int a, int b) {
    return a + b;
}


/// <summary>
/// The XMLSystem class is here to help handle XML items in this site.
/// </summary>
public static class XMLSystem
{
    static XMLSystem()
    {
        // Constructor
    }

    /// <summary>
    /// A function to get the contents of an XML document.
    /// </summary>
    /// <param name="name">A valid name of an XML document in the data folder</param>
    /// <returns>An XmlDocument containing the contents of the XML file</returns>
    public static XmlDocument GetXML(string name)
    {
        return null;
    }
}


#lang racket/gui
(require sgl/gl)

; Macro to delimit and automatically end glBegin - glEnd contexts.
(define-syntax-rule (gl-begin-end Vertex-Mode statement ...)
  (let () (glBegin Vertex-Mode) statement ... (glEnd)))

(define (resize w h)
  (glViewport 0 0 w h))

(define (draw-opengl x y z)
  (glClearColor 0.0 0.0 0.0 0.0)
  (glEnable GL_DEPTH_TEST)
  (glClear GL_COLOR_BUFFER_BIT)
  (glClear GL_DEPTH_BUFFER_BIT)

  (define max-axis (add1 (max x y z)))

  (glMatrixMode GL_PROJECTION)
  (glLoadIdentity)
  (glOrtho (/ (- max-axis) 2) max-axis (/ (- max-axis) 2) max-axis (/ (- max-axis) 2) max-axis)
  (glMatrixMode GL_MODELVIEW)
  (glLoadIdentity)
  (glRotatef -45 1.0 0.0 0.0)
  (glRotatef 45 0.0 1.0 0.0)

  (gl-begin-end GL_QUADS
                (glColor3f 0 0 1)
                (glVertex3d x 0.0 z)
                (glVertex3d x y z)
                (glVertex3d x y 0.0)
                (glVertex3d x 0.0 0.0))
  (gl-begin-end GL_QUADS
                (glColor3f 1 0 0)
                (glVertex3d x 0.0 0.0)
                (glVertex3d x y 0.0)
                (glVertex3d 0.0 y 0.0)
                (glVertex3d 0.0 0.0 0.0))
  (gl-begin-end GL_QUADS
                (glColor3f 0 1 0)
                (glVertex3d x y 0.0)
                (glVertex3d x y z)
                (glVertex3d 0.0 y z)
                (glVertex3d 0.0 y 0.0)))

(define my-canvas%
  (class* canvas% ()
    (inherit with-gl-context swap-gl-buffers)
    (init-field (x 2) (y 3) (z 4))

    (define/override (on-paint)
      (with-gl-context
        (lambda ()
          (draw-opengl x y z)
          (swap-gl-buffers))))

    (define/override (on-size width height)
      (with-gl-context
        (lambda ()
          (resize width height))))

    (super-instantiate () (style '(gl)))))

(define win (new frame% (label "Racket Draw a cuboid") (min-width 300) (min-height 300)))
(define gl  (new my-canvas% (parent win) (x 2) (y 3) (z 4)))

(send win show #t)


# Clock
#
func draw hour min sec . .
  # dial
  color 333
  move 50 50
  circle 45
  color 797
  circle 44
  color 333
  for i range 60
    a = i * 6
    move 50 + sin a * 40 50 - cos a * 40
    circle 0.25
  .
  for i range 12
    a = i * 30
    move 50 + sin a * 40 50 - cos a * 40
    circle 1
  .
  # hour
  linewidth 2
  color 000
  a = (hour * 60 + min) / 2
  move 50 50
  line 50 + sin a * 32 50 - cos a * 32
  # min
  linewidth 1.5
  a = (sec + min * 60) / 10
  move 50 50
  line 50 + sin a * 40 50 - cos a * 40
  # sec
  linewidth 1
  color 700
  a = sec * 6
  move 50 50
  line 50 + sin a * 40 50 - cos a * 40
.
on timer
  if t <> floor systime
    t = floor systime
    h$ = timestr t
    sec = number substr h$ 17 2
    min = number substr h$ 14 2
    hour = number substr h$ 11 2
    if hour > 12
      hour -= 12
    .
    call draw hour min sec
  .
  timer 0.1
.
timer 0


open System.Text.RegularExpressions

let numberTemplate = """
 _     _  _     _     __ _  _
/ \ /|  ) _)|_||_  /   /(_)(_) *
\_/  | /_ _)  | _)(_) / (_) /  *
"""
let g =
    numberTemplate.Split([|'\n';'\r'|], System.StringSplitOptions.RemoveEmptyEntries)
    |> Array.map (fun s ->
        Regex.Matches(s, "...")
        |> Seq.cast<Match>
        |> Seq.map (fun m -> m.ToString())
        |> Seq.toArray)

let idx c =
    let v c = ((int) c) - ((int) '0')
    let i = v c
    if 0 <= i && i <= 9 then i
    elif c = ':' then 10
    else failwith ("Cannot draw character " + c.ToString())

let draw (s :string) =
    System.Console.Clear()
    g
    |> Array.iter (fun a ->
        s.ToCharArray() |> Array.iter (fun c ->
            let i = idx c
            printf "%s" (a.[i]))
        printfn ""
        )

[<EntryPoint>]
let main argv =
    let showTime _ = draw (System.String.Format("{0:HH:mm:ss}", (System.DateTime.Now)))
    let timer = new System.Timers.Timer(500.)
    timer.AutoReset <- true // The timer triggers cyclically
    timer.Elapsed // An event stream
    |> Observable.subscribe showTime |> ignore // Subscribe to the event stream
    timer.Start() // Now it counts
    System.Console.ReadLine() |> ignore // Until return is hit
    showTime ()
    0


(def
 #^{:doc "Metadata can contain documentation and can be added to vars like this."}
     test1)

(defn test2
  "defn and some other macros allow you add documentation like this. Works the same way"
  [])


*>****L* cobweb/cobweb-gtk [0.2]
      *> Author:
      *>   Author details
      *> Colophon:
      *>   Part of the GnuCobol free software project
      *>   Copyright (C) 2014 person
      *>   Date      20130308
      *>   Modified  20141003
      *>   License   GNU General Public License, GPL, 3.0 or greater
      *>   Documentation licensed GNU FDL, version 2.1 or greater
      *>   HTML Documentation thanks to ROBODoc --cobol
      *> Purpose:
      *> GnuCobol functional bindings to GTK+
      *> Main module includes paperwork output and self test
      *> Synopsis:
      *> |dotfile cobweb-gtk.dot
      *> |html

      *> Functions include
      *> |exec cobcrun cobweb-gtk >cobweb-gtk.repository
      *> |html

      *> |copy cobweb-gtk.repository
      *> |html

      *> |exec rm cobweb-gtk.repository
      *> Tectonics:
      *>   cobc -v -b -g -debug cobweb-gtk.cob voidcall_gtk.c
      *>        `pkg-config --libs gtk+-3.0` -lvte2_90 -lyelp
      *>   robodoc --cobol --src ./ --doc cobwebgtk --multidoc --rc robocob.rc --css cobodoc.css
      *>   cobc -E -Ddocpass cobweb-gtk.cob
      *>   make singlehtml  # once Sphinx set up to read cobweb-gtk.i
      *> Example:
      *>  COPY cobweb-gtk-preamble.
      *>  procedure division.
      *>  move TOP-LEVEL to window-type
      *>  move 640 to width-hint
      *>  move 480 to height-hint
      *>  move new-window("window title", window-type,
      *>      width-hint, height-hint)
      *>    to gtk-window-data
      *>  move gtk-go(gtk-window) to extraneous
      *>  goback.
      *> Notes:
      *>  The interface signatures changed between 0.1 and 0.2
      *> Screenshot:
      *> image:cobweb-gtk1.png
      *> Source:
       REPLACE ==FIELDSIZE== BY ==80==
               ==AREASIZE==  BY ==32768==
               ==FILESIZE==  BY ==65536==.

id     identification division.
       program-id. cobweb-gtk.

       ...

done   goback.
       end program cobweb-gtk.
      *>****


CL-USER 83 > (defun add (a b)
               "add two numbers a and b"
               (+ a b))
ADD


# Any block of comments *directly* before (no blank lines) a module, class, or method is used as a doc comment
# This one is for a module
module Documentation

  # This comment documents a class, *and* it uses markdown
  class Foo

    # This comment doesn't do anything, because it isn't directly above a module, class, or method

    # Finally, this comment documents a method
    def initialize
    end
  end
end


3 elements d h w

: spaces  ( n- )  &space times ;
: ---     ( -  )  '+ putc @w 2 * [ '- putc ] times '+ putc ;
: ?       ( n- )  @h <> [ '| ] [ '+ ] if ;
: slice   ( n- )  '/ putc @w 2 * spaces '/ putc @d swap - dup spaces ? putc cr ;
: |...|/  ( -  )  @h [ '| putc @w 2 * spaces '| putc 1- spaces '/ putc cr ] iterd ;
: face    ( -  )
   ---    @w 1+ spaces '/ putc cr
  |...|/
   ---    cr ;

: cuboid  ( whd- )
  !d !h !w cr
  @d 1+ spaces --- cr
  @d [ dup spaces slice ] iterd
  face ;

2 3 4 cuboid


/*REXX program displays a cuboid  (dimensions, if specified, must be positive integers).*/
parse arg x  y  z  indent .                      /*x, y, z:  dimensions and indentation.*/
x=p(x 2);  y=p(y 3);  z=p(z 4);  in=p(indent 0)  /*use the defaults if not specified.   */
pad=left('', in)                                 /*indentation must be non-negative.    */
                        call show  y+2  ,        ,     "+-"
       do j=1  for y;   call show  y-j+2,     j-1,     "/ |"     ;       end  /*j*/
                        call show       ,     y  ,     "+-|"
       do z-1;          call show       ,     y  ,     "| |"     ;       end  /*z-1*/
                        call show       ,     y  ,     "| +"
       do j=1  for y;   call show       ,     y-j,     "| /"     ;       end  /*j*/
                        call show       ,        ,     "+-"
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
p:     return word( arg(1), 1)                   /*pick the first number or word in list*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show:  parse arg #,$,a 2 b 3 c 4                 /*get the arguments (or parts thereof).*/
       say pad || right(a, p(# 1) )copies(b, 4*x)a || right(c, p($ 0) + 1);         return


--
-- demo\rosetta\Draw_a_sphere.exw
-- ==============================
--
with javascript_semantics
include pGUI.e

constant title = "Draw a sphere"
Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas

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

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

procedure drawSphere(integer width, height, atom k, amb, sequence direction)
    atom t0 = time()+1, t1 = t0,
         lmul = 255/(1+amb)
    integer r = floor((min(width,height)-20)/2),
           cx = floor(width/2),
           cy = floor(height/2)
    for x=-r to r do
        if time()>t1 then
            -- Let the user know we aren't completely dead just yet
            IupSetStrAttribute(dlg,"TITLE","%s - drawing (%d%%)",{title,100*(x+r)/(2*r)})
            t1 = time()+1
            -- (as per DeathStar.exw, prevent "(Not Responding)" nonsense)
            if platform()!=JS then
                if IupLoopStep()=IUP_CLOSE then
                    IupExitLoop()
                    exit
                end if
            end if
        end if
        for y=-r to r do
            integer z = r*r-(x*x+y*y)
            if z>=0 then
                atom s = dot(direction, normalize({x,y,sqrt(z)})),
                     l = iff(s<=0?0:power(s,k))
                integer lum = and_bits(#FF,lmul*(l+amb))
                cdCanvasPixel(cddbuffer, x+cx, y+cy, lum*#10101)
            end if
        end for
    end for
    if t1!=t0 then
        IupSetStrAttribute(dlg,"TITLE",title)
    end if
end procedure

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

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

procedure main()
    IupOpen()

    canvas = IupCanvas("RASTERSIZE=340x340")
    IupSetCallbacks(canvas, {"MAP_CB", Icallback("map_cb"),
                             "ACTION", Icallback("redraw_cb")})
    dlg = IupDialog(canvas,`TITLE="%s"`,{title})
    IupShow(dlg)
    IupSetAttribute(canvas, "RASTERSIZE", NULL) -- release the minimum limitation
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


# -*- coding: utf-8 -*- #
COMMENT REQUIRES:
  MODE VALUE = ~;
# For example: #
  MODE VALUE = UNION(INT, REAL, COMPL)
END COMMENT

MODE LINKNEW = STRUCT (
  LINK next, prev,
  VALUE value
);

MODE LINK = REF LINKNEW;

SKIP


/* ARM assembly Raspberry PI  */
/*  program defDblList.s   */

/* Constantes    */
.equ STDOUT, 1                           @ Linux output console
.equ EXIT,   1                           @ Linux syscall
.equ READ,   3
.equ WRITE,  4

/*******************************************/
/* Structures                               */
/********************************************/
/* structure Doublylinkedlist*/
    .struct  0
dllist_head:                    @ head node
    .struct  dllist_head + 4
dllist_tail:                    @ tail node
    .struct  dllist_tail  + 4
dllist_fin:
/* 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:
/* Initialized data */
.data
szMessInitListe:         .asciz "List initialized.\n"
szCarriageReturn:        .asciz "\n"
szMessErreur:            .asciz "Error detected.\n"

/* UnInitialized data */
.bss
dllist1:              .skip dllist_fin    @ list memory place

/*  code section */
.text
.global main
main:
    ldr r0,iAdrdllist1
    bl newDList                      @ create new list
    ldr r0,iAdrszMessInitListe
    bl affichageMess
    ldr r0,iAdrdllist1               @ list address
    mov r1,#10                       @ value
    bl insertHead                    @ insertion at head
    cmp r0,#-1
    beq 99f
    ldr r0,iAdrdllist1
    mov r1,#20
    bl insertTail                    @ insertion at tail
    cmp r0,#-1
    beq 99f
    ldr r0,iAdrdllist1               @ list address
    mov r1,#10                       @ value to after insered
    mov r2,#15                       @ new value
    bl insertAfter
    cmp r0,#-1
    beq 99f

    b 100f
99:
    ldr r0,iAdrszMessErreur
    bl affichageMess
100:                                    @ standard end of the program
    mov r7, #EXIT                       @ request to exit program
    svc 0                               @ perform system call
iAdrszMessInitListe:       .int szMessInitListe
iAdrszMessErreur:          .int szMessErreur
iAdrszCarriageReturn:      .int szCarriageReturn
iAdrdllist1:               .int dllist1
/******************************************************************/
/*     create new list                         */
/******************************************************************/
/* r0 contains the address of the list structure */
newDList:
    push {r1,lr}                         @ save  registers
    mov r1,#0
    str r1,[r0,#dllist_tail]
    str r1,[r0,#dllist_head]
    pop {r1,lr}                          @ restaur registers
    bx lr                                @ return
/******************************************************************/
/*     list is empty ?                         */
/******************************************************************/
/* r0 contains the address of the list structure */
/* r0 return 0 if empty  else return 1 */
isEmpty:
    //push {r1,lr}                         @ save  registers
    ldr r0,[r0,#dllist_head]
    cmp r0,#0
    movne r0,#1
    //pop {r1,lr}                          @ restaur registers
    bx lr                                @ return
/******************************************************************/
/*     insert value at list head                        */
/******************************************************************/
/* r0 contains the address of the list structure */
/* r1 contains value */
insertHead:
    push {r1-r4,lr}                         @ save  registers
    mov r4,r0                            @ save address
    mov r0,r1                            @ value
    bl createNode
    cmp r0,#-1                           @ allocation error ?
    beq 100f
    ldr r2,[r4,#dllist_head]             @ load address first node
    str r2,[r0,#NDlist_next]             @ store in next pointer on new node
    mov r1,#0
    str r1,[r0,#NDlist_prev]             @ store zero in previous pointer on new node
    str r0,[r4,#dllist_head]             @ store address new node in address head list
    cmp r2,#0                            @ address first node is null ?
    strne r0,[r2,#NDlist_prev]           @ no store adresse new node in previous pointer
    streq r0,[r4,#dllist_tail]           @ else store new node in tail address
100:
    pop {r1-r4,lr}                       @ restaur registers
    bx lr                                @ return
/******************************************************************/
/*     insert value at list tail                        */
/******************************************************************/
/* r0 contains the address of the list structure */
/* r1 contains value */
insertTail:
    push {r1-r4,lr}                         @ save  registers
    mov r4,r0                            @ save list address
    mov r0,r1                            @ value
    bl createNode                        @ create new node
    cmp r0,#-1
    beq 100f                             @ allocation error
    ldr r2,[r4,#dllist_tail]             @ load address last node
    str r2,[r0,#NDlist_prev]             @ store in previous pointer on new node
    mov r1,#0                            @ store null un next pointer
    str r1,[r0,#NDlist_next]
    str r0,[r4,#dllist_tail]             @ store address new node on list tail
    cmp r2,#0                            @ address last node is null ?
    strne r0,[r2,#NDlist_next]           @ no store address new node in next pointer
    streq r0,[r4,#dllist_head]           @ else store in head list
100:
    pop {r1-r4,lr}                          @ restaur registers
    bx lr                                @ return
/******************************************************************/
/*     insert value after other element                        */
/******************************************************************/
/* r0 contains the address of the list structure */
/* r1 contains value to search*/
/* r2 contains value to insert */
insertAfter:
    push {r1-r5,lr}                         @ save  registers
    mov r4,r0                               @ save list address
    bl searchValue                          @ search this value in r1
    cmp r0,#-1
    beq 100f                                @ not found -> error
    mov r5,r0                               @ save address of node find
    mov r0,r2                               @ new value
    bl createNode                           @ create new node
    cmp r0,#-1
    beq 100f                                @ allocation error
    ldr r2,[r5,#NDlist_next]                @ load pointer next of find node
    str r0,[r5,#NDlist_next]                @ store new node in pointer next
    str r5,[r0,#NDlist_prev]                @ store address find node in previous pointer on new node
    str r2,[r0,#NDlist_next]                @ store pointer next of find node on pointer next on new node
    cmp r2,#0                               @ next pointer is null ?
    strne r0,[r2,#NDlist_prev]              @ no store address new node in previous pointer
    streq r0,[r4,#dllist_tail]              @ else store in list tail
100:
    pop {r1-r5,lr}                          @ restaur registers
    bx lr                                   @ return
/******************************************************************/
/*     search value                                               */
/******************************************************************/
/* r0 contains the address of the list structure */
/* r1 contains the value to search  */
/* r0 return address of node or -1 if not found */
searchValue:
    push {r2,lr}                         @ save  registers
    ldr r0,[r0,#dllist_head]             @ load first node
1:
    cmp r0,#0                            @ null -> end search not found
    moveq r0,#-1
    beq 100f
    ldr r2,[r0,#NDlist_value]            @ load node value
    cmp r2,r1                            @ equal ?
    beq 100f
    ldr r0,[r0,#NDlist_next]             @ load addresse next node
    b 1b                                 @ and loop
100:
    pop {r2,lr}                          @ restaur registers
    bx lr                                @ return
/******************************************************************/
/*     Create new node                                            */
/******************************************************************/
/* r0 contains the value */
/* r0 return node address or -1 if allocation error*/
createNode:
    push {r1-r7,lr}                         @ save  registers
    mov r4,r0                            @ save value
    @ allocation place on the heap
    mov r0,#0                                   @ allocation place heap
    mov r7,#0x2D                                @ call system 'brk'
    svc #0
    mov r5,r0                                   @ save address heap for output string
    add r0,#NDlist_fin                            @ reservation place one element
    mov r7,#0x2D                                @ call system 'brk'
    svc #0
    cmp r0,#-1                                  @ allocation error
    beq 100f
    mov r0,r5
    str r4,[r0,#NDlist_value]                   @ store value
    mov r2,#0
    str r2,[r0,#NDlist_next]                    @ store zero to pointer next
    str r2,[r0,#NDlist_prev]                    @ store zero to pointer previous
100:
    pop {r1-r7,lr}                          @ restaur registers
    bx lr                                @ return
/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {r0,r1,r2,r7,lr}                       @ save  registers
    mov r2,#0                                   @ counter length */
1:                                              @ loop length calculation
    ldrb r1,[r0,r2]                             @ read octet start position + index
    cmp r1,#0                                   @ if 0 its over
    addne r2,r2,#1                              @ else add 1 in the length
    bne 1b                                      @ and loop
                                                @ so here r2 contains the length of the message
    mov r1,r0                                   @ address message in r1
    mov r0,#STDOUT                              @ code to write to the standard output Linux
    mov r7, #WRITE                              @ code call system "write"
    svc #0                                      @ call system
    pop {r0,r1,r2,r7,lr}                        @ restaur registers
    bx lr                                       @ return


HEX
8379 CONSTANT TICKER   \ address of 1/60 second counter

CREATE PDT ( -- addr) \ bit pattern descriptors for 0..9 and colon
        0038 , 444C , 5464 , 4438 , ( 0)
        0010 , 3010 , 1010 , 1038 , ( 1)
        0038 , 4404 , 1820 , 407C , ( 2)
        007C , 0810 , 0804 , 4438 , ( 3)
        0008 , 1828 , 487C , 0808 , ( 4)
        007C , 4078 , 0404 , 4438 , ( 5)
        0038 , 4040 , 7844 , 4438 , ( 6)
        007C , 0408 , 1020 , 2020 , ( 7)
        0038 , 4444 , 3844 , 4438 , ( 8)
        0038 , 4444 , 3C04 , 0438 , ( 9)
        0000 , 3030 , 0030 , 3000 , ( :)

: ]PDT  ( 0..9 -- addr) [CHAR] 0 - 8 * PDT + ;

: BIG.TYPE ( caddr len -- )
    8 0
    DO
        CR
        2DUP BOUNDS
        ?DO
            I [email protected] ]PDT J + [email protected]         \ PDT char, byte# J
            2 7 DO                   \ from bit# 7 to 2
                DUP 1 I LSHIFT AND   \ mask out each bit
                IF    [char] * EMIT  \ if true emit a character
                ELSE  SPACE          \ else print space
                THEN
            -1 +LOOP  DROP
        LOOP
    LOOP
    2DROP ;

DECIMAL

CREATE SECONDS  0 , 0 ,   \ 2 CELLS, holds a double integer

: SECONDS++  ( -- )  SECONDS [email protected] 1 M+  SECONDS 2! ;

\  subtract old value from new value until ticker changes.
: 1/60  ( -- )
        TICKER DUP @  ( -- addr value)
        BEGIN
             PAUSE    \ *Gives time to other Forth processes while we wait
             OVER @   \ read ticker addr
             OVER -   \ subtract from old value
        UNTIL
        2DROP ;

: SEXTAL ( -- ) 6 BASE ! ;
: 1SEC   ( -- ) 60 0 DO  1/60  LOOP   SECONDS++  ;
: ##:    ( -- ) # SEXTAL # DECIMAL [CHAR] : HOLD  ;
: .TIME  ( d --) <#  ##: ##: # # #> BIG.TYPE ;

: CLOCK  ( -- )
         DECIMAL  \ set task's local radix
         BEGIN
            1SEC
            0 0 AT-XY  SECONDS [email protected] .TIME
            ?TERMINAL
         UNTIL
         2DROP ;


!Digital Text implemented as in C version - Anant Dixit (Oct, 2014)
program clock
implicit none
integer :: t(8)
do
  call date_and_time(values=t)
  call sleep(1)
  call system('clear')
  call digital_display(t(5),t(6),t(7))
end do
end program

subroutine digital_display(H,M,S)
!arguments
integer :: H, M, S
!local
character(len=*), parameter :: nfmt='(A8)', cfmt='(A6)'
character(len=88), parameter :: d1 = ' 00000     1     22222   33333      4   5555555  66666  7777777  88888   99999        '
character(len=88), parameter :: d2 = '0     0   11    2     2 3     3    44   5       6     6 7     7 8     8 9     9  ::   '
character(len=88), parameter :: d3 = '0    00  1 1          2       3   4 4   5       6             7 8     8 9     9  ::   '
character(len=88), parameter :: d4 = '0   0 0    1         2        3  4  4   5       6            7  8     8 9     9  ::   '
character(len=88), parameter :: d5 = '0  0  0    1        2      333  4444444 555555  666666      7    88888   999999       '
character(len=88), parameter :: d6 = '0 0   0    1       2          3     4         5 6     6    7    8     8       9  ::   '
character(len=88), parameter :: d7 = '00    0    1      2           3     4         5 6     6   7     8     8       9  ::   '
character(len=88), parameter :: d8 = '0     0    1     2      3     3     4   5     5 6     6  7      8     8 9     9  ::   '
character(len=88), parameter :: d9 = ' 00000  1111111 2222222  33333      4    55555   66666  7        88888   99999        '
integer :: h1, h2, m1, m2, s1, s2
h1 = 1+8*floor(dble(H)/10.D0)
h2 = 1+8*modulo(H,10)
m1 = 1+8*floor(dble(M)/10.D0)
m2 = 1+8*modulo(M,10)
s1 = 1+8*floor(dble(S)/10.D0)
s2 = 1+8*modulo(S,10)

write(*,nfmt,advance='no') d1(h1:h1+8)
write(*,nfmt,advance='no') d1(h2:h2+8)
write(*,cfmt,advance='no') d1(81:88)
write(*,nfmt,advance='no') d1(m1:m1+8)
write(*,nfmt,advance='no') d1(m2:m2+8)
write(*,cfmt,advance='no') d1(81:88)
write(*,nfmt,advance='no') d1(s1:s1+8)
write(*,nfmt) d1(s2:s2+8)

write(*,nfmt,advance='no') d2(h1:h1+8)
write(*,nfmt,advance='no') d2(h2:h2+8)
write(*,cfmt,advance='no') d2(81:88)
write(*,nfmt,advance='no') d2(m1:m1+8)
write(*,nfmt,advance='no') d2(m2:m2+8)
write(*,cfmt,advance='no') d2(81:88)
write(*,nfmt,advance='no') d2(s1:s1+8)
write(*,nfmt) d2(s2:s2+8)

write(*,nfmt,advance='no') d3(h1:h1+8)
write(*,nfmt,advance='no') d3(h2:h2+8)
write(*,cfmt,advance='no') d3(81:88)
write(*,nfmt,advance='no') d3(m1:m1+8)
write(*,nfmt,advance='no') d3(m2:m2+8)
write(*,cfmt,advance='no') d3(81:88)
write(*,nfmt,advance='no') d3(s1:s1+8)
write(*,nfmt) d3(s2:s2+8)

write(*,nfmt,advance='no') d4(h1:h1+8)
write(*,nfmt,advance='no') d4(h2:h2+8)
write(*,cfmt,advance='no') d4(81:88)
write(*,nfmt,advance='no') d4(m1:m1+8)
write(*,nfmt,advance='no') d4(m2:m2+8)
write(*,cfmt,advance='no') d4(81:88)
write(*,nfmt,advance='no') d4(s1:s1+8)
write(*,nfmt) d4(s2:s2+8)

write(*,nfmt,advance='no') d5(h1:h1+8)
write(*,nfmt,advance='no') d5(h2:h2+8)
write(*,cfmt,advance='no') d5(81:88)
write(*,nfmt,advance='no') d5(m1:m1+8)
write(*,nfmt,advance='no') d5(m2:m2+8)
write(*,cfmt,advance='no') d5(81:88)
write(*,nfmt,advance='no') d5(s1:s1+8)
write(*,nfmt) d5(s2:s2+8)

write(*,nfmt,advance='no') d6(h1:h1+8)
write(*,nfmt,advance='no') d6(h2:h2+8)
write(*,cfmt,advance='no') d6(81:88)
write(*,nfmt,advance='no') d6(m1:m1+8)
write(*,nfmt,advance='no') d6(m2:m2+8)
write(*,cfmt,advance='no') d6(81:88)
write(*,nfmt,advance='no') d6(s1:s1+8)
write(*,nfmt) d6(s2:s2+8)

write(*,nfmt,advance='no') d7(h1:h1+8)
write(*,nfmt,advance='no') d7(h2:h2+8)
write(*,cfmt,advance='no') d7(81:88)
write(*,nfmt,advance='no') d7(m1:m1+8)
write(*,nfmt,advance='no') d7(m2:m2+8)
write(*,cfmt,advance='no') d7(81:88)
write(*,nfmt,advance='no') d7(s1:s1+8)
write(*,nfmt) d7(s2:s2+8)

write(*,nfmt,advance='no') d8(h1:h1+8)
write(*,nfmt,advance='no') d8(h2:h2+8)
write(*,cfmt,advance='no') d8(81:88)
write(*,nfmt,advance='no') d8(m1:m1+8)
write(*,nfmt,advance='no') d8(m2:m2+8)
write(*,cfmt,advance='no') d8(81:88)
write(*,nfmt,advance='no') d8(s1:s1+8)
write(*,nfmt) d8(s2:s2+8)

write(*,nfmt,advance='no') d9(h1:h1+8)
write(*,nfmt,advance='no') d9(h2:h2+8)
write(*,cfmt,advance='no') d9(81:88)
write(*,nfmt,advance='no') d9(m1:m1+8)
write(*,nfmt,advance='no') d9(m2:m2+8)
write(*,cfmt,advance='no') d9(81:88)
write(*,nfmt,advance='no') d9(s1:s1+8)
write(*,nfmt) d9(s2:s2+8)

end subroutine


DIM SHARED angle AS DOUBLE

SUB turn (degrees AS DOUBLE)
    angle = angle + degrees*3.14159265/180
END SUB

SUB forward (length AS DOUBLE)
    LINE - STEP (COS(angle)*length, SIN(angle)*length), 7
END SUB

SUB dragon (length AS DOUBLE, split AS INTEGER, d AS DOUBLE)
    IF split=0 THEN
        forward length
    ELSE
	turn d*45
	dragon length/1.4142136, split-1, 1
	turn -d*90
	dragon length/1.4142136, split-1, -1
	turn d*45
    END IF
END SUB

' Main program

SCREEN 12
angle = 0
PSET (150,180), 0
dragon 400, 12, 1
SLEEP


/**
This is a documentation comment for someFunc and someFunc2.
$(DDOC_COMMENT comment inside a documentation comment
(results in a HTML comment not displayed by the browser))

Header:
    content (does not need to be tabbed out; this is done for clarity
    of the comments and has no effect on the resulting documentation)

Params:
    arg1 = Something (listed as "int <i>arg1</i> Something")
    arg2 = Something else

Returns:
    Nothing

TODO:
    Nothing at all

BUG:
    None found
*/
void someFunc(int arg1, int arg2) {}

// This groups this function with the above (both have the
//  same doc and are listed together)
/// ditto
void someFunc2(int arg1, int arg2) {}

/// Sum function.
int sum(in int x, in int y) pure nothrow {
    return x + y;
}

// These unittests will become part of sum documentation:
///
unittest {
    assert(sum(2, 3) == 5);
}

/++ Another documentation comment +/
void main() {}


type
  /// Sample class.
  TMyClass = class
  public
    /// Converts a string into a number.
    /// <param name="aValue">String parameter</param>
    /// <returns>Numeric equivalent of aValue</returns>
    /// <exception cref="EConvertError">aValue is not a valid integer.</exception>
    function StringToNumber(aValue: string): Integer;
  end;


? /** This is an object with documentation */
> def foo {
>   # ...
> }
# value: <foo>

? foo.__getAllegedType().getDocComment()
# value: " This is an object with documentation "


note
	description: "Objects that model Times of Day: 00:00:00 - 23:59:59"
	author: "Eiffel Software Construction Students"

class
    TIME_OF_DAY
create
    make

feature -- Initialization

    make
            -- Initialize to 00:00:00
        do
            hour := 0
            minute := 0
            second := 0
        ensure
            initialized: hour   = 0 and
                    minute = 0 and
                    second = 0
        end

feature -- Access

    hour:   INTEGER
            -- Hour expressed as 24-hour value

    minute: INTEGER
            -- Minutes past the hour

    second: INTEGER
            -- Seconds past the minute

feature -- Element change

    set_hour (h: INTEGER)
            -- Set the hour from `h'
        require
            argument_hour_valid: 0 <= h and h <= 23
        do
            hour := h
        ensure
            hour_set: hour = h
            minute_unchanged: minute = old minute
            second_unchanged: second = old second
        end

    set_minute (m: INTEGER)
            -- Set the minute from `m'
        require
            argument_minute_valid: 0 <= m and m <= 59
        do
            minute := m
        ensure
            minute_set: minute = m
            hour_unchanged: hour = old hour
            second_unchanged: second = old second
        end

    set_second (s: INTEGER)
            -- Set the second from `s'
        require
            argument_second_valid: 0 <= s and s <= 59
        do
            second := s
        ensure
            second_set: second = s
            hour_unchanged: hour = old hour
            minute_unchanged: minute = old minute
        end

feature {NONE} -- Implementation

    protected_routine
            -- A protected routine (not available to client classes)
            -- Will not be present in documentation (Contract) view
        do

        end

invariant

    hour_valid:   0 <= hour   and hour   <= 23
    minute_valid: 0 <= minute and minute <= 59
    second_valid: 0 <= second and second <= 59

end -- class TIME_OF_DAY


# Project : Draw a cuboid

load "guilib.ring"

paint = null

new qapp
        {
        win1 = new qwidget() {
                  setwindowtitle("Draw a cuboid")
                  setgeometry(100,100,500,600)
                  label1 = new qlabel(win1) {
                              setgeometry(10,10,400,400)
                              settext("")
                  }
                  new qpushbutton(win1) {
                          setgeometry(150,500,100,30)
                          settext("draw")
                          setclickevent("draw()")
                  }
                  show()
        }
        exec()
        }

func draw
        p1 = new qpicture()
               color = new qcolor() {
               setrgb(0,0,255,255)
        }
        pen = new qpen() {
                 setcolor(color)
                 setwidth(1)
        }
        paint = new qpainter() {
                  begin(p1)
                  setpen(pen)

        color = new qcolor()
        color.setrgb(255,0,0,255)
        mybrush = new qbrush() {setstyle(1) setcolor(color)}
        setbrush(mybrush)
        paint.drawPolygon([[200,200],[300,200],[300,100],[200,100]], 0)
        color = new qcolor()
        color.setrgb(0,255,0,255)
        mybrush = new qbrush() {setstyle(1) setcolor(color)}
        setbrush(mybrush)
        paint.drawPolygon([[200,100],[250,50],[350,50],[300,100]], 0)
        color = new qcolor()
        color.setrgb(0, 0, 255,255)
        mybrush = new qbrush() {setstyle(1) setcolor(color)}
        setbrush(mybrush)
        paint.drawPolygon([[350,50],[350,150],[300,200],[300,100]], 0)

        endpaint()
        }
        label1 { setpicture(p1) show() }
        return


X, Y, Z = 6, 2, 3
DIR = {"-" => [1,0], "|" => [0,1], "/" => [1,1]}

def cuboid(nx, ny, nz)
  puts "cuboid %d %d %d:" % [nx, ny, nz]
  x, y, z = X*nx, Y*ny, Z*nz
  area = Array.new(y+z+1){" " * (x+y+1)}
  draw_line = lambda do |n, sx, sy, c|
    dx, dy = DIR[c]
    (n+1).times do |i|
      xi, yi = sx+i*dx, sy+i*dy
      area[yi][xi] = (area[yi][xi]==" " ? c : "+")
    end
  end
  nz    .times {|i| draw_line[x,     0,   Z*i, "-"]}
  (ny+1).times {|i| draw_line[x,   Y*i, z+Y*i, "-"]}
  nx    .times {|i| draw_line[z,   X*i,     0, "|"]}
  (ny+1).times {|i| draw_line[z, x+Y*i,   Y*i, "|"]}
  nz    .times {|i| draw_line[y,     x,   Z*i, "/"]}
  (nx+1).times {|i| draw_line[y,   X*i,     z, "/"]}
  puts area.reverse
end

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


(load "@lib/openGl.l")

(glutInit)
(glutInitDisplayMode (| GLUT_RGBA GLUT_DOUBLE GLUT_ALPHA GLUT_DEPTH))
(glutInitWindowSize 400 400)
(glutCreateWindow "Sphere")

(glEnable GL_LIGHTING)
(glEnable GL_LIGHT0)
(glLightiv GL_LIGHT0 GL_POSITION (10 10 -10 0))

(glEnable GL_COLOR_MATERIAL)
(glColorMaterial GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE)

(glClearColor 0.3 0.3 0.5 0)
(glColor4f 0.0 0.8 0.0 1.0)

(displayPrg
   (glClear (| GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
   (glutSolidSphere 0.9 40 32)
   (glFlush)
   (glutSwapBuffers) )

# Exit upon mouse click
(mouseFunc '((Btn State X Y) (bye)))
(glutMainLoop)


%!PS-Adobe-3.0
%%BoundingBox 0 0 300 300

150 150 translate 0 0 130 0 360 arc

/Pattern setcolorspace
<<      /PatternType    2
        /Shading <<
                /ShadingType    3
                /ColorSpace     /DeviceRGB
                /Coords         [-60 60 0 0 0 100]
                /Function <<
                        /FunctionType   2
                        /Domain         [0 1]
                        /C0             [1 1 1]
                        /C1             [0 0 0]
                        /N              2
                >>
        >>
>> matrix makepattern setcolor fill

showpage
%%EOF