home *** CD-ROM | disk | FTP | other *** search
/ DTP Toolbox / DTPToolbox.iso / utilities / propage_pdraw / donsgenies / adproscripts.lha / Thumbnails76 < prev   
Encoding:
Text File  |  1995-10-07  |  12.8 KB  |  418 lines
  1. /* Program to use ADPro to make sets of thumbnail miniatures of all the pictures in a directory, including subdirectories. They can be in a variey of formats. They will be rendered in Hi-Res Interlace, 16-colour or Ham-8.
  2. The dither mode currently in force is used. */
  3. /* If it jams up while trying to load in a file which it thinks (wrongly) is a Targa or PCX image, just click on Abort. */
  4.  
  5. /* Written by Don Cox, Nov. '93. Bug Fix June 94. PCX bug fix Oct 95. Copyright, not Public Domain. */
  6. /* $VER:Thumbnails76 Oct 95 */
  7.  
  8. /* call open("STDERR","ram:traceTN","W")
  9. trace r */
  10.  
  11. options results
  12. numeric digits 14
  13.  
  14. /* Screen type definitions - do not alter */
  15. hires = 1
  16. interlace = 2
  17. pal = 4  /* NTSC if off */
  18. hoverscan = 8
  19. voverscan = 16
  20. vga = 32
  21. superhires = 64
  22. super72 = 128
  23. default = 256
  24.  
  25.  
  26. /* ++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++ */
  27.  
  28. /* These presets can be edited by the user */
  29. backcolour = "80 80 80" /* colours in RGB format - don't forget the quotes */
  30. framecolour = "190 190 190"
  31. highlightcolour = "220 220 220" /* 3D effect on frames */
  32. shadowcolour = "80 80 80"
  33. textcolour = "0 0 0"
  34. textfont = "Folio-Medium"  /* Must be in Fonts: directory */
  35. textsize = 13
  36. bigwidth = 640 /* width of final Catalogue image */
  37. bigheight = 512 /* height of final image */
  38. columns = 7  /* layout of final picture */
  39. rows = 6
  40.  
  41. dithertype = 8  /* This is small ordered */
  42. ditheramount = 16  /* How much dither */
  43. screentype = hires + interlace + pal
  44.  
  45.  
  46. /* +++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++ */
  47.  
  48. address "ADPro"
  49. ADPRO_TO_FRONT
  50.  
  51. getdir '"Select source directory"'
  52. if rc=10 then exit
  53. directory = ADPro_Result
  54.  
  55. getdir '"Select directory for saving"'
  56. if rc=10 then exit
  57. sdirectory = ADPro_Result
  58. if upper(sdirectory) = "RAM DISK:" then sdirectory = "Ram:"
  59. if right(sdirectory,1) ~=":" then sdirectory = sdirectory||"/"
  60.  
  61. getdir '"Select directory for temporary files"' '"ram:"'
  62. if rc=10 then exit
  63. tdirectory = ADPro_Result
  64. if right(tdirectory,1) ~=":" then tdirectory = tdirectory||"/"
  65.  
  66. hammer = "HAM8"
  67. okay2 "OK for Ham8, Cancel for 16 colours"
  68. hammit = rc
  69. if hammit = 0 then hammer = 16
  70.  
  71.  
  72.  
  73. lformat "UNIVERSAL"
  74. sformat "IFF"
  75. pstatus "UNLOCKED"
  76. load_type "REPLACE"
  77.  
  78.  
  79. smallwidth = trunc(bigwidth/columns)
  80. smallheight = trunc(bigheight/rows) 
  81.  
  82.  
  83. /* Make index chart files of one directory and its descendents */
  84.  
  85. address command
  86. 'list >ram:dirlist 'directory' dirs all LFORMAT="%P%S"'
  87. call open("dirinput","ram:dirlist","r")
  88.  
  89. /* First make index charts for pics in root diectory */
  90. 'delete ram:filelist1'
  91. 'delete ram:filelist'
  92. 'list >ram:filelist1 'directory' files LFORMAT="%P%S"'
  93. call open(input,"ram:filelist1","r") /* test in case it's empty */
  94. listtest = readln(input)
  95. call close input
  96.  
  97. if listtest~="" then do
  98.     'sort from ram:filelist1 to ram:filelist'
  99.  
  100.     pos1 = lastpos("/",directory)
  101.     if pos1 = 0 then pos1 = lastpos(":",directory)
  102.     basename = substr(directory,pos1+1)
  103.     if basename = "" then basename = strip(directory,'T',":")
  104.     if length(basename)>18 then basename = left(basename,18)
  105.     basename = basename||".index."
  106.     address "ADPro"
  107.     call dirchart
  108.     end
  109.  
  110.  
  111. /* Now do all the subdirectories */
  112. do d = 1 to 700
  113.     dirname = readln("dirinput")
  114.     if dirname = "" then break
  115.     pos1 = lastpos("/",dirname)
  116.     if pos1 = 0 then pos1 = lastpos(":",dirname)
  117.     basename = substr(dirname,pos1+1)
  118.     if length(basename)>18 then basename = left(basename,18)
  119.     basename = basename||".index."
  120.  
  121.  
  122.     address command
  123.     'delete ram:filelist1'
  124.     'delete ram:filelist'
  125.     'list >ram:filelist1 'dirname' files LFORMAT="%P%S"'
  126.     call open(input,"ram:filelist1","r") /* test in case it's empty */
  127.     listtest = readln(input)
  128.     call close input
  129.  
  130.     if listtest~="" then do
  131.         'sort from ram:filelist1 to ram:filelist'
  132.         address "ADPro"
  133.         call dirchart
  134.         end
  135.     end
  136.  
  137. address "ADPro"
  138. ADPRO_TO_FRONT
  139. OKAY1 "Finished..."
  140. exit
  141. end
  142.  
  143. /* ++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++ */
  144.  
  145.  
  146. getpath:
  147. arg allname
  148. pos1 = lastpos("/",allname)
  149. if pos1 = 0 then pos1 = lastpos(":",allname)
  150. filepath = left(allname,pos1)
  151. return filepath
  152.  
  153. getname:
  154. arg allname
  155. pos1 = lastpos("/",allname)
  156. if pos1 = 0 then pos1 = lastpos(":",allname)
  157. justname = substr(allname,pos1+1)
  158. return justname 
  159.  
  160. /* +++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++ */
  161.  
  162. /* Make a single screen full of little pictures */
  163. makechart:
  164.         lformat "BACKDROP"
  165.         LOAD "XXX" bigwidth bigheight "COLOR"
  166.         lformat "IFF"
  167.         LOAD_TYPE "COMPOSE"
  168.         do p = 0 to lastpic
  169.             pp = p+1
  170.             /* position by rows & columns, and adjust for centring */
  171.             xpos = ((p//columns)* smallwidth)
  172.             ypos = ((p%columns) * smallheight)
  173.             xpos2 = xpos + ((smallwidth-scalewidth.pp)%2) /* centring - use integer division to avoid half-pixels */
  174.             ypos2 = ypos + ((imageheight-scaleheight.pp)%2)
  175.             pnumber = right(pp,3,"0")
  176.             loadname = tdirectory||"tpic"||pnumber
  177.  
  178.             OPERATOR "RECTANGLE" xpos ypos smallwidth smallheight "-1" backcolour /* grey background */
  179.             LOAD loadname xpos2 ypos2
  180.             OPERATOR "RECTANGLE" (xpos) (ypos) (smallwidth-1) (imageheight) 1 highlightcolour
  181.             OPERATOR "RECTANGLE" (xpos+1) (ypos+1) (smallwidth-1) (smallheight-1) 1 shadowcolour
  182.             OPERATOR "RECTANGLE" xpos ypos smallwidth smallheight 1 framecolour
  183.             OPERATOR "RECTANGLE" xpos (ypos+imageheight) smallwidth textsize "-1" framecolour
  184.             xoff = trunc(xpos+4)
  185.             yoff = trunc(ypos+smallheight-textsize)
  186.  
  187.  
  188.             OPERATOR "TEXT_VISUAL",
  189.                 FONT_TYPE "BITMAPPED",
  190.                 FONT_DIR "Fonts:",
  191.                 FONT_NAME textfont,
  192.                 SET_FONT_SIZE textsize,
  193.                 SET_BLUR "-1",
  194.                 EMBOSS_DIRECTION "OFF",
  195.                 RENDER_TYPE "MIX",
  196.                 SET_COLORS textcolour,
  197.                 SET_RENDER 100,
  198.                 SET_XOFFSET xoff,
  199.                 SET_YOFFSET yoff,
  200.                 STRING picname.pp ,
  201.                 TEXT_HANDLE "LEFT",
  202.                 DRAW
  203.             success = rc
  204.             end
  205.  
  206.  
  207.         SCREEN_TYPE screentype
  208.         DITHER dithertype
  209.         DITHER_AMOUNT ditheramount
  210.         RENDER_TYPE hammer  /* Ham8 or 16-colour */
  211.         CONTRAST 1
  212.         EXECUTE
  213.         ADPRO_DISPLAY
  214.         PAUSE 150
  215.         pnumber = right(picnumber,3,"0")
  216.         savename = sdirectory||basename||pnumber
  217.         
  218.         if exists(savename) then do q=1 to 10
  219.             ADPRO_TO_FRONT
  220.             okay2 '"File exists. Overwrite it?"'
  221.             if rc ~= 0 then break /* User wants to overwrite */
  222.             getstring "'Type new basename for files'" basename
  223.             if rc~=0 then exit
  224.             basename = ADPRO_RESULT
  225.             savename = sdirectory||basename||pnumber
  226.             if ~exists(savename) then break /* break if new name provided */
  227.             end
  228.         SAVE savename "IMAGE"
  229.         PAUSE 150
  230.         picnumber = picnumber + 1
  231.         LOAD_TYPE "REPLACE"
  232.         
  233. return
  234.  
  235.  
  236. /* ++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++ */
  237.  
  238.  
  239. /* Make a set of charts for all the pics in a directory */
  240. dirchart:
  241. address "ADPro"
  242.  
  243. tn = 1         /* thumbnail pic number as saved to temp. storage */
  244. picnumber = 1  /* final chart pic number */
  245.  
  246. call open(input,"ram:filelist","r")
  247. do i = 1 to 7000   /* safety limit of 7000 files  */
  248.     filename = readln(input)
  249.     if filename = "" then break
  250.  
  251.     slashpos = lastpos("/",filename)
  252.     dotpos = lastpos(".",filename)
  253.     if dotpos<slashpos then dotpos = 0 /* not dots in directory names */
  254.     if dotpos~=0 then extension = substr(filename,dotpos)
  255.     else extension = ""
  256.     
  257.     if upper(extension) = ".INFO" then iterate
  258.     if upper(extension) = ".PSFONT" then iterate
  259.     if upper(extension) = ".FONT" then iterate
  260.     if upper(extension) = ".PDFONT" then iterate
  261.     if upper(extension) = ".PFB" then iterate
  262.     if upper(extension) = ".AFM" then iterate
  263.     if upper(extension) = ".METRIC" then iterate
  264.     if upper(extension) = ".LIB" then iterate
  265.     if upper(extension) = ".DEM" then iterate
  266.     if upper(extension) = ".DOC" then iterate
  267.     if upper(extension) = ".ZIP" then iterate
  268.     if upper(extension) = ".LHA" then iterate
  269.     if upper(extension) = ".ARC" then iterate
  270.     if upper(extension) = ".ME" then iterate
  271.     if upper(extension) = ".DAT" then iterate
  272.     if upper(extension) = ".TF" then iterate
  273.     if upper(extension) = ".DB" then iterate
  274.     if upper(extension) = ".C" then iterate    
  275.     if upper(extension) = ".H" then iterate
  276.     if upper(extension) = ".GF" then iterate
  277.     if upper(extension) = ".PPRX" then iterate
  278.     if upper(extension) = ".PDRX" then iterate
  279.     if upper(extension) = ".REXX" then iterate
  280.     if upper(extension) = ".ADPRO" then iterate
  281. /* Now some common PC extensions */
  282.     if upper(extension) = "." then iterate
  283.     if upper(extension) = ".HLP" then iterate
  284.     if upper(extension) = ".GAL" then iterate
  285.     if upper(extension) = ".EXE" then iterate
  286.     if upper(extension) = ".INI" then iterate
  287.     if upper(extension) = ".COM" then iterate
  288.     if upper(extension) = ".BAT" then iterate
  289.  
  290.  
  291.     if word(filename,2) = "files" then iterate /* This line not a file name */
  292.     if word(filename,1) = "TOTAL:" then break  /* or this one */
  293.  
  294.     load_type "REPLACE"
  295.     lformat "UNIVERSAL"
  296.  
  297.     call open("picinput",filename,"R")
  298.     chunks = readch("picinput",1000)
  299.     call seek("picinput",3,'B') /* position 3 to read 4th byte */
  300.     EGAbyte = readch("picinput",1) /* looking out for 1-bit PCXs */
  301.     EGAtest = c2d(EGAbyte,1)
  302.     call close("picinput")
  303.  
  304.  
  305.     if substr(chunks,9,4) = "ANIM" then do
  306.         lformat "ANIM"
  307.         load '"'filename'"' FRAME 1
  308.         end
  309.     else load '"'filename'"' /* Quotes allow file names with spaces */
  310.     if rc ~=0 then iterate /* if load fails, try the next one */
  311.  
  312.     pos1 = lastpos("/",filename)
  313.     if pos1 = 0 then pos1 = lastpos(":",filename)
  314.     picname.tn = '"'||substr(filename,pos1+1)||'"'
  315.  
  316.  
  317.     imagetype = 24bit /* if in doubt */
  318.     IMAGE_TYPE
  319.     itype = ADPRO_RESULT
  320.     if left(itype,8)="BITPLANE" then imagetype = bitplane
  321.     else if left(itype,5) = "COLOR" then imagetype = 24bit
  322.     else if left(itype,4) = "GRAY" then imagetype = gray
  323.  
  324.     if imagetype = bitplane then iterate /* can't scale if no 24-bit or 8-bit data  - i.e. picture too big for memory */
  325.  
  326.  
  327. /*    EGAbyte = substr(chunks,4,1)
  328.     EGAtest = b2c(EGAbyte)*/
  329.     if (upper(extension) = ".PCX" & EGAtest=1) then do /* deal with palette problems */
  330.         EXECUTE
  331.         ppoke 0 0 0 0
  332.         ppoke 1 255 255 255
  333.         OPERATOR "RENDERED_TO_RAW"
  334.         end
  335.  
  336.  
  337. /* Get size of loaded image, before scaling */
  338.     xsize
  339.     inputwidth = ADPro_result
  340.     ysize
  341.     inputheight = ADPro_result
  342.  
  343. /* Adjusting proportions */
  344.     CONTRAST "-1" /* Prevents ADPro's scaling artefacts, seen on 0 or 255 colours */
  345.     OPERATOR "APPLY_MAP"
  346.     prop = 1 /* for starters */
  347.  
  348. /* If it's an IFF file, the CAMG chunk should tell us its proportions */
  349.     CAMG = "null" /* just a dummy string */
  350.     binCAMG = "null"
  351.     filetype = left(chunks,4)
  352.     if filetype = "FORM" then do
  353.         CAMG = substr(chunks,pos("CAMG",chunks)+10,2)
  354.         if pos("CAMG",chunks)=0 then break
  355.         binCAMG = c2b(CAMG)
  356.         binCAMG = overlay("000000000000",binCAMG,2) /* don't want these bits */
  357.  
  358.         picformat = "null"
  359. /* These comparisons only just work, with numeric digits at 14, as the last 2 digits don't matter */
  360.         select
  361.             when binCAMG = "0000000000000000" then do
  362.                 picformat = "lores"
  363.                 prop=1
  364.                 end
  365.             when binCAMG = "1000000000000000" then do
  366.                 picformat = "medres"
  367.                 prop=0.5
  368.                 end
  369.             when binCAMG = "0000000000000100" then do
  370.                 picformat = "interlace"
  371.                 prop=2
  372.                 end
  373.             when binCAMG = "1000000000000100" then do
  374.                 picformat = "hires"
  375.                 prop=1
  376.                 end
  377.             otherwise do
  378.                 picformat = "unknown"
  379.                 prop=1
  380.                 end
  381.             end
  382.  
  383.         end
  384.  
  385.  
  386.     imageheight = smallheight-textsize /* allow for label */
  387.     scalewidth.tn = smallwidth
  388.     proportion = (inputheight)/(inputwidth*prop)
  389.     scaleheight.tn = trunc(scalewidth.tn * proportion ) /* keep proportions */
  390.     if scaleheight.tn >imageheight then do  /* vertical pics */
  391.         proportion = inputwidth*prop/inputheight
  392.         scalewidth.tn = trunc(imageheight* proportion )
  393.         scaleheight.tn = imageheight
  394.         end
  395.     ABS_SCALE scalewidth.tn scaleheight.tn
  396.  
  397.     tnumber = right(tn,3,"0") /* make 6 be 006, etc */
  398.     savename = tdirectory||"tpic"||tnumber
  399.     SAVE savename "RAW"
  400.  
  401.     tn = tn + 1
  402.     lastpic = tn - 2
  403.     if tn = (rows*columns)+1 then do
  404.         call makechart /* assemble pics together */
  405.         tn = 1
  406.         end
  407.  
  408.     end    /* end of directory */
  409.  
  410. call close(input)
  411. lastpic = tn - 2
  412. if tn~=1 then call makechart  /* do the remaining pics */
  413.  
  414. ADPRO_UNDISPLAY
  415.  
  416.  
  417. return
  418.