/* macfun.c - macintosh user interface functions for xlisp */

#include <Quickdraw.h>
#include <Windows.h>	/* was WindowMgr.h -- RBD */
#include <Memory.h>		/* was MemoryMgr.h -- RBD */
#include "xlisp.h"

/* external variables */
extern GrafPtr cwindow,gwindow;

/* forward declarations */
FORWARD LOCAL LVAL do_0(int fcn);
FORWARD LOCAL LVAL do_1(int fcn);
FORWARD LOCAL LVAL do_2(int fcn);
FORWARD LOCAL int getnumber(void);

/* xptsize - set the command window point size */
LVAL xptsize(void)
{
    LVAL val;
    val = xlgafixnum();
    xllastarg();
    TextSize((int)getfixnum(val));
    InvalRect(&cwindow->portRect);
    SetupScreen();
    return (NIL);
}

/* xhidepen - hide the pen */
LVAL xhidepen(void)
{
    return (do_0('H'));
}

/* xshowpen - show the pen */
LVAL xshowpen(void)
{
    return (do_0('S'));
}

/* xgetpen - get the pen position */
LVAL xgetpen(void)
{
    LVAL val;
    Point p;
    xllastarg();
    SetPort(gwindow);
    GetPen(&p);
    SetPort(cwindow);
    xlsave1(val);
    val = consa(NIL);
    rplaca(val,cvfixnum((FIXTYPE)p.h));
    rplacd(val,cvfixnum((FIXTYPE)p.v));
    xlpop();
    return (val);
}

/* xpenmode - set the pen mode */
LVAL xpenmode(void)
{
    return (do_1('M'));
}

/* xpensize - set the pen size */
LVAL xpensize(void)
{
    return (do_2('S'));
}

/* xpenpat - set the pen pattern */
LVAL xpenpat(void)
{
    LVAL plist;
    Pattern pat;
    int i;
    plist = xlgalist();
    xllastarg();
    for (i = 0; i < 8 && consp(plist); ++i, plist = cdr(plist))
	if (fixp(car(plist)))
	    pat[i] = getfixnum(car(plist));
    SetPort(gwindow);
    PenPat(pat);
    SetPort(cwindow);
    return (NIL);
}

/* xpennormal - set the pen to normal */
LVAL xpennormal(void)
{
    xllastarg();
    SetPort(gwindow);
    PenNormal();
    SetPort(cwindow);
    return (NIL);
}

/* xmoveto - Move to a screen location */
LVAL xmoveto(void)
{
    return (do_2('m'));
}

/* xmove - Move in a specified direction */
LVAL xmove(void)
{
    return (do_2('M'));
}

/* xlineto - draw a Line to a screen location */
LVAL xlineto(void)
{
    return (do_2('l'));
}

/* xline - draw a Line in a specified direction */
LVAL xline(void)
{
    return (do_2('L'));
}

/* xshowgraphics - show the graphics window */
LVAL xshowgraphics(void)
{
    xllastarg();
    scrsplit(1);
    return (NIL);
}

/* xhidegraphics - hide the graphics window */
LVAL xhidegraphics(void)
{
    xllastarg();
    scrsplit(0);
    return (NIL);
}

/* xcleargraphics - clear the graphics window */
LVAL xcleargraphics(void)
{
    xllastarg();
    SetPort(gwindow);
    EraseRect(&gwindow->portRect);
    SetPort(cwindow);
    return (NIL);
}

/* do_0 - Handle commands that require no arguments */
LOCAL LVAL do_0(int fcn)
{
    xllastarg();
    SetPort(gwindow);
    switch (fcn) {
    case 'H':	HidePen(); break;
    case 'S':	ShowPen(); break;
    }
    SetPort(cwindow);
    return (NIL);
}

/* do_1 - Handle commands that require one integer argument */
LOCAL LVAL do_1(int fcn)
{
    int x;
    x = getnumber();
    xllastarg();
    SetPort(gwindow);
    switch (fcn) {
    case 'M':	PenMode(x); break;
    }
    SetPort(cwindow);
    return (NIL);
}

