Generic Conversion {weak start}

Started by spl, December 17, 2024, 06:25:18 AM

Previous topic - Next topic

spl

The script below has several tests for some of the conversion function. Currently failing with hex 2 binary (hb) as I assumed the MapKeyFind() method would return the map value as a string, but the error message 'Variable is Not an Array' is confounding. While the docs for other map values indicate a return value as an array, MapKeyFind() doesn't. Outside of creating 2 listitems for hex=>bin lookup I thought a map lookup would be more efficient, but obviously more frustrating...

The code is raw, some of it kludged from WB scripts circa 2003... but does imply a generic conversion is possible.
;Winbatch 2024B - Generic number conversion
;Stan Littlefield, December 17,2024
;definite WIP
;/////////////////////////////////////////////////////////////////////////////////////////////////////////
gosub udfs
IntControl(73,1,0,0,0)

;TESTS - comment/uncomment sections as needed, assumes understanding of conversion types
;invalid conversion type
;input = "AF1D"
;cvtype = "hh"
;result = gencvt(input,cvtype)


;hex 2 decimal
;input = "AF1D"
;cvtype = "hd"
;result = gencvt(input,cvtype)

;decimal 2 hex
;input = "45789990"
;cvtype = "dh"
;result = gencvt(input,cvtype)

;hex 2 string
;input = "48656c6c6f20576f726c64"
;cvtype = "hs"
;result = gencvt(input,cvtype)

;hex 2 binary
input = "48656c6c6f20576f726c64"
cvtype = "hb"
result = gencvt(input,cvtype)

If result<>""
Message(input,result)
Endif
Exit

:WBERRORHANDLER
geterror()
Terminate(@TRUE,"Error Encountered",errmsg)

;/////////////////////////////////////////////////////////////////////////////////////////////////////////

:udfs
#DefineSubRoutine geterror()
   wberroradditionalinfo = wberrorarray[6]
   lasterr = wberrorarray[0]
   handlerline = wberrorarray[1]
   textstring = wberrorarray[5]
   linenumber = wberrorarray[8]
   errmsg = "Error: ":lasterr:@LF:textstring:@LF:"Line (":linenumber:")":@LF:wberroradditionalinfo
   Return(errmsg)
#EndSubRoutine

#DefineFunction gencvt(input,cvtype)
IntControl(73,1,0,0,0)
conversions ="bd|bh|bi|db|dh|di|hb|hd|hi|hs|ib|id|ih"
retval = ""
If (!StrIndex(conversions, cvtype, 0 , @FWDSCAN))
   Display(4,"Conversion: ":cvtype,"Type not recognized")
   Return retval
Endif

If cvtype=="hd"
  hex=strtrim(strupper(input))
  hexlen=strlen(hex)
  If ((hexlen mod 2) <> 0)
      Display("Cannot Continue", "Invalid Hex Values")
      Return retval
  Endif
  retval=0
  for x=1 to hexlen
    retval=(retval*16) + strindex(input,strsub(hex,x,1),0,@fwdscan) -1
  next
  return retval
Endif

If cvtype=="dh"
   IsZero=@TRUE
   str="0123456789ABCDEF"
   retval=""   
   for x=7 to 0 by -1
       nibble= (input >> (x*4)) & 15
       if nibble==0 && IsZero==@TRUE then continue
       IsZero=@FALSE
       retval=strcat(retval,Strsub(input,nibble+1,1))
   next
  return retval
Endif

If cvtype=="hs"
   hexstr = StrUpper(StrTrim(input))
   iLength = StrLen(hexstr)
   If ((iLength mod 2) <> 0)
      Display("Cannot Continue", "Invalid Hex Values")
      Return retval
   Endif
   For i=1 To iLength By 2
      sHex = StrSub(hexstr,i,2)
      n1 = Char2Num(StrSub(sHex,1,1))-48
      n2 = Char2Num(StrSub(sHex,2,1))-48
      iByte = (((n1-7*(n1>9))<<4)+(n2-7*(n2>9)))
      retval = retval:Num2Char(iByte)
   Next

   return retval
