Sign in to follow this  
Followers 0
czardas

Flip Flap Flop

6 posts in this topic

#1 ·  Posted (edited)

Flip Flap Flop

FlipFlapFlop is a simulation of a logical ternary architecture.

SPECS

Produce a three value logic system using ternary, and write tritwise functions that mimick the behaviour of bitwise funtions available in AutoIt. The tritwise functions must copy the behaviour of their binary counterparts as closely as possible.

Differences from binary

Tritwise operations operate on unsigned 31-trit integers.

1 tryte = 6 trits

A ternary value of 2 is set to TRUE and a ternary value of 1 is set to Undefined.

Three's compliment is not employed since an undefined most significant trit would be illegal and somewhat meaningless.

You will need math10.au3 and stringf.au3

#include-once
#include 'math10.au3'
#include 'stringf.au3'

; #INDEX# =======================================================================================================================
; Title .........: flipflapflop
; AutoIt Version : 3.3.8.1
; Language ......: English
; Description ...: Three value logic tritwise function library based on Kleen's logic.
; Notes .........: A trit is a single ternary digit (base 3), and can have one of the following values:
;                  _____________________
;                  Trit    Meaning
;                  ---------------------
;                  0          False
;                  1          Undefined
;                  2          True
;                  ---------------------
;                  A tryte contains six trits, and is similar to the term byte.
;                  An unsigned 31-trit integer contains 5 trytes plus 1 trit ==> 2222222222222222222222222222222
;                  Decimal values range from 0 to 617673396283946 (negative numbers are not used and will cause errors).
; Author(s) .....: czardas
; ===============================================================================================================================

; #CURRENT# =====================================================================================================================
;_TritAND
;_TritNOT
;_TritOR
;_TritRotate
;_TritShift
;_TritXOR
; ===============================================================================================================================

; #INTERNAL_USE_ONLY#============================================================================================================
; __31TritInt
; ===============================================================================================================================

; #FUNCTION# ====================================================================================================================
; Name...........: _TritAND
; Description ...: Performs a tritwise AND operation.
; Syntax.........: _TritAND( value1, value2 [, value n])
; Parameters ....: value1  - The first number
;                  value2  - The second number
;                  value n - [optional] The nth number - up to 37 values can be specified
; Return values .: Success - Returns the parameters tritwise-AND'ed together
;                  Failure - Returns an empty string, sets @error to 1 and sets @extended to the fail point
; Author ........: czardas
; Modified.......:
; Remarks .......: Returns 2 in trit positions where all values are 2 (True)
;                  Returns 0 in trit positions where at least one value is 0 (False)
;                  Returns 1 in all other trit positions (Undefined)
; Related .......: _TritNOT , _TritOR , _TritRotate , _TritShift , _TritXOR
; Link ..........:
; Example .......: MsgBox(0, "_TritAND(8, 7) = 7", _TritAND(8, 7) = 7)
; ===============================================================================================================================

Func  _TritAND($_,$0,$1=0,$2=0,$3=0,$4=0,$5=0,$6=0,$7=0,$8=0,$9=0,$a=0,$b=0,$c=0,$d=0,$e=0,$f=0,$g=0,$h=0,$i=0,$j=0,$k=0,$l=0,$m=0,$n=0,$o=0,$p=0,$q=0,$r=0,$s=0,$t=0,$u=0,$v=0,$w=0,$x=0,$y=0,$z=0)
    Local $sTrinary = "", $iBound = @NumParams -1, $aParam[37] = [$_,$0,$1,$2,$3,$4,$5,$6,$7,$8,$9,$a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u,$v,$w,$x,$y,$z], $iTrit
    ReDim $aParam[$iBound +1]
    For $e = 0 To $iBound
        __31TritInt($aParam[$e])
        If @error Then SetError(1, $e +1, "") ; Invalid or out of bounds input
    Next
    For $c = 1 To 31
        $iTrit = 2
        For $e = 0 To $iBound
            Switch StringMid($aParam[$e], $c, 1)
                Case 1
                    $iTrit = 1
                Case 0
                    $iTrit = 0
                    ExitLoop
            EndSwitch
        Next
        $sTrinary &= $iTrit
    Next
    Return _BaseToDec($sTrinary, 3)
EndFunc ;==> _TritAND

; #FUNCTION# ====================================================================================================================
; Name...........: _TritNOT
; Description ...: Performs a tritwise NOT operation on an unsigned 31-trit integer.
; Syntax.........: _TritNOT($iNumber)
; Parameters ....: $iNumber - The number to operate on.
; Return values .: Success  - Returns the tritwise NOT of the number.
;                  Failure  - Returns an empty string and sets @error to 1 if the input is not an unsigned 31-trit integer.
; Author ........: czardas
; Modified.......:
; Remarks .......: Returns 0 in trit positions containing 2
;                  Returns 1 in trit positions containing 1
;                  Returns 2 in trit positions containing 0
; Related .......: _TritAND , _TritOR , _TritRotate , _TritShift , _TritXOR
; Link ..........:
; Example .......: MsgBox(0, _TritNOT(0), _DecToBase(_TritNOT(0), 3))
; ===============================================================================================================================

Func _TritNOT($iNumber)
    __31TritInt($iNumber)
    If @error Then SetError(1, 0, "")
    Return _BaseToDec(StringReplace(StringReplace(StringReplace($iNumber,"2","3"),"0","2"),"3","0"), 3)
EndFunc

; #FUNCTION# ====================================================================================================================
; Name...........: _TritOR
; Description ...: Performs a tritwise OR operation.
; Syntax.........: _TritOR( value1, value2 [, value n])
; Parameters ....: value1  - The first number
;                  value2  - The second number
;                  value n - [optional] The nth number - up to 37 values can be specified
; Return values .: Success - Returns the parameters tritwise-OR'ed together
;                  Failure - Returns an empty string, sets @error to 1 and sets @extended to the fail point
; Author ........: czardas
; Modified.......:
; Remarks .......: Returns 0 in trit positions where all values are 1 (False)
;                  Returns 2 in trit positions where at least one value is 2 (True)
;                  Returns 1 in all other trit positions (Undefined)
; Related .......: _TritAND , _TritNOT , _TritRotate , _TritShift , _TritXOR
; Link ..........:
; Example .......: MsgBox(0, "_TritOR(12, 4)", _TritOR(12, 4))
; ===============================================================================================================================

Func  _TritOR($_,$0,$1=0,$2=0,$3=0,$4=0,$5=0,$6=0,$7=0,$8=0,$9=0,$a=0,$b=0,$c=0,$d=0,$e=0,$f=0,$g=0,$h=0,$i=0,$j=0,$k=0,$l=0,$m=0,$n=0,$o=0,$p=0,$q=0,$r=0,$s=0,$t=0,$u=0,$v=0,$w=0,$x=0,$y=0,$z=0)
    Local $sTrinary = "", $iBound = @NumParams -1, $aParam[37] = [$_,$0,$1,$2,$3,$4,$5,$6,$7,$8,$9,$a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u,$v,$w,$x,$y,$z], $iTrit
    ReDim $aParam[$iBound +1]
    For $e = 0 To $iBound
        __31TritInt($aParam[$e])
        If @error Then SetError(1, $e +1, "")
    Next
    For $c = 1 To 31
        $iTrit = 0
        For $e = 0 To $iBound
            Switch StringMid($aParam[$e], $c, 1)
                Case 1
                    $iTrit = 1
                Case 2
                    $iTrit = 2
                    ExitLoop
            EndSwitch
        Next
        $sTrinary &= $iTrit
    Next
    Return _BaseToDec($sTrinary, 3)
EndFunc ;==> _TritOR

; #FUNCTION# ====================================================================================================================
; Name...........: _TritRotate
; Description ...: Performs a trit shift operation, with rotation.
; Syntax.........: _TritRotate($iNumber [, $iShift = 1 [, $iSize = 31 ]])
; Parameters ....: $iNumber  - The trinary value to rotate.
;                : $iShift   - Number of trits to rotate to the left (negative numbers shift right) => Default = 1.
;                : $iSize    - [optional] Trit loop size => Default = 31 trits
; Return values .: Success   - Returns the value rotated by the required number of trits
;                  Failure   - Sets @error to the following values
;                  |@error = 1 Invalid first parameter - $iNumber must be an unsigned 31-trit integer.
;                  |@error = 2 Invalid second parameter - $iShift value is not an integer.
;                  |@error = 3 Invalid third parameter - $iSize must be a positive integer.
; Author ........: czardas
; Modified.......:
; Related .......: _TritAND , _TritNOT , _TritOR , _TritShift , _TritXOR
; Link ..........:
; Example .......: MsgBox(0, "_TritRotate(19, 2, 4)", _TritRotate(19, 2, 4))
; ===============================================================================================================================

Func _TritRotate($iNumber, $iShift = 1, $iSize = 31)
    __31TritInt($iNumber)
    If @error Then SetError(1, 0, "")
    If Not IsInt($iShift) Then Return SetError(2, 0, "")
    If Not IsInt($iSize) Or $iSize < 0 Or $iSize > 31  Then Return SetError(3, 0, "")
    $iNumber = StringLeft($iNumber, 31 -$iSize) & _StringModulate(StringRight($iNumber, $iSize), $iShift)
    Return _BaseToDec($iNumber, 3)
EndFunc ; _TritRotate

