' 96C4F11381B0C2EE779617D410D973A47715BFD8A612FA062F7AE056B929A1B870D6F6E9F326A8E9D2D8B434BEAD12CC40D46CE240E75807A6F3B7900C229D6B
' sRipeTech
' D192EF751 2024-11-18 09:25:22 
dbclose()
newscript
dir = app$path
' -----------------------------------
const appVersion = "2024-11-18"
const appDescription = "MIDI file decoder"
dim myWindow  =  sob ("application","NEW",appDescription   )
' -----------------------------------
const TabChar = chr(0x09)
const crChar  = chr(0x0a)
const readOnlyRGB  = rgb ( 237, 229, 225 )
const greenBtnRGB  = rgb ( 0x00, 0xff, 0x00 )

dim decodeInfo
' --------------------
' Define a callback to handle a click on the TOP Right "X"
' Callbacks are discussed in detail in the CALLBACK help option

FUNCTION ClickMyWindow ( sobid )
   ' delete the SOB   myWindow  and automatically deletes all of its child SOBs
   sob ( myWindow, "delete")
   quit
END function

' Associate the callback with    myWindow
sob ( myWindow ,  "ON"   ,  "CLICK"  , "ClickMyWindow" )

' -----------------------------------------------------
' add a menu bar    myWindow
dim  myMenuBar   = sob (myWindow  ,  "add"  ,  "menu"   ,  "bar"  )

' add  horizonal menus to    myMenuBar
dim  myMenuFile     = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" , "File"   )

dim  myMenuOptions  = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" , "Decode Options"    )
dim  myMenuFont     = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" , "Font"    )

dim  myMenuHelp     = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" , "Help"    )

' -----------------------------------------------------
' add a menu item to the FILE menu
' Note: we are not going to explicitly remember the ID of the menu SOB we are about to create.
'       This is a trick, see comment in about 4 lines!

FUNCTION ClickGetMidi ( sobid )
   cbFile_File ( sobid )
END function

sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "Get Midi file"    )

' Associate a click / press on the File.Exit menu option with a callback handler
' Note: a SOB id of -1 always refers to the SOB used in the last  SOB command
'       If we did not have this, then we would have had to have a DIM in the previous SOB command line

sob ( -1     ,  "ON"   ,  "CLICK"  , "ClickGetMidi")
' -----------------------------------------------------
dim LastProcessedFileName = ""
FUNCTION cbLastProcessed  ( sobid )
   IF !(  LastProcessedFileName == "" ) then ShellExecute ( LastProcessedFileName)

END Function

sob ( myMenuFile , "add"   ,  "menu"   ,  "Vertical",   "Default file handling"      )

sob (-1 ,  "ON"   ,  "CLICK"  , "cbLastProcessed"  )
' -----------------------------------------------------
' add a menu item to the FILE menu
' Note: we are not going to explicitly remember the ID of the menu SOB we are about to create.
'       This is a trick, see comment in about 4 lines!

sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "Exit"    )

' Associate a click / press on the File.Exit menu option with a callback handler
' Note: a SOB id of -1 always refers to the SOB used in the last  SOB command
'       If we did not have this, then we would have had to have a DIM in the previous SOB command line

sob ( -1     ,  "ON"   ,  "CLICK"  , "ClickMyWindow")
' -----------------------------------------------------

dim hexOutPutFlag = 0
dim textOutPutFlag = 0

FUNCTION ClickHex ( sobid )
   dim newVal = ! SOB (sobid  , "GET" , "CHECK"   )
   hexOutPutFlag = newVal

   IF ( ( ! textOutPutFlag ) AND  ( ! hexOutPutFlag ) )   then
      SOB ( sobTextOutput , "TRIGGER"   )
   END if

   SOB (sobid  , "SET" , "CHECK" , newVal   )

END Function

dim sobHexOutput = sob ( myMenuOptions , "add"   ,  "menu"   ,  "Vertical",   "Hex output"      )

sob (sobHexOutput , "ON"   ,  "CLICK"  , "ClickHex"  )
' SOB (sobHexOutput , "TRIGGER"   )
' -----------------------------------------------------

dim rsHexOutPutFlag = 0

FUNCTION ClickRSHex ( sobid )
   dim newVal = ! SOB (sobid  , "GET" , "CHECK"   )
   rsHexOutPutFlag = newVal
   SOB (sobid  , "SET" , "CHECK" , newVal   )

END Function

dim sobrsHexOutput = sob ( myMenuOptions , "add"   ,  "menu"   ,  "Vertical",   "    Insert Running Status"      )

sob (sobrsHexOutput , "ON"   ,  "CLICK"  , "ClickRSHex"  )
SOB (sobrsHexOutput , "TRIGGER"   )

' -----------------------------------------------------

dim addrOutPutFlag = 0

FUNCTION ClickAddr ( sobid )
   addrOutPutFlag  = ! SOB (sobid  , "GET" , "CHECK"   )
   SOB (sobid  , "SET" , "CHECK" , addrOutPutFlag )

END Function

dim sobAddrOutPutFlag = sob ( myMenuOptions , "add"   ,  "menu"   ,  "Vertical",   "    File offset"      )

sob (sobAddrOutPutFlag , "ON"   ,  "CLICK"  , "ClickAddr"  )
SOB (sobAddrOutPutFlag , "TRIGGER"   )
' -----------------------------------------------------
SOB ( myMenuOptions , "ADD" , "MENU" , "SPACER"   )
' -----------------------------------------------------

FUNCTION addrOutPut ( val )
   returnValue = tabChar

   IF addrOutPutFlag then
      returnValue = "" & sprintf("0x%.5lx" , val) & " = "
   END if
END function

FUNCTION ClickText ( sobid )
   dim newVal = ! SOB (sobid  , "GET" , "CHECK"   )
   textOutPutFlag = newVal
   IF ( ( ! textOutPutFlag ) AND  ( ! hexOutPutFlag ) )  then
      SOB ( sobHexOutput , "TRIGGER"   )
   END if

   SOB (sobid  , "SET" , "CHECK" , newVal   )

END Function

dim sobTextOutput = sob ( myMenuOptions , "add"   ,  "menu"   ,  "Vertical",   "Text (decoded) output"      )

sob (sobTextOutput,  "ON"   ,  "CLICK"  , "ClickText"  )
SOB (sobTextOutput, "TRIGGER" )
' -----------------------------------------------------

