home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / amiga / utility / text / emacsdif.lha / emacs-18.58 / src / amiga_screen.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-05-04  |  24.5 KB  |  899 lines

  1. #include "config.h"
  2. #undef NULL
  3. #include "lisp.h"
  4. #include "termchar.h"
  5. #include "dispextern.h"
  6.  
  7. #include <stdio.h>
  8. #include <string.h>
  9.  
  10. #define min(x,y) ((x) > (y) ? (y) : (x))
  11. #define max(x,y) ((x) < (y) ? (y) : (x))
  12.  
  13. #undef LONGBITS
  14.  
  15. #include <exec/types.h>
  16. #include <intuition/intuition.h>
  17. #include <devices/conunit.h>
  18. #include <devices/inputevent.h>
  19. #include <devices/timer.h>
  20. #include <graphics/gfxbase.h>
  21. #include <graphics/gfxmacros.h>
  22. #include <utility/hooks.h>
  23. #include <workbench/startup.h>
  24. #include <workbench/workbench.h>
  25.  
  26. #include <proto/exec.h>
  27. #include <proto/dos.h>
  28. #include <proto/intuition.h>
  29. #include <proto/graphics.h>
  30. #include <proto/console.h>
  31. #include <proto/timer.h>
  32. #include <proto/diskfont.h>
  33. #include <proto/wb.h>
  34.  
  35. extern struct Library *TimerBase, *WorkbenchBase;
  36.  
  37. #include "amiga.h"
  38.  
  39. #define SHIFT_MASK (IEQUALIFIER_LSHIFT | IEQUALIFIER_RSHIFT)
  40. #define CONTROL_MASK IEQUALIFIER_CONTROL
  41. #define META_MASK IEQUALIFIER_LALT
  42.  
  43. extern struct GfxBase *GfxBase;
  44. extern struct IntuitionBase *IntuitionBase;
  45. struct Library *DiskfontBase;
  46.  
  47. static struct Device *ConsoleDevice;
  48. struct Window *emacs_win;
  49. struct Screen *emacs_screen;
  50. char *emacs_screen_name;
  51. static struct TextFont *font;
  52. int font_opened;
  53. /* The reset string resets the console, turns off scrolling and sets up
  54.    the foreground & background colors. */
  55. #define CONSOLE_RESET "\x1b""c\x9b>1l\x9b""3%d;4%d;>%dm"
  56. char reset_string[20]; /* Must be big enough for
  57.               printf(CONSOLE_RESET, foreground, background, background);
  58.               (0 <= foreground, background <= 7) */
  59. int foreground = 1, background = 0;
  60.  
  61. static struct IOStdReq *emacs_console;
  62.  
  63. static struct NewWindow far emacs_window =
  64. {
  65.     0, 0,                /* LeftEdge, TopEdge   */
  66.     640, 200,                /* Width, Height       */
  67.     -1, -1,                /* DetailPen, BlockPen */
  68.     IDCMP_CLOSEWINDOW | IDCMP_RAWKEY | IDCMP_MOUSEBUTTONS | IDCMP_NEWSIZE |
  69.     IDCMP_MENUPICK | IDCMP_MENUHELP,
  70.     WFLG_CLOSEGADGET | WFLG_SIZEGADGET | WFLG_DRAGBAR | WFLG_DEPTHGADGET |
  71.     WFLG_ACTIVATE | WFLG_SIMPLE_REFRESH,
  72.     0,                    /* First Gadget        */
  73.     0,                    /* CheckMark           */
  74.     (UBYTE *)"GNU Emacs 18.58, Amiga port "VERS,
  75.     0,                    /* Screen              */
  76.     0,                    /* BitMap              */
  77.     0, 0,                /* Min Width, Height   */
  78.     STDSCREENWIDTH, STDSCREENHEIGHT, /* Max Width, Height   */
  79.     WBENCHSCREEN,            /* Type */
  80. };
  81.  
  82. #define emacs_icon_width 57
  83. #define emacs_icon_height 55
  84. #define emacs_icon_num_planes 1
  85. #define emacs_icon_words_per_plane 220
  86.  
  87. UWORD chip emacs_icon_data[1][55][4] = {
  88.     {
  89.         0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,
  90.         0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,
  91.         0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0fe0,0x6000,
  92.         0x0000,0x0000,0x0060,0x6000,0x0000,0x0000,0x0fff,0xe000,
  93.         0x0000,0x0000,0x1800,0x2000,0x0000,0x0000,0x13ff,0xa000,
  94.         0x0000,0x0000,0x1400,0xa000,0x0000,0x0000,0x3600,0xa000,
  95.         0x0000,0x0000,0x0000,0xa000,0x0000,0x0000,0x0c00,0xa000,
  96.         0x0000,0x0000,0x1e00,0xa000,0x0000,0x0000,0x0c00,0xa000,
  97.         0x0000,0x0000,0x0000,0xa000,0x0000,0x0000,0x2100,0xa000,
  98.         0x0000,0x0000,0x3300,0xa000,0x0000,0x0000,0x0c00,0xa000,
  99.         0x003f,0xffff,0xffff,0xb000,0x001f,0xffff,0xffff,0x8000,
  100.         0x004e,0x0000,0x0001,0xf000,0x00c6,0x00f0,0x0001,0x8000,
  101.         0x00c6,0x0100,0x0001,0x8000,0x0006,0x0103,0x9201,0x8000,
  102.         0x0006,0x013a,0x5201,0x8000,0x00c6,0x010a,0x5201,0x8000,
  103.         0x00c6,0x010a,0x5601,0x8000,0x0086,0x00f2,0x4a01,0x8000,
  104.         0x0006,0x0000,0x0001,0x8000,0x0046,0x0000,0x0001,0x8000,
  105.         0x00c6,0x7c00,0x0001,0x8000,0x00c6,0x4000,0x0001,0x8000,
  106.         0x0006,0x41d8,0xc319,0x8000,0x0006,0x7925,0x24a1,0x8000,
  107.         0x00c6,0x4125,0x2419,0x8000,0x01c6,0x4125,0x2485,0x8000,
  108.         0x0086,0x7d24,0xd319,0x8000,0x0007,0x0000,0x0003,0x8000,
  109.         0x0003,0xffe3,0xffff,0x0000,0x0081,0xfff7,0xfffe,0x0000,
  110.         0x01c0,0x0036,0x0000,0x0000,0x0180,0x0014,0x0f80,0x0000,
  111.         0x0000,0x0014,0x1040,0x0000,0x0000,0x0014,0x2720,0x0000,
  112.         0x0000,0x0012,0x28a0,0x0000,0x0080,0x000a,0x48a0,0x0000,
  113.         0x01c0,0x0009,0x90a0,0x0000,0x0180,0x0004,0x20a0,0x0000,
  114.         0x0000,0x0003,0xc0a0,0x0000,0x0000,0x0000,0x00a0,0x0000,
  115.         0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,
  116.         0x0000,0x0000,0x0000,0x0000
  117.     },
  118. };
  119.  
  120. struct Image far emacs_icon = {
  121.   0, 0,
  122.   emacs_icon_width, emacs_icon_height, emacs_icon_num_planes,
  123.   emacs_icon_data,
  124.   3, 0,
  125.   0
  126. };
  127.   
  128. static struct Hook background_hook;
  129.  
  130. #define EVENTSIZE 32
  131.  
  132. static struct event {
  133.     ULONG class;
  134.     UWORD code, qual;
  135.     WORD x, y;
  136. } events[EVENTSIZE];
  137. static int event_num, event_in, event_out;
  138.  
  139. Lisp_Object Vamiga_mouse_pos;
  140. Lisp_Object Vamiga_mouse_item;
  141. extern Lisp_Object MouseMap;
  142. int amiga_remap_bsdel;
  143. int amiga_mouse_initialized;
  144.  
  145. static int amiga_pos_x(int x)
  146. {
  147.     return (x - emacs_win->BorderLeft) / emacs_win->RPort->Font->tf_XSize;
  148. }
  149.  
  150. static int amiga_pos_y(int y)
  151. {
  152.     return (y - emacs_win->BorderTop) / emacs_win->RPort->Font->tf_YSize;
  153. }
  154.  
  155. static void amiga_change_size(void)
  156. {
  157.     int new_height = amiga_pos_y(emacs_win->Height - emacs_win->BorderBottom);
  158.     int new_width = amiga_pos_x(emacs_win->Width - emacs_win->BorderRight);
  159.  
  160.     /* Hack to force redisplay */
  161.     if (screen_height == new_height) screen_height--;
  162.     change_screen_size(new_height, new_width, 0, !sleeping && !waiting_for_input, 1);
  163. }
  164.  
  165. /* Get terminal size from system.
  166.    Store number of lines into *heightp and width into *widthp.
  167.    If zero or a negative number is stored, the value is not valid.  */
  168.  
  169. void get_window_size (widthp, heightp)
  170.      int *widthp, *heightp;
  171. {
  172.     *heightp = amiga_pos_y(emacs_win->Height - emacs_win->BorderBottom);
  173.     *widthp = amiga_pos_x(emacs_win->Width - emacs_win->BorderRight);
  174. }
  175.  
  176. static int set_min_size(struct Window *win, struct TextFont *font,
  177.             WORD *minw, WORD *minh)
  178. {
  179.     *minw = 11 * font->tf_XSize + win->BorderLeft + win->BorderRight;
  180.     *minh = 4 * font->tf_YSize + win->BorderTop + win->BorderBottom;
  181.  
  182.     return (int)WindowLimits(emacs_win, *minw, *minh, 0, 0);
  183. }
  184.  
  185. struct fill
  186. {
  187.     struct Layer *layer;
  188.     struct Rectangle bounds;
  189.     WORD offsetx, offsety;
  190. };
  191.  
  192. static ULONG __asm __saveds fill_background(register __a2 struct RastPort *obj,
  193.                                             register __a1 struct fill *msg)
  194. {
  195.     struct Layer *l;
  196.  
  197.     SetAPen(obj, background);
  198.     SetDrMd(obj, JAM1);
  199.     SetAfPt(obj, 0, 0);
  200.     SetWrMsk(obj, 0xff);
  201.     /* Gross hack starts here */
  202.     l = obj->Layer;
  203.     obj->Layer = 0;
  204.     /* Stops */
  205.     RectFill(obj, msg->bounds.MinX, msg->bounds.MinY,
  206.          msg->bounds.MaxX, msg->bounds.MaxY);
  207.     /* Starts again */
  208.     obj->Layer = l;
  209.     /* And finally dies */
  210.  
  211.     return 0;
  212. }
  213.  
  214. static void clear_window(void)
  215. {
  216.     SetAPen(emacs_win->RPort, background);
  217.     RectFill(emacs_win->RPort, emacs_win->BorderLeft, emacs_win->BorderTop,
  218.          emacs_win->Width - emacs_win->BorderRight - 1,
  219.          emacs_win->Height - emacs_win->BorderBottom - 1);
  220. }
  221.  
  222. static int make_reset_string(void)
  223. {
  224.     sprintf(reset_string, CONSOLE_RESET, foreground, background, background);
  225. }
  226.  
  227. /* returns:
  228.  *    -2 if msg is not class RAWKEY
  229.  *    same as RawKeyConvert otherwise:
  230.  *    buffer length if <= kbsize
  231.  *    -1 else
  232.  */
  233. static DeadKeyConvert(struct IntuiMessage *msg, UBYTE *kbuffer, int kbsize,
  234.               struct KeyMap *kmap)
  235. {
  236.     static struct InputEvent ievent = {0, IECLASS_RAWKEY, 0, 0, 0};
  237.  
  238.     if (msg->Class != RAWKEY) return (-2);
  239.  
  240.     /* Do some keymapping ourselves to make emacs users happy */
  241.  
  242.     /* Ctrl-space becomes Ctrl-@ */
  243.     if (msg->Code == 0x40 && msg->Qualifier & CONTROL_MASK)
  244.     {
  245.     *kbuffer = 0;
  246.     return 1;
  247.     }
  248.     /* Backspace becomes DEL */
  249.     if (msg->Code == 0x41 && amiga_remap_bsdel)
  250.     {
  251.     *kbuffer = 0177;
  252.     return 1;
  253.     }
  254.     /* And DEL becomes CTRL-D */
  255.     if (msg->Code == 0x46 && amiga_remap_bsdel)
  256.     {
  257.     *kbuffer = 04;
  258.     return 1;
  259.     }
  260.  
  261.     /* pack input event */
  262.     ievent.ie_Code = msg->Code;
  263.  
  264.     /* Ignore meta in decoding keys */
  265.     ievent.ie_Qualifier = msg->Qualifier & ~META_MASK;
  266.  
  267.     /* get previous codes from location pointed to by IAddress
  268.      *  this pointer is valid until IntuiMessage is replied.
  269.      */
  270.     ievent.ie_position.ie_addr = *((APTR *)msg->IAddress);
  271.     ievent.ie_position.ie_dead.ie_prev1DownQual &= ~META_MASK;
  272.     ievent.ie_position.ie_dead.ie_prev2DownQual &= ~META_MASK;
  273.  
  274.     return ( RawKeyConvert(&ievent, kbuffer, kbsize, kmap) );
  275. }
  276.  
  277. void check_window(int force)
  278. {
  279.     ULONG class;
  280.     USHORT code;
  281.     USHORT qualifier;
  282.     UWORD mx, my;
  283.     unsigned char buf[32];
  284.     int buflen;
  285.     struct IntuiMessage *msg;
  286.     int mouse_event = FALSE;
  287.  
  288.     while (msg = (struct IntuiMessage *)GetMsg(emacs_win->UserPort))
  289.     {
  290.     class = msg->Class;
  291.     code = msg->Code;
  292.     qualifier = msg->Qualifier;
  293.     mx = msg->MouseX; my = msg->MouseY;
  294.     buflen = DeadKeyConvert(msg, buf, 32, 0);
  295.     ReplyMsg(msg);
  296.  
  297.     switch (class)
  298.     {
  299.         case IDCMP_CLOSEWINDOW: {
  300.         enque(030, FALSE); enque(03, FALSE); /* ^X^C */
  301.         break;
  302.         }
  303.         case IDCMP_RAWKEY: {
  304.         if (buflen > 0)
  305.         {
  306.             unsigned char *sbuf = buf;
  307.             int meta = qualifier & META_MASK;
  308.  
  309.             /* Don't set META on CSI */
  310.             do {
  311.             enque(*sbuf, meta && *sbuf != 0233);
  312.             sbuf++;
  313.             } while (--buflen);
  314.         }
  315.         break;
  316.         }
  317.         case IDCMP_NEWSIZE: amiga_change_size(); break;
  318.         case IDCMP_MENUPICK: case IDCMP_MENUHELP:
  319.             if (code == MENUNULL) break; /* else fall through */
  320.         case IDCMP_MOUSEBUTTONS: {
  321.         mouse_event = TRUE;
  322.         if (event_num == EVENTSIZE) break;
  323.  
  324.         events[event_in].class = class;
  325.         events[event_in].code = code;
  326.         events[event_in].qual = qualifier;
  327.         events[event_in].x = mx;
  328.         events[event_in].y = my;
  329.         event_num++;
  330.         event_in = (event_in + 1) % EVENTSIZE;
  331.  
  332.         break;
  333.         }
  334.     }
  335.     }
  336.     if (amiga_mouse_initialized && (force && event_num > 0 || mouse_event))
  337.     {
  338.     enque(AMIGASEQ, FALSE); enque('M', FALSE);
  339.     }
  340. }
  341.  
  342. DEFUN ("amiga-mouse-events", Famiga_mouse_events, Samiga_mouse_events, 0, 0, 0,
  343.   "Return number of pending mouse events from Intuition.")
  344.   ()
  345. {
  346.     register Lisp_Object tem;
  347.  
  348.     check_intuition ();
  349.  
  350.     XSET (tem, Lisp_Int, event_num);
  351.  
  352.     return tem;
  353. }
  354.  
  355. DEFUN ("amiga-proc-mouse-event", Famiga_proc_mouse_event, Samiga_proc_mouse_event,
  356.   0, 0, 0,
  357.   "Pulls a mouse event out of the mouse event buffer and dispatches\n\
  358. the appropriate function to act upon this event.")
  359.   ()
  360. {
  361.     register Lisp_Object mouse_cmd;
  362.     register char com_letter;
  363.     register char key_mask;
  364.     register Lisp_Object tempx;
  365.     register Lisp_Object tempy;
  366.     extern Lisp_Object get_keyelt ();
  367.     extern int meta_prefix_char;
  368.     struct event *ev;
  369.  
  370.     check_intuition ();
  371.  
  372.     if (event_num) {
  373.     ev = &events[event_out];
  374.     event_out = (event_out + 1) % EVENTSIZE;
  375.     event_num--;
  376.     if (ev->class == MOUSEBUTTONS)
  377.     {
  378.         switch (ev->code)
  379.         {
  380.         case SELECTDOWN: com_letter = 2; break;
  381.         case SELECTUP: com_letter = 6; break;
  382.         case MIDDLEDOWN: com_letter = 1; break;
  383.         case MIDDLEUP: com_letter = 5; break;
  384.         case MENUDOWN: com_letter = 0; break;
  385.         case MENUUP: com_letter = 4; break;
  386.         default: com_letter = 3; break;
  387.         }
  388.         XSET (tempx, Lisp_Int,
  389.           min (screen_width-1,
  390.                max (0, amiga_pos_x(ev->x))));
  391.         XSET (tempy, Lisp_Int,
  392.           min (screen_height-1,
  393.                max (0, amiga_pos_y(ev->y))));
  394.     }
  395.     else
  396.     {
  397.         /* Must be Menu Pick or Help */
  398.         com_letter = ev->class == IDCMP_MENUPICK ? 3 : 7;
  399.  
  400.         /* The parameters passed describe the selected item */
  401.         XSET (tempx, Lisp_Int, MENUNUM(ev->code));
  402.         XSET (tempy, Lisp_Int, ITEMNUM(ev->code));
  403.     }
  404.     if (ev->qual & META_MASK) com_letter |= 0x20;
  405.     if (ev->qual & SHIFT_MASK) com_letter |= 0x10;
  406.     if (ev->qual & CONTROL_MASK) com_letter |= 0x40;
  407.  
  408.     Vamiga_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
  409.     Vamiga_mouse_item = make_number (com_letter);
  410.     mouse_cmd = get_keyelt (access_keymap (MouseMap, com_letter));
  411.     if (NULL (mouse_cmd)) {
  412.         bell ();
  413.         Vamiga_mouse_pos = Qnil;
  414.     }
  415.     else return call1 (mouse_cmd, Vamiga_mouse_pos);
  416.     }
  417.     return Qnil;
  418. }
  419.  
  420. DEFUN ("amiga-get-mouse-event", Famiga_get_mouse_event, Samiga_get_mouse_event,
  421.   1, 1, 0,
  422.   "Get next mouse event out of mouse event buffer (com-letter (x y)).\n\
  423. ARG non-nil means return nil immediately if no pending event;\n\
  424. otherwise, wait for an event.")
  425.   (arg)
  426.      Lisp_Object arg;
  427. {
  428.     register char com_letter;
  429.     register char key_mask;
  430.  
  431.     register Lisp_Object tempx;
  432.     register Lisp_Object tempy;
  433.     struct event *ev;
  434.  
  435.     check_intuition ();
  436.  
  437.     if (NULL (arg))
  438.     {
  439.     amiga_consume_input(FALSE);
  440.     while (!event_num)
  441.     {
  442.         amiga_wait_for_input();
  443.         amiga_consume_input(FALSE);
  444.     }
  445.     }
  446.     /*** ??? Surely you don't mean to busy wait??? */
  447.  
  448.     if (event_num) {
  449.     ev = &events[event_out];
  450.     event_out = (event_out + 1) % EVENTSIZE;
  451.     event_num--;
  452.     switch (ev->code)
  453.     {
  454.         case SELECTDOWN: com_letter = 2; break;
  455.         case SELECTUP: com_letter = 6; break;
  456.         case MIDDLEDOWN: com_letter = 1; break;
  457.         case MIDDLEUP: com_letter = 5; break;
  458.         case MENUDOWN: com_letter = 0; break;
  459.         case MENUUP: com_letter = 4; break;
  460.         default: com_letter = 3; break;
  461.     }
  462.     if (ev->qual & META_MASK) com_letter |= 0x20;
  463.     if (ev->qual & SHIFT_MASK) com_letter |= 0x10;
  464.     if (ev->qual & CONTROL_MASK) com_letter |= 0x40;
  465.  
  466.     XSET (tempx, Lisp_Int,
  467.           min (screen_width-1,
  468.            max (0, amiga_pos_x(ev->x))));
  469.     XSET (tempy, Lisp_Int,
  470.           min (screen_height-1,
  471.            max (0, amiga_pos_y(ev->y))));
  472.  
  473.     Vamiga_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
  474.     Vamiga_mouse_item = make_number (com_letter);
  475.     return Fcons (com_letter, Fcons (Vamiga_mouse_pos, Qnil));
  476.     }
  477.     return Qnil;
  478. }
  479.  
  480. DEFUN("amiga-set-foreground-color", Famiga_set_foreground_color,
  481.   Samiga_set_foreground_color, 1, 1, "nPen number: ",
  482.   "Use PEN as foreground color")
  483.   (pen)
  484. {
  485.     int fg;
  486.  
  487.     CHECK_NUMBER(pen, 0);
  488.  
  489.     fg = XUINT (pen);
  490.     if (pen > 7) error("Pen colors must be between 0 & 7");
  491.     foreground = fg;
  492.     make_reset_string();
  493.     screen_puts (reset_string, strlen(reset_string));
  494.     clear_window();
  495.     amiga_change_size ();
  496.     return Qnil;
  497. }
  498.  
  499. DEFUN("amiga-set-background-color", Famiga_set_background_color,
  500.   Samiga_set_background_color, 1, 1, "nPen number: ",
  501.   "Use PEN as background color")
  502.   (pen)
  503. {
  504.     int bg;
  505.  
  506.     CHECK_NUMBER(pen, 0);
  507.  
  508.     bg = XUINT (pen);
  509.     if (pen > 7) error("Pen colors must be between 0 & 7");
  510.     background = bg;
  511.     make_reset_string();
  512.     screen_puts (reset_string, strlen(reset_string));
  513.     clear_window();
  514.     amiga_change_size ();
  515.     return Qnil;
  516. }
  517.  
  518. DEFUN("amiga-set-font", Famiga_set_font, Samiga_set_font, 2, 2,
  519.   "sFont: \n\
  520. nSize: ",
  521.   "Set font used for window to FONT with given HEIGHT.\n\
  522. The font used must be non-proportional.")
  523.   (wfont, height)
  524. {
  525.     struct TextAttr attr;
  526.     struct TextFont *newfont;
  527.     char *fname;
  528.     struct Lisp_String *fstr;
  529.     WORD minw, minh, oldmw, oldmh;
  530.  
  531.     CHECK_STRING (wfont, 0);
  532.     CHECK_NUMBER (height, 0);
  533.  
  534.     check_intuition();
  535.  
  536.     fstr = XSTRING (wfont);
  537.     fname = (char *)alloca (fstr->size + 6);
  538.     strcpy (fname, fstr->data);
  539.     strcat (fname, ".font");
  540.     attr.ta_Name = fname;
  541.     attr.ta_YSize = XFASTINT (height);
  542.     attr.ta_Style = 0;
  543.     attr.ta_Flags = 0;
  544.     newfont = OpenDiskFont (&attr);
  545.  
  546.     if (!newfont)
  547.     error ("Font %s %d not found", fstr->data, XFASTINT (height));
  548.     if (newfont->tf_Flags & FPF_PROPORTIONAL)
  549.     {
  550.     CloseFont(newfont);
  551.     error ("Font %s %d is proportional", fstr->data, XFASTINT (height));
  552.     }
  553.  
  554.     if (!set_min_size(emacs_win, newfont, &minw, &minh))
  555.     {
  556.     CloseFont(newfont);
  557.     if (!set_min_size(emacs_win, font, &oldmw, &oldmh))
  558.     {
  559.         fprintf(stderr, "Failed to restore old minimum window size, aborting\n");
  560.         exit(1);
  561.     }
  562.     error("Window is too small for this font, need at least %d(w) by %d(h)",
  563.           minw, minh);
  564.     }
  565.  
  566.     if (font_opened) CloseFont(font);
  567.     font_opened = TRUE;
  568.  
  569.     SetFont (emacs_win->RPort, newfont);
  570.     font = newfont;
  571.     /* Reset console to use new font */
  572.     screen_puts (reset_string, strlen(reset_string));
  573.     clear_window();
  574.     amiga_change_size ();
  575.     return Qnil;
  576. }
  577.  
  578. DEFUN("amiga-set-geometry", Famiga_set_geometry, Samiga_set_geometry, 4, 5, 0,
  579.   "Set Emacs window geometry and screen.\n\
  580. First 4 parameters are the (X,Y) position of the top-left corner of the window\n\
  581. and its WIDTH and HEIGHT. These must be big enough for an 11x4 characters window.\n\
  582. The optional argument SCREEN specifies which screen to use, nil stands for the\n\
  583. same screen as the window is on, t stands for the default public screen (normally\n\
  584. the Workbench), a string specifies a given public screen.")
  585.   (x, y, w, h, scr)
  586. Lisp_Object x, y, w, h, scr;
  587. {
  588.     struct Screen *newscreen;
  589.     struct Window *newwindow;
  590.     struct IOStdReq *newconsole;
  591.     WORD minw, minh;
  592.  
  593.     CHECK_NUMBER(x, 0);
  594.     CHECK_NUMBER(y, 0);
  595.     CHECK_NUMBER(w, 0);
  596.     CHECK_NUMBER(h, 0);
  597.  
  598.     if (NULL (scr)) newscreen = emacs_screen;
  599.     else if (scr == Qt) newscreen = 0;
  600.     else
  601.     {
  602.     CHECK_STRING(scr, 0);
  603.     newscreen = LockPubScreen(XSTRING (scr)->data);
  604.     if (!newscreen) error("Unknown public screen %s", XSTRING (scr)->data);
  605.     }
  606.     newwindow = OpenWindowTags(&emacs_window,
  607.                    WA_Left, XUINT (x), WA_Top, XUINT (y),
  608.                    WA_Width, XUINT (w), WA_Height, XUINT (h),
  609.                    WA_PubScreen, newscreen,
  610.                           WA_BackFill, &background_hook,
  611.                    WA_MenuHelp, TRUE,
  612.                    TAG_END);
  613.     UnlockPubScreen(0L, newscreen);
  614.     if (!newwindow) error("Failed to open desired window");
  615.     if (!set_min_size(newwindow, font, &minw, &minh))
  616.     {
  617.     CloseWindow(newwindow);
  618.     error("Window is too small, need at least %d(w) by %d(h)", minw, minh);
  619.     }
  620.     SetFont(emacs_win->RPort, font);
  621.  
  622.     newconsole = (struct IOStdReq *)device_open("console.device", CONU_CHARMAP,
  623.                         CONFLAG_NODRAW_ON_NEWSIZE,
  624.                         (APTR)newwindow, sizeof(*newwindow),
  625.                         sizeof(struct IOStdReq));
  626.     if (!newconsole)
  627.     {
  628.     CloseWindow(newwindow);
  629.     error("Failed to open console for window (No memory?)");
  630.     }
  631.     suspend_menus();
  632.     if (!set_menu_window(newwindow))
  633.     {
  634.     device_close(newconsole);
  635.     CloseWindow(newwindow);
  636.     resume_menus();
  637.     error("Failed to setup menus (No memory?)");
  638.     }
  639.     /* Use new window */
  640.     device_close(emacs_console);
  641.     emacs_console = newconsole;
  642.     inputsig &= ~(1L << emacs_win->UserPort->mp_SigBit);
  643.     emacs_screen = newscreen;
  644.     if (emacs_screen_name) free (emacs_screen_name);
  645.     emacs_screen_name = (char *)xmalloc (XSTRING (scr)->size + 1);
  646.     strcpy(emacs_screen_name, XSTRING (scr)->data);
  647.     CloseWindow(emacs_win);
  648.     emacs_win = newwindow;
  649.     inputsig |= 1L << emacs_win->UserPort->mp_SigBit;
  650.     resume_menus();
  651.     /* Turn off scrolling */
  652.     screen_puts (reset_string, strlen(reset_string));
  653.     clear_window();
  654.     amiga_change_size ();
  655.  
  656.     return Qnil;
  657. }
  658.  
  659.  
  660. void Iconify(struct Image *im)
  661. {
  662.     struct AppIcon *icon;
  663.     struct MsgPort *port;
  664.     static struct DiskObject wbicon = {
  665.     0, 0,
  666.         { 0 },
  667.     0, 0, 0,
  668.     NO_ICON_POSITION, NO_ICON_POSITION
  669.     };
  670.  
  671.  
  672.     if (port = CreateMsgPort())
  673.     {
  674.     wbicon.do_Gadget.Width = im->Width;
  675.     wbicon.do_Gadget.Height = im->Height;
  676.     wbicon.do_Gadget.GadgetRender = (APTR)im;
  677.  
  678.     if (icon = AddAppIconA(0, 0, "Emacs", port, 0, &wbicon, 0))
  679.     {
  680.         struct AppMessage *msg;
  681.         int quit = FALSE;
  682.  
  683.         while (!quit)
  684.         {
  685.         WaitPort(port);
  686.         while (msg = (struct AppMessage *)GetMsg(port))
  687.         {
  688.             quit = TRUE;
  689.             ReplyMsg(msg);
  690.         }
  691.         }
  692.         RemoveAppIcon(icon);
  693.     }
  694.     }
  695. }
  696.  
  697. DEFUN("amiga-iconify", Famiga_iconify, Samiga_iconify, 0, 0, "",
  698.   "Iconify emacs window. \n\
  699. The routine returns when emacs is deiconified.")
  700.   ()
  701. {
  702.     WORD minw, minh;
  703.     UWORD x, y, w, h;
  704.  
  705.     /* Close window */
  706.     suspend_menus();
  707.     device_close(emacs_console);
  708.     inputsig &= ~(1L << emacs_win->UserPort->mp_SigBit);
  709.     x = emacs_win->LeftEdge; y = emacs_win->TopEdge;
  710.     w = emacs_win->Width; h = emacs_win->Height;
  711.     CloseWindow(emacs_win);
  712.  
  713.     Iconify(&emacs_icon);
  714.  
  715.     /* Reopen window */
  716.     emacs_screen = LockPubScreen(emacs_screen_name);
  717.     emacs_win = OpenWindowTags(&emacs_window,
  718.                    WA_Left, x, WA_Top, y, WA_Width, w, WA_Height, h,
  719.                    WA_PubScreen, emacs_screen,
  720.                    WA_BackFill, &background_hook,
  721.                    WA_MenuHelp, TRUE,
  722.                    TAG_END);
  723.     UnlockPubScreen(0L, emacs_screen);
  724.     if (emacs_win)
  725.     {
  726.     SetFont(emacs_win->RPort, font);
  727.  
  728.     if (set_min_size(emacs_win, font, &minw, &minh) &&
  729.         set_menu_window(emacs_win) && 
  730.         (emacs_console = (struct IOStdReq *)
  731.          device_open("console.device", CONU_CHARMAP, CONFLAG_NODRAW_ON_NEWSIZE,
  732.              (APTR)emacs_win, sizeof(*emacs_win),
  733.              sizeof(struct IOStdReq))))
  734.     {
  735.         inputsig |= 1L << emacs_win->UserPort->mp_SigBit;
  736.         resume_menus();
  737.         /* Turn off scrolling */
  738.         screen_puts (reset_string, strlen(reset_string));
  739.         clear_window();
  740.         amiga_change_size ();
  741.  
  742.         return Qnil;
  743.     }
  744.     CloseWindow(emacs_win);
  745.     }
  746.     fprintf(stderr, "Iconify: failed to reinitialise (No memory?)\n");
  747.     exit(1);
  748. }
  749.  
  750. struct EClockVal scount[16], ecount[16];
  751. long total[16], counting[16], nb[16], susp[16];
  752.  
  753. void start_count(int n)
  754. {
  755. /*    nb[n]++;
  756.     if (counting[n]) printf("Restarted %d\n", n);
  757.     counting[n] = 1;
  758.     ReadEClock(&scount[n]);*/
  759. }
  760.  
  761. void stop_count(int n)
  762. {
  763.     if (counting[n])
  764.     {
  765.     ReadEClock(&ecount[n]);
  766.     counting[n] = 0;
  767.  
  768.     total[n] += ecount[n].ev_lo - scount[n].ev_lo;
  769.     }
  770. }
  771.  
  772. void suspend_count(int n)
  773. {
  774.     if (counting[n] && susp[n]++ == 0)
  775.     {
  776.     ReadEClock(&ecount[n]);
  777.     total[n] += ecount[n].ev_lo - scount[n].ev_lo;
  778.     }
  779. }
  780.  
  781. void resume_count(int n)
  782. {
  783.     if (counting[n] && --susp[n] == 0) ReadEClock(&scount[n]);
  784. }
  785.  
  786. void screen_puts(char *str, unsigned int len)
  787. {
  788.     int i;
  789.  
  790.     emacs_console->io_Command = CMD_WRITE;
  791.     emacs_console->io_Data    = (APTR)str;
  792.     emacs_console->io_Length  = len;
  793.  
  794. /*    start_count(0);
  795.     for (i = 1; i <= 6; i++) suspend_count(i);*/
  796.     DoIO(emacs_console);
  797. /*    for (i = 1; i <= 6; i++) resume_count(i);
  798.     stop_count(0);*/
  799. }
  800.  
  801. void syms_of_amiga_screen(void)
  802. {
  803.     DEFVAR_LISP ("amiga-mouse-item", &Vamiga_mouse_item,
  804.          "Encoded representation of last mouse click, corresponding to\n\
  805. numerical entries in amiga-mouse-map.");
  806.     Vamiga_mouse_item = Qnil;
  807.     DEFVAR_LISP ("amiga-mouse-pos", &Vamiga_mouse_pos,
  808.          "Current x-y position of mouse by row, column as specified by font.");
  809.     Vamiga_mouse_pos = Qnil;
  810.  
  811.     DEFVAR_BOOL ("amiga-remap-bsdel", &amiga_remap_bsdel,
  812. "*If true, map DEL to Ctrl-D and Backspace to DEL. \n\
  813. This is the most convenient (and default) setting. If nil, don't remap.");
  814.     amiga_remap_bsdel = 1;
  815.  
  816.     DEFVAR_BOOL ("amiga-mouse-initialized", &amiga_mouse_initialized,
  817. "Set to true once lisp has been setup to process mouse commands.\n\
  818. No mouse processing request (C-\ M) will be queued while this is nil.");
  819.     amiga_mouse_initialized = 0;
  820.  
  821.     defsubr (&Samiga_mouse_events);
  822.     defsubr (&Samiga_proc_mouse_event);
  823.     defsubr (&Samiga_get_mouse_event);
  824.     defsubr (&Samiga_set_font);
  825.     defsubr (&Samiga_set_geometry);
  826.     defsubr (&Samiga_set_background_color);
  827.     defsubr (&Samiga_set_foreground_color);
  828.     defsubr (&Samiga_iconify);
  829. }
  830.  
  831. int init_amiga_screen(void)
  832. {
  833.     int minw, minh;
  834.  
  835.     event_num = event_in = event_out = 0;
  836.  
  837.     if (!((IntuitionBase = (struct IntuitionBase *)
  838.        OpenLibrary("intuition.library", 37L)) &&
  839.       (GfxBase = (struct GfxBase *)OpenLibrary("graphics.library", 0L)) &&
  840.       (DiskfontBase = OpenLibrary("diskfont.library", 0L)) &&
  841.       (WorkbenchBase = OpenLibrary("workbench.library", 37))))
  842.     {
  843.     fprintf(stderr, "Need version 2.04 and diskfont.library!\n");
  844.     return FALSE;
  845.     }
  846.     background_hook.h_Entry = fill_background;
  847.     emacs_screen = 0; emacs_screen_name = 0;
  848.     if ((emacs_win = OpenWindowTags(&emacs_window,
  849.                     WA_BackFill, &background_hook,
  850.                     WA_MenuHelp, TRUE,
  851.                     TAG_END)))
  852.     {
  853.     WORD minw, minh;
  854.  
  855.     font = GfxBase->DefaultFont;
  856.     SetFont(emacs_win->RPort, font);
  857.     if (!set_min_size(emacs_win, font, &minw, &minh))
  858.     {
  859.         fprintf(stderr, "Default font is too large for a 640 by 200 window\n");
  860.         CloseWindow(emacs_win);
  861.         return FALSE;
  862.     }
  863.     if (emacs_console =
  864.         (struct IOStdReq *)device_open("console.device", CONU_CHARMAP,
  865.                        CONFLAG_NODRAW_ON_NEWSIZE,
  866.                        (APTR)emacs_win, sizeof(*emacs_win),
  867.                        sizeof(struct IOStdReq)))
  868.     {
  869.         ConsoleDevice = emacs_console->io_Device;
  870.         inputsig |= 1L << emacs_win->UserPort->mp_SigBit;
  871.         make_reset_string();
  872.         screen_puts (reset_string, strlen(reset_string));
  873.         clear_window();
  874.     }
  875.     else
  876.     {
  877.         fprintf(stderr, "Console didn't open!\n");
  878.         return FALSE;
  879.     }
  880.     }
  881.     else
  882.     {
  883.     fprintf(stderr, "Window will not open!\n");
  884.     return FALSE;
  885.     }
  886.     return init_amiga_menu();
  887. }
  888.  
  889. void cleanup_amiga_screen(void)
  890. {
  891.     cleanup_amiga_menu();
  892.     device_close(emacs_console);
  893.     if (emacs_win) CloseWindow(emacs_win);
  894.     if (font_opened) CloseFont(font);
  895.     if (IntuitionBase) CloseLibrary(IntuitionBase);
  896.     if (GfxBase) CloseLibrary(GfxBase);
  897.     if (WorkbenchBase) CloseLibrary(WorkbenchBase);
  898. }
  899.