TML Pascal Tricks
Volume Number: | | 6
|
Issue Number: | | 3
|
Column Tag: | | Pascal Procedures
|
TML Pascal Tricks
By Paul Diegenbach, Amsterdam, the Netherlands
XCMD - drawing in a Hypercard stack
The attractiveness of Hypercard is for a large part due to it graphical possibilities. Nice cards always mean nice graphics. The Hypertalk language allows drawing on the screen under program control. When we tear the tools menu off the menubar, we can actually see the actions as the tools flop from pen to brush to marquee and so on. Nice to watch, but oh so slow. Ever tried to draw a complicated graph in Hypercard? I tried it in an attempt to simulate the differentiation of an egg to all the different cells an embryo consists of. One of the theories implies the evaluation of some differential equations and then drawing a thousand points on the screen.
The idea was to let students be able to change the parameters in the equations and see the results in a user-friendly environment. The first step was to implement the equation solving in Hypertalk. Too slow, so an XCMD was quickly written. Drawing the results by Hypertalk: still to slow, so why not do the drawing in the XCMD as well? In a first result the drawing looks nice, but as soon as Hypercard updates the screen from its offscreen bitmap, the drawing disappears. The solution to this problem is to copy the drawing in the paste buffer (scrap) and paste it into Hypercard using the paste command from the menu. This combination works fine and quick. The skeleton for the XCMD is given below, in TML-Pascal, with a Fourier-demo in the drawing part to make it less dumb. In this demo we use parameters from Hypercard for the size of the rectangle and for the Fourier coefficients. Although not necessary, it is often handy to give the rectangle parameters. They can easily be estimated by having a temporary field of the same size and asking in the message window put the size of card field tmp into msg. The Hypercard stack with this demo implemented is on the source disk for this month.
To avoid flicker between the copy and paste, it is convenient to lock the screen before the XCMD is used. Users of other Pascals sometimes need to remove the ParamPtr parameter, that is the first parameter in every call to the glue routines:
{1}
UNIT PictToScrp;
(******************************************************
This XCMD demodnstrates a method to plot and calculate in Pascal (perhaps
with floating point processor enabled) and then copy and paste the picture
in the card compile and link as follows (assuming Fourier is an existing
stack):
TMLPascal Fourier.p
or: ( really fast on a mac II)
TMLPascal Fourier.p -MC68020 -MC68881 -d Elems881=true
Link -w -t STAK -c WILD
-m FOURIER -rt XCMD=1282 -sg Fourier
Fourier.p.o
{Libraries}Runtime.o
{Libraries}Interface.o
{TMLPLibraries}TMLPasLib.o
{Libraries}HyperXLib.o
-o Fourier
Hypercard call :
set the lockscreen to true
-- prevents flicker
Fourier 330,14,480,319,10,7,5,3,4
-- 330,14,480 is the area to draw into
-- 10,7,5,3,4 are the fourier factors times 10
set the lockscreen to false
******************************************************)
INTERFACE
USES MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, PasLibIntf, HyperXCMD;
PROCEDURE Fourier(ParamPtr: XCMDPtr);
IMPLEMENTATION
PROCEDURE PictScrap(ParamPtr: XCMDPtr); FORWARD;
PROCEDURE Fourier(ParamPtr: XCMDPtr);
BEGIN
PictScrap(ParamPtr);
END;
PROCEDURE PictScrap(ParamPtr: XCMDPtr);
VAR
thePoint : Point;
hPicture : PicHandle;
rg : rect;
Piclength : LONGINT;
xoffset, yoffset: integer;
str : str255;
xLeft, bot, top, xRight: LONGINT;
one, two, three, four, five: LONGINT;
x, y : extended;
z1, z2, z3, z4, z5: extended;
PROCEDURE MyDrawing;
{ all your drawing stuff goes here }
VAR
i : integer;
maxim, offset: extended;
FUNCTION Sinus(x: extended): extended;
BEGIN
Sinus := sin(x) * z1 + sin(2 * x) * z2 + sin(3 * x) * z3 +
sin(4 * x) * z4 + sin(5 * x) * z5
{ the more, the better }
END;
BEGIN
eraserect(rg);
Framerect(rg); { optional }
offset := top + (bot - top) / 2.0;
z1 := one / 10.0;
z2 := two / 10.0;
z3 := three / 10.0;
z4 := four / 10.0;
z5 := five / 10.0;
x := 0.02 {1 / 50} ;
maxim := Sinus(x);
FOR i := 2 TO 314 DO
BEGIN
IF i MOD 10 = 0 THEN
SendCardMessage(ParamPtr, set cursor to busy);
x := i / 50;
y := Sinus(x);
IF maxim < y THEN
maxim := y;
END;
x := 1 / 50;
y := Sinus(x);
maxim := 100 / maxim;
SendCardMessage(ParamPtr, set cursor to busy);
moveto(xLeft + 1, round(y * maxim + offset));
FOR i := 2 TO 314 DO
BEGIN { for two pi }
x := i / 50;
y := Sinus(x);
lineto(i + xLeft + 1, round(y * maxim + offset))
END;
SendCardMessage(ParamPtr, set cursor to busy);
penpat(ltgray);
moveto(xLeft + 1, round(offset));
lineto(xRight - 2, round(offset));
pennormal
END;
FUNCTION GetParameter(n: integer): LONGINT;
VAR
tmp : LONGINT;
BEGIN
ZeroToPas(ParamPtr, ParamPtr^.params[n]^, str);
stringToNum(str, tmp);
GetParameter := tmp
END;
BEGIN
IF ParamPtr^.paramCount <> 9 THEN
SendCardMessage(ParamPtr, put wrong number of parameters into
msg)
{ I think a more convenient way of error report than by ParamPtr^.ReturnValue
}
ELSE
BEGIN
{get the drawing rectangle coordinates from hypercard }
xLeft := GetParameter(1);
top := GetParameter(2);
xRight := GetParameter(3);
bot := GetParameter(4);
{ In this example : get Fourier coëfficients from hypercard }
one := GetParameter(5);
two := GetParameter(6);
three := GetParameter(7);
four := GetParameter(8);
five := GetParameter(9);
setrect(rg, xLeft, top, xRight, bot);
xoffset := xLeft + 5;
yoffset := top + 5;
cliprect(rg);
hPicture := OpenPicture(rg);
Showpen;
MyDrawing; { here all your drawing }
closepicture;
Piclength := GethandleSize(handle(hPicture));
IF ZeroScrap + putscrap(Piclength, PICT, ptr(hPicture^)) =
NoErr THEN
ParamPtr^.ReturnValue := PasToZero(ParamPtr, )
ELSE
ParamPtr^.ReturnValue := PasToZero(ParamPtr, something wrong);
SendCardMessage(ParamPtr, choose select tool);
SendCardMessage(ParamPtr, domenu Paste Picture);
SendCardMessage(ParamPtr, choose browse tool);
END
END;
END.
Small and Dirty Write Always
In the debugging of large programs we were accustomed to put a lot of writelns in the source text to show what was happening. Although a workable solution on mainframes and minis, thats not so easy in the Macintosh environment, there is not always a window available to write in. The following small subroutine (TML Pascal version) does the trick with some disadvantage: it overwrite all its lines on top of each other at the bottom of the screen in some kind of status line (bit like Online companion), but, sorry, the line is not automatically removed after leaving the program. Dirty isnt it, so surely for debugging only. An invalrect after each multifinder event and at the end of the program is sometimes a solution.
In the program source you write something like :
--2
if dbg then DQText(now in procedure blahblah)
(The clever ones can write a MPW-script to put it after the first begin in every procedure or function) Dbg is used as a constant (or in a compiler directive).
The procedure (as a Pascal unit) looks like :
{3}
UNIT DQTextProcedure;
INTERFACE
USES
MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, QDaccess;
{ Tml pascals QDaccess defines:
TYPE QDGlobalsPtr = ^QDGlobalsRec;
QDGlobalsRec =
record
randSeed : LongInt;
screenBits : BitMap;
arrow : Cursor;
dkGray : Pattern;
ltGray : Pattern;
gray : Pattern;
black : Pattern;
white : Pattern;
ThePort : GrafPtr;
end;
function QDGlobals: QDGlobalsPtr;external;}
PROCEDURE DQText(Message: Str255);
IMPLEMENTATION
PROCEDURE DQText(Message: Str255);
VAR
SavedPort : GrafPtr;
LocalPort : GrafPort;
TheRect : Rect;
BEGIN
WITH QDGlobals^ DO
BEGIN
GetPort(SavedPort);
OpenPort(@LocalPort);
SetPort(@LocalPort);
WITH ScreenBits.Bounds DO
{ this is QDGlobals^ s ScreenBits ! }
SetRect(TheRect, Left, Bottom-20, Right, Bottom);
FillRect(TheRect, White);
MoveTo(TheRect.Left, TheRect.Top);
LineTo(TheRect.Right, TheRect.Top);
MoveTo(TheRect.Left+7, TheRect.Bottom-7);
DrawString(Message);
ClosePort(@LocalPort);
SetPort(SavedPort);
END;
END;
END.
PROGRAM tstDQtext;
{ test the dqtext procedure : }
USES MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf,
PaslibIntf, QDaccess, DQtext;
(*
link as :
Link -t APPL -c ????
DQtext.p.o
tstDQtext.p.o
{Libraries}Runtime.o
{Libraries}Interface.o
{TMLPLibraries}TMLPasLib.o
-o tstDQtext
*)
BEGIN
textbook(NIL); { TML pascal simple window }
writeln( see bottom line);
writeln( click mouse button);
PLFlush(output);
DQtext(before);
REPEAT
UNTIL button;
DQtext(after mouse button);
writeln( type return to end program);
readln
END.