WBT2HTML v1.05
;===============================================================================
; WBT2HTML 1.05  2002:02:07                (c) Detlev Dalitz 2001:07:29:00:00:00
;===============================================================================
; user information is placed at end of file
; ------------------------------------------------------------------------------

ParamResult = @FALSE
If (param0 > 0)
   GoSub GetParams
Else
   Goto AskParams
EndIf
If !ParamResult
   GoSub DefineUDFs
   GoSub UserConfigurableInit
   GoSub ProgInit
   GoSub CollectColors
   GoSub CollectKeywords
   GoSub OpenReadSourceFile
   If UseAutoDelimiter Then GoSub CalculateDelimiters
   GoSub TagQuote
   GoSub TagComment
   GoSub TagBracket
   GoSub TagOperator
   GoSub TagOthers
   GoSub TagWordNumber
   GoSub ColorizeWord
   GoSub ColorizeNumber
   GoSub ColorizeOthers
   GoSub ColorizeOperator
   GoSub ColorizeBracket
   GoSub ColorizeComment
   GoSub ColorizeQuote
   GoSub WriteCloseTargetFile
EndIf
If (IntControl (77, 80, 0, 0, 0) > 0) Then Return (ParamResult)
Exit

;===============================================================================
:DefineUDFs
;-------------------------------------------------------------------------------
If ItemLocate ("udfbytetohex", IntControl (77, 103, 0, 0, 0), @TAB) Then Goto skip_udfbytetohex
#DefineFunction udfByteToHex (Byte)
HexChars = "0123456789abcdef"
h1 = StrSub (HexChars, 1 + (Byte >> 4), 1)
h2 = StrSub (HexChars, 1 + (Byte & 15), 1)
Return (StrCat (h1, h2))
;HexChars="0123456789ABCDEF"
#EndFunction
:skip_udfbytetohex
;-------------------------------------------------------------------------------
If ItemLocate ("udffilecrc", IntControl (77, 103, 0, 0, 0), @TAB) Then Goto skip_udffilecrc
#DefineFunction udfFileCRC (filename, type) ; returns integer
chk = 0
If ((type == 32) || (type == 16))
   fsize = FileSize (filename)
   If (fsize > 0)
      ;     AddExtender("wwser34i.dll") ; Load the serial extender ; 2002-12-26, 21:04:08, 77.893 Bytes.
      AddExtender ("wwser44i.dll") ; Load the serial extender ; 2004-07-27, 22:33:08, 90.181 Bytes.
      bb = BinaryAlloc (fsize)
      BinaryRead (bb, filename)
      chk = pCheckBinary (IntControl (42, bb, 0, 0, 0), BinaryEodGet (bb) - 1, type)
      BinaryFree (bb)
   EndIf
EndIf
Return (chk)
;calculates checksum for type=16 or type=32
;DD.20010731
#EndFunction
:skip_udffilecrc
;-------------------------------------------------------------------------------
If ItemLocate ("udfdisplaymsg", IntControl (77, 103, 0, 0, 0), @TAB) Then Goto skip_udfdisplaymsg
#DefineFunction udfDisplayMsg (str)
If (RtStatus () == 10) Then wStatusMsg (str)
   Else BoxText (str)
#EndFunction
:skip_udfdisplaymsg
;-------------------------------------------------------------------------------
Return ; from DefineUDFs
;===============================================================================


;===============================================================================
;Procedures
;-------------------------------------------------------------------------------
:CollectColors ; collect names and rgb color values
udfDisplayMsg (StrCat (logo, "Collecting colors ..."))
colorvaluelist = ""
colornamelist = StrCat ("Keyword", @TAB, "Quote", @TAB, "Comment", @TAB, "Default Text", @TAB, "Background")
;--- read colors for WIL files from WinBatch Studio Registry ---
colorcount = ItemCount (colornamelist, @TAB)
regkey = RegOpenKey (@REGCURRENT, "Software\Wilson WindowWare\WinBatch Studio\Settings\File types\WIL Files")
For i = 1 To colorcount
   colorvalueitem = RegQueryValue (regkey, StrCat ("[", ItemExtract (i, colornamelist, @TAB), "]"))
   colorvaluelist = ItemInsert (colorvalueitem, -1, colorvaluelist, @TAB)
Next
RegCloseKey (regkey)
Drop (regkey, colorcount, i, colorvalueitem)
;--- additional colors from my own inspiration -----------------
; create new hashtable if colors were changed
colornamelist = ItemInsert ("Operator", -1, colornamelist, @TAB)
colorvaluelist = ItemInsert ("000,048,128", -1, colorvaluelist, @TAB)

colornamelist = ItemInsert ("Bracket", -1, colornamelist, @TAB)
colorvaluelist = ItemInsert ("032,032,032", -1, colorvaluelist, @TAB)

colornamelist = ItemInsert ("Number", -1, colornamelist, @TAB)
colorvaluelist = ItemInsert ("096,000,000", -1, colorvaluelist, @TAB)

colornamelist = ItemInsert ("Other", -1, colornamelist, @TAB)
colorvaluelist = ItemInsert ("000,32,128", -1, colorvaluelist, @TAB)
;--- additional colors from WIL.CLR inifile --------------------
colorfile = StrCat (DirHome (), "WIL.CLR")
colorlist = IniItemizePvt ("COLORS", colorfile)
colorcount = ItemCount (colorlist, @TAB)
For i = 1 To colorcount
   colornameitem = ItemExtract (i, colorlist, @TAB)
   colorvalueitem = IniReadPvt ("COLORS", colornameitem, "000,000,000", colorfile)
   colorvaluelist = ItemInsert (colorvalueitem, -1, colorvaluelist, @TAB)
   colornamelist = ItemInsert (colornameitem, -1, colornamelist, @TAB)
