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