; #FUNCTION# ====================================================================================================================
; Name...........: _TritShift
; Description ...: Performs a trit shifting operation on an unsigned 31-trit integer.
; Syntax.........: _TritShift($iNumber [, $iShift =1 ])
; Parameters ....: $iNumber  - The unsigned 31-trit integer to be shifted
;                : $iShift   - Number of trits to shift to the left (negative numbers shift right) => Default = 1.
; Return values .: Success   - Returns the value shifted by the required number of trits
;                  Failure   - Sets @error to the following values:
;                  |@error = 1 Invalid first parameter - number must be an unsigned 31-trit integer
;                  |@error = 2 Invalid second parameter - shift value is not an integer
; Author ........: czardas
; Modified.......:
; Remarks .......: _TritShift uses logical shift, as opposed to arithmetic shift.
; Related .......: _TritAND , _TritNOT , _TritOR , _TritRotate , _TritXOR
; Link ..........:
; Example .......: MsgBox(0, "_TritShift(1,3)", _TritShift(1,3))
; ===============================================================================================================================

Func _TritShift($iNumber, $iShift =1)
    __31TritInt($iNumber)
    If @error Then SetError(1, 0, "")
    If Not IsInt($iShift) Then Return SetError(2, 0, "")
    If $iShift > 0 Then
        $iNumber = StringTrimLeft($iNumber, $iShift) & StringRight("0000000000000000000000000000000", $iShift)
    Else
        $iNumber = StringRight("0000000000000000000000000000000", -$iShift) & StringTrimRight($iNumber, -$iShift)
    EndIf
    Return _BaseToDec($iNumber, 3)
EndFunc ;==> _TritShift

; #FUNCTION# ====================================================================================================================
; Name...........: _TritXOR
; Description ...: Performs a tritwise XOR operation.
; Syntax.........: _TritXOR( value1, value2 [, value n])
; Parameters ....: value1  - The first number.
;                  value2  - The second number.
;                  value n - [optional] The nth number - up to 37 values can be specified.
; Return values .: Success - Returns the parameters tritwise-XOR'ed together.
;                  Failure - Returns an empty string, sets @error to 1 and sets @extended to the fail point
; Author ........: czardas
; Modified.......:
; Remarks .......: Returns 2 in trit positions when there are an odd number 2's in all corresponding trit positions. (True)
;                  Returns 1 in trit positions where at least one value is 1 (Undefined)
;                  Returns 0 in all other trit positions (False)
; Related .......: _TritAND , _TritNOT , _TritOR , _TritRotate , _TritShift
; Link ..........:
; Example .......: MsgBox(0, "_TritXOR(55,55)", _TritXOR(55,55))
; ===============================================================================================================================

Func  _TritXOR($_,$0,$1=0,$2=0,$3=0,$4=0,$5=0,$6=0,$7=0,$8=0,$9=0,$a=0,$b=0,$c=0,$d=0,$e=0,$f=0,$g=0,$h=0,$i=0,$j=0,$k=0,$l=0,$m=0,$n=0,$o=0,$p=0,$q=0,$r=0,$s=0,$t=0,$u=0,$v=0,$w=0,$x=0,$y=0,$z=0)
    Local $sTrinary = "", $iBound = @NumParams -1, $aParam[37] = [$_,$0,$1,$2,$3,$4,$5,$6,$7,$8,$9,$a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u,$v,$w,$x,$y,$z], $iTrit
    ReDim $aParam[$iBound +1]
    For $e = 0 To $iBound
        __31TritInt($aParam[$e])
        If @error Then SetError(1, $e +1, "")
    Next
    For $c = 1 To 31
        $iTrit = 0
        For $e = 0 To $iBound
            Switch StringMid($aParam[$e], $c, 1)
                Case 1
                    $iTrit = 1
                    ExitLoop
                Case 2
                    If $iTrit = 0 Then
                        $iTrit = 2
                    Else
                        $iTrit = 0
                    EndIf
            EndSwitch
        Next
        $sTrinary &= $iTrit
    Next
    Return _BaseToDec($sTrinary, 3)
EndFunc ;==> _TritXOR

; #INTERNAL_USE_ONLY# ===========================================================================================================
; Name...........: __31TritInt
; Description ...: Converts a positive decimal integer to an unsigned 31-trit ternary string
; Syntax.........: __31TritInt(ByRef $iTrinary)
; Parameters ....: $iTrinary - The number to convert
; Return values .: Success   - Returns [ByRef] a 31 digit ternary string representation of the number
;                  Failure   - Sets @error to an empty string if the input is not a 31-trit integer
; Author ........: czardas
; Modified.......:
; Related .......:
; Link ..........:
; Example .......:
; ===============================================================================================================================

