home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD1.iso / GFX / Painting / PP701.LHA / ppaint / rexx / SaveAnimGif.pprx < prev    next >
Encoding:
Text File  |  1996-12-12  |  13.2 KB  |  529 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: SaveAnimGif.pprx 1.2 */
  4.  
  5. /** ENG
  6.  This script saves the current anim-brush as a GIF animation file. Specific
  7.  features of the GIF animation specification can be set through a requester.
  8.  
  9.  This script checks for the differences between frames and only stores
  10.  the smallest rectangular region containing changes. Other techniques
  11.  are employed for additional compression. The resulting GIF animations are
  12.  highly optimized and occupy considerably less space than GIF animations
  13.  created with other tools available on the Amiga.
  14.  
  15.  The "Use Loop" option inserts an "Application Extension Block" into the GIF
  16.  file (as implemented by Netscape in its Navigator software from version 2).
  17.  This additional block, which is interpreted by most other browsers
  18.  supporting GIF animations, specifies that the animation be repeated as many
  19.  times as indicated by the "Loop" value. A value of 0 expressly means
  20.  "loop continuously".
  21.  
  22.  The list of frames shows the timing value for each frame, in seconds/100.
  23.  These values can be selected, edited and applied to one or more frames.
  24. */
  25.  
  26. /** DEU
  27.  Dieses Skript dient zum Speichern des aktuellen Anim-Brushes als GIF-Animation.
  28.  Eine Reihe spezifischer Merkmale des Animationsformats läßt sich in einem dazugehörigen
  29.  Dialogfenster auswählen.
  30.  
  31.  Nach der Skriptausführung werden zwei aufeinanderfolgende Frames zunächst auf
  32.  Unterschiede untersucht. Gespeichert wird dann nur der kleinste rechteckige
  33.  Bereich, der Unterschiede zwischen den beiden Bildern aufweist. Außerdem
  34.  werden zum Erzielen einer weiter verbesserten Komprimierung noch andere
  35.  Verfahren angewendet. Die daraus resultierenden hochoptimierten GIF-Animationen
  36.  benötigen erheblich weniger Speicherplatz als solche, die mit anderen für den
  37.  Amiga erhältlichen Tools erstellt worden sind.
  38.  
  39.  Durch die Option "Schleife aktiv:" wird der GIF-Datei eine Programmerweiterung
  40.  ("Application Extension Block") hinzugefügt, wie sie von Netscape im Navigator
  41.  ab Version 2 implementiert ist. Dieser auch von den meisten anderen Browsern,
  42.  die GIF-Animationen unterstützen, interpretierte Block legt fest, daß die
  43.  Animation so oft wiederholt wird, wie unter "Schleife:" angegeben. Ein Wert
  44.  von 0 bewirkt das Abspielen in einer Endlosschleife.
  45.  
  46.  Die Frameliste zeigt den Timingwert für jedes Einzelbild in Hundertstel
  47.  Sekunden. Diese Werte lassen sich auswählen, bearbeiten und anschließend
  48.  einem oder mehreren Werten zuweisen.
  49.  
  50. */
  51.  
  52. IF ARG(1, EXISTS) THEN
  53.     PARSE ARG PPPORT
  54. ELSE
  55.     PPPORT = 'PPAINT'
  56.  
  57. IF ~SHOW('P', PPPORT) THEN DO
  58.     IF EXISTS('PPaint:PPaint') THEN DO
  59.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  60.         DO 30 WHILE ~SHOW('P',PPPORT)
  61.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  62.         END
  63.     END
  64.     ELSE DO
  65.         SAY "Personal Paint could not be loaded."
  66.         EXIT 10
  67.     END
  68. END
  69.  
  70. IF ~SHOW('P', PPPORT) THEN DO
  71.     SAY 'Personal Paint Rexx port could not be opened'
  72.     EXIT 10
  73. END
  74.  
  75. ADDRESS VALUE PPPORT
  76. OPTIONS RESULTS
  77. /*OPTIONS FAILAT 10000*/
  78.  
  79. Get 'LANG'
  80. IF RESULT = 1 THEN DO        /* Deutsch */
  81.     txt_title_req     = 'GIF-Anim-Brush speichern'
  82.     txt_title_set     = 'GIF-Anim-Brush-Einstellungen'
  83.     txt_title_delay   = 'Frame-Verzögerung'
  84.     txt_gad_delay     = 'Frame-Verzögerungen:'
  85.     txt_gad_annot     = '_Bemerkung:'
  86.     txt_gad_loop      = '_Schleife:'
  87.     txt_gad_useloop   = 'Schleife ak_tiv:'
  88.     txt_gad_del       = '_Verzögerung (1/100\""):'
  89.     txt_gad_from      = 'A_b Frame:'
  90.     txt_gad_to        = 'Bi_s Frame:'
  91.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  92.     txt_err_notabsh   = 'Aktueller Brush_ist kein Anim-Brush'
  93.     txt_err_notemp    = 'Zu wenig Speicher_für temporären Brush'
  94.     txt_err_nomem     = 'Speichermangel'
  95.     txt_err_nosave    = 'Fehler bei Datei-Ein-/Ausgabe'
  96. END
  97. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  98.     txt_title_req     = 'Scrivere Anim-brush GIF'
  99.     txt_title_set     = 'Parametri Anim-brush GIF'
  100.     txt_title_delay   = 'Temporizzazione'
  101.     txt_gad_delay     = 'Temporizzazione fotogrammi:'
  102.     txt_gad_annot     = '_Note:'
  103.     txt_gad_loop      = 'Cic_lo:'
  104.     txt_gad_useloop   = '_Usare ciclo:'
  105.     txt_gad_del       = '_Temporizzazione (1/100\""):'
  106.     txt_gad_from      = 'Da _fotogramma:'
  107.     txt_gad_to        = 'A f_otogramma:'
  108.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  109.     txt_err_notabsh   = 'Il pennello attuale_non è un anim-brush'
  110.     txt_err_notemp    = 'Impossibile creare_pennello temporaneo'
  111.     txt_err_nomem     = 'Memoria insufficiente'
  112.     txt_err_nosave    = 'Errore di scrittura'
  113. END
  114. ELSE DO                /* English */
  115.     txt_title_req     = 'Save GIF Anim-Brush'
  116.     txt_title_set     = 'GIF Anim-Brush Settings'
  117.     txt_title_delay   = 'Frame Delay'
  118.     txt_gad_delay     = 'Frame Delays:'
  119.     txt_gad_annot     = '_Annotation:'
  120.     txt_gad_loop      = '_Loop:'
  121.     txt_gad_useloop   = '_Use Loop:'
  122.     txt_gad_del       = '_Delay (1/100\""):'
  123.     txt_gad_from      = '_From Frame:'
  124.     txt_gad_to        = 'T_o Frame:'
  125.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  126.     txt_err_notabsh   = 'The current brush_is not an anim-brush'
  127.     txt_err_notemp    = 'No space for temporary brush'
  128.     txt_err_nomem     = 'Not enough memory'
  129.     txt_err_nosave    = 'File I/O error'
  130. END
  131.  
  132. Version 'REXX'
  133. IF RESULT < 7 THEN DO
  134.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  135.     EXIT 10
  136. END
  137.  
  138. LockGUI
  139. GetBrushAttributes 'FRAMES'
  140. frames = RESULT
  141.  
  142. IF frames < 2 THEN DO
  143.     RequestNotify 'PROMPT "'txt_err_notabsh'"'
  144.     UnlockGUI
  145.     EXIT 0
  146. END
  147.  
  148. GetBrushNumber
  149. bshnum = RESULT
  150.  
  151. SetCurrentBrush 'UNUSED'
  152. IF RC ~= 0 THEN DO
  153.     RequestNotify 'PROMPT "'txt_err_notemp'"'
  154.     UnlockGUI
  155.     EXIT 0
  156. END
  157. GetBrushNumber
  158. tbshnum = RESULT
  159.  
  160. SetCurrentBrush 'BRUSH' bshnum
  161. GetBrushInfo 'ANNOTATION'
  162. frame_annot = RESULT
  163.  
  164. loop = -1
  165. delay. = 0
  166. IF WORD(frame_annot, 1) = 'LOOP' & WORD(frame_annot, 3) = 'DELAY' THEN DO
  167.     loop = WORD(frame_annot, 2)
  168.     IF ~DATATYPE(loop, 'W') THEN
  169.         loop = -1
  170.     DO frm = 1 TO frames
  171.         del = WORD(frame_annot, 3+frm)
  172.         IF DATATYPE(del, 'W') THEN
  173.             delay.frm = del
  174.     END
  175. END
  176. use_loop = (loop >= 0)
  177. IF loop < 0 THEN
  178.     loop = 0
  179.  
  180. fnlen = LENGTH(frames)
  181. dsel = 1
  182. do_req = 1
  183.  
  184. GetBrushInfo 'COPYRIGHT'
  185. annot = RESULT
  186. max_annot_size = LENGTH(annot) * 2
  187. IF max_annot_size < 200 THEN
  188.     max_annot_size = 200
  189.  
  190. DO WHILE do_req
  191.     ppos = 1
  192.     DO FOREVER
  193.         ppos = INDEX(annot, '"', ppos)
  194.         IF ppos = 0 THEN BREAK
  195.         annot = INSERT('\"', annot, ppos-1)
  196.         ppos = ppos + 3
  197.     END
  198.  
  199.     req = '"LIST ACTION = ""'txt_gad_delay'"", 'frames', 'dsel-1', 20, 9'
  200.     DO frm = 1 TO frames
  201.         req = req || ', ""'RIGHT(frm, fnlen) || ':' delay.frm || '""'
  202.     END
  203.  
  204.     req = req ||,
  205.       ' STRING = ""'txt_gad_annot'"", 'max_annot_size', ""'annot'"" ' ||,
  206.         ' INTSTR = ""'txt_gad_loop'"", 0, 32767, 'loop' ' ||,
  207.         ' CHECK = ""'txt_gad_useloop'"", 'use_loop' "'
  208.  
  209.     Request 'RESIZE "'txt_title_set'"' req
  210.     IF RC = 0 THEN DO
  211.         dsel  = RESULT.1 + 1
  212.         annot = RESULT.2
  213.         loop  = RESULT.3
  214.         use_loop = RESULT.4
  215.         IF RESULT = -1 THEN DO
  216.             Request '"'txt_title_delay'" ' ||,
  217.                         '"INTSTR = ""'txt_gad_del'"", 0, 32767, 'delay.dsel' ' ||,
  218.                         ' SEPARATOR ' ||,
  219.                         ' INTSTR = ""'txt_gad_from'"", 1, 'frames', 'dsel' ' ||,
  220.                         ' INTSTR = ""'txt_gad_to'"", 1, 'frames', 'dsel' "'
  221.             IF RC = 0 THEN DO
  222.                 del    = RESULT.1
  223.                 frfrom = RESULT.2
  224.                 frto   = RESULT.3
  225.                 frstep = SIGN(frto - frfrom)
  226.                 IF frstep = 0 THEN
  227.                     frstep = 1
  228.                 DO frm = frfrom TO frto BY frstep
  229.                     delay.frm = del
  230.                 END
  231.             END
  232.         END
  233.         ELSE do_req = 0
  234.     END
  235.     ELSE DO
  236.         UnlockGUI
  237.         EXIT 0
  238.     END
  239. END
  240.  
  241. IF ~use_loop THEN
  242.     loop = -1
  243. frame_annot = 'LOOP' loop 'DELAY'
  244. DO frm = 1 TO frames
  245.     frame_annot = frame_annot delay.frm
  246. END
  247. SetBrushInfo 'ANNOTATION "'frame_annot'"'
  248.  
  249.  
  250. RequestFile '"'txt_title_req'" SAVEMODE'
  251. IF RC = 0 THEN DO
  252.     PARSE VALUE RESULT WITH '"' fname '"'
  253.     tempfile = 'T:PP_AnGif.'PRAGMA('ID')
  254.  
  255.     GetBrushAttributes 'FRAMEFIRST'
  256.     sv_frmin = RESULT
  257.     GetBrushAttributes 'FRAMELAST'
  258.     sv_frmax = RESULT
  259.     GetBrushAttributes 'LENGTH'
  260.     sv_frlen = RESULT
  261.     GetBrushAttributes 'FRAMEPOSITION'
  262.     sv_frpos = RESULT
  263.     Get 'ICONS'
  264.     sv_icons = RESULT
  265.  
  266.     GetBrushAttributes 'WIDTH'
  267.     bwidth = RESULT
  268.     GetBrushAttributes 'HEIGHT'
  269.     bheight = RESULT
  270.  
  271.     GetBrushAttributes 'TRANSPARENCY'
  272.     transp = RESULT
  273.     GetBrushAttributes 'TRANSPARENTCOLOR'
  274.     transpcol = RESULT
  275.     GetBrushAttributes 'COLORS'
  276.     bcolors = RESULT
  277.     plt_size = bcolors * 3
  278.  
  279.     IF transp = 1 THEN
  280.         pckinfo = '09'x
  281.     ELSE
  282.         pckinfo = '00'x
  283.  
  284.     DO bdepth = 1 TO 8
  285.         IF bcolors = (2 ** bdepth) THEN
  286.             BREAK
  287.     END
  288.  
  289.     tbmap.0 = 0
  290.     tbmap.1 = 0
  291.     tbnum = 0
  292.     gfile_open = 0
  293.     last_plt = ''
  294.     err_msg = ''
  295.  
  296.     SIGNAL ON Break_C
  297.  
  298.     AllocateBitmap bwidth bheight bdepth
  299.     IF RC = 0 THEN DO
  300.         tbmap.0 = RESULT
  301.  
  302.         AllocateBitmap bwidth bheight bdepth
  303.         IF RC = 0 THEN DO
  304.             tbmap.1 = RESULT
  305.  
  306.             SetBrushAttributes 'FRAMEFIRST 1 FRAMELAST' frames 'LENGTH' frames
  307.             Set '"ICONS = 0"'
  308.  
  309.             DO frm = 1 TO frames
  310.                 SetCurrentBrush 'BRUSH' bshnum
  311.                 IF RC ~= 0 THEN DO
  312.                     err_msg = txt_err_nomem
  313.                     BREAK
  314.                 END
  315.  
  316.                 SetBrushAttributes 'FRAMEPOSITION' frm
  317.                 IF RC ~= 0 THEN DO
  318.                     err_msg = txt_err_nomem
  319.                     BREAK
  320.                 END
  321.  
  322.                 GetBitmap '0 0 BITMAP' tbmap.tbnum 'FROMBRUSH'
  323.                 tbnum = 1 - tbnum
  324.  
  325.                 IF frm = 1 THEN DO
  326.                     dx0 = 0
  327.                     dy0 = 0
  328.                     dx1 = bwidth - 1
  329.                     dy1 = bheight - 1
  330.                 END
  331.                 ELSE DO
  332.                     IF transp = 1 THEN
  333.                         GetBrushAttributes 'BOUNDARIES'
  334.                     ELSE
  335.                         GetBitmapDelta tbmap.0 tbmap.1
  336.  
  337.                     PARSE VAR RESULT dx0 dy0 dx1 dy1 .
  338.                     IF dx0 < 0 THEN DO
  339.                         dx0 = 0
  340.                         dy0 = 0
  341.                         dx1 = 0
  342.                         dy1 = 0
  343.                     END
  344.                 END
  345.  
  346.                 SetCurrentBrush 'BRUSH' tbshnum
  347.                 IF RC ~= 0 THEN DO
  348.                     err_msg = txt_err_nomem
  349.                     BREAK
  350.                 END
  351.  
  352.                 CopyBrush bshnum dx0 dy0 dx1 dy1 'NOFRAMES'
  353.                 IF RC ~= 0 THEN DO
  354.                     err_msg = txt_err_nomem
  355.                     BREAK
  356.                 END
  357.  
  358.                 SaveBrush tempfile 'FORCE QUIET NOPROGRESS FORMAT "GIF" OPTIONS "GIF89=1" "PROGDSP=0" "SCRFMT=0"'
  359.                 IF RC ~= 0 THEN DO
  360.                     err_msg = txt_err_nosave
  361.                     BREAK
  362.                 END
  363.  
  364.                 IF ~OPEN('tfile', tempfile, 'R') THEN DO
  365.                     err_msg = txt_err_nosave
  366.                     BREAK
  367.                 END
  368.  
  369.                 IF frm = 1 THEN DO
  370.                     IF ~OPEN('gfile', fname, 'W') THEN DO
  371.                         err_msg = txt_err_nosave
  372.                         BREAK
  373.                     END
  374.                     gfile_open = 1
  375.                     data = READCH('tfile', 13)        /* sign + screen descriptor */
  376.                     bxpix = BITOR(BITAND(SUBSTR(data, 11, 1), '07'x), '80'x)
  377.                     CALL WRITECH('gfile', data)
  378.  
  379.                     plt_data = READCH('tfile', plt_size)    /* palette */
  380.                     CALL WRITECH('gfile', plt_data)
  381.                     do_plt = 0
  382.  
  383.                     IF use_loop THEN
  384.                         CALL WRITECH('gfile', '21FF0B'x || 'NETSCAPE2.0' || '0301'x || IntelWord(loop) || '00'x)
  385.  
  386.                     IF annot ~= '' THEN DO        /* annotation */
  387.                         CALL WRITECH('gfile', '21FE'x)
  388.                         alen = LENGTH(annot)
  389.                         apos = 1
  390.                         DO WHILE alen > 0
  391.                             IF alen <= 255 THEN
  392.                                 aln = alen
  393.                             ELSE
  394.                                 aln = 255
  395.                             CALL WRITECH('gfile', D2C(aln) || SUBSTR(annot, apos, aln))
  396.                             apos = apos + aln
  397.                             alen = alen - aln
  398.                         END
  399.                         CALL WRITECH('gfile', '00'x)
  400.                     END
  401.                 END
  402.                 ELSE DO
  403.                     CALL SEEK('tfile', 13, 'B')
  404.                     plt_data = READCH('tfile', plt_size)
  405.                     do_plt = (plt_data ~== last_plt)
  406.                 END
  407.                 last_plt = plt_data
  408.  
  409.                 DO FOREVER
  410.                     code = READCH('tfile', 1)
  411.  
  412.                     IF code = ',' THEN DO    /* image */
  413.                         /* gfx control */
  414.                         CALL WRITECH('gfile', '21F904'x || pckinfo || IntelWord(delay.frm) || D2C(transpcol) || '00'x)
  415.  
  416.                         data = READCH('tfile', 9)        /* Get image descriptor */
  417.                         imginfo = SUBSTR(data, 9, 1)
  418.                         IF do_plt THEN
  419.                             imginfo = BITOR(BITAND(imginfo, '40'x), bxpix)
  420.  
  421.                         /* image descriptor */
  422.                         CALL WRITECH('gfile', ',' || IntelWord(dx0) || IntelWord(dy0) || IntelWord(dx1-dx0+1) || IntelWord(dy1-dy0+1) || imginfo)
  423.  
  424.                         IF do_plt THEN
  425.                             CALL WRITECH('gfile', plt_data)
  426.  
  427.                         tpos = SEEK('tfile', 0, 'C')
  428.                         epos = SEEK('tfile', 0, 'E')
  429.                         dsize = epos - tpos - 1
  430.                         CALL SEEK('tfile', tpos, 'B')
  431.  
  432.                         /* image data */
  433.                         DO WHILE dsize > 0
  434.                             IF dsize > 65000 THEN
  435.                                 tsize = 65000
  436.                             ELSE
  437.                                 tsize = dsize
  438.                             data = READCH('tfile', tsize)
  439.                             CALL WRITECH('gfile', data)
  440.                             dsize = dsize - tsize
  441.                         END
  442.                         BREAK
  443.                     END
  444.                     ELSE IF code = '!' THEN DO        /* extension */
  445.                         CALL SEEK('tfile', 1, 'C')
  446.                         length = 1
  447.                         DO WHILE length ~= 0
  448.                             length = C2D(READCH('tfile', 1))
  449.                             IF length > 0 THEN
  450.                                 CALL SEEK('tfile', length, 'C')
  451.                         END
  452.                     END
  453.                     ELSE BREAK
  454.                 END
  455.  
  456.                 CALL CLOSE('tfile')
  457.             END
  458.  
  459.             CALL WRITECH('gfile', ';')
  460.             CALL CLOSE('gfile')
  461.             gfile_open = 0
  462.  
  463.             ADDRESS COMMAND 'Delete >NIL: 'tempfile
  464.  
  465.             SetCurrentBrush 'BRUSH' tbshnum
  466.             IF RC = 0 THEN
  467.                 FreeBrush 'FORCE'
  468.  
  469.             SetCurrentBrush 'BRUSH' bshnum
  470.             IF RC = 0 THEN
  471.                 SetBrushAttributes 'FRAMEFIRST' sv_frmin 'FRAMELAST' sv_frmax 'LENGTH' sv_frlen 'FRAMEPOSITION' sv_frpos
  472.  
  473.             Set '"ICONS =' sv_icons '"'
  474.  
  475.             FreeBitmap tbmap.1
  476.         END
  477.         ELSE err_msg = txt_err_nomem
  478.  
  479.         FreeBitmap tbmap.0
  480.     END
  481.     ELSE err_msg = txt_err_nomem
  482.  
  483.     IF err_msg ~= '' THEN
  484.         RequestNotify 'PROMPT "'err_msg'"'
  485. END
  486. UnlockGUI
  487.  
  488. EXIT 0
  489.  
  490.  
  491.  
  492.  
  493. IntelWord: PROCEDURE
  494.  
  495.     value = ARG(1)
  496.  
  497.     hibyte = value % 256
  498.     lobyte = value - (hibyte * 256)
  499.  
  500.     RETURN D2C(lobyte) || D2C(hibyte)
  501.  
  502.  
  503.  
  504.  
  505. Break_C:
  506.  
  507.     IF gfile_open THEN
  508.         CALL CLOSE('gfile')
  509.  
  510.     ADDRESS COMMAND 'Delete >NIL: 'tempfile
  511.  
  512.     SetCurrentBrush 'BRUSH' tbshnum
  513.     IF RC = 0 THEN
  514.         FreeBrush 'FORCE'
  515.  
  516.     SetCurrentBrush 'BRUSH' bshnum
  517.     IF RC = 0 THEN
  518.         SetBrushAttributes 'FRAMEFIRST' sv_frmin 'FRAMELAST' sv_frmax 'LENGTH' sv_frlen 'FRAMEPOSITION' sv_frpos
  519.  
  520.     Set '"ICONS =' sv_icons '"'
  521.  
  522.     IF tbmap.1 ~= 0 THEN
  523.         FreeBitmap tbmap.1
  524.  
  525.     IF tbmap.0 ~= 0 THEN
  526.         FreeBitmap tbmap.0
  527.  
  528.     RETURN
  529.