dim sobFontSize = sob ( myMenuFont , "add"   ,  "menu"   ,  "Vertical",   "  "       )
sob ( -1 , "SET", "menu.GREY", 1 )

FUNCTION setFontSize ( useValue )
   sob( sobFontSize , "SET", "TITLE", "Font size = " & useValue )
   SOB (decodeInfo , "SET" , "ROW" , "TOP" ,0  )
END function

FUNCTION cbFontBigger( sobid )
   IF ( fontSize <  48) then
      fontSize = fontSize + 2
   END if
   setFontSize ( fontSize)
END Function

sob ( myMenuFont , "add"   ,  "menu"   ,  "Vertical",   "bigger"       )
sob (-1 , "ON"   ,  "CLICK"  , "cbFontBigger"  )

FUNCTION cbFontDefault( sobid )
   fontSize = APP$ARG ( asc("F")   )
   setFontSize ( fontSize)
END Function

sob ( myMenuFont , "add"   ,  "menu"   ,  "Vertical",   " default size"       )
sob (-1 , "ON"   ,  "CLICK"  , "cbFontDefault"  )
sob (-1 , "TRIGGER")

FUNCTION cbFontSmaller( sobid )
   IF ( fontSize > 3 ) then
      fontSize = fontSize - 2
   END if
   setFontSize ( fontSize)
END Function

sob ( myMenuFont , "add"   ,  "menu"   ,  "Vertical",   "smaller"       )
sob (-1 , "ON"   ,  "CLICK"  , "cbFontSmaller"  )

' -----------------------------------------------------
SOB ( myMenuFont , "ADD" , "MENU" , "SPACER"   )
' -----------------------------------------------------
dim sobFontBold = sob ( myMenuFont , "add"   ,  "menu"   ,  "Vertical",   "  "       )
sob ( -1 , "SET", "menu.GREY", 1 )

FUNCTION setFontBold ( useValue )
   sob( sobFontBold , "SET", "TITLE", "Font bold = " & useValue )
   SOB( decodeInfo , "SET" , "ROW" , "TOP" ,0  )
END function

FUNCTION cbBoldDarkest( sobid )
   fontBold = fontBold + 1000
   setFontBold (fontBold)
END Function

sob ( myMenuFont , "add"   ,  "menu"   ,  "Vertical",   "darkest"       )
sob (-1 , "ON"   ,  "CLICK"  , "cbBoldDarkest"  )

FUNCTION cbBoldDarker( sobid )
   fontBold = fontBold + 100
   setFontBold (fontBold)
END Function

sob ( myMenuFont , "add"   ,  "menu"   ,  "Vertical",   "darker"       )
sob (-1 , "ON"   ,  "CLICK"  , "cbBoldDarker"  )

FUNCTION cbBoldDefault( sobid )
   fontBold = 400
   setFontBold (fontBold)
END Function

sob ( myMenuFont , "add"   ,  "menu"   ,  "Vertical",   " default bold"       )
sob (-1 , "ON"   ,  "CLICK"  , "cbBoldDefault"  )

FUNCTION cbBoldlighter( sobid )
   fontBold = fontBold - 100
   setFontBold (fontBold)
END Function

sob ( myMenuFont , "add"   ,  "menu"   ,  "Vertical",   "lighter"       )
sob (-1 , "ON"   ,  "CLICK"  , "cbBoldlighter"  )

' -----------------------------------------------------
SOB ( myMenuFont , "ADD" , "MENU" , "SPACER"   )
' -----------------------------------------------------

FUNCTION cbNewInstance( sobid )
   dim tmpNIDir = dir()
   dir = app$path
   NewInstance ( "\ F" & fontSize & " B" & FontBold )
   dir= tmpNIDir
END Function

sob ( myMenuFont , "add"   ,  "menu"   ,  "Vertical",   "New instance with this FONT SIZE/BOLD"       )
sob (-1 , "ON"   ,  "CLICK"  , "cbNewInstance"  )

' -----------------------------------------------------
' Define a callback to handle a click on the Help.About menu option (not yet defined)

FUNCTION ClickAbout ( sobid )
   sob( decodeInfo , "empty")

   dim txt = "Decodes a midi file in to a human readable form." & crChar & appVersion  & crChar
   txt =  txt & crChar & "Optionally it will present the contents in hexadecimal." & crChar

   txt =  txt & crChar & "To decode a file drag and drop it on the green bar (above)." & crChar

   txt =  txt & crChar
   txt =  txt & crChar & "Running Status." & crChar
   txt =  txt &   "Midi Channel Voice Messages (MCVM) consist of usually 3, sometimes 2, bytes. " & crChar
   txt =  txt &   "(A MCVM is something that you could send using the  winmm library's midiOutShortMsg function.)" & crChar
   txt =  txt &   "The first byte, the Status byte, of a MCVM is the Status value bit-wise ORed with a channel number." & crChar
   txt =  txt &   "The Status value identifies the action to be done on the channel e.g. Note ON/OFF." & crChar
   txt =  txt &   "It is quite possible that a Midi file contains a sequence of MCVMs that use the same first byte (Status/channel). " & crChar
   txt =  txt &   "The Midi file specification allows the suppression of a *repeated* Status byte in such a sequence." & crChar
   txt =  txt &   "The suppression of such a byte is termed *running status*." & crChar

   txt =  txt & crChar
   txt =  txt & crChar & "A double right click on this panel will reload the last decoded file." & crChar

   txt =  txt & crChar
   txt =  txt & crChar & "This program was written in the pwScripter script language, compressed, encoded"
   txt =  txt & crChar & "and embedded in to the  pwScripter  interpreter." & crChar
   txt =  txt & crChar & "The interpreter and the script are available at my website, see below. " & crChar

   txt =  txt & crChar & "For more about pwScripter please visit https://www.ripetech.com"
   txt =  txt & crChar & "( menu:   help  /  Browse website )" & crChar

   sob (decodeInfo,"add", "row" , txt )
   SOB (decodeInfo , "SET" , "ROW" , "TOP" ,0  )
END Function

dim sobAbout = sob ( myMenuHelp , "add"   ,  "menu"   ,  "Vertical", "About"      )

sob ( -1     ,  "ON"   ,  "CLICK"  , "ClickAbout"  )

' -----------------------------------------------------
' Define a callback to handle a click on the Help.Contact menu option (not yet defined)