Next
Drop (colorfile, colorlist, colorvalueitem, colornameitem, colorcount)
;---------------------------------------------------------------
colornamelist = StrLower (colornamelist) ; set all items to lower case, no check if duplicates exist (todo?)
;---------------------------------------------------------------
If UseRGB
   ; delete all leading zeroes
   colorvaluelist = ItemInsert ("", 0, colorvaluelist, @TAB)
   colorvaluelist = StrReplace (colorvaluelist, @TAB, StrCat (",", @TAB, ","))
   colorvaluelist = StrReplace (colorvaluelist, ",0", ",")
   colorvaluelist = StrReplace (colorvaluelist, ",0", ",")
   colorvaluelist = StrReplace (colorvaluelist, ",,", ",0,")
   colorvaluelist = StrReplace (colorvaluelist, ",,", ",0,")
   colorvaluelist = StrReplace (colorvaluelist, StrCat (",", @TAB, ","), @TAB)
   colorvaluelist = ItemRemove (1, colorvaluelist, @TAB)
Else
   ; convert rgb to hex
   colorcount = ItemCount (colorvaluelist, @TAB)
   For i = 1 To colorcount
      rgbitem = ItemExtract (i, colorvaluelist, @TAB)
      colorvalueitem = StrCat ("#", udfByteToHex (ItemExtract (1, rgbitem, ",")))
      colorvalueitem = StrCat (colorvalueitem, udfByteToHex (ItemExtract (2, rgbitem, ",")))
      colorvalueitem = StrCat (colorvalueitem, udfByteToHex (ItemExtract (3, rgbitem, ",")))
      colorvaluelist = ItemReplace (colorvalueitem, i, colorvaluelist, @TAB)
   Next
EndIf
Return
;-------------------------------------------------------------------------------
:CollectKeywords
udfDisplayMsg (StrCat (logo, "Collecting keywords ..."))
; read our inifile in WinBatch system folder
wbt2htmlini = StrCat (DirHome (), "wbt2html.ini")
hashok = FileExist (wbt2htmlini)
If hashok
   colorFilename = IniReadPvt ("WIL", "ColorName", "", wbt2htmlini)
   hashok = (colorFilename <> "")
   If hashok
      hashok = FileExist (colorFilename)
      If hashok
         hashok = (IniReadPvt ("WIL", "ColorCRC", "", wbt2htmlini) == udfFileCRC (colorFilename, 32))
         If hashok
            hashok = FileExist (IniReadPvt ("WIL", "HashName", "", wbt2htmlini))
         EndIf
      EndIf
   EndIf
EndIf
If hashok
   udfDisplayMsg (StrCat (logo, "Reading hashtable ..."))
   GoSub ReadIni
   hbbsize = FileSizeEx (hfilename)
   Terminate ((hbbsize == 0), "Error", "Hashfile exists but has Filesize=0")
   hbb = BinaryAlloc (hbbsize)
   BinaryRead (hbb, hfilename)
