home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / windows / c / xlisp21w / sources / winstuff.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-04-08  |  33.3 KB  |  1,505 lines
  1. /* winstuff.c - Windows specific sources */
  2. /* for the Borland C 3.0 */
  3.  
  4. #include "xlisp.h"
  5. #include "osdefs.h"
  6. #include "winstuff.h"
  7.  
  8. #include <dos.h>
  9. #include <process.h>
  10. #include <math.h>
  11. #include <io.h>
  12. #include <float.h>
  13. #ifdef TIMES
  14. #include <time.h>
  15. #endif
  16.  
  17. #define LBSIZE 200
  18.  
  19. #ifdef __TURBOC__
  20. unsigned _Cdecl _stklen = 16384;        /* set up reasonable stack */
  21. #ifdef MEDMEM
  22. unsigned _Cdecl _heaplen = 4096;    /* compress the near heap */
  23. #endif
  24. #endif
  25.  
  26. /* Server variables */
  27. int    GotClientReq;        /* TRUE , if the server DLL
  28.                 is ready to send a packet */
  29. int    ServerReady;        /* TRUE , if the server packet
  30.                    is ready to be processed */
  31. int    ServerPacket;        /* TRUE , if the server is
  32.                 executing a client packet */
  33. HANDLE    ReplyBlock;        /* Area to store the
  34.                 reply text */
  35. int    ReplyIndex;        /* Index in the reply area */
  36.  
  37. /* external variables */
  38. extern LVAL s_unbound,s_dosinput,true;
  39. extern FILEP tfp;
  40.  
  41. /* exported variables */
  42. int lposition;
  43.  
  44. int    ServerTask;        /* TRUE , if the system runs in Lisp server mode */
  45. #define    KB_FIFOSIZE    256
  46. char    kFifo[ KB_FIFOSIZE ];
  47. int    kFifoHead,kFifoTail;
  48. HWND    MainWindow;        /* Handle to the main window */
  49. HANDLE    hInst;            /* Instance handle */
  50. HANDLE    hAccel;            /* Accelerator handle */
  51. int    CursorVisible;        /* True , if the cursor is
  52.                    visible */
  53. int    FontWidth;        /* The width of the actual
  54.                    font */
  55. int    FontHeight;        /* The height of the actual
  56.                    font */
  57. int    MenuEnabled;        /* TRUE , if the popup command
  58.                    shortcuts are active */
  59. /* The MenuCommand variable belongs to the popup Lisp command
  60.    logic. When a popup Lisp command is selected , a function
  61.    code is written into this variable then the read loop is
  62.    broken by placing an EOF into the keyboard buffer. The Lisp
  63.    uplevel command loop then executes the command */
  64. int    MenuCommand;
  65.  
  66.  
  67. #define    SCREENBUFSIZE    8192
  68. HANDLE    ScreenBuf;        /* Screen buffer handle */
  69. int    sTailIndex,sHeadIndex;    /* Screen buffer indices */
  70. int    sTPosIndex;        /* The tail of the screen
  71.                    buffer */
  72. int    ScreenXPos,ScreenYPos;    /* X and Y output position */
  73.  
  74. /* File dialog variables */
  75. static char    szDefExt[5];        /* Default extension */
  76. char        szFileName[96];        /* Name of the file */
  77. static char    szFileSpec[16];
  78. static OFSTRUCT    pof;
  79. static WORD    wFileAttr;
  80.  
  81. /* The size of the client area */
  82. static int    cxSize,cySize;
  83.  
  84. /* local variables */
  85. static char lbuf[LBSIZE];
  86. static int lpos[LBSIZE];
  87. static int lindex;
  88. static int lcount;
  89.  
  90. /* forward declarations */
  91. void XNEAR xinfo(void);
  92. void XNEAR xflush(void);
  93. int  XNEAR xgetc(void);
  94. void XNEAR xputc(int ch);
  95.  
  96. /* Dialog template structure - missing from WINDOWS.H */
  97. typedef struct {
  98.     long    dtStyle;
  99.     BYTE    dtItemCount;
  100.     int    dtX;
  101.     int    dtY;
  102.     int    dtCX;
  103.     int    dtCY;
  104.     char    dtMenuName[];
  105.     char    dtClassName[];
  106.     char    dtCaptionText[];
  107. } DLGTEMPLATE;
  108. typedef DLGTEMPLATE FAR        *LPDLGTEMPLATE;
  109.  
  110. #define    EXE_NAME_MAX_SIZE    128
  111. char    helpfilename[ EXE_NAME_MAX_SIZE + 1 ];
  112.  
  113. /* enables the popup commands */
  114. void EnableMenuCommands()
  115. {
  116.   MenuEnabled = TRUE;
  117. }
  118.  
  119. /* disables the popup commands */
  120. void DisableMenuCommands()
  121. {
  122.   MenuEnabled = FALSE;
  123. }
  124.  
  125. /* Windows message loop. Waits for a character to be typed or the closing
  126.    of the application. Returns 0 if the application was closed */
  127. static int XNEAR MessageLoop()
  128. {
  129.   MSG    msg;
  130.  
  131.   while( !GotClientReq   && ( kFifoHead == kFifoTail )
  132.      && GetMessage( &msg , NULL , NULL , NULL ) )
  133.     if( !TranslateAccelerator( MainWindow , hAccel , &msg ) )
  134.     {
  135.       TranslateMessage( &msg );
  136.       DispatchMessage( &msg );
  137.     };
  138.   return( kFifoHead - kFifoTail );
  139. }
  140.  
  141. /* Shows the caret at the current position */
  142. static void XNEAR XShowCursor()
  143. {
  144.   if( MainWindow == GetFocus() )
  145.   {
  146.     SetCaretPos( ScreenXPos , ScreenYPos );
  147.     ShowCaret( MainWindow );
  148.   }
  149. }
  150.  
  151. /* Hides the caret */
  152. static void XNEAR XHideCursor()
  153. {
  154.   HDC        hdc;
  155.   HBRUSH    DelBrush;
  156.   RECT        DelRect;
  157.  
  158.   HideCaret( MainWindow );
  159.   hdc = GetDC( MainWindow );
  160.   SetRect( &DelRect , ScreenXPos , ScreenYPos ,
  161.        ScreenXPos + 2  , ScreenYPos + FontHeight );
  162.   DelBrush = CreateSolidBrush( GetSysColor( COLOR_WINDOW ) );
  163.   FillRect( hdc , &DelRect , DelBrush );
  164.   DeleteObject( DelBrush );
  165.   ReleaseDC( MainWindow , hdc );
  166. }
  167.  
  168. /* Returns the first occurence of the ch character in the str
  169.    string. Searches from the beginning of the string */
  170. LPSTR lstrchr( LPSTR str , char ch )
  171. {
  172.   while( *str )
  173.   {
  174.     if( ch == *str )
  175.     return str;
  176.     str = AnsiNext( str );
  177.   }
  178.   return NULL;
  179. }
  180.  
  181. /* Returns the first occurence of the ch in the str string.
  182.    Searches from the end of the string */
  183. LPSTR lstrrchr( LPSTR str , char ch )
  184. {
  185.   LPSTR strl = str + lstrlen( str );
  186.  
  187.   do
  188.   {
  189.     if( ch == *strl )
  190.     return strl;
  191.     strl = AnsiPrev( str,strl );
  192.   }
  193.   while( strl > str );
  194.  
  195.   return NULL;
  196. }
  197.  
  198. /* FileOpen dialog procedure */
  199. BOOL FAR PASCAL _export FileOpenDlgProc( HWND hDlg , WORD message ,
  200.                  WORD wParam , LONG lParam )
  201. {
  202.   char    cLastChar;
  203.   short    nEditLen;
  204.  
  205.   switch( message )
  206.   {
  207.     case WM_INITDIALOG:
  208.     SendDlgItemMessage( hDlg,IDD_FNAME,EM_LIMITTEXT,80,0L );
  209.     DlgDirList( hDlg,szFileSpec,IDD_FLIST,IDD_FPATH,
  210.             wFileAttr );
  211.     SetDlgItemText( hDlg,IDD_FNAME,szFileSpec );
  212.     return TRUE;
  213.  
  214.     case WM_COMMAND:
  215.     switch( wParam )
  216.     {
  217. /* List box messages */
  218.       case IDD_FLIST:
  219.         switch( HIWORD( lParam ) )
  220.         {
  221.           case LBN_SELCHANGE:
  222.             if( DlgDirSelect( hDlg,szFileName,
  223.                         IDD_FLIST ) )
  224.                 lstrcat( szFileName,szFileSpec );
  225.             SetDlgItemText( hDlg,IDD_FNAME,szFileName );
  226.             return TRUE;
  227.  
  228.           case LBN_DBLCLK:
  229.             if( DlgDirSelect( hDlg,szFileName,
  230.                         IDD_FLIST ) )
  231.             {
  232.               lstrcat( szFileName,szFileSpec );
  233.               DlgDirList( hDlg,szFileName,IDD_FLIST,
  234.                     IDD_FPATH,wFileAttr );
  235.               SetDlgItemText( hDlg,IDD_FNAME,
  236.                       szFileSpec );
  237.             }
  238.             else
  239.             {
  240.               SetDlgItemText( hDlg,IDD_FNAME,
  241.                       szFileName );
  242.               SendMessage( hDlg,WM_COMMAND,IDOK,0L );
  243.             }
  244.             return TRUE;
  245.         }
  246.         break;
  247.  
  248.       case IDD_FNAME:
  249.         if( HIWORD(lParam) == EN_CHANGE )
  250.             EnableWindow( GetDlgItem( hDlg,IDOK ),
  251.             (BOOL)SendMessage(LOWORD(lParam),
  252.             WM_GETTEXTLENGTH,0,0L) );
  253.         return TRUE;
  254.  
  255.       case IDOK:
  256.         GetDlgItemText( hDlg,IDD_FNAME,szFileName,80 );
  257.         nEditLen = lstrlen( szFileName );
  258.         cLastChar = *AnsiPrev( szFileName,szFileName +
  259.                 nEditLen );
  260.         if( ( cLastChar == '\\' ) || ( cLastChar == ':' ) )
  261.             lstrcat( szFileName,szFileSpec );
  262.         if( lstrchr( szFileName,'*' ) ||
  263.             lstrchr( szFileName,'?' ) )
  264.         {
  265.           if( DlgDirList( hDlg,szFileName,IDD_FLIST,
  266.                   IDD_FPATH,wFileAttr ) )
  267.           {
  268.             lstrcpy( szFileSpec,szFileName );
  269.             SetDlgItemText( hDlg,IDD_FNAME,szFileSpec );
  270.           }
  271.           else
  272.             MessageBeep( 0 );
  273.           return TRUE;
  274.         }
  275.         lstrcat( lstrcat( szFileName,"\\" ),szFileSpec );
  276.         if( DlgDirList( hDlg,szFileName,IDD_FLIST,
  277.                 IDD_FPATH,wFileAttr ) )
  278.         {
  279.           lstrcpy( szFileSpec,szFileName );
  280.           SetDlgItemText( hDlg,IDD_FNAME,szFileSpec );
  281.           return TRUE;
  282.         }
  283.         szFileName[ nEditLen ] = '\0';
  284.         if( -1 == OpenFile( szFileName,(LPOFSTRUCT)&pof,
  285.                     OF_READ | OF_EXIST ) )
  286.         {
  287.           lstrcat( szFileName,szDefExt );
  288.           if( -1 == OpenFile( szFileName,(LPOFSTRUCT)&pof,
  289.                       OF_READ | OF_EXIST ) )
  290.           {
  291.             MessageBeep( 0 );
  292.             return TRUE;
  293.           }
  294.         }
  295.         lstrcpy( szFileName,AnsiNext(
  296.              lstrrchr( pof.szPathName,'\\') ) );
  297.         OemToAnsi( szFileName,szFileName );
  298.         EndDialog( hDlg,TRUE );
  299.         return TRUE;
  300.  
  301.       case IDCANCEL:
  302.         EndDialog( hDlg,FALSE );
  303.         return TRUE;
  304.  
  305.     }    /* switch( wParam ) */
  306.   }        /* switch( message ) */
  307.   return FALSE;
  308. }
  309.  
  310. /* About dialog procedure */
  311. BOOL FAR PASCAL _export AboutDlgProc( HWND hDlg , WORD message ,
  312.                   WORD wParam , LONG lParam )
  313. {
  314.   switch( message )
  315.   {
  316.     case WM_INITDIALOG:
  317.     return TRUE;
  318.  
  319.     case WM_COMMAND:
  320.     switch( wParam )
  321.     {
  322.         case IDOK:
  323.         case IDCANCEL:
  324.             EndDialog( hDlg,0 );
  325.             return TRUE;
  326.     }
  327.     break;
  328.   }
  329.   return FALSE;
  330. }
  331.  
  332. /* Executes a file dialog */
  333. int DoFileDialog( char Extension[] )
  334. {
  335.   int        ErrorCode;
  336.   FARPROC       lpfnDlgProc;
  337.  
  338.   wFileAttr = 0x4010;
  339.  
  340.   strcpy( szFileSpec,"*" );
  341.   strcat( szFileSpec,Extension );
  342.   strcpy( szDefExt,Extension );
  343.   lpfnDlgProc = MakeProcInstance( FileOpenDlgProc,hInst );
  344.   ErrorCode = DialogBox( hInst,"FileOpen",MainWindow,lpfnDlgProc );
  345.   FreeProcInstance( lpfnDlgProc );
  346.   return ErrorCode;
  347. }
  348.  
  349. /* Puts its parameter into the keyboard FIFO */
  350. void PutFifo( int keycode )
  351. {
  352.   kFifo[ kFifoHead ] = keycode;
  353.   kFifoHead = ++kFifoHead % KB_FIFOSIZE;
  354. }
  355.  
  356. /* Executes a dialog box - aligns the box to the center
  357.    of the client area. Gets the name of the box and
  358.    the address of its callback function */
  359. void CenterDialogBox( char BoxName[] , FARPROC CBFunc )
  360. {
  361.   FARPROC        lpfnDlgProc;
  362.   LPDLGTEMPLATE        lpDlgTempl;
  363.   HANDLE        hDialog;
  364.   long            lpDlgBaseUnits;
  365.   WORD            wXDlg,wYDlg,wT;
  366.  
  367.   lpfnDlgProc = MakeProcInstance( CBFunc,hInst );
  368.   hDialog = LoadResource( hInst,FindResource( hInst, BoxName ,
  369.               RT_DIALOG ));
  370.   lpDlgTempl = (LPDLGTEMPLATE)LockResource( hDialog );
  371.   lpDlgBaseUnits = GetDialogBaseUnits();
  372.   wXDlg = LOWORD( lpDlgBaseUnits );
  373.   wYDlg = HIWORD( lpDlgBaseUnits );
  374.   wT = ( 4*cxSize )/( 2*wXDlg );
  375.   wT -= lpDlgTempl->dtCX/2;
  376.   lpDlgTempl->dtX = wT;
  377.   wT = ( 8*cySize )/( 2*wYDlg );
  378.   wT -= lpDlgTempl->dtCY/2;
  379.   lpDlgTempl->dtY = wT;
  380.   UnlockResource( hDialog );
  381.   DialogBoxIndirect( hInst,hDialog,MainWindow,lpfnDlgProc );
  382.   FreeResource( hDialog );
  383.   FreeProcInstance( lpfnDlgProc );
  384. }
  385.  
  386. /* Window procedure of the main window */
  387. long FAR PASCAL _export WndProc( HWND hWnd , WORD message , WORD wParam ,
  388.              LONG lParam )
  389. {
  390.  
  391.   HDC            hdc;
  392.   PAINTSTRUCT        ps;
  393.   RECT            rect;
  394.   int            xpos,ypos,chwidth,idx,i;
  395.   int            sw,sh,lines,ctr;
  396.   int            ErrorCode;
  397.   int            sctr;
  398.   char far        *DispBuf;
  399.   char            string[200];
  400.  
  401.   switch( message )
  402.   {
  403. /* XServer DLL request message */
  404.     case XL_REQ:
  405.     GotClientReq = TRUE;
  406.     return 0;
  407. /* XServer DLL trigger message */
  408.     case XL_TRIG:
  409.      return 0;
  410.  
  411.     case WM_SIZE:
  412.     cxSize = LOWORD( lParam );
  413.     cySize = HIWORD( lParam );
  414.     if( ( ( wParam == SIZEFULLSCREEN ) ||
  415.           ( wParam == SIZENORMAL ) ) &&
  416.           ( sHeadIndex != sTPosIndex ) )
  417.     {
  418.       DispBuf = GlobalLock( ScreenBuf );
  419.       lines = cySize / FontHeight;
  420.       idx = sHeadIndex;
  421.       ctr = 0;
  422.       i = 0;
  423.       do
  424.       {
  425.         idx = ( idx == 0 ? SCREENBUFSIZE-1 : --idx );
  426.         ctr += FontWidth;
  427.         if( DispBuf[ idx ] == '\n' )
  428.             ++i,ctr = 0;
  429.         else
  430.         if( ctr >= cxSize )
  431.             ++i,ctr = FontWidth;
  432.       }
  433.       while( ( i < lines ) && ( idx != sTPosIndex ) );
  434.       sTailIndex = idx;
  435.       if( idx != sTPosIndex )
  436.         sTailIndex = ++sTailIndex % SCREENBUFSIZE;
  437.       GlobalUnlock( ScreenBuf );
  438.     }
  439.     return 0;
  440.  
  441.     case WM_PAINT:
  442.     XHideCursor();
  443.     DispBuf = GlobalLock( ScreenBuf );
  444.     hdc = BeginPaint( hWnd , &ps );
  445.     SetBkColor( hdc , GetSysColor( COLOR_WINDOW ) );
  446.     SetTextColor( hdc , GetSysColor( COLOR_WINDOWTEXT ) );
  447.     SelectObject( hdc , GetStockObject( SYSTEM_FIXED_FONT )
  448.               );
  449.     idx = sTailIndex;
  450.     xpos = ypos = 0;
  451.     sctr = 0;
  452.     while( idx != sHeadIndex )
  453.     {
  454.       if( DispBuf[ idx ] == '\n' )
  455.       {
  456.         if( sctr )
  457.         TextOut( hdc , 0 , ypos , string , sctr );
  458.         sctr = 0;
  459.         ypos += FontHeight;
  460.         xpos = 0;
  461.       }
  462.       else
  463.       {
  464.         if( ( xpos + FontWidth ) >= cxSize )
  465.         {
  466.           if( sctr )
  467.         TextOut( hdc , 0 , ypos , string , sctr );
  468.           sctr = 0;
  469.           ypos += FontHeight;
  470.           xpos = 0;
  471.         }
  472.         string[ sctr++ ] = DispBuf[ idx ];
  473.         xpos += FontWidth;
  474.       }
  475.       idx = ++idx % SCREENBUFSIZE;
  476.     }
  477.     if( sctr )
  478.         TextOut( hdc , 0 , ypos , string , sctr );
  479.     ScreenXPos = xpos;
  480.     ScreenYPos = ypos;
  481.     EndPaint( hWnd , &ps );
  482.     GlobalUnlock( ScreenBuf );
  483.     XShowCursor();
  484.     return 0;
  485.  
  486.     case WM_DESTROY:
  487.     WinHelp( MainWindow , helpfilename , HELP_QUIT , 0L );
  488.     PostQuitMessage( 0 );
  489.     return 0;
  490.  
  491.     case WM_CHAR:
  492.     PutFifo( wParam );
  493.     return 0;
  494.  
  495.     case WM_SETFOCUS:
  496.     CreateCaret( MainWindow , NULL , 2 , FontHeight );
  497.     if( CursorVisible )
  498.         XShowCursor();
  499.     return 0;
  500.  
  501.     case WM_KILLFOCUS:
  502.     XHideCursor();
  503.     DestroyCaret();
  504.     return 0;
  505.  
  506. /* Popup menu initialization message */
  507.     case WM_INITMENUPOPUP:
  508.     if( lParam == 0L )    /* If the File Menu */
  509.       if( MenuEnabled )
  510.       {
  511.         EnableMenuItem( wParam , IDM_LISPOPEN , MF_ENABLED );
  512.         EnableMenuItem( wParam , IDM_WSOPEN , MF_ENABLED );
  513.       }
  514.       else
  515.       {
  516.         EnableMenuItem( wParam , IDM_LISPOPEN , MF_GRAYED );
  517.         EnableMenuItem( wParam , IDM_WSOPEN , MF_GRAYED );
  518.       }
  519.     return 0;
  520.  
  521. /* Menu command messages */
  522.     case WM_COMMAND:
  523.     switch( wParam )
  524.     {
  525.       case IDM_LISPOPEN:    /* Load Lisp source */
  526. /* cannot execute if the interpreter is running */
  527.         if( !MenuEnabled )
  528.             return 0;
  529.         ErrorCode = DoFileDialog( ".lsp" );
  530.         if( ErrorCode )        /* if file was selected */
  531.         {
  532.           PutFifo( EOF );
  533.           MenuCommand = FUNC_LLSP;
  534.         }
  535.         return 0;
  536.  
  537.       case IDM_WSOPEN:
  538.         if( !MenuEnabled )
  539.             return 0;
  540.         ErrorCode = DoFileDialog( ".wks" );
  541.         if( ErrorCode )
  542.         {
  543.           PutFifo( EOF );
  544.           MenuCommand = FUNC_LWKS;
  545.         }
  546.         return 0;
  547.  
  548.       case IDM_INFO:    /* Memory info */
  549.         xinfo();
  550.         return 0;
  551.  
  552.       case IDM_EXIT:    /* Exit */
  553.         SendMessage( hWnd , WM_CLOSE , 0 , 0L );
  554.         return 0;
  555.  
  556.       case IDM_INDEX:
  557.         WinHelp( MainWindow , helpfilename , HELP_INDEX ,
  558.              0L );
  559.         return 0;
  560.       case IDM_HELPONHELP:
  561.         WinHelp( MainWindow , helpfilename , HELP_HELPONHELP ,
  562.              0L );
  563.         return 0;
  564.  
  565.       case IDM_ABOUT:
  566.         CenterDialogBox( "About" , AboutDlgProc );
  567.         return 0;
  568.     }
  569.     break;
  570.  
  571.   }
  572.   return DefWindowProc( hWnd , message , wParam , lParam );
  573. }
  574.  
  575. /* Math error handler */
  576. int CDECL matherr(struct exception *er)
  577. {
  578.     char *emsg;
  579.  
  580.     switch (er->type) {
  581.     case DOMAIN: emsg="domain"; break;
  582.     case OVERFLOW: emsg="overflow"; break;
  583.     case PLOSS: case TLOSS: emsg="inaccurate"; break;
  584.     case UNDERFLOW: return 1;
  585.     default: emsg="????"; break;
  586.     }
  587.     xlerror(emsg,cvflonum(er->arg1));
  588.     return 0; /* never happens */
  589. }
  590.  
  591. /* Creates the full help file path */
  592. void MakeHelpPathName(char *szFileName)
  593. {
  594.    char *  pcFileName;
  595.    int     nFileNameLen;
  596.  
  597.    nFileNameLen = GetModuleFileName(hInst,szFileName,EXE_NAME_MAX_SIZE);
  598.    pcFileName = szFileName + nFileNameLen;
  599.  
  600.    while (pcFileName > szFileName) {
  601.        if (*pcFileName == '\\' || *pcFileName == ':') {
  602.        *(++pcFileName) = '\0';
  603.        break;
  604.        }
  605.    nFileNameLen--;
  606.    pcFileName--;
  607.    }
  608.  
  609.    if ((nFileNameLen+12) < EXE_NAME_MAX_SIZE) {
  610.        lstrcat(szFileName, "xlisp.hlp");
  611.    }
  612.  
  613.    else {
  614.        lstrcat(szFileName, "?");
  615.    }
  616.  
  617.    return;
  618. }
  619.  
  620. /* osinit - initialize */
  621. VOID osinit()
  622. {
  623.   HDC        hdc;
  624.   char        c;
  625.   DWORD        fm;
  626.  
  627.   hdc = GetDC( MainWindow );
  628.   SelectObject( hdc , GetStockObject( SYSTEM_FIXED_FONT ) );
  629.   c = 'M';
  630.   fm = GetTextExtent( hdc , (LPSTR)&c , 1 );
  631.   FontWidth = LOWORD( fm );
  632.   FontHeight = HIWORD( fm );
  633.  
  634.   CursorVisible = FALSE;
  635.   kFifoHead = kFifoTail = 0;
  636.  
  637.   GotClientReq = FALSE;
  638.   ServerReady = FALSE;
  639.   ServerPacket = FALSE;
  640.  
  641.   sHeadIndex = sTailIndex = sTPosIndex = 0;
  642.   ScreenXPos = ScreenYPos = 0;
  643.   if( ( ScreenBuf = GlobalAlloc( GMEM_MOVEABLE | GMEM_ZEROINIT ,
  644.       (DWORD)SCREENBUFSIZE ) ) == NULL )
  645.   {
  646.     MessageBox( MainWindow , "Cannot allocate screen buffer" , "XLISP" ,
  647.           MB_OK | MB_ICONSTOP );
  648.     exit( 1 );
  649.   }
  650.   ReleaseDC( MainWindow , hdc );
  651.   DisableMenuCommands();
  652.   MakeHelpPathName( helpfilename );
  653. }
  654.  
  655. /* osfinish - clean up before returning to the operating system */
  656. VOID osfinish()
  657. {
  658. }
  659.  
  660. /* xoserror - print an error message */
  661. VOID xoserror(char msg[])
  662. {
  663.   char w[100];
  664.  
  665.   sprintf( w ,"error: %s\n" , msg);
  666.   stdputstr( msg );
  667. }
  668.  
  669. /* osrand - return next random number in sequence */
  670. long osrand(long rseed)
  671. {
  672.     long k1;
  673.  
  674.     /* make sure we don't get stuck at zero */
  675.     if (rseed == 0L) rseed = 1L;
  676.  
  677.     /* algorithm taken from Dr. Dobbs Journal, November 1985, page 91 */
  678.     k1 = rseed / 127773L;
  679.     if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
  680.     rseed += 2147483647L;
  681.  
  682.     /* return a random number between 0 and MAXFIX */
  683.     return rseed;
  684. }
  685.  
  686. #ifdef FILETABLE
  687.  
  688. int truename(char *name, char *rname)
  689. {
  690.     union REGS regs;
  691. #ifndef MEDMEM
  692.     struct SREGS sregs;
  693. #endif
  694.     int i;
  695.     char *cp;
  696.     int drive;          /* drive letter */
  697.     char pathbuf[FNAMEMAX+1];   /* copy of path part of name */
  698.     char curdir[FNAMEMAX+1];    /* current directory of drive */
  699.     char *fname;        /* pointer to file name part of name */
  700.  
  701.     /* use backslashes consistantly */
  702.  
  703.     for (cp = name; (cp = strchr(cp, '/')) != NULL; *cp = '\\') ;
  704.  
  705.     /* parse any drive specifier */
  706.  
  707.     if ((cp = strrchr(name, ':')) != NULL) {
  708.     if (cp != name+1 || !isalpha(*name)) return FALSE;
  709.     drive = toupper(*name);
  710.     name = cp+1;            /* name now excludes drivespec */
  711.     }
  712.     else {
  713.     regs.h.ah = 0x19;   /* get current disk */
  714.     intdos(®s, ®s);
  715.     drive = regs.h.al + 'A';
  716.     }
  717.  
  718.     /* check for absolute path (good news!) */
  719.  
  720.     if (*name == '\\') {
  721.     sprintf(rname,"%c:%s",drive,name);
  722.     }
  723.     else {
  724.     strcpy(pathbuf, name);
  725.     if ((cp = strrchr(pathbuf, '\\')) != NULL) {    /* path present */
  726.         cp[1] = 0;
  727.         fname = strrchr(name, '\\') + 1;
  728.     }
  729.     else {
  730.         pathbuf[0] = 0;
  731.         fname = name;
  732.     }
  733.  
  734.     /* get the current directory of the selected drive */
  735.  
  736.     regs.h.ah = 0x47;
  737.     regs.h.dl = drive + 1 - 'A';
  738. #ifdef MEDMEM
  739.     regs.x.si = (unsigned) curdir;
  740.     intdos(®s, ®s);
  741. #else
  742.     regs.x.si = (unsigned) FP_OFF(curdir);
  743.     sregs.ds = (unsigned) FP_SEG(curdir);
  744.     intdosx(®s, ®s, &sregs);
  745. #endif
  746.  
  747.     if (regs.x.cflag != 0) return FALSE;    /* invalid drive */
  748.  
  749.     /* peel off "..\"s */
  750.     while (strncmp(pathbuf, "..\\", 3) == 0) {
  751.         if (*curdir == 0) return FALSE;     /* already at root */
  752.         strcpy(pathbuf, pathbuf+3);
  753.         if ((cp=strrchr(curdir, '\\')) != NULL)
  754.         *cp = 0;    /* peel one depth of directories */
  755.         else
  756.         *curdir = 0;    /* peeled back to root */
  757.     }
  758.  
  759.     /* allow for a ".\" */
  760.     if (strncmp(pathbuf, ".\\", 2) == 0)
  761.         strcpy(pathbuf, pathbuf+2);
  762.  
  763.     /* final name is drive:\curdir\pathbuf\fname */
  764.  
  765.     if (strlen(pathbuf)+strlen(curdir)+strlen(fname)+4 > FNAMEMAX)
  766.         return FALSE;
  767.  
  768.     if (*curdir)
  769.         sprintf(rname, "%c:\\%s\\%s%s", drive, curdir, pathbuf, fname);
  770.     else
  771.         sprintf(rname, "%c:\\%s%s", drive, pathbuf, fname);
  772.     }
  773.  
  774.     /* lowercase the whole string */
  775.  
  776.     for (cp = rname; (i = *cp) != 0; cp++) {
  777.     if (isupper(i)) *cp = tolower(i);
  778.     }
  779.  
  780.     return TRUE;
  781. }
  782.  
  783. extern void gc(void);
  784.  
  785. LOCAL int XNEAR getslot(VOID)
  786. {
  787.     int i=0;
  788.  
  789.     for (; i < FTABSIZE; i++)   /* look for available slot */
  790.     if (filetab[i].fp == NULL) return i;
  791.  
  792.     gc();   /* is this safe??????? */
  793.  
  794.     for (i=0; i < FTABSIZE; i++) /* try again -- maybe one has been freed */
  795.     if (filetab[i].fp == NULL) return i;
  796.  
  797.     xlfail("too many open files");
  798.  
  799.     return 0;   /* never returns */
  800. }
  801.  
  802.  
  803. FILEP osaopen(const char *name, const char *mode)
  804. {
  805.     int i=getslot();
  806.     char namebuf[FNAMEMAX+1];
  807.     FILE *fp;
  808.  
  809.     if (!truename((char *)name, namebuf))
  810.     strcpy(namebuf, name);  /* should not happen */
  811.  
  812.     if ((filetab[i].tname = malloc(strlen(namebuf)+1)) == NULL) {
  813.     free(filetab[i].tname);
  814.     xlfail("insufficient memory");
  815.     }
  816.  
  817.  
  818.     if ((fp = fopen(name,mode)) == NULL) {
  819.     free(filetab[i].tname);
  820.     return CLOSED;
  821.     }
  822.  
  823.     filetab[i].fp = fp;
  824.  
  825.     strcpy(filetab[i].tname, namebuf);
  826.  
  827.     return i;
  828. }
  829.  
  830.  
  831. FILEP osbopen(const char *name, const char *mode)
  832. {
  833.     char bmode[10];
  834.  
  835.     strcpy(bmode,mode); strcat(bmode,"b");
  836.  
  837.     return osaopen(name, bmode);
  838. }
  839.  
  840. VOID osclose(FILEP f)
  841. {
  842.     fclose(filetab[f].fp);
  843.     free(filetab[f].tname);
  844.     filetab[f].tname = NULL;
  845.     filetab[f].fp = NULL;
  846. }
  847.  
  848. #else
  849. /* osbopen - open a binary file */
  850. FILE * CDECL osbopen(const char *name, const char *mode)
  851. {
  852.     char bmode[10];
  853.     strcpy(bmode,mode); strcat(bmode,"b");
  854.     return (fopen(name,bmode));
  855. }
  856. #endif
  857.  
  858. #ifdef PATHNAMES
  859. /* ospopen - open for reading using a search path */
  860. FILEP ospopen(char *name, int ascii)
  861. {
  862.     FILEP fp;
  863.     char *path = getenv(PATHNAMES);
  864.     char *newnamep;
  865.     char ch;
  866.     char newname[256];
  867.  
  868.     /* don't do a thing if user specifies explicit path */
  869.     if (strchr(name,'/') != NULL && strchr(name, '\\') != NULL)
  870. #ifdef FILETABLE
  871.     return (ascii? osaopen: osbopen)(name,"r");
  872. #else
  873.     return fopen(name,(ascii? "r": "rb"));
  874. #endif
  875.  
  876.     do {
  877.     if (*path == '\0')  /* no more paths to check */
  878.         /* check current directory just in case */
  879. #ifdef FILETABLE
  880.         return (ascii? osaopen: osbopen)(name,"r");
  881. #else
  882.         return fopen(name,(ascii? "r": "rb"));
  883. #endif
  884.  
  885.     newnamep = newname;
  886.     while ((ch=*path++) != '\0' && ch != ';' && ch != ' ')
  887.         *newnamep++ = ch;
  888.  
  889.     if (ch == '\0') path--;
  890.  
  891.     if (newnamep != newname &&
  892.         *(newnamep-1) != '/' && *(newnamep-1) != '\\')
  893.         *newnamep++ = '/';  /* final path separator needed */
  894.     *newnamep = '\0';
  895.  
  896.     strcat(newname, name);
  897. #ifdef FILETABLE
  898.         fp = (ascii? osaopen: osbopen)(newname,"r");
  899. #else
  900.         fp = fopen(newname, ascii? "r": "rb");
  901. #endif
  902.     } while (fp == CLOSED); /* not yet found */
  903.  
  904.     return fp;
  905. }
  906. #endif
  907.  
  908. /* rename argument file as backup, return success name */
  909. /* For new systems -- if cannot do it, just return TRUE! */
  910.  
  911. int renamebackup(char *filename) {
  912.     char *bufp, ch=0;
  913.  
  914.     strcpy(buf, filename);  /* make copy with .bak extension */
  915.  
  916.     bufp = &buf[strlen(buf)];   /* point to terminator */
  917.     while (bufp > buf && (ch = *--bufp) != '.' && ch != '/' && ch != '\\') ;
  918.  
  919.  
  920.     if (ch == '.') strcpy(bufp, ".bak");
  921.     else strcat(buf, ".bak");
  922.  
  923.     remove(buf);
  924.  
  925.     return !rename(filename, buf);
  926. }
  927.  
  928.  
  929. /* ostgetc - get a character from the terminal */
  930. int ostgetc()
  931. {
  932.     int        ch;
  933.  
  934.     /* check for a buffered character */
  935.     if (lcount-- > 0)
  936.     return (lbuf[lindex++]);
  937.  
  938.     /* get an input line */
  939.  
  940.     for (lcount = 0; ; )
  941.     switch (ch = xgetc()) {
  942.     case '\r':
  943.     case '\n':
  944.         lbuf[lcount++] = '\n';
  945.         xputc('\r'); xputc('\n'); lposition = 0;
  946.         if (tfp!=CLOSED) OSWRITE(lbuf,1,lcount,tfp);
  947.         lindex = 0; lcount--;
  948.         return (lbuf[lindex++]);
  949.     case '\010':
  950.     case '\177':
  951.         if (lcount) {
  952.             lcount--;
  953.             while (lposition > lpos[lcount]) {
  954.             xputc('\b');
  955.             lposition--;
  956.             }
  957.         }
  958.         break;
  959.     case '\032':
  960.         xflush();
  961.         return (EOF);
  962.     default:
  963.         if (ch == '\t' || (ch >= 0x20 && ch < 0x7F)) {
  964.             lbuf[lcount] = ch;
  965.             lpos[lcount] = lposition;
  966.             if (ch == '\t')
  967.             do {
  968.                 xputc(' ');
  969.             } while (++lposition & 7);
  970.             else {
  971.             xputc(ch); lposition++;
  972.             }
  973.             lcount++;
  974.         }
  975.         else {
  976.             xflush();
  977.             switch (ch) {
  978.             case '\003':    xltoplevel();   /* control-c */
  979.             case '\007':    xlcleanup();    /* control-g */
  980.             case '\020':    xlcontinue();   /* control-p */
  981.             case '\032':    return (EOF);   /* control-z */
  982.             default:        return (ch);
  983.             }    /* switch */
  984.         }    /* else */
  985.     }    /* switch */
  986. }
  987.  
  988. /* ostputc - put a character to the terminal */
  989. VOID ostputc(ch)
  990.   int ch;
  991. {
  992.     /* check for control characters */
  993.  
  994.     oscheck();
  995.  
  996.     /* output the character */
  997.     if (ch == '\n') {
  998.     xputc('\r'); xputc('\n');
  999.     lposition = 0;
  1000.     }
  1001.     else if (ch == '\t')
  1002.     do { xputc(' '); } while (++lposition & 7);
  1003.     else {
  1004.     xputc(ch);
  1005.     lposition++;
  1006.    }
  1007.  
  1008.    /* output the character to the transcript file */
  1009.    if (tfp!=CLOSED)
  1010.     OSPUTC(ch,tfp);
  1011. }
  1012.  
  1013. /* osflush - flush the terminal input buffer */
  1014. VOID osflush()
  1015. {
  1016.   kFifoTail = kFifoHead;
  1017. }
  1018.  
  1019. /* oscheck - check for control characters during execution */
  1020. VOID oscheck()
  1021. {
  1022.   MSG    msg;
  1023.   int ch;
  1024.  
  1025.   if( PeekMessage( &msg , MainWindow , 0 , 0xFFFF ,
  1026.       PM_REMOVE ) )
  1027.   {
  1028.     if( !TranslateAccelerator( MainWindow , hAccel , &msg ) )
  1029.     {
  1030.       TranslateMessage( &msg );
  1031.  
  1032.       if( msg.message == WM_CHAR )
  1033.       {
  1034.     ch = msg.wParam;
  1035.     switch (ch)
  1036.     {
  1037.       case '\002':    /* control-b */
  1038.         xflush();
  1039.         xlbreak("BREAK",s_unbound);
  1040.         break;
  1041.  
  1042.       case '\003':    /* control-c */
  1043.         xflush();
  1044.         xltoplevel();
  1045.         break;
  1046.  
  1047.       case '\023':    /* control-s */
  1048.         xgetc();    /* paused -- get character and toss */
  1049.         break;
  1050.     }
  1051.       }
  1052.       else
  1053.     DispatchMessage( &msg );
  1054.     }
  1055.   }
  1056. }
  1057.  
  1058. /* xinfo - show information on control-t */
  1059. static VOID XNEAR xinfo()
  1060. {
  1061.     extern long nfree;
  1062.     extern int gccalls;
  1063.     extern long total;
  1064.  
  1065.     sprintf(buf,"Free: %ld, GC calls: %d, Total: %ld",
  1066.         nfree,gccalls,total);
  1067.     MessageBox( MainWindow , buf , "XLisp - Memory info",
  1068.         MB_OK | MB_ICONINFORMATION );
  1069.  
  1070. }
  1071.  
  1072. /* xflush - flush the input line buffer and start a new line */
  1073. static VOID XNEAR xflush()
  1074. {
  1075.     osflush();
  1076.     ostputc('\n');
  1077. }
  1078.  
  1079. /* xgetc - get a character from the terminal without echo */
  1080. static int XNEAR xgetc()
  1081. {
  1082.   int    ch;
  1083.   LPSTR    p;
  1084.   char    c;
  1085.  
  1086.   CursorVisible = TRUE;
  1087.   XShowCursor();
  1088.   while( 1 )
  1089.   {
  1090.     /* check for a buffered character */
  1091.     if( kFifoHead != kFifoTail )
  1092.     {
  1093.       ch = kFifo[ kFifoTail ];
  1094.       kFifoTail = ++kFifoTail % KB_FIFOSIZE;
  1095.       CursorVisible = FALSE;
  1096.       XHideCursor();
  1097.       return ch;
  1098.     }
  1099.     if( !MessageLoop() )
  1100.       if( GotClientReq )    /* If the message loop was broken
  1101.                    by a client request */
  1102.       {
  1103.     p = XDGetRequest();
  1104.     while( c = *( p++ ) )
  1105.         PutFifo( c );
  1106.     GotClientReq = FALSE;
  1107.     ServerReady = TRUE;
  1108.       }
  1109.       else
  1110.       {
  1111.     CursorVisible = FALSE;
  1112.     XHideCursor();
  1113.     MenuCommand = FUNC_EOF;
  1114.     return EOF;
  1115.       }
  1116.   }
  1117. }
  1118.  
  1119. /* Moves sHeadIndex backward */
  1120. static void XNEAR BackScreenHead()
  1121. {
  1122.   --sHeadIndex;
  1123.   if( sHeadIndex < 0 )
  1124.     sHeadIndex = SCREENBUFSIZE - 1;
  1125. }
  1126.  
  1127. /* Moves sHeadIndex forward */
  1128. static void XNEAR ForwardScreenHead()
  1129. {
  1130.   sHeadIndex = ++sHeadIndex % SCREENBUFSIZE;
  1131.   if( sHeadIndex == sTPosIndex )
  1132.     sTPosIndex = ++sTPosIndex % SCREENBUFSIZE;
  1133. }
  1134.  
  1135. /* Pushes forward the screen tail pointer by one line. Used when scrolling
  1136.    the screen up */
  1137. static void XNEAR ForwardScreenTail( char far *Buf , int xsize )
  1138. {
  1139.   int    xpos = 0;
  1140.  
  1141.   while( xpos < xsize )
  1142.   {
  1143.     if( Buf[ sTailIndex ] == '\n' )
  1144.     {
  1145.       sTailIndex = ++sTailIndex % SCREENBUFSIZE;
  1146.       break;
  1147.     }
  1148.     xpos += FontWidth;
  1149.     sTailIndex = ++sTailIndex % SCREENBUFSIZE;
  1150.   }
  1151. }
  1152.  
  1153.  
  1154. /* Scrolls the screen by one line */
  1155. void ScrollScreen()
  1156. {
  1157.   HDC        hdc;
  1158.   RECT        rect,DelRect;
  1159.   HBRUSH    DelBrush;
  1160.  
  1161.   ScrollWindow( MainWindow , 0 , -FontHeight , NULL , NULL );
  1162.   ValidateRect( MainWindow , NULL );
  1163.   hdc = GetDC( MainWindow );
  1164.   GetClientRect( MainWindow , &rect );
  1165.   SetRect( &DelRect , 0 , ScreenYPos , rect.right ,
  1166.          ScreenYPos + FontHeight + 1 );
  1167.   DelBrush = CreateSolidBrush( GetSysColor( COLOR_WINDOW ) );
  1168.   FillRect( hdc , &DelRect , DelBrush );
  1169.   DeleteObject( DelBrush );
  1170.   ReleaseDC( MainWindow , hdc );
  1171. }
  1172.  
  1173. /* xputc - put a character to the terminal */
  1174. static void XNEAR xputc( int ch )
  1175. {
  1176.   HDC        hdc;
  1177.   char        string[2];
  1178.   char        far *DispBuf,far *ReplyBuf;
  1179.   int        i,chwidth;
  1180.   HBRUSH    DelBrush;
  1181.   RECT        rect,DelRect;
  1182.  
  1183. /* if the reply is passed to the XServer DLL */
  1184.   if( ServerPacket )
  1185.   {
  1186.     ReplyBuf = GlobalLock( ReplyBlock );
  1187.     ReplyBuf[ ReplyIndex ] = ch;
  1188.     ReplyIndex = ++ReplyIndex % RBLOCK_SIZE;
  1189.     GlobalUnlock( ReplyBlock );
  1190.   }
  1191.  
  1192.   string[1] = 0;
  1193.   DispBuf = GlobalLock( ScreenBuf );
  1194.  
  1195.   hdc = GetDC( MainWindow );        /* Get display context for the
  1196.                        main window */
  1197.   SelectObject( hdc , GetStockObject( SYSTEM_FIXED_FONT ) );
  1198.   GetClientRect( MainWindow , &rect );
  1199.   SetBkColor( hdc , GetSysColor( COLOR_WINDOW ) );
  1200.   SetTextColor( hdc , GetSysColor( COLOR_WINDOWTEXT ) );
  1201.  
  1202.   switch( ch )
  1203.   {
  1204.     case '\b':                    /* Backspace */
  1205.     if( !ScreenXPos )            /* if the first char */
  1206.     {
  1207.       if( !ScreenYPos )            /* if at the top of the
  1208.                            screen */
  1209.         break;
  1210.       ScreenYPos -= FontHeight;
  1211.       i = rect.right / FontWidth;
  1212.       ScreenXPos = ( rect.right / FontWidth )*FontWidth;
  1213.     }
  1214.     BackScreenHead();
  1215.     if( DispBuf[ sHeadIndex ] == '\n' )
  1216.         BackScreenHead();
  1217.     string[0] = DispBuf[ sHeadIndex ];
  1218.     chwidth = GetTextExtent( hdc , string , 1 );
  1219.     SetRect( &DelRect , ScreenXPos-FontWidth , ScreenYPos ,
  1220.          ScreenXPos , ScreenYPos + FontHeight );
  1221.     DelBrush = CreateSolidBrush( GetSysColor( COLOR_WINDOW ) );
  1222.     FillRect( hdc , &DelRect , DelBrush );
  1223.     DeleteObject( DelBrush );
  1224.     ScreenXPos -= FontWidth;
  1225.     break;
  1226.  
  1227.     case '\r':                    /* CR */
  1228.     ScreenXPos = 0;
  1229.     break;
  1230.  
  1231.     case '\n':                    /* LF */
  1232.     DispBuf[ sHeadIndex ] = ch;        /* Store LF */
  1233.     ForwardScreenHead();
  1234.     if( ( ScreenYPos + 2*FontHeight ) > rect.bottom )
  1235.     {
  1236.       ForwardScreenTail( DispBuf , rect.right );
  1237.       ScrollScreen();
  1238.     }
  1239.     else
  1240.         ScreenYPos += FontHeight;
  1241.     break;
  1242.  
  1243.     default:
  1244.     string[0] = ch;            /* Makes string of the character */
  1245.     chwidth = GetTextExtent( hdc , string , 1 );
  1246.     if( ( ScreenXPos + FontWidth) >= rect.right )
  1247.     {
  1248.       if( ( ScreenYPos + 2*FontHeight ) > rect.bottom )
  1249.       {
  1250.         ForwardScreenTail( DispBuf , rect.right );
  1251.         ScrollScreen();
  1252.       }
  1253.       else
  1254.         ScreenYPos += FontHeight;
  1255.       ScreenXPos = 0;
  1256.     }
  1257.     i = ( FontWidth - chwidth )/2;
  1258.     TextOut( hdc,ScreenXPos+i,ScreenYPos,string,1 );
  1259.     DispBuf[ sHeadIndex ] = ch;
  1260.     ForwardScreenHead();
  1261.     ScreenXPos += FontWidth;
  1262.     break;
  1263.  
  1264.   }
  1265.   ReleaseDC( MainWindow , hdc );
  1266.   GlobalUnlock( ScreenBuf );
  1267. }
  1268.  
  1269. /* xsystem - execute a system command */
  1270. LVAL xsystem()
  1271. {
  1272.   char    cmd[STRMAX];
  1273.   WORD    ok;
  1274.  
  1275.   MEMCPY( cmd , getstring(xlgastring()) , STRMAX );
  1276.   xllastarg();
  1277.   ok = WinExec( cmd , SW_SHOW );
  1278.   return (ok > 32 ? true : cvfixnum((FIXTYPE)ok));
  1279. }
  1280.  
  1281. /* xgetkey - get a key from the keyboard */
  1282. LVAL xgetkey()
  1283. {
  1284.     xllastarg();
  1285.     return (cvfixnum((FIXTYPE)xgetc()));
  1286. }
  1287.  
  1288. /* ossymbols - enter os specific symbols */
  1289. VOID ossymbols()
  1290. {
  1291. }
  1292.  
  1293. #ifdef GRAPHICS
  1294.  
  1295. static int GrXPos = 0,GrYPos = 0;
  1296. static DWORD DrawColor = 0;
  1297.  
  1298. /* function goto-xy which set/obtains cursor position */
  1299. LVAL xgotoxy()
  1300. {
  1301.     FIXTYPE x, y;
  1302.     LVAL oldpos;
  1303.  
  1304.     oldpos = cons(cvfixnum((FIXTYPE)GrXPos ),
  1305.           cons(cvfixnum((FIXTYPE)GrYPos ),NIL));
  1306.  
  1307.     if (moreargs()) {
  1308.     x = getfixnum(xlgafixnum());
  1309.     y = getfixnum(xlgafixnum());
  1310.     xllastarg();
  1311.     if (x < 0) x = 0;   /* check for in bounds */
  1312.     if (y < 0) y = 0;
  1313.  
  1314.     GrXPos = x;
  1315.     GrYPos = y;
  1316.     lposition = (int)x;
  1317.     }
  1318.  
  1319.     return oldpos;
  1320. }
  1321.  
  1322. LVAL xcls() /* clear the screen */
  1323. {
  1324.   lposition = 0;
  1325.   sHeadIndex = sTailIndex;
  1326.   InvalidateRect( MainWindow , NULL , TRUE );
  1327.   return NIL;
  1328. }
  1329.  
  1330. LVAL xcleol()   /* clear to end of line */
  1331. {
  1332.   HDC        hdc;
  1333.   RECT        rect,DelRect;
  1334.   HBRUSH    DelBrush;
  1335.  
  1336.   hdc = GetDC( MainWindow );
  1337.   GetClientRect( MainWindow , &rect );
  1338.   SetRect( &DelRect , ScreenXPos , ScreenYPos , rect.right ,
  1339.          ScreenYPos + FontHeight + 1 );
  1340.   DelBrush = CreateSolidBrush( GetSysColor( COLOR_WINDOW ) );
  1341.   FillRect( hdc , &DelRect , DelBrush );
  1342.   DeleteObject( DelBrush );
  1343.   ReleaseDC( MainWindow , hdc );
  1344.   return NIL;
  1345. }
  1346.  
  1347. static LVAL XNEAR draw(int x, int y, int x2, int y2)
  1348. {
  1349.   HDC    hdc;
  1350.   HPEN    pen;
  1351.  
  1352.   hdc = GetDC( MainWindow );
  1353.   pen = CreatePen( PS_SOLID , 1 , DrawColor );
  1354.   SelectObject( hdc , pen );
  1355.   MoveTo( hdc , x , y );
  1356.   LineTo( hdc , x2 , y2 );
  1357.   GrXPos = x2;
  1358.   GrYPos = y2;
  1359.   ReleaseDC( MainWindow , hdc );
  1360.   DeleteObject( pen );
  1361.  
  1362.   return( true );
  1363. }
  1364.  
  1365.  
  1366. /* xmode -- set display mode */
  1367. LVAL xmode()
  1368. {
  1369.   xoserror( "xmode : not implemented under Windows" );
  1370.   return NIL;
  1371. }
  1372.  
  1373. /* xcolor -- set color */
  1374.  
  1375. LVAL xcolor()
  1376. {
  1377.     LVAL arg;
  1378.  
  1379.     arg = xlgafixnum();
  1380.     xllastarg();
  1381.  
  1382.     DrawColor = getfixnum(arg);
  1383.  
  1384.     return (arg);
  1385. }
  1386.  
  1387. /* xdraw -- absolute draw */
  1388.  
  1389. LVAL xdraw()
  1390. {
  1391.     LVAL arg = true;
  1392.     int newx, newy;
  1393.  
  1394.     while (moreargs()) {
  1395.     arg = xlgafixnum();
  1396.     newx = (int) getfixnum(arg);
  1397.  
  1398.     arg = xlgafixnum();
  1399.     newy = (int) getfixnum(arg);
  1400.  
  1401.     arg = draw(GrXPos,GrYPos,newx,newy);
  1402.  
  1403.     }
  1404.     return (arg);
  1405. }
  1406.  
  1407. /* xdrawrel -- absolute draw */
  1408.  
  1409. LVAL xdrawrel()
  1410. {
  1411.     LVAL arg = true;
  1412.     int newx, newy;
  1413.  
  1414.     while (moreargs()) {
  1415.     arg = xlgafixnum();
  1416.     newx = GrXPos + (int) getfixnum(arg);
  1417.  
  1418.     arg = xlgafixnum();
  1419.     newy = GrYPos + (int) getfixnum(arg);
  1420.  
  1421.     arg = draw(GrXPos,GrYPos,newx,newy);
  1422.  
  1423.     }
  1424.     return (arg);
  1425. }
  1426.  
  1427. /* xmove -- absolute move, then draw */
  1428.  
  1429. LVAL xmove()
  1430. {
  1431.     LVAL arg;
  1432.  
  1433.     arg = xlgafixnum();
  1434.     GrXPos = (int) getfixnum(arg);
  1435.  
  1436.     arg = xlgafixnum();
  1437.     GrYPos = (int) getfixnum(arg);
  1438.  
  1439.     return (xdraw());
  1440. }
  1441.  
  1442. /* xmoverel -- relative move */
  1443.  
  1444. LVAL xmoverel()
  1445. {
  1446.     LVAL arg;
  1447.  
  1448.     arg = xlgafixnum();
  1449.     GrXPos += (int) getfixnum(arg);
  1450.  
  1451.     arg = xlgafixnum();
  1452.     GrYPos += (int) getfixnum(arg);
  1453.  
  1454.     return (xdrawrel());
  1455. }
  1456.  
  1457. #endif        /* Graphics */
  1458.  
  1459. #ifdef TIMES
  1460. unsigned long ticks_per_second() { return((unsigned long) CLK_TCK); }
  1461.  
  1462. unsigned long run_tick_count()
  1463. {
  1464.   return((unsigned long) clock()); /* Real time in MSDOS */
  1465. }
  1466.  
  1467. unsigned long real_tick_count()
  1468. {                                  /* Real time */
  1469.   return((unsigned long) clock());
  1470. }
  1471.  
  1472.  
  1473. LVAL xtime()
  1474. {
  1475.     LVAL expr,result;
  1476.     unsigned long tm;
  1477.  
  1478.     /* get the expression to evaluate */
  1479.     expr = xlgetarg();
  1480.     xllastarg();
  1481.  
  1482.     tm = run_tick_count();
  1483.     result = xleval(expr);
  1484.     tm = run_tick_count() - tm;
  1485.     sprintf(buf, "The evaluation took %.2f seconds.\n",
  1486.         ((double)tm) / ticks_per_second());
  1487.     trcputstr(buf);
  1488.  
  1489.  
  1490.     return(result);
  1491. }
  1492.  
  1493. LVAL xruntime() {
  1494.     xllastarg();
  1495.     return(cvfixnum((FIXTYPE) run_tick_count()));
  1496. }
  1497.  
  1498. LVAL xrealtime() {
  1499.     xllastarg();
  1500.     return(cvfixnum((FIXTYPE) real_tick_count()));
  1501. }
  1502.  
  1503.  
  1504. #endif
  1505.