hodas@eniac.seas.upenn.edu (Josh Hodas) (07/25/88)
[Xlisp 2.0 Partial Sources]
These are partial sources to XLISP 2.0.
Josh
--
Josh Hodas (hodas@eniac.seas.upenn.edu)
4223 Pine Street
Philadelphia, PA 19104
(215) 222-7112 (home)
(215) 898-9515 (school office)
---
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# macfun.c
# macint.c
# macstuff.c
# osdefs.h
# osptrs.h
# xlisp.r
# This archive created: Mon Jul 25 07:46:59 1988
# By: Roger L. Long (bytebug@dhw68k.cts.com)
export PATH; PATH=/bin:$PATH
echo shar: extracting "'macfun.c'" '(5908 characters)'
if test -f 'macfun.c'
then
echo shar: will not over-write existing file "'macfun.c'"
else
sed 's/^X//' << \SHAR_EOF > 'macfun.c'
X/* macfun.c - macintosh user interface functions for xlisp */
X
X#include <Quickdraw.h>
X#include <WindowMgr.h>
X#include <MemoryMgr.h>
X#include "xlisp.h"
X
X/* external variables */
Xextern GrafPtr cwindow,gwindow;
X
X/* forward declarations */
XFORWARD LVAL do_0();
XFORWARD LVAL do_1();
XFORWARD LVAL do_2();
X
X/* xptsize - set the command window point size */
XLVAL xptsize()
X{
X LVAL val;
X val = xlgafixnum();
X xllastarg();
X TextSize((int)getfixnum(val));
X InvalRect(&cwindow->portRect);
X SetupScreen();
X return (NIL);
X}
X
X/* xhidepen - hide the pen */
XLVAL xhidepen()
X{
X return (do_0('H'));
X}
X
X/* xshowpen - show the pen */
XLVAL xshowpen()
X{
X return (do_0('S'));
X}
X
X/* xgetpen - get the pen position */
XLVAL xgetpen()
X{
X LVAL val;
X Point p;
X xllastarg();
X SetPort(gwindow);
X GetPen(&p);
X SetPort(cwindow);
X xlsave1(val);
X val = consa(NIL);
X rplaca(val,cvfixnum((FIXTYPE)p.h));
X rplacd(val,cvfixnum((FIXTYPE)p.v));
X xlpop();
X return (val);
X}
X
X/* xpenmode - set the pen mode */
XLVAL xpenmode()
X{
X return (do_1('M'));
X}
X
X/* xpensize - set the pen size */
XLVAL xpensize()
X{
X return (do_2('S'));
X}
X
X/* xpenpat - set the pen pattern */
XLVAL xpenpat()
X{
X LVAL plist;
X char pat[8],i;
X plist = xlgalist();
X xllastarg();
X for (i = 0; i < 8 && consp(plist); ++i, plist = cdr(plist))
X if (fixp(car(plist)))
X pat[i] = getfixnum(car(plist));
X SetPort(gwindow);
X PenPat(pat);
X SetPort(cwindow);
X return (NIL);
X}
X
X/* xpennormal - set the pen to normal */
XLVAL xpennormal()
X{
X xllastarg();
X SetPort(gwindow);
X PenNormal();
X SetPort(cwindow);
X return (NIL);
X}
X
X/* xmoveto - Move to a screen location */
XLVAL xmoveto()
X{
X return (do_2('m'));
X}
X
X/* xmove - Move in a specified direction */
XLVAL xmove()
X{
X return (do_2('M'));
X}
X
X/* xlineto - draw a Line to a screen location */
XLVAL xlineto()
X{
X return (do_2('l'));
X}
X
X/* xline - draw a Line in a specified direction */
XLVAL xline()
X{
X return (do_2('L'));
X}
X
X/* xshowgraphics - show the graphics window */
XLVAL xshowgraphics()
X{
X xllastarg();
X scrsplit(1);
X return (NIL);
X}
X
X/* xhidegraphics - hide the graphics window */
XLVAL xhidegraphics()
X{
X xllastarg();
X scrsplit(0);
X return (NIL);
X}
X
X/* xcleargraphics - clear the graphics window */
XLVAL xcleargraphics()
X{
X xllastarg();
X SetPort(gwindow);
X EraseRect(&gwindow->portRect);
X SetPort(cwindow);
X return (NIL);
X}
X
X/* do_0 - Handle commands that require no arguments */
XLOCAL LVAL do_0(fcn)
X int fcn;
X{
X xllastarg();
X SetPort(gwindow);
X switch (fcn) {
X case 'H': HidePen(); break;
X case 'S': ShowPen(); break;
X }
X SetPort(cwindow);
X return (NIL);
X}
X
X/* do_1 - Handle commands that require one integer argument */
XLOCAL LVAL do_1(fcn)
X int fcn;
X{
X int x;
X x = getnumber();
X xllastarg();
X SetPort(gwindow);
X switch (fcn) {
X case 'M': PenMode(x); break;
X }
X SetPort(cwindow);
X return (NIL);
X}
X
X/* do_2 - Handle commands that require two integer arguments */
XLOCAL LVAL do_2(fcn)
X int fcn;
X{
X int h,v;
X h = getnumber();
X v = getnumber();
X xllastarg();
X SetPort(gwindow);
X switch (fcn) {
X case 'l': LineTo(h,v); break;
X case 'L': Line(h,v); break;
X case 'm': MoveTo(h,v); break;
X case 'M': Move(h,v); break;
X case 'S': PenSize(h,v);break;
X }
X SetPort(cwindow);
X return (NIL);
X}
X
X/* getnumber - get an integer parameter */
XLOCAL int getnumber()
X{
X LVAL num;
X num = xlgafixnum();
X return ((int)getfixnum(num));
X}
X
X/* xtool - call the toolbox */
XLVAL xtool()
X{
X LVAL val;
X int trap;
X
X trap = getnumber();
X/*
X
X asm {
X move.l args(A6),D0
X beq L2
XL1: move.l D0,A0
X move.l 2(A0),A1
X move.w 4(A1),-(A7)
X move.l 6(A0),D0
X bne L1
XL2: lea L3,A0
X move.w trap(A6),(A0)
XL3: dc.w 0xA000
X clr.l val(A6)
X }
X*/
X
X return (val);
X}
X
X/* xtool16 - call the toolbox with a 16 bit result */
XLVAL xtool16()
X{
X int trap,val;
X
X trap = getnumber();
X/*
X
X asm {
X clr.w -(A7)
X move.l args(A6),D0
X beq L2
XL1: move.l D0,A0
X move.l 2(A0),A1
X move.w 4(A1),-(A7)
X move.l 6(A0),D0
X bne L1
XL2: lea L3,A0
X move.w trap(A6),(A0)
XL3: dc.w 0xA000
X move.w (A7)+,val(A6)
X }
X*/
X
X return (cvfixnum((FIXTYPE)val));
X}
X
X/* xtool32 - call the toolbox with a 32 bit result */
XLVAL xtool32()
X{
X int trap;
X long val;
X
X trap = getnumber();
X/*
X
X asm {
X clr.l -(A7)
X move.l args(A6),D0
X beq L2
XL1: move.l D0,A0
X move.l 2(A0),A1
X move.w 4(A1),-(A7)
X move.l 6(A0),D0
X bne L1
XL2: lea L3,A0
X move.w trap(A6),(A0)
XL3: dc.w 0xA000
X move.l (A7)+,val(A6)
X }
X*/
X
X return (cvfixnum((FIXTYPE)val));
X}
X
X/* xnewhandle - allocate a new handle */
XLVAL xnewhandle()
X{
X LVAL num;
X long size;
X num = xlgafixnum(); size = getfixnum(num);
X xllastarg();
X return (cvfixnum((FIXTYPE)NewHandle(size)));
X}
X
X/* xnewptr - allocate memory */
XLVAL xnewptr()
X{
X LVAL num;
X long size;
X num = xlgafixnum(); size = getfixnum(num);
X xllastarg();
X return (cvfixnum((FIXTYPE)NewPtr(size)));
X}
X
X/* xhiword - return the high order 16 bits of an integer */
XLVAL xhiword()
X{
X unsigned int val;
X val = (unsigned int)(getnumber() >> 16);
X xllastarg();
X return (cvfixnum((FIXTYPE)val));
X}
X
X/* xloword - return the low order 16 bits of an integer */
XLVAL xloword()
X{
X unsigned int val;
X val = (unsigned int)getnumber();
X xllastarg();
X return (cvfixnum((FIXTYPE)val));
X}
X
X/* xrdnohang - get the next character in the look-ahead buffer */
XLVAL xrdnohang()
X{
X int ch;
X xllastarg();
X if ((ch = scrnextc()) == EOF)
X return (NIL);
X return (cvfixnum((FIXTYPE)ch));
X}
X
X/* ossymbols - enter important symbols */
Xossymbols()
X{
X LVAL sym;
X
X /* setup globals for the window handles */
X sym = xlenter("*COMMAND-WINDOW*");
X setvalue(sym,cvfixnum((FIXTYPE)cwindow));
X sym = xlenter("*GRAPHICS-WINDOW*");
X setvalue(sym,cvfixnum((FIXTYPE)gwindow));
X}
SHAR_EOF
if test 5908 -ne "`wc -c < 'macfun.c'`"
then
echo shar: error transmitting "'macfun.c'" '(should have been 5908 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'macint.c'" '(13207 characters)'
if test -f 'macint.c'
then
echo shar: will not over-write existing file "'macint.c'"
else
sed 's/^X//' << \SHAR_EOF > 'macint.c'
X/* macint.c - macintosh interface routines for xlisp */
X
X#include <MacTypes.h>
X#include <Quickdraw.h>
X#include <WindowMgr.h>
X#include <EventMgr.h>
X#include <DialogMgr.h>
X#include <MenuMgr.h>
X#include <PackageMgr.h>
X#include <StdFilePkg.h>
X#include <MemoryMgr.h>
X#include <DeskMgr.h>
X#include <FontMgr.h>
X#include <ControlMgr.h>
X#include <SegmentLdr.h>
X#include <FileMgr.h>
X
X/* program limits */
X#define SCRH 40 /* maximum screen height */
X#define SCRW 100 /* maximum screen width */
X#define CHARMAX 100 /* maximum number of buffered characters */
X#define TIMEON 40 /* cursor on time */
X#define TIMEOFF 20 /* cursor off time */
X
X/* useful definitions */
X#define MenuBarHeight 20
X#define TitleBarHeight 20
X#define SBarWidth 16
X#define MinWidth 80
X#define MinHeight 40
X#define ScreenMargin 2
X#define TextMargin 4
X#define GHeight 232
X
X/* menu id's */
X#define appleID 1
X#define fileID 256
X#define editID 257
X#define controlID 258
X
X/* externals */
Xextern char *s_unbound;
Xextern char *PtoCstr();
X
X/* screen dimensions */
Xint screenWidth;
Xint screenHeight;
X
X/* command window (normal screen) */
Xint nHorizontal,nVertical,nWidth,nHeight;
X
X/* command window (split screen) */
Xint sHorizontal,sVertical,sWidth,sHeight;
X
X/* graphics window */
Xint gHorizontal,gVertical,gWidth,gHeight;
X
X/* menu handles */
XMenuHandle appleMenu;
XMenuHandle fileMenu;
XMenuHandle editMenu;
XMenuHandle controlMenu;
X
X/* misc variables */
XOSType filetypes[] = { 'TEXT' };
X
X/* font information */
Xint tmargin,lmargin;
Xint xinc,yinc;
X
X/* command window */
XWindowRecord cwrecord;
XWindowPtr cwindow;
X
X/* graphics window */
XWindowRecord gwrecord;
XWindowPtr gwindow;
X
X/* window mode */
Xint splitmode;
X
X/* cursor variables */
Xlong cursortime;
Xint cursorstate;
Xint x,y;
X
X/* screen buffer */
Xchar screen[SCRH*SCRW],*topline,*curline;
Xint scrh,scrw;
X
X/* type ahead buffer */
Xchar charbuf[CHARMAX],*inptr,*outptr;
Xint charcnt;
X
Xmacinit()
X{
X /* initialize the toolbox */
X InitGraf(&thePort);
X InitFonts();
X InitWindows();
X InitMenus();
X TEInit();
X InitDialogs(0L);
X InitCursor();
X
X /* setup the menu bar */
X SetupMenus();
X
X /* get the size of the screen */
X screenWidth = screenBits.bounds.right - screenBits.bounds.left;
X screenHeight = screenBits.bounds.bottom - screenBits.bounds.top;
X
X /* Create the graphics and control windows */
X gwindow = GetNewWindow(129,&gwrecord,-1L);
X cwindow = GetNewWindow(128,&cwrecord,-1L);
X
X /* establish the command window as the current port */
X SetPort(cwindow);
X
X /* compute the size of the normal command window */
X nHorizontal = ScreenMargin;
X nVertical = MenuBarHeight + TitleBarHeight + ScreenMargin - 2;
X nWidth = screenWidth - (ScreenMargin * 2) - 1;
X nHeight = screenHeight - MenuBarHeight - TitleBarHeight - (ScreenMargin * 2);
X
X /* compute the size of the split command window */
X sHorizontal = nHorizontal;
X sVertical = nVertical + GHeight + 1;
X sWidth = nWidth;
X sHeight = nHeight - GHeight - 1;
X
X /* compute the size of the graphics window */
X gHorizontal = nHorizontal;
X gVertical = MenuBarHeight + ScreenMargin;
X gWidth = screenWidth - (ScreenMargin * 2);
X gHeight = GHeight;
X
X /* move and size the graphics window */
X MoveWindow(gwindow,gHorizontal,gVertical,0);
X SizeWindow(gwindow,gWidth,gHeight,0);
X
X /* setup the font, size and writing mode for the command window */
X TextFont(monaco); TextSize(9); TextMode(srcCopy);
X
X /* setup command mode */
X scrsplit(FALSE);
X
X /* disable the Cursor */
X cursorstate = -1;
X
X /* setup the input ring buffer */
X inptr = outptr = charbuf;
X charcnt = 0;
X
X /* lock the font in memory */
X SetFontLock(-1);
X}
X
XSetupMenus()
X{
X appleMenu = GetMenu(appleID); /* setup the apple menu */
X AddResMenu(appleMenu,'DRVR');
X InsertMenu(appleMenu,0);
X fileMenu = GetMenu(fileID); /* setup the file menu */
X InsertMenu(fileMenu,0);
X editMenu = GetMenu(editID); /* setup the edit menu */
X InsertMenu(editMenu,0);
X controlMenu = GetMenu(controlID); /* setup the control menu */
X InsertMenu(controlMenu,0);
X DrawMenuBar();
X}
X
Xint scrgetc()
X{
X CursorOn();
X while (charcnt == 0)
X DoEvent();
X CursorOff();
X return (scrnextc());
X}
X
Xint scrnextc()
X{
X int ch;
X if (charcnt > 0) {
X ch = *outptr++; charcnt--;
X if (outptr >= &charbuf[CHARMAX])
X outptr = charbuf;
X }
X else {
X charcnt = 0;
X ch = -1;
X }
X return (ch);
X}
X
Xscrputc(ch)
X int ch;
X{
X switch (ch) {
X case '\r':
X x = 0;
X break;
X case '\n':
X nextline(&curline);
X if (++y >= scrh) {
X y = scrh - 1;
X scrollup();
X }
X break;
X case '\t':
X do { scrputc(' '); } while (x & 7);
X break;
X case '\010':
X if (x) x--;
X break;
X default:
X if (ch >= 0x20 && ch < 0x7F) {
X scrposition(x,y);
X DrawChar(ch);
X curline[x] = ch;
X if (++x >= scrw) {
X nextline(&curline);
X if (++y >= scrh) {
X y = scrh - 1;
X scrollup();
X }
X x = 0;
X }
X }
X break;
X }
X}
X
Xscrdelete()
X{
X scrputc('\010');
X scrputc(' ');
X scrputc('\010');
X}
X
Xscrclear()
X{
X curline = screen;
X for (y = 0; y < SCRH; y++)
X for (x = 0; x < SCRW; x++)
X *curline++ = ' ';
X topline = curline = screen;
X x = y = 0;
X}
X
Xscrflush()
X{
X inptr = outptr = charbuf;
X charcnt = -1;
X osflush();
X}
X
Xscrposition(x,y)
X int x,y;
X{
X MoveTo((x * xinc) + lmargin,(y * yinc) + tmargin);
X}
X
XDoEvent()
X{
X EventRecord myEvent;
X
X SystemTask();
X CursorUpdate();
X
X while (GetNextEvent(everyEvent,&myEvent))
X switch (myEvent.what) {
X case mouseDown:
X DoMouseDown(&myEvent);
X break;
X case keyDown:
X case autoKey:
X DoKeyPress(&myEvent);
X break;
X case activateEvt:
X DoActivate(&myEvent);
X break;
X case updateEvt:
X DoUpdate(&myEvent);
X break;
X }
X}
X
XDoMouseDown(myEvent)
X EventRecord *myEvent;
X{
X WindowPtr whichWindow;
X
X switch (FindWindow(myEvent->where,&whichWindow)) {
X case inMenuBar:
X DoMenuClick(myEvent);
X break;
X case inSysWindow:
X SystemClick(myEvent,whichWindow);
X break;
X case inDrag:
X DoDrag(myEvent,whichWindow);
X break;
X case inGoAway:
X DoGoAway(myEvent,whichWindow);
X break;
X case inGrow:
X DoGrow(myEvent,whichWindow);
X break;
X case inContent:
X DoContent(myEvent,whichWindow);
X break;
X }
X}
X
XDoMenuClick(myEvent)
X EventRecord *myEvent;
X{
X long choice;
X if (choice = MenuSelect(myEvent->where))
X DoCommand(choice);
X}
X
XDoDrag(myEvent,whichWindow)
X EventRecord *myEvent;
X WindowPtr whichWindow;
X{
X Rect dragRect;
X SetRect(&dragRect,0,MenuBarHeight,screenWidth,screenHeight);
X InsetRect(&dragRect,ScreenMargin,ScreenMargin);
X DragWindow(whichWindow,myEvent->where,&dragRect);
X}
X
XDoGoAway(myEvent,whichWindow)
X EventRecord *myEvent;
X WindowPtr whichWindow;
X{
X if (TrackGoAway(whichWindow,myEvent->where))
X wrapup();
X}
X
XDoGrow(myEvent,whichWindow)
X EventRecord *myEvent;
X WindowPtr whichWindow;
X{
X Rect sizeRect;
X long newSize;
X if (whichWindow != FrontWindow() && whichWindow != gwindow)
X SelectWindow(whichWindow);
X else {
X SetRect(&sizeRect,MinWidth,MinHeight,screenWidth,screenHeight-MenuBarHeight);
X newSize = GrowWindow(whichWindow,myEvent->where,&sizeRect);
X if (newSize) {
X EraseRect(&whichWindow->portRect);
X SizeWindow(whichWindow,LoWord(newSize),HiWord(newSize),-1);
X InvalRect(&whichWindow->portRect);
X SetupScreen();
X scrflush();
X }
X }
X}
X
XDoContent(myEvent,whichWindow)
X EventRecord *myEvent;
X WindowPtr whichWindow;
X{
X if (whichWindow != FrontWindow() && whichWindow != gwindow)
X SelectWindow(whichWindow);
X}
X
XDoKeyPress(myEvent)
X EventRecord *myEvent;
X{
X long choice;
X
X if (FrontWindow() == cwindow) {
X if (myEvent->modifiers & 0x100) {
X if (choice = MenuKey((char)myEvent->message))
X DoCommand(choice);
X }
X else {
X if (charcnt < CHARMAX) {
X *inptr++ = myEvent->message & 0xFF; charcnt++;
X if (inptr >= &charbuf[CHARMAX])
X inptr = charbuf;
X }
X }
X }
X}
X
XDoActivate(myEvent)
X EventRecord *myEvent;
X{
X WindowPtr whichWindow;
X whichWindow = (WindowPtr)myEvent->message;
X SetPort(whichWindow);
X if (whichWindow == cwindow)
X DrawGrowIcon(whichWindow);
X}
X
XDoUpdate(myEvent)
X EventRecord *myEvent;
X{
X WindowPtr whichWindow;
X GrafPtr savePort;
X GetPort(&savePort);
X whichWindow = (WindowPtr)myEvent->message;
X SetPort(whichWindow);
X BeginUpdate(whichWindow);
X EraseRect(&whichWindow->portRect);
X if (whichWindow == cwindow) {
X DrawGrowIcon(whichWindow);
X RedrawScreen();
X }
X EndUpdate(whichWindow);
X SetPort(savePort);
X}
X
XDoCommand(choice)
X long choice;
X{
X int theMenu,theItem;
X
X /* decode the menu choice */
X theMenu = HiWord(choice);
X theItem = LoWord(choice);
X
X CursorOff();
X HiliteMenu(theMenu);
X switch (theMenu) {
X case appleID:
X DoAppleMenu(theItem);
X break;
X case fileID:
X DoFileMenu(theItem);
X break;
X case editID:
X DoEditMenu(theItem);
X break;
X case controlID:
X DoControlMenu(theItem);
X break;
X }
X HiliteMenu(0);
X CursorOn();
X}
X
Xpascal aboutfilter(theDialog,theEvent,itemHit)
X DialogPtr theDialog; EventRecord *theEvent; int *itemHit;
X{
X return (theEvent->what == mouseDown ? -1 : 0);
X}
X
XDoAppleMenu(theItem)
X int theItem;
X{
X DialogRecord mydialog;
X char name[256];
X GrafPtr gp;
X int n;
X
X switch (theItem) {
X case 1:
X GetNewDialog(129,&mydialog,-1L);
X ModalDialog(aboutfilter,&n);
X CloseDialog(&mydialog);
X break;
X default:
X GetItem(appleMenu,theItem,name);
X GetPort(&gp);
X OpenDeskAcc(name);
X SetPort(gp);
X break;
X }
X}
X
Xpascal int filefilter(pblock)
X ParmBlkPtr pblock;
X{
X unsigned char *p; int len;
X p = pblock->fileParam.ioNamePtr; len = *p++ &0xFF;
X return (len >= 4 && strncmp(p+len-4,".lsp",4) == 0 ? 0 : -1);
X}
X
XDoFileMenu(theItem)
X int theItem;
X{
X SFReply loadfile;
X Point p;
X
X switch (theItem) {
X case 1: /* load */
X case 2: /* load noisily */
X p.h = 100; p.v = 100;
X SFGetFile(p,"\P",filefilter,-1,filetypes,0L,&loadfile);
X if (loadfile.good) {
X HiliteMenu(0);
X SetVol(0L,loadfile.vRefNum);
X if (xlload(PtoCstr(loadfile.fName),1,(theItem == 1 ? 0 : 1)))
X scrflush();
X else
X xlabort("load error");
X }
X break;
X case 4: /* quit */
X wrapup();
X }
X}
X
XDoEditMenu(theItem)
X int theItem;
X{
X switch (theItem) {
X case 1: /* undo */
X case 3: /* cut */
X case 4: /* copy */
X case 5: /* paste */
X case 6: /* clear */
X SystemEdit(theItem-1);
X break;
X }
X}
X
XDoControlMenu(theItem)
X int theItem;
X{
X scrflush();
X HiliteMenu(0);
X switch (theItem) {
X case 1: /* break */
X xlbreak("user break",s_unbound);
X break;
X case 2: /* continue */
X xlcontinue();
X break;
X case 3: /* clean-up error */
X xlcleanup();
X break;
X case 4: /* Cancel input */
X xlabort("input canceled");
X break;
X case 5: /* Top Level */
X xltoplevel();
X break;
X case 7: /* split screen */
X scrsplit(splitmode ? FALSE : TRUE);
X break;
X }
X}
X
Xscrsplit(split)
X int split;
X{
X ShowHide(cwindow,0);
X if (split) {
X CheckItem(controlMenu,7,-1);
X ShowHide(gwindow,-1);
X MoveWindow(cwindow,sHorizontal,sVertical,-1);
X SizeWindow(cwindow,sWidth,sHeight,-1);
X InvalRect(&cwindow->portRect);
X SetupScreen();
X }
X else {
X CheckItem(controlMenu,7,0);
X ShowHide(gwindow,0);
X MoveWindow(cwindow,nHorizontal,nVertical,-1);
X SizeWindow(cwindow,nWidth,nHeight,-1);
X InvalRect(&cwindow->portRect);
X SetupScreen();
X }
X ShowHide(cwindow,-1);
X splitmode = split;
X}
X
XSetupScreen()
X{
X FontInfo info;
X Rect *pRect;
X
X /* get font information */
X GetFontInfo(&info);
X
X /* compute the top and bottom margins */
X tmargin = TextMargin + info.ascent;
X lmargin = TextMargin;
X
X /* compute the x and y increments */
X xinc = info.widMax;
X yinc = info.ascent + info.descent + info.leading;
X
X /* compute the character dimensions of the screen */
X pRect = &cwindow->portRect;
X scrh = (pRect->bottom - (2 * TextMargin) - (SBarWidth - 1)) / yinc;
X if (scrh > SCRH) scrh = SCRH;
X scrw = (pRect->right - (2 * TextMargin) - (SBarWidth - 1)) / xinc;
X if (scrw > SCRW) scrw = SCRW;
X
X /* clear the screen */
X scrclear();
X}
X
XCursorUpdate()
X{
X if (cursorstate != -1)
X if (cursortime < TickCount()) {
X scrposition(x,y);
X if (cursorstate) {
X DrawChar(' ');
X cursortime = TickCount() + TIMEOFF;
X cursorstate = 0;
X }
X else {
X DrawChar('_');
X cursortime = TickCount() + TIMEON;
X cursorstate = 1;
X }
X }
X}
X
XCursorOn()
X{
X cursortime = TickCount();
X cursorstate = 0;
X}
X
XCursorOff()
X{
X if (cursorstate == 1) {
X scrposition(x,y);
X DrawChar(' ');
X }
X cursorstate = -1;
X}
X
XRedrawScreen()
X{
X char *Line; int y;
X Line = topline;
X for (y = 0; y < scrh; y++) {
X scrposition(0,y);
X DrawText(Line,0,scrw);
X nextline(&Line);
X }
X}
X
Xnextline(pline)
X char **pline;
X{
X if ((*pline += SCRW) >= &screen[SCRH*SCRW])
X *pline = screen;
X}
X
Xscrollup()
X{
X RgnHandle updateRgn;
X Rect rect;
X int x;
X updateRgn = NewRgn();
X rect = cwindow->portRect;
X rect.bottom -= SBarWidth - 1;
X rect.right -= SBarWidth - 1;
X ScrollRect(&rect,0,-yinc,updateRgn);
X DisposeRgn(updateRgn);
X for (x = 0; x < SCRW; x++)
X topline[x] = ' ';
X nextline(&topline);
X}
SHAR_EOF
if test 13207 -ne "`wc -c < 'macint.c'`"
then
echo shar: error transmitting "'macint.c'" '(should have been 13207 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'macstuff.c'" '(2425 characters)'
if test -f 'macstuff.c'
then
echo shar: will not over-write existing file "'macstuff.c'"
else
sed 's/^X//' << \SHAR_EOF > 'macstuff.c'
X/* macstuff.c - macintosh interface routines for xlisp */
X
X#include <stdio.h>
X
X/* program limits */
X#define LINEMAX 200 /* maximum line length */
X
X/* externals */
Xextern FILE *tfp;
Xextern int x;
X
X/* local variables */
Xstatic char linebuf[LINEMAX+1],*lineptr;
Xstatic int linepos[LINEMAX],linelen;
Xstatic long rseed = 1L;
X
Xosinit(name)
X char *name;
X{
X /* initialize the mac interface routines */
X macinit();
X
X /* initialize the line editor */
X linelen = 0;
X}
X
Xosfinish()
X{
X}
X
Xoserror(msg)
X{
X char line[100],*p;
X sprintf(line,"error: %s\n",msg);
X for (p = line; *p != '\0'; ++p)
X ostputc(*p);
X}
X
Xint osrand(n)
X int n;
X{
X long k1;
X
X /* make sure we don't get stuck at zero */
X if (rseed == 0L) rseed = 1L;
X
X /* algorithm taken from Dr. Dobbs Journal, November 1985, Page 91 */
X k1 = rseed / 127773L;
X if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
X rseed += 2147483647L;
X
X /* return a random number between 0 and n-1 */
X return ((int)(rseed % (long)n));
X}
X
XFILE *osaopen(name,mode)
X char *name,*mode;
X{
X return (fopen(name,mode));
X}
X
XFILE *osbopen(name,mode)
X char *name,*mode;
X{
X char nmode[4];
X strcpy(nmode,mode); strcat(nmode,"b");
X return (fopen(name,nmode));
X}
X
Xint osclose(fp)
X FILE *fp;
X{
X return (fclose(fp));
X}
X
Xint osagetc(fp)
X FILE *fp;
X{
X return (getc(fp));
X}
X
Xint osbgetc(fp)
X FILE *fp;
X{
X return (getc(fp));
X}
X
Xint osaputc(ch,fp)
X int ch; FILE *fp;
X{
X return (putc(ch,fp));
X}
X
Xint osbputc(ch,fp)
X int ch; FILE *fp;
X{
X return (putc(ch,fp));
X}
X
Xint ostgetc()
X{
X int ch,i;
X
X if (linelen--) return (*lineptr++);
X linelen = 0;
X while ((ch = scrgetc()) != '\r')
X switch (ch) {
X case EOF:
X return (ostgetc());
X case '\010':
X if (linelen > 0) {
X linelen--;
X while (x > linepos[linelen])
X scrdelete();
X }
X break;
X default:
X if (linelen < LINEMAX) {
X linebuf[linelen] = ch;
X linepos[linelen] = x;
X linelen++;
X }
X scrputc(ch);
X break;
X }
X linebuf[linelen++] = '\n';
X scrputc('\r'); scrputc('\n');
X if (tfp)
X for (i = 0; i < linelen; ++i)
X osaputc(linebuf[i],tfp);
X lineptr = linebuf; linelen--;
X return (*lineptr++);
X}
X
Xint ostputc(ch)
X int ch;
X{
X if (ch == '\n')
X scrputc('\r');
X scrputc(ch);
X if (tfp)
X osaputc(ch,tfp);
X return (1);
X}
X
Xosflush()
X{
X lineptr = linebuf;
X linelen = 0;
X}
X
Xoscheck()
X{
X DoEvent();
X}
X
SHAR_EOF
if test 2425 -ne "`wc -c < 'macstuff.c'`"
then
echo shar: error transmitting "'macstuff.c'" '(should have been 2425 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'osdefs.h'" '(306 characters)'
if test -f 'osdefs.h'
then
echo shar: will not over-write existing file "'osdefs.h'"
else
sed 's/^X//' << \SHAR_EOF > 'osdefs.h'
Xextern LVAL xptsize(),
X xhidepen(),xshowpen(),xgetpen(),xpensize(),xpenmode(),
X xpenpat(),xpennormal(),xmoveto(),xmove(),xlineto(),xline(),
X xshowgraphics(),xhidegraphics(),xcleargraphics(),
X xtool(),xtool16(),xtool32(),xnewhandle(),xnewptr(),
X xhiword(),xloword(),xrdnohang();
X
SHAR_EOF
if test 306 -ne "`wc -c < 'osdefs.h'`"
then
echo shar: error transmitting "'osdefs.h'" '(should have been 306 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'osptrs.h'" '(977 characters)'
if test -f 'osptrs.h'
then
echo shar: will not over-write existing file "'osptrs.h'"
else
sed 's/^X//' << \SHAR_EOF > 'osptrs.h'
X{ "HIDEPEN", S, xhidepen }, /* 300 */
X{ "SHOWPEN", S, xshowpen }, /* 301 */
X{ "GETPEN", S, xgetpen }, /* 302 */
X{ "PENSIZE", S, xpensize }, /* 303 */
X{ "PENMODE", S, xpenmode }, /* 304 */
X{ "PENPAT", S, xpenpat }, /* 305 */
X{ "PENNORMAL", S, xpennormal }, /* 306 */
X{ "MOVETO", S, xmoveto }, /* 307 */
X{ "MOVE", S, xmove }, /* 308 */
X{ "LINETO", S, xlineto }, /* 309 */
X{ "LINE", S, xline }, /* 310 */
X{ "SHOW-GRAPHICS", S, xshowgraphics }, /* 311 */
X{ "HIDE-GRAPHICS", S, xhidegraphics }, /* 312 */
X{ "CLEAR-GRAPHICS", S, xcleargraphics }, /* 313 */
X{ "TOOLBOX", S, xtool }, /* 314 */
X{ "TOOLBOX-16", S, xtool16 }, /* 315 */
X{ "TOOLBOX-32", S, xtool32 }, /* 316 */
X{ "NEWHANDLE", S, xnewhandle }, /* 317 */
X{ "NEWPTR", S, xnewptr }, /* 318 */
X{ "HIWORD", S, xhiword }, /* 319 */
X{ "LOWORD", S, xloword }, /* 320 */
X{ "READ-CHAR-NO-HANG", S, xrdnohang }, /* 321 */
X{ "COMMAND-POINT-SIZE", S, xptsize }, /* 322 */
X
SHAR_EOF
if test 977 -ne "`wc -c < 'osptrs.h'`"
then
echo shar: error transmitting "'osptrs.h'" '(should have been 977 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'xlisp.r'" '(956 characters)'
if test -f 'xlisp.r'
then
echo shar: will not over-write existing file "'xlisp.r'"
else
sed 's/^X//' << \SHAR_EOF > 'xlisp.r'
XXLisp.Rsrc
X
XTYPE WIND
X ,128
XXLISP version 2.0
X41 4 339 508
XInVisible GoAway
X0
X0
X
XTYPE WIND
X ,129
XGraphics Window
X22 4 254 508
XInVisible NoGoAway
X2
X0
X
XTYPE DLOG
X ,129
XAbout XLISP
X50 100 290 395
XVisible NoGoAway
X3
X0
X129
X
XTYPE DITL
X ,129
X9
X
XstaticText
X20 20 40 275
XXLISP v2.0, February 6, 1988
X
XstaticText
X40 20 60 275
XCopyright (c) 1988, by David Betz
X
XstaticText
X60 20 80 275
XAll Rights Reserved
X
XstaticText
X90 20 110 275
XAuthor contact information:
X
XstaticText
X110 40 130 275
XDavid Betz
X
XstaticText
X130 40 150 275
X127 Taylor Road
X
XstaticText
X150 40 170 275
XPeterborough, NH 03458
X
XstaticText
X170 40 190 275
X(603) 924-6936
X
XstaticText
X200 20 220 275
XPortions Copyright Think Technologies
X
XTYPE MENU
X ,1
X\14
XAbout XLISP
X(-
X
XTYPE MENU
X ,256
XFile
XLoad.../L
XLoad Noisily.../N
X(-
XQuit/Q
X
XTYPE MENU
X ,257
XEdit
XUndo/Z
X(-
XCut/X
XCopy/C
XPaste/V
XClear
X
XTYPE MENU
X ,258
XControl
XBreak/B
XContinue/P
XClean Up Error/G
XCancel Input/U
XTop Level/T
X(-
XSplit Screen/S
X
SHAR_EOF
if test 956 -ne "`wc -c < 'xlisp.r'`"
then
echo shar: error transmitting "'xlisp.r'" '(should have been 956 characters)'
fi
fi # end of overwriting check
# End of shell archive
exit 0
---