FUNCTION ClickContact ( sobid )
   sob( decodeInfo , "empty")

   dim txt = "E-Mail: george.salisbury@ripetech.com"

   txt =  txt & crChar & "Double right click on the info panel to return to last decode, " & crChar
   sob (decodeInfo,"add", "row" , txt )
END Function

sob ( myMenuHelp   , "add"  ,  "menu"   ,  "Vertical" ,  "Contact"   )

sob ( -1 ,"ON","CLICK", "ClickContact")

' -----------------------------------------------------
SOB ( myMenuHelp , "ADD" , "MENU" , "SPACER"   )
' -----------------------------------------------------
' Define a callback to handle a click on the Help.Contact menu option (not yet defined)

FUNCTION ClickOnline ( sobid )
   ShellExecute  ( "https://www.ripetech.com" )
END Function

sob ( myMenuHelp   , "add"  ,  "menu"   ,  "Vertical" ,  "Browse website"   )

sob ( -1 ,"ON","CLICK", "ClickOnline")

FUNCTION ClickDnLoad ( sobid )
   ShellExecute  ( "https://ripetech.com/downloads-and-script-files" )
END Function

sob ( myMenuHelp   , "add"  ,  "menu"   ,  "Vertical" ,  "Browse download website"   )

sob ( -1 ,"ON","CLICK", "ClickDnLoad")
' -----------------------------------------------------
SOB ( myMenuHelp , "ADD" , "MENU" , "SPACER"   )
' -----------------------------------------------------

' Define a callback to handle a click on the Help.Contact menu option (not yet defined)

FUNCTION ClickShowpwScripter ( sobid )
   SOB (sobid  , "SET" , "CHECK"  ,   !  SOB (sobid  , "GET" , "CHECK"     ) )
   SOB (pwSwindow  , "SET" , "show"  ,   SOB (sobid  , "GET" , "CHECK"     ) )
END Function

sob ( myMenuHelp   , "add"  ,  "menu"   ,  "Vertical" ,  "Show pwScripter"   )

sob ( -1 ,"ON","CLICK", "ClickShowpwScripter")
sob ( -1 ,"SET" , "CHECK"  , 1)
sob ( -1 ,"Trigger")

' -----------------------------------------------------
' Create a Container as a ROW of objects that have the same WIDTH
dim appCOL = sob ( myWindow, "ADD", "CONTAINER", "COLUMN.w")

' --------------------
FUNCTION hex ( val )

   returnValue =  sprintf("0x%02x" , val)
END function

FUNCTION showDeltaTime ( val )
   returnValue =  "Delta-time: " & sprintf("%.5ld" , val)
END function

FUNCTION read_word ( fdata , index )
   returnValue =    fdata (index++)
   returnValue =  ( returnValue * 0x100) +   ( fdata (index++) )
END function

FUNCTION read_24 ( fdata , index )
   returnValue =    fdata (index++)
   returnValue =  ( returnValue * 0x100) +   ( fdata (index++) )
   returnValue =  ( returnValue * 0x100) +   ( fdata (index++) )
END function

FUNCTION read_dword ( fdata , index )
   returnValue =    fdata (index++)
   returnValue =  ( returnValue * 0x100) +   ( fdata (index++) )
   returnValue =  ( returnValue * 0x100) +   ( fdata (index++) )
   returnValue =  ( returnValue * 0x100) +   ( fdata (index++) )
END function

FUNCTION read_vinteger ( fdata , index )

   dim tmp
   tmp =  fdata (index++)
   returnValue =  ( returnValue * 0x080) + ( tmp BAND 0x7f )
   DO while (  tmp BAND 0x80 )
      tmp =  fdata (index++)
      returnValue =  ( returnValue * 0x080) + ( tmp BAND 0x7f )
   LOOP

END function

FUNCTION read_counted_text ( fdata , index )
   dim len , i
   len = read_vinteger ( fdata , byRef  index )
   FOR i = 0 to len -1
      returnValue = returnValue &   chr (  fdata(index++) )
   NEXT i

END function

FUNCTION read_counted_number ( fdata , index )
   dim len , i
   len = read_vinteger ( fdata , byRef  index )
   SELECT CASE len
   CASE 0
      returnValue = 0
   CASE 1
      returnValue = fdata(index++)
   CASE 2
      returnValue = read_word ( fdata , byRef index )
   CASE 3
      returnValue = read_24 ( fdata , byRef index )
   CASE 4
      returnValue = read_dword ( fdata , byRef index )
   CASE else
      index = index + len
      returnValue = -1
   END SELECT

END function

FUNCTION show_counted_bytes ( fdata , index )
   dim len , i

   Len = read_vinteger ( fdata , byRef index )

   IF ( ! hexOutPutFlag ) then
      returnValue = ""
      index = index + len
      EXIT function
   END if

   returnValue = ""   & hex(len) & crChar & addrOutPut ( index )
   FOR i = 0 to len - 1
      returnValue = returnValue &  hex(fdata(index+i))
      IF ( i <> (len-1) ) then
         returnValue = returnValue & ", "
      END IF

      IF (( i BAND 0x0f ) == 0x0f) then
         returnValue = returnValue & crChar & addrOutPut ( index )
      END IF

   NEXT i
   '   returnValue = returnValue & crChar
   index = index + len

END function

FUNCTION MajorKey ( val )
   dim res

   SELECT CASE VAL
   CASE -7
      res ="Cb"
   CASE -6
      res ="Gb"
   CASE -5
      res ="Db"
   CASE -4
      res ="Ab"
   CASE -3
      res ="Eb"
   CASE -2
      res ="Bb"
   CASE -1
      res ="F"
   CASE   0
      res ="C"
   CASE   1
      res ="G"
   CASE   2
      res ="D"
   CASE   3
      res ="A"
   CASE   4
      res ="E"
   CASE   5
      res ="B"
   CASE   6
      res ="F#"
   CASE   7
      res ="C#"
   CASE ELSE
      res = "? " & VAL
   END SELECT
   returnValue = res & " Major"

END function

FUNCTION MinorKey ( val )
   dim res

   SELECT CASE VAL
   CASE -7
      res ="Ab"
   CASE -6
      res ="Eb"
   CASE -5
      res ="Bb"
   CASE -4
      res ="F"
   CASE -3
      res ="C"
   CASE -2
      res ="G"
   CASE -1
      res ="D"
   CASE   0
      res ="A"
   CASE   1
      res ="E"
   CASE   2
      res ="B"
   CASE   3
      res ="F#"
   CASE   4
      res ="C#"
   CASE   5
      res ="G#"
   CASE   6
      res ="D#"
   CASE   7
      res ="A#"
   CASE ELSE
      res = "? " & VAL
   END SELECT
   returnValue = res & " Minor"
