/* DoLoadDT.m -- A datatype load, scale, remap and dither routine. */ /* $VER:doloaddt 0.88 (7.6.95) */ /* THIS SOURCE IS COPYRIGHT 1994,1995 by Chad Randall, mbissaymssiK Software If you wish to include this, or any modified version of this routine in your own program, you *MUST* credit me somewhere in your program and/or documentation. I am distributing this source mainly for those who wish to learn a thing or two. Please don't rip me off. */ OPT MODULE OPT PREPROCESS MODULE 'exec/memory','exec/types' MODULE 'dos/dos' MODULE 'intuition/intuition','intuition/screens','intuition/gadgetclass' MODULE 'graphics/rastport','graphics/gfx','graphics/text','graphics/scale','graphics/view', 'graphics/gfxbase','graphics/clip','graphics/layers','graphics/modeid' MODULE 'iffparse','libraries/iffparse' MODULE 'utility','utility/hooks','utility/tagitem' MODULE 'datatypes','datatypes/datatypes','datatypes/datatypesclass','datatypes/pictureclass' MODULE 'mathffp' MODULE 'gadtools','libraries/gadtools' MODULE 'tools/boopsi' MODULE 'mod/fonts' MODULE 'mod/bits' MODULE 'mod/compare' MODULE 'mod/gadgets' MODULE 'mod/gauge' MODULE 'mod/macros' MODULE 'mod/pool' MODULE 'mod/color' EXPORT OBJECT statwindow scr:PTR TO screen centerx:INT centery:INT textfont:PTR TO textfont textattr:PTR TO textattr textstyle:LONG load_string:LONG scale_string:LONG histogram_string:LONG quant_string:LONG render_string:LONG cancel_string:LONG title_string:LONG status_string:LONG ENDOBJECT EXPORT OBJECT gauge rast:PTR TO rastport scr:PTR TO screen x:INT y:INT w:INT h:INT ENDOBJECT EXPORT OBJECT imageinfo source_w:LONG source_h:LONG destination_x:LONG destination_y:LONG destination_w:LONG destination_h:LONG depth:LONG highest_pen:LONG statwindowx:LONG statwindowy:LONG reserved3:LONG reserved4:LONG reserved5:LONG reserved6:LONG reserved7:LONG reserved8:LONG blackpen:LONG whitepen:LONG greypen:LONG ENDOBJECT /*OBJECT ditherarray p1:CHAR p2:CHAR p3:CHAR p4:CHAR p5:CHAR p6:CHAR p7:CHAR p8:CHAR p9:CHAR p10:CHAR p11:CHAR p12:CHAR dividend:CHAR ENDOBJECT*/ EXPORT ENUM DLDT_CENTER=TAG_USER, ->Centers image in w/h DLDT_INTEGERSCALE, ->Does integer scaling routines. NOT FASTER, but may look better. DLDT_DITHER, ->If =true then FS dithering is done DLDT_REMAP, ->Use FindColor to remap pens? DLDT_ASPECTX, ->x aspect value as in x:y DLDT_ASPECTY, ->y aspect value DLDT_SCALE, ->Should we scale, or crop? if=false then crop. DLDT_USEASPECT, ->Should we use the aspect values, or do 1:1 to 1:1? DLDT_ENLARGE, ->NOT IMPLEMENTED YET DLDT_CLEAR, ->Clears from x->y, w->h DLDT_GAUGE, ->A gauge struct. DLDT_CLIGAUGE, ->A ptr to a STRING with an imbedded "%s" code. DLDT_HOOK, ->A PROCedure (E!) to call periodically. DLDT_INFO, ->A ptr to a imageinfo struct to be filled in. DLDT_BIDIRECTIONAL, ->NOT IMPLEMENTED DLDT_DIARRAY, ->NOT IMPLEMENTED DLDT_HIGHPEN, ->Highest pen to use, -1 for all available. (default) DLDT_FILLCMAP, -> Use DT cmap, and fill-in given cmap! no faint-hearts!!! DLDT_GREYSCALE, -> create greyscale icon DLDT_QUANTIZE, -> quantize to x number of colors DLDT_CUSTOMFINDCOLOR, ->Use custom routine! OUCH DLDT_RENDERHAM, -> if =6 then HAM6, if =8 then HAM8, else normal DLDT_HAMTHRESHOLD, -> specifies when to use base-4 colors DLDT_FULLHAMBASE, DLDT_DISCARDERROR, DLDT_STRETCHTOFIT, DLDT_NORENDER, DLDT_STATWINDOW, DLDT_ACTIVATESTATWINDOW, DLDT_DITHERTYPE, DLDT_QUANTTYPE EXPORT ENUM DITH_ERRORDIFF,DITH_FLOYD,DITH_STUCKI,DITH_BURKES EXPORT ENUM QUANT_VERBATIM,QUANT_POPULARITY,QUANT_MEDIANCUT DEF dtlib,utillib,ifflib,mathlib #define PPM_GETR(p) (Shr(Shr(((p) AND $FF0000),8),8)) #define PPM_GETG(p) (Shr(((p) AND $FF00),8)) #define PPM_GETB(p) ((p) AND $FF) #define PPM_PUTR(red) (Shl(Shl(((red) AND $FF),8),8)) #define PPM_PUTG(grn) (Shl(((grn) AND $FF),8)) #define PPM_PUTB(blu) ((blu) AND $FF) #define PPM_ASSIGN(red,grn,blu) ((Shl(Shl(red AND $FF,8),8)) OR (Shl(grn AND $FF,8)) OR (blu AND $FF)) OBJECT box ind:INT colors:INT sum:LONG redw:CHAR grnw:CHAR bluw:CHAR ENDOBJECT CONST HASH_SIZE=20023 CONST MAXCOLORS=32767 #define HASHPIXEL(p) (Mod(((p) AND $ffffff),HASH_SIZE)) OBJECT colorhist_item color:LONG value:LONG ENDOBJECT OBJECT colorhist_list_item ch:colorhist_item next:PTR TO colorhist_list_item ENDOBJECT DEF statwindow:PTR TO window DEF statgauge DEF stat:PTR TO statwindow DEF histopool EXPORT PROC doloaddt(source,rast:PTR TO rastport,cmap:PTR TO colormap,x,y,w,h,taglist=0) HANDLE DEF dtf=NIL:PTR TO dtframebox,fri=NIL:PTR TO frameinfo,obj=NIL:PTR TO datatypeheader,gpl=NIL:PTR TO gplayout DEF dtrast=NIL:PTR TO rastport DEF red[260]:LIST,grn[260]:LIST,blu[260]:LIST DEF tag:PTR TO tagitem DEF cregs,bm=NIL:PTR TO bitmap,bmhd=NIL:PTR TO bitmapheader,numcolors,modeid DEF norender=FALSE DEF center=FALSE,intscale=FALSE,dither=TRUE,remap=TRUE,aspectx=1,aspecty=1,scale=TRUE,useaspect=TRUE,enlarge=FALSE,clear=TRUE DEF scalex,scaley,scalef DEF res,res2 DEF trast=NIL:PTR TO rastport,tbm=NIL:PTR TO bitmap DEF sfixx,sfixy DEF ditz=0,dang=0,dumb=0,body DEF usehighpen=-1 DEF fillcmap=FALSE DEF cm DEF hammode=FALSE,gauge=FALSE:PTR TO gauge,gaugestr=FALSE,hook=0 DEF i,t,u,v,z,xpixper=1,ypixper=1,step,stop DEF scalarx,scalary,percent,adjustw,adjusth,finalw,finalh,finalx,finaly DEF linebuf=0,redbuf=0,grnbuf=0,blubuf=0 DEF dithermode=DITH_FLOYD DEF r38,g38,b38,r39,g39,b39 DEF stretch=FALSE DEF statx=0,staty=0,statw=0,stath=0 DEF statgad=0 DEF glist=0,gad DEF tmp1=0,tmp2=0,tmp3=0,tmp4=0,tmp5,tmp6,tmp7,tmp8,ttmp1,ttmp2,ttmp3 DEF lmp4,lmp5,lmp6 DEF er1,er2,er3,er4 DEF eg1,eg2,eg3,eg4 DEF eb1,eb2,eb3,eb4 DEF sumred=0,sumgrn=0,sumblu=0,num=0 DEF fc,reddif,grndif,bludif,grabbuf DEF realred[260]:LIST,realgrn[260]:LIST,realblu[260]:LIST DEF drawinfo=NIL:PTR TO drawinfo DEF vis=0 DEF iinfo=0:PTR TO imageinfo DEF highpen=0 DEF activatewindow=FALSE DEF speed1,speed2,speed3,speed4,speed5,speed6,speed7,speed8 DEF red24=0,grn24=0,blu24=0 DEF grey=0,quant=256 DEF hamr,hamg,hamb DEF hadr,hadg,hadb DEF renderham=0,hamthres=64 DEF hambase=3 DEF discard=FALSE DEF quantmode=QUANT_MEDIANCUT DEF histo -> WriteF('\n Start AVAILMEM-\d\n',AvailMem(MEMF_ANY)) histo:=0;statwindow:=0;statgauge:=0;stat:=0 dtf:=New(600);fri:=New(600);gpl:=New(600) dtrast:=New(SIZEOF rastport);InitRastPort(dtrast) trast:=New(SIZEOF rastport) CopyMem(dtrast,trast,SIZEOF rastport);trast.layer:=0 IF checklibs()=FALSE THEN Raise("LIB") IF taglist IF (tag:=FindTagItem(DLDT_CENTER,taglist)) THEN center:=tag.data IF (tag:=FindTagItem(DLDT_INTEGERSCALE,taglist)) THEN intscale:=tag.data IF (tag:=FindTagItem(DLDT_DITHER,taglist)) THEN dither:=tag.data IF (tag:=FindTagItem(DLDT_REMAP,taglist)) THEN remap:=tag.data IF (tag:=FindTagItem(DLDT_ASPECTX,taglist)) THEN aspecty:=tag.data IF (tag:=FindTagItem(DLDT_ASPECTY,taglist)) THEN aspectx:=tag.data IF (tag:=FindTagItem(DLDT_SCALE,taglist)) THEN scale:=tag.data IF (tag:=FindTagItem(DLDT_USEASPECT,taglist)) THEN useaspect:=tag.data IF (tag:=FindTagItem(DLDT_ENLARGE,taglist)) THEN enlarge:=tag.data IF (tag:=FindTagItem(DLDT_CLEAR,taglist)) THEN clear:=tag.data IF (tag:=FindTagItem(DLDT_GAUGE,taglist)) THEN gauge:=tag.data IF (tag:=FindTagItem(DLDT_CLIGAUGE,taglist)) THEN gaugestr:=tag.data IF (tag:=FindTagItem(DLDT_HOOK,taglist)) THEN hook:=tag.data IF (tag:=FindTagItem(DLDT_INFO,taglist)) THEN iinfo:=tag.data IF (tag:=FindTagItem(DLDT_HIGHPEN,taglist)) THEN usehighpen:=tag.data IF (tag:=FindTagItem(DLDT_FILLCMAP,taglist)) THEN fillcmap:=tag.data IF (tag:=FindTagItem(DLDT_QUANTIZE,taglist)) THEN quant:=limit(tag.data,1,256) IF (tag:=FindTagItem(DLDT_GREYSCALE,taglist)) THEN grey:=limit(tag.data,0,2) IF (tag:=FindTagItem(DLDT_RENDERHAM,taglist)) THEN renderham:=limit(tag.data,0,8) IF (tag:=FindTagItem(DLDT_HAMTHRESHOLD,taglist)) THEN hamthres:=limit(tag.data,0,760) IF (tag:=FindTagItem(DLDT_FULLHAMBASE,taglist)) THEN IF (tag.data<>FALSE) THEN hambase:=IF (renderham=6) THEN 15 ELSE 63 IF (tag:=FindTagItem(DLDT_DISCARDERROR,taglist)) THEN discard:=tag.data IF (tag:=FindTagItem(DLDT_STRETCHTOFIT,taglist)) THEN stretch:=tag.data IF (tag:=FindTagItem(DLDT_NORENDER,taglist)) THEN norender:=tag.data IF (tag:=FindTagItem(DLDT_STATWINDOW,taglist)) THEN stat:=tag.data IF (tag:=FindTagItem(DLDT_ACTIVATESTATWINDOW,taglist)) THEN activatewindow:=tag.data IF (tag:=FindTagItem(DLDT_DITHERTYPE,taglist)) THEN dithermode:=tag.data IF (tag:=FindTagItem(DLDT_QUANTTYPE,taglist)) THEN quantmode:=tag.data IF usehighpen=-1 THEN usehighpen:=256 IF (quant<256) usehighpen:=limit(smaller(usehighpen,quant-1),1,255) ENDIF ENDIF IF stat drawinfo:=GetScreenDrawInfo(stat.scr) vis:=GetVisualInfoA(stat.scr, NIL) ENDIF IF (stat AND drawinfo AND vis) statw,stath:=biggest(rast,[stat.load_string,stat.scale_string,stat.histogram_string,stat.render_string,TAG_END]:LONG,stat.textfont,stat.textstyle) tmp1,tmp2:=fontsize2(rast,stat.cancel_string,stat.textfont,stat.textstyle) tmp8,tmp7:=fontsize2(rast,stat.status_string,stat.textfont,stat.textstyle) statw:=bigger(bigger(statw,tmp1),tmp8) tmp8:=bigger(tmp8,statw) statx:=stat.centerx-(statw/2) staty:=stat.centery-(stath/2) tmp3:=(WFLG_SMART_REFRESH OR WFLG_DRAGBAR OR WFLG_DEPTHGADGET) IF activatewindow THEN tmp3:=tmp3 OR WFLG_ACTIVATE statwindow:=OpenWindowTagList(0, [WA_INNERWIDTH,statw+16, WA_INNERHEIGHT,stath+26+tmp2+tmp7, WA_LEFT,statx, WA_TOP,staty, WA_FLAGS,tmp3, WA_TITLE,stat.title_string, WA_CUSTOMSCREEN,stat.scr, WA_IDCMP,(BUTTONIDCMP OR IDCMP_REFRESHWINDOW), WA_NEWLOOKMENUS,TRUE, WA_AUTOADJUST,TRUE, NIL]) SetAPen(statwindow.rport,2) SetBPen(statwindow.rport,0) setafpt(statwindow.rport,[%1010101010101010,%0101010101010101]:INT,1) SetDrMd(statwindow.rport,RP_JAM2) RectFill(statwindow.rport,statwindow.borderleft,statwindow.bordertop,rightedge(statwindow)-1,bottomedge(statwindow)-1) setafpt(statwindow.rport,0,0) IF statwindow gad:=CreateContext({glist}) tmp3:=(statwindow.width/2)-(tmp1/2) tmp4:=(statwindow.height-statwindow.borderbottom-tmp2-6) statgad,gad:=CreateGadgetA(BUTTON_KIND,gad, [tmp3-6,tmp4,tmp1+12,tmp2+4,stat.cancel_string,stat.textattr,1,0,vis,0]:newgadget,[NIL,NIL]) AddGList(statwindow,statgad,-1,-1,0) RefreshGList(statgad,statwindow,0,-1) disablegadget(statgad,statwindow) statgauge:=newgauge(statwindow.rport,statwindow.borderleft+2,statwindow.bordertop+10+tmp7,insidewidth(statwindow)-4,stath+8,stat.textfont,stat.textstyle,vis,drawinfo,GAUGETYPE_FANCY) tmp1:=(statwindow.width/2)-(tmp8/2) tmp2:=statwindow.bordertop+2 drawbevelbox(vis,statwindow.rport,tmp1-6,tmp2,tmp8+12,tmp7+4,1,TRUE,0) Move(statwindow.rport,tmp1,stat.textfont.baseline+tmp2+2) SetAPen(statwindow.rport,1) SetFont(statwindow.rport,stat.textfont) Text(statwindow.rport,stat.status_string,StrLen(stat.status_string)) statusgauge(statgauge,stat.load_string) ENDIF ENDIF IF source<257 obj:=NewDTObjectA(source,[DTA_SOURCETYPE,DTST_CLIPBOARD,DTA_GROUPID,GID_PICTURE,PDTA_REMAP,FALSE,NIL,NIL]) ELSE obj:=NewDTObjectA(source,[DTA_SOURCETYPE,DTST_FILE,DTA_GROUPID,GID_PICTURE,PDTA_REMAP,FALSE,NIL,NIL]) ENDIF IF obj IF (drawinfo=0) THEN IF (gauge) THEN drawinfo:=GetScreenDrawInfo(gauge.scr) PutLong(dtf,DTM_FRAMEBOX) dtf.frameinfo:=fri dtf.contentsinfo:=fri dtf.sizeframeinfo:=SIZEOF frameinfo IF (domethod(obj,dtf)) PutLong(gpl,DTM_PROCLAYOUT) gpl.ginfo:=NIL gpl.initial:=1 IF (domethod(obj,gpl)) GetDTAttrsA(obj,[PDTA_CREGS,{cregs},PDTA_BITMAP,{bm},PDTA_NUMCOLORS,{numcolors}, PDTA_BITMAPHEADER,{bmhd},PDTA_MODEID,{modeid},NIL,NIL]) IF (modeid AND HAM_KEY);hammode:=TRUE;ENDIF dtrast.bitmap:=bm IF usehighpen=256 THEN usehighpen:=-1 IF bm<>NIL body:=cregs FOR i:=0 TO (Shl(1,(bmhd.depth))-1) ditz:=Char(body);body:=body+4;red[i]:=ditz dang:=Char(body);body:=body+4;grn[i]:=dang dumb:=Char(body);body:=body+4;blu[i]:=dumb ENDFOR /* IF (fillcmap) IF (grey>0) speed2:=limit(smaller(quant,Shl(1,bmhd.depth)-1),1,255) FOR i:=0 TO speed2-1 speed1:=((((i*100)/(speed2-1))*256)/100) r38:=limit(speed1,0,255) r38:=Shl(r38,8) OR r38 r38:=Shl(r38,8) OR r38 r38:=Shl(r38,8) OR r38 SetRGB32CM(cmap,smaller(i,255),r38,r38,r38) ENDFOR ENDIF ENDIF*/ grabbuf:=[0,0,0,0,0,0,0,0]:LONG tbm:=AllocBitMap((bmhd.width*2),1,8,(BMF_CLEAR OR BMF_STANDARD),NIL) trast.bitmap:=tbm adjustw:=SpFlt(bmhd.width) adjusth:=SpFlt(bmhd.height) IF ((useaspect<>FALSE) AND (intscale=FALSE)) IF bmhd.xaspect=0 THEN bmhd.xaspect:=1 IF bmhd.yaspect=0 THEN bmhd.yaspect:=1 scalarx:=SpDiv(SpFlt(aspectx),SpFlt(bmhd.xaspect)) scalary:=SpDiv(SpFlt(aspecty),SpFlt(bmhd.yaspect)) res:=SpCmp(scalarx,scalary) IF res<0 -> scaraly is GREATER THAN scalarx percent:=SpDiv(scalarx,scalary) adjusth:=SpMul(percent,SpFlt(bmhd.height)) ELSE percent:=SpDiv(scalary,scalarx) adjustw:=SpMul(percent,SpFlt(bmhd.width)) ENDIF ENDIF finalx:=x;finaly:=y;finalw:=w;finalh:=h;scalex:=SpFlt(1);scaley:=SpFlt(1) res:=SpCmp(SpFlt(w),adjustw) res2:=SpCmp(SpFlt(h),adjusth) IF (((res<0) OR (res2<0)) AND (scale<>FALSE)) -> Datatype is LARGER than workspace, so scale? IF (intscale<>FALSE) scalex:=SpFlt(SpFix( SpDiv(SpFlt(w),SpFlt(SpFix(adjustw))))) scaley:=SpFlt(SpFix( SpDiv(SpFlt(h),SpFlt(SpFix(adjusth))))) res:=SpCmp(scalex,scaley) IF (res<0);scalef:=scaley;ELSE;scalef:=scalex;ENDIF finalw:=SpFix(SpDiv(scalef,adjustw)) finalh:=SpFix(SpDiv(scalef,adjusth)) ELSE scalex:=SpDiv(SpFlt(w),adjustw) scaley:=SpDiv(SpFlt(h),adjusth) res:=SpCmp(scalex,scaley) IF (res<0);scalef:=scaley;ELSE;scalef:=scalex;ENDIF finalw:=SpFix(SpDiv(scalef,adjustw)) finalh:=SpFix(SpDiv(scalef,adjusth)) ENDIF IF (stretch) finalw:=smaller(bmhd.width,w);finalh:=smaller(bmhd.height,h) -> finalw:=w;finalh:=h ENDIF xpixper:=SpDiv(SpFlt(finalw),SpFlt(bmhd.width)) ypixper:=SpDiv(SpFlt(finalh),SpFlt(bmhd.height)) ELSE finalw:=smaller(bmhd.width,w);finalh:=smaller(bmhd.height,h) xpixper:=SpFlt(1);ypixper:=SpFlt(1) ENDIF IF center finalx:=x+(w/2)-(finalw/2) finaly:=y+(h/2)-(finalh/2) ENDIF IF statgauge THEN cleargauge(statgauge) IF statgad THEN enablegadget(statgad,statwindow) IF ((remap=FALSE) AND (scale=FALSE)) FOR t:=0 TO finalh-1 IF checkcancel(statwindow) THEN Raise("canc") IF (((t+3)/4) = (t/4)) IF statgauge THEN fuelgauge(statgauge,t,finalh-1,stat.render_string) ENDIF FOR i:=0 TO finalw-1 fc:=ReadPixel(dtrast,i,t) WHILE fc>usehighpen fc:=Shr(fc,1) ENDWHILE IF highpen HAM8 IF (speed8 AND %11000000) IF ((speed8 AND %11000000)=%10000000) -> Modify RED tmp1:=Shl((speed8 AND %111111),2);ENDIF IF ((speed8 AND %11000000)=%01000000) -> Modify BLUE tmp3:=Shl((speed8 AND %111111),2);ENDIF IF ((speed8 AND %11000000)=%11000000) -> Modify GRN tmp2:=Shl((speed8 AND %111111),2);ENDIF ELSE tmp1:=red[(speed8 AND %111111)];tmp2:=grn[(speed8 AND %111111)];tmp3:=blu[(speed8 AND %111111)] ENDIF ELSE IF (speed8 AND %110000) IF (speed8 AND %110000)=%100000 -> Modify RED tmp1:=Shl((speed8 AND %1111),4);ENDIF IF (speed8 AND %110000)=%010000 -> Modify BLUE tmp3:=Shl((speed8 AND %1111),4);ENDIF IF (speed8 AND %110000)=%110000 -> Modify GRN tmp2:=Shl((speed8 AND %1111),4);ENDIF ELSE tmp1:=red[(z AND %1111)];tmp2:=grn[(z AND %1111)];tmp3:=blu[(z AND %1111)] ENDIF ENDIF ENDIF speed1:=bmhd.width*(u-t) ditz:=redbuf+speed1 dang:=grnbuf+speed1 dumb:=blubuf+speed1 IF (remap=FALSE) THEN ditz:=redbuf FOR v:=1 TO bmhd.width IF (remap=FALSE) PutChar(ditz,Char(linebuf+v));ditz:=ditz+1 ELSE PutChar(ditz,tmp1);ditz:=ditz+1 PutChar(dang,tmp2);dang:=dang+1 PutChar(dumb,tmp3);dumb:=dumb+1 z:=Char(linebuf+v) IF (hammode=FALSE) tmp1:=red[z];tmp2:=grn[z];tmp3:=blu[z] ELSE IF (bmhd.depth=8) -> HAM8 speed7:=(z AND %11000000) IF (speed7) IF (speed7=%10000000) -> Modify RED tmp1:=Shl((z AND %111111),2) ELSE IF (speed7=%01000000) tmp3:=Shl((z AND %111111),2) ELSE tmp2:=Shl((z AND %111111),2) ENDIF ENDIF ELSE speed6:=(z AND %111111) tmp1:=red[speed6];tmp2:=grn[speed6];tmp3:=blu[speed6] ENDIF ELSE IF (z AND %110000) IF (z AND %110000)=%100000 -> Modify RED tmp1:=Shl((z AND %1111),4);ENDIF IF (z AND %110000)=%010000 -> Modify BLUE tmp3:=Shl((z AND %1111),4);ENDIF IF (z AND %110000)=%110000 -> Modify GRN tmp2:=Shl((z AND %1111),4);ENDIF ELSE speed6:=(z AND %1111) tmp1:=red[speed6];tmp2:=grn[speed6];tmp3:=blu[speed6] ENDIF ENDIF ENDIF ENDIF ENDFOR ENDFOR IF (remap=FALSE) FOR i:=0 TO speed5 fc:=Char(redbuf+(SpFix(SpMul(xpixper,SpFlt(i))))) SetAPen(rast,fc) highpen:=bigger(highpen,fc) WritePixel(rast,finalx+i,finaly+t) ENDFOR ELSE FOR i:=0 TO speed5 tmp4:=(SpFix(SpMul(xpixper,SpFlt(i)))) ditz:=redbuf+tmp4 dang:=grnbuf+tmp4 dumb:=blubuf+tmp4 IF ((sfixy>=1) AND (sfixx>=1)) num:=0;sumred:=0;sumgrn:=0;sumblu:=0 MOVEM.L D0-D7/A0-A3,-(A7) MOVE.L ditz,A0 MOVE.L dang,A1 MOVE.L dumb,A2 MOVE.L bmhd,A3 CLR.L D2 -> The result from Char() CLR.L D4 -> num CLR.L D5 -> sumred CLR.L D6 -> sumgrn CLR.L D7 -> sumblu MOVE.L sfixy,D0 -> ADD.L #1,D0 loop3: MOVE.L sfixx,D1 -> ADD.L #1,D1 loop2: SUB.L D3,D3 -> EQ: CLR.L D3 ? Is it faster??!? MOVE.W 0(A3),D3 MULU.L D0,D3 ADD.L D1,D3 MOVE.B 0(A0,D3),D2 ADD.L D2,D5 MOVE.B 0(A1,D3),D2 ADD.L D2,D6 MOVE.B 0(A2,D3),D2 ADD.L D2,D7 ADDQ.L #1,D4 DBRA D1,loop2 DBRA D0,loop3 MOVE.L D4,num MOVE.L D5,sumred MOVE.L D6,sumgrn MOVE.L D7,sumblu MOVEM.L (A7)+,D0-D7/A0-A3 IF num>0 sumred:=limit(sumred/num,0,255) sumgrn:=limit(sumgrn/num,0,255) sumblu:=limit(sumblu/num,0,255) ENDIF ELSE sumred:=Char(ditz) sumgrn:=Char(dang) sumblu:=Char(dumb) ENDIF MOVE.L t,D1 MOVE.L finalw,D2 MULU.L D2,D1 ADD.L i,D1 MOVE.L D1,D0 ADD.L red24,D0 MOVE.L D0,A0 MOVE.L sumred,D2 MOVE.B D2,(A0) MOVE.L D1,D0 ADD.L grn24,D0 MOVE.L D0,A0 MOVE.L sumgrn,D2 MOVE.B D2,(A0) MOVE.L D1,D0 ADD.L blu24,D0 MOVE.L D0,A0 MOVE.L sumblu,D2 MOVE.B D2,(A0) ENDFOR ENDIF ENDFOR IF grey tmp1:=red24 tmp2:=grn24 tmp3:=blu24 tmp7:=finalh*finalw-1 FOR i:=0 TO tmp7 IF grey=1 er1:=(Char(tmp1)*1000)/30 er2:=(Char(tmp2)*1000)/30 er3:=(Char(tmp3)*1000)/30 ELSE er1:=(Char(tmp1)*3000)/100 er2:=(Char(tmp2)*6000)/100 er3:=(Char(tmp3)*1000)/100 ENDIF er4:=(er1+er2+er3)/100 PutChar(tmp1,er4) PutChar(tmp2,er4) PutChar(tmp3,er4) tmp1:=tmp1+1 tmp2:=tmp2+1 tmp3:=tmp3+1 ENDFOR ENDIF IF (fillcmap) IF usehighpen>=quant THEN usehighpen:=(quant-1) SELECT quantmode CASE QUANT_VERBATIM FOR i:=0 TO quant SetRGB32CM(cmap,smaller(i,255),byte2long(red[i]),byte2long(grn[i]),byte2long(blu[i])) ENDFOR CASE QUANT_POPULARITY histo:=New(20000) FOR t:=0 TO finalh-1 IF checkcancel(statwindow) THEN Raise("canc") IF (((t+3)/4)=(t/4)) IF statgauge THEN fuelgauge(statgauge,t,finalh-1,stat.histogram_string) ENDIF FOR i:=0 TO finalw-1 tmp1:=Shr((Char(red24+(t*finalw)+i) AND $F0) ,4) tmp2:=Shr((Char(grn24+(t*finalw)+i) AND $F0) ,4) tmp3:=Shr((Char(blu24+(t*finalw)+i) AND $F0) ,4) tmp4:=histo+((tmp1+(tmp2*16)+(tmp3*256))*4) PutLong(tmp4,(Long(tmp4)+1)) ENDFOR ENDFOR FOR i:=0 TO quant IF checkcancel(statwindow) THEN Raise("canc") IF (((i+3)/4)=(i/4)) IF statgauge THEN fuelgauge(statgauge,i,quant,stat.quant_string) ENDIF tmp1:=0 tmp2:=0 tmp3:=histo FOR t:=0 TO 4095 IF Long(tmp3)>tmp2 tmp2:=Long(tmp3) tmp1:=t ENDIF tmp3:=tmp3+4 ENDFOR PutLong(histo+(tmp1*4),0) er1:=tmp1 AND $F er1:=er1 OR Shl(er1,4) er2:=Shr((tmp1 AND $F0),4) er2:=er2 OR Shl(er2,4) er3:=Shr((tmp1 AND $F00),8) er3:=er3 OR Shl(er3,4) SetRGB32CM(cmap,smaller(i,255),byte2long(er1),byte2long(er2),byte2long(er3)) ENDFOR CASE QUANT_MEDIANCUT cm:=domediancut(red24,grn24,blu24,finalw,finalh,cmap,quant) IF (cm) FOR i:=0 TO (quant) SetRGB32CM(cmap,smaller(i,255),byte2long(PPM_GETR(Long(cm+(i*SIZEOF colorhist_item)))),byte2long(PPM_GETG(Long(cm+(i*SIZEOF colorhist_item)))),byte2long(PPM_GETB(Long(cm+(i*SIZEOF colorhist_item))))) ENDFOR Dispose(cm) ENDIF ENDSELECT doexchange(cmap,3,0,255,255,usehighpen) doexchange(cmap,2,255,255,255,usehighpen) doexchange(cmap,1,0,0,0,usehighpen) doexchange(cmap,0,128,128,128,usehighpen) ENDIF IF (norender) THEN Raise("nore") IF (clear<>FALSE);SetAPen(rast,0);RectFill(rast,x,y,x+w-1,y+h-1);ENDIF FOR i:=0 TO Shl(1,8)-1 GetRGB32(cmap,i,1,grabbuf) realred[i]:=Char(grabbuf) realgrn[i]:=Char(grabbuf+4) realblu[i]:=Char(grabbuf+8) ENDFOR IF renderham THEN dither:=FALSE FOR t:=0 TO finalh-1 IF checkcancel(statwindow) THEN Raise("canc") IF (((t+3)/4)=(t/4)) IF ((gauge<>0) AND (drawinfo<>0)) IF (gauge.rast<>0) SetAPen(gauge.rast,Int(drawinfo.pens+(FILLPEN*2))) RectFill(gauge.rast,gauge.x,gauge.y,gauge.x+((((gauge.w-2)*100)/(10000/(bigger((t*100/(finalh-1)),1))))),gauge.y+gauge.h-1) ENDIF ENDIF IF (gaugestr<>0) WriteF(gaugestr,smaller(((t*100))/(bigger(finalh-1,1)),100)) ENDIF IF statgauge THEN fuelgauge(statgauge,t,finalh-1,stat.render_string) ENDIF IF ((((t+1)/2)=(t/2)) OR (renderham>5) OR (dithermode=DITH_ERRORDIFF)) i:=0;stop:=finalw;step:=1 tmp4:=t*finalw tmp1:=red24+tmp4 tmp2:=grn24+tmp4 tmp3:=blu24+tmp4 ELSE i:=finalw-1;stop:=-1;step:=-1 tmp4:=(t*finalw)+(finalw-1) tmp1:=red24+tmp4 tmp2:=grn24+tmp4 tmp3:=blu24+tmp4 ENDIF REPEAT tmp4:=Char(tmp1) tmp5:=Char(tmp2) tmp6:=Char(tmp3) lmp4:=byte2long(tmp4) lmp5:=byte2long(tmp5) lmp6:=byte2long(tmp6) IF (dither=FALSE) SELECT 9 OF renderham CASE 6,8 IF (i>0) fc:=FindColor(cmap,lmp4,lmp5,lmp6,hambase) hadr:=Abs(tmp4-realred[fc]) hadg:=Abs(tmp5-realgrn[fc]) hadb:=Abs(tmp6-realblu[fc]) IF ((hadr+hadg+hadb)<=hamthres) hamr:=realred[fc] -> CHAR hamg:=realgrn[fc] hamb:=realblu[fc] ELSE hadr:=Abs(tmp4-hamr) -> CHAR-CHAR hadg:=Abs(tmp5-hamg) hadb:=Abs(tmp6-hamb) IF (renderham=8) IF ((hadb>(hadr*2)) AND (hadb>(hadg*3))) hamb:=(tmp6 AND %11111100) fc:=(%01000000 OR Shr(hamb,2)) IF (discard) THEN hamb:=(tmp6 AND %11111111) ELSE IF (hadr>(hadg*2)) hamr:=(tmp4 AND %11111100) fc:=(%10000000 OR Shr(hamr,2)) IF (discard) THEN hamr:=(tmp4 AND %11111111) ELSE hamg:=(tmp5 AND %11111100) fc:=(%11000000 OR Shr(hamg,2)) IF (discard) THEN hamg:=(tmp5 AND %11111111) ENDIF ENDIF ELSE IF ((hadb>(hadr*2)) AND (hadb>(hadg*3))) hamb:=(tmp6 AND %11110000) fc:=(%010000 OR Shr(hamb,4)) IF (discard) THEN hamb:=(tmp6 AND %11111111) ELSE IF (hadr>(hadg*2)) hamr:=(tmp4 AND %11110000) fc:=(%100000 OR Shr(hamr,4)) IF (discard) THEN hamr:=(tmp4 AND %11111111) ELSE hamg:=(tmp5 AND %11110000) fc:=(%110000 OR Shr(hamg,4)) IF (discard) THEN hamg:=(tmp5 AND %11111111) ENDIF ENDIF ENDIF ENDIF ELSE fc:=FindColor(cmap,lmp4,lmp5,lmp6,hambase) hamr:=realred[fc] hamg:=realgrn[fc] hamb:=realblu[fc] ENDIF DEFAULT fc:=FindColor(cmap,lmp4,lmp5,lmp6,usehighpen) ENDSELECT IF fc>highpen THEN highpen:=fc SetAPen(rast,fc) WritePixel(rast,finalx+i,finaly+t) ELSE -> Do dither! fc:=FindColor(cmap,lmp4,lmp5,lmp6,usehighpen) IF fc>highpen THEN highpen:=fc SetAPen(rast,fc) WritePixel(rast,finalx+i,finaly+t) reddif:=tmp4-realred[fc] grndif:=tmp5-realgrn[fc] bludif:=tmp6-realblu[fc] SELECT 4 OF dithermode CASE DITH_FLOYD,DITH_ERRORDIFF IF dithermode=DITH_FLOYD er1:=(reddif*7)/16 er2:=(reddif*3)/16 er3:=(reddif*5)/16 er4:=reddif-er1-er2-er3 eg1:=(grndif*7)/16 eg2:=(grndif*3)/16 eg3:=(grndif*5)/16 eg4:=grndif-eg1-eg2-eg3 eb1:=(bludif*7)/16 eb2:=(bludif*3)/16 eb3:=(bludif*5)/16 eb4:=bludif-eb1-eb2-eb3 ELSE er1:=(reddif*3)/8 AND %11111111111111111111111111111110 er2:=0 er3:=er1 er4:=reddif-er1-er3 AND %11111111111111111111111111111100 eg1:=(grndif*3)/8 AND %11111111111111111111111111111100 eg2:=0 eg3:=eg1 eg4:=grndif-eg1-eg3 AND %11111111111111111111111111111100 eb1:=(bludif*3)/8 AND %11111111111111111111111111111110 eb2:=0 eb3:=eb1 eb4:=bludif-eb1-eb3 AND %11111111111111111111111111111100 ENDIF IF step=1 IF ((i+1)0) byteplace(tmp1-1+finalw,er2) byteplace(tmp2-1+finalw,eg2) byteplace(tmp3-1+finalw,eb2) ENDIF byteplace(tmp1+finalw,er3) byteplace(tmp2+finalw,eg3) byteplace(tmp3+finalw,eb3) ENDIF ELSE IF ((i-1)>stop) byteplace(tmp1-1,er1) byteplace(tmp2-1,eg1) byteplace(tmp3-1,eb1) ENDIF IF t<(finalh-1) IF ((i-1)>stop) byteplace(tmp1-1+finalw,er4) byteplace(tmp2-1+finalw,eg4) byteplace(tmp3-1+finalw,eb4) ENDIF IF (i<(finalw-1)) byteplace(tmp1+1+finalw,er2) byteplace(tmp2+1+finalw,eg2) byteplace(tmp3+1+finalw,eb2) ENDIF byteplace(tmp1+finalw,er3) byteplace(tmp2+finalw,eg3) byteplace(tmp3+finalw,eb3) ENDIF ENDIF CASE DITH_BURKES,DITH_STUCKI IF dithermode=DITH_BURKES er1:=(reddif*8)/32 ->8 er2:=(reddif*4)/32 ->4 er3:=(reddif-(er1*2)-(er2*3))/2 ->2 eg1:=(grndif*8)/32 eg2:=(grndif*4)/32 eg3:=(grndif-(eg1*2)-(eg2*3))/2 eb1:=(bludif*8)/32 eb2:=(bludif*4)/32 eb3:=(bludif-(eb1*2)-(eb2*3))/2 ELSE er1:=(reddif*8)/42 ->8 er2:=(reddif*4)/42 ->4 er3:=(reddif*2)/42 ->2 er4:=(reddif-(er1*2)-(er2*4)-(er3*4))/2 ->1 eg1:=(grndif*8)/42 eg2:=(grndif*4)/42 eg3:=(grndif*2)/42 eg4:=(grndif-(eg1*2)-(eg2*4)-(eg3*4))/2 eb1:=(bludif*8)/42 eb2:=(bludif*4)/42 eb3:=(bludif*2)/42 eb4:=(bludif-(eb1*2)-(eb2*4)-(eb3*4))/2 ENDIF IF step=1 IF ((i+1)0) byteplace(ttmp1-1,er2) byteplace(ttmp2-1,eg2) byteplace(ttmp3-1,eb2) IF (i>1) byteplace(ttmp1-2,er3) byteplace(ttmp2-2,eg3) byteplace(ttmp3-2,eb3) ENDIF ENDIF byteplace(ttmp1,er1) byteplace(ttmp2,eg1) byteplace(ttmp3,eb1) IF dithermode=DITH_STUCKI IF t<(finalh-1) ttmp1:=ttmp1+finalw ttmp2:=ttmp2+finalw ttmp3:=ttmp3+finalw IF ((i+1)0) byteplace(ttmp1-1,er3) byteplace(ttmp2-1,eg3) byteplace(ttmp3-1,eb3) IF (i>1) byteplace(ttmp1-2,er4) byteplace(ttmp2-2,eg4) byteplace(ttmp3-2,eb4) ENDIF ENDIF byteplace(ttmp1,er2) byteplace(ttmp2,eg2) byteplace(ttmp3,eb2) ENDIF ENDIF ENDIF ELSE IF ((i-1)>stop) byteplace(tmp1-1,er1) byteplace(tmp2-1,eg1) byteplace(tmp3-1,eb1) IF ((i-2)>stop) byteplace(tmp1-2,er2) byteplace(tmp2-2,eg2) byteplace(tmp3-2,eb2) ENDIF ENDIF IF t<(finalh-1) ttmp1:=tmp1+finalw ttmp2:=tmp2+finalw ttmp3:=tmp3+finalw IF ((i-1)>stop) byteplace(ttmp1-1,er2) byteplace(ttmp2-1,eg2) byteplace(ttmp3-1,eb2) IF ((i-2)>stop) byteplace(ttmp1-2,er3) byteplace(ttmp2-2,eg3) byteplace(ttmp3-2,eb3) ENDIF ENDIF IF (i<(finalw-1)) byteplace(ttmp1+1,er2) byteplace(ttmp2+1,eg2) byteplace(ttmp3+1,eb2) IF (i<(finalw-2)) byteplace(ttmp1+2,er3) byteplace(ttmp2+2,eg3) byteplace(ttmp3+2,eb3) ENDIF ENDIF byteplace(ttmp1,er1) byteplace(ttmp2,eg1) byteplace(ttmp3,eb1) IF dithermode=DITH_STUCKI IF (t<(finalh-1)) ttmp1:=ttmp1+finalw ttmp2:=ttmp2+finalw ttmp3:=ttmp3+finalw IF ((i-1)>stop) byteplace(ttmp1-1,er3) byteplace(ttmp2-1,eg3) byteplace(ttmp3-1,eb3) IF ((i-2)>stop) byteplace(ttmp1-2,er4) byteplace(ttmp2-2,eg4) byteplace(ttmp3-2,eb4) ENDIF ENDIF IF (i<(finalw-1)) byteplace(ttmp1+1,er3) byteplace(ttmp2+1,eg3) byteplace(ttmp3+1,eb3) IF (i<(finalw-2)) byteplace(ttmp1+2,er4) byteplace(ttmp2+2,eg4) byteplace(ttmp3+2,eb4) ENDIF ENDIF byteplace(ttmp1,er2) byteplace(ttmp2,eg2) byteplace(ttmp3,eb2) ENDIF ENDIF ENDIF ENDIF ENDSELECT ENDIF tmp1:=tmp1+step tmp2:=tmp2+step tmp3:=tmp3+step i:=i+step;UNTIL i=stop ENDFOR ENDIF IF (renderham=6) THEN highpen:=63 IF (renderham=8) THEN highpen:=255 IF iinfo iinfo.source_w:=bmhd.width iinfo.source_h:=bmhd.height iinfo.destination_x:=finalx iinfo.destination_y:=finaly iinfo.destination_w:=finalw iinfo.destination_h:=finalh iinfo.depth:=bmhd.depth iinfo.highest_pen:=highpen IF ((renderham=6) OR (renderham=8)) THEN usehighpen:=3 iinfo.blackpen:=FindColor(cmap,0,0,0,usehighpen) iinfo.whitepen:=FindColor(cmap,$FFFFFFFF,$FFFFFFFF,$FFFFFFFF,usehighpen) iinfo.greypen:=FindColor(cmap,$99999999,$99999999,$99999999,usehighpen) IF statwindow iinfo.statwindowx:=stat.centerx-(statx-statwindow.leftedge) iinfo.statwindowy:=stat.centery-(staty-statwindow.topedge) ENDIF ENDIF IF (gaugestr<>0) WriteF(gaugestr,100) ENDIF ELSE Raise("MEM") ENDIF ELSE Raise("Nodt") ENDIF ELSE Raise("Nodt") ENDIF ELSE Raise("Nodt") ENDIF EXCEPT DO res:=exception IF statwindow CloseWindow(statwindow) IF glist FreeGadgets(glist) ENDIF statwindow:=0 ENDIF IF statgauge THEN endgauge(statgauge) IF drawinfo THEN FreeScreenDrawInfo(gauge.scr,drawinfo) IF vis THEN FreeVisualInfo(vis) IF obj THEN DisposeDTObject(obj) IF tbm THEN FreeBitMap(tbm) IF redbuf THEN Dispose(redbuf) IF grnbuf THEN Dispose(grnbuf) IF blubuf THEN Dispose(blubuf) IF linebuf THEN Dispose(linebuf) IF trast THEN Dispose(trast) IF dtf THEN Dispose(dtf) IF fri THEN Dispose(fri) IF histo THEN Dispose(histo) IF red24 THEN Dispose(red24) IF grn24 THEN Dispose(grn24) IF blu24 THEN Dispose(blu24) IF gpl THEN Dispose(gpl) IF dtrast THEN Dispose(dtrast) ->WriteF('\n End AVAILMEM-\d\n',AvailMem(MEMF_ANY)) ENDPROC res PROC checklibs() IF ((iffparsebase) AND (utilitybase) AND (datatypesbase) AND (mathbase)) THEN RETURN TRUE ENDPROC FALSE PROC checkcancel(window:PTR TO window) DEF mes:PTR TO intuimessage DEF class DEF retu=FALSE IF window REPEAT IF mes:=Gt_GetIMsg(window.userport) class:=extractmessage(mes) IF (class=IDCMP_GADGETUP) retu:=TRUE ELSEIF class=IDCMP_REFRESHWINDOW Gt_BeginRefresh(window) Gt_EndRefresh(window,TRUE) ENDIF Gt_ReplyIMsg(mes) ENDIF UNTIL mes=0 ELSE IF CtrlC() THEN retu:=TRUE ENDIF ENDPROC retu PROC byteplace(loc,error) DEF old old:=Char(loc) old:=old+error IF old<0 THEN old:=0 IF old>255 THEN old:=255 PutChar(loc,old) ENDPROC PROC rgbint(intval) DEF r,g,b r:=intval AND $F r:=r OR Shl(r,4) g:=Shr((intval AND $F0),4) g:=g OR Shl(g,4) b:=Shr((intval AND $F00),8) b:=b OR Shl(b,4) ENDPROC r,g,b PROC rgb2int(r,g,b) DEF int=0 int:=(Shr(r,4) OR (Shl(Shr(g,4),4)) OR (Shl(Shr(b,4),8)) ) ENDPROC int PROC rgbtab(r,g,b) DEF rr rr:=(r+(g*16)+(b*256))*4 ENDPROC rr PROC domediancut(redbuf,grnbuf,blubuf,width,height,palette,newcolors) DEF chv=0:PTR TO colorhist_item DEF colors=0 DEF colormap histopool:=createpool() chv:=computecolorhist(redbuf,grnbuf,blubuf,width,height,MAXCOLORS,{colors}) IF chv -> WriteF('\n\nFOUND \d COLORS! -- Choosing \d colors...\n\n',colors,newcolors) colormap:=mediancut(chv,colors,width*height,newcolors) Dispose(chv) ENDIF ENDPROC colormap PROC mediancut(chv,colors,sum,newcolors) DEF colormap=0,bv=0 DEF boxes,bi,i,bigbox,movebox,tmp1,tmp2,score DEF box:PTR TO box,chi:PTR TO colorhist_item DEF indx,clrs,sm,minr,maxr,ming,maxg,minb,maxb,v,halfsum,lowersum DEF r,g,b DEF rl,gl,bl DEF f_0_299,f_0_587,f_0_114 DEF colo bv:=New((SIZEOF box*newcolors)+100) f_0_299:=SpDiv(SpFlt(1000),SpFlt(299)) f_0_587:=SpDiv(SpFlt(1000),SpFlt(587)) f_0_114:=SpDiv(SpFlt(1000),SpFlt(114)) IF (bv) colormap:=New((SIZEOF colorhist_item*newcolors)+100) IF (colormap) FOR i:=0 TO (newcolors-1) PutLong(colormap+(i*SIZEOF colorhist_item),0) PutLong(colormap+(i*SIZEOF colorhist_item)+4,0) ENDFOR box:=bv box.ind:=0 box.colors:=colors box.sum:=sum boxes:=1 sizebox(box,chv) WHILE (boxes(boxes/2)) IF statgauge THEN fuelgauge(statgauge,boxes,newcolors,stat.quant_string) ENDIF FOR bi:=0 TO (boxes-1) box:=bv+(bi*SIZEOF box) IF box.colors>=2 THEN JUMP break2 ENDFOR JUMP break3 break2: -> IF (bi=boxes) THEN JUMP break3 indx:=box.ind clrs:=box.colors sm:=box.sum rl:=SpMul(SpFlt(box.redw),f_0_299) gl:=SpMul(SpFlt(box.grnw),f_0_587) bl:=SpMul(SpFlt(box.bluw),f_0_114) rl:=SpFlt(box.redw) gl:=SpFlt(box.grnw) bl:=SpFlt(box.bluw) /* rl:=SpMul(SpFlt(box.bluw),f_0_299) gl:=SpMul(SpFlt(box.grnw),f_0_587) bl:=SpMul(SpFlt(box.bluw),f_0_114) chi:=chv+(indx*SIZEOF colorhist_item) colo:=chi.color minr:=PPM_GETR(colo);maxr:=minr ming:=PPM_GETG(colo);maxg:=ming minb:=PPM_GETB(colo);maxb:=minb FOR i:=1 TO (clrs-1) chi:=chv+((indx+i)*SIZEOF colorhist_item) colo:=chi.color v:=PPM_GETR(colo) IF (vmaxr) THEN maxr:=v v:=PPM_GETG(colo) IF (vmaxg) THEN maxg:=v v:=PPM_GETB(colo) IF (vmaxb) THEN maxb:=v ENDFOR rl:=SpMul(SpFlt(maxr-minr),f_0_299) gl:=SpMul(SpFlt(maxg-ming),f_0_587) bl:=SpMul(SpFlt(maxb-minb),f_0_114)*/ IF ((SpCmp(rl,gl)>0) AND (SpCmp(rl,bl)>0)) qsort(chv+(indx*SIZEOF colorhist_item),0,clrs-1,$FF0000) /* WriteF('\n------------RED--------------') FOR i:=0 TO clrs-1 chi:=chv+((i+indx)*SIZEOF colorhist_item) WriteF('\n\h[8] \d[6]',chi.color,chi.value) ENDFOR */ ELSE IF (SpCmp(gl,bl)>0) qsort(chv+(indx*SIZEOF colorhist_item),0,clrs-1,$FF00) /* WriteF('\n------------GRN--------------') FOR i:=0 TO clrs-1 chi:=chv+((i+indx)*SIZEOF colorhist_item) WriteF('\n\h[8] \d[6]',chi.color,chi.value) ENDFOR */ ELSE qsort(chv+(indx*SIZEOF colorhist_item),0,clrs-1,$FF) /* WriteF('\n------------BLU--------------') FOR i:=0 TO clrs-1 chi:=chv+((i+indx)*SIZEOF colorhist_item) WriteF('\n\h[8] \d[6]',chi.color,chi.value) ENDFOR */ ENDIF ENDIF chi:=chv+(indx*SIZEOF colorhist_item) lowersum:=chi.value halfsum:=(sm/2) ->WriteF('\n\d,',lowersum) i:=1 WHILE (i<(clrs-1)) IF (lowersum>=halfsum) THEN JUMP break4 chi:=chv+((indx+i)*SIZEOF colorhist_item) lowersum:=lowersum+(chi.value) ->WriteF('\d,',lowersum) i:=i+1;ENDWHILE break4: lowersum:=limit(lowersum,0,sm-1) box:=bv+(bi*SIZEOF box) box.colors:=i box.sum:=lowersum sizebox(box,chv) box:=bv+(boxes*SIZEOF box) box.ind:=indx+i box.colors:=clrs-i box.sum:=sm-lowersum sizebox(box,chv) boxes:=boxes+1 /* IF (box.sum<=0) WriteF('\nSMALL SUM=\d \d \d',box.sum,sm,lowersum) ENDIF*/ bigbox:=0;movebox:=0 box:=bv FOR i:=1 TO boxes-1 box:=(box+SIZEOF box) IF (box.colors>1) score:=(((box.redw*box.redw))+((box.grnw*box.grnw))+(box.bluw*box.bluw)) ->*(box.sum) IF score>bigbox;movebox:=i;bigbox:=score;ENDIF /* IF box.redw>bigbox;bigbox:=box.redw;movebox:=i WriteF(' R-\d',bigbox) ENDIF IF box.grnw>bigbox;bigbox:=box.grnw;movebox:=i WriteF(' G-\d',bigbox) ENDIF IF box.bluw>bigbox;bigbox:=box.bluw;movebox:=i WriteF(' B-\d',bigbox) ENDIF */ ENDIF ENDFOR -> WriteF('\nbigbox=\d',bigbox) swapboxes(bv,bv+(movebox*SIZEOF box)) /* WriteF('------\n') FOR i:=0 TO boxes-1 box:=bv+(i*SIZEOF box) WriteF('\d[4] \d[6] \d[6] (\d[3],\d[3],\d[3])\n',box.ind,box.colors,box.sum,box.redw,box.grnw,box.bluw) ENDFOR WriteF('------\n') */ ENDWHILE break3: FOR bi:=0 TO (boxes-1) box:=bv+(bi*SIZEOF box) indx:=box.ind clrs:=box.colors r:=0;g:=0;b:=0;sum:=0 FOR i:=0 TO (clrs-1) chi:=chv+((indx+i)*SIZEOF colorhist_item) colo:=chi.color tmp1:=chi.value -> r:=r+((PPM_GETR(colo))*tmp1) -> g:=g+((PPM_GETG(colo))*tmp1) -> b:=b+((PPM_GETB(colo))*tmp1) -> sum:=sum+tmp1 r:=r+((PPM_GETR(colo))) g:=g+((PPM_GETG(colo))) b:=b+((PPM_GETB(colo))) sum:=sum+1 ENDFOR r:=limit(r/sum,0,255) g:=limit(g/sum,0,255) b:=limit(b/sum,0,255) chi:=colormap+(bi*SIZEOF colorhist_item) chi.color:=PPM_ASSIGN(r,g,b) ENDFOR ENDIF Dispose(bv) ENDIF ENDPROC colormap PROC swapboxes(box1:PTR TO box,box2:PTR TO box) DEF tmp tmp:=box1.ind; box1.ind:=box2.ind; box2.ind:=tmp tmp:=box1.colors; box1.colors:=box2.colors; box2.colors:=tmp tmp:=box1.sum; box1.sum:=box2.sum; box2.sum:=tmp tmp:=box1.redw; box1.redw:=box2.redw; box2.redw:=tmp tmp:=box1.grnw; box1.grnw:=box2.grnw; box2.grnw:=tmp tmp:=box1.bluw; box1.bluw:=box2.bluw; box2.bluw:=tmp ENDPROC PROC computecolorhist(redbuf,grnbuf,blubuf,cols,rows,maxcolors,colorsP) DEF cht=0 DEF chv=0 cht:=computecolorhash(redbuf,grnbuf,blubuf,cols,rows,maxcolors,colorsP) IF cht chv:=colorhashtocolorhist(cht,maxcolors) freecolorhash(cht) RETURN chv ELSE RETURN 0 ENDIF ENDPROC PROC computecolorhash(redbuf,grnbuf,blubuf,cols,rows,maxcolors,colorsP) DEF cht=0 DEF pP=0 DEF chl=0:PTR TO colorhist_list_item DEF col,row,hash,ccoolloorr cht:=alloccolorhash() IF cht PutLong(colorsP,0) row:=0 REPEAT IF checkcancel(statwindow) freecolorhash(cht) Raise("canc") ENDIF IF (((row+3)/4)=(row/4)) IF statgauge THEN fuelgauge(statgauge,row,rows-1,stat.histogram_string) ENDIF col:=0 REPEAT ccoolloorr:=((PPM_PUTR(Char(redbuf+pP)) OR PPM_PUTG(Char(grnbuf+pP)) OR PPM_PUTB(Char(blubuf+pP))) AND $FEFEFE) hash:=HASHPIXEL(ccoolloorr) chl:=Long(cht+(hash*4)) WHILE (chl<>0) IF (chl.ch.color=ccoolloorr) JUMP break ENDIF chl:=chl.next ENDWHILE break: IF (chl<>0) chl.ch.value:=(chl.ch.value+1) ELSE PutLong(colorsP,Long(colorsP)+1) IF Long(colorsP)>maxcolors freecolorhash(cht) RETURN 0 ENDIF -> chl:=New(SIZEOF colorhist_list_item) chl:=alloc(histopool,SIZEOF colorhist_list_item) IF chl chl.ch.color:=ccoolloorr chl.ch.value:=1 chl.next:=Long(cht+(hash*4)) PutLong((cht+(hash*4)),chl) ENDIF ENDIF col:=col+1;pP:=pP+1;UNTIL col=cols row:=row+1;UNTIL row=rows ENDIF ENDPROC cht PROC alloccolorhash() DEF cht=0 cht:=New((HASH_SIZE*4)+20) ENDPROC cht PROC colorhashtocolorhist(cht,maxcolors) DEF chv=0:PTR TO colorhist_item DEF chl=0:PTR TO colorhist_list_item DEF i,j chv:=New((maxcolors*SIZEOF colorhist_item)+20) j:=0 FOR i:=0 TO (HASH_SIZE-1) chl:=Long(cht+(i*4)) WHILE (chl<>0) PutLong(chv+(j*SIZEOF colorhist_item),chl.ch.color) PutLong(chv+4+(j*SIZEOF colorhist_item),chl.ch.value) -> WriteF('\n\h \d',chl.ch.color,chl.ch.value) j:=j+1 chl:=chl.next ENDWHILE ENDFOR ENDPROC chv PROC freecolorhash(cht) DEF i DEF chl:PTR TO colorhist_list_item DEF chlnext i:=0 deletepool(histopool) /* WHILE (i0) chlnext:=chl.next -> WriteF('(\z\h[2] \z\h[2] \z\h[2],\z\h[8])\n',PPM_GETR(chl.ch.color),PPM_GETG(chl.ch.color),PPM_GETB(chl.ch.color),chl.ch.value) Dispose(chl) chl:=chlnext ENDWHILE i:=i+1 ENDWHILE*/ Dispose(cht) ENDPROC 0 PROC qsort(chv,l,r,and) DEF i,j,x,m1,m2 -> RETURN ->WriteF('>') ->WriteF('\n\d',FreeStack()) x:=((Long(chv+((Shr(l+r,1))*SIZEOF colorhist_item))) AND and) i:=l j:=r REPEAT WHILE (((Long(chv+(i++*SIZEOF colorhist_item))) AND and) < x) -> WriteF('I') ENDWHILE WHILE (x<((Long(chv+(j*SIZEOF colorhist_item))) AND and)) j:=j-1 -> WriteF('*') ENDWHILE IF (i-- <=j) -> WriteF('!') m1:=chv+(j*SIZEOF colorhist_item) m2:=chv+(i*SIZEOF colorhist_item) /* MOVE.L j,D0 MULU.L #8,D0 ADD.L chv,D0 MOVE.L i,D1 MULU.L #8,D1 ADD.L chv,D1 MOVE.L D0,A0 MOVE.L D1,A1*/ MOVE.L m1,A0 MOVE.L m2,A1 MOVE.L (A0),D0 MOVE.L (A1),(A0)+ MOVE.L D0,(A1)+ MOVE.L (A0),D0 MOVE.L (A1),(A0) MOVE.L D0,(A1) i:=i+1 DEC j ENDIF UNTIL i>j IF l WriteF('<') ENDPROC /* PROC qsort(chv,l,r,and) DEF i,j,m1,m2,vand -> RETURN ->WriteF('Q') IF (r>l) vand:=((Long(chv+(r*SIZEOF colorhist_item))) AND and) i:=l-1 j:=r WHILE (1=1) m2:=TRUE REPEAT i:=i+1 IF (((Long(chv+(i*SIZEOF colorhist_item))) AND and)>=vand) THEN m2:=FALSE IF i>=r THEN m2:=FALSE ->WriteF('i') UNTIL m2=FALSE m2:=TRUE REPEAT j:=j-1 IF (((Long(chv+(j*SIZEOF colorhist_item))) AND and)<=vand) THEN m2:=FALSE IF j<=l THEN m2:=FALSE ->WriteF('j') UNTIL m2=FALSE IF (i>=j) THEN JUMP break6 ->WriteF('#') m1:=chv+(j*SIZEOF colorhist_item) m2:=chv+(i*SIZEOF colorhist_item) MOVE.L m1,A0 MOVE.L m2,A1 MOVE.L (A0),D0 MOVE.L (A1),(A0)+ MOVE.L D0,(A1)+ MOVE.L (A0),D0 MOVE.L (A1),(A0) MOVE.L D0,(A1) ENDWHILE break6: ->WriteF('*') IF (ixr) THEN xr:=r IF (g>xg) THEN xg:=g IF (b>xb) THEN xb:=b ptr:=ptr+SIZEOF colorhist_item ENDFOR box.redw:=xr-mr box.grnw:=xg-mg box.bluw:=xb-mb -> WriteF('\n (\d,\d,\d) \d',box.redw,box.grnw,box.bluw,box.colors) ENDPROC