home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / fish / disks / d1047.lha / Programs / Iconian / Source / 3-2-8.e < prev    next >
Encoding:
Text File  |  1994-04-09  |  5.7 KB  |  221 lines
  1. /*
  2.   open drop-app-icon image (Either default, or filename)
  3.   place app icon image onto workbench
  4.   enter loop
  5.     double click, ask to quit.
  6.     dropped image
  7.       loadimage
  8.       if 8 planes
  9.         save 3 planes
  10.       if 3 planes
  11.         save 8 planes
  12.   endloop
  13. */
  14.  
  15. OPT OSVERSION=39
  16.  
  17. MODULE    'exec/nodes','exec/ports','exec/types','exec/memory',
  18.                 'intuition/intuition',
  19.                 'dos/dos','dos/dosextens','workbench/workbench',
  20.                 'workbench/startup','wb','icon','Asl','libraries/Asl'
  21.  
  22.     DEF appport=NIL:PTR TO mp
  23.     DEF appflag=NIL
  24.     DEF appicon,newproj[250]:STRING
  25.     DEF lockname[250]:STRING,newlock=NIL
  26.     DEF fname[250]:STRING
  27.     DEF appobj:PTR TO diskobject
  28.     DEF oldchoice
  29.     DEF sleepobject=NIL:PTR TO diskobject
  30.     DEF appobject:PTR TO diskobject
  31.     DEF filename[250]:STRING
  32.     DEF amsg:PTR TO appmessage
  33.     DEF argptr:PTR TO wbarg
  34.     DEF args:PTR TO wbarg
  35.     DEF scratch
  36.     DEF appname[250]:STRING
  37.     DEF wb:PTR TO wbstartup
  38.     DEF olddir
  39.     DEF toolobject:PTR TO diskobject
  40.  
  41. PROC main()
  42.     IF (workbenchbase:=OpenLibrary('workbench.library',0))
  43.         IF (iconbase:=OpenLibrary('icon.library',0))
  44.             IF (aslbase:=OpenLibrary('asl.library',0))
  45.  
  46.                 IF wbmessage<>NIL
  47.                     wb:=wbmessage;args:=wb.arglist
  48.                     olddir:=CurrentDir(args.lock)
  49.                     IF args.name>0
  50.                         GetCurrentDirName(appname,250)
  51.                     ENDIF
  52.                 ENDIF
  53.                 StrAdd(appname,'328_DropImage',ALL)
  54.  
  55.                 IF (sleepobject:=GetDiskObjectNew(appname))=NIL
  56.                     sleepobject:=GetDefDiskObject(WBTOOL)
  57.                 ENDIF
  58.                 IF sleepobject
  59.                     sleepobject.type:=NIL
  60.                     appobject:=sleepobject
  61.                     IF (appport:=CreateMsgPort())
  62.                         IF (appicon:=AddAppIconA(0,0,'3-2-8',appport,0,appobject,NIL))<>NIL
  63.                             WHILE appflag=NIL
  64.                                 WaitPort(appport)
  65.                                 WHILE (amsg:=GetMsg(appport))<>NIL
  66.                                     IF amsg.numargs=0
  67.                                         IF EasyRequestArgs(0, [20, 0, '3-2-8', 'COPYRIGHT ®1994 by Chad Randall\n\nDo you wish to quit?','Ok|Cancel'], 0, 0)
  68.                                             appflag:=TRUE
  69.                                         ENDIF
  70.                                     ELSE
  71.                                         argptr:=amsg.arglist
  72.                                         FOR scratch:=1 TO amsg.numargs
  73.                                             StrCopy(newproj,argptr.name,ALL)
  74.                                             newlock:=argptr.lock
  75.                                             IF newlock
  76.                                                 NameFromLock(newlock,lockname,250)
  77.                                                 processname(filename,lockname,newproj)
  78.                                                 toggleiconplanes(filename)
  79.                                             ENDIF
  80.                                             argptr:=argptr+(SIZEOF wbarg)
  81.                                         ENDFOR
  82.                                     ENDIF
  83.                                     ReplyMsg(amsg)
  84.                                 ENDWHILE
  85.                             ENDWHILE
  86.                             RemoveAppIcon(appicon)
  87.                             WHILE (amsg:=GetMsg(appport))<>NIL
  88.                                 ReplyMsg(amsg)
  89.                             ENDWHILE
  90.                         ENDIF
  91.                         DeleteMsgPort(appport)
  92.                     ENDIF
  93.                     FreeDiskObject(sleepobject);sleepobject:=NIL
  94.                 ENDIF
  95.                 CloseLibrary(aslbase)
  96.             ENDIF
  97.             CloseLibrary(iconbase)
  98.         ENDIF
  99.         CloseLibrary(workbenchbase)
  100.     ENDIF
  101. ENDPROC
  102.  
  103. PROC stripinfo(name)
  104.     DEF comp1[6]:STRING,comp2[6]:STRING
  105.  
  106.     StrCopy(comp1,'.INFO',ALL)
  107.     MidStr(comp2,name,StrLen(name)-5,5)
  108.     UpperStr(comp2)
  109.     IF StrCmp(comp1,comp2,5)
  110.         MidStr(name,name,0,(StrLen(name)-5))
  111.     ENDIF
  112. ENDPROC
  113.  
  114. PROC processname(name,dir,file)
  115.  
  116.     DEF wish[20]:STRING
  117.  
  118.     StrCopy(name,dir,ALL)
  119.     IF StrLen(file)            /* IF a file (NOT DISK/DRAWER) */
  120.         RightStr(wish,name,1)
  121.         IF StrCmp(wish,':',1)=NIL       /*  DISK:DIR/NAME */
  122.             StrAdd(name,'/',ALL)
  123.         ENDIF
  124.         StrAdd(name,file,ALL)
  125.     ELSE
  126.         RightStr(wish,name,1)
  127.         IF StrCmp(wish,':',1)        /* DISK:  (so add disk) */
  128.             StrAdd(name,'disk',ALL)
  129.         ENDIF
  130.         IF StrCmp(wish,'/',1)        /* DISK:DIR/DIR/  (delete '/' */
  131.             MidStr(name,name,0,StrLen(name)-1)
  132.         ENDIF
  133.     ENDIF
  134.     MidStr(wish,name,0,1)
  135.     IF StrCmp(wish,'/',1)
  136.         MidStr(name,name,1,ALL)
  137.     ENDIF    
  138.     stripinfo(name)
  139. ENDPROC
  140.  
  141. PROC toggleiconplanes(name)
  142.     DEF diskobj:PTR TO diskobject
  143.     DEF icongad:PTR TO gadget
  144.     DEF regimage:PTR TO image,selimage:PTR TO image
  145.     DEF sizetmp,sizetmp2,tmpbuf,tmpbuf2,oldtmp,oldtmp2
  146.     DEF bufptr,bufptr2,dummy,scratch
  147.  
  148.     IF (diskobj:=GetDiskObject(name))
  149.         IF ((icongad:=diskobj.gadget))
  150.             regimage:=icongad.gadgetrender
  151.             selimage:=icongad.selectrender
  152.  
  153.             IF regimage.depth=3
  154.                 regimage.depth:=8
  155.                 IF selimage THEN selimage.depth:=8
  156.  
  157.                 sizetmp:=((((regimage.width+15)/16)*2)*regimage.height*8)+1000
  158.                 sizetmp2:=((((selimage.width+15)/16)*2)*selimage.height*8)+1000
  159.                 tmpbuf:=AllocMem(sizetmp,MEMF_CHIP OR MEMF_CLEAR)
  160.                 tmpbuf2:=AllocMem(sizetmp,MEMF_CHIP OR MEMF_CLEAR)
  161.  
  162.                 bufptr:=regimage.imagedata
  163.                 bufptr2:=tmpbuf
  164.                 FOR scratch:=1 TO ((((regimage.width+15)/16)*2)*regimage.height*3)
  165.                     PutChar(bufptr2,Char(bufptr))
  166.                     bufptr:=bufptr+1
  167.                     bufptr2:=bufptr2+1
  168.                 ENDFOR
  169.  
  170.                 FOR dummy:=3 TO 7
  171.                     bufptr:=regimage.imagedata+((((regimage.width+15)/16)*2)*2*regimage.height)
  172.                     FOR scratch:=1 TO ((((regimage.width+15)/16)*2)*regimage.height)
  173.                         PutChar(bufptr2,Char(bufptr))
  174.                         bufptr:=bufptr+1
  175.                         bufptr2:=bufptr2+1
  176.                     ENDFOR
  177.                 ENDFOR
  178.  
  179.                 IF selimage
  180.                     bufptr:=selimage.imagedata
  181.                     bufptr2:=tmpbuf2
  182.                     FOR scratch:=1 TO ((((selimage.width+15)/16)*2)*selimage.height*3)
  183.                         PutChar(bufptr2,Char(bufptr))
  184.                         bufptr:=bufptr+1
  185.                         bufptr2:=bufptr2+1
  186.                     ENDFOR
  187.  
  188.                     FOR dummy:=3 TO 7
  189.                         bufptr:=selimage.imagedata+((((selimage.width+15)/16)*2)*2*selimage.height)
  190.                         FOR scratch:=1 TO ((((selimage.width+15)/16)*2)*selimage.height)
  191.                             PutChar(bufptr2,Char(bufptr))
  192.                             bufptr:=bufptr+1
  193.                             bufptr2:=bufptr2+1
  194.                         ENDFOR
  195.                     ENDFOR
  196.                 ENDIF
  197.  
  198.                 oldtmp:=regimage.imagedata
  199.                 IF selimage THEN oldtmp2:=selimage.imagedata
  200.                 regimage.imagedata:=tmpbuf
  201.                 IF selimage THEN selimage.imagedata:=tmpbuf2
  202.  
  203.                 PutDiskObject(name,diskobj)
  204.  
  205.                 regimage.depth:=3
  206.                 IF selimage THEN selimage.depth:=3
  207.                 regimage.imagedata:=oldtmp
  208.                 IF selimage THEN selimage.imagedata:=oldtmp2
  209.             ENDIF
  210.             IF regimage.depth=8
  211.                 regimage.depth:=3
  212.                 IF selimage THEN selimage.depth:=3
  213.                 PutDiskObject(name,diskobj)
  214.                 regimage.depth:=8
  215.                 IF selimage THEN selimage.depth:=8
  216.             ENDIF
  217.         ENDIF
  218.     ENDIF
  219.     IF diskobj THEN FreeDiskObject(diskobj)
  220. ENDPROC
  221.