END function

FUNCTION getKeySignature ( fdata, index )
   IF ( fData(index++) == 2 ) then
   ELSE
      returnValue ="Invalid length"
      EXIT function
   END if
   dim sharpsFlats =  fData(index++)
   dim majorMinor = fData(index++)

   IF ( majorMinor ) then
      returnValue = MinorKey ( sharpsFlats )
   ELSE
      returnValue = MajorKey ( sharpsFlats )
   END if

END function

FUNCTION getTimeSignature ( fdata, index )
   IF ( fData(index++) == 4 ) then
   ELSE
      returnValue ="Invalid length"
      EXIT function
   END if

   dim nn = fdata ( index++)
   dim dd = fdata ( index++)
   dim cc = fdata ( index++)
   dim bb = fdata ( index++)

   dim i , lower = 1
   FOR i = 0 to dd - 1
      lower = lower * 2
   NEXT i

   returnValue = "" & nn & "/" & lower  &  ", tick every " & cc & " eighth notes, " & bb &  " clocks per quarter note"

END function

FUNCTION metaEvent ( fdata , index )

   dim tmp, indexIn , i , res
   indexIn =  index
   returnValue = tabChar & "Meta" & tabChar & showDeltaTime ( read_vinteger ( fdata , byRef index ) ) & tabChar
   dim subEvent = fdata (++index++)

   returnValue = returnValue & "  "  & hex(subEvent) & " "

   SELECT CASE  subEvent

   CASE 0x00
      returnValue = returnValue  & "Sequence Number:" &  read_counted_number ( fdata, byRef index)
   CASE 0x01
      returnValue = returnValue  & "Text: " &  read_counted_text ( fdata, byRef index)
   CASE 0x02
      returnValue = returnValue  & "Copyright: " &  read_counted_text ( fdata, byRef index)
   CASE 0x03
      returnValue = returnValue  & "Sequence/Track Name: " &  read_counted_text ( fdata, byRef index)
   CASE 0x04
      returnValue = returnValue  & "Instrument Name: " &  read_counted_text ( fdata, byRef index)
   CASE 0x05
      returnValue = returnValue  & "Lyric: " &  read_counted_text ( fdata, byRef index)
   CASE 0x06
      returnValue = returnValue  & "Marker: " &  read_counted_text ( fdata, byRef index)
   CASE 0x07
      returnValue = returnValue  & "Cue point: " &  read_counted_text ( fdata, byRef index)
   CASE 0x08,0x09,0x0a,0x0b,0x0c,0x0d,0x0e,0x0f
      returnValue = returnValue  & " text: " &  read_counted_text ( fdata, byRef index)

   CASE 0x20
      returnValue = returnValue  & "Prefix Channel: " & read_counted_number ( fdata, byRef index)
   CASE 0x21
      returnValue = returnValue  & "Prefix Port: " & read_counted_number ( fdata, byRef index)

   CASE 0x2f
      dim cnt =  fdata ( index++)
      returnValue = returnValue  & "End of track: "

   CASE 0x51
      returnValue = returnValue  & "Set Tempo: " &  read_counted_number ( fdata, byRef index) &  " milliseconds per MIDI quarter note"
   CASE 0x54
      returnValue = returnValue  & "SMPTE Offset: " &  hex( read_counted_number ( fdata, byRef index) )

   CASE 0x58
      returnValue = returnValue  & "Time Signature: " & getTimeSignature ( fdata, byRef index )

   CASE 0x59
      returnValue = returnValue  & "Key Signature: " &  getKeySignature ( fdata, byRef index )

   CASE 0x7f
      returnValue = returnValue  & "Sequencer Specific: " &    show_counted_bytes ( fdata, byRef index)

   CASE ELSE
      returnValue = "Unknown " & hex(tmp) & ":  "  & show_counted_bytes ( fdata, byRef index)
   END SELECT

   IF ! textOutPutFlag then    returnValue = ""
   IF ( ( indexIn < index ) AND ( hexOutPutFlag ) ) then
      res= ""
      IF  textOutPutFlag then res = crChar
      res = res &  addrOutPut ( indexIn )
      DO while ( indexIn < index )
         res = res & hex(fdata(indexIn++))
         IF ( indexIn < index ) then  res = res & ", "
      LOOP
      returnValue = returnValue & res
   END IF

END function

FUNCTION MThd_handler ( sobOut , fdata  , index , hdLen )

   returnValue = 1
   freestring = "Format: "
   SELECT CASE        read_word ( fdata , index + 0  )
   CASE 0
      freestring = freestring & "0 - single multi-channel track"
   CASE 1
      freestring = freestring & "1 - one or more simultaneous tracks (or MIDI outputs) of a sequence"
   CASE 2
      freestring = freestring & "2 - one or more sequentially independent single-track pattern"
   CASE else
      freestring = freestring & read_word ( fdata , index + 0  ) & "  - INVALID "
      returnValue = 0

   END SELECT

   sob (sobOut,"add", "row" , TabChar &  freestring & crChar )

   ' -------------------------
   freestring = "ntrks: "  &   read_word ( fdata , index + 2  )
   sob (sobOut,"add", "row" , TabChar &   freestring  & chr(0x0a) )

   dim division = read_word ( fdata , index + 4  )
   IF ( division BAND 0x08000 ) then
      freestring =  showDeltaTime ( hex( ( division / 0x100 ) BAND 0x07f  ) )

      freestring = freestring & crChar & TabChar &     "resolution within a frame " & division BAND 0x0ff

   ELSE
      freestring = "division: ticks per quarter-note " & division
   END if

   sob (sobOut,"add", "row" , TabChar &   freestring  & crChar )

