singer@endor.harvard.edu (Richard Siegel) (01/10/88)
[HyperCard Interfaces for Lightspeed Pascal]
This is a "shar" archive which contains Lightspeed Pascal units
that allow users to write XCMD and XFCN resources for HyperCard.
Also included are two sample extensions.
These were written by Steve Stein of THINK Technologies.
For more (necessary) information, see the HyperCard Developer's
Package, available from APDA.
--Rich
**The opinions stated herein are my own opinions and do not necessarily
represent the policies or opinions of my employer (THINK Technologies).
* Richard M. Siegel | {decvax, ucbvax, sun}!harvard!endor!singer *
* Customer Support | singer@endor.harvard.edu *
* Symantec, THINK Technologies Division. (No snappy quote) *
---
#!/bin/sh
# shar: Shell Archiver
# Run the following text with /bin/sh to create:
# LSP_Flash.p
# LSP_Peek.p
# XCMD_Interface.p
# XCMD_Utilities.p
sed 's/^X//' << 'SHAR_EOF' > LSP_Flash.p
XUNIT FlashUnit;
XINTERFACE
X USES
X XCmdIntf, XCmdUtils;
X
X PROCEDURE main (paramPtr : XCmdPtr);
X
XIMPLEMENTATION
X
X PROCEDURE Flash (paramPtr : XCmdPtr);
X VAR
X flashCount : LongInt;
X i : INTEGER;
X port : GrafPtr;
X str : Str255;
X
X PROCEDURE Fail (errMsg : Str255); { set theResult and quit }
X BEGIN
X paramPtr^.returnValue := PasToZero(paramPtr, errMsg);
X END;
X
X BEGIN
X IF paramPtr^.paramCount <> 1 THEN
X Fail('parameter count is not 1');
X
X ZeroToPas(paramPtr, paramPtr^.params[1]^, str); { first param is flash count }
X flashCount := StrToNum(paramPtr, str);
X
X IF ODD(flashCount) THEN
X Fail('can''t flash an odd number of times')
X ELSE
X BEGIN
X GetPort(port);
X FOR i := 1 TO flashCount DO
X BEGIN
X InvertRect(port^.portRect);
X InvertRect(port^.portRect);
X END;
X END
X END;
X
X PROCEDURE main;
X BEGIN
X Flash(paramPtr);
X END;
X
XEND.
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > LSP_Peek.p
XUNIT PeekUnit;
X
XINTERFACE
X USES
X XCmdIntf, XCmdUtils;
X
X PROCEDURE main (paramPtr : XCmdPtr);
X
XIMPLEMENTATION
X
X PROCEDURE Peek (paramPtr : XCmdPtr);
X VAR
X peekAddr : Ptr;
X peekSize, peekVal : LongInt;
X str : Str255;
X tempWordPtr : ^integer;
X tempLongPtr : ^longint;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X { first param is addr }
X ZeroToPas(paramPtr, params[1]^, str);
X peekAddr := ptr(StrToNum(paramPtr, str));
X
X { second param, if given, is size }
X peekSize := 1;
X IF paramCount = 2 THEN
X BEGIN
X ZeroToPas(paramPtr, params[2]^, str);
X peekSize := StrToNum(paramPtr, str);
X END;
X
X CASE peekSize OF
X 1 :
X peekVal := BitAnd($000000FF, peekAddr^);
X 2 :
X BEGIN
X tempWordPtr := pointer(BitAnd($FFFFFFFE, ord4(peekAddr)));
X peekVal := BitAnd($0000FFFF, tempWordPtr^);
X END;
X 4 :
X BEGIN
X tempLongPtr := pointer(BitAnd($FFFFFFFE, peekAddr^));
X peekVal := tempLongPtr^;
X END;
X OTHERWISE
X peekVal := 0;
X END;
X
X str := NumToStr(paramPtr, peekVal);
X returnValue := PasToZero(paramPtr, str);
X END;
X END;
X
X PROCEDURE main;
X BEGIN
X Peek(paramPtr);
X END;
X
XEND.
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > XCMD_Interface.p
X{ Hypercard XCMD interface unit for Lightspeed Pascal }
X
X{ (c) 1987 Symantec Corp. THINK Technologies Division }
X
X{ Adapted for use with Lightspeed Pascal from information provided }
X{ by Apple Computer, Inc. }
X
XUNIT XCMDIntf;
XINTERFACE
X CONST
X
X { result codes }
X xresSucc = 0;
X xresFail = 1;
X xresNotImp = 2;
X
X { request codes }
X xreqSendCardMessage = 1;
X xreqEvalExpr = 2;
X xreqStringLength = 3;
X xreqStringMatch = 4;
X
X xreqZeroBytes = 6;
X xreqPasToZero = 7;
X xreqZeroToPas = 8;
X xreqStrToLong = 9;
X xreqStrToNum = 10;
X xreqStrToBool = 11;
X xreqStrToExt = 12;
X xreqLongToStr = 13;
X xreqNumToStr = 14;
X xreqNumToHex = 15;
X xreqBoolToStr = 16;
X xreqExtToStr = 17;
X xreqGetGlobal = 18;
X xreqSetGlobal = 19;
X xreqGetFieldByName = 20;
X xreqGetFieldByNum = 21;
X xreqGetFieldByID = 22;
X xreqSetFieldByName = 23;
X xreqSetFieldByNum = 24;
X xreqSetFieldByID = 25;
X xreqStringEqual = 26;
X xreqReturnToPas = 27;
X xreqScanToReturn = 28;
X xreqScanToZero = 39;
X
X TYPE
X
X XCmdPtr = ^XCmdBlock;
X XCmdBlock = RECORD
X paramCount : INTEGER;
X params : ARRAY[1..16] OF Handle;
X returnValue : Handle;
X passFlag : BOOLEAN;
X
X entryPoint : ProcPtr; { to call back to HyperCard }
X request : INTEGER;
X result : INTEGER;
X inArgs : ARRAY[1..8] OF LongInt;
X outArgs : ARRAY[1..4] OF LongInt;
X END;
X
XIMPLEMENTATION
X
XEND.
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > XCMD_Utilities.p
X{ Hypercard XCMD utilities unit for Lightspeed Pascal }
X
X{ (c) 1987 Symantec Corp. THINK Technologies Division }
X
X{ Adapted for use with Lightspeed Pascal from information provided }
X{ by Apple Computer, Inc. }
X
XUNIT XCMDUtils;
X
XINTERFACE
X
X USES
X XCMDIntf;
X
X TYPE
X Str31 = STRING[31];
X
X FUNCTION StringMatch (paramPtr : XCmdPtr;
X pattern : Str255;
X target : Ptr) : Ptr;
X
X FUNCTION PasToZero (paramPtr : XCmdPtr;
X str : Str255) : Handle;
X
X PROCEDURE ZeroToPas (paramPtr : XCmdPtr;
X zeroStr : Ptr;
X VAR pasStr : Str255);
X
X FUNCTION StrToLong (paramPtr : XCmdPtr;
X str : Str31) : LongInt;
X
X FUNCTION StrToNum (paramPtr : XCmdPtr;
X str : Str31) : LongInt;
X
X FUNCTION StrToBool (paramPtr : XCmdPtr;
X str : Str31) : BOOLEAN;
X
X FUNCTION StrToExt (paramPtr : XCmdPtr;
X str : Str31) : Extended;
X
X FUNCTION LongToStr (paramPtr : XCmdPtr;
X posNum : LongInt) : Str31;
X
X FUNCTION NumToStr (paramPtr : XCmdPtr;
X num : LongInt) : Str31;
X
X FUNCTION NumToHex (paramPtr : XCmdPtr;
X num : LongInt;
X nDigits : INTEGER) : Str31;
X
X FUNCTION ExtToStr (paramPtr : XCmdPtr;
X num : Extended) : Str31;
X
X FUNCTION BoolToStr (paramPtr : XCmdPtr;
X bool : BOOLEAN) : Str31;
X
X PROCEDURE SendCardMessage (paramPtr : XCmdPtr;
X msg : Str255);
X
X FUNCTION EvalExpr (paramPtr : XCmdPtr;
X expr : Str255) : Handle;
X
X FUNCTION StringLength (paramPtr : XCmdPtr;
X strPtr : Ptr) : LongInt;
X
X FUNCTION GetGlobal (paramPtr : XCmdPtr;
X globName : Str255) : Handle;
X
X PROCEDURE SetGlobal (paramPtr : XCmdPtr;
X globName : Str255;
X globValue : Handle);
X
X FUNCTION GetFieldByName (paramPtr : XCmdPtr;
X cardFieldFlag : BOOLEAN;
X fieldName : Str255) : Handle;
X
X FUNCTION GetFieldByNum (paramPtr : XCmdPtr;
X cardFieldFlag : BOOLEAN;
X fieldNum : INTEGER) : Handle;
X
X FUNCTION GetFieldByID (paramPtr : XCmdPtr;
X cardFieldFlag : BOOLEAN;
X fieldID : INTEGER) : Handle;
X
X PROCEDURE SetFieldByName (paramPtr : XCmdPtr;
X cardFieldFlag : BOOLEAN;
X fieldName : Str255;
X fieldVal : Handle);
X
X PROCEDURE SetFieldByNum (paramPtr : XCmdPtr;
X cardFieldFlag : BOOLEAN;
X fieldNum : INTEGER;
X fieldVal : Handle);
X
X PROCEDURE SetFieldByID (paramPtr : XCmdPtr;
X cardFieldFlag : BOOLEAN;
X fieldID : INTEGER;
X fieldVal : Handle);
X
X FUNCTION StringEqual (paramPtr : XCmdPtr;
X str1, str2 : Str255) : BOOLEAN;
X
X PROCEDURE ReturnToPas (paramPtr : XCmdPtr;
X zeroStr : Ptr;
X VAR pasStr : Str255);
X
X PROCEDURE ScanToReturn (paramPtr : XCmdPtr;
X VAR scanPtr : Ptr);
X
X PROCEDURE ScanToZero (paramPtr : XCmdPtr;
X VAR scanPtr : Ptr);
X
X PROCEDURE ZeroBytes (paramPtr : XCmdPtr;
X dstPtr : Ptr;
X longCount : LongInt);
X
XIMPLEMENTATION
X
X PROCEDURE DoJsr (addr : ProcPtr);
X INLINE
X $205F, $4E90;
X
X FUNCTION StringMatch;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@pattern);
X inArgs[2] := ORD(target);
X request := xreqStringMatch;
X DoJsr(entryPoint);
X StringMatch := Ptr(outArgs[1]);
X END;
X END;
X
X
X FUNCTION PasToZero;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@str);
X request := xreqPasToZero;
X DoJsr(entryPoint);
X PasToZero := Handle(outArgs[1]);
X END;
X END;
X
X
X PROCEDURE ZeroToPas;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(zeroStr);
X inArgs[2] := ORD(@pasStr);
X request := xreqZeroToPas;
X DoJsr(entryPoint);
X END;
X END;
X
X
X FUNCTION StrToLong;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@str);
X request := xreqStrToLong;
X DoJsr(entryPoint);
X StrToLong := outArgs[1];
X END;
X END;
X
X
X FUNCTION StrToNum;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@str);
X request := xreqStrToNum;
X DoJsr(entryPoint);
X StrToNum := outArgs[1];
X END;
X END;
X
X
X FUNCTION StrToBool;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@str);
X request := xreqStrToBool;
X DoJsr(entryPoint);
X StrToBool := BOOLEAN(outArgs[1]);
X END;
X END;
X
X
X FUNCTION StrToExt;
X VAR
X x : Extended;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@str);
X inArgs[2] := ORD(@x);
X request := xreqStrToExt;
X DoJsr(entryPoint);
X StrToExt := x;
X END;
X END;
X
X
X FUNCTION LongToStr;
X VAR
X str : Str31;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := posNum;
X inArgs[2] := ORD(@str);
X request := xreqLongToStr;
X DoJsr(entryPoint);
X LongToStr := str;
X END;
X END;
X
X
X FUNCTION NumToStr;
X VAR
X str : Str31;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := num;
X inArgs[2] := ORD(@str);
X request := xreqNumToStr;
X DoJsr(entryPoint);
X NumToStr := str;
X END;
X END;
X
X
X FUNCTION NumToHex;
X VAR
X str : Str31;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := num;
X inArgs[2] := nDigits;
X inArgs[3] := ORD(@str);
X request := xreqNumToHex;
X DoJsr(entryPoint);
X NumToHex := str;
X END;
X END;
X
X
X FUNCTION ExtToStr;
X VAR
X str : Str31;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@num);
X inArgs[2] := ORD(@str);
X request := xreqExtToStr;
X DoJsr(entryPoint);
X ExtToStr := str;
X END;
X END;
X
X
X FUNCTION BoolToStr;
X VAR
X str : Str31;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := LongInt(bool);
X inArgs[2] := ORD(@str);
X request := xreqBoolToStr;
X DoJsr(entryPoint);
X BoolToStr := str;
X END;
X END;
X
X
X PROCEDURE SendCardMessage;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@msg);
X request := xreqSendCardMessage;
X DoJsr(entryPoint);
X END;
X END;
X
X
X FUNCTION EvalExpr;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@expr);
X request := xreqEvalExpr;
X DoJsr(entryPoint);
X EvalExpr := Handle(outArgs[1]);
X END;
X END;
X
X
X FUNCTION StringLength;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(strPtr);
X request := xreqStringLength;
X DoJsr(entryPoint);
X StringLength := outArgs[1];
X END;
X END;
X
X
X FUNCTION GetGlobal;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@globName);
X request := xreqGetGlobal;
X DoJsr(entryPoint);
X GetGlobal := Handle(outArgs[1]);
X END;
X END;
X
X
X PROCEDURE SetGlobal;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@globName);
X inArgs[2] := ORD(globValue);
X request := xreqSetGlobal;
X DoJsr(entryPoint);
X END;
X END;
X
X
X FUNCTION GetFieldByName;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(cardFieldFlag);
X inArgs[2] := ORD(@fieldName);
X request := xreqGetFieldByName;
X DoJsr(entryPoint);
X GetFieldByName := Handle(outArgs[1]);
X END;
X END;
X
X
X FUNCTION GetFieldByNum;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(cardFieldFlag);
X inArgs[2] := fieldNum;
X request := xreqGetFieldByNum;
X DoJsr(entryPoint);
X GetFieldByNum := Handle(outArgs[1]);
X END;
X END;
X
X
X FUNCTION GetFieldByID;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(cardFieldFlag);
X inArgs[2] := fieldID;
X request := xreqGetFieldByID;
X DoJsr(entryPoint);
X GetFieldByID := Handle(outArgs[1]);
X END;
X END;
X
X
X PROCEDURE SetFieldByName;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(cardFieldFlag);
X inArgs[2] := ORD(@fieldName);
X inArgs[3] := ORD(fieldVal);
X request := xreqSetFieldByName;
X DoJsr(entryPoint);
X END;
X END;
X
X
X PROCEDURE SetFieldByNum;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(cardFieldFlag);
X inArgs[2] := fieldNum;
X inArgs[3] := ORD(fieldVal);
X request := xreqSetFieldByNum;
X DoJsr(entryPoint);
X END;
X END;
X
X
X PROCEDURE SetFieldByID;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(cardFieldFlag);
X inArgs[2] := fieldID;
X inArgs[3] := ORD(fieldVal);
X request := xreqSetFieldByID;
X DoJsr(entryPoint);
X END;
X END;
X
X
X FUNCTION StringEqual;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@str1);
X inArgs[2] := ORD(@str2);
X request := xreqStringEqual;
X DoJsr(entryPoint);
X StringEqual := BOOLEAN(outArgs[1]);
X END;
X END;
X
X
X PROCEDURE ReturnToPas;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(zeroStr);
X inArgs[2] := ORD(@pasStr);
X request := xreqReturnToPas;
X DoJsr(entryPoint);
X END;
X END;
X
X
X PROCEDURE ScanToReturn;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@scanPtr);
X request := xreqScanToReturn;
X DoJsr(entryPoint);
X END;
X END;
X
X
X PROCEDURE ScanToZero;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(@scanPtr);
X request := xreqScanToZero;
X DoJsr(entryPoint);
X END;
X END;
X
X
X PROCEDURE ZeroBytes;
X BEGIN
X WITH paramPtr^ DO
X BEGIN
X inArgs[1] := ORD(dstPtr);
X inArgs[2] := longCount;
X request := xreqZeroBytes;
X DoJsr(entryPoint);
X END;
X END;
XEND.
SHAR_EOF
exit
---