home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / DEMO / SRC / LINEDEMO.MOD < prev    next >
Text File  |  1996-11-08  |  16KB  |  492 lines
  1. MODULE LineDemo;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*              Demonstration of GWindows               *)
  6.         (*                                                      *)
  7.         (*  Programmer:         S. Lontis, P. Moylan            *)
  8.         (*  Last edited:        8 November 1996                 *)
  9.         (*  Status:             Working                         *)
  10.         (*                                                      *)
  11.         (*      Note: This is an EGA demonstration.  I've       *)
  12.         (*      done some scaling to make it work with other    *)
  13.         (*      screen resolutions, but I lost patience for     *)
  14.         (*      covering the completely general case.           *)
  15.         (*                                                      *)
  16.         (********************************************************)
  17.  
  18. FROM TaskControl IMPORT
  19.     (* type *)  Lock,
  20.     (* proc *)  CreateTask, CreateLock, Obtain, Release;
  21.  
  22. FROM Semaphores IMPORT
  23.     (* type *)  Semaphore,
  24.     (* proc *)  CreateSemaphore, Wait, Signal;
  25.  
  26. FROM ScreenGeometry IMPORT
  27.     (* type *)  Point;
  28.  
  29. FROM Graphics IMPORT
  30.     (* type *)  ColourType,
  31.     (* proc *)  GetScreenShape;
  32.  
  33. FROM GWindows IMPORT
  34.     (* type *)  Window, BorderType,
  35.     (* proc *)  OpenWindow, Line, PutPixel2, WriteString, ClearWindow,
  36.                 CloseWindow, WindowMemory, SetColour, InitGraphics;
  37.  
  38. FROM MATHLIB IMPORT
  39.     (* proc *)  Sin, Cos, Exp;
  40.  
  41. FROM Keyboard IMPORT
  42.     (* proc *)  InKey;
  43.  
  44. FROM Timer IMPORT
  45.     (* proc *)  Sleep;
  46.  
  47. (************************************************************************)
  48.  
  49. CONST pi = 3.14159;
  50.  
  51. TYPE Vector2 = RECORD
  52.                     x, y: LONGREAL;
  53.                END;
  54.  
  55. VAR
  56.     Xmax, Ymax, CharHeight: CARDINAL;
  57.     maxcolour: ColourType;
  58.  
  59. (************************************************************************)
  60.  
  61. (*
  62. PROCEDURE Sleep (time: CARDINAL);
  63.  
  64.     (* Dummy procedure to prevent Timer.Sleep from being called.        *)
  65.     (* Needed only during debugging.                                    *)
  66.  
  67.     BEGIN
  68.     END Sleep;
  69. *)
  70.  
  71. (************************************************************************)
  72. (*                  "PRESS ANY KEY TO CONTINUE"                         *)
  73. (************************************************************************)
  74.  
  75. PROCEDURE Pause;
  76.  
  77.     VAR dummy: CHAR;  w: Window;
  78.  
  79.     BEGIN
  80.         OpenWindow(w,Xmax DIV 2,30,Xmax DIV 2 + 205,40+CharHeight,0,3,single);
  81.         WriteString (w, "Press any key to continue");
  82.         dummy := InKey();
  83.         CloseWindow (w);
  84.     END Pause;
  85.  
  86. (************************************************************************)
  87. (*                      FLOATING POINT ROUND                            *)
  88. (************************************************************************)
  89.  
  90. PROCEDURE ROUND (x: LONGREAL): INTEGER;
  91.  
  92.     VAR negative: BOOLEAN;  result: INTEGER;
  93.  
  94.     BEGIN
  95.         negative := FALSE;
  96.         IF x < 0.0 THEN
  97.             x := -x;  negative := TRUE;
  98.         END (*IF*);
  99.         x := x + 0.5;
  100.         IF x >= VAL(LONGREAL, MAX(INTEGER)) THEN result := MAX(INTEGER)
  101.         ELSE result := VAL (INTEGER, x);
  102.         END (*IF*);
  103.         IF negative THEN RETURN -result
  104.         ELSE RETURN result;
  105.         END (*IF*);
  106.     END ROUND;
  107.  
  108. (************************************************************************)
  109.  
  110. PROCEDURE Round2 (fpoint: Vector2): Point;
  111.  
  112.     (* Converts floating point (x,y) coordinates to cardinal.   *)
  113.  
  114.     VAR result: Point;
  115.  
  116.     BEGIN
  117.         result.x := ROUND (fpoint.x);
  118.         result.y := ROUND (fpoint.y);
  119.         RETURN result;
  120.     END Round2;
  121.  
  122. (************************************************************************)
  123. (*                         CRO SIMULATION                               *)
  124. (************************************************************************)
  125.  
  126. VAR
  127.     (* Data shared between the DataGenerator and CROdemo tasks. *)
  128.  
  129.     ToPlot: RECORD
  130.                 ready: Semaphore;
  131.                 access: Lock;
  132.                 datum: LONGREAL;
  133.             END (*RECORD*);
  134.  
  135. (************************************************************************)
  136.  
  137. PROCEDURE DataGenerator;
  138.  
  139.     (* Runs as a separate task, generating data for task CROdemo to plot.*)
  140.  
  141.     CONST tincr = 0.002;  M0 = 0.8;
  142.           alpha = 5.0;  omega = 10.0;
  143.  
  144.     VAR t, value, M: LONGREAL;
  145.  
  146.     BEGIN
  147.         t := 0.0;  M := M0;
  148.         LOOP
  149.             value := M*(1.0 - 2.0*Exp(-alpha*t)*Cos(omega*t));
  150.             WITH ToPlot DO
  151.                 Obtain (access);
  152.                 datum := value;
  153.                 Release (access);
  154.                 Signal (ready);
  155.             END (*WITH*);
  156.             t := t + tincr;
  157.             IF t > 1.0 THEN
  158.                 t := 0.0;  M := -M;
  159.             END (*IF*);
  160.             Sleep (120);
  161.         END (*LOOP*);
  162.     END DataGenerator;
  163.  
  164. (************************************************************************)
  165.  
  166. TYPE index = [10..190];
  167.  
  168. VAR data: ARRAY index OF CARDINAL;
  169.  
  170. PROCEDURE CROdemo;
  171.  
  172.     (* Runs as a separate task, plotting a moving waveform *)
  173.  
  174.     (* Colours on the default palette are:                              *)
  175.     (*   0 black         1 blue          2 green         3 cyan         *)
  176.     (*   4 red           5 magenta       6 brown         7 white        *)
  177.     (*   8 grey          9 lt blue      10 lt green     11 lt cyan      *)
  178.     (*  12 lt red       13 lt magenta   14 yellow       15 very white   *)
  179.  
  180.     CONST colour = 10;
  181.  
  182.     VAR CRO: Window;  t: index;
  183.         newval: LONGREAL;  scaledval: INTEGER;
  184.         background: CARDINAL;
  185.  
  186.     PROCEDURE Blob (x, y: INTEGER);
  187.         BEGIN
  188.             PutPixel2 (CRO, x, y);
  189.             PutPixel2 (CRO, x+1, y);
  190.             PutPixel2 (CRO, x, y+1);
  191.             PutPixel2 (CRO, x+1, y+1);
  192.             PutPixel2 (CRO, x, y-1);
  193.             PutPixel2 (CRO, x+1, y-1);
  194.         END Blob;
  195.  
  196.     (********************************************************************)
  197.  
  198.     BEGIN
  199.         IF maxcolour > 8 THEN background := 8
  200.         ELSE background := 0
  201.         END (*IF*);
  202.         OpenWindow (CRO,Xmax-200,Ymax-CharHeight-140,Xmax,Ymax-CharHeight-10,
  203.                                                 0,background,single);
  204.         WindowMemory (CRO, FALSE);
  205.         WITH ToPlot DO
  206.             CreateSemaphore (ready, 0);
  207.             CreateLock (access);
  208.         END (*WITH*);
  209.         FOR t := MIN(index) TO MAX(index) DO
  210.             PutPixel2 (CRO, t, 30);
  211.             data[t] := 30;
  212.         END (*FOR*);
  213.         CreateTask (DataGenerator, 4, "Data for CRO");
  214.         t := MIN(index);
  215.         LOOP
  216.             WITH ToPlot DO
  217.                 Wait (ready);
  218.                 Obtain (access);
  219.                 newval := datum;
  220.                 Release (access);
  221.             END (*WITH*);
  222.             scaledval := 60 + VAL(INTEGER,30.0*newval);
  223.  
  224. (* Original version: non-shifting:
  225.  
  226.             SetColour (CRO, background);
  227.             PutPixel2 (CRO, t, data[t]);
  228.             SetColour (CRO, colour);
  229.             PutPixel2 (CRO, t, scaledval);
  230.             data[t] := scaledval;
  231.             IF t = MAX(index) THEN t := MIN(index) ELSE INC(t) END(*IF*);
  232. *)
  233.             (* New version: shift data in window *)
  234.  
  235.             FOR t := MIN(index) TO MAX(index)-1 DO
  236.                 SetColour (CRO, background);
  237.                 PutPixel2 (CRO, t, data[t]);
  238.                 data[t] := data[t+1];
  239.                 SetColour (CRO, colour);
  240.                 PutPixel2 (CRO, t, data[t]);
  241.             END (*FOR*);
  242.             t := MAX(index);
  243.             SetColour (CRO, background);
  244.             Blob (t, data[t]);
  245.             data[t] := scaledval;
  246.             SetColour (CRO, 15);
  247.             Blob (t, scaledval);
  248.         END (*LOOP*);
  249.         CloseWindow (CRO);
  250.     END CROdemo;
  251.  
  252. (************************************************************************)
  253. (*                      MISCELLANEOUS DEMO PLOTS                        *)
  254. (************************************************************************)
  255.  
  256. PROCEDURE Spiral (w: Window; centre: Point;
  257.                                 radius, ang: LONGREAL; n: CARDINAL);
  258.  
  259.     CONST thinc = 0.05*pi;
  260.  
  261.     VAR theta, r: LONGREAL;
  262.         i, ptnumber: CARDINAL;
  263.         pt, pt1: Point;
  264.  
  265.     BEGIN
  266.         theta := ang;  pt := centre;
  267.         ptnumber := 40*n;
  268.         FOR i := 1 TO ptnumber DO
  269.             theta := theta+thinc;  r:= radius*VAL(LONGREAL,i)/VAL(LONGREAL,ptnumber);
  270.             pt1.x := ROUND(3.0*r*Cos(theta)) + centre.x;
  271.             pt1.y := ROUND(2.0*r*Sin(theta)) + centre.y;
  272.             Line (w, pt, pt1);
  273.             pt := pt1;
  274.         END (* FOR *)
  275.     END Spiral;
  276.  
  277. (************************************************************************)
  278.  
  279. PROCEDURE Rose(w: Window; xoffset, yoffset: INTEGER;
  280.                                 scale, m, n: CARDINAL);
  281.  
  282.     VAR inner, outer: ARRAY [1..100] OF Point;
  283.         i, j: CARDINAL;
  284.         r, theta, thinc: LONGREAL;
  285.  
  286.     BEGIN
  287.         thinc := 2.0*pi/VAL(LONGREAL,n);
  288.         FOR i := 1 TO n DO
  289.             inner[i].x := xoffset;
  290.             inner[i].y := yoffset;
  291.         END (* FOR *);
  292.         FOR j := 1 TO m DO
  293.             theta := -VAL(LONGREAL,j)*pi/VAL(LONGREAL,n);
  294.             r := VAL(LONGREAL,j*scale)/VAL(LONGREAL,m);
  295.             FOR i := 1 TO n DO
  296.                 theta := theta+thinc;
  297.                 outer[i].x := xoffset + ROUND (3.0*r*Cos(theta));
  298.                 outer[i].y := yoffset + ROUND (2.0*r*Sin(theta));
  299.             END (* FOR *);
  300.             FOR i:= 1 TO n DO
  301.                 Line (w, outer[i], outer[(i MOD n) + 1]);
  302.                 Line (w, outer[(i MOD n) + 1], inner[i]);
  303.                 Line (w, inner[i], outer[i]);
  304.                 inner[i] := outer[i];
  305.             END (* FOR *);
  306.         END (* FOR *)
  307.     END Rose;
  308.  
  309. (************************************************************************)
  310.  
  311. PROCEDURE SquareinSquare (w: Window; xoffset, yoffset, size: LONGREAL);
  312.  
  313.     CONST mu = 0.1;
  314.  
  315.     VAR pt, ptd: ARRAY[1..4] OF Vector2;
  316.         i, j, nextj: INTEGER;
  317.         um: LONGREAL;
  318.         pti: Point;
  319.  
  320.     BEGIN
  321.         pt[1].x:=  xoffset+size*2.5; pt[1].y:=  yoffset+size*2.0;
  322.         pt[2].x:=  xoffset+size*2.5; pt[2].y:=  yoffset;
  323.         pt[3].x:=  xoffset; pt[3].y:=   yoffset;
  324.         pt[4].x:=  xoffset; pt[4].y:=   yoffset+size*2.0;
  325.         um:= 1.0-mu;
  326.         FOR i:= 1 TO 21 DO
  327.             pti := Round2 (pt[4]);
  328.             FOR j:= 1 TO 4 DO
  329.                 Line(w, Round2 (pt[j]), pti);
  330.                 pti := Round2 (pt[j]);
  331.                 nextj:= (j MOD 4) + 1;
  332.                 ptd[j].x:= um*pt[j].x + mu*pt[nextj].x;
  333.                 ptd[j].y:= um*pt[j].y + mu*pt[nextj].y
  334.             END (* FOR *);
  335.             FOR j:= 1 TO 4 DO  pt[j]:= ptd[j]   END (* FOR *)
  336.         END (* FOR *)
  337.     END SquareinSquare;
  338.  
  339. (************************************************************************)
  340.  
  341. PROCEDURE SpiroGraph(w: Window; xcenter, ycenter: INTEGER;
  342.                                         a, b, d: CARDINAL);
  343.  
  344.     CONST Scale= 6.0;  Xscale = 1.6*Scale;  steps = 50;
  345.  
  346.     VAR pt, oldpt: Point;
  347.         i: CARDINAL;
  348.         phi, theta, thinc: LONGREAL;
  349.  
  350.     (********************************************************************)
  351.  
  352.     PROCEDURE hcf (i, j: CARDINAL) : CARDINAL;
  353.  
  354.         VAR remain: CARDINAL;
  355.  
  356.         BEGIN
  357.             REPEAT
  358.                 remain := i MOD j;
  359.                 i := j;  j := remain;
  360.             UNTIL remain = 0;
  361.             RETURN i;
  362.         END hcf;
  363.  
  364.     (********************************************************************)
  365.  
  366.     BEGIN
  367.         theta := 0.0;  thinc:= 2.0*pi/VAL(LONGREAL,steps);
  368.         oldpt.x := xcenter + ROUND(Xscale*VAL(LONGREAL,a - b + d));
  369.         oldpt.y := ycenter;
  370.         FOR i := 1 TO steps*(b DIV hcf(a,b)) DO
  371.             theta:= theta + thinc;  phi:= theta*VAL(LONGREAL,a-b)/VAL(LONGREAL,b);
  372.             pt.x := xcenter+ROUND(Xscale*(VAL(LONGREAL,a-b)*Cos(theta)
  373.                                 + VAL(LONGREAL,d)*Cos(phi)));
  374.             pt.y := ycenter+ROUND(Scale*(VAL(LONGREAL,a-b)*Sin(theta)
  375.                                 - VAL(LONGREAL,d)*Sin(phi)));
  376.             Line (w, pt, oldpt);
  377.             oldpt := pt;
  378.         END (* FOR *)
  379.     END SpiroGraph;
  380.  
  381. (************************************************************************)
  382.  
  383. PROCEDURE StringPoly (w: Window; xcentre, ycentre, radius, n: CARDINAL);
  384.  
  385.     (* Draws a polygon of n vertices, with every vertex connected to    *)
  386.     (* every other.                                                     *)
  387.  
  388.     VAR pt: ARRAY[1..100] OF Point;
  389.         i, j: CARDINAL;
  390.         theta, thinc: LONGREAL;
  391.  
  392.     BEGIN
  393.         theta:=0.0; thinc:= 2.0*pi/VAL(LONGREAL,n);
  394.         FOR i := 1 TO n DO
  395.             pt[i].x := VAL(INTEGER,xcentre) + ROUND(VAL(LONGREAL,3*radius-20)*Cos(theta));
  396.             pt[i].y := VAL(INTEGER,ycentre) + ROUND(VAL(LONGREAL,2*radius)*Sin(theta));
  397.             theta:= theta + thinc;
  398.         END (* FOR *);
  399.         FOR i:= 1 TO n-1 DO
  400.             FOR j:= i+1 TO n DO
  401.                 Line (w, pt[i], pt[j]);
  402.             END (* FOR *)
  403.         END (* FOR *);
  404.     END StringPoly;
  405.  
  406. (************************************************************************)
  407. (*                      THE MAIN DEMONSTRATION TASK                     *)
  408. (************************************************************************)
  409.  
  410. PROCEDURE RunTheDemo;
  411.  
  412.     VAR w1, w2, w3, w4, w5: Window;
  413.         i: [5..15];  b, c: [1..4];
  414.         point: Point;
  415.         xc, yc: CARDINAL;
  416.         radius: LONGREAL;
  417.  
  418.     BEGIN
  419.         OpenWindow(w5,15,Ymax-CharHeight-8,275,Ymax,1,3,single);
  420.         WriteString (w5,' Demonstration of line graphics');
  421.  
  422.         IF Xmax > 400 THEN
  423.             xc := Xmax-201;
  424.             CreateTask (CROdemo, 3, "CRO demo");
  425.         ELSE
  426.             xc := 3*Xmax DIV 4;
  427.         END (*IF*);
  428.         yc := 7*Ymax DIV 8;
  429.         OpenWindow(w1,0,0,xc,yc,7,6,single);
  430.  
  431.         WriteString (w1,'Spiral');
  432.         xc := xc DIV 2;  yc := yc DIV 2;
  433.         IF xc DIV 3 < yc DIV 2 THEN
  434.             radius := 0.3*VAL(LONGREAL,xc);
  435.         ELSE
  436.             radius := 0.5*VAL(LONGREAL,yc);
  437.         END (*IF*);
  438.         point.x := xc;  point.y := yc;
  439.         Spiral (w1, point, radius, 0.0, 8);
  440.         Sleep(2000);
  441.  
  442.         FOR i:= 5 TO 15 BY 2 DO
  443.             ClearWindow (w1);
  444.             WriteString (w1, 'Rose Pattern');
  445.             Rose (w1,xc,yc,VAL(CARDINAL,radius),i,i);
  446.             Sleep (1000);
  447.         END (* FOR *);
  448.  
  449.         xc := xc DIV 2;
  450.         yc := yc DIV 2;
  451.         radius := 0.5*radius;
  452.         OpenWindow(w4,Xmax DIV 3,Ymax DIV 3,
  453.                 Xmax DIV 3+2*xc,Ymax DIV 3+2*yc,0,3,double);
  454.         StringPoly (w4,xc,yc,VAL(CARDINAL,radius),17);
  455.         Sleep(1000);
  456.  
  457.         OpenWindow(w2,320,40,620,180,4,7,single);
  458.  
  459.         WriteString (w2,' Rotating Squares');
  460.         SquareinSquare (w2, 125.0, 20.0, 50.0);
  461.         SquareinSquare (w2, 15.0, 30.0, 40.0);
  462.         Sleep(1000);
  463.  
  464.         OpenWindow(w3,20,20,240,180,14,6,double);
  465.         FOR b := 2 TO 3 DO
  466.             ClearWindow(w3);
  467.             WriteString (w3,'SpiroGraphs');
  468.             FOR c := 2 TO 4 DO
  469.                 SpiroGraph(w3,110,70,9,b,c);
  470.                 Sleep(1000);
  471.             END (* FOR *)
  472.         END (* FOR *);
  473.  
  474.         Pause;
  475.  
  476.         Sleep(1000);  CloseWindow (w1);
  477.         Sleep(1000);  CloseWindow (w2);
  478.         Sleep(1000);  CloseWindow (w3);
  479.         Sleep(1000);  CloseWindow (w4);
  480.         Sleep(1000);  CloseWindow (w5);
  481.  
  482.     END RunTheDemo;
  483.  
  484. (************************************************************************)
  485.  
  486. BEGIN
  487.     InitGraphics(18);
  488.     GetScreenShape (Xmax, Ymax, maxcolour, CharHeight);
  489.     RunTheDemo;
  490. END LineDemo.
  491.  
  492.