home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d3xx / d386 / xlispstat.lha / XLispStat / src3.lzh / Mac / macxsgraph.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-07-30  |  1.9 KB  |  79 lines
  1. /* macxsgraph - Macintosh lisp low level graphics functions            */
  2. /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney                  */
  3. /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz    */
  4. /* You may give out copies of this software; for conditions see the    */
  5. /* file COPYING included with this distribution.                       */
  6.  
  7. #ifdef MPWC
  8. # include <Windows.h>
  9. # include <Picker.h>
  10. #else
  11. # include <WindowMgr.h>
  12. # include <Color.h>
  13. #endif MPWC
  14. # include "xlisp.h"
  15.  
  16. # define nil 0L
  17. # define MULTIPLIER 62535
  18.  
  19. /* external variables */
  20.  
  21. /* external functions */
  22. extern double makedouble();
  23. extern LVAL mklist();
  24.  
  25. static RGBColor ListToRGB(x)
  26.     LVAL x;
  27. {
  28.   RGBColor color;
  29.  
  30.   if (! consp(x) || llength(x) != 3) xlerror("not a color list", x);
  31.   color.red   = MULTIPLIER * makedouble(car(x)); x = cdr(x);
  32.   color.green = MULTIPLIER * makedouble(car(x)); x = cdr(x);
  33.   color.blue  = MULTIPLIER * makedouble(car(x));
  34.   return(color);
  35. }
  36.   
  37. static LVAL RGBToList(color)
  38.     RGBColor color;
  39. {
  40.   LVAL result, rp;
  41.   
  42.   xlsave1(result);
  43.   result = rp = mklist(3, NIL);
  44.   rplaca(rp, cvflonum((FLOTYPE) (((double) color.red)   / MULTIPLIER)));
  45.   rp = cdr(rp);
  46.   rplaca(rp, cvflonum((FLOTYPE) (((double) color.green) / MULTIPLIER)));
  47.   rp = cdr(rp);
  48.   rplaca(rp, cvflonum((FLOTYPE) (((double) color.blue)  / MULTIPLIER)));
  49.   xlpop();
  50.   return(result);
  51. }
  52.  
  53. LVAL xspick_color()
  54. {
  55.   Point where;
  56.   char *prompt;
  57.   RGBColor in_color, out_color;
  58.   int ok;
  59.   LVAL arg, sk_initial = xlenter(":INITIAL");
  60.   
  61.   if (! StScreenHasColor()) return(NIL);
  62.   
  63.   in_color.red = 0; 
  64.   in_color.green = 0;
  65.    in_color.blue = 0;
  66.   if (moreargs()) {
  67.     prompt = (char *) getstring(xlgastring());
  68.     if (xlgetkeyarg(sk_initial, &arg)) in_color = ListToRGB(arg);
  69.   }
  70.   else prompt = "Pick a color";
  71.   
  72.   where.h = 0; where.v = 0;
  73.   CtoPstr(prompt);
  74.   ok = GetColor(where, prompt, &in_color, &out_color);
  75.   PtoCstr(prompt);
  76.   
  77.   return((ok) ? RGBToList(out_color) : NIL);
  78. }
  79.