home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 148.lha / Planes_v1.1 / MakeIcon.bas < prev    next >
Encoding:
BASIC Source File  |  1980-11-15  |  2.5 KB  |  85 lines
  1.  
  2. ' MakeIcon by David M. Pochron v.1.0  7/18/88
  3.  
  4. ' Converts IFF brushes to Workbench icons in any amount of colors
  5. ' (depends on brush) and replaces existing .info file image with
  6. ' that new image.
  7.  
  8. ' (Yes folks I could program this in C or assembly but what the heck...it works.)
  9.  
  10.  
  11.  
  12. 'CLEAR ,70000   'UnREM this if you want to convert bigger brushes
  13. DEFINT a-z
  14.  
  15. DECLARE FUNCTION GetDiskObject& LIBRARY
  16. DECLARE FUNCTION PutDiskObject& LIBRARY
  17.  
  18. DIM pp(6):RESTORE ppdat:FOR i=1 TO 6:READ pp(i):NEXT
  19. ppdat:DATA 1,3,7,15,31,63
  20.  
  21. INPUT "Enter IFF path & filename > ",f$
  22.  
  23.  
  24. OPEN f$ FOR INPUT AS 1
  25. IF RIGHT$(INPUT$(12,1),4)<>"ILBM" THEN PRINT "Not an IFF file!":CLOSE 1:END
  26. f1=0:f2=0
  27. WHILE (f1=0 OR f2=0) AND (EOF(1)=0)
  28.    a$=INPUT$(8,1):csz=CVL(RIGHT$(a$,4)):a$=LEFT$(a$,4)
  29.    IF a$="BMHD" THEN
  30.        xs=CVI(INPUT$(2,1)):ys=CVI(LEFT$(INPUT$(6,1),2)):bp=ASC(LEFT$(INPUT$(2,1),1))
  31.        comp=ASC(LEFT$(INPUT$(10,1),1)):nw=INT(xs/16+.99):nb=nw*2:f1=1
  32.    ELSEIF a$="BODY" THEN
  33.        d$=INPUT$(csz,1):f2=1
  34.    ELSE
  35.        b$=INPUT$(csz,1)
  36.    END IF
  37. WEND
  38. CLOSE 1
  39.  
  40. IF (f1 AND f2)=0 THEN PRINT "Error reading IFF file...missing chunk!":END
  41. PRINT "Read in IFF file...";
  42. DIM a(nw*ys*bp+4)
  43. IF comp=0 THEN
  44.    PRINT "de-interleaving..."
  45.    p=1:st1=ys*nw:t1=(bp-1)*st1:t2=(ys-1)*nw
  46.    FOR i=0 TO t2 STEP nw:FOR j=0 TO t1 STEP st1:FOR k=1 TO nw:a(2+k+j+i)=CVI(MID$(d$,p,2))
  47.    p=p+2:NEXT:NEXT:NEXT
  48.    a(0)=xs:a(1)=ys:a(2)=bp
  49. ELSE
  50.    PRINT "De-compressing..."
  51.    p=1:st1=ys*nb:t1=(bp-1)*st1:t2=(ys-1)*nb
  52.    FOR j=0 TO t2 STEP nb:FOR k=0 TO t1 STEP st1:i=0
  53.      WHILE i<nb
  54.        value=ASC(MID$(d$,p,1)):p=p+1
  55.        IF value<128 THEN
  56.          FOR ii=0 TO value:POKE VARPTR(a(3))+j+k+i,ASC(MID$(d$,p,1)):i=i+1:p=p+1:NEXT
  57.        ELSEIF value>128 THEN
  58.          repval=ASC(MID$(d$,p,1)):p=p+1
  59.          FOR ii=0 TO 256-value:POKE VARPTR(a(3))+j+k+i,repval:i=i+1:NEXT   
  60.        END IF
  61.      WEND
  62.    NEXT:NEXT
  63.    a(0)=xs:a(1)=ys:a(2)=bp
  64. END IF
  65.  
  66.  
  67. LIBRARY "icon.library"
  68. PRINT :PRINT "Enter path & filename of icon to replace image with: (no .info)"
  69. INPUT f2$:f2$=f2$+CHR$(0):obj&=GetDiskObject&(SADD(f2$))
  70. IF obj&<>0 THEN
  71.    img&=PEEKL(obj&+22)
  72.    POKEW obj&+58,&H8000:POKEW obj&+60,0:POKEW obj&+62,&H8000:POKEW obj&+64,0
  73.    POKEW obj&+12,xs:POKEW obj&+14,ys
  74.    POKEW img&+4,xs:POKEW img&+6,ys:POKEW img&+8,bp:POKE img&+14,pp(bp)
  75.    POKEL img&+10,VARPTR(a(8)):e&=PutDiskObject&(SADD(f2$),obj&)
  76.    FreeDiskObject& obj&
  77.    IF e&=0 THEN PRINT "Error writing out new icon!"
  78. ELSE
  79.    PRINT "Couldn't open that icon file!"
  80. END IF
  81.  
  82. LIBRARY CLOSE
  83. END
  84.  
  85.