Mac-Carbon
view release on metacpan or search on metacpan
MacPerl/MacPerl.xs view on Meta::CPAN
}
} else if (myEvent->what == activateEvt && gPickList != NULL) {
activate = (myEvent->modifiers & 0x01) != 0;
LActivate((Boolean) activate, gPickList);
}
return false;
}
#if TARGET_RT_MAC_CFM
RoutineDescriptor uMacListFilter =
BUILD_ROUTINE_DESCRIPTOR(uppModalFilterProcInfo, MacListFilter);
#else
#define uMacListFilter MacListFilter
#endif
#endif /* MACOS_TRADITIONAL */
static OSErr GetVolInfo(short volume, Boolean indexed, FSSpec * spec)
{
OSErr err;
HParamBlockRec pb;
pb.volumeParam.ioNamePtr = spec->name;
pb.volumeParam.ioVRefNum = indexed ? 0 : volume;
pb.volumeParam.ioVolIndex = indexed ? volume : 0;
if (err = PBHGetVInfoSync(&pb))
return err;
spec->vRefNum = pb.volumeParam.ioVRefNum;
spec->parID = 1;
return noErr;
}
int choose()
{
croak("choose not implemented at the moment");
return -1;
}
MODULE = MacPerl PACKAGE = MacPerl PREFIX = MP_
void
MP_SetFileInfo(creator, type, path, ...)
OSType creator
OSType type
char * path
CODE:
{
int i;
for (i=2; i<items; i++)
fsetfileinfo((char *) SvPV_nolen(ST(i)), creator, type);
}
void
MP_GetFileInfo(path)
char * path
PPCODE:
{
OSType creator;
OSType type;
errno = 0;
fgetfileinfo(path, &creator, &type);
if (errno) {
if (GIMME != G_ARRAY)
XPUSHs(&PL_sv_undef);
/* Else return empty list */
} else if (GIMME != G_ARRAY) {
OSType ntype = htonl(type);
XPUSHs(sv_2mortal(newSVpv((char *) &ntype, 4)));
} else {
OSType ntype = htonl(type);
OSType ncreator = htonl(creator);
XPUSHs(sv_2mortal(newSVpv((char *) &ncreator, 4)));
XPUSHs(sv_2mortal(newSVpv((char *) &ntype, 4)));
}
}
void
MP_Ask(prompt, ...)
char * prompt
CODE:
#ifndef MACOS_TRADITIONAL
croak("Usage: MacPerl::Ask unsupported in Carbon");
#else
{
short item;
DialogPtr dlg;
dlg = GetNewDialog(2010, NULL, (WindowPtr)-1);
InitCursor();
SetDlgText(dlg, 3, prompt);
if (items > 1)
SetDlgText(dlg, 4, (char *) SvPV_nolen(ST(1)));
SelectDialogItemText(dlg, 4, 0, 1024);
ShowWindow(dlg);
SetPort(dlg);
FrameDlgRect(dlg, ok);
ModalDialog((ModalFilterUPP)0, &item);
switch (item) {
case ok:
GetDlgText(dlg, 4, gMacPerlScratchString);
ST(0) = sv_2mortal(newSVpv(gMacPerlScratch+!!*gMacPerlScratch, gMacPerlScratch[0]));
break;
case cancel:
ST(0) = &PL_sv_undef;
break;
}
DisposeDialog(dlg);
}
#endif
MacPerl/MacPerl.xs view on Meta::CPAN
if (items > 1)
for (item = 1; item < items; item++) {
strcpy(gMacPerlScratch+1, (char *) SvPV_nolen(ST(item)));
*gMacPerlScratchString = strlen(gMacPerlScratch+1);
SetControlTitle(GetDlgCtrl(dlg, item), gMacPerlScratchString);
}
else
SetControlTitle(GetDlgCtrl(dlg, 1), "\pOK");
ShowWindow(dlg);
SetPort(dlg);
FrameDlgRect(dlg, ok);
ModalDialog((ModalFilterUPP)0, &item);
DisposeDialog(dlg);
RETVAL = (items > 1) ? items - item - 1 : 0;
}
#endif
OUTPUT:
RETVAL
void
MP_Choose(domain, type, prompt, ...)
int domain
int type
char * prompt
CODE:
#ifndef MACOS_TRADITIONAL
croak("Usage: MacPerl::Choose unsupported in Carbon");
#else
{
int flags;
STRLEN len;
char * constraint;
char * def_addr;
constraint = (items>=4) ? ((char *) SvPV(ST(3), len)) : nil;
constraint = constraint && len ? constraint : nil;
flags = (items>=5) ? ((int) SvIV(ST(4))) : 0;
def_addr = (items>=6) ? ((char *) SvPV(ST(5), len)) : nil;
def_addr = def_addr && len ? def_addr : nil;
gMacPerlScratch[0] = 0;
if (def_addr) {
memcpy(gMacPerlScratch, def_addr, len);
gMacPerlScratch[len] = 0; /* Some types require this */
}
len = 256; /* Len is output only! */
if (choose(domain, type, prompt, constraint, flags, gMacPerlScratch, &len) < 0 || !len)
ST(0) = &PL_sv_undef;
else
ST(0) = sv_2mortal(newSVpv(gMacPerlScratch, len));
}
#endif
void
MP_Pick(prompt, ...)
char * prompt
PPCODE:
#ifndef MACOS_TRADITIONAL
croak("Usage: MacPerl::Pick unsupported in Carbon");
#else
{
short itemHit;
STRLEN len;
Boolean done;
DialogPtr dlg;
Cell mycell;
short mytype;
Handle myhandle;
Point cellsize;
Rect listrect, dbounds;
char * item;
InitCursor();
dlg = GetNewDialog(2020, NULL, (WindowPtr)-1);
SetDlgText(dlg, 3, prompt);
GetDialogItem(dlg, 4, &mytype, &myhandle, &listrect);
SetDialogItem(dlg, 4, mytype, (Handle)&uMacListUpdate, &listrect);
SetPort(dlg);
InsetRect(&listrect, 1, 1);
SetRect(&dbounds, 0, 0, 1, items-1);
cellsize.h = (listrect.right - listrect.left);
cellsize.v = 17;
listrect.right -= 15;
gPickList = LNew(&listrect, &dbounds, cellsize, 0,
dlg, true, false, false, true);
gPickScalar = GIMME != G_ARRAY;
gPickList[0]->selFlags = !gPickScalar ? lExtendDrag+lUseSense : lOnlyOne;
LSetDrawingMode(false, gPickList);
SetCell(mycell, 0, 0);
for (; mycell.v<items-1; ++mycell.v) {
item = (char *) SvPV(ST(mycell.v+1), len);
LSetCell(item, len, mycell, gPickList);
}
LSetDrawingMode(true, gPickList);
ShowWindow(dlg);
for (done=false; !done; ) {
SetPort(dlg);
FrameDlgRect(dlg, ok);
ModalDialog((ModalFilterUPP) &uMacListFilter, &itemHit);
switch (itemHit) {
case ok:
SetCell(mycell, 0, 0);
done = true;
while (LGetSelect(true, &mycell, gPickList)) {
XPUSHs(sv_mortalcopy(ST(mycell.v+1)));
++mycell.v;
}
break;
case cancel:
done = true;
break;
}
} /* Modal Loop */
SetPort(dlg);
LDispose(gPickList);
gPickList = nil;
DisposeDialog(dlg);
}
#endif
int
MP_Quit(...)
CODE:
#ifndef MACOS_TRADITIONAL
croak("Usage: MacPerl::Quit unsupported in Carbon");
#else
if (items > 0)
gMacPerl_Quit = SvIV(ST(0));
RETVAL = gMacPerl_Quit;
#endif
OUTPUT:
RETVAL
int
MP_ErrorFormat(...)
CODE:
#ifndef MACOS_TRADITIONAL
croak("Usage: MacPerl::ErrorFormat unsupported in Carbon");
#else
if (items > 0)
gMacPerl_ErrorFormat = SvIV(ST(0));
RETVAL = gMacPerl_ErrorFormat;
#endif
OUTPUT:
RETVAL
void
MP_FAccess(file, cmd, ...)
char * file
unsigned cmd
PPCODE:
{
#ifndef MACOS_TRADITIONAL
croak("Usage: MacPerl::FAccess unsupported in Carbon");
#else
unsigned uarg;
Rect rarg;
SelectionRecord sarg;
char * name;
switch (cmd) {
case F_GFONTINFO:
if (faccess(file, cmd, (long *)&uarg) < 0)
XPUSHs(&PL_sv_undef);
else if (GIMME != G_ARRAY)
XPUSHs(sv_2mortal(newSViv(uarg >> 16)));
else {
GetFontName(uarg >> 16, gMacPerlScratchString);
XPUSHs(sv_2mortal(newSVpv(gMacPerlScratch+!!*gMacPerlScratch, *gMacPerlScratch)));
XPUSHs(sv_2mortal(newSViv(uarg & 0xFFFF)));
}
break;
case F_GSELINFO:
if (faccess(file, cmd, (long *)&sarg) < 0)
XPUSHs(&PL_sv_undef);
else if (GIMME != G_ARRAY)
XPUSHs(sv_2mortal(newSViv(sarg.startingPos)));
else {
XPUSHs(sv_2mortal(newSViv(sarg.startingPos)));
XPUSHs(sv_2mortal(newSViv(sarg.endingPos)));
XPUSHs(sv_2mortal(newSViv(sarg.displayTop)));
}
break;
case F_GTABINFO:
if (faccess(file, cmd, (long *)&uarg) < 0)
XPUSHs(&PL_sv_undef);
else
XPUSHs(sv_2mortal(newSViv(uarg)));
break;
case F_GWININFO:
if (faccess(file, cmd, (long *)&rarg) < 0)
XPUSHs(&PL_sv_undef);
else if (GIMME != G_ARRAY)
XPUSHs(sv_2mortal(newSViv(rarg.top)));
else {
XPUSHs(sv_2mortal(newSViv(rarg.left)));
XPUSHs(sv_2mortal(newSViv(rarg.top)));
XPUSHs(sv_2mortal(newSViv(rarg.right)));
XPUSHs(sv_2mortal(newSViv(rarg.bottom)));
}
break;
case F_SFONTINFO:
if (items < 3)
croak("Usage: MacPerl::FAccess(file, F_SFONTINFO, font [, size])");
name = SvPV_nolen(ST(2));
if (items == 3) {
if (faccess(file, F_GFONTINFO, (long *)&uarg) < 0)
uarg = 9;
} else
MacPerl/MacPerl.xs view on Meta::CPAN
break;
case F_SWININFO:
if (items < 4 )
croak("Usage: MacPerl::FAccess(file, F_SWININFO, left, top [, right [, bottom]])");
if (items < 6) {
if (faccess(file, F_GWININFO, (long *)&rarg) < 0)
rarg.bottom = rarg.right = 400;
else {
rarg.bottom = rarg.bottom - rarg.top + (short) SvIV(ST(3));
if (items == 4)
rarg.right = rarg.right - rarg.left + (short) SvIV(ST(2));
}
} else {
rarg.right = (short) SvIV(ST(4));
rarg.bottom = (short) SvIV(ST(5));
}
rarg.left = (short) SvIV(ST(2));
rarg.top = (short) SvIV(ST(3));
if (faccess(file, cmd, (long *)&rarg) < 0)
XPUSHs(&PL_sv_undef);
else
XPUSHs(sv_2mortal(newSViv(1)));
break;
default:
croak("MacPerl::FAccess() can't handle this command");
}
#endif
}
void
MP_MakeFSSpec(path)
char * path
CODE:
{
FSSpec spec;
if (GUSIPath2FSp(path, &spec))
ST(0) = &PL_sv_undef;
else
ST(0) = sv_2mortal(MP_GUSIFSp2Encoding(&spec, newSVpvn("", 0)));
}
void
MP_MakePath(path)
char * path
CODE:
{
FSSpec spec;
if (GUSIPath2FSp(path, &spec))
ST(0) = &PL_sv_undef;
else
ST(0) = sv_2mortal(MP_GUSIFSp2FullPath(&spec, newSVpvn("", 0)));
}
void
MP_Volumes()
PPCODE:
{
FSSpec spec;
if (GIMME != G_ARRAY) {
GUSISpecial2FSp('macs', kOnSystemDisk, &spec);
GetVolInfo(spec.vRefNum, false, &spec);
XPUSHs(sv_2mortal(MP_GUSIFSp2Encoding(&spec, newSVpvn("", 0))));
} else {
short index;
for (index = 0; !GetVolInfo(index+1, true, &spec); ++index)
XPUSHs(sv_2mortal(MP_GUSIFSp2Encoding(&spec, newSVpvn("", 0))));
}
}
BOOT:
{
/* This is all MacPerl-specific stuff */
#ifdef MACOS_TRADITIONAL
extern int StandAlone;
VersRecHndl vers = (VersRecHndl) GetResource('vers', 1);
int versLen = *(*vers)->shortVersion;
SV * version = get_sv("MacPerl::Version", TRUE | GV_ADDMULTI);
SV * arch = get_sv("MacPerl::Architecture", TRUE | GV_ADDMULTI);
SV * cc = get_sv("MacPerl::Compiler", TRUE | GV_ADDMULTI);
HLock((Handle) vers);
memcpy(gMacPerlScratch, (char *)(*vers)->shortVersion+1, versLen);
if (StandAlone)
strcpy(gMacPerlScratch+versLen, " Application");
else
strcpy(gMacPerlScratch+versLen, " MPW");
sv_setpv(version, gMacPerlScratch);
SvREADONLY_on(version);
sv_setpv(arch, ARCHNAME);
SvREADONLY_on(arch);
sv_setpv(cc, CC);
SvREADONLY_on(cc);
#endif
}
( run in 0.532 second using v1.01-cache-2.11-cpan-5511b514fd6 )