END function
' -------------------------------------------------------------------
FUNCTION getInstrument ( val )
   dim res

   SELECT CASE VAL
   CASE 1
      res ="Acoustic Grand Piano"
   CASE 2
      res ="Bright Acoustic Piano"
   CASE 3
      res ="Electric Grand Piano"
   CASE 4
      res ="Honky-tonk Piano"
   CASE 5
      res ="Electric Piano 1 (Rhodes Piano)"
   CASE 6
      res ="Electric Piano 2 (Chorused Piano)"
   CASE 7
      res ="Harpsichord"
   CASE 8
      res ="Clavinet"
   CASE 9
      res ="Celesta"
   CASE 10
      res ="Glockenspiel"
   CASE 11
      res ="Music Box"
   CASE 12
      res ="Vibraphone"
   CASE 13
      res ="Marimba"
   CASE 14
      res ="Xylophone"
   CASE 15
      res ="Tubular Bells"
   CASE 16
      res ="Dulcimer (Santur)"
   CASE 17
      res ="Drawbar Organ (Hammond)"
   CASE 18
      res ="Percussive Organ"
   CASE 19
      res ="Rock Organ"
   CASE 20
      res ="Church Organ"
   CASE 21
      res ="Reed Organ"
   CASE 22
      res ="Accordion (French)"
   CASE 23
      res ="Harmonica"
   CASE 24
      res ="Tango Accordion (Band neon)"
   CASE 25
      res ="Acoustic Guitar (nylon)"
   CASE 26
      res ="Acoustic Guitar (steel)"
   CASE 27
      res ="Electric Guitar (jazz)"
   CASE 28
      res ="Electric Guitar (clean)"
   CASE 29
      res ="Electric Guitar (muted)"
   CASE 30
      res ="Overdriven Guitar"
   CASE 31
      res ="Distortion Guitar"
   CASE 32
      res ="Guitar harmonics"
   CASE 33
      res ="Acoustic Bass"
   CASE 34
      res ="Electric Bass (fingered)"
   CASE 35
      res ="Electric Bass (picked)"
   CASE 36
      res ="Fretless Bass"
   CASE 37
      res ="Slap Bass 1"
   CASE 38
      res ="Slap Bass 2"
   CASE 39
      res ="Synth Bass 1"
   CASE 40
      res ="Synth Bass 2"
   CASE 41
      res ="Violin"
   CASE 42
      res ="Viola"
   CASE 43
      res ="Cello"
   CASE 44
      res ="Contrabass"
   CASE 45
      res ="Tremolo Strings"
   CASE 46
      res ="Pizzicato Strings"
   CASE 47
      res ="Orchestral Harp"
   CASE 48
      res ="Timpani"
   CASE 49
      res ="String Ensemble 1 (strings)"
   CASE 50
      res ="String Ensemble 2 (slow strings)"
   CASE 51
      res ="SynthStrings 1"
   CASE 52
      res ="SynthStrings 2"
   CASE 53
      res ="Choir Aahs"
   CASE 54
      res ="Voice Oohs"
   CASE 55
      res ="Synth Voice"
   CASE 56
      res ="Orchestra Hit"
   CASE 57
      res ="Trumpet"
   CASE 58
      res ="Trombone"
   CASE 59
      res ="Tuba"
   CASE 60
      res ="Muted Trumpet"
   CASE 61
      res ="French Horn"
   CASE 62
      res ="Brass Section"
   CASE 63
      res ="SynthBrass 1"
   CASE 64
      res ="SynthBrass 2"
   CASE 65
      res ="Soprano Sax"
   CASE 66
      res ="Alto Sax"
   CASE 67
      res ="Tenor Sax"
   CASE 68
      res ="Baritone Sax"
   CASE 69
      res ="Oboe"
   CASE 70
      res ="English Horn"
   CASE 71
      res ="Bassoon"
   CASE 72
      res ="Clarinet"
   CASE 73
      res ="Piccolo"
   CASE 74
      res ="Flute"
   CASE 75
      res ="Recorder"
   CASE 76
      res ="Pan Flute"
   CASE 77
      res ="Blown Bottle"
   CASE 78
      res ="Shakuhachi"
   CASE 79
      res ="Whistle"
   CASE 80
      res ="Ocarina"
   CASE 81
      res ="Lead 1 (square wave)"
   CASE 82
      res ="Lead 2 (sawtooth wave)"
   CASE 83
      res ="Lead 3 (calliope)"
   CASE 84
      res ="Lead 4 (chiffer)"
   CASE 85
      res ="Lead 5 (charang)"
   CASE 86
      res ="Lead 6 (voice solo)"
   CASE 87
      res ="Lead 7 (fifths)"
   CASE 88
      res ="Lead 8 (bass + lead)"
   CASE 89
      res ="Pad 1 (new age Fantasia)"
   CASE 90
      res ="Pad 2 (warm)"
   CASE 91
      res ="Pad 3 (polysynth)"
   CASE 92
      res ="Pad 4 (choir space voice)"
   CASE 93
      res ="Pad 5 (bowed glass)"
   CASE 94
      res ="Pad 6 (metallic pro)"
   CASE 95
      res ="Pad 7 (halo)"
   CASE 96
      res ="Pad 8 (sweep)"
   CASE 97
      res ="FX 1 (rain)"
   CASE 98
      res ="FX 2 (soundtrack)"
   CASE 99
      res ="FX 3 (crystal)"
   CASE 100
      res ="FX 4 (atmosphere)"
   CASE 101
      res ="FX 5 (brightness)"
   CASE 102
      res ="FX 6 (goblins)"
   CASE 103
      res ="FX 7 (echoes, drops)"
   CASE 104
      res ="FX 8 (sci-fi, star theme)"
   CASE 105
      res ="Sitar"
   CASE 106
      res ="Banjo"
   CASE 107
      res ="Shamisen"
   CASE 108
      res ="Koto"
   CASE 109
      res ="Kalimba"
   CASE 110
      res ="Bag pipe"
   CASE 111
      res ="Fiddle"
   CASE 112
      res ="Shanai"
   CASE 113
      res ="Tinkle Bell"
   CASE 114
      res ="Agogo"
   CASE 115
      res ="Steel Drums"
   CASE 116
      res ="Woodblock"
   CASE 117
      res ="Taiko Drum"
   CASE 118
      res ="Melodic Tom"
   CASE 119
      res ="Synth Drum"
   CASE 120
      res ="Reverse Cymbal"
   CASE 121
      res ="Guitar Fret Noise"
   CASE 122
      res ="Breath Noise"
   CASE 123
      res ="Seashore"
   CASE 124
      res ="Bird Tweet"
   CASE 125
      res ="Telephone Ring"
   CASE 126
      res ="Helicopter"
   CASE 127
      res ="Applause"
   CASE ELSE
      res = "Unknown & Val
   END SELECT
   returnValue = res
END function