Endif


If cvtype=="hb"
   hexstr = StrUpper(StrTrim(input))
   iLength = StrLen(hexstr)
   If ((iLength mod 2) <> 0)
      Display("Cannot Continue", "Invalid Hex Values")
      Return retval
   Endif
   h1 = $"0=0000
   1=0001
   2=0010
   3=0011           
   4=0100
   5=0101
   6=0110           
   7=0111
   8=1000
   9=1001
   A.1010
   B=1011
   C=1100
   D=1101
   E=1110
   F=1111$"
   hexbin= MapCreate(h1,'=',@lf)
   For i=1 To iLength By 2
      sHex = StrSub(hexstr,i,2)
      c1 = StrSub(sHex,1,1)
      c2 = StrSub(sHex,2,1)
      b1 = MapKeyFind(c1, hexbin , '')
      b2 = MapKeyFind(c2, hexbin , '')
      retval = retval:b1:b2
   Next

   return retval
Endif


Return retval


:WBERRORHANDLER
geterror()
Terminate(@TRUE,"Error Encountered",errmsg)
#EndFunction

Return
;/////////////////////////////////////////////////////////////////////////////////////////////////////////

Stan - formerly stanl [ex-Pundit]

td

I found two problems with your script. The first is the line "A.1010" in the ML string. The second is that the first and second parameters of the MapKeyFind function calls are reversed.

MapKeyExist(map, key [,not_found])

Overall it is a good reference point for a new WIL function. 


"No one who sees a peregrine falcon fly can ever forget the beauty and thrill of that flight."
  - Dr. Tom Cade

spl

