Skip to content

Instantly share code, notes, and snippets.

@steventroughtonsmith
Created January 16, 2015 09:22
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save steventroughtonsmith/8043130cea031f9ef8fe to your computer and use it in GitHub Desktop.
Save steventroughtonsmith/8043130cea031f9ef8fe to your computer and use it in GitHub Desktop.
MPW PascalIIGS
/*
* Copyright Apple Computer, Inc. 1986, 1987
* All Rights Reserved
*/
extern int OpenDA();
extern int CloseDA();
extern int ActionDA();
extern int InitDA();
asm(BEGINDA) {
dcl OpenDA
dcl CloseDA
dcl AsmAction
dcl AsmInit
dcw 20
dcw 0xffff
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb ' '
dcb 0
}
asm(AsmAction) {
phy
phx
pha
jsl ActionDA
ply
ply
ply
rtl
}
asm(AsmInit) {
pha
jsl InitDA
ply
rtl
}
int _toolErr;
static char __dataBank;
asm(SaveDB) {
phb
lda #^__dataBank ; high word of anything in ~globals will do
pha
plb
pla
rtl
}
asm(RestoreDB) {
lda 4,s
pha
plb
plb
rtl
}
#include <memory.h>
#include <setjmp.h>
#include <stdio.h>
#include <misctool.h>
#include <locator.h>
#include <quickdraw.h>
#include <window.h>
#include <desk.h>
#include <sane.h>
extern int _toolErr;
extern GrafPortPtr IDLEWIND;
extern int QUITFLAG;
extern int INITTYPE;
extern int SANE_SIZE;
extern int STK_SIZE;
int hasBeenOpened = 0;
typedef int (*pfi)(); /* pointer to a function returning int */
static jmp_buf orig_buf;
int myId;
static
int
dummy_open()
{
REALLYOPEN();
longjmp(orig_buf, 1); /* gets you back to POINT A */
}
/*
static
int
dummy_init()
{
REALLYINIT();
doit = 0;
longjmp(orig_buf, 1); */ /* gets you back to POINT A *//*
}
*/
static
int
dummy_close()
{
REALLYCLOSE();
IDLEWIND = nil;
longjmp(orig_buf, 1); /* gets you back to POINT A */
}
static
int
dummy_action()
{
REALLYACTION();
longjmp(orig_buf, 1); /* gets you back to POINT A */
}
/*
* do_work() implements:
* change to the new stack, and set up the new SANE area.
* Control is passed to the user routine via a longjmp(jb, 1), which
* calls the 'dummy_XX' intermediate
* procedure. The dummy procedure executes the 'real' procedure, and
* then switches back to the original stack via a longjmp(orig_buf, 1)
* After this latter longjmp, control is passed to the routine which
* called do_work (it comes out of the preceding 'setjmp()' a second time)
* control resumes at POINT A, and the stack is to the original value.
* do_work() relies on how data is laid out inside a jmp_buf,
* as implemented by setjmp() and longjmp() in the standard C library.
*/
#define SaneTOOL 10
do_work(newSane, stack, stack_size, address)
char *newSane, *stack;
unsigned int stack_size;
pfi address;
{
long *jb;
if(stack != NULL && newSane != NULL) {
jb = (long *)(stack + stack_size - sizeof(jmp_buf));
#define STK_PTR_OFFSET 0
#define EMPTY_STACK 1
#define RET_ADR_OFFSET 4
*(int *)(((char *)jb) + STK_PTR_OFFSET) = (int)jb - EMPTY_STACK;
*(long *)((char *)jb + RET_ADR_OFFSET) = ((long)address << 8);
SANEStartUp((unsigned) newSane);
longjmp(jb, 1); /* same as *address(), but changes stack */
}
else {
longjmp(orig_buf, 1); /* gets you back to POINT A */
}
}
/* allocate a block of zero-ed out memory in the stack bank, bank 0
* Note that we do this allocation call everytime we do OpenDA, CloseDA
* and the action routines; action routines are called very frequently.
* You may want to allocate some stack space and SANE space only in
* the Open routine, and de-allocate this space in the Close routine.
* But this means that you will keep that space until you do the Close.
*/
char **
alloc_stk(siz)
unsigned siz;
{
char **temph;
#define PG_ZERO_LCKED (attrLocked+attrFixed+attrPage+attrBank)
temph = NewHandle((long)siz, myId, PG_ZERO_LCKED, (char *)NULL);
if (_toolErr == 0) {
return temph;
}
else {
return 0;
}
}
DoProc(procp)
pfi procp;
{
char **stack;
char **sanebuf;
char *oldSane;
if(setjmp(orig_buf) == 0) {
oldSane = GetWAP(sysTool,SaneTOOL);
/* This is where we jump to the function actually doing something */
sanebuf = alloc_stk(SANE_SIZE);
if (sanebuf != 0) {
stack = alloc_stk(STK_SIZE);
if (stack != 0) {
do_work(*sanebuf, *stack, STK_SIZE, procp);
}
else {
DisposeHandle(sanebuf);
}
}
}
else {
/* POINT A: */
if (sanebuf)
DisposeHandle(sanebuf);
if (stack)
DisposeHandle(stack);
SetWAP(sysTool, SaneTOOL, oldSane);
}
}
/* below this point in the program, we must be very careful about
* managing the contents of the data bank register. We must save
* it first, alter it to point to the ~globals segment (SaveDB() does this)
* and then when we are done, call RestoreDB().
* Access to arrays and automatic (i.e. local) variables will work correctly
* with ANY value of data bank register.
*/
/* funtion to be called for InitDA and Time */
InitDA(a_reg)
int a_reg;
{
int dbr;
GrafPortPtr holdptr;
dbr = SaveDB();
holdptr = GetPort();
INITTYPE = a_reg;
if (INITTYPE != 0){
SANE_SIZE = 512;
STK_SIZE = 2048;
}
/* DoProc(dummy_init); */
REALLYINIT();
SetPort(holdptr);
RestoreDB(dbr);
}
pascal
void
CloseDA()
{
int dbr;
GrafPortPtr holdptr;
dbr = SaveDB();
holdptr = GetPort();
if (hasBeenOpened) {
hasBeenOpened = 0;
DoProc(dummy_close);
}
DeleteID(myId);
SetPort(holdptr);
RestoreDB(dbr);
}
pascal
GrafPortPtr
OpenDA()
{
GrafPortPtr p, holdptr;
int dbr;
dbr = SaveDB();
holdptr = GetPort();
if (! hasBeenOpened) {
hasBeenOpened = 1;
myId = GetNewID(0x5000); /* 5000 means 'for desk acc' */
DoProc(dummy_open);
}
p = IDLEWIND;
SetPort(holdptr);
RestoreDB(dbr);
return p; /* WARNING: at this point, DB is at a random value */
} /* but access to p will work OK; doesn't use DBR */
ActionDA(a_reg, x_reg, y_reg)
int a_reg, x_reg, y_reg;
{
int dbr;
GrafPortPtr holdptr;
extern int ACTIONCODE;
extern EventRecordPtr EVENTP;
extern int MENUID;
extern int ITEMID;
dbr = SaveDB();
holdptr = GetPort();
if(hasBeenOpened && ! QUITFLAG) {
ACTIONCODE = a_reg;
EVENTP = (EventRecordPtr) ((y_reg * 0x10000 ) + x_reg );
MENUID = x_reg;
ITEMID = y_reg;
DoProc(dummy_action);
if(QUITFLAG) {
CloseNDAByWinPtr(IDLEWIND);
}
}
SetPort(holdptr);
RestoreDB(dbr);
}
# File: Makefile
# Target: 'idle'
# Created: Thursday, Aug 3, 1988
# Copyright Apple Computer, Inc. 1988
# All rights reserved.
# To make this desk accessory set the directory to the directory containing
# this file and the source files. From the worksheet type 'make'
# then the enter key. Next select the newly created lines and type enter.
# If you use this make file to create other desk accessories:
# Put in the new [App]lication name replacing "idle"
# Put in the new [Sources] file names.
App = idle
ObjectFiles = DAHeader.c.o \
DAInterface.c.o \
SampleDA.p.o
# make idle desk accessory
all: $(App)
$(App) :$(ObjectFiles)
mpw LinkIIGS -t NDA \
$(ObjectFiles) \
-lib "{PIIGSLibraries}"PLib \
-o "$(App)"
mpw DuplicateIIGS -y -mac "$(App)" "$(App)"
%.c.o : %.c
mpw CIIGS $< -o $@
%.p.o : %.p
#Always use the -r option when creating a desk accessory
mpw PascalIIGS -r $< -o $@
clean:
rm -f $(App) $(ObjectFiles)
UNIT SampleDA;
{+----------------------------------------------------------------------------+
| |
| SampleDA: An example Apple IIGS Desk Accessory |
| |
| Copyright (c) Apple Computer, Inc. 1987-1988 |
| All Rights Reserved |
| |
| Written by the Apple IIGS MAX Developement Team |
| |
| Contributers: |
| |
| Mike Shannon |
| Guillermo Ortiz |
| Bill Grimm |
| |
| |
| ---------------------------------------------------------------------- |
| |
| This program and its derivatives are licensed only for |
| use on Apple computers. |
| |
| Works based on this program must contain and |
| conspicuously display this notice. |
| |
| This software is provided for your evaluation and to |
| assist you in developing software for the Apple IIGS |
| computer. |
| |
| This is not a distribution license. Distribution of |
| this and other Apple software requires a separate |
| license. Contact the Software Licensing Department of |
| Apple Computer, Inc. for details. |
| |
| DISCLAIMER OF WARRANTY |
| |
| THE SOFTWARE IS PROVIDED "AS IS" WITHOUT |
| WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, |
| WITH RESPECT TO ITS MERCHANTABILITY OR ITS FITNESS |
| FOR ANY PARTICULAR PURPOSE. THE ENTIRE RISK AS TO |
| THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH |
| YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU (AND |
| NOT APPLE OR AN APPLE AUTHORIZED REPRESENTATIVE) |
| ASSUME THE ENTIRE COST OF ALL NECESSARY SERVICING, |
| REPAIR OR CORRECTION. |
| |
| Apple does not warrant that the functions |
| contained in the Software will meet your requirements |
| or that the operation of the Software will be |
| uninterrupted or error free or that defects in the |
| Software will be corrected. |
| |
| SOME STATES DO NOT ALLOW THE EXCLUSION |
| OF IMPLIED WARRANTIES, SO THE ABOVE EXCLUSION MAY |
| NOT APPLY TO YOU. THIS WARRANTY GIVES YOU SPECIFIC |
| LEGAL RIGHTS AND YOU MAY ALSO HAVE OTHER RIGHTS |
| WHICH VARY FROM STATE TO STATE. |
| |
+----------------------------------------------------------------------------+}
INTERFACE
USES
types,
quickdraw,
IntMath,
events,
controls,
windows,
menus,
desk,
misctool;
{$Z+} {So 'C' routines know about these names}
VAR
idleWind : GrafPortPtr; { do not remove }
initType, { do not remove }
Sane_Size, { do not remove }
Stk_Size, { do not remove }
quitflag, { do not remove }
menuID, { do not remove }
itemID, { do not remove }
actionCode : Integer; { do not remove }
eventP : EventRecordPtr; { do not remove }
PROCEDURE ReallyOpen; { do not remove }
PROCEDURE ReallyInit; { do not remove }
PROCEDURE ReallyClose; { do not remove }
PROCEDURE ReallyAction; { do not remove }
IMPLEMENTATION
{$Z-} { hide the rest }
{ place variables & constants here that need to be known between calls }
CONST
borderV = $E1C034;
TYPE
borderType = packed array [1..2] of 0..127;
borderPoint = ^borderType;{ NOTE: do not use char since must force to less bits}
charPtr = ^char;
VAR
windParams : ParamList;
origRgn : RgnHandle;
oldBorder : char;
appleIcon : array [1..34] of packed array [1..16] of byte;
emptyString : STR255;
IconSrc : LocInfo;
blackPat : pattern ; (* all zeroes == black *)
borderPtr : borderPoint;
oldBorderPtr :charPtr;
numevents : Integer;
PROCEDURE BeginDA; EXTERNAL;
{ ------------------------------------------------------------------------------------}
PROCEDURE HPStuffHex (thingPtr : Ptr; s : Str255);
{StuffHex stores bytes (expressed as a string
of hexadecimal digits) into any data structure, and is based on the
StuffHex procedure in Macintosh QuickDraw. The resolution of this
routine is on byte boundaries.}
var iterator : integer;
stringIndex : integer;
begin {of HPStuffHex}
for iterator := 0 to Length (s) - 1 do begin
stringIndex := (iterator * 2) + 1;
thingPtr^ := Hex2Int (Ptr (longint (@s) + stringIndex),2);
thingPtr := pointer (longint (thingPtr) + 1);
end;
end; {of HPStuffHex}
{ ------------------------------------------------------------------------------------}
{ This procedure is called when the desk accessory is selected from the }
{ Apple menu. It will only be called once. Any re-selection of the DA's }
{ menu item will be filtered out before reaching this routine. }
PROCEDURE ReallyOpen;
VAR
oldRgn,
tmpRgn : RgnHandle;
myPoint : Ptr;
BEGIN
emptyString := '';
windParams.paramLength := sizeOf(ParamList);
windParams.wFrameBits := fVis+fAllocated+fAlert;
windParams.wPosition.v2 := 200;
windParams.wPlane := GrafPortPtr(-1);
oldRgn := RgnHandle( Desktop(GetDesktop, 0));
origRgn := NewRgn;
CopyRgn(oldRgn, origRgn);
tmpRgn := NewRgn;
IF BAND (GetMasterSCB, $80) = 0 THEN WindParams.wPosition.h2 := 320
ELSE WindParams.wPosition.h2 := 640;
RectRgn(tmpRgn, WindParams.wPosition);
myPoint := Desktop(ToDesk, LongInt(ORD4(tmpRgn)));
DisposeRgn(tmpRgn);
idleWind := NewWindow(WindParams);
if _toolErr <> 0 THEN SysFailMgr(_toolErr,emptyString);
SetSysWindow(idleWind);
borderPtr := borderPoint(borderV);
oldBorderPtr := charPtr(borderV);
oldBorder := oldBorderPtr^;
borderPtr^[1] := 0;
HPStuffHex (@AppleIcon[1], '00000000000000000000000000000000');
HPStuffHex (@AppleIcon[2], '0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0');
HPStuffHex (@AppleIcon[3], '0F0000000000000000000000000000F0');
HPStuffHex (@AppleIcon[4], '0F0FFFFFFFFFFFFFFFFFFFFFFFFFF0F0');
HPStuffHex (@AppleIcon[5], '0F0FFFFFFFFFFFFFFFFFF88FFFFFF0F0');
HPStuffHex (@AppleIcon[6], '0F0FFFFFFFFFFFFFFFF8888FFFFFF0F0');
HPStuffHex (@AppleIcon[7], '0F0FFFFFFFFFFFFFFF88888FFFFFF0F0');
HPStuffHex (@AppleIcon[8], '0F0FFFFFFFFFFFFFF88888FFFFFFF0F0');
HPStuffHex (@AppleIcon[9], '0F0FFFFFFFFFFFFF888888FFFFFFF0F0');
HPStuffHex (@AppleIcon[10],'0F0FFFFFFFFFFFFF88888FFFFFFFF0F0');
HPStuffHex (@AppleIcon[11],'0F0FFFFFFFFFFFFF8888FFFFFFFFF0F0');
HPStuffHex (@AppleIcon[12],'0F0FFFFFF8888FFF88FF8888FFFFF0F0');
HPStuffHex (@AppleIcon[13],'0F0FFFF88888888FFF88888888FFF0F0');
HPStuffHex (@AppleIcon[14],'0F0FFF888888888888888888888FF0F0');
HPStuffHex (@AppleIcon[15],'0F0FFeeeeeeeeeeeeeeeeeeeeFFFF0F0');
HPStuffHex (@AppleIcon[16],'0F0FFeeeeeeeeeeeeeeeeeeeFFFFF0F0');
HPStuffHex (@AppleIcon[17],'0F0FFeeeeeeeeeeeeeeeeeeFFFFFF0F0');
HPStuffHex (@AppleIcon[18],'0F0FF666666666666666666FFFFFF0F0');
HPStuffHex (@AppleIcon[19],'0F0FF666666666666666666FFFFFF0F0');
HPStuffHex (@AppleIcon[20],'0F0FF666666666666666666FFFFFF0F0');
HPStuffHex (@AppleIcon[21],'0F0FF4444444444444444444FFFFF0F0');
HPStuffHex (@AppleIcon[22],'0F0FF44444444444444444444FFFF0F0');
HPStuffHex (@AppleIcon[23],'0F0FFF444444444444444444444FF0F0');
HPStuffHex (@AppleIcon[24],'0F0FFF555555555555555555555FF0F0');
HPStuffHex (@AppleIcon[25],'0F0FFF555555555555555555555FF0F0');
HPStuffHex (@AppleIcon[26],'0F0FFFF5555555555555555555FFF0F0');
HPStuffHex (@AppleIcon[27],'0F0FFFF1111111111111111111FFF0F0');
HPStuffHex (@AppleIcon[28],'0F0FFFFF11111111111111111FFFF0F0');
HPStuffHex (@AppleIcon[29],'0F0FFFFFF111111FFF111111FFFFF0F0');
HPStuffHex (@AppleIcon[30],'0F0FFFFFFF1111FFFFF1111FFFFFF0F0');
HPStuffHex (@AppleIcon[31],'0F0FFFFFFFFFFFFFFFFFFFFFFFFFF0F0');
HPStuffHex (@AppleIcon[32],'0F0000000000000000000000000000F0');
HPStuffHex (@AppleIcon[33],'0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0');
HPStuffHex (@AppleIcon[34],'00000000000000000000000000000000');
iconSrc.portSCB := $80; { 640 mode }
iconSrc.ptrToPixImage := @AppleIcon;
iconSrc.width := 16;
iconSrc.boundsRect.v2 := $22;
iconSrc.boundsRect.h2 := $40;
quitflag := 0; { set to 1 by action routine if its time to quit }
numevents := 0;
END; {ReallyOpen}
{ ------------------------------------------------------------------------------------}
{ This procedure is called when DeskStartUp or DeskShutDown is called }
{ It is normally not used but is used here so that the header for the }
{ desk accessory can be built from Pascal }
PROCEDURE ReallyInit;
TYPE
DAHeader = RECORD
openPtr : LongInt; { pointer to open routine (do not change) }
closePtr : LongInt; { pointer to close routine (do not change) }
actionPtr : LongInt; { pointer to action routine (do not change) }
initPtr : LongInt; { pointer to init routine (do not change) }
period : Integer; { How often the DA is to get a run call }
eventMask : Integer; { Discribes what events DA responds to }
menuLine : packed ARRAY [0..20] of char;
END;
DAHeaderPtr = ^DAHEADER;
VAR
customHeader : DAHeaderPtr;
BEGIN
IF initType <> 0 THEN
BEGIN { DeskStartUp call being made }
customHeader := DAHeaderPtr(@BeginDA);
customHeader^.period := 20;
customHeader^.eventMask := $ffff;
customHeader^.menuline[0] := ' '; { do not modify }
customHeader^.menuline[1] := ' '; { do not modify }
customHeader^.menuline[2] := 'A'; { Put DA name here adding }
customHeader^.menuline[3] := 'p'; { characters as needed. }
customHeader^.menuline[4] := 'p'; { The maximum characters }
customHeader^.menuline[5] := 'l'; { for the menuLine array is 21. }
customHeader^.menuline[6] := 'e';
customHeader^.menuline[7] := 's';
customHeader^.menuline[8] := ' ';
customHeader^.menuline[9] := '\'; { These last 5 entries }
customHeader^.menuline[10] := 'H'; { must be the last 5 following }
customHeader^.menuline[11] := '*'; { the menu name for any DA }
customHeader^.menuline[12] := '*';
customHeader^.menuline[13] := char(0);
{ change the following if you want more or less stack }
Sane_Size := 512; { Be conservative with allocating memory since you must }
Stk_Size := 2048; { live with applications }
END
ELSE
BEGIN { DeskShutDown call being made - this is not close desk accessory}
END;
END;
{ ------------------------------------------------------------------------------------}
{ This procedure is called when the desk accessory is about to close. }
PROCEDURE ReallyClose;
BEGIN
oldBorderPtr^ := oldBorder;
CloseWindow(idleWind);
CopyRgn(origRgn, RgnHandle(Desktop(GetDesktop, 0)));
DrawMenuBar;
DisposeRgn(origRgn);
END; {ReallyClose }
{ ------------------------------------------------------------------------------------}
{ This procedure handles any events or periodic run requests which are passed }
{ to the desk accessory. }
PROCEDURE ReallyAction;
CONST
XSpan = 145;
YSpan = 168;
VAR
savePort : GrafPortPtr;
newX,
newY : integer;
BEGIN
CASE ActionCode of
runAction:
BEGIN { a periodic call is being made }
IF numevents <= 100 THEN
BEGIN { draw an apple }
savePort := GetPort;
SetPort(idleWind);
newX := abs(Random mod XSpan) * 4 ;
newY := abs(Random mod YSpan);
PPToPort(iconSrc, RectPtr(@iconSrc.boundsRect), newX, newY, 0);
SetPort(savePort);
numevents := numevents + 1;
END
ELSE
BEGIN { fill window to black }
FillRect(windParams.wPosition, BlackPat);
numevents := 0;
END;
END;
eventAction:
BEGIN { an event has been passed to the DA }
CASE EventP^.what OF
updateEvt:
BEGIN
BeginUpdate(idleWind);
FillRect(windParams.wPosition, BlackPat);
EndUpdate(idleWind);
END;
mouseDownEvt,
mouseUpEvt,
keyDownEvt: quitflag := 1;
AutoKeyEvt,
ActivateEvt:
BEGIN
END;
END; { CASE }
END;
cursorAction,
undoAction,
cutAction,
copyAction,
pasteAction,
clearAction:
BEGIN
END;
END; { CASE }
END;
END. { of Unit }
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment