%!PS % PS Bitmap "Swings and Tilts" Architect's Perspective Untilt 3.0 % ================================================================ % by Don Lancaster % This NUTILT30.PSL does a swing and tilt only plus a FORCED white ( no pure red ) blocking % It has a new scaling that eliminates the distortion above 0.15 % and has been simplified and heavily revised. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% /inputfilename (gt3a.bmp) store % name of file to be tilted /tiltoutfilename (detest1.bmp) store % name of tilt only output file /filenameprefix (C:\\Documents and Settings\\don 2\\Desktop\\Madeline Rework\\) store % input and tiltout files must presently be in the same subdirectory /tiltaxis 0.53 store % the VERTICAL position at which no tilt adjustment will be made. % Usually 0.5 on a strictly limited 0 to 1.0 range. 0 = left 1 = right /howmuchtilt 0.10 store % amount of tilt to correct for. Typical range is 0.06 to 0.12 .06 = 6%. % positive values compress top of image (usual). % negative values compress bottom of image (rarely needed) %% To run this file, select START then RUN then Acrodist-F. Drag and drop into Distiller. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Copyright c 2003,2011 by Don Lancaster & Synergetics, Box 809, Thatcher, AZ, 85552 % (928) 428-4073 Email: don@tinaja.com Website: http://www.tinaja.com % Consulting services available http://www.tinaja.com/info01.html % All commercial rights and all electronic media rights ~fully~ reserved. % Linking usually welcome. Reposting expressly forbidden. Version 1.5 % PostScript-as-language utility reads a .BMP bitmap file and provides "view camera" % swing and tilt image distortion effects that make edges truly vertical. % To use, modify filenames and correction axis and percentage. Resave and send % to Acrobat Distiller USING "Acrodist-F" from the XP command line! % Alys run at highest possible resolution, preferably before any other post processing. % Some extreme left or right pixel columns may be lost during processing % and replaced by neighbor values. Pre-expand image if edge values are critical. % Several interpolations may be explored. Nearest neighbor should not be too much of a problem % if later reductions use bicubic elsewhere. % A "no Acrobat file produced" error is normal and expected. % ========= % IMPORTANT NOTE: Don Lancaster's file gonzo.ps is required for this program. % After obvious location mods, uncomment ONE of the following two lines: (C:\\Documents and Settings\\don\\Desktop\\gonzo\\gonzo.ps) run % use internal gonzo % (A:\\gonzo.ps) run % use external gonzo % NOTE THAT ALL PS FILENAME STRINGS !!!DEMAND!!! DOUBLE REVERSE SLASHES. % NOTE THAT DISTILLER DEMANDS EXECUTION FROM THE COMMAND LINE VIA "acrodist-F" % Otherwise most files can not be accessed % GONZO20A Guru Gonzo PostScript power tools (Interim release) % Includes gonzo justification and layout utilities. % Copyright c 1990, 1996, 2001, 2011 and later by Don Lancaster and Synergetics, Box 809, % Thatcher Arizona, 5552 (928) 428-4073 don@tinaja.com support % via http://www.tinaja.com All commercial rights and all electronic % media rights **FULLY** reserved. Reposting is expressly forbidden. % ======== /guru { gonzo begin ps.util.1 begin printerror nuisance begin} def guru % activate gonzo utilities % ========= % gonzo excerpts /mt {moveto} store /black {0 setgray} store % timing utilities. use stopwatchon and stopwatchoff for simple % one shot timing. For multiple time totals, use resettimer % starttimer stoptimer ... starttimer stoptimer reporttimer /stopwatchoff {stoptimer reporttimer} def % for single shots /stopwatchon {resettimer starttimer} def % for single shots /reporttimer {mytime 1000 div (\nElapsed time: ) print 20 string cvs print ( seconds.\n) print flush} def % to host /resettimer {/mytime 0 def} def % reset timer /starttimer {usertime /mytimenow exch def} def % add to time so far /stoptimer {usertime mytimenow sub /mytime exch mytime add def} def % for multiple timing intervals % mergestr merges the two top stack strings into one top stack string /mergestr {2 copy length exch length add string dup dup 4 3 roll 4 index length exch putinterval 3 1 roll exch 0 exch putinterval} def % [yourarray] makestring converts an array to a string... /makestring {dup length string dup % new string of right size /NullEncode filter % make a file out of string 3 -1 roll {1 index exch write} forall pop } def /random {rand 65536 div 32768 div mul cvi} def % as in -- 6 random -- % no longer used %%%%%%%%% end gonzo excerpts % ========= % define connecting files /sourcefilename filenameprefix inputfilename mergestr store /targetfilename filenameprefix tiltoutfilename mergestr store /readfile sourcefilename (r) file store % establish input read file /writefile targetfilename (w+) file store % establish output target file %%%%%%%%%%% /showtime true store % show annotation? /bitsperpixelposition 28 store % These are .BMP header offset params /datastartposition 10 store /horizontalpixels 18 store /verticalpixels 22 store % % deal with possible reverse tilt... howmuchtilt 0 ge {false}{true} ifelse % set reverse=true flag /reversetilt exch store /howmuchtilt howmuchtilt abs store % and leave howmuchtilt positive %%%%%%%%%%%%%%%% DISK ACCESS SERVICE ROUTINES %%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%% CHECK FOR VALID 24-BIT UNCOMPRESSED BITMAP %%%%%%%%%%%%% % BM check: readfile (XX) readstring pop % error message if file not two chars long (BM) eq {(File has correct "BM" as first two bytes.\n) print } { sourcefilename ( is not in .BMP format; further eval terminated.\n\n\n) mergestr print quit } ifelse % 24 bit check: readfile bitsperpixelposition setfileposition % access 2 {readfile read pop} repeat % get color planes error if not present 1 {256 mul add} repeat % calculate bits per pixel dup /bpp exch store % save for expanded analysis 10 string cvs % make string (24) eq {(File has correct 24-bit color format.\n) print } { sourcefilename ( is not in 24-bit format; further eval terminated.\n\n\n) mergestr print quit } ifelse % Compression mode: 4 {readfile read pop} repeat % get color planes error if not present 3 {256 mul add} repeat % calculate compression mode dup /cmm exch store % save for expanded analysis 10 string cvs % make string (0) eq {(File has correct 0 uncompressed format.\n) print } { sourcefilename ( is not in uncompressed format; further action terminated.\n\n\n) mergestr print quit } ifelse % Bitmap Width: readfile horizontalpixels setfileposition % access 4 {readfile read pop} repeat % get bitmap width bytes error if not present 3 {256 mul add} repeat % calculate data start dup /hres exch def 10 string cvs % make string showtime { (Bitmap width is ) exch mergestr ( pixels.\n) mergestr print flush } if % Bitmap Width: readfile verticalpixels setfileposition % access 4 {readfile read pop} repeat % get bitmap width bytes error if not present 3 {256 mul add} repeat % calculate data start dup /vres exch def 10 string cvs % make string showtime { (Bitmap height is ) exch mergestr ( pixels.\n) mergestr print flush } if % Find padding % .BMP rows MUST end on a 32-bit boundary! Zero, one, two, or three 00 % padding bits are required depending upon the actual width. /padding hres 3 mul cvi 4 mod % find start of next 32-byte block [ 0 3 2 1 ] exch get % TLU correction def (Padding 8-bit bytes per line are ) padding 10 string cvs mergestr ( .\n\n) mergestr print flush (Active storage 8-bit RGB bytes per line are ) hres 3 mul dup cvi /activestore exch store 10 string cvs mergestr ( .\n) mergestr print flush activestore 4 div ceiling cvi 4 mul /totalbytesperline exch store % find data start readfile datastartposition setfileposition % access 4 {readfile read pop} repeat % get data start bytes error if not present 3 {256 mul add} repeat % calculate data start /actualdatastart exch store % define read strings /linestring hres 3 mul string store % read file line buffer %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % % (A) BITMAP FILE CAPTURE ROUTINE /grabbitmap % % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % /grabbitmap reads a disk file and converts its underlying bitmap to % a PostScript /instrarray image array of STRINGS. Each horizontal line % is one subarray, and the arrays build from the image BOTTOM UPWARDS... % In general, PostScript strings can be manipulated as arrays without % needing the overhead of string to array or array to string conversion. % The speed savings can be quite significant. % This is normally the FIRST step in any image manipulation. % Note that there is NO PADDING in instrarray. /grabbitmap { showtime { (\nReading initial bitmap from disk...) print flush } if -2 vmreclaim /instrarray mark % start input data array 0 = bottom 0 1 vres 1 sub { % begin line reading loop /vline exch store % start of next hires line vline hres 3 mul padding add mul actualdatastart add % position read file readfile exch setfileposition readfile linestring readstring % grab a line of characters not {Error_reading_input_file_data} if % error trap dup length string cvs % must dereference } for ] store % complete instrarray definition 2 vmreclaim 0 vmreclaim } store %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % % (C) BITMAP FILE STORAGE ROUTINE /savebitmap % % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % /savebitmap saves the internal PostScript /outarray to disk in % the .BMP format a chosen disk file. % This is normally the LAST step in any image manipulation. % Note that input and output files can be different sizes for certain % operations such as cropping or rotations. % This version resaves the input string %%%%%%%%%%%%%%%% COPY HEADER TO TARGET FILE %%%%%%%%%%%%%%%%%% % The entire old header gets reused. outwidth and outlength is then % overwritten. /writeoutfileheader { readfile datastartposition setfileposition % access 4 {readfile read pop} repeat % get data start bytes error if not present 3 {256 mul add} repeat % calculate data start /actualdatastart exch store readfile 0 setfileposition readfile actualdatastart 1 sub string readstring not { sourcefilename ( has a short header; further action terminated.\n\n\n) mergestr print quit } if writefile exch writestring % write the entire header to new file writefile actualdatastart setfileposition % go to end of header } store % this version of savebitmap assumes it is the same size as the original /savebitmap { showtime {(\nSaving processed bitmap image to disk...) print flush } if instrarray length /outlength exch store % find output pixelslength instrarray 0 get length 3 div cvi % find output pixels width /outwidth exch store % note three RGB bytes per pixel writeoutfileheader % write the outfile header 0 1 instrarray length 1 sub { % for each data line instrarray exch get % get data line as string dup length 4 mod % add padding if needed dup 0 gt {[ (xxx) threepad twopad onepad] exch get mergestr}{pop}ifelse writefile exch writestring } for } store /onepad [ 0 ] makestring store % null padding strings used by /savebitmap /twopad [0 0] makestring store /threepad [ 0 0 0 ] makestring store %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % % (P) Revised Architect's Perspective /untilt % % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%% new routine to minimize barrel distortion %%%%%%%%%%%%% % /calccurrowscale finds the current row shift /crs factor, given vfract and howmuchtilt % This subtle math gets executed once per row. /calccurrowscale {/crs 1 dup howmuchtilt % reversetilt {1 exch sub} if % reverse if negative WRONG sub div 1 sub vfract reversetilt {1 exch sub} if mul 1 add store /crs- crs neg store % may need for sneakiness } store %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% /processrows { /max instrarray 0 get length 3 sub store % simplify for later 0 1 instrarray length 1 sub { /currownum exch store % for current row currownum 50 mod 0 eq {(.) print flush } if % show progress instrarray currownum get /curinrow exch store % grab current row /vfract currownum instrarray length 1 sub div store % find row screen ratio calccurrowscale % find shift scale factor for row /westmin neut dup crs div % precalculate to not need underflow test sub ceiling cvi store /eastmax max neut sub crs div % precalculate to not need overflow test neut add floor cvi store neut -3 westmin { % process west pixels neut dup 2 index sub crs mul sub % calculate shift 1.5 add cvi 3 idiv 3 mul % nearest neighbor for now curinrow exch 3 getinterval % get rgb pixels to be shifted curinrow 3 1 roll putinterval % and shift } for neut 3 eastmax { % process east pixels dup neut sub crs mul neut add % calculate shift 1.5 add cvi 3 idiv 3 mul % nearest neighbor for now curinrow exch 3 getinterval % get rgb pixels to be shifted curinrow 3 1 roll putinterval % and shift } for } for % for each row } bind store /untilt { grabbitmap % build line by line RGB PS strings /neut instrarray 0 get length 1 sub % find neutral pixel position tiltaxis mul round cvi 3 idiv 3 mul store % must be a triad group edge (\nstart processing rows ) print flush stopwatchon processrows % correct one line at a time stopwatchoff (\ndone processing rows ) print flush stopwatchon savebitmap % rewrite bitmap stopwatchoff } store %%%%%%%%%%% demo - alter above values before reuse %%%%%%%%%%%%%%%%% % stopwatchon untilt % this does it all % stopwatchoff (\nFinished.\n) print % report readfile closefile writefile closefile % EOF