import Base.show, Base.parse, Base.+, Base.-, Base.*, Base./, Base.^

function inbase4(charvec::Vector)
    if (!all(x -> x in ['-', '0', '1', '2', '3', '.'], charvec)) ||
        ((x = findlast(x -> x == '-', charvec)) != nothing && x > findfirst(x -> x != '-', charvec)) ||
        ((x = findall(x -> x == '.', charvec)) != nothing && length(x) > 1)
        return false
    end
    true
end
inbase4(s::String) = inbase4(split(s, ""))

abstract type ImaginaryBaseNumber <: Number end

struct QuaterImaginary <: ImaginaryBaseNumber
    cvector::Vector{Char}
    isnegative::Bool
end

function QuaterImaginary(charvec::Vector{Char})
    isneg = false
    if !inbase4(charvec)
        throw("Constructor vector for QuaterImaginary ($charvec) is not base 2i")
    elseif (i = length(findall(x -> x == '-', charvec))) > 0
        isneg = (-1) ^ i == -1
    end
    while length(charvec) > 1 && charvec[1] == '0' && charvec[2] != '.'
        popfirst!(charvec)
    end
    if (i = findfirst(x -> x == '.', charvec)) != nothing
        while length(charvec) > 3 && charvec[end] == '0' && charvec[end-1] != '.'
            pop!(charvec)
        end
    end
    if charvec[1] == '.'
            pushfirst!(charvec, '0')
    end
    if charvec[end] == '.'
        pop!(charvec)
    end
    QuaterImaginary(filter!(x -> x in ['0', '1', '2', '3', '.'], charvec), isneg)
end

function QuaterImaginary(s::String = "0")
    if match(r"^-?[0123\.]+$", s) == nothing
        throw("String constructor argument <$s> for QuaterImaginary is not base 2i")
    end
    QuaterImaginary([s[i] for i in 1:length(s)])
end

show(io::IO, qim::QuaterImaginary) = print(io, qim.isnegative ? "-" : "", join(qim.cvector, ""))

function parse(QuaterImaginary, x::Complex)
    sb = Vector{Char}()
    rea, ima = Int(floor(real(x))), Int(floor(imag(x)))
    if floor(real(x)) != rea || floor(imag(x)) != ima
        throw("Non-integer real and complex portions of complex numbers are not supported for QuaterImaginary")
    elseif rea == 0 == ima
        return QuaterImaginary(['0'])
    else
        fi = -1
        while rea != 0
            rea, rem = divrem(rea, -4)
            if rem < 0
                rem += 4
                rea += 1
            end
            push!(sb, Char(rem + '0'), '0')
        end
        if ima != 0
            f = real((ima * im)/(2im))
            ima = Int(ceil(f))
            f = -4.0 * (f - ima)
            idx = 1
            while ima != 0
                ima, rem = divrem(ima, -4)
                if rem < 0
                    rem += 4
                    ima += 1
                end
                if idx < length(sb)
                    sb[idx + 1] = Char(rem + '0')
                else
                    push!(sb, '0', Char(rem + '0'))
                end
                idx += 2
            end
            fi = Int(floor(f))
        end
        sb = reverse(sb)
        if fi != -1
            push!(sb, '.')
            append!(sb, map(x -> x[1], split(string(fi), "")))
        end
    end
    QuaterImaginary(sb)
end

function parse(Complex, qim::QuaterImaginary)
    pointpos = ((x = indexin('.', qim.cvector))[1] == nothing) ? -1 : x[1]
    poslen = (pointpos != -1) ? pointpos : length(qim.cvector) + 1
    qsum = 0.0 + 0.0im
    prod = 1.0 + 0.0im
    for j in 1:poslen-1
        k = Float64(qim.cvector[poslen - j] - '0')
        if k > 0.0
            qsum += prod * k
        end
        prod *= 2im
    end
    if pointpos != -1
        prod = inv(2im)
        for j in poslen+1:length(qim.cvector)
            k = Float64(qim.cvector[j] - '0')
            if k > 0.0
                qsum += prod * k
            end
            prod *= inv(2im)
        end
    end
    qsum
end

function testquim()
    function printcqc(c)
        q = parse(QuaterImaginary, Complex(c))
        c2 = parse(Complex, q)
        if imag(c2) == 0
            c2 = Int(c2)
        end
        print(lpad(c, 10), " -> ", lpad(q, 10), " -> ", lpad(c2, 12))
    end
    for i in 1:16
        printcqc(i)
        print("       ")
        printcqc(-i)
        println()
    end
    println()
    for i in 1:16
        c1 = Complex(0, i)
        printcqc(c1)
        print("       ")
        printcqc(-c1)
        println()
    end
end

QuaterImaginary(c::Complex) = parse(QuaterImaginary, c)
Complex(q::QuaterImaginary) = parse(Complex, q)

+(q1::QuaterImaginary, q2::QuaterImaginary) = QuaterImaginary(Complex(q1) + Complex(q2))
+(q1::Complex, q2::QuaterImaginary) = q1 + Complex(q2)
+(q1::QuaterImaginary, q2::Complex) = Complex(q1) + q2
-(q1::QuaterImaginary, q2::QuaterImaginary) = QuaterImaginary(Complex(q1) - Complex(q2))
-(q1::Complex, q2::QuaterImaginary) = q1 - Complex(q2)
-(q1::QuaterImaginary, q2::Complex) = Complex(q1) - q2
*(q1::QuaterImaginary, q2::QuaterImaginary) = QuaterImaginary(Complex(q1) * Complex(q2))
*(q1::Complex, q2::QuaterImaginary) = q1 * Complex(q2)
*(q1::QuaterImaginary, q2::Complex) = Complex(q1) * q2
/(q1::QuaterImaginary, q2::QuaterImaginary) = QuaterImaginary(Complex(q1) / Complex(q2))
/(q1::Complex, q2::QuaterImaginary) = q1 / Complex(q2)
/(q1::QuaterImaginary, q2::Complex) = Complex(q1) / q2
^(q1::QuaterImaginary, q2::QuaterImaginary) = QuaterImaginary(Complex(q1) ^ Complex(q2))
^(q1::Complex, q2::QuaterImaginary) = q1 ^ Complex(q2)
^(q1::QuaterImaginary, q2::Complex) = Complex(q1) ^ q2

testquim()


// version 1.2.10

import kotlin.math.ceil

class Complex(val real: Double, val imag: Double) {

    constructor(r: Int, i: Int) : this(r.toDouble(), i.toDouble())

    operator fun plus(other: Complex) = Complex(real + other.real, imag + other.imag)

    operator fun times(other: Complex) = Complex(
        real * other.real - imag * other.imag,
        real * other.imag + imag * other.real
    )

    operator fun times(other: Double) = Complex(real * other, imag * other)

    fun inv(): Complex {
        val denom = real * real + imag * imag
        return Complex(real / denom, -imag / denom)
    }

    operator fun unaryMinus() = Complex(-real, -imag)

    operator fun minus(other: Complex) = this + (-other)

    operator fun div(other: Complex) = this * other.inv()

    // only works properly if 'real' and 'imag' are both integral
    fun toQuaterImaginary(): QuaterImaginary {
        if (real == 0.0 && imag == 0.0) return QuaterImaginary("0")
        var re = real.toInt()
        var im = imag.toInt()
        var fi = -1
        val sb = StringBuilder()
        while (re != 0) {
            var rem = re % -4
            re /= -4
            if (rem < 0) {
                rem = 4 + rem
                re++
            }
            sb.append(rem)
            sb.append(0)
        }
        if (im != 0) {
            var f = (Complex(0.0, imag) / Complex(0.0, 2.0)).real
            im = ceil(f).toInt()
            f = -4.0 * (f - im.toDouble())
            var index = 1
            while (im != 0) {
                var rem = im % -4
                im /= -4
                if (rem < 0) {
                    rem = 4 + rem
                    im++
                }
                if (index < sb.length) {
                    sb[index] = (rem + 48).toChar()
                }
                else {
                    sb.append(0)
                    sb.append(rem)
                }
                index += 2
            }
            fi = f.toInt()
        }
        sb.reverse()
        if (fi != -1) sb.append(".$fi")
        var s = sb.toString().trimStart('0')
        if (s.startsWith(".")) s = "0$s"
        return QuaterImaginary(s)
    }

    override fun toString(): String {
        val real2 = if (real == -0.0) 0.0 else real  // get rid of negative zero
        val imag2 = if (imag == -0.0) 0.0 else imag  // ditto
        var result = if (imag2 >= 0.0) "$real2 + ${imag2}i" else "$real2 - ${-imag2}i"
        result = result.replace(".0 ", " ").replace(".0i", "i").replace(" + 0i", "")
        if (result.startsWith("0 + ")) result = result.drop(4)
        if (result.startsWith("0 - ")) result = "-" + result.drop(4)
        return result
    }
}

class QuaterImaginary(val b2i: String) {

    init {
        if (b2i == "" || !b2i.all { it in "0123." } || b2i.count { it == '.'} > 1 )
            throw RuntimeException("Invalid Base 2i number")
    }

    fun toComplex(): Complex {
        val pointPos = b2i.indexOf(".")
        var posLen = if (pointPos != -1) pointPos else b2i.length
        var sum = Complex(0.0, 0.0)
        var prod = Complex(1.0, 0.0)
        for (j in 0 until posLen) {
            val k = (b2i[posLen - 1 - j] - '0').toDouble()
            if (k > 0.0) sum += prod * k
            prod *= twoI
        }
        if (pointPos != -1) {
            prod = invTwoI
            for (j in posLen + 1 until b2i.length) {
                val k = (b2i[j] - '0').toDouble()
                if (k > 0.0) sum += prod * k
                prod *= invTwoI
            }
        }
        return sum
    }

    override fun toString() = b2i

    companion object {
        val twoI = Complex(0.0, 2.0)
        val invTwoI = twoI.inv()
    }
}

fun main(args: Array<String>) {
    val fmt = "%4s -> %8s -> %4s"
    for (i in 1..16) {
        var c1 = Complex(i, 0)
        var qi = c1.toQuaterImaginary()
        var c2 = qi.toComplex()
        print("$fmt     ".format(c1, qi, c2))
        c1 = -c1
        qi = c1.toQuaterImaginary()
        c2 = qi.toComplex()
        println(fmt.format(c1, qi, c2))
    }
    println()
    for (i in 1..16) {
        var c1 = Complex(0, i)
        var qi = c1.toQuaterImaginary()
        var c2 = qi.toComplex()
        print("$fmt     ".format(c1, qi, c2))
        c1 = -c1
        qi = c1.toQuaterImaginary()
        c2 = qi.toComplex()
        println(fmt.format(c1, qi, c2))
    }
}


MODULE ImaginaryBase;
FROM FormatString IMPORT FormatString;
FROM RealMath IMPORT round;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

(* Helper *)
TYPE
    String = ARRAY[0..10] OF CHAR;
    StringBuilder = RECORD
        buf : String;
        ptr : CARDINAL;
    END;

PROCEDURE ToChar(n : INTEGER) : CHAR;
BEGIN
    CASE n OF
        0 : RETURN '0' |
        1 : RETURN '1' |
        2 : RETURN '2' |
        3 : RETURN '3' |
        4 : RETURN '4' |
        5 : RETURN '5' |
        6 : RETURN '6' |
        7 : RETURN '7' |
        8 : RETURN '8' |
        9 : RETURN '9'
    ELSE
        RETURN '-'
    END
END ToChar;

PROCEDURE AppendChar(VAR sb : StringBuilder; c : CHAR);
BEGIN
    sb.buf[sb.ptr] := c;
    INC(sb.ptr);
    sb.buf[sb.ptr] := 0C
END AppendChar;

PROCEDURE AppendInt(VAR sb : StringBuilder; n : INTEGER);
BEGIN
    sb.buf[sb.ptr] := ToChar(n);
    INC(sb.ptr);
    sb.buf[sb.ptr] := 0C
END AppendInt;

PROCEDURE Ceil(r : REAL) : REAL;
VAR t : REAL;
BEGIN
    t := FLOAT(INT(r));
    IF r - t > 0.0 THEN
        t := t + 1.0
    END;
    RETURN t
END Ceil;

PROCEDURE Modulus(q,d : INTEGER) : INTEGER;
VAR t : INTEGER;
BEGIN
    t := q / d;
    RETURN q - d * t
END Modulus;

PROCEDURE PrependInt(VAR sb : StringBuilder; n : INTEGER);
VAR i : CARDINAL;
BEGIN
    i := sb.ptr;
    INC(sb.ptr);
    sb.buf[sb.ptr] := 0C;
    WHILE i > 0 DO
        sb.buf[i] := sb.buf[i-1];
        DEC(i)
    END;
    sb.buf[0] := ToChar(n)
END PrependInt;

PROCEDURE Reverse(VAR str : String);
VAR
    i,j : CARDINAL;
    c : CHAR;
BEGIN
    IF str[0] = 0C THEN RETURN END;
    i := 0;
    WHILE str[i] # 0C DO INC(i) END;
    DEC(i);
    j := 0;
    WHILE i > j DO
        c := str[i];
        str[i] := str[j];
        str[j] := c;

        DEC(i);
        INC(j)
    END
END Reverse;

PROCEDURE TrimStart(VAR str : String; c : CHAR);
VAR i : CARDINAL;
BEGIN
    WHILE str[0] = c DO
        i := 0;
        WHILE str[i] # 0C DO
            str[i] := str[i+1];
            INC(i)
        END
    END
