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.

 

Community Search:
MacTech Search:

Software Updates via MacUpdate

Check out the new Pirate Attack update i...
Love pirates and board games? Well, you'll love the new Pirate Attack themed update that just launched in Game of Dice. It adds a bunch of new content themed around pirates, like an all new event map based on a pirate ship which revamps the toll... | Read more »
Splash Cars guide - How to paint the tow...
Splash Cars is an arcade driving game that feels like a hybrid between Dawn of the Plow and Splatoon. In it, you'll need to drive a car around to repaint areas of a town that have lost all of their color. Check out these tips to help you perform... | Read more »
The best video player on mobile
We all know the stock video player on iOS is not particularly convenient, primarily because it asks us to hook a device up to iTunes to sync video in a world that has things like Netflix. [Read more] | Read more »
Four apps to help improve your Super Bow...
Super Bowl Sunday is upon us, and whether you’re a Panthers or a Broncos fan you’re no doubt gearing up for it. [Read more] | Read more »
LooperSonic (Music)
LooperSonic 1.0 Device: iOS Universal Category: Music Price: $4.99, Version: 1.0 (iTunes) Description: LooperSonic is a multi-track audio looper and recorder that will take your loops to the next level. Use it like a loop pedal to... | Read more »
Space Grunts guide - How to survive
Space Grunts is a fast-paced roguelike from popular iOS developer, Orange Pixel. While it taps into many of the typical roguelike sensibilities, you might still find yourself caught out by a few things. We delved further to find you some helpful... | Read more »
Dreii guide - How to play well with othe...
Dreii is a rather stylish and wonderful puzzle game that’s reminiscent of cooperative games like Journey. If that sounds immensely appealing, then you should immediately get cracking and give it a whirl. We can offer you some tips and tricks on... | Read more »
Kill the Plumber World guide - How to ou...
You already know how to hop around like Mario, but do you know how to defeat him? Those are your marching orders in Kill the Plumber, and it's not always as easy as it looks. Here are some tips to get you started. This is not a seasoned platform... | Read more »
Planar Conquest (Games)
Planar Conquest 1.0 Device: iOS Universal Category: Games Price: $12.99, Version: 1.0 (iTunes) Description: IMPORTANT: Planar Conquest is compatible only with iPad 3 & newer devices, iPhone 5 & newer. It’s NOT compatible with... | Read more »
We talk to Cheetah Mobile about its plan...
Piano Tiles 2 is a fast-paced rhythm action high score chaser out now on iOS and Android. You have to tap a series of black tiles that appear on the screen in time to the music, being careful not to accidentally hit anywhere else. Do that and it's... | Read more »

Price Scanner via MacPrices.net

BookBook For iPad Pro Coming Soon
The iPad Pro is a device unlike any other, and with Apple Pencil, it’s the ideal portable sketchpad: all that’s missing is the modern easel and portfolio to go. TwelveSouth’s BookBook for iPad Pro... Read more
12-inch 1.2GHz Silver Retina MacBook on sale...
B&H Photo has the 12″ 1.2GHz Silver Retina MacBook on sale for $1399 including free shipping plus NY sales tax only. Their price is $200 off MSRP, and it’s the lowest price for this model from... Read more
iPads on sale at Target: $100 off iPad Air 2,...
Target has WiFi iPad Air 2s and iPad mini 4s on sale for up to $100 off MSRP on their online store for a limited time. Choose free shipping or free local store pickup (if available). Sale prices for... Read more
Target offers Apple Watch for $100 off MSRP
Target has Apple Watches on sale for $100 for a limited time. Choose free shipping or free local store pickup (if available). Sale prices for online orders only, in-store prices may vary: - Apple... Read more
Apple refurbished 2014 13-inch Retina MacBook...
Apple has Certified Refurbished 2014 13″ Retina MacBook Pros available for up to $400 off original MSRP, starting at $979. An Apple one-year warranty is included with each model, and shipping is free... Read more
Macs available for up to $300 off MSRP, $20 o...
Purchase a new Mac or iPad using Apple’s Education Store and take up to $300 off MSRP. All teachers, students, and staff of any educational institution qualify for the discount. Shipping is free, and... Read more
Watch Super Bowl 50 Live On Your iPad For Fre...
Watch Super Bowl 50 LIVE on the CBS Sports app for iPad and Apple TV. Get the app and then tune in Sunday, February 7, 2016 at 6:30 PM ET to catch every moment of the big game. The CBS Sports app is... Read more
Two-thirds Of All Smart Watches Shipped In 20...
Apple dominated the smart watch market in 2015, accounting for over 12 million units and two-thirds of all shipments according to Canalys market research analysts’ estimates. Samsung returned to... Read more
12-inch 1.2GHz Retina MacBooks on sale for up...
B&H Photo has 12″ 1.2GHz Retina MacBooks on sale for $180 off MSRP. Shipping is free, and B&H charges NY tax only: - 12″ 1.2GHz Gray Retina MacBook: $1499 $100 off MSRP - 12″ 1.2GHz Silver... Read more
12-inch 1.1GHz Gray Retina MacBook on sale fo...
B&H Photo has the 12″ 1.1GHz Gray Retina MacBook on sale for $1199 including free shipping plus NY sales tax only. Their price is $100 off MSRP, and it’s the lowest price available for this model... Read more

Jobs Board

*Apple* Retail - Multiple Positions (US) - A...
Sales Specialist - Retail Customer Service and Sales Transform Apple Store visitors into loyal Apple customers. When customers enter the store, you're also the Read more
*Apple* Retail - Multiple Positions (US) - A...
Job Description: Sales Specialist - Retail Customer Service and Sales Transform Apple Store visitors into loyal Apple customers. When customers enter the store, Read more
*Apple* Subject Matter Expert - Experis (Uni...
This position is for an Apple Subject Matter Expert to assist in developing the architecture, support and services for integration of Apple devices into the domain. Read more
*Apple* Macintosh OSX - Net2Source Inc. (Uni...
…: * Work Authorization : * Contact Number(Best time to reach you) : Skills : Apple Macintosh OSX Location : New York, New York. Duartion : 6+ Months The associate would Read more
Computer Operations Technician ll - *Apple*...
# Web Announcement** Apple Technical Liaison**The George Mason University, Information Technology Services (ITS), Technology Support Services, Desktop Support Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.