XProfan

Título de la ventana "PROGRAM RosettaISAAC V2.6-beta"
'(PD) Public Domain, transposed to XProfan-11.2a en
'Feb. 2020 by P.Pájaro carpintero(AT)gmx.at, Vienna/Austria/EU
'-----------------------------------------------------------------------------
'[The Improved] Random Number Generator ISAAC (C) by Bob Jenkins,
' March 1996, Public Domain, C-Source Intro: "You may use this code en any way
' you wish, and it is free.  No warrantee."
'-----------------------------------------------------------------------------
'[Rosetta Texto:] ISAAC stands for "Indirection, Shift, Accumulate, Add, and Count"
'which are the principal bitwise operations employed. To date - after 24 years of
'existence ISAAC has not been broken (unless GCHQ or NSA did it, but dont tell us).
'ISAAC thus deserves a lot more attention than it has received, and it would be
'salutary to see it more universally implemented.
'-----------------------------------------------------------------------------
GOTO "FloatMaths"
// uses MODf() on uInt instead of XProfan's MOD Operator
START:
CLS
Var iMode&=0
Def &iEncrypt 0
Def &iDecrypt 1
Def &true 1
Def &falso 0
// TASK globals
Var msg$ = "Das es una langer Geheimtext con uno Longitud de len Byte!"'"a Top Secret secret"// Recommended max 4095 Byte
var key$ = "Goodbye Auf Wiedersehen Arrevederci Bonne nuit Tschüss!"'"this is my secret key"// Max. 256 Byte are used
// Main Globals
var  xctx$ = ""
// XOR ciphertext
var  mctx$ = ""
// MOD ciphertext
var  xptx$ = ""
// XOR decryption (plaintext)
var  mptx$ = ""
// MOD decryption (plaintext)
// ISAAC vars have to be globals en XProfan:
// external results
declarar randrsl&[255]
declarar randcnt&
// internal state
declarar  mm&[255]
declarar  aa&,bb&,cc&
// inter proc
declarar a&,b&,c&,d&,e&,f&,g&,h&

PROC ISAAC

    // PSEUDO RANDOM GENERATOR
    'If the initial internal state is all zero, after ten calls the values of
    'aa, bb, and cc en hexadecimal voluntad be d4d3f473, 902c0691, and 0000000a.
    declarar i&,x&,y&
    inc cc&// cc just gets incremented once por 256 results
    inc bb&,cc&// then combined with bb

    Whileloop 0,255:i&=&Loop

        x&=mm&[i&]

        SELECT (i& MOD 4)

            caseof 0:aa&=XOR(aa&,(aa&<<13))

            caseof 1:aa&=XOR(aa&,(aa&>>6))

            caseof 2:aa&=XOR(aa&,(aa&<<2))

            caseof 3:aa&=XOR(aa&,(aa&>>16))

        ENDSELECT

        aa&= mm&[(i&+128) MOD 256]+aa&
        y&= mm&[(x&>>2) MOD 256]+aa&+bb&
        mm&[i&]=y&
        bb&=mm&[(y&>>10) MOD 256]+x&
        randrsl&[i&]=bb&

    EndWhile

    // Additionally  prepare to use the first set of results
    randcnt&=0

ENDPROC

Proc Mix

    a&=XOR(a&,(b&<<11)):inc d&,a&:inc b&,c&
    b&=XOR(b&,(c&>>2)):inc e&,b&:inc c&,d&
    c&=XOR(c&,(d&<<8)):inc f&,c&:inc d&,e&
    d&=XOR(d&,(e&>>16)):inc g&,d&:inc e&,f&
    e&=XOR(e&,(f&<<10)):inc h&,e&:inc f&,g&
    f&=XOR(f&,(g&>>4)):inc a&,f&:inc g&,h&
    g&=XOR(g&,(h&<<8)):inc b&,g&:inc h&,a&
    h&=XOR(h&,(a&>>9)):inc c&,h&:inc a&,b&

ENDPROC

Proc iRandInit :parámetros flag&

    declarar i&':init a,b,c,d,e,f,g,h 'In XProfan globaly!
    clear aa&,bb&,cc&
    a&=$9e3779b9// the golden ratio
    b&=a&:c&=a&:d&=a&:e&=a&:f&=a&:g&=a&:h&=a&

    Whileloop 0,3// scramble it

        Mix

    Endwhile

    i&=0

    REPEAT

        // fill en mm[]

        IF flag&

            // use all the information en the seed
            a&=a&+randrsl&[i&]
            b&=b&+randrsl&[i&+1]
            c&=c&+randrsl&[i&+2]
            d&=d&+randrsl&[i&+3]
            e&=e&+randrsl&[i&+4]
            f&=f&+randrsl&[i&+5]
            g&=g&+randrsl&[i&+6]
            h&=h&+randrsl&[i&+7]

        ENDIF

        Mix()
        ' mm[] using a-h
        mm&[i&]=a&
        mm&[i&+1]=b&
        mm&[i&+2]=c&
        mm&[i&+3]=d&
        mm&[i&+4]=e&
        mm&[i&+5]=f&
        mm&[i&+6]=g&
        mm&[i&+7]=h&
        inc i&,8

    UNTIL i& > 255

    IF flag&

        // do a second pass to make all of the seed affect all of mm
        i&=0

        REPEAT

            a&=a&+mm&[i&]
            b&=b&+mm&[i&+1]
            c&=c&+mm&[i&+2]
            d&=d&+mm&[i&+3]
            e&=e&+mm&[i&+4]
            f&=f&+mm&[i&+5]
            g&=g&+mm&[i&+6]
            h&=h&+mm&[i&+7]
            Mix()
            mm&[i&]=a&
            mm&[i&+1]=b&
            mm&[i&+2]=c&
            mm&[i&+3]=d&
            mm&[i&+4]=e&
            mm&[i&+5]=f&
            mm&[i&+6]=g&
            mm&[i&+7]=h&
            inc i&,8

        UNTIL i& > 255

    ENDif

    ISAAC
    // fill en the first set of results
    randcnt&=0
    // prepare to use the first set of results

ENDPROC

Proc iSeed :parámetros seed$,flag&

    // Seed ISAAC with a given cadena.
    // The cadena can be any size. The first 256 values voluntad be used.
    declarar i&,m&
    mm&[]=0
    m&=Len(seed$)-1

    Whileloop 0,255:i&=&Loop

        // en caso seed has less than 256 elements

        If i&>m&

            randrsl&[i&]=0
            // Pascal strings are 1-based, like en XProfan

        Más

            randrsl&[i&]=Ord(mid$(seed$,i&+1,1))

        Endif

    Endwhile

    // initialize ISAAC with seed
    iRandInit(flag&)

ENDPROC

Proc iRandom

    // Get a random 32-bit value 0..MAXINT
    declarar iRandom&
    iRandom& = randrsl&[randcnt&]
    inc randcnt&

    IF randcnt&>255

        ISAAC
        randcnt&=0

    ENDif

    volver if(iRandom&<0,iRandom&+2^32,iRandom&*1)
    '= float

ENDPROC

Proc iRandA

    // Get a random character en printable ASCII range
    volver intf(modf(iRandom(),95)+32)

ENDproc

Proc Ascii2Hex :parámetros s$

    Declarar i&,Ascii2Hex$
    Ascii2Hex$=""

    Whileloop len(s$):i&=&Loop

        Ascii2Hex$=Ascii2Hex$+Right$("0"+hex$(Ord(mid$(s$,i&,1))),2)

    Endwhile

    volver Ascii2Hex$

ENDPROC

Proc Vernam :parámetros msg$

    // XOR encrypt on random stream. Output a ASCII cadena
    Declarar i&,vernam$
    Vernam$=""

    whileloop len(msg$) : i&=&Loop

        Vernam$=Vernam$+Chr$(xor(iRandA(),Ord(mid$(msg$,i&,1))))

    endwhile

    volver vernam$

ENDPROC