Func __31TritInt(ByRef $iTrinary)
    If Not IsInt($iTrinary) Or $iTrinary < 0 Or $iTrinary > 3^31 -1 Then Return SetError(1, 0, "")
    $iTrinary = _DecToBase($iTrinary, 3)
    $iTrinary = StringRight("0000000000000000000000000000000", 31 - StringLen($iTrinary)) & $iTrinary
EndFunc

Related Links

http://en.wikipedia.org/wiki/Ternary_logic

http://c2.com/cgi/wiki?ThreeValuedLogic

http://en.wikipedia.org/wiki/Ternary_computer

Edited by czardas

Share this post


Link to post
Share on other sites



#2 ·  Posted (edited)

RESERVED SPACE

What purpose some of these functions may serve isn't entirely clear to me. My own plan is to store harmonic information as some kind of three state objects. The data can represent theoretical group notes, additional notes.and notes to avoid. That's pretty close to how many jazz musicians see music. I was originally using binary to store this information, but I felt I needed something more powerful. I'm not entirely sure if my experiment will work or not. It could turn out to be a complete flop.

I imagine there will be some obscure uses for this, but I can't tell you much more than that without further investigation.

Edited by czardas
1 person likes this

Share this post


Link to post
Share on other sites

It could turn out to be a complete flop.

Or flip... or even flap. :D

Your main problem is that we use Binary for a reason: That's what the hardware uses. Trying to mimic it's behaviour on a computer is not going to be that efficient, you are probably better of allowing for 4 different values. Of course for AutoIt it is probably ok as there is always an overhead so anything you add is negligible.

Share this post


Link to post
Share on other sites

#4 ·  Posted (edited)

Quaternary (4 value) logic is definately worth looking into. It certainly would be easier to write functions for that. The main idea is to store and compress complicated information in an easily accessible form, and although the underlying system is binary, I hope to gain on the swings what I lose on the roundabout.

Edited by czardas

Share this post


Link to post
Share on other sites

I have had a big rethink about this. The code in the first post has been modified quite a lot. I couldn't for the life of me think of a use for _TritXOR. It has only taken me a year and a half to find one. I still have no idea what I'm doing. :wacko:

#include 'flipflapflop.au3'

Local $iTrinary = "201021020101"
ConsoleWrite($iTrinary & " - Original Trinary" & @LF)
$iTrinary = _BaseToDec($iTrinary, 3) ; Convert to decimal

; Modify all logical values
ConsoleWrite(_DecToBase(_TrueToUndefined($iTrinary), 3) & " - True to Undefined" & @LF)
ConsoleWrite("00" & _DecToBase(_TrueToFalse($iTrinary), 3) & " - True to False" & @LF) ; Padded for alignment
ConsoleWrite(_DecToBase(_UndefinedToTrue($iTrinary), 3) & " - Undefined to True" & @LF)
ConsoleWrite(_DecToBase(_UndefinedToFalse($iTrinary), 3) & " - Undefined to False" & @LF)
ConsoleWrite(_DecToBase(_TritShift(_TritShift(_FalseToTrue($iTrinary),19),-19), 3) & " - False to True" & @LF)
ConsoleWrite(_DecToBase(_TritShift(_TritShift(_FalseToUndefined($iTrinary),19),-19), 3) & " - False to Undefined" & @LF)

Func _TrueToFalse($iTrinary)
    Return _TritXOR($iTrinary, $iTrinary)
EndFunc

Func _TrueToUndefined($iTrinary)
    Return ($iTrinary + _TritXOR($iTrinary, $iTrinary))/2
EndFunc

Func _UndefinedToFalse($iTrinary)
    Return $iTrinary - _TritXOR($iTrinary, $iTrinary)
EndFunc

Func _UndefinedToTrue($iTrinary)
    Return $iTrinary + _TritXOR($iTrinary, $iTrinary)
EndFunc

Func _FalseToTrue($iTrinary)
    Return _TritNOT(_TritXOR($iTrinary, $iTrinary))
EndFunc

Func _FalseToUndefined($iTrinary)
    Return _TritOR($iTrinary, (3^31-1)/2)
EndFunc

Share this post


Link to post
Share on other sites

#6 ·  Posted (edited)

Finally the power of three value logic unleashed. This thing never plays the same three chords twice. I don't know how many three chord wonders it can produce, but it's really a lot. Admittedly some of them are not very good, but these are probably the first chord sequences ever created using three value logic. Besides flipflapflop.au3 and the includes in the first post you will also need bitwise.au3. Alternatively all includes can be downloaded in this udf_suite.zip. The zip file also contains some other stuff.

#include 'flipflapflop.au3'
#include 'bitwise.au3'
#include <Array.au3>

Global Const $MIDINOTE = _GetMidiNotes()