As I wrote 'raw' being the operative word. Thanks for re-mapping me and below was my plan-b Hex 2 Binary, which seemed to work as well. I will play around with other conversions (I think the IV4 will be a challenge, and maybe not needed). Will also need validation of the other inputs as well as hex.
If cvtype=="hb"
   hexstr = StrUpper(StrTrim(input))
   iLength = StrLen(hexstr)
   If ((iLength mod 2) <> 0)
      Display(2,"Cannot Continue", "Invalid Hex Values")
      Return retval
   Endif
   hList = "0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F"
   bList = "0000,0001,0010,0011,0100,0101,0110,0111,1000,1001,1010,1011,1100,1101,1111"
   For i=1 To iLength By 2
      sHex = StrSub(hexstr,i,2)
      c1 = StrSub(sHex,1,1)
      n = ItemLocate(c1,hlist,",")
      b1 = ItemExtract(n,bList,","
      c2 = StrSub(sHex,2,1)
      n = ItemLocate(c2,hlist,",")
      b2 = ItemExtract(n,bList,","     
      retval = retval:b1:b2
   Next

   return retval
Endif
Stan - formerly stanl [ex-Pundit]

td

I have been working on a regression test script for a new WIL function. I wish I only had to correct two problems in the script.
"No one who sees a peregrine falcon fly can ever forget the beauty and thrill of that flight."
  - Dr. Tom Cade

spl

Quote from: td on December 18, 2024, 07:44:48 AMI have been working on a regression test script for a new WIL function. I wish I only had to correct two problems in the script.

So perhaps I should stop. What is needed to be done is commonplace, but packing it into a single function does keep one's brain alive. Happy this piqued some interest.
Stan - formerly stanl [ex-Pundit]

spl

The hd (hex 2 decimal) is just wrong. It assumed hex is even number, so hex like 62C which should equal 1580 still failed with a lot of coding changes. Finally Occam's Razor and CLR
;Winbatch 2024B - Generic number conversion
;Stan Littlefield, December 17,2024
;definite WIP
; Edit: 12/19/2024 - redo hd conversion with CLR [System.Convert]
;/////////////////////////////////////////////////////////////////////////////////////////////////////////
gosub udfs
IntControl(73,1,0,0,0)

;TESTS - comment/uncomment sections as needed, assumes understanding of conversion types
;invalid conversion type
;input = "AF1D"
;cvtype = "hh"
;result = gencvt(input,cvtype)


;hex 2 decimal
input = "62C"
;input = 'C2CCBE630B8D9C00'
cvtype = "hd"
result = gencvt(input,cvtype)

;decimal 2 hex
;input = "45789990"
;cvtype = "dh"
;result = gencvt(input,cvtype)

;hex 2 string
;input = "48656c6c6f20576f726c64"
;cvtype = "hs"
;result = gencvt(input,cvtype)

;hex 2 binary
;input = "48656c6c6f20576f726c64"
;cvtype = "hb"
;result = gencvt(input,cvtype)

If result<>""
Message(input,result)
Endif
Exit

:WBERRORHANDLER
geterror()
Terminate(@TRUE,"Error Encountered",errmsg)

;/////////////////////////////////////////////////////////////////////////////////////////////////////////

:udfs
#DefineSubRoutine geterror()
   wberroradditionalinfo = wberrorarray[6]
   lasterr = wberrorarray[0]
   handlerline = wberrorarray[1]
   textstring = wberrorarray[5]
   linenumber = wberrorarray[8]
   errmsg = "Error: ":lasterr:@LF:textstring:@LF:"Line (":linenumber:")":@LF:wberroradditionalinfo
   Return(errmsg)
#EndSubRoutine

#DefineFunction gencvt(input,cvtype)
IntControl(73,1,0,0,0)
conversions ="bd|bh|bi|db|dh|di|hb|hd|hi|hs|ib|id|ih"
retval = ""
If (!StrIndex(conversions, cvtype, 0 , @FWDSCAN))
   Display(4,"Conversion: ":cvtype,"Type not recognized")
   Return retval
Endif

If cvtype=="hd"
   Cvt    = ObjectClrNew('System.Convert')
   retval  = Cvt.ToUInt64(input,16) ;use Uint to avoid negative number
   return retval
Endif

If cvtype=="dh"         
   IsZero=@TRUE
   str="0123456789ABCDEF"
   retval=""  
   for x=7 to 0 by -1
       nibble= (input >> (x*4)) & 15
       if nibble==0 && IsZero==@TRUE then continue
       IsZero=@FALSE
       retval=strcat(retval,Strsub(input,nibble+1,1))
   next
  return retval
Endif

If cvtype=="hs"
   hexstr = StrUpper(StrTrim(input))
   iLength = StrLen(hexstr)
   If ((iLength mod 2) <> 0)
      Display("Cannot Continue", "Invalid Hex Values")
      Return retval
   Endif
   For i=1 To iLength By 2
      sHex = StrSub(hexstr,i,2)
      n1 = Char2Num(StrSub(sHex,1,1))-48
      n2 = Char2Num(StrSub(sHex,2,1))-48
      iByte = (((n1-7*(n1>9))<<4)+(n2-7*(n2>9)))
      retval = retval:Num2Char(iByte)
   Next

   return retval
Endif

If cvtype=="hb"
   hexstr = StrUpper(StrTrim(input))
   iLength = StrLen(hexstr)
   If ((iLength mod 2) <> 0)
      Display("Cannot Continue", "Invalid Hex Values")
      Return retval
   Endif
   hList = "0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F"
   bList = "0000,0001,0010,0011,0100,0101,0110,0111,1000,1001,1010,1011,1100,1101,1111"
   For i=1 To iLength By 2
      sHex = StrSub(hexstr,i,2)
      c1 = StrSub(sHex,1,1)
      n = ItemLocate(c1,hlist,",")
      b1 = ItemExtract(n,bList,",")
      c2 = StrSub(sHex,2,1)
      n = ItemLocate(c2,hlist,",")
      b2 = ItemExtract(n,bList,",")    
      retval = retval:b1:b2
   Next

   return retval
Endif

Return retval


:WBERRORHANDLER
geterror()
Message("Error Encountered",errmsg)
Exit
#EndFunction

Return
;/////////////////////////////////////////////////////////////////////////////////////////////////////////

Stan - formerly stanl [ex-Pundit]