Data update

Task/Color-wheel/Ada/color-wheel.adb

@@ -0,0 +1,89 @@
+with Ada.Numerics;                      use Ada.Numerics;
+with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;
+with Ada.Text_IO;                       use Ada.Text_IO;
+procedure Color_Wheel is
+   type Colour_Level is mod 2 ** 8;
+   type RGB is record
+      R, G, B : Colour_Level;
+   end record;
+   BLACK : constant RGB := (0, 0, 0);
+   type Image_Grid is array (Integer range <>, Integer range <>) of RGB;
+
+   Diameter  : constant Integer := 480;
+   Radius    : constant Integer := Diameter / 2;
+   Radius_Fl : constant Float   := Float (Radius);
+   Image     : Image_Grid (-Radius .. Radius, -Radius .. Radius);
+   V         : constant Float   := 1.0;
+
+   procedure Write_PPM (Grid : Image_Grid; Filename : String) is
+      PPM_File : File_Type;
+   begin
+      Create (PPM_File, Out_File, Filename);
+      Put_Line (PPM_File, "P3");
+      Put_Line (PPM_File, Grid'Length (1)'Image & Grid'Length (2)'Image);
+      Put_Line (PPM_File, "255");
+      for Y in reverse -Radius .. Radius loop
+         for X in -Radius .. Radius loop
+            Put_Line (PPM_File, Grid (X, Y).R'Image & Grid (X, Y).G'Image & Grid (X, Y).B'Image);
+         end loop;
+      end loop;
+      Close (PPM_File);
+   end Write_PPM;
+
+   function Atan2 (Y, X : Float) return Float is
+      Res : Float;
+   begin
+      if X > 0.0 then Res := Arctan (Y / X);
+      elsif X < 0.0 and then Y >= 0.0 then Res := Arctan (Y / X) + Pi;
+      elsif X < 0.0 and then Y < 0.0  then Res := Arctan (Y / X) - Pi;
+      elsif X = 0.0 and then Y > 0.0  then Res := Pi / 2.0;
+      elsif X = 0.0 and then Y > 0.0  then Res := -Pi / 2.0;
+      else Res := -Pi / 2.0;  --  Technically: Undefined
+      end if;
+      return Res;
+   end Atan2;
+begin
+   for Y in -Radius .. Radius loop
+      for X in -Radius .. Radius loop
+         declare
+            XX   : constant Float := Float (X);
+            YY   : constant Float := Float (Y);
+            Dist : constant Float := Sqrt (XX ** 2 + YY ** 2);
+            Hue_Int, Hue_Frac, P, Q, T : Float;
+            Point : RGB;
+         begin
+            if Dist <= Radius_Fl then
+               declare
+                  Sat  : constant Float := Dist / Radius_Fl;
+                  Hue  : Float := Atan2 (YY, XX);
+                  RR, GG, BB : Float;
+               begin
+                  if Hue < 0.0 then Hue := Hue + 2.0 * Pi; end if;
+                  Hue := (Hue * 180.0 / Pi) / 60.0;
+                  Hue_Int  := Float'Floor (Hue);
+                  Hue_Frac := Hue - Hue_Int;
+                  P := V - Sat;
+                  Q := V - Sat * Hue_Frac;
+                  T := V - Sat * (V - Hue_Frac);
+                  case Integer (Hue_Int) is
+                     when 0 => RR := V; GG := T; BB := P;
+                     when 1 => RR := Q; GG := V; BB := P;
+                     when 2 => RR := P; GG := V; BB := T;
+                     when 3 => RR := P; GG := Q; BB := V;
+                     when 4 => RR := T; GG := P; BB := V;
+                     when 5 => RR := V; GG := P; BB := Q;
+                     when others => null;
+                  end case;
+                  Point.R := Colour_Level (Integer (Float'Floor (RR * 255.0)));
+                  Point.G := Colour_Level (Integer (Float'Floor (GG * 255.0)));
+                  Point.B := Colour_Level (Integer (Float'Floor (BB * 255.0)));
+                  Image (X, Y) := Point;
+               end;
+            else
+               Image (X, Y) := BLACK;
+            end if;
+         end;
+      end loop;
+   end loop;
+   Write_PPM (Image, "color_wheel.ppm");
+end Color_Wheel;

Task/Color-wheel/Crystal/color-wheel.cr

@@ -0,0 +1,17 @@
+require "complex"
+require "crimage"
+
+R = 70
+
+img = CrImage.rgba(R*2, R*2, CrImage::Color::WHITE)
+
+(-R...R).each do |y|
+  (-R...R).each do |x|
+    c = Complex.new(x, y)
+    length, angle = c.polar
+    next unless length <= R
+    img[x+R, y+R] = CrImage::Color::HSV.new(angle * (180.0 / Math::PI), length/R, 1.0)
+  end
+end
+
+CrImage.write("color_wheel_crystal.png", img)

Task/Color-wheel/Emacs-Lisp/color-wheel.el

@@ -0,0 +1,75 @@
+(defun make-colors ()
+  "Make a list of colors in RGB format."
+  (let ((red #xff)
+      (green #x0)
+      (blue #x0)
+      (colors))
+  (while (<= green #xff)
+    (push (format "#%02x%02x%02x" red green blue) colors)
+    (setq green (+ green #x11)))
+  (setq green #xff)
+  (while (>= red #x0)
+    (push (format "#%02x%02x%02x" red green blue) colors)
+    (setq red (- red #x11)))
+  (setq red #x0)
+  (while (<= blue #xff)
+    (push (format "#%02x%02x%02x" red green blue) colors)
+    (setq blue (+ blue #x11)))
+  (setq blue #xff)
+  (while (>= green #x0)
+    (push (format "#%02x%02x%02x" red green blue) colors)
+    (setq green (- green #x11)))
+  (setq green #x0)
+  (while (<= red #xff)
+    (push (format "#%02x%02x%02x" red green blue) colors)
+    (setq red (+ red #x11)))
+  (reverse colors)))
+
+(defun sample-colors (sample-size colors)
+  "Get SAMPLE-SIZE number from COLORS"
+  (let* ((total-colors (length colors))
+         (interval (/ (float (- total-colors 1)) (float (- sample-size 1))))
+         (color-position-in-list 0)
+         (samples))
+    (while (< color-position-in-list total-colors)
+      (push (nth (round color-position-in-list) colors) samples)
+      (setq color-position-in-list (+ interval color-position-in-list)))
+    samples))
+
+(defun correct-y (reversed-y)
+  "Correct REVERSED-Y to work with Cartesian coordinates.
+This function assumes that the y-axis size of the svg-create command
+is 400. If it has another value, then the 400 below would need to be
+changed. This function is necessary because svg has y axis values
+increasing in a downward direction, the opposite of Cartesian
+coordinates."
+  (- 400 reversed-y))
+
+(defun plot-triangle (svg h k r angle1 angle2 fill-color)
+  "Create svg code for triangle inscribed in circle.
+Circle center and one point of the triangle is located at point H and
+K. Other two points of the triangle are on the circle
+circumference. Radius of circle is R. ANGLE is angle in radians of point
+on circle relative to the circle center."
+  (let ((x1)
+        (y1)
+        (x2)
+        (y2))
+    (setq x1 (+ (* r (cos angle1)) h))
+    (setq y1 (+ (* r (sin angle1)) k))
+    (setq y1 (correct-y y1))
+    (setq x2 (+ (* r (cos angle2)) h))
+    (setq y2 (+ (* r (sin angle2)) k))
+    (setq y2 (correct-y y2))
+    (svg-polygon svg (list (cons x1 y1) (cons x2 y2) (cons h  k)) :fill-color fill-color)))
+
+(defun color-wheel (number-of-colors)
+  "Create a color-wheel with NUMBER-OF-COLORS."
+  (let ((angle 0)
+        (portion-of-circle (/ (* 2 float-pi) number-of-colors))
+        (colors (sample-colors number-of-colors (make-colors)))
+        (svg (svg-create 400 400 :stroke-width 0 :stroke-color "red")))
+    (dolist (color colors)
+      (plot-triangle svg 200 200 200 angle (+ angle portion-of-circle) color)
+      (setq angle (+ angle portion-of-circle)))
+    (insert-image (svg-image svg))))

Task/Color-wheel/Odin/color-wheel.odin

@@ -0,0 +1,89 @@
+package main
+
+import "core:bytes"
+import "core:fmt"
+import "core:image/bmp"
+import "core:math"
+import "core:math/linalg"
+
+Vec2 :: [2]f32
+Color :: bmp.RGB_Pixel
+
+// Adapted from
+// https://github.com/raysan5/raylib/blob/5aa3f0ccc374c1fbfc880402b37871b9c3bb7d8e/src/rtextures.c#L4936
+//
+// Hue is provided in degrees: [0..360]
+//
+// Saturation/Value are provided normalized: [0.0f..1.0f]
+from_hsv :: proc(hue, saturation, value: f32) -> Color {
+	pixel := Color{0, 0, 0}
+	k, t: f32
+
+	// Red channel
+	k = math.mod((5.0 + hue / 60.0), 6)
+	t = 4.0 - k
+	k = (t < k) ? t : k
+	k = (k < 1) ? k : 1
+	k = (k > 0) ? k : 0
+	pixel.r = u8((value - value * saturation * k) * 255.0)
+
+	// Green channel
+	k = math.mod((3.0 + hue / 60.0), 6)
+	t = 4.0 - k
+	k = (t < k) ? t : k
+	k = (k < 1) ? k : 1
+	k = (k > 0) ? k : 0
+	pixel.g = u8((value - value * saturation * k) * 255.0)
+
+	// Blue channel
+	k = math.mod((1.0 + hue / 60.0), 6)
+	t = 4.0 - k
+	k = (t < k) ? t : k
+	k = (k < 1) ? k : 1
+	k = (k > 0) ? k : 0
+	pixel.b = u8((value - value * saturation * k) * 255.0)
+
+	return pixel
+}
+
+main :: proc() {
+	img_size :: 1000
+	img_buff: bytes.Buffer
+	img := bmp.Image {
+		width    = img_size,
+		height   = img_size,
+		channels = 3,
+		depth    = 8,
+		pixels   = img_buff,
+		which    = .BMP,
+	}
+	bmp.make_output(&img)
+
+	for x in 0 ..< img_size {
+		for y in 0 ..< img_size {
+			radius :: img_size / 2
+			center :: Vec2{radius, radius}
+			color := Color{0x1e, 0x1e, 0x1e}
+
+			fx, fy := f32(x), f32(y)
+
+			// if distance from current pixel to center of image is less than radius - we inside of the colorwheel
+			dist := linalg.distance(center, Vec2{fx, fy})
+			if (dist <= radius) {
+				// angle between x-axis and line from center to pixel in radians
+				angle := math.atan2(fx - center.x, fy - center.y)
+				// convert from radian to degree
+				hue := angle * (180 / math.PI)
+				// normalize distance to [0..1] range and use as saturation
+				sat := dist / radius
+				color = from_hsv(hue, sat, 1)
+			}
+			err := bmp.write(&img, x, y, color)
+			if err != nil do fmt.panicf("Error writing pixel: ", err)
+		}
+	}
+
+	err := bmp.save_to_file("wheel.bmp", &img)
+	if err != nil do fmt.panicf("Error saving image: ", err)
+	bytes.buffer_destroy(&img_buff)
+}

Task/Color-wheel/Pluto/color-wheel.pluto

@@ -0,0 +1,21 @@
+require "bitmap"
+
+local w, h = 640, 640
+local bmp = bitmap.of(w, h, color.black, "Color_wheel")
+local cx = w // 2
+local cy = h // 2
+local r = (cx < cy) ? cx : cy
+for y = 0, h - 1 do
+    local dy = y - cy
+    for x = 0, w - 1 do
+        local dx = x - cx
+        local dist = math.sqrt(dx * dx + dy * dy)
+        if dist <= r then
+            local theta = math.atan(dy, dx)
+            local hue = (theta + math.pi) / math.pi * 180
+            local col = bitmap.hsvColor(hue, dist / r, 1)
+            bmp:set(x, y, col)
+        end
+    end
+end
+bmp:view()

Task/Color-wheel/Uiua/color-wheel.uiua

@@ -0,0 +1,2 @@
+H ← °hsv[⊃(∠°⊟|+0.5÷100⍜(ⁿ2|/+)|⨬(1|0)>40⍜(ⁿ2|/+))]-40_40
+▽₂2∧(∧(⍜(⊡|◌)⊃(⊙∘|H)⊟)⇡80)⇡80↯80_80_3Black

Task/Color-wheel/V-(Vlang)/color-wheel.v

@@ -0,0 +1,69 @@
+import gg
+import gx
+import math
+
+const width  = 320
+const height = 320
+
+struct App {
+	mut:
+    cx int = width / 2
+    cy int = height / 2
+    r  int = if width / 2 < height / 2 { width / 2 } else { height / 2 }
+}
+
+fn hsv_to_rgb(h f32, s f32, v f32) gx.Color {
+    c := v * s
+    h_prime := h / 60.0
+    x := c * (1 - math.abs(math.fmod(f64(h_prime), 2) - 1))
+    m := v - c
+    mut r, mut g, mut b := 0.0, 0.0, 0.0
+    match int(h_prime) {
+        0 { r, g, b = c, x, 0 }
+        1 { r, g, b = x, c, 0 }
+        2 { r, g, b = 0, c, x }
+        3 { r, g, b = 0, x, c }
+        4 { r, g, b = x, 0, c }
+        5, 6 { r, g, b = c, 0, x }
+        else { r, g, b = 0, 0, 0 }
+    }
+    rrr := u8(math.min((r + m) * 255, 255))
+    ggg := u8(math.min((g + m) * 255, 255))
+    bbb := u8(math.min((b + m) * 255, 255))
+    return gx.rgb(rrr, ggg, bbb)
+}
+
+fn main() {
+    mut app := &App{}
+    mut context := gg.new_context(
+        width: width
+        height: height
+        window_title: "Color Wheel"
+        frame_fn: frame
+        user_data: app
+        bg_color: gx.black
+    )
+    context.run()
+}
+
+fn frame(mut app App) {
+    mut ctx := gg.Context{}
+    ctx.begin()
+    for y in 0 .. height {
+        dy := app.cy - y
+        for x in 0 .. width {
+            dx := x - app.cx
+            dist := math.sqrt(f64(dx * dx + dy * dy))
+            if dist < f64(app.r) {
+                mut angle := math.atan2(f64(dy), f64(dx)) * 180 / math.pi
+                if angle < 0 { angle += 360 }
+                s := f32(dist / f64(app.r))
+                v := f32(1.0)
+                col := hsv_to_rgb(f32(angle), s, v)
+				// `draw_pixel` not best for large width and height
+                ctx.draw_pixel(f32(x), f32(y), col, size: 1)
+            }
+        }
+    }
+    ctx.end()
+}

Task/Color-wheel/VBScript/color-wheel.vbs

@@ -0,0 +1,277 @@
+Option explicit
+
+Class ImgClass
+  Private ImgL,ImgH,ImgDepth,bkclr,loc,tt
+  private xmini,xmaxi,ymini,ymaxi,dirx,diry
+  public ImgArray()  'rgb in 24 bit mode, indexes to palette in 8 bits
+  private filename
+  private Palette,szpal
+
+  public property get xmin():xmin=xmini:end property
+  public property get ymin():ymin=ymini:end property
+  public property get xmax():xmax=xmaxi:end property
+  public property get ymax():ymax=ymaxi:end property
+  public property let depth(x)
+  if x<>8 and x<>32 then err.raise 9
+  Imgdepth=x
+  end property
+
+  public sub set0 (x0,y0) 'sets the new origin (default tlc). The origin does'nt work if ImgArray is accessed directly
+    if x0<0 or x0>=imgl or y0<0 or y0>imgh then err.raise 9
+    xmini=-x0
+    ymini=-y0
+    xmaxi=xmini+imgl-1
+    ymaxi=ymini+imgh-1
+  end sub
+
+  'constructor
+  Public Default Function Init(name,w,h,orient,dep,bkg,mipal)
+  'offx, offy posicion de 0,0. si ofx+ , x se incrementa de izq a der, si offy+ y se incrementa de abajo arriba
+  dim i,j
+  ImgL=w
+  ImgH=h
+  tt=timer
+  loc=getlocale
+  ' not useful as we are not using SetPixel and accessing  ImgArray directly
+  set0 0,0   'origin blc positive up and right
+  redim imgArray(ImgL-1,ImgH-1)
+  bkclr=bkg
+  if bkg<>0 then
+    for i=0 to ImgL-1
+      for j=0 to ImgH-1
+        imgarray(i,j)=bkg
+      next
+    next
+  end if
+  Select Case orient
+    Case 1: dirx=1 : diry=1
+    Case 2: dirx=-1 : diry=1
+    Case 3: dirx=-1 : diry=-1
+    Case 4: dirx=1 : diry=-1
+  End select
+  filename=name
+  ImgDepth =dep
+  'load user palette if provided
+  if imgdepth=8 then
+    loadpal(mipal)
+  end if
+  set init=me
+  end function
+
+  private sub loadpal(mipale)
+    if isarray(mipale) Then
+      palette=mipale
+      szpal=UBound(mipale)+1
+    Else
+      szpal=256
+    'Default palette recycled from ATARI
+    'removed
+
+, not relevant
+   End if
+  End Sub
+
+
+  'class termination writes it to a BMP file and displays it
+  'if an error happens VBS terminates the class before exiting so the BMP is displayed the same
+  Private Sub Class_Terminate
+
+    if err<>0 then wscript.echo "Error " & err.number
+    wscript.echo "copying image to bmp file"
+    savebmp
+    wscript.echo "opening " & filename & " with your default bmp viewer"
+    CreateObject("Shell.Application").ShellExecute filename
+    wscript.echo timer-tt & "  iseconds"
+  End Sub
+
+    function long2wstr( x)  'falta muy poco!!!
+      dim k1,k2,x1
+      k1=  (x and &hffff&)' or (&H8000& And ((X And &h8000&)<>0)))
+      k2=((X And &h7fffffff&) \ &h10000&) Or (&H8000& And (x<0))
+      long2wstr=chrw(k1) & chrw(k2)
+    end function
+
+    function int2wstr(x)
+        int2wstr=ChrW((x and &h7fff) or (&H8000 And (X<0)))
+    End Function
+
+
+   Public Sub SaveBMP
+    'Save the picture to a bmp file
+    Dim s,ostream, x,y,loc
+
+    const hdrs=54 '14+40
+    dim bms:bms=ImgH* 4*(((ImgL*imgdepth\8)+3)\4)  'bitmap size including padding
+    dim palsize:if (imgdepth=8) then palsize=szpal*4 else palsize=0
+
+    with  CreateObject("ADODB.Stream") 'auxiliary ostream, it creates an UNICODE with bom stream in memory
+      .Charset = "UTF-16LE"    'o "UTF16-BE"
+      .Type =  2' adTypeText
+      .open
+
+      'build a header
+      'bmp header: VBSCript does'nt have records nor writes binary values to files, so we use strings of unicode chars!!
+      'BMP header
+      .writetext ChrW(&h4d42)                           ' 0 "BM" 4d42
+      .writetext long2wstr(hdrs+palsize+bms)            ' 2 fiesize
+      .writetext long2wstr(0)                           ' 6  reserved
+      .writetext long2wstr (hdrs+palsize)               '10 image offset
+       'InfoHeader
+      .writetext long2wstr(40)                          '14 infoheader size
+      .writetext long2wstr(Imgl)                        '18 image length
+      .writetext long2wstr(imgh)                        '22 image width
+      .writetext int2wstr(1)                            '26 planes
+      .writetext int2wstr(imgdepth)                     '28 clr depth (bpp)
+      .writetext long2wstr(&H0)                         '30 compression used 0= NOCOMPR
+
+      .writetext long2wstr(bms)                         '34 imgsize
+      .writetext long2wstr(&Hc4e)                       '38 bpp hor
+      .writetext long2wstr(&hc43)                       '42 bpp vert
+      .writetext long2wstr(szpal)                       '46  colors in palette
+      .writetext long2wstr(&H0)                         '50 important clrs 0=all
+
+      'write bitmap
+      'precalc data for orientation
+       Dim x1,x2,y1,y2
+       If dirx=-1 Then x1=ImgL-1 :x2=0 Else x1=0:x2=ImgL-1
+       If diry=-1 Then y1=ImgH-1 :y2=0 Else y1=0:y2=ImgH-1
+
+      Select Case imgdepth
+
+      Case 32
+        For y=y1 To y2  step diry
+          For x=x1 To x2 Step dirx
+           'writelong fic, Pixel(x,y)
+           .writetext long2wstr(Imgarray(x,y))
+          Next
+        Next
+
+      Case 8
+        'palette
+        For x=0 to szpal-1
+          .writetext long2wstr(palette(x))  '52
+        Next
+        'image
+        dim pad:pad=ImgL mod 4
+        For y=y1 to y2 step diry
+          For x=x1 To x2 step dirx*2
+             .writetext chrw((ImgArray(x,y) and 255)+ &h100& *(ImgArray(x+dirx,y) and 255))
+          Next
+          'line padding
+          if pad and 1 then .writetext  chrw(ImgArray(x2,y))
+          if pad >1 then .writetext  chrw(0)
+         Next
+
+      Case Else
+        WScript.Echo "ColorDepth not supported : " & ImgDepth & " bits"
+      End Select
+
+      'use a second stream to save to file starting past the BOM  the first ADODB.Stream has added
+      Dim outf:Set outf= CreateObject("ADODB.Stream")
+      outf.Type    = 1 ' adTypeBinary
+      outf.Open
+      .position=2              'remove bom (1 wchar)
+      .CopyTo outf
+      .close
+      outf.savetofile filename,2   'adSaveCreateOverWrite
+      outf.close
+    end with
+  End Sub
+end class
+
+
+
+function hsv2rgb( Hue, Sat, Value) 'hue 0-360   0-ro 120-ver 240-az ,sat 0-100,value 0-100
+  dim Angle, Radius,Ur,Vr,Wr,Rdim
+  dim r,g,b, rgb
+  Angle = (Hue-150) *0.01745329251994329576923690768489
+  Ur = Value * 2.55
+  Radius = Ur * tan(Sat *0.01183199)
+  Vr = Radius * cos(Angle) *0.70710678  'sqrt(1/2)
+  Wr = Radius * sin(Angle) *0.40824829  'sqrt(1/6)
+  r = (Ur - Vr - Wr)
+  g = (Ur + Vr - Wr)
+  b = (Ur + Wr + Wr)
+
+  'clamp values
+ if r >255 then
+   Rdim = (Ur - 255) / (Vr + Wr)
+   r = 255
+   g = Ur + (Vr - Wr) * Rdim
+   b = Ur + 2 * Wr * Rdim
+ elseif r < 0 then
+   Rdim = Ur / (Vr + Wr)
+   r = 0
+   g = Ur + (Vr - Wr) * Rdim
+   b = Ur + 2 * Wr * Rdim
+ end if
+
+ if g >255 then
+   Rdim = (255 - Ur) / (Vr - Wr)
+   r = Ur - (Vr + Wr) * Rdim
+   g = 255
+   b = Ur + 2 * Wr * Rdim
+ elseif g<0 then
+   Rdim = -Ur / (Vr - Wr)
+   r = Ur - (Vr + Wr) * Rdim
+   g = 0
+   b = Ur + 2 * Wr * Rdim
+ end if
+ if b>255 then
+   Rdim = (255 - Ur) / (Wr + Wr)
+   r = Ur - (Vr + Wr) * Rdim
+   g = Ur + (Vr - Wr) * Rdim
+   b = 255
+ elseif b<0 then
+   Rdim = -Ur / (Wr + Wr)
+   r = Ur - (Vr + Wr) * Rdim
+   g = Ur + (Vr - Wr) * Rdim
+   b = 0
+ end If
+ 'b lowest byte, red highest byte
+ hsv2rgb= ((b and &hff)+256*((g and &hff)+256*(r and &hff))and &hffffff)
+end function
+
+function ang(col,row)
+    'if col =0 then  if row>0 then ang=0 else ang=180:exit function
+    if col =0 then
+      if row<0 then ang=90 else ang=270 end if
+    else
+   if col>0 then
+      ang=atn(-row/col)*57.2957795130
+   else
+     ang=(atn(row/-col)*57.2957795130)+180
+  end if
+  end if
+   ang=(ang+360) mod 360
+end function
+
+
+Dim X,row,col,fn,tt,hr,sat,row2
+const h=160
+const w=160
+const rad=159
+const r2=25500
+tt=timer
+fn=CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2)& "\testwchr.bmp"
+Set X = (New ImgClass)(fn,w*2,h*2,1,32,0,0)
+
+x.set0 w,h
+'wscript.echo x.xmax, x.xmin
+
+for row=x.xmin+1 to x.xmax
+   row2=row*row
+   hr=int(Sqr(r2-row2))
+   For col=hr To 159
+     Dim a:a=((col\16 +row\16) And 1)* &hffffff
+     x.imgArray(col+160,row+160)=a
+     x.imgArray(-col+160,row+160)=a
+   next
+   for col=-hr to hr
+     sat=100-sqr(row2+col*col)/rad *50
+    ' wscript.echo c,r
+     x.imgArray(col+160,row+160)=hsv2rgb(ang(row,col)+90,100,sat)
+    next
+    'script.echo row
+  next
+Set X = Nothing