home *** CD-ROM | disk | FTP | other *** search
Text File | 1988-08-17 | 95.5 KB | 2,151 lines | [TEXT/MPS ] |
- {------------------------------------------------------------------------------
- #
- # Apple Macintosh Developer Technical Support
- #
- # MacApp Color QuickDraw Fractal Sample Application
- #
- # FracApp
- #
- # UFracApp.inc1.p - Pascal Source
- #
- # Copyright © 1988 Apple Computer, Inc.
- # All rights reserved.
- #
- # Versions: 1.0 8/88
- #
- # Components: MFracApp.p August 1, 1988
- # UFracApp.p August 1, 1988
- # UFracApp.inc1.p August 1, 1988
- # FracApp.r August 1, 1988
- # FracApp.make August 1, 1988
- #
- # This is a program to calculate the Mandelbrot set, allowing you to zoom in on areas
- # that are selected with the mouse. There are some special color tricks played
- # in order to make the program more jazzy. A special color table is used to give
- # smooth transitions from one color to the next. Color table animation is also
- # supported, for the wowem effect of flowing Mandelbrot images.
- # The program is written in MacApp 1.1, which explains why it has a real user
- # interface. Mandelbrot images take about 30 minutes to calculate. It is
- # Juggler aware so you can put the program in the background where it will
- # continue to calculate, while you do something more important, like look at
- # the source code. It also handles multiple documents, and reading/writing of
- # PICT files using the bottlenecks to minimize the memory hit.
- #
- # This program is intended to be a real world example of handling color in a
- # nontrivial fashion. As such it has some rather special color requirements,
- # and those don’t match the current system architecture very well. The program
- # is designed to be compatible with the future, it will not break in future
- # systems. However, it does not use the Palette Manager, which means that
- # there will be situations where the colors will not look right in either FracApp
- # or another program running under MultiFinder. The approach that FracApp
- # uses is thus not the preferred Apple approach and does NOT have the Apple
- # seal of approval from engineering. The only way to get the stamp of approval
- # is to use the Palette Manager. To do a program of this form, you cannot
- # use the Palette Manager without some extra hacks that are compatibility
- # risks in themselves. So... use at your own risk. If you are forced to revise your
- # program because you followed this as an example, you cannot gripe to Apple, since
- # it is not fully approved. You just have to change your program, which I hope is no
- # big deal. You can give this code to other people, as long as they recognize
- # that it is not fully approved too.
- #
- # Unless you have very special color requirements, you should use the Palette
- # Manager. It works for most things, and is much easier to use than the
- # approach taken here. There are a few things it won’t do of course, leading
- # to this code. If you can do it, use the Palette Manager and save yourself
- # some grief.
- # Written in MacApp Object Pascal code.
- # Compatibility rating = 2. (nothing will break, but it may not
- # always look correct.)
- #
- ------------------------------------------------------------------------------}
- {Copyright 1988 by Bob. All rights reserved, since Bob has all rights.
- February 1, 1988.
- Written by Bo3b Johnson of Developer Technical Support. }
-
- { Version 1.0 }
-
- { The following is a list of features or bug fixes that could be added to the program:
- *** Check the segmentation.
- *** Bug with selection rectangle on edge of document, moving by 1 pixel.
- *** Make it run crashless using temp documents to store partial fractals.
- *** Updates could be cleaner so no partial fractals are displayed.
- *** Override window.updateevent so we can avoid the EraseRect on updates.
- *** Draw selection rect in offscreen, copy up to screen for flicker free selection.
- *** Crash on 3 monitor system during window drag.
- *** Could set the bytes directly in offscreen PixMap, skip using MoveTo:Line.
- *** Copy up from small picture up to big screen gets garbage, src rect too big?
- *** Allow a way to Zoom in using coordinates.
- *** Allow the user to set the colors used in display.
- *** Bigger penSize for fast, lo-res fractals. Allow user to set size of pen.
- *** Add MacApp debugging stuff like Inspect and TList object checking.
- *** Some things for the reader to do to modify the program.
- }
-
- { Where does it fit:
- This is a series of sample programs for those doing development
- using Color QuickDraw. Since the whole color problem depends
- upon the exact effect desired, there are a number of answers
- to how to use colors, from the simple to the radically complex.
- These programs try to cover the gamut, so you should use
- which ever seems appropriate. In most cases, use the simplest
- one that will give the desired results. The compatibility
- rating is from 0..9 where low is better. The more known risks
- there are the higher the rating.
-
-
- The programs (in order of compatibility):
-
- SillyBalls:
- This is the simplest use of Color QuickDraw, and does
- not use the Palette Manager. It draws randomly colored
- balls in a color window. This is intended to give you
- the absolute minimum required to get color on the screen.
- Written in straight Pascal code.
- Compatibility rating = 0, no known risks.
-
- FracAppPalette:
- This is a version of FracApp that uses only the Palette
- Manager. It does not support color table animation
- since that part of the Palette Manager is not sufficient.
- The program demonstrates a full color palette that is
- used to display the Mandelbrot set. It uses an offscreen
- gDevice w/ Port to handle the data, using CopyBits to
- draw to the window. The Palette is automatically
- associated with each window. The PICT files are read
- and written using the bottlenecks, to save on memory
- useage.
- Written in MacApp Object Pascal code.
- Compatibility rating = 0, no known risks.
-
- TubeTest:
- This is a small demo program that demonstrates using the
- Palette Manager for color table animation. It uses a
- color palette with animating entries, and draws using the
- Palette Manager. There are two circles of animating colors
- which gives a flowing tube effect. This is a valid case
- for using the animating colors aspect of the Palette Manager,
- since the image is being drawn directly.
- Written in straight Pascal code.
- Compatibility rating = 0, no known risks.
-
- FracApp: (***)
- This is the ‘commercial quality’ version of FracApp. This
- version supports color table animation, using an offscreen
- gDevice w/ Port, and handles multiple documents. The
- CopyBits updates to the screen are as fast as possible. The
- program does not use the Palette Manager, except to
- provide for the system palette, or color modes with less than
- 255 colors. For color table animation using an offscreen
- gDevice w/ Port, it uses the Color Manager and handles the
- colors itself. Strict compatibility was relaxed to allow for
- a higher performance program. This is the most ‘real’ of the
- sample programs.
- Written in MacApp Object Pascal code.
- Compatibility rating = 2. (nothing will break, but it may not
- always look correct.)
-
- FracApp300:
- This doesn't support colors, but demonstrates how to create and
- use a 300 dpi bitmap w/ Port. The bitmap is printed at full
- resolution on LaserWriters, and clipped on other printers (but
- they still print). It demonstrates how to use a high resolution
- image as a PICT file, and how to print them out.
- Written in MacApp Object Pascal code.
- Compatibility rating = 1. (The use of PrGeneral is slightly
- out of the ordinary, although supported.)
- }
-
- { Reasons for this version of reality (the strategy):
- The main idea behind this program is to allow you to create and fool around
- with the Mandelbrot set, using this number cruncher wizzo computer we got
- here. While we are making these documents, we also throw in a couple of
- special effects to make it more fun, like the special color mapping and the
- color table rotation. This program is intended to be a real-life program,
- done as well as possible given current constraints. The program is supposed
- to be something that somebody (who was silly perhaps) might try to sell.
- The idea is to pretend that we are developers as well, testing the development
- world as well as making a fun program. Well, life’s a bitch as a developer
- trying to write a program of this form. No intentional shortcuts were taken
- in the program, but some things were left out due to time constraints. Like
- all real programs, some people will like it and some people will hate it. I
- hope you like it, but if you don’t, send me some mail telling me why.
-
- The overall structure of the program is to have the MacApp Document object
- handle all the data. This includes an offscreen gDevice and port that are
- the actual fractal data. The View object uses the Document’s data to draw
- into the window visible to the user. The Document does all the work of
- calculating new fractals during Idle times. It also handles saving the
- data to disk and reading it back. The data files are PICT so as to be as
- compatible as we can. The color table animation is handled by the Application
- object during its Idle processing. The program handles zooming in to
- see closer views of the environment, using selection rectangles as you
- would expect. This whole block of comments at the beginning are intended
- to describe some more macroscopic problems and structure. In the code
- itself you will find the tactical comments dealing with how a specific
- operation is done.
-
- The fractal calculation is done by the CalcCity routine of the Document. The
- Application object gets the DoIdle call, and he calls each document to
- have a pixel calculated in each document. The calculation is done a pixel
- at a time so that it can be done in the background with no visible effect
- on the foreground app. As each horizontal line of data is finished it is
- updated to the screen. The algorithm is very simple.
-
- The color handling to be as nice as possible under MultiFinder is found in
- the AboutToLoseControl and RegainControl methods of the Application. In
- addition, the color table animation is done by the RotateColors routine,
- called from the Application's DoIdle method after it gives some CPU time
- to each open document. The handling of the gDevices on the system, essentially
- all the work the Palette Manager would have done for us can be found in
- the GarDevice methods. Those handle changing the colors and color table
- animation.
-
- Allocating and using an offscreen gDevice and port are found in the Document
- object, as the BuildOffWorld method. The port offscreen is used as a drawing
- environment once a pixel is calculated, as seen in DoIdle for the Document.
-
-
- You should use the Palette Manager if at all possible. For other references
- see the other sample programs in this collection.
- This program does not fully use the
- Palette Manager. I apologize. The Palette Manager has two major
- flaws for a program of this form. It does not provide a convenient way to
- remap the colors after the color table is scrambled so that updates to the
- screen can be as fast as possible; and it does not support a single animating
- palette used for multiple windows. The first can be partially solved using the
- CopyBits to itself trick, but this is inconvenient while a fractal is being
- calculated. The second can only be solved by incredible hacks, which
- would not be done in a commercial program. The problem stems from having
- 195 animating colors for each window, but I only wish to use 195 colors
- for the whole program, not each window. In addition, this is 195 animating
- colors. If they were standard colors, then the same entries in the table
- would be used for multiple windows. The answer to the problems
- was to use the Color Manager, and try to be as friendly as possible. When
- the Palette Manager is fixed, the program can be revised to reflect these
- changes and live a much happier life.
-
- The Color Manager is used, primarily the SetEntries call in order to set
- the color enviroment the way we need it. Color Search Procs are also
- used to map the fractals into devices that have fewer colors. Using
- SetEntries can be a little rough since the Palette Manager is also using
- it to set the color environment and does not respect our use of the
- color table. FracApp could be described as Palette Manager aware, but
- not friendly. It uses the PM whenever it can, but for the fanciest effects
- it must bypass the PM. Using the Palette Manager is far and away the
- most sensible thing to do, but we were stuck here with a low-performance
- program that would not be commercially viable. If you don’t need some
- of the high-end tricks played here, your life will be much easier if you
- use the Palette Manager instead. In particular, FracApp knows and keeps
- track of all the Monitors connected to the machine, which is normally
- done by the Palette Manager. If you can do it, save yourself some time
- and use the PM.
-
- This color changing will only be done if we have enough colors in the system
- to do the full blown fractal (ie. > kNumColors). If not, we can’t get a reasonable
- fractal anyway, so we will just do zebra fractals. This way you can still
- use the program in lesser color modes, it just isn’t as impressive. This is far
- preferable to a ‘you must use 256 color mode’ dialog. Color table animation
- will only be enabled when running with enough colors. If we have enough colors
- on a given monitor then we just set the ctSeeds to match to get a fast update.
-
- When we set up the offscreen gDevice, we set it up using a 3 bit iTable to save
- on memory that isn't used. We don’t use the iTable in the offscreen gDevice
- since it is never the destination of a CopyBits or color selection operation.
- There is thus no reason to waste memory on unused data.
-
- When a document is saved the color table from the offscreen gDevice is used.
- This is the clut resource that is used uniformly throughout the program. If
- you hate my choice of colors, you can change the clut to something else and
- all should work the same (except old documents will map into something else).
- When the color animation is done, we don’t rotate the offscreen guys, we just
- move a copy of the system color table around.
-
- There is a known bug with programs that animate the color table in the
- background. This doesn’t seem like a reasonable goal given the environment,
- but some programs wish to do this. If they do, the color table will get
- munged up, giving you some wild effects.
-
- The Palette Manager is used to the extent that we have the System Palette
- (14 colors) attached to each window automatically. If the window is on
- a monitor with not enough colors to do our thing, the Palette will be used
- instead, giving a fixed color environment so the fractals look the same
- each time they are displayed. If we have enough colors on the device we
- walk all over the colors there, so the PM is not being used there.
-
- The Apple Menu was a special hack to make sure that it would draw in the
- right colors, and not be animated when we were doing the color table
- animation. It is done by making sure that the system palette is always
- available, even when we hammer on the color table. We hammer an
- extra 14 colors when we do it, and make sure the menubar is redrawn
- after we hammer. To avoid having the Apple animate, we Reserve the
- entries we use. When the menubar is drawn it will only match non-
- reserved entries.
-
- The program currently uses ScreenBits.Bounds as the determining size of the
- view and thus the fractal that is calculated. This is OK, but a better approach
- would be to allow the user to specify the limits of the Fractal they want. This
- involves adding another dialog and save defaults type of feature but is a better
- way to solve the problem since it is not obvious what the best size would be.
- ScreenBits.bounds is easy to use, but whenever there is no obvious best answer
- it is always better to let the user decide instead, that way they can’t bitch.
-
- We have to be pretty rowdy about changing the color table. In order to be sure that
- our colors are set up the right way, we need to check the depth and make sure
- the colors are right at each update event. We may get an update during the program
- that comes from changing depth. During any update, if we don’t have enough
- colors to do the full fractal, we will use a color search proc to map the
- fractal into the color space available. This will make zebra fractals, a
- reasonable compromise.
-
- Another goal of course was to get this thing done. A goal that tends to slide
- away as more things are added to the program, so in true Macintosh style,
- the 1.0 version of the program is somewhat limited, and may not be fully
- debugged. Some things specifically left out: printing the documents to
- a LaserWriter with grey scales instead, using temporary documents to
- make the program crashless (so you can start up where you left off, saving
- the computation it took to get there), an option to make the ‘pen’ size bigger
- so you can do a low-res fractal to begin with. These things are all admirable
- features to add, but you have to finish version 1.0 sometime, so this was it.
- These other things will be added if possible.
-
- Carefully watch the 881 flag with this MPW business. There are a number of
- ridiculous problems associated with its use. In particular the $LOAD files
- are dangerous to use with 881 and the combination of the two will often
- end up compiling successfully into a program that is garbage and will
- crash upon running it. This, remind yourself, is a feature of the most
- powerful development system around. In order to build currently, the main
- program MFracApp.p should be compiled with new $LOAD files and the 881
- flag turned off. All of the MacApp sources should be compiled with a new
- $LOAD file and 881 turned off. The last step should be to compile the UFracApp.p
- with the 881 flag turned on, and with new $LOAD files as well. Beware or
- be prepared to spend a lot of time on something silly. To solve this
- problem the Make file used with FracApp has a specific compile rule for
- the UFracApp file. UFracApp also uses its own $LOAD file, that is different
- from the MacApp and MFracApp ones. The 881 flag is not specifically
- required, but it makes code that uses the 881 directly instead of going
- through SANE for a speed up of about 10 times. Since we are speed freaks
- here as well, the 881 option had to be used. Given the problems, I would
- probably skip the 881 option and do the time critical pieces in assembler.
-
- If you want to know how long a fractal took to calculate there is a time
- stamp saved in the file header. It is no longer drawn in the window since
- it is not accurate when the program has run in the background or if there
- are multiple documents open. This could be added again if desired.
- This will be made more accurate in the future, probably
- using a calculation that gives us a once through the loop calculation
- in units of TimeDBRA, so we can be more machine independent.
-
- Notably I am aware of the fact that this program does not really calculate
- Fractals. Actually it calculates and displays the Mandelbrot set which is
- not self-similar so it cannot really be called a fractal. It is distressing to
- add to the confusion as to what fractals are, but it is too late. For more
- information on Fractals and the Mandelbrot set (no umlaut on the o), you
- could see Mandelbrot’s book ‘The Fractal Geometry of Nature’, but it is
- pretty mathematical and not all that helpful. A better source is the
- Peitgen-Richter book ‘The Beauty of Fractals’, which has a do it yourself
- section in the back.
-
- The program is structured primarily around the document. The document is
- the object to create and maintain the offscreen gDevice & port. The document
- converts the offscreen data into a PICT file when saved or restored. The
- document also does the calculation of the fractal, keeping the offscreen data
- up to data as it goes along. The view only handles taking the document data
- and displaying it.
-
- For the zoom operation, there was no really great way to handle the new
- document case based on another document. This is a little strange to be
- doing, and the structure of MacApp was such that we couldn’t get to the
- data desired at the right time. The logical place to put it in at
- DoMakeDocument was too early to have the gDevice allocated and ready
- to start more stuff. The problem was resolved by using global variables
- to transmit the information to the other piece of the program that
- might need it. Essentially DoInitialState decides if this is a brand new
- base level document or a zoom in based on the state of the global variables.
-
- When we feel obligated to go whap on a monitor and change the color table,
- we use a special TList built during the IFracApplication. The TGarList is
- a list of display devices in the system. Whenever we need to do something
- to a display device we do an Each operation and do it to each device in the
- system. This simplifies the handling of multiple monitors dramatically.
- Thank you MacApp, this is cool. The GarDevices have a number of methods
- that handle the special things we do to the gDevices in the system. When
- the Palette Manager is more robust, this GarDevice object can probably
- be removed, since virtually all of the work done by the GarDevice are things
- that the Palette Manager will handle for us.
-
- The MacApp memory management approach is used as well. The big pieces
- used by the Documents come out of permanent memory, helping to avoid
- a crash from no memory. When we allocate something that will be thrown
- away immediately, like a spare color table or something, it of course
- comes out of normal memory. We did not do a full blown memory analysis
- of the program since it is such a memory hog anyway. The mem! resource
- is set up in a form that is roughly close (a bit high) without trying to be
- extra accurate. When a document takes 400K of RAM to open it hardly
- seems relevant to make sure the mem! is accurate to 2K. Because of this
- somewhat cavalier approach you may not be able to open a document in
- a few cases where you really should be able to. The mem! in use of 40K
- is close with a +2K/-10K error on how big it should really be.
-
- The QuickDraw BottleNecks are used to both read and write the actual
- fractal data from/to the disk. This is done since the data in the document
- may be very large (100K) and if we just spool the data from the file
- we don't actually have to use that extra hunk of memory. We have to read
- the data anyway, so we go ahead and just read it in as we play it back.
- As it is played back it goes into the offscreen gDevice's pixMap, so we
- have the data to display. No memory hit for the document is a big win.
- When writing the data, the same thing is true so we don't have to have
- a huge handle to hold the picture data itself. We also avoid the problem
- of not having enough memory to create the picture in the first place,
- making a document unsaveable. That is particualarly annoying, and
- is easy to avoid using the spooling approach.
-
- While in the foreground we set the color table to be our special set of
- colors, making the display as good as we can get it for us. This has the
- side effect of making programs in the background change. When we are
- in the background we make no claims on the color table. We don’t bother
- to Protect entries, but we Reserve the entries so that Color2Index
- will find colors other than the animating ones we are using. This is
- specifically to make the Apple Menu look correct, but will also help
- the programs in the background to avoid having them animate when
- we are in the front. When they are redrawn, they will use the non-
- animating entries out of the color table. Again, in the background
- we make no claims, so any color in the table is available for use.
-
- With thanks to Skippy Blair for the discussions of color QuickDraw and the
- Palette Manager. Thanks to Darin Adler for further discussion of the Palette
- Manager and for good suggestions on making it more MacApp friendly.
- Thanks too to Dave McGary for the discussion on color mapping in other than 256
- color mode, and for coming up with the solution to use a MOD or DIV to wrap
- the excess colors around, making it come out in the stripes when not enough
- colors are available.
- }
-
-
- { Global variables. }
- VAR
- gRotateOn: BOOLEAN; { whether we are color animating or not. }
- gStaggerCount: INTEGER; { for staggering windows. }
- gGarList: TList; { List of gDevices in system. }
- gBackGround: Boolean; { flag if we are in background or not. }
- gOurColors: CTabHandle; { color table we use as a source for documents. }
- gRealMin,
- gRealMax,
- gImagMin,
- gImagMax: Extended; { used for zooming in operation. }
-
- { The next globals are used for the QuickDraw bottlenecks when reading or
- writing a picture to disk. These are needed, since the bottlenecks cannot
- be owned procedures. }
- gPictSize: LongInt; { number of bytes used for saving a PICT. }
- gPictError: OSErr; { do some error handling in bottleneck. }
- gPictRefNum: Integer; { Need the refnum of the open file too. }
- gPictHandle: PicHandle; { for reading/writing a picture. }
-
-
- { Set some compiler options that we desire for the main body of code only. You
- might wish to leave on the range checking, but I was not satisfied with having
- to push and pop in the code, and was not pleased with the slowdown in performance.
- These can be dangerous to turn off, especially the $H. For those who use MPW
- more than I, you probably want to make these settable from the command line,
- or use the MacApp debug or no-debug compile time variables. }
- {$PUSH} { Save the compiler state before we change it. }
- {$D+} { Debugging labels on for the code here. }
- {$R-} { No range checking to make things faster. }
- {$OV-} { No overflow checking either. }
- {$H-} { No handle checking to avoid compiler complaints on WITHs. Be careful. }
- {$N+}
-
- {------------------------------- Application -------------------------------}
-
- PROCEDURE TFracAppApplication.IFracAppApplication(itsMainFileType: OSType);
-
- VAR I: Integer;
- nextDevice: GDHandle;
- nextGar: TGarDevice;
-
- BEGIN
- gStaggerCount := 0;
- IApplication(itsMainFileType);
- fIdlePriority := 1; { say we need Idle time calls to TApp.DoIdle }
- gRotateOn := FALSE; { no color rotation as we start. }
- gBackGround := FALSE; { not in background to start. }
- gRealMin := 0; { must be set to empty to start with. }
- gRealMax := 0; { so we do normal document open. }
-
- { Now allocate a color table that we will use whenever we create a new document
- or need to compare colors. This is so we have the same color table for each
- document, as well having the ctSeed the same for them all. }
- gOurColors := GetCTable(kClut); { install our new desired one from clut }
- FailNil (gOurColors);
-
- { In order to handle the multiple gDevices that abound in Mac II, we need to make
- a TList of the gDevices so we can more easily keep track of them. The TGarDevice
- objects will be used to keep track of the devices, one object for each gDevice.
- We need to set up this TList here though. The GarDevice list won't change while
- the program is running. We only add devices that are screen devices, to avoid
- any spurious devices that we don't care about. When initialized each GarDevice
- will set up the color environment as best it can. }
- gGarList:= NewList;
-
- nextDevice := GetDeviceList; { First gDevice in system. }
- While nextDevice <> NIL DO BEGIN
- IF TestDeviceAttribute(nextDevice, screenDevice) AND
- TestDeviceAttribute(nextDevice, screenActive) THEN BEGIN
- New (nextGar); { Make a new object for this device. }
- FailNil (nextGar); { If not possible, we are toast. }
- nextGar.IGarDevice (nextDevice); { Init the GarDevice object. }
- END; { Add a legitimate screen Device. }
- nextDevice := GetNextDevice(nextDevice); { move to next gDevice in chain. }
- END; { While }
- END; { TFracAppApplication.IFracAppApplication }
-
-
- { OK, this is where a new document gets created. This does the init for the
- document object itself. After it is done, the view and window can
- be created, relying upon the data in the document. }
- FUNCTION TFracAppApplication.DoMakeDocument(itsCmdNumber: CmdNumber):
- TDocument; OVERRIDE;
-
- VAR aFracAppDocument: TFracAppDocument;
-
- BEGIN
- { Allocate and initialize the document}
- New(aFracAppDocument);
- FailNil(aFracAppDocument);
-
- { Now initialize the document fields, and set up the global state of the fractal
- to a default set of the starting fractal. }
- aFracAppDocument.IFracAppDocument;
-
- { We successfully created a document so we can return the document object for
- use by the application. }
- DoMakeDocument := aFracAppDocument;
-
- END; { TFracAppApplication.DoMakeDocument }
-
-
- { Performs Idle time processing for the application. This will do the
- fractal calculation during the idle times. It will allow each open
- document a chance to calculate. The CalcCity is a method owned by
- each document that will get a call from the ForAllDocumentsDo.
- The documents don't use the DoIdle routine since we want each
- open document to get time, not just the one in the target chain. }
- PROCEDURE TFracAppApplication.DoIdle (phase: IdlePhase); OVERRIDE;
-
- { Give each document some CPU time. }
- PROCEDURE DoFractalCalc(aDocument: TFracAppDocument);
-
- BEGIN
- aDocument.CalcCity; { give the document its time to calc. }
- END;
-
- { Give each GarDevice the message to rotate colors. }
- PROCEDURE DoRotateColors(curGar: TGarDevice);
-
- BEGIN
- curGar.RotateColors; { tell the device to rotate colors if possible. }
- END;
-
- BEGIN
- IF phase = IdleContinue THEN BEGIN
-
- { Send the message to each open document to calculate the next pixel. }
- ForAllDocumentsDo (DoFractalCalc);
-
- { Now we have calculated the next pixel in each document. If the Rotate Colors menu
- option has been checked we want to rotate the color table using our routine. We
- need to rotate all color tables in devices we can see, so we'll use the GarList to
- do them all. }
- IF (gRotateOn) AND (gFrontWindow <> NIL) AND (NOT gBackGround) THEN
- gGarList.Each (DoRotateColors);
- END;
- END; { TFracAppApplication.DoIdle }
-
-
- { Set up the menus choices in Fractal Menu. Set the Rotate Colors choice to
- be enabled if we have a device with enough colors, and set the check mark
- on if it has been chosen. We will go through the chain of devices to see if
- any are capable of rotation, and if so will enable the menu. If we have a
- saved color table for any device, that device can do rotation. }
- PROCEDURE TFracAppApplication.DoSetupMenus; OVERRIDE;
-
- VAR rotateFlag: Boolean;
-
-
- PROCEDURE CheckRotate (curGar: TGarDevice);
-
- BEGIN
- IF curGar.fColorTable <> NIL THEN rotateFlag := TRUE;
- END;
-
- BEGIN
- INHERITED DoSetupMenus; { Do mainline stuff first. }
-
- rotateFlag := FALSE; { Assume we can't do it. }
- gGarList.Each (CheckRotate); { Change flag if needed. }
-
- EnableCheck (kRotateColors, rotateFlag, gRotateOn); { enabled, and checked or not. }
- END; { TFracAppApplication.DoSetupMenus }
-
-
- { Handle the menu choice out of the Fractal Menu for Rotate Colors. This will either
- set or unset the check mark, thus enabling or disabling the color rotation
- performed in the Idle loop. }
- FUNCTION TFracAppApplication.DoMenuCommand(
- aCmdNumber: CmdNumber): TCommand; OVERRIDE;
-
- BEGIN
- DoMenuCommand := gNoChanges; { assume no command object returned. }
-
- CASE aCmdNumber OF
- kRotateColors:
- { Chose the rotate colors menu option. We want to set the check mark, or unset it
- if already there, and reflect the menu state in our document variable which is
- used to rotate the color list at Idle time. }
- BEGIN
- gRotateOn := NOT gRotateOn; { invert the state of menu option. }
- END; { kRotateColors }
-
- OTHERWISE
- DoMenuCommand := INHERITED DoMenuCommand (aCmdNumber); { next guy in chain. }
- END; { CASE aCmdNumber }
- END; { TFracAppApplication.DoMenuCommand }
-
-
- { When we are switched in we need to reset the color table to our color table. }
- PROCEDURE TFracAppApplication.RegainControl(checkClipboard: BOOLEAN); OVERRIDE;
-
- PROCEDURE SendPound (curGar: TGarDevice);
-
- BEGIN
- curGar.PoundColors;
- END;
-
-
- BEGIN
- gBackGround := FALSE; { no longer in background. }
-
- { Change the color table on each gDevice in the system that has enough colors to
- support our fancy colors. If any device has enough colors we will enable the
- rotation flag. }
- gGarList.Each (SendPound);
-
- { Call the inherited routine to do the normal regain control operations as well. }
- INHERITED RegainControl (checkClipboard);
- END; { TFracAppApplication.RegainControl }
-
-
- { When we are switched out we need to restore the color table to be polite. When
- the program is closed this routine is called as well, so we don't need to override
- the Close method in order to fix the color table on Quit. }
- PROCEDURE TFracAppApplication.AboutToLoseControl(convertClipboard: BOOLEAN);
- OVERRIDE;
-
- PROCEDURE SendUnPound (curGar: TGarDevice);
-
- BEGIN
- curGar.UnPoundColors;
- END;
-
-
- BEGIN
- gBackGround := TRUE; { are going into background. }
-
- { Fix up every gDevice that needs it. }
- gGarList.Each (SendUnPound);
-
- { Call the inherited routine to do the normal work for losing control. }
- INHERITED AboutToLoseControl (convertClipboard);
- END; { TFracAppApplication.AboutToLoseControl }
-
-
-
- {------------------------------- Document -------------------------------}
-
- { An auxiliary method to set up the step constants for the fractal calculation.
- It is external since we need to set up the constants when we create a new
- fractal as a zoom in. Sets up the width/height of fractal, the delta in each
- axis as a real number, and ensures that the starting min/max values for
- the figure are set to supply a 1:1 aspect ratio. The step constants are
- zeroed to start the fractal anew. Allocates no memory. }
- PROCEDURE TFracAppDocument.SetUpConstants;
-
- BEGIN
- WITH fFracHeader DO BEGIN
- { Set up the iterations by calculating up the step constants, and the
- edges of the view area in pixels. }
-
- plotWidth := (calcRect.Right - calcRect.Left);
- plotHeight := (calcRect.Bottom - calcRect.Top);
- deltaP := (realMax-realMin)/(plotWidth-1);
- deltaQ := (imagMax-imagMin)/(plotHeight-1);
-
- { Force aspect ratio 1:1, making delta smallest of two. This effectively grows
- one side or the other out, like rMax/iMax becoming bigger number. }
- IF deltaP > deltaQ THEN BEGIN
- deltaQ := deltaP;
- imagMax := deltaQ * (plotHeight-1) + imagMin; { new maximum for q }
- END { grow the q side }
- ELSE BEGIN
- deltaP := deltaQ;
- realMax := deltaP * (plotWidth-1) + realMin; { new maximum for p }
- END; { grow the p side }
-
- { Now start the counters at zero, as the edge of the area to calc. }
- curCol := 0; curRow := 0;
-
- { And the elapsed time is zero of course, since we are just starting. }
- elapsedTime := 0;
- END; { WITH fractalDocument }
- END; { SetUpConstants }
-
-
- { Utility method to build the offscreen gDevice and offscreen Port that is used for
- the document data. This happy fellow will allocate huge old hunks of Ram for
- the document and set up the initial state of the gDevice with the right color
- table and so on. This is done as a utility routine since we don't know in advance
- how big the gDevice will be, and we want to make it as big as it was when the
- document was saved, reading it from the header. If we are making a new
- document, the DoInitialState will call with the screen rectangle. }
-
- PROCEDURE TFracAppDocument.BuildOffWorld (sizeOfDoc: Rect);
-
- VAR oldPerm: Boolean;
- dummy: Boolean;
- docW, docH: LongInt;
- fi: FailInfo;
- currDevice: GDHandle;
- currPort: GrafPtr;
- Erry: OSErr;
-
- { This is the error handler for when we get errors while making a new document,
- typically like running out of memory. Since the Free method for the document
- will get called we don't have to chuck the things that normally get killed.
- Just set allocation back to normal (for the error message itself), the drawing
- environment back to normal and return. }
- PROCEDURE DeathBuildOff (error: OSErr; message: LONGINT);
-
- BEGIN
- oldPerm := PermAllocation (oldPerm); { Set memory back to previous. }
-
- SetGDevice (currDevice); { Set device back to main, just in case. }
- SetPort (currPort);
- END;
-
- BEGIN
- currDevice := GetGDevice; { save current for error handling. }
- GetPort(currPort);
-
- { The memory used creating the view must be out of permanent memory, it is too
- big. Any failure to get it from permanent memory will invoke the error handler. }
- oldPerm := PermAllocation (TRUE);
-
- CatchFailures(fi, DeathBuildOff); { any failures, must be cleaned up. }
-
- { Let's set up the size of the rectangle we are using for the document. }
- docW := sizeOfDoc.right - sizeOfDoc.left;
- docH := sizeOfDoc.bottom - sizeOfDoc.top;
-
-
- { Now try to set up the offscreen bitMap (color). If we fail we have to split,
- and we might since we may not have 300K or more (basically a full screen
- worth, which is unlikely to be less than 300K) for the pixMap. Each document
- on screen will have a full pixMap for it. Allocate a full screen size buffer in
- 8 bit depth. Also make it into a color port so we can draw into it normally and
- use it as a source for CopyBits. Requires 8 bits deep for the number of colors,
- and sets up a buffer with that in mind, that is full docRect size with
- one byte per pixel as 8 bit mode. This is width x height. 8 bits/byte. }
- fBigBuff := NewPtr (docW * docH);
- FailMemError; { couldn't get it we die. }
-
-
- { OK, now we get wacko. We need to create our own gDevice, since we want to have
- an offscreen device. This needs to be done so that we have full control over the
- color table used, in order to save full 8 bit documents, even if we aren't in 8 bit
- mode when we save. So... We will start by creating a NewGDevice, that will
- allocate a temporary ITable, and PixMap with partial colorTable; change the
- fields of the device's pixMap to our bitMap, with right size, depth, and rowbytes;
- init the fields of that device, including changing the color table to our color
- table created from our clut; set that gDevice as the current one; then do the
- OpenCPort which will use the current gDevice to make its PixMap and color table;
- When we go to draw or save the data in the offscreen buffer,
- we need to set the current device so we use our color table, making all the
- colors come out right. }
-
- { Now we need to do the piece to make an offscreen gDevice that is not connected
- to the screen. Allocate a new one, with stub pixMap. }
- fDrawingDevice := NewGDevice (0, -1); { -1 means unphysical device. }
- FailNIL (fDrawingDevice); { If we failed, error out. }
-
- { Now init all the fields we can in the gDevice Record, since it comes uninitialized. }
- HLock ( Handle(fDrawingDevice) );
- WITH fDrawingDevice^^ DO BEGIN
- gdId := 0; { no ID for search & complement procs }
- gdType := clutType; { color table type fer sure. }
-
- { Get the color table for the offscreen gDevice. This is a copy of the global
- color table we created early on. }
- DisposCTable (gdPMap^^.pmTable); { kill the stub that is there. }
- gdPMap^^.pmTable := gOurColors; { make a copy of our global color table. }
- Erry := HandToHand (Handle(gdPMap^^.pmTable)); { and stick it into this gDevice too. }
- FailOSErr (Erry); { if not possible, blow out. }
-
- { build a new iTable for this device, based on the new color table. 3 bit res to
- save on memory since we don't need the iTable for our stuff. If we fail here,
- we have some dumb error code like -151. This is translated via the ‘errs’
- resource into the ‘there is not enough memory’ message instead. }
- MakeITable (gdPMap^^.pmTable, gdITable, 3);
- FailOSErr (QDError); { no memory, we can leave here. }
-
- gdResPref := 3; { preferred resolution in table. }
- gdSearchProc := NIL; { no search proc. }
- gdCompProc := NIL; { no complement proc. }
- { Set the gdFlags to be: color, ramInit, noDriver, screenActive }
- gdFlags := 2**0 + 2**10 + 2**14 + 2**15; { set each bit we need. }
-
- { Now set up the fields in the offscreen PixMap correctly. }
- gdPMap^^.baseAddr := fBigBuff; { The base address is our buffer. }
- gdPMap^^.bounds := sizeOfDoc; { bounding rectangle to our device. }
- { one byte per pixel horizontally is rowBytes. + $8000 to make it color port. }
- gdPMap^^.rowBytes := docW + $8000;
- gdPMap^^.pixelSize := 8;
- gdPMap^^.cmpCount := 1;
- gdPMap^^.cmpSize := 8;
-
- gdRect := sizeOfDoc; { the bounding rectangle for gDevice, too. }
- END; { With fDrawingDevice }
-
- { Now unlock the gDevice handle since it is in the System Heap. The system
- can use it unlocked as well as locked so we try to help avoid fragmentation. }
- HUnLock ( Handle(fDrawingDevice) );
-
- { Yow, that was rough. Now we have a fully initialized gDevice offscreen with its
- own colortable. All color mapping should be done using that color table, and the
- drawing we do to it should make the saved pictures save that color table too.
- Set to our new device so we OpenCPort with all new parameters. }
- SetGDevice (fDrawingDevice);
-
- { After all of that, we have a gDevice which is complete. It has the color table we want
- associated with it, from the clut, it has the right portBits.baseAddr and the right
- size. It is complete, except that we can't draw into it using normal calls. We thus
- need to make a port that we can use. We have set the gDevice to be the one we just
- created, and when we OpenCPort we will get a copy of the fields we just set up in
- our new gDevice. The port is simply an interface into our gDevice for drawing.
- Allocate a port record on the heap as a pointer. We get the Port record out of
- permanent memory, but the actual opening of the port must use all the memory
- available to avoid blowing up (system error). QuickDraw is very unfriendly.
- After it lives, we need to be sure we still have memory reserve, and if not, we
- exit, killing this document. }
- fDrawingPort := CGrafPtr( NewPtr (SizeOf (CGrafPort)) ); { address of C Port record. }
- FailNil (fDrawingPort); { didn’t get it, means we die. }
-
- { Now the world is created, put memory allocation back to temporary, so that the
- QD pieces can come out of temp memory as well. No more permanent blocks are
- allocated by us, except for the port, which cannot fail or we die. }
- dummy := PermAllocation (FALSE);
-
- OpenCPort (fDrawingPort); { make a new port offscreen. }
- FailNoReserve; { Make reserve, die if we can’t }
-
- { QuickDraw is most obnoxious about making a port that is bigger than the screen,
- so we need to modify the visRgn to make it as big as our full page document. It is
- OK to change this ports visRgn since we own it offscreen. This is in case we
- are opening a document made on a different computer with a bigger screen. }
- RectRgn(fDrawingPort^.visRgn, sizeOfDoc);
-
- { Go whap on the other pieces of the port record to set it up to be offscreen. }
- fDrawingPort^.portRect := sizeOfDoc;
-
- { OK, we have a nice new color port that is offscreen. It has a fancy color table that
- came from the clut that will be used for the owning window. It is 8 bits deep,
- has 256 colors in its color table and has a rect the size passed in. It has no
- pieces that are related to the main gDevice, so we shouldn't alter that by drawing
- in this port. }
-
- { Clear the error handler chain, we don't make any more dangerous requests. }
- Success (fi);
-
- { Set the memory allocation to what we started with. }
- oldPerm := PermAllocation (oldPerm);
-
- { Now we have the offscreen PixMap, we need to initialize it to white. }
- SetPort (GrafPtr(fDrawingPort));
- EraseRect (sizeOfDoc); { clear the bits. }
-
- { We are done drawing and stuff for now, so set the gDevice back to where it was. }
- SetGDevice (currDevice);
- SetPort (currPort);
- END; { BuildOffWorld }
-
-
- { Init for the FracAppDocument itself. This sets up the Document object. }
- PROCEDURE TFracAppDocument.IFracAppDocument;
-
- VAR dummyTime: LongInt; { for picky compiler }
-
- BEGIN
- { Set up failure mechanism in case IDocument fails}
- IDocument(kFileType, kSignature, kUsesDataFork,
- NOT kUsesRsrcFork, NOT kDataOpen, NOT kRsrcOpen);
-
- { Set the time in our starting time variable in case we are still calculating.
- Temp var is to make the picky compiler not get worried about the var
- parameter. This routine can't move memory anyway, but it won't allow
- this use. }
- GetDateTime (dummyTime);
- fStartTime := dummyTime;
-
- fBigBuff := NIL;
- fDrawingPort := NIL; { set up in case we fail in here. }
- fDrawingDevice := NIL;
- END; { TFracAppDocument.IFracAppDocument }
-
-
- { Does the work for a New operation, where we start with a new fractal
- that doesn't have any stored data. This is to set up the view with no
- data and set up the fractal coordinates to the default. It will use the size
- of the main screen to make a new document, and create the offscreen
- world to match. If the global variable of gRealMin and gRealMax are both
- nonzero, then we want to use the global state being passed us by the
- New Fractal handler. This is for the zoom in. }
- PROCEDURE TFracAppDocument.DoInitialState; OVERRIDE;
-
- BEGIN
- WITH fFracHeader DO BEGIN
- { Start by filling in the fields that never change. }
- fType := kSignature; { creator of these documents. }
- hdrId := INTEGER ('FA'); { ID of the file, different from other PICT files. }
- version := 1; { version 1 files. 0 was old MandibleJug docs. }
-
- done := FALSE; { not done, starting brand new document. }
-
- { We start from scratch. This is the standard set of coordinates to start
- the default Mandelbrot set.
- Set up the coordinates to do, saving state in header vars. }
- realMin := -2.5; realMax := 1.5;
- imagMin := -1.5; imagMax := 1.5;
-
- { If we are supposed to do a zoom in, use those numbers instead. }
- IF (gRealMin <> 0) AND (gRealMax <> 0) THEN BEGIN
- realMin := gRealMin; realMax := gRealMax;
- imagMin := gImagMin; imagMax := gImagMax;
- END;
-
- { Set the fractal rectangle to be the full screen size. }
- calcRect := ScreenBits.bounds;
-
- END; { With FracHeader }
-
- { Clear the state of the globals so any new documents will not be zoom in types. }
- gRealMin := 0; gRealMax := 0;
-
- { Build the initial state of the document offscreen gDevice & port }
- BuildOffWorld (fFracHeader.calcRect);
-
- { Set up the rest of the constants that are used in the fractal, including
- the deltas in each axis and the step constants for stepping through
- each point in the fractal plane. }
- SetUpConstants;
- END; { TFracAppDocument.DoInitialState }
-
-
- PROCEDURE TFracAppDocument.DoMakeViews(forPrinting: BOOLEAN); OVERRIDE;
-
- VAR aFracAppView: TFracAppView;
-
- BEGIN
- { Create a new view (failing if we can't), get a rectangle with
- the appropriate extent, and initialize the view. }
- New(aFracAppView);
- FailNil(aFracAppView);
-
- { Initialize the view for use as a drawing environment. }
- aFracAppView.IFracAppView (SELF, fFracHeader.calcRect);
-
- {save a reference to the view in a TFracAppDocument field, for use
- by DoMakeWindows}
- fFracAppView := aFracAppView;
- END; { TFracAppDocument.DoMakeViews }
-
-
- PROCEDURE TFracAppDocument.DoMakeWindows; OVERRIDE;
-
- VAR aWindow: TWindow;
-
- BEGIN
- { Gets window definition from resource file; the window is to have both horizontal
- and vertical scrollbars, and is to have my 'fFracAppView' installed in it;
- NewSimpleWindow will exit via the failure mechanism if allocation fails.
- There is a palette associated with this window by Resource Id, so it will
- automatically get used when the window is created. }
- aWindow := NewSimpleWindow(kFracAppWindowID, NOT kDialogWindow,
- kWantHScrollBar, kWantVScrollBar, fFracAppView);
-
- SimpleStagger(aWindow, kStaggerAmount, kStaggerAmount, gStaggerCount);
- END; { TFracAppDocument.DoMakeWindows }
-
-
- { This routine will size the current image as it goes to the disk. It won't actually
- save any data or anything, but will merely watch the bytes go by keeping track
- of how many go by. The size is used by DoNeedDiskSpace. }
- PROCEDURE PictSizer (dPointer: Ptr; nextHunk: Integer);
-
- BEGIN
- gPictSize := gPictSize + nextHunk;
- END;
-
-
- { Routine to find out how much disk space will be required to save the data.
- This does not call the Inherited DoNeedDiskSpace since we don't support
- printing info here. The routine will replace the PutPicProc of the port
- with our PictSizer routine. When the picture is created here, no bytes
- will actually be allocated or saved, we will just watch it go by and
- save off the size in the global variable. That value is returned
- as the expected document size. }
- PROCEDURE TFracAppDocument.DoNeedDiskSpace(VAR dataForkBytes,
- rsrcForkBytes: LONGINT); OVERRIDE;
-
- VAR picPort: GrafPtr;
- currDevice: GDHandle;
- currPort: GrafPtr;
- newGrafs: CQDProcs;
- oldProcs: QDProcsPtr; { bug in include files, CGrafPort has QDProcs *** }
-
- BEGIN
- { Create a picture Item itself, by opening the picture and doing the CopyBits
- operation to the same port. That picture will then be packed using the
- normal packing operation of the Mac. That block is then the data to be
- written to the file. }
-
- currDevice := GetGDevice; { save off current one. }
- GetPort (currPort);
-
- SetGDevice (fDrawingDevice); { set to ours for drawing in it. }
- picPort := GrafPtr (fDrawingPort); { the pointer to our port. }
- SetPort (picPort); { set there to do pict saving. }
-
- { Save the pointer to the current CGrafProcs }
- oldProcs := thePort^.grafProcs;
-
- { Set our GrafProc record up to have the standard pieces. }
- SetStdCProcs(newGrafs);
-
- { Change the port to use those GrafProcs instead. }
- thePort^.grafProcs := @newGrafs;
-
- { We are in our offscreen port. Change the GrafProc pointer for picture saving. }
- newGrafs.putPicProc := @PictSizer;
-
- { Init the size of the pict we are going to save. Start with picture header. }
- gPictSize := SIZEOF (Picture);
-
- { The current gDevice is our offscreen device. Now go ahead and open the picture
- and build it in RAM. We would have done this by slices before, but the newer
- systems have a patch for playing back pictures that minimize the RAM hit, so
- we don't have to worry about the full screen CopyBits here. }
- WITH picPort^ DO BEGIN
- gPictHandle := OpenPicture (portRect);
-
- { copy all of the image to itself, in an open picture it saves the bits. }
- CopyBits (portBits, portBits, portRect, portRect, srcCopy, NIL);
-
- ClosePicture; { the picture is created, and packed. }
- END; { with picPort^ }
-
-
- { Done saving the size of the picture itself. Now set the GrafProcs back to normal. }
- thePort^.grafProcs := oldProcs;
-
- { Dispose the pict handle, we didn't actually make anything there. }
- KillPicture (gPictHandle);
- gPictHandle := NIL;
-
- { Set the drawing device back where it belongs, in case of error, we get right device. }
- SetGDevice (currDevice); { set back to system for normal. }
- SetPort (currPort);
-
- { The picture has been sized. Now add that in to the total size the file will use on
- disk, include the header for the file, plus the number of bytes in actual PICT. }
- dataForkBytes := dataForkBytes + gPictSize + kPICTHeaderSize;
- END; { DoNeedDiskSpace }
-
-
- { This routine will save the current image as it is created. As the data requests
- go by that data will be written to the file. The data is being created by the
- OpenPicture/CopyBits in DoWrite, this is the bottleneck for that operation.
- Any errors found while doing this will make us skip any further requests
- to write data to the disk. No memory is allocated. Communication with
- DoWrite is done through globals, since bottlenecks must be at the main
- level. The bottleneck must also keep track of how many bytes are written,
- so that the header on the picture can be fixed up to be correct. This must
- be done to avoid creating bogus pictures. The picSize field of the handle
- must be updated continuously so that when the picture is done, the ClosePicture
- can create a valid picture. The check for the NIL handle is to handle the
- problem of when the OpenPicture is called. The proc gets called before
- the handle is valid. Be very careful of these bottleneck things, it is
- easy to run into problems that are very hard to figure out. QuickDraw
- has no facilities to give you info when things go wrong so it makes it
- a bit tougher. }
- PROCEDURE PictWriter (dPointer: Ptr; nextHunk: Integer);
-
- VAR longHunk: LongInt;
-
- BEGIN
- IF gPictError = noErr THEN BEGIN
- longHunk := nextHunk;
- gPictError := FSWrite(gPictRefNum, longHunk, dPointer);
- gPictSize := gPictSize + longHunk;
- IF gPictHandle <> NIL THEN gPictHandle^^.picSize := LoWord (gPictSize);
- END;
- END;
-
-
- { Write the data calculated into the document to the file. This will make it a real
- PICT file. It writes the header first, then the PICT data. This is so that it
- will still be a normal PICT file and can be used by other programs.
- The file will be saved using QuickDraw Bottlenecks for the PutPicProc.
- As the data requests go by, they will be written to the file, using the
- PictWriter routine. }
- PROCEDURE TFracAppDocument.DoWrite(aRefNum: INTEGER; makingCopy: BOOLEAN);
- OVERRIDE;
-
- VAR recSize: LongInt;
- fi: FailInfo;
- picPort: GrafPtr;
- currDevice: GDHandle;
- currPort: GrafPtr;
- newGrafs: CQDProcs;
- oldProcs: QDProcsPtr; { bug in include files, CGrafPort has QDProcs *** }
-
- PROCEDURE DeathWrite (error: OSErr; message: LONGINT);
- BEGIN
- IF gPictHandle <> NIL THEN KillPicture (gPictHandle);
- gPictHandle := NIL;
-
- thePort^.grafProcs := oldProcs;
- SetGDevice (currDevice); { set back to system for normal. }
- SetPort (currPort);
- END;
-
- BEGIN
- { We have legit data in our document, set the mark in the file to be at the front. }
- FailOSErr ( SetFPos (aRefNum, fsFromStart, 0) );
-
- { Write the FracHeader to the file, it includes the pertinent details about
- the fractal including the global state for it. }
- recSize := SIZEOF (FracRecord); { our header on fractal files. }
- FailOSErr ( FSWrite (aRefNum, recSize, @fFracHeader) );
-
- { Now we need to write the picture data itself out to the file, after we set the
- mark to be after the entire header. Make sure the file is that big before we do it.
- Included in this set is the header of the picture itself, the 10 bytes that
- include the rectangle. Those bytes will be updated after the picture is
- written. }
- FailOSErr ( SetEOF (aRefNum, kPICTHeaderSize+SIZEOF (Picture) ) );
- FailOSErr ( SetFPos (aRefNum, fsFromStart, kPICTHeaderSize+SIZEOF (Picture) ) );
-
- { The file is all set up to go. We now want to replace the QuickDraw bottleneck
- and create the actual Picture data. }
- currDevice := GetGDevice; { save off current one. }
- GetPort (currPort);
-
- { If the write of the picture header fails, we want to dispose the handle allocated. }
- CatchFailures(fi, DeathWrite);
-
- { Move over to the offscreen port/device. }
- SetGDevice (fDrawingDevice); { set to ours for drawing in it. }
- picPort := GrafPtr (fDrawingPort); { the pointer to our port. }
- SetPort (picPort); { set there to do pict saving. }
-
- { Save the pointer to the current CGrafProcs }
- oldProcs := thePort^.grafProcs;
-
- { Set our GrafProc record up to have the standard pieces. }
- SetStdCProcs(newGrafs);
-
- { Change the port to use those GrafProcs instead. }
- thePort^.grafProcs := @newGrafs;
-
- { We are in our offscreen port. Change the GrafProc pointer for picture saving. }
- newGrafs.putPicProc := @PictWriter;
-
- { Tell PictWriter what file to write to, and start the pic size including the
- picture header. Start all the pieces off the right way. }
- gPictRefNum := aRefNum;
- gPictSize := SIZEOF(Picture);
- gPictError := noErr;
- gPictHandle := NIL;
-
- { Actually open the picture and do the CopyBits in order to process the picture.
- The data will be written by PictWriter as it is called by QuickDraw. }
- WITH picPort^ DO BEGIN
- gPictHandle := OpenPicture (portRect);
- ClipRect(portRect); { Make it a happier picture. }
-
- { copy all of the image to itself, in an open picture it saves the bits. }
- CopyBits (portBits, portBits, portRect, portRect, srcCopy, NIL);
-
- ClosePicture; { the picture is created, and packed. }
- END; { with picPort^ }
-
- { Now check for errors during the write operation. The gPictError field will be
- nonzero if we failed during the operation. }
- FailOSErr (gPictError);
-
- { Move back to front of file and write the valid picture info to file. }
- FailOSErr ( SetFPos (aRefNum, fsFromStart, kPICTHeaderSize) );
- recSize := SIZEOF(Picture);
- FailOSErr (FSWrite(aRefNum, recSize, Ptr(gPictHandle^)));
-
- { Done saving the data of the picture itself. Now set the GrafProcs back to normal. }
- thePort^.grafProcs := oldProcs;
-
- { Dispose the pict handle, we didn't actually make anything there. }
- KillPicture (gPictHandle);
- gPictHandle := NIL;
-
- { Set the drawing device back where it belongs, in case of error, we get right device. }
- SetGDevice (currDevice); { set back to system for normal. }
- SetPort (currPort);
-
- { If we lived through it, clear error handler. }
- Success (fi);
- END; { TFracAppDocument.DoWrite }
-
-
- { The bottleneck routine to read the picture from the disk. This will read the
- data required, and pass it along to the unpacker. This makes it possible to
- avoid using any RAM for the actual reading part, as it is being played back
- into the offscreen device. Error handling is somewhat tricky, since we
- need to force the picture to finish, and there isn't a really good way to
- do this. The desired attempt here is to pass back a picture is finished
- opcode ($00FF) so we can get back to our code to handle the error. This is
- better than no error recovery, but is not guaranteed to work. }
- PROCEDURE PictReader (dPointer: Ptr; nextHunk: Integer);
-
- VAR longHunk: LongInt;
- I: Integer;
-
- BEGIN
- IF gPictError = noErr THEN BEGIN
- longHunk := nextHunk;
- gPictError := FSRead(gPictRefNum, longHunk, dPointer);
- END
- ELSE { handle the error situation by passing back $00FF as the data.? }
- FOR I := 1 to nextHunk DO BEGIN
- IF ODD (I) THEN dPointer^ := $00
- ELSE dPointer^ := $FF;
- dPointer := PTR (ORD4(dPointer) + 1);
- END;
- END;
-
-
- { Routine to read the data from the data fork of the file into our document so it
- can be displayed. The quickdraw bottleneck will be replaced with the
- PictReader routine, making it read the data from the disk as the picture
- requests more data. This obviates the need for an extra handle that is
- used to play back the picture. This is done since that extra handle can
- be on the order of 100K, memory we may not have available. }
- PROCEDURE TFracAppDocument.DoRead(aRefNum: INTEGER; rsrcExists,
- forPrinting: BOOLEAN); OVERRIDE;
-
- VAR recSize: LongInt;
- fi: FailInfo;
- currDevice: GDHandle;
- currPort: GrafPtr;
- newGrafs: CQDProcs;
- oldProcs: QDProcsPtr; { bug in include files, CGrafPort has QDProcs *** }
-
- PROCEDURE DeathRead (error: OSErr; message: LONGINT);
- BEGIN
- IF gPictHandle <> NIL THEN KillPicture (gPictHandle);
- gPictHandle := NIL;
- END;
-
- BEGIN
- { The file is open already, we just have to read the data out of it. The first thing
- to read is the header we use to describe a fractal. If we get an error
- here we need to split since we should always have at least a header. The fractal
- header is the global state for the document. We just read it into the record
- and use it from there. }
- FailOSErr ( SetFPos (aRefNum, fsFromStart, 0) ); { starts at first byte of file. }
- recSize := SIZEOF (FracRecord); { size of header on fractal files. }
- FailOSErr ( FSRead (aRefNum, recSize, @fFracHeader) );
-
- { We have the header for the PICT file. Now we need to be sure that it is a fractal
- document, and not something we can't use. Check the header to be sure, and if
- not right, error out with a good alert message (using a standard MacApp errcode). }
- IF fFracHeader.fType <> kSignature THEN FailOSErr (errNotMyType);
-
- { We have the data from the header, go ahead and set up an offscreen world for this
- document, using the header rectangle. }
- BuildOffWorld (fFracHeader.calcRect);
-
- { Make sure the file position is right at the start of the picture in the file. }
- FailOSErr ( SetFPos (aRefNum, fsFromStart, kPICTHeaderSize) );
-
- { Allocate a small handle that will be used as the Pict handle for drawing from
- the disk. This is just the picture header. }
- gPictHandle := PicHandle (NewHandle (SIZEOF(Picture)));
- FailNil (gPictHandle);
-
- { If the read of the picture header fails, we want to dispose the handle allocated. }
- CatchFailures(fi, DeathRead);
-
- { Tell PictReader what file to read from. }
- gPictRefNum := aRefNum;
- gPictError := noErr;
-
- { Now fill in the picture header itself, using the data from the disk. }
- recSize := SIZEOF(Picture);
- gPictError := FSRead(aRefNum, recSize, Ptr (gPictHandle^));
- FailOSErr (gPictError);
-
- { That is the only call we can’t recover from immediately, the rest of the
- routine is not easy to recover from, so we won’t go through DeathRead. }
- Success (fi);
-
- { The file position is right at the beginning of the picture data, so we can just
- install the bottleneck and call DrawPicture to fill our offscreen gDevice
- with the data that was saved. Set to that port and gDevice for playback. }
- currDevice := GetGDevice; { save current to get back. }
- GetPort (currPort);
-
- SetGDevice (fDrawingDevice);
- SetPort (GrafPtr(fDrawingPort));
-
- { Save the pointer to the current CGrafProcs }
- oldProcs := thePort^.grafProcs;
-
- { Set our GrafProc record up to have the standard pieces. }
- SetStdCProcs(newGrafs);
-
- { Change the port to use those GrafProcs instead. }
- thePort^.grafProcs := @newGrafs;
-
- { We are in our offscreen port. Change the GrafProc pointer for picture reading. }
- newGrafs.getPicProc := @PictReader;
-
- { Now we have the buffer and the offscreen port. We can draw the picture that
- will be read out of the file into this port in order to init the port for later use in
- updating the window. We are already set to draw in the offscreen port. Do the
- DrawPicture to have PictReader read the data out of the file while it is being
- played into the offscreen Port. }
- DrawPicture(gPictHandle, gPictHandle^^.picFrame);
-
- { Done reading the data of the picture itself. Now set the GrafProcs back to normal. }
- thePort^.grafProcs := oldProcs;
-
- { Bag the handle we made for playing back the picture. }
- KillPicture (gPictHandle);
- gPictHandle := NIL;
-
- { Set back to the normal drawing environment. }
- SetGDevice (currDevice);
- SetPort (currPort);
-
- { If we had an error while reading the data, we must error out. }
- FailOSErr (gPictError);
- END; { TFracAppDocument.DoRead }
-
-
- { This is typically used in a Revert case which is not really meaningful here, but
- the structure is the same so we use it anyway. Frees the data associated with
- a document, that is strictly program data, not MacApp data. }
- PROCEDURE TFracAppDocument.FreeData; OVERRIDE;
-
- BEGIN
- { Kill the bits for the offscreen bitMap if they were allocated. }
- IF fBigBuff <> NIL THEN DisposPtr (fBigBuff);
- { Close the port: remove from portList, kill visRgn and clipRgn, kill the penPixPat
- and fill PixPat and back PixPat, kill PixMap handle, kill grafVars handle. }
- IF fDrawingPort <> NIL THEN BEGIN
- CloseCPort (fDrawingPort);
- DisposPtr (Ptr (fDrawingPort) );
- END;
- { DisposGDevice does: kills the ITable, kills Cursor expanded data and mask if
- nonzero, calls DisposPixMap if gdPMap is nonzero, then disposes the gDevice
- handle itself. DisposPixMap kills the colorTable and the pixMap record. }
- IF fDrawingDevice <> NIL THEN DisposGDevice (fDrawingDevice);
- END; { TFracAppDocument.FreeData }
-
-
- { Free method for the documents themselves. We need to override so that we
- can throw away the data object that was read in from the disk if it exists.
- Also chuck the gDevice and port used for the document data. }
- PROCEDURE TFracAppDocument.Free; OVERRIDE;
-
- BEGIN
- FreeData;
-
- INHERITED Free;
- END; { TFracAppDocument.Free }
-
-
- { The procedure to do the idle time processing in the document. This will do the
- entire fractal calculation so as to be able to do it in the background. It
- does it one pixel at a time to avoid any hit on performance for the
- foreground application. This is called in response to the DoIdle for the
- application. The fIdlePriority is not set for this method, so it won't get
- time except when the application calls specifically. It is done this way
- since otherwise the target chain would need to have each document in
- the list, which is not desireable for other event handling. Notably the
- time keeper in here is not too accurate. Each pixel takes less than a
- tick to calculate, making it a bit tougher. A way to make it more
- accurate would be to figure out the maximum time for a full black
- document, and divide by the number of pixels in the screen and the
- number of loops. That number (in microseconds) could be added each
- time through the calculation loop to give a more accurate timestamp.
- This would be wrong if the clock changes, so perhaps it should use the
- low memory TimeDBRA value as units instead.
- This is left as an exercise for the reader. }
- PROCEDURE TFracAppDocument.CalcCity;
-
- CONST M = 100; { this decides what 'infinity' is. If value less than this, loop. }
- K = kNumColors; { number of colors to choose from. Also iterations times. This
- is 195 to match the clut created for it. }
- BlackPen = 255; { entry in our modified color table for black. }
-
- VAR currTime: LongInt; { temp var for time check. }
-
- x,y,x1,y1: Extended; { for interim values of current point. }
- Po,Qo: Extended;
-
- kol: Integer; { color we are currently on. }
- r: Extended; { 'distance' from root. }
- currDevice: GDHandle; { current gDevice handle, so we can get back there. }
- currPort: GrafPtr;
- drawRect: Rect; { for updating the screen as we calculate. }
-
- BEGIN
- { Calculate the fractal as we go. Do next pixel here, based on the state saved
- in the document object. When done, the variables are updated to go to the
- next location to do. It sets the pixel in the offscreen port to be whatever
- we calculate it to be. The buffer will be copied to the screen at update time.
- The global state is saved in the FracHeader record in the document object.
- That state is saved across the use of a document, so it will always be right. }
-
- { If we are done, or not started, we can split. }
- IF fFracHeader.done THEN Exit(CalcCity);
-
- currDevice := GetGDevice; { save off current one. }
- GetPort (currPort);
-
- SetGDevice (fDrawingDevice); { set to ours for drawing in it. }
- SetPort (GrafPtr(fDrawingPort)); { draw in offscreen guy. }
-
- { Now do the calculation to determine the color of the pixel at the
- current location. Uses the header saved state. }
-
- With fFracHeader DO BEGIN
- (* x := realMin + curCol * deltaP; { Use these for a Julia set calculation. }
- y := imagMin + curRow * deltaQ;
- kol := 0;
- Po := -0.39054;
- Qo := 0.58679;
- *)
- Po := realMin + curCol * deltaP; { next starting point }
- Qo := imagMin + curRow * deltaQ;
- kol := 0;
- x := 0; { Mandel set starts with 0 always. }
- y := 0; { For Julia set you start with previous number. }
- END; { With }
-
- REPEAT
- { the following is for y = X^2 + C for imaginary numbers.
- pt1 = x + yi, C = Po + Qoi, in pt2 := pt1^2 + C }
-
- x1 := x*x - y*y + Po;
- y1 :=2*x*y + Qo;
-
- kol := kol + 1;
- x := x1; y := y1;
-
- r := x1*x1 + y1*y1;
- UNTIL (r > M) OR (kol > K); { Until 'distance' > our infinity, or out of colors. }
-
- IF kol <= K THEN { r must be > M. }
- fDrawingPort^.fgColor := kol { set the color }
- ELSE { must be kol > K, ran out of colors. }
- fDrawingPort^.fgColor := BlackPen;
-
- { Move to the pixel we calculated for, then draw the pixel in right color. This
- could be done by setting the bytes in pixel map directly, since we own the
- PixMap and the buffer. }
- MoveTo (fFracHeader.curCol, fFracHeader.curRow);
- Line (0,0); { draw that 'pixel' in the right color }
-
-
- { up the counters to the next pixel location to do. }
- WITH fFracHeader DO BEGIN
- curCol := curCol + 1; { up the column count. }
- drawRect := thePort^.portRect; { in case we finished a line. }
- IF curCol >= plotWidth THEN BEGIN { did we run off end of row? }
- { Have the line just calculated drawn to window. }
- drawRect.top := curRow;
- drawRect.bottom := curRow+1;
-
- curCol := 0; { start on the next row. }
- curRow := curRow + 1; { and up the counter of the next row to do. }
- END; { start at next row. }
-
- END; { with fFracHeader }
-
- { Check if we are done, and if so, set the flag to stop calculations. Set the
- elapsed time counter in the header. }
- IF fFracHeader.curRow >= fFracHeader.plotHeight THEN BEGIN
- fFracHeader.done := TRUE;
- GetDateTime(currTime);
- fFracHeader.elapsedTime := currTime - fStartTime;
- END;
-
- IF NOT EqualRect (thePort^.portRect, drawRect) THEN
- fFracAppView.InvalidRect (drawRect);
-
- SetGDevice (currDevice); { set back to main for normal drawing. }
- SetPort (currPort);
-
- { Now we have changed another point in the document. We need to mark it as
- changed so we can save the document. }
- fChangeCount := fChangeCount + 1;
-
- END; { TFracAppDocument.DoIdle }
-
-
- {------------------------------- View -------------------------------}
-
- { Initialize the view, basically set up the view object and clear the selection. }
- PROCEDURE TFracAppView.IFracAppView (itsDocument: TFracAppDocument;
- sizeOfView: Rect);
-
- BEGIN
- fSelectionRect := gZeroRect; { no selection to start with. }
- fFracAppDocument := itsDocument; { save off parent document for convenience. }
-
- { This view will be the full size of the screen since we have an offscreen
- bitMap as the view. This will be clipped to fit the frame of the window.
- There is no parent view, and the horizontal and vertical are fixed. The
- selection is to be shown, and is initially off. }
- IView(NIL, itsDocument, sizeOfView, sizeFixed, sizeFixed, TRUE, hlOff);
-
- END; { TFracAppView.IFracAppView }
-
-
- { We are going to map our full blown fractal into a sub universe with lesser
- colors. We need to do a linear map of the indices we get to whatever
- is in the color table. This will make zebra fractals. This mapping
- is only done for devices that don’t have enough colors to handle our
- normal fractals. }
-
- FUNCTION SearchLips(VAR RGB: RGBColor; VAR result: LongInt) : Boolean;
-
- VAR I: Integer;
- theIndex: Integer;
-
- BEGIN
- SearchLips := True; { always say we hit. }
-
- { Start the map by finding the input color in the offscreen color table. Using
- the global color table makes it easy to get the right colors. }
-
- FOR I := 0 to gOurColors^^.ctSize DO
- IF (gOurColors^^.ctTable[I].rgb.red = RGB.red) &
- (gOurColors^^.ctTable [I].rgb.green = RGB.green) &
- (gOurColors^^.ctTable [I].rgb.blue = RGB.blue) THEN BEGIN
- theIndex := I;
- Leave; { Skip out of the loop, we found it. }
- END; { Found index in offscreen table that is the input color. }
-
- { Now theIndex has the index value corresponding to the color we are trying to
- match. Perform the MOD operation on it to get into the range needed for
- the current gDevice. (If you do a DIV instead, you will get a picture without
- bands, but with the available colors mapped across the range nicely instead.
- Multiple bands will be one color.)
- This MOD uses ctSize+1 since ctSize is a zero-based number, and the MOD
- needs to be for the number of actual colors available. }
- result := theIndex MOD (GetGDevice^^.gdPMap^^.pmTable^^.ctSize+1);
-
- END; { SearchLips }
-
-
- { Our routine to do the drawing of the fractal. This is the display routine
- to take the data out of the offscreen buffer and whip it up to the window,
- as the current view. The fractal is full screen size, clips without
- scaling into the window. It draws to any device connected to the machine
- and uses fast updates or search procs where needed, for the enough colors
- or not enough colors cases. }
- PROCEDURE TFracAppView.Draw(area: Rect); OVERRIDE;
-
- PROCEDURE SetUp (curGar: TGarDevice);
-
- BEGIN
- curGar.SetUpColorMap;
- END;
-
- PROCEDURE Remove (curGar: TGarDevice);
-
- BEGIN
- curGar.RemoveColorMap;
- END;
-
-
- BEGIN
- { Make the ctSeed of both the source gDevice and destination match so there is no
- remapping of the colors that we are using. The colors are close enough together
- that even 5 bit resolution provided for the mapping procedure is not sufficient.
- The primary reason to do this is to make the blitting faster, since no color
- mapping is done. This gives the fastest updates possible, since color quickdraw
- does no color mapping, it just moves bytes. This will only work properly if we
- have enough colors to do it. If we don’t have enough, we will set up the color
- search procs to do the mapping required. We will also watch the ctSeed of the
- device to see if we need to set our colors. If the ctSeed changes, the color
- table changed, so we need to reset our colors useage. In order to do this for
- each gDevice we will use our TList to make it easy. We also save the current
- seed for each device before we update to them, then restore that seed after
- the drawing. This makes the drawing fast still, but is a more mellow use of the
- ctSeeds. }
-
- gGarList.Each (SetUp);
-
- CopyBits ( GrafPtr(fFracAppDocument.fDrawingPort)^.portBits,
- thePort^.portBits, area, area, srcCopy, Nil);
-
- gGarList.Each (Remove);
- END; { TFracAppView.Draw }
-
-
- { Handle the menu choice for New Fractal out of the Fractal Menu. This makes a new
- Fractal based on the current selection. It does it by calling on the application
- object to make a new document. The communication to the DoInitialState is
- through the global variables. }
- FUNCTION TFracAppView.DoMenuCommand(aCmdNumber: CmdNumber): TCommand; OVERRIDE;
-
- VAR oldDeltaP,
- oldDeltaQ,
- oldRealMin,
- oldImagMin: Extended; { for figuring new fractal area. }
-
- BEGIN
- { Assume that we have no command to return, since none of our commands currently
- change the document. }
- DoMenuCommand := gNoChanges; { no command object returned. }
-
- { Case off on the various menus. Currently we have the new fractal item.
- Any out of that list are handled by Mr. MacApp and we pass it on. }
- CASE aCmdNumber OF
-
- kNewFractal:
- { If the option chosen was the New Fractal item, then we need to start
- up a fresh one based on the selection rectangle. This new fractal is
- based on parts of the old one, since it is
- a zoom in operation. We make a new document/window/view
- as if it were a New operation. We then change the fields we need to in
- that document to make it start calculating based on the selection from
- the current view. }
-
- BEGIN
- { Make a new document and initialize it to the base state. If we fail in
- opening it, we won't return here, the failure handler will kill it. We
- have nothing else to dispose of, so we don't make a CatchSignals here.
- This will come out of permanent memory. The aCmdNumber is so that
- the new document knows it came from a zoom in operation. Since this
- is somewhat funky, we communicate to the other part of the program
- with the global variables. If nonzero, the code that makes a
- new document will know to use these numbers in order to do the zoom.
- This is less than completely desireable, but there are no good places
- to override in order to get both the selection rectangle and the new
- document objects. }
-
- { The basic fractal has been set up. We now need to change the calculation
- area based on the current selection, in order to effect the zoom in. }
- WITH fFracAppDocument.fFracHeader DO BEGIN
- oldDeltaP := deltaP; { from SELF, the old document. }
- oldDeltaQ := deltaQ;
- oldRealMin := realMin;
- oldImagMin := imagMin;
- END;
-
- { calculate new min/max for real and imaginary parts based on how far
- into the old fractal plane we were. This is an extended calculation
- since our plane is in extendeds. We get the new locations of min and
- max, and save them off. We reset the deltaP or Q with SetUpConstants,
- in order to force a 1:1 ratio, but we need all sides to determine
- which one to force. }
- gRealMin := oldRealMin + oldDeltaP * fSelectionRect.left;
- gImagMin := oldImagMin + oldDeltaQ * fSelectionRect.top;
- gRealMax := oldRealMin + oldDeltaP * fSelectionRect.right;
- gImagMax := oldImagMin + oldDeltaQ * fSelectionRect.bottom;
-
- gApplication.OpenNew (aCmdNumber);
- END;
-
- OTHERWISE
- DoMenuCommand := INHERITED DoMenuCommand (aCmdNumber); { next guy in chain. }
- END; { CASE on aCmdNumber }
-
- END; { TFracAppView.DoMenuCommand }
-
-
- { Set up the New Fractal menus choice in Fractal Menu, based on selection. }
- PROCEDURE TFracAppView.DoSetupMenus; OVERRIDE;
-
- BEGIN
- INHERITED DoSetupMenus; { Do mainline stuff first. }
-
- { If we have a non-zero selection, then we can enable the menu item to use
- it as the new fractal dimensions for this document. }
- Enable (kNewFractal, NOT EmptyRect (fSelectionRect));
- END; { TFracAppView.DoSetupMenus }
-
-
- { The way to handle mouse events in the content region of the view. This will
- pass back the command object to handle tracking the mouse and creating a
- new selection in preparation for making a new fractal. }
- FUNCTION TFracAppView.DoMouseCommand(VAR downLocalPoint: Point;
- VAR info: EventInfo; VAR hysteresis: Point): TCommand; OVERRIDE;
-
- VAR tracker: TAreaSelector;
-
- BEGIN
- New(tracker); { make a new command object. }
- FailNIL(tracker); { no memory, trash out. }
- tracker.IAreaSelector(SELF, downLocalPoint); { Initialize the command object. }
- DoMouseCommand := tracker; { return it for later use. }
- END; { TFracAppView.DoMouseCommand }
-
-
- { Highlight the current selection rectangle if there is one. This is drawn in scrCopy
- mode to make it stand out better when it is a final selection. XOR is used for
- the rubberband, until mouseUp. }
- PROCEDURE TFracAppView.DoHighLightSelection(fromHL, toHL: HLState); OVERRIDE;
-
- VAR selPatHandle: PatHandle;
-
- BEGIN
- IF toHL = hlOn THEN BEGIN
- selPatHandle := GetPattern(kSelPattern); { get the pattern we use. }
- IF selPatHandle <> NIL THEN { If pattern available, use it. }
- PenPat (selPatHandle^^); { set pen pattern to our selection kind. }
- PenMode(srcCopy); { copy mode on pattern selection. }
-
- { We have a selection, so go ahead and draw the selection rectangle. }
- FrameRect (fSelectionRect); { outline the frame of selection. }
- END; { highlight turned on. }
-
- { Turning off the highlight, we need to remove the traces of the selection.
- To do this, redraw that rectangle. }
- IF toHL = hlOff THEN Draw (fSelectionRect); { ReDraw it to clear selection. }
- END; { TFracAppView.DoHighlightSelection }
-
-
- {------------------------------- Command -------------------------------}
-
- { Initialize the selector object itself. Sets up the normal fields. }
- PROCEDURE TAreaSelector.IAreaSelector(ownerView: TFracAppView; startPt: Point);
-
- BEGIN
- ICommand(cMouseCommand); { initialize normal parts of command }
-
- fCausesChange := FALSE; { just selection, not changing document. }
- fCanUndo := FALSE; { therefore, no Undo of no change. }
- fConstrainsMouse := TRUE; { do the constrain to match to screen. }
- fOwnerView := ownerView; { save the view for use in tracking. }
- END; { TAreaSelector.IAreaSelector }
-
-
- { Track the mouse while the button is down. This is overridden so we can leave
- the command object as not having changed, ie. so we can pass back the
- gNoChanges as the last step since this is not an undoable operation. It
- doesn't change the view, so we don't need to DoIt or Commit. }
- FUNCTION TAreaSelector.TrackMouse(aTrackPhase: TrackPhase;
- VAR anchorPoint, previousPoint, nextPoint: Point;
- mouseDidMove: BOOLEAN): TCommand; OVERRIDE;
-
- VAR selPatHandle: PatHandle;
-
- BEGIN
- TrackMouse := SELF; { Assume we are not in release phase. }
-
- CASE aTrackPhase OF
- trackPress:
- BEGIN
- fOwnerView.DoHighLightSelection (hlOn, hlOff); { turn off old selection if any. }
- fOwnerView.fSelectionRect := gZeroRect; { clear rect, there isn't one. }
- END;
-
- trackRelease:
- BEGIN
- Pt2Rect(anchorPoint, nextPoint, fOwnerView.fSelectionRect);
- fOwnerView.DoHighlightSelection (hlOff, hlOn); { leave on selection. }
- TrackMouse := gNoChanges;
- END;
- END; { Case on aTrackPhase }
- END; { TAreaSelector.TrackMouse }
-
-
- { Track the mouse giving the feedback of a different rectangle kind. This is so
- we can use the selection pattern to give a preferred rectangle. The selection
- pattern comes out of temporary memory so as to not fail needlessly. }
- PROCEDURE TAreaSelector.TrackFeedback(anchorPoint, nextPoint: Point;
- turnItOn, mouseDidMove: BOOLEAN); OVERRIDE;
-
- VAR selBoy: Rect;
- selPatHandle: PatHandle;
-
- BEGIN
- IF mouseDidMove THEN
- BEGIN {the pen is already in patXOR mode, black, one wide}
- selPatHandle := GetPattern(kSelPattern); { get the pattern we use. }
- IF selPatHandle <> NIL THEN { use our pattern if available. }
- PenPat (selPatHandle^^); { set pen pattern to our selection kind. }
-
- Pt2Rect(anchorPoint, nextPoint, selBoy);
- FrameRect(selBoy);
- END;
- END; { TAreaSelector.TrackFeedback }
-
-
- { Constrain the mouse to a rectangle that is the same proportion as the screen, so
- we can make the selection match better without having to guess at the length
- or width, or scaling the chosen rect to fit the screen. Small piece chosen will
- blow up to fit easily. This will make it easier to choose a selection that
- gives a 1:1 aspect ratio. This also chooses which direction the mouse has
- moved, deciding which is larger in order to decide the direction to constrain. }
- PROCEDURE TAreaSelector.TrackConstrain(anchorPoint, previousPoint: Point;
- VAR nextPoint: Point); OVERRIDE;
-
- VAR newWidth, newHeight: LongInt;
- mouseRatio, plotRatio: Real;
- constrainRect: Rect;
-
- PROCEDURE ChangeWidth;
- BEGIN
- WITH fOwnerView.fFracAppDocument.fFracHeader DO BEGIN
- { Get the new width as a positive number, a displacement that is constrained. }
- newWidth := ABS (nextPoint.v - anchorPoint.v) * plotWidth DIV plotHeight;
- { Decide which quadrant we are in, moving the right direction. }
- IF nextPoint.h < anchorPoint.h THEN newWidth := -newWidth;
- { Actually change the final point to pass back. }
- nextPoint.h := anchorPoint.h + newWidth; { add offset to get new pt. }
- END;
- END;
-
- PROCEDURE ChangeHeight;
- BEGIN
- WITH fOwnerView.fFracAppDocument.fFracHeader DO BEGIN
- newHeight := ABS (nextPoint.h - anchorPoint.h) * plotHeight DIV plotWidth;
- IF nextPoint.v < anchorPoint.v THEN newHeight := -newHeight;
- nextPoint.v := anchorPoint.v + newHeight; { add offset to get new pt. }
- END;
- END;
-
- PROCEDURE PinPoint; { Pin the rectangle to the edge of the document. }
- BEGIN
- WITH fOwnerView.fFracAppDocument.fFracHeader DO BEGIN
- SetRect(constrainRect, 0, 0, plotWidth, plotHeight);
- nextPoint := Point (PinRect(constrainRect, nextPoint));
- END;
- END;
-
- BEGIN
- WITH fOwnerView.fFracAppDocument.fFracHeader DO BEGIN
- mouseRatio := ABS ((nextPoint.h - anchorPoint.h)/(nextPoint.v - anchorPoint.v));
- plotRatio := plotWidth/plotHeight;
-
- { The deltaX, deltaY can be thought of as a rect too. If the ratio of sides on
- that rect (width/height) is greater than the ratio of width/height of the
- plot rectangle, then we need to grow the height of the rect. If it is less,
- we need to grow the width. This is a ratio of sides to decide which way
- to grow. We grow to make the new rect still touch the mouse position.
- It can be thought of as the rectangle being thicker than tall wanting to
- grow the tall part in a constrained way, and the corollary for the width. }
- IF mouseRatio > plotRatio THEN BEGIN { constrain height to new value. }
- ChangeHeight;
- PinPoint;
- ChangeWidth;
- END
- ELSE BEGIN { constrain width to new value. }
- ChangeWidth;
- PinPoint;
- ChangeHeight;
- END;
- END; { With }
- END; { TAreaSelector.TrackConstrain }
-
-
- {------------------------------- GarDevice -------------------------------}
-
- { A routine to initialize all the GarDevice objects desired for the system. This
- takes the info passed in and sets up the GarDevice object the right way. It
- also adds it to the gGarList TList. }
-
- PROCEDURE TGarDevice.IGarDevice (OwnerGDevice: GDHandle);
-
- BEGIN
- fDevice := OwnerGDevice; { Init the fields to keep track of device. }
- fColorTable := NIL;
- fOldSeed := 0;
- gGarList.InsertLast (SELF); { Add this guy into the TList. }
- END;
-
-
- { A routine to pound the color table to be ours if there are enough colors available.
- This will use the clut resource used for documents to set up the color table to
- our nice prechosen set of colors. If there aren't enough colors available to do
- the full job, we leave it alone, and let the Palette Manager do his thing. Error
- handling here is done in a simple fashion. If we have errors, we leave the
- fColorTable = NIL so that we don’t change the colors. We won’t pass back
- an alert since it would be confusing and we don’t have a good thing to say.
- On the SetEntries and protection, we
- don’t check errors since they can only cause strange colors to be displayed,
- not a crash, and it is unclear how to handle errors there without being
- too obtuse. }
- PROCEDURE TGarDevice.PoundColors;
-
- VAR offColorTable: CTabHandle;
- I: Integer;
- Erry: OSErr;
- currDevice: GDHandle;
- LocalColors: CTabHandle;
-
- BEGIN
- IF fColorTable <> NIL THEN DisposCTable (fColorTable);
- fColorTable := NIL;
-
- LocalColors := fDevice^^.gdPMap^^.pmTable; { for convenient use. }
-
- { If we have enough colors on this device, we can do our strangeness. }
- IF LocalColors^^.ctSize > kNumColors THEN BEGIN
-
- { Save a copy of the system color table in our object. This table will be used when
- we need to restore the color table upon exit. If there aren't enough colors for
- our funny business we have the handle to NIL to imply that we didn't change it. }
- offColorTable := LocalColors;
- Erry := HandToHand (Handle (offColorTable)); { copy it so we don’t use actual system handle. }
- IF Erry <> noErr THEN Exit (PoundColors); { If it couldn’t be done, exit with NIL. }
-
- fColorTable := offColorTable; { Save it off into the GarDevice object. }
-
- currDevice := GetGDevice; { Save current state. }
-
- { Set to the current GarDevice }
- SetGDevice(fDevice);
-
- { We now need to set up the color table in the system to be the way we want it,
- so we can avoid problems with programs that use the Palette Manager. This
- involves reserving all of the colors we use so that they won’t be used by any
- other program (including the Menu Manager for the Apple), and protecting the
- entries so they cannot be changed by the Palette Manager or other programs.
- Before doing that we need to save the state of the world so we can put it
- back when done or switched out. We will use the global color table that
- matches all the documents. }
- { SetEntries is zero based, so we actually set kNumColors+1, and so starting
- with 0 makes us do the right number of entries. The CSpecArray we have
- to pass is also conveniently starting at zero, which is why it is done this way. }
- SetEntries(0, kNumColors+kNumPalette, gOurColors^^.ctTable);
-
- For I := 1 to kNumColors DO
- ReserveEntry (I, TRUE); { No one should use our animating colors. }
-
- { We changed the ctSeed now, so we need to save it off, so we know when the
- color table has changed for real. }
- fOldSeed := LocalColors^^.ctSeed;
-
- { Set back to where we started from. }
- SetGDevice(currDevice);
-
- { If we changed the main device, redraw the menu bar to make colors right. }
- IF fDevice = GetMainDevice THEN DrawMenuBar;
-
- END; { enough colors to make it worthwhile. }
- END; { PoundColors }
-
-
- { When we leave we need to restore the color table to its pristine form. This is
- only done if we have changed the color table to our fancy set of colors. We use
- the fColorTable handle as a boolean as well. If it is NIL, we didn't have a
- saved color table to restore. This routine will be called for each GarDevice in
- the TList. Any errors that are run into here are ignored, since it is too late
- to fix them. They will not be catastrophic, and in the worst case will munge
- up the colors in the color table as we exit. Since we have the temporary
- memory available we should never have any error here in the first place. }
- PROCEDURE TGarDevice.UnPoundColors;
-
- VAR I: Integer;
- currDevice: GDHandle;
-
- BEGIN
- { If we still have enough colors on this gDevice, we can restore the color table. }
- IF fColorTable <> NIL THEN BEGIN
-
- { Save off the current device state. }
- currDevice := GetGDevice;
-
- { Set us to be on that gDevice. }
- SetGDevice(fDevice);
-
- { Set the color table back to what it was before we came in and took over. This
- means setting the colors back to those we started with, and setting the
- useage back to normal. }
- For I := 1 to kNumColors DO
- ReserveEntry (I, FALSE);
-
- { and reset the color table to the colors that the system was using. }
- SetEntries(0, kNumColors+kNumPalette, fColorTable^^.ctTable);
-
- { Set back to the device we started on. }
- SetGDevice(currDevice);
-
- END; { Had some colors to restore. }
- END; { UnPoundColors }
-
-
- { If there are enough colors on this GarDevice and the check mark was set, we must
- rotate them colors around. If this GarDevice has enough colors we do it,
- otherwise we skip it. If we have an error while trying to do this, we want to
- just skip it, since it is noncritical to the program. If we use the normal
- error handler we will end up giving an alert each time this is called which
- is too many. In addition, we will use temporary memory for the allocations,
- so it is virtually impossible for the memory allocations to fail here. The
- memory used is returned at the end of the routine, so it is temporary. }
- PROCEDURE TGarDevice.RotateColors;
-
- VAR newCTable: CTabHandle;
- lastCSpec: ColorSpec;
- I: Integer;
- Erry: OSErr;
- currDevice: GDHandle;
- LocalColors: CTabHandle;
- fi: FailInfo;
-
- { If we had a memory problem during Rotation we need to exit, setting things
- back to normal. We also clear the Rotation flag, to avoid being called again.
- In order to give a better error message in the alert, we pass our own string
- description as the message field. This will look up the STR# in our resource
- list to use as the message. }
- PROCEDURE DeathRotate (error: OSErr; message: LONGINT);
-
- BEGIN
- IF newCTable <> NIL THEN DisposCTable(newCTable);
- SetGDevice (currDevice); { Set device back to main, just in case. }
- gRotateOn := FALSE; { Turn rotation off. }
- Failure (error, kBadRotate); { give the right error string. }
- END;
-
-
- BEGIN
- { Get handle to color table so we don't have to use With statements, but still have
- it dereferenced more effectively. }
- LocalColors := fDevice^^.gdPMap^^.pmTable;
-
- { Check the seed for this device and be sure it matches what we have saved.
- When the color depth is changed with an FKEY or by some other code behind
- our back, we get the chance to rotate the colors around, before we handle
- the update event. In any case, for safety, we want to avoid rotating if the
- color table has changed since we last looked at it. }
- IF fOldSeed <> LocalColors^^.ctSeed THEN Exit (RotateColors);
-
- { See if we have enough colors on the current device to do, do nothing if not. }
- IF LocalColors^^.ctSize > kNumColors THEN BEGIN
-
- currDevice := GetGDevice; { Save current gDevice. }
- SetGDevice(fDevice); { Set to our current Gar.}
-
- CatchFailures(fi, DeathRotate); { any failures, must be cleaned up. }
-
- { Get this device’s color table and copy it temporarily. If not enough memory
- just skip out since it is not catastrophic. }
- newCTable := LocalColors; { Handle to this CTable. }
- Erry := HandToHand (Handle(newCTable)); { Make copy of it. }
- IF Erry <> noErr THEN newCTable := NIL; { on error, we should skip dispose. }
- FailOSErr (Erry); { If we had an error, exit. }
-
- { Move the colors we are going to use down to the zero position so it is easy
- to use SetEntries. We are trashing the color table, but it is a copy. }
- lastCSpec := newCTable^^.ctTable[1]; { pull first one off. }
- BlockMove (@newCTable^^.ctTable[2], @newCTable^^.ctTable[1],
- (kNumColors) * SIZEOF (ColorSpec) ); { copy all one entry down. }
- newCTable^^.ctTable[kNumColors] := lastCSpec; { put last color back on front. }
-
- { Change the color table to new position. }
- SetEntries (0, kNumColors, newCTable^^.ctTable);
- FailOSErr (QDError);
-
- DisposCTable(newCTable);
-
- { Save the new seed, since we changed it. }
- fOldSeed := LocalColors^^.ctSeed;
-
- SetGDevice(currDevice); { Set back to start. }
-
- Success (fi);
- END; { enough colors on device to rotate. }
- END; { RotateColors }
-
-
- { The routine to set up for the CopyBits by changing the color table if needed, and
- to make the ctSeeds match for fast updates where possible, and to install the
- color search procs on devices where we don't have enough color. Called for
- each GarDevice in our TList. Save off the devices' seed value so we can put
- it back after our update. }
- PROCEDURE TGarDevice.SetUpColorMap;
-
- VAR currDevice: GDHandle;
- LocalColors: CTabHandle;
-
- BEGIN
- currDevice := GetGDevice; { Save current device. }
- SetGDevice (fDevice); { Set to this gDevice. }
-
- LocalColors := fDevice^^.gdPMap^^.pmTable; { Handle to color table. }
-
- { Check if the color environment changed on this device, and if so, pound
- our colors into place there. This handles changes in depth when we are
- not switched out (FKEYs). }
- IF (fOldSeed <> LocalColors^^.ctSeed) AND NOT gBackGround THEN
- PoundColors;
-
- { During the update process we want to be as fast as possible, so for the
- CopyBits we want the ctSeeds to match. This will save the current seed
- and restore it when we are done CopyBitsing. }
- fDrawSeed := LocalColors^^.ctSeed;
-
- { If we have enough colors on this device, then make the seeds match so we
- have a high speed update. If there isn't enough colors, then set up the search
- proc so we get the happy MOD color mapping on this device. If we have enough
- colors do the slightly naughty operation of changing the devices' seed to
- match all the documents. This is only done in order to make fast updates on
- devices that have enough colors. }
- IF LocalColors^^.ctSize > kNumColors THEN
- LocalColors^^.ctSeed := gOurColors^^.ctSeed
- ELSE
- AddSearch (@SearchLips); { Add our search proc to that device. }
-
- SetGDevice (currDevice); { Set back to starting device. }
- END; { SetUpColorMap }
-
-
- { A routine applied to each GarDevice to remove any color search procs we installed,
- and restore any seeds we may have changed in order to be speedy. }
- PROCEDURE TGarDevice.RemoveColorMap;
-
- VAR currDevice: GDHandle;
-
- BEGIN
- currDevice := GetGDevice; { Save current device. }
- SetGDevice (fDevice); { Set to this gDevice. }
-
- { If there were, restore the seed on the device to what color QD wants it to be.
- If there were not enough colors on this device, remove the color mapping proc. }
- WITH fDevice^^.gdPMap^^.pmTable^^ DO
- IF ctSize > kNumColors THEN
- ctSeed := fDrawSeed { restore the seed value. }
- ELSE
- DelSearch (@SearchLips); { Remove our special color mapper. }
-
- SetGDevice (currDevice); { Set back to starting device. }
- END; { RemoveColorMap }
-
-
- {$POP} { Restore the compiler state. }
-