MODULE 'exec/nodes','exec/ports','exec/types','exec/memory', 'intuition/intuition','intuition/screens','intuition/gadgetclass', 'intuition/screens','dos/dos','dos/dosextens','gadtools', 'libraries/gadtools','graphics/rastport','graphics/gfx','graphics/text', 'graphics/view','graphics/gfxbase','workbench/workbench', 'workbench/startup','wb','icon','graphics/clip','diskfont', 'libraries/diskfont','libraries/iffparse','iffparse','Asl','libraries/Asl', 'datatypes/datatypes','datatypes/datatypesclass','datatypes/pictureclass', 'utility/hooks','intuition/classes','intuition/classusr','utility/tagitem', 'libraries/locale', 'mathffp','dos/dosasl', 'datatypes','layers','keymap','devices/inputevent','mathtrans','locale' MODULE 'newicon','libraries/newicon' MODULE 'whatis','libraries/whatisbase' MODULE '*doloaddt' /* options: MAXIWIDTH=x ;buffer size width MAXIHEIGHT=x ;buffer size height APPICON=$ ;name of App-icon image TEMPLATE_ICON=$ ;name of icon to modify (tooltypes, positions) BACKGROUND_ICON=$ ;Name of background icon. CHUNKYMODE=B ;save icon with ReadPixels, not bitmap->image. FORCE_EIGHT=B ;If YES then eight planes are saved. PIC_X_POS=x ;Offset for image. PIC_Y_POS=x ;Offset for image. PIC_X_SIZE=x ;Real size of image (not always, but at least < than) PIC_Y_SIZE=x ;Real size of image. CENTER=B ;Center icon? Only valid with PIC_X_SIZE/PIC_Y_SIZE SHOWSIZE_X=x ;X pos for size coords SHOWSIZE_Y=x ;Y pos for size coords LOWPRI=B ;If= "yes" then run at priority -1 FREE_ICON_POS=B ;Set icon to "unsnapshot" HIGHPEN=x ;topmost pen to use SHOWSIZE_OUTLINE=B;If yes, then outline the size, otherwise, shadow it SHOWSIZE_NORMAL=B ;If yes, then no shadow, no outline. SHOWSIZE_TALL=B ;If yes, then font is 8 high, not 6. QUIET=B ;If yes then surpress ALL output. APP_X_POS=x ;x pos of appicon APP_Y_POS=y ;y pos of appicon DITHER=B ;if YES then do dithering */ ENUM E_NONE,L_OK, L_E_GENERAL,L_E_FILE,L_E_NOFILE,L_E_BADICON,L_E_NOWRITEICON,L_E_CLIP, L_E_DATATYPE,L_E_NOPICTURE,L_E_GADGET, L_EF_LIBRARY,L_EF_FATAL,L_EF_PUBSCREEN,L_EF_CHIPBUFFER,L_EF_VISUAL,L_EF_MENUS, L_EF_MSGPORT,L_EF_WINDOW,L_EF_MEMORY,L_TEXTTITLE, L_PICTURE,L_FILEOF,L_LOADING,L_SCALING,L_REMAPPING,L_SAVING,L_PERCENT, L_TITLE,L_BODY,L_BUTTONS,L_RENDERING,L_PERCENT2,L_NUMDIRS,L_CREATINGICON,L_ENDS ENUM MODE_CLI,MODE_WB,MODE_QUIET,MODE_APP ENUM TEXT_NORMAL,TEXT_SHADOW,TEXT_OUTLINE OBJECT mybitmapstruct bytesperrow:INT;rows:INT;flags:CHAR;depth:CHAR;pad:INT plane1:LONG;plane2:LONG;plane3:LONG;plane4:LONG plane5:LONG;plane6:LONG;plane7:LONG;plane8:LONG ENDOBJECT DEF dumstr[500]:STRING DEF texttype=TEXT_SHADOW,tallfont=FALSE DEF iff:PTR TO iffhandle,ierror DEF sp=NIL:PTR TO storedproperty DEF freeme=FALSE DEF curfile=1,totfile=1 DEF screenfont=NIL:PTR TO textfont DEF window=NIL:PTR TO window,rast,drawinfo,fgx,fgy,fgw,fgh DEF showflag=FALSE,showx=0,showy=0,bitsizex,bitsizey,sizestr[50]:STRING DEF black,white,writecolors=2 DEF posx=0,posy=0,sizex=0,sizey=0,centerflag=FALSE,posflag=FALSE DEF noappitem=FALSE DEF minimumx,minimumy DEF quietflag=FALSE,goodload DEF requestsizex,requestsizey,highestcolor DEF k[15]:LIST DEF redt[256]:LIST,grnt[256]:LIST,blut[256]:LIST DEF ditz,dang,dumb,body DEF osversion,quitter,newicon=FALSE DEF abort DEF aspectx=1,aspecty=1,useaspect=TRUE,addicon=FALSE,addiconoverwrite=FALSE DEF radian,pointfive DEF catalog,sl[500]:LIST DEF iconianheader[80]:STRING DEF scratch,ret,dummy DEF appimagedata,diskobj=NIL:PTR TO diskobject,newdiskobj=NIL:PTR TO newdiskobject DEF progname[500]:STRING,sleepername[500]:STRING,templatename[500]:STRING DEF backname[500]:STRING DEF gaugestr[100]:STRING DEF toolobject=NIL:PTR TO diskobject DEF stretch=FALSE DEF greyscale=0,quant=256 DEF usewhatis=TRUE DEF chunkyflag=FALSE,force8=FALSE,first4=-1 DEF maxiwidth=128,maxiheight=100,maxiw=127,maxih=99 DEF filename[500]:STRING DEF mode=MODE_CLI DEF scr=NIL:PTR TO screen,viewport:PTR TO viewport DEF bitmap:PTR TO bitmap,depth,colormap=0,newcolormap=0,cmbuf=0 DEF currast=NIL:PTR TO rastport,curbitmap=NIL:PTR TO bitmap DEF appname[500]:STRING DEF visual=NIL,winx=-1,winy=-1 DEF oldpx=-1 DEF appx=-1,appy=-1 DEF dither=TRUE DEF twopass=FALSE DEF rawdata=0 DEF div1=3,div2=0,div3=3,div4=1,rem1=8,rem2=1,rem3=8,rem4=4 DEF thres=2,ignore=16,lim=255,typ=0 DEF iinfo=0:PTR TO imageinfo DEF stacked[750]:LIST DEF renderham=FALSE DEF hamthres=-1 DEF hambase=FALSE DEF discard=FALSE PROC main() NEW iinfo openlibs() radian:=sp_div_tf_tf_f(10000,572958) pointfive:=sp_div_tf_tf_f(10,5) StrCopy(iconianheader,'Picticon 1.1',ALL) loadwinpos() handwb() savewinpos() leave(0) ENDPROC PROC setraw(x,y,r,g,b) IF rawdata PutLong(rawdata+(limit(x,0,maxiwidth)*12)+(limit(y,0,1)*12*maxiwidth),r) PutLong(rawdata+(limit(x,0,maxiwidth)*12)+4+(limit(y,0,1)*12*maxiwidth),g) PutLong(rawdata+(limit(x,0,maxiwidth)*12)+8+(limit(y,0,1)*12*maxiwidth),b) ENDIF ENDPROC PROC rawred(x,y) RETURN Long(rawdata+(x*12)+(y*12*maxiwidth)) ENDPROC PROC rawgrn(x,y) RETURN Long(rawdata+4+(x*12)+(y*12*maxiwidth)) ENDPROC PROC rawblu(x,y) RETURN Long(rawdata+8+(x*12)+(y*12*maxiwidth)) ENDPROC PROC processicon() HANDLE DEF gadget:PTR TO gadget DEF backobj=NIL:PTR TO diskobject DEF screenattr:PTR TO textattr,sfonth=8 DEF heystring[500]:STRING,file[500]:STRING DEF whaticon[500]:STRING DEF iiii,tttt,oldshowx,loo,gc1,gc2 DEF inw,inh,lock DEF imsg:PTR TO intuimessage DEF whatobj=NIL:PTR TO diskobject DEF newwhatobj=NIL:PTR TO newdiskobject oldshowx:=showx window:=NIL IF StrLen(filename)<1 THEN Raise(E_NONE) IF ((scr:=LockPubScreen('Workbench'))=0) THEN Raise(L_EF_PUBSCREEN) visual:=GetVisualInfoA(scr,NIL) viewport:=scr.viewport colormap:=viewport.colormap bitmap:=scr.bitmap depth:=bitmap.depth IF (newicon) newcolormap:=GetColorMap(256) cmbuf:=New(32) FOR loo:=0 TO 255 gc1:=loo AND (Shl(1,depth)-1) GetRGB32(colormap,gc1,1,cmbuf) SetRGB32CM(newcolormap,loo,Long(cmbuf),Long(cmbuf+4),Long(cmbuf+8)) ENDFOR colormap:=newcolormap Dispose(cmbuf) ENDIF IF (curbitmap:=myallocbitmap(maxiwidth,maxiheight,8,BMF_CLEAR OR BMF_STANDARD,NIL))=NIL THEN Raise(L_EF_CHIPBUFFER) IF (currast:=New(SIZEOF rastport))=NIL THEN Raise(L_EF_FATAL) InitRastPort(currast);currast.bitmap:=curbitmap screenattr:=scr.font sfonth:=screenattr.ysize IF ((mode<>MODE_QUIET) AND (mode<>MODE_CLI)) inw:=bigger(300,12*StrLen(FilePart(filename))) inh:=sfonth*3+20-(((totfile<-1) OR (totfile>1))*(sfonth+4)) IF winx=-1 THEN winx:=(((scr.width-300)/2)) IF winy=-1 THEN winy:=(((scr.height-(sfonth*2+16))/2)) window:=OpenWindowTagList(0,[WA_LEFT,winx, WA_TOP,winy, WA_INNERWIDTH,inw, WA_INNERHEIGHT,inh, WA_FLAGS,WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET, WA_IDCMP,IDCMP_CLOSEWINDOW, WA_TITLE,sl[L_TEXTTITLE], WA_CUSTOMSCREEN,scr, WA_AUTOADJUST,TRUE, NIL,NIL]) rast:=window.rport screenfont:=OpenFont(scr.font) IF screenfont THEN SetFont(rast,screenfont) fgx:=4+window.borderleft fgw:=window.width-(8+window.borderleft+window.borderright) fgh:=window.height-(window.bordertop+4+window.borderbottom)-(sfonth*2)-8+(((totfile<-1) OR (totfile>1))*(sfonth+4)) fgy:=window.height-(sfonth*2)-18 SetAPen(rast,2) shadowtext(rast,fgx,fgy+6+fgh+screenfont.baseline,'0%',2) shadowtext(rast,fgx+fgw-TextLength(rast,'100%',4),fgy+fgh+6+screenfont.baseline,'100%',4) shadowtext(rast,fgx+(fgw/2)-(TextLength(rast,'50%',3)/2),fgy+fgh+6+screenfont.baseline,'50%',3) shadowtext(rast,fgx+(fgw/4)-(TextLength(rast,'25%',3)/2),fgy+fgh+6+screenfont.baseline,'25%',3) shadowtext(rast,fgx+(fgw*3/4)-(TextLength(rast,'75%',3)/2),fgy+fgh+6+screenfont.baseline,'75%',3) StringF(heystring,sl[L_PICTURE],FilePart(filename)) SetAPen(rast,1) Move(rast,fgx+(fgw/2)-(TextLength(rast,heystring,StrLen(heystring))/2),window.bordertop+3+screenfont.baseline) Text(rast,heystring,StrLen(heystring)) shadowline(rast,fgx,fgy+1+fgh,fgx,fgy+4+fgh) shadowline(rast,fgx+fgw-2,fgy+1+fgh,fgx+fgw-2,fgy+4+fgh) shadowline(rast,fgx+(fgw/2),fgy+1+fgh,fgx+(fgw/2),fgy+4+fgh) shadowline(rast,fgx+(fgw/4),fgy+1+fgh,fgx+(fgw/4),fgy+4+fgh) shadowline(rast,fgx+(fgw*3/4),fgy+1+fgh,fgx+(fgw*3/4),fgy+4+fgh) IF ((totfile<-1) OR (totfile>1)) IF totfile>1 StringF(heystring,sl[L_FILEOF],curfile,totfile) ELSE StrCopy(heystring,sl[L_NUMDIRS],ALL) ENDIF Move(rast,fgx+(fgw/2)-(TextLength(rast,heystring,StrLen(heystring))/2),window.bordertop+5+screenfont.baseline+screenfont.ysize) Text(rast,heystring,StrLen(heystring)) ENDIF ELSE IF (mode=MODE_CLI) WriteF('\n"\s" - ',filename) ENDIF ENDIF diskobj:=0;newdiskobj:=0 IF StrLen(templatename) IF (newicon) newdiskobj:=GetNewDiskObject(templatename) IF (newdiskobj) diskobj:=newdiskobj.ndo_stdobject ENDIF ELSE diskobj:=GetDiskObject(templatename) ENDIF ENDIF IF (diskobj=0) IF (newicon) newdiskobj:=GetNewDiskObject(filename) IF (newdiskobj) diskobj:=newdiskobj.ndo_stdobject ENDIF ELSE diskobj:=GetDiskObject(filename) ENDIF ENDIF StrCopy(whaticon,'ENV:sys/def_project',ALL) IF (addicon) IF (((usewhatis<>0) AND (diskobj=0))) StrCopy(file,'Icons:',ALL) IF (lock:=Lock(filename,ACCESS_READ)) AddPart(file,GetIconName(WhatIs(filename,[WI_DEEP,DEEPTYPE,NIL,NIL]:LONG)),490) StrCopy(whaticon,file,ALL) UnLock(lock) ENDIF IF (StrCmp(whaticon,'Icons:')) StrCopy(whaticon,'ENV:sys/def_project',ALL) ENDIF IF (diskobj=0) IF (newicon) newdiskobj:=GetNewDiskObject(file) IF (newdiskobj) diskobj:=newdiskobj.ndo_stdobject ENDIF ELSE diskobj:=GetDiskObject(file) ENDIF ENDIF ELSE IF (newicon) newdiskobj:=GetNewDiskObject('env:sys/def_project') IF (newdiskobj) diskobj:=newdiskobj.ndo_stdobject ENDIF ELSE diskobj:=GetDiskObject(WBPROJECT) ENDIF ENDIF ENDIF IF (diskobj=0) IF (newicon) newdiskobj:=GetNewDiskObject('ENV:sys/def_picture') IF (newdiskobj) diskobj:=newdiskobj.ndo_stdobject ENDIF ELSE diskobj:=GetDiskObject('ENV:sys/def_picture') -> Next to last resort. ENDIF ENDIF IF (diskobj=0) THEN diskobj:=GetDefDiskObject(WBPROJECT) -> Last resort. SetAPen(currast,0) SetBPen(currast,0) RectFill(currast,0,0,maxiw,maxih) IF (StrLen(backname)) IF (backobj:=GetDiskObject(backname)) IF (newicon) IF (mode=MODE_CLI) WriteF('Background template ignored.\n') ENDIF ELSE gadget:=backobj.gadget copyimagerast(currast,gadget.gadgetrender) ENDIF ENDIF ENDIF goodload:=FALSE displaypercent(1,5000) StrCopy(gaugestr,{controlstring},ALL) StrAdd(gaugestr,sl[L_PERCENT2],ALL) displaymessage(sl[L_LOADING],TRUE) IF (abort=FALSE) IF (doloaddt(filename,currast,colormap,posx,posy,sizex,sizey,[DLDT_CENTER,centerflag, DLDT_INTEGERSCALE,FALSE, DLDT_DITHER,dither, DLDT_REMAP,TRUE, DLDT_ASPECTX,aspectx, DLDT_ASPECTY,aspecty, DLDT_SCALE,TRUE, DLDT_USEASPECT,useaspect, DLDT_ENLARGE,FALSE, DLDT_CLEAR,FALSE, DLDT_GAUGE,IF ((mode=MODE_WB) OR (mode=MODE_APP)) THEN [rast,scr,fgx+3,fgy+2,fgw-8,fgh-4]:gauge ELSE 0, DLDT_CLIGAUGE,IF (mode=MODE_CLI) THEN gaugestr ELSE 0, DLDT_INFO,iinfo, DLDT_HIGHPEN,first4, DLDT_FILLCMAP,newicon, DLDT_GREYSCALE,greyscale, DLDT_QUANTIZE,quant, DLDT_RENDERHAM,renderham, DLDT_FULLHAMBASE,hambase, DLDT_DISCARDERROR,discard, DLDT_STRETCHTOFIT,stretch, IF (hamthres>=0) THEN DLDT_HAMTHRESHOLD ELSE TAG_IGNORE,hamthres, NIL,NIL])=0) goodload:=TRUE ELSE IF (addicon) displaymessage(sl[L_CREATINGICON],TRUE) ELSE displaymessage(sl[L_E_DATATYPE],TRUE);Delay(20) ENDIF ENDIF ENDIF bitsizex:=iinfo.source_w bitsizey:=iinfo.source_h black:=iinfo.blackpen white:=iinfo.whitepen -> writecolors:=limit((Shl(1,iinfo.depth)*2),1,255) writecolors:=limit(iinfo.highest_pen+1,1,256) IF showflag StringF(sizestr,'\dx\d',bitsizex,bitsizey) IF showx=-1 THEN showx:=posx+(sizex/2)-((StrLen(sizestr)*6)/2) IF showy=-1 THEN showy:=1 IF texttype=TEXT_OUTLINE FOR tttt:=-1 TO 1 FOR iiii:=-1 TO 1 showpicsize(showx+iiii,showy+tttt,black,sizestr) ENDFOR ENDFOR ENDIF IF texttype=TEXT_SHADOW THEN showpicsize(showx+1,showy+1,black,sizestr) showpicsize(showx,showy,white,sizestr) ENDIF showx:=oldshowx IF goodload IF newicon savenewicon() ELSE saveicon() ENDIF ELSE IF (addicon) whatobj:=0;newwhatobj:=0 IF (((whatobj:=GetDiskObject(filename))=0) OR (addiconoverwrite=TRUE)) IF (whatobj);FreeDiskObject(whatobj);whatobj:=0;ENDIF IF (newicon) newwhatobj:=GetNewDiskObject(whaticon) IF (newwhatobj) whatobj:=newwhatobj.ndo_stdobject ENDIF ENDIF IF (whatobj=0) whatobj:=GetDiskObjectNew(whaticon) ENDIF IF (whatobj) DeleteDiskObject(filename) IF (freeme) IF (whatobj.gadget) whatobj.gadget::gadget.leftedge:=NO_ICON_POSITION whatobj.gadget::gadget.topedge:=NO_ICON_POSITION ENDIF whatobj.currentx:=NO_ICON_POSITION whatobj.currenty:=NO_ICON_POSITION ENDIF IF ((newicon) AND (newwhatobj)) PutNewDiskObject(filename,newwhatobj) ELSE PutDiskObject(filename,whatobj) ENDIF ENDIF IF (newwhatobj) FreeNewDiskObject(newwhatobj);newwhatobj:=0;whatobj:=0 ENDIF ENDIF IF (whatobj) FreeDiskObject(whatobj);whatobj:=0 ENDIF ENDIF ENDIF Raise(E_NONE) EXCEPT IF visual THEN FreeVisualInfo(visual);visual:=NIL IF scr THEN UnlockPubScreen(0,scr);scr:=NIL IF curbitmap THEN myfreebitmap(curbitmap);curbitmap:=NIL IF currast THEN Dispose(currast);currast:=NIL IF newicon IF newdiskobj THEN FreeNewDiskObject(newdiskobj);newdiskobj:=NIL;diskobj:=NIL ELSE IF diskobj THEN FreeDiskObject(diskobj);diskobj:=NIL ENDIF IF backobj THEN FreeDiskObject(backobj);backobj:=NIL IF (newicon) IF (newcolormap) FreeColorMap(newcolormap) ENDIF ENDIF IF window WHILE (imsg:=GetMsg(window.userport)) IF (imsg.class=IDCMP_CLOSEWINDOW) abort:=TRUE ENDIF ReplyMsg(imsg);imsg:=0 ENDWHILE winx:=window.leftedge;winy:=window.topedge CloseWindow(window);window:=NIL savewinpos() ENDIF IF screenfont THEN CloseFont(screenfont);screenfont:=NIL handleexception(exception) ENDPROC PROC shadowline(rast,x1,y1,x2,y2) DEF drawinfo=NIL:PTR TO drawinfo IF ((scr=0) OR (rast=0)) THEN RETURN IF (drawinfo:=GetScreenDrawInfo(scr)) SetAPen(rast,Int(drawinfo.pens+(SHINEPEN*2))) Move(rast,x1+1,y1+1) Draw(rast,x2+1,y2+1) SetAPen(rast,Int(drawinfo.pens+(SHADOWPEN*2))) Move(rast,x1,y1) Draw(rast,x2,y2) FreeScreenDrawInfo(scr,drawinfo) ENDIF ENDPROC PROC shadowtext(rast,x1,y1,x2,y2) DEF drawinfo=NIL:PTR TO drawinfo IF ((scr=0) OR (rast=0)) THEN RETURN IF (drawinfo:=GetScreenDrawInfo(scr)) SetDrMd(rast,RP_JAM1) /* SetAPen(rast,Int(drawinfo.pens+(SHINEPEN*2))) Move(rast,x1+1,y1+1) Text(rast,x2,y2)*/ SetAPen(rast,Int(drawinfo.pens+(SHADOWPEN*2))) Move(rast,x1,y1) Text(rast,x2,y2) FreeScreenDrawInfo(scr,drawinfo) SetDrMd(rast,RP_JAM2) ENDIF ENDPROC PROC saveicon() HANDLE DEF ire DEF mydiskobj=NIL:PTR TO diskobject mydiskobj:=diskobj IF mode=MODE_CLI THEN WriteF('\n') displaymessage(sl[L_SAVING],TRUE) creatediskobj(mydiskobj,currast) IF (ire:=PutDiskObject(filename,mydiskobj))=NIL THEN Raise(L_E_NOWRITEICON) Raise(E_NONE) EXCEPT restorediskobj(mydiskobj) handleexception(exception) ENDPROC oldimage: INT 0,0,1,1,1 fillim: LONG 0 ->FILL ME CHAR 1,0 LONG 0 image: LONG $FFFF PROC savenewicon() HANDLE DEF ire,i,x,y DEF chunk=NIL:PTR TO chunkyimage,ctab=NIL,ci=NIL DEF mydiskobj=NIL:PTR TO diskobject DEF myni=NIL:PTR TO newdiskobject DEF buffer=NIL DEF file[500]:STRING NEW chunk,myni ctab:=New(260*3) ci:=New(maxiwidth*maxiheight*2) buffer:=New(20) mydiskobj:=diskobj IF mode=MODE_CLI THEN WriteF('\n') displaymessage(sl[L_SAVING],TRUE) creatediskobj(mydiskobj,currast) PutLong({fillim},{image}) mydiskobj.gadget::gadget.width:=1 mydiskobj.gadget::gadget.height:=1 mydiskobj.gadget::gadget.gadgetrender:={oldimage} myni.ndo_stdobject:=mydiskobj myni.ndo_normalimage:=chunk chunk.width:=requestsizex chunk.height:=requestsizey-1 chunk.numcolors:=writecolors+1 chunk.flags:=0 -> Color 0 in NOT transparent! chunk.palette:=ctab chunk.chunkydata:=ci FOR i:=0 TO writecolors GetRGB32(newcolormap,i,1,buffer) PutChar(ctab+(i*3)+0,Char(buffer)) PutChar(ctab+(i*3)+1,Char(buffer+4)) PutChar(ctab+(i*3)+2,Char(buffer+8)) ENDFOR FOR y:=0 TO requestsizey-1 FOR x:=0 TO requestsizex-1 PutChar(ci+(y*requestsizex)+x,ReadPixel(currast,x,y)) ENDFOR ENDFOR StrCopy(file,filename,ALL) StrAdd(file,'.info',ALL) DeleteFile(file) DeleteDiskObject(filename) IF (ire:=PutNewDiskObject(filename,myni))=NIL THEN Raise(L_E_NOWRITEICON) Raise(E_NONE) EXCEPT restorediskobj(mydiskobj) handleexception(exception) Dispose(ctab);Dispose(ci);Dispose(buffer) END chunk,myni ENDPROC PROC displaypercent(done,max) IF (mode<>MODE_CLI) IF (((mode=MODE_WB) OR (mode=MODE_APP)) AND (window) AND (rast)) SetAPen(rast,3) IF visual DrawBevelBoxA(rast,fgx,fgy,fgw,fgh,[GT_VISUALINFO,visual, GTBB_RECESSED,TRUE,GTBB_FRAMETYPE,BBFT_BUTTON,NIL,NIL]) ENDIF ENDIF ENDIF ENDPROC PROC displaymessage(msg,flag) IF mode=MODE_CLI WriteF('\s\n',msg) ELSE IF (((mode=MODE_WB) OR (mode=MODE_APP)) AND (window) AND (rast)) IF flag<>0 SetAPen(rast,0) RectFill(rast,fgx+2,fgy+1,fgx+fgw-4,fgy+fgh-2) ELSE SetDrMd(rast,RP_JAM1) ENDIF Move(rast,fgx+(fgw/2)-(TextLength(rast,msg,StrLen(msg))/2),fgy+fgh-(screenfont.ysize-screenfont.baseline)-3) SetAPen(rast,1) Text(rast,msg,StrLen(msg)) SetDrMd(rast,RP_JAM2) IF visual DrawBevelBoxA(rast,fgx,fgy,fgw,fgh,[GT_VISUALINFO,visual, GTBB_RECESSED,TRUE,GTBB_FRAMETYPE,BBFT_BUTTON,NIL,NIL]) ENDIF ENDIF ENDIF ENDPROC PROC showpicsize(x,y,p,s) DEF ii,tt,uu,mm,charptr,xptr,ysize=6 charptr:={chardata} xptr:={xdata} IF tallfont ysize:=8 charptr:={chardatal} xptr:={xdatal} ENDIF SetAPen(currast,p) FOR ii:=0 TO (StrLen(s)-1) mm:=Char(s+ii) FOR tt:=0 TO (ysize-1) FOR uu:=0 TO 5 IF mm<>"x" IF Char(charptr+uu+(tt*8)+((mm-48)*(8*ysize)))="x" WritePixel(currast,smaller(bigger(x+uu+(ii*6),0),maxiw),smaller(bigger(y+tt,0),maxih)) ENDIF ELSE IF Char(xptr+uu+(tt*8))="x" WritePixel(currast,smaller(bigger(x+uu+(ii*6),0),maxiw),smaller(bigger(y+tt,0),maxih)) ELSE ENDIF ENDIF ENDFOR ENDFOR ENDFOR ENDPROC PROC postprocessicon() DEF ii FOR ii:=0 TO 749 IF (stacked[ii]=0) stacked[ii]:=String(StrLen(filename)+6) StrCopy(stacked[ii],filename,ALL) ii:=5000 ENDIF ENDFOR ENDPROC PROC dosleep() DEF sleepobject=NIL:PTR TO diskobject DEF appobject=NIL:PTR TO diskobject DEF appport=NIL:PTR TO mp DEF appflag=NIL DEF appicon,appitem=FALSE,newproj[250]:STRING DEF lockname[250]:STRING,newlock=NIL DEF amsg:PTR TO appmessage DEF argptr:PTR TO wbarg DEF lofal DEF fh DEF agadget:PTR TO gadget DEF fileinfo=NIL:PTR TO fileinfoblock DEF fileinfo1=NIL:PTR TO fileinfoblock DEF apath=NIL:PTR TO anchorpath DEF achain=NIL:PTR TO achain DEF err,pathlen,filestart,first DEF patstr[500]:STRING DEF dirstr[500]:STRING DEF dumstr[500]:STRING,i StrCopy(appname,sleepername,ALL) IF (sleepobject:=GetDiskObject(appname))=NIL IF (sleepobject:=GetDiskObject('ENV:SYS/def_appicon'))=NIL StrCopy(appname,progname,ALL) IF (sleepobject:=GetDiskObject(appname))=NIL sleepobject:=GetDefDiskObject(WBTOOL) ENDIF ENDIF ENDIF IF sleepobject sleepobject.type:=NIL appobject:=sleepobject agadget:=appobject.gadget IF appx<0 agadget.leftedge:=NO_ICON_POSITION appobject.currentx:=NO_ICON_POSITION ELSE agadget.leftedge:=appx appobject.currentx:=appx ENDIF IF appy<0 agadget.topedge:=NO_ICON_POSITION appobject.currenty:=NO_ICON_POSITION ELSE agadget.topedge:=appy appobject.currenty:=appy ENDIF IF (appport:=CreateMsgPort()) IF (appicon:=AddAppIconA(0,0,'Picticon',appport,0,appobject,NIL))<>NIL IF (noappitem<>TRUE) appitem:=AddAppMenuItemA(0,0,'Picticon',appport,0) ENDIF IF ((appitem) OR (noappitem=TRUE)) WHILE appflag=NIL WaitPort(appport) WHILE (amsg:=GetMsg(appport))<>NIL IF amsg.numargs=0 IF EasyRequestArgs(0, [20, 0, sl[L_TITLE], sl[L_BODY],sl[L_BUTTONS]], 0, 0) appflag:=TRUE ENDIF ELSE abort:=FALSE argptr:=amsg.arglist curfile:=0 FOR lofal:=1 TO amsg.numargs totfile:=amsg.numargs curfile:=curfile+1 StrCopy(newproj,argptr.name,ALL) newlock:=argptr.lock IF newlock IF (fileinfo1:=AllocDosObject(DOS_FIB,NIL)) NameFromLock(newlock,lockname,250) processname(filename,lockname,newproj) IF (fh:=Lock(filename,ACCESS_READ)) Examine(fh,fileinfo1) IF (fileinfo1.direntrytype>0) StrCopy(patstr,filename,ALL) StrCopy(dirstr,filename,ALL) AddPart(patstr,'~(#?.info)',490) apath:=New(SIZEOF anchorpath) first:=FALSE err:=0 WHILE err=NIL IF first=FALSE err:=MatchFirst(patstr,apath) first:=TRUE ELSE err:=MatchNext(apath) ENDIF IF err=NIL achain:=apath.last IF (achain) fileinfo:=achain.info IF (fileinfo) IF (fileinfo.direntrytype<0) StrCopy(filename,dirstr,ALL) AddPart(filename,fileinfo.filename,490) StrCopy(dumstr,filename,ALL) UpperStr(dumstr) IF (InStr(dumstr,'.INFO')<0) totfile:=-2 postprocessicon() ENDIF ENDIF ENDIF ENDIF ENDIF ENDWHILE MatchEnd(apath) Dispose(apath) FOR i:=0 TO 749 IF stacked[i]<>0 StrCopy(filename,stacked[i],ALL) processicon() ENDIF IF CtrlC();i:=5000;appflag:=TRUE;ENDIF IF (abort);i:=5000;ENDIF ENDFOR FOR i:=0 TO 749 IF stacked[i]<>0 DisposeLink(stacked[i]) stacked[i]:=0 ENDIF ENDFOR ELSE IF (fileinfo1.direntrytype<0) processicon() ENDIF ENDIF UnLock(fh) ENDIF FreeDosObject(DOS_FIB,fileinfo1) ENDIF ENDIF argptr:=argptr+(SIZEOF wbarg) IF CtrlC();lofal:=50000;appflag:=TRUE;ENDIF IF (abort<>FALSE);lofal:=50000;ENDIF ENDFOR ENDIF ReplyMsg(amsg) ENDWHILE ENDWHILE IF (appitem) THEN RemoveAppMenuItem(appitem);appitem:=0 ENDIF RemoveAppIcon(appicon) ENDIF WHILE (amsg:=GetMsg(appport))<>NIL ReplyMsg(amsg) ENDWHILE DeleteMsgPort(appport) ENDIF IF sleepobject THEN FreeDiskObject(sleepobject);sleepobject:=NIL ENDIF ENDPROC yes: CHAR 'YES',0 no: CHAR 'NO',0 true: CHAR 'TRUE',0 false: CHAR 'FALSE',0 PROC handwb() DEF wb:PTR TO wbstartup,args:PTR TO wbarg DEF argarray[40]:LIST,olddir,rdarg,s,wstr[500]:STRING DEF locs,namesptr:PTR TO LONG,patternstr[500]:STRING DEF fileinfo=NIL:PTR TO fileinfoblock DEF achain=NIL:PTR TO achain DEF err=0,pathlen,filestart,first=0,chance=1 DEF newdate=NIL:PTR TO datestamp DEF apath=NIL:PTR TO anchorpath,i IF wbmessage<>NIL /* E provides us with WB's startup message in this variable */ wb:=wbmessage;args:=wb.arglist olddir:=CurrentDir(args.lock) IF args.name>0 GetCurrentDirName(progname,500) StrAdd(progname,args.name,ALL) toolobject:=GetDiskObjectNew(progname) ENDIF IF toolobject<>NIL /* If we succeded in opening our program icon. */ IF s:=FindToolType(toolobject.tooltypes,'MAXIWIDTH') StrToLong(s,{maxiwidth}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'MAXIHEIGHT') StrToLong(s,{maxiheight}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'APPICON') StrCopy(sleepername,s,ALL) ENDIF IF s:=FindToolType(toolobject.tooltypes,'NOAPPITEM') IF yup(s) THEN noappitem:=TRUE ENDIF IF s:=FindToolType(toolobject.tooltypes,'TEMPLATE_ICON') StrCopy(templatename,s,ALL) ENDIF IF s:=FindToolType(toolobject.tooltypes,'BACKGROUND_ICON') StrCopy(backname,s,ALL) ENDIF IF s:=FindToolType(toolobject.tooltypes,'CHUNKYMODE') chunkyflag:=yup(s) ENDIF IF s:=FindToolType(toolobject.tooltypes,'FORCE_EIGHT') force8:=yup(s) ENDIF IF s:=FindToolType(toolobject.tooltypes,'CENTER') centerflag:=yup(s) ENDIF IF s:=FindToolType(toolobject.tooltypes,'HIGHPEN') StrToLong(s,{first4}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'FIRSTFOUR') IF yup(s) THEN first4:=3 ENDIF IF s:=FindToolType(toolobject.tooltypes,'FREE_ICON_POS') freeme:=yup(s) ENDIF IF s:=FindToolType(toolobject.tooltypes,'PIC_X_POS') StrToLong(s,{posx}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'PIC_Y_POS') StrToLong(s,{posy}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'APP_X_POS') StrToLong(s,{appx}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'APP_Y_POS') StrToLong(s,{appy}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'PIC_X_SIZE') StrToLong(s,{sizex}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'PIC_Y_SIZE') StrToLong(s,{sizey}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_X') StrToLong(s,{showx}) showflag:=TRUE ENDIF IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_Y') StrToLong(s,{showy}) showflag:=TRUE ENDIF IF s:=FindToolType(toolobject.tooltypes,'ASPECT_X') StrToLong(s,{aspectx}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'QUANTIZE') StrToLong(s,{quant}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'ASPECT_Y') StrToLong(s,{aspecty}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'HAMTHRESHOLD') StrToLong(s,{hamthres}) ENDIF IF s:=FindToolType(toolobject.tooltypes,'LOWPRI') IF yup(s) THEN SetTaskPri(FindTask(0),-1) ENDIF IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_OUTLINE') IF yup(s) texttype:=TEXT_OUTLINE ENDIF ENDIF IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_NORMAL') IF yup(s) texttype:=TEXT_NORMAL ENDIF ENDIF IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_TALL') IF yup(s) tallfont:=TRUE ENDIF ENDIF IF s:=FindToolType(toolobject.tooltypes,'QUIET') IF yup(s) quietflag:=TRUE mode:=MODE_QUIET ENDIF ENDIF IF s:=FindToolType(toolobject.tooltypes,'ADDICON') IF yup(s) THEN addicon:=TRUE ENDIF IF s:=FindToolType(toolobject.tooltypes,'OVERWRITE') IF yup(s) THEN addiconoverwrite:=TRUE ENDIF IF s:=FindToolType(toolobject.tooltypes,'DITHER') IF nope(s) dither:=FALSE ENDIF ENDIF IF s:=FindToolType(toolobject.tooltypes,'NEWICON') IF yup(s) IF (newiconbase) newicon:=TRUE ENDIF ENDIF ENDIF IF s:=FindToolType(toolobject.tooltypes,'WHATIS') IF nope(s) THEN usewhatis:=FALSE ENDIF IF s:=FindToolType(toolobject.tooltypes,'STRETCH') IF yup(s) THEN stretch:=TRUE ENDIF IF s:=FindToolType(toolobject.tooltypes,'RENDERHAM6') IF yup(s) THEN renderham:=6 ENDIF IF s:=FindToolType(toolobject.tooltypes,'RENDERHAM8') IF yup(s) THEN renderham:=8 ENDIF IF s:=FindToolType(toolobject.tooltypes,'FULLHAMBASE') IF yup(s) THEN hambase:=TRUE ENDIF IF s:=FindToolType(toolobject.tooltypes,'DISCARDERROR') IF yup(s) THEN discard:=TRUE ENDIF IF s:=FindToolType(toolobject.tooltypes,'GREYSCALE') IF yup(s) THEN greyscale:=1 ENDIF IF s:=FindToolType(toolobject.tooltypes,'LUMSCALE') IF yup(s) THEN greyscale:=2 ENDIF ENDIF IF wb.numargs>1 totfile:=wb.numargs-1 curfile:=1 abort:=FALSE FOR locs:=2 TO wb.numargs olddir:=args[].lock++ IF args.lock olddir:=CurrentDir(args.lock) GetCurrentDirName(filename,250) NameFromLock(args.lock,wstr,240) CurrentDir(olddir) processname(filename,wstr,args.name) mode:=MODE_WB enforcemax() processicon() ENDIF curfile:=curfile+1 IF CtrlC();locs:=50000;ENDIF IF (abort<>0);locs:=50000;ENDIF ENDFOR ELSE mode:=MODE_APP enforcemax() dosleep() ENDIF ELSE mode:=MODE_CLI FOR scratch:=0 TO 39 argarray[scratch]:=NIL ENDFOR rdarg:=ReadArgs('FILE/A/M,TI=TEMPLATE/K,BI=BACKICON/K,MW=MAXIWIDTH/K/N,MH=MAXIHEIGHT/K/N,PX=PICXPOS/K/N,PY=PICYPOS/K/N,PW=PICXSIZE/K/N,PH=PICYSIZE/K/N,SSX=SHOWSIZEX/K/N,SSY=SHOWSIZEY/K/N,HP=HIGHPEN/K/N,QZ=QUANTIZE/K/N,THRES=HAMTHRESHOLD/K/N,NOD=NODITHER/S,C=CENTER/S,FF=FIRSTFOUR/S,FIP=FREEICONPOS/S,CM=CHUNKY/S,F8=FORCEEIGHT/S,SSOL=SHOWSIZEOUTLINE/S,SSN=SHOWSIZENORMAL/S,SST=SHOWSIZETALL/S,LP=LOWPRI/S,Q=QUIET/S,AX=ASPECTX/N,AY=ASPECTY/N,IA=IGNOREASPECT/S,NWI=NOWHATIS/S,NI=NEWICON/S,GS=GREYSCALE/S,LUM=LUMSCALE/S,HAM6=RENDERHAM6/S,HAM8=RENDERHAM8/S,FHB=FULLHAMBASE/S,DE=DISCARDERROR/S,S=STRETCH/S',argarray,0) IF rdarg IF argarray[1] StrCopy(templatename,argarray[1],ALL) stripinfo(templatename) ENDIF IF argarray[2] StrCopy(backname,argarray[2],ALL) stripinfo(backname) ENDIF IF argarray[3] maxiwidth:=argarray[3] maxiwidth:=^maxiwidth ENDIF IF argarray[4] maxiheight:=argarray[4] maxiheight:=^maxiheight ENDIF IF argarray[5] posx:=argarray[5] posx:=^posx ENDIF IF argarray[6] posy:=argarray[6] posy:=^posy ENDIF IF argarray[7] sizex:=argarray[7] sizex:=^sizex ENDIF IF argarray[8] sizey:=argarray[8] sizey:=^sizey ENDIF IF argarray[9] showx:=argarray[9] showx:=^showx showflag:=TRUE ENDIF IF argarray[10] showy:=argarray[10] showy:=^showy showflag:=TRUE ENDIF IF argarray[11] first4:=argarray[11] first4:=^first4 ENDIF IF argarray[12] quant:=argarray[12] quant:=^quant ENDIF IF argarray[13] hamthres:=argarray[12] hamthres:=^hamthres ENDIF IF argarray[14] THEN dither:=FALSE IF argarray[15] THEN centerflag:=TRUE IF argarray[16] THEN first4:=3 IF argarray[17] THEN freeme:=TRUE IF argarray[18] THEN chunkyflag:=TRUE IF argarray[19] THEN force8:=TRUE IF argarray[20] THEN texttype:=TEXT_OUTLINE IF argarray[21] THEN texttype:=TEXT_NORMAL IF argarray[22] THEN tallfont:=TRUE IF argarray[23] THEN SetTaskPri(FindTask(0),-1) IF argarray[24];quietflag:=TRUE;mode:=MODE_QUIET;ENDIF IF argarray[25] aspectx:=argarray[25] aspectx:=limit(^aspectx,1,100) ENDIF IF argarray[26] aspecty:=argarray[26] aspecty:=limit(^aspecty,1,100) ENDIF IF argarray[27] THEN useaspect:=FALSE IF argarray[28] THEN usewhatis:=FALSE IF argarray[29] IF (newiconbase) newicon:=TRUE ENDIF ENDIF IF argarray[30] THEN greyscale:=1 IF argarray[31] THEN greyscale:=2 IF argarray[32] THEN renderham:=6 IF argarray[33] THEN renderham:=8 IF argarray[34] THEN hambase:=TRUE IF argarray[35] THEN discard:=TRUE IF argarray[36] THEN stretch:=TRUE enforcemax() IF argarray[0] namesptr:=argarray[0] err:=NIL WHILE ((namesptr[0]) AND (err=NIL)) StrCopy(patternstr,namesptr[0],ALL) apath:=New(SIZEOF anchorpath) first:=FALSE WHILE err=NIL IF first=FALSE err:=MatchFirst(patternstr,apath) first:=TRUE ELSE err:=MatchNext(apath) ENDIF IF err=NIL achain:=apath.last IF (achain) fileinfo:=achain.info IF (fileinfo) IF (fileinfo.direntrytype<0) filestart:=FilePart(patternstr) pathlen:=filestart-patternstr IF (pathlen) StrCopy(filename,patternstr,pathlen) ELSE StrCopy(filename,'',ALL) ENDIF AddPart(filename,fileinfo.filename,490) StrCopy(dumstr,filename,ALL) UpperStr(dumstr) IF (InStr(dumstr,'.INFO')<0) postprocessicon() ENDIF ENDIF ENDIF ENDIF ENDIF ENDWHILE MatchEnd(apath) Dispose(apath) FOR i:=0 TO 749 IF stacked[i]<>0 StrCopy(filename,stacked[i],ALL) processicon() ENDIF IF CtrlC();i:=5000;WriteF('***Break\n');ENDIF ENDFOR FOR i:=0 TO 749 IF stacked[i]<>0 DisposeLink(stacked[i]) stacked[i]:=0 ENDIF ENDFOR namesptr:=namesptr+4 IF err<>87 THEN err:=0 ENDWHILE StrCopy(filename,argarray[0],ALL) ENDIF FreeArgs(rdarg);rdarg:=NIL ENDIF ENDIF ENDPROC PROC enforcemax() IF maxiwidth<32 THEN maxiwidth:=32 IF maxiwidth>1024 THEN maxiwidth:=1024 IF maxiheight<32 THEN maxiheight:=32 IF maxiheight>1024 THEN maxiheight:=1024 IF (newicon) IF maxiwidth>92 THEN maxiwidth:=92 IF maxiheight>92 THEN maxiheight:=92 ENDIF maxiw:=maxiwidth-1 maxih:=maxiheight-1 IF quietflag mode:=MODE_QUIET ENDIF IF sizex>maxiw THEN sizex:=maxiw IF sizey>maxih THEN sizey:=maxih IF posx>=maxiw THEN posx:=maxiw-1 IF posy>=maxih THEN posy:=maxih-1 IF posx+sizex>maxiw THEN sizex:=maxiw-posx IF posy+sizey>maxih THEN sizey:=maxih-posy IF ((posx) OR (posy) OR (sizex) OR (sizey)) THEN posflag:=TRUE IF sizex=0 THEN sizex:=maxiw-posx IF sizey=0 THEN sizey:=maxih-posy ENDPROC PROC loadcatalog() IF localebase catalog:=OpenCatalogA(NIL,'picticon.catalog',[OC_BUILTINLANGUAGE,'english',NIL,NIL]) ENDIF readstrings() FOR scratch:=0 TO L_ENDS sl[scratch]:=locale(scratch) ENDFOR ENDPROC PROC locale(strnum) DEF stpoint,defstr defstr:=sl[strnum] IF ((localebase) AND (catalog)) stpoint:=GetCatalogStr(catalog,strnum,defstr) ELSE stpoint:=defstr ENDIF ENDPROC stpoint PROC readstrings() DEF buf,res=0 buf:={catstrs} WHILE(Int(buf))<>0 res:=res+1 IF res>0 AND res<300 sl[res]:=buf ENDIF WHILE Char(buf)<>"¶" buf:=buf+1 ENDWHILE PutChar(buf,0) buf:=buf+1 buf:=(Mul(Div((buf+1),2),2)) ENDWHILE ENDPROC PROC savewinpos() HANDLE DEF buffer=NIL,fhand=0 IF ((mode=MODE_CLI) OR (mode=MODE_QUIET)) THEN RETURN iff:=AllocIFF() IF (iff) fhand:=Open('ENV:Picticon.prefs',MODE_NEWFILE) iff.stream:=fhand IF (iff.stream)=NIL THEN Raise(E_NONE) InitIFFasDOS(iff) buffer:=New(100) ierror:=OpenIFF(iff,IFFF_WRITE) IF ierror THEN Raise(E_NONE) PushChunk(iff,"PREF","FORM",IFFSIZE_UNKNOWN) PushChunk(iff,"PREF","PRHD",IFFSIZE_UNKNOWN) PutLong(buffer,0);PutLong(buffer+2,0) WriteChunkBytes(iff,buffer,6) PopChunk(iff) PushChunk(iff,"PREF","WIND",IFFSIZE_UNKNOWN) dumb:=buffer PutLong(dumb,winx);PutLong(dumb+4,winy) WriteChunkBytes(iff,buffer,8) PopChunk(iff) PopChunk(iff) ENDIF Raise(E_NONE) EXCEPT IF buffer THEN Dispose(buffer);buffer:=NIL freeiff(666) handleexception(exception) ENDPROC PROC loadwinpos() HANDLE DEF buffer=NIL iff:=AllocIFF() iff.stream:=Open('ENV:Picticon.prefs',MODE_OLDFILE) IF (iff.stream)=NIL THEN Raise(E_NONE) InitIFFasDOS(iff) buffer:=New(100) ierror:=OpenIFF(iff,IFFF_READ) IF ierror THEN Raise(E_NONE) ierror:=PropChunk(iff,"PREF","WIND") ierror:=StopOnExit(iff,"PREF","FORM") ierror:=ParseIFF(iff,IFFPARSE_SCAN) IF (sp:=FindProp(iff,"PREF","WIND")) dumb:=sp.data winx:=Long(dumb);winy:=Long(dumb+4) ENDIF Raise(E_NONE) EXCEPT IF buffer THEN Dispose(buffer) freeiff(666) handleexception(exception) ENDPROC PROC freeiff(unit) IF iff CloseIFF(iff) IF (iff.stream) THEN Close(iff.stream) FreeIFF(iff) iff:=NIL ENDIF ENDPROC PROC openlibs() IF (aslbase:=OpenLibrary('asl.library', 36))=NIL THEN CleanUp(25) localebase:=OpenLibrary('locale.library',37) loadcatalog() mathbase:=safeopenlibrary('mathffp.library',39) datatypesbase:=safeopenlibrary('datatypes.library',39) mathtransbase:=safeopenlibrary('mathtrans.library',36) gadtoolsbase:=safeopenlibrary('gadtools.library',36) workbenchbase:=safeopenlibrary('workbench.library',36) iconbase:=safeopenlibrary('icon.library', 36) iffparsebase:=safeopenlibrary('iffparse.library',36) diskfontbase:=safeopenlibrary('diskfont.library', 36) whatisbase:=OpenLibrary('whatis.library', 3);IF whatisbase=0 THEN usewhatis:=0 newiconbase:=OpenLibrary('newicon.library', 37) IF KickVersion(39);osversion:=TRUE;ELSE;osversion:=FALSE;ENDIF ENDPROC PROC safeopenlibrary(name,vers) HANDLE DEF lret IF ((lret:=OpenLibrary(name,vers))=NIL) THEN Raise(L_EF_LIBRARY) Raise(E_NONE) EXCEPT handleexception(exception) ENDPROC lret PROC handleexception(except) IF except<>E_NONE THEN errormessage(except) IF quitter THEN leave(quitter) ENDPROC PROC closelibs() IF whatisbase THEN CloseLibrary(whatisbase) IF newiconbase THEN CloseLibrary(newiconbase) IF diskfontbase THEN CloseLibrary(diskfontbase) IF aslbase THEN CloseLibrary(aslbase) IF iffparsebase THEN CloseLibrary(iffparsebase) IF iconbase THEN CloseLibrary(iconbase) IF workbenchbase THEN CloseLibrary(workbenchbase) IF gadtoolsbase THEN CloseLibrary(gadtoolsbase) IF datatypesbase THEN CloseLibrary(datatypesbase) IF layersbase THEN CloseLibrary(layersbase) IF keymapbase THEN CloseLibrary(keymapbase) IF mathbase THEN CloseLibrary(mathbase) IF mathtransbase THEN CloseLibrary(mathtransbase) IF localebase THEN CloseLibrary(localebase) ENDPROC PROC errormessage(errnum) IF errnum>=L_EF_FATAL errmsg(sl[errnum]) quitter:=TRUE ELSE IF errnum>=L_E_GENERAL errmsg(sl[errnum]) ELSE errmsg(sl[L_E_GENERAL]) ENDIF ENDIF ENDPROC PROC errmsg(msgptr) IF mode=MODE_CLI WriteF('\s\n\n',msgptr) ELSE IF ((mode=MODE_WB) OR (mode=MODE_APP)) displaymessage(msgptr,TRUE) Delay(80) ENDIF ENDIF ENDPROC PROC sp_div_tf_tf_f(int1,int2) RETURN SpDiv(SpFlt(int1),SpFlt(int2)) ENDPROC PROC leave(flag) IF catalog THEN CloseCatalog(catalog) IF appimagedata THEN FreeMem(appimagedata,3200);appimagedata:=NIL IF curbitmap THEN myfreebitmap(curbitmap);curbitmap:=NIL IF newicon IF newdiskobj THEN FreeNewDiskObject(newdiskobj);newdiskobj:=NIL;diskobj:=NIL ELSE IF diskobj THEN FreeDiskObject(diskobj);diskobj:=NIL ENDIF IF visual THEN FreeVisualInfo(visual);visual:=NIL IF toolobject THEN FreeDiskObject(toolobject);toolobject:=NIL closelibs() END iinfo IF flag IF flag=TRUE CleanUp(0) ELSE CleanUp(flag) ENDIF ENDIF ENDPROC PROC myallocbitmap(w,h,d,type,tags) IF osversion=TRUE RETURN AllocBitMap(w,h,d,type,tags) ENDIF ENDPROC PROC myfreebitmap(bm) IF osversion=TRUE RETURN FreeBitMap(bm) ELSE ENDIF ENDPROC /*PROC findcolor(colap,ared,agrn,ablu) DEF pointred,pointgrn,pointblu,mpen mpen:=-1 IF (first4>0) THEN mpen:=first4 pointred:=Shl(Shl(Shl(ared,8),8),8) pointgrn:=Shl(Shl(Shl(agrn,8),8),8) pointblu:=Shl(Shl(Shl(ablu,8),8),8) RETURN FindColor(colap,pointred,pointgrn,pointblu,mpen) ENDPROC */ /*PROC mygetrgb32(colmap,first,ncolors,table) DEF rre,eee IF osversion=TRUE GetRGB32(colmap,first,ncolors,table) ELSE rre:=GetRGB4(colmap,first) eee:=(rre AND $F) PutChar(table,eee) PutChar(table+1,eee) PutChar(table+2,eee) PutChar(table+3,eee) eee:=Shr((rre AND $F0),4) PutChar(table+4,eee) PutChar(table+5,eee) PutChar(table+6,eee) PutChar(table+7,eee) eee:=Shr((rre AND $F00),8) PutChar(table+8,eee) PutChar(table+9,eee) PutChar(table+10,eee) PutChar(table+11,eee) ENDIF ENDPROC*/ PROC processname(name,dir,file) DEF wish[20]:STRING StrCopy(name,dir,ALL) IF StrLen(file) /* IF a file (NOT DISK/DRAWER) */ RightStr(wish,name,1) IF StrCmp(wish,':',1)=NIL /* DISK:DIR/NAME */ StrAdd(name,'/',ALL) ENDIF StrAdd(name,file,ALL) ELSE RightStr(wish,name,1) IF StrCmp(wish,':',1) /* DISK: (so add disk) */ StrAdd(name,'disk',ALL) ENDIF IF StrCmp(wish,'/',1) /* DISK:DIR/DIR/ (delete '/' */ MidStr(name,name,0,StrLen(name)-1) ENDIF ENDIF MidStr(wish,name,0,1) IF StrCmp(wish,'/',1) MidStr(name,name,1,ALL) ENDIF stripinfo(name) ENDPROC PROC stripinfo(name) DEF comp1[6]:STRING,comp2[6]:STRING StrCopy(comp1,'.INFO',ALL) MidStr(comp2,name,StrLen(name)-5,5) UpperStr(comp2) IF StrCmp(comp1,comp2,5) MidStr(name,name,0,(StrLen(name)-5)) ENDIF ENDPROC /*PROC grabrgbtables() DEF cmtable cmtable:=[0,0,0,0,0,0]:LONG FOR scratch:=0 TO Shl(1,depth)-1 mygetrgb32(newcolormap,scratch,1,cmtable) redt[scratch]:=Char(cmtable) grnt[scratch]:=Char(cmtable+4) blut[scratch]:=Char(cmtable+8) ENDFOR ENDPROC */ PROC stripselect(flags) IF (flags AND GFLG_GADGHIMAGE) THEN flags:=flags-GFLG_GADGHIMAGE IF (flags AND GFLG_GADGHCOMP) THEN flags:=flags-GFLG_GADGHCOMP IF (flags AND GADGBACKFILL) THEN flags:=flags-GADGBACKFILL ENDPROC flags PROC copybitmap2image(sb,di,nb,ys,dp,savedepth) DEF plane,cp,cr,cb,byte,sbs=NIL:PTR TO mybitmapstruct sbs:=sb;byte:=di FOR plane:=1 TO savedepth IF plane>dp /* If save plane is not edited, use highest that was */ SELECT dp CASE 1;cp:=sbs.plane1 CASE 2;cp:=sbs.plane2 CASE 3;cp:=sbs.plane3 CASE 4;cp:=sbs.plane4 CASE 5;cp:=sbs.plane5 CASE 6;cp:=sbs.plane6 CASE 7;cp:=sbs.plane7 CASE 8;cp:=sbs.plane8 ENDSELECT ELSE SELECT plane CASE 1;cp:=sbs.plane1 CASE 2;cp:=sbs.plane2 CASE 3;cp:=sbs.plane3 CASE 4;cp:=sbs.plane4 CASE 5;cp:=sbs.plane5 CASE 6;cp:=sbs.plane6 CASE 7;cp:=sbs.plane7 CASE 8;cp:=sbs.plane8 ENDSELECT ENDIF FOR cr:=0 TO ys-1 FOR cb:=0 TO nb-1 MOVE.L byte,A0 MOVE.L cp,A1 MOVE.B (A1),(A0) byte:=byte+1;cp:=cp+1 ENDFOR cp:=cp+(sbs.bytesperrow-nb) ENDFOR ENDFOR ENDPROC PROC copyrast2image(sb,di,nb,ys,dp,savedepth) DEF plane,cp,cr,cb,byte,sbs=NIL:PTR TO mybitmapstruct byte:=di FOR plane:=0 TO savedepth-1 ditz:=Shl(1,smaller(plane,dp)) FOR cr:=0 TO ys-1 FOR cb:=0 TO nb-1 body:=0 FOR dang:=7 TO 0 STEP -1 dumb:=ReadPixel(sb,(cb*8)+(7-dang),cr) IF (dumb AND ditz) THEN body:=(body OR Shl(1,dang)) ENDFOR PutChar(byte,body) byte:=byte+1 ENDFOR ENDFOR ENDFOR ENDPROC PROC findsize(rast1) DEF li,lt,a requestsizex:=NIL;requestsizey:=NIL FOR li:=0 TO maxih;FOR lt:=0 TO maxiw a:=ReadPixel(rast1,lt,li) IF (a) IF lt>requestsizex;requestsizex:=lt;ENDIF IF li>requestsizey;requestsizey:=li;ENDIF ENDIF IF a>highestcolor;highestcolor:=a;ENDIF ENDFOR;ENDFOR requestsizex:=requestsizex+1;requestsizey:=requestsizey+2 ENDPROC PROC restorediskobj(diskobj:PTR TO diskobject) DEF gadget:PTR TO gadget gadget:=diskobj.gadget gadget.gadgetrender:=k[0] gadget.selectrender:=k[1] gadget.flags:=k[2] diskobj.drawerdata:=k[3] Dispose(k[4]);k[4]:=NIL Dispose(k[5]);k[5]:=NIL Dispose(k[6]);k[6]:=NIL diskobj.type:=k[7] IF k[9] THEN FreeMem(k[9], k[8]) IF k[10] THEN FreeMem(k[10],k[8]) k[9]:=NIL k[10]:=NIL ENDPROC PROC creatediskobj(diskobj:PTR TO diskobject,rast1:PTR TO rastport) HANDLE DEF gadget:PTR TO gadget DEF iconsizex,iconsizey,highplane DEF numbyteswide,savedepthhow,sizetmp DEF i1:PTR TO image,i2:PTR TO image DEF bitm1 gadget:=diskobj.gadget k[0]:=gadget.gadgetrender k[1]:=gadget.selectrender k[2]:=gadget.flags k[3]:=diskobj.drawerdata k[4]:=New(SIZEOF image) k[5]:=New(SIZEOF image) k[6]:=New(SIZEOF drawerdata) k[7]:=diskobj.type k[8]:=0 k[9]:=0 highestcolor:=0 bitm1:=curbitmap findsize(rast1) iconsizex:=bigger(bigger(requestsizex,10),minimumx) iconsizey:=bigger(bigger(requestsizey,10),minimumy) numbyteswide:=((iconsizex+15)/16)*2 savedepthhow:=depth IF (force8) THEN savedepthhow:=8 sizetmp:=(numbyteswide*iconsizey*savedepthhow)+1000 k[8]:=sizetmp k[9]:=AllocMem(sizetmp,(MEMF_CHIP OR MEMF_CLEAR)) k[10]:=AllocMem(sizetmp,(MEMF_CHIP OR MEMF_CLEAR)) IF ((k[9]=NIL) OR (k[10]=NIL)) THEN Raise(L_EF_CHIPBUFFER) IF chunkyflag=NIL copybitmap2image(bitm1,k[9],numbyteswide,iconsizey-1,depth,savedepthhow) ELSE copyrast2image(rast1,k[9],numbyteswide,iconsizey-1,depth,savedepthhow) ENDIF i1:=k[4];i2:=k[5] i1.leftedge:=0;i1.topedge:=0;i1.width:=iconsizex i1.height:=iconsizey-1;i1.depth:=8;i1.imagedata:=k[9] i1.planepick:=0;i1.planeonoff:=0;i1.nextimage:=NIL i2.leftedge:=0;i2.topedge:=0;i2.width:=iconsizex i2.height:=iconsizey-1;i2.depth:=8;i2.imagedata:=k[10] i2.planepick:=0;i2.planeonoff:=0;i2.nextimage:=NIL highplane:=1 IF highestcolor>1;highplane:=2;ENDIF IF highestcolor>3;highplane:=3;ENDIF IF highestcolor>7;highplane:=4;ENDIF IF highestcolor>15;highplane:=5;ENDIF IF highestcolor>31;highplane:=6;ENDIF IF highestcolor>63;highplane:=7;ENDIF IF highestcolor>127;highplane:=8;ENDIF IF (force8) i1.depth:=8 i2.depth:=8 ELSE i1.depth:=highplane i2.depth:=highplane ENDIF gadget.width:=iconsizex;gadget.height:=iconsizey;gadget.gadgetrender:=i1 gadget.selectrender:=NIL IF freeme=TRUE diskobj.currentx:=NO_ICON_POSITION diskobj.currenty:=NO_ICON_POSITION ENDIF gadget.flags:=stripselect(gadget.flags) gadget.flags:=(gadget.flags OR GFLG_GADGHCOMP) diskobj.type:=WBPROJECT Raise(E_NONE) EXCEPT IF exception<>E_NONE errormessage(exception) ENDIF IF quitter THEN leave(quitter) ENDPROC PROC yup(s) IS (MatchToolValue(s,{yes}) OR MatchToolValue(s,{true})) PROC nope(s) IS (MatchToolValue(s,{no}) OR MatchToolValue(s,{false})) PROC threshold(val,th);IF Abs(val)<=th THEN RETURN 0;ENDPROC val PROC domethod( obj:PTR TO object, msg:PTR TO msg ) DEF h:PTR TO hook, o:PTR TO object, dispatcher IF obj o := obj-SIZEOF object /* instance data is to negative offset */ h := o.class dispatcher := h.entry /* get dispatcher from hook in iclass */ MOVEA.L h,A0 MOVEA.L msg,A1 MOVEA.L obj,A2 /* probably should use CallHookPkt, but the */ MOVEA.L dispatcher,A3 /* original code (DoMethodA()) doesn't. */ JSR (A3) /* call classDispatcher() */ MOVE.L D0,o RETURN o ENDIF ENDPROC NIL PROC copyimagerast(rastp:PTR TO rastport,image) DrawImage(rastp,image,0,0) ENDPROC catstrs: CHAR 'Ok¶' CHAR 'Error: A general error has occured.¶' CHAR 'Error: File not found.¶' CHAR 'Error: Could not open file.¶' CHAR 'Error: Problems with icon.¶' CHAR 'Error: Unable to write icon file.¶' CHAR 'Error: Problems opening clipboard.¶' CHAR 'Error: Problems with datatype.¶' CHAR 'Error: Datatype is not a picture.¶' CHAR 'Error: Problems creating gadgets.¶' CHAR 'Error: Could not open a required library.¶' CHAR 'Error: An undefined FATAL error has occured.¶' CHAR 'Fatal Error: Could not lock a public screen.¶' CHAR 'Fatal Error: Not enough CHIP memory\n for a required buffer.¶' CHAR 'Fatal Error: Could not obtain a visual lock.¶' CHAR 'Fatal Error: Unable to create menus.¶' CHAR 'Fatal Error: Could not open a port.¶' CHAR 'Fatal Error: Unable to open window.¶' CHAR 'Error: Unable to allocate some memory.¶' CHAR 'Picticon Status¶' CHAR 'Picture "\s"¶' CHAR '(\d of \d items)¶' CHAR 'Loading...¶' CHAR '*¶' CHAR '*¶' CHAR 'Saving icon.¶' CHAR '*¶' CHAR 'Picticon¶' CHAR 'Copyright ©1993,94\n by Chad Randall\n\nThis software is freely re-distributable.\n\nDo you wish to quit?¶' CHAR 'Quit|Cancel¶' CHAR 'Rendering...¶' CHAR '(\d%% done.)¶' CHAR '(directory)¶' CHAR 'Creating icon...¶' LONG 0,0,0 chardata: CHAR '.xxx...' CHAR 'x...x..' CHAR 'x...x..' CHAR 'x...x..' CHAR 'x...x..' CHAR '.xxx...' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR 'xxxxx..' CHAR '....x..' CHAR '..xxx..' CHAR '.x.....' CHAR 'x......' CHAR 'xxxxx..' CHAR 'xxxx...' CHAR '....x..' CHAR '..xx...' CHAR '....x..' CHAR '....x..' CHAR 'xxxx...' CHAR '...x...' CHAR '..xx...' CHAR '.x.x...' CHAR 'xxxxx..' CHAR '...x...' CHAR '...x...' CHAR 'xxxxx..' CHAR 'x......' CHAR 'xxxx...' CHAR '....x..' CHAR '....x..' CHAR 'xxxx...' CHAR '.xxx...' CHAR 'x......' CHAR 'xxxx...' CHAR 'x...x..' CHAR 'x...x..' CHAR '.xxx...' CHAR 'xxxxx..' CHAR '....x..' CHAR '...x...' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR '.xxx...' CHAR 'x...x..' CHAR '.xxx...' CHAR 'x...x..' CHAR 'x...x..' CHAR '.xxx...' CHAR '.xxx...' CHAR 'x...x..' CHAR '.xxxx..' CHAR '....x..' CHAR '....x..' CHAR '.xxx...' xdata: CHAR '.......' CHAR '.......' CHAR '.x.x...' CHAR '..x....' CHAR '.x.x...' CHAR '.......' chardatal: CHAR '.xxx...' CHAR 'x...x..' CHAR 'x...x..' CHAR 'x...x..' CHAR 'x...x..' CHAR 'x...x..' CHAR 'x...x..' CHAR '.xxx...' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR '.xxx...' CHAR 'x...x..' CHAR '....x..' CHAR '...x...' CHAR '..x....' CHAR '.x.....' CHAR 'x......' CHAR 'xxxxx..' CHAR '.xxx...' CHAR 'x...x..' CHAR '....x..' CHAR '..xx...' CHAR '....x..' CHAR '....x..' CHAR 'x...x..' CHAR '.xxx...' CHAR '...x...' CHAR '..xx...' CHAR '.x.x...' CHAR 'x..x...' CHAR 'xxxxx..' CHAR '...x...' CHAR '...x...' CHAR '...x...' CHAR 'xxxxx..' CHAR 'x......' CHAR 'x......' CHAR 'xxxx...' CHAR '....x..' CHAR '....x..' CHAR '....x..' CHAR 'xxxx...' CHAR '.xxx...' CHAR 'x......' CHAR 'x......' CHAR 'xxxx...' CHAR 'x...x..' CHAR 'x...x..' CHAR 'x...x..' CHAR '.xxx...' CHAR 'xxxxx..' CHAR '....x..' CHAR '....x..' CHAR '...x...' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR '..x....' CHAR '.xxx...' CHAR 'x...x..' CHAR 'x...x..' CHAR '.xxx...' CHAR 'x...x..' CHAR 'x...x..' CHAR 'x...x..' CHAR '.xxx...' CHAR '.xxx...' CHAR 'x...x..' CHAR 'x...x..' CHAR '.xxxx..' CHAR '....x..' CHAR '....x..' CHAR 'x...x..' CHAR '.xxx...' xdatal: CHAR '.......' CHAR '.......' CHAR 'x...x..' CHAR '.x.x...' CHAR '..x....' CHAR '.x.x...' CHAR 'x...x..' CHAR '.......' controlstring: CHAR 10,$B,0,0,0,0 CHAR $9B,"1",$53,$0,$0,$0,$0 versionstring: CHAR 0,0,0,0 CHAR '\0$VER: picticon 1.1 (2.4.95)\0' CHAR 0,0,0,0