FUNCTION getCC ( CCval)

   SELECT CASE CCval

   CASE 0
      returnValue ="Bank Select 1st byte"
   CASE 1
      returnValue ="Modulation Depth"
   CASE 2
      returnValue ="Breath Controller"
   CASE 4
      returnValue ="Foot Pedal"
   CASE 5
      returnValue ="Portamento Time"
   CASE 6
      returnValue ="Data Entry"
   CASE 7
      returnValue ="Channel Volume"
   CASE 8
      returnValue ="Balance"
   CASE 10
      returnValue ="Pan"
   CASE 11
      returnValue ="Expression"
   CASE 12
      returnValue ="Effect Controller 1"
   CASE 13
      returnValue ="Effect Controller 2"
   CASE 16,17,18,19
      returnValue ="General Purpose"
   CASE 32
      returnValue ="Bank Select 2nd byte"
   CASE 64
      returnValue ="Damper Pedal ON/OFF"
   CASE 65
      returnValue ="Portamento ON/OFF"
   CASE 66
      returnValue ="Sostenuto  Pedal"
   CASE 67
      returnValue ="Soft"
   CASE 68
      returnValue ="Legato FootSwitch"
   CASE 69
      returnValue ="Hold 2"
   CASE 70
      returnValue ="Sound Controller 1"
   CASE 71
      returnValue ="Filter Resonance (Timbre/Harmonic Intensity)"
   CASE 72
      returnValue ="Release Time"
   CASE 73
      returnValue ="Attack time"
   CASE 74
      returnValue ="Brightness"
   CASE 75
      returnValue ="Decay Time"
   CASE 76
      returnValue ="Vibrato Rate"
   CASE 77
      returnValue ="Vibrato Depth"
   CASE 78
      returnValue ="Vibrato Delay"
   CASE 79
      returnValue ="Sound Controller 10"
   CASE 80
      returnValue ="GP Decay or ON/OFF"
   CASE 81
      returnValue ="Hi-Pass Filter or ON/OFF"
   CASE 82 , 83
      returnValue ="Generic ON/OFF"
   CASE 84
      returnValue ="Portamento (amount)"
   CASE 88
      returnValue ="High Resolution Velocity Prefix"
   CASE 91
      returnValue ="Reverb Send Level"
   CASE 92
      returnValue ="Tremolo"
   CASE 93
      returnValue ="Chorus Send Level"
   CASE 94
      returnValue ="Detune"
   CASE 95
      returnValue ="Phaser"
   CASE 96
      returnValue ="Data increment"
   CASE 97
      returnValue ="Data decrement"
   CASE 98
      returnValue ="Non-RPN LSB"
   CASE 99
      returnValue ="Non-RPN MSB"
   CASE 100
      returnValue ="RPN LSB"
   CASE 101
      returnValue ="RPN MSB"
   CASE 120
      returnValue ="All Sound Off"
   CASE 121
      returnValue ="Reset all controllers"
   CASE 122
      returnValue ="Local On/Off switch"
   CASE 123
      returnValue ="All notes Off"
   CASE 124
      returnValue ="Omni Mode Off"
   CASE 125
      returnValue ="Omni Mode On"
   CASE 126
      returnValue ="Mono Mode"
   CASE 127
      returnValue ="Poly Mode"
   CASE else
      returnValue ="Undefined "  & CCval
   END SELECT
END function

FUNCTION MidiChannelVoiceEvent ( fdata ,   index )
   dim status , proceed
   dim indexIn
   static dim RunningStatus = 0
   dim hexOut = ""
   dim txtOut = ""
   dim dtIndex = index  ' points at the CURRENT delta time
   dim dLen = 0

   '       sob (decodeInfo,"add", "row" , "Start "  &  addrOutPut ( Index)  & crChar )

   dim dTime

   dim chn = RunningStatus   BAND  0x00f
   status  = RunningStatus
   returnValue = ""

   dim rsHexOut

   DO

      ProgressToggle ()
      ' ---------------------------------------------
      ' index = start of MCVE  delta-time
      dtIndex = index

      dTime  =  read_vinteger ( fdata , byRef Index )
      txtOut =  tabChar & "MCVM" & tabChar & showDeltaTime( dTime ) &  tabChar & "  "

      ' ---------------------------------------------
      ' index = first BYTE after   delta-time

      IF (  fdata(index) > 0x7f ) then
         status = fdata(index++)
         chn = status   BAND  0x00f
         RunningStatus = 0    
      ELSE
         RunningStatus = 1
      END IF

      rsHexOut = "      "
      IF ( rsHexOutPutFlag ) then
         rsHexOut =  hex(status) &  ", "
      END IF

      ' ---------------------------------------------
      ' index = first BYTE after   STATUS byte

      indexIn = index

      ' we MUST do this SELECT to get the number of data bytes, usually 2 but not always
      ' AND we must use INDEX

      SELECT CASE   status BAND 0x0f0
      CASE  0x80
         txtOut = txtOut & "Off " & "Chn= " & chn &  " Key= " &  ( fdata(index++) Band 0x7f ) &  "  Vel= " &  ( fdata(index++) Band 0x7f )
      CASE  0x90
         txtOut = txtOut & "ON  " & "Chn= " & chn &  " Key= " &  ( fdata(index++) Band 0x7f ) &  "  Vel= " &  ( fdata(index++) Band 0x7f )
      CASE  0xA0
         txtOut = txtOut & "Polyphonic Key Pressure (After touch)  " & "Chn= " & chn &  " Key= " &  ( fdata(index++) Band 0x7f ) &  "  Pressure= " &  ( fdata(index++) Band 0x7f )
      CASE  0xB0
         txtOut = txtOut & "Control Change.  " & "Chn= " & chn &  " Controller = " &  getCC( fdata(index++) Band 0x7f ) &  " => " &  ( fdata(index++) Band 0x7f )
      CASE  0xC0
         txtOut = txtOut & "Program Change.  " & "Chn= " & chn &  " Program = " & getInstrument (    ( fdata(index++) Band 0x7f ))
      CASE  0xD0
         txtOut = txtOut & "Channel Pressure (After touch)  " & "Chn= " & chn &  " Pressure= " &  ( fdata(index++) Band 0x7f )
      CASE  0xE0
         txtOut = txtOut & "Pitch Wheel Change.  " & "Chn= " & chn &  " Controller = +/- " &  ( fdata(index++) Band 0x7f ) +  ( 0x80 * ( fdata(index++) Band 0x7f ) - 0x02000 )
      CASE  ELSE
         txtOut = txtOut & "status: MCV ???? " & hex(index) & "  "  & hex(status) & "  " & metaEvent ( fdata , byRef index )
      END SELECT
      dLen = index  - indexIn

      IF  textOutPutFlag   then
         IF hexOutPutFlag then   hexOut = crChar
      ELSE
         txtOut = ""
         hexOut = ""
      END IF

      ' have handled the TEXT line

      ' -------------------------------------------------------
      ' create the hex output if it is needed
      IF hexOutPutFlag then

         ' ------------------------------
         hexOut  = hexOut  &  addrOutPut (dtIndex)

         ' ------------------------------
         ' write the deltaTime bytes

         DO while ( fdata(dtIndex)   > 0x7f )
            hexOut = hexOut &  hex(fdata(dtIndex++)) & ", "
         LOOP
         hexOut = hexOut &  hex(fdata(dtIndex++)) & ", "

         ' ------------------------------
         ' handle the STATUS

         IF ( fdata(dtIndex)  > 0x7f ) then
            hexOut = hexOut &  hex(fdata(dtIndex++)) & ", "
         ELSE
            hexOut = hexOut &  rsHexOut     
         END if

         ' ------------------------------
         ' output the action's  data

         DO while ( dlen-- )
            hexOut = hexOut &  hex(fdata(indexIn++))
            IF ( dlen  ) then  hexOut = hexOut & ", "
         LOOP

      END IF

      ' -------------------------------------------------------

      returnValue = returnValue & txtOut  & hexOut

      ' -------------------------------------------------------
      ' index is pointing at the next delta time
      ' which MIGHT be followed by a RUNNING STATUS

      dtIndex = index
      dTime   = read_vinteger ( fdata , byRef dtIndex )

      IF ( fdata(dtIndex) < 0x80 ) then
      runningStatus = 1
      proceed = 1
      returnValue = returnValue & crChar
   ELSE
      proceed = 0
   END IF

