home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 August / PCWorld_2000-08_cd.bin / Software / TemaCD / xbasic / xbpro.exe / xb / gif.x < prev    next >
Text File  |  1999-08-16  |  45KB  |  1,464 lines
  1. '
  2. ' ####################
  3. ' #####  PROLOG  #####
  4. ' ####################
  5. '
  6. ' This is an XBasic program with functions to convert
  7. ' GIF 89a format images into BMP format and vice versa.
  8. ' This program handles the basics and you can learn the
  9. ' GIF format and see what's going on by taking the comment
  10. ' off the "print = $$TRUE" line near the beginning of the
  11. ' conversion functions.
  12. '
  13. ' This program handles 24-bit and 32-bit varieties of the
  14. ' BMP format, but not run-length encoded and maybe others.
  15. '
  16. ' XBasic is a comprehensive 32-bit compiler + IDE + GuiDesigner.
  17. ' See http://www.maxreason.com/software/xbasic/xbasic.html for
  18. ' information and download.
  19. '
  20. '
  21. PROGRAM    "gif"
  22. VERSION    "0.0083"
  23. '
  24. IMPORT    "xst"
  25. IMPORT    "xgr"
  26. IMPORT    "xui"
  27. '
  28. TYPE GifHeader                                                ' REQUIRED
  29.     STRING*3 .signature
  30.     STRING*3 .version
  31. END TYPE
  32. '
  33. TYPE GifLogicalScreenDescriptor                ' REQUIRED
  34.     UBYTE    .widthLSB
  35.     UBYTE    .widthMSB
  36.     UBYTE    .heightLSB
  37.     UBYTE    .heightMSB
  38.     UBYTE    .bitfields
  39.     UBYTE    .backgroundColorIndex
  40.     UBYTE    .pixelAspectRatio
  41. END TYPE
  42. '
  43. TYPE GifColorTableEntry                                ' global/local color tables are optional
  44.     UBYTE    .r                                                    ' red
  45.     UBYTE    .g                                                    ' green
  46.     UBYTE    .b                                                    ' blue
  47. END TYPE
  48. '
  49. TYPE GifDataBlockSize                                    ' required if image has any data blocks
  50.     UBYTE    .blockSize                                    ' 0x00 blockSize means end of data
  51. END TYPE
  52. '
  53. TYPE GifImageDescriptor                                ' required for images
  54.     UBYTE    .imageSeparator
  55.     UBYTE    .imageLeftPositionLSB
  56.     UBYTE    .imageLeftPositionMSB
  57.     UBYTE    .imageTopPositionLSB
  58.     UBYTE    .imageTopPositionMSB
  59.     UBYTE    .imageWidthLSB
  60.     UBYTE    .imageWidthMSB
  61.     UBYTE    .imageHeightLSB
  62.     UBYTE    .imageHeightMSB
  63.     UBYTE    .bitfields
  64. END TYPE
  65. '
  66. TYPE GifTableBasedImageDataHeader            ' required before 1st image block
  67.     UBYTE    .minimumCodeSize
  68. END TYPE
  69. '
  70. TYPE GifGraphicControlExtension                ' OPTIONAL
  71.     UBYTE    .extensionIntroducer
  72.     UBYTE    .graphicControlLabel
  73.     UBYTE    .blockSize
  74.     UBYTE    .bitfields
  75.     UBYTE    .delayTimeLSB
  76.     UBYTE    .delayTImeMSB
  77.     UBYTE    .transparentColorIndex
  78.     UBYTE    .blockTerminator
  79. END TYPE
  80. '
  81. TYPE GifCommentExtensionHeader                ' OPTIONAL
  82.     UBYTE    .extensionIntroducer
  83.     UBYTE    .commentLabel
  84. END TYPE
  85. '
  86. TYPE GifPlainTextExtensionHeader            ' OPTIONAL
  87.     UBYTE    .extensionIntroducer
  88.     UBYTE    .plainTextLabel
  89.     UBYTE    .blockSize
  90.     UBYTE    .textGridLeftPositionLSB
  91.     UBYTE    .textGridLeftPositionMSB
  92.     UBYTE    .textGridWidthLSB
  93.     UBYTE    .textGridWidthMSB
  94.     UBYTE    .textGridHeightLSB
  95.     UBYTE    .textGridHeightMSB
  96.     UBYTE    .characterCellWidth
  97.     UBYTE    .characterCellHeight
  98.     UBYTE    .textForegroundColorIndex
  99.     UBYTE    .textBackgroundColorIndex
  100. END TYPE
  101. '
  102. TYPE GifApplicationExtensionHeader        ' OPTIONAL
  103.     UBYTE    .extensionIntroducer
  104.     UBYTE    .extensionLabel
  105.     UBYTE    .blockSize
  106.     UBYTE    .applicationIdentifier0
  107.     UBYTE    .applicationIdentifier1
  108.     UBYTE    .applicationIdentifier2
  109.     UBYTE    .applicationIdentifier3
  110.     UBYTE    .applicationIdentifier4
  111.     UBYTE    .applicationIdentifier5
  112.     UBYTE    .applicationIdentifier6
  113.     UBYTE    .applicationIdentifier7
  114.     UBYTE    .applicationAuthenticationCode0
  115.     UBYTE    .applicationAuthenticationCode1
  116.     UBYTE    .applicationAuthenticationCode2
  117. END TYPE
  118. '
  119. TYPE GifTrailer                                                ' REQUIRED
  120.     UBYTE    .gifTrailer
  121. END TYPE
  122. '
  123. ' ***********************
  124. ' *****  FUNCTIONS  *****
  125. ' ***********************
  126. '
  127. EXPORT
  128. DECLARE FUNCTION  Gif              ()
  129. DECLARE FUNCTION  ConvertGIFToBMP  (UBYTE gif[], UBYTE bmp[])
  130. DECLARE FUNCTION  ConvertBMPToGIF  (UBYTE bmp[], UBYTE gif[])
  131. END EXPORT
  132. '
  133.     $$BI_RGB        = 0
  134.     $$BI_BITFIELDS  = 3
  135. '
  136. '
  137. ' ####################
  138. ' #####  Gif ()  #####
  139. ' ####################
  140. '
  141. FUNCTION  Gif ()
  142.     UBYTE  gif[]
  143.     UBYTE  gix[]
  144.     UBYTE  bmp[]
  145.     UBYTE  bmx[]
  146.     UBYTE  bmp0[]
  147.     UBYTE  bmp1[]
  148. '
  149. '
  150.     RETURN        ' enable this line to disable the following tests
  151. '
  152. ' get array of *.gif filenames
  153. '
  154.     print = $$TRUE
  155.     path$ = "/xb/xxx/"
  156.     XstGetFiles (path$ + "*.gif", @giffile$[])        ' GIF images
  157.     XstGetFiles (path$ + "*.bmp", @bmpfile$[])        ' BMP images
  158.     ubmpfile = UBOUND (bmpfile$[])
  159.     ugiffile = UBOUND (giffile$[])
  160.     IF print THEN PRINT ubmpfile, ugiffile
  161.     count = 0
  162.     grid = 0
  163. '
  164. '
  165. ' display BMP images in path$
  166. '
  167.     FOR i = 0 TO ubmpfile                            ' for all BMP files
  168.         ifile$ = path$ + bmpfile$[i]        ' BMP path/filename
  169.         ifile = OPEN (ifile$, $$RD)            ' open BMP file
  170.         IF (ifile < 3) THEN DO NEXT            ' did not open
  171.         ofile$ = STRING$(i) + ".gif"        ' say what?
  172.         IF print THEN PRINT i, ifile$, ofile$
  173.         error = ERROR (0)                                ' reset error
  174.         IF error THEN DO NEXT                        ' but skip this file
  175. '
  176.         bytes = LOF (ifile)                            ' size of BMP file in bytes
  177.         upper = bytes - 1                                ' upper element in array of UBYTEs
  178.         DIM bmp[upper]                                    ' create UBYTE array for BMP image
  179. '
  180.         READ [ifile], bmp[]                            ' read the whole BMP file
  181.         CLOSE (ifile)                                        ' close the BMP file
  182. '
  183.         error = ERROR (0)                                ' error in READ ???
  184.         IF error THEN DO NEXT                        ' READ did not work
  185.         IFZ bmp[] THEN DO NEXT                    ' no BMP image ???
  186. '
  187.         ConvertBMPToGIF (@bmp[], @gif[])    ' convert BMP image to GIF image
  188.         IFZ gif[] THEN DO NEXT                        ' if no GIF image then error
  189. '
  190.         DIM bmx[]                                                    ' empty bmx[]
  191.         ConvertGIFToBMP (@gif[], @bmx[])    ' convert GIF back to BMP image
  192.         IFZ bmx[] THEN DO NEXT                        ' didn't work
  193. '
  194.         ofile = OPEN (ofile$, $$WRNEW)    ' create file to hold GIF image
  195.         IF (ofile < 3) THEN RETURN            ' open error
  196.         error = ERROR (0)                                ' error ???
  197. '
  198.         WRITE [ofile], gif[]                        ' save GIF image in file
  199.         CLOSE (ofile)                                        ' close output GIF file
  200. '
  201.         GOSUB DisplayImage                            ' display in window
  202.         DIM bmp[]                                                ' done with image
  203.         DIM gif[]                                                ' done with image
  204.     NEXT i
  205. '
  206. '
  207. ' display GIF images in path$
  208. '
  209.     FOR i = 0 TO ugiffile                            ' for all GIF files
  210.         ifile$ = path$ + giffile$[i]        ' GIF path/filename
  211.         ifile = OPEN (ifile$, $$RD)            ' open GIF file
  212.         IF (ifile < 3) THEN DO NEXT            ' did not open
  213.         ofile$ = STRING$(i) + ".bmp"        ' say what?
  214.         IF print THEN PRINT i, ifile$, ofile$
  215.         error = ERROR (0)                                ' reset error
  216.         IF error THEN DO NEXT                        ' but skip this file
  217. '
  218.         bytes = LOF (ifile)                            ' size of GIF file in bytes
  219.         upper = bytes - 1                                ' upper element in array of UBYTEs
  220.         DIM gif[upper]                                    ' create UBYTE array for GIF image
  221. '
  222.         READ [ifile], gif[]                            ' read the whole GIF file
  223.         CLOSE (ifile)                                        ' close the GIF file
  224. '
  225.         error = ERROR (0)                                ' error in READ ???
  226.         IF error THEN DO NEXT                        ' READ did not work
  227.         IFZ gif[] THEN DO NEXT                    ' no GIF image ???
  228. '
  229.         ConvertGIFToBMP (@gif[], @bmp[])    ' convert GIF image to BMP image
  230.         IFZ bmp[] THEN DO NEXT                        ' if no BMP image then error
  231. '
  232.         DIM gix[]                                                    ' empty gix[]
  233.         ConvertBMPToGIF (@bmp[], @gix[])    ' convert back to GIF
  234.         IFZ gix[] THEN DO NEXT                        ' didn't work
  235. '
  236.         ofile = OPEN (ofile$, $$WRNEW)    ' create file to hold BMP image
  237.         IF (ofile < 3) THEN RETURN            ' open error
  238.         error = ERROR (0)                                ' error ???
  239. '
  240.         WRITE [ofile], bmp[]                        ' save BMP image in file
  241.         CLOSE (ofile)                                        ' close output BMP file
  242. '
  243.         GOSUB DisplayImage                            ' display in window
  244.         DIM bmp[]                                                ' done with image
  245.         DIM gif[]                                                ' done with image
  246.     NEXT i
  247.     RETURN
  248. '
  249. '
  250. ' ******************************
  251. ' *****  SUB DisplayImage  *****
  252. ' ******************************
  253. '
  254. SUB DisplayImage
  255.     IFZ error THEN
  256.         XgrGetDisplaySize ("", @displayWidth, @displayHeight, @windowBorderWidth, @windowTitleHeight)
  257.         XgrGetImageArrayInfo (@bmp[], @bbp, @width, @height)
  258.         x = (displayWidth - width) >> 1
  259.         y = (displayHeight - height) >> 1
  260.         IF (x < windowBorderWidth) THEN x = windowBorderWidth
  261.         IF (y < (windowTitleHeight+windowBorderWidth)) THEN y = windowBorderWidth+windowTitleHeight
  262.         PRINT RJUST$(STRING$(bytes),6); " : "; RJUST$(STRING$(width),4); ","; RJUST$(STRING$(height),4); " : "; ifile$
  263.         IF grid THEN
  264.             XuiSendStringMessage (grid, @"DestroyWindow", 0, 0, 0, 0, 0, 0)
  265.             grid = 0
  266.         END IF
  267.         IF grid THEN
  268.             XuiSendStringMessage (grid, @"ResizeWindow", x, y, width, height, 0, 0)
  269.         ELSE
  270.             XuiCreateWindow (@grid, @"XuiLabel", x, y, width, height, $$WindowTypeNoFrame, "")
  271.             XuiSendStringMessage (grid, @"DisplayWindow", 0, 0, 0, 0, 0, 0)
  272.             XgrClearGrid (grid, $$LightRed)
  273.         END IF
  274.         XgrSetImage (grid, @bmp[])
  275.         DIM bmp[]
  276.     END IF
  277.     XstSleep (250)
  278.     IF grid THEN
  279.         XuiSendStringMessage (grid, @"DestroyWindow", 0, 0, 0, 0, 0, 0)
  280.         grid = 0
  281.     END IF
  282. END SUB
  283. END FUNCTION
  284. '
  285. '
  286. ' ################################
  287. ' #####  ConvertGIFToBMP ()  #####
  288. ' ################################
  289. '
  290. FUNCTION  ConvertGIFToBMP (UBYTE gif[], UBYTE bmp[])
  291.     SHARED  GifColorTableEntry  colorTable[]
  292.     AUTO  USHORT  bitmask[]
  293.     AUTO  GifHeader  gifHeader
  294.     AUTO  GifLogicalScreenDescriptor  gifLogicalScreenDescriptor
  295.     AUTO  GifImageDescriptor  gifImageDescriptor
  296.     AUTO  UBYTE  raw[]
  297.     AUTO  code$[]
  298. '
  299.     DIM bmp[]
  300.     IFZ gif[] THEN RETURN
  301.     ugif = UBOUND (gif[])
  302.     IF (ugif < 32) THEN RETURN
  303. '
  304.     GOSUB Initialize
  305. '
  306.     gifaddr = &gif[]
  307.     error = $$FALSE
  308. '    print = $$TRUE
  309. '
  310.     IFZ error THEN
  311.         GOSUB GetGifHeader
  312.         IF print THEN GOSUB PrintGifHeader
  313.     END IF
  314. '
  315.     IFZ error THEN
  316.         GOSUB GetGifLogicalScreenDescriptor
  317.         IF print THEN GOSUB PrintGifLogicalScreenDescriptor
  318.     END IF
  319. '
  320.     IFZ error THEN
  321.         IF colorTableFlag THEN
  322.             IF colorsInColorTable THEN
  323.                 GOSUB GetGifColorTable
  324.                 IF print THEN GOSUB PrintGifColorTable
  325.             END IF
  326.         END IF
  327.     END IF
  328. '
  329.     IFZ error THEN
  330.         GOSUB GetGifImageDescriptor
  331.         IF print THEN GOSUB PrintGifImageDescriptor
  332.         IF (imageSeparator != 0x2C) THEN error = $$TRUE
  333.     END IF
  334. '
  335.     IFZ error THEN
  336.         IF colorTableFlag THEN
  337.             IF colorsInColorTable THEN
  338.                 GOSUB GetGifColorTable
  339.                 IF print THEN GOSUB PrintGifColorTable
  340.             END IF
  341.         END IF
  342.     END IF
  343. '
  344.     dataOffset = 128
  345.     bmpheight = imageHeight
  346.     bmpwidth = (imageWidth + 3) AND -4        ' room for mod 4 pixel width
  347.     bmpline = bmpwidth * 3
  348.     bmpsize = dataOffset + (bmpheight * bmpline)
  349.     pixels = imageWidth * imageHeight
  350.     uraw = UBOUND (gif[])
  351.     ubmp = bmpsize - 1
  352. '
  353.     IF error THEN RETURN
  354. '
  355.     raw = 0
  356.     DIM raw[uraw]
  357.     DIM bmp[ubmp]
  358.     rawaddr = &raw[]
  359.     DIM code$[4095]
  360.     GOSUB FillBitmapHeader
  361. '
  362. '    GOSUB CreateTestWindow
  363. '
  364.     IFZ error THEN
  365.         IF colorTableFlag THEN
  366.             IF colorsInColorTable THEN
  367.                 GOSUB GetGifColorTable
  368.                 IF print THEN GOSUB PrintGifColorTable
  369.             END IF
  370.         END IF
  371.     END IF
  372. '
  373.     IFZ error THEN
  374.         GOSUB GetGifMinimumCodeSize
  375.         IF print THEN GOSUB PrintGifMinimumCodeSize
  376.     END IF
  377. '
  378. '        PRINT HEX$ (addr,8)
  379. '        PRINT HEX$ (daddr,8); RJUST$(STRING$(daddr-addr),6)
  380. '        PRINT HEX$ (bmpaddr,8); RJUST$(STRING$(bmpaddr-addr),6)
  381. '        PRINT HEX$ (uaddr,8); RJUST$(STRING$(uaddr-addr),6)
  382. '
  383.     IFZ error THEN
  384.         GOSUB GetGifImage
  385.         GOSUB DrawGifImage
  386.     END IF
  387. '
  388. '    PRINT HEX$ (addr,8)
  389. '    PRINT HEX$ (daddr,8); RJUST$(STRING$(daddr-addr),6)
  390. '    PRINT HEX$ (bmpaddr,8); RJUST$(STRING$(bmpaddr-addr),6)
  391. '    PRINT HEX$ (uaddr,8); RJUST$(STRING$(uaddr-addr),6)
  392. '
  393.     RETURN
  394. '
  395. '
  396. '
  397. ' *****  FillBitmapHeader  *****
  398. '
  399. SUB FillBitmapHeader
  400.     addr = &bmp[]                                                ' header
  401.     uaddr = addr + ubmp                                    ' upper
  402.     daddr = addr + dataOffset                        ' fixed
  403.     bmpaddr = addr + dataOffset                    ' moves
  404. '
  405.     UBYTEAT (addr, 0) = 'B'                            ' signature
  406.     UBYTEAT (addr, 1) = 'M'                            ' signature
  407.     XLONGAT (addr, 2) = bmpsize                    ' bytes in array
  408.     XLONGAT (addr, 10) = dataOffset            ' from beginning of array
  409. '
  410.     iaddr = addr + 14                                        ' info header address
  411.     XLONGAT (iaddr, 0) = 40                            ' bytes in this sub-header
  412.     XLONGAT (iaddr, 4) = bmpwidth                ' in pixels
  413.     XLONGAT (iaddr, 8) = bmpheight            ' in pixels
  414.     USHORTAT (iaddr, 12) = 1                        ' 1 image plane
  415.     USHORTAT (iaddr, 14) = 24                        ' bits per pixel
  416.     XLONGAT (iaddr, 16) = $$BI_RGB            ' 24-bit indicator
  417. '
  418.     caddr = iaddr + 40                                    ' color header address
  419. '    XLONGAT (caddr, 0) = 0xFFC00000            ' 32-bit color only
  420. '    XLONGAT (caddr, 4) = 0x003FF800            ' 32-bit color only
  421. '    XLONGAT (caddr, 8) = 0x000007FF            ' 32-bit color only
  422. END SUB
  423. '
  424. SUB CreateTestWindow
  425.     width = imageWidth
  426.     height = imageHeight
  427.     XgrGetDisplaySize ("", @displayWidth, @displayHeight, @windowBorderWidth, @windowTitleHeight)
  428.     x = (displayWidth - width) >> 1
  429.     y = (displayHeight - height) >> 1
  430.     IF (x < windowBorderWidth) THEN x = windowBorderWidth
  431.     IF (y < (windowTitleHeight+windowBorderWidth)) THEN y = windowBorderWidth+windowTitleHeight
  432.     XuiCreateWindow (@grid, @"XuiLabel", 700, 23, width, height, 0, "")
  433.     XuiSendStringMessage (grid, @"DisplayWindow", 0, 0, 0, 0, 0, 0)
  434.     XgrProcessMessages (-2)
  435.     XgrClearGrid (grid, $$DarkGrey)
  436. END SUB
  437. '
  438. SUB GetGifHeader
  439.     XstCopyMemory (gifaddr, &gifHeader, 6)
  440.     gifaddr = gifaddr + 6
  441. END SUB
  442. '
  443. SUB PrintGifHeader
  444.     PRINT
  445.     PRINT "GifHeader.signature                             = "; RJUST$("\"" + gifHeader.signature + "\"", 8); " : must be \"GIF\""
  446.     PRINT "GifHeader.version                               = "; RJUST$("\"" + gifHeader.version + "\"", 8); " : must be \"89a\""
  447. END SUB
  448. '
  449. SUB GetGifLogicalScreenDescriptor
  450.     XstCopyMemory (gifaddr, &gifLogicalScreenDescriptor, 7)
  451.     gifaddr = gifaddr + 7
  452. '
  453.     screenWidth = (gifLogicalScreenDescriptor.widthMSB << 8) OR gifLogicalScreenDescriptor.widthLSB
  454.     screenHeight = (gifLogicalScreenDescriptor.heightMSB << 8) OR gifLogicalScreenDescriptor.heightLSB
  455.     backgroundColorIndex = gifLogicalScreenDescriptor.backgroundColorIndex
  456.     pixelAspectRatio = gifLogicalScreenDescriptor.pixelAspectRatio
  457. '
  458.     bitfields = gifLogicalScreenDescriptor.bitfields
  459.     colorTableFlag = (bitfields AND 0x80) >> 7
  460.     colorResolution = (bitfields AND 0x70) >> 4
  461.     sortFlag = (bitfields AND 0x08) >> 3
  462.     sizeOfColorTable = bitfields AND 0x07
  463.     colorsInColorTable = 0x01 << (sizeOfColorTable + 1)
  464.     bytesInColorTable = 3 * colorsInColorTable
  465. END SUB
  466. '
  467. SUB PrintGifLogicalScreenDescriptor
  468.     PRINT
  469.     PRINT "GifLogicalScreenDescriptor.width                = "; RJUST$(HEX$(gifLogicalScreenDescriptor.widthLSB OR (gifLogicalScreenDescriptor.widthMSB << 8),4),8); " : image width in pixels"
  470.     PRINT "GifLogicalScreenDescriptor.height               = "; RJUST$(HEX$(gifLogicalScreenDescriptor.heightLSB OR (gifLogicalScreenDescriptor.heightMSB << 8),4),8); " : image height in pixels"
  471.     PRINT "GifLogicalScreenDescriptor.bitfields            = "; BIN$(gifLogicalScreenDescriptor.bitfields,8); " : 1,3,1,3 bit fields ...)"
  472.     PRINT "   .bitfields.globalColorTableFlag              = "; BIN$(colorTableFlag,1); "        = "; : IF (colorTableFlag) THEN PRINT "TRUE" ELSE PRINT "FALSE"
  473.     PRINT "   .bitfields.colorResolution                   =  "; BIN$(colorResolution,3); "     = "; STRING$(colorResolution+1); " bits per primary color"
  474.     PRINT "   .bitfields.sortFlag                          =     "; BIN$(sortFlag, 1); "    = "; IF sortFlag THEN PRINT "TRUE" ELSE PRINT "FALSE"
  475.     PRINT "   .bitfields.sizeOfGlobalColorTable            =      "; BIN$(sizeOfColorTable, 3); " = "; STRING$(bytesInColorTable); " bytes in global color table"
  476.     PRINT "              colorsInColorTable                =          : "; STRING$(colorsInColorTable)
  477.     PRINT "              bytesInColorTable                 =          : "; STRING$(bytesInColorTable)
  478.     PRINT "GifLogicalScreenDescriptor.backgroundColorIndex = "; RJUST$(HEX$(gifLogicalScreenDescriptor.backgroundColorIndex,2),8)
  479.     PRINT "GifLogicalScreenDescriptor.pixelAspectRatio     = "; RJUST$(HEX$(gifLogicalScreenDescriptor.pixelAspectRatio,2),8)
  480. END SUB
  481. '
  482. SUB GetGifColorTable
  483.     upper = colorsInColorTable - 1
  484.     DIM colorTable[upper]
  485. '
  486.     FOR i = 0 TO upper
  487.         XstCopyMemory (gifaddr, &colorTable[i], 3)
  488.         gifaddr = gifaddr + 3
  489.     NEXT i
  490. END SUB
  491. '
  492. SUB PrintGifColorTable
  493.     upper = UBOUND (colorTable[])
  494. '
  495.     PRINT
  496.     FOR i = 0 TO upper
  497.         r = colorTable[i].r
  498.         g = colorTable[i].g
  499.         b = colorTable[i].b
  500. '        PRINT "color "; HEX$(i,4); " : RGB = "; HEX$(r,2); "."; HEX$(g,2); "."; HEX$(b,2)
  501.     NEXT i
  502. END SUB
  503. '
  504. SUB GetGifImageDescriptor
  505.     XstCopyMemory (gifaddr, &gifImageDescriptor, 10)
  506.     gifaddr = gifaddr + 10
  507. '
  508.     imageSeparator = gifImageDescriptor.imageSeparator
  509.     imageLeftPosition = gifImageDescriptor.imageLeftPositionLSB OR (gifImageDescriptor.imageLeftPositionMSB << 8)
  510.     imageTopPosition = gifImageDescriptor.imageTopPositionLSB OR (gifImageDescriptor.imageTopPositionMSB << 8)
  511.     imageWidth = gifImageDescriptor.imageWidthLSB OR (gifImageDescriptor.imageWidthMSB << 8)
  512.     imageHeight = gifImageDescriptor.imageHeightLSB OR (gifImageDescriptor.imageHeightMSB << 8)
  513.     bitfields = gifImageDescriptor.bitfields
  514. '
  515.     colorTableFlag = (bitfields AND 0x80) >> 7
  516.     interlaceFlag = (bitfields AND 0x40) >> 6
  517.     sortFlag = (bitfields AND 0x20) >> 5
  518.     reserved = (bitfields AND 0x18) >> 3
  519.     sizeOfColorTable = bitfields AND 0x07
  520.     colorsInColorTable = 0x01 << (sizeOfColorTable + 1)
  521.     bytesInColorTable = 3 * colorsInColorTable
  522. END SUB
  523. '
  524. SUB PrintGifImageDescriptor
  525.     PRINT
  526.     PRINT "GifImageDescriptor.imageSeparator               = "; RJUST$(HEX$(imageSeparator,2),8); " : must be 2C"
  527.     PRINT "GifImageDescriptor.imageLeftPosition            = "; RJUST$(HEX$(imageLeftPosition,4),8); " = "; STRING$(imageLeftPosition)
  528.     PRINT "GifImageDescriptor.imageTopPosition             = "; RJUST$(HEX$(imageTopPosition,4),8); " = "; STRING$(imageTopPosition)
  529.     PRINT "GifImageDescriptor.imageWidth                   = "; RJUST$(HEX$(imageWidth,4),8); " = "; STRING$(imageWidth)
  530.     PRINT "GifImageDescriptor.imageHeight                  = "; RJUST$(HEX$(imageHeight,4),8); " = "; STRING$(imageHeight)
  531.     PRINT "GifImageDescriptor.bitfields                    = "; BIN$(bitfields,8)
  532.     PRINT "   .bitfields.colorTableFlag                    = "; BIN$(colorTableFlag,1)
  533.     PRINT "   .bitfields.interlaceFlag                     =  "; BIN$(interlaceFlag,1)
  534.     PRINT "   .bitfields.sortFlag                          =   "; BIN$(sortFlag,1)
  535.     PRINT "   .bitfields.reserved                          =    "; BIN$(reserved,2)
  536.     PRINT "   .bitfields.sizeOfColorTable                  =      "; BIN$(sizeOfColorTable,3)
  537.     PRINT "              colorsInColorTable                =          : "; STRING$(colorsInColorTable)
  538.     PRINT "              bytesInColorTable                 =          : "; STRING$(bytesInColorTable)
  539. END SUB
  540. '
  541. SUB GetGifMinimumCodeSize
  542.     minimumCodeSize = UBYTEAT (gifaddr)
  543.     gifaddr = gifaddr + 1
  544. END SUB
  545. '
  546. SUB PrintGifMinimumCodeSize
  547.     PRINT
  548.     PRINT "GifMinimumCodeSize                              = "; RJUST$(HEX$(minimumCodeSize,2),8)
  549. END SUB
  550. '
  551. SUB GetGifImage
  552.     DO
  553.         blockSize = UBYTEAT (gifaddr)
  554.         gifaddr = gifaddr + 1
  555. '
  556.         IF blockSize THEN
  557.             XstCopyMemory (gifaddr, rawaddr, blockSize)
  558.             gifaddr = gifaddr + blockSize
  559.             rawaddr = rawaddr + blockSize
  560.             raw = raw + blockSize
  561.         END IF
  562.     LOOP WHILE blockSize
  563. END SUB
  564. '
  565. SUB DrawGifImage
  566.     pass = 0
  567.     offbit = 0
  568.     offbyte = 0
  569.     bits = minimumCodeSize + 1
  570.     clearCode = 1 << minimumCodeSize
  571.     terminateCode = clearCode + 1
  572.     maximumValue = clearCode - 1
  573.     widthCode = clearCode << 1
  574. '
  575.     FOR i = 0 TO clearCode-1
  576.         code$[i] = CHR$(i)
  577.     NEXT i
  578. '
  579.     x = 0
  580.     y = 0
  581. '
  582.     char$ = ""
  583.     slot = 130
  584.     done = $$FALSE
  585. '
  586.     GOSUB GetNewCode
  587.     IF (new != clearCode) THEN STOP
  588.     GOSUB ClearCode
  589. '
  590.     DO
  591.         GOSUB GetNewCode
  592.         terminate = $$FALSE
  593.         IF ((offbyte + 3) >= uraw) THEN EXIT SUB
  594.         SELECT CASE TRUE
  595.             CASE (new = clearCode)            : GOSUB ClearCode
  596.             CASE (new = terminateCode)    : IF print THEN PRINT "terminateCode"
  597.                                                                         EXIT DO
  598.             CASE ELSE                                        :    string$ = code$[new]
  599.                                                                         IFZ string$ THEN string$ = code$[old] + char$
  600.                                                                         GOSUB DrawString
  601.                                                                         IFZ terminate THEN
  602.                                                                             char$ = CHR$(string${0})
  603.                                                                             IF (slot > UBOUND(code$[])) THEN EXIT SUB
  604.                                                                             code$[slot] = code$[old] + char$
  605.                                                                             old = new
  606.                                                                             INC slot
  607.                                                                             IF (slot >= widthCode) THEN
  608.                                                                                 IF print THEN PRINT HEX$(offbyte,8); " tableFull : bits = "; RJUST$(STRING$(bits),2); " to "; RJUST$(STRING$(bits+1),2); " : slot = "; RJUST$(STRING$(slot-1),2); " to "; RJUST$(STRING$(slot),2)
  609.                                                                                 IF (bits < 12) THEN
  610.                                                                                     widthCode = widthCode << 1
  611.                                                                                     INC bits
  612.                                                                                 END IF
  613.                                                                             END IF
  614.                                                                         END IF
  615.         END SELECT
  616.     LOOP UNTIL terminate
  617. END SUB
  618. '
  619. SUB GetNewCode
  620.     offbyte = offbit >> 3
  621.     bitaddr = offbit AND 0x07
  622.     IF ((offbyte + 3) >= uraw) THEN EXIT SUB
  623.     new = raw[offbyte] OR (raw[offbyte+1] << 8) OR (raw[offbyte+2] << 16 OR raw[offbyte+3] << 24)
  624.     new = new >> bitaddr
  625.     new = new AND bitmask[bits]
  626.     offbit = offbit + bits
  627.     IF (offbyte >= uraw) THEN STOP
  628. END SUB
  629. '
  630. SUB ClearCode
  631.     oldbits = bits
  632.     slot = terminateCode + 1
  633.     REDIM code$[clearCode-1]
  634.     bits = minimumCodeSize + 1
  635.     widthCode = clearCode << 1
  636.     REDIM code$[4095]
  637.     IF print THEN PRINT HEX$(offbyte,8); " clearCode : bits = "; RJUST$(STRING$(oldbits),2); " to "; RJUST$(STRING$(bits),2); " : slot = "; RJUST$(STRING$(slot),2)
  638.     GOSUB GetNewCode
  639.     string$ = code$[new]
  640.     GOSUB DrawString
  641. '    char$ = CHR$(string${0})                                                                    ' old
  642.     IF string$ THEN    char$ = CHR$(string${0}) ELSE char$ = ""    ' new
  643.     old = new
  644. END SUB
  645. '
  646. SUB DrawString
  647.     u = UBOUND (string$)
  648. '
  649.     FOR n = 0 TO u
  650.         pixel = string${n}
  651.         r = colorTable[pixel].r
  652.         g = colorTable[pixel].g
  653.         b = colorTable[pixel].b
  654. '
  655. ' try to color adjust does not work as desired
  656. '
  657. '        IF (b < 0x80) THEN b = b + b >> 2
  658. '        IF (g < 0x80) THEN g = g + g >> 2
  659. '        IF (r < 0x80) THEN r = r + r >> 2
  660. '
  661.         color = (r << 24) OR (g << 16) OR (b << 8)
  662. '
  663.         IF bmp[] THEN
  664.             IFZ x THEN
  665.                 bmpy = bmpheight - y - 1                    ' y in bitmap - inverted
  666.                 bmp0 = daddr + (bmpy * bmpline)        ' address of 1st pixel on line
  667.                 bmpaddr = bmp0
  668. '
  669. ' added to catch disasterous error - fixed in v0.0082
  670. '
  671.                 xlasty = y
  672.                 xlastbmpline = bmpline
  673.                 IF ((bmpaddr < daddr) OR (bmpaddr > uaddr)) THEN
  674.                     IF print THEN PRINT HEX$(bmpaddr,8);; HEX$(daddr,8);; HEX$(uaddr,8);; HEX$(bmp0,8);; bmpy;; bmpheight;; bmpline;; xlastbmpline;; xlasty;; imageWidth;; imageHeight
  675.                     terminate = $$TRUE
  676.                     EXIT SUB
  677.                 END IF
  678.             END IF
  679. '
  680. '
  681. '
  682.             UBYTEAT (bmpaddr) = b    : INC bmpaddr
  683.             UBYTEAT (bmpaddr) = g    : INC bmpaddr
  684.             UBYTEAT (bmpaddr) = r    : INC bmpaddr
  685. '
  686. ' the following makes no difference
  687. '
  688. '            XgrConvertRGBToColor (r << 8 OR r, g << 8 OR g, b << 8 OR b, @kolor)
  689. '            XgrConvertColorToRGB (kolor, @red, @green, @blue)
  690. '            UBYTEAT (bmpaddr) = blue >> 8        : INC bmpaddr
  691. '            UBYTEAT (bmpaddr) = green >> 8    : INC bmpaddr
  692. '            UBYTEAT (bmpaddr) = red >> 8        : INC bmpaddr
  693. '
  694.         END IF
  695. '
  696. '        IF grid THEN XgrDrawPoint (grid, color, x, y)
  697. '        IF image THEN XgrDrawPoint (image, color, x, y)
  698. '
  699.         INC x
  700.         IF (x >= imageWidth) THEN
  701.             x = 0
  702.             IFZ interlaceFlag THEN
  703.                 y = y + 1
  704.             ELSE
  705.                 SELECT CASE pass
  706.                     CASE 0        : y = y + 8
  707.                     CASE 1        : y = y + 8
  708.                     CASE 2        : y = y + 4
  709.                     CASE 3        : y = y + 2
  710.                     CASE ELSE    : STOP
  711.                 END SELECT
  712.             END IF
  713.         END IF
  714. '
  715.         IF (y >= imageHeight) THEN
  716.             INC pass
  717.             IFZ interlaceFlag THEN
  718.                 y = y + 1
  719.             ELSE
  720.                 SELECT CASE pass
  721.                     CASE 1        : y = 4
  722.                     CASE 2        : y = 2
  723.                     CASE 3        : y = 1
  724.                     CASE ELSE    : INC y            ' past end of image
  725.                 END SELECT
  726.                 IF (y >= imageHeight) THEN
  727.                     IF print THEN PRINT HEX$(bmpaddr,8);; HEX$(daddr,8);; HEX$(bmp0,8);; bmpy;; bmpheight;; bmpline;; xlastbmpline;; xlasty;; imageWidth;; imageHeight
  728.                     terminate = $$TRUE
  729.                     EXIT FOR
  730.                 END IF
  731.             END IF
  732.         END IF
  733.     NEXT n
  734. '    XgrProcessMessages (-2)
  735. END SUB
  736. '
  737. '
  738. ' *****  Initialize  *****
  739. '
  740. SUB Initialize
  741.     DIM bitmask[31]
  742.     bitmask[ 0] = 0x00000000
  743.     bitmask[ 1] = 0x00000001
  744.     bitmask[ 2] = 0x00000003
  745.     bitmask[ 3] = 0x00000007
  746.     bitmask[ 4] = 0x0000000F
  747.     bitmask[ 5] = 0x0000001F
  748.     bitmask[ 6] = 0x0000003F
  749.     bitmask[ 7] = 0x0000007F
  750.     bitmask[ 8] = 0x000000FF
  751.     bitmask[ 9] = 0x000001FF
  752.     bitmask[10] = 0x000003FF
  753.     bitmask[11] = 0x000007FF
  754.     bitmask[12] = 0x00000FFF
  755.     bitmask[13] = 0x00001FFF
  756.     bitmask[14] = 0x00003FFF
  757.     bitmask[15] = 0x00007FFF
  758.     bitmask[16] = 0x0000FFFF
  759.     bitmask[17] = 0x0001FFFF
  760.     bitmask[18] = 0x0003FFFF
  761.     bitmask[19] = 0x0007FFFF
  762.     bitmask[20] = 0x000FFFFF
  763.     bitmask[21] = 0x001FFFFF
  764.     bitmask[22] = 0x003FFFFF
  765.     bitmask[23] = 0x007FFFFF
  766.     bitmask[24] = 0x00FFFFFF
  767.     bitmask[25] = 0x01FFFFFF
  768.     bitmask[26] = 0x03FFFFFF
  769.     bitmask[27] = 0x07FFFFFF
  770.     bitmask[28] = 0x0FFFFFFF
  771.     bitmask[29] = 0x1FFFFFFF
  772.     bitmask[30] = 0x3FFFFFFF
  773.     bitmask[31] = 0x7FFFFFFF
  774. END SUB
  775. END FUNCTION
  776. '
  777. '
  778. ' ################################
  779. ' #####  ConvertBMPToGIF ()  #####
  780. ' ################################
  781. '
  782. FUNCTION  ConvertBMPToGIF (UBYTE bmp[], UBYTE gif[])
  783.     SHARED  GifColorTableEntry  colorTable[]
  784.     AUTO  USHORT  bitmask[]
  785.     AUTO  GifHeader  gifHeader
  786.     AUTO  GifLogicalScreenDescriptor  gifLogicalScreenDescriptor
  787.     AUTO  GifImageDescriptor  gifImageDescriptor
  788.     AUTO  USHORT  h[]
  789.     AUTO  USHORT  hx[]
  790.     AUTO  USHORT  hash[]
  791.     AUTO  UBYTE  gdata[]
  792.     AUTO  code$[]
  793. '
  794.     DIM gif[]
  795.     IFZ bmp[] THEN RETURN
  796.     ubmp = UBOUND (bmp[])
  797.     IF (ubmp < 64) THEN RETURN
  798. '
  799.     GOSUB Initialize
  800. '
  801.     bmpaddr = &bmp[]
  802.     error = $$FALSE
  803. '    print = $$TRUE
  804. '
  805.     haddr = bmpaddr                                            ' header address
  806. '
  807. ' get 'BM' signature
  808. '
  809.     hoff = 0
  810.     h0 = UBYTEAT (haddr, 0)
  811.     h1 = UBYTEAT (haddr, 1)
  812.     h0 = bmp[hoff+0]
  813.     h1 = bmp[hoff+1]
  814. '
  815.     IF ((h0 != 'B') OR (h1 != 'M')) THEN
  816.         error = ($$ErrorObjectImage << 8) OR $$ErrorNatureInvalidFormat
  817.         old = ERROR (error)
  818.         DIM gif[]
  819.         RETURN ($$TRUE)
  820.     END IF
  821. '
  822.     IF print THEN PRINT " signature      =       "; CHR$(h0); CHR$(h1)
  823. '
  824. ' get bitmap file size in bytes
  825. '
  826.     h2 = UBYTEAT (haddr, 2)
  827.     h3 = UBYTEAT (haddr, 3)
  828.     h4 = UBYTEAT (haddr, 4)
  829.     h5 = UBYTEAT (haddr, 5)
  830.     h2 = bmp[hoff+2]
  831.     h3 = bmp[hoff+3]
  832.     h4 = bmp[hoff+4]
  833.     h5 = bmp[hoff+5]
  834. '
  835.     bmpsize = (h5 << 24) OR (h4 << 16) OR (h3 << 8) OR h2
  836.     IF print THEN PRINT " BMP file size  = "; RJUST$(STRING$(bmpsize),8)
  837. '
  838. ' get offset from beginning of file to beginning of data
  839. '
  840.     h10 = UBYTEAT (haddr, 10)
  841.     h11 = UBYTEAT (haddr, 11)
  842.     h12 = UBYTEAT (haddr, 12)
  843.     h13 = UBYTEAT (haddr, 13)
  844.     h10 = bmp[hoff+10]
  845.     h11 = bmp[hoff+11]
  846.     h12 = bmp[hoff+12]
  847.     h13 = bmp[hoff+13]
  848. '
  849.     dataOffset = (h13 << 24) OR (h12 << 16) OR (h11 << 8) OR h10
  850.     IF print THEN PRINT " data offset    = "; RJUST$(STRING$(dataOffset),8)
  851. '
  852. ' get info header size
  853. '
  854.     ioff = 14
  855.     iaddr = haddr + 14
  856.     i0 = UBYTEAT (iaddr, 0)
  857.     i1 = UBYTEAT (iaddr, 1)
  858.     i2 = UBYTEAT (iaddr, 2)
  859.     i3 = UBYTEAT (iaddr, 3)
  860.     i0 = bmp[ioff+0]
  861.     i1 = bmp[ioff+1]
  862.     i2 = bmp[ioff+2]
  863.     i3 = bmp[ioff+3]
  864. '
  865.     infoBytes = (i3 << 24) OR (i2 << 16) OR (i1 << 8) OR i0
  866.     IF print THEN PRINT " info bytes     = "; RJUST$(STRING$(infoBytes),8)
  867. '
  868.     i4 = UBYTEAT (iaddr, 4)
  869.     i5 = UBYTEAT (iaddr, 5)
  870.     i6 = UBYTEAT (iaddr, 6)
  871.     i7 = UBYTEAT (iaddr, 7)
  872.     i4 = bmp[ioff+4]
  873.     i5 = bmp[ioff+5]
  874.     i6 = bmp[ioff+6]
  875.     i7 = bmp[ioff+7]
  876. '
  877.     width = (i7 << 24) OR (i6 << 16) OR (i5 << 8) OR i4
  878.     IF print THEN PRINT " image width    = "; RJUST$(STRING$(width),8)
  879. '
  880.     i8 = UBYTEAT (iaddr, 8)
  881.     i9 = UBYTEAT (iaddr, 9)
  882.     i10 = UBYTEAT (iaddr, 10)
  883.     i11 = UBYTEAT (iaddr, 11)
  884.     i8 = bmp[ioff+8]
  885.     i9 = bmp[ioff+9]
  886.     i10 = bmp[ioff+10]
  887.     i11 = bmp[ioff+11]
  888. '
  889.     height = (i11 << 24) OR (i10 << 16) OR (i9 << 8) OR i8
  890.     IF print THEN PRINT " image height   = "; RJUST$(STRING$(height),8)
  891. '
  892.     i12 = UBYTEAT (iaddr, 12)
  893.     i13 = UBYTEAT (iaddr, 13)
  894.     i14 = UBYTEAT (iaddr, 14)
  895.     i15 = UBYTEAT (iaddr, 15)
  896.     i12 = bmp[ioff+12]
  897.     i13 = bmp[ioff+13]
  898.     i14 = bmp[ioff+14]
  899.     i15 = bmp[ioff+15]
  900. '
  901.     im$ = ""
  902.     planes = (i13 << 8) OR i12
  903.     bitsPerPixel = (i15 << 8) OR i14
  904.     IF (bitsPerPixel < 24) THEN im$ = " not supported"
  905.     IF print THEN PRINT " planes         = "; RJUST$(STRING$(planes),8)
  906.     IF print THEN PRINT " bits per pixel = "; RJUST$(STRING$(bitsPerPixel),8); im$
  907. '
  908.     i16 = UBYTEAT (iaddr, 16)
  909.     i17 = UBYTEAT (iaddr, 17)
  910.     i18 = UBYTEAT (iaddr, 18)
  911.     i19 = UBYTEAT (iaddr, 19)
  912.     i16 = bmp[ioff+16]
  913.     i17 = bmp[ioff+17]
  914.     i18 = bmp[ioff+18]
  915.     i19 = bmp[ioff+19]
  916. '
  917.     imageMode = (i19 << 24) OR (i18 << 16) OR (i17 << 8) OR i16
  918.     IF print THEN
  919.         SELECT CASE imageMode
  920.             CASE 0    : im$ = "BI_RGB"
  921.             CASE 1    : im$ = "BI_RLE8 = run-length encoded : not supported"
  922.             CASE 2    : im$ = "BI_RLE4 = run-length encoded : not supported"
  923.             CASE 3    : im$ = "BI_BITFIELDS"
  924.             CASE 4    : im$ = "not recognized"
  925.         END SELECT
  926.         PRINT " image mode     = "; HEX$(imageMode,8); " = "; im$
  927.     END IF
  928. '
  929.     coff = ioff + infoBytes
  930.     caddr = iaddr + infoBytes
  931.     c0 = UBYTEAT (caddr, 0)
  932.     c1 = UBYTEAT (caddr, 1)
  933.     c2 = UBYTEAT (caddr, 2)
  934.     c3 = UBYTEAT (caddr, 3)
  935.     c0 = bmp[coff+0]
  936.     c1 = bmp[coff+1]
  937.     c2 = bmp[coff+2]
  938.     c3 = bmp[coff+3]
  939. '
  940.     rbits = (c3 << 24) OR (c2 << 16) OR (c1 << 8) OR c0
  941.     IF print THEN PRINT " R bits         = "; HEX$(rbits,8)
  942. '
  943.     c4 = UBYTEAT (caddr, 4)
  944.     c5 = UBYTEAT (caddr, 5)
  945.     c6 = UBYTEAT (caddr, 6)
  946.     c7 = UBYTEAT (caddr, 7)
  947.     c4 = bmp[coff+4]
  948.     c5 = bmp[coff+5]
  949.     c6 = bmp[coff+6]
  950.     c7 = bmp[coff+7]
  951. '
  952. '    gbits = (c3 << 24) OR (c2 << 16) OR (c1 << 8) OR c0
  953.     gbits = (c7 << 24) OR (c6 << 16) OR (c5 << 8) OR c4
  954.     IF print THEN PRINT " G bits         = "; HEX$(gbits,8)
  955. '
  956.     c8 = UBYTEAT (caddr, 8)
  957.     c9 = UBYTEAT (caddr, 9)
  958.     c10 = UBYTEAT (caddr, 10)
  959.     c11 = UBYTEAT (caddr, 11)
  960.     c8 = bmp[coff+8]
  961.     c9 = bmp[coff+9]
  962.     c10 = bmp[coff+10]
  963.     c11 = bmp[coff+11]
  964. '
  965. '    bbits = (c3 << 24) OR (c2 << 16) OR (c1 << 8) OR c0
  966.     bbits = (c11 << 24) OR (c10 << 16) OR (c9 << 8) OR c8
  967.     IF print THEN PRINT " B bits         = "; HEX$(bbits,8)
  968. '
  969.     IF (width <= 0) THEN RETURN ($$TRUE)
  970.     IF (height <= 0) THEN RETURN ($$TRUE)
  971.     IF (bitsPerPixel <= 0) THEN RETURN ($$TRUE)
  972.     IF (bitsPerPixel < 24) THEN RETURN ($$TRUE)
  973. '
  974.     DIM gif[ubmp+4095]
  975.     ugif = ubmp+4095
  976.     gaddr = &gif[]
  977. '
  978. ' gif header - signature and version
  979. '
  980.     UBYTEAT (gaddr, 0) = 'G'                                                ' GIF signature
  981.     UBYTEAT (gaddr, 1) = 'I'
  982.     UBYTEAT (gaddr, 2) = 'F'
  983.     UBYTEAT (gaddr, 3) = '8'                                                ' GIF version
  984.     UBYTEAT (gaddr, 4) = '9'
  985.     UBYTEAT (gaddr, 5) = 'a'
  986. '
  987. ' gif logical screen descriptor
  988. '
  989.     UBYTEAT (gaddr, 6) = width AND 0x00FF                        ' width LSB
  990.     UBYTEAT (gaddr, 7) = (width >> 8) AND 0x00FF        ' width MSB
  991.     UBYTEAT (gaddr, 8) = height AND 0x00FF                    ' height LSB
  992.     UBYTEAT (gaddr, 9) = (height >> 8) AND 0x00FF        ' height MSB
  993. '
  994.     UBYTEAT (gaddr,10) = 0xF6                ' 0x80 mask            ' 1 = colorTableFlag
  995.                                                                     ' 0x70 mask            ' 7 = colorResolution
  996.                                                                     ' 0x08 mask            ' 0 = sortFlag
  997.                                                                     ' 0x07 mask            ' 6 = sizeOfColorTable
  998.     UBYTEAT (gaddr,11) = 0x00                                                ' backgroundColorIndex
  999.     UBYTEAT (gaddr,12) = 0x00                                                ' pixelAspectRatio
  1000. '
  1001. '
  1002. '
  1003. ' *****  gif color palette  *****  first add standard 125 colors
  1004. '
  1005.     nextpalette = 0
  1006.     caddr = gaddr + 13
  1007.     palette = gaddr + 13
  1008. '
  1009. '    FOR color = 0 TO 124
  1010. '        XgrConvertColorToRGB (color, @r, @g, @b)
  1011. '        UBYTEAT (caddr) = (r >> 8) AND 0x00FF    : INC caddr
  1012. '        UBYTEAT (caddr) = (g >> 8) AND 0x00FF    : INC caddr
  1013. '        UBYTEAT (caddr) = (b >> 8) AND 0x00FF    : INC caddr
  1014. '    NEXT color
  1015. '
  1016. '
  1017. ' *****  gif color palette  ***** - undefined colors to fill 128 colors
  1018. '
  1019. '    FOR color = 125 TO 127
  1020. '        UBYTEAT (caddr) = 0x00    : INC caddr
  1021. '        UBYTEAT (caddr) = 0x00    : INC caddr
  1022. '        UBYTEAT (caddr) = 0x00    : INC caddr
  1023. '    NEXT color
  1024. '
  1025. '
  1026. ' *****  TEMPORARY FOR DEBUGGING  -  ORIGINAL PALETTE  *****
  1027. '
  1028. '    xaddr = palette
  1029. '    FOR color = 0 TO 127
  1030. '        UBYTEAT (xaddr) = colorTable[color].r    : INC xaddr
  1031. '        UBYTEAT (xaddr) = colorTable[color].g    : INC xaddr
  1032. '        UBYTEAT (xaddr) = colorTable[color].b    : INC xaddr
  1033. '    NEXT color
  1034. '
  1035. ' *****  gif image descriptor  *****
  1036. '
  1037.     addr = palette + 128 + 128 + 128                                            ' 128 RGBs
  1038.     UBYTEAT (addr) = 0x2C                                            : INC addr    ' image separator
  1039.     UBYTEAT (addr) = 0x00                                            : INC addr    ' image left LSB
  1040.     UBYTEAT (addr) = 0x00                                            : INC addr    ' image left MSB
  1041.     UBYTEAT (addr) = 0x00                                            : INC addr    ' image top LSB
  1042.     UBYTEAT (addr) = 0x00                                            : INC addr    ' image top MSB
  1043.     UBYTEAT (addr) = width AND 0x00FF                    : INC addr    ' width LSB
  1044.     UBYTEAT (addr) = (width >> 8) AND 0x00FF    : INC addr    ' width MSB
  1045.     UBYTEAT (addr) = height AND 0x00FF                : INC addr    ' height LSB
  1046.     UBYTEAT (addr) = (height >> 8) AND 0x00FF    : INC addr    ' height MSB
  1047.     UBYTEAT (addr) = 0x46                                            : INC addr    ' bitfields
  1048.                                                                                         ' 0x80 mask    ' colorTableFlag
  1049.                                                                                         ' 0x40 mask    ' interlaceFlag
  1050.                                                                                         ' 0x20 mask    ' sortFlag
  1051.                                                                                         ' 0x18 mask    ' reserved
  1052.                                                                                         ' 0x07 mask    ' sizeOfColorTable
  1053. '
  1054. ' *****  gif image data  *****
  1055. '
  1056. ' interlace    : pass 1 = every 8th scan line starting at 0
  1057. '                        : pass 2 = every 8th scan line starting at 4
  1058. '                        : pass 3 = every 4th scan line starting at 2
  1059. '                        : pass 4 = every 2nd scan line starting at 1
  1060. '
  1061. ' 1st byte of data is bits in starting color table codes - 0x00 to 0x7F
  1062. '
  1063.     UBYTEAT (addr) = 0x07                    : INC addr        ' minimumCodeSize
  1064. '
  1065. ' addressing in gif image is bitwise because the index elements
  1066. ' put in the image grow/vary between 8,9,10,11,12 bits wide.
  1067. '
  1068.     xoffbyte = addr - gaddr    ' byte offset in gif[]
  1069.     xoffbit = offbyte << 3    ' bit offset in gif[]
  1070. '
  1071. ' *****  initialize index code array  *****
  1072. '
  1073.     DIM code$[4095]                    ' maximum 12-bit index
  1074. '
  1075.     FOR i = 0 TO 127
  1076.         code$[i] = CHR$(i)        ' indices 0 to 127 mean the values themselves
  1077.     NEXT i
  1078. '
  1079.     clearCode = 128                    ' clear code$[] code
  1080.     terminateCode = 129            ' terminate image code
  1081.     slot = 130                            ' first available index
  1082. '
  1083.     DIM gdata[ugif]                    ' collect data in gdata[]
  1084.     offbyte = 0                            ' start at beginning
  1085.     offbit = 0                            '    ditto
  1086. '
  1087. '
  1088. ' read image data from BMP image and put in GIF image data area
  1089. '
  1090.     xmod = ((width * 3) + 3) AND -4                        ' bytes per BMP scan line
  1091.     ibase = haddr + dataOffset                                ' address of bmp image
  1092.     bsize = xmod * height                                            ' bytes in BMP image
  1093.     zbase = ibase + bsize                                            ' address after bmp image
  1094.     addr = zbase - xmod                                                ' top scan line
  1095.     pixelbytes = 3                                                        ' 3 bytes per pixel
  1096.     past = 0x0100                                                            ' past 8-bit indexes
  1097.     pass = 1                                                                    ' pass 1 - begin the show
  1098.     yinc = 8                                                                    ' pass 1 - 8 line interlace
  1099.     done = 0                                                                    ' not done image conversion
  1100.     bits = 8                                                                    ' start with 8-bit indices
  1101.     y = 0                                                                            ' pass 1 - start at the top
  1102.     x = 0                                                                            ' start at left edge
  1103. '
  1104. ' startup code to reduce overhead in normal loops
  1105. '
  1106.     string = 0x80                                                            ' initial clearCode
  1107.     GOSUB OutputCode                                                    ' put in data stream
  1108.     IF print THEN PRINT HEX$(addr,8), x, y, done
  1109. '
  1110.     GOSUB GetNextIndex                                                ' next pixel color table index
  1111.     string$ = CHR$ (index)                                        ' 1st index character
  1112.     string = index                                                        ' string code
  1113.     INC x                                                                            ' 2nd pixel
  1114. '
  1115.     DO
  1116. '        old = string                                                        ' may need old code
  1117. '        old$ = string$                                                    ' may need old string
  1118.         GOSUB GetNextIndex                                            ' next pixel color table index
  1119.         index$ = CHR$ (index)                                        ' next index character
  1120. '        IF (index > 127) THEN STOP                            ' idiot check - remove
  1121. '        IF (index < 0) THEN STOP                                ' idiot check - remove
  1122.         string$ = string$ + index$                            ' possible next string$
  1123. '
  1124.         found = 0                                                                ' string not found yet
  1125.         uhash = UBOUND (string$)                                ' initial hash value
  1126.         hash = hx[uhash AND 0x00FF]
  1127. '
  1128.         FOR i = 0 TO uhash
  1129.             hash = hash + hx[string${i}]
  1130.         NEXT i
  1131.         hash = hash AND 0x00000FFF
  1132. '
  1133.         IF hash[hash,] THEN
  1134.             FOR i = 0 TO UBOUND(hash[hash,])
  1135.                 s = hash[hash,i]
  1136.                 IFZ s THEN EXIT FOR
  1137.                 IF (string$ = code$[s]) THEN
  1138.                     string = s
  1139.                     found = s
  1140.                     EXIT FOR
  1141.                 END IF
  1142.             NEXT i
  1143.         END IF
  1144. '
  1145. '        FOR i = 130 TO slot-1                                        ' for all code strings
  1146. '            IF (string$ = code$[i]) THEN                    ' string already in table?
  1147. '                string = i                                                    ' string code in table
  1148. '                found = i                                                        '
  1149. '                EXIT FOR                                                        '
  1150. '            END IF                                                                '
  1151. '        NEXT i                                                                    '
  1152. '
  1153.         IFZ found THEN
  1154.             GOSUB OutputStringCode                                ' output string code
  1155.             string$ = index$                                            ' new string is index
  1156.             string = index                                                ' ditto
  1157.         END IF
  1158. '
  1159.         INC x                                                                        ' next horizontal pixel
  1160.         IF (x >= width) THEN                                        ' time for new scan line
  1161.             SELECT CASE pass
  1162.                 CASE    1        : y = y + 8
  1163.                 CASE    2        : y = y + 8
  1164.                 CASE    3        : y = y + 4
  1165.                 CASE    4        : y = y + 2
  1166.                 CASE ELSE    : STOP
  1167.             END SELECT
  1168.             x = 0
  1169.             IF (y >= height) THEN
  1170.                 SELECT CASE pass
  1171.                     CASE 1        : y = 4
  1172.                     CASE 2        : y = 2
  1173.                     CASE 3        : y = 1
  1174.                     CASE 4        : done = $$TRUE
  1175.                     CASE ELSE    : STOP
  1176.                 END SELECT
  1177.                 INC pass
  1178.             END IF
  1179.             addr = zbase - (xmod * (y+1))                    ' address of bmp scan line
  1180.             ooooo = offbit >> 3
  1181.             IF print THEN PRINT HEX$(addr,8), HEX$(ooooo, 8), RJUST$(STRING$(ooooo),4), x, y, done
  1182.         END IF
  1183.     LOOP UNTIL done
  1184. '
  1185.     GOSUB OutputCode
  1186. '
  1187.     index = terminateCode
  1188.     GOSUB OutputCode
  1189. '
  1190.     index = 0x3B
  1191.     GOSUB OutputCode
  1192. '
  1193. ' transfer GIF image-data into GIF image
  1194. '
  1195.     offbit = offbit + 32
  1196.     offbyte = offbit >> 3
  1197. '
  1198.     offgif = xoffbyte
  1199.     offdata = 0
  1200. '
  1201.     DO
  1202.         IF (offbyte >= 255) THEN
  1203.             offbyte = offbyte - 255
  1204.             length = 255
  1205.         ELSE
  1206.             length = offbyte
  1207.             offbyte = 0
  1208.         END IF
  1209. '
  1210.         gif[offgif] = length    : INC offgif
  1211. '
  1212.         FOR i = 0 TO length-1
  1213.             gif[offgif] = gdata[offdata]    : INC offgif : INC offdata
  1214.         NEXT i
  1215.     LOOP WHILE offbyte
  1216. '
  1217.     REDIM gif[offgif-1]
  1218. '
  1219.     RETURN ($$FALSE)
  1220. '
  1221. '
  1222. '
  1223. ' *****  GetNextIndex  *****
  1224. '
  1225. SUB GetNextIndex
  1226.     b = UBYTEAT (addr)    : INC addr                        ' blue byte
  1227.     g = UBYTEAT (addr)    : INC addr                        ' green byte
  1228.     r = UBYTEAT (addr)    : INC addr                        ' red byte
  1229. '
  1230.     error = 0x7FFFFFFF
  1231. '
  1232.     c = palette
  1233.     FOR p = 0 TO nextpalette-1                                ' for all palette colors
  1234.         rr = UBYTEAT (c)    : INC c                                ' palette red
  1235.         gg = UBYTEAT (c)    : INC c                                ' palette green
  1236.         bb = UBYTEAT (c)    : INC c                                ' palette blue
  1237. '
  1238.         cerror = ABS(r-rr)+ABS(g-gg)+ABS(b-bb)    ' color error
  1239. '
  1240.         IFZ cerror THEN
  1241.             error = 0
  1242.             index = p
  1243.             EXIT FOR
  1244.         END IF
  1245.  
  1246.         i = b + g + r                                                        ' pixel intensity
  1247.         ii = rr + gg + bb                                                ' palette intensity
  1248.         ierror = ABS(i-ii)                                            ' intensity error
  1249.         terror = cerror + ierror                                ' total error is sum
  1250. '
  1251.         IF (terror < error) THEN                                '
  1252.             error = terror                                                ' new smallest error
  1253.             index = p                                                            ' new palette index
  1254.         END IF
  1255.     NEXT p
  1256. '
  1257. ' if no perfect color match, add new color to palette if room
  1258. '
  1259.     IF error THEN
  1260.         IF (nextpalette < 128) THEN
  1261.             UBYTEAT (caddr) = r : INC caddr
  1262.             UBYTEAT (caddr) = g : INC caddr
  1263.             UBYTEAT (caddr) = b : INC caddr
  1264.             index = nextpalette
  1265.             INC nextpalette
  1266.         END IF
  1267.     END IF
  1268. END SUB
  1269. '
  1270. '
  1271. ' *****  OutputStringCode  *****
  1272. '
  1273. SUB OutputStringCode
  1274.     IF (slot > past) THEN
  1275.         past = past << 1
  1276.         INC bits
  1277.     END IF
  1278. '
  1279.     GOSUB OutputCode
  1280. '
  1281.     IF (slot = 4095) THEN
  1282.         IF print THEN PRINT "table full - issue a clear code : "; STRING$(bits);; STRING$(slot);; STRING$(y);; STRING$(x)
  1283.         temp = string
  1284.         string = clearCode
  1285.         GOSUB OutputCode
  1286.         DIM hash[]
  1287.         DIM hash[4095,]
  1288.         REDIM code$[127]
  1289.         REDIM code$[4095]
  1290.         past = 0x0100
  1291.         slot = 130
  1292.         bits = 8
  1293.     ELSE
  1294.         GOSUB AddStringToHashTable
  1295.         code$[slot] = string$
  1296.         INC slot
  1297.     END IF
  1298. END SUB
  1299. '
  1300. SUB AddStringToHashTable
  1301.     uhash = UBOUND (string$)                                ' initial hash value
  1302.     hash = hx[uhash AND 0x00FF]
  1303.     FOR off = 0 TO uhash
  1304.         hash = hash + hx[string${off}]
  1305.     NEXT off
  1306.     hash = hash AND 0x00000FFF
  1307. '
  1308.     IFZ hash[hash,] THEN
  1309.         DIM h[7]
  1310.         empty = 0
  1311.         h[empty] = slot
  1312.         ATTACH h[] TO hash[hash,]
  1313.     ELSE
  1314.         empty = -1
  1315.         ATTACH hash[hash,] TO h[]
  1316.         FOR e = 0 TO UBOUND (h[])
  1317.             IFZ h[e] THEN
  1318.                 empty = e
  1319.                 EXIT FOR
  1320.             END IF
  1321.         NEXT e
  1322.         IF (empty < 0) THEN
  1323.             u = UBOUND (h[])
  1324.             empty = u + 1
  1325.             REDIM h[u+8]
  1326.             h[empty] = slot
  1327.         ELSE
  1328.             h[empty] = slot
  1329.         END IF
  1330.         ATTACH h[] TO hash[hash,]
  1331.     END IF
  1332. '    PRINT hash, empty, u
  1333. END SUB
  1334. '
  1335. SUB OutputCode
  1336.     offbyte = offbit >> 3
  1337.     bitaddr = offbit AND 0x07
  1338. '
  1339.     old0 = gdata[offbyte]
  1340.     old1 = gdata[offbyte+1]
  1341.     old2 = gdata[offbyte+2]
  1342. '
  1343.     new0 = (string << bitaddr) AND 0x000000FF
  1344.     new1 = (string >> (8-bitaddr)) AND 0x000000FF
  1345.     new2 = (string >> (16-bitaddr)) AND 0x000000FF
  1346. '
  1347.     IF (old0 AND new0) THEN STOP            ' algorithm error
  1348.     IF (old1 AND new1) THEN STOP            ' algorithm error
  1349.     IF (old2 AND new2) THEN STOP            ' algorithm error
  1350. '
  1351.     offbit = offbit + bits
  1352.     gdata[offbyte] = old0 OR new0
  1353.     gdata[offbyte+1] = old1 OR new1
  1354.     gdata[offbyte+2] = old2 OR new2
  1355. END SUB
  1356. '
  1357. '
  1358. ' *****  Initialize  *****
  1359. '
  1360. SUB Initialize
  1361.     DIM hx[255]
  1362.     DIM hash[4095,]
  1363.     DIM bitmask[31]
  1364.     bitmask[ 0] = 0x00000000
  1365.     bitmask[ 1] = 0x00000001
  1366.     bitmask[ 2] = 0x00000003
  1367.     bitmask[ 3] = 0x00000007
  1368.     bitmask[ 4] = 0x0000000F
  1369.     bitmask[ 5] = 0x0000001F
  1370.     bitmask[ 6] = 0x0000003F
  1371.     bitmask[ 7] = 0x0000007F
  1372.     bitmask[ 8] = 0x000000FF
  1373.     bitmask[ 9] = 0x000001FF
  1374.     bitmask[10] = 0x000003FF
  1375.     bitmask[11] = 0x000007FF
  1376.     bitmask[12] = 0x00000FFF
  1377.     bitmask[13] = 0x00001FFF
  1378.     bitmask[14] = 0x00003FFF
  1379.     bitmask[15] = 0x00007FFF
  1380.     bitmask[16] = 0x0000FFFF
  1381.     bitmask[17] = 0x0001FFFF
  1382.     bitmask[18] = 0x0003FFFF
  1383.     bitmask[19] = 0x0007FFFF
  1384.     bitmask[20] = 0x000FFFFF
  1385.     bitmask[21] = 0x001FFFFF
  1386.     bitmask[22] = 0x003FFFFF
  1387.     bitmask[23] = 0x007FFFFF
  1388.     bitmask[24] = 0x00FFFFFF
  1389.     bitmask[25] = 0x01FFFFFF
  1390.     bitmask[26] = 0x03FFFFFF
  1391.     bitmask[27] = 0x07FFFFFF
  1392.     bitmask[28] = 0x0FFFFFFF
  1393.     bitmask[29] = 0x1FFFFFFF
  1394.     bitmask[30] = 0x3FFFFFFF
  1395.     bitmask[31] = 0x7FFFFFFF
  1396. '
  1397.     hx[  0] = 0xF3C9:    hx[ 64] = 0x811D:    hx[128] = 0x199C:    hx[192] = 0xD0C8
  1398.     hx[  1] = 0xE034:    hx[ 65] = 0xC6E3:    hx[129] = 0x1299:    hx[193] = 0x3C07
  1399.     hx[  2] = 0xB37C:    hx[ 66] = 0xCA5D:    hx[130] = 0xA314:    hx[194] = 0xDDCA
  1400.     hx[  3] = 0x4E31:    hx[ 67] = 0x5AF2:    hx[131] = 0xEF45:    hx[195] = 0xB2C1
  1401.     hx[  4] = 0xC0DE:    hx[ 68] = 0xB2F3:    hx[132] = 0xEFC3:    hx[196] = 0x6A7C
  1402.     hx[  5] = 0x2487:    hx[ 69] = 0xCF28:    hx[133] = 0x8A2D:    hx[197] = 0x5E02
  1403.     hx[  6] = 0x98E2:    hx[ 70] = 0x4714:    hx[134] = 0x2553:    hx[198] = 0x4C8B
  1404.     hx[  7] = 0x557C:    hx[ 71] = 0x32B0:    hx[135] = 0x8CA6:    hx[199] = 0x6652
  1405.     hx[  8] = 0xA6CB:    hx[ 72] = 0x9A76:    hx[136] = 0x60B8:    hx[200] = 0x3C50
  1406.     hx[  9] = 0x410D:    hx[ 73] = 0xB2A4:    hx[137] = 0x2192:    hx[201] = 0x02B8
  1407.     hx[ 10] = 0x7767:    hx[ 74] = 0xDE9B:    hx[138] = 0xA15C:    hx[202] = 0x7B70
  1408.     hx[ 11] = 0x3861:    hx[ 75] = 0xE0E1:    hx[139] = 0xA527:    hx[203] = 0x118F
  1409.     hx[ 12] = 0x5517:    hx[ 76] = 0xA7C3:    hx[140] = 0x1FAC:    hx[204] = 0xEF65
  1410.     hx[ 13] = 0x0918:    hx[ 77] = 0x0E48:    hx[141] = 0xC554:    hx[205] = 0x3D6E
  1411.     hx[ 14] = 0xF3AF:    hx[ 78] = 0xFABE:    hx[142] = 0x5ECB:    hx[206] = 0xCAB2
  1412.     hx[ 15] = 0x2EAB:    hx[ 79] = 0xE351:    hx[143] = 0x7941:    hx[207] = 0x23F0
  1413.     hx[ 16] = 0x210D:    hx[ 80] = 0x4419:    hx[144] = 0x3EA2:    hx[208] = 0x927F
  1414.     hx[ 17] = 0xDF19:    hx[ 81] = 0x5AB4:    hx[145] = 0xE73D:    hx[209] = 0x1F12
  1415.     hx[ 18] = 0x2F0B:    hx[ 82] = 0xDDF9:    hx[146] = 0xDE62:    hx[210] = 0xEDCE
  1416.     hx[ 19] = 0x269A:    hx[ 83] = 0x513E:    hx[147] = 0x9FFA:    hx[211] = 0x0D52
  1417.     hx[ 20] = 0xE171:    hx[ 84] = 0x1BDF:    hx[148] = 0x0CE8:    hx[212] = 0x69B5
  1418.     hx[ 21] = 0x8D07:    hx[ 85] = 0xA0BC:    hx[149] = 0x8683:    hx[213] = 0x9DC4
  1419.     hx[ 22] = 0x0AF1:    hx[ 86] = 0xC2E5:    hx[150] = 0x481C:    hx[214] = 0x910F
  1420.     hx[ 23] = 0x4627:    hx[ 87] = 0x5917:    hx[151] = 0x80E4:    hx[215] = 0xEE6D
  1421.     hx[ 24] = 0x7C4B:    hx[ 88] = 0x0448:    hx[152] = 0xC43E:    hx[216] = 0xA0E7
  1422.     hx[ 25] = 0xA59A:    hx[ 89] = 0xE110:    hx[153] = 0x7830:    hx[217] = 0xF2ED
  1423.     hx[ 26] = 0x561F:    hx[ 90] = 0xA4C8:    hx[154] = 0x3952:    hx[218] = 0x6EA2
  1424.     hx[ 27] = 0x1F90:    hx[ 91] = 0x5BC6:    hx[155] = 0x2BBA:    hx[219] = 0xFEFC
  1425.     hx[ 28] = 0x9407:    hx[ 92] = 0x1250:    hx[156] = 0x476D:    hx[220] = 0x0A20
  1426.     hx[ 29] = 0xAAAA:    hx[ 93] = 0x3D09:    hx[157] = 0xF307:    hx[221] = 0xA568
  1427.     hx[ 30] = 0x404B:    hx[ 94] = 0xD230:    hx[158] = 0x5A6A:    hx[222] = 0xB90E
  1428.     hx[ 31] = 0xCCB2:    hx[ 95] = 0x19F1:    hx[159] = 0x232A:    hx[223] = 0xFA26
  1429.     hx[ 32] = 0xB6B8:    hx[ 96] = 0x28D0:    hx[160] = 0x36DA:    hx[224] = 0xFB8E
  1430.     hx[ 33] = 0x93E5:    hx[ 97] = 0x0FD7:    hx[161] = 0x1448:    hx[225] = 0x3091
  1431.     hx[ 34] = 0xCD83:    hx[ 98] = 0x79BD:    hx[162] = 0x016A:    hx[226] = 0x56A1
  1432.     hx[ 35] = 0x8392:    hx[ 99] = 0xE856:    hx[163] = 0xF0CC:    hx[227] = 0x184A
  1433.     hx[ 36] = 0x951B:    hx[100] = 0xDDDE:    hx[164] = 0x5328:    hx[228] = 0xDEC0
  1434.     hx[ 37] = 0x983F:    hx[101] = 0xBD28:    hx[165] = 0x8B83:    hx[229] = 0xC39F
  1435.     hx[ 38] = 0x1BB3:    hx[102] = 0xD9F7:    hx[166] = 0x1566:    hx[230] = 0xBED3
  1436.     hx[ 39] = 0x40A7:    hx[103] = 0xCBB9:    hx[167] = 0xB0D3:    hx[231] = 0x51F5
  1437.     hx[ 40] = 0x5D7E:    hx[104] = 0x9B85:    hx[168] = 0xCE2F:    hx[232] = 0xC0E9
  1438.     hx[ 41] = 0x65A1:    hx[105] = 0x82DC:    hx[169] = 0x30FA:    hx[233] = 0x617B
  1439.     hx[ 42] = 0x8576:    hx[106] = 0x67B0:    hx[170] = 0x49C6:    hx[234] = 0xF6E9
  1440.     hx[ 43] = 0xAC39:    hx[107] = 0x8720:    hx[171] = 0x94D9:    hx[235] = 0x9775
  1441.     hx[ 44] = 0xFE04:    hx[108] = 0x0CDF:    hx[172] = 0xE69B:    hx[236] = 0xD5A5
  1442.     hx[ 45] = 0x6C6F:    hx[109] = 0xA884:    hx[173] = 0x7B2C:    hx[237] = 0xF7D3
  1443.     hx[ 46] = 0x838F:    hx[110] = 0x238D:    hx[174] = 0x340B:    hx[238] = 0x2BD5
  1444.     hx[ 47] = 0xDA44:    hx[111] = 0xACED:    hx[175] = 0x2E46:    hx[239] = 0xBB3D
  1445.     hx[ 48] = 0x7B93:    hx[112] = 0x773B:    hx[176] = 0xFD83:    hx[240] = 0x1483
  1446.     hx[ 49] = 0x851E:    hx[113] = 0x84F1:    hx[177] = 0xB1A9:    hx[241] = 0x5906
  1447.     hx[ 50] = 0xD23F:    hx[114] = 0xB1A6:    hx[178] = 0x6F78:    hx[242] = 0x6D25
  1448.     hx[ 51] = 0x1F47:    hx[115] = 0x049F:    hx[179] = 0xF3FE:    hx[243] = 0x0BEE
  1449.     hx[ 52] = 0x7C74:    hx[116] = 0x8B30:    hx[180] = 0x387B:    hx[244] = 0xE76B
  1450.     hx[ 53] = 0xBF9D:    hx[117] = 0xB545:    hx[181] = 0xCCC2:    hx[245] = 0x6751
  1451.     hx[ 54] = 0x7646:    hx[118] = 0x48EC:    hx[182] = 0x762C:    hx[246] = 0x2A06
  1452.     hx[ 55] = 0xC9FF:    hx[119] = 0xF885:    hx[183] = 0x603E:    hx[247] = 0x49E3
  1453.     hx[ 56] = 0x7944:    hx[120] = 0x3985:    hx[184] = 0x02F9:    hx[248] = 0x9854
  1454.     hx[ 57] = 0x953D:    hx[121] = 0x3D6A:    hx[185] = 0x3F51:    hx[249] = 0x11F4
  1455.     hx[ 58] = 0xE666:    hx[122] = 0x6871:    hx[186] = 0x6C2E:    hx[250] = 0xA655
  1456.     hx[ 59] = 0xB2DA:    hx[123] = 0x2F08:    hx[187] = 0x0777:    hx[251] = 0x742F
  1457.     hx[ 60] = 0x743C:    hx[124] = 0x94DE:    hx[188] = 0xE456:    hx[252] = 0x8C19
  1458.     hx[ 61] = 0xDB99:    hx[125] = 0x4CA5:    hx[189] = 0x7AA0:    hx[253] = 0xB74A
  1459.     hx[ 62] = 0x48BB:    hx[126] = 0xD5EA:    hx[190] = 0x0766:    hx[254] = 0xD219
  1460.     hx[ 63] = 0xF794:    hx[127] = 0xAD4C:    hx[191] = 0x4882:    hx[255] = 0x63DD
  1461. END SUB
  1462. END FUNCTION
  1463. END PROGRAM
  1464.