Printing Hilbert Graphs

By Mark McBride, Contributing Editor, Oxford, OH

After an extended absence from writing for MacTutor, I have found time to develop new articles using Fortran on the Mac. The absence arose from developing of an educational application in LightSpeed Pascal for use in my 400 level college course. If only Fortran could have that type of development environment, I might never have switched to Pascal for start from scratch Mac applications. A final release version of that educational project should be finished by the summer (i.e., real soon now!). In the meantime, Microsoft released version 2.2 in the Fall of 1986 and other individuals picked up some of the slack (thanks for the article on controls in the April 1987 issue). This month’s article provides errata for Version 2.2, an overview of an “Extras” disk available from Absoft, and a small application which illustrates using the Print Manager, pictures, and procptr’s from within Fortran.

Extras Disk

Available from Absoft (the company which developed Microsoft Fortran for the Mac) is a disk call “Extras.” This disk contains additional example programs and subroutines that were not included in the Version 2.2 release. In particular the file contains:

gpsl: An alternative spool.sub which is compatible with the Laserwriter.

Macxrf: A Fortran source file cross referencer.

ctlprc: A method for using toolbox filter procedures, including a sample program using scroll bars.

splown: An additional, more flexible, interface to spool.sub. Three examples are provided.

prdrag: An example program for use of the prport.sub routine which allows calls to the Print Manager.

gpprnt: An example program of how to send a grafport to the printer.

scrdump: An example program of how to dump the current screen to the printer.

date: Assembly language routines for easy manipulation of the date and time records available with the Mac.

errata: Errata for the include files and toolbx.par files.

If you are interested in this disk contact Absoft Tech Support at (904) 423-7587. [Most of these files have been placed on the source code disk for this issue. I find it interesting that Microsoft never bothered to tell anyone about these errors, or correct them! -Ed] Several of the files are of interest for this month’s article. First, Listing 1 provides the errata for the include files. The last line of several of the include files mysteriously disappeared in the 2.2 release. Second, Listing 2 provides errors in the trap descriptors. These must be changed in both the toolbx.par file and the appropriate include files. One of these changes is for ‘HUnlock’ which is used in this month’s program. Listing 3 gives my modified version of the prdefs.inc file that provides definitions for the print record structures, used with the prprt.sub routine. Listing 4 gives the assembly code for the routine ctlprc.sub and the associated link file. This routine provides the “glue” to return a pointer to a Fortran procedure, which allows the use of filterprocs and control tracking procs. Discussion of the use of this routine is given below in the Hilbert graph program. In listing 5, is a little assembly routine to reset the randseed, since the Editor couldn’t find a copy of a5Glob.inc that is supposed to provide access to the quickdraw globals. Finally, in listings 6,7 and 8 is the actual Hilbert program for this month!

Fig. 1 Our Fortran Program prints Hilbert Graphs on a Laser

Hilbert Graph Program

This month’s program illustrates several Mac user interface features in a Fortran program: use of the Print Manager via the subroutine prport.sub, use of filter procedures via the subroutine ctlprc.sub, use of dialogs with the default button, use of pictures, and the addition of color to your printed Imagewriter II output.

The printgraph program has four salient features:

1. initialization of the program structures including a random order hilbert curve in pict format and use of common variables for the toolbox structures.

2. a short event loop to detect menu selections and a subroutine to process the menu selection.

3. a print subroutine which prints the hilbert picture via a graphport which is also Laserwriter compatible.

4. use of a background procedure during printing which allows the user to cancel the print in progress

The first two processes are straight forward and/or have been covered extensively in other MacTutor articles. The Hilbert curve is drawn using an adaptation to Fortran of an algorithm presented by Michael Anderson (Byte, June 1986:137-148). The routine draws the curve once as a picture (OPENPICTURE, CLOSEPICTURE). This allows the program to quickly redraw the graph to any grafport (window or printer) by a call to DRAWPICTURE. Before the picture is drawn, the order, the color, and the linesize of the Hilbert curve are set randomly.

The structure of the printgraph program keeps most of the toolbox related variables accessible to all routines through a common block. The use of the common block substantially reduced the resulting source code, given the source code intensity of Fortran when using ‘implicit none.’ An additional advantage of the common block approach (at least for me) is the ability to keep variable declarations grouped and clear for the toolbox related variables. A disadvantage of the approach is that include files cannot contain include files, thus the toolbox .inc files must be listed for every subroutine. This has a tendency to increase the number of lines being compiled (and compile time). The source for the common block declarations is kept in a separate file which is then “included” in the main program and every subroutine which needs access to the global toolbox related variables.

Printing

MS Fortran supports printing by two basic methods. The first is through standard Fortran output device methods (unit=6) and the routine spool.sub (or the laser compatible version available on the ‘Extras’ disk). The second is implementation of the Mac’s Print Manager routines. Version 2.2 uses a ‘glue’ routine, prport.sub, (similar to toolbx.sub for toolbox calls) to provide access to the Print Manager. The second method enables the Fortran program to have the typical Macintosh printing options. The Hilbert program uses the second method. Extensive details for using the Print Manager have been provided in other MacTutor articles (March 1987 MacTutor has one recent thorough overview of the basics). [The prport source and object code is included on the source code disk. Ed]