Local $aCadence[3], $iTranspose = 0, $aMyTune[20][3], $iStart, $iDelay, $iDuration
Local $iCurrentlyPlaying, $aTemp, $open, $iTimer, $iProgress, $iTimeOut = 1000
For $iRepeat = 1 To 13
    ; Testing three value logic
    $iTranspose += Random(1, 6, 1)
    $aCadence[0] = _BitModulate(_GetSubDominant(), $iTranspose, 12)
    $aCadence[1] = _BitModulate(_GetDominant(), $iTranspose, 12)
    $aCadence[2] = _BitModulate(_GetTonic(), $iTranspose, 12)

    ; Building the sequence
    ReDim $aMyTune[20][3]
    $iCount = 0
    For $i = 0 To 2
        $iStart = 39
        $iDelay = 1300
        For $j = 11 To 0 Step -1
            If BitAND($aCadence[$i], 2^$j) = 2^$j Then
                $aMyTune[$iCount][0] = $iDelay
                $aMyTune[$iCount][1] = $iStart + 12*Random(-1, 0, 1)
                If $i < 2 Then
                    $iDuration = 1300
                Else
                    $iDuration = 2600
                EndIf
                $aMyTune[$iCount][2] = $iDuration
                $iCount += 1
                $iDelay = 0
            EndIf
            $iStart += 1
        Next
    Next
    ReDim $aMyTune[$iCount][3]

    ; Some old code
    $iCurrentlyPlaying = 0
    $aTemp = _ConvertToMidiStream($aMyTune)
    $open = _MidiOutOpen()
    _MidiOutShortMsg($open,256 * 11 + 192)
    $iProgress = 0
    $iCurrentlyPlaying = 1
    $iTimer = TimerInit()

    While 1
        If ($iCurrentlyPlaying = 1) And ($iProgress > UBound($aTemp) -1) Then
            $iCurrentlyPlaying = 2
            $iTimer = TimerInit()
        EndIf
        If ($iCurrentlyPlaying = 1) And (TimerDiff($iTimer) >= $aTemp[$iProgress][0]) And ($iProgress <= UBound($aTemp) -1) Then
            _PlayMidiSequence($open, $aTemp, $iProgress)
            $iTimer = TimerInit()
        Else
            Sleep(20)
        EndIf
        If $iCurrentlyPlaying = 2 And TimerDiff($iTimer) >= $iTimeOut Then
            _MidiOutclose($open)
            $iCurrentlyPlaying = 0
            ExitLoop
        EndIf
    WEnd
Next

; The power of three value logic - Here's where the fun begins.
Func _GetDominant()
    Local $aRoot[8] = [179826, 179394, 216600, 178692, 217005, 216573, 179097, 178665]
    Local $aExt[12] = [118836, 118881, 118638, 118593, 20466, 20421, 20223, 20178, 13860, 13905, 13662, 13617]
    Local $iDominant = _TritOR($aRoot[Random(0, 7, 1)], $aExt[Random(0, 11, 1)])

    For $i = 1 To Random(0, 3, 1)
        $iDominant = _StripRandomUndefined($iDominant)
        If @extended Then ExitLoop
    Next
    $iDominant = _TritRotate(($iDominant + _TritXOR($iDominant, $iDominant))/2, 5, 12)
    Return _BaseToDec(_DecToBase($iDominant, 3), 2) ; Convert to binary
EndFunc

Func _GetSubDominant()
    Local $iTranspose, $iSubDom
    If Random(0, 1, 1) Then
        $iSubDom = 190356
        $iTranspose = -2
    Else
        $iSubDom = 181603
        $iTranspose = -5
    EndIf
    $iSubDom = _TritOR($iSubDom, 20421)
    For $i = 1 To Random(1, 3, 1)
        $iSubDom = _StripRandomUndefined($iSubDom)
        If @extended Then ExitLoop
    Next
    $iSubDom = _TritRotate(($iSubDom + _TritXOR($iSubDom, $iSubDom))/2, $iTranspose, 12)
    Return _BaseToDec(_DecToBase($iSubDom, 3), 2) ; Convert to binary
EndFunc

Func _GetTonic()
    Local $iTonic, $iMax
    If Random(0, 1, 1) Then
        $iTonic = 367497
        $iMax = 3
    Else
        $iTonic = 358750
        $iMax = 4
    EndIf
    $iTonic = _TritOR($iTonic, 20421)
    For $i = 1 To Random(2, $iMax, 1)
        $iTonic = _StripRandomUndefined($iTonic)
        If @extended Then ExitLoop
    Next
    $iTonic = ($iTonic + _TritXOR($iTonic, $iTonic))/2
    Return _BaseToDec(_DecToBase($iTonic, 3), 2) ; Convert to binary
EndFunc

