home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 090.lha / EHBarGph.mod < prev    next >
Encoding:
Text File  |  1986-11-21  |  2.6 KB  |  114 lines
  1. MODULE pix;
  2.  
  3. FROM SYSTEM IMPORT BYTE, ASH, ADR;
  4. FROM CommandLine IMPORT CLStrings, GetCL;
  5. FROM M2Conversions IMPORT ConvertToReal;
  6. FROM HiRes IMPORT sp, wp, graphics, bye;
  7. FROM MathLib0 IMPORT real, entier, sin, cos;
  8. FROM Pens IMPORT SetAPen, Draw, Move, RectFill;
  9. FROM Views IMPORT Modes, ModeSet, ViewPortPtr;
  10. FROM Rasters IMPORT RastPortPtr, SetRast;
  11. FROM Colors IMPORT SetRGB4;
  12. FROM InOut IMPORT Done, ReadCard, OpenInputFile, CloseInput;
  13. FROM RealInOut IMPORT ReadReal, WriteReal;
  14. IMPORT Trapper;
  15.  
  16. CONST
  17.    WIDTH = 300;
  18.    HEIGHT = 380;
  19.    DEPTH = 6;
  20.  
  21. VAR
  22.    ok: BOOLEAN;
  23.    argc,c,i,v,w,xmin,ymin,xmax,ymax : CARDINAL;
  24.    argv: ARRAY [0..1] OF CLStrings;
  25.    Vptr : ViewPortPtr;
  26.    Rptr : RastPortPtr;
  27.    mx,mi,k,maxy: REAL;
  28.    n: ARRAY [0..62] OF REAL;
  29.  
  30. PROCEDURE InitColor;
  31. VAR 
  32.    q,i,r,g,b : CARDINAL;
  33.    rc,gc,bc,j,k: REAL;
  34. BEGIN
  35.    SetRGB4(Vptr,0,0,0,0);
  36.    
  37.    FOR i := 1 TO 31 DO
  38.       q := i - 1;
  39.       j := FLOAT(q);
  40.       
  41.       IF q > 9 THEN
  42.          rc := 0.0;
  43.       ELSE
  44.          rc := 10.0 - j;
  45.       END;
  46.       
  47.       IF (q > 12) OR (q < 2) THEN
  48.          gc := 0.0;
  49.       ELSE
  50.          gc := j - 2.0;
  51.       END;
  52.       
  53.       IF (q < 6) OR (q > 20) THEN
  54.          bc := 0.0;
  55.       ELSE
  56.          bc := j - 6.0;
  57.       END;
  58.       
  59.       IF q > 15 THEN
  60.          bc := 15.0 - (j - 15.0);
  61.          rc := bc;
  62.       END;
  63.       
  64.       r := TRUNC(rc); g := TRUNC(gc); b := TRUNC(bc);
  65.       
  66.       SetRGB4(Vptr,i,r,g,b);
  67.    END ;
  68. END InitColor;
  69.  
  70. BEGIN
  71.    IF GetCL(argc,argv) THEN
  72.       IF argc > 0 THEN
  73.          OpenInputFile(argv[0]);
  74.          
  75.          ReadCard(argc);
  76.          IF argc < 62 THEN
  77.             mi := MAX(REAL); mx := MIN(REAL);
  78.             maxy := FLOAT(HEIGHT) - 10.0;
  79.             
  80.             FOR i := 0 TO argc - 1 DO
  81.                ReadReal(n[i]);
  82.                IF n[i] < mi THEN mi := n[i] END;
  83.                IF n[i] > mx THEN mx := n[i] END;
  84.             END;
  85.             
  86.             CloseInput;
  87.             
  88.             k := maxy/(mx - mi);
  89.             w := WIDTH DIV (argc - 2);
  90.             
  91.             graphics(DEPTH,ModeSet{Lace,ExtraHalfBright});
  92.             Vptr := ADR(sp^.VPort);  (* ViewPortPtr *)
  93.             Rptr := ADR(sp^.RPort);  (* RastPortPtr *)
  94.    
  95.             InitColor;
  96.             
  97.             FOR i := 0 TO argc - 1 DO
  98.                v := TRUNC(k * (n[i] - mi));
  99.                xmin := i * w + 5; xmax := xmin + (w - 2);
  100.                ymax := TRUNC(maxy) + 10;
  101.                c := i + 1;
  102.                IF c > 31 THEN c := c + 1 END;
  103.                SetAPen(Rptr,c);
  104.                RectFill(Rptr,xmin,ymax - v,xmax,ymax);
  105.             END;
  106.       
  107.             bye()
  108.          END
  109.       END
  110.    END;   
  111.  
  112.  
  113. END pix.
  114.