;Chunky Palette Remapping example ; ;Original code by : ; Curt Esser camge@ix.netcom.com ; ;Last modified May 17 1998 by : ; Xavier Nuel xn.baddolls@a2points.com ; ;Use any part of this in any way you like ;but please, if you make any improvements or find any errors ;let me know. Thanx! ; ;NOTE : Colour remapping library only works on AGA systems! ;NOTE : NEEDS BDGfxLib (C) BadDolls Production ; available in Aminet/dev/basic ; or at http://www.a2points.com/homepage/3698138 ; ; NEEDS BDChunkyLib V1.0 (C) BadDolls Production ; available in Aminet/dev/basic or ; at http://www.a2points.com/homepage/3698138 ; ;------------------------------------------------------------------------- WBStartup ;just in case! WBenchToFront_ ;make sure it shows WbToScreen 0 ;grab the wb screen ScreensBitMap 0,0 NoCli ;don't need that! NEWTYPE.NChunky Width.l ; Width of picture Height.l ; Height of picture Size.l ; Size of buffer AWidth.l ; Aligned Width for buffer *ChunkyData.b End NEWTYPE ;==== Get info about current Workbench Screen and grab it's palette ======= Dim col.b(255) ;table for storing colour matches maxw=WBWidth ;these are used to set our window maxh=WBHeight ;size later wd.w=WBDepth ;number of bitplanes of WB WBcolors.w=2^wd ;convert this to number of colours aga.b=CheckAGA ;see if system is AGA MaxLen fi$=200 ;these are needed for the MaxLen chfil$=200 MaxLen svpath$=200 MaxLen iff$=200 MaxLen pa$=200 ;ASL requestor accuracy.w=0 ;accuracy of remapping - 0-255 ;higher = faster but less accurate If NOT aga Request "Sorry","This example for AGA machines only","Damn!" End EndIf ;------------- Store the WB palette as palette #0 ------------------------- InitPalette 0,WBcolors ;set up palette 0 to WB depth For i=0 To WBcolors-1 AGAPalRGB 0,i,AGARed(i),AGAGreen(i),AGABlue(i) Next Use Palette 0 ;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Repeat ;TEST LOOP STARTS HERE! Window 0,0,0,1,1,$1000,"",1,0 ;needed for requestors CatchDosErrs ;show requestors here! ;first we need an iff picture picpath$=ASLFileRequest$("Select IFF picture",pa$,fi$) If picpath$="" Then End ;exit program when "cancel" is selected ;----------- CHECK SELECTED FILE FOR A USABLE IFF PICTURE --------------- error$="" If ReadFile(0,picpath$) ;make sure it is a valid iff picture file! FileInput 0 header$ = Inkey$(2000) ;Read 2000 bytes of the header CloseFile 0 WindowInput 0 ;IFF picture header should read: FORM....ILBM If Left$(header$,4)<> "FORM" OR Mid$(header$,9,4) <> "ILBM" If Left$(header$,3)="GIF" Then error$="GIF " If Mid$(header$,7,4)="JFIF" Then error$="JPEG" If Mid$(header$,9,4)="ANIM" Then error$="ANIM" If error$="" Then error$="ERROR" Else ;Valid IFF header found! ham=False ;we can't remap HAM pic, so check x.w=Instr(header$,"CAMG") If x<>0 a$=Left$(Right$(Hex$(Peek.l(&header$+x+7) AND $88A4),3),1) If a$="8" Then error$="HAM " EndIf x=Instr(header$,"CMAP") ;24 bit pics will crash! If x=0 Then error$="True Color (24 bit)" EndIf Else ;couldn't even find the file! error$="NF" EndIf If error$="" ;Valid iff picture selected! ; ------ check for enough chip & fast memory for the conversion ----------- ILBMInfo picpath$ ;read the pictures size information sd.w=ILBMDepth sh.w=ILBMHeight sw.w=ILBMWidth winwid=sw If winwid>maxw Then winwid=maxw winhi=sh If winhi>maxh Then winhi=maxh winx=maxw/2-winwid/2 winy=maxh/2-winhi/2 shapecolors.w=2^sd ;convert depth to number of colours planemem.l=sh*sw/8 ;bytes needed for 1 bitplane of this pic planes.b=wd ;calculate total bitplanes needed mem.l=planes*planemem+20000 ;total chipmem required & some padding memchip.l=AvailMem_(131074) ;#MEMF_CHIP|#MEMF_LARGEST memfast.l=AvailMem_(131076) ;#MEMF_FAST|#MEMF_LARGEST If mem>memchip error$="MEM" EndIf ;bytes of fast memory needed for the chunky "bitmap" chunkmem.l=(((sw+15) LSL 4) LSR 4)*sh If chunkmem>memfast error$="FAST" EndIf EndIf ; ----------- READY! ----------------------------------------------------- If error$="" ;get ready to process picture ; ------- For the progress indicator -------------------------------------- Format"" i$="Remap "+Str$(sw)+" x "+Str$(sh)+" " i$=i$+Str$(shapecolors)+" colour picture " a=PICreateRequest("Loading Picture...",0,100,1) ;open progress bar BitMap 1,sw,sh,sd ;standard bitmap for the iff pic a=PIUpdateRequest(10) InitPalette 1,2^sd a=PIUpdateRequest(20) LoadBitMap 1,picpath$,1 a=PIUpdateRequest(60) *AddrChky.NChunky=InitNChunkyA(sw,sh) ;fast mem chunky bitmap a=PIUpdateRequest(70) BtmToNChunkyA Addr BitMap(1),*AddrChky ;fill the chunky buffer a=PIUpdateRequest(95) Free BitMap 1 ;free the picture's bitmap a=PIUpdateRequest(100) PIEndRequest ;-------------Remap the picture's palette to WB palette-------------------- PaletteInfo 1 For i = 0 To shapecolors-1 ;remap the shape to wb screen ColorMatch.w=FindColor(0,AGAPalRed(i),AGAPalGreen(i),AGAPalBlue(i),accuracy) If ColorMatch<128 ; col(i)=ColorMatch ; Check for OverFlow Error Else ; col(i)=ColorMatch-256 ; col(i) is a byte and EndIf ; ColorMatch is a word ;-) Next a=PICreateRequest(i$,0,sh,1) ;open progress bar For yy.l=0 To sh-1 ;read each line a=PIUpdateRequest(yy) ;and remap it !!! RemapNChunkyLineA *AddrChky,yy,&col(0) Next If a Then PIEndRequest ;------------Open a window and put the picture on it----------------------- Free Window 0 suc.l=Window(0,winx,winy,winwid,winhi,$800|$1000,"",1,0) If suc=0 Window 0,0,0,1,1,$1000,"",1,0 ;needed for requestors CatchDosErrs ;show requestors here! Rq$="Not enough chip memory for open the window :-( " Request "Graphic load error",Rq$,"Cancel" Else *tmprp.RastPort=AllocMem_(SizeOf.RastPort,#MEMF_ANY|#MEMF_CLEAR) InitRastPort_ *tmprp *bm2.BitMap=AllocBitMap_(((sw+15) LSL 4) LSR 1,1,wd,#BMF_CLEAR,0) *tmprp\Layer=0 *tmprp\_BitMap=*bm2 WritePixelArray8_ RastPort(0),0,0,sw-1,sh-1,*AddrChky\ChunkyData,*tmprp EndIf FreeNChunkyA *AddrChky Free Palette 1 ;---------Non-supported file formats and memory errors wind up here --------------------- Else ;We can't use the file - tell 'em why! Rq$="" If error$="MEM" Format "#,##0,000" memchip$=Str$(memchip) Rq$="Not enough chip memory|Need:"+Str$(mem)+" bytes|Have:"+memchip$+" bytes" EndIf If error$="FAST" Format "#,##0,000" memfast$=Str$(memfast) Rq$="Not enough fast memory|Need:"+Str$(chunkmem)+" bytes|Have:"+memfast$+" bytes" EndIf If error$="ERROR" Then Rq$="Unrecognized file type|" If Rq$="" Rq$="Can't process selected file|" If error$="NF" Rq$=Rq$+"File not found!" Else Rq$=Rq$+error$+" pictures not supported|" EndIf EndIf If error$<>"NF" AND error$<>"MEM" AND error$<>"FAST" Rq$=Rq$+"Pictures must be IFF - ILBM" EndIf Request "Graphic load error",Rq$,"Cancel" EndIf ;------------Wait for some user action to continue ------------------------ If error$="" ;if a picture was shown wait If suc WaitEvent FreeBitMap_ *bm2 FreeMem_ *tmprp,SizeOf.RastPort Free Window 0 EndIf EndIf Forever