Else
   udfDisplayMsg (StrCat (logo, "Creating hashtable ... be patient ..."))
   hfilename = Environment ("temp")
   If (StrSub (hfilename, StrLen (hfilename), 1) <> "\") Then hfilename = StrCat (hfilename, "\")
   hfilename = StrCat (hfilename, "WIL.HSH")
   colorfilename = StrCat (DirHome (), "WIL.CLR")
   Terminate (!FileExist (colorfilename), "Error", "WBT2HTML.WBT needs a good WIL.CLR file with some keywords in it ...")
   GoSub InitIni
   GoSub ReadIni
   ; read keywords from WIL.CLR inifile and create hashtable
   keywordlist = IniItemizePvt ("KEYWORDS", colorfilename)
   keywordcount = ItemCount (keywordlist, @TAB)
   hbbsize = 1.5 * keywordcount * hrecsize ; hashfactor*keycount*(length of identifier + length of colorname)
   hbb = BinaryAlloc (hbbsize)
   For i = 1 To keywordcount
      keyworditem = ItemExtract (i, keywordlist, @TAB)
      colornameitem = StrTrim (IniReadPvt ("KEYWORDS", keyworditem, "", colorfilename))
      If (colornameitem == "1") Then colornameitem = "Keyword" ; set standard WIL color=1 to "Keyword" as set in Registry
      hoffset = BinaryHashRec (hbb, hrecsize, hkeyoffset, hkeysize, StrLower (keyworditem))
      BinaryPokeStr (hbb, hoffset + hcolornameoffset, StrLower (colornameitem))
      BinaryPokeStr (hbb, hoffset + hmixcaseoffset, keyworditem)
      BinaryWrite (hbb, hfilename)
   Next
   BinaryWrite (hbb, hfilename)
   GoSub WriteIni
EndIf
Return
;-------------------------------------------------------------------------------
:InitIni
IniWritePvt ("WBT2HTML", "InternalName", "wbt2html.wbt", wbt2htmlini)
IniWritePvt ("WBT2HTML", "FileVersion", "1.05", wbt2htmlini)
IniWritePvt ("WBT2HTML", "FileDescription", "wbt to coloured html script converter", wbt2htmlini)
IniWritePvt ("WBT2HTML", "OriginalFilename", "WBT2HTML.WBT", wbt2htmlini)
IniWritePvt ("WBT2HTML", "ProductName", "WBT2HTML", wbt2htmlini)
IniWritePvt ("WBT2HTML", "ProductVersion", "1", wbt2htmlini)
IniWritePvt ("WBT2HTML", "CompanyName", "Detlev Dalitz", wbt2htmlini)
IniWritePvt ("WBT2HTML", "LegalCopyright", "(c)20010729 Detlev Dalitz", wbt2htmlini)
IniWritePvt ("WBT2HTML", "Comments", "emailto:dd@dalitz-im-netz.de", wbt2htmlini)
IniWritePvt ("WBT2HTML", "IniYmdHms", TimeYmdHms (), wbt2htmlini)
IniWritePvt ("WIL", "ColorName", colorFilename, wbt2htmlini)
IniWritePvt ("WIL", "ColorYmdHms", "0", wbt2htmlini)
IniWritePvt ("WIL", "ColorCRC", "0", wbt2htmlini)
IniWritePvt ("WIL", "HashName", hFilename, wbt2htmlini)
IniWritePvt ("WIL", "HashYmdHms", "0", wbt2htmlini)
IniWritePvt ("WIL", "HashCRC", "0", wbt2htmlini)
;IniWritePvt("WIL","HashCol","3",wbt2htmlini)
;IniWritePvt("WIL","HashCol1","0,30",wbt2htmlini)
;IniWritePvt("WIL","HashCol2","30,30",wbt2htmlini)
;IniWritePvt("WIL","HashCol3","60,30",wbt2htmlini)
;IniWritePvt("WIL","HashKey","1,HashCol1",wbt2htmlini)
Return
;-------------------------------------------------------------------------------
:WriteIni
IniWritePvt ("WIL", "ColorName", colorFilename, wbt2htmlini)
IniWritePvt ("WIL", "ColorYmdHms", FileTimeGetEx (colorfilename, 2), wbt2htmlini)
IniWritePvt ("WIL", "ColorCRC", udfFileCRC (colorFilename, 32), wbt2htmlini)
IniWritePvt ("WIL", "HashName", hFilename, wbt2htmlini)
IniWritePvt ("WIL", "HashYmdHms", FileTimeGetEx (hfilename, 2), wbt2htmlini)
IniWritePvt ("WIL", "HashCRC", udfFileCRC (hFilename, 32), wbt2htmlini)
Return
;-------------------------------------------------------------------------------
:ReadIni
;col1=IniReadPvt("WIL","HashCol1","",wbt2htmlini)
;col2=IniReadPvt("WIL","HashCol2","",wbt2htmlini)
;col3=IniReadPvt("WIL","HashCol3","",wbt2htmlini)
;hkeyoffset = ItemExtract(1,col1,",") ; key lowercase
;hkeysize   = ItemExtract(2,col1,",") ; key lowercase
;hcolornameoffset= ItemExtract(1,col2,",") ; color name
;hcolornamesize  = ItemExtract(2,col2,",") ; color name
;hmixcaseoffset = ItemExtract(1,col3,",") ; doubled key field in mixed case as stored in WIL.CLR
;hmixcasesize   = ItemExtract(2,col3,",") ; doubled key field in mixed case as stored in WIL.CLR
;drop(col1,col2,col3)
hkeyoffset = 0  ; key lowercase
hkeysize = 30 ; key lowercase
hcolornameoffset = 30 ; color name
hcolornamesize = 30 ; color name
hmixcaseoffset = 60 ; doubled key field in mixed case as stored in WIL.CLR
hmixcasesize = 30 ; doubled key field in mixed case as stored in WIL.CLR
hrecsize = hkeysize + hcolornamesize + hmixcasesize
hFilename = IniReadPvt ("WIL", "HashName", "", wbt2htmlini)
Return
;-------------------------------------------------------------------------------
:TagQuote
defmsgstr = StrCat (logo, "Tagging quotes ...")
udfDisplayMsg (defmsgstr)

qlist = """.'.`"

TagIdent = "q"
TagList = "TagListq"
If !IsDefined (%TagList%) Then %TagList% = TagOn ; start list with a well known item

structlfcr = BinaryTagInit (bb, @LF, @CR)
While @TRUE
   structlfcr = BinaryTagFind (structlfcr)
   If (structlfcr == "") Then Break
   line = BinaryTagExtr (structlfcr, 1)
   qstr = StrClean (line, ";""'`", "", @FALSE, 2)
   qstrlen = StrLen (qstr)
   If (qstrlen > 0)
      If (StrSub (qstr, 1, 1) <> ";")
         qstr = StrClean (qstr, ";", "", @FALSE, 1)
         qstrlen = StrLen (qstr)
         qlist = ""
         For i = 1 To qstrlen
            qchar = StrSub (qstr, i, 1)
            If (ItemLocate (qchar, qlist, ".") == 0) Then qlist = ItemInsert (qchar, -1, qlist, ".")
         Next
         BinaryEodSet (bbline, 0)
         BinaryPokeStr (bbline, 0, line)
         GoSub TagQuoteLine
         qtagstr = StrCat (@LF, BinaryPeekStr (bbline, 0, BinaryEodGet (bbline)), @CR)
         structlfcr = BinaryTagRepl (structlfcr, qtagstr)
      EndIf
   EndIf
EndWhile
Drop (structlfcr, line, qtagstr, qstr, qstrlen, qlist)
Drop (TagIdent, TagList)
Return
;-------------------------------------------------------------------------------
:TagQuoteLine
qcount = ItemCount (qlist, ".")
For q = 1 To qcount
   qitem = ItemExtract (q, qlist, ".")
   structqq = BinaryTagInit (bbline, qitem, qitem)
   While @TRUE
      structqq = BinaryTagFind (structqq)
      If (structqq == "") Then Break
      qstr = BinaryTagExtr (structqq, 1)
      If UseVerbose
         msgstr = StrCat (defmsgstr, @CRLF, "BufferUse bb ", 100 * BinaryEodGet (bb) / bbsize, "%%")
         msgstr = StrCat (msgstr, @CRLF, "BufferUse bbline ", 100 * BinaryEodGet (bbline) / bblinesize, "%%")
         msgstr = StrCat (msgstr, @CRLF, qstr)
         udfDisplayMsg (msgstr)
      EndIf
      locpos = ItemLocate (qstr, %TagList%, @TAB)
      If (locpos == 0)
         %TagList% = ItemInsert (qstr, -1, %TagList%, @TAB)
         qtagstr = StrCat (TagOn, TagIdent, ItemCount (%TagList%, @TAB), TagOff)
      Else
         qtagstr = StrCat (TagOn, TagIdent, locpos, TagOff)
      EndIf
      qtagstr = StrCat (qitem, qtagstr, qitem)
      structqq = BinaryTagRepl (structqq, qtagstr)
   EndWhile
Next
Drop (qcount, q, qitem, structqq, qstr, qtagstr)
Return
;-------------------------------------------------------------------------------
:TagComment
defmsgstr = StrCat (logo, "Tagging comments ...")
udfDisplayMsg (defmsgstr)

clist = ";"

TagIdent = "c"
TagList = "TagListc"
If !IsDefined (%TagList%) Then %TagList% = TagOn ; start list with a well known item

ccount = ItemCount (clist, "/")
For c = 1 To ccount
   citem = ItemExtract (c, clist, "/")
   structccr = BinaryTagInit (bb, citem, @CR)
   While @TRUE
      structccr = BinaryTagFind (structccr)
      If (structccr == "") Then Break
      cstr = BinaryTagExtr (structccr, 1)
      cstr = StrCat (citem, cstr) ; keep semicolon
      If UseVerbose
         msgstr = StrCat (defmsgstr, @CRLF, "BufferUse ", 100 * BinaryEodGet (bb) / bbsize, "%%", @CRLF, cstr)
         udfDisplayMsg (msgstr)
      EndIf
      locpos = ItemLocate (cstr, %TagList%, @TAB)
      If (locpos == 0)
         %TagList% = ItemInsert (cstr, -1, %TagList%, @TAB)
         ctagstr = StrCat (TagOn, TagIdent, ItemCount (%TagList%, @TAB), TagOff)
      Else
         ctagstr = StrCat (TagOn, TagIdent, locpos, TagOff)
      EndIf
      ctagstr = StrCat (ctagstr, @CR)
      structccr = BinaryTagRepl (structccr, ctagstr)
   EndWhile
Next
Drop (ccount, c, citem, structccr, cstr, ctagstr, clist)
Drop (TagIdent, TagList)
Return
;-------------------------------------------------------------------------------
:TagOperator
defmsgstr = StrCat (logo, "Tagging operators ...")
udfDisplayMsg (defmsgstr)

olist = "==.<=.>=.<>.!=.<.>.**.*./.+.-.&&.||.<<.>>.&.|.^.~.!.+.-.=" ; plus ".mod"
; binary(relational,arithmetic,logical),unary(integer logical,integer & float),assignment

TagIdent = "o"
TagList = "TagListo"
If !IsDefined (%TagList%) Then %TagList% = TagOn ; start list with a well known item

ocount = ItemCount (olist, ".")
For o = 1 To ocount
   ostr = ItemExtract (o, olist, ".")
   If UseVerbose
      msgstr = StrCat (defmsgstr, @CRLF, "BufferUse ", 100 * BinaryEodGet (bb) / bbsize, "%%", @CRLF, ostr)
      udfDisplayMsg (msgstr)
   EndIf
   otagstr = StrCat (TagOn, TagIdent, o, TagOff)
   BinaryReplace (bb, ostr, otagstr, @FALSE)
Next

%TagList% = olist
%TagList% = StrReplace (%TagList%, ".", @TAB)

Drop (ocount, o, ostr, otagstr, olist)
Drop (TagIdent, TagList)
Return
; special handling for mod operator!?
; the operator "mod" cannot be treated well in all cases by this part of my progam
; at this time I will treat the "mod" operator as a normal keyword
; workaround:
; WIL.CLR has an entry "[KEYWORDS]mod=1",
; change it to "[KEYWORDS]mod=Operator" and "[COLORS]Operator=rrr,ggg,bbb"
;-------------------------------------------------------------------------------
:TagBracket
defmsgstr = StrCat (logo, "Tagging brackets ...")
udfDisplayMsg (defmsgstr)

blist = "(.).[.].{.}" ; brackets

TagIdent = "b"
TagList = "TagListb"
If !IsDefined (%TagList%) Then %TagList% = TagOn ; start list with a well known item

bcount = ItemCount (blist, ".")
For b = 1 To bcount
   bstr = ItemExtract (b, blist, ".")
   If UseVerbose
      msgstr = StrCat (defmsgstr, @CRLF, "BufferUse ", 100 * BinaryEodGet (bb) / bbsize, "%%", @CRLF, bstr)
      udfDisplayMsg (msgstr)
   EndIf
   btagstr = StrCat (TagOn, TagIdent, b, TagOff)
   BinaryReplace (bb, bstr, btagstr, @FALSE)
Next

%TagList% = blist
%TagList% = StrReplace (%TagList%, ".", @TAB)

Drop (bcount, b, bstr, btagstr, blist)
Drop (TagIdent, TagList)
Return
;-------------------------------------------------------------------------------
:TagOthers
defmsgstr = StrCat (logo, "Tagging others ...")
udfDisplayMsg (defmsgstr)

mlist = " .,.@.#.::.:" ; blank,comma,ASCII-64,colon,ASCII-35 (percent sign too?)

TagIdent = "m"
TagList = "TagListm"
If !IsDefined (%TagList%) Then %TagList% = TagOn ; start list with a well known item

mcount = ItemCount (mlist, ".")
For m = 1 To mcount
   mstr = ItemExtract (m, mlist, ".")
   If UseVerbose
      msgstr = StrCat (defmsgstr, @CRLF, "BufferUse ", 100 * BinaryEodGet (bb) / bbsize, "%%", @CRLF, mstr)
      udfDisplayMsg (msgstr)
   EndIf
   mtagstr = StrCat (TagOn, TagIdent, m, TagOff)
   BinaryReplace (bb, mstr, mtagstr, @FALSE)
Next

%TagList% = mlist
%TagList% = StrReplace (%TagList%, ".", @TAB)

Drop (mcount, m, mstr, mtagstr, mlist)
Drop (TagIdent, TagList)
Return
;-------------------------------------------------------------------------------
:TagWordNumber
defmsgstr = StrCat (logo, "Tagging words and numbers ...")
udfDisplayMsg (defmsgstr)

TagIdentn = "n"
NumberList = "TagListn"
If !IsDefined (%NumberList%) Then %NumberList% = ""

TagIdentw = "w"
WordList = "TagListw"
If !IsDefined (%WordList%) Then %WordList% = ""

BinaryReplace (bb, @CRLF, StrCat (TagOn, @CRLF, TagOff), @FALSE)

structwn = BinaryTagInit (bb, TagOff, TagOn)
While @TRUE
   structwn = BinaryTagFind (structwn)
   If (structwn == "") Then Break
   wnstr = BinaryTagExtr (structwn, 1)
   If (wnstr <> "")
      If UseVerbose
         msgstr = StrCat (defmsgstr, @CRLF, "BufferUse ", 100 * BinaryEodGet (bb) / bbsize, "%%", @CRLF, wnstr)
         udfDisplayMsg (msgstr)
      EndIf
      If IsNumber (wnstr)
         locpos = ItemLocate (wnstr, %NumberList%, @TAB)
         If (locpos == 0)
            %NumberList% = ItemInsert (wnstr, -1, %NumberList%, @TAB)
            locpos = ItemCount (%NumberList%, @TAB)
         EndIf
         wntagstr = StrCat (TagOff, TagOn, TagIdentn, locpos, TagOff, TagOn)
      Else
         locpos = ItemLocate (wnstr, %WordList%, @TAB)
         If (locpos == 0)
            %WordList% = ItemInsert (wnstr, -1, %WordList%, @TAB)
            locpos = ItemCount (%WordList%, @TAB)
         EndIf
         wntagstr = StrCat (TagOff, TagOn, TagIdentw, locpos, TagOff, TagOn)
      EndIf
      structwn = BinaryTagRepl (structwn, wntagstr)
   EndIf
EndWhile
BinaryReplace (bb, StrCat (TagOn, @CRLF, TagOff), @CRLF, @FALSE)

Drop (structwn, wnstr, wntagstr)
Drop (nTagIdent, NumberList)
Drop (wTagIdent, WordList)
Return
;-------------------------------------------------------------------------------
:ColorizeWord

TagIdent = "w"
WordList = "TagListw"
wcount = ItemCount (%WordList%, @TAB)
colcount = ItemCount (colornamelist, @TAB)

; fill the lists with well known items
;For cwindex=1 to colcount
;   TagList = StrCat("TagList",TagIdent,cwindex)
;   %TagList% = ""
;   For iw=1 to wcount
;     %TagList% = ItemInsert(TagOn,-1,%TagList%,@tab)
;   Next
;Next

; fill the lists with well known items
fillitem = StrCat (TagOn, @TAB)
fillcount = (2 * wcount) - 1
For cwindex = 1 To colcount
   TagList = StrCat ("TagList", TagIdent, cwindex)
   %TagList% = StrFill (fillitem, fillcount)
Next

cdefault = ItemLocate ("default text", colornamelist, @TAB)
For iw = 1 To wcount
   wstr = ItemExtract (iw, %WordList%, @TAB)
   hoffset = BinaryHashRec (hbb, hrecsize, hkeyoffset, hkeysize, StrLower (wstr))
   hcolorname = BinaryPeekStr (hbb, hoffset + hcolornameoffset, hcolornamesize)
   If (hcolorname == "")
      BinaryPoke (hbb, hoffset, 0) ; housekeeping the hashtable
      cwindex = cdefault
   Else
      cwindex = ItemLocate (hcolorname, colornamelist, @TAB)
      Select UseCase
      Case 4
         wstr = BinaryPeekStr (hbb, hoffset + hmixcaseoffset, hmixcasesize)
      Case 3
         wstr = StrUpper (wstr)
         Break
      Case 2
         wstr = StrLower (wstr)
         Break
      Case 1
         ; wstr = wstr ; freestyle, no change
         Break
      EndSelect
   EndIf
   TagList = StrCat ("TagList", TagIdent, cwindex)
   %TagList% = ItemReplace (wstr, iw, %TagList%, @TAB)
Next

For cwindex = 1 To colcount
   TagList = StrCat ("TagList", TagIdent, cwindex)
   If (StrClean (%TagList%, StrCat (@TAB, TagOn), "", @FALSE, 1) <> "")
      colorname = ItemExtract (cwindex, colornamelist, @TAB)
      colormsgstr = StrCat (logo, "Colorizing words (", colorname, ") ...")
      GoSub ReplaceColorTag
      Drop (colormsgstr, colorname)
   EndIf
   Drop (%TagList%)
Next

Drop (iw, cwindex, colcount, wcount, cdefault, wstr, hoffset, hcolorname)
Drop (TagIdent, TagList)
Return
;-------------------------------------------------------------------------------
:ColorizeNumber
colormsgstr = StrCat (logo, "Colorizing numbers ...")
colorname = "Number"
TagIdent = "n"
TagList = "TagListn"
GoSub ReplaceColorTag
Drop (%TagList%)
Drop (colormsgstr, colorname, TagIdent, TagList)
Return
;-------------------------------------------------------------------------------
:ColorizeOthers
colormsgstr = StrCat (logo, "Colorizing others ...")
colorname = "" ; "" or "Other"
TagIdent = "m"
TagList = "TagListm"
GoSub ReplaceColorTag
Drop (%TagList%)
Drop (colormsgstr, colorname, TagIdent, TagList)
Return
;-------------------------------------------------------------------------------
:ColorizeBracket
colormsgstr = StrCat (logo, "Colorizing brackets ...")
colorname = "" ; "" or "Bracket"
TagIdent = "b"
TagList = "TagListb"
GoSub ReplaceColorTag
Drop (%TagList%)
Drop (colormsgstr, colorname, TagIdent, TagList)
Return
;-------------------------------------------------------------------------------
:ColorizeOperator
colormsgstr = StrCat (logo, "Colorizing operators ...")
colorname = "Operator"
TagIdent = "o"
TagList = "TagListo"
GoSub ReplaceColorTag
Drop (%TagList%)
Drop (colormsgstr, colorname, TagIdent, TagList)
Return
;-------------------------------------------------------------------------------
:ColorizeComment
colormsgstr = StrCat (logo, "Colorizing comments ...")
colorname = "Comment"
TagIdent = "c"
TagList = "TagListc"
GoSub ReplaceColorTag
Drop (%TagList%)
Drop (colormsgstr, colorname, TagIdent, TagList)
Return
;-------------------------------------------------------------------------------
:ColorizeQuote
colormsgstr = StrCat (logo, "Colorizing quotes ...")
colorname = "Quote"
TagIdent = "q"
TagList = "TagListq"
GoSub ReplaceColorTag
Drop (%TagList%)
Drop (colormsgstr, colorname, TagIdent, TagList)
Return
;-------------------------------------------------------------------------------
:ReplaceColorTag ; needs a TagList
udfDisplayMsg (colormsgstr)

cbo = "{" ; helper
tagcount = ItemCount (%TagList%, @TAB)
For itag = tagcount To 1 By -1
   If UseVerbose
      percent = 100 * itag / tagcount
      If ((percent mod 10) == 0)
         udfDisplayMsg (StrCat (colormsgstr, " ", percent, "%%", @CRLF, "BufferUse ", 100 * BinaryEodGet (bb) / bbsize, "%%"))
      EndIf
   EndIf
   If UseAnimation
      percent = 100 * itag / tagcount
      eod = BinaryEodGet (bb) - 1
      eodfactor = eod / tagcount
      bbbot = eodfactor * (itag - 1)
      bbtop = Min (eod - bbbot, bbbot + eodfactor)
      BoxText (StrCat (colormsgstr, " ", percent, "%%", @CRLF, BinaryPeekStr (bb, bbbot, bbtop)))
   EndIf
   htmtag = ItemExtract (itag, %TagList%, @TAB)
   If (htmtag <> TagOn)
      colorvalue = ItemExtract (ItemLocate (StrLower (colorname), colornamelist, @TAB), colorvaluelist, @TAB)
      If (colorvalue <> "")
         htmtag = StrReplace (htmdef, "%cbo%{txt}}", htmtag)
         htmtag = StrReplace (htmtag, "%cbo%{color}}", colorvalue)
      EndIf
      BinaryReplace (bb, StrCat (TagOn, TagIdent, itag, TagOff), htmtag, @FALSE)
   EndIf
Next

Drop (percent, bbbot, bbtop, eod, eodfactor)
Drop (colormsgstr, colorname, itag, tagcount, cbo, colorvalue, htmtag)
Return
;-------------------------------------------------------------------------------
:OpenReadSourceFile
udfDisplayMsg (StrCat (logo, "Reading source file ", sourcefilename))
fsize = FileSizeEx (sourcefilename)
Terminate ((fsize == 0), "Error", "Sourcefile has Filesize=0")
bbsize = fsize * 16 ; or more ? (changing plain text to html lets grow the file sometimes enormously)
bbsize = Max (8192, bbsize) ; minimum 8KB Buffer
bb = BinaryAlloc (bbsize)
bblinesize = 4096 ; or more ?
bbline = BinaryAlloc (bblinesize)
BinaryPokeStr (bb, 0, @LF) ; a little helper
BinaryPokeStr (bb, 1, @CRLF) ; a little helper
BinaryReadEx (bb, 3, sourcefilename, 0, fsize)
BinaryPokeStr (bb, BinaryEodGet (bb), @CRLF) ; a little helper
BinaryPokeStr (bb, BinaryEodGet (bb), @CR) ; a little helper
BinaryReplace (bb, @TAB, StrFill (" ", UseTabReplaceSize), @FALSE) ; CleanTabs
Return
;-------------------------------------------------------------------------------
:CalculateDelimiters
udfDisplayMsg (StrCat (logo, "Calculating delimiters ... be patient ... on file", @CRLF, sourcefilename))
teststr = "" ; create a chartable ...
For i = 1 To 31
   teststr = StrCat (teststr, Num2Char (i))
Next
For i = 129 To 255
   teststr = StrCat (teststr, Num2Char (i))
Next
teststr = StrClean (teststr, StrCat (@TAB, @CR, @LF), "", @FALSE, 1)
teststr = StrClean (teststr, BinaryPeekStr (bb, 0, BinaryEodGet (bb) - 1), "", @FALSE, 1) ; ... and delete used chars
Terminate ((StrLen (teststr) < 2), StrCat (logo, "Error"), "This special WBT sourcefile cannot be converted into HTML ('tag chars not available').")
TagOn = StrSub (teststr, 1, 1)
TagOff = StrSub (teststr, 2, 1)
Drop (teststr)
Return
;-------------------------------------------------------------------------------
:WriteCloseTargetFile
udfDisplayMsg (StrCat (logo, "Writing target file ", targetfilename))

; create small html header and footer
lt = "<" ; html tag helper
;--- read font attributes for WIL files from WinBatch Studio Registry ---
regkey = RegOpenKey (@REGCURRENT, "Software\Wilson WindowWare\WinBatch Studio\Settings\File types\WIL Files")
stylefont = ""
stylefont = StrCat (stylefont, 'font-style:', ItemExtract (RegQueryValue (regkey, "[Font Italic]") + 1, "normal/italic", "/"), '; ')
stylefont = StrCat (stylefont, 'font-family:''', RegQueryValue (regkey, "[Font name]"), '''; ')
stylefont = StrCat (stylefont, 'font-size:', RegQueryValue (regkey, "[Font size]"), 'pt; ')
stylefont = StrCat (stylefont, 'font-weight:', RegQueryValue (regkey, "[Font weight]"), '; ')
RegCloseKey (regkey)
Drop (regkey)
bgcolor = ItemExtract (ItemLocate (StrLower ("Background"), colornamelist, @TAB), colorvaluelist, @TAB)
If UseRGB Then bgcolor = StrCat ('rgb(', bgcolor, ')')
stylebgcolor = StrCat ('background-color:', bgcolor, '; ')
styleborder = 'border:1pt solid #dddddd; padding:3pt; width:100%%; '

tagpre = '%lt%pre'
tagpre = StrCat (tagpre, ' style="', stylebgcolor, styleborder, stylefont, '"')
tagpre = StrCat (tagpre, ' title="colorized by WBT2HTML"', '>')
tagcomment = StrCat ('%lt%! [', TimeYmdHms (), '] colorized html by WBT2HTML.WBT Version 1.05 (c)20010729 Detlev Dalitz -->')
header = StrCat ('%lt%html>', @CRLF, '%lt%body>', @CRLF, tagcomment, @CRLF, tagpre, @CRLF)
footer = StrCat ('%lt%/pre>', @CRLF, '%lt%/body>', @CRLF, '%lt%/html>', @CRLF)

; write the html file
BinaryEodSet (bb, BinaryEodGet (bb) - 1) ; cut little helper @cr
BinaryEodSet (bb, BinaryEodGet (bb) - 2) ; cut little helper @crlf
If (BinaryPeekStr (bb, BinaryEodGet (bb) - 2, 2) <> @CRLF) Then BinaryPokeStr (bb, BinaryEodGet (bb), @CRLF); add @crlf for sure
bbhelp = BinaryAlloc (1024)
BinaryWriteEx (bbhelp, 0, targetfilename, 0, -1) ; set new eof marker
BinaryPokeStr (bbhelp, 0, header)
BinaryWriteEx (bbhelp, 0, targetfilename, 0, BinaryEodGet (bbhelp)) ; write header
BinaryWriteEx (bb, 3, targetfilename, FileSize (targetfilename), BinaryEodGet (bb) - 3) ; write the main buffer (minus helper length)
BinaryEodSet (bbhelp, 0)
BinaryPokeStr (bbhelp, 0, footer)
BinaryWriteEx (bbhelp, 0, targetfilename, FileSize (targetfilename), BinaryEodGet (bbhelp)); write footer

; close all files
BinaryFree (bbhelp)
BinaryFree (bbline)
BinaryFree (hbb)
BinaryFree (bb)

udfDisplayMsg (StrCat (logo, "Ready."))
TimeDelay (1)
If (RtStatus () <> 10) Then BoxShut ()

Drop (footer, header, lt, stylefont, stylebgcolor, styleborder, tagpre)
Drop (tagon, tagoff, useanimation, usergb, htmdef, targetfilename, UseCase)
Drop (qstrlist, cstrlist, ostrlist, bstrlist, mstrlist, wstrlist, nstrlist)
Drop (colorvaluelist, colornamelist, i, rgbitem, colornameitem, colorfile, colorvalueitem)
Drop (hfilename, hkeysize, hcolornamesize, hmixcasesize, hrecsize, keywordlist, keywordcount)
Drop (hbbsize, hbb, keyworditem, colorcount, fsize, bbsize, bb, bbline, sourcefilename, bbb, qchar)
Drop (percent, num, bbhelp, msgstr, locpos, color)
Drop (param1, param2)
Return
;-------------------------------------------------------------------------------
:ProgInit
logo = "WBT2HTML: "
logolong = "WBT2HTML 1.05   (c)20010729 Detlev Dalitz"
If (RtStatus () <> 10) Then BoxOpen (logolong, "Be patient")
udfDisplayMsg (StrCat (logo, "Initiating ..."))

lt = "<" ; helper
cbo = "{" ; helper

If UseRGB   ; be aware if your wbt source has embedded html tags !!!
   htmdef = '%lt%font color="rgb(%cbo%{color}})">%cbo%{txt}}%lt%/font>'
Else        ; I use this tricky html tagging because I do not know other method
   ; to prevent embedded html tags from interpreting by the browser!
   htmdef = '%lt%font color="%cbo%{color}}">%cbo%{txt}}%lt%/font>'
EndIf       ; maybe a preprocessor job can do the html tag blending automagically (todo?)

If (UseAnimation && (RtStatus () == 10)) Then BoxOpen (StrCat (logolong, " // animated run //"), "Be patient")

Drop (lt, cbo) ; drop helpers
Return
;===============================================================================
:GetParams
Drop (SourceFilename, TargetFilename)
If (StrLower (FileExtension (param1)) <> "wbt")
   Message ("Error", "WBT2HTM.WBT needs a good *.WBT file as input.")
   ParamResult = @TRUE
Else
   If IsDefined (param1) Then SourceFilename = param1
   If IsDefined (param2)
      TargetFilename = StrCat (FilePath (param2), FileRoot (param2), ".htm") ; force extension
   Else
      TargetFilename = StrCat (FilePath (param1), FileRoot (param1), ".", FileExtension (param1), ".htm") ; add extension
   EndIf
   ParamResult = @FALSE
EndIf
Return
;===============================================================================
:AskParams
MyTitle = "WBT2HTML: Select File to convert from WBT to HTM"
MyFolder = "W:\WINBATCH\2001\" ; define your standard folder here
MyFiletypes = "WBT Files|*.wbt|HTML Files|*.htm;*.html|All Files|*.*|"
MyDefault = "*.wbt"
MyTool = IntControl (1004, 0, 0, 0, 0)
While @TRUE
   fname = AskFilename (MyTitle, MyFolder, MyFiletypes, MyDefault, 1)
   MyFolder = FilePath (fname)
   result = Call (MyTool, '"%fname%"')
   If (result == 0)
      newfile = StrCat (fname, ".htm")
      If (FileExist (newfile)) Then Run ("iexplore.exe", newfile)
   EndIf
EndWhile
Exit
;===============================================================================
:UserConfigurableInit ;############ user configurable area begin ###############

UseCase = 1      ; 1=freestyle
;UseCase=2     ; 2=lowercase
;UseCase=3     ; 3=uppercase
;UseCase=4     ; 4=standardcase as defined in WIL.CLR resp. as stored in hashtable

;UseRGB=@true  ; activate this line for 'font color="rgb(rrr,ggg,bbb)"'
UseRGB = @FALSE  ; activate this line for 'font color="#rrggbb"'

;UseVerbose=@true ; more screen messages
UseVerbose = @FALSE ; less screen messages

;UseAnimation=@true ; if you have time to waste and need some animation ...
UseAnimation = @FALSE

;UseAutoDelimiter=@true
UseAutoDelimiter = @FALSE
;if you set UseAutoDelimiter=@false then TagOn and TagOff must be defined manually!!!
;Otherwise unpredictable results will occur!
TagOn = Num2Char (215)
TagOff = Num2Char (208)

UseTabReplaceSize = 3 ; if there exist tabs in the source file then replace it with blanks

Return ;########################### user configurable area end #################
;===============================================================================
;===============================================================================
;===============================================================================
; syntax 1 (call by another program or start on the commandline without parameters):
; WBT2HTML.WBT
; opens an AskFilename dialog
;
; syntax2 (call or start with parameters):
; WBT2HTML.WBT sourcefilename [targetfilename]
;
; if targetfilename is omitted then sourcefilename will be used
; with added extension ".htm"
;
; example1:
; WBT2HTML.WBT mybest.wbt
; will create  mybest.wbt.htm
;
; example2:
; WBT2HTML.WBT mybest.wbt mybad.htm
; will create  mybad.htm
;
; Good luck! Viel Spass! And happy converting ...
;===============================================================================
;===============================================================================
;===============================================================================
; This was the initial idea and starting point of this program:
; <_!-- mit  Quotes, KEDIT change r §((("{[~"]@}")|('{[~']@}')|(`{[~`]@}`)))\c§<_font color="#aaaaaa">&1&2&3<_/font>§ * *             --_>
; <_!-- ohne Quotes, KEDIT change r §((({"}{[~"]@}{"})|({'}{[~']@}{'})|({`}{[~`]@}{`})))\c§<_font color="#aaaaaa">&2&5&8<_/font>§ * * --_>
;===============================================================================
;===============================================================================
;note:
;- wbt2html creates an ini file "wbt2html.ini" in winbatch system folder
;- creates a hash file "WIL.HSH" in temp folder
;- needs WIL's serial extender "wwser34i.dll"
;- html output is placed in source folder.
;===============================================================================