END TrimStart;

PROCEDURE WriteInteger(n : INTEGER);
VAR buf : ARRAY[0..15] OF CHAR;
BEGIN
    FormatString("%i", buf, n);
    WriteString(buf)
END WriteInteger;

(* Imaginary *)
TYPE
    Complex = RECORD
        real,imag : REAL;
    END;
    QuaterImaginary = RECORD
        b2i : String;
    END;

PROCEDURE ComplexMul(lhs,rhs : Complex) : Complex;
BEGIN
    RETURN Complex{
        rhs.real * lhs.real - rhs.imag * lhs.imag,
        rhs.real * lhs.imag + rhs.imag * lhs.real
    }
END ComplexMul;

PROCEDURE ComplexMulR(lhs : Complex; rhs : REAL) : Complex;
BEGIN
    RETURN Complex{lhs.real * rhs, lhs.imag * rhs}
END ComplexMulR;

PROCEDURE ComplexInv(c : Complex) : Complex;
VAR denom : REAL;
BEGIN
    denom := c.real * c.real + c.imag * c.imag;
    RETURN Complex{c.real / denom, -c.imag / denom}
END ComplexInv;

PROCEDURE ComplexDiv(lhs,rhs : Complex) : Complex;
BEGIN
    RETURN ComplexMul(lhs, ComplexInv(rhs))
END ComplexDiv;

PROCEDURE ComplexNeg(c : Complex) : Complex;
BEGIN
    RETURN Complex{-c.real, -c.imag}
END ComplexNeg;

PROCEDURE ComplexSum(lhs,rhs : Complex) : Complex;
BEGIN
    RETURN Complex{lhs.real + rhs.real, lhs.imag + rhs.imag}
END ComplexSum;

PROCEDURE WriteComplex(c : Complex);
VAR buf : ARRAY[0..15] OF CHAR;
BEGIN
    IF c.imag = 0.0 THEN
        WriteInteger(INT(c.real))
    ELSIF c.real = 0.0 THEN
        WriteInteger(INT(c.imag));
        WriteString("i")
    ELSIF c.imag > 0.0 THEN
        WriteInteger(INT(c.real));
        WriteString(" + ");
        WriteInteger(INT(c.imag));
        WriteString("i")
    ELSE
        WriteInteger(INT(c.real));
        WriteString(" - ");
        WriteInteger(INT(-c.imag));
        WriteString("i")
    END
END WriteComplex;

PROCEDURE ToQuaterImaginary(c : Complex) : QuaterImaginary;
VAR
    re,im,fi,rem,index : INTEGER;
    f : REAL;
    t : Complex;
    sb : StringBuilder;
BEGIN
    IF (c.real = 0.0) AND (c.imag = 0.0) THEN RETURN QuaterImaginary{"0"} END;
    re := INT(c.real);
    im := INT(c.imag);
    fi := -1;
    sb := StringBuilder{"", 0};
    WHILE re # 0 DO
        rem := Modulus(re, -4);
        re := re / (-4);
        IF rem < 0 THEN
            rem := 4 + rem;
            INC(re)
        END;
        AppendInt(sb, rem);
        AppendInt(sb, 0)
    END;
    IF im # 0 THEN
        t := ComplexDiv(Complex{0.0, c.imag}, Complex{0.0, 2.0});
        f := t.real;
        im := INT(Ceil(f));
        f := -4.0 * (f - FLOAT(im));
        index := 1;
        WHILE im # 0 DO
            rem := Modulus(im, -4);
            im := im / (-4);
            IF rem < 0 THEN
                rem := 4 + rem;
                INC(im)
            END;
            IF index < INT(sb.ptr) THEN
                sb.buf[index] := ToChar(rem)
            ELSE
                AppendInt(sb, 0);
                AppendInt(sb, rem)
            END;
            index := index + 2;
        END;
        fi := INT(f)
    END;
    Reverse(sb.buf);
    IF fi # -1 THEN
        AppendChar(sb, '.');
        AppendInt(sb, fi)
    END;
    TrimStart(sb.buf, '0');
    IF sb.buf[0] = '.' THEN
        PrependInt(sb, 0)
    END;

    RETURN QuaterImaginary{sb.buf}
END ToQuaterImaginary;

PROCEDURE ToComplex(qi : QuaterImaginary) : Complex;
VAR
    j,pointPos,posLen,b2iLen : INTEGER;
    k : REAL;
    sum,prod : Complex;
