TweetFollow Us on Twitter

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 ‘writeln’s’ in the source text to show what was happening. Although a workable solution on mainframes and mini’s, that’s 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 isn’t 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 one’s 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.

 
AAPL
$562.06
Apple Inc.
+5.09
MSFT
$28.91
Microsoft Corpora
-0.85
GOOG
$604.48
Google Inc.
+3.68
MacTech Search:
Community Search:

Favorite 4: Euro 2012 Apps
In a matter of weeks, one of the biggest soccer tournaments out there begins: Euro 2012. Qualification is over and 16 European teams are all lined up to prove which one is the best of the bunch. As a Brit, I’m ever hopeful that England will achieve... | Read more »
Zombie Farm 2 Review
Zombie Farm 2 Review By Rob LeFebvre on May 23rd, 2012 Our Rating: Universal App - Designed for iPhone and iPad Take on the role of a social game farmer who plants both crops AND zombies in this sequel to the original hit, Zombie... | Read more »
Facebook Pages Manager Does Exactly What...
Sick of hearing about the Facebook IPO? Want to hear about something actually related to the Facebook product? Well, I have good news then. Facebook has launched a new app that will come in handy for users who manage Facebook Pages. | Read more »
Score! Classic Goals Review
Score! Classic Goals Review By Jennifer Allen on May 23rd, 2012 Our Rating: :: GOAL!Universal App - Designed for iPhone and iPad Relive some classic goals by creating them in this addictive soccer game.   | Read more »
Turn The iPhone Into a Cash Register wit...
While credit card readers like Square are targeted toward end users who may want to collect occasional credit card payments, for those who are looking to make the iPhone a major part of their retail business, Cashier Live is hoping to fill that void. | Read more »
Alive4ever mini Review
Alive4ever mini Review By Angela LaFollette on May 23rd, 2012 Our Rating: :: KILL THOSE ZOMBIESiPhone App - Designed for the iPhone, compatible with the iPad Alive4ever mini brings a new game play style to the zombie killing series... | Read more »
1Card Eliminates the Need for Lugging Ar...
Doubtless most people these days carry around one or two club cards. Virtually every single retail and grocery store in existence uses them and they’re a great way to save some money with (typically) no initial cost. The only problem is having to... | Read more »

Price Scanner via MacPrices.net

Are You Sure You Really Want A Retina Display MacB...
Apple didn’t invent the laptop computer, but over the past 21 years they’ve continuously set and reset the bar for laptop innovation and engineering advances, with PC competitors mostly playing catch... Read more
Two PC Pundits Weigh In On PC To Mac Switching (Or...
ZNet’s Stephen Chapman and Forbes’ Brian Caulfield have posted recent blogs on the topic of their personally switching from Windows PCs to Macs. From PC to Mac 10-Months Later ZNet blogger Stephen... Read more
Apple Maintains Top Mobile PC Share in Q112 on Str...
Apple shipped nearly 17.2 million mobile PCs in Q112, accounting for 118% year-over-year shipment growth, according to preliminary results from the latest NPD DisplaySearch Quarterly Mobile PC... Read more
Apple offering refurbished 17″ MacBook Pros for $3...
 The Apple Store has Apple Certified Refurbished 17″ 2.4GHz MacBook Pros available for $2119 including free shipping. That’s $380 off the price of new models. Apple’s one-year warranty is standard. Read more
Week’s Best MacBook Deals
We’ve posted the Week’s Best Deals on MacBook Airs and MacBook Pros for Wednesday, the 23rd of May. Find the lowest price or the best set of bundles from Apple’s Authorized Resellers with these deals... Read more
MacBook Airs on sale for up to $101 off MSRP, free...
 Adorama has MacBook Airs on sale today for up to $101 off MSRP including free shipping. NY and NJ sales tax only. Their prices are among the lowest available for these models from any Apple... Read more
Open-box special: 2.3GHz Mac mini for $493
MacMall has open-box return 2.3GHz Mac minis available for $493 including free shipping. That’s $106 off MSRP. Apple’s one-year warranty and all materials are included. Act now if you’re interested,... Read more
Apple iPhone Charger’s Secrets And Engineering Sup...
Blogger Ken Shirriff’s has posted a thoroughgoing Apple iPhone charger teardown and analysis, the one-line takeaway being: “quality in a tiny expensive package.” Shirriff says that disassembling... Read more

Jobs Board

*Apple* Solutions Consultant-Retail Sal...
Requisition Number 15545261 Job title Apple Solutions Consultant-Retail Sales Location Spanish Fort Country United States City Spanish Fort State Alabama Job type Job Read more
Android and Iphone Application at Elance...
I need an interval timer application to be created for iphone and android platforms... I am on a tight budget but this ... & IPHONES) not just one so if you can only do one don't waste your time... Read more
*Apple* Solutions Consultant-Retail Sal...
The Apple Solutions Consultant (ASC) is an Apple employee who oversees the sales, merchandising, and operations of an Apple Store-in-a-Store in a single unit Read more
Events App - iPhone at Elance.com (Louis...
I would like to create an events app for iPhone, Android and Blackberry. This would basically be a calendar that users could access which would have all of the local events in their area on it. This... Read more
*Apple* Retail - Sales - Apple Inc. (Un...
…other. As a Specialist, you're the essence of a customer's experience at the Apple Retail Store. You enrich people's lives through meaningful dialogue about the coolest Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.