LOOP  while ( proceed)

RunningStatus = Status
END Function

' -------------------------------------------------------------------

FUNCTION MTrk_handler ( sobOut , fdata  , index , hdLen )

   dim i , chn , event , eventIndex ,Len , indexIn
   hdLen = hdLen + index
   dim txtOut = ""
   returnValue = 1

   IF ( hdlen > length (fdata) ) THEN
      sob (sobOut,"add", "row" , "MTrk header too large"   & crChar )

      returnValue = 0
      EXIT function
   END IF

   DO while (  index < hdLen )
      ProgressToggle ()
      txtOut = ""
      indexIn = index
      ' need to pass over the delta-time to get to the EVENT

      showDeltaTime ( read_vinteger ( fdata , byRef indexIn ) )

      eventIndex = indexIn
      event  = fdata(indexIn)

      IF (  event == 0x0ff) then

         txtOut =  metaEvent ( fdata , byRef index )
      ELSEIF (  (event BAND 0x0ff) == 0x0f0  ) then

         txtOut =  tabChar & "SysEx " & tabChar & showDeltaTime ( read_vinteger ( fdata , byRef index  ) ) & tabCHar
         IF ( textOutPutFlag )  then
            txtOut = txtOut & "  "  & hex ( fdata(index ))  & ", " &  hex ( fdata(index+1  ))
            IF ( HexOutPutFlag )  then  txtOut = txtOut &    crChar
         ELSE
            txtOut = ""
         END IF

         IF ( HexOutPutFlag )  then
            txtOut =  txtOut &  AddrOUtPut ( index)  & hex ( fdata(index++ )) & ", " &   show_counted_bytes ( fdata, byRef index)
         ELSE
            index++
            show_counted_bytes ( fdata, byRef index )
         END IF

      ELSEIF (  (event BAND 0x0ff) == 0x0f7  ) then

         txtOut =  tabChar & "SysEx " & tabChar & showDeltaTime ( read_vinteger ( fdata , byRef index  ) ) & tabCHar
         IF ( textOutPutFlag )  then
            txtOut = txtOut & "  "  & hex ( fdata(index ))  & ", " &  hex ( fdata(index+1  ))
            IF ( HexOutPutFlag )  then
               txtOut = txtOut &    crChar
            END if
         ELSE
            txtOut = ""
         END IF

         IF ( HexOutPutFlag )  then
            txtOut =  txtOut &  AddrOUtPut ( index)  & hex ( fdata(index++ )) & ", " &   show_counted_bytes ( fdata, byRef index)
         ELSE
            index++
            show_counted_bytes ( fdata, byRef index )
         END IF

      ELSEIF (  (event BAND 0x0ff) > 0xf0  ) then

         txtOut = "Event: ???? " & hex(eventIndex)  & "  " & hex(event)
         ' must force an exit
         returnValue = 0
         index = hdlen
      ELSEIF (   event BAND 0x0f0     ) then

         txtOut =   MidiChannelVoiceEvent ( fdata , byRef index )

      ELSE
         txtOut = "Event: ???? " & hex(eventIndex)  & "  " & hex(event) & "  " & metaEvent ( fdata , byRef index )
         returnValue = 0
      END IF

      sob (sobOut,"add", "row" ,    txtOut  & crChar )
      ProgressToggle(    )
   LOOP

END function

