/* Personal Paint Amiga Rexx script - Copyright © 1997, Andres Paabo. 'SaveAnimGif.pprx 1.7 script is copyright Cloanto (see bottom portion of this script)*/ /* $VER: WebAnimDesigner.pprx 1.0 */ /** ENG This script is intended to assist in the creation of animated gifs for web pages. NOTE this program does not create animated gifs itslf. It only helps design the anim or animbrush that is used as a source for creating the animated gifs. The animated gifs have to be created with other programs such as Cloanto's DefineAnimGif.pprx and SaveAnimGif.pprx. However since this runs on Personal Paint. and for convenience, this script will call on Personal Paint's 'SaveAnimGif.pprx' (in slightly modified form) and pass information to it. */ IF ARG(1, EXISTS) THEN PARSE ARG PPPORT ELSE PPPORT = 'PPAINT' IF ~SHOW('P', PPPORT) THEN DO IF EXISTS('PPaint:PPaint') THEN DO ADDRESS COMMAND 'Run >NIL: PPaint:PPaint' DO 30 WHILE ~SHOW('P',PPPORT) ADDRESS COMMAND 'Wait >NIL: 1 SEC' END END ELSE DO SAY "Personal Paint could not be loaded." EXIT 10 END END IF ~SHOW('P', PPPORT) THEN DO SAY 'Personal Paint Rexx port could not be opened' EXIT 10 END ADDRESS VALUE PPPORT OPTIONS RESULTS OPTIONS FAILAT 10000 /*********ANIM IS SET UP****WHAT TO DO NEXT***************************/ openWAD= getclip('openWAD') if openWAD = "" then DO /*******************ENSURES SCREEN NOT TOO SMALL & STUFF IS WITHIN SCREEN*****************/ accept = 0 GET 'SCREENW' scw = result if scw >= 640 then DO GET 'SCREENH' sch = result if sch >= 400 then DO GET 'IMAGEW' imgw = result if imgw <= scw then DO GET 'IMAGEH' imgh = result if imgh <= sch then accept = 1 END END END if accept = 0 then DO Requestnotify 'TITLE "CHANGE SCREEN or IMAGE SIZE" PROMPT "For viewability, screen size must be 640x 400 or greater, and image size equal or less the screen size"' EXIT 0 END /********/ call setclip('openWAD', 1) END /********THE ABOVE IS DONE ONLY AT VERY START****IF OPENWAD =""****/ numcolors2=getclip('numcolors2') GET 'COLORS' numcolors=result if numcolors = 256 then DO; RequestResponse 'PROMPT "You must start on the source page. Proceed if okay. Cancel if not."';if rc~=0 then EXIT 0;END if numcolors = numcolors2 then DO switchenvironment GET 'COLORS' numcolors=result end SETFRAMEPOSITION 1 REQUESTER: txt_gad_title = 'WEB ANIM DESIGNER 1.0 by A.Paabo for use with Personal Paint 7.+' txt_gad_transp = 'transparency' txt_gad_dispose = 'dispose' txt_gad_optimize = 'Optimization:' txt_gad_optimnone = 'None (Constant size & position)' txt_gad_optimdelta = 'Deltas (Varying size & position)' txt_gad_optimbndy= 'Boundaries (Varying size & position)' txt_gad_operation = 'Select Operation:' txtnew = 'WEBANIMDESIGNER OPERATES ON THE CURRENT ANIMATION' txt_gad_preview = '1.SIMULATE animgif in 2nd environment' txt_gad_anbrush = 'SPECIAL: animbrush operations:' txt_gad_anbrushnone = 'ABOVE OPERATIONS IN EFFECT' txt_gad_pickup = 'pick up web anim as annotated animbrush' txt_gad_animload = 'make current animbrush into WAD anim' txt_gad_final = '2.MAKE ANIMGIF via Cloanto SaveAnimGif' txt_gad_drawrect = 'in simulation show frame rectangles' txt_gad_curglobal = 'define global rectangle' txt_gad_curglobal0 = '- use current global rectangle - ' txt_gad_curglobal1 = 'let WAD determine new from anim' txt_gad_curglobal2 = 'User-define new with mouse' transpcol = getclip('transpcol'); if transpcol = "" then transpcol=0 X0 = getclip('X0') Y0 = getclip('Y0') X1 = getclip('X1') Y1 = getclip('Y1') GETFRAMES frames=result transp=getclip('transp') if transp = "" then transp = 1 dispose = getclip('dispose') if dispose = "" then dispose = 1 optimization= getclip('optimization') if optimization="" then optimization = 0 drawrect= getclip('drawrect') if drawrect="" then drawrect=1 curglobal = getclip('curglobal') if curglobal="" then curglobal=0 anbrush=0 operation = getclip('operation') if operation = "" then operation =0 Request '"'txt_gad_title'" ' ||, ' "TEXT = ""'txtnew'"" '||, ' CYCLE = ""'txt_gad_operation'"", 2, 'operation',""'txt_gad_preview'"", ""'txt_gad_final'"" '||, ' CYCLE = ""'txt_gad_curglobal'"", 3, 'curglobal', ""'txt_gad_curglobal0'"", ""'txt_gad_curglobal1'"", ""'txt_gad_curglobal2'"" ' ||, ' CHECK = ""'txt_gad_transp'"", 'transp' ' ||, ' CHECK = ""'txt_gad_dispose'"", 'dispose' ' ||, ' CYCLE = ""'txt_gad_optimize'"", 3, 'optimization', ""'txt_gad_optimnone'"",""'txt_gad_optimbndy'"", ""'txt_gad_optimdelta'"" ' ||, ' CHECK = ""'txt_gad_drawrect'"", 'drawrect' ' ||, ' SEPARATOR ' ||, ' CYCLE = ""'txt_gad_anbrush'"", 3, 'anbrush', ""'txt_gad_anbrushnone'"", ""'txt_gad_animload'"", ""'txt_gad_pickup'"" "' if rc~=0 then EXIT 0 if rc = 0 then DO operation = RESULT.1 curglobal = RESULT.2 transp = RESULT.3 dispose = RESULT.4 optimization = RESULT.5 drawrect = RESULT.6 anbrush = RESULT.7 END call setclip('transp', transp) call setclip('dispose', dispose) call setclip('operation', operation) call setclip('optimization', optimization) call setclip('drawrect', drawrect) call setclip('curglobal', curglobal) call setclip('anbrush', anbrush) if anbrush = 1 then DO GetBrushAttributes 'FRAMES' frames = RESULT IF frames < 2 then DO Requestnotify 'PROMPT "You selected animbrush but there is no animbrush present. We exit."' EXIT 0 END if frames ~< 2 then call BRUSHLOADER END if anbrush = 2 then call PICKUPABRUSH /*does not continue to save as there is an anbrush=2 block*/ if transp= 0 then SET '"TRANSP=0"' if transp=1 then SET '"TRANSP=1"' Getframes frames = result if frames <2 then DO Requestnotify 'PROMPT "There is no animation to work on. Load an animation, or make one from animbrush"' EXIT END if curglobal = 0 then DO if X0 = "" then DO Requestnotify 'PROMPT "There is no previous global rectangle definition. You must define the global rectangle. Try again."' EXIT END END if curglobal = 1 then call GLOBALAREA if curglobal = 2 then call DEFINERECT if operation = 1 then CALL PICKUPABRUSH /*saveanimgif bypasses it all*/ if optimization = 1 then DO if transp =0 then Requestnotify 'PROMPT "Boundaries optimization in settings other than transp=1 and dispose=1 may produce a webanim result different from the source Amiga animation."' END if optimization = 2 then DO if transp =1 then Requestnotify 'PROMPT "Deltas optimization in settings other than transp=0 and dispose=0 may produce a webanim result different from the source Amiga animation."' END SWITCHENVIRONMENT DELETEFRAMES ALL FORCE CLEARIMAGE if numcolors < 256 then numcolors2 = numcolors*2 if numcolors = 256 then numcolors2 = numcolors Set 'FORCE "COLORS='numcolors2'"' col = '153 153 153' col2 = '204 204 204' Setcolors 'FROM "'numcolors2-1'" COLORS "'col'"' Setcolors 'FROM "'numcolors2-2'" COLORS "'col2'"' SETPEN 'BACKGROUND' numcolors2-1 call setclip('numcolors2', numcolors2) Clearimage CALL TEXTSRECT ADDFRAMES SWITCHENVIRONMENT /*********BEGIN***********/ SETFRAMEPOSITION 1 /*************************/ if optimization=0 then DO DO frm = 1 to frames SETFRAMEPOSITION frm GETFRAMEDELAY frm delay = result Definebrush x0 y0 x1 y1 setbrushhandle UPPERLEFT SWITCHENVIRONMENT SETFRAMEPOSITION frm SETFRAMEDELAY delay usebrushpalette remapimage if dispose = 0 then Putbrush x0 y0 if frm < frames then ADDFRAMES 1 AFTER if dispose = 1 then Putbrush x0 y0 SWITCHENVIRONMENT END END /*********BOUNDARIES*****************/ if optimization=1 then DO DO frm = 1 to frames SETFRAMEPOSITION frm GETFRAMEDELAY frm delay = result GetImageAttributes 'BOUNDARIES' PARSE VAR RESULT bx0 by0 bx1 by1 rest if bx0 <= X0 then bx0 = X0 if by0 <= Y0 then by0 = Y0 if bx0 >= X1 then bx0 = X1 if by0 >= Y1 then by0 = Y1 if bx1 >= X1 then bx1 = X1 if by1 >= Y1 then by1 = Y1 if bx1 <= X0 then bx1 = X0 if by1 <= Y0 then by1 = Y0 Definebrush bx0 by0 bx1 by1 setbrushhandle UPPERLEFT SWITCHENVIRONMENT SETFRAMEPOSITION frm SETFRAMEDELAY delay usebrushpalette remapimage if dispose = 0 then Putbrush bx0 by0 if frm < frames then ADDFRAMES 1 AFTER if dispose = 1 then Putbrush bx0 by0 freebrush force Setpen 'FOREGROUND' numcolors2-3 if drawrect=1 then Drawrectangle bx0 by0 bx1 by1 SWITCHENVIRONMENT END END /********DELTA******************/ if optimization=2 then DO tbmap.0 = 0 tbmap.1 = 0 GET 'COLORS' bcolors = result /*get bdepth from number of colros*/ DO bdepth = 1 to 8 if bcolors = (2 ** bdepth) THEN BREAK END bwidth = X1-X0 bheight = Y1-Y0 AllocateBitmap bwidth bheight bdepth tbmap.0 = result AllocateBitmap bwidth bheight bdepth tbmap.1 = result SETFRAMEPOSITION 1 GETFRAMEDELAY 1 delay = result DefineBrush X0 Y0 X1 Y1 setbrushhandle upperleft SWITCHENVIRONMENT if dispose=1 then ADDFRAMES 1 AFTER usebrushpalette remapimage Putbrush X0 Y0 if dispose = 0 then ADDFRAMES 1 AFTER SETFRAMEDELAY delay SWITCHENVIRONMENT DO frm = 1 to frames-1 SETFRAMEPOSITION frm GetBitmap X0 Y0 X1-1 Y1-1 'BITMAP' tbmap.0 SETFRAMEPOSITION frm+1 GetBitmap X0 Y0 X1-1 Y1-1 'BITMAP' tbmap.1 GetBitmapDelta tbmap.0 tbmap.1 PARSE VAR RESULT delx0 dely0 delx1 dely1 if delx0 < 0 then DO /*means a value of -1 meaning identical*/ delx0 = 0 dely0 = 0 delx1 = 0 dely1 = 0 END dx0 = X0 + delx0 dy0 = Y0 + dely0 dx1 = X0 + delx1 + 1 dy1 = Y0 + dely1 + 1 if dx0 <= X0 then dbx0 = X0 if dy0 <= Y0 then dy0 = Y0 if dx0 >= X1 then dx0 = X1 if dy0 >= Y1 then dy0 = Y1 if dx1 >= X1 then dx1 = X1 if dy1 >= Y1 then dy1 = Y1 if dx1 <= X0 then dx1 = X0 if dy1 <= Y0 then dy1 = Y0 Definebrush dx0 dy0 dx1 dy1 SwitchENvironment /*to switch env*/ SETFRAMEPOSITION frm+1 GETFRAMEDELAY frm delay = result Usebrushpalette remapimage SetBrushHandle UPPERLEFT if dispose = 0 then PutBrush dx0 dy0 if frm maxdx then maxdx = dx1 if dy1 > maxdy then maxdy = dy1 END X0 = mindx Y0 = mindy X1 = maxdx Y1 = maxdy call setclip('X0', X0) call setclip('Y0', Y0) call setclip('X1', X1) call setclip('Y1', Y1) rc=0 RETURN /***********************************************/ TEXTSRECT: GET 'IMAGEW' imgw = RESULT Xmid = TRUNC(imgw/2) SETPEN 'FOREGROUND' numcolors2-2 Text 'TEXT "WebAnimDesigner 1.0 by Andres Pääbo (c)97 -- email: paabo@bancom.net" "fonts:" "times" "10" "of" "'Xmid'" "20" CENTER' Text 'TEXT "SIMULATION OF ANIM GIF ON WEB PAGE" "fonts:" "times" "20" "of" "'Xmid'" "40" CENTER' Text 'TEXT "(IF ACTIVE)LARGE RECTANGLE SHOWS GLOBAL ANIMGIF SIZE.SMALLER RECTANGLES SHOW FRAME SIZES" "fonts:" "times" "10" "of" "'Xmid'" "60" CENTER' if transp=1 then DO if dispose = 1 then Text 'TEXT "angif setting at TRANSPARENCY=1 DISPOSE=1" "fonts:" "times" "15" "of" "'Xmid'" "70" CENTER' if dispose = 0 then Text 'TEXT "angif setting at TRANSPARENCY=1 DISPOSE=0" "fonts:" "times" "15" "of" "'Xmid'" "70" CENTER' END if transp=0 then DO if dispose = 1 then Text 'TEXT "angif setting at TRANSPARENCY=0 DISPOSE=1" "fonts:" "times" "15" "of" "'Xmid'" "70" CENTER' if dispose = 0 then Text 'TEXT "angif setting at TRANSPARENCY=0 DISPOSE=0" "fonts:" "times" "15" "of" "'Xmid'" "70" CENTER' eND if optimization = 0 then Text 'TEXT "OPTIMIZATION=NONE (CONST FRAME & POSTITION)" "fonts:" "times" "15" "of" "'Xmid'" "85" CENTER' if optimization =1 then Text 'TEXT "OPTIMIZATION=BOUNDARIES" "fonts:" "times" "15" "of" "'Xmid'" "85" CENTER' if optimization = 2 then Text 'TEXT "OPTIMIZATION=DELTA" "fonts:" "times" "15" "of" "'Xmid'" "85" CENTER' freebrush FORCE if drawrect=1 then DrawRectangle X0 Y0 X1 Y1 RETURN /*********************************************/ /*************************************************/ BRUSHLOADER: /**if frames ~< 2 then continue as originally***/ CLEARIMAGE FREEENVIRONMENT FORCE SWITCHENVIRONMENT GetbrushAttributes 'COLORS' numcolors = RESULT Set 'FORCE "COLORS='numcolors'"' copyenvironment FORCE Set 'FORCE "TRANSP= 1"' GET 'IMAGEW' imgw = RESULT GET 'IMAGEH' imgh = RESULT imgmid = TRUNC(imgw/2) GetBrushAttributes 'FRAMES' frames = RESULT GetBrushAttributes WIDTH width = result if width > imgw-100 then DO; Requestnotify 'TITLE "ANIMBRUSH TO WIDE" PROMPT "The animbrush is too wide. Use larger screen size"';EXIT 0; END GetBrushAttributes HEIGHT height = RESULT if height > imgh-100 then DO; Requestnotify 'TITLE "ANIMBRUSH TO WIDE" PROMPT "The animbrush is too high. Use larger screen size."'; EXIT 0; END x0 = TRUNC((imgw-width)/2) y0 = TRUNC((imgh-height)/2) x1 = x0 + width y1 = y0 + height setbrushhandle UPPERLEFT UseBrushPalette GetBrushAttributes 'TRANSPARENCY' transp = RESULT IF transp=0 then transpcol = 0 If transp >0 then DO GetBrushAttributes 'TRANSPARENTCOLOR' transpcol = RESULT setpen 'BACKGROUND' transpcol END /************CLEAR TO ABRS TRANSP COLOR & STAMP DOWN*************************/ GetBrushInfo 'ANNOTATION' frame_annot = RESULT delayannot = 0 loop = -1 delay. = 0 IF WORD(frame_annot, 1) = 'LOOP' & WORD(frame_annot, 3) = 'DELAY' THEN DO delayannot=1 loop = WORD(frame_annot, 2) IF ~DATATYPE(loop, 'W') THEN loop = -1 DO frm = 1 TO frames del = WORD(frame_annot, 3+frm) IF DATATYPE(del, 'W') THEN delay.frm = del delay.frm = TRUNC(delay.frm*(60/100)) END END SETPEN 'BACKGROUND' transpcol ClearImage