Func _StripRandomUndefined($iTrinary)
    Local $sString = _DecToBase($iTrinary, 3), $sLen
    $sLen = StringLen($sString)
    Local $aTemp[$sLen], $iCount = 1
    Do
        $aTemp[$iCount -1] = StringInStr($sString, "1", 0, $iCount)
        $iCount += 1
    Until $aTemp[$iCount -2] = 0
    If $iCount <= 2 Then Return SetExtended(1, $iTrinary)
    Return $iTrinary - 3^($sLen - $aTemp[Random(0, $iCount -3, 1)])
EndFunc

; Midi stuff
;=======================================================
;Retrieves a MIDI handle and Opens the Device
;Parameters(Optional) - Device ID, Window Callback,
; instance, flags
;Author : Eynstyne
;Library : Microsoft winmm.dll
;=======================================================
Func _MidiOutOpen($devid = 0, $callback = 0, $instance = 0, $flags = 0)
   Local $ret = DllCall("winmm.dll", "long", "midiOutOpen", "handle*", 0, "int", $devid, "dword_ptr", $callback, "dword_ptr", $instance, "long", $flags)
   If @error Then Return SetError(@error,0,0)
   If $ret[0] Then Return SetError(-1,$ret[0],0)
   Return $ret[1]
EndFunc   ;==>_MidiOutOpen

;=======================================================

;=======================================================
;Closes Midi Output/Input devices
;Parameters - MidiHandle
;Author : Eynstyne
;Library : Microsoft winmm.dll
;=======================================================
Func _MidiOutClose ($hmidiout)
   Local $ret = DllCall("winmm.dll", "long", "midiOutClose", "handle", $hmidiout)
   If @error Then Return SetError(@error,0,0)
   If $ret[0] Then Return SetError(-1,$ret[0],0)
   Return $ret[0]
EndFunc   ;==>_MidiOutClose

;=======================================================
;Gets the Mixer Volume for MIDI
;Parameters - None
;Author : Eynstyne
;Library : Microsoft winmm.dll
;=======================================================
Func _MidiOutGetVolume ($devid = 0)
   Local $ret = DllCall("winmm.dll", "long", "midiOutGetVolume", "handle", $devid, "dword*",0)
   If @error Then Return SetError(@error,0,0)
   If $ret[0] Then Return SetError(-1,$ret[0],0)
   Return $ret[2]
EndFunc   ;==>_MidiOutGetVolume

;=======================================================
;Sets the Mixer Volume for MIDI
;Parameters - Volume (0 - 65535)
;Author : Eynstyne
;Library : Microsoft winmm.dll
;=======================================================
Func _MidiOutSetVolume($iVolume = 65535, $devid = 0)
    Local $iMixVolume=BitAND($iVolume,0xFFFF)+BitShift(BitAND($iVolume,0xFFFF),-16) ; From Ascend4nt
    Local $ret = DllCall("winmm.dll", "long", "midiOutSetVolume", "handle", $devid, "int", $iMixVolume)
    If @error Then Return SetError(@error,0,0)
    If $ret[0] Then Return SetError(-1,$ret[0],0)
    Return $ret[0]
EndFunc ;==> _MidiOutSetVolume

;=======================================================
;MIDI Message Send Function
;Parameters - Message as Hexcode or Constant
;Author : Eynstyne
;Library : Microsoft winmm.dll
;=======================================================
Func _MidiOutShortMsg($hmidiout, $msg)
   Local $ret = DllCall("winmm.dll", "long", "midiOutShortMsg", "handle", $hmidiout, "long", $msg)
   If @error Then Return SetError(@error,0,0)
   If $ret[0] Then Return SetError(-1,$ret[0],0)
   Return $ret[0]
EndFunc   ;==>_MidiOutShortMsg