FUNCTION decodeFile ( fName , sobOut)
   dim chunkCnt = 0, ProceedFlag = 1
   dim tmpHex , nbrTrks

   sob (btnFile,"SET", "RGB" , greenBtnRGB )

   dim fSize = fileSize ( fName )
   sob (sobOut,"add", "row" , tabChar & "File size " & Hex( fsize ) & " " & crChar & crChar )
   dim  fdata = byteArray ( fsize )

   fileRead (  fname ,    fdata , fSize  )
   dim chunkName  , chunkSize ,  i  , chunkIndex = 0
   DO while (   chunkIndex + 8 <  fSize )

      ProgressToggle ()

      chunkName = ""
      FOR i= 0 to 3
         chunkName = chunkName + chr  ( fdata( chunkIndex + i )   )
      NEXT i

      chunkSize = read_dword ( fdata , chunkIndex + 4 )

      SELECT case  chunkName

      CASE "MThd"
         IF ( textOutPutFlag ) then
            sob (sobOut,"add", "row" ,  "Chunk: " & chunkName & " at offset " & hex(chunkIndex) & "h   length: "   &  chunkSize  & crChar)
            ProceedFlag = MThd_handler ( sobOut , fdata  , chunkIndex + 8 , chunkSize )
         END if
         ProgressText ("MThd",2)
         nbrTrks= -1 * read_word ( fdata , chunkIndex + 10  )

         ProgressTick( nbrTrks  )

         IF ( hexOutPutFlag ) then
            tmpHex = "" &   addrOutPut ( 0 )

            i = 0
            FOR i = 0 to  13
               tmpHex = tmpHex & hex(fdata(i))
               IF ( i < 13) then
                  tmpHex = tmpHex & ", "
               END if

            NEXT i
            sob (sobOut,"add", "row" ,  tmpHex &  crChar)
         END if

      CASE "MTrk"

         ProgressText ("MTrk",2)
         sob (sobOut,"add", "row" ,  "Chunk: " & chunkName & " at offset " & hex(chunkIndex) & "h   length: "   &  chunkSize  & crChar)
         IF ( hexOutPutFlag ) then
            tmpHex = "" &   addrOutPut ( chunkIndex )
            i = 0
            FOR i = 0 to  7
               tmpHex = tmpHex & hex(fdata(i))
               IF ( i < 7) then
                  tmpHex = tmpHex & ", "
               END if

            NEXT i
            sob (sobOut,"add", "row" ,  tmpHex &  crChar)
         END if

         ProceedFlag =  MTrk_handler ( sobOut , fdata  , chunkIndex + 8 , chunkSize )
         ProgressTick( ++nbrTrks  )

      CASE ELSE
         sob (btnFile,"SET", "RGB" , rgb( 0xff,  0x80 ,   0x80 ) )

         tmpHex = "Error at offset " &    addrOutPut ( chunkIndex )

         i = 0
         FOR i = 0 to  7
            tmpHex = tmpHex & hex(fdata(i))
            IF ( i < 7) then
               tmpHex = tmpHex & ", "
            END if

         NEXT i
         sob (sobOut,"add", "row" ,  tmpHex &  crChar)

         IF ( chunkCnt  ) then
            sob (sobOut,"add", "row" ,"MTrk expected but not found." & crChar & "No handler for this Chunk type."  & crChar )
         ELSE
            sob (sobOut,"add", "row" ,"MThd not found." & crChar & "This is probably not a MIDI file."  & crChar )
            ProceedFlag =  0
         END if
         chunkIndex = -1

      END SELECT

      sob (sobOut,"add", "row" ,   crChar )
      chunkCnt++
      chunkIndex = chunkIndex + 8 + chunkSize

      IF ProceedFlag == 0 then
         chunkIndex = fsize ' forces an early  exit
         sob (sobOut,"add", "row" , "Invalid format " & crChar )
      ELSE

      END if

   LOOP

   IF ! ( chunkIndex == fSize )   then
      sob (sobOut,"add", "row" , "Bad chunk " & crChar )
   END if

END function
' --------------------
SOB ( "OVERRIDE" , "STYLE+"  , 0x00002000)

dim btnFile = sob ( appCOL  ,  "add"  ,  "button" ,   "push"    ,  chr(0x0a)  )
sob ( -1   , "SET", "TITLE" , "Drop a MIDI file on this bar, or press this bar for a file explorer"   )

FUNCTION processFile ( fName )
   LastProcessedFileName = fname
   report ()

   report( fName )

   ProgressClear(  )
   ProgressText("Decode a Midi file", 0 )
   ProgressText(fname, 1 )

   progressShow (1)

   sob (decodeInfo,"SET", "SHOW", 0 )

   TRY
      decodeFile ( fName , decodeInfo )
      report(crChar & "Processing Finished normally " )

   CATCH

      IF ( LastError == 113 ) then
         ' triggered by the user pressing the   Progress dialog CANCEL button
         sob (decodeInfo,"add", "row" , "Processing interrupted by user" &  crChar )
      ELSEIF ( LastError == 423 ) then
         ' triggered by a   UserError  command
         sob (decodeInfo,"add", "row" , "Error: " & errortext(lasterror) &  crChar )
      ELSE
         ' programming error
         sob (decodeInfo,"add", "row" , "An error occurred: " &  errortext(lasterror) &  crChar )
         sob (decodeInfo,"add", "row" , "Error line: " &  errorline &  crChar )
      END if

   END TRY

   progressShow (0)
   SOB (decodeInfo , "SET" , "ROW" , "TOP" ,0  )
   sob (decodeInfo,"SET", "SHOW", 1 )
END FUNCTION
' --------------------
FUNCTION cbFile_File ( sobid )
   sob (decodeInfo,"empty")
   dim midiFIle = FileSel (  , "Midi Files (*.mid)\0*.mid\0All Files \0*.*\0\0" )
   IF ( midiFile <> "" ) then
      processFile ( midiFile )
   END IF
END Function
sob ( btnFile ,"ON","CLICK", "cbFile_File")

FUNCTION cbBtn_File ( sobid   )
   sob (decodeInfo,"empty")
   IF  GetDropCount  then
      processFile ( getDropData(1) )
   END if
END Function

sob (btnFile,"ON","DROP.FILE", "cbBtn_File")
sob (btnFile,"SET", "RGB" , greenBtnRGB   )
' --------------------
decodeInfo = sob(appCOL,"add","Edit.rows" ,   "define the minimum width", 10 )
RedirectReportingTo ( decodeInfo )

sob (-1 , "SET" , "RW" , 0  )

sob (-1,"empty")
sob (-1,"add", "row" , crChar )
sob (-1,"add", "row" , crChar )
sob (-1,"SET", "RGB" , readOnlyRGB)

' --------------------

' change the FONT of the  decodeInfo  panel  to a monospaced font!
font("default")
font("SET" ,"HEIGHT" , APP$ARG ( asc("F") ) )
font("SET" ,"WEIGHT" , APP$ARG ( asc("B") ) )
font("SET" ,"FaceName" , "Courier New" )
dim myFont = Font("CREATE")
sob ( decodeInfo, "SET", "FONT" , myFont )

setFontBold ( fontBold  )
' --------------------

' use a Double right mouse click as a trigger to decode the current file again
FUNCTION cbdecodeInfo_mouseclicks ( sobid, clickValue, row , col )
   IF ! (clickValue == 6) then exit function

   IF (LastProcessedFileName == "")  then exit function

   sob (decodeInfo,"empty")
   processFile ( LastProcessedFileName )
END function

sob ( decodeInfo,"ON","MOUSECLICKS", "cbdecodeInfo_mouseclicks")
' --------------------
SOB (pwSwindow  , "SET" , "show"  , 0 )
sob ( sobAbout, "trigger")