Merge branch 'develop' into 'develop'

GKS: update demo programs (C/Fortran/Pascal) See merge request Scientific-IT-Systems/gr!999
sciapp · Jan 23, 2023 · 819fac7 · 819fac7
2 parents 324298c + f1164c8
commit 819fac7
Show file tree

Hide file tree

Showing 4 changed files with 44 additions and 11 deletions.
diff --git a/lib/gks/Makefile b/lib/gks/Makefile
@@ -101,7 +101,7 @@ plugins:
 endif
 
 pasdemo: default
-	fpc -Px86_64 demo.p -g -Fl./ -k-rpath -k./
+	fpc demo.p -g -Fl./ -k-rpath -k./
 
 install:
 	@if [ ! -d $(DESTDIR)$(GRDIR) ]; then mkdir -m 755 $(DESTDIR)$(GRDIR); fi

diff --git a/lib/gks/demo.c b/lib/gks/demo.c
@@ -1,3 +1,6 @@
+/*
+  cc demo.c -L/usr/local/gr/lib -lGKS -Wl,-rpath,/usr/local/gr/lib
+ */
 
 #include <stdio.h>
 #include <stdlib.h>
@@ -132,12 +135,9 @@ int main(int argc, char *argv[])
       gks_set_pline_linewidth(1.0 * i);
       for (j = 1; j <= 4; j++)
         {
-          if (j)
-            {
-              gks_set_pline_linetype(j);
-              y[1] = y[0] -= 0.02;
-              gks_polyline(2, x, y);
-            }
+          gks_set_pline_linetype(j);
+          y[1] = y[0] -= 0.02;
+          gks_polyline(2, x, y);
         }
     }
 

diff --git a/lib/gks/demo.f b/lib/gks/demo.f
@@ -1,3 +1,6 @@
+C*
+C*  gfortran demo.f -L/usr/local/gr/lib -lGKS -Wl,-rpath,/usr/local/gr/lib
+C*
         INTEGER ASF(13)
         REAL X(10), Y(10), CPX, CPY, TX(4), TY(4)
         INTEGER I, J, K      
@@ -102,11 +105,22 @@
         DO 100, J = -8, 4
           IF (J .EQ. 0) GOTO 100
           CALL GSLN(J)
-          Y(1) = Y(1) - 0.05
+          Y(1) = Y(1) - 0.02
           Y(2) = Y(1)
           CALL GPL(2, X, Y)
  100    CONTINUE 
 
+        DO 120, i = 1, 3
+          Y(1) = Y(1) - 0.03
+          CALL GSLWSC(1.0 * i)
+          DO 130, J = 1, 4
+            CALL GSLN(J)
+            Y(1) = Y(1) - 0.02
+            Y(2) = Y(1)
+            CALL GPL(2, X, Y)
+ 130      CONTINUE
+ 120    CONTINUE
+
 C* markertypes
         CALL GSMKSC(3.5)
 
@@ -199,12 +213,16 @@
         CALL GSTXAL(1, 1)
         CALL GSTXFP(3, 0)
         CALL GSCHUP(-1., 0.)
+        CALL GSTXCI(200)
         CALL GTX(.05, .15, 'up')
         CALL GSCHUP(0., -1.)
+        CALL GSTXCI(400)
         CALL GTX(.05, .15, 'left')
         CALL GSCHUP(1., 0.)
+        CALL GSTXCI(600)
         CALL GTX(.05, .15, 'down')
         CALL GSCHUP(0., 1.)
+        CALL GSTXCI(800)
         CALL GTX(.05, .15, 'right')
 
         CALL GUWK(1, 0)

diff --git a/lib/gks/demo.p b/lib/gks/demo.p
@@ -1,8 +1,7 @@
 program demo(input, output);
 
 {
-  fpc -Px86_64 demo.p
-  env DYLD_LIBRARY_PATH=/usr/local/gr/lib GKS_WSTYPE=x11 ./demo
+  fpc -Fl/usr/local/gr/lib -k-rpath -k/usr/local/gr/lib demo.p
 }
 
 uses
@@ -122,11 +121,24 @@ begin
     if j <> 0 then
       begin
       gks_set_pline_linetype(j);
-      y[1] := y[1] - 0.05;
+      y[1] := y[1] - 0.02;
       y[2] := y[1];
       gks_polyline(2, x, y);
       end;
 
+  for i := 1 to 3 do
+    begin
+      y[1] := y[1] - 0.03;
+      gks_set_pline_linewidth(1.0 * i);
+      for j := 1 to 4 do
+        begin
+          gks_set_pline_linetype(j);
+          y[1] := y[1] - 0.02;
+          y[2] := y[1];
+          gks_polyline(2, x, y);
+        end;
+    end;
+
   { Markertypes }
   gks_set_pmark_size(3.5);
 
@@ -252,6 +264,9 @@ begin
   else
     begin
     gks_update_ws(2, GKS_K_POSTPONE_FLAG);
+    write('Press RETURN to continue ...');
+    readln();
+
     gks_set_pmark_type(2);
     gks_request_locator(2, 1, inp_status, tnr, x[1], y[1]);
     while inp_status = 1 do