/* do_2 - Handle commands that require two integer arguments */
LOCAL LVAL do_2(int fcn)
{
    int h,v;
    h = getnumber();
    v = getnumber();
    xllastarg();
    SetPort(gwindow);
    switch (fcn) {
    case 'l':	LineTo(h,v); break;
    case 'L':	Line(h,v);   break;
    case 'm':   MoveTo(h,v); break;
    case 'M':	Move(h,v);   break;
    case 'S':	PenSize(h,v);break;
    }
    SetPort(cwindow);
    return (NIL);
}

/* getnumber - get an integer parameter */
LOCAL int getnumber(void)
{
    LVAL num;
    num = xlgafixnum();
    return ((int)getfixnum(num));
}

/* xtool - call the toolbox */
LVAL xtool(void)
{
    LVAL val;
    int trap;

    trap = getnumber();
/*

    asm {
	move.l	args(A6),D0
	beq	L2
L1:	move.l	D0,A0
	move.l	2(A0),A1
	move.w	4(A1),-(A7)
	move.l	6(A0),D0
	bne	L1
L2:	lea	L3,A0
	move.w	trap(A6),(A0)
L3:	dc.w	0xA000
	clr.l	val(A6)
    }
*/

    return (val);
}

/* xtool16 - call the toolbox with a 16 bit result */
LVAL xtool16(void)
{
    int trap,val;

    trap = getnumber();
/*

    asm {
	clr.w	-(A7)
	move.l	args(A6),D0
	beq	L2
L1:	move.l	D0,A0
	move.l	2(A0),A1
	move.w	4(A1),-(A7)
	move.l	6(A0),D0
	bne	L1
L2:	lea	L3,A0
	move.w	trap(A6),(A0)
L3:	dc.w	0xA000
	move.w	(A7)+,val(A6)
    }
*/

    return (cvfixnum((FIXTYPE)val));
}

/* xtool32 - call the toolbox with a 32 bit result */
LVAL xtool32(void)
{
    int trap;
    long val;

    trap = getnumber();
/*

    asm {
	clr.l	-(A7)
	move.l	args(A6),D0
	beq	L2
L1:	move.l	D0,A0
	move.l	2(A0),A1
	move.w	4(A1),-(A7)
	move.l	6(A0),D0
	bne	L1
L2:	lea	L3,A0
	move.w	trap(A6),(A0)
L3:	dc.w	0xA000
	move.l	(A7)+,val(A6)
    }
*/

    return (cvfixnum((FIXTYPE)val));
}

/* xnewhandle - allocate a new handle */
LVAL xnewhandle(void)
{
    LVAL num;
    long size;
    num = xlgafixnum(); size = getfixnum(num);
    xllastarg();
    return (cvfixnum((FIXTYPE)NewHandle(size)));
}

/* xnewptr - allocate memory */
LVAL xnewptr(void)
{
    LVAL num;
    long size;
    num = xlgafixnum(); size = getfixnum(num);
    xllastarg();
    return (cvfixnum((FIXTYPE)NewPtr(size)));
}
    
/* xhiword - return the high order 16 bits of an integer */
LVAL xhiword(void)
{
    unsigned int val;
    val = (unsigned int)(getnumber() >> 16);
    xllastarg();
    return (cvfixnum((FIXTYPE)val));
}

/* xloword - return the low order 16 bits of an integer */
LVAL xloword(void)
{
    unsigned int val;
    val = (unsigned int)getnumber();
    xllastarg();
    return (cvfixnum((FIXTYPE)val));
}

/* xrdnohang - get the next character in the look-ahead buffer */
LVAL xrdnohang(void)
{
    int ch;
    xllastarg();
    if ((ch = scrnextc()) == EOF)
	return (NIL);
    return (cvfixnum((FIXTYPE)ch));
}

/* ossymbols - enter important symbols */
void ossymbols(void)
{
    LVAL sym;

    /* setup globals for the window handles */
    sym = xlenter("*COMMAND-WINDOW*");
    setvalue(sym,cvfixnum((FIXTYPE)cwindow));
    sym = xlenter("*GRAPHICS-WINDOW*");
    setvalue(sym,cvfixnum((FIXTYPE)gwindow));
}
