home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / sgraph_a.c < prev    next >
C/C++ Source or Header  |  1999-01-02  |  45KB  |  1,362 lines
  1. /* -*-C-*-
  2.  
  3. $Id: sgraph_a.c,v 1.16 1999/01/02 06:11:34 cph Exp $
  4.  
  5. Copyright (c) 1987-1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. #include "scheme.h"
  23. #include "prims.h"
  24. #include "sgraph.h"
  25. #include "array.h"
  26. #include "x11.h"
  27.  
  28. #define SB_DEVICE_ARG(arg) (arg_nonnegative_integer (arg))
  29.  
  30. #ifndef STARBASE_COLOR_TABLE_START
  31. #define STARBASE_COLOR_TABLE_START 0
  32. #endif
  33.  
  34. #ifndef STARBASE_COLOR_TABLE_SIZE
  35. #define STARBASE_COLOR_TABLE_SIZE 16
  36. #endif
  37.  
  38. float Color_Table [STARBASE_COLOR_TABLE_SIZE] [3];
  39.  
  40. static void
  41. arg_plotting_box (arg_number, plotting_box)
  42.      int arg_number;
  43.      float * plotting_box;
  44. {
  45.   fast SCHEME_OBJECT object;
  46.   fast int i;
  47.   TOUCH_IN_PRIMITIVE ((ARG_REF (arg_number)), object);
  48.   for (i = 0; (i < 4); i += 1)
  49.     {
  50.       if (! (PAIR_P (object)))
  51.     error_wrong_type_arg (arg_number);
  52.       {
  53.     fast SCHEME_OBJECT number = (PAIR_CAR (object));
  54.     if (! (REAL_P (number)))
  55.       error_wrong_type_arg (arg_number);
  56.     if (! (real_number_to_double_p (number)))
  57.       error_bad_range_arg (arg_number);
  58.     (plotting_box [i]) = (real_number_to_double (number));
  59.       }
  60.       TOUCH_IN_PRIMITIVE ((PAIR_CDR (object)), object);
  61.     }
  62.   if (object != EMPTY_LIST)
  63.     error_wrong_type_arg (arg_number);
  64.   return;
  65. }
  66.  
  67. DEFINE_PRIMITIVE ("XPLOT-ARRAY-0", 
  68.           Prim_xplot_array_0, 6, 6, 
  69.           "(XPLOT-ARRAY-0 WINDOW ARRAY BOX OFFSET SCALE FILL)")
  70. {
  71.   SCHEME_OBJECT array;
  72.   float plotting_box [4];
  73.   REAL offset, scale;
  74.   PRIMITIVE_HEADER (6);
  75.   { 
  76.     struct xwindow * xw = (x_window_arg (1));
  77.     CHECK_ARG (2, ARRAY_P);
  78.     array = (ARG_REF (2));
  79.     arg_plotting_box (3, plotting_box);
  80.     offset = (arg_real (4));    /* arg_real is defined in array.h */
  81.     scale = (arg_real (5));
  82.     XPlot_C_Array_With_Offset_Scale
  83.       (xw,
  84.        (ARRAY_CONTENTS (array)),
  85.        (ARRAY_LENGTH (array)),
  86.        plotting_box,
  87.        (arg_index_integer (6, 2)),
  88.        offset,
  89.        scale);
  90.     PRIMITIVE_RETURN (UNSPECIFIC);
  91.   }
  92. }
  93.  
  94. /* The following are taken from x11graphics.c 
  95.  */
  96.  
  97. struct gw_extra
  98. {
  99.   float x_left;
  100.   float x_right;
  101.   float y_bottom;
  102.   float y_top;
  103.   float x_slope;
  104.   float y_slope;
  105.   int x_cursor;
  106.   int y_cursor;
  107. };
  108.  
  109. #define XW_EXTRA(xw) ((struct gw_extra *) ((xw) -> extra))
  110.  
  111. #define XW_X_LEFT(xw) ((XW_EXTRA (xw)) -> x_left)
  112. #define XW_X_RIGHT(xw) ((XW_EXTRA (xw)) -> x_right)
  113. #define XW_Y_BOTTOM(xw) ((XW_EXTRA (xw)) -> y_bottom)
  114. #define XW_Y_TOP(xw) ((XW_EXTRA (xw)) -> y_top)
  115. #define XW_X_SLOPE(xw) ((XW_EXTRA (xw)) -> x_slope)
  116. #define XW_Y_SLOPE(xw) ((XW_EXTRA (xw)) -> y_slope)
  117. #define XW_X_CURSOR(xw) ((XW_EXTRA (xw)) -> x_cursor)
  118. #define XW_Y_CURSOR(xw) ((XW_EXTRA (xw)) -> y_cursor)
  119.  
  120. #define ROUND_FLOAT(flonum)                        \
  121.   ((int) (((flonum) >= 0.0) ? ((flonum) + 0.5) : ((flonum) - 0.5)))
  122.  
  123. static int
  124. xmake_x_coord (xw, virtual_device_x)
  125.      struct xwindow * xw;
  126.      float virtual_device_x;
  127. {
  128.   float device_x = ((XW_X_SLOPE (xw)) * (virtual_device_x - (XW_X_LEFT (xw))));
  129.   return (ROUND_FLOAT (device_x));
  130. }
  131.  
  132. static int
  133. xmake_y_coord (xw, virtual_device_y)
  134.      struct xwindow * xw;
  135.      float virtual_device_y;
  136. {
  137.   float device_y =
  138.     ((XW_Y_SLOPE (xw)) * (virtual_device_y - (XW_Y_BOTTOM (xw))));
  139.   return (((XW_Y_SIZE (xw)) - 1) + (ROUND_FLOAT (device_y)));
  140. }
  141.  
  142. XPlot_C_Array_With_Offset_Scale (xw, Array, Length, Plotting_Box, 
  143.                  fill_with_lines, Offset, Scale)
  144.      struct xwindow * xw;
  145.      float *Plotting_Box;
  146.      long Length;
  147.      int fill_with_lines;    /* plots filled with lines from 0 to y(t) */
  148.      REAL *Array, Scale, Offset;
  149. {
  150.   float box_x_min = Plotting_Box[0];
  151.   float box_y_min = Plotting_Box[1];
  152.   float box_x_max = Plotting_Box[2];
  153.   float box_y_max = Plotting_Box[3];
  154.   float Box_Length = box_x_max - box_x_min;
  155.   float Box_Height = box_y_max - box_y_min;
  156.   long i;
  157.   float        v_d_clipped_offset;
  158.   fast float   v_d_x, v_d_y, v_d_x_increment; /* virtual device coordinates */
  159.   fast int    x, y, clipped_offset; /* X window coordinates */
  160.   fast int    internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
  161.   
  162.   v_d_x = box_x_min;        /* horizontal starting point */
  163.   v_d_x_increment = ((float) Box_Length/Length);
  164.   
  165.   if (fill_with_lines == 0)
  166.     {                /* plot just the points */
  167.       for (i = 0; i < Length; i++)
  168.     {
  169.       x =     (xmake_x_coord (xw, v_d_x));
  170.       v_d_y = ((float) (Offset + (Scale * Array[i])));
  171.       y =     (xmake_y_coord (xw, v_d_y));
  172.       
  173.       XDrawPoint
  174.         ((XW_DISPLAY (xw)),
  175.          (XW_WINDOW (xw)),
  176.          (XW_NORMAL_GC (xw)),
  177.          (internal_border_width + x),
  178.          (internal_border_width + y));
  179.       
  180.       v_d_x = v_d_x + v_d_x_increment;
  181.  
  182.       /* Can not use INTEGERS x+x_increment because x_increment
  183.          may round to 0 and we'll never move the cursor from
  184.          starting point.  Also Array[i+skip] will not work well,
  185.          say 1024 points for 1000 places => last 24 are chopped
  186.          whereas the costly loop we do, downsamples in between
  187.          more gracefully.  i.e. loop over v_d_coordinates - in
  188.          floats. */
  189.     }
  190.     }
  191.   else
  192.     {                /* fill with lines */
  193.       v_d_clipped_offset = min( max(box_y_min, ((float) Offset)), box_y_max);
  194.       clipped_offset     = (xmake_y_coord (xw, v_d_clipped_offset));
  195.       /* The above allows us to 
  196.      fill with vertical bars from the zero-line  to the graphed point y(x)
  197.      and never go outside box. 
  198.      */
  199.       for (i = 0; i < Length; i++)
  200.     {
  201.       x =     (xmake_x_coord (xw, v_d_x));
  202.       v_d_y = ((float) (Offset + (Scale * Array[i])));
  203.       y =     (xmake_y_coord (xw, v_d_y));
  204.       
  205.       XDrawLine
  206.         ((XW_DISPLAY (xw)),
  207.          (XW_WINDOW (xw)),
  208.          (XW_NORMAL_GC (xw)),
  209.          (internal_border_width + x),
  210.          (internal_border_width + clipped_offset),
  211.          (internal_border_width + x),
  212.          (internal_border_width + y));
  213.       
  214.       v_d_x = v_d_x + v_d_x_increment;
  215.     }
  216.     }
  217. }
  218.  
  219. /* plot-array-0 is suffixed -0   in case we need more versions of array plot */
  220.  
  221. DEFINE_PRIMITIVE ("PLOT-ARRAY-0", 
  222.           Prim_plot_array_0, 6, 6, 
  223.           "(PLOT-ARRAY-0 DEVICE ARRAY BOX OFFSET SCALE FILL)")
  224. {
  225.   SCHEME_OBJECT array;
  226.   float plotting_box [4];
  227.   REAL offset, scale;
  228.   int device;
  229.   PRIMITIVE_HEADER (6);
  230.   device = (SB_DEVICE_ARG (1));
  231.   
  232.   CHECK_ARG (2, ARRAY_P);
  233.   array = (ARG_REF (2));
  234.   arg_plotting_box (3, plotting_box);
  235.   offset = (arg_real (4));    /* arg_real is defined in array.h */
  236.   scale = (arg_real (5));
  237.   Plot_C_Array_With_Offset_Scale
  238.     (device,
  239.      (ARRAY_CONTENTS (array)),
  240.      (ARRAY_LENGTH (array)),
  241.      plotting_box,
  242.      (arg_index_integer (6, 2)),
  243.      offset,
  244.      scale);
  245.   PRIMITIVE_RETURN
  246.     (cons ((double_to_flonum ((double) (offset))),
  247.        (cons ((double_to_flonum ((double) (scale))),
  248.           EMPTY_LIST))));
  249. }
  250.  
  251. Plot_C_Array_With_Offset_Scale (device, Array, Length, Plotting_Box, 
  252.                 fill_with_lines, Offset, Scale)
  253.      int device; 
  254.      float *Plotting_Box; long Length;
  255.      int fill_with_lines;    /* plots filled with lines from 0 to y(t) */
  256.      REAL *Array, Scale, Offset;
  257. {
  258.   float box_x_min = Plotting_Box[0];
  259.   float box_y_min=Plotting_Box[1];
  260.   float box_x_max = Plotting_Box[2];
  261.   float box_y_max = Plotting_Box[3];
  262.   float Box_Length = box_x_max - box_x_min;
  263.   float Box_Height = box_y_max - box_y_min;
  264.   fast float x_position, y_position, index_inc, clipped_offset;
  265.   long i;
  266.  
  267.   index_inc = ((float) Box_Length/Length);
  268.   x_position = box_x_min;
  269.   if (fill_with_lines == 0)
  270.     {                /* plot just the points */
  271.       for (i = 0; i < Length; i++)
  272.     {
  273.       y_position = ((float) (Offset + (Scale * Array[i])));
  274.       move2d(device, x_position, y_position);
  275.       draw2d(device, x_position, y_position);
  276.       x_position = x_position + index_inc;
  277.     }
  278.     }
  279.   else
  280.     {                /* fill with lines */
  281.       clipped_offset = min( max(box_y_min, ((float) Offset)), box_y_max);
  282.       /* Fill from zero-line but do not go outside box,
  283.      (Don't bother with starbase clipping)
  284.      */
  285.       for (i = 0; i < Length; i++)
  286.     {
  287.       y_position = ((float) (Offset + (Scale * Array[i])));
  288.       move2d(device, x_position, clipped_offset);
  289.       draw2d(device, x_position, y_position);
  290.       x_position = x_position + index_inc;
  291.     }
  292.     }
  293.   make_picture_current(device);
  294. }
  295.  
  296. DEFINE_PRIMITIVE ("POLYGON2D", Prim_polygon2d, 2,2, 0)
  297. {
  298.   float clist [TWICE_MAX_NUMBER_OF_CORNERS];
  299.   int count;
  300.   fast SCHEME_OBJECT object;
  301.   int device; 
  302.   PRIMITIVE_HEADER (2); 
  303.   
  304.   device = (SB_DEVICE_ARG (1));
  305.   CHECK_ARG (2, PAIR_P);
  306.   count = 0;
  307.     
  308.   TOUCH_IN_PRIMITIVE ((ARG_REF (2)), object);
  309.   while (PAIR_P (object))
  310.   {
  311.     fast SCHEME_OBJECT number = (PAIR_CAR (object));
  312.     if (! (REAL_P (number)))
  313.       error_wrong_type_arg (2);
  314.     if (! (real_number_to_double_p (number)))
  315.       error_bad_range_arg (2);
  316.     (clist [count]) = (real_number_to_double (number));
  317.     count += 1;
  318.     if (count == (TWICE_MAX_NUMBER_OF_CORNERS - 2))
  319.       error_bad_range_arg (2);
  320.     TOUCH_IN_PRIMITIVE ((PAIR_CDR (object)), object);
  321.   }
  322.   if (object != EMPTY_LIST)
  323.     error_wrong_type_arg (2);
  324.  
  325.   (clist [count]) = (clist [0]);
  326.   (clist [count + 1]) = (clist [1]);
  327.   polygon2d (device, clist, ((long) ((count + 2) / 2)), 0);
  328.   make_picture_current (device);
  329.   PRIMITIVE_RETURN (UNSPECIFIC);
  330. }
  331.  
  332.  
  333. DEFINE_PRIMITIVE ("BOX-MOVE", Prim_box_move, 3,3, 0)
  334. {
  335.   int device;
  336.   float From_Box[4];        /* x_min, y_min, x_max, y_max */
  337.   float To_Box[4];
  338.   float x_source, y_source, x_dest, y_dest, x_length, y_length;
  339.   PRIMITIVE_HEADER (3);
  340.   device = (SB_DEVICE_ARG (1));  
  341.   arg_plotting_box (2, From_Box);
  342.   arg_plotting_box (3, To_Box);
  343.   x_source = From_Box[0]; y_source = From_Box[3];
  344.   x_dest   =   To_Box[0]; y_dest   =   To_Box[3];
  345.   /* notice convention of matrix row, column! */
  346.   y_length = From_Box[3] - From_Box[1] + 1;
  347.   x_length = From_Box[2] - From_Box[0] + 1;
  348.   if ((y_length != (To_Box[3]-To_Box[1]+1)) ||
  349.       (x_length != (To_Box[2]-To_Box[0]+1)))
  350.     error_bad_range_arg (3);
  351.   block_move
  352.     (device,
  353.      x_source, y_source,
  354.      ((int) x_length), ((int) y_length),
  355.      x_dest, y_dest);
  356.   PRIMITIVE_RETURN (UNSPECIFIC);
  357. }
  358.  
  359. /* Image Drawing (halftoning)
  360.    HG = Hard Grey levels (i.e. output device greys)
  361.    SG = Soft Grey levels (i.e. simulated grey levels)
  362.    There are 3 methods: PSAM, OD, BN (see below)
  363.    There are also the old 16-color drawing routines. */
  364.  
  365. /* PSAM (Pulse-Surface-Area Modulation) works only for 2 HG grey
  366.    levels.  It maps 1 pxl to a square of 16 pxls.  The distribution of
  367.    on/off pxls in the square gives 16 grey levels.  It's the most
  368.    efficient for B&W monitors, but see below for better quality
  369.    drawing using OD and BN.  Halftoning using OD and BN works for any
  370.    number of grey levels, and there are many methods available (see
  371.    below).
  372.  
  373.    IMAGE-PSAM-ATXY-WMM fixed magnification 1pxl->16pxls Draw line
  374.    (width 4) by line.  Pdata space needed = (4 * ncols * 16).  The
  375.    following 2 primitives simply take in arguments, and allocate
  376.    space, They call C_image_psam_atxy_wmm to do the actual drawing. */
  377.  
  378. DEFINE_PRIMITIVE ("IMAGE-PSAM-ATXY-WMM", Prim_image_psam_atxy_wmm, 6,6, 0)
  379. {
  380.   int device;
  381.   long nrows, ncols;
  382.   REAL * Array;
  383.   PRIMITIVE_HEADER (6);
  384.   device = (SB_DEVICE_ARG (1));
  385.   arg_image (2, (&nrows), (&ncols), (&Array));
  386.   Primitive_GC_If_Needed (BYTES_TO_WORDS (16 * ncols));
  387.   C_image_psam_atxy_wmm
  388.     (device, Array,
  389.      ((unsigned char *) Free),
  390.      nrows,
  391.      ncols,
  392.      ((float) (arg_real (3))),
  393.      ((float) (arg_real (4))),
  394.      (arg_real (5)),
  395.      (arg_real (6)));
  396.   PRIMITIVE_RETURN (UNSPECIFIC);
  397. }
  398.  
  399. DEFINE_PRIMITIVE ("IMAGE-PSAM-ATXY-WOMM", Prim_image_psam_atxy_womm, 6,6, 0)
  400. {
  401.   int device;
  402.   long nrows, ncols;
  403.   REAL * Array;
  404.   PRIMITIVE_HEADER (6);
  405.   device = (SB_DEVICE_ARG (1));
  406.   arg_image (2, (&nrows), (&ncols), (&Array));
  407.   Primitive_GC_If_Needed (BYTES_TO_WORDS (16 * ncols));
  408.   C_image_psam_atxy_womm
  409.     (device, Array,
  410.      ((unsigned char *) Free),
  411.      nrows,
  412.      ncols,
  413.      ((float) (arg_real (3))),
  414.      ((float) (arg_real (4))),
  415.      (arg_real (5)),
  416.      (arg_real (6)));
  417.   PRIMITIVE_RETURN (UNSPECIFIC);
  418. }
  419.  
  420. DEFINE_PRIMITIVE ("IMAGE-HT-OD-ATXY-WMM", Prim_image_ht_od_atxy_wmm, 8,8, 0)
  421. {
  422.   int device;
  423.   long nrows, ncols;
  424.   REAL * Array;
  425.   PRIMITIVE_HEADER (8);
  426.   device = (SB_DEVICE_ARG (1));
  427.   arg_image (2, (&nrows), (&ncols), (&Array));
  428.   Primitive_GC_If_Needed (BYTES_TO_WORDS (ncols));
  429.   C_image_ht_od_atxy_wmm
  430.     (device, Array,
  431.      ((unsigned char *) Free),
  432.      nrows,
  433.      ncols,
  434.      ((float) (arg_real (3))),
  435.      ((float) (arg_real (4))),
  436.      (arg_real (5)),
  437.      (arg_real (6)),
  438.      (arg_integer_in_range (7, 1, 257)),
  439.      (arg_integer_in_range (8, 0, 8)));
  440.   PRIMITIVE_RETURN (UNSPECIFIC);
  441. }
  442.  
  443. DEFINE_PRIMITIVE ("IMAGE-HT-BN-ATXY-WMM", Prim_image_ht_bn_atxy_wmm, 8,8, 0)
  444. {
  445.   int device;
  446.   long nrows, ncols;
  447.   REAL * Array;
  448.   unsigned char * pdata;
  449.   float ** er_rows;
  450.   PRIMITIVE_HEADER (8);
  451.   device = (SB_DEVICE_ARG (1));
  452.   arg_image (2, (&nrows), (&ncols), (&Array));
  453.   Primitive_GC_If_Needed
  454.     (BYTES_TO_WORDS
  455.      (/* pdata */
  456.       ncols +
  457.       /* er_rows header */
  458.       (3 * (sizeof (float *))) +
  459.       /* er_rows data */
  460.       (3 * (ncols + 4) * (sizeof (float)))));
  461.   pdata = ((unsigned char *) Free);
  462.   er_rows = ((float **) (pdata + ncols));
  463.   (er_rows [0]) = ((float *) (er_rows + 3));
  464.   (er_rows [1]) = ((er_rows [0]) + (ncols + 4));
  465.   (er_rows [2]) = ((er_rows [1]) + (ncols + 4));
  466.   C_image_ht_bn_atxy_wmm
  467.     (device, Array,
  468.      pdata,
  469.      nrows,
  470.      ncols,
  471.      ((float) (arg_real (3))),
  472.      ((float) (arg_real (4))),
  473.      (arg_real (5)),
  474.      (arg_real (6)),
  475.      (arg_integer_in_range (7, 1, 257)),
  476.      (arg_nonnegative_integer (8)),
  477.      er_rows);
  478.   PRIMITIVE_RETURN (UNSPECIFIC);
  479. }
  480.  
  481. #define MINTEGER long
  482.  
  483. DEFINE_PRIMITIVE ("IMAGE-HT-IBN-ATXY-WMM", Prim_image_ht_ibn_atxy_wmm, 9,9, 0)
  484. {
  485.   int device;
  486.   long nrows, ncols;
  487.   REAL * Array;
  488.   unsigned char * pdata;
  489.   MINTEGER ** er_rows;
  490.   PRIMITIVE_HEADER (9);
  491.   device = (SB_DEVICE_ARG (1));
  492.   arg_image (2, (&nrows), (&ncols), (&Array));
  493.   Primitive_GC_If_Needed
  494.     (BYTES_TO_WORDS
  495.      (/* pdata */
  496.       ncols +
  497.       /* er_rows header */
  498.       (3 * (sizeof (MINTEGER *))) +
  499.       /* er_rows data */
  500.       (3 * (ncols + 4) * (sizeof (MINTEGER)))));
  501.   pdata = ((unsigned char *) Free);
  502.   er_rows = ((MINTEGER **) (pdata + ncols));
  503.   (er_rows [0]) = ((MINTEGER *) (er_rows + 3));
  504.   (er_rows [1]) = (er_rows [0]) + (ncols + 4);
  505.   (er_rows [2]) = (er_rows [1]) + (ncols + 4);
  506.   C_image_ht_ibn_atxy_wmm
  507.     (device, Array,
  508.      pdata,
  509.      nrows,
  510.      ncols,
  511.      ((float) (arg_real (3))),
  512.      ((float) (arg_real (4))),
  513.      (arg_real (5)),
  514.      (arg_real (6)),
  515.      (arg_integer_in_range (7, 1, 257)),
  516.      (arg_index_integer (8, 3)),
  517.      er_rows,
  518.      (arg_integer_in_range
  519.       (9, 1, ((1 << ((8 * (sizeof (MINTEGER))) - 2)) / 64))));
  520.   PRIMITIVE_RETURN (UNSPECIFIC);
  521. }
  522.  
  523. /* THE FOLLOWING 3 ROUTINES ARE THE OLD 16-color drawing routines
  524.    they also do magnification. */
  525.  
  526. /* color_table entries 0 and 1 are not used */
  527. /* Just like in array-plotting,
  528.    Use Min,Max and Offset,Scale s.t. values map into [2,15] */
  529.  
  530. #define SCREEN_BACKGROUND_COLOR 0
  531. #define MINIMUM_INTENSITY_INDEX 2
  532. #define MAXIMUM_INTENSITY_INDEX 15
  533.  
  534. /* ARGS = (device image x_at y_at magnification)
  535.    magnification can be 1, 2, or 3 */
  536.  
  537. DEFINE_PRIMITIVE ("DRAW-MAGNIFY-IMAGE-AT-XY", Prim_draw_magnify_image_at_xy, 5, 5, 0)
  538. {
  539.   int device;
  540.   long nrows, ncols, Length;
  541.   REAL * Array;
  542.   long Magnification;
  543.   REAL Offset, Scale;
  544.   REAL Array_Min, Array_Max;
  545.   long nmin, nmax;
  546.   PRIMITIVE_HEADER (5);
  547.   device = (SB_DEVICE_ARG (1));
  548.   arg_image (2, (&nrows), (&ncols), (&Array));
  549.   Magnification = (arg_integer_in_range (5, 1, 101));
  550.   Length = (nrows * ncols);
  551.   {
  552.     C_Array_Find_Min_Max (Array, Length, &nmin, &nmax);
  553.     Array_Min = (Array [nmin]);
  554.     Array_Max = (Array [nmax]);
  555.     /* Do not use colors 0 and 1 */
  556.     Find_Offset_Scale_For_Linear_Map
  557.       (Array_Min, Array_Max, 2.0, 15.0, &Offset, &Scale);
  558.     Primitive_GC_If_Needed (BYTES_TO_WORDS (Magnification * ncols));
  559.     Image_Draw_Magnify_N_Times_With_Offset_Scale
  560.       (device, Array,
  561.        ((unsigned char *) Free),
  562.        nrows,
  563.        ncols,
  564.        ((float) (arg_real (3))),
  565.        ((float) (arg_real (4))),
  566.        Offset,
  567.        Scale,
  568.        Magnification);
  569.     PRIMITIVE_RETURN (UNSPECIFIC);
  570.   }
  571. }
  572.  
  573. DEFINE_PRIMITIVE ("DRAW-MAGNIFY-IMAGE-AT-XY-WITH-MIN-MAX",
  574.           Prim_draw_magnify_image_at_xy_with_min_max, 7,7, 0)
  575. {
  576.   int device;
  577.   long nrows, ncols;
  578.   REAL * Array;
  579.   REAL Offset, Scale;
  580.   long Magnification;
  581.   PRIMITIVE_HEADER (7);
  582.   device = (SB_DEVICE_ARG (1));
  583.   arg_image (2, (&nrows), (&ncols), (&Array));
  584.   Magnification = (arg_integer_in_range (5, 1, 101));
  585.   /* Do not use colors 0 and 1 */
  586.   Find_Offset_Scale_For_Linear_Map
  587.     ((arg_real (6)), (arg_real (7)), 2.0, 15.0, &Offset, &Scale);
  588.   Primitive_GC_If_Needed (BYTES_TO_WORDS (Magnification * ncols));
  589.   Image_Draw_Magnify_N_Times_With_Offset_Scale
  590.     (device, Array,
  591.      ((unsigned char *) Free),
  592.      nrows,
  593.      ncols,
  594.      ((float) (arg_real (3))),
  595.      ((float) (arg_real (4))),
  596.      Offset,
  597.      Scale,
  598.      Magnification);
  599.   PRIMITIVE_RETURN (UNSPECIFIC);
  600. }
  601.  
  602. DEFINE_PRIMITIVE ("DRAW-MAGNIFY-IMAGE-AT-XY-ONLY-BETWEEN-MIN-MAX",
  603.           Prim_draw_magnify_image_at_xy_only_between_min_max, 7,7, 0)
  604. {
  605.   int device;
  606.   long nrows, ncols;
  607.   REAL * Array;
  608.   REAL Offset, Scale;
  609.   long Magnification;
  610.   PRIMITIVE_HEADER (7);
  611.   device = (SB_DEVICE_ARG (1));
  612.   arg_image (2, (&nrows), (&ncols), (&Array));
  613.   Magnification = (arg_integer_in_range (5, 1, 101));
  614.   /* Do not use colors 0 and 1 */
  615.   Find_Offset_Scale_For_Linear_Map
  616.     ((arg_real (6)), (arg_real (7)), 2.0, 15.0, &Offset, &Scale);
  617.   Primitive_GC_If_Needed (BYTES_TO_WORDS (Magnification * ncols));
  618.   Image_Draw_Magnify_N_Times_With_Offset_Scale_Only
  619.     (device, Array,
  620.      ((unsigned char *) Free),
  621.      nrows,
  622.      ncols,
  623.      ((float) (arg_real (3))),
  624.      ((float) (arg_real (4))),
  625.      Offset,
  626.      Scale,
  627.      Magnification);
  628.   PRIMITIVE_RETURN (UNSPECIFIC);
  629. }
  630.  
  631. /* Below are the real drawing routines */
  632.  
  633. /* ht = halftoning
  634.    od = ordered-dither (dispersed dot), Ulichney terminology
  635.    bn = blue noise (also called: minimized average error)
  636.    psam = pulse surface area modulation
  637.    Also, there are the old drawing routines for 16 colors, which are basically
  638.    fixed threshold ordered dither. */
  639.  
  640. /* The macro Adjust_Value_Wmm is used by most drawing routines.
  641.    The macro Adjust_Value_Womm is used only by psam-atxy-womm.
  642.    REAL value, newvalue, ngreys_min, ngreys_max, Vmin,Vmax, offset,scale;
  643.    offset, scale must be such as to map (min,max)
  644.    into (ngreys_min,ngreys_max) */
  645.  
  646. #define Adjust_Value_Wmm(value, newvalue, ngreys_min, ngreys_max, Vmin, Vmax, offset, scale) \
  647. {                                    \
  648.   if (value >= Vmax)                            \
  649.     newvalue = ngreys_max;                        \
  650.   else if (value <= Vmin)                        \
  651.     newvalue = ngreys_min;                        \
  652.   else                                    \
  653.     newvalue = offset + (value * scale);                \
  654. }
  655.  
  656. #define Adjust_Value_Womm(value, newvalue, ngreys_min, ngreys_max, Vmin, Vmax, offset, scale) \
  657. {                                    \
  658.   if (value >= Vmax)                            \
  659.     newvalue = ngreys_min;                        \
  660.   else if (value <= Vmin)                        \
  661.     newvalue = ngreys_min;                        \
  662.   else                                    \
  663.     newvalue = offset + (value * scale);                \
  664. }
  665.  
  666. #define Round_REAL(x) ((long) ((x >= 0) ? (x+.5) : (x-.5)))
  667.  
  668. /* Ordered Dither MASKS
  669.    A mask is a SQUARE matrix of threshold values,
  670.    that is effectively replicated periodically all over the image.
  671.  
  672.    ht_od_table[][0] --->  int SG;               number of soft greys
  673.    ht_od_table[][1] --->   int SGarray_nrows;
  674.     nrows=ncols i.e. square matrix of threshold values
  675.    ht_od_table[][2+i] ----> int SGarray[36];
  676.     threshold values with range [0,SG).
  677.  
  678.    ATTENTION: Currently, the LARGEST SGarray is 6X6 MATRIX
  679.   */
  680.  
  681. static int ht_od_table[8][2+36] =
  682. { {2,1, 1},            /* fixed threshold at halfpoint */
  683.     /* this one and following 4 come from Ulichney p.135 */
  684.   {3,2, 1,2,2,1},
  685.   {5,3, 2,3,2, 4,1,4, 2,3,2},
  686.   {9,4, 1,8,2,7, 5,3,6,4, 2,7,1,8, 6,4,5,3},
  687.   {17,5, 2,16,3,13,2, 10,6,11,7,10, 4,14,1,15,4, 12,8,9,5,12, 2,16,3,13,2},
  688.   {33,6, 1,30,8,28,2,29, 17,9,24,16,18,10, 5,25,3,32,6,26, 21,13,19,11,22,14,
  689.      2,29,7,27,1,30, 18,10,23,15,17,9},
  690.     /* this one and following 1 come from Jarvis,Judice,Ninke: CGIP 5, p.23 */
  691.   {4,2, 0,2,3,1},
  692.   {17,4, 0,8,2,10, 12,4,14,6, 3,11,1,9, 15,7,13,5}
  693. };
  694. #define HT_OD_TABLE_MAX_INDEX 7
  695.  
  696. /* ordered dither
  697.    pdata must have length ncols
  698.    HG= Hardware Grey levels (output pixel values 0,HG-1)
  699.    ODmethod is index for ht_od method
  700.    */
  701.  
  702. C_image_ht_od_atxy_wmm (device, Array, pdata, nrows,ncols, x_at,y_at, Min,Max,
  703.             HG,ODmethod)
  704.      int device; 
  705.      REAL Array[], Min,Max;
  706.      unsigned char *pdata;
  707.      int nrows,ncols,HG,ODmethod;
  708.      float x_at,y_at;
  709. { int i,j, SG, *SGarray, SGarray_nrows, dither, pixel, array_index;
  710.   REAL    REAL_pixel, value, offset,scale, HG1_SG;
  711.   /* static int ht_od_table[][]; */
  712.   /* void Find_Offset_Scale_For_Linear_Map(); */
  713.  
  714.   if (ODmethod>HT_OD_TABLE_MAX_INDEX)
  715.     error_external_return ();
  716.   SG = ht_od_table[ODmethod][0];
  717.   SGarray_nrows = ht_od_table[ODmethod][1]; /* nrows=ncols   */
  718.   SGarray = &(ht_od_table[ODmethod][2]);    /* square matrix */
  719.  
  720.   HG1_SG = ((REAL) ((HG-1)*SG));
  721.   Find_Offset_Scale_For_Linear_Map
  722.     (Min, Max, 0.0, HG1_SG,  &offset, &scale); /* HG output greys */
  723.   array_index=0;
  724.   for (i=0; i<nrows; i++)
  725.   { for (j=0; j<ncols; j++)
  726.     { value = Array[array_index++];
  727.       Adjust_Value_Wmm(value, REAL_pixel, 0.0, HG1_SG, Min,Max, offset,scale);
  728.       /* Turn into integer--- integer arithmetic gives speed */
  729.       pixel = ((long) REAL_pixel);
  730.       /* this special case is necessary to avoid ouput_pxl greater than.. */
  731.       if (pixel == HG1_SG) pixel = pixel-1;
  732.       dither = SGarray[ (i%SGarray_nrows)*SGarray_nrows + (j%SGarray_nrows) ];
  733.       /* integer division */ }
  734.       pdata[j] = ((unsigned char) ((pixel + SG - dither) / SG));
  735.     block_write(device, x_at, (y_at-((float) i)), ncols, 1, pdata, 0);
  736.   }
  737. }
  738.  
  739. /* Blue Noise (minimized average error)
  740.    pdata must have length ncols
  741.    HG= Hardware Grey levels (output pixel values 0,HG-1)
  742.    BNmethod is index for ht_bn method
  743.  
  744.    er_rows[][] should be 3 arrays of integers, of length (ncols+2*ER_C),
  745.    which store previous errors, (ALLOCATED STORAGE)
  746.    ER_R is number of error rows, (currently 3)
  747.    ER_C is number of extra columns (to the left and to the right)
  748.    of each er_row, they always contain ZEROS and serve to simplify the
  749.    error summing process, i.e. we don't have to check for i,j bounds
  750.    at edges, (no conditionals in the sum loop).  Also, the code handles
  751.    all cases in a uniform manner (for better explanation get PAS
  752.    halftoning notes). */
  753.  
  754. C_image_ht_bn_atxy_wmm (device, Array, pdata, nrows, ncols, x_at, y_at,
  755.             Min, Max, HG, BNmethod, er_rows)
  756.      int device;
  757.      REAL Array [], Min, Max;
  758.      unsigned char * pdata;
  759.      int nrows, ncols;
  760.      int HG, BNmethod;
  761.      float x_at, y_at;
  762.      float ** er_rows;
  763. {
  764.   if (BNmethod == 0)
  765.     C_image_ht_bn_atxy_wmm_0_
  766.       (device, Array, pdata, nrows, ncols, x_at, y_at, Min, Max, HG, er_rows);
  767.   else if (BNmethod == 1)
  768.     C_image_ht_bn_atxy_wmm_1_
  769.       (device, Array, pdata, nrows, ncols, x_at, y_at, Min, Max, HG, er_rows);
  770.   else if (BNmethod == 2)
  771.     C_image_ht_bn_atxy_wmm_2_
  772.       (device, Array, pdata, nrows, ncols, x_at, y_at, Min, Max, HG, er_rows);
  773.   else
  774.     {
  775.       fprintf (stderr, "\nHT_BN methods 0,1,2 only\n");
  776.       fflush (stderr);
  777.     }
  778. }
  779.  
  780. /* the following 3 routines are identical,
  781.    except for the mask weight numbers in computing ersum,
  782.    the sole reason for this duplication is speed (if any) */
  783.  
  784. /* FLOYD-STEINBERG-75 */
  785. C_image_ht_bn_atxy_wmm_0_ (device, Array, pdata, nrows, ncols, x_at, y_at,
  786.                Min, Max, HG, er_rows)
  787.      int device;
  788.      REAL Array[], Min,Max;
  789.      unsigned char *pdata;
  790.      int nrows,ncols,HG;
  791.      float x_at,y_at,  **er_rows;
  792. {
  793.   int i, j, m, array_index;
  794.   int row_offset, col_offset, INT_pixel;
  795.   REAL REAL_pixel, value, offset,scale, HG1_2;
  796.   float ersum, weight, pixel;
  797.   static int
  798.     ER_R = 3,
  799.     ER_R1 = 2,
  800.     ER_C = 2,
  801.     ER_C1 = 1;
  802.  
  803.   /* initialize error rows */
  804.   for (i = 0; (i < ER_R); i += 1)
  805.     for (j = 0; (j < (ncols + (2 * ER_C))); j += 1)
  806.       (er_rows [i] [j]) = 0.0;
  807.   /* notice this is REAL number */
  808.   HG1_2 = ((REAL) ((HG - 1) * 2));
  809.   /* HG output greys */
  810.   Find_Offset_Scale_For_Linear_Map (Min, Max, 0.0, HG1_2, &offset, &scale);
  811.   array_index = 0;
  812.   for (i = 0; (i < nrows); i += 1)
  813.     {
  814.       for (j = 0; (j < ncols); j += 1)
  815.     {
  816.       ersum =
  817.         (((1.0 / 16.0) * (er_rows [ER_R1 - 1] [ER_C + j - 1])) +
  818.          ((5.0 / 16.0) * (er_rows [ER_R1 - 1] [ER_C + j])) +
  819.          ((3.0 / 16.0) * (er_rows [ER_R1 - 1] [ER_C + j + 1])) +
  820.          ((7.0 / 16.0) * (er_rows [ER_R1] [ER_C + j - 1])));
  821.       /* this encodes the FLOYD-STEINBERG-75 mask for computing
  822.          the average error correction */
  823.       value = (Array [array_index++]);
  824.       Adjust_Value_Wmm
  825.         (value, REAL_pixel, 0.0, HG1_2, Min, Max, offset, scale);
  826.       /* corrected intensity */
  827.       pixel = (((float) REAL_pixel) + ersum);
  828.       /* the (long) does truncation, this corresponds to "IF J>R/2 R 0" */
  829.       INT_pixel = ((long) ((pixel + 1) / 2.0));
  830.       /* output pixel to be painted */
  831.       (pdata [j]) = ((unsigned char) INT_pixel);
  832.       /* error estimate */
  833.       (er_rows [ER_R1] [ER_C + j]) = ((pixel / 2.0) - ((float) INT_pixel));
  834.     }
  835.       /* paint a row */
  836.       block_write
  837.     (device, x_at, (y_at - ((float) i)), ncols, 1, pdata, 0);
  838.       /* rotate rows */
  839.       {
  840.     float * temp = (er_rows [0]);
  841.     (er_rows [0]) = (er_rows [1]);
  842.     (er_rows [1]) = (er_rows [2]);
  843.     (er_rows [2]) = temp;
  844.       }
  845.       /* initialize (clean up) the new error row */
  846.       for (m = ER_C; (m < ncols); m += 1)
  847.     (er_rows [2] [m]) = 0.0;
  848.     }
  849. }
  850.  
  851. /* JARVIS-JUDICE-NINKE-76 mask */
  852. C_image_ht_bn_atxy_wmm_1_ (device, Array, pdata, nrows,ncols, x_at,y_at,
  853.                Min,Max, HG, er_rows)
  854.      int device;
  855.      REAL Array[], Min,Max;
  856.      unsigned char *pdata;
  857.      int nrows,ncols,HG;
  858.      float x_at,y_at,  **er_rows;
  859. { int i,j, m, array_index;
  860.   int row_offset, col_offset, INT_pixel;
  861.   REAL    REAL_pixel, value, offset,scale, HG1_2;
  862.   float ersum, weight, pixel, *temp;
  863.   static int ER_R=3, ER_R1=2, ER_C=2, ER_C1=1;
  864.  
  865.   /* initialize error rows */
  866.   for (i=0;i<ER_R;i++)
  867.     for (j=0;j<ncols+(2*ER_C);j++)
  868.       er_rows[i][j] = 0.0;
  869.   HG1_2 = ((REAL) ((HG-1)*2));    /* notice this is REAL number */
  870.   /* HG output greys */
  871.   Find_Offset_Scale_For_Linear_Map
  872.     (Min, Max, 0.0, HG1_2,  &offset, &scale);
  873.   array_index=0;
  874.   for (i=0;i<nrows;i++) {
  875.     for (j=0;j<ncols;j++) {
  876.       ersum =
  877.     ((1.0/48.0)*er_rows[ER_R1+(-2)][ER_C+(-2)+j] +
  878.      (3.0/48.0)*er_rows[ER_R1+(-2)][ER_C+(-1)+j] +
  879.      (5.0/48.0)*er_rows[ER_R1+(-2)][ER_C+(0)+j] +
  880.      (3.0/48.0)*er_rows[ER_R1+(-2)][ER_C+(1)+j] +
  881.      (1.0/48.0)*er_rows[ER_R1+(-2)][ER_C+(2)+j] +
  882.      (3.0/48.0)*er_rows[ER_R1+(-1)][ER_C+(-2)+j] +
  883.      (5.0/48.0)*er_rows[ER_R1+(-1)][ER_C+(-1)+j] +
  884.      (7.0/48.0)*er_rows[ER_R1+(-1)][ER_C+(0)+j] +
  885.      (5.0/48.0)*er_rows[ER_R1+(-1)][ER_C+(1)+j] +
  886.      (3.0/48.0)*er_rows[ER_R1+(-1)][ER_C+(2)+j] +
  887.      (5.0/48.0)*er_rows[ER_R1+(0)][ER_C+(-2)+j] +
  888.      (7.0/48.0)*er_rows[ER_R1+(0)][ER_C+(-1)+j]);
  889.       /* this encodes the JARVIS-JUDICE-NINKE-76 mask
  890.      for computating the average error correction */
  891.       value = Array[array_index++];
  892.       Adjust_Value_Wmm(value, REAL_pixel, 0.0, HG1_2, Min,Max, offset,scale);
  893.       /* */
  894.       pixel = ((float) REAL_pixel) + ersum; /*     corrected intensity */
  895.       /* the (long) does truncation, this corresponds to "IF J>R/2 R 0" */
  896.       INT_pixel = ((long) ((pixel + 1) / 2.0));
  897.       pdata[j] = ((unsigned char) INT_pixel); /* output pixel to be painted */
  898.       /* error estimate */
  899.       er_rows[ER_R1][ER_C +j] = (pixel/2.0) - ((float) INT_pixel);
  900.     }
  901.     /* paint a row */
  902.     block_write(device, x_at, (y_at-((float) i)), ncols, 1, pdata, 0);
  903.     temp = er_rows[0];        /* rotate rows */
  904.     er_rows[0] = er_rows[1];
  905.     er_rows[1] = er_rows[2];
  906.     er_rows[2] = temp;
  907.     /* initialize (clean up) the new error row */
  908.     for (m=ER_C;m<ncols;m++) er_rows[2][m]=0.0;
  909.   }
  910. }
  911.  
  912. /* STUCKI-81 mask */
  913. C_image_ht_bn_atxy_wmm_2_ (device, Array, pdata, nrows,ncols, x_at,y_at,
  914.                Min,Max, HG, er_rows)
  915.      int device;
  916.      REAL Array[], Min,Max;
  917.      unsigned char *pdata;
  918.      int nrows,ncols,HG;
  919.      float x_at,y_at,  **er_rows;
  920. { int i,j, m, array_index;
  921.   int row_offset, col_offset, INT_pixel;
  922.   REAL    REAL_pixel, value, offset,scale, HG1_2;
  923.   float ersum, weight, pixel, *temp;
  924.   static int ER_R=3, ER_R1=2, ER_C=2, ER_C1=1;
  925.  
  926.   for (i=0;i<ER_R;i++)
  927.     for (j=0;j<ncols+(2*ER_C);j++)
  928.       er_rows[i][j] = 0.0;
  929.   HG1_2 = ((REAL) ((HG-1)*2));
  930.   Find_Offset_Scale_For_Linear_Map(Min, Max, 0.0, HG1_2,  &offset, &scale);
  931.   array_index=0;
  932.   for (i=0;i<nrows;i++) {
  933.     for (j=0;j<ncols;j++) {
  934.       ersum =
  935.     ((1.0/42.0)*er_rows[ER_R1+(-2)][ER_C+(-2)+j] +
  936.      (2.0/42.0)*er_rows[ER_R1+(-2)][ER_C+(-1)+j] +
  937.      (4.0/42.0)*er_rows[ER_R1+(-2)][ER_C+(0)+j] +
  938.      (2.0/42.0)*er_rows[ER_R1+(-2)][ER_C+(1)+j] +
  939.      (1.0/42.0)*er_rows[ER_R1+(-2)][ER_C+(2)+j] +
  940.      (2.0/42.0)*er_rows[ER_R1+(-1)][ER_C+(-2)+j] +
  941.      (4.0/42.0)*er_rows[ER_R1+(-1)][ER_C+(-1)+j] +
  942.      (8.0/42.0)*er_rows[ER_R1+(-1)][ER_C+(0)+j] +
  943.      (4.0/42.0)*er_rows[ER_R1+(-1)][ER_C+(1)+j] +
  944.      (2.0/42.0)*er_rows[ER_R1+(-1)][ER_C+(2)+j] +
  945.      (4.0/42.0)*er_rows[ER_R1+(0)][ER_C+(-2)+j] +
  946.      (8.0/42.0)*er_rows[ER_R1+(0)][ER_C+(-1)+j]);
  947.       /* this encodes the STUCKI-81 mask
  948.      for computating the average error correction */
  949.       value = Array[array_index++];
  950.       Adjust_Value_Wmm(value, REAL_pixel, 0.0, HG1_2, Min,Max, offset,scale);
  951.       /* */
  952.       pixel = ((float) REAL_pixel) + ersum; /* corrected intensity */
  953.       /* the (long) does truncation, this corresponds to "IF J>R/2 R 0" */
  954.       INT_pixel = ((long) ((pixel + 1) / 2.0));
  955.       pdata[j] = ((unsigned char) INT_pixel); /* output pixel to be painted */
  956.       /*  error estimate */
  957.       er_rows[ER_R1][ER_C +j] = (pixel/2.0) - ((float) INT_pixel);
  958.     }
  959.     block_write (device, x_at, (y_at-((float) i)), ncols, 1, pdata, 0);
  960.     temp = er_rows[0];        /* rotate rows */
  961.     er_rows[0] = er_rows[1];
  962.     er_rows[1] = er_rows[2];
  963.     er_rows[2] = temp;
  964.     /* initialize (clean up) the new error row */
  965.     for (m=ER_C;m<ncols;m++)
  966.       er_rows[2][m]=0.0;
  967.   }
  968. }
  969.  
  970. /* INTEGER BLUE NOISE
  971.    pdata must have length ncols
  972.    HG= Hardware Grey levels (output pixel values 0,HG-1)
  973.    BNmethod is index for ht_ibn method
  974.  
  975.    IBN = integer blue noise
  976.    uses integer arithmetic for speed, but also has different effect
  977.    depending on the scaling of the integer intensities and error-corrections.
  978.    A scale of PREC_SCALE=4 gives a very clear picture, with EDGE-INHANCEMENT.
  979.    */
  980.  
  981. /*
  982.   ht_ibn_table[][0] --->  int BN;               sum of error weights
  983.   ht_ibn_table[][1] --->   int BNentries;       number of weight entries
  984.   ht_ibn_table[][2+i+0,1,2] ----> int row_offset,col_offset,weight;
  985.   */
  986.  
  987. static int ht_ibn_table[3][2+(3*12)] =
  988. { {16,4,  -1,-1,1, -1,0,5,  -1,1,3,  0,-1,7},
  989.   {48,12, -2,-2,1, -2,-1,3, -2,0,5, -2,1,3, -2,2,1,
  990.           -1,-2,3, -1,-1,5, -1,0,7, -1,1,5, -1,2,3,
  991.            0,-2,5,  0,-1,7},
  992.   {42,12, -2,-2,1, -2,-1,2, -2,0,4, -2,1,2, -2,2,1,
  993.           -1,-2,2, -1,-1,4, -1,0,8, -1,1,4, -1,2,2,
  994.            0,-2,4,  0,-1,8}
  995. };
  996.  
  997. /*
  998.   er_rows[][] should be 3 arrays of integers, of length (ncols+2*ER_C),
  999.   which store previous errors, (ALLOCATED STORAGE)
  1000.   ER_R is number of error rows, (currently 3)
  1001.   ER_C is number of extra columns (to the left and right) of each er_row,
  1002.   they always contain ZEROS and serve to simplify the error summing process,
  1003.   i.e. we don't have to check for i,j bounds at edges
  1004.   (no conditionals in the sum loop).
  1005.   Also, the code handles all cases in a uniform manner.
  1006.   (for better explanation get pas halftoning notes) */
  1007.  
  1008. C_image_ht_ibn_atxy_wmm (device, Array, pdata, nrows,ncols, x_at,y_at, Min,Max,
  1009.              HG,BNmethod, er_rows, PREC_SCALE)
  1010.      int device; 
  1011.      REAL Array[], Min,Max;
  1012.      unsigned char *pdata;
  1013.      int nrows,ncols,HG,BNmethod;
  1014.      MINTEGER   **er_rows, PREC_SCALE;
  1015.      float x_at,y_at;
  1016. { int i,j, m, BNentries, array_index, row_offset, col_offset;
  1017.   MINTEGER  BN, ersum, weight, PREC_2, PREC, *temp, pixel;
  1018.   /* PREC is a scale factor that varies the precision in ersum
  1019.      -- using integer arithmetic for speed */
  1020.   REAL REAL_pixel, value, offset,scale, HG1_2_PREC;
  1021.   static int ER_R=3, ER_R1=2, ER_C=2, ER_C1=1;
  1022.  
  1023.   for (i=0;i<ER_R;i++)
  1024.     for (j=0;j<ncols+(2*ER_C);j++) er_rows[i][j] = 0;
  1025.   BN = ((MINTEGER) ht_ibn_table[BNmethod][0]);
  1026.   BNentries = ht_ibn_table[BNmethod][1];
  1027.   HG1_2_PREC = ((REAL) PREC_SCALE);
  1028.   /* HG1_2_PREC = ((REAL) ( (1<<( 8*(sizeof(MINTEGER))-1 )) / BN)); */
  1029.   /* max_intensity   maps to  (max_integer/BN), so that */
  1030.   /* neither ersum*BN nor (max_intensity + ersum) overflow */
  1031.   PREC_2 = ((MINTEGER) HG1_2_PREC) / ((MINTEGER) (HG-1));
  1032.   PREC   = PREC_2 / 2;
  1033.   Find_Offset_Scale_For_Linear_Map
  1034.     (Min, Max, 0.0, HG1_2_PREC, &offset, &scale);
  1035.   array_index=0;
  1036.   for (i=0;i<nrows;i++) {
  1037.     for (j=0;j<ncols;j++) {
  1038.       ersum=0;
  1039.       for (m=0;m<(3*BNentries); m=m+3)
  1040.     {
  1041.       row_offset = ht_ibn_table[BNmethod][2+m+0]; /* should be 0,1,2 */
  1042.       col_offset = ht_ibn_table[BNmethod][2+m+1];
  1043.       weight = ((MINTEGER) ht_ibn_table[BNmethod][2+m+2]);
  1044.       ersum += weight * er_rows[ER_R1+row_offset][ER_C +j+ col_offset];
  1045.     }
  1046.       ersum = ersum / BN;
  1047.       value = Array[array_index++];
  1048.       Adjust_Value_Wmm
  1049.     (value, REAL_pixel, 0.0, HG1_2_PREC, Min,Max, offset,scale);
  1050.       pixel = ((MINTEGER) REAL_pixel);
  1051.       pixel = pixel + ersum;    /* corrected intensity */
  1052.       ersum = ((pixel + PREC) / PREC_2);
  1053.       pdata[j] = ((unsigned char) ersum);
  1054.       er_rows[ER_R1][ER_C +j] = pixel - (PREC_2*ersum);
  1055.     }
  1056.     block_write (device, x_at, (y_at-((float) i)), ncols, 1, pdata, 0);
  1057.     temp = er_rows[0];        /* rotate rows */
  1058.     er_rows[0] = er_rows[1];
  1059.     er_rows[1] = er_rows[2];
  1060.     er_rows[2] = temp;
  1061.     for (m=0;m<(ncols+(2*ER_C));m++) er_rows[2][m]=0;
  1062.   }
  1063. }
  1064.  
  1065. /* PSAM drawing (see scheme primitives definition for description)
  1066.    Pdata must be (16 * ncols) bytes in size. */
  1067.  
  1068. C_image_psam_atxy_wmm(device, Array, pdata, nrows, ncols, x_origin, y_origin,
  1069.               Min,Max)
  1070.      int device;
  1071.      REAL Array[], Min,Max;
  1072.      unsigned char *pdata; /* pdata should have length 16*4*ncols */
  1073.      long nrows, ncols;
  1074.      float x_origin, y_origin;
  1075. { register long i,j, i4;
  1076.   register long array_index, pdata_index;
  1077.   long ncols4 = 4 * ncols;
  1078.   long color_index;
  1079.   REAL REAL_pixel, value, offset,scale;
  1080.  
  1081.   Find_Offset_Scale_For_Linear_Map
  1082.     (Min, Max, 0.0, 15.0,  &offset, &scale); /* 16 grey levels */
  1083.   
  1084.   array_index=0;    i4=0;
  1085.   for (i=0; i<nrows; i++) 
  1086.   { pdata_index = 0;
  1087.     for (j=0; j<ncols; j++) 
  1088.     { value = Array[array_index++];
  1089.       Adjust_Value_Wmm(value, REAL_pixel, 0.0, 15.0, Min,Max, offset,scale);
  1090.       color_index = ((long) (REAL_pixel + .5));    /* integer between 0 and 15 */
  1091.       /* */
  1092.       my_write_dither(pdata, pdata_index, ncols4, color_index);
  1093.       /* dependency between this and my_write_dither */
  1094.       pdata_index = pdata_index + 4;
  1095.     }
  1096.     block_write(device, x_origin, y_origin-i4, ncols4, 4, pdata, 0);
  1097.     i4 = i4+4;
  1098.   }
  1099.   /* A(i,j) --> Array[i*ncols + j] */
  1100. }
  1101.  
  1102. /* Same as above, except use Adjust_Value_Womm.
  1103.  */
  1104. C_image_psam_atxy_womm(device, Array, pdata, nrows, ncols, x_origin, y_origin,
  1105.                Min,Max)
  1106.      int device;
  1107.      REAL Array[], Min,Max;
  1108.      unsigned char *pdata; /* pdata should have length 16*4*ncols */
  1109.      long nrows, ncols;
  1110.      float x_origin, y_origin;
  1111. { register long i,j, i4;
  1112.   register long array_index, pdata_index;
  1113.   long ncols4 = 4*ncols;
  1114.   long color_index;
  1115.   REAL REAL_pixel, value, offset,scale;
  1116.   
  1117.   Find_Offset_Scale_For_Linear_Map
  1118.     (Min, Max, 0.0, 15.0,  &offset, &scale); /* 16 grey levels */
  1119.   array_index=0;    i4=0;
  1120.   for (i=0; i<nrows; i++) 
  1121.   { pdata_index = 0;
  1122.     for (j=0; j<ncols; j++) 
  1123.     { value = Array[array_index++];
  1124.       Adjust_Value_Womm(value, REAL_pixel, 0.0, 15.0, Min,Max, offset,scale);
  1125.       /* ONLY DIFFERENCE WITH PREVIOUS ONE */
  1126.       color_index = ((long) (REAL_pixel + .5));    /* integer between 0 and 15 */
  1127.       /* */
  1128.       my_write_dither(pdata, pdata_index, ncols4, color_index);
  1129.       /* dependency between this and my_write_dither */
  1130.       pdata_index = pdata_index + 4;
  1131.     }
  1132.     block_write(device, x_origin, y_origin-i4, ncols4, 4, pdata, 0);
  1133.     i4 = i4+4;
  1134.   }
  1135.   /* A(i,j) --> Array[i*ncols + j] */
  1136. }
  1137.  
  1138. /* psam dither[11] is left out, { 1,1,0,1, 1,1,1,0, 0,1,1,0, 1,0,1,1 } */
  1139.  
  1140. /* The following routine writes a 4x4 dither cell
  1141.    in 4 consecutive rows of pdata. It assumes a lot about
  1142.    pdata and the other args passed to it. READ carefully.
  1143.    Designed TO BE USED BY C_image_psam_atxy_wmm
  1144. */
  1145.  
  1146. my_write_dither(pdata, pdata_row_index, ncols , color_index)
  1147.      unsigned char *pdata;
  1148.      long pdata_row_index, ncols;
  1149.      long color_index; /* should be 0 to 15 */
  1150. { static unsigned char dither_table[16][16] =
  1151.     {{ 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0 },
  1152.        { 0,0,0,0, 0,1,0,0, 0,0,0,0, 0,0,0,0 },
  1153.        { 0,0,0,0, 0,1,0,0, 0,0,1,0, 0,0,0,0 },
  1154.        { 0,0,0,0, 0,1,1,0, 0,0,1,0, 0,0,0,0 },
  1155.        { 0,0,0,0, 0,1,1,0, 0,1,1,0, 0,0,0,0 },
  1156.        { 1,0,0,0, 0,1,1,0, 0,1,1,0, 0,0,0,0 },
  1157.        { 1,0,0,0, 0,1,1,0, 0,1,1,0, 0,0,0,1 },
  1158.        { 1,0,0,1, 0,1,1,0, 0,1,1,0, 0,0,0,1 },
  1159.        { 1,0,0,1, 0,1,1,0, 0,1,1,0, 1,0,0,1 },
  1160.        { 1,1,0,1, 0,1,1,0, 0,1,1,0, 1,0,0,1 },
  1161.        { 1,1,0,1, 1,1,1,0, 0,1,1,0, 1,0,0,1 },
  1162.        { 1,1,0,1, 1,1,1,0, 0,1,1,1, 1,0,1,1 },
  1163.        { 1,1,0,1, 1,1,1,0, 1,1,1,1, 1,0,1,1 },
  1164.        { 1,1,1,1, 1,1,1,0, 1,1,1,1, 1,0,1,1 },
  1165.        { 1,1,1,1, 1,1,1,0, 1,1,1,1, 1,1,1,1 },
  1166.        { 1,1,1,1, 1,1,1,1, 1,1,1,1, 1,1,1,1 }};
  1167.   long i, row_start,m;
  1168.   long dither_index;        /* do not mix up the counters, indexes */
  1169.   dither_index=0;
  1170.   for (i=0;i<4;i++) { row_start = pdata_row_index + (i*ncols);
  1171.               for (m=row_start; m<row_start+4; m++) 
  1172.             pdata[m] = dither_table[color_index][dither_index++]; }
  1173. }
  1174.  
  1175. /* Below are the OLD DRAWING ROUTINES for 16 color monitors.
  1176.    In effect they are fixed threshold, with 16 HG levels.
  1177.    The only difference is they also do magnification by replicating pixels.
  1178.    */
  1179.  
  1180. /* Image_Draw_Magnify_N_Times : N^2 in area
  1181.  */
  1182. Image_Draw_Magnify_N_Times_With_Offset_Scale
  1183.   (device, Array, pdata, nrows, ncols, x_origin,y_origin,Offset,Scale,N)
  1184.      int device;
  1185.      REAL Array[], Offset, Scale;
  1186.      unsigned char *pdata;
  1187.      long nrows, ncols, N;
  1188.      float x_origin, y_origin;
  1189. { fast long i,j,m;
  1190.   fast long array_index;
  1191.   long ncolsN= N * ncols;
  1192.   long nrowsN= N * nrows;
  1193.   fast unsigned char pixel;
  1194.   fast REAL REAL_pixel;
  1195.  
  1196.   array_index = 0;
  1197.   for (i = 0; i < nrowsN;)    /* note that i is NOT incremented here */
  1198.   { for (j = 0; j < ncolsN;)    /* note that j is NOT incremented here */
  1199.     { REAL_pixel = Offset + (Array[array_index++] * Scale);
  1200.       if (REAL_pixel > 15.0)
  1201.     pixel = MAXIMUM_INTENSITY_INDEX;
  1202.       else if (REAL_pixel < 2.0)
  1203.     pixel = MINIMUM_INTENSITY_INDEX;
  1204.       else
  1205.     pixel = ((unsigned char) (Round_REAL(REAL_pixel)));
  1206.       for (m=0; m<N; m++) { pdata[j] = pixel;
  1207.                 j++; }
  1208.     }
  1209.     for (m=0; m<N; m++) {
  1210.       block_write(device, x_origin, y_origin-i, ncolsN, 1, pdata, 0);
  1211.       i++; }
  1212.     /* A(i,j) --> Array[i*ncols + j] */
  1213.   }
  1214. }
  1215.  
  1216. /* Image_Draw_Magnify_N_Times_Only : N^2 in area
  1217.    This procedure throws away (i.e. maps to SCREEN_BACKGROUND_COLOR)
  1218.    all values outside the range given by Offset,Scale.
  1219.    */
  1220. Image_Draw_Magnify_N_Times_With_Offset_Scale_Only
  1221.   (device, Array, pdata, nrows, ncols, x_origin, y_origin, Offset, Scale, N)
  1222.      int device;
  1223.      REAL Array[], Offset, Scale;
  1224.      unsigned char *pdata;
  1225.      long nrows, ncols, N;
  1226.      float x_origin, y_origin;
  1227. { fast long i,j,m;
  1228.   fast long array_index;
  1229.   long ncolsN= N * ncols;
  1230.   long nrowsN= N * nrows;
  1231.   fast unsigned char pixel;
  1232.   fast REAL REAL_pixel;
  1233.  
  1234.   array_index = 0;
  1235.   for (i=0; i<nrowsN;)    /* note that i is NOT incremented here */
  1236.   { for (j=0; j<ncolsN;)    /* note that j is NOT incremented here */
  1237.     { REAL_pixel = Offset + (Array[array_index++] * Scale);
  1238.       if (REAL_pixel > 15.0)
  1239.     pixel = SCREEN_BACKGROUND_COLOR;
  1240.       else if (REAL_pixel < 2.0)
  1241.     pixel = SCREEN_BACKGROUND_COLOR;
  1242.       else
  1243.     pixel = ((unsigned char) (Round_REAL(REAL_pixel)));
  1244.       for (m=0; m<N; m++)
  1245.       {    pdata[j] = pixel;
  1246.     j++; }
  1247.     }
  1248.     for (m=0; m<N; m++) {
  1249.       block_write(device, x_origin, y_origin - i, ncolsN, 1, pdata, 0);
  1250.       i++; }
  1251.     /* A(i,j) --> Array[i*ncols + j] */
  1252.   }
  1253. }
  1254.  
  1255. /* Grey Level Manipulations */
  1256.  
  1257. DEFINE_PRIMITIVE ("NEW-COLOR", Prim_new_color, 5,5, 0)
  1258. {
  1259.   int device;
  1260.   long index;
  1261.   PRIMITIVE_HEADER (5);
  1262.   device = (SB_DEVICE_ARG (1));
  1263.   index =
  1264.     (arg_integer_in_range
  1265.      (2, STARBASE_COLOR_TABLE_START, STARBASE_COLOR_TABLE_SIZE));
  1266.   inquire_color_table
  1267.     (device,
  1268.      STARBASE_COLOR_TABLE_START,
  1269.      STARBASE_COLOR_TABLE_SIZE,
  1270.      Color_Table);
  1271.   (Color_Table [index] [0]) =
  1272.     (arg_real_in_range (3, ((double) 0), ((double) 1)));
  1273.   (Color_Table [index] [1]) =
  1274.     (arg_real_in_range (4, ((double) 0), ((double) 1)));
  1275.   (Color_Table [index] [2]) =
  1276.     (arg_real_in_range (5, ((double) 0), ((double) 1)));
  1277.   define_color_table
  1278.     (device,
  1279.      STARBASE_COLOR_TABLE_START,
  1280.      STARBASE_COLOR_TABLE_SIZE,
  1281.      Color_Table);
  1282.   PRIMITIVE_RETURN (UNSPECIFIC);
  1283. }
  1284.  
  1285. DEFINE_PRIMITIVE ("INQUIRE-COLOR", Prim_inquire_color, 2,2, 0)
  1286. {
  1287.   int device, index;
  1288.   PRIMITIVE_HEADER (2);
  1289.   device = (SB_DEVICE_ARG (1));
  1290.   index =
  1291.     (arg_integer_in_range
  1292.      (2, STARBASE_COLOR_TABLE_START, STARBASE_COLOR_TABLE_SIZE));
  1293.   inquire_color_table
  1294.     (device,
  1295.      STARBASE_COLOR_TABLE_START,
  1296.      STARBASE_COLOR_TABLE_SIZE,
  1297.      Color_Table);
  1298.   PRIMITIVE_RETURN
  1299.     (cons ((double_to_flonum ((double) (Color_Table[index][0]))),
  1300.        (cons ((double_to_flonum ((double) (Color_Table[index][1]))),
  1301.           (cons ((double_to_flonum ((double) (Color_Table[index][2]))),
  1302.              EMPTY_LIST))))));
  1303. }
  1304.  
  1305. DEFINE_PRIMITIVE ("READ-COLORS-FROM-FILE", Prim_read_colors_from_file, 2,2, 0)
  1306. {
  1307.   int device;
  1308.   long i;
  1309.   FILE * fp;
  1310.   PRIMITIVE_HEADER (2);
  1311.   device = (SB_DEVICE_ARG (1));
  1312.   CHECK_ARG (2, STRING_P);
  1313.  
  1314.   fp = (fopen (((char *) (STRING_LOC ((ARG_REF (2)), 0))), "r"));
  1315.   if (fp == ((FILE *) 0))
  1316.     error_bad_range_arg (2);
  1317.   if (feof (fp))
  1318.     {
  1319.       fprintf (stderr, "\nColor Datafile is empty!\n");
  1320.       error_external_return ();
  1321.     }
  1322.   for (i = 0; (i < STARBASE_COLOR_TABLE_SIZE); i += 1)
  1323.     fscanf (fp, "%f %f %f\n",
  1324.         (& (Color_Table [i] [0])),
  1325.         (& (Color_Table [i] [1])),
  1326.         (& (Color_Table [i] [2])));
  1327.   if ((fclose (fp)) != 0)
  1328.     error_external_return ();
  1329.   define_color_table
  1330.     (device,
  1331.      STARBASE_COLOR_TABLE_START,
  1332.      STARBASE_COLOR_TABLE_SIZE,
  1333.      Color_Table);
  1334.   PRIMITIVE_RETURN (UNSPECIFIC);
  1335. }
  1336.  
  1337. DEFINE_PRIMITIVE ("SAVE-COLORS-IN-FILE", Prim_save_colors_in_file, 2,2, 0)
  1338. {
  1339.   int device;
  1340.   long i;
  1341.   FILE * fp;
  1342.   PRIMITIVE_HEADER (2);
  1343.   device = (SB_DEVICE_ARG (1));
  1344.   CHECK_ARG (2, STRING_P);
  1345.   fp = (fopen (((char *) (STRING_LOC ((ARG_REF (2)), 0))), "w"));
  1346.   if (fp == ((FILE *) 0))
  1347.     error_bad_range_arg (2);
  1348.   inquire_color_table
  1349.     (device,
  1350.      STARBASE_COLOR_TABLE_START,
  1351.      STARBASE_COLOR_TABLE_SIZE,
  1352.      Color_Table);
  1353.   for (i = 0; (i < STARBASE_COLOR_TABLE_SIZE); i += 1)
  1354.     fprintf (fp, "%f %f %f\n",
  1355.          (Color_Table [i] [0]),
  1356.          (Color_Table [i] [1]),
  1357.          (Color_Table [i] [2]));
  1358.   if ((fclose (fp)) != 0)
  1359.     error_external_return ();
  1360.   PRIMITIVE_RETURN (UNSPECIFIC);
  1361. }
  1362.