Func _GetMidiNotes()
    Local $aMIDINOTE[88][2] = [ _ ; [?][0] = Play, [?][1] = Stop
    [0x00401590,0x00001590], _ ; [0][?] .... A
    [0x00401690,0x00001690], _ ; [1][?] .... Bb
    [0x00401790,0x00001790], _ ; [2][?] .... B
    [0x00401890,0x00001890], _ ; [3][?] .... C   First Octave
    [0x00401990,0x00001990], _ ; [4][?] .... Db
    [0x00401A90,0x00001A90], _ ; [5][?] .... D
    [0x00401B90,0x00001B90], _ ; [6][?] .... Eb
    [0x00401C90,0x00001C90], _ ; [7][?] .... E
    [0x00401D90,0x00001D90], _ ; [8][?] .... F
    [0x00401E90,0x00001E90], _ ; [9][?] .... Gb
    [0x00401F90,0x00001F90], _ ; [10][?] ... G
    [0x00402090,0x00002090], _ ; [11][?] ... Ab
    [0x00402190,0x00002190], _ ; [12][?] ... A
    [0x00402290,0x00002290], _ ; [13][?] ... Bb
    [0x00402390,0x00002390], _ ; [14][?] ... B
    [0x00402490,0x00002490], _ ; [15][?] ... C   Second Octave
    [0x00402590,0x00002590], _ ; [16][?] ... Db
    [0x00402690,0x00002690], _ ; [17][?] ... D
    [0x00402790,0x00002790], _ ; [18][?] ... Eb
    [0x00402890,0x00002890], _ ; [19][?] ... E
    [0x00402990,0x00002990], _ ; [20][?] ... F
    [0x00402A90,0x00002A90], _ ; [21][?] ... Gb
    [0x00402B90,0x00002B90], _ ; [22][?] ... G
    [0x00402C90,0x00002C90], _ ; [23][?] ... Ab
    [0x00402D90,0x00002D90], _ ; [24][?] ... A
    [0x00402E90,0x00002E90], _ ; [25][?] ... Bb
    [0x00402F90,0x00002F90], _ ; [26][?] ... B
    [0x00403090,0x00003090], _ ; [27][?] ... C   Third Octave
    [0x00403190,0x00003190], _ ; [28][?] ... Db
    [0x00403290,0x00003290], _ ; [29][?] ... D
    [0x00403390,0x00003390], _ ; [30][?] ... Eb
    [0x00403490,0x00003490], _ ; [31][?] ... E
    [0x00403590,0x00003590], _ ; [32][?] ... F
    [0x00403690,0x00003690], _ ; [33][?] ... Gb
    [0x00403790,0x00003790], _ ; [34][?] ... G
    [0x00403890,0x00003890], _ ; [35][?] ... Ab
    [0x00403990,0x00003990], _ ; [36][?] ... A
    [0x00403A90,0x00003A90], _ ; [37][?] ... Bb
    [0x00403B90,0x00003B90], _ ; [38][?] ... B
    [0x00403C90,0x00003C90], _ ; [39][?] ... C   Fourth Octave - Middle C
    [0x00403D90,0x00003D90], _ ; [40][?] ... Db
    [0x00403E90,0x00003E90], _ ; [41][?] ... D
    [0x00403F90,0x00003F90], _ ; [42][?] ... Eb
    [0x00404090,0x00004090], _ ; [43][?] ... E
    [0x00404190,0x00004190], _ ; [44][?] ... F
    [0x00404290,0x00004290], _ ; [45][?] ... Gb
    [0x00404390,0x00004390], _ ; [46][?] ... G
    [0x00404490,0x00004490], _ ; [47][?] ... Ab
    [0x00404590,0x00004590], _ ; [48][?] ... A
    [0x00404690,0x00004690], _ ; [49][?] ... Bb
    [0x00404790,0x00004790], _ ; [50][?] ... B
    [0x00404890,0x00004890], _ ; [51][?] ... C   Fifth Octave
    [0x00404990,0x00004990], _ ; [52][?] ... Db
    [0x00404A90,0x00004A90], _ ; [53][?] ... D
    [0x00404B90,0x00004B90], _ ; [54][?] ... Eb
    [0x00404C90,0x00004C90], _ ; [55][?] ... E
    [0x00404D90,0x00004D90], _ ; [56][?] ... F
    [0x00404E90,0x00004E90], _ ; [57][?] ... Gb
    [0x00404F90,0x00004F90], _ ; [58][?] ... G
    [0x00405090,0x00005090], _ ; [59][?] ... Ab
    [0x00405190,0x00005190], _ ; [60][?] ... A
    [0x00405290,0x00005290], _ ; [61][?] ... Bb
    [0x00405390,0x00005390], _ ; [62][?] ... B
    [0x00405490,0x00005490], _ ; [63][?] ... C   Sixth Octave
    [0x00405590,0x00005590], _ ; [64][?] ... Db
    [0x00405690,0x00005690], _ ; [65][?] ... D
    [0x00405790,0x00005790], _ ; [66][?] ... Eb
    [0x00405890,0x00005890], _ ; [67][?] ... E
    [0x00405990,0x00005990], _ ; [68][?] ... F
    [0x00405A90,0x00005A90], _ ; [69][?] ... Gb
    [0x00405B90,0x00005B90], _ ; [70][?] ... G
    [0x00405C90,0x00005C90], _ ; [71][?] ... Ab
    [0x00405D90,0x00005D90], _ ; [72][?] ... A
    [0x00405E90,0x00005E90], _ ; [73][?] ... Bb
    [0x00405F90,0x00005F90], _ ; [74][?] ... B
    [0x00406090,0x00006090], _ ; [75][?] ... C   Seventh Octave
    [0x00406190,0x00006190], _ ; [76][?] ... Db
    [0x00406290,0x00006290], _ ; [77][?] ... D
    [0x00406390,0x00006390], _ ; [78][?] ... Eb
    [0x00406490,0x00006490], _ ; [79][?] ... E
    [0x00406590,0x00006590], _ ; [80][?] ... F
    [0x00406690,0x00006690], _ ; [81][?] ... Gb
    [0x00406790,0x00006790], _ ; [82][?] ... G
    [0x00406890,0x00006890], _ ; [83][?] ... Ab
    [0x00406990,0x00006990], _ ; [84][?] ... A
    [0x00406A90,0x00006A90], _ ; [85][?] ... Bb
    [0x00406B90,0x00006B90], _ ; [86][?] ... B
    [0x00406C90,0x00006C90]]   ; [87][?] ... C   Eighth Octave
    Return $aMIDINOTE
