home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fish 'n' More 2
/
fishmore-publicdomainlibraryvol.ii1991xetec.iso
/
fish
/
applications
/
xlispstat
/
src
/
src1.lzh
/
Amiga
/
amistuff.c
< prev
next >
Wrap
C/C++ Source or Header
|
1990-10-11
|
18KB
|
595 lines
/* AmiStuff.c - Amiga specific routines */
/* Copyright (c) 1990 by J.K. Lindsey */
/* Additions to XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney */
/* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz */
/* You may give out copies of this software; for conditions see the */
/* file COPYING included with this distribution. */
#include <proto/exec.h>
#include <proto/dos.h>
#include <proto/intuition.h>
#include <proto/graphics.h>
#include <graphics/gfxbase.h>
#include <graphics/display.h>
#include <libraries/dosextens.h>
#include <rexx/rxslib.h>
#include <rexx/simplerexx.h>
#include <math.h>
#include <time.h>
#include <stdlib.h>
#include <string.h>
#include "autil2.h"
#include "version.h"
#include "xlisp.h"
#include "osdef.h"
#include "xlproto.h"
#include "xlsproto.h"
#include "iviewproto.h"
#include "Stproto.h"
#include "osproto.h"
#include "xlvar.h"
#include "xlsvar.h"
#define extern
#include "amivar.h"
#undef extern
/* input buffer allows about 20 lines of text from ARexx */
#define LBSIZE 1600
char deftool[100]="";
/* line buffer variables */
static char lbuf[LBSIZE];
static char rexxerror[]="Commands truncated (too large for buffer).";
static int lpos[LBSIZE],lindex,lcount,lposition,start_time,numparen=0;
static struct FileHandle *fh=0;
static struct IOStdReq *OutConWM,*OutConRM;
static struct MsgPort *wport,*rport;
static struct BitMap bm,bm1,bm2;
static struct TextAttr StdFont={
"topaz.font",TOPAZ_EIGHTY,FS_NORMAL,FPF_ROMFONT};
static short hch,wch;
static unsigned long rportsig,rexxsig;
static unsigned short colormap[]={
RWHITE,RBLACK,RRED,RGREEN,RBLUE,RCYAN,RMAGENTA,RYELLOW,RBLUE,RGREEN,
RRED,RYELLOW,RMAGENTA,RCYAN,RWHITE,RBLACK};
static char ch;
static AREXXCONTEXT RexxStuff;
/* forward declarations */
void xputc(int),xflush(void);
int xgetc(void),xcheck(void),dokeys(void),dorexx(void),
DeadKeyConvert(unsigned short,unsigned short,char **,char *,int);
LVAL get_menu_by_id(int);
/* disable Lattice ctrl-C */
int CXBRK(void){return(0);}
int chkabort(void){return(0);}
/* osinit - initialize */
void osinit(char *banner){
struct NewScreen ns;
struct NewWindow nw;
struct RastPort *orp;
unsigned long clock[2];
char buffer[80],*b;
int i;
timer(clock);
start_time=clock[0];
/* open custom screen */
screen=0;
screentype=CUSTOMSCREEN;
OutConWM=OutConRM=0;
rport=wport=0;
if(openlibs())xlfatal("cannot open libraries");
screenw=GfxBase->NormalDisplayColumns;
screenh=2*GfxBase->NormalDisplayRows;
ns.LeftEdge=0;
ns.TopEdge=0;
ns.Width=screenw;
ns.Height=screenh;
ns.Depth=PLANES;
ns.DetailPen=WHITE;
ns.BlockPen=BLACK;
ns.ViewModes=HIRES|INTERLACE;
ns.Type=screentype;
ns.Font=&StdFont;
ns.DefaultTitle="Xlisp-Stat by Luke Tierney";
ns.Gadgets=0;
ns.CustomBitMap=0;
if(!(screen=OpenScreen(&ns)))xlfatal("cannot open xlisp screen");
LoadRGB4(&screen->ViewPort,colormap,16);
/* open backdrop window */
nw.LeftEdge=0;
nw.TopEdge=11;
nw.Width=screenw;
nw.Height=screenh-11;
nw.DetailPen=WHITE;
nw.BlockPen=BLACK;
nw.IDCMPFlags=GADGETUP|MENUPICK;
nw.Flags=SMART_REFRESH|ACTIVATE|BACKDROP|BORDERLESS|NOCAREREFRESH;
nw.FirstGadget=0;
nw.CheckMark=0;
nw.Title=0;
nw.Screen=screen;
nw.BitMap=0;
nw.MinWidth=100;
nw.MinHeight=50;
nw.MaxWidth=0;
nw.MaxHeight=0;
nw.Type=screentype;
if(!(window=OpenWindow(&nw)))xlfatal("cannot open xlisp window");
screen->FirstWindow->UserData=0;
/* initialize double buffering raster */
orp=screen->FirstWindow->RPort;
dbsize=screenh>screenw?screenh:screenw;
InitBitMap(&bm,PLANES,dbsize,dbsize);
for(i=0;i<PLANES;i++){
if(!(bm.Planes[i]=(PLANEPTR)AllocRaster(dbsize,dbsize)))xlfatal("raster allocation failed");}
InitRastPort(&dbrp);
dbrp.BitMap=&bm;
dbrp.Font=orp->Font;
dbrp.TxFlags=orp->TxFlags;
dbrp.TxHeight=orp->TxHeight;
dbrp.TxWidth=orp->TxWidth;
dbrp.TxBaseline=orp->TxBaseline;
dbrp.TxSpacing=orp->TxSpacing;
dbflag=0;
/* initialize rasters for writing vertical text */
wch=16;
hch=16;
InitBitMap(&bm1,PLANES,wch,hch);
InitBitMap(&bm2,PLANES,hch,wch);
for(i=0;i<PLANES;i++){
if(!(bm1.Planes[i]=(PLANEPTR)AllocRaster(wch,hch)))xlfatal("raster allocation failed");
if(!(bm2.Planes[i]=(PLANEPTR)AllocRaster(hch,wch)))xlfatal("raster allocation failed");}
InitRastPort(&rp1);
InitRastPort(&rp2);
rp1.BitMap=&bm1;
rp2.BitMap=&bm2;
rp1.Font=orp->Font;
rp1.TxFlags=orp->TxFlags;
rp1.TxHeight=hch;
rp1.TxWidth=wch;
rp1.TxBaseline=orp->TxBaseline;
rp1.TxSpacing=orp->TxSpacing;
RexxStuff=InitARexx("XLisp",0);
rexxsig=ARexxSignal(RexxStuff);
if(OpenConsole(&OutConWM,&OutConRM,&wport,&rport,0,0,screen->FirstWindow))xlfatal("cannot open console");
rportsig=1<<rport->mp_SigBit;
QueueRead(OutConRM,&ch);
while(*banner!='\000')xputc(*banner++);
xputc('\n');
sprintf(buffer, "XLISP-STAT version %s, Copyright (c) 1989, by Luke Tierney.",
XLISPSTAT_VERSION);
b=buffer;
while(*b!='\000')xputc(*b++);
xputc('\n');
strcpy(buffer,"Several files will be loaded; this may take a few minutes.");
b=buffer;
while(*b!='\000')xputc(*b++);
xputc('\n');
xputc('\n');
lposition=lindex=lcount=0;
Menu_Ptr=0;}
void osfinish (void){
struct Window *l,*ll;
int i;
if(fh&&fh!=(struct FileHandle *)Output())Close((BPTR)fh);
for(i=0;i<PLANES;i++){
FreeRaster(bm.Planes[i],dbsize,dbsize);
FreeRaster(bm1.Planes[i],wch,hch);
FreeRaster(bm2.Planes[i],hch,wch);}
FreeARexx(RexxStuff);
if(OutConWM)DelConsole(OutConWM,OutConRM,wport,rport);
l=screen->FirstWindow;
while(ll=l){
l=l->NextWindow;
if(ll!=window)StGWRemove((StGWWinInfo *)ll->UserData);}
ClearMenuStrip(screen->FirstWindow);
CloseWindow(screen->FirstWindow);
if(screen)CloseScreen(screen);
closelibs();}
/* osrand - return a random number between 0 and n-1 */
int osrand(unsigned n){
return((int)(rand()%n));}
/* oscheck - check for control characters during execution */
void oscheck(void){
int ch;
if(ch=xcheck())switch (ch) {
case '\002': osflush(); xlbreak("BREAK",s_unbound); break;
case '\004': osflush(); xltoplevel(); break;}}
/* osflush - flush the input line buffer */
void osflush(void){
lindex=lcount=0;}
/* xgetc - get a character from the terminal without echo */
static int xgetc(void){
register temp;
struct IOStdReq *readreq;
if(!(readreq=(struct IOStdReq *)GetMsg(rport)))return(-1);
temp=ch;
QueueRead(readreq,&ch);
return(temp&0xFF);}
/* xputc - put a character to the terminal */
static void xputc(int ch){
char chout;
chout=ch;
ConsoleWrite(OutConWM,&chout,1);}
/* xcheck - check for a character */
static int xcheck(void){
int c;
if((c=ConsoleMayRead(rport,&ch))==-1)return(0);
return (c&0xFF);}
/* osclose - close a file */
int osclose(FILE *fp){
return (fclose(fp));}
/* ostputc - put a character to the terminal */
int ostputc(int ch){
/* check for control characters */
oscheck();
/* output the character */
if(ch=='\n') {
xputc('\r');
xputc('\n');
lposition=0;}
else {
xputc(ch);
lposition++;}
/* output the character to the transcript file */
if(tfp)osaputc(ch,tfp);
return(0);}
/* ostgetc - get a character from the terminal */
int ostgetc(void){
struct IntuiMessage *message;
struct MenuItem *item;
struct Window *w;
struct Gadget *address;
StGWWinInfo *gwinfo;
int mn,in,active;
#ifdef RMOUSE
int x,y;
#endif RMOUSE
unsigned long wsig,signal,class,iflags;
unsigned short code,qualifier;
/* check for a buffered character */
if(lcount--){
/*printf("lcount=%d lindex=%d %c\n",lcount,lindex,lbuf[lindex]);*/
return((int)lbuf[lindex++]);}
/* get an input event */
for(message=0,lcount=0;;){
/*printf("\nready for event\n");*/
for(active=0;;){ /* not friendly to other tasks, but I haven't found */
if(window->Flags&WINDOWACTIVE)break; /* another way to do it */
w=screen->FirstWindow;
while(w){
if(!(gwinfo=(StGWWinInfo *)w->UserData)){
w=w->NextWindow;
continue;}
if(w->Flags&WINDOWACTIVE&&!dialog_p(gwinfo->Object)){
active=1;
ami_do_cursor(gwinfo);
for(;;){
#ifdef RMOUSE
StGWObDoIdle(gwinfo->Object);
#else
idle_action(gwinfo);
#endif RMOUSE
if(message=(struct IntuiMessage *)GetMsg(w->UserPort))goto S1;}}
else if(dialog_p(gwinfo->Object)&&(message=(struct IntuiMessage *)GetMsg(w->UserPort)))goto S1;
w=w->NextWindow;}
if(!active)break;}
S1: if(!message){
w=screen->FirstWindow; /* must be inside loop in case */
wsig=0; /* windows are created or closed */
while(w){
wsig|=1<<w->UserPort->mp_SigBit;
w=w->NextWindow;}
signal=Wait(rexxsig|rportsig|wsig);
/*printf("message received\n");*/
if(signal&rportsig){
if((in=dokeys())!=-1&&in!=-2)return(in);}
else if((signal&rexxsig)&&(in=dorexx()))return(in);
else if(signal&wsig){
w=screen->FirstWindow;
while(w){
if(signal&(1<<w->UserPort->mp_SigBit))break;
w=w->NextWindow;}}}
if(message||signal&wsig)for(;;){
if(!message)message=(struct IntuiMessage *)GetMsg(w->UserPort);
if(message){
#ifdef RMOUSE
ReportMouse(w,0);
#endif RMOUSE
class=message->Class;
code=message->Code;
address=(struct Gadget *)message->IAddress;
qualifier=message->Qualifier;
#ifdef RMOUSE
x=message->MouseX;
y=message->MouseY;
#endif RMOUSE
ReplyMsg((struct Message *)message);
message=0;
if((w!=window)&&!(gwinfo=(StGWWinInfo *)w->UserData))continue;
iflags=w->IDCMPFlags;
switch(class){
#ifdef RMOUSE
case MOUSEMOVE: {
StGWObDoMouse(gwinfo->Object,x-w->BorderLeft,y-w->BorderTop,MouseMove,0);
break;}
#endif RMOUSE
case INACTIVEWINDOW:
case ACTIVEWINDOW: {
send_message_1L(gwinfo->Object,sk_activate,class==ACTIVEWINDOW?s_true:0);
break;}
case VANILLAKEY: {
key_action(gwinfo,(char)code,qualifier);
break;}
case GADGETDOWN:
case GADGETUP: {
if(dialog_p(gwinfo->Object)){
Dodo(w,0);
doDialog(address->GadgetID,w);
Dodo(w,iflags);}
else if(gwinfo->hasVscroll||gwinfo->hasHscroll){
scroll_action(gwinfo,address->GadgetID);}
break;}
case MOUSEBUTTONS: {
if(code==SELECTDOWN&&!dialog_p(gwinfo->Object))mouse_action(gwinfo,qualifier);
break;}
case CLOSEWINDOW: {
if(dialog_p(gwinfo->Object))DialogRemove(GetDialogObject(w));
else send_message(gwinfo->Object,sk_close);
break;}
case NEWSIZE: {
Dodo(w,0);
send_message_1L(gwinfo->Object,sk_update,s_true);
Dodo(w,iflags);
break;}
case MENUPICK: {
while(code!=MENUNULL){
item=ItemAddress(mymenu,code);
mn=MENUNUM(code);
in=ITEMNUM(code);
code=item->NextSelect;
send_message1(get_menu_by_id(mn),sk_select,in+1);}
break;}}}
else break;
if(class==CLOSEWINDOW||class==MENUPICK)break;}
#ifdef RMOUSE
ReportMouse(w,1);
#endif RMOUSE
}}
/* xflush - flush the input line buffer */
static void xflush(void){
ostputc('\n');
osflush();}
/* osaopen - open an ascii file */
#include "icon.h"
void wfile(char *fname){
static struct IntuiText ptext={0,1,JAM2,5,3,&StdFont,"OK",0},
ntext={0,1,JAM2,5,3,&StdFont,"CANCEL",0},
btext={0,1,JAM2,5,15,&StdFont,"File exists! OverWrite?",0};
BPTR lock;
if(lock=Lock(fname,ACCESS_WRITE)){
UnLock(lock);
if(!AutoRequest(window,&btext,&ptext,&ntext,0,0,215,70))xlfail("file open cancelled");}
MakeIcon(icon,80,42,deftool,fname,20000);}
FILE *osaopen(char *name,char *mode){
char buffer[120],*m;
strcpy(buffer,name);
if(mode[0]=='w'){
if(stcpm(buffer,".lsp",&m)!=4)strcat(buffer,".lsp");
wfile(buffer);}
return(fopen(buffer,mode));}
/* oserror - print an error message */
void oserror(char *msg){
printf("error: %s\n",msg);}
/* xsystem - the built-in function 'system' */
LVAL xsystem(void){
char *str;
int result;
/* get the command string */
str=getstring(xlgastring());
xllastarg();
if(!fh&&!(fh=(struct FileHandle *)Output())&&
!(fh=(struct FileHandle *)Open("CON:0/10/640/100/XLisp CLI",MODE_NEWFILE)))
xlfail("unable to open CLI");
result=Execute(str,0,(BPTR)fh);
return(cvfixnum((FIXTYPE)result));}
/* xarexx - the built-in function 'arexx' */
LVAL xarexx(void){
char *str;
int result;
/* get the command string */
str=getstring(xlgastring());
xllastarg();
if(!RexxStuff)xlfail("no AREXX port");
result=SendARexxMsg(RexxStuff,str,0);
return(cvfixnum((FIXTYPE)result));}
/* osagetc - get a character from an ascii file */
int osagetc(FILE *fp){
return(getc(fp));}
/* osaputc - put a character to an ascii file */
int osaputc(int ch,FILE *fp){
return(putc(ch,fp));}
/* ossymbols - lookup important symbols */
void ossymbols(void){
statsymbols();}
unsigned long run_tick_count(void){
unsigned int clock[2];
timer(clock);
return((unsigned long)(6e-5*(1e6*(clock[0]-start_time)+clock[1])));}
#ifndef HZ
#define HZ 60
#endif
unsigned long real_tick_count(void){
return((unsigned long)(HZ*(time((unsigned long *)NULL)-time_stamp)));}
unsigned long ticks_per_second(void){
return((unsigned long)HZ);}
void SysBeep(int n){
DisplayBeep(0);}
void bzero(char *p,int n){
while(n-->0)*p++=0;}
void osfinit(void){
statfinit();}
void osreset(void){
}
FILE *osbopen(char *name,char *mode){
char nmode[4];
strcpy(nmode,mode);
strcat(nmode,"b");
return(fopen(name,nmode));}
int osbgetc(FILE *fp){
return(getc(fp));}
int osbputc(int ch,FILE *fp){
return(putc(ch,fp));}
extern unsigned short bag[];
void set_gc_cursor(int on){
struct Window *w;
w=screen->FirstWindow;
while(w){
if(w->Flags&WINDOWACTIVE)break;
w=w->NextWindow;}
if(w){
if(on){
SetPointer(w,bag,16,16,-2,-1);}
else {
if(w==window)SetPointer(w,0,0,0,0,0);
else ami_do_cursor((StGWWinInfo *)*w->UserData);}}}
/* find lisp menu with a specified Amiga ID */
static LVAL get_menu_by_id(int m){
struct SuperMenu *this;
int i;
this=Menu_Ptr;
i=0;
while(this&&i!=m){
i++;
this=this->Next;}
if(!this)xlfail("menu not found");
return(get_menu_by_hardware((IVIEW_MENU)this));}
static int dokeys(void){
int ch,i;
if((ch=xgetc())!=-1)switch(ch){
case '\r': {
lbuf[lcount]='\n';
xputc('\r');
xputc('\n');
lposition=0;
if(tfp)for(lindex=0;lindex<lcount+1;lindex++)osaputc(lbuf[lindex],tfp);
lindex=1;
return((int)lbuf[0]);}
case '\010':
case '\177': {
if(lcount){
lcount--;
while(lposition>lpos[lcount]){
xputc('\010');
xputc(' ');
xputc('\010');
lposition--;}}
return(-2);}
default: {
if(ch=='(')numparen++;
else if(ch==')'&&numparen>0)numparen--;
if(ch=='\t'||(ch>=0x20&&ch<0x7F)){
lbuf[lcount]=ch;
lpos[lcount]=lposition;
if(ch=='\t'){
if(!lposition)for(i=0;i<3*numparen;lposition++,i++)xputc(' ');
else do {
xputc(' ');}
while(++lposition&7);}
else {
xputc(ch);
lposition++;}
lcount++;
return(-2);}
else {
numparen=0;
xflush();
switch (ch) {
case '\003': xltoplevel(); /* control-c */
case '\007': xlcleanup(); /* control-g */
case '\020': xlcontinue(); /* control-p */
case '\032': return(EOF); /* control-z */
default: return(-2);}}}}
else return(ch);}
static int dorexx(void){
struct RexxMsg *rmsg;
char *nc,*error=0;
int errlevel=0;
if(rmsg=GetARexxMsg(RexxStuff)){
if(strlen(ARG0(rmsg))>LBSIZE){
errlevel=5;
error=rexxerror;}
lcount=stccpy(lbuf,ARG0(rmsg),LBSIZE)-1;
if(error)SetARexxLastError(RexxStuff,rmsg,error);
ReplyARexxMsg(RexxStuff,rmsg,0,errlevel);
nc=lbuf;
while(*nc)xputc(*nc++);
xputc('\r');
xputc('\n');
lposition=0;
lbuf[lcount]='\n';
if(tfp)for(lindex=0;lindex<lcount+1;lindex++)osaputc(lbuf[lindex],tfp);
lindex=1;
return((int)lbuf[0]);}
else return(0);}
extern unsigned short snooze[];
void Dodo(struct Window *w,unsigned long iflags){
if(iflags){
ClearPointer(w);
ModifyIDCMP(w,iflags);}
else {
ModifyIDCMP(w,0);
SetPointer(w,snooze,22,16,-7,-8);}}