BEGIN
    pointPos := 0;
    WHILE (qi.b2i[pointPos] # 0C) AND (qi.b2i[pointPos] # '.') DO
        INC(pointPos)
    END;
    IF qi.b2i[pointPos] # '.' THEN
        pointPos := -1;
        posLen := 0;
        WHILE qi.b2i[posLen] # 0C DO
            INC(posLen)
        END
    ELSE
        posLen := pointPos
    END;

    sum := Complex{0.0, 0.0};
    prod := Complex{1.0, 0.0};

    FOR j:=0 TO posLen - 1 DO
        k := FLOAT(ORD(qi.b2i[posLen - 1 - j]) - ORD('0'));
        IF k > 0.0 THEN
            sum := ComplexSum(sum, ComplexMulR(prod, k))
        END;
        prod := ComplexMul(prod, Complex{0.0, 2.0})
    END;

    IF pointPos # -1 THEN
        prod := ComplexInv(Complex{0.0, 2.0});
        b2iLen := 0;
        WHILE qi.b2i[b2iLen] # 0C DO INC(b2iLen) END;
        FOR j:=posLen + 1 TO b2iLen - 1 DO
            k := FLOAT(ORD(qi.b2i[j]) - ORD('0'));
            IF k > 0.0 THEN
                sum := ComplexSum(sum, ComplexMulR(prod, k))
            END;
            prod := ComplexMul(prod, ComplexInv(Complex{0.0, 2.0}))
        END
    END;

    RETURN sum
END ToComplex;

(* Main *)
VAR
    c1,c2 : Complex;
    qi : QuaterImaginary;
    i : INTEGER;
BEGIN
    FOR i:=1 TO 16 DO
        c1 := Complex{FLOAT(i), 0.0};
        WriteComplex(c1);
        WriteString(" -> ");
        qi := ToQuaterImaginary(c1);
        WriteString(qi.b2i);
        WriteString(" -> ");
        c2 := ToComplex(qi);
        WriteComplex(c2);
        WriteString("   ");

        c1 := ComplexNeg(c1);
        WriteComplex(c1);
        WriteString(" -> ");
        qi := ToQuaterImaginary(c1);
        WriteString(qi.b2i);
        WriteString(" -> ");
        c2 := ToComplex(qi);
        WriteComplex(c2);
        WriteLn
    END;
    WriteLn;

    FOR i:=1 TO 16 DO
        c1 := Complex{0.0, FLOAT(i)};
        WriteComplex(c1);
        WriteString(" -> ");
        qi := ToQuaterImaginary(c1);
        WriteString(qi.b2i);
        WriteString(" -> ");
        c2 := ToComplex(qi);
        WriteComplex(c2);
        WriteString("   ");

        c1 := ComplexNeg(c1);
        WriteComplex(c1);
        WriteString(" -> ");
        qi := ToQuaterImaginary(c1);
        WriteString(qi.b2i);
        WriteString(" -> ");
        c2 := ToComplex(qi);
        WriteComplex(c2);
        WriteLn
    END;

    ReadChar
END ImaginaryBase.


import algorithm, complex, math, strformat, strutils

const
  TwoI = complex(0.0, 2.0)
  InvTwoI = inv(TwoI)

type QuaterImaginery = object
  b2i: string

# Conversions between digit character and digit value.
template digitChar(n: range[0..9]): range['0'..'9'] = chr(n + ord('0'))
template digitValue(c: range['0'..'9']): range[0..9] = ord(c) - ord('0')

####################################################################################################
# Quater imaginary functions.

func initQuaterImaginary(s: string): QuaterImaginery =
  ## Create a Quater imaginary number.
  if s.len == 0 or not s.allCharsInSet({'0'..'3', '.'}) or s.count('.') > 1:
    raise newException(ValueError, "invalid base 2i number.")
  result = QuaterImaginery(b2i: s)

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

func toComplex(q: QuaterImaginery): Complex[float] =
  ## Convert a Quater imaginary number to a complex.

  let pointPos = q.b2i.find('.')
  let posLen = if pointPos != -1: pointPos else: q.b2i.len
  var prod = complex(1.0)

  for j in 0..<posLen:
    let k = float(q.b2i[posLen - 1 - j].digitValue)
    if k > 0: result += prod * k
    prod *= TwoI

  if pointPos != -1:
    prod = InvTwoI
    for j in (posLen + 1)..q.b2i.high:
      let k = float(q.b2i[j].digitValue)
      if k > 0: result += prod * k
      prod *= InvTwoI

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

func `$`(q: QuaterImaginery): string =
  ## Convert a Quater imaginary number to a string.
  q.b2i

####################################################################################################
# Supplementary functions for complex numbers.

func toQuaterImaginary(c: Complex): QuaterImaginery =
  ## Convert a complex number to a Quater imaginary number.

  if c.re == 0 and c.im == 0: return initQuaterImaginary("0")

  var re = c.re.toInt
  var im = c.im.toInt
  var fi = -1

  while re != 0:
    var rem = re mod -4
    re = re div -4
    if rem < 0:
      inc rem, 4
      inc re
    result.b2i.add rem.digitChar
    result.b2i.add '0'

  if im != 0:
    var f = (complex(0.0, c.im) / TwoI).re
    im = f.ceil.toInt
    f = -4 * (f - im.toFloat)
    var index = 1
    while im != 0:
      var rem = im mod -4
      im = im div -4
      if rem < 0:
        inc rem, 4
        inc im
      if index < result.b2i.len:
        result.b2i[index] = rem.digitChar
      else:
        result.b2i.add '0'
        result.b2i.add rem.digitChar
      inc index, 2
    fi = f.toInt

  result.b2i.reverse()
  if fi != -1: result.b2i.add "." & $fi
  result.b2i = result.b2i.strip(leading = true, trailing = false, {'0'})
  if result.b2i.startsWith('.'): result.b2i = '0' & result.b2i

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

func toString(c: Complex[float]): string =
  ## Convert a complex number to a string.
  ## This function is used in place of `$`.

  let real = if c.re.classify == fcNegZero: 0.0 else: c.re
  let imag = if c.im.classify == fcNegZero: 0.0 else: c.im
  result = if imag >= 0: fmt"{real} + {imag}i" else: fmt"{real} - {-imag}i"
  result = result.replace(".0 ", " ").replace(".0i", "i").replace(" + 0i", "")
  if result.startsWith("0 + "): result = result[4..^1]
  if result.startsWith("0 - "): result = '-' & result[4..^1]

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

when isMainModule:

  for i in 1..16:
    var c1 = complex(i.toFloat)
    var qi = c1.toQuaterImaginary
    var c2 = qi.toComplex
    stdout.write fmt"{c1.toString:>4s} → {qi:>8s} → {c2.toString:>4s}     "
    c1 = -c1
    qi = c1.toQuaterImaginary
    c2 = qi.toComplex
    echo fmt"{c1.toString:>4s} → {qi:>8s} → {c2.toString:>4s}"

  echo ""

  for i in 1..16:
    var c1 = complex(0.0, i.toFloat)
    var qi = c1.toQuaterImaginary
    var c2 = qi.toComplex
    stdout.write fmt"{c1.toString:>4s} → {qi:>8s} → {c2.toString:>4s}     "
    c1 = -c1
    qi = c1.toQuaterImaginary
    c2 = qi.toComplex
    echo fmt"{c1.toString:>4s} → {qi:>8s} → {c2.toString:>4s}"


use strict;
use warnings;
use feature 'say';

use Math::Complex;
use List::AllUtils qw(sum mesh);
use ntheory qw<todigitstring fromdigits>;

sub zip {
    my($a,$b) = @_;
    my($la, $lb) = (length $a, length $b);
    my $l = '0' x abs $la - $lb;
    $a .= $l if $la < $lb;
    $b .= $l if $lb < $la;
    (join('', mesh(@{[split('',$a),]}, @{[split('',$b),]})) =~ s/0+$//r) or 0;
}

sub base_i {
    my($num,$radix,$precision) = @_;
    die unless $radix > -37 and $radix < -1;
    return '0' unless $num;
    my $value  = $num;
    my $result = '';
    my $place  = 0;
    my $upper_bound = 1 / (-$radix + 1);
    my $lower_bound = $radix * $upper_bound;

    $value = $num / $radix ** ++$place until $lower_bound <= $value and $value < $upper_bound;

    while (($value or $place > 0) and $place > $precision) {
        my $digit = int $radix * $value - $lower_bound;
        $value    =  $radix * $value - $digit;
        $result  .= '.' unless $place or not index($result, '.');
        $result  .= $digit == -$radix ? todigitstring($digit-1, -$radix) . '0' : (todigitstring($digit, -$radix) or '0');
        $place--;
    }
    $result
}

sub base_c {
    my($num, $radix, $precision) = @_;
    die "Base $radix out of range" unless
        (-6 <= $radix->Im or $radix->Im <= -2) or (2 <= $radix->Im or $radix->Im <= 6);
    my ($re,$im);
    defined $num->Im ? ($re, $im) = ($num->Re, $num->Im) : $re = $num;
    my ($re_wh, $re_fr) = split /\./, base_i(  $re,               -1 * int($radix->Im**2), $precision);
    my ($im_wh, $im_fr) = split /\./, base_i( ($im/($radix->Im)), -1 * int($radix->Im**2), $precision);
    $_ //= '' for $re_fr, $im_fr;

    my $whole = reverse zip scalar reverse($re_wh), scalar reverse($im_wh);
    my $fraction = zip $im_fr, $re_fr;
    $fraction eq 0 ? "$whole" : "$whole.$fraction"
}

sub parse_base {
    my($str, $radix) = @_;
    return -1 * parse_base( substr($str,1), $radix) if substr($str,0,1) eq '-';
    my($whole, $frac) = split /\./, $str;
    my $fraction = 0;
    my $k = 0;
    $fraction = sum map { (fromdigits($_, int $radix->Im**2) || 0) * $radix ** -($k++ +1) } split '', $frac
        if $frac;
    $k = 0;
    $fraction + sum map { (fromdigits($_, int $radix->Im**2) || 0) * $radix ** $k++  } reverse split '', $whole;
}

for (
    [  0*i,  2*i], [1+0*i,  2*i], [5+0*i,      2*i], [ -13+0*i, 2*i],
    [  9*i,  2*i], [ -3*i,  2*i], [7.75-7.5*i, 2*i], [0.25+0*i, 2*i],
    [5+5*i,  2*i], [5+5*i,  3*i], [5+5*i,  4*i], [5+5*i,  5*i], [5+5*i,  6*i],
    [5+5*i, -2*i], [5+5*i, -3*i], [5+5*i, -4*i], [5+5*i, -5*i], [5+5*i, -6*i]
) {
    my($v,$r) = @$_;
    my $ibase = base_c($v, $r, -6);
    my $rt = cplx parse_base($ibase, $r);
    $rt->display_format('format' => '%.2f');
    printf "base(%3s): %10s  => %9s  => %13s\n", $r, $v, $ibase, $rt;
}

say '';
say 'base( 6i): 31432.6219135802-2898.5266203704*i => ' .
         base_c(31432.6219135802-2898.5266203704*i, 0+6*i, -3);


with javascript_semantics
include complex.e

function base2(atom num, integer radix, precision = -8)
    if radix<-36 or radix>-2 then throw("radix out of range (-2..-36)") end if
    sequence result
    if num=0 then
        result = {"0",""}
    else
        integer place = 0
        result = ""
        atom v = num
        atom upper_bound = 1/(1-radix),
             lower_bound = radix*upper_bound
        while not(lower_bound <= v) or not(v < upper_bound) do
            place += 1
            v = num/power(radix,place)
        end while

        while (v or place > 0) and (place > precision) do
            integer digit = floor(radix*v - lower_bound)
            v = (radix*v - digit)
            if place=0 and not find('.',result) then result &= '.' end if
            result &= digit+iff(digit>9?'a'-10:'0')
            place -= 1
        end while
        integer dot = find('.',result)
        if dot then
            result = trim_tail(result,'0')
            result = {result[1..dot-1],result[dot+1..$]}
        else
            result = {result,""}
        end if
    end if
    return result
end function

function zip(string a, string b)
    integer ld = length(a)-length(b)
    if ld!=0 then
        if ld>0 then
            b &= repeat('0',ld)
        else
            a &= repeat('0',abs(ld))
        end if
    end if
    string res = ""
    for i=1 to length(a) do
        res &= a[i]&b[i]
    end for
    res = trim_tail(res,'0')
    if res="" then res = "0" end if
    return res
end function

function base(complexn num, integer radix, precision = -8)

    integer absrad = abs(radix),
            radix2 = -power(radix,2)
    if absrad<2 or absrad>6 then throw("base radix out of range") end if

    atom {re, im}         = {complex_real(num), complex_imag(num)}
    string {re_wh, re_fr} = base2(re,       radix2, precision),
           {im_wh, im_fr} = base2(im/radix, radix2, precision)

    string whole = reverse(zip(reverse(re_wh), reverse(im_wh))),
           fraction = zip(im_fr, re_fr)
    if fraction!="0" then whole &= '.'&fraction end if
    return whole
end function

function parse_base(string str, integer radix)

    complexn fraction = 0

    integer dot = find('.',str)
    if dot then
        string fr = str[dot+1..$]
        for i=1 to length(fr) do
            integer c = fr[i]
            c -= iff(c>='a'?'a'-10:'0')
            fraction = complex_add(fraction,complex_mul(c,complex_power({0,radix},-i)))
        end for
        str = str[1..dot-1]
    end if

    str = reverse(str)
    for i=1 to length(str) do
        integer c = str[i]
        c -= iff(c>='a'?'a'-10:'0')
        fraction = complex_add(fraction,complex_mul(c,complex_power({0,radix},(i-1))))
    end for

    return fraction
end function

constant tests = {{0,2},{1,2},{5,2},{-13,2},{{0,9},2},{{0,-3},2},{{7.75,-7.5}, 2},{.25, 2}, -- base 2i tests
                  {{5,5}, 2},{{5,5}, 3},{{5,5}, 4},{{5,5}, 5},{{5,5}, 6}, -- same value, positive imaginary bases
                  {{5,5},-2},{{5,5},-3},{{5,5},-4},{{5,5},-5},{{5,5},-6}, -- same value, negative imaginary bases
                  {{227.65625,10.859375},4}, -- larger test value
                  {{-579.8225308641975744,-5296.406378600824},6}}   -- phix.rules

-- matches output of Sidef and Raku:
for t=1 to length(tests) do
    {complexn v, integer r} = tests[t]
    string ibase = base(v,r),
           strv = complex_sprint(v),
           strb = complex_sprint(parse_base(ibase, r))
    printf(1,"base(%20s, %2di) = %-10s : parse_base(%12s, %2di) = %s\n",
                  {strv,  r,     ibase,    '"'&ibase&'"', r,     strb})
end for

-- matches output of Kotlin, Java, Go, D, and C#:
for ri=1 to 2 do    -- real then imag
    for i=1 to 16 do
        complexn c = iff(ri=1?i:{0,i}),
                nc = complex_neg(c)
        string sc = complex_sprint(c),
              snc = complex_sprint(nc),
               ib = base(c,2),
              inb = base(nc,2),
               rc = complex_sprint(parse_base(ib,2)),
              rnc = complex_sprint(parse_base(inb,2))
        printf(1,"%4s -> %8s -> %4s     %4s -> %8s -> %4s\n",
                 {sc,    ib,    rc,     snc,   inb,   rnc })
    end for
    puts(1,"\n")
end for


import math
import re

def inv(c):
    denom = c.real * c.real + c.imag * c.imag
    return complex(c.real / denom, -c.imag / denom)

class QuaterImaginary:
    twoI = complex(0, 2)
    invTwoI = inv(twoI)

    def __init__(self, str):
        if not re.match("^[0123.]+$", str) or str.count('.') > 1:
            raise Exception('Invalid base 2i number')
        self.b2i = str

    def toComplex(self):
        pointPos = self.b2i.find('.')
        posLen = len(self.b2i) if (pointPos < 0) else pointPos
        sum = complex(0, 0)
        prod = complex(1, 0)
        for j in xrange(0, posLen):
            k = int(self.b2i[posLen - 1 - j])
            if k > 0:
                sum += prod * k
            prod *= QuaterImaginary.twoI
        if pointPos != -1:
            prod = QuaterImaginary.invTwoI
            for j in xrange(posLen + 1, len(self.b2i)):
                k = int(self.b2i[j])
                if k > 0:
                    sum += prod * k
                prod *= QuaterImaginary.invTwoI
        return sum

    def __str__(self):
        return str(self.b2i)

def toQuaterImaginary(c):
    if c.real == 0.0 and c.imag == 0.0:
        return QuaterImaginary("0")

    re = int(c.real)
    im = int(c.imag)
    fi = -1
    ss = ""
    while re != 0:
        re, rem = divmod(re, -4)
        if rem < 0:
            rem += 4
            re += 1
        ss += str(rem) + '0'
    if im != 0:
        f = c.imag / 2
        im = int(math.ceil(f))
        f = -4 * (f - im)
        index = 1
        while im != 0:
            im, rem = divmod(im, -4)
            if rem < 0:
                rem += 4
                im += 1
            if index < len(ss):
                ss[index] = str(rem)
            else:
                ss += '0' + str(rem)
            index = index + 2
        fi = int(f)
    ss = ss[::-1]
    if fi != -1:
        ss += '.' + str(fi)
    ss = ss.lstrip('0')
    if ss[0] == '.':
        ss = '0' + ss
    return QuaterImaginary(ss)

for i in xrange(1,17):
    c1 = complex(i, 0)
    qi = toQuaterImaginary(c1)
    c2 = qi.toComplex()
    print "{0:8} -> {1:>8} -> {2:8}     ".format(c1, qi, c2),

    c1 = -c1
    qi = toQuaterImaginary(c1)
    c2 = qi.toComplex()
    print "{0:8} -> {1:>8} -> {2:8}".format(c1, qi, c2)
print

for i in xrange(1,17):
    c1 = complex(0, i)
    qi = toQuaterImaginary(c1)
    c2 = qi.toComplex()
    print "{0:8} -> {1:>8} -> {2:8}     ".format(c1, qi, c2),

    c1 = -c1
    qi = toQuaterImaginary(c1)
    c2 = qi.toComplex()
    print "{0:8} -> {1:>8} -> {2:8}".format(c1, qi, c2)

print "done"


multi sub base ( Real $num, Int $radix where -37 < * < -1, :$precision = -15 ) {
    return '0' unless $num;
    my $value  = $num;
    my $result = '';
    my $place  = 0;
    my $upper-bound = 1 / (-$radix + 1);
    my $lower-bound = $radix * $upper-bound;

    $value = $num / $radix ** ++$place until $lower-bound <= $value < $upper-bound;

    while ($value or $place > 0) and $place > $precision {
        my $digit = ($radix * $value - $lower-bound).Int;
        $value    =  $radix * $value - $digit;
        $result ~= '.' unless $place or $result.contains: '.';
        $result ~= $digit == -$radix ?? ($digit-1).base(-$radix)~'0' !! $digit.base(-$radix);
        $place--
    }
    $result
}

multi sub base (Numeric $num, Complex $radix where *.re == 0, :$precision = -8 ) {
    die "Base $radix out of range" unless -6 <= $radix.im <= -2 or 2 <= $radix.im <= 6;
    my ($re, $im) = $num.Complex.reals;
    my ($re-wh, $re-fr) =             $re.&base( -$radix.im².Int, :precision($precision) ).split: '.';
    my ($im-wh, $im-fr) = ($im/$radix.im).&base( -$radix.im².Int, :precision($precision) ).split: '.';
    $_ //= '' for $re-fr, $im-fr;

    sub zip (Str $a, Str $b) {
        my $l = '0' x ($a.chars - $b.chars).abs;
        ([~] flat ($a~$l).comb Z flat ($b~$l).comb).subst(/ '0'+ $ /, '') || '0'
    }

    my $whole = flip zip $re-wh.flip, $im-wh.flip;
    my $fraction = zip $im-fr, $re-fr;
    $fraction eq 0 ?? "$whole" !! "$whole.$fraction"
}

multi sub parse-base (Str $str, Complex $radix where *.re == 0) {
    return -1 * $str.substr(1).&parse-base($radix) if $str.substr(0,1) eq '-';
    my ($whole, $frac) = $str.split: '.';
    my $fraction = 0;
    $fraction = [+] $frac.comb.kv.map: { $^v.parse-base($radix.im².Int) * $radix ** -($^k+1) } if $frac;
    $fraction + [+] $whole.flip.comb.kv.map: { $^v.parse-base($radix.im².Int) * $radix ** $^k }
}

# TESTING
for 0, 2i, 1, 2i, 5, 2i, -13, 2i, 9i, 2i, -3i, 2i, 7.75-7.5i, 2i, .25, 2i, # base 2i tests
    5+5i,  2i, 5+5i,  3i, 5+5i,  4i, 5+5i,  5i, 5+5i,  6i, # same value, positive imaginary bases
    5+5i, -2i, 5+5i, -3i, 5+5i, -4i, 5+5i, -5i, 5+5i, -6i, # same value, negative imaginary bases
    227.65625+10.859375i, 4i, # larger test value
    31433.3487654321-2902.4480452675i, 6i # heh
  -> $v, $r {
my $ibase = $v.&base($r, :precision(-6));
printf "%33s.&base\(%2si\) = %-11s : %13s.&parse-base\(%2si\) = %s\n",
  $v, $r.im, $ibase, "'$ibase'", $r.im, $ibase.&parse-base($r).round(1e-10).narrow;
}


# Convert a quarter-imaginary base value (as a string) into a base 10 Gaussian integer.

def base2i_decode(qi)
  return 0 if qi == '0'
  md = qi.match(/^(?<int>[0-3]+)(?:\.(?<frc>[0-3]+))?$/)
  raise 'ill-formed quarter-imaginary base value' if !md
  ls_pow = md[:frc] ? -(md[:frc].length) : 0
  value = 0
  (md[:int] + (md[:frc] ? md[:frc] : '')).reverse.each_char.with_index do |dig, inx|
    value += dig.to_i * (2i)**(inx + ls_pow)
  end
  return value
end

# Convert a base 10 Gaussian integer into a quarter-imaginary base value (as a string).

def base2i_encode(gi)
  odd = gi.imag.to_i.odd?
  frac = (gi.imag.to_i != 0)
  real = gi.real.to_i
  imag = (gi.imag.to_i + 1) / 2
  value = ''
  phase_real = true
  while (real != 0) || (imag != 0)
    if phase_real
      real, rem = real.divmod(4)
      real = -real
    else
      imag, rem = imag.divmod(4)
      imag = -imag
    end
    value.prepend(rem.to_s)
    phase_real = !phase_real
  end
  value = '0' if value == ''
  value.concat(odd ? '.2' : '.0') if frac
  return value
end


func base (Number num, Number radix { _ ~~ (-36 .. -2) }, precision = -15) -> String {
    num || return '0'

    var place  = 0
    var result = ''
    var value  = num
    var upper_bound = 1/(-radix + 1)
    var lower_bound = radix*upper_bound

    while (!(lower_bound <= value) || !(value < upper_bound)) {
        value = num/(radix**++place)
    }

    while ((value || (place > 0)) && (place > precision)) {
        var digit = (radix*value - lower_bound -> int)
        value    =  (radix*value - digit)
        result += '.' if (!place && !result.contains('.'))
        result += ((digit == -radix) ? (digit-1 -> base(-radix) + '0') : digit.base(-radix))
        place--
    }

    return result
}

func base (Number num, Number radix { .re == 0 }, precision = -8) -> String {

    (radix.im.abs ~~ 2..6) || die "Base #{radix} out of range"

    var (re, im)          = (num.re, num.im)
    var (re_wh, re_fr='') = base(re,          -radix.im**2, precision).split('.')...
    var (im_wh, im_fr='') = base(im/radix.im, -radix.im**2, precision).split('.')...

    func zip (String a, String b) {
        var l = ('0' * abs(a.len - b.len))
        chars(a+l) ~Z chars(b+l) -> flat.join.sub(/0+\z/, '') || '0'
    }

    var whole = zip(re_wh.flip, im_wh.flip).flip
    var fraction = zip(im_fr, re_fr)
    fraction == '0' ? whole : "#{whole}.#{fraction}"
}

func parse_base (String str, Number radix { .re == 0 }) -> Number {

    if (str.char(0) == '-') {
        return (-1 * parse_base(str.substr(1), radix))
    }

    var (whole, frac='') = str.split('.')...

    var fraction = frac.chars.map_kv {|k,v|
        Number(v, radix.im**2) * radix**-(k+1)
    }.sum

    fraction += whole.flip.chars.map_kv {|k,v|
        Number(v, radix.im**2) * radix**k
    }.sum

    return fraction
}

var tests = [0, 2i, 1, 2i, 5, 2i, -13, 2i, 9i, 2i, -3i, 2i, 7.75-7.5i, 2i, .25, 2i, # base 2i tests
    5+5i,  2i, 5+5i,  3i, 5+5i,  4i, 5+5i,  5i, 5+5i,  6i, # same value, positive imaginary bases
    5+5i, -2i, 5+5i, -3i, 5+5i, -4i, 5+5i, -5i, 5+5i, -6i, # same value, negative imaginary bases
    227.65625+10.859375i, 4i] # larger test value

tests.each_slice(2, {|v,r|
    var ibase = base(v, r)
    printf("base(%20s, %2si) = %-10s : parse_base(%12s, %2si) = %s\n",
        v, r.im, ibase, "'#{ibase}'", r.im, parse_base(ibase, r).round(-8))
})


Imports System.Text

Module Module1

    Class Complex : Implements IFormattable
        Private ReadOnly real As Double
        Private ReadOnly imag As Double

        Public Sub New(r As Double, i As Double)
            real = r
            imag = i
        End Sub

        Public Sub New(r As Integer, i As Integer)
            real = r
            imag = i
        End Sub

        Public Function Inv() As Complex
            Dim denom = real * real + imag * imag
            Return New Complex(real / denom, -imag / denom)
        End Function

        Public Shared Operator -(self As Complex) As Complex
            Return New Complex(-self.real, -self.imag)
        End Operator

        Public Shared Operator +(lhs As Complex, rhs As Complex) As Complex
            Return New Complex(lhs.real + rhs.real, lhs.imag + rhs.imag)
        End Operator

        Public Shared Operator -(lhs As Complex, rhs As Complex) As Complex
            Return New Complex(lhs.real - rhs.real, lhs.imag - rhs.imag)
        End Operator

        Public Shared Operator *(lhs As Complex, rhs As Complex) As Complex
            Return New Complex(lhs.real * rhs.real - lhs.imag * rhs.imag, lhs.real * rhs.imag + lhs.imag * rhs.real)
        End Operator

        Public Shared Operator /(lhs As Complex, rhs As Complex) As Complex
            Return lhs * rhs.Inv
        End Operator

        Public Shared Operator *(lhs As Complex, rhs As Double) As Complex
            Return New Complex(lhs.real * rhs, lhs.imag * rhs)
        End Operator

        Public Function ToQuaterImaginary() As QuaterImaginary
            If real = 0.0 AndAlso imag = 0.0 Then
                Return New QuaterImaginary("0")
            End If
            Dim re = CType(real, Integer)
            Dim im = CType(imag, Integer)
            Dim fi = -1
            Dim sb As New StringBuilder
            While re <> 0
                Dim rm = re Mod -4
                re \= -4
                If rm < 0 Then
                    rm += 4
                    re += 1
                End If
                sb.Append(rm)
                sb.Append(0)
            End While
            If im <> 0 Then
                Dim f = (New Complex(0.0, imag) / New Complex(0.0, 2.0)).real
                im = Math.Ceiling(f)
                f = -4.0 * (f - im)
                Dim index = 1
                While im <> 0
                    Dim rm = im Mod -4
                    im \= -4
                    If rm < 0 Then
                        rm += 4
                        im += 1
                    End If
                    If index < sb.Length Then
                        sb(index) = Chr(rm + 48)
                    Else
                        sb.Append(0)
                        sb.Append(rm)
                    End If
                    index += 2
                End While
                fi = f
            End If
            Dim reverse As New String(sb.ToString().Reverse().ToArray())
            sb.Length = 0
            sb.Append(reverse)
            If fi <> -1 Then
                sb.AppendFormat(".{0}", fi)
            End If
            Dim s = sb.ToString().TrimStart("0")
            If s(0) = "." Then
                s = "0" + s
            End If
            Return New QuaterImaginary(s)
        End Function

        Public Overloads Function ToString() As String
            Dim r2 = If(real = -0.0, 0.0, real) 'get rid of negative zero
            Dim i2 = If(imag = -0.0, 0.0, imag) 'ditto
            If i2 = 0.0 Then
                Return String.Format("{0}", r2)
            End If
            If r2 = 0.0 Then
                Return String.Format("{0}i", i2)
            End If
            If i2 > 0.0 Then
                Return String.Format("{0} + {1}i", r2, i2)
            End If
            Return String.Format("{0} - {1}i", r2, -i2)
        End Function

        Public Overloads Function ToString(format As String, formatProvider As IFormatProvider) As String Implements IFormattable.ToString
            Return ToString()
        End Function
    End Class

    Class QuaterImaginary
        Private Shared ReadOnly twoI = New Complex(0.0, 2.0)
        Private Shared ReadOnly invTwoI = twoI.Inv()

        Private ReadOnly b2i As String

        Public Sub New(b2i As String)
            If b2i = "" OrElse Not b2i.All(Function(c) "0123.".IndexOf(c) > -1) OrElse b2i.Count(Function(c) c = ".") > 1 Then
                Throw New Exception("Invalid Base 2i number")
            End If
            Me.b2i = b2i
        End Sub

        Public Function ToComplex() As Complex
            Dim pointPos = b2i.IndexOf(".")
            Dim posLen = If(pointPos <> -1, pointPos, b2i.Length)
            Dim sum = New Complex(0.0, 0.0)
            Dim prod = New Complex(1.0, 0.0)
            For j = 0 To posLen - 1
                Dim k = Asc(b2i(posLen - 1 - j)) - Asc("0")
                If k > 0.0 Then
                    sum += prod * k
                End If
                prod *= twoI
            Next
            If pointPos <> -1 Then
                prod = invTwoI
                For j = posLen + 1 To b2i.Length - 1
                    Dim k = Asc(b2i(j)) - Asc("0")
                    If k > 0.0 Then
                        sum += prod * k
                    End If
                    prod *= invTwoI
                Next
            End If
            Return sum
        End Function

        Public Overrides Function ToString() As String
            Return b2i
        End Function
    End Class

    Sub Main()
        For i = 1 To 16
            Dim c1 As New Complex(i, 0)
            Dim qi = c1.ToQuaterImaginary()
            Dim c2 = qi.ToComplex()
            Console.Write("{0,4} -> {1,8} -> {2,4}     ", c1, qi, c2)
            c1 = -c1
            qi = c1.ToQuaterImaginary()
            c2 = qi.ToComplex()
            Console.WriteLine("{0,4} -> {1,8} -> {2,4}", c1, qi, c2)
        Next
        Console.WriteLine()
        For i = 1 To 16
            Dim c1 As New Complex(0, i)
            Dim qi = c1.ToQuaterImaginary()
            Dim c2 = qi.ToComplex()
            Console.Write("{0,4} -> {1,8} -> {2,4}     ", c1, qi, c2)
            c1 = -c1
            qi = c1.ToQuaterImaginary()
            c2 = qi.ToComplex()
            Console.WriteLine("{0,4} -> {1,8} -> {2,4}", c1, qi, c2)
        Next
    End Sub

End Module


import "/complex" for Complex
import "/fmt" for Fmt

class QuaterImaginary {
    construct new(b2i) {
       if (b2i.type != String || b2i == "" || !b2i.all { |d| "0123.".contains(d) } ||
           b2i.count { |d| d == "." } > 1) Fiber.abort("Invalid Base 2i number.")
        _b2i = b2i
    }

    // only works properly if 'c.real' and 'c.imag' are both integral
    static fromComplex(c) {
        if (c.real == 0 && c.imag == 0) return QuaterImaginary.new("0")
        var re = c.real.truncate
        var im = c.imag.truncate
        var fi = -1
        var sb = ""
        while (re != 0) {
            var rem = re % (-4)
            re = (re/(-4)).truncate
            if (rem < 0) {
                rem = 4 + rem
                re = re + 1
            }
            if (rem == -0) rem = 0 // get rid of minus zero
            sb = sb + rem.toString + "0"
        }
        if (im != 0) {
            var f = (Complex.new(0, c.imag) / Complex.imagTwo).real
            im = f.ceil
            f = -4 * (f - im)
            var index = 1
            while (im != 0) {
                var rem = im % (-4)
                im = (im/(-4)).truncate
                if (rem < 0) {
                    rem = 4 + rem
                    im = im + 1
                }
                if (index < sb.count) {
                    var sbl = sb.toList
                    sbl[index] = String.fromByte(rem + 48)
                    sb = sbl.join()
                } else {
                    if (rem == -0) rem = 0 // get rid of minus zero
                    sb = sb + "0" + rem.toString
                }
                index = index + 2
            }
            fi = f.truncate
        }
        if (sb.count > 0) sb = sb[-1..0]
        if (fi != -1) {
            if (fi == -0) fi = 0 // get rid of minus zero
            sb = sb + ".%(fi)"
        }
        sb = sb.trimStart("0")
        if (sb.startsWith(".")) sb = "0" + sb
        return QuaterImaginary.new(sb)
    }

    toComplex {
        var pointPos = _b2i.indexOf(".")
        var posLen = (pointPos != -1) ? pointPos : _b2i.count
        var sum = Complex.zero
        var prod = Complex.one
        for (j in 0...posLen) {
            var k = _b2i.bytes[posLen-1-j] - 48
            if (k > 0) sum = sum + prod * k
            prod = prod * Complex.imagTwo
        }
        if (pointPos != -1) {
            prod = Complex.imagTwo.inverse
            var j = posLen + 1
            while (j < _b2i.count) {
                var k = _b2i.bytes[j] - 48
                if (k > 0) sum = sum + prod * k
                prod = prod / Complex.imagTwo
                j = j + 1
            }
        }
        return sum
    }

    toString { _b2i }
}

var imagOnly = Fn.new { |c| c.imag.toString + "i" }

var fmt = "$4s -> $8s -> $4s"
Complex.showAsReal = true
for (i in 1..16) {
    var c1 = Complex.new(i, 0)
    var qi = QuaterImaginary.fromComplex(c1)
    var c2 = qi.toComplex
    Fmt.write("%(fmt)     ", c1, qi, c2)
    c1 = -c1
    qi = QuaterImaginary.fromComplex(c1)
    c2 = qi.toComplex
    Fmt.print(fmt, c1, qi, c2)
}
System.print()
for (i in 1..16) {
    var c1 = Complex.new(0, i)
    var qi = QuaterImaginary.fromComplex(c1)
    var c2 = qi.toComplex
    Fmt.write("%(fmt)     ", imagOnly.call(c1), qi, imagOnly.call(c2))
    c1 = -c1
    qi = QuaterImaginary.fromComplex(c1)
    c2 = qi.toComplex
    Fmt.print(fmt, imagOnly.call(c1), qi, imagOnly.call(c2))
}


define sysRandom $fe

Snow:
lda sysRandom  ;get a random number
and #$01       ;remove all but bit 0
sta $0200,x    ;store in first section of VRAM

lda sysRandom  ;get a random number
and #$01       ;remove all but bit 0
sta $0300,x    ;store in second section of VRAM

lda sysRandom  ;get a random number
and #$01       ;remove all but bit 0
sta $0400,x    ;store in third section of VRAM

lda sysRandom  ;get a random number
and #$01       ;remove all but bit 0
sta $0500,x    ;store in last section of VRAM

inx            ;next X
jmp Snow       ;loop forever


INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

DEFINE TEXT_SIZE="40"
BYTE ARRAY text(TEXT_SIZE)

CARD FUNC GetFrame()
  BYTE RTCLOK1=$13,RTCLOK2=$14
  CARD res
  BYTE lsb=res,msb=res+1

  lsb=RTCLOK2
  msb=RTCLOK1
RETURN (res)

PROC CalcFPS(CARD frames REAL POINTER fps)
  BYTE PALNTSC=$D014
  REAL ms,r1000

  IF PALNTSC=15 THEN
    frames==*60
  ELSE
    frames==*50
  FI

  IntToReal(1000,r1000)
  IntToReal(frames,ms)
  RealDiv(r1000,ms,fps)
RETURN

PROC FillNoise()
  BYTE POINTER ptr
  BYTE x,y,rnd=$D20A

  ptr=PeekC(88)
  FOR y=0 TO 191
  DO
    FOR x=0 TO 39
    DO
      ptr^=rnd
      ptr==+1
    OD
  OD
RETURN

PROC PrepareScreen()
  BYTE COLOR1=$02C5,COLOR2=$02C6
  CARD SDLSTL=$0230,ptr
  BYTE i,v
  BYTE ARRAY dlist(205)

  Graphics(8+16)
  COLOR1=$0F
  COLOR2=$00

  ;prepare text
  FOR i=0 TO TEXT_SIZE-1
  DO
    text(i)=0
  OD
  text(6)='F-32
  text(7)='P-32
  text(8)='S-32

  ;modify display list to add one row with text on the top
  dlist(0)=$70
  dlist(1)=$70
  dlist(2)=$42
  PokeC(dlist+3,text)

  ptr=SDLSTL
  ptr==+3
  FOR i=5 TO 202
  DO
    dlist(i)=Peek(ptr)
    ptr==+1
  OD
  PokeC(dlist+203,dlist)

  SDLSTL=dlist
RETURN

PROC PrintFPS(REAL POINTER fps)
  CHAR ARRAY tmp(20)
  BYTE i

  StrR(fps,tmp)
  FOR i=1 TO 5
  DO
    text(i-1)=tmp(i)-32
  OD
RETURN

PROC Main()
  BYTE CH=$02FC
  CARD beg,end
  REAL fps

  PrepareScreen()
  beg=GetFrame()
  DO
    FillNoise()
    end=GetFrame()
    CalcFPS(end-beg,fps)
    PrintFPS(fps)
    beg=end
  UNTIL CH#$FF
  OD
  CH=$FF
RETURN


with Lumen.Image;

package Noise is

   function Create_Image (Width, Height : Natural) return Lumen.Image.Descriptor;

end Noise;


.Enable 15 MHz full speed mode
Full
.Disable memory access delays (adds 1 FPS)
Fullʳ

.Flush key presses
While getKey(0)
End

.Setup
0→F
0→N
Fix 5
fnInt(FPS,6)

Repeat getKey(0)
 NOISE()
 F++
 .Reset the FPS counter before it overflows
 F>606?0→F→N
 Text(0,0,F*108/N▶Dec)
 DispGraph
End

.Clean up
LnRegʳ
Fix 4
Return

.Draws random noise to the buffer
Lbl NOISE
ClrDraw
For(I,0,5)
 For(J,0,63)
  rand→{J*12+(I*2)+L₆}ʳ
 End
End
Return

.Increments the tick counter
Lbl FPS
N++
Return


      dx% = 320
      dy% = 240
      images% = 100000
      VDU 23,22,dx%;dy%;8,8,16,0

      REM Create a block of random data in memory:
      DIM random% dx%*dy%+images%
      FOR R% = random% TO random%+dx%*dy%+images%
        ?R% = RND(256)-1
      NEXT

      REM Create a BMP file structure:
      DIM bmpfile{bfType{l&,h&}, bfSize%, bfReserved%, bfOffBits%, \
      \   biSize%, biWidth%, biHeight%, biPlanes{l&,h&}, biBitCount{l&,h&}, \
      \   biCompression%, biSizeImage%, biXPelsPerMeter%, biYPelsPerMeter%, \
      \   biClrUsed%, biClrImportant%, biPalette%(255)}
      bmpfile.biSize% = 40
      bmpfile.biWidth% = dx%
      bmpfile.biHeight% = dy%
      bmpfile.biPlanes.l& = 1
      bmpfile.biBitCount.l& = 8
      FOR C% = 0 TO 255
        bmpfile.biPalette%(C%) = C% OR C%<<8 OR C%<<16
      NEXT

      REM Display image at a random offset into the data:
      frame% = 0
      TIME = 0
      REPEAT
        bmpfile.bfOffBits% = random% - bmpfile{} + RND(images%)
        OSCLI "MDISPLAY " + STR$~bmpfile{}
        frame% += 1
        IF TIME>10 THEN
          SYS "SetWindowText", @hwnd%, "BBC BASIC: " + STR$(frame%*100 DIV TIME) + " fps"
        ENDIF
      UNTIL FALSE


#include <stdlib.h>
#include <stdio.h>
#include <time.h>
#include <SDL/SDL.h>

unsigned int frames = 0;
unsigned int t_acc = 0;

void print_fps ()
{
  static Uint32 last_t = 0;
  Uint32 t = SDL_GetTicks();
  Uint32 dt = t - last_t;
  t_acc += dt;
  if (t_acc > 1000)
  {
    unsigned int el_time = t_acc / 1000;
    printf("- fps: %g\n",
            (float) frames / (float) el_time);
    t_acc = 0;
    frames = 0;
  }
  last_t = t;
}

void blit_noise(SDL_Surface *surf)
{
  unsigned int i;
  long dim = surf->w * surf->h;
  while (1)
  {
    SDL_LockSurface(surf);
    for (i=0; i < dim; ++i) {
      ((unsigned char *)surf->pixels)[i] = ((rand() & 1) ? 255 : 0);
    }
    SDL_UnlockSurface(surf);
    SDL_Flip(surf);
    ++frames;
    print_fps();
  }
}

int main(void)
{
  SDL_Surface *surf = NULL;
  srand((unsigned int)time(NULL));
  SDL_Init(SDL_INIT_TIMER | SDL_INIT_VIDEO);
  surf = SDL_SetVideoMode(320, 240, 8, SDL_DOUBLEBUF | SDL_HWSURFACE);
  blit_noise(surf);
}


using System;
using System.Collections.Generic;
using System.ComponentModel;
using System.Drawing;
using System.Drawing.Imaging;
using System.Linq;
using System.Runtime.InteropServices;
using System.Windows.Forms;

class Program
{
    static Size size = new Size(320, 240);
    static Rectangle rectsize = new Rectangle(new Point(0, 0), size);
    static int numpixels = size.Width * size.Height;
    static int numbytes = numpixels * 3;

    static PictureBox pb;
    static BackgroundWorker worker;

    static double time = 0;
    static double frames = 0;
    static Random rand = new Random();

    static byte tmp;
    static byte white = 255;
    static byte black = 0;
    static int halfmax = int.MaxValue / 2; // more voodoo! calling Next() is faster than Next(2)!

    static IEnumerable<byte> YieldVodoo()
    {
        // Yield 3 times same number (i.e 255 255 255) for numpixels times.

        for (int i = 0; i < numpixels; i++)
        {
            tmp = rand.Next() < halfmax ? black : white; // no more lists!

            // no more loops! yield! yield! yield!
            yield return tmp;
            yield return tmp;
            yield return tmp;
        }
    }

    static Image Randimg()
    {
        // Low-level bitmaps
        var bitmap = new Bitmap(size.Width, size.Height);
        var data = bitmap.LockBits(rectsize, ImageLockMode.WriteOnly, PixelFormat.Format24bppRgb);

        Marshal.Copy(
            YieldVodoo().ToArray<byte>(),// source
            0, // start
            data.Scan0, // scan0 is a pointer to low-level bitmap data
            numbytes); // number of bytes in source

        bitmap.UnlockBits(data);
        return bitmap;
    }

    [STAThread]
    static void Main()
    {
        var form = new Form();

        form.AutoSize = true;
        form.Size = new Size(0, 0);
        form.Text = "Test";

        form.FormClosed += delegate
        {
            Application.Exit();
        };

        worker = new BackgroundWorker();

        worker.DoWork += delegate
        {
            System.Threading.Thread.Sleep(500); // remove try/catch, just wait a bit before looping

            while (true)
            {
                var a = DateTime.Now;
                pb.Image = Randimg();
                var b = DateTime.Now;

                time += (b - a).TotalSeconds;
                frames += 1;

                if (frames == 30)
                {
                    Console.WriteLine("{0} frames in {1:0.000} seconds. ({2:0} FPS)", frames, time, frames / time);

                    time = 0;
                    frames = 0;
                }
            }
        };

        worker.RunWorkerAsync();

        FlowLayoutPanel flp = new FlowLayoutPanel();
        form.Controls.Add(flp);

        pb = new PictureBox();
        pb.Size = size;

        flp.AutoSize = true;
        flp.Controls.Add(pb);

        form.Show();
        Application.Run();
    }
}


#include <windows.h>
#include <sstream>
#include <tchar.h>
//--------------------------------------------------------------------------------------------------
using namespace std;

//--------------------------------------------------------------------------------------------------
const unsigned int BMP_WID = 320, BMP_HEI = 240, WHITE = 16777215, BLACK = 0;

//--------------------------------------------------------------------------------------------------
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;
    }

    void* getBits( void ) const { return pBits; }
    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 bmpNoise
{
public:
    bmpNoise()
    {
	QueryPerformanceFrequency( &_frequency );
	_bmp.create( BMP_WID, BMP_HEI );
	_frameTime = _fps = 0; _start = getTime(); _frames = 0;
    }

    void mainLoop()
    {
	float now = getTime();
	if( now - _start > 1.0f ) { _fps = static_cast<float>( _frames ) / ( now - _start ); _start = now; _frames = 0; }
	HDC wdc, dc = _bmp.getDC();
	unsigned int* bits = reinterpret_cast<unsigned int*>( _bmp.getBits() );

	for( int y = 0; y < BMP_HEI; y++ )
	{
	    for( int x = 0; x < BMP_WID; x++ )
	    {
		if( rand() % 10 < 5 ) memset( bits, 255, 3 );
		else memset( bits, 0, 3 );
		bits++;
	    }
	}
	ostringstream o; o << _fps; TextOut( dc, 0, 0, o.str().c_str(), o.str().size() );

	wdc = GetDC( _hwnd );
	BitBlt( wdc, 0, 0, BMP_WID, BMP_HEI, dc, 0, 0, SRCCOPY );
	ReleaseDC( _hwnd, wdc );
	_frames++; _frameTime = getTime() - now;
	if( _frameTime > 1.0f ) _frameTime = 1.0f;
    }

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

private:
    float getTime()
    {
	LARGE_INTEGER liTime; QueryPerformanceCounter( &liTime );
	return liTime.QuadPart  / ( float )_frequency.QuadPart;
    }
    myBitmap      _bmp;
    HWND          _hwnd;
    float         _start, _fps, _frameTime;
    unsigned int  _frames;
    LARGE_INTEGER _frequency;
};
//--------------------------------------------------------------------------------------------------
class wnd
{
public:
    wnd() { _inst = this; }
    int wnd::Run( HINSTANCE hInst )
    {
	_hInst = hInst; _hwnd = InitAll();
        _noise.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 );
	    }
	    else
	    {
		_noise.mainLoop();
	    }
	}
	return UnregisterClass( "_MY_NOISE_", _hInst );
    }