Proc LetterNum : parámetros letter$,start$

    // Get position of the letter en chosen alphabet
    volver Ord(letter$) - Ord(start$)

ENDPROC

// Caesar-shift a character <shift> places by Generalized Vigenere

Proc Caesar : parámetros m&,ch$,shift&,modulo&,start$

    Declarar n&
    Case m& = &iDecrypt: shift& = -shift&
    n& = LetterNum(ch$, start$) + shift&
    n& = n& MOD modulo&
    Case n&<0:n& = n&+modulo&
    volver Chr$(Ord(start$) + n&)

ENDPROC

// EoCaesar
// Vigenere MOD 95 encryption & decryption. Output a ASCII cadena

Proc Vigenere

    parámetros msg$,m&
    Declarar i&,Vigenere$
    Vigenere$ = ""

    whileloop len(msg$):i&=&Loop

        Vigenere$ = Vigenere$ + Caesar(m&, mid$(msg$,i&,1), iRandA(), 95, " ")

    endwhile

    volver Vigenere$

ENDPROC

BEGIN:
'Main Program
// 1) seed ISAAC with the key
iSeed(key$, &true)
// 2) Encryption
// a) XOR (Vernam)
xctx$ = Vernam(msg$)
// b) MOD (Vigenere)
mctx$ = Vigenere(msg$, &iEncrypt)
// 3) Decryption
iSeed(key$, &true)
// key sentence, 0=totally new 1=useAllpreviouseRandoms
// a) XOR (Vernam)
xptx$ = Vernam(xctx$)
// b) MOD (Vigenere)
mptx$ = Vigenere(mctx$, &iDecrypt)
// program output
Imprimir
imprimir "Message: ", msg$
imprimir "Key    : ", key$
Imprimir "XOR    : ", Ascii2Hex(xctx$)
Imprimir "MOD    : ", Ascii2Hex(mctx$)
Imprimir "XOR dcr: ", xptx$
Imprimir "MOD dcr: ", mptx$
'Check Output:
'Message: a Top Secret secret
'Key    : this is my secret key
'XOR    : 1C0636190B1260233B35125F1E1D0E2F4C5422
'MOD    : 734270227D36772A783B4F2A5F206266236978
'XOR dcr: a Top Secret secret
'MOD dcr: a Top Secret secret
waitinput
FIN
FloatMaths:

proc sgn :parámetros x!

    ' Signum-Función: -1,0,+1
    volver (x!>0)-(x!<0)

ENDPROC

proc floor :parámetros x!

    ' Gaussklammer-Función
    caso abs(x!)<(10^-35):volver 0
    caso x!>0:volver intf(x!)
    volver (abs(x!-intf(x!)) < 10^-35)-intf(abs(x!-1))

ENDPROC

proc ceil :parámetros x!

    ' Ceiling-Función
    volver -1*floor(-1*x!)

ENDPROC

proc modf :parámetros x!,y!

    ' Q  de.wikipedia.org/wiki/Modulo
    caso abs(x!)<10^-35:volver 0
    caso abs(y!)<10^-35:volver x!
    volver sgn(y!)*abs(x!-y!*floor(x!/y!))

ENDPROC

proc remn :parámetros x!,y!

    ' Q: https://de.wikipedia.org/wiki/Modulo = Remnant()
    caso abs(x!)<(10^-35):volver 0
    caso abs(y!)<(10^-35):volver x!
    volver sgn(x!)*abs(x!-y!*floor(x!/y!))

ENDPROC

proc IsNeg :parámetros x!

    volver byte(Addr(x!),7)&%10000000>>7

ENDPROC

proc frac :parámetros x!

    var s!=sgn(x!)
    x!=abs(x!)
    x!=x!-round(x!,0)
    caso x!<0:x!=1+x!
    volver s!*x!

ENDPROC

proc intf :parámetros x!

    var s!=sgn(x!)
    x!=abs(x!)
    x!=x!-frac(x!)
    volver s!*x!

ENDPROC

GOTO "START"
ProgEnd