home *** CD-ROM | disk | FTP | other *** search
/ Amiga Games 1996 January / amigagames-cdrom-1996-01.iso / userbox / publicdomain / picticon / source / picticon.e < prev    next >
Text File  |  1995-04-02  |  53KB  |  1,919 lines
  1. MODULE 'exec/nodes','exec/ports','exec/types','exec/memory',
  2.        'intuition/intuition','intuition/screens','intuition/gadgetclass',
  3.        'intuition/screens','dos/dos','dos/dosextens','gadtools',
  4.        'libraries/gadtools','graphics/rastport','graphics/gfx','graphics/text',
  5.        'graphics/view','graphics/gfxbase','workbench/workbench',
  6.        'workbench/startup','wb','icon','graphics/clip','diskfont',
  7.        'libraries/diskfont','libraries/iffparse','iffparse','Asl','libraries/Asl',
  8.        'datatypes/datatypes','datatypes/datatypesclass','datatypes/pictureclass',
  9.        'utility/hooks','intuition/classes','intuition/classusr','utility/tagitem',
  10.        'libraries/locale',
  11.              'mathffp','dos/dosasl',
  12.        'datatypes','layers','keymap','devices/inputevent','mathtrans','locale'
  13. MODULE 'newicon','libraries/newicon'
  14.  
  15. MODULE    'whatis','libraries/whatisbase'
  16.  
  17. MODULE    '*doloaddt'
  18.  
  19. /* options:
  20.  
  21.   MAXIWIDTH=x       ;buffer size width
  22.   MAXIHEIGHT=x      ;buffer size height
  23.   APPICON=$         ;name of App-icon image
  24.   TEMPLATE_ICON=$   ;name of icon to modify (tooltypes, positions)
  25.   BACKGROUND_ICON=$ ;Name of background icon.
  26.   CHUNKYMODE=B      ;save icon with ReadPixels, not bitmap->image.
  27.   FORCE_EIGHT=B     ;If YES then eight planes are saved.
  28.   PIC_X_POS=x       ;Offset for image.
  29.   PIC_Y_POS=x       ;Offset for image.
  30.   PIC_X_SIZE=x      ;Real size of image (not always, but at least < than)
  31.   PIC_Y_SIZE=x      ;Real size of image.
  32.   CENTER=B          ;Center icon? Only valid with PIC_X_SIZE/PIC_Y_SIZE
  33.   SHOWSIZE_X=x      ;X pos for size coords
  34.   SHOWSIZE_Y=x      ;Y pos for size coords
  35.   LOWPRI=B          ;If= "yes" then run at priority -1
  36.   FREE_ICON_POS=B   ;Set icon to "unsnapshot"
  37.   HIGHPEN=x         ;topmost pen to use
  38.   SHOWSIZE_OUTLINE=B;If yes, then outline the size, otherwise, shadow it
  39.   SHOWSIZE_NORMAL=B ;If yes, then no shadow, no outline.
  40.   SHOWSIZE_TALL=B   ;If yes, then font is 8 high, not 6.
  41.   QUIET=B           ;If yes then surpress ALL output.
  42.   APP_X_POS=x       ;x pos of appicon
  43.   APP_Y_POS=y       ;y pos of appicon
  44.     DITHER=B                    ;if YES then do dithering
  45.  
  46. */
  47.  
  48. ENUM E_NONE,L_OK,
  49.   L_E_GENERAL,L_E_FILE,L_E_NOFILE,L_E_BADICON,L_E_NOWRITEICON,L_E_CLIP,
  50.   L_E_DATATYPE,L_E_NOPICTURE,L_E_GADGET,
  51.   L_EF_LIBRARY,L_EF_FATAL,L_EF_PUBSCREEN,L_EF_CHIPBUFFER,L_EF_VISUAL,L_EF_MENUS,
  52.   L_EF_MSGPORT,L_EF_WINDOW,L_EF_MEMORY,L_TEXTTITLE,
  53.   L_PICTURE,L_FILEOF,L_LOADING,L_SCALING,L_REMAPPING,L_SAVING,L_PERCENT,
  54.   L_TITLE,L_BODY,L_BUTTONS,L_RENDERING,L_PERCENT2,L_NUMDIRS,L_CREATINGICON,L_ENDS
  55.  
  56. ENUM MODE_CLI,MODE_WB,MODE_QUIET,MODE_APP
  57. ENUM TEXT_NORMAL,TEXT_SHADOW,TEXT_OUTLINE
  58.   OBJECT mybitmapstruct
  59.     bytesperrow:INT;rows:INT;flags:CHAR;depth:CHAR;pad:INT
  60.     plane1:LONG;plane2:LONG;plane3:LONG;plane4:LONG
  61.     plane5:LONG;plane6:LONG;plane7:LONG;plane8:LONG
  62.   ENDOBJECT
  63.  
  64. DEF dumstr[500]:STRING
  65. DEF texttype=TEXT_SHADOW,tallfont=FALSE
  66. DEF iff:PTR TO iffhandle,ierror
  67. DEF sp=NIL:PTR TO storedproperty
  68. DEF freeme=FALSE
  69. DEF curfile=1,totfile=1
  70. DEF screenfont=NIL:PTR TO textfont
  71. DEF window=NIL:PTR TO window,rast,drawinfo,fgx,fgy,fgw,fgh
  72. DEF showflag=FALSE,showx=0,showy=0,bitsizex,bitsizey,sizestr[50]:STRING
  73. DEF black,white,writecolors=2
  74. DEF posx=0,posy=0,sizex=0,sizey=0,centerflag=FALSE,posflag=FALSE
  75. DEF noappitem=FALSE
  76. DEF minimumx,minimumy
  77. DEF quietflag=FALSE,goodload
  78. DEF requestsizex,requestsizey,highestcolor
  79. DEF k[15]:LIST
  80. DEF redt[256]:LIST,grnt[256]:LIST,blut[256]:LIST
  81. DEF ditz,dang,dumb,body
  82. DEF osversion,quitter,newicon=FALSE
  83. DEF abort
  84. DEF aspectx=1,aspecty=1,useaspect=TRUE,addicon=FALSE,addiconoverwrite=FALSE
  85. DEF radian,pointfive
  86. DEF catalog,sl[500]:LIST
  87. DEF iconianheader[80]:STRING
  88. DEF scratch,ret,dummy
  89. DEF appimagedata,diskobj=NIL:PTR TO diskobject,newdiskobj=NIL:PTR TO newdiskobject
  90. DEF progname[500]:STRING,sleepername[500]:STRING,templatename[500]:STRING
  91. DEF backname[500]:STRING
  92. DEF gaugestr[100]:STRING
  93. DEF toolobject=NIL:PTR TO diskobject
  94. DEF stretch=FALSE
  95. DEF greyscale=0,quant=256
  96. DEF usewhatis=TRUE
  97. DEF chunkyflag=FALSE,force8=FALSE,first4=-1
  98. DEF maxiwidth=128,maxiheight=100,maxiw=127,maxih=99
  99. DEF filename[500]:STRING
  100. DEF mode=MODE_CLI
  101. DEF scr=NIL:PTR TO screen,viewport:PTR TO viewport
  102. DEF bitmap:PTR TO bitmap,depth,colormap=0,newcolormap=0,cmbuf=0
  103. DEF currast=NIL:PTR TO rastport,curbitmap=NIL:PTR TO bitmap
  104. DEF appname[500]:STRING
  105. DEF visual=NIL,winx=-1,winy=-1
  106. DEF oldpx=-1
  107. DEF appx=-1,appy=-1
  108. DEF dither=TRUE
  109. DEF twopass=FALSE
  110. DEF rawdata=0
  111. DEF div1=3,div2=0,div3=3,div4=1,rem1=8,rem2=1,rem3=8,rem4=4
  112. DEF thres=2,ignore=16,lim=255,typ=0
  113. DEF iinfo=0:PTR TO imageinfo
  114. DEF stacked[750]:LIST
  115. DEF renderham=FALSE
  116. DEF hamthres=-1
  117. DEF    hambase=FALSE
  118. DEF discard=FALSE
  119. PROC main()
  120.     NEW iinfo
  121.   openlibs()
  122.   radian:=sp_div_tf_tf_f(10000,572958)
  123.   pointfive:=sp_div_tf_tf_f(10,5)
  124.   StrCopy(iconianheader,'Picticon 1.1',ALL)
  125.   loadwinpos()
  126.   handwb()
  127.   savewinpos()
  128.   leave(0)
  129. ENDPROC
  130.  
  131. PROC setraw(x,y,r,g,b)
  132.   IF rawdata
  133.     PutLong(rawdata+(limit(x,0,maxiwidth)*12)+(limit(y,0,1)*12*maxiwidth),r)
  134.     PutLong(rawdata+(limit(x,0,maxiwidth)*12)+4+(limit(y,0,1)*12*maxiwidth),g)
  135.     PutLong(rawdata+(limit(x,0,maxiwidth)*12)+8+(limit(y,0,1)*12*maxiwidth),b)
  136.   ENDIF
  137. ENDPROC
  138.  
  139. PROC rawred(x,y)
  140.   RETURN Long(rawdata+(x*12)+(y*12*maxiwidth))
  141. ENDPROC
  142.  
  143. PROC rawgrn(x,y)
  144.   RETURN Long(rawdata+4+(x*12)+(y*12*maxiwidth))
  145. ENDPROC
  146.  
  147. PROC rawblu(x,y)
  148.   RETURN Long(rawdata+8+(x*12)+(y*12*maxiwidth))
  149. ENDPROC
  150.  
  151. PROC processicon() HANDLE
  152.   DEF gadget:PTR TO gadget
  153.   DEF backobj=NIL:PTR TO diskobject
  154.   DEF screenattr:PTR TO textattr,sfonth=8
  155.   DEF heystring[500]:STRING,file[500]:STRING
  156.     DEF whaticon[500]:STRING
  157.   DEF iiii,tttt,oldshowx,loo,gc1,gc2
  158.     DEF inw,inh,lock
  159.     DEF imsg:PTR TO intuimessage
  160.     DEF whatobj=NIL:PTR TO diskobject
  161.     DEF newwhatobj=NIL:PTR TO newdiskobject
  162.  
  163.   oldshowx:=showx
  164.   window:=NIL
  165.   IF StrLen(filename)<1 THEN Raise(E_NONE)
  166.   IF ((scr:=LockPubScreen('Workbench'))=0) THEN Raise(L_EF_PUBSCREEN)
  167.   visual:=GetVisualInfoA(scr,NIL)
  168.   viewport:=scr.viewport
  169.   colormap:=viewport.colormap
  170.   bitmap:=scr.bitmap
  171.   depth:=bitmap.depth
  172.     IF (newicon)
  173.         newcolormap:=GetColorMap(256)
  174.         cmbuf:=New(32)
  175.         FOR loo:=0 TO 255
  176.             gc1:=loo AND (Shl(1,depth)-1)
  177.             GetRGB32(colormap,gc1,1,cmbuf)
  178.             SetRGB32CM(newcolormap,loo,Long(cmbuf),Long(cmbuf+4),Long(cmbuf+8))            
  179.         ENDFOR
  180.         colormap:=newcolormap
  181.         Dispose(cmbuf)
  182.     ENDIF
  183.   IF (curbitmap:=myallocbitmap(maxiwidth,maxiheight,8,BMF_CLEAR OR BMF_STANDARD,NIL))=NIL THEN Raise(L_EF_CHIPBUFFER)
  184.  
  185.   IF (currast:=New(SIZEOF rastport))=NIL THEN Raise(L_EF_FATAL)
  186.   InitRastPort(currast);currast.bitmap:=curbitmap
  187.  
  188.   screenattr:=scr.font
  189.   sfonth:=screenattr.ysize
  190.  
  191.   IF ((mode<>MODE_QUIET) AND (mode<>MODE_CLI))
  192.         inw:=bigger(300,12*StrLen(FilePart(filename)))
  193.         inh:=sfonth*3+20-(((totfile<-1) OR (totfile>1))*(sfonth+4))
  194.     IF winx=-1 THEN winx:=(((scr.width-300)/2))
  195.     IF winy=-1 THEN winy:=(((scr.height-(sfonth*2+16))/2))
  196.     window:=OpenWindowTagList(0,[WA_LEFT,winx,
  197.       WA_TOP,winy,
  198.       WA_INNERWIDTH,inw,
  199.       WA_INNERHEIGHT,inh,
  200.       WA_FLAGS,WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET,
  201.             WA_IDCMP,IDCMP_CLOSEWINDOW,
  202.       WA_TITLE,sl[L_TEXTTITLE],
  203.       WA_CUSTOMSCREEN,scr,
  204.       WA_AUTOADJUST,TRUE,
  205.       NIL,NIL])
  206.     rast:=window.rport
  207.     screenfont:=OpenFont(scr.font)
  208.     IF screenfont THEN SetFont(rast,screenfont)
  209.     fgx:=4+window.borderleft
  210.     fgw:=window.width-(8+window.borderleft+window.borderright)
  211.     fgh:=window.height-(window.bordertop+4+window.borderbottom)-(sfonth*2)-8+(((totfile<-1) OR (totfile>1))*(sfonth+4))
  212.     fgy:=window.height-(sfonth*2)-18
  213.  
  214.  
  215.         SetAPen(rast,2)
  216.         shadowtext(rast,fgx,fgy+6+fgh+screenfont.baseline,'0%',2)
  217.         shadowtext(rast,fgx+fgw-TextLength(rast,'100%',4),fgy+fgh+6+screenfont.baseline,'100%',4)
  218.         shadowtext(rast,fgx+(fgw/2)-(TextLength(rast,'50%',3)/2),fgy+fgh+6+screenfont.baseline,'50%',3)
  219.         shadowtext(rast,fgx+(fgw/4)-(TextLength(rast,'25%',3)/2),fgy+fgh+6+screenfont.baseline,'25%',3)
  220.         shadowtext(rast,fgx+(fgw*3/4)-(TextLength(rast,'75%',3)/2),fgy+fgh+6+screenfont.baseline,'75%',3)
  221.  
  222.     StringF(heystring,sl[L_PICTURE],FilePart(filename))
  223.     SetAPen(rast,1)
  224.     Move(rast,fgx+(fgw/2)-(TextLength(rast,heystring,StrLen(heystring))/2),window.bordertop+3+screenfont.baseline)
  225.     Text(rast,heystring,StrLen(heystring))
  226.  
  227.         shadowline(rast,fgx,fgy+1+fgh,fgx,fgy+4+fgh)
  228.         shadowline(rast,fgx+fgw-2,fgy+1+fgh,fgx+fgw-2,fgy+4+fgh)
  229.         shadowline(rast,fgx+(fgw/2),fgy+1+fgh,fgx+(fgw/2),fgy+4+fgh)
  230.         shadowline(rast,fgx+(fgw/4),fgy+1+fgh,fgx+(fgw/4),fgy+4+fgh)
  231.         shadowline(rast,fgx+(fgw*3/4),fgy+1+fgh,fgx+(fgw*3/4),fgy+4+fgh)
  232.  
  233.     IF ((totfile<-1) OR (totfile>1))
  234.         IF totfile>1
  235.           StringF(heystring,sl[L_FILEOF],curfile,totfile)
  236.         ELSE
  237.           StrCopy(heystring,sl[L_NUMDIRS],ALL)
  238.         ENDIF
  239.          Move(rast,fgx+(fgw/2)-(TextLength(rast,heystring,StrLen(heystring))/2),window.bordertop+5+screenfont.baseline+screenfont.ysize)
  240.          Text(rast,heystring,StrLen(heystring))
  241.     ENDIF
  242.     ELSE
  243.         IF (mode=MODE_CLI)
  244.             WriteF('\n"\s" - ',filename)
  245.         ENDIF
  246.   ENDIF
  247.  
  248.     diskobj:=0;newdiskobj:=0
  249.     IF StrLen(templatename)
  250.         IF (newicon)
  251.             newdiskobj:=GetNewDiskObject(templatename)
  252.             IF (newdiskobj)
  253.                 diskobj:=newdiskobj.ndo_stdobject
  254.             ENDIF
  255.         ELSE
  256.             diskobj:=GetDiskObject(templatename)
  257.         ENDIF
  258.     ENDIF
  259.     
  260.     IF (diskobj=0)
  261.         IF (newicon)
  262.             newdiskobj:=GetNewDiskObject(filename)
  263.             IF (newdiskobj)
  264.                 diskobj:=newdiskobj.ndo_stdobject
  265.             ENDIF
  266.         ELSE
  267.             diskobj:=GetDiskObject(filename)
  268.         ENDIF
  269.     ENDIF
  270.     StrCopy(whaticon,'ENV:sys/def_project',ALL)
  271.  
  272.     IF (addicon)
  273.         IF (((usewhatis<>0) AND (diskobj=0)))
  274.           StrCopy(file,'Icons:',ALL)
  275.             IF (lock:=Lock(filename,ACCESS_READ))
  276.                 AddPart(file,GetIconName(WhatIs(filename,[WI_DEEP,DEEPTYPE,NIL,NIL]:LONG)),490)
  277.                 StrCopy(whaticon,file,ALL)
  278.                 UnLock(lock)
  279.             ENDIF
  280.             IF (StrCmp(whaticon,'Icons:'))
  281.                 StrCopy(whaticon,'ENV:sys/def_project',ALL)
  282.             ENDIF
  283.             IF (diskobj=0)
  284.                 IF (newicon)
  285.                     newdiskobj:=GetNewDiskObject(file)
  286.                     IF (newdiskobj)
  287.                         diskobj:=newdiskobj.ndo_stdobject
  288.                     ENDIF
  289.                 ELSE
  290.                     diskobj:=GetDiskObject(file)
  291.                 ENDIF
  292.             ENDIF
  293.         ELSE
  294.             IF (newicon)
  295.                 newdiskobj:=GetNewDiskObject('env:sys/def_project')
  296.                 IF (newdiskobj)
  297.                     diskobj:=newdiskobj.ndo_stdobject
  298.                 ENDIF
  299.             ELSE
  300.                 diskobj:=GetDiskObject(WBPROJECT)
  301.             ENDIF
  302.         ENDIF
  303.     ENDIF
  304.     IF (diskobj=0)
  305.         IF (newicon)
  306.             newdiskobj:=GetNewDiskObject('ENV:sys/def_picture')
  307.             IF (newdiskobj)
  308.                 diskobj:=newdiskobj.ndo_stdobject
  309.             ENDIF
  310.         ELSE
  311.             diskobj:=GetDiskObject('ENV:sys/def_picture')            -> Next to last resort.
  312.         ENDIF
  313.     ENDIF
  314.     IF (diskobj=0) THEN diskobj:=GetDefDiskObject(WBPROJECT)                            -> Last resort.
  315.  
  316.   SetAPen(currast,0)
  317.   SetBPen(currast,0)
  318.   RectFill(currast,0,0,maxiw,maxih)
  319.   IF (StrLen(backname))
  320.       IF (backobj:=GetDiskObject(backname))
  321.             IF (newicon)
  322.                 IF (mode=MODE_CLI)
  323.                     WriteF('Background template ignored.\n')
  324.                 ENDIF
  325.             ELSE
  326.             gadget:=backobj.gadget
  327.                 copyimagerast(currast,gadget.gadgetrender)
  328.             ENDIF
  329.         ENDIF
  330.   ENDIF
  331.     goodload:=FALSE
  332.   displaypercent(1,5000)
  333.     StrCopy(gaugestr,{controlstring},ALL)
  334.     StrAdd(gaugestr,sl[L_PERCENT2],ALL)
  335.   displaymessage(sl[L_LOADING],TRUE)
  336.     IF (abort=FALSE)
  337.       IF (doloaddt(filename,currast,colormap,posx,posy,sizex,sizey,[DLDT_CENTER,centerflag,
  338.             DLDT_INTEGERSCALE,FALSE,
  339.             DLDT_DITHER,dither,
  340.             DLDT_REMAP,TRUE,
  341.             DLDT_ASPECTX,aspectx,
  342.             DLDT_ASPECTY,aspecty,
  343.             DLDT_SCALE,TRUE,
  344.             DLDT_USEASPECT,useaspect,
  345.             DLDT_ENLARGE,FALSE,
  346.             DLDT_CLEAR,FALSE,
  347.             DLDT_GAUGE,IF ((mode=MODE_WB) OR (mode=MODE_APP)) THEN [rast,scr,fgx+3,fgy+2,fgw-8,fgh-4]:gauge ELSE 0,
  348.             DLDT_CLIGAUGE,IF (mode=MODE_CLI) THEN gaugestr ELSE 0,
  349.             DLDT_INFO,iinfo,
  350.             DLDT_HIGHPEN,first4,
  351.             DLDT_FILLCMAP,newicon,
  352.             DLDT_GREYSCALE,greyscale,
  353.             DLDT_QUANTIZE,quant,
  354.             DLDT_RENDERHAM,renderham,
  355.             DLDT_FULLHAMBASE,hambase,
  356.             DLDT_DISCARDERROR,discard,
  357.             DLDT_STRETCHTOFIT,stretch,
  358.             IF (hamthres>=0) THEN DLDT_HAMTHRESHOLD ELSE TAG_IGNORE,hamthres,
  359.             NIL,NIL])=0)
  360.             goodload:=TRUE
  361.         ELSE
  362.             IF (addicon)
  363.               displaymessage(sl[L_CREATINGICON],TRUE)
  364.             ELSE
  365.               displaymessage(sl[L_E_DATATYPE],TRUE);Delay(20)
  366.           ENDIF
  367.         ENDIF
  368.     ENDIF
  369.  
  370.     bitsizex:=iinfo.source_w
  371.     bitsizey:=iinfo.source_h
  372.     black:=iinfo.blackpen
  373.     white:=iinfo.whitepen
  374. ->    writecolors:=limit((Shl(1,iinfo.depth)*2),1,255)
  375.     writecolors:=limit(iinfo.highest_pen+1,1,256)
  376.   IF showflag
  377.     StringF(sizestr,'\dx\d',bitsizex,bitsizey)
  378.     IF showx=-1 THEN showx:=posx+(sizex/2)-((StrLen(sizestr)*6)/2)
  379.     IF showy=-1 THEN showy:=1
  380.  
  381.     IF texttype=TEXT_OUTLINE
  382.       FOR tttt:=-1 TO 1
  383.         FOR iiii:=-1 TO 1
  384.           showpicsize(showx+iiii,showy+tttt,black,sizestr)
  385.         ENDFOR
  386.       ENDFOR
  387.     ENDIF
  388.     IF texttype=TEXT_SHADOW THEN showpicsize(showx+1,showy+1,black,sizestr)
  389.     showpicsize(showx,showy,white,sizestr)
  390.   ENDIF
  391.   showx:=oldshowx
  392.   IF goodload
  393.         IF newicon
  394.             savenewicon()
  395.         ELSE
  396.         saveicon()
  397.         ENDIF
  398.     ELSE
  399.         IF (addicon)
  400.             whatobj:=0;newwhatobj:=0
  401.             IF (((whatobj:=GetDiskObject(filename))=0) OR (addiconoverwrite=TRUE))
  402.                 IF (whatobj);FreeDiskObject(whatobj);whatobj:=0;ENDIF
  403.                 IF (newicon)
  404.                     newwhatobj:=GetNewDiskObject(whaticon)
  405.                     IF (newwhatobj)
  406.                         whatobj:=newwhatobj.ndo_stdobject
  407.                     ENDIF
  408.                 ENDIF
  409.                 IF (whatobj=0)
  410.                     whatobj:=GetDiskObjectNew(whaticon)
  411.                 ENDIF
  412.                 IF (whatobj)
  413.                     DeleteDiskObject(filename)
  414.                     IF (freeme)
  415.                         IF (whatobj.gadget)
  416.                             whatobj.gadget::gadget.leftedge:=NO_ICON_POSITION
  417.                             whatobj.gadget::gadget.topedge:=NO_ICON_POSITION
  418.                         ENDIF
  419.                         whatobj.currentx:=NO_ICON_POSITION
  420.                         whatobj.currenty:=NO_ICON_POSITION
  421.                     ENDIF
  422.                     IF ((newicon) AND (newwhatobj))
  423.                         PutNewDiskObject(filename,newwhatobj)
  424.                     ELSE
  425.                         PutDiskObject(filename,whatobj)
  426.                     ENDIF
  427.                 ENDIF
  428.                 IF (newwhatobj)
  429.                     FreeNewDiskObject(newwhatobj);newwhatobj:=0;whatobj:=0
  430.                 ENDIF
  431.             ENDIF
  432.             IF (whatobj)
  433.                 FreeDiskObject(whatobj);whatobj:=0
  434.             ENDIF
  435.         ENDIF
  436.   ENDIF
  437.   Raise(E_NONE)
  438. EXCEPT
  439.   IF visual THEN FreeVisualInfo(visual);visual:=NIL
  440.   IF scr THEN UnlockPubScreen(0,scr);scr:=NIL
  441.   IF curbitmap THEN myfreebitmap(curbitmap);curbitmap:=NIL
  442.   IF currast THEN Dispose(currast);currast:=NIL
  443.     IF newicon
  444.         IF newdiskobj THEN FreeNewDiskObject(newdiskobj);newdiskobj:=NIL;diskobj:=NIL
  445.     ELSE
  446.       IF diskobj THEN FreeDiskObject(diskobj);diskobj:=NIL
  447.     ENDIF
  448.   IF backobj THEN FreeDiskObject(backobj);backobj:=NIL
  449.     IF (newicon)
  450.         IF (newcolormap)
  451.             FreeColorMap(newcolormap)
  452.         ENDIF
  453.     ENDIF
  454.   IF window
  455.         WHILE (imsg:=GetMsg(window.userport))
  456.             IF (imsg.class=IDCMP_CLOSEWINDOW)
  457.                 abort:=TRUE
  458.             ENDIF
  459.             ReplyMsg(imsg);imsg:=0
  460.         ENDWHILE
  461.     winx:=window.leftedge;winy:=window.topedge
  462.     CloseWindow(window);window:=NIL
  463.       savewinpos()
  464.   ENDIF
  465.   IF screenfont THEN CloseFont(screenfont);screenfont:=NIL
  466.   handleexception(exception)
  467. ENDPROC
  468.  
  469. PROC shadowline(rast,x1,y1,x2,y2)
  470.     DEF drawinfo=NIL:PTR TO drawinfo
  471.     IF ((scr=0) OR (rast=0)) THEN RETURN
  472.     IF (drawinfo:=GetScreenDrawInfo(scr))
  473.         SetAPen(rast,Int(drawinfo.pens+(SHINEPEN*2)))
  474.         Move(rast,x1+1,y1+1)
  475.         Draw(rast,x2+1,y2+1)
  476.         SetAPen(rast,Int(drawinfo.pens+(SHADOWPEN*2)))
  477.         Move(rast,x1,y1)
  478.         Draw(rast,x2,y2)
  479.         FreeScreenDrawInfo(scr,drawinfo)
  480.     ENDIF
  481. ENDPROC
  482.  
  483. PROC shadowtext(rast,x1,y1,x2,y2)
  484.     DEF drawinfo=NIL:PTR TO drawinfo
  485.     IF ((scr=0) OR (rast=0)) THEN RETURN
  486.     IF (drawinfo:=GetScreenDrawInfo(scr))
  487.         SetDrMd(rast,RP_JAM1)
  488. /*        SetAPen(rast,Int(drawinfo.pens+(SHINEPEN*2)))
  489.         Move(rast,x1+1,y1+1)
  490.         Text(rast,x2,y2)*/
  491.         SetAPen(rast,Int(drawinfo.pens+(SHADOWPEN*2)))
  492.         Move(rast,x1,y1)
  493.         Text(rast,x2,y2)
  494.         FreeScreenDrawInfo(scr,drawinfo)
  495.         SetDrMd(rast,RP_JAM2)
  496.     ENDIF
  497. ENDPROC
  498.  
  499. PROC saveicon() HANDLE
  500.   DEF ire
  501.   DEF mydiskobj=NIL:PTR TO diskobject
  502.  
  503.   mydiskobj:=diskobj
  504.  
  505.   IF mode=MODE_CLI THEN WriteF('\n')
  506.   displaymessage(sl[L_SAVING],TRUE)
  507.   creatediskobj(mydiskobj,currast)
  508.  
  509.   IF (ire:=PutDiskObject(filename,mydiskobj))=NIL THEN Raise(L_E_NOWRITEICON)
  510.  
  511.   Raise(E_NONE)
  512. EXCEPT
  513.   restorediskobj(mydiskobj)
  514.   handleexception(exception)
  515. ENDPROC
  516.  
  517. oldimage:
  518.     INT 0,0,1,1,1
  519. fillim:
  520.     LONG 0    ->FILL ME
  521.     CHAR 1,0
  522.     LONG 0
  523.  
  524. image:
  525.     LONG $FFFF
  526.  
  527. PROC savenewicon() HANDLE
  528.   DEF ire,i,x,y
  529.     DEF chunk=NIL:PTR TO chunkyimage,ctab=NIL,ci=NIL
  530.   DEF mydiskobj=NIL:PTR TO diskobject
  531.     DEF myni=NIL:PTR TO newdiskobject
  532.     DEF buffer=NIL
  533.     DEF file[500]:STRING
  534.  
  535.     NEW chunk,myni
  536.     ctab:=New(260*3)
  537.     ci:=New(maxiwidth*maxiheight*2)
  538.     buffer:=New(20)
  539.  
  540.   mydiskobj:=diskobj
  541.  
  542.   IF mode=MODE_CLI THEN WriteF('\n')
  543.   displaymessage(sl[L_SAVING],TRUE)
  544.   creatediskobj(mydiskobj,currast)
  545.  
  546.     PutLong({fillim},{image})
  547.     mydiskobj.gadget::gadget.width:=1
  548.     mydiskobj.gadget::gadget.height:=1
  549.  
  550.     mydiskobj.gadget::gadget.gadgetrender:={oldimage}
  551.  
  552.     myni.ndo_stdobject:=mydiskobj
  553.     myni.ndo_normalimage:=chunk
  554.  
  555.     chunk.width:=requestsizex
  556.     chunk.height:=requestsizey-1
  557.     chunk.numcolors:=writecolors+1
  558.     chunk.flags:=0                                -> Color 0 in NOT transparent!
  559.     chunk.palette:=ctab
  560.     chunk.chunkydata:=ci
  561.  
  562.     FOR i:=0 TO writecolors
  563.         GetRGB32(newcolormap,i,1,buffer)
  564.         PutChar(ctab+(i*3)+0,Char(buffer))
  565.         PutChar(ctab+(i*3)+1,Char(buffer+4))
  566.         PutChar(ctab+(i*3)+2,Char(buffer+8))
  567.     ENDFOR
  568.  
  569.     FOR y:=0 TO requestsizey-1
  570.         FOR x:=0 TO requestsizex-1
  571.             PutChar(ci+(y*requestsizex)+x,ReadPixel(currast,x,y))
  572.         ENDFOR
  573.     ENDFOR
  574.  
  575.     StrCopy(file,filename,ALL)
  576.     StrAdd(file,'.info',ALL)
  577.     DeleteFile(file)
  578.     DeleteDiskObject(filename)
  579.   IF (ire:=PutNewDiskObject(filename,myni))=NIL THEN Raise(L_E_NOWRITEICON)
  580.   Raise(E_NONE)
  581. EXCEPT
  582.   restorediskobj(mydiskobj)
  583.   handleexception(exception)
  584.     Dispose(ctab);Dispose(ci);Dispose(buffer)
  585.     END chunk,myni
  586. ENDPROC
  587.  
  588. PROC displaypercent(done,max)
  589.   IF (mode<>MODE_CLI)
  590.     IF (((mode=MODE_WB) OR (mode=MODE_APP)) AND (window) AND (rast))
  591.       SetAPen(rast,3)
  592.       IF visual
  593.         DrawBevelBoxA(rast,fgx,fgy,fgw,fgh,[GT_VISUALINFO,visual,
  594.           GTBB_RECESSED,TRUE,GTBB_FRAMETYPE,BBFT_BUTTON,NIL,NIL])
  595.       ENDIF
  596.     ENDIF
  597.   ENDIF
  598. ENDPROC
  599.  
  600. PROC displaymessage(msg,flag)
  601.   IF mode=MODE_CLI
  602.     WriteF('\s\n',msg)
  603.   ELSE
  604.     IF (((mode=MODE_WB) OR (mode=MODE_APP)) AND (window) AND (rast))
  605.       IF flag<>0
  606.         SetAPen(rast,0)
  607.         RectFill(rast,fgx+2,fgy+1,fgx+fgw-4,fgy+fgh-2)
  608.       ELSE
  609.         SetDrMd(rast,RP_JAM1)
  610.       ENDIF
  611.       Move(rast,fgx+(fgw/2)-(TextLength(rast,msg,StrLen(msg))/2),fgy+fgh-(screenfont.ysize-screenfont.baseline)-3)
  612.       SetAPen(rast,1)
  613.       Text(rast,msg,StrLen(msg))
  614.       SetDrMd(rast,RP_JAM2)
  615.       IF visual
  616.         DrawBevelBoxA(rast,fgx,fgy,fgw,fgh,[GT_VISUALINFO,visual,
  617.           GTBB_RECESSED,TRUE,GTBB_FRAMETYPE,BBFT_BUTTON,NIL,NIL])
  618.       ENDIF
  619.     ENDIF
  620.   ENDIF
  621. ENDPROC
  622.  
  623. PROC showpicsize(x,y,p,s)
  624.   DEF ii,tt,uu,mm,charptr,xptr,ysize=6
  625.   charptr:={chardata}
  626.   xptr:={xdata}
  627.   IF tallfont
  628.     ysize:=8
  629.     charptr:={chardatal}
  630.     xptr:={xdatal}
  631.   ENDIF
  632.   SetAPen(currast,p)
  633.   FOR ii:=0 TO (StrLen(s)-1)
  634.     mm:=Char(s+ii)
  635.     FOR tt:=0 TO (ysize-1)
  636.       FOR uu:=0 TO 5
  637.         IF mm<>"x"
  638.           IF Char(charptr+uu+(tt*8)+((mm-48)*(8*ysize)))="x"
  639.             WritePixel(currast,smaller(bigger(x+uu+(ii*6),0),maxiw),smaller(bigger(y+tt,0),maxih))
  640.           ENDIF
  641.         ELSE
  642.           IF Char(xptr+uu+(tt*8))="x"
  643.             WritePixel(currast,smaller(bigger(x+uu+(ii*6),0),maxiw),smaller(bigger(y+tt,0),maxih))
  644.           ELSE
  645.           ENDIF
  646.         ENDIF
  647.       ENDFOR
  648.     ENDFOR
  649.   ENDFOR
  650.  
  651. ENDPROC
  652.  
  653. PROC postprocessicon()
  654.     DEF ii
  655.     FOR ii:=0 TO 749
  656.         IF (stacked[ii]=0)
  657.             stacked[ii]:=String(StrLen(filename)+6)
  658.             StrCopy(stacked[ii],filename,ALL)
  659.             ii:=5000
  660.         ENDIF
  661.     ENDFOR
  662. ENDPROC
  663.  
  664. PROC dosleep()
  665.   DEF sleepobject=NIL:PTR TO diskobject
  666.   DEF appobject=NIL:PTR TO diskobject
  667.   DEF appport=NIL:PTR TO mp
  668.   DEF appflag=NIL
  669.   DEF appicon,appitem=FALSE,newproj[250]:STRING
  670.   DEF lockname[250]:STRING,newlock=NIL
  671.   DEF amsg:PTR TO appmessage
  672.   DEF argptr:PTR TO wbarg
  673.   DEF lofal
  674.     DEF fh
  675.   DEF agadget:PTR TO gadget
  676.     DEF fileinfo=NIL:PTR TO fileinfoblock
  677.     DEF fileinfo1=NIL:PTR TO fileinfoblock
  678.     DEF apath=NIL:PTR TO anchorpath
  679.     DEF    achain=NIL:PTR TO achain
  680.     DEF err,pathlen,filestart,first
  681.     DEF patstr[500]:STRING
  682.     DEF dirstr[500]:STRING
  683.     DEF dumstr[500]:STRING,i
  684.  
  685.   StrCopy(appname,sleepername,ALL)
  686.   IF (sleepobject:=GetDiskObject(appname))=NIL
  687.     IF (sleepobject:=GetDiskObject('ENV:SYS/def_appicon'))=NIL
  688.       StrCopy(appname,progname,ALL)
  689.       IF (sleepobject:=GetDiskObject(appname))=NIL
  690.         sleepobject:=GetDefDiskObject(WBTOOL)
  691.       ENDIF
  692.     ENDIF
  693.   ENDIF
  694.   IF sleepobject
  695.     sleepobject.type:=NIL
  696.     appobject:=sleepobject
  697.     agadget:=appobject.gadget
  698.     IF appx<0
  699.       agadget.leftedge:=NO_ICON_POSITION
  700.       appobject.currentx:=NO_ICON_POSITION
  701.     ELSE
  702.       agadget.leftedge:=appx
  703.       appobject.currentx:=appx
  704.     ENDIF
  705.     IF appy<0
  706.       agadget.topedge:=NO_ICON_POSITION
  707.       appobject.currenty:=NO_ICON_POSITION
  708.     ELSE
  709.       agadget.topedge:=appy
  710.       appobject.currenty:=appy
  711.     ENDIF
  712.  
  713.     IF (appport:=CreateMsgPort())
  714.       IF (appicon:=AddAppIconA(0,0,'Picticon',appport,0,appobject,NIL))<>NIL
  715.           IF (noappitem<>TRUE)
  716.               appitem:=AddAppMenuItemA(0,0,'Picticon',appport,0)
  717.           ENDIF
  718.           IF ((appitem) OR (noappitem=TRUE))
  719.             WHILE appflag=NIL
  720.               WaitPort(appport)
  721.               WHILE (amsg:=GetMsg(appport))<>NIL
  722.                 IF amsg.numargs=0
  723.                   IF EasyRequestArgs(0, [20, 0, sl[L_TITLE], sl[L_BODY],sl[L_BUTTONS]], 0, 0)
  724.                     appflag:=TRUE
  725.                   ENDIF
  726.                 ELSE
  727.                     abort:=FALSE
  728.                   argptr:=amsg.arglist
  729.                   curfile:=0
  730.                   FOR lofal:=1 TO amsg.numargs
  731.                                     totfile:=amsg.numargs
  732.                       curfile:=curfile+1
  733.                     StrCopy(newproj,argptr.name,ALL)
  734.                     newlock:=argptr.lock
  735.                     IF newlock
  736.                         IF (fileinfo1:=AllocDosObject(DOS_FIB,NIL))
  737.                           NameFromLock(newlock,lockname,250)
  738.                             processname(filename,lockname,newproj)
  739.                                             IF (fh:=Lock(filename,ACCESS_READ))
  740.                                 Examine(fh,fileinfo1)
  741.                                 IF (fileinfo1.direntrytype>0)
  742.                                     StrCopy(patstr,filename,ALL)
  743.                                     StrCopy(dirstr,filename,ALL)
  744.                                     AddPart(patstr,'~(#?.info)',490)
  745.                                                     apath:=New(SIZEOF anchorpath)
  746.                                                     first:=FALSE
  747.                                                     err:=0
  748.                                                     WHILE err=NIL
  749.                                                         IF first=FALSE
  750.                                                             err:=MatchFirst(patstr,apath)
  751.                                                             first:=TRUE
  752.                                                         ELSE
  753.                                                             err:=MatchNext(apath)
  754.                                                         ENDIF
  755.                                                         IF err=NIL
  756.                                                             achain:=apath.last
  757.                                                             IF (achain)
  758.                                                                 fileinfo:=achain.info
  759.                                                                 IF (fileinfo)
  760.                                                                     IF (fileinfo.direntrytype<0)
  761.                                                                         StrCopy(filename,dirstr,ALL)
  762.                                                                         AddPart(filename,fileinfo.filename,490)
  763.                                                                         StrCopy(dumstr,filename,ALL)
  764.                                                                         UpperStr(dumstr)
  765.                                                                         IF (InStr(dumstr,'.INFO')<0)
  766.                                                                             totfile:=-2
  767.                                                                         postprocessicon()
  768.                                                                         ENDIF
  769.                                                                     ENDIF
  770.                                                                 ENDIF
  771.                                                             ENDIF
  772.                                                         ENDIF
  773.                                                     ENDWHILE
  774.                                                     MatchEnd(apath)
  775.                                                     Dispose(apath)
  776.                                                     FOR i:=0 TO 749
  777.                                                         IF stacked[i]<>0
  778.                                                             StrCopy(filename,stacked[i],ALL)
  779.                                                             processicon()
  780.                                                         ENDIF
  781.                                                         IF CtrlC();i:=5000;appflag:=TRUE;ENDIF
  782.                                                         IF (abort);i:=5000;ENDIF
  783.                                                     ENDFOR
  784.                                                     FOR i:=0 TO 749
  785.                                                         IF stacked[i]<>0
  786.                                                             DisposeLink(stacked[i])
  787.                                                             stacked[i]:=0
  788.                                                         ENDIF
  789.                                                     ENDFOR
  790.                                 ELSE
  791.                                     IF (fileinfo1.direntrytype<0)
  792.                                       processicon()
  793.                                     ENDIF
  794.                                                 ENDIF
  795.                                                 UnLock(fh)
  796.                             ENDIF
  797.                              FreeDosObject(DOS_FIB,fileinfo1)
  798.                         ENDIF
  799.                     ENDIF
  800.                     argptr:=argptr+(SIZEOF wbarg)
  801.                                     IF CtrlC();lofal:=50000;appflag:=TRUE;ENDIF
  802.                                     IF (abort<>FALSE);lofal:=50000;ENDIF
  803.                   ENDFOR
  804.                 ENDIF
  805.                 ReplyMsg(amsg)
  806.                         ENDWHILE
  807.             ENDWHILE
  808.             IF (appitem) THEN RemoveAppMenuItem(appitem);appitem:=0
  809.                 ENDIF
  810.            RemoveAppIcon(appicon)
  811.       ENDIF
  812.          WHILE (amsg:=GetMsg(appport))<>NIL
  813.            ReplyMsg(amsg)
  814.          ENDWHILE
  815.       DeleteMsgPort(appport)
  816.     ENDIF
  817.     IF sleepobject THEN FreeDiskObject(sleepobject);sleepobject:=NIL
  818.   ENDIF
  819. ENDPROC
  820.  
  821. yes:
  822.     CHAR    'YES',0
  823. no:
  824.     CHAR    'NO',0
  825. true:
  826.     CHAR    'TRUE',0
  827. false:
  828.     CHAR    'FALSE',0
  829.  
  830. PROC handwb()
  831.   DEF wb:PTR TO wbstartup,args:PTR TO wbarg
  832.   DEF argarray[40]:LIST,olddir,rdarg,s,wstr[500]:STRING
  833.   DEF locs,namesptr:PTR TO LONG,patternstr[500]:STRING
  834.     DEF fileinfo=NIL:PTR TO fileinfoblock
  835.     DEF    achain=NIL:PTR TO achain
  836.     DEF err=0,pathlen,filestart,first=0,chance=1
  837.     DEF    newdate=NIL:PTR TO datestamp
  838.     DEF apath=NIL:PTR TO anchorpath,i
  839.  
  840.   IF wbmessage<>NIL /* E provides us with WB's startup message in this variable */
  841.     wb:=wbmessage;args:=wb.arglist
  842.     olddir:=CurrentDir(args.lock)
  843.  
  844.     IF args.name>0
  845.       GetCurrentDirName(progname,500)
  846.       StrAdd(progname,args.name,ALL)
  847.       toolobject:=GetDiskObjectNew(progname)
  848.     ENDIF
  849.  
  850.     IF toolobject<>NIL  /* If we succeded in opening our program icon. */
  851.       IF s:=FindToolType(toolobject.tooltypes,'MAXIWIDTH')
  852.         StrToLong(s,{maxiwidth})
  853.       ENDIF
  854.       IF s:=FindToolType(toolobject.tooltypes,'MAXIHEIGHT')
  855.         StrToLong(s,{maxiheight})
  856.       ENDIF
  857.       IF s:=FindToolType(toolobject.tooltypes,'APPICON')
  858.         StrCopy(sleepername,s,ALL)
  859.       ENDIF
  860.             IF s:=FindToolType(toolobject.tooltypes,'NOAPPITEM')
  861.                 IF yup(s) THEN noappitem:=TRUE
  862.             ENDIF
  863.       IF s:=FindToolType(toolobject.tooltypes,'TEMPLATE_ICON')
  864.         StrCopy(templatename,s,ALL)
  865.       ENDIF
  866.       IF s:=FindToolType(toolobject.tooltypes,'BACKGROUND_ICON')
  867.         StrCopy(backname,s,ALL)
  868.       ENDIF
  869.       IF s:=FindToolType(toolobject.tooltypes,'CHUNKYMODE')
  870.                 chunkyflag:=yup(s)
  871.       ENDIF
  872.       IF s:=FindToolType(toolobject.tooltypes,'FORCE_EIGHT')
  873.         force8:=yup(s)
  874.       ENDIF
  875.       IF s:=FindToolType(toolobject.tooltypes,'CENTER')
  876.         centerflag:=yup(s)
  877.       ENDIF
  878.       IF s:=FindToolType(toolobject.tooltypes,'HIGHPEN')
  879.         StrToLong(s,{first4})
  880.       ENDIF
  881.       IF s:=FindToolType(toolobject.tooltypes,'FIRSTFOUR')
  882.         IF yup(s) THEN first4:=3
  883.       ENDIF
  884.       IF s:=FindToolType(toolobject.tooltypes,'FREE_ICON_POS')
  885.         freeme:=yup(s)
  886.       ENDIF
  887.       IF s:=FindToolType(toolobject.tooltypes,'PIC_X_POS')
  888.         StrToLong(s,{posx})
  889.       ENDIF
  890.       IF s:=FindToolType(toolobject.tooltypes,'PIC_Y_POS')
  891.         StrToLong(s,{posy})
  892.       ENDIF
  893.       IF s:=FindToolType(toolobject.tooltypes,'APP_X_POS')
  894.         StrToLong(s,{appx})
  895.       ENDIF
  896.       IF s:=FindToolType(toolobject.tooltypes,'APP_Y_POS')
  897.         StrToLong(s,{appy})
  898.       ENDIF
  899.       IF s:=FindToolType(toolobject.tooltypes,'PIC_X_SIZE')
  900.         StrToLong(s,{sizex})
  901.       ENDIF
  902.       IF s:=FindToolType(toolobject.tooltypes,'PIC_Y_SIZE')
  903.         StrToLong(s,{sizey})
  904.       ENDIF
  905.       IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_X')
  906.         StrToLong(s,{showx})
  907.         showflag:=TRUE
  908.       ENDIF
  909.       IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_Y')
  910.         StrToLong(s,{showy})
  911.         showflag:=TRUE
  912.       ENDIF
  913.       IF s:=FindToolType(toolobject.tooltypes,'ASPECT_X')
  914.         StrToLong(s,{aspectx})
  915.       ENDIF
  916.       IF s:=FindToolType(toolobject.tooltypes,'QUANTIZE')
  917.         StrToLong(s,{quant})
  918.       ENDIF
  919.       IF s:=FindToolType(toolobject.tooltypes,'ASPECT_Y')
  920.         StrToLong(s,{aspecty})
  921.       ENDIF
  922.       IF s:=FindToolType(toolobject.tooltypes,'HAMTHRESHOLD')
  923.         StrToLong(s,{hamthres})
  924.       ENDIF
  925.       IF s:=FindToolType(toolobject.tooltypes,'LOWPRI')
  926.         IF yup(s) THEN SetTaskPri(FindTask(0),-1)
  927.       ENDIF
  928.       IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_OUTLINE')
  929.         IF yup(s)
  930.           texttype:=TEXT_OUTLINE
  931.         ENDIF
  932.       ENDIF
  933.       IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_NORMAL')
  934.         IF yup(s)
  935.           texttype:=TEXT_NORMAL
  936.         ENDIF
  937.       ENDIF
  938.       IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_TALL')
  939.         IF yup(s)
  940.           tallfont:=TRUE
  941.         ENDIF
  942.       ENDIF
  943.       IF s:=FindToolType(toolobject.tooltypes,'QUIET')
  944.         IF yup(s)
  945.           quietflag:=TRUE
  946.                     mode:=MODE_QUIET
  947.         ENDIF
  948.       ENDIF
  949.  
  950.       IF s:=FindToolType(toolobject.tooltypes,'ADDICON')
  951.         IF yup(s) THEN addicon:=TRUE
  952.       ENDIF
  953.       IF s:=FindToolType(toolobject.tooltypes,'OVERWRITE')
  954.         IF yup(s) THEN addiconoverwrite:=TRUE
  955.       ENDIF
  956.  
  957.       IF s:=FindToolType(toolobject.tooltypes,'DITHER')
  958.         IF nope(s)
  959.           dither:=FALSE
  960.         ENDIF
  961.       ENDIF
  962.       IF s:=FindToolType(toolobject.tooltypes,'NEWICON')
  963.         IF yup(s)
  964.                     IF (newiconbase)
  965.               newicon:=TRUE
  966.                     ENDIF
  967.         ENDIF
  968.       ENDIF
  969.       IF s:=FindToolType(toolobject.tooltypes,'WHATIS')
  970.         IF nope(s) THEN usewhatis:=FALSE
  971.       ENDIF
  972.       IF s:=FindToolType(toolobject.tooltypes,'STRETCH')
  973.         IF yup(s) THEN stretch:=TRUE
  974.       ENDIF
  975.       IF s:=FindToolType(toolobject.tooltypes,'RENDERHAM6')
  976.         IF yup(s) THEN renderham:=6
  977.       ENDIF
  978.       IF s:=FindToolType(toolobject.tooltypes,'RENDERHAM8')
  979.         IF yup(s) THEN renderham:=8
  980.       ENDIF
  981.       IF s:=FindToolType(toolobject.tooltypes,'FULLHAMBASE')
  982.         IF yup(s) THEN hambase:=TRUE
  983.       ENDIF
  984.       IF s:=FindToolType(toolobject.tooltypes,'DISCARDERROR')
  985.         IF yup(s) THEN discard:=TRUE
  986.       ENDIF
  987.       IF s:=FindToolType(toolobject.tooltypes,'GREYSCALE')
  988.         IF yup(s) THEN greyscale:=1
  989.       ENDIF
  990.       IF s:=FindToolType(toolobject.tooltypes,'LUMSCALE')
  991.         IF yup(s) THEN greyscale:=2
  992.       ENDIF
  993.     ENDIF
  994.     IF wb.numargs>1
  995.       totfile:=wb.numargs-1
  996.       curfile:=1
  997.             abort:=FALSE
  998.       FOR locs:=2 TO wb.numargs
  999.         olddir:=args[].lock++
  1000.         IF args.lock
  1001.           olddir:=CurrentDir(args.lock)
  1002.           GetCurrentDirName(filename,250)
  1003.           NameFromLock(args.lock,wstr,240)
  1004.           CurrentDir(olddir)
  1005.           processname(filename,wstr,args.name)
  1006.           mode:=MODE_WB
  1007.           enforcemax()
  1008.           processicon()
  1009.         ENDIF
  1010.         curfile:=curfile+1
  1011.                 IF CtrlC();locs:=50000;ENDIF
  1012.                 IF (abort<>0);locs:=50000;ENDIF
  1013.       ENDFOR
  1014.     ELSE
  1015.       mode:=MODE_APP
  1016.       enforcemax()
  1017.       dosleep()
  1018.     ENDIF
  1019.   ELSE
  1020.     mode:=MODE_CLI
  1021.     FOR scratch:=0 TO 39
  1022.       argarray[scratch]:=NIL
  1023.     ENDFOR
  1024.     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)
  1025.     IF rdarg
  1026.       IF argarray[1]
  1027.         StrCopy(templatename,argarray[1],ALL)
  1028.         stripinfo(templatename)
  1029.       ENDIF
  1030.       IF argarray[2]
  1031.         StrCopy(backname,argarray[2],ALL)
  1032.         stripinfo(backname)
  1033.       ENDIF
  1034.       IF argarray[3]
  1035.         maxiwidth:=argarray[3]
  1036.         maxiwidth:=^maxiwidth
  1037.       ENDIF
  1038.       IF argarray[4]
  1039.         maxiheight:=argarray[4]
  1040.         maxiheight:=^maxiheight
  1041.       ENDIF
  1042.       IF argarray[5]
  1043.         posx:=argarray[5]
  1044.         posx:=^posx
  1045.       ENDIF
  1046.       IF argarray[6]
  1047.         posy:=argarray[6]
  1048.            posy:=^posy
  1049.       ENDIF
  1050.       IF argarray[7]
  1051.         sizex:=argarray[7]
  1052.         sizex:=^sizex
  1053.       ENDIF
  1054.       IF argarray[8]
  1055.         sizey:=argarray[8]
  1056.         sizey:=^sizey
  1057.       ENDIF
  1058.       IF argarray[9]
  1059.         showx:=argarray[9]
  1060.         showx:=^showx
  1061.                 showflag:=TRUE
  1062.       ENDIF
  1063.       IF argarray[10]
  1064.         showy:=argarray[10]
  1065.         showy:=^showy
  1066.                 showflag:=TRUE
  1067.       ENDIF
  1068.       IF argarray[11]
  1069.         first4:=argarray[11]
  1070.         first4:=^first4
  1071.       ENDIF
  1072.       IF argarray[12]
  1073.         quant:=argarray[12]
  1074.         quant:=^quant
  1075.       ENDIF
  1076.       IF argarray[13]
  1077.         hamthres:=argarray[12]
  1078.         hamthres:=^hamthres
  1079.       ENDIF
  1080.  
  1081.             IF argarray[14] THEN dither:=FALSE
  1082.             IF argarray[15] THEN centerflag:=TRUE
  1083.             IF argarray[16] THEN first4:=3
  1084.             IF argarray[17] THEN freeme:=TRUE
  1085.             IF argarray[18] THEN chunkyflag:=TRUE
  1086.             IF argarray[19] THEN force8:=TRUE
  1087.             IF argarray[20] THEN texttype:=TEXT_OUTLINE
  1088.             IF argarray[21] THEN texttype:=TEXT_NORMAL
  1089.             IF argarray[22] THEN tallfont:=TRUE
  1090.             IF argarray[23] THEN SetTaskPri(FindTask(0),-1)
  1091.             IF argarray[24];quietflag:=TRUE;mode:=MODE_QUIET;ENDIF
  1092.       IF argarray[25]
  1093.         aspectx:=argarray[25]
  1094.         aspectx:=limit(^aspectx,1,100)
  1095.       ENDIF
  1096.       IF argarray[26]
  1097.         aspecty:=argarray[26]
  1098.         aspecty:=limit(^aspecty,1,100)
  1099.       ENDIF
  1100.             IF argarray[27] THEN useaspect:=FALSE
  1101.             IF argarray[28] THEN usewhatis:=FALSE
  1102.             IF argarray[29]
  1103.                 IF (newiconbase)
  1104.                     newicon:=TRUE
  1105.                 ENDIF
  1106.             ENDIF
  1107.             IF argarray[30] THEN greyscale:=1
  1108.             IF argarray[31] THEN greyscale:=2
  1109.             IF argarray[32] THEN renderham:=6
  1110.             IF argarray[33] THEN renderham:=8
  1111.             IF argarray[34] THEN hambase:=TRUE
  1112.             IF argarray[35] THEN discard:=TRUE
  1113.             IF argarray[36] THEN stretch:=TRUE
  1114.         enforcemax()
  1115.       IF argarray[0]
  1116.                 namesptr:=argarray[0]
  1117.                 err:=NIL
  1118.                 WHILE ((namesptr[0]) AND (err=NIL))
  1119.                     StrCopy(patternstr,namesptr[0],ALL)
  1120.                     apath:=New(SIZEOF anchorpath)
  1121.                     first:=FALSE
  1122.                     WHILE err=NIL
  1123.                         IF first=FALSE
  1124.                             err:=MatchFirst(patternstr,apath)
  1125.                             first:=TRUE
  1126.                         ELSE
  1127.                             err:=MatchNext(apath)
  1128.                         ENDIF
  1129.                         IF err=NIL
  1130.                             achain:=apath.last
  1131.                             IF (achain)
  1132.                                 fileinfo:=achain.info
  1133.                                 IF (fileinfo)
  1134.                                     IF (fileinfo.direntrytype<0)
  1135.                                         filestart:=FilePart(patternstr)
  1136.                                         pathlen:=filestart-patternstr
  1137.                                         IF (pathlen)
  1138.                                             StrCopy(filename,patternstr,pathlen)
  1139.                                         ELSE
  1140.                                             StrCopy(filename,'',ALL)
  1141.                                         ENDIF
  1142.                                         AddPart(filename,fileinfo.filename,490)
  1143.                                         StrCopy(dumstr,filename,ALL)
  1144.                                         UpperStr(dumstr)
  1145.                                         IF (InStr(dumstr,'.INFO')<0)
  1146.                                         postprocessicon()
  1147.                                         ENDIF
  1148.                                     ENDIF
  1149.                                 ENDIF
  1150.                             ENDIF
  1151.                         ENDIF
  1152.                     ENDWHILE
  1153.                     MatchEnd(apath)
  1154.                     Dispose(apath)
  1155.                     FOR i:=0 TO 749
  1156.                         IF stacked[i]<>0
  1157.                             StrCopy(filename,stacked[i],ALL)
  1158.                             processicon()
  1159.                         ENDIF
  1160.                         IF CtrlC();i:=5000;WriteF('***Break\n');ENDIF
  1161.                     ENDFOR
  1162.                     FOR i:=0 TO 749
  1163.                         IF stacked[i]<>0
  1164.                             DisposeLink(stacked[i])
  1165.                             stacked[i]:=0
  1166.                         ENDIF
  1167.                     ENDFOR
  1168.                     namesptr:=namesptr+4
  1169.                     IF err<>87 THEN err:=0
  1170.                 ENDWHILE
  1171.         StrCopy(filename,argarray[0],ALL)
  1172.       ENDIF
  1173.       FreeArgs(rdarg);rdarg:=NIL
  1174.     ENDIF
  1175.   ENDIF
  1176. ENDPROC
  1177. PROC enforcemax()
  1178.     IF maxiwidth<32 THEN maxiwidth:=32
  1179.     IF maxiwidth>1024 THEN maxiwidth:=1024
  1180.     IF maxiheight<32 THEN maxiheight:=32
  1181.     IF maxiheight>1024 THEN maxiheight:=1024
  1182.         IF (newicon)
  1183.             IF maxiwidth>92 THEN maxiwidth:=92
  1184.             IF maxiheight>92 THEN maxiheight:=92
  1185.         ENDIF
  1186.     maxiw:=maxiwidth-1
  1187.     maxih:=maxiheight-1
  1188.     IF quietflag
  1189.       mode:=MODE_QUIET
  1190.     ENDIF
  1191.     IF sizex>maxiw THEN sizex:=maxiw
  1192.     IF sizey>maxih THEN sizey:=maxih
  1193.     IF posx>=maxiw THEN posx:=maxiw-1
  1194.     IF posy>=maxih THEN posy:=maxih-1
  1195.     IF posx+sizex>maxiw THEN sizex:=maxiw-posx
  1196.     IF posy+sizey>maxih THEN sizey:=maxih-posy
  1197.     IF ((posx) OR (posy) OR (sizex) OR (sizey)) THEN posflag:=TRUE
  1198.     IF sizex=0 THEN sizex:=maxiw-posx
  1199.     IF sizey=0 THEN sizey:=maxih-posy
  1200. ENDPROC
  1201. PROC loadcatalog()
  1202.   IF localebase
  1203.     catalog:=OpenCatalogA(NIL,'picticon.catalog',[OC_BUILTINLANGUAGE,'english',NIL,NIL])
  1204.   ENDIF
  1205.   readstrings()
  1206.   FOR scratch:=0 TO L_ENDS
  1207.     sl[scratch]:=locale(scratch)
  1208.   ENDFOR
  1209. ENDPROC
  1210. PROC locale(strnum)
  1211.   DEF stpoint,defstr
  1212.   defstr:=sl[strnum]
  1213.   IF ((localebase) AND (catalog))
  1214.     stpoint:=GetCatalogStr(catalog,strnum,defstr)
  1215.   ELSE
  1216.     stpoint:=defstr
  1217.   ENDIF
  1218. ENDPROC stpoint
  1219. PROC readstrings()
  1220.   DEF buf,res=0
  1221.   buf:={catstrs}
  1222.   WHILE(Int(buf))<>0
  1223.     res:=res+1
  1224.     IF res>0 AND res<300
  1225.       sl[res]:=buf
  1226.     ENDIF
  1227.     WHILE Char(buf)<>"¶"
  1228.       buf:=buf+1
  1229.     ENDWHILE
  1230.     PutChar(buf,0)
  1231.     buf:=buf+1
  1232.     buf:=(Mul(Div((buf+1),2),2))
  1233.   ENDWHILE
  1234. ENDPROC
  1235. PROC savewinpos() HANDLE
  1236.   DEF buffer=NIL,fhand=0
  1237.  
  1238.     IF ((mode=MODE_CLI) OR (mode=MODE_QUIET)) THEN RETURN
  1239.  
  1240.   iff:=AllocIFF()
  1241.     IF (iff)
  1242.         fhand:=Open('ENV:Picticon.prefs',MODE_NEWFILE)
  1243.         iff.stream:=fhand
  1244.       IF (iff.stream)=NIL THEN Raise(E_NONE)
  1245.       InitIFFasDOS(iff)
  1246.       buffer:=New(100)
  1247.       ierror:=OpenIFF(iff,IFFF_WRITE)
  1248.       IF ierror THEN Raise(E_NONE)
  1249.         PushChunk(iff,"PREF","FORM",IFFSIZE_UNKNOWN)
  1250.         PushChunk(iff,"PREF","PRHD",IFFSIZE_UNKNOWN)
  1251.       PutLong(buffer,0);PutLong(buffer+2,0)
  1252.         WriteChunkBytes(iff,buffer,6)
  1253.        PopChunk(iff)
  1254.  
  1255.        PushChunk(iff,"PREF","WIND",IFFSIZE_UNKNOWN)
  1256.         dumb:=buffer
  1257.         PutLong(dumb,winx);PutLong(dumb+4,winy)
  1258.         WriteChunkBytes(iff,buffer,8)
  1259.        PopChunk(iff)
  1260.       PopChunk(iff)
  1261.     ENDIF
  1262.   Raise(E_NONE)
  1263. EXCEPT
  1264.   IF buffer THEN Dispose(buffer);buffer:=NIL
  1265.   freeiff(666)
  1266.   handleexception(exception)
  1267. ENDPROC
  1268. PROC loadwinpos() HANDLE
  1269.   DEF buffer=NIL
  1270.  
  1271.   iff:=AllocIFF()
  1272.   iff.stream:=Open('ENV:Picticon.prefs',MODE_OLDFILE)
  1273.   IF (iff.stream)=NIL THEN Raise(E_NONE)
  1274.   InitIFFasDOS(iff)
  1275.   buffer:=New(100)
  1276.   ierror:=OpenIFF(iff,IFFF_READ)
  1277.   IF ierror THEN Raise(E_NONE)
  1278.   ierror:=PropChunk(iff,"PREF","WIND")
  1279.   ierror:=StopOnExit(iff,"PREF","FORM")
  1280.   ierror:=ParseIFF(iff,IFFPARSE_SCAN)
  1281.  
  1282.   IF (sp:=FindProp(iff,"PREF","WIND"))
  1283.     dumb:=sp.data
  1284.     winx:=Long(dumb);winy:=Long(dumb+4)
  1285.   ENDIF
  1286.  
  1287.   Raise(E_NONE)
  1288. EXCEPT
  1289.   IF buffer THEN Dispose(buffer)
  1290.   freeiff(666)
  1291.   handleexception(exception)
  1292. ENDPROC
  1293. PROC freeiff(unit)
  1294.   IF iff
  1295.     CloseIFF(iff)
  1296.     IF (iff.stream) THEN Close(iff.stream)
  1297.     FreeIFF(iff)
  1298.     iff:=NIL
  1299.   ENDIF
  1300. ENDPROC
  1301. PROC openlibs()
  1302.   IF (aslbase:=OpenLibrary('asl.library', 36))=NIL THEN CleanUp(25)
  1303.   localebase:=OpenLibrary('locale.library',37)
  1304.   loadcatalog()
  1305.   mathbase:=safeopenlibrary('mathffp.library',39)
  1306.   datatypesbase:=safeopenlibrary('datatypes.library',39)
  1307.   mathtransbase:=safeopenlibrary('mathtrans.library',36)
  1308.   gadtoolsbase:=safeopenlibrary('gadtools.library',36)
  1309.   workbenchbase:=safeopenlibrary('workbench.library',36)
  1310.   iconbase:=safeopenlibrary('icon.library', 36)
  1311.   iffparsebase:=safeopenlibrary('iffparse.library',36)
  1312.   diskfontbase:=safeopenlibrary('diskfont.library', 36)
  1313.   whatisbase:=OpenLibrary('whatis.library', 3);IF whatisbase=0 THEN usewhatis:=0
  1314.   newiconbase:=OpenLibrary('newicon.library', 37)
  1315.   IF KickVersion(39);osversion:=TRUE;ELSE;osversion:=FALSE;ENDIF
  1316. ENDPROC
  1317. PROC safeopenlibrary(name,vers) HANDLE
  1318.   DEF lret
  1319.   IF ((lret:=OpenLibrary(name,vers))=NIL) THEN Raise(L_EF_LIBRARY)
  1320.   Raise(E_NONE)
  1321. EXCEPT
  1322.   handleexception(exception)
  1323. ENDPROC lret
  1324. PROC handleexception(except)
  1325.   IF except<>E_NONE THEN errormessage(except)
  1326.   IF quitter THEN leave(quitter)
  1327. ENDPROC
  1328. PROC closelibs()
  1329.     IF whatisbase THEN CloseLibrary(whatisbase)
  1330.   IF newiconbase THEN CloseLibrary(newiconbase)
  1331.   IF diskfontbase THEN CloseLibrary(diskfontbase)
  1332.   IF aslbase THEN CloseLibrary(aslbase)
  1333.   IF iffparsebase THEN CloseLibrary(iffparsebase)
  1334.   IF iconbase THEN CloseLibrary(iconbase)
  1335.   IF workbenchbase THEN CloseLibrary(workbenchbase)
  1336.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  1337.   IF datatypesbase THEN CloseLibrary(datatypesbase)
  1338.   IF layersbase THEN CloseLibrary(layersbase)
  1339.   IF keymapbase THEN CloseLibrary(keymapbase)
  1340.   IF mathbase THEN CloseLibrary(mathbase)
  1341.   IF mathtransbase THEN CloseLibrary(mathtransbase)
  1342.   IF localebase THEN CloseLibrary(localebase)
  1343. ENDPROC
  1344. PROC errormessage(errnum)
  1345.   IF errnum>=L_EF_FATAL
  1346.     errmsg(sl[errnum])
  1347.     quitter:=TRUE
  1348.   ELSE
  1349.     IF errnum>=L_E_GENERAL
  1350.       errmsg(sl[errnum])
  1351.     ELSE
  1352.       errmsg(sl[L_E_GENERAL])
  1353.     ENDIF
  1354.   ENDIF
  1355. ENDPROC
  1356. PROC errmsg(msgptr)
  1357.   IF mode=MODE_CLI
  1358.     WriteF('\s\n\n',msgptr)
  1359.   ELSE
  1360.     IF ((mode=MODE_WB) OR (mode=MODE_APP))
  1361.       displaymessage(msgptr,TRUE)
  1362.       Delay(80)
  1363.     ENDIF
  1364.   ENDIF
  1365. ENDPROC
  1366. PROC sp_div_tf_tf_f(int1,int2)
  1367.   RETURN SpDiv(SpFlt(int1),SpFlt(int2))
  1368. ENDPROC
  1369. PROC leave(flag)
  1370.   IF catalog THEN CloseCatalog(catalog)
  1371.   IF appimagedata THEN FreeMem(appimagedata,3200);appimagedata:=NIL
  1372.   IF curbitmap THEN myfreebitmap(curbitmap);curbitmap:=NIL
  1373.     IF newicon
  1374.         IF newdiskobj THEN FreeNewDiskObject(newdiskobj);newdiskobj:=NIL;diskobj:=NIL
  1375.     ELSE
  1376.       IF diskobj THEN FreeDiskObject(diskobj);diskobj:=NIL
  1377.     ENDIF
  1378.   IF visual THEN FreeVisualInfo(visual);visual:=NIL
  1379.   IF toolobject THEN FreeDiskObject(toolobject);toolobject:=NIL
  1380.  
  1381.   closelibs()
  1382.     END iinfo
  1383.  
  1384.   IF flag
  1385.     IF flag=TRUE
  1386.       CleanUp(0)
  1387.     ELSE
  1388.       CleanUp(flag)
  1389.     ENDIF
  1390.   ENDIF
  1391. ENDPROC
  1392.  
  1393. PROC myallocbitmap(w,h,d,type,tags)
  1394.   IF osversion=TRUE
  1395.     RETURN AllocBitMap(w,h,d,type,tags)
  1396.   ENDIF
  1397. ENDPROC
  1398.  
  1399. PROC myfreebitmap(bm)
  1400.   IF osversion=TRUE
  1401.     RETURN FreeBitMap(bm)
  1402.   ELSE
  1403.   ENDIF
  1404. ENDPROC
  1405.  
  1406. /*PROC findcolor(colap,ared,agrn,ablu)
  1407.   DEF pointred,pointgrn,pointblu,mpen
  1408.   mpen:=-1
  1409.   IF (first4>0) THEN mpen:=first4
  1410.   pointred:=Shl(Shl(Shl(ared,8),8),8)
  1411.   pointgrn:=Shl(Shl(Shl(agrn,8),8),8)
  1412.   pointblu:=Shl(Shl(Shl(ablu,8),8),8)
  1413.   RETURN FindColor(colap,pointred,pointgrn,pointblu,mpen)
  1414. ENDPROC
  1415. */
  1416. /*PROC mygetrgb32(colmap,first,ncolors,table)
  1417.   DEF rre,eee
  1418.   IF osversion=TRUE
  1419.     GetRGB32(colmap,first,ncolors,table)
  1420.   ELSE
  1421.     rre:=GetRGB4(colmap,first)
  1422.     eee:=(rre AND $F)
  1423.     PutChar(table,eee)
  1424.     PutChar(table+1,eee)
  1425.     PutChar(table+2,eee)
  1426.     PutChar(table+3,eee)
  1427.     eee:=Shr((rre AND $F0),4)
  1428.     PutChar(table+4,eee)
  1429.     PutChar(table+5,eee)
  1430.     PutChar(table+6,eee)
  1431.     PutChar(table+7,eee)
  1432.     eee:=Shr((rre AND $F00),8)
  1433.     PutChar(table+8,eee)
  1434.     PutChar(table+9,eee)
  1435.     PutChar(table+10,eee)
  1436.     PutChar(table+11,eee)
  1437.   ENDIF
  1438. ENDPROC*/
  1439. PROC processname(name,dir,file)
  1440.  
  1441.   DEF wish[20]:STRING
  1442.  
  1443.   StrCopy(name,dir,ALL)
  1444.   IF StrLen(file)            /* IF a file (NOT DISK/DRAWER) */
  1445.     RightStr(wish,name,1)
  1446.     IF StrCmp(wish,':',1)=NIL       /*  DISK:DIR/NAME */
  1447.       StrAdd(name,'/',ALL)
  1448.     ENDIF
  1449.     StrAdd(name,file,ALL)
  1450.   ELSE
  1451.     RightStr(wish,name,1)
  1452.     IF StrCmp(wish,':',1)        /* DISK:  (so add disk) */
  1453.       StrAdd(name,'disk',ALL)
  1454.     ENDIF
  1455.     IF StrCmp(wish,'/',1)        /* DISK:DIR/DIR/  (delete '/' */
  1456.       MidStr(name,name,0,StrLen(name)-1)
  1457.     ENDIF
  1458.   ENDIF
  1459.   MidStr(wish,name,0,1)
  1460.   IF StrCmp(wish,'/',1)
  1461.     MidStr(name,name,1,ALL)
  1462.   ENDIF
  1463.   stripinfo(name)
  1464. ENDPROC
  1465. PROC stripinfo(name)
  1466.   DEF comp1[6]:STRING,comp2[6]:STRING
  1467.  
  1468.   StrCopy(comp1,'.INFO',ALL)
  1469.   MidStr(comp2,name,StrLen(name)-5,5)
  1470.   UpperStr(comp2)
  1471.   IF StrCmp(comp1,comp2,5)
  1472.     MidStr(name,name,0,(StrLen(name)-5))
  1473.   ENDIF
  1474. ENDPROC
  1475. /*PROC grabrgbtables()
  1476.   DEF cmtable
  1477.   cmtable:=[0,0,0,0,0,0]:LONG
  1478.   FOR scratch:=0 TO Shl(1,depth)-1
  1479.     mygetrgb32(newcolormap,scratch,1,cmtable)
  1480.     redt[scratch]:=Char(cmtable)
  1481.     grnt[scratch]:=Char(cmtable+4)
  1482.     blut[scratch]:=Char(cmtable+8)
  1483.   ENDFOR
  1484. ENDPROC
  1485. */
  1486. PROC stripselect(flags)
  1487.   IF (flags AND GFLG_GADGHIMAGE) THEN flags:=flags-GFLG_GADGHIMAGE
  1488.   IF (flags AND GFLG_GADGHCOMP) THEN flags:=flags-GFLG_GADGHCOMP
  1489.   IF (flags AND GADGBACKFILL) THEN flags:=flags-GADGBACKFILL
  1490. ENDPROC flags
  1491.  
  1492.  
  1493. PROC copybitmap2image(sb,di,nb,ys,dp,savedepth)
  1494.  
  1495.   DEF plane,cp,cr,cb,byte,sbs=NIL:PTR TO mybitmapstruct
  1496.  
  1497.   sbs:=sb;byte:=di
  1498.   FOR plane:=1 TO savedepth
  1499.     IF plane>dp         /* If save plane is not edited, use highest that was */
  1500.       SELECT dp
  1501.         CASE 1;cp:=sbs.plane1
  1502.         CASE 2;cp:=sbs.plane2
  1503.         CASE 3;cp:=sbs.plane3
  1504.         CASE 4;cp:=sbs.plane4
  1505.         CASE 5;cp:=sbs.plane5
  1506.         CASE 6;cp:=sbs.plane6
  1507.         CASE 7;cp:=sbs.plane7
  1508.         CASE 8;cp:=sbs.plane8
  1509.       ENDSELECT
  1510.     ELSE
  1511.       SELECT plane
  1512.         CASE 1;cp:=sbs.plane1
  1513.         CASE 2;cp:=sbs.plane2
  1514.         CASE 3;cp:=sbs.plane3
  1515.         CASE 4;cp:=sbs.plane4
  1516.         CASE 5;cp:=sbs.plane5
  1517.         CASE 6;cp:=sbs.plane6
  1518.         CASE 7;cp:=sbs.plane7
  1519.         CASE 8;cp:=sbs.plane8
  1520.       ENDSELECT
  1521.     ENDIF
  1522.     FOR cr:=0 TO ys-1
  1523.       FOR cb:=0 TO nb-1
  1524.         MOVE.L byte,A0
  1525.         MOVE.L cp,A1
  1526.         MOVE.B (A1),(A0)
  1527.         byte:=byte+1;cp:=cp+1
  1528.       ENDFOR
  1529.       cp:=cp+(sbs.bytesperrow-nb)
  1530.     ENDFOR
  1531.   ENDFOR
  1532. ENDPROC
  1533.  
  1534. PROC copyrast2image(sb,di,nb,ys,dp,savedepth)
  1535.  
  1536.   DEF plane,cp,cr,cb,byte,sbs=NIL:PTR TO mybitmapstruct
  1537.  
  1538.   byte:=di
  1539.   FOR plane:=0 TO savedepth-1
  1540.     ditz:=Shl(1,smaller(plane,dp))
  1541.     FOR cr:=0 TO ys-1
  1542.       FOR cb:=0 TO nb-1
  1543.         body:=0
  1544.         FOR dang:=7 TO 0 STEP -1
  1545.           dumb:=ReadPixel(sb,(cb*8)+(7-dang),cr)
  1546.           IF (dumb AND ditz) THEN body:=(body OR Shl(1,dang))
  1547.         ENDFOR
  1548.         PutChar(byte,body)
  1549.         byte:=byte+1
  1550.       ENDFOR
  1551.     ENDFOR
  1552.   ENDFOR
  1553. ENDPROC
  1554.  
  1555. PROC findsize(rast1)
  1556.   DEF li,lt,a
  1557.   requestsizex:=NIL;requestsizey:=NIL
  1558.   FOR li:=0 TO maxih;FOR lt:=0 TO maxiw
  1559.       a:=ReadPixel(rast1,lt,li)
  1560.       IF (a)
  1561.         IF lt>requestsizex;requestsizex:=lt;ENDIF
  1562.         IF li>requestsizey;requestsizey:=li;ENDIF
  1563.       ENDIF
  1564.       IF a>highestcolor;highestcolor:=a;ENDIF
  1565.     ENDFOR;ENDFOR
  1566.   requestsizex:=requestsizex+1;requestsizey:=requestsizey+2
  1567. ENDPROC
  1568.  
  1569. PROC restorediskobj(diskobj:PTR TO diskobject)
  1570.   DEF gadget:PTR TO gadget
  1571.   gadget:=diskobj.gadget
  1572.   gadget.gadgetrender:=k[0]
  1573.   gadget.selectrender:=k[1]
  1574.   gadget.flags:=k[2]
  1575.   diskobj.drawerdata:=k[3]
  1576.   Dispose(k[4]);k[4]:=NIL
  1577.   Dispose(k[5]);k[5]:=NIL
  1578.   Dispose(k[6]);k[6]:=NIL
  1579.   diskobj.type:=k[7]
  1580.   IF k[9]  THEN FreeMem(k[9], k[8])
  1581.   IF k[10] THEN FreeMem(k[10],k[8])
  1582.   k[9]:=NIL
  1583.   k[10]:=NIL
  1584. ENDPROC
  1585.  
  1586. PROC creatediskobj(diskobj:PTR TO diskobject,rast1:PTR TO rastport) HANDLE
  1587.   DEF gadget:PTR TO gadget
  1588.   DEF iconsizex,iconsizey,highplane
  1589.   DEF numbyteswide,savedepthhow,sizetmp
  1590.   DEF i1:PTR TO image,i2:PTR TO image
  1591.   DEF bitm1
  1592.  
  1593.   gadget:=diskobj.gadget
  1594.   k[0]:=gadget.gadgetrender
  1595.   k[1]:=gadget.selectrender
  1596.   k[2]:=gadget.flags
  1597.   k[3]:=diskobj.drawerdata
  1598.   k[4]:=New(SIZEOF image)
  1599.   k[5]:=New(SIZEOF image)
  1600.   k[6]:=New(SIZEOF drawerdata)
  1601.   k[7]:=diskobj.type
  1602.   k[8]:=0
  1603.   k[9]:=0
  1604.   highestcolor:=0
  1605.   bitm1:=curbitmap
  1606.  
  1607.   findsize(rast1)
  1608.   iconsizex:=bigger(bigger(requestsizex,10),minimumx)
  1609.   iconsizey:=bigger(bigger(requestsizey,10),minimumy)
  1610.  
  1611.   numbyteswide:=((iconsizex+15)/16)*2
  1612.   savedepthhow:=depth
  1613.   IF (force8) THEN savedepthhow:=8
  1614.   sizetmp:=(numbyteswide*iconsizey*savedepthhow)+1000
  1615.  
  1616.   k[8]:=sizetmp
  1617.   k[9]:=AllocMem(sizetmp,(MEMF_CHIP OR MEMF_CLEAR))
  1618.   k[10]:=AllocMem(sizetmp,(MEMF_CHIP OR MEMF_CLEAR))
  1619.   IF ((k[9]=NIL) OR (k[10]=NIL)) THEN Raise(L_EF_CHIPBUFFER)
  1620.  
  1621.   IF chunkyflag=NIL
  1622.     copybitmap2image(bitm1,k[9],numbyteswide,iconsizey-1,depth,savedepthhow)
  1623.   ELSE
  1624.     copyrast2image(rast1,k[9],numbyteswide,iconsizey-1,depth,savedepthhow)
  1625.   ENDIF
  1626.   i1:=k[4];i2:=k[5]
  1627.   i1.leftedge:=0;i1.topedge:=0;i1.width:=iconsizex
  1628.   i1.height:=iconsizey-1;i1.depth:=8;i1.imagedata:=k[9]
  1629.   i1.planepick:=0;i1.planeonoff:=0;i1.nextimage:=NIL
  1630.   i2.leftedge:=0;i2.topedge:=0;i2.width:=iconsizex
  1631.   i2.height:=iconsizey-1;i2.depth:=8;i2.imagedata:=k[10]
  1632.   i2.planepick:=0;i2.planeonoff:=0;i2.nextimage:=NIL
  1633.  
  1634.   highplane:=1
  1635.   IF highestcolor>1;highplane:=2;ENDIF
  1636.   IF highestcolor>3;highplane:=3;ENDIF
  1637.   IF highestcolor>7;highplane:=4;ENDIF
  1638.   IF highestcolor>15;highplane:=5;ENDIF
  1639.   IF highestcolor>31;highplane:=6;ENDIF
  1640.   IF highestcolor>63;highplane:=7;ENDIF
  1641.   IF highestcolor>127;highplane:=8;ENDIF
  1642.   IF (force8)
  1643.     i1.depth:=8
  1644.     i2.depth:=8
  1645.   ELSE
  1646.     i1.depth:=highplane
  1647.     i2.depth:=highplane
  1648.   ENDIF
  1649.   gadget.width:=iconsizex;gadget.height:=iconsizey;gadget.gadgetrender:=i1
  1650.   gadget.selectrender:=NIL
  1651.   IF freeme=TRUE
  1652.     diskobj.currentx:=NO_ICON_POSITION
  1653.     diskobj.currenty:=NO_ICON_POSITION
  1654.   ENDIF
  1655.   gadget.flags:=stripselect(gadget.flags)
  1656.   gadget.flags:=(gadget.flags OR GFLG_GADGHCOMP)
  1657.   diskobj.type:=WBPROJECT
  1658.  
  1659.   Raise(E_NONE)
  1660. EXCEPT
  1661.   IF exception<>E_NONE
  1662.     errormessage(exception)
  1663.   ENDIF
  1664.   IF quitter THEN leave(quitter)
  1665. ENDPROC
  1666.  
  1667. PROC yup(s) IS (MatchToolValue(s,{yes}) OR MatchToolValue(s,{true}))
  1668. PROC nope(s) IS (MatchToolValue(s,{no}) OR MatchToolValue(s,{false}))
  1669. PROC threshold(val,th);IF Abs(val)<=th THEN RETURN 0;ENDPROC val
  1670.  
  1671. PROC domethod( obj:PTR TO object, msg:PTR TO msg )
  1672.   DEF h:PTR TO hook, o:PTR TO object, dispatcher
  1673.   IF obj
  1674.     o := obj-SIZEOF object     /* instance data is to negative offset */
  1675.     h := o.class
  1676.     dispatcher := h.entry      /* get dispatcher from hook in iclass */
  1677.     MOVEA.L h,A0
  1678.     MOVEA.L msg,A1
  1679.     MOVEA.L obj,A2           /* probably should use CallHookPkt, but the */
  1680.     MOVEA.L dispatcher,A3    /*   original code (DoMethodA()) doesn't. */
  1681.     JSR (A3)                 /* call classDispatcher() */
  1682.     MOVE.L D0,o
  1683.     RETURN o
  1684.   ENDIF
  1685. ENDPROC NIL
  1686.  
  1687. PROC copyimagerast(rastp:PTR TO rastport,image)
  1688.   DrawImage(rastp,image,0,0)
  1689. ENDPROC
  1690.  
  1691. catstrs:
  1692.   CHAR 'Ok¶'
  1693.   CHAR 'Error: A general error has occured.¶'
  1694.   CHAR 'Error: File not found.¶'
  1695.   CHAR 'Error: Could not open file.¶'
  1696.   CHAR 'Error: Problems with icon.¶'
  1697.   CHAR 'Error: Unable to write icon file.¶'
  1698.   CHAR 'Error: Problems opening clipboard.¶'
  1699.   CHAR 'Error: Problems with datatype.¶'
  1700.   CHAR 'Error: Datatype is not a picture.¶'
  1701.   CHAR 'Error: Problems creating gadgets.¶'
  1702.   CHAR 'Error: Could not open a required library.¶'
  1703.   CHAR 'Error: An undefined FATAL error has occured.¶'
  1704.   CHAR 'Fatal Error: Could not lock a public screen.¶'
  1705.   CHAR 'Fatal Error: Not enough CHIP memory\n        for a required buffer.¶'
  1706.   CHAR 'Fatal Error: Could not obtain a visual lock.¶'
  1707.   CHAR 'Fatal Error: Unable to create menus.¶'
  1708.   CHAR 'Fatal Error: Could not open a port.¶'
  1709.   CHAR 'Fatal Error: Unable to open window.¶'
  1710.   CHAR 'Error: Unable to allocate some memory.¶'
  1711.   CHAR 'Picticon Status¶'
  1712.   CHAR 'Picture "\s"¶'
  1713.   CHAR '(\d of \d items)¶'
  1714.   CHAR 'Loading...¶'
  1715.   CHAR '*¶'
  1716.   CHAR '*¶'
  1717.   CHAR 'Saving icon.¶'
  1718.   CHAR '*¶'
  1719.   CHAR 'Picticon¶'
  1720.   CHAR 'Copyright ©1993,94\n by Chad Randall\n\nThis software is freely re-distributable.\n\nDo you wish to quit?¶'
  1721.   CHAR 'Quit|Cancel¶'
  1722.   CHAR 'Rendering...¶'
  1723.   CHAR '(\d%% done.)¶'
  1724.   CHAR '(directory)¶'
  1725.     CHAR 'Creating icon...¶'
  1726.   LONG 0,0,0
  1727.  
  1728. chardata:
  1729.  
  1730.   CHAR '.xxx...'
  1731.   CHAR 'x...x..'
  1732.   CHAR 'x...x..'
  1733.   CHAR 'x...x..'
  1734.   CHAR 'x...x..'
  1735.   CHAR '.xxx...'
  1736.  
  1737.   CHAR '..x....'
  1738.   CHAR '..x....'
  1739.   CHAR '..x....'
  1740.   CHAR '..x....'
  1741.   CHAR '..x....'
  1742.   CHAR '..x....'
  1743.  
  1744.   CHAR 'xxxxx..'
  1745.   CHAR '....x..'
  1746.   CHAR '..xxx..'
  1747.   CHAR '.x.....'
  1748.   CHAR 'x......'
  1749.   CHAR 'xxxxx..'
  1750.  
  1751.   CHAR 'xxxx...'
  1752.   CHAR '....x..'
  1753.   CHAR '..xx...'
  1754.   CHAR '....x..'
  1755.   CHAR '....x..'
  1756.   CHAR 'xxxx...'
  1757.  
  1758.   CHAR '...x...'
  1759.   CHAR '..xx...'
  1760.   CHAR '.x.x...'
  1761.   CHAR 'xxxxx..'
  1762.   CHAR '...x...'
  1763.   CHAR '...x...'
  1764.  
  1765.   CHAR 'xxxxx..'
  1766.   CHAR 'x......'
  1767.   CHAR 'xxxx...'
  1768.   CHAR '....x..'
  1769.   CHAR '....x..'
  1770.   CHAR 'xxxx...'
  1771.  
  1772.   CHAR '.xxx...'
  1773.   CHAR 'x......'
  1774.   CHAR 'xxxx...'
  1775.   CHAR 'x...x..'
  1776.   CHAR 'x...x..'
  1777.   CHAR '.xxx...'
  1778.  
  1779.   CHAR 'xxxxx..'
  1780.   CHAR '....x..'
  1781.   CHAR '...x...'
  1782.   CHAR '..x....'
  1783.   CHAR '..x....'
  1784.   CHAR '..x....'
  1785.  
  1786.   CHAR '.xxx...'
  1787.   CHAR 'x...x..'
  1788.   CHAR '.xxx...'
  1789.   CHAR 'x...x..'
  1790.   CHAR 'x...x..'
  1791.   CHAR '.xxx...'
  1792.  
  1793.   CHAR '.xxx...'
  1794.   CHAR 'x...x..'
  1795.   CHAR '.xxxx..'
  1796.   CHAR '....x..'
  1797.   CHAR '....x..'
  1798.   CHAR '.xxx...'
  1799.  
  1800. xdata:
  1801.   CHAR '.......'
  1802.   CHAR '.......'
  1803.   CHAR '.x.x...'
  1804.   CHAR '..x....'
  1805.   CHAR '.x.x...'
  1806.   CHAR '.......'
  1807.  
  1808. chardatal:
  1809.  
  1810.   CHAR '.xxx...'
  1811.   CHAR 'x...x..'
  1812.   CHAR 'x...x..'
  1813.   CHAR 'x...x..'
  1814.   CHAR 'x...x..'
  1815.   CHAR 'x...x..'
  1816.   CHAR 'x...x..'
  1817.   CHAR '.xxx...'
  1818.  
  1819.   CHAR '..x....'
  1820.   CHAR '..x....'
  1821.   CHAR '..x....'
  1822.   CHAR '..x....'
  1823.   CHAR '..x....'
  1824.   CHAR '..x....'
  1825.   CHAR '..x....'
  1826.   CHAR '..x....'
  1827.  
  1828.   CHAR '.xxx...'
  1829.   CHAR 'x...x..'
  1830.   CHAR '....x..'
  1831.   CHAR '...x...'
  1832.   CHAR '..x....'
  1833.   CHAR '.x.....'
  1834.   CHAR 'x......'
  1835.   CHAR 'xxxxx..'
  1836.  
  1837.   CHAR '.xxx...'
  1838.   CHAR 'x...x..'
  1839.   CHAR '....x..'
  1840.   CHAR '..xx...'
  1841.   CHAR '....x..'
  1842.   CHAR '....x..'
  1843.   CHAR 'x...x..'
  1844.   CHAR '.xxx...'
  1845.  
  1846.   CHAR '...x...'
  1847.   CHAR '..xx...'
  1848.   CHAR '.x.x...'
  1849.   CHAR 'x..x...'
  1850.   CHAR 'xxxxx..'
  1851.   CHAR '...x...'
  1852.   CHAR '...x...'
  1853.   CHAR '...x...'
  1854.  
  1855.   CHAR 'xxxxx..'
  1856.   CHAR 'x......'
  1857.   CHAR 'x......'
  1858.   CHAR 'xxxx...'
  1859.   CHAR '....x..'
  1860.   CHAR '....x..'
  1861.   CHAR '....x..'
  1862.   CHAR 'xxxx...'
  1863.  
  1864.   CHAR '.xxx...'
  1865.   CHAR 'x......'
  1866.   CHAR 'x......'
  1867.   CHAR 'xxxx...'
  1868.   CHAR 'x...x..'
  1869.   CHAR 'x...x..'
  1870.   CHAR 'x...x..'
  1871.   CHAR '.xxx...'
  1872.  
  1873.   CHAR 'xxxxx..'
  1874.   CHAR '....x..'
  1875.   CHAR '....x..'
  1876.   CHAR '...x...'
  1877.   CHAR '..x....'
  1878.   CHAR '..x....'
  1879.   CHAR '..x....'
  1880.   CHAR '..x....'
  1881.  
  1882.   CHAR '.xxx...'
  1883.   CHAR 'x...x..'
  1884.   CHAR 'x...x..'
  1885.   CHAR '.xxx...'
  1886.   CHAR 'x...x..'
  1887.   CHAR 'x...x..'
  1888.   CHAR 'x...x..'
  1889.   CHAR '.xxx...'
  1890.  
  1891.   CHAR '.xxx...'
  1892.   CHAR 'x...x..'
  1893.   CHAR 'x...x..'
  1894.   CHAR '.xxxx..'
  1895.   CHAR '....x..'
  1896.   CHAR '....x..'
  1897.   CHAR 'x...x..'
  1898.   CHAR '.xxx...'
  1899.  
  1900. xdatal:
  1901.   CHAR '.......'
  1902.   CHAR '.......'
  1903.   CHAR 'x...x..'
  1904.   CHAR '.x.x...'
  1905.   CHAR '..x....'
  1906.   CHAR '.x.x...'
  1907.   CHAR 'x...x..'
  1908.   CHAR '.......'
  1909.  
  1910. controlstring:
  1911.   CHAR 10,$B,0,0,0,0
  1912.   CHAR $9B,"1",$53,$0,$0,$0,$0
  1913.  
  1914. versionstring:
  1915. CHAR 0,0,0,0
  1916. CHAR '\0$VER: picticon 1.1 (2.4.95)\0'
  1917. CHAR 0,0,0,0
  1918.  
  1919.