`icon test
`by ESC
sync on:set window off:set display mode 800,600,32
sync
file$="evolution.ico"

open to read 1,file$
print "file name: ";
print file$
`---------header---------
read word 1,Reserved
print "reserved:";
print Reserved

read word 1,type_
print "type:";
print type_

read word 1,count
print "count:";
print count

print " "
`---------entries---------
for i=1 to count

   read byte 1,width
   print "  width:";
   print width

   read byte 1,height
   print "  height:";
   print height

   read byte 1,ColorCount
   if colorcount=0 then ColorCount=256
   print "  ColorCount:";
   print ColorCount

   dim red(colorcount)
   dim green(colorcount)
   dim blue(colorcount)

   read byte 1,Reserved
   print "  Reserved:";
   print Reserved

   read word 1,planes
   print "  planes:";
   print planes

   read word 1,BitCount
   print "  BitCount:";
   print BitCount

   read long 1,SizeInBytes
   print "  SizeInBytes:";
   print SizeInBytes

   read long 1,FileOffset
   print "  FileOffset:";
   print FileOffset

next i
print " "

`---------infoheader---------
   read long 1,bSize
   print "bSize:";
   print bSize

   read long 1,bWidth
   print "bWidth:";
   print bWidth

   read long 1,bHeight
   print "bHeight:";
   print bHeight

   read word 1,bplanes
   print "bplanes:";
   print bplanes

   read word 1,bbitcount
   print "bbitcount:";
   print bbitcount

   read long 1,compression
   print "compression:";
   print compression

   read long 1,imagesize
   print "imagesize:";
   print imagesize

   read long 1,XpixelsPerM
   print "XpixelsPerM:";
   print XpixelsPerM

   read long 1,YpixelsPerM
   print "YpixelsPerM:";
   print YpixelsPerM

   read long 1,ColorsUsed
   print "ColorsUsed:";
   print ColorsUsed

   read long 1,ColorsImportant
   print "ColorsImportant:";
   print ColorsImportant
sync
wait key
   cls
   sync


   for c=1 to ColorCount
      read byte 1,red(c)
      read byte 1,green(c)
      read byte 1,blue(c)
      read byte 1,reserved
      print red(c)
      print green(c)
      print blue(c)
      print " "
   next c
sync
wait key

cls
sync

if bbitcount=1 and compression=0
   for y=height to 1 step -1
      for x=1 to width step 8
         read byte 1,pallete
         pal$=right$(bin$(pallete),8)
         pal8=val(mid$(pal$,8))
         pal7=val(mid$(pal$,7))
         pal6=val(mid$(pal$,6))
         pal5=val(mid$(pal$,5))
         pal4=val(mid$(pal$,4))
         pal3=val(mid$(pal$,3))
         pal2=val(mid$(pal$,2))
         pal1=val(mid$(pal$,1))

         if pal1=1 then color=255 else color=0
         dot x,y,rgb(color,color,color)
         if pal2=1 then color=255 else color=0
         dot x+1,y,rgb(color,color,color)
         if pal3=1 then color=255 else color=0
         dot x+2,y,rgb(color,color,color)
         if pal4=1 then color=255 else color=0
         dot x+3,y,rgb(color,color,color)
         if pal5=1 then color=255 else color=0
         dot x+4,y,rgb(color,color,color)
         if pal6=1 then color=255 else color=0
         dot x+5,y,rgb(color,color,color)
         if pal7=1 then color=255 else color=0
         dot x+6,y,rgb(color,color,color)
         if pal8=1 then color=255 else color=0
         dot x+7,y,rgb(color,color,color)

      next x
   next y
sync
endif

if bbitcount=4 and compression=0
   for y=height to 1 step -1
      for x=1 to width step 2
         read byte 1,pallete
         pal1=((pallete && 0xf0) >> 4)
         pal2=(pallete && 0xf)
         dot x,y,rgb(blue(pal1+1),green(pal1+1),red(pal1+1))
         dot x+1,y,rgb(blue(pal2+1),green(pal2+1),red(pal2+1))
      next x
   next y
sync
endif

if bbitcount=8 and compression=0
   for y=height to 1 step -1
      for x=1 to width
         read byte 1,pallete
         dot x,y,rgb(blue(pallete+1),green(pallete+1),red(pallete+1))
      next x
   next y
sync
endif

   for y=height to 1 step -1
      for x=1 to width step 8
         read byte 1,pallete
         pal$=right$(bin$(pallete),8)
         pal8=val(mid$(pal$,8))
         pal7=val(mid$(pal$,7))
         pal6=val(mid$(pal$,6))
         pal5=val(mid$(pal$,5))
         pal4=val(mid$(pal$,4))
         pal3=val(mid$(pal$,3))
         pal2=val(mid$(pal$,2))
         pal1=val(mid$(pal$,1))

         if pal1=1 then color=255 else color=0
         dot x,y+64,rgb(color,color,color)
         if pal2=1 then color=255 else color=0
         dot x+1,y+64,rgb(color,color,color)
         if pal3=1 then color=255 else color=0
         dot x+2,y+64,rgb(color,color,color)
         if pal4=1 then color=255 else color=0
         dot x+3,y+64,rgb(color,color,color)
         if pal5=1 then color=255 else color=0
         dot x+4,y+64,rgb(color,color,color)
         if pal6=1 then color=255 else color=0
         dot x+5,y+64,rgb(color,color,color)
         if pal7=1 then color=255 else color=0
         dot x+6,y+64,rgb(color,color,color)
         if pal8=1 then color=255 else color=0
         dot x+7,y+64,rgb(color,color,color)

      next x
   next y

sync

wait key