'  Windows .ICO to .IFF converter
'  by Jay Gramlich 
'  Jan 20, 1993
'
'  Handles up to 32 color icons
'
'
' procedure to take two ascii characters, flip them, and get 
' a value for this 
'
CMD$=Command Line$
Procedure IBMBYT[BYT$]
   X=Val(Hex$(Asc(BYT$)))
End Proc[X]
Procedure IBMHEX[BYT$]
   X$=""
   X$=Hex$(Asc(Left$(BYT$,1)))
   X$=Mid$(X$,2)
   If Len(X$)<2 Then X$="0"+X$
   X$=Hex$(Asc(Mid$(BYT$,2,1)))+X$
   X=Val(X$)
End Proc[X]
Procedure LHEX[BYT$]
   X$=""
   B1$=Left$(BYT$,2)
   B2$=Mid$(BYT$,3,2)
   IBMHEX[B1$]
   X$=Hex$(Param)
'remove $
   X$=Mid$(X$,2)
   While Len(X$)<4
      X$="0"+X$
   Wend 
   IBMHEX[B2$]
   X$=Hex$(Param)+X$
   X=Val(X$)
End Proc[X]
'
'
Amos To Back 
'open output window
'
Set Input 10,-1
Open Port 2,"con://560/100/Wiconvert/simple"
Print #2,Chr$(27);"[1mWiconvert 0.10";Chr$(27);"[22m";" by Jay Gramlich ";
Print #2,"1993 Freeware"
Print #2,"This program was written using ";Chr$(27);"[1m";
Print #2,Chr$(27);"[33mAMOS";Chr$(27);"[32";Chr$(27);"[22m"
Print #2,""
'
' check for ok to do work
'
OK=1
If CMD$="?" or Len(CMD$)=0
   Print #2,"Converts the first icon from a Windows icon file to an iff bitmap"
   Print #2,"Usage: Winconvert ICOfile"
   Print #2,""
   Print #2,"Press 'Return' to end"
   Line Input #2,X$
   OK=0
End If 
If OK=1
   If Exist(CMD$)=0
      Print #2,CMD$;" - File not found"
      Print #2,""
      Print #2,"Press 'return'"
      Line Input #2,X$
      OK=0
   End If 
End If 
'
'
'
If OK
   Open In 1,CMD$
'
' Get the idReserved and idType bytes always 0 and 1 and start on first
' directory entry
'
   IDRES$=Input$(1,2)
   IDTYP$=Input$(1,2)
   IBMHEX[IDRESS$]
   IDRES=Param
   IBMHEX[IDTYP$]
   IDTYP=Param
   COUNT$=Input$(1,2)
   COUNT=Param
   JUNK$=Input$(1,2)
   CLRS$=Input$(1,1)
   IBMBYT[CLRS$]
   CLRS=Param
   OK2=1
   If IDRES<>0 or IDTYP<>1 or COUNT<1
      OK2=0
      Print #2,"This doesn't appear to be a correct .ICO file"
      Print #2,""
      Print #2,"Press 'Return'"
      Line Input #2,X$
   End If 
   If CLRS>32
      OK2=0
      Print #2,"Contains ";CLRS;" colors - this program will only supprts 32"
      Print #2,""
      Print #2,"Press 'Return'"
      Line Input #2,X$
   End If 
   If OK2
      Print #2,"There ";
      If COUNT>1
         Print #2,"are ";COUNT;" images. I'll convert the first one"
      Else 
         Print #2,"is 1 image.";
      End If 
'
' more of first image directory entry - skip alot as info is elsewhere 
'
      JUNK$=Input$(1,9)
      OFFSET$=Input$(1,4)
' we are now at byte 22 - Let's go to offset for first image 
      LHEX[OFFSET$]
      OFFSET=Param
      Pof(1)=OFFSET
'  bitmapinfo header 
      JUNK$=Input$(1,4)
      WID$=Input$(1,4)
      LHEX[WID$]
      WID=Param
      HEI$=Input$(1,4)
      LHEX[HEI$]
      HEI=Param/2
      JUNK$=Input$(1,2)
      PLN$=Input$(1,2)
      LHEX[PLN$]
      PLN=Param
      JUNK$=Input$(1,24)
'
'open screen 
'
      Screen Open 0,320,200,2^PLN,Lowres
      Flash Off 
      Curs Off 
'
'now at RGB color table - set colors 
'
      Print #2,""
      Print #2,"Color Table";
      For X=1 To CLRS
         X$=Input$(1,1)
         IBMBYT[X$]
         B=Param/17
         X$=Input$(1,1)
         IBMBYT[X$]
         G=Param/17
         X$=Input$(1,1)
         R=Param/17
         CL$=Hex$(R)
         CL$=CL$+Mid$(Hex$(G),2,1)
         CL$=CL$+Mid$(Hex$(B),2,1)
         X$=Input$(1,1)
         ' unused byte
         Colour X-1,Val(CL$)
         Print #2,".";
      Next X
         Print #2,""
' xor mask - read it into a string (will crash if over 65535 in length)
      LG=(WID*HEI*PLN)/8
      BITS$=Input$(1,LG)
'
' plot xor mask (since just setting color this is all we need to do) 
' another bug is that this will only work up to 8 bitplanes
      Print #2,"Converting";
      CBIT$=""
      For YC=WID-1 To 0 Step -1
         For XC=0 To HEI-1
            If Len(CBIT$)<PLN
               TBT$=""
               TBT$=Mid$(Bin$(Asc(Left$(BITS$,1))),2)
               BITS$=Mid$(BITS$,2)
               While Len(TBT$)<8
                  TBT$="0"+TBT$
               Wend 
               CBIT$=CBIT$+TBT$
            End If 
            PLTCLR=Val("%"+Left$(CBIT$,PLN))
            CBIT$=Mid$(CBIT$,PLN+1)
            Plot XC,YC,PLTCLR
         Next XC
         If YC mod 2=0
            Print #2,".";
         End If 
      Next YC
      Close 1
      Print #2,""
      Print #2,"Saving to Ram:ICO.IFF"
      Save Iff "ram:ICO.IFF"
      Print #2,""
      Print #2,"Done - Press Return";
      Line Input #2,X$
      Close 2
   End If 
End If