Use of the Print Manager involves two primary actions by the programmer. First, the program must maintain 120 byte printing record (TPrint record in Pascal, accessed via a THPrint handle or TPPrint pointer). The TPrint record contains most of the control information necessary for printing. Actually, the TPrint record contains several sub-records of information dealing with the printer, style, band, and job information as well as a variety of other variables (Print Manager version, page rectangle, etc.). Listing 6 provides an extended version of the file prdefs.inc, which provides the offsets into the print record. For a complete list of the offsets, see Inside Mac or the March 1987 MacTutor article on printing.

The various elements of the print record may be accessed via the MS Fortran long, word, or byte functions. For example, to obtain a pointer to the page rectangle from the print record you would:

rPageptr = long(prrechdl)+prInfo+rPage

where rPageptr is the returned pointer and prInfo+rPage provide the offset to the print record pointer. To set the pIdleProc pointer you would:

long(long(prrechdl)+prJob+pIdleProc = canproc

where canproc is the address of the print idle procedure (more below on this ability). Two key items to remember when accessing the print record are: first, temporarily lock the print record with HLOCK so that it does not move around on you because of a toolbox call and second, you have a handle to the print record. Thus, long(prrechdl) is a pointer to the start of the print record and long(long(prrechdl) + offsets) will return the 4 bytes at the offset into the print record. The functions word(long(...)) and byte(long(...)) return 2 bytes and 1 byte respectively.

To use the Print Manager, you first need to set up a print record using NEWHANDLE with a size of iPrintSize. Then set the values of the print record to the default with a call to PRINTDEFAULT. In your menu subroutine, handle a ‘Page Setup’ selection with a call to PRSTLDIALOG using the print record handle to set the style fields.

Once the print command has been selected, the program needs to do preliminary setup work (dialogs, margins, etc.). The actual printing process begins with a call PRJOBDIALOG. If the user accepted the job dialog, the program then needs to call PROPENDOC. Next, print a page of material by calling PROPENPAGE, drawing to the printer port (with QuickDraw commands, e.g., TextBox, DrawPicture, DrawString), and ending a page with PRCLOSEPAGE. The page cycle continues until all pages have been printed. When the user selects draft (or is using a Laserwriter) then the material is imaged and printed as the page is processed. If the user selected a spooled print operation, then the spool file is sent to the printer via a call to PRPICFILE. Whenever an error occurs, the print routine needs to exit ‘gracefully.’ If PROPENPAGE was called, call PRCLOSEPAGE after the error occurred and if PROPENDOC was called, call PRCLOSEDOC after the error occurred. See Apple Tech Note # 72 for further details on error handling and Laserwriter compatibility issues.

The Print Manager provides a useful feature in allowing ‘background’ tasks to occur during idle time. The most common use of the background feature is a dialog which provides information to the user about the progress of the print and allows the user to pause or cancel the print request. To use a background procedure, the pIdleProc field of the prJob sub-record of the print record is set to the address of the background procedure. The use of a procptr gives the program the flexibility to override the default mechanism, e.g., prssing command period. Until Absoft provided the assembly routine ctlprc.sub, programmers in Fortran were not able to implement this feature.

The subroutine ctlprc.sub generates a pointer to a Fortran procedure, which can then be passed as an argument to a toolbox call. The calling procedure for ctlprc.sub is:

aptr=CTLPRC(<filte proc name,<argument byte count>)

where CTLPRC and aptr are both declared integer*4. The filter proc name must also be declared integer*4 and external. The byte count is the number of bytes that will be pushed onto the stack by the toolbox, which is specific to the filter function being used. Ctlprc.sub locks itself in the Fortran heap and should be the first executable statement in the Fortran main program. If you are not going to use the procedure pointer till later, you can call ctlprc.sub with dummy arguments (which is what the printgraph program does).

The background procedure used in the printgraph program looks at the event queue with GETNEXTEVENT. If there was a keydown event corresponding to the return key or a click in the cancel button of the dialog, then a print abort error is set with PRSETERROR. After setting the error condition, control is returned to the Print Manager routine. The Print Manager routine detects the error and drops out of the printing process.

The printgraph program may be easily modified to allow printing of text. The user will need to print the text for each particular page using TEXTBOX, DRAWSTRING, etc. The key issues the program must keep track of are line and page counts in order to control the by-page imaging process.

Editor’s Notes

[As usual, I’ve stumbled over all the things Microsoft forgot to put in version 2.2. In particular, they left out the include file for getting at the quickdraw globals. Since this program re-seeds the random number generator by changing the quickdraw global randseed, I was unable to compile the program without the a5Glob.inc file, which I suppose many of you may have. I tried to create this file from the MDS assembler equates for the qd globals, but was unable to come up with a Fortran equivalent that would run correctly. The globals are tricky because they are a negative offset from A5. Finally, as deadline approached, I simply bashed an assembly routine called reset that calls tickcount and resets the randseed global. That listing and the link file is included here. The only file you need that is not included is the prport.sub listing, which was just too long. You can get that on the source code disk, or by contacting Absoft about their “Extras” disk, another item I had not heard of. Don’t you just love how these companies go out of their way to keep you informed of their upgrades, bugs and omissions? A guy could starve on the information Microsoft sends out. ]

{1}
Listing 1
Errata for Include Files
Provided by Absoft Tech Support

Microsoft FORTRAN Version 2.2 is distributed with several INCLUDE files
to aid in the interface to the Macintosh.  Five of these files are
incomplete.  They all are missing the last line.  The following lists 
the
file affected and the missing line.  Add these lines to the end of their
respective file.

FONT.INC:
   parameter (SETFONTLOCK=Z’90318000')
 
MENU.INC:
  +             SETMENUFLASH=Z’94A11000')

SCRAP.INC:
  parameter (ZEROSCRAP=Z’9FC80000',PUTSCRAP=Z’9FE92400')

SEGMENT.INC:
  +           GETAPPPARMS=Z’9F536C00',EXITTOSHELL=Z’9F400000')
     
TEXTEDIT.INC:
  parameter (TESCROLL=Z’9DD09400',TECALTEXT=Z’9D010000')

{2}
Listing 2
Errata for Toolbox.par
Provided by Absoft Tech Support

***********************************************************
* FUNCTION HomeResFile (TheResource: Handle) : Integer;
 INTEGER HOMERESFILE
 PARAMETER (HOMERESFILE=Z’9A450000')

* FUNCTION EventAvail (EventMask: Integer; VAR TheEvent: EventRecord):
*       Boolean;
 INTEGER EVENTAVAIL
 PARAMETER (EVENTAVAIL=Z’971CE000')

* FUNCTION SizeResource (TheResource: Handle): Longint;
 INTEGER SIZERESOURCE
 PARAMETER (SIZERESOURCE=Z’9A590000')

* PROCEDURE HUnlock (H: Handle);
 INTEGER HUNLOCK
 PARAMETER (HUNLOCK=Z’02A80088')

* PROCEDURE SetItemStyle (Menu: MenuHandle; Item: Integer;
*  ChStyle: Style);
 INTEGER SETITEMSTYLE
 PARAMETER (SETITEMSTYLE=Z’94211200')

* PROCEDURE SpaceExtra (extra: Integer);
 INTEGER SPACEEXTRA
 PARAMETER (SPACEEXTRA=Z’88E10000')

* PROCEDURE SetResInfo (TheResource: Handle; TheID: Integer;
*TheType: ResType; Name: Str255);
 INTEGER SETRESINFO
 PARAMETER (SETRESINFO=Z’9A911400')

{3}
* Listing 3
* Modified prdefs.inc
*

* [This file contains data definitions for use with the FORTRAN print 
manager interface (prport.sub).  This is not a complete set of print 
manager definitions; just enough to set up a basic print loop, using 
the print manager style and job dialogs to fill out the records.  See 
also prport.inc, prdrag.for. 20 Jan 86 Sent to Compuserve. EWG]

*
* 9 Apr 87  Modified by Mark E. McBride to add 
* additional print record offsets
*
* Offsets into 120 byte printing record
*
 integer iPrVersion! Print software ver
 parameter (iPrVersion=0)
 integer prInfo  ! PrInfo data 
 parameter (prInfo=2)
 integer rPaper  ! paper rect offset
 parameter (rPaper=16)
 integer prStl   ! print request’s style.
 parameter (prStl=24)
 integer prInfoPT! Time Imaging metrics
 parameter (prInfoPT=32)
 integer prXInfo ! Print info record.
 parameter (prXInfo=46)
 integer prJob   ! The Print Job request
 parameter (prJob=62)
 integer iPrintSize! rec size.[120 bytes]
 parameter (iPrintSize=120)
*
* Offsets into prInfo subrecord
*
 integer iDev    ! driver info
 parameter (iDev=0)
 integer iVRes   ! printer vert res
 parameter (iVRes=2)
 integer iHRes   ! printer hor resolution
 parameter (iHRes=4)
 integer rPage   ! page rectangle
 parameter (rPage=6)
*
* Offsets into prJob subrecord
*
 integer iFstPage! First page to print
 parameter (iFstPage=0)
 integer iLstPage! Last page to print
 parameter (iLstPage=2)
 integer iCopies ! copies to print
 parameter (iCopies=4)
 integer bJDocLoop ! Printing method
 parameter (bJDocLoop=6)
 integer bDraftLoop! Draft print flag.
 parameter(bDraftLoop=0)
 integer bSpoolLoop! Spooled print flag.
 parameter (bSpoolLoop=1)
 integer iFromUsr! True from application
 parameter (iFromUsr=7)
 integer pIdleProc ! background procedure
 parameter (pIdleProc=8)
 integer iPrStatSize ! PrStatus rec size [26 bytes]
 parameter (iPrStatSize=26)

{4}
; Listing 4
; ctlprc.sub source code
; Provided by Absoft Tech Support
;
; [Title: Toolbox Control/Filter glue procedure. Produced by: Absoft 
Soft, Inc.                        Date:  8/19/86
Purpose: To interface MacFortran with the Macintosh’s Toolbox. Notes: 
This procedure takes a FORTRAN procedure as an argument and returns a 
pointer to a procedure that can be called by the Macintosh toolbox.  
This is used to allow control tracking and filter procedures to be written 
in FORTRAN. Warnings/ Limitations: This procedure locks itself into the 
FORTRAN heap when it is called for the first time.  Since it returns 
pointers to locations within itself, it must never move.  It should therefore 
be called as the first executable statement in the main program.  If 
it is not desireable to set up the procedure pointers at the begining 
of the main program, ctlprc can also be called with a zero for the procedure 
argument.]
;
;
;DUMMY = CTLPRC(0, 0)
;
;[This will lock the subroutine in memory without setting up a procedure. 
Calling sequence: <procedure pointer> = CTLPRC(<filter proc>, <argument 
byte count> where <procedure pointer> is a FORTRAN INTEGER variable. 
 This will be assigned a pointer to a procedure.  This variable is then 
used as the filter procedure parameter in calls to the toolbox. <filter 
proc> is the name of the FORTRAN procedure to be called.from the toolbox. 
 This should be a procedure with a single integer parameter, which on 
entry will contain a pointer to the arguments from the toolbox as they 
appear on the stack. This must be declared as EXTERNAL in the program 
unit where CTLPRC is used; this will usually be the main program. <argument 
byte count> is the total number of bytes of arguments that the toolbox 
will push on the stack for the type of filter procedure that this FORTRAN 
procedure will be used for. For example, if the procudure is to be used 
to track a scroll bar, the toolbox will pass 2 parameters on the stack; 
the control handle (4 bytes) and the part code (2 bytes), for a total 
of 6 bytes.  The track procdure should be initialized with
;
 INTEGER TRACK
 .
 .
 .
 TRACK = CTLPRC(FTRACK, 6)
;
where FTRACK is the FORTRAN procedure name.  The integer variable TRACK 
will contain the address of a toolbox callable procedure.  A maximum 
of 16 procedures can be set up by ctlprc.  When this limit is reached, 
ctlprc will return a zero instead of a procedure pointer.]
;


        INCLUDE TOOLEQU.D

CTLPRC: 
 LEA    4(A7),A4 ; Load original Stack Ptr
 LEA    CTLPRC(PC),A5 ; Get exec addr
   CMPA.L  A0,A5   ; loaded in heap?
   BMI.S   L1      ; If linked avoid the set.
   MOVE.W  #1,-8(A1)    ; Mark routine PERMENANT.
L1:
 MOVE.L A0,APPLSCRATCH+4  ; Save impure pointer.
 LEA    NXTPRC,A2; Get addr next routine ptr.
 MOVE.L (A2),D0  ; Get offset to next routine.
 LEA    PRCTBL,A1; Get pointer to proc table.
 ADD.L  D0,A1    ; Point to next proc
 CLR.L  D0; Flag no room.
 LEA    ENDPRC,A3; Get address of table end
 CMPA.L A3,A2    ; Any room left?
 BGE.S  NOROOM   ; no
 MOVE.L A1,D0    ; Return proc pointer.
 MOVE.L (A4)+,A5 ; Get a pointer to count.
 MOVE.L (A5),D1  ; Get argument byte count.
 ADDQ.W #2,A1    ; Bypass BSR.S instruction.
 MOVE.W D1,(A1)+ ; Store argument byte count.
 MOVE.L (A4)+,A5 ; Get pointer to proc. ptr.
 MOVE.L (A5)+,(A1)+; Store procedure pointer.
 BNE.S  OKPROC   ; Not nil - update offset.
 MOVEQ  #0,D0    ; Nil proc-flag not installed.
 BRA.S  NOROOM   ; Do not update offset.
OKPROC: ADDI.L #8,(A2)  ; Offset to next proc
NOROOM: RTS


NXTPRC: DC.L0

PRCTBL: BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0

 BSR.S  GLUE
 DC.W 0
 DC.L 0
ENDPRC:


GLUE: MOVE.LA7,A1; Save pointer to proc info.
 MOVEM.LD2-D7/A2-A5,-(A7) ; Save the world.
 MOVE.L APPLSCRATCH+4,A0  ; Restore impure pointer.
 MOVE.L (A0),A4  ; Restore runtime lib pointer.
 LINK A6,#-1024  ; Get an arithmetic stack.
 LEA    -4(A6),A5; Put math stack in A5.
 MOVE.L (A1),A2  ; Get pointer to proc. info.
 MOVE.W (A2)+,-(A7); Save the argument byte count.
 MOVE.L (A2),A2  ; Get the procedure address.
 PEA    8(A1)    ; Push a pntr to arguments.
 MOVE.L A7,-(A7) ; Push a pntr to arg. pointer.
 JSR    (A2); Call the FORTRAN procedure.
 ADDQ.W #8,A7    ; Push argument to FORTRAN proc.
 MOVE.W (A7)+,D1 ; Get the argument byte count.
 UNLK A6; Return aritmetic stack.
 MOVEM.L(A7)+,D2-D7/A2-A5 ; Restore the world.
 ADDQ.W #4,A7  ; Bypass pointer to procedure info.
 MOVE.L (A7)+,A1 ; Save return address.
 ADD.W  D1,A7    ; Pop arguments.
 TST.W  D0; Set the condition codes.
 JMP    (A1); Return to the toolbox.

 END

Link File for ctlprc file

/DATA
/TYPE ‘    ‘ ‘    ‘
CTLPRC.REL
/OUTPUT ctlprc.sub
$

{5}
; Listing 5 Reset Subroutine
; resets the randseed qd global
;
; reset random seed
;
 include quickequ.d
 include traps.d
 include sysequx.d
 
 xdef   start
 
start:  
 clr.l  -(A7)  ;clear result
 _TickCount ;get tickcount
 clr.l  D2;clear D2
 move.l (A7)+,D2 ;pop off result
 movea.l(currentA5),A4  ;get A5
 movea.lGrafGlobals(A4), A3 ;get qd globals
 move.l D2, randSeed(A3)  ;update seed
 rts

Link File for Reset

/DATA
/TYPE ‘    ‘ ‘    ‘
reset.REL
/OUTPUT reset.sub
$

{6}
* Listing 6
* file:  PrintGraph.for
*
* PrintGraph Fortran Program
*
* Copyright (c) 1987 Mark E. McBride
*                    211 N. University Ave.
*                    Oxford, OH  45056
*
*
* Main Program
*
 program PrintGraph
 
 implicit none   ! helps keep us out of trouble

*
* Reset the pathname to reflect your disk setup
*
include XP40-6:MS Fortran:Include Files:desk.inc
include XP40-6:MS Fortran:Include Files:dialog.inc
include XP40-6:MS Fortran:Include Files:event.inc
include XP40-6:MS Fortran:Include Files:menu.inc
include XP40-6:MS Fortran:Include Files:memory.inc
include XP40-6:MS Fortran:Include Files:misc.inc
include XP40-6:MS Fortran:Include Files:quickdraw.inc
include XP40-6:MS Fortran:Include Files:textedit.inc
include XP40-6:MS Fortran:Include Files:utilities.inc
include XP40-6:MS Fortran:Include Files:window.inc
include XP40-6:MS Fortran:Include Files:prport.inc
include XP40-6:MS Fortran:Include Files:prdefs.inc
 
*include XP40-6:MS Fortran:Include Files:a5Glob.inc
*
* Local Variables
*
 integer*4 mouseloc! mouse loc from FINDWINDOW
 integer*4 eventmask ! events of interest
 integer*4 window! to get default window closed
 integer*4 rnum,rnum1! for use in random numbers
*
* Include the common variables
*
 include XP40-6:MS Fortran:printgraph.com
*
* lock in control proc handler in memory
*
 window=ctlprc(0,0)
*
*  Flush the event manager before calling
*
 eventmask = -1
*
*  Close MacFortran I/O window 
*
 window=toolbx(FRONTWINDOW)
 call toolbx(CLOSEWINDOW,window)
*
*  Call Text Edit and Dialog initilization.
*
 call toolbx(TEINIT)
 call toolbx(INITDIALOGS, 0)
*
*  Setup a print record for use later 
*
 prrechdl=toolbx(NEWHANDLE,iPrintSize)
 call prport(PROPEN)
 call prport(PRINTDEFAULT,prrechdl)
 call prport(PRCLOSE)
*
*  Setup colors array
*
 colors(1)=33
 colors(2)=30
 colors(3)=205
 colors(4)=341
 colors(5)=409
 colors(6)=273
 colors(7)=137
 colors(8)=69
*
* Build the menu from the resource file 
*
 menuhandle=toolbx(GETMENU,Apple)
 call toolbx(INSERTMENU,menuhandle,0)
 call toolbx(ADDRESMENU,menuhandle,’DRVR’)
 menuhandle=toolbx(GETMENU,File)
 call toolbx(INSERTMENU,menuhandle,0)
 menuhandle=toolbx(GETMENU,Edit)
 call toolbx(INSERTMENU,menuhandle,0)
 call toolbx(DRAWMENUBAR)
*
* setup rectangles 
*
 call toolbx(SETRECT,rect,0,0,342,512)
*
* setup watch cursor for later use
*
 curshandle=toolbx(GETCURSOR,4)
 call toolbx(HLOCK,curshandle)
 cursptr=long(curshandle)
 call toolbx(BLOCKMOVE,cursptr,toolbx(PTR, watch(1)),68)
 call toolbx(HUNLOCK,curshandle)
*
* seed the random number generator
*
*long(toolbx(GETGLOBAL)+RANDSEED)=toolbx(TICKCOUNT)
 call reset
*
* Setup values for Hilbert curve
*
 rnum=2 ! randomly set color
 do while (rnum=2) ! don’t get white
   rnum1=toolbx(RANDOM)
   rnum=int((abs(rnum1)/32768.0)*8+1)
 repeat
 colorpick=colors(rnum)
 rnum=toolbx(RANDOM) ! randomly set line size
 linepick=int((abs(rnum)/32768.0)*4+1)
 rnum=2
 do while (rnum<3)
   rnum1=toolbx(RANDOM) ! randomly set Hilbert order
   rnum=int((abs(rnum1)/32768.0)*6+1)
 repeat
 n=rnum

 call Drawing
*
* main event processing loop
*
 do
*
* handle system jobs
*
 call toolbx(SYSTEMTASK)
*
* handle events
*
 if (toolbx(GETNEXTEVENT,eventmask,eventrecord)) then
   select case (what)
     case (1)  ! mouse down
       mouseloc = toolbx(FINDWINDOW,where,window)
       if (mouseloc=1) then ! in menu bar
 call menus
       else if (mouseloc=2) then  ! systemwindow
         call toolbx(SYSTEMCLICK,eventrecord,window)
       end if
     case default! ignore other events
   end select
 end if
 repeat ! repeat for another event
*
* end of the main program
*
 end

*
* menus: mouse down event detected in menu area
*
 subroutine menus
 
 implicit none
*
* Reset the pathname to reflect your disk setup
*
include XP40-6:MS Fortran:Include Files:desk.inc
include XP40-6:MS Fortran:Include Files:dialog.inc
include XP40-6:MS Fortran:Include Files:event.inc
include XP40-6:MS Fortran:Include Files:menu.inc
include XP40-6:MS Fortran:Include Files:memory.inc
include XP40-6:MS Fortran:Include Files:quickdraw.inc
include XP40-6:MS Fortran:Include Files:misc.inc
include XP40-6:MS Fortran:Include Files:textedit.inc
include XP40-6:MS Fortran:Include Files:utilities.inc
include XP40-6:MS Fortran:Include Files:window.inc
include XP40-6:MS Fortran:Include Files:prport.inc
include XP40-6:MS Fortran:Include Files:prdefs.inc

include XP40-6:MS Fortran:Include Files:OSUtilities.inc
include XP40-6:MS Fortran:Include Files:scrap.inc
 
*
* local variables for menu subroutine
*
 character*80 name,pname
 integer*4 refnum,item4,i,j,size,count
 integer*2 OSErr
 logical ok
*
* variable for conversion to pascal type strings
*
 character*256 str255
*
*  variables for making menu selections
*
 integer*2 menuselection(2) ! menu select info
 integer*4 menudata! for use left of equals sign
 equivalence (menuselection,menudata)
*
* Include the common variables
*
 include XP40-6:MS Fortran:printgraph.com
*
* Start of Subroutine
*
 menudata=toolbx(MENUSELECT,where) ! get selected menu data
 item4=menuselection(2)   ! convert to 4 bytes
 select case (menuselection(1))    ! which menu?
   case (File) ! File menu
     menuhandle=toolbx(GETMHANDLE,File)
     select case (menuselection(2))
       case(PSetUp)! Page Setup selected
         call prport(PROPEN)
        ok=prport(PRSTLDIALOG,prrechdl)
 call prport(PRCLOSE)
       case(PrintPic)! Print Hiblert curve selected
        call PrintIt
       case(Quit)! Quit selected
 stop
       case default
       end select
    case (Apple)   ! Apple menu
      menuhandle=toolbx(GETMHANDLE,Apple)
      select case(menuselection(2))
        case(About)! About item selected
          call toolbx(GETPORT,oldPort)
  dlg=toolbx(GETNEWDIALOG,200,0,-1)
  call toolbx(SETPORT,dlg)
  call FrameDItem
  ditemh=0
  while (ditemh<>1)
    call toolbx(MODALDIALOG,0,ditemh)
  repeat
  call toolbx(SETPORT,oldPort)
  call toolbx(DISPOSEDIALOG,dlg)
        case default ! desk acc selected
          call toolbx(GETITEM,menuhandle,item4,name)
  refnum=toolbx(OPENDSKACC,name)
        end select
    case (Edit)    ! Edit menu
      if (.not. toolbx(SYSTEMEDIT,item4-1)) then
      end if
    case default ! just playing with the mouse
 end select
 call toolbx(HILITEMENU,0)
 end

*
*  Drawing:  create hilbert picture of order n using
*            recursive techniques. This is an 
*adaptation of Michael Ackerman’s 
*algorithim given in Byte, June 1986, 
*pages 137-148.
*
 subroutine Drawing
 
 implicit none
*
* Reset the pathname to reflect your disk setup
*
include XP40-6:MS Fortran:Include Files:quickdraw.inc
include XP40-6:MS Fortran:Include Files:memory.inc
include XP40-6:MS Fortran:Include Files:misc.inc
include XP40-6:MS Fortran:Include Files:window.inc
*
* include common variables
*
include XP40-6:MS Fortran:printgraph.com

 call toolbx(SETCURSOR,watch)
 call toolbx(SETRECT,rect,0,0,342,512)
 pichandle=toolbx(OPENPICTURE,rect)
 call toolbx(FORECOLOR,colorpick)
 call toolbx(BACKCOLOR,colors(White))
 call toolbx(PENSIZE,linepick,linepick)
 rder=n
 dy=512/((2**rder-1)+12)
 turn=-1
 dx=0
 x=10
 y=10
 call toolbx(MOVETO,10,10)
 call Graph
 call toolbx(CLOSEPICTURE)

 call toolbx(FORECOLOR,colors(Black))
 call toolbx(PENSIZE,1,1)
 call toolbx(INITCURSOR)
 end


*
* Graph:  draws a hilbert curve 
*
 subroutine Graph

 implicit none
*
* Reset the pathname to reflect your disk setup
*
include XP40-6:MS Fortran:Include Files:quickdraw.inc
include XP40-6:MS Fortran:Include Files:window.inc
*
* include common variables
*
include XP40-6:MS Fortran:printgraph.com

 integer*4 temp

 rder=rder-1
 turn=-turn
 temp=dy
 dy=-turn*dx
 dx=turn*temp
 if (rder.gt.0) call Graph
 x=x+dx
 y=y+dy
 call toolbx(LINETO,x,y)
 turn=-turn
 temp=dy
 dy=-turn*dx
 dx=turn*temp
 if (rder.gt.0) call Graph
 x=x+dx
 y=y+dy
 call toolbx(LINETO,x,y)
 if (rder.gt.0) call Graph
 temp=dy
 dy=-turn*dx
 dx=turn*temp
 turn=-turn
 x=x+dx
 y=y+dy
 call toolbx(LINETO,x,y)
 if (rder.gt.0) call Graph
 temp=dy
 dy=-turn*dx
 dx=turn*temp
 turn=-turn
 rder=rder+1
 end  
*
* Subroutine to print out contents of graph window
*
 Subroutine PrintIt

 implicit none
*
* Reset the pathname to reflect your disk setup
*
include XP40-6:MS Fortran:Include Files:quickdraw.inc
include XP40-6:MS Fortran:Include Files:dialog.inc
include XP40-6:MS Fortran:Include Files:memory.inc
include XP40-6:MS Fortran:Include Files:misc.inc
include XP40-6:MS Fortran:Include Files:window.inc
include XP40-6:MS Fortran:Include Files:prport.inc
include XP40-6:MS Fortran:Include Files:prdefs.inc
*
* other local variables
*
 integer*2 qflag ! Variable to hold bjDocLoop flag
 integer*4 temp,i
 integer*2 srect(4),margins(4)
 integer*4 rPageptr
 logical ok
 integer*4 canproc
*
* variable for conversion to pascal type strings
*
 character*256 str255,str1
*
* print manager structures
*
 integer*4 theprport ! Pointer to printer grafport
 integer*1 thestrec(26) ! Status rec for PRPICFILE
*
* include common variables
*
include XP40-6:MS Fortran:printgraph.com
*
* start print job
*
 call toolbx(HLOCK,prrechdl)
 ok=.false.
 call prport(PROPEN)
 ok=prport(PRJOBDIALOG,prrechdl)
 if (ok) then
*
* set up idle proc
*
   call toolbx(GETPORT,oldPort)
   call toolbx(SETCURSOR,watch)
   canproc=ctlprc(ftrack,0)
   long(long(prrechdl)+prJob+pIdleProc)=canproc
   
   rPageptr=long(prrechdl)+prInfo+rPage
   call toolbx(BLOCKMOVE,rPageptr,toolbx(PTR, srect(1)),8)
   
   dlg=toolbx(GETNEWDIALOG,1010,0,-1)
   str1=str255(‘Hilbert Order ‘//char(48+n))
   call toolbx(PARAMTEXT,str1,’’,’’,’’)
   call toolbx(DRAWDIALOG,dlg)
   call toolbx(SETPORT,dlg)
   call FrameDItem

   call toolbx(INITCURSOR)
*
* start printing
*
   theprport = prport(PROPENDOC, prrechdl, 0, 0)
   if (prport(PRERROR) .NE. 0) then
     write(9,*) “Printer error “,prport(PRERROR)
     goto 10
   endif
   call prport(PROPENPAGE,theprport,0)
   if (prport(PRERROR) .NE. 0) then
     write(9,*) “Printer error “,prport(PRERROR)
     goto 20
   endif
   call toolbx(DRAWPICTURE,pichandle,rect)
20   call prport(PRCLOSEPAGE, theprport)
10   call prport(PRCLOSEDOC, theprport)
   qflag = byte(long(prrechdl)+prJob+bJDocLoop)
*
*  If the print method is spooled, the actual printing 
*still needs to be done.
*
   if ((qflag = bSpoolLoop) .AND. (prport(PRERROR) = 0)) then
     call prport(PRPICFILE, prrechdl, 0, 0, 0, toolbx(PTR, thestrec))
   endif

   if (prport(PRERROR) .NE. 0) then
     write(9,*) “Printer error “,prport(PRERROR)
   endif
   call toolbx(DISPOSEDIALOG,dlg)
   call toolbx(SETPORT,oldPort)
 endif
 call prport(PRCLOSE)
 call toolbx(HUNLOCK,prrechdl)
 end

*
*  Frame rounded rectangle, sets the default item
*
 subroutine FrameDItem

 implicit none
*
* Reset the pathname to reflect your disk setup
*
include XP40-6:MS Fortran:Include Files:quickdraw.inc
include XP40-6:MS Fortran:Include Files:dialog.inc
*
* include common variables
*
 include XP40-6:MS Fortran:printgraph.com
*
* local variables
*
 integer*4 dLog
 integer*2 iBox(4)
 integer*4 iBox4(4)
 integer*2 iType
 integer*4 iHandle
 integer*1 oldPenState(18)
 
 call toolbx(GETPENSTATE,oldPenState)
 call toolbx(GETDITEM,dlg,1,iType,iHandle,iBox)
 call toolbx(INSETRECT,iBox,-4,-4)
 call toolbx(PENSIZE,3,3)
 call toolbx(FRAMEROUNDRECT,iBox,16,16)
 call toolbx(SETPENSTATE,oldPenState)
 
 end
*
*  str255: converts a FORTRAN string to a 
*Pascal LSTRING
*
 character*256 function str255(string)
 character*(*) string
 
 str255 = char(len(trim(string)))//string

 end


* [This is the idleProc for the Print Manager used in the printit subsubroutine. 
Normally, a pointer to the arguments passed to a control proc routine 
by the toolbox is passed in argptr.  This is done since the glue routine 
used by ctlprc to interface the toolbox to FORTRAN has no way of knowing 
what kind of procedure this is (control actionProc, dialog filterProc, 
etc.), and therefore no way of knowing how many parameters to expect. 
 argptr points to the last argument (partCode) as pushed on the stack 
by the toolbox; preceding arguments are at higher addresses.]

      subroutine ftrack(argptr)

 implicit none   ! Declare all variables.
 integer argptr  ! Pointer to arguments.
 ! but there are none
 logical bool
 integer*2 item
 integer*4 cancelitem
 integer*4 dlgptr,toolbx
 integer*4 mDownMask,KeyDownMask,keyDown
 parameter (cancelitem=1)
 parameter (mDownMask=2,KeyDownMask=8,keyDown=3)
 
 integer*2 theEvent(8)
 integer*2 what
 integer*4 message
 integer*4 when
 integer*2 where(2)
 integer*2 modifiers 

*
* Reset the pathname to reflect your disk setup
*
include XP40-6:MS Fortran:Include Files:event.inc
include XP40-6:MS Fortran:Include Files:dialog.inc
include XP40-6:MS Fortran:Include Files:prport.inc
include XP40-6:MS Fortran:Include Files:prdefs.inc
 
 bool=toolbx(GETNEXTEVENT,mDownMask+KeyDownMask, theEvent)
 item=0
 if ((what=keyDown).and.(mod(message,256) = 13)) then
   item=cancelitem
 else if toolbx(ISDIALOGEVENT,theEvent) then
   bool=toolbx(DIALOGSELECT,theEvent,dlgptr,item)
 end if
 if (item=cancelitem) then
   call prport(PRSETERROR,128)! set abort error
 end if
 return
      end
!codeexamp
leend!codeexamplestart
{7]
* Listing 7
* file:  PrintGraph.com

*
* PrintGraph Fortran Program
*
* Copyright (c) 1987 Mark E. McBride
*                    211 N. University Ave.
*                    Oxford, OH  45056
*
* This file contains variable definitions
* that will be common to the main program and 
* the non-print related subroutines.
* These include most of the toolbox structures
* used throughout the program
*
*
* general and toolbox variables
*
 integer*4 toolbx! toolbx.sub interface
 integer*4 prport! print manager interface
 integer*4 ctlprc! Create toolbox callable procs.
 integer*4 n,dy,dx,x,y,turn,rder ! Hilbert curve variables
 integer track   ! Address of the track proc.
 integer ftrack  ! This keeps IMPLICIT NONE happy.

* Declare ftrack as a subroutine.
 external ftrack

*
* handles
*
 integer*4 menuhandle! handle to menu
 integer*4 pichandle ! handle to picture
 integer*4 oldPort ! handle to oldport
 integer*4 curshandle,cursptr ! handle to cursor
 integer*1 watch(68) ! watch cursor record
*
* print manager structures
*
 integer*4 prrechdl! Handle to print record
 integer*4 theprport ! Pointer to printer grafport
 integer*1 thestrec(26) ! Status rec PRPICFILE
*
* dialog structures
*
 integer*4 dlg,itemno,itemhdl ! general purpose dialog pointer
 integer*2 ditemh,itemtype! item hit in dialog
*
* event strucutures
*
 integer*2 eventrecord(8) ! overlying structure
 integer*2 what  ! type of event
 integer*4 message ! extra event information
 integer*4 when  ! time of event in 60ths of seconds
 integer*2 where(2)! mouse loc in global coordinates
 integer*2 modifiers ! mouse button and modkeys
*
* Menu and other selection constants
*
 integer*4 Apple,File,Edit
 integer*4 About
 integer*4 PSetUp,PrintPic,Quit
 integer*4 Undo,Cut,Copy,Paste,Clear,ShowClip
 integer*4 Black,White,Red,Green,Blue, Cyan,Magenta,Yellow
 integer*4 top,left,bottom,right
*
* Colors and line size
*
 integer*4 colors(8)
 integer*4 colorpick
 integer*4 linepick
*
* Rectangles for general use
*
 integer*2 rect(4),rect1(4),rect2(4),rect3(4)
*
* common variable sets
*
 common /set1/menuhandle,pichandle,rect,rect1, rect2,rect3,
     +  prrechdl,theprport,thestrec,dlg,itemno, itemhdl,ditemh,
     +  itemtype,eventrecord(8),toolbx,ctlprc, track,ftrack,
     +  prport,n,dy,dx,x,y,turn,rder,colorpick, linepick,
     +  curshandle,cursptr,watch,colors,oldPort

*
*  parameters
*
 parameter (top=1,left=2,bottom=3,right=4)
 parameter (Apple=29,File=30,Edit=31)
 parameter (About=1)
 parameter (PSetUp=1,PrintPic=2,Quit=4)
 parameter (Undo=1,Cut=3,Copy=4,Paste=5,Clear=6, ShowClip=8)
 parameter (Black=1,White=2,Red=3,Green=4,Blue=5, Cyan=6)
 parameter (Magenta=7,Yellow=8)

Link File

* This is the Link File
* for the PrintGraph Program
 
o PrintGraph
f PrintGraph apl
f prport.sub
f ctlprc.sub
f toolbx.sub
f reset.sub
l f77.rl
g