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 >
Wrap
BASIC Source File
|
1980-11-15
|
3KB
|
85 lines
' MakeIcon by David M. Pochron v.1.0 7/18/88
' Converts IFF brushes to Workbench icons in any amount of colors
' (depends on brush) and replaces existing .info file image with
' that new image.
' (Yes folks I could program this in C or assembly but what the heck...it works.)
'CLEAR ,70000 'UnREM this if you want to convert bigger brushes
DEFINT a-z
DECLARE FUNCTION GetDiskObject& LIBRARY
DECLARE FUNCTION PutDiskObject& LIBRARY
DIM pp(6):RESTORE ppdat:FOR i=1 TO 6:READ pp(i):NEXT
ppdat:DATA 1,3,7,15,31,63
INPUT "Enter IFF path & filename > ",f$
OPEN f$ FOR INPUT AS 1
IF RIGHT$(INPUT$(12,1),4)<>"ILBM" THEN PRINT "Not an IFF file!":CLOSE 1:END
f1=0:f2=0
WHILE (f1=0 OR f2=0) AND (EOF(1)=0)
a$=INPUT$(8,1):csz=CVL(RIGHT$(a$,4)):a$=LEFT$(a$,4)
IF a$="BMHD" THEN
xs=CVI(INPUT$(2,1)):ys=CVI(LEFT$(INPUT$(6,1),2)):bp=ASC(LEFT$(INPUT$(2,1),1))
comp=ASC(LEFT$(INPUT$(10,1),1)):nw=INT(xs/16+.99):nb=nw*2:f1=1
ELSEIF a$="BODY" THEN
d$=INPUT$(csz,1):f2=1
ELSE
b$=INPUT$(csz,1)
END IF
WEND
CLOSE 1
IF (f1 AND f2)=0 THEN PRINT "Error reading IFF file...missing chunk!":END
PRINT "Read in IFF file...";
DIM a(nw*ys*bp+4)
IF comp=0 THEN
PRINT "de-interleaving..."
p=1:st1=ys*nw:t1=(bp-1)*st1:t2=(ys-1)*nw
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))
p=p+2:NEXT:NEXT:NEXT
a(0)=xs:a(1)=ys:a(2)=bp
ELSE
PRINT "De-compressing..."
p=1:st1=ys*nb:t1=(bp-1)*st1:t2=(ys-1)*nb
FOR j=0 TO t2 STEP nb:FOR k=0 TO t1 STEP st1:i=0
WHILE i<nb
value=ASC(MID$(d$,p,1)):p=p+1
IF value<128 THEN
FOR ii=0 TO value:POKE VARPTR(a(3))+j+k+i,ASC(MID$(d$,p,1)):i=i+1:p=p+1:NEXT
ELSEIF value>128 THEN
repval=ASC(MID$(d$,p,1)):p=p+1
FOR ii=0 TO 256-value:POKE VARPTR(a(3))+j+k+i,repval:i=i+1:NEXT
END IF
WEND
NEXT:NEXT
a(0)=xs:a(1)=ys:a(2)=bp
END IF
LIBRARY "icon.library"
PRINT :PRINT "Enter path & filename of icon to replace image with: (no .info)"
INPUT f2$:f2$=f2$+CHR$(0):obj&=GetDiskObject&(SADD(f2$))
IF obj&<>0 THEN
img&=PEEKL(obj&+22)
POKEW obj&+58,&H8000:POKEW obj&+60,0:POKEW obj&+62,&H8000:POKEW obj&+64,0
POKEW obj&+12,xs:POKEW obj&+14,ys
POKEW img&+4,xs:POKEW img&+6,ys:POKEW img&+8,bp:POKE img&+14,pp(bp)
POKEL img&+10,VARPTR(a(8)):e&=PutDiskObject&(SADD(f2$),obj&)
FreeDiskObject& obj&
IF e&=0 THEN PRINT "Error writing out new icon!"
ELSE
PRINT "Couldn't open that icon file!"
END IF
LIBRARY CLOSE
END