home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 4 / CDPD_IV.bin / fish / 911-930 / ff925 / donsgenies / frenchgenies.lha / Rexx / ImporteS駲uencedImages.pprx < prev    next >
Text File  |  1993-08-03  |  6KB  |  162 lines
  1. /*
  2. @BImporteSéquenceD'Images @P @I Ecrit et © par Don Cox 1993
  3. @IN'est pas du Domaine Publique. Tous Droits Réservés.
  4. Traduit par Fabien Larini le 30/07/93.
  5.     
  6. Ce Génie importe une série d'images (celles d'une animation par exemple)
  7. dans une page existante. Les pages nécessaires seront crées de la même
  8. manière que dans le Génie ImportationAuto. Le contenu des boîtes est caché
  9. afin de limiter la consommation de mémoire, deplus cela augmente la 
  10. vitesse de chargement du fichier.
  11. */    
  12.  
  13.  
  14. /*ImportFrames*/
  15. /* Program to load a numbered series of pictures (usually animation frames)
  16. onto an existing page. New pages are also created as in AutoImport. The box
  17. contents are hidden because showing a large number of bitmaps can exhaust 
  18. chip memory; also, hiding the images greatly speeds up loading. 
  19. Written by Don Cox, 1993. Not Public Domain. All rights reserved. */
  20.       
  21. trace n
  22.  
  23. call SafeEndEdit.rexx()
  24. call ppm_AutoUpdate(0)
  25. oldunits = ppm_GetUnits()
  26. call ppm_SetUnits(2)
  27. oldpoints = ppm_GetSize()
  28. call ppm_SetSize(12)
  29.  
  30. address command
  31.  
  32. currentpage = ppm_CurrentPage()
  33. if currentpage = 0 then currentpage = ppm_CreatePage(1,1,1,0,0)
  34. psize = ppm_GetPageSize(currentpage)
  35. pwidth = word(psize,1)
  36. if pwidth<5 then exit_msg("Page trop Petite")
  37. pheight = word(psize,2)
  38.  
  39. filename = ppm_GetFileName("Première Image", "", "")
  40. if filename = '' then exit_msg("Pas de fichier choisi")
  41.  
  42. form = "Images/Ligne (1-20):4"||"0a"x "Toute les :1"||"0a"x "Largeur Cadre (mm):1"
  43. form = ppm_GetForm("Mise en Page",5,form)
  44. if form = "" then exit_msg("Abandon Importation")
  45. parse var form rownumber "0a"x interval "0a"x linewidth
  46.  
  47. if rownumber<1 | rownumber>20 then exit_msg("Nombre d'Images par Ligne Invalide: "rownumber)
  48. if interval<1 then Exit_msg("Saisie Incorrecte pour l'intervalle des images chargées: "interval)
  49.  
  50. colgap = 0.5
  51. rowgap = 1.5
  52. pagemargin = 1.5
  53. pagemargin2 = pagemargin * 2
  54.  
  55. collist = ppm_GetColorList()
  56. collist = substr(collist, pos('0a'x, collist) +1) /* strip off initial line which is number of colours */
  57. firstcolour =  left(collist, pos('0a'x, collist)-1 )
  58. linecolor = firstcolour
  59.  
  60. if datatype(linewidth, 'N') =1 then do
  61.     if linewidth =0 then break 
  62.     linewidth = linewidth/10 /* convert to cm */
  63.     linecolor=ppm_SelectFromList("Couleur du Cadre",24,18,0,collist)
  64.     if linecolor = "" then linecolor = firstcolour
  65.     end
  66. else do
  67.     linecolor = firstcolour
  68.     linewidth = 0
  69.     end
  70.  
  71. pwidth2 = pwidth- pagemargin2 -((rownumber-1)*colgap) /* 3 is margins */
  72. framewidth = pwidth2/rownumber
  73. frameheight = (framewidth*512)/640
  74. frameheight2 = frameheight+ rowgap
  75. colnumber = (pheight-pagemargin2)%frameheight2
  76. if colnumber = 0 then exit_msg("Page too Small")
  77.  
  78. /* strip off number from end of filename */
  79. do i = 1 to length(filename)
  80.     endofname = right(filename,i)
  81.     if verify(endofname,"0123456789") ~=0 then break
  82.     end
  83. numberlength = length(endofname)-1
  84.  
  85. if numberlength = 0 then exit_msg("Fichiers non numérotés")
  86.     
  87. filenumber = substr(endofname,2)
  88. filebase = left(filename,length(filename)-numberlength)
  89.  
  90. /* Create some boxes */
  91. thispage = currentpage
  92. do limit = 1 to 20   /* safety limit of 20 pages  */
  93.     do i = 1 to colnumber
  94.         do j = 1 to rownumber
  95.             k = j-1
  96.             k2= k * colgap
  97.             m = i-1
  98.             m2 = m * rowgap
  99.  
  100.             currentnumber = right(filenumber,numberlength,"0")
  101.             fullname = filebase||currentnumber
  102.             if ~exists(fullname) then Exit_msg("Done")
  103.  
  104.             boxes.i.j.pic = ppm_CreateBox(pagemargin +(framewidth*k)+k2, pagemargin + (frameheight*m)+ m2, framewidth, frameheight, 0)
  105.             box = boxes.i.j.pic
  106.             call ppm_SetBoxHide(box,1) /* To avoid using up chip RAM */
  107.            
  108.             worked = ppm_ImportBM(box, fullname)
  109.             if worked = 0 then Exit_msg("Terminé")
  110.             
  111.             size = ppm_GetBoxSize(box)
  112.             boxwidth = word(size,1)
  113.             boxheight = word(size,2)
  114.             boxwidth = boxwidth-(linewidth*2)
  115.             boxheight = boxheight-(linewidth*2)
  116.  
  117.             info = ppm_GetBoxInfo(box)
  118.             width = word(info,2) /* width & height of bitmap */
  119.             height = word(info,3)
  120.  
  121.             width = width/(75/2.54) /* screen images at 75dpi for high res */
  122.             xscale = boxwidth/width
  123.             height = height/(75/2.54)
  124.             yscale = boxheight/height
  125.  
  126.             call ppm_SetBoxScale(box,xscale,yscale)
  127.             call ppm_SetBoxOffset(box,0,0)
  128.             call ppm_SetBoxFrame(box,1)
  129.             call ppm_SetBoxFrameData(box, linecolor, linecolor, linewidth*30, 1, 0)
  130.             call ppm_SetBoxMargins(box, linewidth, linewidth, linewidth, linewidth)
  131.             
  132.             boxes.i.j.caption = ppm_CreateBox(pagemargin +(framewidth*k)+k2, pagemargin + (frameheight*i)+ m2+ 0.2, framewidth, 1, 0)
  133.             captiontext = "Image "||currentnumber
  134.             overflow = ppm_TextIntoBox(boxes.i.j.caption,captiontext)
  135.             call ppm_ShowStatus(captiontext)
  136.             
  137.             filenumber = filenumber+interval
  138.             end /* of row */
  139.     end /* of column */
  140. /* Create a new page without adding a blank page at end of document */
  141. trace n
  142.     newpage = ppm_CreatePage(thispage,1,1,0,0)
  143.     newpage = ppm_MovePage(newpage+1,newpage)
  144.     thispage = ppm_GoToPage(newpage+1)
  145. trace n
  146.  
  147. end /* 1 to 20 */
  148.  
  149.  
  150.  
  151. exit_msg: 
  152. do
  153.     parse arg message
  154.     if message ~= '' then call ppm_Inform(1, message,)
  155.     call ppm_AutoUpdate(1)
  156.     call ppm_SetUnits(oldunits)
  157.     call ppm_SetSize(oldpoints)
  158.     call ppm_ClearStatus()
  159.     exit
  160. end
  161.  
  162.