RosettaCodeData/Task/Imaginary-base-numbers/FreeBASIC/imaginary-base-numbers.basic

#define ceil(x) (-((-x*2.0-0.5) Shr 1))

Type Complex
    real As Double
    imag As Double
End Type

Type QuaterImaginary
    b2i As String
End Type

Dim Shared As Complex c1, c2

Function StrReverse(Byval txt As String) As String
    Dim result As String
    For i As Integer = Len(txt) To 1 Step -1
        result &= Mid(txt, i, 1)
    Next i
    Return result
End Function

Function ToChar(n As Integer) As String
    Return Chr(n + Asc("0"))
End Function

Function ComplexMul(lhs As Complex, rhs As Complex) As Complex
    Dim As Complex result
    result.real = rhs.real * lhs.real - rhs.imag * lhs.imag
    result.imag = rhs.real * lhs.imag + rhs.imag * lhs.real
    Return result
End Function

Function ComplexMulR(lhs As Complex, rhs As Double) As Complex
    Dim As Complex result
    result.real = lhs.real * rhs
    result.imag = lhs.imag * rhs
    Return result
End Function

Function ComplexInv(c As Complex) As Complex
    Dim As Double denom
    Dim As Complex result
    denom = c.real * c.real + c.imag * c.imag
    result.real = c.real / denom
    result.imag = -c.imag / denom
    Return result
End Function

Function ComplexDiv(lhs As Complex, rhs As Complex) As Complex
    Return ComplexMul(lhs, ComplexInv(rhs))
End Function

Function ComplexNeg(c As Complex) As Complex
    Dim As Complex result
    result.real = -c.real
    result.imag = -c.imag
    Return result
End Function

Function ComplexSum(lhs As Complex, rhs As Complex) As Complex
    Dim As Complex result
    result.real = lhs.real + rhs.real
    result.imag = lhs.imag + rhs.imag
    Return result
End Function

Function ToQuaterImaginary(c As Complex) As QuaterImaginary
    Dim As Integer re, im, fi, rem_, index
    Dim As Double f
    Dim As Complex t
    Dim As QuaterImaginary result
    Dim As String sb
    re = Int(c.real)
    im = Int(c.imag)
    fi = -1
    While re <> 0
        rem_ = (re Mod -4)
        re = re \ (-4)
        If rem_ < 0 Then
            rem_ = 4 + rem_
            re += 1
        End If
        sb &= ToChar(rem_) & "0"
    Wend
    If im <> 0 Then
        t = ComplexDiv(Type<Complex>(0.0, c.imag), Type<Complex>(0.0, 2.0))
        f = t.real
        im = Ceil(f)
        f = -4.0 * (f - Cdbl(im))
        index = 1
        While im <> 0
            rem_ = im Mod -4
            im \= -4
            If rem_ < 0 Then
                rem_ = 4 + rem_
                im += 1
            End If
            If index < Len(sb) Then
                Mid(sb, index + 1, 1) = ToChar(rem_)
            Else
                sb &= "0" & ToChar(rem_)
            End If
            index += 2
        Wend
        fi = Int(f)
    End If
    sb = StrReverse(sb)
    If fi <> -1 Then sb &= "." & ToChar(fi)
    sb = Ltrim(sb, "0")
    If Left(sb, 1) = "." Then sb = "0" & sb
    result.b2i = sb
    Return result
End Function

Function ToComplex(qi As QuaterImaginary) As Complex
    Dim As Integer j, pointPos, posLen, b2iLen
    Dim As Double k
    Dim As Complex sum, prod
    pointPos = Instr(qi.b2i, ".")
    posLen = Iif(pointPos = 0, Len(qi.b2i), pointPos - 1)
    sum.real = 0.0
    sum.imag = 0.0
    prod.real = 1.0
    prod.imag = 0.0
    For j = 0 To posLen - 1
        k = Val(Mid(qi.b2i, posLen - j, 1))
        If k > 0.0 Then sum = ComplexSum(sum, ComplexMulR(prod, k))
        prod = ComplexMul(prod, Type<Complex>(0.0, 2.0))
    Next
    If pointPos <> 0 Then
        prod = ComplexInv(Type<Complex>(0.0, 2.0))
        b2iLen = Len(qi.b2i)
        For j = posLen + 1 To b2iLen - 1
            k = Val(Mid(qi.b2i, j + 1, 1))
            If k > 0.0 Then sum = ComplexSum(sum, ComplexMulR(prod, k))
            prod = ComplexMul(prod, ComplexInv(Type<Complex>(0.0, 2.0)))
        Next
    End If
    Return sum
End Function

Dim As QuaterImaginary qi
Dim As Integer i
For i = 1 To 16
    c1.real = Cdbl(i)
    c1.imag = 0.0
    qi = ToQuaterImaginary(c1)
    c2 = ToComplex(qi)
    Print c1.real; "i -> "; qi.b2i; " -> "; c2.real; "i";
    c1 = ComplexNeg(c1)
    qi = ToQuaterImaginary(c1)
    c2 = ToComplex(qi)
    Print c1.real; "i -> "; qi.b2i; " -> "; c2.real; "i"
Next
Print
For i = 1 To 16
    c1.real = 0.0
    c1.imag = Cdbl(i)
    qi = ToQuaterImaginary(c1)
    c2 = ToComplex(qi)
    Print c1.imag; "i -> "; qi.b2i; " -> "; c2.imag; "i";
    c1 = ComplexNeg(c1)
    qi = ToQuaterImaginary(c1)
    c2 = ToComplex(qi)
    Print c1.imag; "i -> "; qi.b2i; " -> "; c2.imag; "i"
Next

Sleep