EndFunc

; More midi stuff
Func _ConvertToMidiStream($aInit)
    Local $iLimit = UBound($aInit) -1
    Local $iCount = 0
    For $i = 1 To $iLimit
        If $aInit[$i][2] <> 0 Then
            $aInit[$i][0] += $aInit[$i -1][0] ; Calculate the start time for every note.
        Else
            Return SetError (1,0,0) ; Duration must not be zero, but a value of -1 is allowed.
        EndIf
    Next
    $aStopped = $aInit

    Local $iCount = 0 ; Count midi messages which do not need to be sent.
    For $i = 0 To $iLimit
        If $aInit[$i][2] <> -1 Then
            $aStopped[$i][0] += $aInit[$i][2] ; Calculate the stop time for every note.
        Else
            $aStopped[$i][0] = -1
            $iCount +=1
        EndIf
    Next

    Local $aTemp[2*($iLimit +1) -$iCount][3]

    $iCount = 0
    For $i = 0 To $iLimit
        If $aStopped[$i][0] <> -1 Then
            $aTemp[$iCount][0] = $aStopped[$i][0] *10 ; Stopping notes first is the logical order.
            $aTemp[$iCount][1] = $aStopped[$i][1]
            $aTemp[$iCount][2] = 1 ; Indicates the note will be stopped.
            $iCount += 1
        EndIf
    Next
    $aStopped = 0 ; No longer needed.

    For $i = 0 To $iLimit
        $aTemp[$iCount][0] = $aInit[$i][0] *10 +1 ;
        $aTemp[$iCount][1] = $aInit[$i][1]
        $aTemp[$iCount][2] = 0 ; Indicates the note will be played.
        $iCount += 1
    Next
    $aInit = 0 ; No longer needed.

    _ArraySort($aTemp) ; Places Midi messages in the correct order.

    $iLimit = $iCount - 1
    For $i = 0 To $iLimit
        If $aTemp[$i][2] = 0 Then $aTemp[$i][0] -= 1
        $aTemp[$i][0] /= 10
        $aTemp[$i][1] = $MIDINOTE[ $aTemp[$i][1] ][ $aTemp[$i][2] ]
    Next

    Local $aStream[$iLimit +1][2]
    For $i = 0 To $iLimit
        For $j = 0 To 1
            $aStream[$i][$j] = $aTemp[$i][$j]
        Next
    Next
    $aTemp = 0

    Local $iRealTime
    For $i = 0 To $iLimit -1
        $iRealTime = $aStream[$i][0]
        For $j = $i +1 To $iLimit
            If $aStream[$j][0] = $iRealTime Then
                $aStream[$j][0] = 0 ; Delay in miliseconds before sending the message.
                $i += 1
            Else
                ExitLoop
            EndIf
        Next
    Next

    For $i = $iLimit To 1 Step -1
        If $aStream[$i][0] <> 0 Then
            $iRealTime = $aStream[$i][0]
            For $j = $i -1 To 0 Step -1
                If $aStream[$j][0] <> 0 Then
                    $aStream[$i][0] -= $aStream[$j][0] ; Delay in miliseconds before sending the message.
                    ExitLoop
                EndIf
            Next
        EndIf
    Next
    Return $aStream
EndFunc

Func _PlayMidiSequence($open, $aTemp, ByRef $iProgress)
    _MidiOutshortmsg($open, $aTemp[$iProgress][1] )
    $iProgress += 1
    If UBound ($aTemp) > $iProgress And $aTemp[$iProgress][0] = 0 Then
        _PlayMidiSequence($open, $aTemp, $iProgress)
    EndIf
EndFunc

No way should this be considered a fully worked out musical concept, because it is devoid of any serious melodic elements and really represents a test sample of the harmonic foundation. Adding rhythmic and melodic elements will be more complicated, but enriching the harmonic vocabulary will not.

Regarding the trinary: hundreds (actually thousands) of note combinations can be represented with very few numbers. From a programming perspective this represents extreme compression (for certain types of data) on what I believe to be an unprecedented scale. Fait accompli!

Edited by czardas

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!


Register a new account

Sign in

Already have an account? Sign in here.


Sign In Now
Sign in to follow this  
Followers 0