private:
    static int WINAPI wnd::WndProc( HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam )
    {
	switch( msg )
	{
	    case WM_DESTROY: PostQuitMessage( 0 ); 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_NOISE_";

	RegisterClassEx( &wcex );

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

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


;; (require :lispbuilder-sdl)

(defun draw-noise (surface)
  "draws noise on the surface. Returns the surface"
  (let ((width (sdl:width surface))
	(height (sdl:height surface))
	(i-white (sdl:map-color sdl:*white* surface))
	(i-black (sdl:map-color sdl:*black* surface)))
    (sdl-base::with-pixel (s (sdl:fp surface))
      (dotimes (h height)
	(dotimes (w width)
	  (sdl-base::write-pixel s w h (if (zerop (random 2))
					   i-white i-black ))))))
  surface)

(defun draw-fps (surface)
  "draws fps text-info on surface. Returns surface"
  (sdl:with-surface (s surface)
    (sdl:draw-string-solid-* (format nil "FPS: ~,3f" (sdl:average-fps))
			     20 20 :surface s :color sdl:*magenta*)))

(defun main ()
  "main function, initializes the library and creates de display window"
  (setf *random-state* (make-random-state))
  (sdl:with-init (SDL:SDL-INIT-VIDEO SDL:SDL-INIT-TIMER)
    (let ((main-window (sdl:window 320 240
				   :title-caption "noise_sdl.lisp"
				   :bpp 8
				   :flags (logior SDL:SDL-DOUBLEBUF SDL:SDL-HW-SURFACE)
				   :fps (make-instance 'sdl:fps-unlocked))))
      (sdl:initialise-default-font)
      (sdl:with-events ()
	(:idle ()
	       (sdl:update-display (draw-fps (draw-noise main-window))))
	(:video-expose-event ()
			     (sdl:update-display))
	(:quit-event () T)))))

(main)


import std.stdio, std.random, sdl.SDL;

void main() {
  SDL_Init(SDL_INIT_TIMER | SDL_INIT_VIDEO);
  auto surface = SDL_SetVideoMode(320,240,8, SDL_DOUBLEBUF|SDL_HWSURFACE);

  uint frameNumber, totalTime, lastTime;
  while (true) {
    SDL_LockSurface(surface);
    foreach (i; 0 .. surface.w * surface.h)
      (cast(ubyte*)surface.pixels)[i] = (uniform(0, 2) ? 255 : 0);
    SDL_UnlockSurface(surface);
    SDL_Flip(surface);
    frameNumber++;

    uint time = SDL_GetTicks();
    totalTime += time - lastTime;
    if (totalTime > 1000) {
      writeln("FPS: ", frameNumber / (totalTime / 1000.0));
      totalTime = frameNumber = 0;
    }
    lastTime = time;
  }
}


unit Main;

interface

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

type
  TfmNoise = class(TForm)
    tmr1sec: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure tmr1secTimer(Sender: TObject);
  end;

var
  fmNoise: TfmNoise;
  Surface: TBitmap;
  FrameCount: Cardinal = 0;

implementation

{$R *.dfm}

procedure TfmNoise.FormCreate(Sender: TObject);
begin
  Surface := TBitmap.Create;
  Surface.SetSize(320, 240);
  Surface.PixelFormat := pf1bit;
  Randomize;
end;

procedure TfmNoise.FormDestroy(Sender: TObject);
begin
  Surface.Free;
end;

type
  PDWordArray = ^TDWordArray;

  TDWordArray = array[0..16383] of DWord;

procedure TfmNoise.FormPaint(Sender: TObject);
var
  x, y: Integer;
  line: PWordArray;
begin
  with Surface do
    for y := 0 to Height - 1 do
    begin
      line := Surface.ScanLine[y];
      for x := 0 to (Width div 16) - 1 do
        line[x] := Random($FFFF);
      // Fill 16 pixels at same time
    end;

  Canvas.Draw(0, 0, Surface);
  Inc(FrameCount);
  Application.ProcessMessages;
  Invalidate;
end;

procedure TfmNoise.tmr1secTimer(Sender: TObject);
begin
  Caption := 'FPS: ' + FrameCount.ToString;
  FrameCount := 0;
end;

end.


>function noiseimg () ...
$aspect(320,240); clg;
$count=0; now=time;
$repeat
$  plotrgb(intrandom(240,420,2)-1,[0,0,1024,1024]);
$  wait(0);
$  count=count+1;
$  until testkey();
$end;
$return count/(time-now);
$endfunction
>noiseimg
 2.73544353263


open System.Windows.Forms
open System.Drawing
open System.Drawing.Imaging
open System.Runtime.InteropServices
open System.Diagnostics
open Microsoft.FSharp.NativeInterop
#nowarn "9"

let rnd = System.Random()

// Draw pixels using unsafe native pointer accessor.
// This updates the bitmap as fast as possible.
let drawbits_fast (size:int) (bits:BitmapData) =
    let mutable (p:nativeptr<byte>) = NativePtr.ofNativeInt(bits.Scan0)
    for n = 0 to size-1 do
        let c = rnd.Next(2) * 255
        NativePtr.set p 2 (byte c)
        NativePtr.set p 1 (byte c)
        NativePtr.set p 0 (byte c)
        NativePtr.set p 3 (byte 255)
        p <- NativePtr.add p 4

// A reasonably efficient updater using marshalling to copy an array of generated
// integers onto the managed bitmap pixel data (see the C# example as well).
let drawbits_safe (size:int) (bits:BitmapData) =
    let data = Array.init size (fun n ->
            let c = rnd.Next(2) * 255
            0xff000000 ||| (c <<< 16) ||| (c <<< 8) ||| c)
    Marshal.Copy(data, 0, bits.Scan0, size) |> ignore

// Create a new bitmap and update using the specified function
let make_image (width:int) (height:int) f =
    let size = width * height
    let bmp = new Bitmap(width, height)
    let bits = bmp.LockBits(Rectangle(0,0,width,height), ImageLockMode.WriteOnly, PixelFormat.Format32bppArgb)
    f size bits
    bmp.UnlockBits(bits)
    bmp

// Draw 30 frames and record the time and display the frames per second
// This function is run asynchronously to avoid blocking the main GUI thread.
let drawImage (box:PictureBox) (label:Label) f = async {
    while true do
        let timer = new Stopwatch()
        timer.Start()
        for frames = 0 to 29 do
            let bmp = make_image 320 240 f
            box.Image <- bmp
        timer.Stop()
        let fps = 30000. / timer.Elapsed.TotalMilliseconds
        label.Text <- sprintf "%.1f fps" fps }

[<System.STAThread>]
[<EntryPoint>]
let main args =
    let form = new Form(AutoSize=true,
                        Size=new Size(0,0),
                        Text="image noise demo")
    let panel = new FlowLayoutPanel(AutoSize=true,FlowDirection=FlowDirection.TopDown)
    let box = new PictureBox(AutoSize=true)
    let label = new Label(AutoSize=true, Text="Ready")
    form.FormClosed.Add(fun eventArgs -> Async.CancelDefaultToken()
                                         Application.Exit())
    form.Controls.Add(panel)
    panel.Controls.Add(box)
    panel.Controls.Add(label)
    if args.Length > 0 && args.[0] = "-safe" then
        drawImage box label drawbits_safe |> Async.Start
    else
        drawImage box label drawbits_fast |> Async.Start
    form.Show()
    Application.Run()
    0


USING: accessors calendar images images.viewer kernel math
math.parser models models.arrow random sequences threads timers
ui ui.gadgets ui.gadgets.labels ui.gadgets.packs ;
IN: rosetta-code.image-noise

: bits>pixels ( bits -- bits' pixels )
    [ -1 shift ] [ 1 bitand ] bi 255 * ; inline

: ?generate-more-bits ( a bits -- a bits' )
    over 32 mod zero? [ drop random-32 ] when ; inline

: <random-images-bytes> ( dim -- bytes )
    [ 0 0 ] dip product  [
        ?generate-more-bits
        [ 1 + ] [ bits>pixels ] bi*
    ] B{ } replicate-as 2nip ;

: <random-bw-image> ( -- image )
    <image>
        { 320 240 } [ >>dim ] [ <random-images-bytes> >>bitmap ] bi
        L >>component-order
        ubyte-components >>component-type ;

TUPLE: bw-noise-gadget < image-control timers cnt old-cnt fps-model ;

: animate-image ( control -- )
    [ 1 + ] change-cnt
    model>> <random-bw-image> swap set-model ;

: update-cnt ( gadget -- )
    [ cnt>> ] [ old-cnt<< ] bi ;

: fps ( gadget -- fps )
    [ cnt>> ] [ old-cnt>> ] bi - ;

: fps-monitor ( gadget -- )
    [ fps ] [ update-cnt ] [ fps-model>> set-model ] tri ;

: start-animation ( gadget -- )
    [ [ animate-image ] curry 1 nanoseconds every ] [ timers>> push ] bi ;

: start-fps ( gadget -- )
    [ [ fps-monitor ] curry 1 seconds every ] [ timers>> push ] bi ;

: setup-timers ( gadget -- )
    [ start-animation ] [ start-fps ] bi ;

: stop-animation ( gadget -- )
    timers>> [ [ stop-timer ] each ] [ delete-all ] bi ;

M: bw-noise-gadget graft* [ call-next-method ] [ setup-timers ] bi ;

M: bw-noise-gadget ungraft* [ stop-animation ] [ call-next-method ] bi ;

: <bw-noise-gadget> ( -- gadget )
    <random-bw-image> <model> bw-noise-gadget new-image-gadget*
    0 >>cnt 0 >>old-cnt 0 <model> >>fps-model V{ } clone >>timers ;

: fps-gadget ( model -- gadget )
    [ number>string ] <arrow> <label-control>
    "FPS: " <label>
    <shelf> swap add-gadget swap add-gadget ;

: with-fps ( gadget -- gadget' )
    [ fps-model>> fps-gadget ]
    [ <pile> swap add-gadget swap add-gadget ] bi ;

MAIN-WINDOW: open-noise-window
    { { title "Black and White noise" } }
    <bw-noise-gadget> with-fps >>gadgets ;


' version 13-07-2018
' compile with: fbc -s console
'           or: fbc -s gui

' hit any to key to stop program

Randomize Timer
Screen 13

If ScreenPtr = 0 Then
    Print "Error setting video mode!"
    End
End If

Palette 0, 0                  ' black
Palette 1, RGB(255, 255, 255) ' white

Dim As UInteger c, x, y, Col
Dim As Double fps, t = Timer

' empty keyboard buffer
While InKey <> "" : Wend

While InKey = ""

    For x = 0 To 319
        For y = 0 To 199
            ' color is as integer, a float gets rounded off by FreeBASIC
            PSet(x, y), Rnd
        Next
    Next
    c += 1
    fps = c / (Timer - t)
    WindowTitle "fps = " + Str(fps)

Wend


package main

import (
    "code.google.com/p/x-go-binding/ui/x11"
    "fmt"
    "image"
    "image/color"
    "image/draw"
    "log"
    "os"
    "time"
)

var randcol = genrandcol()

func genrandcol() <-chan color.Color {
    c := make(chan color.Color)

    go func() {
        for {
            select {
            case c <- image.Black:
            case c <- image.White:
            }
        }
    }()

    return c
}

func gennoise(screen draw.Image) {
    for y := 0; y < 240; y++ {
        for x := 0; x < 320; x++ {
            screen.Set(x, y, <-randcol)
        }
    }
}

func fps() chan<- bool {
    up := make(chan bool)

    go func() {
        var frames int64
        var lasttime time.Time
        var totaltime time.Duration

        for {
            <-up
            frames++
            now := time.Now()
            totaltime += now.Sub(lasttime)
            if totaltime > time.Second {
                fmt.Printf("FPS: %v\n", float64(frames)/totaltime.Seconds())
                frames = 0
                totaltime = 0
            }
            lasttime = now
        }
    }()

    return up
}

func main() {
    win, err := x11.NewWindow()
    if err != nil {
        fmt.Println(err)
        os.Exit(1)
    }
    defer win.Close()

    go func() {
        upfps := fps()
        screen := win.Screen()

        for {
            gennoise(screen)

            win.FlushImage()

            upfps <- true
        }
    }()

    for _ = range win.EventChan() {
    }
}


link printf

procedure main()
   &window := open("B&W noise 320x240","g","size=320,240","bg=white","fg=black") |
              stop("Open window failed ")
   runtime := 10 # seconds to run
   sec := &now
   frames := 0
   until (&now - sec) >= runtime do {
      s := "320,#"
      every 1 to 240 & 1 to 320/4 do s ||:= ?"0123456789ABCDEF"
      DrawImage(0,0,s)
      frames +:= 1
      }
   sec := &now - sec
   printf("frames=%d, elapsed time=%r, fps=%r\n",frames,sec, frames/real(sec))
   Event()   # wait for any window event
   close(&window)
end


coclass'example'
(coinsert[require)'jzopengl'

P=: 0 : 0
pc p nosize;
xywh 0 0 160 120;cc c isigraph opengl;
pas 0 0;pcenter;
rem form end;
 pshow;
 timer 1;
)

timestamp=: (6!:8'') %~ 6!:9

create=:3 :0
  ogl=:''conew'jzopengl'
  frames=:0
  start=: timestamp''
  sys_timer_base_=: ''1 :('p_c_paint_',(;coname''),'_')
  wd P
)

p_run=: 3 : 0
  ''conew'example'
)

destroy=:3 :0
  end=:timestamp''
  smoutput 'frames per second: ',":frames%end-start
  wd 'timer 0'
  destroy__ogl''
  wd'pclose'
  codestroy''
)

p_close=: destroy

p_c_paint=: 3 : 0
  rc__ogl''
  glClear GL_COLOR_BUFFER_BIT
  glBegin GL_POINTS
    glVertex _1+2*53050 2[email protected]$ 0
  glEnd''
  show__ogl''
  frames=:frames+1
)

p_run''


import java.awt.*;
import java.awt.event.*;
import java.awt.image.*;
import java.util.Arrays;
import java.util.Random;
import javax.swing.*;

public class ImageNoise {
    int framecount = 0;
    int fps = 0;
    BufferedImage image;
    Kernel kernel;
    ConvolveOp cop;
    JFrame frame = new JFrame("Java Image Noise");

    JPanel panel = new JPanel() {
        private int show_fps = 0; // 0 = blur + FPS; 1 = FPS only; 2 = neither
        private MouseAdapter ma = new MouseAdapter() {
            @Override
            public void mouseClicked(MouseEvent e) {
                show_fps = (show_fps + 1) % 3;
            }
        };
        {addMouseListener(ma);}

        @Override
        public Dimension getPreferredSize() {
            return new Dimension(320, 240);
        }

        @Override
        @SuppressWarnings("fallthrough")
        public void paintComponent(Graphics g1) {
            Graphics2D g = (Graphics2D) g1;
            drawNoise();
            g.drawImage(image, 0, 0, null);

            switch (show_fps) {
            case 0:
                // add blur behind FPS
                int xblur = getWidth() - 130, yblur = getHeight() - 32;
                BufferedImage bc = image.getSubimage(xblur, yblur, 115, 32);
                BufferedImage bs = new BufferedImage(bc.getWidth(), bc.getHeight(),
                                                     BufferedImage.TYPE_BYTE_GRAY);
                cop.filter(bc, bs);
                g.drawImage(bs, xblur, yblur , null);
            case 1:
                // add FPS text; case fallthough is deliberate
                g.setColor(Color.RED);
                g.setFont(new Font("Monospaced", Font.BOLD, 20));
                g.drawString("FPS: " + fps, getWidth() - 120, getHeight() - 10);
            }
            framecount++;
        }
    };

    // Timer to trigger update display, with 1 ms delay
    Timer repainter = new Timer(1, new ActionListener() {
        @Override
        public void actionPerformed(ActionEvent e) {
            panel.repaint();
        }
    });

    // Timer to check FPS, once per second
    Timer framerateChecker = new Timer(1000, new ActionListener() {
        @Override
        public void actionPerformed(ActionEvent e) {
            fps = framecount;
            framecount = 0;
        }
    });

    public ImageNoise() {
        // Intitalize kernel describing blur, and convolve operation based on this
        float[] vals = new float[121];
        Arrays.fill(vals, 1/121f);
        kernel = new Kernel(11, 11, vals);
        cop = new ConvolveOp(kernel, ConvolveOp.EDGE_NO_OP, null);

        // Initialize frame and timers
        frame.add(panel);
        frame.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
        frame.pack();
        frame.setVisible(true);
        repainter.start();
        framerateChecker.start();
    }

    void drawNoise() {
        int w = panel.getWidth(), h = panel.getHeight();

        // Check if our image is null or window has been resized, requiring new image
        if (null == image || image.getWidth() != w || image.getHeight() != h) {
            image = new BufferedImage(w, h, BufferedImage.TYPE_BYTE_GRAY);
        }
        Random rand = new Random();
        int[] data = new int[w * h];
        // Each int has 32 bits so we can use each bit for a different pixel - much faster
        for (int x = 0; x < w * h / 32; x++) {
            int r = rand.nextInt();
            for (int i = 0; i < 32; i++) {
                data[x * 32 + i] = (r & 1) * Integer.MAX_VALUE;
                r >>>= 1;
            }
        }
        // Copy raw data to the image's raster
        image.getRaster().setPixels(0, 0, w, h, data);
    }

    public static void main(String[] args) {
        // Invoke GUI on the Event Dispatching Thread
        SwingUtilities.invokeLater(new Runnable() {
            @Override
            public void run() {
                ImageNoise i = new ImageNoise();
            }
        });
    }
}


<body>
<canvas id='c'></canvas>

<script>
var canvas = document.getElementById('c');
var ctx = canvas.getContext('2d');

var w = canvas.width = 320;
var h = canvas.height = 240;
var t1 = new Date().getTime();
var frame_count = 0;
ctx.font = 'normal 400 24px/2 Unknown Font, sans-serif';
var img = ctx.createImageData(w, h);

var index_init = 0;
for (var x = 0; x < w; x++) {
    for (var y = 0; y < h; y++) {
        img.data[index_init + 3] = 255; // alpha
        index_init += 4;
    }
}

function animate() {
    var index = 0;
    for (var x = 0; x < w; x++) {
        for (var y = 0; y < h; y++) {
            var value = (Math.random() > 0.5) ? 255 : 0;
            img.data[index    ] = value;
            img.data[index + 1] = value;
            img.data[index + 2] = value;
            // alpha channel is constant
            index += 4;
        }
    }

    ctx.putImageData(img, 0, 0);

    frame_count++;
    if (frame_count % 50 == 0) {
        var fps = frame_count / (new Date().getTime() - t1) * 1000;
        window.status = fps.toFixed(2) + " fps";
    }

    setTimeout(animate, 0);
}

animate();
</script>
</body>


using Gtk, GtkUtilities

 function randbw(ctx, w, h)
    pic = zeros(Int64, w, h)
    for i in 1:length(pic)
        pic[i] = rand([1, 0])
    end
    copy!(ctx, pic)
end

const can = @GtkCanvas()
const win = GtkWindow(can, "Image Noise", 320, 240)

@guarded draw(can) do widget
    ctx = getgc(can)
    h = height(can)
    w = width(can)
    randbw(ctx, w, h)
end

show(can)
const cond = Condition()
endit(w) = notify(cond)
signal_connect(endit, win, :destroy)

while true
    frames = 0
    t = time()
    for _ in 1:100
        draw(can)
        show(can)
        sleep(0.0001)
        frames += 1
    end
    fps = round(frames / (time() - t), digits=1)
    set_gtk_property!(win, :title, "Image Noise: $fps fps")
end

wait(cond)


// version 1.2.10

import java.awt.*
import java.awt.event.*
import java.awt.image.*
import java.util.Random
import javax.swing.*

class ImageNoise {
    var framecount = 0
    var fps = 0
    lateinit var image: BufferedImage
    val kernel: Kernel
    lateinit var cop: ConvolveOp
    val frame = JFrame("Java Image Noise")

    val panel = object : JPanel() {
        private var showFps = 0  // 0 = blur + FPS; 1 = FPS only; 2 = neither
        private val ma = object : MouseAdapter() {
            override fun mouseClicked(e: MouseEvent) {
                showFps = (showFps + 1) % 3
            }
        }

        init {
            addMouseListener(ma)
            preferredSize = Dimension(320, 240)
        }

        override fun paintComponent(g1: Graphics) {
            val g = g1 as Graphics2D
            drawNoise()
            g.drawImage(image, 0, 0, null)
            if (showFps == 0) {
                // add blur behind FPS
                val xblur = width - 130
                val yblur = height - 32
                val bc = image.getSubimage(xblur, yblur, 115, 32)
                val bs = BufferedImage(
                    bc.width, bc.height, BufferedImage.TYPE_BYTE_GRAY
                )
                cop.filter(bc, bs)
                g.drawImage(bs, xblur, yblur, null)
            }
            if (showFps <= 1) {
                // add FPS text
                g.color = Color.RED
                g.font = Font("Monospaced", Font.BOLD, 20)
                g.drawString("FPS: $fps", width - 120, height - 10)
            }
            framecount++
        }
    }

    // Timer to trigger update display, with 1 ms delay
    val repainter = Timer(1, object: ActionListener {
        override fun actionPerformed(e: ActionEvent) = panel.repaint()
    })

    // Timer to check FPS, once per second
    val framerateChecker = Timer(1000, object : ActionListener {
        override fun actionPerformed(e: ActionEvent) {
            fps = framecount
            framecount = 0
        }
    })

    init {
        // Intitalize kernel describing blur, and convolve operation based on this
        val vals = FloatArray(121) { 1.0f / 121.0f }
        kernel = Kernel(11, 11, vals)
        cop = ConvolveOp(kernel, ConvolveOp.EDGE_NO_OP, null)

        // Initialize frame and timers
        with (frame) {
            add(panel)
            defaultCloseOperation = JFrame.EXIT_ON_CLOSE
            pack()
            isVisible = true
        }
        repainter.start()
        framerateChecker.start()
    }

    fun drawNoise() {
        val w = panel.width
        val h = panel.height

        // Check if our image is initialized or window has been resized,
        // requiring new image
        if (!this::image.isInitialized || image.width != w || image.height != h) {
            image = BufferedImage(w, h, BufferedImage.TYPE_BYTE_GRAY)
        }
        val rand = Random()
        val data = IntArray(w * h)
        // Each int has 32 bits so we can use each bit for a different pixel
        // - much faster
        for (x in 0 until w * h / 32) {
            var r = rand.nextInt()
            for (i in 0..31) {
                data[x * 32 + i] = (r and 1) * Int.MAX_VALUE
                r = r ushr 1
            }
        }
        // Copy raw data to the image's raster
        image.raster.setPixels(0, 0, w, h, data)
    }
}

fun main(args: Array<String>) {
    // Invoke GUI on the Event Dispatching Thread
    SwingUtilities.invokeLater(object: Runnable {
        override fun run() {
            ImageNoise()
        }
    })
}


WindowWidth  =411
w            =320
WindowHeight =356
h            =240

open "Noise" for graphics_nsb as #w

#w "trapclose [quit]"
#w "down"

print "Creating BMP header"

'bitmap header, 320x240 pixels 256 colors
data 66,77,54,48,1,0,0,0,0,0,54,4,0,0,40,0,0,0,64,1
data 0,0,240,0,0,0,1,0,8,0,0,0,0,0,0,44,1,0,0,0
data 0,0,0,0,0,0,0,1,0,0,0,1,0,0

head$=""
for i = 1 to 54
    read c
    head$=head$+chr$(c)
next

print "Creating BMP grayscale palette"
pal$=""
for i = 0 to 255
    pal$ = pal$ _
        + chr$(i) _
        + chr$(i) _
        + chr$(i) _
        + chr$(0)
next

print "Creating BMP random body"
    'create bitmap body
    body$=""
    for x =1 To w
        l$=""
        for y =1 To h
            l$=l$+chr$((rnd(1)>0.5)*255)
        next
        body$=body$+l$
    next

[main]
    scan
    ts =time$( "ms")
    'randomly "splice" the body: 1111222222-> 2222221111
    splice=int(len(body$)*rnd(1))+1
    body$= mid$(body$,splice+1)+left$(body$,splice)
    'write BMP
    open "noise.bmp" for output as #1
        #1 head$;pal$;
        #1 body$;
    close #1
    'load bmp
    loadbmp "noise", "noise.bmp"
    #w "cls"
    'drawbmp
    #w "drawbmp noise 0 0"

    tf =time$( "ms")
    dt =tf -ts
    if dt = 0 then dt = 1
    print "Framerate per second ="; using( "#.###", 1/(dt/1000)), "Ms per frame =";dt
    goto [main]

[quit]
    unloadbmp "noise"
    close #w
end


a:=0;
t:=time[real]();
while a< 50 do
a:=a+1;
data := Matrix(`<|>`(`<,>`(Statistics:-Sample(Uniform(0, 1), [1000, 2])), LinearAlgebra:-RandomVector(1000, generator = rand(0 .. 2))));

f := plots:-pointplot(data[NULL .. NULL, 1], data[NULL .. NULL, 2], symbolsize = 20, symbol = solidbox, colorscheme = ["valuesplit", data[NULL .. NULL, 3], [0 = "Black", 1 = "White", 2 = "Grey"]], axes = none);
DocumentTools:-SetProperty('Plot0', 'value', plots:-display(f,plots:-textplot([0.5,0.5,sprintf("FPS: %a", (a/(time[real]()-t)))],color=red)), refresh=true);

end do:


time = AbsoluteTime[]; Animate[
 Column[{Row[{"FPS: ", Round[n/(AbsoluteTime[] - time)]}],
   RandomImage[1, {320, 240}]}], {n, 1, Infinity, 1}]


try destroydialog testRollout catch ()

fn randomBitmap width height =
(
	local newBmp = bitmap width height

	for row = 0 to (height-1) do
	(
		local pixels =  for i in 1 to width collect (white*random 0 1)
		setpixels newBmp [0,row] pixels
	)

	return newBmp
)

rollout testRollout "Test" width:320 height:240
(
	bitmap image width:320 height:240 pos:[0,0]
	timer updateTimer interval:1 active:true

	on updateTimer tick do
	(
		local startTime = timestamp()
		image.bitmap = randomBitmap 320 240
		local endTime = timestamp()
		local fps = ((endTime-startTime)/1000.0)*60.0

		if mod updatetimer.ticks 10 == 0 do (testRollout.title = ("Test (FPS: "+fps as string+")"))

	)
)

createdialog testrollout


import times

import opengl
import opengl/glut

const
  W = 320
  H = 240
  SLen = W * H div sizeof(int)

var
  frame = 0
  bits: array[SLen, uint]
  last, start: Time

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

proc render() {.cdecl.} =
  ## Render the window.

  var r = bits[0] + 1
  for i in countdown(bits.high, 0):
    r *= 1103515245
    bits[i] = r xor bits[i] shr 16

  glClear(GL_COLOR_BUFFER_BIT)
  glBitmap(W, H, 0, 0, 0, 0, cast[ptr GLubyte](bits.addr))
  glFlush()

  inc frame
  if (frame and 15) == 0:
    let t = getTime()
    if t > last:
      last = t
      echo "fps: ", frame.float / (t - start).inSeconds.float

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

proc initGfx(argc: ptr cint; argv: pointer) =
  ## Initialize OpenGL rendering.

  glutInit(argc, argv)
  glutInitDisplayMode(GLUT_RGB)
  glutInitWindowSize(W, H)
  glutIdleFunc(render)
  discard glutCreateWindow("Noise")
  glutDisplayFunc(render)
  loadExtensions()

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

var argc: cint = 0
initGfx(addr(argc), nil)
start = getTime()
last = start
glutMainLoop()


let frames =
  { contents = 0 }

let t_acc =
  { contents = 0 }

let last_t =
  { contents = Sdltimer.get_ticks () }

let print_fps () =
  let t = Sdltimer.get_ticks () in
  let dt = t - !last_t in
  t_acc := !t_acc + dt;
  if !t_acc > 1000 then begin
    let el_time = !t_acc / 1000 in
    Printf.printf
      "- fps: %g\n%!"
      (float !frames /. float el_time);
    t_acc := 0;
    frames := 0;
  end;
  last_t := t

let blit_noise surf =
  let ba = Sdlvideo.pixel_data_8 surf in
  let dim = Bigarray.Array1.dim ba in
  while true do
    for i = 0 to pred dim do
      ba.{i} <- if Random.bool () then max_int else 0
    done;
    Sdlvideo.flip surf;
    incr frames;
    print_fps ()
  done

let blit_noise surf =
  try blit_noise surf
  with _ -> Sdl.quit ()

let () =
  Sdl.init [`VIDEO; `TIMER];
  Random.self_init();
  let surf =
    Sdlvideo.set_video_mode
      ~w:320 ~h:240 ~bpp:8
      [(*`HWSURFACE;*) `DOUBLEBUF]
  in
  Sys.catch_break true;
  blit_noise surf


Program ImageNoise;

uses
  SDL;

var
  surface: PSDL_Surface;
  pixel: ^byte;
  frameNumber, totalTime, lastTime, time, i: longint;

begin
  frameNumber := 0;
  totalTime   := 0;
  lastTime    := 0;
  randomize;
  SDL_Init(SDL_INIT_TIMER or SDL_INIT_VIDEO);
  surface := SDL_SetVideoMode(320, 240, 8, SDL_DOUBLEBUF or SDL_HWSURFACE);

  while (true) do
  begin
    pixel := surface^.pixels;
    SDL_LockSurface(surface);
    for i := 1 to (surface^.w * surface^.h) do
    begin
      pixel^ := random(2)*255;
      inc(pixel);
    end;
    SDL_UnlockSurface(surface);
    SDL_Flip(surface);
    inc (frameNumber);

    time := SDL_GetTicks();
    totalTime := totalTime + time - lastTime;
    if (totalTime > 1000) then
    begin
      writeln('FPS: ', frameNumber / (totalTime / 1000.0):5:1);
      frameNumber := 0;
      totalTime := 0;
    end;
    lastTime := time;
  end;
end.


use Gtk3 '-init';
use Glib qw/TRUE FALSE/;
use Time::HiRes qw/ tv_interval gettimeofday/;

my $time0 = [gettimeofday];
my $frames = -8; # account for set-up steps before drawing

my $window = Gtk3::Window->new();
$window->set_default_size(320, 240);
$window->set_border_width(0);
$window->set_title("Image_noise");
$window->set_app_paintable(TRUE);

my $da = Gtk3::DrawingArea->new();
$da->signal_connect('draw' => \&draw_in_drawingarea);
$window->add($da);
$window->show_all();
Glib::Timeout->add (1, \&update);

Gtk3->main;

sub draw_in_drawingarea {
  my ($widget, $cr, $data) = @_;
  $cr->set_line_width(1);
  for $x (1..320) {
    for $y (1..240) {
      int rand 2 ? $cr->set_source_rgb(0, 0, 0) : $cr->set_source_rgb(1, 1, 1);
      $cr->rectangle( $x, $y, 1, 1);
      $cr->stroke;
    }
  }
}

sub update {
    $da->queue_draw;
    my $elapsed = tv_interval( $time0, [gettimeofday] );
    $frames++;
    printf "fps: %.1f\n", $frames/$elapsed if $frames > 5;
    return TRUE;
}


-- demo\rosetta\ImageNoise.exw
include pGUI.e

Ihandle dlg, canvas, timer
cdCanvas cddbuffer, cdcanvas

constant TITLE = "Image noise"

integer fps = 129   -- (typical value)

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
    integer {w, h} = IupGetIntInt(canvas, "DRAWSIZE")
    cdCanvasActivate(cddbuffer)
    sequence bw = repeat(0,w*h)
    for x=0 to w-1 do
        for y=0 to h-1 do
            if rand(2)=2 then bw[x*h+y+1] = 255 end if
        end for
    end for
    cdCanvasPutImageRectRGB(cddbuffer, w, h, {bw,bw,bw})
    cdCanvasFlush(cddbuffer)
    fps += 1
    return IUP_DEFAULT
end function

atom t1 = time()

function timer_cb(Ihandle /*ih*/)
    if time()>t1 then
        IupSetStrAttribute(dlg, "TITLE", "%s [%g FPS])",{TITLE,fps})
        fps = 0
        t1 = time()+1
    end if
    IupUpdate(canvas)
    return IUP_IGNORE
end function

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

procedure main()
    IupOpen()

    canvas = IupCanvas(NULL)
    IupSetAttribute(canvas, "RASTERSIZE", "320x240")
    IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
    IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))

    timer = IupTimer(Icallback("timer_cb"), 10)

    dlg = IupDialog(canvas)
    IupSetAttribute(dlg, "TITLE", TITLE)

    IupShow(dlg)
    IupSetAttribute(canvas, "RASTERSIZE", NULL)
    IupMainLoop()
    IupClose()
end procedure

main()


(javac "ImageNoise" "JPanel" NIL
      "java.util.*"
      "java.awt.*" "java.awt.image.*" "javax.swing.*" )

   int DX, DY;
   int[] Pixels;
   MemoryImageSource Source;
   Image Img;
   Random Rnd;

   public ImageNoise(int dx, int dy) {
      DX = dx;
      DY = dy;
      Pixels = new int[DX * DY];
      Source = new MemoryImageSource(DX, DY, Pixels, 0, DX);
      Source.setAnimated(true);
      Img = createImage(Source);
      Rnd = new Random();
   }

   public void paint(Graphics g) {update(g);}
   public void update(Graphics g) {g.drawImage(Img, 0, 0, this);}

   public void draw() {
      for (int i = 0; i < Pixels.length; ++i) {
         int c = Rnd.nextInt(255);
         Pixels[i] = 0xFF000000 | c<<16 | c<<8 | c;
      }
      Source.newPixels();
      paint(getGraphics());
   }
/**/

(de imageNoise (DX DY Fps)
   (let
      (Frame (java "javax.swing.JFrame" T "Image Noise")
         Noise (java "ImageNoise" T DX DY)
         Button (java "javax.swing.JButton" T "OK") )
      (java Frame "add" Noise)
      (java Frame "add" "South" Button)
      (java Button "addActionListener"
         (interface "java.awt.event.ActionListener"
            'actionPerformed '((Ev) (bye)) ) )
      (java Frame "setSize" DX DY)
      (java Frame "setVisible" T)
      (task (/ -1000 Fps) 0
         Image Noise
         (java Image "draw") ) ) )

# Start with 25 frames per second
(imageNoise 320 240 25)


Image_Noise: procedure options (main); /* 3 November 2013 */
   declare (start_time, end_time) float (18);
   declare (frame, m, n) fixed binary;

   start_time = secs();
   get (m, n);
   do frame = 1 to 100; /* Generate 100 frames. */
      call display (m, n);
      put skip data (frame);
   end;
   end_time = secs();

   put skip list ('Average FPS =' || fixed(100/(end_time-start_time), 6) );

display: procedure (m, n);
   declare (m, n) fixed binary;
   declare screen(0:m, 0:n) bit (1);
   declare i fixed binary;
   declare random builtin;

      screen = '0'b; /* clear screen for this frame */
      do i = 0 to m*n*random;
         screen(random*m, random*n) = random > 0.5;
      end;
end display;

end Image_Noise;


color black = color(0);
color white = color(255);

void setup(){
  size(320,240);
  // frameRate(300); // 60 by default
}

void draw(){
  loadPixels();
  for(int i=0; i<pixels.length; i++){
    if(random(1)<0.5){
      pixels[i] = black;
    }else{
      pixels[i] = white;
    }
  }
  updatePixels();
  fill(0,128);
  rect(0,0,60,20);
  fill(255);
  text(frameRate, 5,15);
}


#filter=0.2       ; Filter parameter for the FPS-calculation
#UpdateFreq=100   ; How often to update the FPS-display

OpenWindow(0,400,300,320,240,"PureBasic")
Define w=WindowWidth(0), h=WindowHeight(0)
Define x, y, T, TOld, FloatingMedium.f, cnt
InitSprite()
OpenWindowedScreen(WindowID(0),0,0,w,h,1,0,0,#PB_Screen_NoSynchronization)
Repeat
  StartDrawing(ScreenOutput())
  For y=0 To h-1
    For x=0 To w-1
      If Random(1)
        Plot(x,y,#Black)
      Else
        Plot(x,y,#White)
      EndIf
    Next
  Next
  StopDrawing()
  FlipBuffers()
  cnt+1
  If cnt>=#UpdateFreq
    cnt =0
    TOld=T
    T   =ElapsedMilliseconds()
    FloatingMedium*(1-#filter)+1000*#filter/(T-TOld)
    SetWindowTitle(0,"PureBasic: "+StrF(#UpdateFreq*FloatingMedium,2)+" FPS")
    Repeat ; Handle all events
      Event=WindowEvent()
      If Event=#PB_Event_CloseWindow
        End
      EndIf
    Until Not Event
  EndIf
ForEver


import time
import random
import Tkinter
import Image, ImageTk # PIL libray

class App(object):
    def __init__(self, size, root):
        self.root = root
        self.root.title("Image Noise Test")

        self.img = Image.new("RGB", size)
        self.label = Tkinter.Label(root)
        self.label.pack()

        self.time = 0.0
        self.frames = 0
        self.size = size
        self.loop()

    def loop(self):
        self.ta = time.time()
        # 13 FPS boost. half integer idea from C#.
        rnd = random.random
        white = (255, 255, 255)
        black = (0, 0, 0)
        npixels = self.size[0] * self.size[1]
        data = [white if rnd() > 0.5 else black for i in xrange(npixels)]
        self.img.putdata(data)
        self.pimg = ImageTk.PhotoImage(self.img)
        self.label["image"] = self.pimg
        self.tb = time.time()

        self.time += (self.tb - self.ta)
        self.frames += 1

        if self.frames == 30:
            try:
                self.fps = self.frames / self.time
            except:
                self.fps = "INSTANT"
            print ("%d frames in %3.2f seconds (%s FPS)" %
                  (self.frames, self.time, self.fps))
            self.time = 0
            self.frames = 0

        self.root.after(1, self.loop)

def main():
    root = Tkinter.Tk()
    app = App((320, 240), root)
    root.mainloop()

main()


#lang racket
(require 2htdp/image 2htdp/universe)

(define black (color   0   0   0 255))
(define white (color 255 255 255 255))

(define-struct world (last fps))

(define (noise w h)
  (color-list->bitmap
   (for*/list ([x (in-range w)] [y (in-range h)])
     (if (zero? (random 2)) black white))
   w h))

(define (draw w)
  (underlay/xy
   (noise 320 240) 0 0
   (text (number->string (world-fps w)) 64 "Red")))

(define (handle-tick w)
  (define cm (current-inexact-milliseconds))
  (make-world cm (exact-floor (/ 1000.0 (- cm (world-last w))))))

(big-bang (make-world 1 0)
          [on-draw draw]
          [on-tick handle-tick (/ 1. 120)])


use NativeCall;
use SDL2::Raw;

my int ($w, $h) = 320, 240;

SDL_Init(VIDEO);

my SDL_Window $window = SDL_CreateWindow(
    "White Noise - Raku",
    SDL_WINDOWPOS_CENTERED_MASK, SDL_WINDOWPOS_CENTERED_MASK,
    $w, $h,
    RESIZABLE
);

my SDL_Renderer $renderer = SDL_CreateRenderer( $window, -1, ACCELERATED +| TARGETTEXTURE );

my $noise_texture = SDL_CreateTexture($renderer, %PIXELFORMAT<RGB332>, STREAMING, $w, $h);

my $pixdatabuf = CArray[int64].new(0, $w, $h, $w);

sub render {
    my int $pitch;
    my int $cursor;

    # work-around to pass the pointer-pointer.
    my $pixdata = nativecast(Pointer[int64], $pixdatabuf);
    SDL_LockTexture($noise_texture, SDL_Rect, $pixdata, $pitch);

    $pixdata = nativecast(CArray[int8], Pointer.new($pixdatabuf[0]));

    loop (my int $row; $row < $h; $row = $row + 1) {
        loop (my int $col; $col < $w; $col = $col + 1) {
            $pixdata[$cursor + $col] = Bool.roll ?? 0xff !! 0x0;
        }
        $cursor = $cursor + $pitch;
    }

    SDL_UnlockTexture($noise_texture);

    SDL_RenderCopy($renderer, $noise_texture, SDL_Rect, SDL_Rect);
    SDL_RenderPresent($renderer);
}

my $event = SDL_Event.new;

main: loop {

    while SDL_PollEvent($event) {
        my $casted_event = SDL_CastEvent($event);

        given $casted_event {
            when *.type == QUIT {
                last main;
            }
        }
    }

    render();
    print fps;
}

say '';

sub fps {
    state $fps-frames = 0;
    state $fps-now    = now;
    state $fps        = '';
    $fps-frames++;
    if now - $fps-now >= 1 {
        $fps = [~] "\b" x 40, ' ' x 20, "\b" x 20 ,
            sprintf "FPS: %5.2f  ", ($fps-frames / (now - $fps-now)).round(.01);
        $fps-frames = 0;
        $fps-now = now;
    }
    $fps
}