diff -r -N -u gks/Config gli-gks/Config --- gks/Config 1999-11-25 09:08:00.000000000 -0500 +++ gli-gks/Config 1969-12-31 19:00:00.000000000 -0500 @@ -1,30 +0,0 @@ -#!/bin/sh -# -if [ -f /bin/machine ]; then - machine=`machine` -elif [ -f /bin/arch ]; then - machine=`arch` -elif [ -f /bin/uname -o -f /usr/bin/uname ]; then - machine=`uname` -elif [ "x$OSTYPE" = "xcygwin32" ]; then - machine="cygwin32" -else - echo "usage"; exit -fi -# -machine=`echo $machine | sed -e 'y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/' | sed -e 's/-//g'` -# -target="$machine" -if [ "$target" = "alpha" ]; then - if [ `uname` = "Linux" ]; then - target="pclinux" - fi -fi -# -if [ "x`echo $target | grep sun`" != "x" ]; then - if [ `uname -r | cut -d "." -f 1 -` -gt 4 ]; then - target="sunos" - fi -fi -# -echo "$target" diff -r -N -u gks/dos/DEMO.FOR gli-gks/dos/DEMO.FOR --- gks/dos/DEMO.FOR 1998-11-30 19:00:00.000000000 -0500 +++ gli-gks/dos/DEMO.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,206 +0,0 @@ - PROGRAM DEMO - - INTEGER ASF(13) - REAL X(10), Y(10) - INTEGER I, J, K - INTEGER COLIA(8, 10) - INTEGER ISTAT, TNR - - DATA ASF /13*1/ - - K = 0 - DO 200 J=1, 10 - DO 300 I=1, 8 - COLIA(I, J) = K - K = K+1 - 300 CONTINUE - 200 CONTINUE - - CALL GOPKS(6, -1) - CALL GSASF(ASF) - CALL GOPWK(1, 88, 5) - CALL GACWK(1) - CALL GCRSG(1) - CALL GSTXFP(12, 2) -C* Text - CALL GSCHH(0.02) - CALL GSTXFP(-1, 2) - CALL GTX(.6, .7, 'Font-1') - CALL GSTXFP(-2, 2) - CALL GTX(.6, .65, 'Font-2') - CALL GSTXFP(-3, 2) - CALL GTX(.6, .6, 'Font-3') - CALL GSTXFP(-4, 2) - CALL GTX(.6, .55, 'Font-4') - CALL GSTXFP(-5, 2) - CALL GTX(.6, .5, 'Font-5') - CALL GSTXFP(-6, 2) - CALL GTX(.6, .45, 'Font-6') - CALL GSTXFP(-7, 2) - CALL GTX(.6, .4, 'Font-7') - CALL GSTXFP(-8, 2) - CALL GTX(.6, .35, 'Font-8') - CALL GSTXFP(-9, 2) - CALL GTX(.6, .3, 'Font-9') - CALL GSTXFP(-10, 2) - CALL GTX(.6, .25, 'Font-10') - CALL GSTXFP(-11, 2) - CALL GTX(.6, .2, 'Font-11') - CALL GSTXFP(-12, 2) - CALL GTX(.8, .7, 'Font-12') - CALL GSTXFP(-13, 2) - CALL GTX(.8, .65, 'Font-13') - CALL GSTXFP(-14, 2) - CALL GTX(.8, .6, 'Font-14') - CALL GSTXFP(-15, 2) - CALL GTX(.8, .55, 'Font-15') - CALL GSTXFP(-16, 2) - CALL GTX(.8, .5, 'Font-16') - CALL GSTXFP(-17, 2) - CALL GTX(.8, .45, 'Font-17') - CALL GSTXFP(-18, 2) - CALL GTX(.8, .4, 'Font-18') - CALL GSTXFP(-19, 2) - CALL GTX(.8, .35, 'Font-19') - CALL GSTXFP(-20, 2) - CALL GTX(.8, .3, 'Font-20') - CALL GSTXFP(-21, 2) - CALL GTX(.8, .25, 'Font-21') - CALL GSTXFP(-22, 2) - CALL GTX(.8, .2, 'Font-22') - CALL GSTXFP(-23, 2) - CALL GTX(.6, .15, 'Font-23') - CALL GSTXFP(-24, 2) - CALL GTX(.8, .15, 'Font-24') - -C* Colors - CALL GSTXFP(-5, 2) - CALL GSTXCI(0) - CALL GTX(.45, .35, 'White') - CALL GSTXCI(1) - CALL GTX(.45, .32, 'Black') - CALL GSTXCI(2) - CALL GTX(.45, .29, 'Red') - CALL GSTXCI(3) - CALL GTX(.45, .26, 'Green') - CALL GSTXCI(4) - CALL GTX(.45, .23, 'Blue') - CALL GSTXCI(5) - CALL GTX(.45, .20, 'Cyan') - CALL GSTXCI(6) - CALL GTX(.45, .17, 'Yellow') - CALL GSTXCI(7) - CALL GTX(.45, .14, 'Magenta') - -C* Linetypes - X(1) = 0.18 - X(2) = 0.28 - Y(1) = 0.95 - Y(2) = Y(1) - - DO 100, J = -8, 4 - IF (J .EQ. 0) GOTO 100 - CALL GSLN(J) - Y(1) = Y(1) - 0.05 - Y(2) = Y(1) - CALL GPL(2, X, Y) - 100 CONTINUE - -C* Markertypes - CALL GSMKSC(4.0) - - X(1) = 0.3 - Y(1) = 0.95 - DO 150, J = -20, -13 - CALL GSMK(J) - X(1) = X(1)+0.065 - CALL GPM(1, X, Y) - 150 CONTINUE - - X(1) = 0.3 - Y(1) = 0.875 - - DO 160, J = -12, -5 - CALL GSMK(J) - X(1) = X(1)+0.065 - CALL GPM(1, X, Y) - 160 CONTINUE - - X(1) = 0.3 - Y(1) = 0.8 - - DO 170, J = -4, 4 - IF (J .EQ. 0) GOTO 170 - CALL GSMK(J) - X(1) = X(1)+0.065 - CALL GPM(1, X, Y) - 170 CONTINUE - -C* Fill areas - X(1) = 0.02 - X(2) = 0.12 - X(3) = 0.12 - X(4) = 0.02 - X(5) = X(1) - Y(1) = 0.02 - Y(2) = 0.02 - Y(3) = 0.12 - Y(4) = 0.12 - Y(5) = Y(1) - - CALL GSFASI(4) - DO 20, J=0, 3 - DO 10, I=1, 5 - X(I)=X(I)+0.1 - Y(I)=Y(I)+0.1 - 10 CONTINUE - CALL GSFAIS(J) - CALL GFA(5, X, Y) - 20 CONTINUE - -C* Patterns - X(1) = 0.05 - X(2) = 0.1 - X(3) = 0.1 - X(4) = 0.05 - X(5) = X(1) - Y(1) = 0.2 - Y(2) = 0.2 - Y(3) = 0.25 - Y(4) = 0.25 - Y(5) = Y(1) - CALL GSFAIS(2) - DO 40, J=4, 15 - DO 30, I=1, 5 - Y(I)=Y(I)+0.06 - 30 CONTINUE - CALL GSFASI(J-3) - CALL GFA(5, X, Y) - 40 CONTINUE - -C* Cell Array - CALL GCA(0.332, 0.75, 0.532, 0.55, 8, 10, 1, 1, 8, 10, COLIA) - -C* More Text - CALL GSCHH(0.08) - CALL GSTXAL(2, 3) - CALL GSTXCI(1) - CALL GSTXFP(12, 2) - CALL GTX(.5, .05, 'Hello World') - - CALL GCLSG - CALL GDAWK(1) - CALL GOPWK(2, 0, 0) - CALL GACWK(2) - CALL GCSGWK(2, 1) - CALL GSMK(2) - 500 CALL GRQLC(2, 1, ISTAT, TNR, X(1), Y(1)) - IF (ISTAT .EQ. 1) THEN - CALL GPM(1, X, Y) - GO TO 500 - END IF - CALL GECLKS - - WRITE (*,*) X(1), Y(1) - - END diff -r -N -u gks/dos/GKSAFM.FOR gli-gks/dos/GKSAFM.FOR --- gks/dos/GKSAFM.FOR 2000-11-21 07:16:45.000000000 -0500 +++ gli-gks/dos/GKSAFM.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,1947 +0,0 @@ -C* -C* Copyright @ 1995 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* -C* FACILITY: -C* -C* Graphical Kernel System (GKS) -C* -C* ABSTRACT: -C* -C* This module contains the AFM (Adobe Font Metrics) routines. -C* -C* AUTHOR(S): -C* -C* J. Heinen -C* -C* VERSION: -C* -C* V1.0 -C* -C* - SUBROUTINE GKAFM(FONT, CH, BUFF) -C* - INTEGER FONT, CH, BUFF(256) -C* - INTEGER WIDTHS(256, 29), PSMAP(32), DESCEN(29), CAPS(29) - INTEGER PSFONT, CODE - - DATA (WIDTHS(I, 1), I = 1, 4) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 5, 8) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 9, 12) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 13, 16) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 17, 20) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 21, 24) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 25, 28) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 29, 32) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 33, 36) / 250, 333, 408, 500 / - DATA (WIDTHS(I, 1), I = 37, 40) / 500, 833, 778, 333 / - DATA (WIDTHS(I, 1), I = 41, 44) / 333, 333, 500, 564 / - DATA (WIDTHS(I, 1), I = 45, 48) / 250, 564, 250, 278 / - DATA (WIDTHS(I, 1), I = 49, 52) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 1), I = 53, 56) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 1), I = 57, 60) / 500, 500, 278, 278 / - DATA (WIDTHS(I, 1), I = 61, 64) / 564, 564, 564, 444 / - DATA (WIDTHS(I, 1), I = 65, 68) / 921, 722, 667, 667 / - DATA (WIDTHS(I, 1), I = 69, 72) / 722, 611, 556, 722 / - DATA (WIDTHS(I, 1), I = 73, 76) / 722, 333, 389, 722 / - DATA (WIDTHS(I, 1), I = 77, 80) / 611, 889, 722, 722 / - DATA (WIDTHS(I, 1), I = 81, 84) / 556, 722, 667, 556 / - DATA (WIDTHS(I, 1), I = 85, 88) / 611, 722, 722, 944 / - DATA (WIDTHS(I, 1), I = 89, 92) / 722, 722, 611, 333 / - DATA (WIDTHS(I, 1), I = 93, 96) / 278, 333, 469, 500 / - DATA (WIDTHS(I, 1), I = 97, 100) / 333, 444, 500, 444 / - DATA (WIDTHS(I, 1), I = 101, 104) / 500, 444, 333, 500 / - DATA (WIDTHS(I, 1), I = 105, 108) / 500, 278, 278, 500 / - DATA (WIDTHS(I, 1), I = 109, 112) / 278, 778, 500, 500 / - DATA (WIDTHS(I, 1), I = 113, 116) / 500, 500, 333, 389 / - DATA (WIDTHS(I, 1), I = 117, 120) / 278, 500, 500, 722 / - DATA (WIDTHS(I, 1), I = 121, 124) / 500, 500, 444, 480 / - DATA (WIDTHS(I, 1), I = 125, 128) / 200, 480, 541, 250 / - DATA (WIDTHS(I, 1), I = 129, 132) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 133, 136) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 137, 140) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 141, 144) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 145, 148) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 149, 152) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 153, 156) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 157, 160) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 1), I = 161, 164) / 250, 333, 500, 500 / - DATA (WIDTHS(I, 1), I = 165, 168) / 500, 500, 200, 500 / - DATA (WIDTHS(I, 1), I = 169, 172) / 333, 760, 276, 500 / - DATA (WIDTHS(I, 1), I = 173, 176) / 564, 333, 760, 333 / - DATA (WIDTHS(I, 1), I = 177, 180) / 400, 564, 300, 300 / - DATA (WIDTHS(I, 1), I = 181, 184) / 333, 500, 453, 250 / - DATA (WIDTHS(I, 1), I = 185, 188) / 333, 300, 310, 500 / - DATA (WIDTHS(I, 1), I = 189, 192) / 750, 750, 750, 444 / - DATA (WIDTHS(I, 1), I = 193, 196) / 722, 722, 722, 722 / - DATA (WIDTHS(I, 1), I = 197, 200) / 722, 722, 889, 667 / - DATA (WIDTHS(I, 1), I = 201, 204) / 611, 611, 611, 611 / - DATA (WIDTHS(I, 1), I = 205, 208) / 333, 333, 333, 333 / - DATA (WIDTHS(I, 1), I = 209, 212) / 722, 722, 722, 722 / - DATA (WIDTHS(I, 1), I = 213, 216) / 722, 722, 722, 564 / - DATA (WIDTHS(I, 1), I = 217, 220) / 722, 722, 722, 722 / - DATA (WIDTHS(I, 1), I = 221, 224) / 722, 722, 556, 500 / - DATA (WIDTHS(I, 1), I = 225, 228) / 444, 444, 444, 444 / - DATA (WIDTHS(I, 1), I = 229, 232) / 444, 444, 667, 444 / - DATA (WIDTHS(I, 1), I = 233, 236) / 444, 444, 444, 444 / - DATA (WIDTHS(I, 1), I = 237, 240) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 1), I = 241, 244) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 1), I = 245, 248) / 500, 500, 500, 564 / - DATA (WIDTHS(I, 1), I = 249, 252) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 1), I = 253, 256) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 2), I = 1, 4) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 5, 8) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 9, 12) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 13, 16) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 17, 20) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 21, 24) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 25, 28) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 29, 32) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 33, 36) / 250, 333, 420, 500 / - DATA (WIDTHS(I, 2), I = 37, 40) / 500, 833, 778, 333 / - DATA (WIDTHS(I, 2), I = 41, 44) / 333, 333, 500, 675 / - DATA (WIDTHS(I, 2), I = 45, 48) / 250, 675, 250, 278 / - DATA (WIDTHS(I, 2), I = 49, 52) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 2), I = 53, 56) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 2), I = 57, 60) / 500, 500, 333, 333 / - DATA (WIDTHS(I, 2), I = 61, 64) / 675, 675, 675, 500 / - DATA (WIDTHS(I, 2), I = 65, 68) / 920, 611, 611, 667 / - DATA (WIDTHS(I, 2), I = 69, 72) / 722, 611, 611, 722 / - DATA (WIDTHS(I, 2), I = 73, 76) / 722, 333, 444, 667 / - DATA (WIDTHS(I, 2), I = 77, 80) / 556, 833, 667, 722 / - DATA (WIDTHS(I, 2), I = 81, 84) / 611, 722, 611, 500 / - DATA (WIDTHS(I, 2), I = 85, 88) / 556, 722, 611, 833 / - DATA (WIDTHS(I, 2), I = 89, 92) / 611, 556, 556, 389 / - DATA (WIDTHS(I, 2), I = 93, 96) / 278, 389, 422, 500 / - DATA (WIDTHS(I, 2), I = 97, 100) / 333, 500, 500, 444 / - DATA (WIDTHS(I, 2), I = 101, 104) / 500, 444, 278, 500 / - DATA (WIDTHS(I, 2), I = 105, 108) / 500, 278, 278, 444 / - DATA (WIDTHS(I, 2), I = 109, 112) / 278, 722, 500, 500 / - DATA (WIDTHS(I, 2), I = 113, 116) / 500, 500, 389, 389 / - DATA (WIDTHS(I, 2), I = 117, 120) / 278, 500, 444, 667 / - DATA (WIDTHS(I, 2), I = 121, 124) / 444, 444, 389, 400 / - DATA (WIDTHS(I, 2), I = 125, 128) / 275, 400, 541, 250 / - DATA (WIDTHS(I, 2), I = 129, 132) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 133, 136) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 137, 140) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 141, 144) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 145, 148) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 149, 152) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 153, 156) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 157, 160) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 2), I = 161, 164) / 250, 389, 500, 500 / - DATA (WIDTHS(I, 2), I = 165, 168) / 500, 500, 275, 500 / - DATA (WIDTHS(I, 2), I = 169, 172) / 333, 760, 276, 500 / - DATA (WIDTHS(I, 2), I = 173, 176) / 675, 333, 760, 333 / - DATA (WIDTHS(I, 2), I = 177, 180) / 400, 675, 300, 300 / - DATA (WIDTHS(I, 2), I = 181, 184) / 333, 500, 523, 250 / - DATA (WIDTHS(I, 2), I = 185, 188) / 333, 300, 310, 500 / - DATA (WIDTHS(I, 2), I = 189, 192) / 750, 750, 750, 500 / - DATA (WIDTHS(I, 2), I = 193, 196) / 611, 611, 611, 611 / - DATA (WIDTHS(I, 2), I = 197, 200) / 611, 611, 889, 667 / - DATA (WIDTHS(I, 2), I = 201, 204) / 611, 611, 611, 611 / - DATA (WIDTHS(I, 2), I = 205, 208) / 333, 333, 333, 333 / - DATA (WIDTHS(I, 2), I = 209, 212) / 722, 667, 722, 722 / - DATA (WIDTHS(I, 2), I = 213, 216) / 722, 722, 722, 675 / - DATA (WIDTHS(I, 2), I = 217, 220) / 722, 722, 722, 722 / - DATA (WIDTHS(I, 2), I = 221, 224) / 722, 556, 611, 500 / - DATA (WIDTHS(I, 2), I = 225, 228) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 2), I = 229, 232) / 500, 500, 667, 444 / - DATA (WIDTHS(I, 2), I = 233, 236) / 444, 444, 444, 444 / - DATA (WIDTHS(I, 2), I = 237, 240) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 2), I = 241, 244) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 2), I = 245, 248) / 500, 500, 500, 675 / - DATA (WIDTHS(I, 2), I = 249, 252) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 2), I = 253, 256) / 500, 444, 500, 444 / - DATA (WIDTHS(I, 3), I = 1, 4) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 5, 8) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 9, 12) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 13, 16) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 17, 20) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 21, 24) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 25, 28) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 29, 32) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 33, 36) / 250, 333, 555, 500 / - DATA (WIDTHS(I, 3), I = 37, 40) / 500, 1000, 833, 333 / - DATA (WIDTHS(I, 3), I = 41, 44) / 333, 333, 500, 570 / - DATA (WIDTHS(I, 3), I = 45, 48) / 250, 570, 250, 278 / - DATA (WIDTHS(I, 3), I = 49, 52) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 3), I = 53, 56) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 3), I = 57, 60) / 500, 500, 333, 333 / - DATA (WIDTHS(I, 3), I = 61, 64) / 570, 570, 570, 500 / - DATA (WIDTHS(I, 3), I = 65, 68) / 930, 722, 667, 722 / - DATA (WIDTHS(I, 3), I = 69, 72) / 722, 667, 611, 778 / - DATA (WIDTHS(I, 3), I = 73, 76) / 778, 389, 500, 778 / - DATA (WIDTHS(I, 3), I = 77, 80) / 667, 944, 722, 778 / - DATA (WIDTHS(I, 3), I = 81, 84) / 611, 778, 722, 556 / - DATA (WIDTHS(I, 3), I = 85, 88) / 667, 722, 722, 1000 / - DATA (WIDTHS(I, 3), I = 89, 92) / 722, 722, 667, 333 / - DATA (WIDTHS(I, 3), I = 93, 96) / 278, 333, 581, 500 / - DATA (WIDTHS(I, 3), I = 97, 100) / 333, 500, 556, 444 / - DATA (WIDTHS(I, 3), I = 101, 104) / 556, 444, 333, 500 / - DATA (WIDTHS(I, 3), I = 105, 108) / 556, 278, 333, 556 / - DATA (WIDTHS(I, 3), I = 109, 112) / 278, 833, 556, 500 / - DATA (WIDTHS(I, 3), I = 113, 116) / 556, 556, 444, 389 / - DATA (WIDTHS(I, 3), I = 117, 120) / 333, 556, 500, 722 / - DATA (WIDTHS(I, 3), I = 121, 124) / 500, 500, 444, 394 / - DATA (WIDTHS(I, 3), I = 125, 128) / 220, 394, 520, 250 / - DATA (WIDTHS(I, 3), I = 129, 132) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 133, 136) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 137, 140) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 141, 144) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 145, 148) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 149, 152) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 153, 156) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 157, 160) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 3), I = 161, 164) / 250, 333, 500, 500 / - DATA (WIDTHS(I, 3), I = 165, 168) / 500, 500, 220, 500 / - DATA (WIDTHS(I, 3), I = 169, 172) / 333, 747, 300, 500 / - DATA (WIDTHS(I, 3), I = 173, 176) / 570, 333, 747, 333 / - DATA (WIDTHS(I, 3), I = 177, 180) / 400, 570, 300, 300 / - DATA (WIDTHS(I, 3), I = 181, 184) / 333, 556, 540, 250 / - DATA (WIDTHS(I, 3), I = 185, 188) / 333, 300, 330, 500 / - DATA (WIDTHS(I, 3), I = 189, 192) / 750, 750, 750, 500 / - DATA (WIDTHS(I, 3), I = 193, 196) / 722, 722, 722, 722 / - DATA (WIDTHS(I, 3), I = 197, 200) / 722, 722, 1000, 722 / - DATA (WIDTHS(I, 3), I = 201, 204) / 667, 667, 667, 667 / - DATA (WIDTHS(I, 3), I = 205, 208) / 389, 389, 389, 389 / - DATA (WIDTHS(I, 3), I = 209, 212) / 722, 722, 778, 778 / - DATA (WIDTHS(I, 3), I = 213, 216) / 778, 778, 778, 570 / - DATA (WIDTHS(I, 3), I = 217, 220) / 778, 722, 722, 722 / - DATA (WIDTHS(I, 3), I = 221, 224) / 722, 722, 611, 556 / - DATA (WIDTHS(I, 3), I = 225, 228) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 3), I = 229, 232) / 500, 500, 722, 444 / - DATA (WIDTHS(I, 3), I = 233, 236) / 444, 444, 444, 444 / - DATA (WIDTHS(I, 3), I = 237, 240) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 3), I = 241, 244) / 500, 556, 500, 500 / - DATA (WIDTHS(I, 3), I = 245, 248) / 500, 500, 500, 570 / - DATA (WIDTHS(I, 3), I = 249, 252) / 500, 556, 556, 556 / - DATA (WIDTHS(I, 3), I = 253, 256) / 556, 500, 556, 500 / - DATA (WIDTHS(I, 4), I = 1, 4) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 5, 8) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 9, 12) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 13, 16) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 17, 20) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 21, 24) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 25, 28) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 29, 32) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 33, 36) / 250, 389, 555, 500 / - DATA (WIDTHS(I, 4), I = 37, 40) / 500, 833, 778, 333 / - DATA (WIDTHS(I, 4), I = 41, 44) / 333, 333, 500, 570 / - DATA (WIDTHS(I, 4), I = 45, 48) / 250, 606, 250, 278 / - DATA (WIDTHS(I, 4), I = 49, 52) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 4), I = 53, 56) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 4), I = 57, 60) / 500, 500, 333, 333 / - DATA (WIDTHS(I, 4), I = 61, 64) / 570, 570, 570, 500 / - DATA (WIDTHS(I, 4), I = 65, 68) / 832, 667, 667, 667 / - DATA (WIDTHS(I, 4), I = 69, 72) / 722, 667, 667, 722 / - DATA (WIDTHS(I, 4), I = 73, 76) / 778, 389, 500, 667 / - DATA (WIDTHS(I, 4), I = 77, 80) / 611, 889, 722, 722 / - DATA (WIDTHS(I, 4), I = 81, 84) / 611, 722, 667, 556 / - DATA (WIDTHS(I, 4), I = 85, 88) / 611, 722, 667, 889 / - DATA (WIDTHS(I, 4), I = 89, 92) / 667, 611, 611, 333 / - DATA (WIDTHS(I, 4), I = 93, 96) / 278, 333, 570, 500 / - DATA (WIDTHS(I, 4), I = 97, 100) / 333, 500, 500, 444 / - DATA (WIDTHS(I, 4), I = 101, 104) / 500, 444, 333, 500 / - DATA (WIDTHS(I, 4), I = 105, 108) / 556, 278, 278, 500 / - DATA (WIDTHS(I, 4), I = 109, 112) / 278, 778, 556, 500 / - DATA (WIDTHS(I, 4), I = 113, 116) / 500, 500, 389, 389 / - DATA (WIDTHS(I, 4), I = 117, 120) / 278, 556, 444, 667 / - DATA (WIDTHS(I, 4), I = 121, 124) / 500, 444, 389, 348 / - DATA (WIDTHS(I, 4), I = 125, 128) / 220, 348, 570, 250 / - DATA (WIDTHS(I, 4), I = 129, 132) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 133, 136) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 137, 140) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 141, 144) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 145, 148) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 149, 152) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 153, 156) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 157, 160) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 4), I = 161, 164) / 250, 389, 500, 500 / - DATA (WIDTHS(I, 4), I = 165, 168) / 500, 500, 220, 500 / - DATA (WIDTHS(I, 4), I = 169, 172) / 333, 747, 266, 500 / - DATA (WIDTHS(I, 4), I = 173, 176) / 606, 333, 747, 333 / - DATA (WIDTHS(I, 4), I = 177, 180) / 400, 570, 300, 300 / - DATA (WIDTHS(I, 4), I = 181, 184) / 333, 576, 500, 250 / - DATA (WIDTHS(I, 4), I = 185, 188) / 333, 300, 300, 500 / - DATA (WIDTHS(I, 4), I = 189, 192) / 750, 750, 750, 500 / - DATA (WIDTHS(I, 4), I = 193, 196) / 667, 667, 667, 667 / - DATA (WIDTHS(I, 4), I = 197, 200) / 667, 667, 944, 667 / - DATA (WIDTHS(I, 4), I = 201, 204) / 667, 667, 667, 667 / - DATA (WIDTHS(I, 4), I = 205, 208) / 389, 389, 389, 389 / - DATA (WIDTHS(I, 4), I = 209, 212) / 722, 722, 722, 722 / - DATA (WIDTHS(I, 4), I = 213, 216) / 722, 722, 722, 570 / - DATA (WIDTHS(I, 4), I = 217, 220) / 722, 722, 722, 722 / - DATA (WIDTHS(I, 4), I = 221, 224) / 722, 611, 611, 500 / - DATA (WIDTHS(I, 4), I = 225, 228) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 4), I = 229, 232) / 500, 500, 722, 444 / - DATA (WIDTHS(I, 4), I = 233, 236) / 444, 444, 444, 444 / - DATA (WIDTHS(I, 4), I = 237, 240) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 4), I = 241, 244) / 500, 556, 500, 500 / - DATA (WIDTHS(I, 4), I = 245, 248) / 500, 500, 500, 570 / - DATA (WIDTHS(I, 4), I = 249, 252) / 500, 556, 556, 556 / - DATA (WIDTHS(I, 4), I = 253, 256) / 556, 444, 500, 444 / - DATA (WIDTHS(I, 5), I = 1, 4) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 5, 8) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 9, 12) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 13, 16) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 17, 20) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 21, 24) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 25, 28) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 29, 32) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 33, 36) / 278, 278, 355, 556 / - DATA (WIDTHS(I, 5), I = 37, 40) / 556, 889, 667, 222 / - DATA (WIDTHS(I, 5), I = 41, 44) / 333, 333, 389, 584 / - DATA (WIDTHS(I, 5), I = 45, 48) / 278, 584, 278, 278 / - DATA (WIDTHS(I, 5), I = 49, 52) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 5), I = 53, 56) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 5), I = 57, 60) / 556, 556, 278, 278 / - DATA (WIDTHS(I, 5), I = 61, 64) / 584, 584, 584, 556 / - DATA (WIDTHS(I, 5), I = 65, 68) / 1015, 667, 667, 722 / - DATA (WIDTHS(I, 5), I = 69, 72) / 722, 667, 611, 778 / - DATA (WIDTHS(I, 5), I = 73, 76) / 722, 278, 500, 667 / - DATA (WIDTHS(I, 5), I = 77, 80) / 556, 833, 722, 778 / - DATA (WIDTHS(I, 5), I = 81, 84) / 667, 778, 722, 667 / - DATA (WIDTHS(I, 5), I = 85, 88) / 611, 722, 667, 944 / - DATA (WIDTHS(I, 5), I = 89, 92) / 667, 667, 611, 278 / - DATA (WIDTHS(I, 5), I = 93, 96) / 278, 278, 469, 556 / - DATA (WIDTHS(I, 5), I = 97, 100) / 222, 556, 556, 500 / - DATA (WIDTHS(I, 5), I = 101, 104) / 556, 556, 278, 556 / - DATA (WIDTHS(I, 5), I = 105, 108) / 556, 222, 222, 500 / - DATA (WIDTHS(I, 5), I = 109, 112) / 222, 833, 556, 556 / - DATA (WIDTHS(I, 5), I = 113, 116) / 556, 556, 333, 500 / - DATA (WIDTHS(I, 5), I = 117, 120) / 278, 556, 500, 722 / - DATA (WIDTHS(I, 5), I = 121, 124) / 500, 500, 500, 334 / - DATA (WIDTHS(I, 5), I = 125, 128) / 260, 334, 584, 278 / - DATA (WIDTHS(I, 5), I = 129, 132) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 133, 136) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 137, 140) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 141, 144) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 145, 148) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 149, 152) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 153, 156) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 157, 160) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 161, 164) / 278, 333, 556, 556 / - DATA (WIDTHS(I, 5), I = 165, 168) / 556, 556, 260, 556 / - DATA (WIDTHS(I, 5), I = 169, 172) / 333, 737, 370, 556 / - DATA (WIDTHS(I, 5), I = 173, 176) / 584, 333, 737, 333 / - DATA (WIDTHS(I, 5), I = 177, 180) / 400, 584, 333, 333 / - DATA (WIDTHS(I, 5), I = 181, 184) / 333, 556, 537, 278 / - DATA (WIDTHS(I, 5), I = 185, 188) / 333, 333, 365, 556 / - DATA (WIDTHS(I, 5), I = 189, 192) / 834, 834, 834, 611 / - DATA (WIDTHS(I, 5), I = 193, 196) / 667, 667, 667, 667 / - DATA (WIDTHS(I, 5), I = 197, 200) / 667, 667, 1000, 722 / - DATA (WIDTHS(I, 5), I = 201, 204) / 667, 667, 667, 667 / - DATA (WIDTHS(I, 5), I = 205, 208) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 209, 212) / 722, 722, 778, 778 / - DATA (WIDTHS(I, 5), I = 213, 216) / 778, 778, 778, 584 / - DATA (WIDTHS(I, 5), I = 217, 220) / 778, 722, 722, 722 / - DATA (WIDTHS(I, 5), I = 221, 224) / 722, 667, 667, 611 / - DATA (WIDTHS(I, 5), I = 225, 228) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 5), I = 229, 232) / 556, 556, 889, 500 / - DATA (WIDTHS(I, 5), I = 233, 236) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 5), I = 237, 240) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 5), I = 241, 244) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 5), I = 245, 248) / 556, 556, 556, 584 / - DATA (WIDTHS(I, 5), I = 249, 252) / 611, 556, 556, 556 / - DATA (WIDTHS(I, 5), I = 253, 256) / 556, 500, 556, 500 / - DATA (WIDTHS(I, 6), I = 1, 4) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 5, 8) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 9, 12) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 13, 16) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 17, 20) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 21, 24) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 25, 28) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 29, 32) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 33, 36) / 278, 278, 355, 556 / - DATA (WIDTHS(I, 6), I = 37, 40) / 556, 889, 667, 222 / - DATA (WIDTHS(I, 6), I = 41, 44) / 333, 333, 389, 584 / - DATA (WIDTHS(I, 6), I = 45, 48) / 278, 584, 278, 278 / - DATA (WIDTHS(I, 6), I = 49, 52) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 6), I = 53, 56) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 6), I = 57, 60) / 556, 556, 278, 278 / - DATA (WIDTHS(I, 6), I = 61, 64) / 584, 584, 584, 556 / - DATA (WIDTHS(I, 6), I = 65, 68) / 1015, 667, 667, 722 / - DATA (WIDTHS(I, 6), I = 69, 72) / 722, 667, 611, 778 / - DATA (WIDTHS(I, 6), I = 73, 76) / 722, 278, 500, 667 / - DATA (WIDTHS(I, 6), I = 77, 80) / 556, 833, 722, 778 / - DATA (WIDTHS(I, 6), I = 81, 84) / 667, 778, 722, 667 / - DATA (WIDTHS(I, 6), I = 85, 88) / 611, 722, 667, 944 / - DATA (WIDTHS(I, 6), I = 89, 92) / 667, 667, 611, 278 / - DATA (WIDTHS(I, 6), I = 93, 96) / 278, 278, 469, 556 / - DATA (WIDTHS(I, 6), I = 97, 100) / 222, 556, 556, 500 / - DATA (WIDTHS(I, 6), I = 101, 104) / 556, 556, 278, 556 / - DATA (WIDTHS(I, 6), I = 105, 108) / 556, 222, 222, 500 / - DATA (WIDTHS(I, 6), I = 109, 112) / 222, 833, 556, 556 / - DATA (WIDTHS(I, 6), I = 113, 116) / 556, 556, 333, 500 / - DATA (WIDTHS(I, 6), I = 117, 120) / 278, 556, 500, 722 / - DATA (WIDTHS(I, 6), I = 121, 124) / 500, 500, 500, 334 / - DATA (WIDTHS(I, 6), I = 125, 128) / 260, 334, 584, 278 / - DATA (WIDTHS(I, 6), I = 129, 132) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 133, 136) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 137, 140) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 141, 144) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 145, 148) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 149, 152) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 153, 156) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 157, 160) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 161, 164) / 278, 333, 556, 556 / - DATA (WIDTHS(I, 6), I = 165, 168) / 556, 556, 260, 556 / - DATA (WIDTHS(I, 6), I = 169, 172) / 333, 737, 370, 556 / - DATA (WIDTHS(I, 6), I = 173, 176) / 584, 333, 737, 333 / - DATA (WIDTHS(I, 6), I = 177, 180) / 400, 584, 333, 333 / - DATA (WIDTHS(I, 6), I = 181, 184) / 333, 556, 537, 278 / - DATA (WIDTHS(I, 6), I = 185, 188) / 333, 333, 365, 556 / - DATA (WIDTHS(I, 6), I = 189, 192) / 834, 834, 834, 611 / - DATA (WIDTHS(I, 6), I = 193, 196) / 667, 667, 667, 667 / - DATA (WIDTHS(I, 6), I = 197, 200) / 667, 667, 1000, 722 / - DATA (WIDTHS(I, 6), I = 201, 204) / 667, 667, 667, 667 / - DATA (WIDTHS(I, 6), I = 205, 208) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 209, 212) / 722, 722, 778, 778 / - DATA (WIDTHS(I, 6), I = 213, 216) / 778, 778, 778, 584 / - DATA (WIDTHS(I, 6), I = 217, 220) / 778, 722, 722, 722 / - DATA (WIDTHS(I, 6), I = 221, 224) / 722, 667, 667, 611 / - DATA (WIDTHS(I, 6), I = 225, 228) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 6), I = 229, 232) / 556, 556, 889, 500 / - DATA (WIDTHS(I, 6), I = 233, 236) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 6), I = 237, 240) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 6), I = 241, 244) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 6), I = 245, 248) / 556, 556, 556, 584 / - DATA (WIDTHS(I, 6), I = 249, 252) / 611, 556, 556, 556 / - DATA (WIDTHS(I, 6), I = 253, 256) / 556, 500, 556, 500 / - DATA (WIDTHS(I, 7), I = 1, 4) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 5, 8) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 9, 12) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 13, 16) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 17, 20) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 21, 24) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 25, 28) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 29, 32) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 33, 36) / 278, 333, 474, 556 / - DATA (WIDTHS(I, 7), I = 37, 40) / 556, 889, 722, 278 / - DATA (WIDTHS(I, 7), I = 41, 44) / 333, 333, 389, 584 / - DATA (WIDTHS(I, 7), I = 45, 48) / 278, 584, 278, 278 / - DATA (WIDTHS(I, 7), I = 49, 52) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 7), I = 53, 56) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 7), I = 57, 60) / 556, 556, 333, 333 / - DATA (WIDTHS(I, 7), I = 61, 64) / 584, 584, 584, 611 / - DATA (WIDTHS(I, 7), I = 65, 68) / 975, 722, 722, 722 / - DATA (WIDTHS(I, 7), I = 69, 72) / 722, 667, 611, 778 / - DATA (WIDTHS(I, 7), I = 73, 76) / 722, 278, 556, 722 / - DATA (WIDTHS(I, 7), I = 77, 80) / 611, 833, 722, 778 / - DATA (WIDTHS(I, 7), I = 81, 84) / 667, 778, 722, 667 / - DATA (WIDTHS(I, 7), I = 85, 88) / 611, 722, 667, 944 / - DATA (WIDTHS(I, 7), I = 89, 92) / 667, 667, 611, 333 / - DATA (WIDTHS(I, 7), I = 93, 96) / 278, 333, 584, 556 / - DATA (WIDTHS(I, 7), I = 97, 100) / 278, 556, 611, 556 / - DATA (WIDTHS(I, 7), I = 101, 104) / 611, 556, 333, 611 / - DATA (WIDTHS(I, 7), I = 105, 108) / 611, 278, 278, 556 / - DATA (WIDTHS(I, 7), I = 109, 112) / 278, 889, 611, 611 / - DATA (WIDTHS(I, 7), I = 113, 116) / 611, 611, 389, 556 / - DATA (WIDTHS(I, 7), I = 117, 120) / 333, 611, 556, 778 / - DATA (WIDTHS(I, 7), I = 121, 124) / 556, 556, 500, 389 / - DATA (WIDTHS(I, 7), I = 125, 128) / 280, 389, 584, 278 / - DATA (WIDTHS(I, 7), I = 129, 132) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 133, 136) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 137, 140) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 141, 144) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 145, 148) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 149, 152) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 153, 156) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 157, 160) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 161, 164) / 278, 333, 556, 556 / - DATA (WIDTHS(I, 7), I = 165, 168) / 556, 556, 280, 556 / - DATA (WIDTHS(I, 7), I = 169, 172) / 333, 737, 370, 556 / - DATA (WIDTHS(I, 7), I = 173, 176) / 584, 333, 737, 333 / - DATA (WIDTHS(I, 7), I = 177, 180) / 400, 584, 333, 333 / - DATA (WIDTHS(I, 7), I = 181, 184) / 333, 611, 556, 278 / - DATA (WIDTHS(I, 7), I = 185, 188) / 333, 333, 365, 556 / - DATA (WIDTHS(I, 7), I = 189, 192) / 834, 834, 834, 611 / - DATA (WIDTHS(I, 7), I = 193, 196) / 722, 722, 722, 722 / - DATA (WIDTHS(I, 7), I = 197, 200) / 722, 722, 1000, 722 / - DATA (WIDTHS(I, 7), I = 201, 204) / 667, 667, 667, 667 / - DATA (WIDTHS(I, 7), I = 205, 208) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 209, 212) / 722, 722, 778, 778 / - DATA (WIDTHS(I, 7), I = 213, 216) / 778, 778, 778, 584 / - DATA (WIDTHS(I, 7), I = 217, 220) / 778, 722, 722, 722 / - DATA (WIDTHS(I, 7), I = 221, 224) / 722, 667, 667, 611 / - DATA (WIDTHS(I, 7), I = 225, 228) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 7), I = 229, 232) / 556, 556, 889, 556 / - DATA (WIDTHS(I, 7), I = 233, 236) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 7), I = 237, 240) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 7), I = 241, 244) / 611, 611, 611, 611 / - DATA (WIDTHS(I, 7), I = 245, 248) / 611, 611, 611, 584 / - DATA (WIDTHS(I, 7), I = 249, 252) / 611, 611, 611, 611 / - DATA (WIDTHS(I, 7), I = 253, 256) / 611, 556, 611, 556 / - DATA (WIDTHS(I, 8), I = 1, 4) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 5, 8) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 9, 12) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 13, 16) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 17, 20) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 21, 24) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 25, 28) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 29, 32) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 33, 36) / 278, 333, 474, 556 / - DATA (WIDTHS(I, 8), I = 37, 40) / 556, 889, 722, 278 / - DATA (WIDTHS(I, 8), I = 41, 44) / 333, 333, 389, 584 / - DATA (WIDTHS(I, 8), I = 45, 48) / 278, 584, 278, 278 / - DATA (WIDTHS(I, 8), I = 49, 52) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 8), I = 53, 56) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 8), I = 57, 60) / 556, 556, 333, 333 / - DATA (WIDTHS(I, 8), I = 61, 64) / 584, 584, 584, 611 / - DATA (WIDTHS(I, 8), I = 65, 68) / 975, 722, 722, 722 / - DATA (WIDTHS(I, 8), I = 69, 72) / 722, 667, 611, 778 / - DATA (WIDTHS(I, 8), I = 73, 76) / 722, 278, 556, 722 / - DATA (WIDTHS(I, 8), I = 77, 80) / 611, 833, 722, 778 / - DATA (WIDTHS(I, 8), I = 81, 84) / 667, 778, 722, 667 / - DATA (WIDTHS(I, 8), I = 85, 88) / 611, 722, 667, 944 / - DATA (WIDTHS(I, 8), I = 89, 92) / 667, 667, 611, 333 / - DATA (WIDTHS(I, 8), I = 93, 96) / 278, 333, 584, 556 / - DATA (WIDTHS(I, 8), I = 97, 100) / 278, 556, 611, 556 / - DATA (WIDTHS(I, 8), I = 101, 104) / 611, 556, 333, 611 / - DATA (WIDTHS(I, 8), I = 105, 108) / 611, 278, 278, 556 / - DATA (WIDTHS(I, 8), I = 109, 112) / 278, 889, 611, 611 / - DATA (WIDTHS(I, 8), I = 113, 116) / 611, 611, 389, 556 / - DATA (WIDTHS(I, 8), I = 117, 120) / 333, 611, 556, 778 / - DATA (WIDTHS(I, 8), I = 121, 124) / 556, 556, 500, 389 / - DATA (WIDTHS(I, 8), I = 125, 128) / 280, 389, 584, 278 / - DATA (WIDTHS(I, 8), I = 129, 132) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 133, 136) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 137, 140) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 141, 144) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 145, 148) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 149, 152) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 153, 156) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 157, 160) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 161, 164) / 278, 333, 556, 556 / - DATA (WIDTHS(I, 8), I = 165, 168) / 556, 556, 280, 556 / - DATA (WIDTHS(I, 8), I = 169, 172) / 333, 737, 370, 556 / - DATA (WIDTHS(I, 8), I = 173, 176) / 584, 333, 737, 333 / - DATA (WIDTHS(I, 8), I = 177, 180) / 400, 584, 333, 333 / - DATA (WIDTHS(I, 8), I = 181, 184) / 333, 611, 556, 278 / - DATA (WIDTHS(I, 8), I = 185, 188) / 333, 333, 365, 556 / - DATA (WIDTHS(I, 8), I = 189, 192) / 834, 834, 834, 611 / - DATA (WIDTHS(I, 8), I = 193, 196) / 722, 722, 722, 722 / - DATA (WIDTHS(I, 8), I = 197, 200) / 722, 722, 1000, 722 / - DATA (WIDTHS(I, 8), I = 201, 204) / 667, 667, 667, 667 / - DATA (WIDTHS(I, 8), I = 205, 208) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 209, 212) / 722, 722, 778, 778 / - DATA (WIDTHS(I, 8), I = 213, 216) / 778, 778, 778, 584 / - DATA (WIDTHS(I, 8), I = 217, 220) / 778, 722, 722, 722 / - DATA (WIDTHS(I, 8), I = 221, 224) / 722, 667, 667, 611 / - DATA (WIDTHS(I, 8), I = 225, 228) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 8), I = 229, 232) / 556, 556, 889, 556 / - DATA (WIDTHS(I, 8), I = 233, 236) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 8), I = 237, 240) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 8), I = 241, 244) / 611, 611, 611, 611 / - DATA (WIDTHS(I, 8), I = 245, 248) / 611, 611, 611, 584 / - DATA (WIDTHS(I, 8), I = 249, 252) / 611, 611, 611, 611 / - DATA (WIDTHS(I, 8), I = 253, 256) / 611, 556, 611, 556 / - DATA (WIDTHS(I, 9), I = 1, 4) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 5, 8) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 9, 12) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 13, 16) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 17, 20) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 21, 24) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 25, 28) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 29, 32) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 33, 36) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 37, 40) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 41, 44) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 45, 48) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 49, 52) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 53, 56) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 57, 60) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 61, 64) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 65, 68) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 69, 72) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 73, 76) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 77, 80) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 81, 84) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 85, 88) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 89, 92) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 93, 96) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 97, 100) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 101, 104) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 105, 108) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 109, 112) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 113, 116) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 117, 120) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 121, 124) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 125, 128) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 129, 132) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 133, 136) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 137, 140) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 141, 144) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 145, 148) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 149, 152) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 153, 156) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 157, 160) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 161, 164) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 165, 168) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 169, 172) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 173, 176) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 177, 180) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 181, 184) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 185, 188) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 189, 192) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 193, 196) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 197, 200) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 201, 204) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 205, 208) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 209, 212) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 213, 216) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 217, 220) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 221, 224) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 225, 228) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 229, 232) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 233, 236) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 237, 240) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 241, 244) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 245, 248) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 249, 252) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 9), I = 253, 256) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 1, 4) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 5, 8) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 9, 12) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 13, 16) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 17, 20) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 21, 24) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 25, 28) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 29, 32) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 33, 36) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 37, 40) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 41, 44) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 45, 48) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 49, 52) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 53, 56) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 57, 60) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 61, 64) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 65, 68) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 69, 72) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 73, 76) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 77, 80) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 81, 84) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 85, 88) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 89, 92) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 93, 96) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 97, 100) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 101, 104) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 105, 108) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 109, 112) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 113, 116) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 117, 120) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 121, 124) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 125, 128) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 129, 132) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 133, 136) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 137, 140) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 141, 144) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 145, 148) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 149, 152) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 153, 156) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 157, 160) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 161, 164) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 165, 168) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 169, 172) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 173, 176) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 177, 180) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 181, 184) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 185, 188) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 189, 192) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 193, 196) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 197, 200) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 201, 204) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 205, 208) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 209, 212) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 213, 216) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 217, 220) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 221, 224) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 225, 228) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 229, 232) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 233, 236) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 237, 240) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 241, 244) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 245, 248) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 249, 252) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 10), I = 253, 256) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 1, 4) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 5, 8) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 9, 12) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 13, 16) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 17, 20) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 21, 24) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 25, 28) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 29, 32) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 33, 36) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 37, 40) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 41, 44) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 45, 48) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 49, 52) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 53, 56) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 57, 60) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 61, 64) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 65, 68) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 69, 72) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 73, 76) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 77, 80) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 81, 84) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 85, 88) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 89, 92) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 93, 96) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 97, 100) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 101, 104) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 105, 108) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 109, 112) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 113, 116) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 117, 120) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 121, 124) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 125, 128) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 129, 132) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 133, 136) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 137, 140) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 141, 144) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 145, 148) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 149, 152) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 153, 156) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 157, 160) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 161, 164) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 165, 168) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 169, 172) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 173, 176) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 177, 180) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 181, 184) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 185, 188) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 189, 192) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 193, 196) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 197, 200) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 201, 204) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 205, 208) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 209, 212) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 213, 216) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 217, 220) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 221, 224) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 225, 228) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 229, 232) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 233, 236) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 237, 240) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 241, 244) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 245, 248) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 249, 252) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 11), I = 253, 256) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 1, 4) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 5, 8) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 9, 12) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 13, 16) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 17, 20) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 21, 24) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 25, 28) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 29, 32) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 33, 36) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 37, 40) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 41, 44) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 45, 48) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 49, 52) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 53, 56) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 57, 60) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 61, 64) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 65, 68) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 69, 72) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 73, 76) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 77, 80) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 81, 84) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 85, 88) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 89, 92) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 93, 96) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 97, 100) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 101, 104) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 105, 108) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 109, 112) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 113, 116) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 117, 120) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 121, 124) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 125, 128) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 129, 132) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 133, 136) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 137, 140) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 141, 144) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 145, 148) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 149, 152) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 153, 156) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 157, 160) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 161, 164) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 165, 168) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 169, 172) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 173, 176) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 177, 180) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 181, 184) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 185, 188) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 189, 192) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 193, 196) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 197, 200) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 201, 204) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 205, 208) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 209, 212) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 213, 216) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 217, 220) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 221, 224) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 225, 228) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 229, 232) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 233, 236) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 237, 240) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 241, 244) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 245, 248) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 249, 252) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 12), I = 253, 256) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 13), I = 1, 4) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 5, 8) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 9, 12) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 13, 16) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 17, 20) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 21, 24) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 25, 28) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 29, 32) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 33, 36) / 250, 333, 713, 500 / - DATA (WIDTHS(I, 13), I = 37, 40) / 549, 833, 778, 439 / - DATA (WIDTHS(I, 13), I = 41, 44) / 333, 333, 500, 549 / - DATA (WIDTHS(I, 13), I = 45, 48) / 250, 549, 250, 278 / - DATA (WIDTHS(I, 13), I = 49, 52) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 13), I = 53, 56) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 13), I = 57, 60) / 500, 500, 278, 278 / - DATA (WIDTHS(I, 13), I = 61, 64) / 549, 549, 549, 444 / - DATA (WIDTHS(I, 13), I = 65, 68) / 549, 722, 667, 722 / - DATA (WIDTHS(I, 13), I = 69, 72) / 612, 611, 763, 603 / - DATA (WIDTHS(I, 13), I = 73, 76) / 722, 333, 631, 722 / - DATA (WIDTHS(I, 13), I = 77, 80) / 686, 889, 722, 722 / - DATA (WIDTHS(I, 13), I = 81, 84) / 768, 741, 556, 592 / - DATA (WIDTHS(I, 13), I = 85, 88) / 611, 690, 439, 768 / - DATA (WIDTHS(I, 13), I = 89, 92) / 645, 795, 611, 333 / - DATA (WIDTHS(I, 13), I = 93, 96) / 863, 333, 658, 500 / - DATA (WIDTHS(I, 13), I = 97, 100) / 500, 631, 549, 549 / - DATA (WIDTHS(I, 13), I = 101, 104) / 494, 439, 521, 411 / - DATA (WIDTHS(I, 13), I = 105, 108) / 603, 329, 603, 549 / - DATA (WIDTHS(I, 13), I = 109, 112) / 549, 576, 521, 549 / - DATA (WIDTHS(I, 13), I = 113, 116) / 549, 521, 549, 603 / - DATA (WIDTHS(I, 13), I = 117, 120) / 439, 576, 713, 686 / - DATA (WIDTHS(I, 13), I = 121, 124) / 493, 686, 494, 480 / - DATA (WIDTHS(I, 13), I = 125, 128) / 200, 480, 549, 250 / - DATA (WIDTHS(I, 13), I = 129, 132) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 133, 136) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 137, 140) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 141, 144) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 145, 148) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 149, 152) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 153, 156) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 157, 160) / 250, 250, 250, 250 / - DATA (WIDTHS(I, 13), I = 161, 164) / 250, 620, 247, 549 / - DATA (WIDTHS(I, 13), I = 165, 168) / 167, 713, 500, 753 / - DATA (WIDTHS(I, 13), I = 169, 172) / 753, 753, 753, 1042 / - DATA (WIDTHS(I, 13), I = 173, 176) / 987, 603, 987, 603 / - DATA (WIDTHS(I, 13), I = 177, 180) / 400, 549, 411, 549 / - DATA (WIDTHS(I, 13), I = 181, 184) / 549, 713, 494, 460 / - DATA (WIDTHS(I, 13), I = 185, 188) / 549, 549, 549, 549 / - DATA (WIDTHS(I, 13), I = 189, 192) / 1000, 603, 1000, 658 / - DATA (WIDTHS(I, 13), I = 193, 196) / 823, 686, 795, 987 / - DATA (WIDTHS(I, 13), I = 197, 200) / 768, 768, 823, 768 / - DATA (WIDTHS(I, 13), I = 201, 204) / 768, 713, 713, 713 / - DATA (WIDTHS(I, 13), I = 205, 208) / 713, 713, 713, 713 / - DATA (WIDTHS(I, 13), I = 209, 212) / 768, 713, 790, 790 / - DATA (WIDTHS(I, 13), I = 213, 216) / 890, 823, 549, 250 / - DATA (WIDTHS(I, 13), I = 217, 220) / 713, 603, 603, 1042 / - DATA (WIDTHS(I, 13), I = 221, 224) / 987, 603, 987, 603 / - DATA (WIDTHS(I, 13), I = 225, 228) / 494, 329, 790, 790 / - DATA (WIDTHS(I, 13), I = 229, 232) / 786, 713, 384, 384 / - DATA (WIDTHS(I, 13), I = 233, 236) / 384, 384, 384, 384 / - DATA (WIDTHS(I, 13), I = 237, 240) / 494, 494, 494, 494 / - DATA (WIDTHS(I, 13), I = 241, 244) / 250, 329, 274, 686 / - DATA (WIDTHS(I, 13), I = 245, 248) / 686, 686, 384, 384 / - DATA (WIDTHS(I, 13), I = 249, 252) / 384, 384, 384, 384 / - DATA (WIDTHS(I, 13), I = 253, 256) / 494, 494, 494, 250 / - DATA (WIDTHS(I, 14), I = 1, 4) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 5, 8) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 9, 12) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 13, 16) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 17, 20) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 21, 24) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 25, 28) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 29, 32) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 33, 36) / 300, 140, 280, 580 / - DATA (WIDTHS(I, 14), I = 37, 40) / 580, 800, 720, 200 / - DATA (WIDTHS(I, 14), I = 41, 44) / 340, 340, 340, 660 / - DATA (WIDTHS(I, 14), I = 45, 48) / 300, 660, 300, 580 / - DATA (WIDTHS(I, 14), I = 49, 52) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 14), I = 53, 56) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 14), I = 57, 60) / 580, 580, 300, 300 / - DATA (WIDTHS(I, 14), I = 61, 64) / 660, 660, 660, 520 / - DATA (WIDTHS(I, 14), I = 65, 68) / 900, 820, 580, 740 / - DATA (WIDTHS(I, 14), I = 69, 72) / 720, 560, 560, 780 / - DATA (WIDTHS(I, 14), I = 73, 76) / 720, 300, 520, 700 / - DATA (WIDTHS(I, 14), I = 77, 80) / 520, 980, 800, 800 / - DATA (WIDTHS(I, 14), I = 81, 84) / 580, 860, 640, 500 / - DATA (WIDTHS(I, 14), I = 85, 88) / 540, 700, 780, 1040 / - DATA (WIDTHS(I, 14), I = 89, 92) / 740, 680, 520, 300 / - DATA (WIDTHS(I, 14), I = 93, 96) / 580, 300, 660, 500 / - DATA (WIDTHS(I, 14), I = 97, 100) / 200, 660, 660, 560 / - DATA (WIDTHS(I, 14), I = 101, 104) / 660, 580, 300, 660 / - DATA (WIDTHS(I, 14), I = 105, 108) / 640, 260, 240, 580 / - DATA (WIDTHS(I, 14), I = 109, 112) / 280, 980, 660, 580 / - DATA (WIDTHS(I, 14), I = 113, 116) / 660, 660, 360, 420 / - DATA (WIDTHS(I, 14), I = 117, 120) / 320, 640, 640, 900 / - DATA (WIDTHS(I, 14), I = 121, 124) / 600, 640, 420, 300 / - DATA (WIDTHS(I, 14), I = 125, 128) / 660, 300, 660, 300 / - DATA (WIDTHS(I, 14), I = 129, 132) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 133, 136) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 137, 140) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 141, 144) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 145, 148) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 149, 152) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 153, 156) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 157, 160) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 161, 164) / 300, 140, 580, 580 / - DATA (WIDTHS(I, 14), I = 165, 168) / 580, 580, 660, 440 / - DATA (WIDTHS(I, 14), I = 169, 172) / 340, 820, 420, 320 / - DATA (WIDTHS(I, 14), I = 173, 176) / 660, 300, 820, 460 / - DATA (WIDTHS(I, 14), I = 177, 180) / 400, 660, 348, 348 / - DATA (WIDTHS(I, 14), I = 181, 184) / 420, 640, 500, 300 / - DATA (WIDTHS(I, 14), I = 185, 188) / 320, 348, 340, 320 / - DATA (WIDTHS(I, 14), I = 189, 192) / 870, 870, 870, 520 / - DATA (WIDTHS(I, 14), I = 193, 196) / 820, 820, 820, 820 / - DATA (WIDTHS(I, 14), I = 197, 200) / 820, 820, 1000, 740 / - DATA (WIDTHS(I, 14), I = 201, 204) / 560, 560, 560, 560 / - DATA (WIDTHS(I, 14), I = 205, 208) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 14), I = 209, 212) / 720, 800, 800, 800 / - DATA (WIDTHS(I, 14), I = 213, 216) / 800, 800, 800, 660 / - DATA (WIDTHS(I, 14), I = 217, 220) / 800, 700, 700, 700 / - DATA (WIDTHS(I, 14), I = 221, 224) / 700, 680, 580, 580 / - DATA (WIDTHS(I, 14), I = 225, 228) / 660, 660, 660, 660 / - DATA (WIDTHS(I, 14), I = 229, 232) / 660, 660, 1060, 560 / - DATA (WIDTHS(I, 14), I = 233, 236) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 14), I = 237, 240) / 260, 260, 260, 260 / - DATA (WIDTHS(I, 14), I = 241, 244) / 580, 660, 580, 580 / - DATA (WIDTHS(I, 14), I = 245, 248) / 580, 580, 580, 660 / - DATA (WIDTHS(I, 14), I = 249, 252) / 580, 640, 640, 640 / - DATA (WIDTHS(I, 14), I = 253, 256) / 640, 640, 660, 640 / - DATA (WIDTHS(I, 15), I = 1, 4) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 5, 8) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 9, 12) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 13, 16) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 17, 20) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 21, 24) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 25, 28) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 29, 32) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 33, 36) / 300, 140, 280, 580 / - DATA (WIDTHS(I, 15), I = 37, 40) / 580, 800, 720, 200 / - DATA (WIDTHS(I, 15), I = 41, 44) / 340, 340, 340, 660 / - DATA (WIDTHS(I, 15), I = 45, 48) / 300, 660, 300, 580 / - DATA (WIDTHS(I, 15), I = 49, 52) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 15), I = 53, 56) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 15), I = 57, 60) / 580, 580, 300, 300 / - DATA (WIDTHS(I, 15), I = 61, 64) / 660, 660, 660, 520 / - DATA (WIDTHS(I, 15), I = 65, 68) / 900, 820, 580, 740 / - DATA (WIDTHS(I, 15), I = 69, 72) / 720, 560, 560, 780 / - DATA (WIDTHS(I, 15), I = 73, 76) / 720, 300, 520, 700 / - DATA (WIDTHS(I, 15), I = 77, 80) / 520, 980, 800, 800 / - DATA (WIDTHS(I, 15), I = 81, 84) / 580, 860, 640, 500 / - DATA (WIDTHS(I, 15), I = 85, 88) / 540, 700, 780, 1040 / - DATA (WIDTHS(I, 15), I = 89, 92) / 740, 680, 520, 300 / - DATA (WIDTHS(I, 15), I = 93, 96) / 580, 300, 660, 500 / - DATA (WIDTHS(I, 15), I = 97, 100) / 200, 660, 660, 560 / - DATA (WIDTHS(I, 15), I = 101, 104) / 660, 580, 300, 660 / - DATA (WIDTHS(I, 15), I = 105, 108) / 640, 260, 240, 580 / - DATA (WIDTHS(I, 15), I = 109, 112) / 280, 980, 660, 580 / - DATA (WIDTHS(I, 15), I = 113, 116) / 660, 660, 360, 420 / - DATA (WIDTHS(I, 15), I = 117, 120) / 320, 640, 640, 900 / - DATA (WIDTHS(I, 15), I = 121, 124) / 600, 640, 420, 300 / - DATA (WIDTHS(I, 15), I = 125, 128) / 660, 300, 660, 300 / - DATA (WIDTHS(I, 15), I = 129, 132) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 133, 136) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 137, 140) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 141, 144) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 145, 148) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 149, 152) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 153, 156) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 157, 160) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 161, 164) / 300, 140, 580, 580 / - DATA (WIDTHS(I, 15), I = 165, 168) / 580, 580, 660, 440 / - DATA (WIDTHS(I, 15), I = 169, 172) / 340, 820, 420, 320 / - DATA (WIDTHS(I, 15), I = 173, 176) / 660, 300, 820, 460 / - DATA (WIDTHS(I, 15), I = 177, 180) / 400, 660, 348, 348 / - DATA (WIDTHS(I, 15), I = 181, 184) / 420, 640, 500, 300 / - DATA (WIDTHS(I, 15), I = 185, 188) / 320, 348, 340, 320 / - DATA (WIDTHS(I, 15), I = 189, 192) / 870, 870, 870, 520 / - DATA (WIDTHS(I, 15), I = 193, 196) / 820, 820, 820, 820 / - DATA (WIDTHS(I, 15), I = 197, 200) / 820, 820, 1000, 740 / - DATA (WIDTHS(I, 15), I = 201, 204) / 560, 560, 560, 560 / - DATA (WIDTHS(I, 15), I = 205, 208) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 15), I = 209, 212) / 720, 800, 800, 800 / - DATA (WIDTHS(I, 15), I = 213, 216) / 800, 800, 800, 660 / - DATA (WIDTHS(I, 15), I = 217, 220) / 800, 700, 700, 700 / - DATA (WIDTHS(I, 15), I = 221, 224) / 700, 680, 580, 580 / - DATA (WIDTHS(I, 15), I = 225, 228) / 660, 660, 660, 660 / - DATA (WIDTHS(I, 15), I = 229, 232) / 660, 660, 1060, 560 / - DATA (WIDTHS(I, 15), I = 233, 236) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 15), I = 237, 240) / 260, 260, 260, 260 / - DATA (WIDTHS(I, 15), I = 241, 244) / 580, 660, 580, 580 / - DATA (WIDTHS(I, 15), I = 245, 248) / 580, 580, 580, 660 / - DATA (WIDTHS(I, 15), I = 249, 252) / 580, 640, 640, 640 / - DATA (WIDTHS(I, 15), I = 253, 256) / 640, 640, 660, 640 / - DATA (WIDTHS(I, 16), I = 1, 4) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 5, 8) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 9, 12) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 13, 16) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 17, 20) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 21, 24) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 25, 28) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 29, 32) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 33, 36) / 300, 200, 400, 580 / - DATA (WIDTHS(I, 16), I = 37, 40) / 580, 860, 720, 200 / - DATA (WIDTHS(I, 16), I = 41, 44) / 360, 360, 360, 660 / - DATA (WIDTHS(I, 16), I = 45, 48) / 300, 660, 300, 580 / - DATA (WIDTHS(I, 16), I = 49, 52) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 16), I = 53, 56) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 16), I = 57, 60) / 580, 580, 300, 300 / - DATA (WIDTHS(I, 16), I = 61, 64) / 660, 660, 660, 540 / - DATA (WIDTHS(I, 16), I = 65, 68) / 880, 780, 600, 760 / - DATA (WIDTHS(I, 16), I = 69, 72) / 740, 580, 580, 780 / - DATA (WIDTHS(I, 16), I = 73, 76) / 740, 340, 540, 720 / - DATA (WIDTHS(I, 16), I = 77, 80) / 560, 960, 800, 780 / - DATA (WIDTHS(I, 16), I = 81, 84) / 600, 860, 640, 520 / - DATA (WIDTHS(I, 16), I = 85, 88) / 600, 700, 740, 1020 / - DATA (WIDTHS(I, 16), I = 89, 92) / 740, 680, 560, 380 / - DATA (WIDTHS(I, 16), I = 93, 96) / 620, 380, 660, 500 / - DATA (WIDTHS(I, 16), I = 97, 100) / 200, 660, 660, 580 / - DATA (WIDTHS(I, 16), I = 101, 104) / 660, 580, 320, 660 / - DATA (WIDTHS(I, 16), I = 105, 108) / 640, 300, 280, 600 / - DATA (WIDTHS(I, 16), I = 109, 112) / 300, 980, 640, 580 / - DATA (WIDTHS(I, 16), I = 113, 116) / 660, 660, 380, 460 / - DATA (WIDTHS(I, 16), I = 117, 120) / 340, 640, 600, 880 / - DATA (WIDTHS(I, 16), I = 121, 124) / 620, 600, 460, 320 / - DATA (WIDTHS(I, 16), I = 125, 128) / 660, 320, 660, 300 / - DATA (WIDTHS(I, 16), I = 129, 132) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 133, 136) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 137, 140) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 141, 144) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 145, 148) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 149, 152) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 153, 156) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 157, 160) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 161, 164) / 300, 200, 580, 580 / - DATA (WIDTHS(I, 16), I = 165, 168) / 580, 580, 660, 460 / - DATA (WIDTHS(I, 16), I = 169, 172) / 460, 820, 420, 360 / - DATA (WIDTHS(I, 16), I = 173, 176) / 660, 320, 820, 520 / - DATA (WIDTHS(I, 16), I = 177, 180) / 400, 660, 348, 348 / - DATA (WIDTHS(I, 16), I = 181, 184) / 460, 640, 540, 300 / - DATA (WIDTHS(I, 16), I = 185, 188) / 360, 348, 360, 360 / - DATA (WIDTHS(I, 16), I = 189, 192) / 870, 870, 870, 540 / - DATA (WIDTHS(I, 16), I = 193, 196) / 780, 780, 780, 780 / - DATA (WIDTHS(I, 16), I = 197, 200) / 780, 780, 980, 760 / - DATA (WIDTHS(I, 16), I = 201, 204) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 16), I = 205, 208) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 16), I = 209, 212) / 740, 800, 780, 780 / - DATA (WIDTHS(I, 16), I = 213, 216) / 780, 780, 780, 660 / - DATA (WIDTHS(I, 16), I = 217, 220) / 780, 700, 700, 700 / - DATA (WIDTHS(I, 16), I = 221, 224) / 700, 680, 600, 600 / - DATA (WIDTHS(I, 16), I = 225, 228) / 660, 660, 660, 660 / - DATA (WIDTHS(I, 16), I = 229, 232) / 660, 660, 1040, 580 / - DATA (WIDTHS(I, 16), I = 233, 236) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 16), I = 237, 240) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 16), I = 241, 244) / 580, 640, 580, 580 / - DATA (WIDTHS(I, 16), I = 245, 248) / 580, 580, 580, 660 / - DATA (WIDTHS(I, 16), I = 249, 252) / 600, 640, 640, 640 / - DATA (WIDTHS(I, 16), I = 253, 256) / 640, 600, 660, 600 / - DATA (WIDTHS(I, 17), I = 1, 4) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 5, 8) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 9, 12) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 13, 16) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 17, 20) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 21, 24) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 25, 28) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 29, 32) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 33, 36) / 300, 200, 400, 580 / - DATA (WIDTHS(I, 17), I = 37, 40) / 580, 860, 720, 200 / - DATA (WIDTHS(I, 17), I = 41, 44) / 360, 360, 360, 660 / - DATA (WIDTHS(I, 17), I = 45, 48) / 300, 660, 300, 580 / - DATA (WIDTHS(I, 17), I = 49, 52) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 17), I = 53, 56) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 17), I = 57, 60) / 580, 580, 300, 300 / - DATA (WIDTHS(I, 17), I = 61, 64) / 660, 660, 660, 540 / - DATA (WIDTHS(I, 17), I = 65, 68) / 880, 780, 600, 760 / - DATA (WIDTHS(I, 17), I = 69, 72) / 740, 580, 580, 780 / - DATA (WIDTHS(I, 17), I = 73, 76) / 740, 340, 540, 720 / - DATA (WIDTHS(I, 17), I = 77, 80) / 560, 960, 800, 780 / - DATA (WIDTHS(I, 17), I = 81, 84) / 600, 860, 640, 520 / - DATA (WIDTHS(I, 17), I = 85, 88) / 600, 700, 740, 1020 / - DATA (WIDTHS(I, 17), I = 89, 92) / 740, 680, 560, 380 / - DATA (WIDTHS(I, 17), I = 93, 96) / 620, 380, 660, 500 / - DATA (WIDTHS(I, 17), I = 97, 100) / 200, 660, 660, 580 / - DATA (WIDTHS(I, 17), I = 101, 104) / 660, 580, 320, 660 / - DATA (WIDTHS(I, 17), I = 105, 108) / 640, 300, 280, 600 / - DATA (WIDTHS(I, 17), I = 109, 112) / 300, 980, 640, 580 / - DATA (WIDTHS(I, 17), I = 113, 116) / 660, 660, 380, 460 / - DATA (WIDTHS(I, 17), I = 117, 120) / 340, 640, 600, 880 / - DATA (WIDTHS(I, 17), I = 121, 124) / 620, 600, 460, 320 / - DATA (WIDTHS(I, 17), I = 125, 128) / 660, 320, 660, 300 / - DATA (WIDTHS(I, 17), I = 129, 132) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 133, 136) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 137, 140) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 141, 144) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 145, 148) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 149, 152) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 153, 156) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 157, 160) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 161, 164) / 300, 200, 580, 580 / - DATA (WIDTHS(I, 17), I = 165, 168) / 580, 580, 660, 460 / - DATA (WIDTHS(I, 17), I = 169, 172) / 460, 820, 420, 360 / - DATA (WIDTHS(I, 17), I = 173, 176) / 660, 320, 820, 520 / - DATA (WIDTHS(I, 17), I = 177, 180) / 400, 660, 348, 348 / - DATA (WIDTHS(I, 17), I = 181, 184) / 460, 640, 540, 300 / - DATA (WIDTHS(I, 17), I = 185, 188) / 360, 348, 360, 360 / - DATA (WIDTHS(I, 17), I = 189, 192) / 870, 870, 870, 540 / - DATA (WIDTHS(I, 17), I = 193, 196) / 780, 780, 780, 780 / - DATA (WIDTHS(I, 17), I = 197, 200) / 780, 780, 980, 760 / - DATA (WIDTHS(I, 17), I = 201, 204) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 17), I = 205, 208) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 17), I = 209, 212) / 740, 800, 780, 780 / - DATA (WIDTHS(I, 17), I = 213, 216) / 780, 780, 780, 660 / - DATA (WIDTHS(I, 17), I = 217, 220) / 780, 700, 700, 700 / - DATA (WIDTHS(I, 17), I = 221, 224) / 700, 680, 600, 600 / - DATA (WIDTHS(I, 17), I = 225, 228) / 660, 660, 660, 660 / - DATA (WIDTHS(I, 17), I = 229, 232) / 660, 660, 1040, 580 / - DATA (WIDTHS(I, 17), I = 233, 236) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 17), I = 237, 240) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 17), I = 241, 244) / 580, 640, 580, 580 / - DATA (WIDTHS(I, 17), I = 245, 248) / 580, 580, 580, 660 / - DATA (WIDTHS(I, 17), I = 249, 252) / 600, 640, 640, 640 / - DATA (WIDTHS(I, 17), I = 253, 256) / 640, 600, 660, 600 / - DATA (WIDTHS(I, 18), I = 1, 4) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 5, 8) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 9, 12) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 13, 16) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 17, 20) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 21, 24) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 25, 28) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 29, 32) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 33, 36) / 278, 296, 389, 556 / - DATA (WIDTHS(I, 18), I = 37, 40) / 556, 833, 815, 204 / - DATA (WIDTHS(I, 18), I = 41, 44) / 333, 333, 500, 606 / - DATA (WIDTHS(I, 18), I = 45, 48) / 278, 606, 278, 278 / - DATA (WIDTHS(I, 18), I = 49, 52) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 18), I = 53, 56) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 18), I = 57, 60) / 556, 556, 278, 278 / - DATA (WIDTHS(I, 18), I = 61, 64) / 606, 606, 606, 444 / - DATA (WIDTHS(I, 18), I = 65, 68) / 737, 722, 722, 722 / - DATA (WIDTHS(I, 18), I = 69, 72) / 778, 722, 667, 778 / - DATA (WIDTHS(I, 18), I = 73, 76) / 833, 407, 556, 778 / - DATA (WIDTHS(I, 18), I = 77, 80) / 667, 944, 815, 778 / - DATA (WIDTHS(I, 18), I = 81, 84) / 667, 778, 722, 630 / - DATA (WIDTHS(I, 18), I = 85, 88) / 667, 815, 722, 981 / - DATA (WIDTHS(I, 18), I = 89, 92) / 704, 704, 611, 333 / - DATA (WIDTHS(I, 18), I = 93, 96) / 606, 333, 606, 500 / - DATA (WIDTHS(I, 18), I = 97, 100) / 204, 556, 556, 444 / - DATA (WIDTHS(I, 18), I = 101, 104) / 574, 500, 333, 537 / - DATA (WIDTHS(I, 18), I = 105, 108) / 611, 315, 296, 593 / - DATA (WIDTHS(I, 18), I = 109, 112) / 315, 889, 611, 500 / - DATA (WIDTHS(I, 18), I = 113, 116) / 574, 556, 444, 463 / - DATA (WIDTHS(I, 18), I = 117, 120) / 389, 611, 537, 778 / - DATA (WIDTHS(I, 18), I = 121, 124) / 537, 537, 481, 333 / - DATA (WIDTHS(I, 18), I = 125, 128) / 606, 333, 606, 278 / - DATA (WIDTHS(I, 18), I = 129, 132) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 133, 136) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 137, 140) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 141, 144) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 145, 148) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 149, 152) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 153, 156) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 157, 160) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 18), I = 161, 164) / 278, 296, 556, 556 / - DATA (WIDTHS(I, 18), I = 165, 168) / 556, 556, 606, 500 / - DATA (WIDTHS(I, 18), I = 169, 172) / 333, 737, 334, 426 / - DATA (WIDTHS(I, 18), I = 173, 176) / 606, 333, 737, 333 / - DATA (WIDTHS(I, 18), I = 177, 180) / 400, 606, 333, 333 / - DATA (WIDTHS(I, 18), I = 181, 184) / 333, 611, 606, 278 / - DATA (WIDTHS(I, 18), I = 185, 188) / 333, 333, 300, 426 / - DATA (WIDTHS(I, 18), I = 189, 192) / 834, 834, 834, 444 / - DATA (WIDTHS(I, 18), I = 193, 196) / 722, 722, 722, 722 / - DATA (WIDTHS(I, 18), I = 197, 200) / 722, 722, 1000, 722 / - DATA (WIDTHS(I, 18), I = 201, 204) / 722, 722, 722, 722 / - DATA (WIDTHS(I, 18), I = 205, 208) / 407, 407, 407, 407 / - DATA (WIDTHS(I, 18), I = 209, 212) / 778, 815, 778, 778 / - DATA (WIDTHS(I, 18), I = 213, 216) / 778, 778, 778, 606 / - DATA (WIDTHS(I, 18), I = 217, 220) / 778, 815, 815, 815 / - DATA (WIDTHS(I, 18), I = 221, 224) / 815, 704, 667, 574 / - DATA (WIDTHS(I, 18), I = 225, 228) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 18), I = 229, 232) / 556, 556, 796, 444 / - DATA (WIDTHS(I, 18), I = 233, 236) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 18), I = 237, 240) / 315, 315, 315, 315 / - DATA (WIDTHS(I, 18), I = 241, 244) / 500, 611, 500, 500 / - DATA (WIDTHS(I, 18), I = 245, 248) / 500, 500, 500, 606 / - DATA (WIDTHS(I, 18), I = 249, 252) / 500, 611, 611, 611 / - DATA (WIDTHS(I, 18), I = 253, 256) / 611, 537, 574, 537 / - DATA (WIDTHS(I, 19), I = 1, 4) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 5, 8) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 9, 12) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 13, 16) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 17, 20) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 21, 24) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 25, 28) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 29, 32) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 33, 36) / 278, 333, 400, 556 / - DATA (WIDTHS(I, 19), I = 37, 40) / 556, 833, 852, 204 / - DATA (WIDTHS(I, 19), I = 41, 44) / 333, 333, 500, 606 / - DATA (WIDTHS(I, 19), I = 45, 48) / 278, 606, 278, 606 / - DATA (WIDTHS(I, 19), I = 49, 52) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 19), I = 53, 56) / 556, 556, 556, 556 / - DATA (WIDTHS(I, 19), I = 57, 60) / 556, 556, 278, 278 / - DATA (WIDTHS(I, 19), I = 61, 64) / 606, 606, 606, 444 / - DATA (WIDTHS(I, 19), I = 65, 68) / 747, 704, 722, 722 / - DATA (WIDTHS(I, 19), I = 69, 72) / 778, 722, 667, 778 / - DATA (WIDTHS(I, 19), I = 73, 76) / 833, 407, 611, 741 / - DATA (WIDTHS(I, 19), I = 77, 80) / 667, 944, 815, 778 / - DATA (WIDTHS(I, 19), I = 81, 84) / 667, 778, 741, 667 / - DATA (WIDTHS(I, 19), I = 85, 88) / 685, 815, 704, 926 / - DATA (WIDTHS(I, 19), I = 89, 92) / 704, 685, 667, 333 / - DATA (WIDTHS(I, 19), I = 93, 96) / 606, 333, 606, 500 / - DATA (WIDTHS(I, 19), I = 97, 100) / 204, 574, 556, 444 / - DATA (WIDTHS(I, 19), I = 101, 104) / 611, 444, 333, 537 / - DATA (WIDTHS(I, 19), I = 105, 108) / 611, 333, 315, 556 / - DATA (WIDTHS(I, 19), I = 109, 112) / 333, 889, 611, 500 / - DATA (WIDTHS(I, 19), I = 113, 116) / 574, 556, 444, 444 / - DATA (WIDTHS(I, 19), I = 117, 120) / 352, 611, 519, 778 / - DATA (WIDTHS(I, 19), I = 121, 124) / 500, 500, 463, 333 / - DATA (WIDTHS(I, 19), I = 125, 128) / 606, 333, 606, 278 / - DATA (WIDTHS(I, 19), I = 129, 132) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 133, 136) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 137, 140) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 141, 144) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 145, 148) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 149, 152) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 153, 156) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 157, 160) / 278, 278, 278, 278 / - DATA (WIDTHS(I, 19), I = 161, 164) / 278, 333, 556, 556 / - DATA (WIDTHS(I, 19), I = 165, 168) / 556, 556, 606, 500 / - DATA (WIDTHS(I, 19), I = 169, 172) / 333, 747, 422, 426 / - DATA (WIDTHS(I, 19), I = 173, 176) / 606, 333, 747, 333 / - DATA (WIDTHS(I, 19), I = 177, 180) / 400, 606, 333, 333 / - DATA (WIDTHS(I, 19), I = 181, 184) / 333, 611, 650, 278 / - DATA (WIDTHS(I, 19), I = 185, 188) / 333, 333, 372, 426 / - DATA (WIDTHS(I, 19), I = 189, 192) / 834, 834, 834, 444 / - DATA (WIDTHS(I, 19), I = 193, 196) / 704, 704, 704, 704 / - DATA (WIDTHS(I, 19), I = 197, 200) / 704, 704, 870, 722 / - DATA (WIDTHS(I, 19), I = 201, 204) / 722, 722, 722, 722 / - DATA (WIDTHS(I, 19), I = 205, 208) / 407, 407, 407, 407 / - DATA (WIDTHS(I, 19), I = 209, 212) / 778, 815, 778, 778 / - DATA (WIDTHS(I, 19), I = 213, 216) / 778, 778, 778, 606 / - DATA (WIDTHS(I, 19), I = 217, 220) / 778, 815, 815, 815 / - DATA (WIDTHS(I, 19), I = 221, 224) / 815, 685, 667, 556 / - DATA (WIDTHS(I, 19), I = 225, 228) / 574, 574, 574, 574 / - DATA (WIDTHS(I, 19), I = 229, 232) / 574, 574, 722, 444 / - DATA (WIDTHS(I, 19), I = 233, 236) / 444, 444, 444, 444 / - DATA (WIDTHS(I, 19), I = 237, 240) / 333, 333, 333, 333 / - DATA (WIDTHS(I, 19), I = 241, 244) / 500, 611, 500, 500 / - DATA (WIDTHS(I, 19), I = 245, 248) / 500, 500, 500, 606 / - DATA (WIDTHS(I, 19), I = 249, 252) / 500, 611, 611, 611 / - DATA (WIDTHS(I, 19), I = 253, 256) / 611, 500, 574, 500 / - DATA (WIDTHS(I, 20), I = 1, 4) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 5, 8) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 9, 12) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 13, 16) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 17, 20) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 21, 24) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 25, 28) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 29, 32) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 33, 36) / 287, 296, 333, 574 / - DATA (WIDTHS(I, 20), I = 37, 40) / 574, 833, 852, 241 / - DATA (WIDTHS(I, 20), I = 41, 44) / 389, 389, 500, 606 / - DATA (WIDTHS(I, 20), I = 45, 48) / 278, 606, 278, 278 / - DATA (WIDTHS(I, 20), I = 49, 52) / 574, 574, 574, 574 / - DATA (WIDTHS(I, 20), I = 53, 56) / 574, 574, 574, 574 / - DATA (WIDTHS(I, 20), I = 57, 60) / 574, 574, 278, 278 / - DATA (WIDTHS(I, 20), I = 61, 64) / 606, 606, 606, 500 / - DATA (WIDTHS(I, 20), I = 65, 68) / 747, 759, 778, 778 / - DATA (WIDTHS(I, 20), I = 69, 72) / 833, 759, 722, 833 / - DATA (WIDTHS(I, 20), I = 73, 76) / 870, 444, 648, 815 / - DATA (WIDTHS(I, 20), I = 77, 80) / 722, 981, 833, 833 / - DATA (WIDTHS(I, 20), I = 81, 84) / 759, 833, 815, 667 / - DATA (WIDTHS(I, 20), I = 85, 88) / 722, 833, 759, 981 / - DATA (WIDTHS(I, 20), I = 89, 92) / 722, 722, 667, 389 / - DATA (WIDTHS(I, 20), I = 93, 96) / 606, 389, 606, 500 / - DATA (WIDTHS(I, 20), I = 97, 100) / 241, 611, 648, 556 / - DATA (WIDTHS(I, 20), I = 101, 104) / 667, 574, 389, 611 / - DATA (WIDTHS(I, 20), I = 105, 108) / 685, 370, 352, 667 / - DATA (WIDTHS(I, 20), I = 109, 112) / 352, 963, 685, 611 / - DATA (WIDTHS(I, 20), I = 113, 116) / 667, 648, 519, 500 / - DATA (WIDTHS(I, 20), I = 117, 120) / 426, 685, 611, 889 / - DATA (WIDTHS(I, 20), I = 121, 124) / 611, 611, 537, 389 / - DATA (WIDTHS(I, 20), I = 125, 128) / 606, 389, 606, 287 / - DATA (WIDTHS(I, 20), I = 129, 132) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 133, 136) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 137, 140) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 141, 144) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 145, 148) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 149, 152) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 153, 156) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 157, 160) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 20), I = 161, 164) / 287, 296, 574, 574 / - DATA (WIDTHS(I, 20), I = 165, 168) / 574, 574, 606, 500 / - DATA (WIDTHS(I, 20), I = 169, 172) / 333, 747, 367, 500 / - DATA (WIDTHS(I, 20), I = 173, 176) / 606, 333, 747, 333 / - DATA (WIDTHS(I, 20), I = 177, 180) / 400, 606, 344, 344 / - DATA (WIDTHS(I, 20), I = 181, 184) / 333, 685, 747, 278 / - DATA (WIDTHS(I, 20), I = 185, 188) / 333, 344, 367, 500 / - DATA (WIDTHS(I, 20), I = 189, 192) / 861, 861, 861, 500 / - DATA (WIDTHS(I, 20), I = 193, 196) / 759, 759, 759, 759 / - DATA (WIDTHS(I, 20), I = 197, 200) / 759, 759, 981, 778 / - DATA (WIDTHS(I, 20), I = 201, 204) / 759, 759, 759, 759 / - DATA (WIDTHS(I, 20), I = 205, 208) / 444, 444, 444, 444 / - DATA (WIDTHS(I, 20), I = 209, 212) / 833, 833, 833, 833 / - DATA (WIDTHS(I, 20), I = 213, 216) / 833, 833, 833, 606 / - DATA (WIDTHS(I, 20), I = 217, 220) / 833, 833, 833, 833 / - DATA (WIDTHS(I, 20), I = 221, 224) / 833, 722, 759, 611 / - DATA (WIDTHS(I, 20), I = 225, 228) / 611, 611, 611, 611 / - DATA (WIDTHS(I, 20), I = 229, 232) / 611, 611, 870, 556 / - DATA (WIDTHS(I, 20), I = 233, 236) / 574, 574, 574, 574 / - DATA (WIDTHS(I, 20), I = 237, 240) / 370, 370, 370, 370 / - DATA (WIDTHS(I, 20), I = 241, 244) / 611, 685, 611, 611 / - DATA (WIDTHS(I, 20), I = 245, 248) / 611, 611, 611, 606 / - DATA (WIDTHS(I, 20), I = 249, 252) / 611, 685, 685, 685 / - DATA (WIDTHS(I, 20), I = 253, 256) / 685, 611, 667, 611 / - DATA (WIDTHS(I, 21), I = 1, 4) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 5, 8) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 9, 12) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 13, 16) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 17, 20) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 21, 24) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 25, 28) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 29, 32) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 33, 36) / 287, 333, 400, 574 / - DATA (WIDTHS(I, 21), I = 37, 40) / 574, 889, 889, 259 / - DATA (WIDTHS(I, 21), I = 41, 44) / 407, 407, 500, 606 / - DATA (WIDTHS(I, 21), I = 45, 48) / 287, 606, 287, 278 / - DATA (WIDTHS(I, 21), I = 49, 52) / 574, 574, 574, 574 / - DATA (WIDTHS(I, 21), I = 53, 56) / 574, 574, 574, 574 / - DATA (WIDTHS(I, 21), I = 57, 60) / 574, 574, 287, 287 / - DATA (WIDTHS(I, 21), I = 61, 64) / 606, 606, 606, 481 / - DATA (WIDTHS(I, 21), I = 65, 68) / 747, 741, 759, 759 / - DATA (WIDTHS(I, 21), I = 69, 72) / 833, 741, 704, 815 / - DATA (WIDTHS(I, 21), I = 73, 76) / 870, 444, 667, 778 / - DATA (WIDTHS(I, 21), I = 77, 80) / 704, 944, 852, 833 / - DATA (WIDTHS(I, 21), I = 81, 84) / 741, 833, 796, 685 / - DATA (WIDTHS(I, 21), I = 85, 88) / 722, 833, 741, 944 / - DATA (WIDTHS(I, 21), I = 89, 92) / 741, 704, 704, 407 / - DATA (WIDTHS(I, 21), I = 93, 96) / 606, 407, 606, 500 / - DATA (WIDTHS(I, 21), I = 97, 100) / 259, 667, 611, 537 / - DATA (WIDTHS(I, 21), I = 101, 104) / 667, 519, 389, 611 / - DATA (WIDTHS(I, 21), I = 105, 108) / 685, 389, 370, 648 / - DATA (WIDTHS(I, 21), I = 109, 112) / 389, 944, 685, 574 / - DATA (WIDTHS(I, 21), I = 113, 116) / 648, 630, 519, 481 / - DATA (WIDTHS(I, 21), I = 117, 120) / 407, 685, 556, 833 / - DATA (WIDTHS(I, 21), I = 121, 124) / 574, 519, 519, 407 / - DATA (WIDTHS(I, 21), I = 125, 128) / 606, 407, 606, 287 / - DATA (WIDTHS(I, 21), I = 129, 132) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 133, 136) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 137, 140) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 141, 144) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 145, 148) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 149, 152) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 153, 156) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 157, 160) / 287, 287, 287, 287 / - DATA (WIDTHS(I, 21), I = 161, 164) / 287, 333, 574, 574 / - DATA (WIDTHS(I, 21), I = 165, 168) / 574, 574, 606, 500 / - DATA (WIDTHS(I, 21), I = 169, 172) / 333, 747, 412, 481 / - DATA (WIDTHS(I, 21), I = 173, 176) / 606, 333, 747, 333 / - DATA (WIDTHS(I, 21), I = 177, 180) / 400, 606, 344, 344 / - DATA (WIDTHS(I, 21), I = 181, 184) / 333, 685, 650, 287 / - DATA (WIDTHS(I, 21), I = 185, 188) / 333, 344, 356, 481 / - DATA (WIDTHS(I, 21), I = 189, 192) / 861, 861, 861, 481 / - DATA (WIDTHS(I, 21), I = 193, 196) / 741, 741, 741, 741 / - DATA (WIDTHS(I, 21), I = 197, 200) / 741, 741, 889, 759 / - DATA (WIDTHS(I, 21), I = 201, 204) / 741, 741, 741, 741 / - DATA (WIDTHS(I, 21), I = 205, 208) / 444, 444, 444, 444 / - DATA (WIDTHS(I, 21), I = 209, 212) / 833, 852, 833, 833 / - DATA (WIDTHS(I, 21), I = 213, 216) / 833, 833, 833, 606 / - DATA (WIDTHS(I, 21), I = 217, 220) / 833, 833, 833, 833 / - DATA (WIDTHS(I, 21), I = 221, 224) / 833, 704, 741, 574 / - DATA (WIDTHS(I, 21), I = 225, 228) / 667, 667, 667, 667 / - DATA (WIDTHS(I, 21), I = 229, 232) / 667, 667, 815, 537 / - DATA (WIDTHS(I, 21), I = 233, 236) / 519, 519, 519, 519 / - DATA (WIDTHS(I, 21), I = 237, 240) / 389, 389, 389, 389 / - DATA (WIDTHS(I, 21), I = 241, 244) / 574, 685, 574, 574 / - DATA (WIDTHS(I, 21), I = 245, 248) / 574, 574, 574, 606 / - DATA (WIDTHS(I, 21), I = 249, 252) / 574, 685, 685, 685 / - DATA (WIDTHS(I, 21), I = 253, 256) / 685, 519, 648, 519 / - DATA (WIDTHS(I, 22), I = 1, 4) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 5, 8) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 9, 12) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 13, 16) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 17, 20) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 21, 24) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 25, 28) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 29, 32) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 33, 36) / 277, 295, 309, 554 / - DATA (WIDTHS(I, 22), I = 37, 40) / 554, 775, 757, 351 / - DATA (WIDTHS(I, 22), I = 41, 44) / 369, 369, 425, 606 / - DATA (WIDTHS(I, 22), I = 45, 48) / 277, 606, 277, 437 / - DATA (WIDTHS(I, 22), I = 49, 52) / 554, 554, 554, 554 / - DATA (WIDTHS(I, 22), I = 53, 56) / 554, 554, 554, 554 / - DATA (WIDTHS(I, 22), I = 57, 60) / 554, 554, 277, 277 / - DATA (WIDTHS(I, 22), I = 61, 64) / 606, 606, 606, 591 / - DATA (WIDTHS(I, 22), I = 65, 68) / 867, 740, 574, 813 / - DATA (WIDTHS(I, 22), I = 69, 72) / 744, 536, 485, 872 / - DATA (WIDTHS(I, 22), I = 73, 76) / 683, 226, 482, 591 / - DATA (WIDTHS(I, 22), I = 77, 80) / 462, 919, 740, 869 / - DATA (WIDTHS(I, 22), I = 81, 84) / 592, 871, 607, 498 / - DATA (WIDTHS(I, 22), I = 85, 88) / 426, 655, 702, 960 / - DATA (WIDTHS(I, 22), I = 89, 92) / 609, 592, 480, 351 / - DATA (WIDTHS(I, 22), I = 93, 96) / 605, 351, 606, 500 / - DATA (WIDTHS(I, 22), I = 97, 100) / 351, 683, 682, 647 / - DATA (WIDTHS(I, 22), I = 101, 104) / 685, 650, 314, 673 / - DATA (WIDTHS(I, 22), I = 105, 108) / 610, 200, 203, 502 / - DATA (WIDTHS(I, 22), I = 109, 112) / 200, 938, 610, 655 / - DATA (WIDTHS(I, 22), I = 113, 116) / 682, 682, 301, 388 / - DATA (WIDTHS(I, 22), I = 117, 120) / 339, 608, 554, 831 / - DATA (WIDTHS(I, 22), I = 121, 124) / 480, 536, 425, 351 / - DATA (WIDTHS(I, 22), I = 125, 128) / 672, 351, 606, 277 / - DATA (WIDTHS(I, 22), I = 129, 132) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 133, 136) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 137, 140) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 141, 144) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 145, 148) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 149, 152) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 153, 156) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 157, 160) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 22), I = 161, 164) / 277, 295, 554, 554 / - DATA (WIDTHS(I, 22), I = 165, 168) / 554, 554, 672, 615 / - DATA (WIDTHS(I, 22), I = 169, 172) / 369, 747, 369, 425 / - DATA (WIDTHS(I, 22), I = 173, 176) / 606, 332, 747, 485 / - DATA (WIDTHS(I, 22), I = 177, 180) / 400, 606, 332, 332 / - DATA (WIDTHS(I, 22), I = 181, 184) / 375, 608, 564, 277 / - DATA (WIDTHS(I, 22), I = 185, 188) / 324, 332, 369, 425 / - DATA (WIDTHS(I, 22), I = 189, 192) / 831, 831, 831, 591 / - DATA (WIDTHS(I, 22), I = 193, 196) / 740, 740, 740, 740 / - DATA (WIDTHS(I, 22), I = 197, 200) / 740, 740, 992, 813 / - DATA (WIDTHS(I, 22), I = 201, 204) / 536, 536, 536, 536 / - DATA (WIDTHS(I, 22), I = 205, 208) / 226, 226, 226, 226 / - DATA (WIDTHS(I, 22), I = 209, 212) / 790, 740, 869, 869 / - DATA (WIDTHS(I, 22), I = 213, 216) / 869, 869, 869, 606 / - DATA (WIDTHS(I, 22), I = 217, 220) / 868, 655, 655, 655 / - DATA (WIDTHS(I, 22), I = 221, 224) / 655, 592, 592, 554 / - DATA (WIDTHS(I, 22), I = 225, 228) / 683, 683, 683, 683 / - DATA (WIDTHS(I, 22), I = 229, 232) / 683, 683, 1157, 647 / - DATA (WIDTHS(I, 22), I = 233, 236) / 650, 650, 650, 650 / - DATA (WIDTHS(I, 22), I = 237, 240) / 200, 200, 200, 200 / - DATA (WIDTHS(I, 22), I = 241, 244) / 655, 610, 655, 655 / - DATA (WIDTHS(I, 22), I = 245, 248) / 655, 655, 655, 606 / - DATA (WIDTHS(I, 22), I = 249, 252) / 653, 608, 608, 608 / - DATA (WIDTHS(I, 22), I = 253, 256) / 608, 536, 682, 536 / - DATA (WIDTHS(I, 23), I = 1, 4) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 5, 8) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 9, 12) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 13, 16) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 17, 20) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 21, 24) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 25, 28) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 29, 32) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 33, 36) / 277, 295, 309, 554 / - DATA (WIDTHS(I, 23), I = 37, 40) / 554, 775, 757, 351 / - DATA (WIDTHS(I, 23), I = 41, 44) / 369, 369, 425, 606 / - DATA (WIDTHS(I, 23), I = 45, 48) / 277, 606, 277, 437 / - DATA (WIDTHS(I, 23), I = 49, 52) / 554, 554, 554, 554 / - DATA (WIDTHS(I, 23), I = 53, 56) / 554, 554, 554, 554 / - DATA (WIDTHS(I, 23), I = 57, 60) / 554, 554, 277, 277 / - DATA (WIDTHS(I, 23), I = 61, 64) / 606, 606, 606, 591 / - DATA (WIDTHS(I, 23), I = 65, 68) / 867, 740, 574, 813 / - DATA (WIDTHS(I, 23), I = 69, 72) / 744, 536, 485, 872 / - DATA (WIDTHS(I, 23), I = 73, 76) / 683, 226, 482, 591 / - DATA (WIDTHS(I, 23), I = 77, 80) / 462, 919, 740, 869 / - DATA (WIDTHS(I, 23), I = 81, 84) / 592, 871, 607, 498 / - DATA (WIDTHS(I, 23), I = 85, 88) / 426, 655, 702, 960 / - DATA (WIDTHS(I, 23), I = 89, 92) / 609, 592, 480, 351 / - DATA (WIDTHS(I, 23), I = 93, 96) / 605, 351, 606, 500 / - DATA (WIDTHS(I, 23), I = 97, 100) / 351, 683, 682, 647 / - DATA (WIDTHS(I, 23), I = 101, 104) / 685, 650, 314, 673 / - DATA (WIDTHS(I, 23), I = 105, 108) / 610, 200, 203, 502 / - DATA (WIDTHS(I, 23), I = 109, 112) / 200, 938, 610, 655 / - DATA (WIDTHS(I, 23), I = 113, 116) / 682, 682, 301, 388 / - DATA (WIDTHS(I, 23), I = 117, 120) / 339, 608, 554, 831 / - DATA (WIDTHS(I, 23), I = 121, 124) / 480, 536, 425, 351 / - DATA (WIDTHS(I, 23), I = 125, 128) / 672, 351, 606, 277 / - DATA (WIDTHS(I, 23), I = 129, 132) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 133, 136) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 137, 140) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 141, 144) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 145, 148) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 149, 152) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 153, 156) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 157, 160) / 277, 277, 277, 277 / - DATA (WIDTHS(I, 23), I = 161, 164) / 277, 295, 554, 554 / - DATA (WIDTHS(I, 23), I = 165, 168) / 554, 554, 672, 615 / - DATA (WIDTHS(I, 23), I = 169, 172) / 369, 747, 369, 425 / - DATA (WIDTHS(I, 23), I = 173, 176) / 606, 332, 747, 485 / - DATA (WIDTHS(I, 23), I = 177, 180) / 400, 606, 332, 332 / - DATA (WIDTHS(I, 23), I = 181, 184) / 375, 608, 564, 277 / - DATA (WIDTHS(I, 23), I = 185, 188) / 324, 332, 369, 425 / - DATA (WIDTHS(I, 23), I = 189, 192) / 831, 831, 831, 591 / - DATA (WIDTHS(I, 23), I = 193, 196) / 740, 740, 740, 740 / - DATA (WIDTHS(I, 23), I = 197, 200) / 740, 740, 992, 813 / - DATA (WIDTHS(I, 23), I = 201, 204) / 536, 536, 536, 536 / - DATA (WIDTHS(I, 23), I = 205, 208) / 226, 226, 226, 226 / - DATA (WIDTHS(I, 23), I = 209, 212) / 790, 740, 869, 869 / - DATA (WIDTHS(I, 23), I = 213, 216) / 869, 869, 869, 606 / - DATA (WIDTHS(I, 23), I = 217, 220) / 868, 655, 655, 655 / - DATA (WIDTHS(I, 23), I = 221, 224) / 655, 592, 592, 554 / - DATA (WIDTHS(I, 23), I = 225, 228) / 683, 683, 683, 683 / - DATA (WIDTHS(I, 23), I = 229, 232) / 683, 683, 1157, 647 / - DATA (WIDTHS(I, 23), I = 233, 236) / 650, 650, 650, 650 / - DATA (WIDTHS(I, 23), I = 237, 240) / 200, 200, 200, 200 / - DATA (WIDTHS(I, 23), I = 241, 244) / 655, 610, 655, 655 / - DATA (WIDTHS(I, 23), I = 245, 248) / 655, 655, 655, 606 / - DATA (WIDTHS(I, 23), I = 249, 252) / 653, 608, 608, 608 / - DATA (WIDTHS(I, 23), I = 253, 256) / 608, 536, 682, 536 / - DATA (WIDTHS(I, 24), I = 1, 4) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 5, 8) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 9, 12) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 13, 16) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 17, 20) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 21, 24) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 25, 28) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 29, 32) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 33, 36) / 280, 280, 360, 560 / - DATA (WIDTHS(I, 24), I = 37, 40) / 560, 860, 680, 280 / - DATA (WIDTHS(I, 24), I = 41, 44) / 380, 380, 440, 600 / - DATA (WIDTHS(I, 24), I = 45, 48) / 280, 600, 280, 460 / - DATA (WIDTHS(I, 24), I = 49, 52) / 560, 560, 560, 560 / - DATA (WIDTHS(I, 24), I = 53, 56) / 560, 560, 560, 560 / - DATA (WIDTHS(I, 24), I = 57, 60) / 560, 560, 280, 280 / - DATA (WIDTHS(I, 24), I = 61, 64) / 600, 600, 600, 560 / - DATA (WIDTHS(I, 24), I = 65, 68) / 740, 740, 580, 780 / - DATA (WIDTHS(I, 24), I = 69, 72) / 700, 520, 480, 840 / - DATA (WIDTHS(I, 24), I = 73, 76) / 680, 280, 480, 620 / - DATA (WIDTHS(I, 24), I = 77, 80) / 440, 900, 740, 840 / - DATA (WIDTHS(I, 24), I = 81, 84) / 560, 840, 580, 520 / - DATA (WIDTHS(I, 24), I = 85, 88) / 420, 640, 700, 900 / - DATA (WIDTHS(I, 24), I = 89, 92) / 680, 620, 500, 320 / - DATA (WIDTHS(I, 24), I = 93, 96) / 640, 320, 600, 500 / - DATA (WIDTHS(I, 24), I = 97, 100) / 280, 660, 660, 640 / - DATA (WIDTHS(I, 24), I = 101, 104) / 660, 640, 280, 660 / - DATA (WIDTHS(I, 24), I = 105, 108) / 600, 240, 260, 580 / - DATA (WIDTHS(I, 24), I = 109, 112) / 240, 940, 600, 640 / - DATA (WIDTHS(I, 24), I = 113, 116) / 660, 660, 320, 440 / - DATA (WIDTHS(I, 24), I = 117, 120) / 300, 600, 560, 800 / - DATA (WIDTHS(I, 24), I = 121, 124) / 560, 580, 460, 340 / - DATA (WIDTHS(I, 24), I = 125, 128) / 600, 340, 600, 280 / - DATA (WIDTHS(I, 24), I = 129, 132) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 133, 136) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 137, 140) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 141, 144) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 145, 148) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 149, 152) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 153, 156) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 157, 160) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 161, 164) / 280, 280, 560, 560 / - DATA (WIDTHS(I, 24), I = 165, 168) / 560, 560, 600, 560 / - DATA (WIDTHS(I, 24), I = 169, 172) / 500, 740, 360, 460 / - DATA (WIDTHS(I, 24), I = 173, 176) / 600, 420, 740, 420 / - DATA (WIDTHS(I, 24), I = 177, 180) / 400, 600, 336, 336 / - DATA (WIDTHS(I, 24), I = 181, 184) / 420, 576, 600, 280 / - DATA (WIDTHS(I, 24), I = 185, 188) / 340, 336, 360, 460 / - DATA (WIDTHS(I, 24), I = 189, 192) / 840, 840, 840, 560 / - DATA (WIDTHS(I, 24), I = 193, 196) / 740, 740, 740, 740 / - DATA (WIDTHS(I, 24), I = 197, 200) / 740, 740, 900, 780 / - DATA (WIDTHS(I, 24), I = 201, 204) / 520, 520, 520, 520 / - DATA (WIDTHS(I, 24), I = 205, 208) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 24), I = 209, 212) / 742, 740, 840, 840 / - DATA (WIDTHS(I, 24), I = 213, 216) / 840, 840, 840, 600 / - DATA (WIDTHS(I, 24), I = 217, 220) / 840, 640, 640, 640 / - DATA (WIDTHS(I, 24), I = 221, 224) / 640, 620, 560, 600 / - DATA (WIDTHS(I, 24), I = 225, 228) / 660, 660, 660, 660 / - DATA (WIDTHS(I, 24), I = 229, 232) / 660, 660, 1080, 640 / - DATA (WIDTHS(I, 24), I = 233, 236) / 640, 640, 640, 640 / - DATA (WIDTHS(I, 24), I = 237, 240) / 240, 240, 240, 240 / - DATA (WIDTHS(I, 24), I = 241, 244) / 640, 600, 640, 640 / - DATA (WIDTHS(I, 24), I = 245, 248) / 640, 640, 640, 600 / - DATA (WIDTHS(I, 24), I = 249, 252) / 660, 600, 600, 600 / - DATA (WIDTHS(I, 24), I = 253, 256) / 600, 580, 660, 580 / - DATA (WIDTHS(I, 25), I = 1, 4) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 5, 8) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 9, 12) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 13, 16) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 17, 20) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 21, 24) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 25, 28) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 29, 32) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 33, 36) / 280, 280, 360, 560 / - DATA (WIDTHS(I, 25), I = 37, 40) / 560, 860, 680, 280 / - DATA (WIDTHS(I, 25), I = 41, 44) / 380, 380, 440, 600 / - DATA (WIDTHS(I, 25), I = 45, 48) / 280, 600, 280, 460 / - DATA (WIDTHS(I, 25), I = 49, 52) / 560, 560, 560, 560 / - DATA (WIDTHS(I, 25), I = 53, 56) / 560, 560, 560, 560 / - DATA (WIDTHS(I, 25), I = 57, 60) / 560, 560, 280, 280 / - DATA (WIDTHS(I, 25), I = 61, 64) / 600, 600, 600, 560 / - DATA (WIDTHS(I, 25), I = 65, 68) / 740, 740, 580, 780 / - DATA (WIDTHS(I, 25), I = 69, 72) / 700, 520, 480, 840 / - DATA (WIDTHS(I, 25), I = 73, 76) / 680, 280, 480, 620 / - DATA (WIDTHS(I, 25), I = 77, 80) / 440, 900, 740, 840 / - DATA (WIDTHS(I, 25), I = 81, 84) / 560, 840, 580, 520 / - DATA (WIDTHS(I, 25), I = 85, 88) / 420, 640, 700, 900 / - DATA (WIDTHS(I, 25), I = 89, 92) / 680, 620, 500, 320 / - DATA (WIDTHS(I, 25), I = 93, 96) / 640, 320, 600, 500 / - DATA (WIDTHS(I, 25), I = 97, 100) / 280, 660, 660, 640 / - DATA (WIDTHS(I, 25), I = 101, 104) / 660, 640, 280, 660 / - DATA (WIDTHS(I, 25), I = 105, 108) / 600, 240, 260, 580 / - DATA (WIDTHS(I, 25), I = 109, 112) / 240, 940, 600, 640 / - DATA (WIDTHS(I, 25), I = 113, 116) / 660, 660, 320, 440 / - DATA (WIDTHS(I, 25), I = 117, 120) / 300, 600, 560, 800 / - DATA (WIDTHS(I, 25), I = 121, 124) / 560, 580, 460, 340 / - DATA (WIDTHS(I, 25), I = 125, 128) / 600, 340, 600, 280 / - DATA (WIDTHS(I, 25), I = 129, 132) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 133, 136) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 137, 140) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 141, 144) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 145, 148) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 149, 152) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 153, 156) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 157, 160) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 161, 164) / 280, 280, 560, 560 / - DATA (WIDTHS(I, 25), I = 165, 168) / 560, 560, 600, 560 / - DATA (WIDTHS(I, 25), I = 169, 172) / 500, 740, 360, 460 / - DATA (WIDTHS(I, 25), I = 173, 176) / 600, 420, 740, 420 / - DATA (WIDTHS(I, 25), I = 177, 180) / 400, 600, 336, 336 / - DATA (WIDTHS(I, 25), I = 181, 184) / 420, 576, 600, 280 / - DATA (WIDTHS(I, 25), I = 185, 188) / 340, 336, 360, 460 / - DATA (WIDTHS(I, 25), I = 189, 192) / 840, 840, 840, 560 / - DATA (WIDTHS(I, 25), I = 193, 196) / 740, 740, 740, 740 / - DATA (WIDTHS(I, 25), I = 197, 200) / 740, 740, 900, 780 / - DATA (WIDTHS(I, 25), I = 201, 204) / 520, 520, 520, 520 / - DATA (WIDTHS(I, 25), I = 205, 208) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 25), I = 209, 212) / 742, 740, 840, 840 / - DATA (WIDTHS(I, 25), I = 213, 216) / 840, 840, 840, 600 / - DATA (WIDTHS(I, 25), I = 217, 220) / 840, 640, 640, 640 / - DATA (WIDTHS(I, 25), I = 221, 224) / 640, 620, 560, 600 / - DATA (WIDTHS(I, 25), I = 225, 228) / 660, 660, 660, 660 / - DATA (WIDTHS(I, 25), I = 229, 232) / 660, 660, 1080, 640 / - DATA (WIDTHS(I, 25), I = 233, 236) / 640, 640, 640, 640 / - DATA (WIDTHS(I, 25), I = 237, 240) / 240, 240, 240, 240 / - DATA (WIDTHS(I, 25), I = 241, 244) / 640, 600, 640, 640 / - DATA (WIDTHS(I, 25), I = 245, 248) / 640, 640, 640, 600 / - DATA (WIDTHS(I, 25), I = 249, 252) / 660, 600, 600, 600 / - DATA (WIDTHS(I, 25), I = 253, 256) / 600, 580, 660, 580 / - DATA (WIDTHS(I, 26), I = 1, 4) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 5, 8) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 9, 12) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 13, 16) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 17, 20) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 21, 24) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 25, 28) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 29, 32) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 33, 36) / 300, 300, 360, 600 / - DATA (WIDTHS(I, 26), I = 37, 40) / 600, 820, 800, 280 / - DATA (WIDTHS(I, 26), I = 41, 44) / 240, 240, 360, 660 / - DATA (WIDTHS(I, 26), I = 45, 48) / 300, 660, 300, 520 / - DATA (WIDTHS(I, 26), I = 49, 52) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 26), I = 53, 56) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 26), I = 57, 60) / 600, 600, 300, 300 / - DATA (WIDTHS(I, 26), I = 61, 64) / 660, 660, 660, 460 / - DATA (WIDTHS(I, 26), I = 65, 68) / 820, 720, 680, 720 / - DATA (WIDTHS(I, 26), I = 69, 72) / 740, 600, 560, 760 / - DATA (WIDTHS(I, 26), I = 73, 76) / 800, 260, 480, 700 / - DATA (WIDTHS(I, 26), I = 77, 80) / 600, 860, 740, 800 / - DATA (WIDTHS(I, 26), I = 81, 84) / 620, 800, 680, 600 / - DATA (WIDTHS(I, 26), I = 85, 88) / 640, 760, 700, 940 / - DATA (WIDTHS(I, 26), I = 89, 92) / 700, 700, 580, 240 / - DATA (WIDTHS(I, 26), I = 93, 96) / 600, 240, 660, 500 / - DATA (WIDTHS(I, 26), I = 97, 100) / 280, 500, 520, 460 / - DATA (WIDTHS(I, 26), I = 101, 104) / 520, 500, 300, 520 / - DATA (WIDTHS(I, 26), I = 105, 108) / 560, 240, 220, 500 / - DATA (WIDTHS(I, 26), I = 109, 112) / 220, 840, 560, 560 / - DATA (WIDTHS(I, 26), I = 113, 116) / 580, 520, 360, 400 / - DATA (WIDTHS(I, 26), I = 117, 120) / 300, 520, 460, 720 / - DATA (WIDTHS(I, 26), I = 121, 124) / 500, 480, 420, 300 / - DATA (WIDTHS(I, 26), I = 125, 128) / 660, 300, 660, 300 / - DATA (WIDTHS(I, 26), I = 129, 132) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 133, 136) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 137, 140) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 141, 144) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 145, 148) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 149, 152) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 153, 156) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 157, 160) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 26), I = 161, 164) / 300, 300, 600, 600 / - DATA (WIDTHS(I, 26), I = 165, 168) / 600, 600, 660, 520 / - DATA (WIDTHS(I, 26), I = 169, 172) / 460, 840, 400, 340 / - DATA (WIDTHS(I, 26), I = 173, 176) / 660, 300, 800, 380 / - DATA (WIDTHS(I, 26), I = 177, 180) / 400, 660, 360, 360 / - DATA (WIDTHS(I, 26), I = 181, 184) / 320, 520, 720, 300 / - DATA (WIDTHS(I, 26), I = 185, 188) / 300, 360, 400, 340 / - DATA (WIDTHS(I, 26), I = 189, 192) / 900, 900, 900, 460 / - DATA (WIDTHS(I, 26), I = 193, 196) / 720, 720, 720, 720 / - DATA (WIDTHS(I, 26), I = 197, 200) / 720, 720, 960, 720 / - DATA (WIDTHS(I, 26), I = 201, 204) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 26), I = 205, 208) / 260, 260, 260, 260 / - DATA (WIDTHS(I, 26), I = 209, 212) / 740, 740, 800, 800 / - DATA (WIDTHS(I, 26), I = 213, 216) / 800, 800, 800, 660 / - DATA (WIDTHS(I, 26), I = 217, 220) / 800, 760, 760, 760 / - DATA (WIDTHS(I, 26), I = 221, 224) / 760, 700, 620, 520 / - DATA (WIDTHS(I, 26), I = 225, 228) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 26), I = 229, 232) / 500, 500, 800, 460 / - DATA (WIDTHS(I, 26), I = 233, 236) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 26), I = 237, 240) / 240, 240, 240, 240 / - DATA (WIDTHS(I, 26), I = 241, 244) / 570, 560, 560, 560 / - DATA (WIDTHS(I, 26), I = 245, 248) / 560, 560, 560, 660 / - DATA (WIDTHS(I, 26), I = 249, 252) / 560, 520, 520, 520 / - DATA (WIDTHS(I, 26), I = 253, 256) / 520, 480, 580, 480 / - DATA (WIDTHS(I, 27), I = 1, 4) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 5, 8) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 9, 12) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 13, 16) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 17, 20) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 21, 24) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 25, 28) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 29, 32) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 33, 36) / 300, 300, 360, 600 / - DATA (WIDTHS(I, 27), I = 37, 40) / 600, 900, 820, 300 / - DATA (WIDTHS(I, 27), I = 41, 44) / 260, 260, 540, 660 / - DATA (WIDTHS(I, 27), I = 45, 48) / 300, 660, 300, 220 / - DATA (WIDTHS(I, 27), I = 49, 52) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 27), I = 53, 56) / 600, 600, 600, 600 / - DATA (WIDTHS(I, 27), I = 57, 60) / 600, 600, 300, 300 / - DATA (WIDTHS(I, 27), I = 61, 64) / 660, 660, 660, 420 / - DATA (WIDTHS(I, 27), I = 65, 68) / 820, 740, 680, 720 / - DATA (WIDTHS(I, 27), I = 69, 72) / 760, 660, 580, 760 / - DATA (WIDTHS(I, 27), I = 73, 76) / 820, 300, 500, 700 / - DATA (WIDTHS(I, 27), I = 77, 80) / 640, 880, 780, 780 / - DATA (WIDTHS(I, 27), I = 81, 84) / 640, 780, 700, 620 / - DATA (WIDTHS(I, 27), I = 85, 88) / 660, 760, 700, 980 / - DATA (WIDTHS(I, 27), I = 89, 92) / 740, 740, 580, 220 / - DATA (WIDTHS(I, 27), I = 93, 96) / 600, 220, 660, 500 / - DATA (WIDTHS(I, 27), I = 97, 100) / 300, 520, 540, 460 / - DATA (WIDTHS(I, 27), I = 101, 104) / 580, 500, 360, 520 / - DATA (WIDTHS(I, 27), I = 105, 108) / 580, 280, 260, 560 / - DATA (WIDTHS(I, 27), I = 109, 112) / 300, 880, 600, 560 / - DATA (WIDTHS(I, 27), I = 113, 116) / 580, 560, 400, 420 / - DATA (WIDTHS(I, 27), I = 117, 120) / 360, 580, 480, 720 / - DATA (WIDTHS(I, 27), I = 121, 124) / 540, 500, 460, 300 / - DATA (WIDTHS(I, 27), I = 125, 128) / 660, 300, 660, 300 / - DATA (WIDTHS(I, 27), I = 129, 132) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 133, 136) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 137, 140) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 141, 144) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 145, 148) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 149, 152) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 153, 156) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 157, 160) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 161, 164) / 300, 300, 600, 600 / - DATA (WIDTHS(I, 27), I = 165, 168) / 600, 600, 660, 560 / - DATA (WIDTHS(I, 27), I = 169, 172) / 360, 820, 400, 360 / - DATA (WIDTHS(I, 27), I = 173, 176) / 660, 260, 820, 300 / - DATA (WIDTHS(I, 27), I = 177, 180) / 400, 660, 360, 360 / - DATA (WIDTHS(I, 27), I = 181, 184) / 280, 580, 680, 300 / - DATA (WIDTHS(I, 27), I = 185, 188) / 380, 360, 400, 360 / - DATA (WIDTHS(I, 27), I = 189, 192) / 900, 900, 900, 420 / - DATA (WIDTHS(I, 27), I = 193, 196) / 740, 740, 740, 740 / - DATA (WIDTHS(I, 27), I = 197, 200) / 740, 740, 960, 720 / - DATA (WIDTHS(I, 27), I = 201, 204) / 660, 660, 660, 660 / - DATA (WIDTHS(I, 27), I = 205, 208) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 27), I = 209, 212) / 760, 780, 780, 780 / - DATA (WIDTHS(I, 27), I = 213, 216) / 780, 780, 780, 660 / - DATA (WIDTHS(I, 27), I = 217, 220) / 780, 760, 760, 760 / - DATA (WIDTHS(I, 27), I = 221, 224) / 760, 740, 640, 540 / - DATA (WIDTHS(I, 27), I = 225, 228) / 520, 520, 520, 520 / - DATA (WIDTHS(I, 27), I = 229, 232) / 520, 520, 820, 460 / - DATA (WIDTHS(I, 27), I = 233, 236) / 500, 500, 500, 500 / - DATA (WIDTHS(I, 27), I = 237, 240) / 280, 280, 280, 280 / - DATA (WIDTHS(I, 27), I = 241, 244) / 560, 600, 560, 560 / - DATA (WIDTHS(I, 27), I = 245, 248) / 560, 560, 560, 660 / - DATA (WIDTHS(I, 27), I = 249, 252) / 560, 580, 580, 580 / - DATA (WIDTHS(I, 27), I = 253, 256) / 580, 500, 580, 500 / - DATA (WIDTHS(I, 28), I = 1, 4) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 5, 8) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 9, 12) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 13, 16) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 17, 20) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 21, 24) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 25, 28) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 29, 32) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 33, 36) / 340, 360, 580, 680 / - DATA (WIDTHS(I, 28), I = 37, 40) / 680, 940, 840, 320 / - DATA (WIDTHS(I, 28), I = 41, 44) / 340, 340, 400, 660 / - DATA (WIDTHS(I, 28), I = 45, 48) / 340, 660, 340, 460 / - DATA (WIDTHS(I, 28), I = 49, 52) / 680, 680, 680, 680 / - DATA (WIDTHS(I, 28), I = 53, 56) / 680, 680, 680, 680 / - DATA (WIDTHS(I, 28), I = 57, 60) / 680, 680, 340, 340 / - DATA (WIDTHS(I, 28), I = 61, 64) / 660, 660, 660, 540 / - DATA (WIDTHS(I, 28), I = 65, 68) / 860, 740, 740, 760 / - DATA (WIDTHS(I, 28), I = 69, 72) / 820, 660, 620, 780 / - DATA (WIDTHS(I, 28), I = 73, 76) / 820, 340, 560, 780 / - DATA (WIDTHS(I, 28), I = 77, 80) / 600, 920, 760, 860 / - DATA (WIDTHS(I, 28), I = 81, 84) / 680, 860, 740, 680 / - DATA (WIDTHS(I, 28), I = 85, 88) / 680, 760, 740, 1000 / - DATA (WIDTHS(I, 28), I = 89, 92) / 740, 740, 620, 320 / - DATA (WIDTHS(I, 28), I = 93, 96) / 640, 320, 660, 500 / - DATA (WIDTHS(I, 28), I = 97, 100) / 320, 580, 620, 520 / - DATA (WIDTHS(I, 28), I = 101, 104) / 620, 560, 360, 600 / - DATA (WIDTHS(I, 28), I = 105, 108) / 620, 300, 300, 600 / - DATA (WIDTHS(I, 28), I = 109, 112) / 300, 920, 620, 620 / - DATA (WIDTHS(I, 28), I = 113, 116) / 640, 620, 440, 500 / - DATA (WIDTHS(I, 28), I = 117, 120) / 380, 620, 540, 800 / - DATA (WIDTHS(I, 28), I = 121, 124) / 560, 540, 500, 340 / - DATA (WIDTHS(I, 28), I = 125, 128) / 660, 340, 660, 340 / - DATA (WIDTHS(I, 28), I = 129, 132) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 133, 136) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 137, 140) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 141, 144) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 145, 148) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 149, 152) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 153, 156) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 157, 160) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 161, 164) / 340, 360, 680, 680 / - DATA (WIDTHS(I, 28), I = 165, 168) / 680, 680, 660, 600 / - DATA (WIDTHS(I, 28), I = 169, 172) / 540, 840, 440, 380 / - DATA (WIDTHS(I, 28), I = 173, 176) / 660, 340, 840, 440 / - DATA (WIDTHS(I, 28), I = 177, 180) / 400, 660, 408, 408 / - DATA (WIDTHS(I, 28), I = 181, 184) / 380, 620, 780, 340 / - DATA (WIDTHS(I, 28), I = 185, 188) / 340, 408, 440, 380 / - DATA (WIDTHS(I, 28), I = 189, 192) / 1020, 1020, 1020, 540 / - DATA (WIDTHS(I, 28), I = 193, 196) / 740, 740, 740, 740 / - DATA (WIDTHS(I, 28), I = 197, 200) / 740, 740, 1020, 760 / - DATA (WIDTHS(I, 28), I = 201, 204) / 660, 660, 660, 660 / - DATA (WIDTHS(I, 28), I = 205, 208) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 28), I = 209, 212) / 820, 760, 860, 860 / - DATA (WIDTHS(I, 28), I = 213, 216) / 860, 860, 860, 660 / - DATA (WIDTHS(I, 28), I = 217, 220) / 860, 760, 760, 760 / - DATA (WIDTHS(I, 28), I = 221, 224) / 760, 740, 680, 660 / - DATA (WIDTHS(I, 28), I = 225, 228) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 28), I = 229, 232) / 580, 580, 880, 520 / - DATA (WIDTHS(I, 28), I = 233, 236) / 560, 560, 560, 560 / - DATA (WIDTHS(I, 28), I = 237, 240) / 300, 300, 300, 300 / - DATA (WIDTHS(I, 28), I = 241, 244) / 660, 620, 620, 620 / - DATA (WIDTHS(I, 28), I = 245, 248) / 620, 620, 620, 660 / - DATA (WIDTHS(I, 28), I = 249, 252) / 620, 620, 620, 620 / - DATA (WIDTHS(I, 28), I = 253, 256) / 620, 540, 640, 540 / - DATA (WIDTHS(I, 29), I = 1, 4) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 5, 8) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 9, 12) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 13, 16) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 17, 20) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 21, 24) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 25, 28) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 29, 32) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 33, 36) / 340, 380, 580, 680 / - DATA (WIDTHS(I, 29), I = 37, 40) / 680, 900, 880, 320 / - DATA (WIDTHS(I, 29), I = 41, 44) / 360, 360, 680, 660 / - DATA (WIDTHS(I, 29), I = 45, 48) / 340, 660, 340, 420 / - DATA (WIDTHS(I, 29), I = 49, 52) / 680, 680, 680, 680 / - DATA (WIDTHS(I, 29), I = 53, 56) / 680, 680, 680, 680 / - DATA (WIDTHS(I, 29), I = 57, 60) / 680, 680, 320, 340 / - DATA (WIDTHS(I, 29), I = 61, 64) / 660, 660, 660, 520 / - DATA (WIDTHS(I, 29), I = 65, 68) / 860, 760, 780, 780 / - DATA (WIDTHS(I, 29), I = 69, 72) / 860, 700, 640, 820 / - DATA (WIDTHS(I, 29), I = 73, 76) / 880, 400, 600, 780 / - DATA (WIDTHS(I, 29), I = 77, 80) / 660, 960, 800, 860 / - DATA (WIDTHS(I, 29), I = 81, 84) / 720, 880, 780, 680 / - DATA (WIDTHS(I, 29), I = 85, 88) / 660, 800, 720, 1020 / - DATA (WIDTHS(I, 29), I = 89, 92) / 740, 740, 620, 340 / - DATA (WIDTHS(I, 29), I = 93, 96) / 660, 340, 660, 500 / - DATA (WIDTHS(I, 29), I = 97, 100) / 320, 640, 640, 540 / - DATA (WIDTHS(I, 29), I = 101, 104) / 680, 580, 420, 600 / - DATA (WIDTHS(I, 29), I = 105, 108) / 680, 340, 340, 600 / - DATA (WIDTHS(I, 29), I = 109, 112) / 360, 980, 680, 640 / - DATA (WIDTHS(I, 29), I = 113, 116) / 660, 640, 460, 520 / - DATA (WIDTHS(I, 29), I = 117, 120) / 420, 680, 580, 840 / - DATA (WIDTHS(I, 29), I = 121, 124) / 580, 560, 500, 340 / - DATA (WIDTHS(I, 29), I = 125, 128) / 660, 340, 660, 340 / - DATA (WIDTHS(I, 29), I = 129, 132) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 133, 136) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 137, 140) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 141, 144) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 145, 148) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 149, 152) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 153, 156) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 157, 160) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 161, 164) / 340, 380, 660, 680 / - DATA (WIDTHS(I, 29), I = 165, 168) / 680, 680, 660, 680 / - DATA (WIDTHS(I, 29), I = 169, 172) / 520, 840, 440, 460 / - DATA (WIDTHS(I, 29), I = 173, 176) / 660, 300, 840, 480 / - DATA (WIDTHS(I, 29), I = 177, 180) / 400, 660, 408, 408 / - DATA (WIDTHS(I, 29), I = 181, 184) / 320, 680, 660, 340 / - DATA (WIDTHS(I, 29), I = 185, 188) / 540, 408, 440, 460 / - DATA (WIDTHS(I, 29), I = 189, 192) / 1020, 1020, 1020, 520 / - DATA (WIDTHS(I, 29), I = 193, 196) / 760, 760, 760, 760 / - DATA (WIDTHS(I, 29), I = 197, 200) / 760, 760, 1000, 780 / - DATA (WIDTHS(I, 29), I = 201, 204) / 700, 700, 700, 700 / - DATA (WIDTHS(I, 29), I = 205, 208) / 400, 400, 400, 400 / - DATA (WIDTHS(I, 29), I = 209, 212) / 860, 800, 860, 860 / - DATA (WIDTHS(I, 29), I = 213, 216) / 860, 860, 860, 660 / - DATA (WIDTHS(I, 29), I = 217, 220) / 860, 800, 800, 800 / - DATA (WIDTHS(I, 29), I = 221, 224) / 800, 740, 720, 640 / - DATA (WIDTHS(I, 29), I = 225, 228) / 640, 640, 640, 640 / - DATA (WIDTHS(I, 29), I = 229, 232) / 640, 640, 900, 540 / - DATA (WIDTHS(I, 29), I = 233, 236) / 580, 580, 580, 580 / - DATA (WIDTHS(I, 29), I = 237, 240) / 340, 340, 340, 340 / - DATA (WIDTHS(I, 29), I = 241, 244) / 640, 680, 640, 640 / - DATA (WIDTHS(I, 29), I = 245, 248) / 640, 640, 640, 660 / - DATA (WIDTHS(I, 29), I = 249, 252) / 640, 680, 680, 680 / - DATA (WIDTHS(I, 29), I = 253, 256) / 680, 560, 660, 560 / - - DATA PSMAP / - * 22, 9, 5, 14, 18, 26, 13, 1, - * 24, 11, 7, 16, 20, 28, 13, 3, - * 23, 10, 6, 15, 19, 27, 13, 2, - * 25, 12, 8, 17, 21, 29, 13, 4 / - - DATA DESCEN / - * -217, -205, -205, -205, - * -207, -207, -207, -207, - * -157, -157, -142, -142, - * -205, - * -195, -195, -195, -195, - * -205, -205, -205, -205, - * -192, -192, -185, -185, - * -196, -193, -184, -195 / - - DATA CAPS / - * 662, 653, 676, 669, - * 718, 718, 718, 718, - * 562, 562, 562, 562, - * 667, - * 714, 714, 714, 714, - * 722, 722, 722, 722, - * 740, 740, 740, 740, - * 732, 733, 732, 732 / - - PSFONT = ABS(FONT) - IF (PSFONT .GE. 101 .AND. PSFONT .LE. 129) THEN - PSFONT = PSFONT - 100 - ELSE IF (PSFONT .GE. 1 .AND. PSFONT .LE. 32) THEN - PSFONT = PSMAP(PSFONT) - ELSE - PSFONT = 9 - END IF - - CODE = CH + 1 - - BUFF(1) = 0 - BUFF(2) = WIDTHS(CODE, PSFONT) - BUFF(3) = CAPS(PSFONT) - BUFF(4) = DESCEN(PSFONT) - BUFF(5) = 0 - BUFF(6) = BUFF(3) - BUFF(7) = BUFF(6) + 120 - - END - \ No newline at end of file diff -r -N -u gks/dos/GKSDDOS.FOR gli-gks/dos/GKSDDOS.FOR --- gks/dos/GKSDDOS.FOR 2000-11-21 07:16:45.000000000 -0500 +++ gli-gks/dos/GKSDDOS.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,1240 +0,0 @@ -C* -C* Copyright @ 1984 - 1994 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* - -$IF DEFINED(F77L3) - - SUBROUTINE GKDGA (FCTID, DX, DY, DIMX, IA, LR1, R1, LR2, R2, - * LC, CHARS) -C* GKS logical device driver for IBM PC w\ Lahey FORTRAN graphics library - - INTEGER LC, LR1, LR2 - INTEGER FCTID, DX, DY, DIMX, IA(3) - REAL R1(3), R2(3) - CHARACTER*(*) CHARS - - EXTERNAL GKDPL, GKDSCI, GKDFA - - INTEGER LTYPE, ICOLOR - INTEGER ERRIND, TNR, STYLE - - INTEGER IARRAY(9) - REAL RARRAY(7) - CHARACTER STRING*40 - - INTEGER NUMX, NUMY, NUMC - REAL YRES, MAXX, MAXY - - INTEGER ISTAT, NP - REAL X, Y - - SAVE - -C* include GKS symbol definitions - INCLUDE 'gksdefs.i' - -C* connection and type - INTEGER CONID -C* workstation state - INTEGER STATE -C* workstation transformation - REAL WINDOW(4), VIEWPT(4) - - GOTO (999, 999, 2, 3, 4, 5, 6, 999, 8, 999, - * 10, 999, 12, 13, 14, 15, 16, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 48, 999, - * 999, 999, 999, 999, 54, 55, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 81, 82, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999) FCTID+1 - - IF (LR1 .LT. 0 .OR. LR2 .LT. 0 .OR. LC .LT. 0) - * CALL GKDERR ('GKS: internal inconsistency') - GOTO 999 - -C* open workstation - 2 CONTINUE - CONID = IA(2) - - I1 = 0 - I2 = 1 - IMODE = 0 - CALL PLOTS (I1, I2, IMODE) - CALL FACTOR (1.0) - - CALL GRINFO (IARRAY, RARRAY, STRING) - YRES = 1.0/IARRAY(2) - MAXX = RARRAY(2) - MAXY = RARRAY(3) - NUMX = IARRAY(1) - NUMY = IARRAY(2) - NUMC = IARRAY(4) - -C* initialize colormap - CALL GKDICM (NUMC) - -C* set default workstation window - WINDOW(1) = 0. - WINDOW(2) = 1. - WINDOW(3) = 0. - WINDOW(4) = 1. - -C* set default workstation viewport - VIEWPT(1) = 0.032 - VIEWPT(2) = 0.224 - VIEWPT(3) = 0. - VIEWPT(4) = 0.192 - -C* set up device transformation - CALL GKDSDT (WINDOW, VIEWPT, MAXX, MAXY) - GOTO 999 - -C* close workstation - 3 CONTINUE - CALL PLOT (0, 0, 999) - GOTO 999 - -C* activate workstation - 4 CONTINUE - STATE = GACTIV - GOTO 999 - -C* deactivate workstation - 5 CONTINUE - STATE = GINACT - GOTO 999 - -C* clear workstation - 6 CONTINUE - CALL PLOT (0, 0, -999) - GOTO 999 - -C* update workstation - 8 CONTINUE - GOTO 999 - -C* message - 10 CONTINUE - WRITE (CONID, *) CHARS - GOTO 999 - -C* polyline - 12 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* inquire current normalization transformation - CALL GQCNTN (ERRIND, TNR) -C* set up device transformation - CALL GSDT (WINDOW, VIEWPT) -C* inquire current linewidth, and color index - CALL GQLN (ERRIND, LTYPE) - CALL GQPLCI (ERRIND, ICOLOR) - CALL GKDSCI (ICOLOR) - CALL GKDPL (IA(1), R1, R2, LTYPE, TNR) - END IF - GOTO 999 - -C* polymarker - 13 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* set up device transformation - CALL GSDT (WINDOW, VIEWPT) -C* inquire polymarker color index - CALL GQPMCI (ERRIND, ICOLOR) - CALL GKDSCI (ICOLOR) - CALL GPOLMK (IA(1), R1, R2, GKDPL) - END IF - GOTO 999 - -C* text - 14 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* set up device transformation - CALL GSDT (WINDOW, VIEWPT) - CALL GQTXCI (ERRIND, ICOLOR) - CALL GKDSCI (ICOLOR) - CALL GSIMTX (R1, R2, CHARS, GKDPL, GKDFA) - END IF - GOTO 999 - -C* fill area - 15 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* inquire current normalization transformation - CALL GQCNTN (ERRIND, TNR) -C* set up device transformation - CALL GSDT (WINDOW, VIEWPT) - CALL GQFACI (ERRIND, ICOLOR) - CALL GKDSCI (ICOLOR) -C* inquire current fill area interior style - CALL GQFAIS (ERRIND, STYLE) - IF (STYLE .NE. GSOLID) THEN - CALL GFILLA (IA(1), R1, R2, GKDPL, YRES) - ELSE - CALL GKDFA (IA(1), R1, R2, TNR) - END IF - END IF - GOTO 999 - -C* cell array - 16 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* set up device transformation - CALL GSDT (WINDOW, VIEWPT) - CALL GCELLA (R1(1), R1(2), R2(1), R2(2), DX, DY, - * DIMX, IA, GKDSCI, GKDFA) - END IF - GOTO 999 - -C* set color representation - 48 CONTINUE - I = IA(2) - IF (I.GE.0 .AND. I.LE.8) THEN - R = R1(1) - G = R1(2) - B = R1(3) - CALL GKDSCR (I, R, G, B) - END IF - GOTO 999 - -C* set workstation window - 54 CONTINUE - WINDOW(1) = R1(1) - WINDOW(2) = R1(2) - WINDOW(3) = R2(1) - WINDOW(4) = R2(2) - CALL GKDSDT (WINDOW, VIEWPT, MAXX, MAXY) - GOTO 999 - -C* set workstation viewport - 55 CONTINUE - VIEWPT(1) = R1(1) - VIEWPT(2) = R1(2) - VIEWPT(3) = R2(1) - VIEWPT(4) = R2(2) - CALL GKFVP (VIEWPT, 0.256, 0.192) - CALL GKDSDT (WINDOW, VIEWPT, MAXX, MAXY) - GOTO 999 - -C* request locator - 81 CONTINUE - IF (STATE .EQ. GACTIV) THEN - CALL GKDGIN (NUMX, NUMY, ISTAT, X, Y) - IA(1) = ISTAT - R1(1) = X - R2(1) = Y - END IF - GOTO 999 - -C* request stroke - 82 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* set up device transformation - CALL GSDT (WINDOW, VIEWPT) - NP = IA(3) - DO 8201 I = 1, NP - CALL GKDGIN (NUMX, NUMY, ISTAT, X, Y) - IF (ISTAT .NE. GOK) GOTO 8202 - R1(I) = X - R2(I) = Y - J = I-1 - IF (I .EQ. 1) THEN - J = 1 - R1(2) = X - R2(2) = Y - END IF - CALL GKDPL (2, R1(J), R2(J), GLSOLI, 0) - 8201 CONTINUE - 8202 IF (I .GT. 2) ISTAT = GOK - IA(1) = ISTAT - IA(3) = I-1 - END IF - - 999 RETURN - END - - - SUBROUTINE GKDPL (N, PX, PY, LTYPE, TNR) -C* polyline - - REAL PX(1), PY(1) - INTEGER N, LTYPE, TNR - - EXTERNAL GKDMOV, GKDDRW - -C* switch to the polyline utility - CALL GPOLIN (N, PX, PY, LTYPE, TNR, GKDMOV, GKDDRW) - - RETURN - END - - - SUBROUTINE GKDMOV (X, Y) -C* move - - EXTERNAL GKDVEC - - REAL X, Y - -C* switch to the move utility - CALL GMOVE (X, Y, GKDVEC) - - RETURN - END - - - SUBROUTINE GKDDRW (X, Y) -C* draw - - EXTERNAL GKDVEC, GKDCOD - REAL X, Y - -C* switch to the dashed line generator - CALL GDASH (X, Y, GKDVEC, GKDCOD) - - RETURN - END - - - SUBROUTINE GKDFA (N, PX, PY, TNR) -C* fill area - - REAL PX(1), PY(1) - INTEGER N, TNR - - EXTERNAL GKDBFA, GKDCFA - -C* switch to the polyline utility - CALL GPOLIN (N, PX, PY, 0, TNR, GKDBFA, GKDCFA) - CALL GKDEFA - - RETURN - END - - - SUBROUTINE GKDSDT (WN, VP, MAXX, MAXY) -C* set up device transformation - - INTEGER MAXBUF - PARAMETER (MAXBUF = 2000) - - REAL WN(4), VP(4), MAXX, MAXY - INTEGER NUMX, NUMY, ISTAT - REAL X, Y - - REAL A, B, C, D, E, F, G, H - INTEGER INTARY(9), IX, IY - INTEGER BUTTON, MOUSEX, MOUSEY - - REAL RX, RY, SCALEX, SCALEY - INTEGER N - REAL XARRAY(MAXBUF), YARRAY(MAXBUF) - - SAVE - -C* include GKS symbol definitions - INCLUDE 'gksdefs.i' - - DATA MOUSEX /-1/, MOUSEY /-1/ - - SCALEX = MAXX - SCALEY = MAXY - - E = (VP(2)-VP(1))/(WN(2)-WN(1)) - F = MAXX/0.256 - G = (VP(4)-VP(3))/(WN(4)-WN(3)) - H = MAXY/0.192 - - A = E*F - B = F*(VP(1)-WN(1)*E) - C = G*H - D = H*(VP(3)-WN(3)*G) - - RETURN - - - ENTRY GKDVEC (X, Y) -C* re-initialize vector drawing sequence - - RX = A*X+B - RY = C*Y+D - CALL PLOT (RX, RY, 3) - - RETURN - - - ENTRY GKDCOD (X, Y) - -C* device transformation - RX = A*X+B - RY = C*Y+D - CALL PLOT (RX, RY, 2) - - RETURN - - - ENTRY GKDBFA (X, Y) -C* begin fill area - - N = 0 - - ENTRY GKDCFA (X, Y) -C* continue fill area - - IF (N .EQ. MAXBUF) - * CALL GKDERR ('GKS: number of points exceeded') - - N = N + 1 - XARRAY(N) = A*X+B - YARRAY(N) = C*Y+D - - RETURN - - - ENTRY GKDEFA -C* end fill area - - CALL FILL (N, XARRAY, YARRAY) - - RETURN - - - ENTRY GKDGIN (NUMX, NUMY, ISTAT, X, Y) -C* graphic input - -C* check mouse - INTARY(1) = 0 - CALL INTRUP (INTARY, 51) - IF (INTARY(1) .NE. 65535) - * CALL GKDERR ('GKS: mouse not installed') - -C* show mouse - INTARY(1) = 1 - CALL INTRUP (INTARY, 51) - - IF (MOUSEX .GE. 0 .AND. MOUSEY .GE. 0) THEN -C* set mouse position - INTARY(1) = 4 - INTARY(3) = MOUSEX - INTARY(4) = MOUSEY - CALL INTRUP (INTARY, 51) - END IF - - BUTTON = 0 -C* get mouse position - 1 INTARY(1) = 3 - INTARY(2) = 1+2+4 - CALL INTRUP (INTARY, 51) - IF (BUTTON .EQ. 0) THEN - BUTTON = INTARY(2) - MOUSEX = INTARY(3) - MOUSEY = INTARY(4) - GOTO 1 - ELSE IF (INTARY(2) .NE. 0) THEN - GOTO 1 - END IF - -C* check mouse button - IF (BUTTON .EQ. 1) THEN - ISTAT = GOK - IX = MOUSEX - IY = MOUSEY - ELSE - ISTAT = GNONE - END IF - - IF (ISTAT .EQ. GOK) THEN - RX = SCALEX * IX / NUMX - RY = SCALEY * (NUMY-IY) / NUMY - X = (RX-B)/A - Y = (RY-D)/C - END IF - -C* hide mouse - INTARY(1) = 2 - CALL INTRUP (INTARY, 51) - - RETURN - END - - - SUBROUTINE GKDICM (NUMC) -C* initialize colormap - - INTEGER NUMC, ICOLOR - REAL R, G, B - - INTEGER NUMCOL, COLI - INTEGER ML(0:11), PALETT(0:15), CMAP(0:15) - - INTEGER CI - - SAVE - -C* colormap D W R G B C Y M R* G* B* C* Y* M* - DATA PALETT / 0,15,12,10, 9,11,14,13, 4, 2, 1, 3, 6, 5, 8, 7 / -C* map location - DATA ML / 4,10, 7,13, 2, 8, 6,12, 3, 9, 5,11 / - - NUMCOL = NUMC - DO 1, I = 0, 15 - CMAP(I) = MIN(PALETT(I), NUMCOL-1) - 1 CONTINUE - - COLI = 1 - CALL NEWPEN (CMAP(COLI)) - - RETURN - - - ENTRY GKDSCI (ICOLOR) -C* set color index - - IF (ICOLOR .GE. 8) THEN - CI = ML(MOD(ICOLOR-8,72)/6) - ELSE - CI = ICOLOR - END IF - - IF (CI .NE. COLI) THEN - CALL NEWPEN (CMAP(CI)) - COLI = CI - END IF - - RETURN - - - ENTRY GKDSCR (ICOLOR, R, G, B) -C* set color representation - - IF (ICOLOR .LT. 8 .AND. ICOLOR .LT. NUMCOL) THEN - CALL GKRMAP (ICOLOR, R, G, B, 8, PALETT, CMAP) - END IF - - RETURN - END - - - SUBROUTINE GKDERR (ERRMSG) -C* produce an error message and exit - - CHARACTER*(*) ERRMSG - - CALL PLOT (0, 0, 999) - WRITE (*,*) ERRMSG - STOP - - END - -$ELSE - -$IF .NOT. DEFINED(_MSFORTRAN_) -$DEFINE _MSFORTRAN_ = 100 -$ENDIF - -$IF _MSFORTRAN_ .LT. 300 - - INCLUDE 'FGRAPH.FI' - - INTERFACE TO SUBROUTINE INT86 [C] (INTR, INREG, OUTREG) - STRUCTURE /WREGS/ - INTEGER*2 AX, BX, CX, DX, SI, DI, CFLAG - END STRUCTURE - STRUCTURE /BREGS/ - INTEGER*1 AL, AH, BL, BH, CL, CH, DL, DH - END STRUCTURE - STRUCTURE /REGS/ - UNION - MAP - RECORD /WREGS/ X - END MAP - MAP - RECORD /BREGS/ H - END MAP - END UNION - END STRUCTURE - INTEGER*2 INTR [VALUE] - RECORD /REGS/ INREG [REFERENCE] - RECORD /REGS/ OUTREG [REFERENCE] - END -$ENDIF - - - SUBROUTINE GKDGA (FCTID, DX, DY, DIMX, IA, LR1, R1, LR2, R2, - * LC, CHARS) -C* GKS logical device driver for IBM PC w\ Microsoft FORTRAN graphics library - - INTEGER LC, LR1, LR2 - INTEGER FCTID, DX, DY, DIMX, IA(3) - REAL R1(3), R2(3) - CHARACTER*(*) CHARS - - EXTERNAL GKDPL, GKDSCI, GKDFA - - INTEGER I, LTYPE - INTEGER ICOLOR - INTEGER ERRIND, TNR - REAL R, G, B - INTEGER NUMX, NUMY, NUMC - - INTEGER ISTAT, NP - REAL X, Y - - SAVE - -C* include GKS symbol definitions - INCLUDE 'gksdefs.i' - - INCLUDE 'FGRAPH.FD' - -C* connection and type - INTEGER CONID -C* workstation state - INTEGER STATE -C* workstation transformation - REAL WINDOW(4), VIEWPT(4) - - INTEGER*2 STATUS - -C* video/window configuration - RECORD /VIDEOCONFIG/ SCREEN - - GOTO (999, 999, 2, 3, 4, 5, 6, 999, 8, 999, - * 10, 999, 12, 13, 14, 15, 16, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 48, 999, - * 999, 999, 999, 999, 54, 55, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 81, 82, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999) FCTID+1 - - IF (LR1 .LT. 0 .OR. LR2 .LT. 0 .OR. LC .LT. 0) - * CALL GKDERR ('GKS: internal inconsistency') - GOTO 999 - -C* open workstation - 2 CONTINUE - CONID = IA(2) - -$IF _MSFORTRAN_ .LT. 300 - STATUS = SETVIDEOMODE ($MAXRESMODE) - IF (STATUS .EQ. 0) CALL GKDERR ('GKS: cannot set graphics mode') -$ENDIF - CALL GETVIDEOCONFIG (SCREEN) - NUMX = SCREEN.NUMXPIXELS - NUMY = SCREEN.NUMYPIXELS - NUMC = SCREEN.NUMCOLORS - -C* initialize colormap - CALL GKDICM (NUMC) - -C* set default workstation window - WINDOW(1) = 0. - WINDOW(2) = 1. - WINDOW(3) = 0. - WINDOW(4) = 1. - -C* set default workstation viewport - VIEWPT(1) = 0.032 - VIEWPT(2) = 0.224 - VIEWPT(3) = 0. - VIEWPT(4) = 0.192 - -C* set up device transformation - CALL GKDSDT (WINDOW, VIEWPT, NUMX, NUMY) - GOTO 999 - -C* close workstation - 3 CONTINUE - STATUS = SETVIDEOMODE ($DEFAULTMODE) - GOTO 999 - -C* activate workstation - 4 CONTINUE - STATE = GACTIV - GOTO 999 - -C* deactivate workstation - 5 CONTINUE - STATE = GINACT - GOTO 999 - -C* clear workstation - 6 CONTINUE - CALL CLEARSCREEN ($GCLEARSCREEN) - GOTO 999 - -C* update workstation - 8 CONTINUE - GOTO 999 - -C* message - 10 CONTINUE - WRITE (CONID, *) CHARS - GOTO 999 - -C* polyline - 12 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* inquire current normalization transformation - CALL GQCNTN (ERRIND, TNR) -C* set up device transformation - CALL GSDT (WINDOW, VIEWPT) -C* inquire current linewidth, and color index - CALL GQLN (ERRIND, LTYPE) - CALL GQPLCI (ERRIND, ICOLOR) - CALL GKDSCI (ICOLOR) - CALL GKDPL (IA(1), R1, R2, LTYPE, TNR) - END IF - GOTO 999 - -C* polymarker - 13 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* set up device transformation - CALL GSDT (WINDOW, VIEWPT) -C* inquire polymarker color index - CALL GQPMCI (ERRIND, ICOLOR) - CALL GKDSCI (ICOLOR) - CALL GPOLMK (IA(1), R1, R2, GKDPL) - END IF - GOTO 999 - -C* text - 14 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* set up device transformation - CALL GSDT (WINDOW, VIEWPT) - CALL GQTXCI (ERRIND, ICOLOR) - CALL GKDSCI (ICOLOR) - CALL GSIMTX (R1, R2, CHARS, GKDPL, GKDFA) - END IF - GOTO 999 - -C* fill area - 15 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* inquire current normalization transformation - CALL GQCNTN (ERRIND, TNR) -C* set up device transformation - CALL GSDT (WINDOW, VIEWPT) - CALL GQFACI (ERRIND, ICOLOR) - CALL GKDSCI (ICOLOR) - CALL GKDFA (IA(1), R1, R2, TNR) - END IF - GOTO 999 - -C* cell array - 16 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* set up device transformation - CALL GSDT (WINDOW, VIEWPT) - CALL GCELLA (R1(1), R1(2), R2(1), R2(2), DX, DY, - * DIMX, IA, GKDSCI, GKDFA) - END IF - GOTO 999 - -C* set color representation - 48 CONTINUE - I = IA(2) - IF (I.GE.0 .AND. I.LE.8) THEN - R = R1(1) - G = R1(2) - B = R1(3) - CALL GKDSCR (I, R, G, B) - END IF - GOTO 999 - -C* set workstation window - 54 CONTINUE - WINDOW(1) = R1(1) - WINDOW(2) = R1(2) - WINDOW(3) = R2(1) - WINDOW(4) = R2(2) - CALL GKDSDT (WINDOW, VIEWPT, NUMX, NUMY) - GOTO 999 - -C* set workstation viewport - 55 CONTINUE - VIEWPT(1) = R1(1) - VIEWPT(2) = R1(2) - VIEWPT(3) = R2(1) - VIEWPT(4) = R2(2) - CALL GKFVP (VIEWPT, 0.256, 0.192) - CALL GKDSDT (WINDOW, VIEWPT, NUMX, NUMY) - GOTO 999 - -$IF _MSFORTRAN_ .LT. 300 - -C* request locator - 81 CONTINUE - IF (STATE .EQ. GACTIV) THEN - CALL GKDGIN (ISTAT, X, Y) - IA(1) = ISTAT - R1(1) = X - R2(1) = Y - END IF - GOTO 999 - -C* request stroke - 82 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* set up device transformation - CALL GSDT (WINDOW, VIEWPT) - NP = IA(3) - DO 8201 I = 1, NP - CALL GKDGIN (ISTAT, X, Y) - IF (ISTAT .NE. GOK) GOTO 8202 - R1(I) = X - R2(I) = Y - J = I-1 - IF (I .EQ. 1) THEN - J = 1 - R1(2) = X - R2(2) = Y - END IF - CALL GKDPL (2, R1(J), R2(J), GLSOLI, 0) - 8201 CONTINUE - 8202 IF (I .GT. 2) ISTAT = GOK - IA(1) = ISTAT - IA(3) = I-1 - END IF -$ELSE - 81 CONTINUE - 82 CONTINUE - IA(1) = GNONE -$ENDIF - - 999 RETURN - END - - - SUBROUTINE GKDPL (N, PX, PY, LTYPE, TNR) -C* polyline - - REAL PX(1), PY(1) - INTEGER N, LTYPE, TNR - - EXTERNAL GKDMOV, GKDDRW - -C* switch to the polyline utility - CALL GPOLIN (N, PX, PY, LTYPE, TNR, GKDMOV, GKDDRW) - - RETURN - END - - - SUBROUTINE GKDMOV (X, Y) -C* move - - EXTERNAL GKDVEC - - REAL X, Y - -C* switch to the move utility - CALL GMOVE (X, Y, GKDVEC) - - RETURN - END - - - SUBROUTINE GKDDRW (X, Y) -C* draw - - EXTERNAL GKDVEC, GKDCOD - REAL X, Y - -C* switch to the dashed line generator - CALL GDASH (X, Y, GKDVEC, GKDCOD) - - RETURN - END - - - SUBROUTINE GKDFA (N, PX, PY, TNR) -C* fill area - - REAL PX(1), PY(1) - INTEGER N, TNR - - EXTERNAL GKDBFA, GKDCFA - -C* switch to the polyline utility - CALL GPOLIN (N, PX, PY, 0, TNR, GKDBFA, GKDCFA) - CALL GKDEFA - - RETURN - END - - - SUBROUTINE GKDSDT (WN, VP, NUMX, NUMY) -C* set up device transformation - - INTEGER MAXBUF - PARAMETER (MAXBUF = 2000) - - INTEGER ZERO - PARAMETER (ZERO = 64) - - REAL WN(4), VP(4) - INTEGER NUMX, NUMY - REAL X, Y - INTEGER ISTAT - - REAL A, B, C, D, E, F, G, H - INTEGER ERRIND, STYLE, INDEX, PA(0:32) - INTEGER MAXX, MAXY - - SAVE - -C* include GKS symbol definitions - INCLUDE 'gksdefs.i' - - INCLUDE 'FGRAPH.FD' - - STRUCTURE /WREGS/ - INTEGER*2 AX, BX, CX, DX, SI, DI, CFLAG - END STRUCTURE - STRUCTURE /BREGS/ - INTEGER*1 AL, AH, BL, BH, CL, CH, DL, DH - END STRUCTURE - STRUCTURE /REGS/ - UNION - MAP - RECORD /WREGS/ X - END MAP - MAP - RECORD /BREGS/ H - END MAP - END UNION - END STRUCTURE - - INTEGER*2 INTR, STATUS, IX, IY, NP, CONTRL - INTEGER*1 OLDSTYLE(8), PATT(8) - RECORD /XYCOORD/ XY, POINTS(MAXBUF) - INTEGER*2 BUTTON, MOUSEX, MOUSEY, CROSSX, CROSSY - INTEGER*2 ASCII, SCANC - RECORD /REGS/ INREG, OUTREG - - DATA MOUSEX /-1/, MOUSEY /-1/ - - MAXX = NUMX - MAXY = NUMY - - E = (VP(2)-VP(1))/(WN(2)-WN(1)) - F = (NUMX-1)/0.256 - G = (VP(4)-VP(3))/(WN(4)-WN(3)) - H = (NUMY-1)/0.192 - - A = E*F - B = F*(VP(1)-WN(1)*E) - C = G*H - D = H*(VP(3)-WN(3)*G) - - RETURN - - - ENTRY GKDVEC (X, Y) -C* re-initialize vector drawing sequence - - IX = NINT(A*X+B) - IY = MAXY-NINT(C*Y+D) - CALL MOVETO (IX, IY, XY) - - RETURN - - - ENTRY GKDCOD (X, Y) - -C* device transformation - IX = NINT(A*X+B) - IY = MAXY-NINT(C*Y+D) - STATUS = LINETO (IX, IY) - - RETURN - - - ENTRY GKDBFA (X, Y) -C* begin fill area - - NP = 0 -C* inquire current fill area interior style - CALL GQFAIS (ERRIND, STYLE) -C* inquire current fill area style index - CALL GQFASI (ERRIND, INDEX) - - CALL GETFILLMASK (OLDSTYLE) - IF (STYLE .EQ. GHOLLO) THEN - CONTRL = $GBORDER - ELSE - CONTRL = $GFILLINTERIOR - IF (STYLE .EQ. GSOLID) THEN - INDEX = 0 - ELSE IF (STYLE .EQ. GHATCH) THEN - INDEX = INDEX + 108 - END IF - CALL GKQPA (INDEX, PA) - IF (PA(0) .EQ. 4) THEN - DO 10, I = 5,8 - PA(I) = PA(I-4) - 10 CONTINUE - END IF - DO 20, I = 1,8 - PATT(I) = NOT(PA(I)) - 20 CONTINUE - CALL SETFILLMASK (PATT) - END IF - - - ENTRY GKDCFA (X, Y) -C* continue fill area - - IF (NP .EQ. MAXBUF) - * CALL GKDERR ('GKS: number of points exceeded') - - NP = NP + 1 - POINTS(NP).XCOORD = NINT(A*X+B) - POINTS(NP).YCOORD = MAXY-NINT(C*Y+D) - - RETURN - - - ENTRY GKDEFA -C* end fill area - - STATUS = POLYGON (CONTRL, POINTS, NP) - CALL SETFILLMASK (OLDSTYLE) - - RETURN - - -$IF _MSFORTRAN_ .LT. 300 - - ENTRY GKDGIN (ISTAT, X, Y) -C* graphic input - -C* check mouse - INTR = 51 - INREG.X.AX = 0 - CALL INT86(INTR, INREG, OUTREG) - IF (OUTREG.X.AX .NE. -1) - * CALL GKDERR ('GKS: mouse not installed') - - IF (MOUSEX .GE. 0 .AND. MOUSEY .GE. 0) THEN -C* set mouse position - INTR = 51 - INREG.X.AX = 4 - INREG.X.CX = MOUSEX - INREG.X.DX = MOUSEY - CALL INT86(INTR, INREG, OUTREG) - END IF - - STATUS = SETWRITEMODE ($GXOR) - - CALL MOVETO (MOUSEX, 0, XY) - STATUS = LINETO (MOUSEX, MAXY) - CALL MOVETO (0, MOUSEY, XY) - STATUS = LINETO (MAXX, MOUSEY) - CROSSX = MOUSEX - CROSSY = MOUSEY - - BUTTON = 0 - 1 IF (MOUSEX .NE. CROSSX .OR. MOUSEY .NE. CROSSY) THEN - CALL MOVETO (CROSSX, 0, XY) - STATUS = LINETO (CROSSX, MAXY) - CALL MOVETO (0, CROSSY, XY) - STATUS = LINETO (MAXX, CROSSY) -C* update crosshair cursor - CALL MOVETO (MOUSEX, 0, XY) - STATUS = LINETO (MOUSEX, MAXY) - CALL MOVETO (0, MOUSEY, XY) - STATUS = LINETO (MAXX, MOUSEY) - CROSSX = MOUSEX - CROSSY = MOUSEY - END IF - -C* check keyboard buffer - INTR = 33 - INREG.H.AH = 11 - CALL INT86(INTR, INREG, OUTREG) - - IF (OUTREG.H.AL .NE. 0) THEN - INTR = 22 - INREG.H.AH = 0 - CALL INT86(INTR, INREG, OUTREG) - - ASCII = OUTREG.H.AL - IF (ASCII .EQ. 0) THEN -C* non-ASCII character - SCANC = OUTREG.H.AH -C* check for cursor key - IF (SCANC .EQ. 72) THEN - MOUSEY = CROSSY - 1 - ELSE IF (SCANC .EQ. 75) THEN - MOUSEX = CROSSX - 1 - ELSE IF (SCANC .EQ. 77) THEN - MOUSEX = CROSSX + 1 - ELSE IF (SCANC .EQ. 80) THEN - MOUSEY = CROSSY + 1 - END IF -C* set mouse position - INTR = 51 - INREG.X.AX = 4 - INREG.X.CX = MOUSEX - INREG.X.DX = MOUSEY - CALL INT86(INTR, INREG, OUTREG) - GOTO 1 - - ELSE IF (ASCII .EQ. 4 .OR. ASCII .EQ. 26) THEN -C* end-of-file character (CTRL/D, CTRL/Z) - BUTTON = 2 - ELSE - BUTTON = 1 - END IF - ELSE -C* get mouse position - INTR = 51 - INREG.X.AX = 3 - INREG.X.BX = 1+2+4 - CALL INT86(INTR, INREG, OUTREG) - - IF (BUTTON .EQ. 0) THEN - BUTTON = OUTREG.X.BX - MOUSEX = OUTREG.X.CX - MOUSEY = OUTREG.X.DX - GOTO 1 - ELSE IF (OUTREG.X.BX .NE. 0) THEN - GOTO 1 - END IF - END IF - -C* check mouse button - IF (BUTTON .EQ. 1) THEN - ISTAT = GOK - IX = MOUSEX - IY = MOUSEY - ELSE - ISTAT = GNONE - END IF - - IF (ISTAT .EQ. GOK) THEN - X = (IX-B)/A - Y = (MAXY-IY-D)/C - END IF - - CALL MOVETO (CROSSX, 0, XY) - STATUS = LINETO (CROSSX, MAXY) - CALL MOVETO (0, CROSSY, XY) - STATUS = LINETO (MAXX, CROSSY) - - STATUS = SETWRITEMODE ($GPSET) - - RETURN -$ENDIF - END - - - SUBROUTINE GKDICM (NUMC) -C* initialize colormap - - INTEGER NUMC, ICOLOR - REAL R, G, B - - INTEGER NUMCOL, COLI - INTEGER ML(0:11), PALETT(0:15), CMAP(0:15) - - INTEGER CI - INTEGER*2 STATUS - - SAVE - - INCLUDE 'FGRAPH.FD' - -C* colormap W D R G B C Y M R* G* B* C* Y* M* - DATA PALETT / 0,15,12,10, 9,11,14,13, 4, 2, 1, 3, 6, 5, 8, 7 / -C* map location - DATA ML / 4,10, 7,13, 2, 8, 6,12, 3, 9, 5,11 / - - NUMCOL = NUMC - IF (NUMCOL .GE. 16) THEN - STATUS = REMAPPALETTE ( 0, #3F3F3F) - STATUS = REMAPPALETTE (15, #000000) - END IF - - DO 1, I = 0, 15 - CMAP(I) = MIN(PALETT(I), NUMCOL-1) - 1 CONTINUE - - COLI = 1 - STATUS = SETCOLOR (CMAP(COLI)) - - RETURN - - - ENTRY GKDSCI (ICOLOR) -C* set color index - - IF (ICOLOR .GE. 8) THEN - CI = ML(MOD(ICOLOR-8,72)/6) - ELSE - CI = ICOLOR - END IF - - IF (CI .NE. COLI) THEN - STATUS = SETCOLOR (CMAP(CI)) - COLI = CI - END IF - - RETURN - - - ENTRY GKDSCR (ICOLOR, R, G, B) -C* set color representation - - IF (ICOLOR .LT. 8 .AND. ICOLOR .LT. NUMCOL) THEN - CALL GKRMAP (ICOLOR, R, G, B, 8, PALETT, CMAP) - END IF - - RETURN - END - - - SUBROUTINE GKDERR (ERRMSG) -C* produce an error message and exit - - CHARACTER*(*) ERRMSG - - INCLUDE 'FGRAPH.FD' - - INTEGER*2 STATUS - - STATUS = SETVIDEOMODE ($DEFAULTMODE) - WRITE (*,*) ERRMSG - STOP - - END - -$ENDIF - \ No newline at end of file diff -r -N -u gks/dos/GKSDEFS.I gli-gks/dos/GKSDEFS.I --- gks/dos/GKSDEFS.I 2000-11-21 07:16:46.000000000 -0500 +++ gli-gks/dos/GKSDEFS.I 1969-12-31 19:00:00.000000000 -0500 @@ -1,256 +0,0 @@ -C* -C* Copyright @ 1984 - 1993 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* -C* GKS Symbol Table - -C Mnemonic FORTRAN names and their values for GKS ENUMERATION type values - -C aspect source - INTEGER GBUNDL,GINDIV - PARAMETER (GBUNDL=0,GINDIV=1) - -C clear control flag - INTEGER GCONDI,GALWAY - PARAMETER (GCONDI=0,GALWAY=1) - -C clipping indicator - INTEGER GNCLIP,GCLIP - PARAMETER (GNCLIP=0,GCLIP=1) - -C colour available - INTEGER GMONOC,GCOLOR - PARAMETER (GMONOC=0,GCOLOR=1) - -C coordinate switch - INTEGER GWC,GNDC - PARAMETER (GWC=0,GNDC=1) - -C deferral mode - INTEGER GASAP,GBNIL,GBNIG,GASTI - PARAMETER (GASAP=0,GBNIL=1,GBNIG=2,GASTI=3) - -C detectability - INTEGER GUNDET,GDETEC - PARAMETER (GUNDET=0,GDETEC=1) - -C device coordinate units - INTEGER GMETRE,GOTHER - PARAMETER (GMETRE=0,GOTHER=1) - -C display surface empty - INTEGER GNEMPT,GEMPTY - PARAMETER (GNEMPT=0,GEMPTY=1) - -C dynamic modification - INTEGER GIRG,GIMM - PARAMETER (GIRG=0,GIMM=1) - -C echo switch - INTEGER GNECHO,GECHO - PARAMETER (GNECHO=0,GECHO=1) - -C fill area interior style - INTEGER GHOLLO,GSOLID,GPATTR,GHATCH - PARAMETER (GHOLLO=0,GSOLID=1,GPATTR=2,GHATCH=3) - -C highlighting - INTEGER GNORML,GHILIT - PARAMETER (GNORML=0,GHILIT=1) - -C input device status - INTEGER GNONE,GOK,GNPICK - PARAMETER (GNONE=0,GOK=1,GNPICK=2) - -C input class - INTEGER GNCLAS,GLOCAT,GSTROK,GVALUA,GCHOIC,GPICK,GSTRIN - PARAMETER (GNCLAS=0,GLOCAT=1,GSTROK=2,GVALUA=3,GCHOIC=4) - PARAMETER (GPICK=5,GSTRIN=6) - -C implicit regeneration mode - INTEGER GSUPPD,GALLOW - PARAMETER (GSUPPD=0,GALLOW=1) - -C level of GKS - INTEGER GL0A,GL0B,GL0C,GL1A,GL1B,GL1C,GL2A,GL2B,GL2C - PARAMETER (GL0A=0,GL0B=1,GL0C=2,GL1A=3,GL1B=4,GL1C=5) - PARAMETER (GL2A=6,GL2B=7,GL2C=8) - -C new frame action necessary - INTEGER GNO,GYES - PARAMETER (GNO=0,GYES=1) - -C operating mode - INTEGER GREQU,GSAMPL,GEVENT - PARAMETER (GREQU=0,GSAMPL=1,GEVENT=2) - -C operating state value - INTEGER GGKCL,GGKOP,GWSOP,GWSAC,GSGOP - PARAMETER (GGKCL=0,GGKOP=1,GWSOP=2,GWSAC=3,GSGOP=4) - -C presence of invalid values - INTEGER GABSNT,GPRSNT - PARAMETER (GABSNT=0,GPRSNT=1) - -C regeneration flag - INTEGER GSUPP,GPERFO - PARAMETER (GSUPP=0,GPERFO=1) - -C relative input priority - INTEGER GHIGHR,GLOWER - PARAMETER (GHIGHR=0,GLOWER=1) - -C simultaneous events flag - INTEGER GNMORE,GMORE - PARAMETER (GNMORE=0,GMORE=1) - -C text alignment horizontal - INTEGER GAHNOR,GALEFT,GACENT,GARITE - PARAMETER (GAHNOR=0,GALEFT=1,GACENT=2,GARITE=3) - -C text alignment vertical - INTEGER GAVNOR,GATOP,GACAP,GAHALF,GABASE,GABOTT - PARAMETER (GAVNOR=0,GATOP=1,GACAP=2,GAHALF=3,GABASE=4,GABOTT=5) - -C text path - INTEGER GRIGHT,GLEFT,GUP,GDOWN - PARAMETER (GRIGHT=0,GLEFT=1,GUP=2,GDOWN=3) - -C text precision - INTEGER GSTRP,GCHARP,GSTRKP - PARAMETER (GSTRP=0,GCHARP=1,GSTRKP=2) - -C type of returned values - INTEGER GSET,GREALI - PARAMETER (GSET=0,GREALI=1) - -C update state - INTEGER GNPEND,GPEND - PARAMETER (GNPEND=0,GPEND=1) - -C vector/raster/other type - INTEGER GVECTR,GRASTR,GOTHWK - PARAMETER (GVECTR=0,GRASTR=1,GOTHWK=2) - -C visibility - INTEGER GINVIS,GVISI - PARAMETER (GINVIS=0,GVISI=1) - -C workstation category - INTEGER GOUTPT,GINPUT,GOUTIN,GWISS,GMO,GMI - PARAMETER (GOUTPT=0,GINPUT=1,GOUTIN=2,GWISS=3,GMO=4,GMI=5) - -C workstation state - INTEGER GINACT,GACTIV - PARAMETER (GINACT=0,GACTIV=1) - -C list of GDP attributes - INTEGER GPLBND,GPMBND,GTXBND,GFABND - PARAMETER (GPLBND=0,GPMBND=1,GTXBND=2,GFABND=3) - -C line type - INTEGER GLSOLI,GLDASH,GLDOT,GLDASD - PARAMETER (GLSOLI=1,GLDASH=2,GLDOT=3,GLDASD=4) - -C marker type - INTEGER GPOINT,GPLUS,GAST,GOMARK,GXMARK - PARAMETER (GPOINT=1,GPLUS=2,GAST=3,GOMARK=4,GXMARK=5) - -C -C GKS functions - These names are used for error handling. The names -C are the same as the GKS function names except that -C the sentinel character 'G' is replaced by 'E'. - - INTEGER EOPKS,ECLKS,EOPWK,ECLWK - PARAMETER (EOPKS = 0,ECLKS = 1,EOPWK = 2,ECLWK = 3) - INTEGER EACWK,EDAWK,ECLRWK - PARAMETER (EACWK = 4,EDAWK = 5,ECLRWK= 6) - - INTEGER ERSGWK,EUWK,ESDS,EMSG - PARAMETER (ERSGWK= 7,EUWK = 8,ESDS = 9,EMSG = 10) - INTEGER EESC,EPL,EPM - PARAMETER (EESC = 11,EPL = 12,EPM = 13) - - INTEGER ETX,EFA,ECA,EGDP - PARAMETER (ETX = 14,EFA = 15,ECA = 16,EGDP = 17) - INTEGER ESPLI,ESLN,ESLWSC - PARAMETER (ESPLI = 18,ESLN = 19,ESLWSC= 20) - - INTEGER ESPLCI,ESPMI,ESMK,ESMKSC - PARAMETER (ESPLCI= 21,ESPMI = 22,ESMK = 23,ESMKSC= 24) - INTEGER ESPMCI,ESTXI,ESTXFP - PARAMETER (ESPMCI= 25,ESTXI = 26,ESTXFP= 27) - - INTEGER ESCHXP,ESCHSP,ESTXCI,ESCHH - PARAMETER (ESCHXP= 28,ESCHSP= 29,ESTXCI= 30,ESCHH = 31) - INTEGER ESCHUP,ESTXP,ESTXAL - PARAMETER (ESCHUP= 32,ESTXP = 33,ESTXAL= 34) - - INTEGER ESFAI,ESFAIS,ESFASI,ESFACI - PARAMETER (ESFAI = 35,ESFAIS= 36,ESFASI= 37,ESFACI= 38) - INTEGER ESPA,ESPARF,ESASF - PARAMETER (ESPA = 39,ESPARF= 40,ESASF = 41) - - INTEGER ESPKID,ESPLR,ESPMR,ESTXR - PARAMETER (ESPKID= 42,ESPLR = 43,ESPMR = 44,ESTXR = 45) - INTEGER ESFAR,ESPAR,ESCR - PARAMETER (ESFAR = 46,ESPAR = 47,ESCR = 48) - - INTEGER ESWN,ESVP,ESVPIP,ESELNT - PARAMETER (ESWN = 49,ESVP = 50,ESVPIP= 51,ESELNT= 52) - INTEGER ESCLIP,ESWKWN,ESWKVP - PARAMETER (ESCLIP= 53,ESWKWN= 54,ESWKVP= 55) - - INTEGER ECRSG,ECLSG,ERENSG,EDSG - PARAMETER (ECRSG = 56,ECLSG = 57,ERENSG= 58,EDSG = 59) - INTEGER EDSGWK,EASGWK,ECSGWK - PARAMETER (EDSGWK= 60,EASGWK= 61,ECSGWK= 62) - - INTEGER EINSG,ESSGT,ESVIS,ESHLIT - PARAMETER (EINSG = 63,ESSGT = 64,ESVIS = 65,ESHLIT= 66) - INTEGER ESSGP,ESDTEC,EINLC - PARAMETER (ESSGP = 67,ESDTEC= 68,EINLC = 69) - - INTEGER EINSK,EINVL,EINCH,EINPK - PARAMETER (EINSK = 70,EINVL = 71,EINCH = 72,EINPK = 73) - INTEGER EINST,ESLCM,ESSKM - PARAMETER (EINST = 74,ESLCM = 75,ESSKM = 76) - - INTEGER ESVLM,ESCHM,ESPKM,ESSTM - PARAMETER (ESVLM = 77,ESCHM = 78,ESPKM = 79,ESSTM = 80) - INTEGER ERQLC,ERQSK,ERQVL - PARAMETER (ERQLC = 81,ERQSK = 82,ERQVL = 83) - - INTEGER ERQCH,ERQPK,ERQST,ESMLC - PARAMETER (ERQCH = 84,ERQPK = 85,ERQST = 86,ESMLC = 87) - INTEGER ESMSK,ESMVL,ESMCH - PARAMETER (ESMSK = 88,ESMVL = 89,ESMCH = 90) - - INTEGER ESMPK,ESMST,EWAIT,EFLUSH - PARAMETER (ESMPK = 91,ESMST = 92,EWAIT = 93,EFLUSH= 94) - INTEGER EGTLC,EGTSK,EGTVL - PARAMETER (EGTLC = 95,EGTSK = 96,EGTVL = 97) - - INTEGER EGTCH,EGTPK,EGTST,EWITM - PARAMETER (EGTCH = 98,EGTPK = 99,EGTST =100,EWITM =101) - INTEGER EGTITM,ERDITM,EIITM - PARAMETER (EGTITM=102,ERDITM=103,EIITM =104) - - INTEGER EEVTM,EACTM - PARAMETER (EEVTM =105,EACTM=106) - \ No newline at end of file diff -r -N -u gks/dos/GKSDESCR.I gli-gks/dos/GKSDESCR.I --- gks/dos/GKSDESCR.I 2000-11-21 07:16:46.000000000 -0500 +++ gli-gks/dos/GKSDESCR.I 1969-12-31 19:00:00.000000000 -0500 @@ -1,40 +0,0 @@ -C* -C* Copyright @ 1984 - 1994 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* -C* GKS Description Table -C level of GKS - - INTEGER LEVEL - PARAMETER (LEVEL=GL0B) -C number of available workstation types - INTEGER NWSTY - PARAMETER (NWSTY=39) -C max. number of simult. open workstations - INTEGER MNOPWS - PARAMETER (MNOPWS=16) -C max. number of simult. active workstations - INTEGER MNACWS - PARAMETER (MNACWS=16) -C max. number of workstations associated with segment - INTEGER MNWSAS - PARAMETER (MNWSAS=1) -C maximum normalization transformation number - INTEGER MXNTNR - PARAMETER (MXNTNR=8) - \ No newline at end of file diff -r -N -u gks/dos/GKSDHPGL.FOR gli-gks/dos/GKSDHPGL.FOR --- gks/dos/GKSDHPGL.FOR 2000-11-21 07:16:45.000000000 -0500 +++ gli-gks/dos/GKSDHPGL.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,506 +0,0 @@ -C* -C* Copyright @ 1984 - 1993 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* - - SUBROUTINE GKDHP (FCTID,DX,DY,DIMX,IA,LR1,R1,LR2,R2,LC,CHARS) -C* GKS logical device handler for HP-GL devices - - INTEGER LC, LR1, LR2 - INTEGER FCTID,DX,DY,DIMX,IA(*) - REAL R1(*),R2(*) - CHARACTER*(*) CHARS - - EXTERNAL GKHPL,GKHSPL,GKHSFA - - REAL YRES - INTEGER ERRIND,TNR,COLI,STYLE,LTYPE,BORDER,NCHARS - LOGICAL EMPTY - - SAVE - -C* include GKS symbol definitions - INCLUDE 'gksdefs.i' - -C * Workstation State List -C connection and type - INTEGER CONID -C workstation state - INTEGER STATE -C workstation transformation - REAL WINDOW(4),VIEWPT(4) - - - GOTO (999,999, 2, 3, 4, 5, 6,999, 8,999, - * 999,999, 12, 13, 14, 15,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999, 54, 55,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999) FCTID+1 - - IF (LR1 .LT. 0 .OR. LR2 .LT. 0 .OR. LC .LT. 0 .OR. - * DX .LT. 0 .OR. DY .LT. 0 .OR. DIMX .LT. 0) - * STOP 'GKS: internal inconsistency' - GOTO 999 - -C* open workstation - 2 CONTINUE - CONID = IA(2) - -C* set up connection - CALL GKHSCO (CONID) - CALL GKHPB ( - * CHAR(27)//'.Y'//CHAR(27)//'.N;19:'//CHAR(27)//'.I;;17:PS4;' - * //'IN;') -C* select default pen - CALL GKHPEN (-1) - -C* set default workstation window - WINDOW(1) = 0. - WINDOW(2) = 1. - WINDOW(3) = 0. - WINDOW(4) = 1. - -C* set default workstation viewport - VIEWPT(1) = 0.046 - VIEWPT(2) = 0.226 - VIEWPT(3) = 0.005 - VIEWPT(4) = 0.185 - -C* set up device transformation - CALL GKHSDT (WINDOW,VIEWPT) - - EMPTY = .TRUE. - GOTO 999 - -C* close workstation - 3 CONTINUE -CCC CALL GKHPAC - CALL GKHPU (1) - CALL GKHPB ('AF;SP;') - CALL GKHU - GOTO 999 - -C* activate workstation - 4 CONTINUE - STATE = GACTIV - GOTO 999 - -C* deactivate workstation - 5 CONTINUE - STATE = GINACT - CALL GKHPU (1) - CALL GKHU - GOTO 999 - -C* clear workstation - 6 CONTINUE - IF (.NOT.EMPTY) THEN - CALL GKHPU (1) - CALL GKHPB ('AF;') - CALL GKHU - EMPTY = .TRUE. - END IF - GOTO 999 - -C* update workstation - 8 CONTINUE - CALL GKHPU (1) - CALL GKHU - GOTO 999 - -C* polyline - 12 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* inquire current normalization transformation - CALL GQCNTN (ERRIND,TNR) -C* set up device transformation - CALL GSDT (WINDOW,VIEWPT) -C* inquire line type, linewidth, and color index - CALL GQLN (ERRIND,LTYPE) - CALL GQPLCI (ERRIND,COLI) - CALL GKHPEN (COLI) -C* polyline - CALL GKHPL (IA(1),R1,R2,LTYPE,TNR) - CALL GKHPU (1) - EMPTY = .FALSE. - END IF - GOTO 999 - -C* polymarker - 13 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* set up device transformation - CALL GSDT (WINDOW,VIEWPT) -C* inquire current polymarker color index - CALL GQPMCI (ERRIND,COLI) - CALL GKHPEN (COLI) -C* polymarker - CALL GPOLMK (IA(1),R1,R2,GKHPL) - CALL GKHPU (1) - EMPTY = .FALSE. - END IF - GOTO 999 - -C* text - 14 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* set up device transformation - CALL GSDT (WINDOW,VIEWPT) -C* inquire current text color index - CALL GQTXCI (ERRIND,COLI) - CALL GKHPEN (COLI) -C* text - NCHARS = LEN(CHARS) - CALL GSIMTX (R1,R2,NCHARS,CHARS,GKHSPL,GKHSFA) - CALL GKHPU (1) - EMPTY = .FALSE. - END IF - GOTO 999 - -C* fill area - 15 CONTINUE - IF (STATE .EQ. GACTIV) THEN -C* inquire current normalization transformation - CALL GQCNTN (ERRIND,TNR) -C* set up device transformation - CALL GSDT (WINDOW,VIEWPT) -C* inquire current fill area color index - CALL GQFACI (ERRIND,COLI) - CALL GKHPEN (COLI) -C* inquire current fill area interior style - CALL GQFAIS (ERRIND,STYLE) - IF (STYLE .NE. GSOLID) THEN - YRES = 10.0/7600.0 - CALL GFILLA (IA(1),R1,R2,TNR,GKHPL,YRES) - ELSE - BORDER = 0 - CALL GKHPL (IA(1),R1,R2,BORDER,TNR) - END IF - CALL GKHPU (1) - EMPTY = .FALSE. - END IF - GOTO 999 - -C* set workstation window - 54 CONTINUE - WINDOW(1) = R1(1) - WINDOW(2) = R1(2) - WINDOW(3) = R2(1) - WINDOW(4) = R2(2) - CALL GKHSDT (WINDOW,VIEWPT) - GOTO 999 - -C* set workstation viewport - 55 CONTINUE - VIEWPT(1) = R1(1) - VIEWPT(2) = R1(2) - VIEWPT(3) = R2(1) - VIEWPT(4) = R2(2) - CALL GKHSDT (WINDOW,VIEWPT) - GOTO 999 - - 999 RETURN - END - - - SUBROUTINE GKHPL (N,PX,PY,LTYPE,TNR) -C* polyline - - REAL PX(N),PY(N) - INTEGER TNR - INTEGER LTYPE, N - - EXTERNAL GKHMOV,GKHDRW - -C* switch to the polyline utility - CALL GPOLIN (N,PX,PY,LTYPE,TNR,GKHMOV,GKHDRW) - - RETURN - END - - - SUBROUTINE GKHFA (N,PX,PY,TNR) -C* fill area - - INTEGER N - REAL PX(N),PY(N) - INTEGER TNR - - EXTERNAL GKHPL - - REAL YRES - -C* switch to the fill area utility - YRES = 10.0/7600.0 - CALL GFILLA (N,PX,PY,TNR,GKHPL,YRES) - - RETURN - END - - - SUBROUTINE GKHSPL (N,PX,PY,LTYPE,TNR) -C* solid polyline - - INTEGER N - REAL PX(N),PY(N) - INTEGER LTYPE,TNR - - EXTERNAL GKHVEC,GKHCOD - -C* switch to the solid polyline utility - CALL GPOLIN (N,PX,PY,LTYPE,TNR,GKHVEC,GKHCOD) - - RETURN - END - - - SUBROUTINE GKHSFA (N,PX,PY,TNR) -C* solid fill area - - INTEGER N - REAL PX(N),PY(N) - INTEGER TNR - - EXTERNAL GKHSPL - - REAL YRES - -C* switch to the solid fill area utility - YRES = 10.0/7600.0 - CALL GKSFA (N,PX,PY,TNR,GKHSPL,YRES) - - RETURN - END - - - SUBROUTINE GKHMOV (X,Y) -C* move routine - - EXTERNAL GKHVEC - REAL X, Y - -C* switch to the move utility - CALL GMOVE (X,Y,GKHVEC) - - RETURN - END - - - SUBROUTINE GKHDRW (X,Y) -C* draw routine - - EXTERNAL GKHVEC,GKHCOD - REAL X, Y - -C* switch to the dashed line generator - CALL GDASH (X,Y,GKHVEC,GKHCOD) - - RETURN - END - - - SUBROUTINE GKHSDT (WN,VP) -C* set up device transformation - - INTEGER IX, IY, JX, JY, L - REAL A, B, C, D, E, F, G, H, X, Y - REAL WN(4), VP(4) - - SAVE - - INCLUDE 'gksdefs.i' - - E = (VP(2)-VP(1))/(WN(2)-WN(1)) - F = 10870/0.272 - G = (VP(4)-VP(3))/(WN(4)-WN(3)) - H = 7600/0.19 - - A = E*F - B = F*(VP(1)-WN(1)*E) - C = G*H - D = H*(VP(3)-WN(3)*G) - - RETURN - - - ENTRY GKHDT (X,Y,JX,JY) - -C* device transformation - JX = NINT(A*X+B) - JY = NINT(C*Y+D) - - RETURN - - - ENTRY GKHVEC (X,Y) -C* re-initialize vector drawing sequence - - CALL GKHPU (1) - L = 0 - - - ENTRY GKHCOD (X,Y) - -C* device transformation - IX = NINT(A*X+B) - IY = NINT(C*Y+D) - - IF (L .EQ. 0) THEN - L = 1 - ELSE - IF (L .EQ. 1) CALL GKHPU (0) - L = 2 - END IF - CALL GKHPCH (IX,IY) - - RETURN - END - - - SUBROUTINE GKHPCH (IX,IY) -C* encode coordinates - - INTEGER IX, IY - CHARACTER XSTR*16,YSTR*16 - INTEGER XLEN,YLEN - - CALL GDEC (IX,XLEN,XSTR) - CALL GDEC (IY,YLEN,YSTR) - - CALL GKHPB ('PA'//XSTR(1:XLEN)//','//YSTR(1:YLEN)//';') - - RETURN - END - - - SUBROUTINE GKHPEN (COLI) -C* select pen - - INTEGER COLI - - CHARACTER STR*1 - INTEGER PEN - DATA PEN /0/ - - IF (COLI .NE. PEN) THEN - IF (COLI .LE. 8) THEN -C* select pen - PEN = ABS(COLI) - STR = CHAR(ICHAR('0')+PEN) - CALL GKHPU (-1) - CALL GKHPB ('SP'//STR//';') - END IF - END IF - - RETURN - END - - - SUBROUTINE GKHPU (STATE) -C* pen control - - INTEGER STATE - - INTEGER PENUP - DATA PENUP /0/ - - IF (STATE .NE. PENUP) THEN - IF (STATE .NE. 0) THEN - CALL GKHPB ('PU;') - PENUP = 1 - ELSE - CALL GKHPB ('PD;') - PENUP = 0 - END IF - END IF - - RETURN - END - - -CCC SUBROUTINE GKHPAC -CCC -CCC INTEGER NCHARS -CCC CHARACTER BUFFER*100 -CCC -CCC CALL GKINFO (NCHARS, BUFFER) -CCC -CCC IF (NCHARS .GT. 0) THEN -CCC CALL GKHPB ('SP1;PA0,0;LO11;SR0.5,1;SS;') -CCC CALL GKHPB ('LB'//BUFFER(1:24)//' BY '// -CCC * BUFFER(36:NCHARS)//CHAR(3)) -CCC CALL GKHPB ('PU;') -CCC END IF -CCC -CCC RETURN -CCC END - - - SUBROUTINE GKHSCO (ID) -C* set up connection - - INTEGER I, ID, IPNTR - CHARACTER*(*) BUFF - - CHARACTER IOBUFF*500 - INTEGER CONID - - SAVE - - DATA IPNTR /0/ - - CONID = ID - - RETURN - - - ENTRY GKHPB (BUFF) -C* pack buffer - - IF (LEN(BUFF)+2 .GT. 500-IPNTR) THEN -C* xfer buffer - CALL BUFOUT (CONID,IPNTR,IOBUFF) - IPNTR = 0 - END IF - - DO 1 I = 1,LEN(BUFF) - IPNTR = IPNTR+1 - IOBUFF(IPNTR:IPNTR) = BUFF(I:I) - 1 CONTINUE - - IPNTR = IPNTR+1 - IOBUFF(IPNTR:IPNTR) = CHAR(10) - - RETURN - - - ENTRY GKHU -C* update - - CALL BUFOUT (CONID,IPNTR,IOBUFF) - IPNTR = 0 - - RETURN - END - \ No newline at end of file diff -r -N -u gks/dos/GKSDIDD.FOR gli-gks/dos/GKSDIDD.FOR --- gks/dos/GKSDIDD.FOR 2000-11-21 07:16:45.000000000 -0500 +++ gli-gks/dos/GKSDIDD.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,215 +0,0 @@ -C* -C* Copyright @ 1984 - 1995 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* - - SUBROUTINE GKDDLK (FCTID,DX,DY,DIMX,IA,LRX,RX,LRY,RY,LC,CHARS) -C devive driver link routine - - INTEGER I, LC, LRX, LRY - INTEGER FCTID, DX, DY, DIMX, IA(*), ID - REAL RX(*), RY(*) - CHARACTER*(*) CHARS - - INTEGER OK - PARAMETER (OK = 0) - - SAVE -C GKS symbol definitions - INCLUDE 'gksdefs.i' -C GKS description table - INCLUDE 'gksdescr.i' -C GKS state list - INCLUDE 'gksstate.i' - - INTEGER WKID, IPTR(2) - LOGICAL ALL - DOUBLE PRECISION DALIGN - - EQUIVALENCE (DALIGN, IPTR(1)) - - DATA WKID /0/ - - CALL GERSET (OK, -1) - - KERNEL = .TRUE. - - GOTO (1000,1000,2000,2000,2000,2000,2000,1000,2000,1000, - * 2000,2000,1000,1000,1000,1000,1000,1000,1000,1000, - * 1000,1000,1000,1000,1000,1000,1000,1000,1000,1000, - * 1000,1000,1000,1000,1000,1000,1000,1000,1000,1000, - * 1000,1000,1000,1000,1000,1000,1000,1000,2000,1000, - * 1000,1000,1000,1000,2000,2000,1000,1000,1000,1000, - * 1000,1000,1000,1000,1000,1000,1000,1000,1000,2000, - * 1000,1000,1000,1000,1000,1000,1000,1000,1000,1000, - * 1000,2000,2000,1000,1000,1000,2000,1000,1000,1000, - * 1000,1000,1000,1000,1000,1000,1000,1000,1000,1000, - * 1000,1000,1000,1000,1000,1000,1000 ) FCTID+1 - GOTO 5000 - - 1000 CONTINUE - ALL = .TRUE. - GOTO 3000 - - 2000 CONTINUE - ALL = .FALSE. - - 3000 CONTINUE - - IF (NOPWS .GT. 0) THEN - - DO 4000 I = 1,NOPWS - - IF (ALL .OR. IA(1) .EQ. SOPWS(I,1)) THEN - - IF (WKID .NE. 0) THEN - IF (WKID .NE. SOPWS(I,1)) GOTO 4000 - END IF - - GOTO (4000, 201, - * 204, 207, 82, 51, - * 53, 72, 16, 17, - * 61, 62, 63, 64, - * 210, 211, 212, 213, - * 214, 215, 216, 217, - * 218, - * 230, 231, 232, 233, - * 7, 8, 5, 41, - * 38, 103, 104, 92, - * 2, 3, 101, 102), SOPWS(I,4) - GOTO 4000 - -C* TEKtronix 401x Series -C* TAB 132/15-G -C* Monterey MG200 -C* IBM PC -C* DIGITAL LN03 PLUS - 72 CONTINUE - 201 CONTINUE - 204 CONTINUE - 207 CONTINUE - 38 CALL GKDTK1 (FCTID,DX,DY,DIMX,IA,LRX,RX,LRY,RY,LC,CHARS) - GOTO 4000 - -C* TEKtronix 41xx Series - 82 CALL GKDTK2 (FCTID,DX,DY,DIMX,IA,LRX,RX,LRY,RY,LC,CHARS) - GOTO 4000 - -C* HP-GL - 51 CONTINUE - 53 CALL GKDHP (FCTID,DX,DY,DIMX,IA,LRX,RX,LRY,RY,LC,CHARS) - GOTO 4000 - -C* VT3xx - 16 CONTINUE - 17 CALL GKDVT3 (FCTID,DX,DY,DIMX,IA,LRX,RX,LRY,RY,LC,CHARS) - GOTO 4000 - -C* PostScript, Display PostScript, LJ250 - 61 CONTINUE - 62 CONTINUE - 63 CONTINUE - 64 CONTINUE - 92 CALL GKDPS (FCTID,DX,DY,DIMX,IA,LRX,RX,LRY,RY,LC,CHARS) - GOTO 4000 - -C* Adobe's Portable Document Format (PDF) - 101 CONTINUE - 102 IPTR(1) = SOPWS(I,5) - IPTR(2) = SOPWS(I,6) - CALL GKDPDF (FCTID,DX,DY,DIMX,IA,LRX,RX,LRY,RY, - * LC,CHARS,IPTR(1)) - GOTO 4000 - -C* X Windows (Xlib) - 210 CONTINUE - 211 CONTINUE - 212 CONTINUE - 213 CONTINUE - 214 CONTINUE - 215 CONTINUE - 216 CONTINUE - 217 CONTINUE - 218 CONTINUE - 230 CONTINUE - 231 CONTINUE - 232 CONTINUE - 233 IPTR(1) = SOPWS(I,5) - IPTR(2) = SOPWS(I,6) - CALL GKDXW (FCTID,DX,DY,DIMX,IA(1),LRX,RX(1),LRY,RY(1), - * LC,CHARS,IPTR(1)) - GOTO 4000 - -C* GKSM Output Metafile - 2 IPTR(1) = SOPWS(I,5) - IPTR(2) = SOPWS(I,6) - CALL GKDMFO (FCTID,DX,DY,DIMX,IA(1),LRX,RX(1),LRY,RY(1), - * LC,CHARS,IPTR(1)) - GOTO 4000 - -C* GKSM Input Metafile - 3 IPTR(1) = SOPWS(I,5) - IPTR(2) = SOPWS(I,6) - CALL GKDMFI (FCTID,DX,DY,DIMX,IA(1),LRX,RX(1),LRY,RY(1), - * LC,CHARS,IPTR(1)) - GOTO 4000 - -C* CGM (Computer Graphics Metafile) - 7 CONTINUE - 8 IPTR(1) = SOPWS(I,5) - IPTR(2) = SOPWS(I,6) - CALL GKDCGM (FCTID,DX,DY,DIMX,IA(1),LRX,RX(1),LRY,RY(1), - * LC,CHARS,IPTR(1)) - GOTO 4000 - -C* WISS (Workstation Independent Segment Storage) - 5 CALL GKDWIS (FCTID,DX,DY,DIMX,IA,LRX,RX,LRY,RY,LC,CHARS) - GOTO 4000 - -C* IBM PC w\ VGA -C* VAX UIS - 41 CALL GKDGA (FCTID,DX,DY,DIMX,IA(1),LRX,RX(1),LRY,RY(1), - * LC,CHARS) - GOTO 4000 - -C* PBM (Portable BitMap) - 103 CONTINUE - 104 CALL GKDBM (FCTID,DX,DY,DIMX,IA,LRX,RX,LRY,RY,LC,CHARS) - GOTO 4000 - - END IF - - 4000 CONTINUE - - END IF - - 5000 CONTINUE - - KERNEL = .FALSE. - - RETURN - - - ENTRY GKDSWK (ID) -C select workstation - - WKID = ID - - RETURN - END - \ No newline at end of file diff -r -N -u gks/dos/GKSDPBM.FOR gli-gks/dos/GKSDPBM.FOR --- gks/dos/GKSDPBM.FOR 2000-11-21 07:16:45.000000000 -0500 +++ gli-gks/dos/GKSDPBM.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,525 +0,0 @@ -C* -C* Copyright @ 1984 - 1995 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* - - SUBROUTINE GKDBM(FCTID, DX, DY, DIMX, IA, LR1, R1, LR2, R2, - * LC, CHARS) -C* GKS logical device driver for bitmap devices - - INTEGER LC, LR1, LR2 - INTEGER FCTID, DX, DY, DIMX, IA(*) - REAL R1(*), R2(*) - CHARACTER*(*) CHARS - - EXTERNAL GKBPL, GKBSPL, GKBSFA - - INTEGER BORDER, ICOLOR, LTYPE, NCHARS - REAL YRES - INTEGER ERRIND, TNR, CLEAR - - SAVE - -C* include GKS symbol definitons - INCLUDE 'gksdefs.i' - -C* connection identifier, workstation type - INTEGER CONID, WTYPE -C* workstation state - INTEGER STATE -C* workstation transformation - REAL WINDOW(4), VIEWPT(4) -C* resolution (dots/inch) - INTEGER DPI - - GOTO (999, 999, 2, 3, 4, 5, 6, 999, 999, 999, - * 999, 999, 12, 13, 14, 15, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 54, 55, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, - * 999, 999, 999, 999, 999, 999, 999) FCTID + 1 - - IF (DX .LT. 0 .OR. DY .LT. 0 .OR. DIMX .LT. 0 .OR. - * LR1 .LT. 0 .OR. LR2 .LT. 0 .OR. LC .LT. 0) - * STOP 'GKS: internal inconsistency' - GOTO 999 - -C* open workstation - 2 CONTINUE - CONID = IA(2) - WTYPE = IA(3) - -C* set up connection - CALL GKBSCO(CONID) - -C* set default workstation window - WINDOW(1) = 0. - WINDOW(2) = 1. - WINDOW(3) = 0. - WINDOW(4) = 1. - -C* set default workstation viewport - VIEWPT(1) = 0 - VIEWPT(2) = 0.2032 - VIEWPT(3) = 0. - VIEWPT(4) = VIEWPT(2) - - IF (WTYPE .EQ. 103) THEN - DPI = 72 - ELSE - DPI = 75 - END IF -C* set up device transformation - CALL GKBSDT(WINDOW, VIEWPT, DPI) - - CLEAR = 1 - GOTO 999 - -C* close workstation - 3 CONTINUE - IF (CLEAR .NE. 0) THEN - CALL GKBCBM - CLEAR = 0 - END IF - CALL GKBWBM - GOTO 999 - -C* activate workstation - 4 CONTINUE - STATE = GACTIV - GOTO 999 - -C* deactivate workstation - 5 CONTINUE - STATE = GINACT - GOTO 999 - -C* clear workstation - 6 CONTINUE - CLEAR = 1 - GOTO 999 - -C* polyline - 12 CONTINUE - IF (STATE .EQ. GACTIV) THEN - IF (CLEAR .NE. 0) THEN - CALL GKBCBM - CLEAR = 0 - END IF -C* inquire current normalization transformation - CALL GQCNTN(ERRIND, TNR) -C* set up device transformation - CALL GSDT(WINDOW, VIEWPT) -C* inquire current line type - CALL GQLN(ERRIND, LTYPE) -C* inquire polyline color index - CALL GQPLCI(ERRIND, ICOLOR) - CALL GKBSCI(ICOLOR) - CALL GKBPL(IA(1), R1, R2, LTYPE, TNR) - END IF - GOTO 999 - -C* polymarker - 13 CONTINUE - IF (STATE .EQ. GACTIV) THEN - IF (CLEAR .NE. 0) THEN - CALL GKBCBM - CLEAR = 0 - END IF -C* set up device transformation - CALL GSDT(WINDOW, VIEWPT) -C* inquire polymarker color index - CALL GQPMCI(ERRIND, ICOLOR) - CALL GKBSCI(ICOLOR) - CALL GPOLMK(IA(1), R1, R2, GKBPL) - END IF - GOTO 999 - -C* text - 14 CONTINUE - IF (STATE .EQ. GACTIV) THEN - IF (CLEAR .NE. 0) THEN - CALL GKBCBM - CLEAR = 0 - END IF -C* set up device transformation - CALL GSDT(WINDOW, VIEWPT) -C* inquire text color index - CALL GQTXCI(ERRIND, ICOLOR) - CALL GKBSCI(ICOLOR) - NCHARS = LEN(CHARS) - CALL GSIMTX(R1, R2, NCHARS, CHARS, GKBSPL, GKBSFA) - END IF - GOTO 999 - -C* fill area - 15 CONTINUE - IF (STATE .EQ. GACTIV) THEN - IF (CLEAR .NE. 0) THEN - CALL GKBCBM - CLEAR = 0 - END IF -C* inquire current normalization transformation - CALL GQCNTN(ERRIND, TNR) -C* set up device transformation - CALL GSDT(WINDOW, VIEWPT) -C* inquire fill area color index - CALL GQFACI(ERRIND, ICOLOR) - CALL GKBSCI(ICOLOR) - IF (ICOLOR .LE. 1) THEN - YRES = 1.0 / 600.0 - CALL GFILLA(IA(1), R1, R2, TNR, GKBPL, YRES) - ELSE - BORDER = 0 - CALL GKBPL(IA(1), R1, R2, BORDER, TNR) - END IF - END IF - GOTO 999 - -C* set workstation window - 54 CONTINUE - WINDOW(1) = R1(1) - WINDOW(2) = R1(2) - WINDOW(3) = R2(1) - WINDOW(4) = R2(2) - CALL GKBSDT(WINDOW, VIEWPT, DPI) - GOTO 999 - -C* set workstation viewport - 55 CONTINUE - VIEWPT(1) = R1(1) - VIEWPT(2) = R1(2) - VIEWPT(3) = R2(1) - VIEWPT(4) = R2(2) - CALL GKFVP(VIEWPT, 0.254, 0.2032) - CALL GKBSDT(WINDOW, VIEWPT, DPI) - GOTO 999 - - 999 RETURN - END - - - SUBROUTINE GKBPL(N, PX, PY, LTYPE, TNR) -C* polyline - - REAL PX(N), PY(N) - INTEGER N, LTYPE, TNR - - EXTERNAL GKBMOV, GKBDRW - -C* switch to the polyline utility - CALL GPOLIN(N, PX, PY, LTYPE, TNR, GKBMOV, GKBDRW) - - RETURN - END - - - SUBROUTINE GKBMOV(X, Y) -C* move - REAL X, Y - - EXTERNAL GKBVEC - -C* switch to the move utility - CALL GMOVE(X, Y, GKBVEC) - - RETURN - END - - - SUBROUTINE GKBDRW(X, Y) -C* draw - REAL X, Y - - EXTERNAL GKBVEC, GKBCOD - -C* switch to the dashed line generator - CALL GDASH(X, Y, GKBVEC, GKBCOD) - - RETURN - END - - - SUBROUTINE GKBSPL(N, PX, PY, LTYPE, TNR) -C* solid polyline - - REAL PX(N), PY(N) - INTEGER N, LTYPE, TNR - - EXTERNAL GKBVEC, GKBCOD - -C* switch to the polyline utility - CALL GPOLIN(N, PX, PY, LTYPE, TNR, GKBVEC, GKBCOD) - - RETURN - END - - - SUBROUTINE GKBFA(N, PX, PY, TNR) -C* fill area - - INTEGER N - REAL PX(N), PY(N) - INTEGER TNR - - REAL YRES - - EXTERNAL GKBPL - -C* switch to the fill area utility - YRES = 1.0 / 600.0 - CALL GFILLA(N, PX, PY, TNR, GKBPL, YRES) - - RETURN - END - - - SUBROUTINE GKBSFA(N, PX, PY, TNR) -C* solid fill area - - INTEGER N - REAL PX(N), PY(N) - INTEGER TNR - - REAL YRES - - EXTERNAL GKBPL - -C* switch to the solid fill area utility - YRES = 1.0 / 600.0 - CALL GKSFA(N, PX, PY, TNR, GKBPL, YRES) - - RETURN - END - - - SUBROUTINE GKBSDT(WN, VP, DPI) -C* set up device transformation - - REAL WN(4), VP(4) - INTEGER DPI, COLI - REAL X, Y - - REAL A, B, C, D, E, F, G, H - INTEGER VALUE, WIDTH, HEIGHT, X1, Y1, X2, Y2, TMP - INTEGER DX, XINC, DY, YINC, XPLOT, YPLOT, RUNC - LOGICAL LANDSC - - SAVE - - INCLUDE 'gksdefs.i' - - E = (VP(2) - VP(1)) / (WN(2) - WN(1)) - F = (DPI * 10 - 1) / 0.254 - G = (VP(4) - VP(3)) / (WN(4) - WN(3)) - H = (DPI * 8 - 1) / 0.2032 - - A = E * F - B = F * (VP(1) - WN(1) * E) - C = G * H - D = H * (VP(3) - WN(3) * G) - - WIDTH = MAX(MIN(NINT(A * (WN(2) - WN(1))) + 1, DPI * 10), 100) - HEIGHT = MAX(MIN(NINT(C * (WN(4) - WN(3))) + 1, DPI * 8), 100) - - LANDSC = (WIDTH .GT. DPI * 8) - IF (LANDSC) THEN - TMP = WIDTH - WIDTH = HEIGHT - HEIGHT = TMP - ELSE - C = -C - D = HEIGHT - D - 1 - END IF - - CALL GKBSBM(WIDTH, HEIGHT) - - RETURN - - - ENTRY GKBSCI(COLI) -C* set color index - - IF (COLI .GE. 1) THEN - VALUE = 1 - ELSE - VALUE = 0 - END IF - - RETURN - - - ENTRY GKBVEC(X, Y) -C* re-initialize vector drawing sequence - - X1 = INT(A * X + B) - Y1 = INT(C * Y + D) - IF (LANDSC) THEN - TMP = X1 - X1 = Y1 - Y1 = TMP - END IF - - RETURN - - - ENTRY GKBCOD(X, Y) - -C* device transformation - X2 = INT(A * X + B) - Y2 = INT(C * Y + D) - IF (LANDSC) THEN - TMP = X2 - X2 = Y2 - Y2 = TMP - END IF - - RUNC = 0 - DX = ABS(X1 - X2) - IF (X2 .GT. X1) XINC = 1 - IF (X2 .EQ. X1) XINC = 0 - IF (X2 .LT. X1) XINC = -1 - DY = ABS(Y1 - Y2) - IF (Y2 .GT. Y1) YINC = 1 - IF (Y2 .EQ. Y1) YINC = 0 - IF (Y2 .LT. Y1) YINC = -1 - XPLOT = X1 - YPLOT = Y1 - - IF (DX .GT. DY) THEN -C* iterate x - CALL GKBSP(XPLOT, YPLOT, VALUE) - 1 IF (XPLOT .NE. X2) THEN - XPLOT = XPLOT + XINC - RUNC = RUNC + DY - IF (RUNC .GE. DX - RUNC) THEN - YPLOT = YPLOT + YINC - RUNC = RUNC - DX - END IF - CALL GKBSP(XPLOT, YPLOT, VALUE) - GOTO 1 - END IF - ELSE -C* iterate y - CALL GKBSP(XPLOT, YPLOT, VALUE) - 2 IF (YPLOT .NE. Y2) THEN - YPLOT = YPLOT + YINC - RUNC = RUNC + DX - IF (RUNC .GE. DY - RUNC) THEN - XPLOT = XPLOT +XINC - RUNC = RUNC - DY - END IF - CALL GKBSP(XPLOT, YPLOT, VALUE) - GOTO 2 - END IF - END IF - - X1 = X2 - Y1 = Y2 - - RETURN - END - - - SUBROUTINE GKBSCO(ID) -C* set connection identifier - - INTEGER ID - INTEGER X, Y, VALUE - - INTEGER SIZE - PARAMETER (SIZE = 750 * 600 / 8) - - INTEGER CONID, WIDTH, HEIGHT, COLS, NBYTES - CHARACTER*1 BITMAP(-10:SIZE) - INTEGER J, K, MASK, BITS(0:7), LW, LH - CHARACTER LF, BACK, W*8, H*8, HEADER*11 - - SAVE - - DATA BITS /128, 64, 32, 16, 8, 4, 2, 1/ - - CONID = ID - - LF = CHAR(10) - BACK = CHAR(0) - - RETURN - - - ENTRY GKBSBM(X, Y) -C* set bitmap - - WIDTH = X - HEIGHT = Y - X = 8 * INT(X / 8.0 + 0.9) - Y = 8 * INT(Y / 8.0 + 0.9) - COLS = X - NBYTES = MIN(X * Y / 8, SIZE) - - RETURN - - - ENTRY GKBCBM -C* clear bitmap - - DO 1, K = 1, NBYTES - BITMAP(K) = BACK - 1 CONTINUE - - RETURN - - - ENTRY GKBSP(X, Y, VALUE) -C* set pixel - - J = Y * COLS + X - K = J / 8 + 1 - IF (K .GE. 1 .AND. K .LE. NBYTES) THEN - MASK = BITS(MOD(J, 8)) - IF (VALUE .NE. 0) THEN - BITMAP(K) = CHAR(IOR(ICHAR(BITMAP(K)), MASK)) - ELSE - BITMAP(K) = CHAR(IAND(ICHAR(BITMAP(K)), 255 - MASK)) - END IF - END IF - - RETURN - - - ENTRY GKBWBM -C* write bitmap - - CALL GDEC(WIDTH, LW, W) - CALL GDEC(HEIGHT, LH, H) - - HEADER = 'P4'//LF//W(1:LW)//' '//H(1:LH)//LF - DO 2, K = 1, 11 - BITMAP(K - 11) = HEADER(K:K) - 2 CONTINUE - - CALL BINOUT(CONID, 11 + NBYTES, BITMAP) - - RETURN - END - \ No newline at end of file diff -r -N -u gks/dos/GKSDPS.FOR gli-gks/dos/GKSDPS.FOR --- gks/dos/GKSDPS.FOR 2000-11-21 07:16:45.000000000 -0500 +++ gli-gks/dos/GKSDPS.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,1706 +0,0 @@ -C* -C* Copyright @ 1984 - 1995 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* - - SUBROUTINE GKDPS (FCTID,DX,DY,DIMX,IA,LR1,R1,LR2,R2,LC,CHARS) -C* GKS logical device driver for PostScript printers - - INTEGER LC, LR1, LR2 - INTEGER FCTID,DX,DY,DIMX,IA(3) - REAL R1(3),R2(3) - CHARACTER*(*) CHARS - - REAL PI - PARAMETER (PI = 3.141592) - - EXTERNAL GKPPL,GKPPM,GKPFA,GKPTX - - INTEGER ERRIND,TNR,STYLE,COLI,PATTRN,FONT,PREC,LTYPE - REAL YRES,WIDTH,SIZE,FACTOR,X,Y,ANGLE - LOGICAL EMPTY,INIT - INTEGER LPAGE,PAGES - - CHARACTER PAGE*8 - - SAVE - -C* include GKS symbol definitions - INCLUDE 'gksdefs.i' - -C * Workstation State List -C connection and type - INTEGER CONID, WTYPE -C workstation state - INTEGER STATE -C workstation transformation - REAL WINDOW(4),VIEWPT(4) - INTEGER HEIGHT - - - GOTO (999,999, 2, 3, 4, 5, 6,999, 8,999, - * 999,999, 12, 13, 14, 15, 16,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999, 48,999, - * 999,999,999,999, 54, 55,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999) FCTID+1 - - IF (LR1 .LT. 0 .OR. LR2 .LT. 0 .OR. LC .LT. 0) - * STOP 'GKS: internal inconsistency' - GOTO 999 - -C* open workstation - 2 CONTINUE - CONID = IA(2) - WTYPE = IA(3) - -C* initialize color table - CALL GKPICT -C* set up connection - CALL GKPSCO (CONID,WTYPE) - -C* set default workstation window - WINDOW(1) = 0. - WINDOW(2) = 1. - WINDOW(3) = 0. - WINDOW(4) = 1. - -C* set default workstation viewport - VIEWPT(1) = 0. - IF (WTYPE .EQ. 92) THEN - VIEWPT(2) = 0.2032 - ELSE - VIEWPT(2) = 0.19685 - END IF - VIEWPT(3) = 0. - VIEWPT(4) = VIEWPT(2) - -C* set up device transformation - CALL GKPSDT (WINDOW,VIEWPT,HEIGHT,WTYPE) - - PAGES = 0 - INIT = .FALSE. - EMPTY = .TRUE. - GOTO 999 - -C* close workstation - 3 CONTINUE - IF (INIT) THEN - IF (.NOT.EMPTY) THEN - IF (WTYPE .LT. 63) THEN - CALL GKPPB ('showpage') - END IF - END IF - CALL GKPPB ('psl restore end % GLI_GKS_dict') - CALL GKPEP (PAGES) - CALL GKPPB ('%%Trailer') - CALL GKPPB ('GLI_GKS_save restore') - END IF - IF (PAGES .GT. 0) THEN - CALL GDEC (PAGES,LPAGE,PAGE) - CALL GKPPB ('%%Pages: '//PAGE(1:LPAGE)) - ELSE IF (WTYPE .LT. 63) THEN - CALL GKPHDR - CALL GKPPB ('%%Trailer') - CALL GKPPB ('%%Pages: (none)') - END IF - CALL GKPU - IF (WTYPE .GE. 63) CALL DPSCL - GOTO 999 - -C* activate workstation - 4 CONTINUE - STATE = GACTIV - GOTO 999 - -C* deactivate workstation - 5 CONTINUE - STATE = GINACT - GOTO 999 - -C* clear workstation - 6 CONTINUE - IF (INIT) THEN - IF (.NOT.EMPTY) THEN - IF (WTYPE .LT. 63) THEN - CALL GKPPB ('showpage') - END IF - EMPTY = .TRUE. - END IF - CALL GKPPB ('psl restore end % GLI_GKS_dict') - CALL GKPEP (PAGES) - INIT = .FALSE. - END IF - GOTO 999 - -C* update workstation - 8 CONTINUE - CALL GKPU - GOTO 999 - -C* polyline - 12 CONTINUE - IF (STATE .EQ. GACTIV) THEN - IF (.NOT.INIT) THEN - CALL GKPINI (WTYPE,WINDOW,VIEWPT,HEIGHT,PAGES) - INIT = .TRUE. - END IF -C* inquire current normalization transformation - CALL GQCNTN (ERRIND,TNR) -C* set up device transformation - CALL GSDT (WINDOW,VIEWPT) -C* inquire current line type - CALL GQLN (ERRIND,LTYPE) - IF (LTYPE .NE. GLSOLI) CALL GKPSLN (LTYPE) -C* inquire linewidth scale factor - CALL GQLWSC (ERRIND,WIDTH) - CALL GKPSLW (WIDTH) -C* inquire polyline color index - CALL GQPLCI (ERRIND,COLI) - CALL GKPSCI (COLI,WTYPE) -C* polyline - CALL GKPPL (IA(1),R1,R2,LTYPE,TNR) - IF (LTYPE .NE. GLSOLI) CALL GKPSLN (GLSOLI) - EMPTY = .FALSE. - END IF - GOTO 999 - -C* polymarker - 13 CONTINUE - IF (STATE .EQ. GACTIV) THEN - IF (.NOT.INIT) THEN - CALL GKPINI (WTYPE,WINDOW,VIEWPT,HEIGHT,PAGES) - INIT = .TRUE. - END IF -C* set up device transformation - CALL GSDT (WINDOW,VIEWPT) -C* inquire marker size scale factor - CALL GQMKSC (ERRIND,SIZE) - CALL GKPSMS (SIZE) -C* set marker rotation angle - X = 0.0 - Y = 1.0 - CALL GCST (X,Y) - ANGLE = -ATAN2(X,Y)*180.0/PI - CALL GKPSMA (ANGLE) -C* adjust linewidth - FACTOR = SIZE*1.5 - CALL GKPSLW (FACTOR) -C* inquire polymarker color index - CALL GQPMCI (ERRIND,COLI) - CALL GKPSFG (COLI,WTYPE) - CALL GSIMPM (IA(1),R1,R2,GKPPM) - EMPTY = .FALSE. - END IF - GOTO 999 - -C* text - 14 CONTINUE - IF (STATE .EQ. GACTIV) THEN - IF (.NOT.INIT) THEN - CALL GKPINI (WTYPE,WINDOW,VIEWPT,HEIGHT,PAGES) - INIT = .TRUE. - END IF -C* inquire current normalization transformation - CALL GQCNTN (ERRIND,TNR) -C* set up device transformation - CALL GSDT (WINDOW,VIEWPT) -C* inquire text font and text color index - CALL GQTXFP (ERRIND,FONT,PREC) - IF (PREC .NE. GSTRKP) THEN - CALL GKPSCH (FONT,HEIGHT) - ELSE - CALL GKPSLW (1.0) - END IF -C* inquire text color index - CALL GQTXCI (ERRIND,COLI) - CALL GKPSCI (COLI,WTYPE) - CALL GKTEXT (R1,R2,CHARS,GKPPL,GKPFA,GKPTX) - EMPTY = .FALSE. - END IF - GOTO 999 - -C* fill area - 15 CONTINUE - IF (STATE .EQ. GACTIV) THEN - IF (.NOT.INIT) THEN - CALL GKPINI (WTYPE,WINDOW,VIEWPT,HEIGHT,PAGES) - INIT = .TRUE. - END IF -C* inquire current normalization transformation - CALL GQCNTN (ERRIND,TNR) -C* set up device transformation - CALL GSDT (WINDOW,VIEWPT) -C* inquire current fill area interior style - CALL GQFAIS (ERRIND,STYLE) -C* inquire fill area color index - CALL GQFACI (ERRIND,COLI) - CALL GKPSCI (COLI,WTYPE) - CALL GKPSLW (1.0) - IF (STYLE .EQ. GSOLID) THEN - CALL GKPFA (IA(1),R1,R2,TNR) - ELSE IF (STYLE .EQ. GPATTR) THEN - CALL GQFASI (ERRIND,PATTRN) - CALL GKPPA (IA(1),R1,R2,TNR,PATTRN) - ELSE - YRES = 1.0/4650.0 - CALL GFILLA (IA(1),R1,R2,TNR,GKPPL,YRES) - END IF - EMPTY = .FALSE. - END IF - GOTO 999 - -C* cell array - 16 CONTINUE - IF (STATE .EQ. GACTIV) THEN - IF (.NOT.INIT) THEN - CALL GKPINI (WTYPE,WINDOW,VIEWPT,HEIGHT,PAGES) - INIT = .TRUE. - END IF -C* set up device transformation - CALL GSDT (WINDOW,VIEWPT) - CALL GKPCA (R1(1),R1(2),R2(1),R2(2),DX,DY,DIMX,IA,WTYPE) - EMPTY = .FALSE. - END IF - GOTO 999 - -C* set color representation - 48 CONTINUE - CALL GKPSCR (IA(2),R1(1),R1(2),R1(3)) - GOTO 999 - -C* set workstation window - 54 CONTINUE - WINDOW(1) = R1(1) - WINDOW(2) = R1(2) - WINDOW(3) = R2(1) - WINDOW(4) = R2(2) - CALL GKPSDT (WINDOW,VIEWPT,HEIGHT,WTYPE) - - IF (INIT) CALL GKPCLP (WINDOW) - GOTO 999 - -C* set workstation viewport - 55 CONTINUE - VIEWPT(1) = R1(1) - VIEWPT(2) = R1(2) - VIEWPT(3) = R2(1) - VIEWPT(4) = R2(2) - CALL GKPSDT (WINDOW,VIEWPT,HEIGHT,WTYPE) - GOTO 999 - - 999 RETURN - END - - - SUBROUTINE GKPPL (N,PX,PY,LTYPE,TNR) -C* polyline - - INTEGER LIMIT - PARAMETER (LIMIT=1000) - - INTEGER LTYPE, N - REAL PX(N),PY(N) - INTEGER TNR - - EXTERNAL GKPVEC,GKPCOD - - CALL GKPLIM (LIMIT) -C* switch to the polyline utility - CALL GPOLIN (N,PX,PY,LTYPE,TNR,GKPVEC,GKPCOD) -C* close stroke - CALL GKPSK - - RETURN - END - - - SUBROUTINE GKPFA (N,PX,PY,TNR) -C* fill area - - REAL PX(N),PY(N) - INTEGER TNR - INTEGER N - - EXTERNAL GKPVEC,GKPCOD - - CALL GKPLIM (0) -C* switch to the polyline utility - CALL GPOLIN (N,PX,PY,0,TNR,GKPVEC,GKPCOD) -C* fill - CALL GKPPB ('fi') - - RETURN - END - - - SUBROUTINE GKPPA (N,PX,PY,TNR,PATTRN) -C* pattern fill - - INTEGER N - REAL PX(N),PY(N) - INTEGER TNR, PATTRN - - INTEGER PA(0:32),I,J,K,L - CHARACTER STR*64 - - EXTERNAL GKPVEC,GKPCOD - - CALL GKPLIM (0) -C* switch to the polyline utility - CALL GPOLIN (N,PX,PY,0,TNR,GKPVEC,GKPCOD) - -C* inquire pattern - CALL GKQPA (PATTRN,PA) - K = PA(0) - IF (K .EQ. 4 .OR. K .EQ. 8) THEN - J = 2 - ELSE IF (K .EQ. 32) THEN - J = 1 - ELSE - STOP 'GKS: invalid pattern' - END IF - K = 1 - L = 1 - DO 1 I=1,32 - CALL GKPHEX (PA(K),STR(L:L+1)) - IF (MOD(I,J) .EQ. 0) K = K+1 - IF (K .GT. PA(0)) K = 1 - L = L+2 - 1 CONTINUE - - CALL GKPPB ('bp <'//STR(1:64)//'> ep') - - RETURN - END - - - SUBROUTINE GKPTX (X,Y,CHARS) -C* output hardware characters - - REAL FEPS - PARAMETER (FEPS = 1.0E-06) - - REAL PI - PARAMETER (PI = 3.141592) - - INTEGER I, J, IDUMMY - REAL X,Y,YREL - CHARACTER*(*) CHARS - INTEGER FONT,HEIGHT - -C* include GKS symbol definitions - INCLUDE 'gksdefs.i' - - INTEGER ERRIND,PREC,ALH,ALV - REAL XORG,YORG - CHARACTER STR*500 - - CHARACTER*2 SHOW(GAHNOR:GARITE) - REAL YFAC(GAVNOR:GABOTT) - - INTEGER CFONT, MAP(32) - REAL CHH, CHGHT, CAPS(43), YSIZE - CHARACTER*31 FONTS(43), PITCH, OCHAR - INTEGER FAMILY, SIZE, FLEN, PLEN, IC - REAL UX, UY, PHI - INTEGER TNR, ANGLE - CHARACTER BS - - SAVE - - DATA SHOW /'lj','lj','ct','rj'/ - DATA YFAC /0.,-1.2,-1.0,-0.5,0.,0.2/ - DATA YSIZE /64/ - - DATA CFONT /0/, CHGHT /0.0/ - DATA MAP / 22, 9, 5, 14, 18, 26, 13, 1, - * 24, 11, 7, 16, 20, 28, 13, 3, - * 23, 10, 6, 15, 19, 27, 13, 2, - * 25, 12, 8, 17, 21, 29, 13, 4/ - DATA CAPS / 0.662, 0.653, 0.676, 0.669, - * 0.718, 0.718, 0.718, 0.718, - * 0.562, 0.562, 0.562, 0.562, - * 0.667, - * 0.714, 0.714, 0.714, 0.714, - * 0.722, 0.722, 0.722, 0.722, - * 0.740, 0.740, 0.740, 0.740, - * 0.732, 0.733, 0.732, 0.732, - * 0.718, 0.718, 0.718, 0.718, - * 0.681, 0.681, 0.681, 0.681, - * 0.692, 0.692, 0.681, 0.681, - * 0.587, 0.587/ - DATA FONTS / - * 'Times-Roman', 'Times-Italic', 'Times-Bold', 'Times-BoldItalic', - * 'Helvetica', 'Helvetica-Oblique', 'Helvetica-Bold', - * 'Helvetica-BoldOblique', 'Courier', 'Courier-Oblique', - * 'Courier-Bold', 'Courier-BoldOblique', 'Symbol', - * 'LubalinGraph-Book', 'LubalinGraph-BookOblique', - * 'LubalinGraph-Demi', 'LubalinGraph-DemiOblique', - * 'NewCenturySchlbk-Roman', 'NewCenturySchlbk-Italic', - * 'NewCenturySchlbk-Bold', 'NewCenturySchlbk-BoldItalic', - * 'AvantGarde-Book', 'AvantGarde-BookOblique', 'AvantGarde-Demi', - * 'AvantGarde-DemiOblique', 'Souvenir-Light', - * 'Souvenir-LightItalic', 'Souvenir-Demi', 'Souvenir-DemiItalic', - * 'Helvetica-Narrow', 'Helvetica-Narrow-Oblique', - * 'Helvetica-Narrow-Bold', 'Helvetica-Narrow-BoldOblique', - * 'Bookman-Light', 'Bookman-LightItalic', 'Bookman-Demi', - * 'Bookman-DemiItalic', 'Palatino-Roman', 'Palatino-Italic', - * 'Palatino-Bold', 'Palatino-BoldItalic', - * 'ZapfChancery-MediumItalic', 'ZapfDingbats' / - - BS = CHAR(92) - -C* device transformation - CALL GKPDT (X,Y,XORG,YORG) -C* inquire text font and precision, text alignment - CALL GQTXFP (ERRIND,IDUMMY,PREC) - CALL GQTXAL (ERRIND,ALH,ALV) - -C* inquire character-up vector - CALL GQCHUP (ERRIND,UX,UY) - CALL GQCNTN (ERRIND,TNR) - CALL GCNT (UX,UY,TNR) -C* segment transformation - CALL GCST (UX,UY) - ANGLE = NINT(-ATAN2(UX,UY)*180.0/PI) - - IF (PREC .EQ. GSTRP) THEN -C* align the text - PHI = ANGLE/180.0*PI - YREL = YSIZE*YFAC(ALV) - XORG = XORG-YREL*SIN(PHI) - YORG = YORG+YREL*COS(PHI) - END IF - - IF (ANGLE .EQ. 0) THEN - CALL GKPMOV (XORG,YORG) - ELSE - CALL GKPAMT (ANGLE,XORG,YORG) - END IF - - J = 0 - DO 1 I = 1,LEN(CHARS) - IC = ICHAR(CHARS(I:I)) - IF (IC. LT. 0) IC = 255+IC - IF (IC .LE. 127) THEN - IF (INDEX('()\\',CHARS(I:I)) .GT. 0) THEN - J = J+1 - STR(J:J) = BS - END IF - J = J+1 - STR(J:J) = CHARS(I:I) - ELSE - CALL GOCT (IC,OCHAR) - J = J+1 - STR(J:J) = BS - J = J+3 - STR(J-2:J) = OCHAR(1:3) - END IF - 1 CONTINUE - - CALL GKPPB ('('//STR(1:J)//') '//SHOW(ALH)) - IF (ANGLE .NE. 0) CALL GKPPB ('gr') - - RETURN - - - ENTRY GKPSCH (FONT,HEIGHT) -C* set character height - - CALL GSCT - CALL GCHH (CHH) - - IF (FONT .NE. CFONT .OR. (ABS(CHH-CHGHT) .GT. FEPS)) THEN - CFONT = ABS(FONT) - CHGHT = ABS(CHH) - -C* fonts used by Adobe's Illustrator (contributed by Mika.Heiskanen@fmi.fi) - - IF (CFONT .GE. 10001 .AND. CFONT .LE. 10223) THEN - - IF (CFONT .GE. 101 .AND. CFONT .LE. 143) THEN - FAMILY = CFONT-100 - ELSE IF (CFONT .GE. 1 .AND. CFONT .LE. 32) THEN - FAMILY = MAP(CFONT) - ELSE - FAMILY = 9 - END IF - FLEN = INDEX(FONTS(FAMILY),' ') - 1 - - YSIZE = CHGHT*HEIGHT - SIZE = MIN(MAX(INT(YSIZE/CAPS(FAMILY)),1),7200) - CALL GDEC (SIZE,PLEN,PITCH) - - IF (FAMILY .NE. 13 .AND. FAMILY .NE. 42 .AND. - * FAMILY .NE. 43) THEN - CALL GKPPB ('gsave /'//FONTS(FAMILY)(1:FLEN)// - * '_ ISOLatin1Encoding') - - CALL GKPPB ('/'//FONTS(FAMILY)(1:FLEN)// - * ' encodefont pop grestore') - - CALL GKPPB ('/'//FONTS(FAMILY)(1:FLEN)//'_'// - * ' findfont '//PITCH(1:PLEN)// - * ' scalefont setfont') - ELSE - CALL GKPPB ('/'//FONTS(FAMILY)(1:FLEN)// - * ' findfont '//PITCH(1:PLEN)// - * ' scalefont setfont') - END IF - - END IF - - END IF - - RETURN - END - - - SUBROUTINE GKPCA (XMIN,XMAX,YMIN,YMAX,DX,DY,DIMX,COLIA,WTYPE) -C* cell array - - REAL XMIN, XMAX, YMIN, YMAX - INTEGER DX, DY, DIMX, COLIA(*), WTYPE - - INTEGER ERRIND, TNR, CLSW - REAL CLRT(4) - REAL X1, Y1, X2, Y2 - INTEGER W, H, X, Y - - CHARACTER*8 SDX, SDY, SX, SY, SW, SH - INTEGER LSDX, LSDY, LSX, LSY, LSW, LSH - CHARACTER LINE*78, SCI*6 - INTEGER I, J, II, JJ, CI, LSCI, SWAP - -C* inquire current normalization transformation number - CALL GQCNTN (ERRIND,TNR) - - CALL GDEC (DX,LSDX,SDX) - CALL GDEC (DY,LSDY,SDY) - - X1 = XMIN - Y1 = YMAX - CALL GNT (X1,Y1,TNR) - CALL GST (X1,Y1) - CALL GKPDT (X1,Y1,X1,Y1) - - X2 = XMAX - Y2 = YMIN - CALL GNT (X2,Y2,TNR) - CALL GST (X2,Y2) - CALL GKPDT (X2,Y2,X2,Y2) - - W = NINT(ABS(X2-X1)) - H = NINT(ABS(Y2-Y1)) - X = NINT(MIN(X1,X2)) - Y = NINT(MIN(Y1,Y2)) - - CALL GDEC (X,LSX,SX) - CALL GDEC (Y,LSY,SY) - CALL GDEC (W,LSW,SW) - CALL GDEC (H,LSH,SH) - - CALL GKPPB ('gsave') - -C* inquire current clipping rectangle and set clipping path - CALL GQCLIP (ERRIND,CLSW,CLRT) - CALL GKPCLP (CLRT) - - IF (MOD(WTYPE,2) .EQ. 0) THEN - CALL GKPPB ('/rgbstr '//SDX(1:LSDX)//' string def') - ELSE - CALL GKPPB ('/gstr '//SDX(1:LSDX)//' string def') - END IF - CALL GKPPB (SX(1:LSX)//' '//SY(1:LSY)//' translate') - CALL GKPPB (SW(1:LSW)//' '//SH(1:LSH)//' scale') - - SWAP = 0 - IF (X1 .GT. X2) SWAP = 1 - IF (Y1 .GT. Y2) SWAP = SWAP + 2 - - IF (SWAP .EQ. 0) THEN - CALL GKPPB (SDX(1:LSDX)//' '//SDY(1:LSDY)//' 8 ['// - * SDX(1:LSDX)//' 0 0 -'//SDY(1:LSDY)//' 0 '// - * SDY(1:LSDY)//']') - ELSE IF (SWAP .EQ. 1) THEN - CALL GKPPB (SDX(1:LSDX)//' '//SDY(1:LSDY)//' 8 ['// - * '-'//SDX(1:LSDX)//' 0 0 -'//SDY(1:LSDY)//' '// - * SDX(1:LSDX)//' '//SDY(1:LSDY)//']') - ELSE IF (SWAP .EQ. 2) THEN - CALL GKPPB (SDX(1:LSDX)//' '//SDY(1:LSDY)//' 8 ['// - * SDX(1:LSDX)//' 0 0 '//SDY(1:LSDY)//' 0 0]') - ELSE - CALL GKPPB (SDX(1:LSDX)//' '//SDY(1:LSDY)//' 8 ['// - * '-'//SDX(1:LSDX)//' 0 '//SDX(1:LSDX)//' '// - * SDY(1:LSDY)//' 0 0]') - END IF - - IF (MOD(WTYPE,2) .EQ. 0) THEN - CALL GKPPB ('{currentfile rgbstr readhexstring pop}') - CALL GKPPB ('false 3 colorimage') - ELSE - CALL GKPPB ('{currentfile gstr readhexstring pop}') - CALL GKPPB ('image') - END IF - - II = 0 - JJ = 0 - DO 1 J = 1,DY - DO 2 I = 1,DX - CI = COLIA(JJ+I) - IF (CI .GE. 588) THEN - CI = 80 + (CI-588)/56 * 12 + - * NINT(MOD(CI-588,56) * 11.0/56.0) - ELSE IF (CI .GE. 257) THEN - CI = 8 + NINT((CI-257)/330.0 * (72-1)) - ELSE IF (CI .LT. 0) THEN - CI = 0 - END IF - CALL GKPQCI (CI, LSCI, SCI, WTYPE) - II = II+LSCI - LINE(II-LSCI+1:II) = SCI(1:LSCI) - IF (II .GE. 78) THEN - CALL GKPPB (LINE(1:II)) - II = 0 - END IF - 2 CONTINUE - JJ = JJ+DIMX - 1 CONTINUE - IF (II .GT. 0) CALL GKPPB (LINE(1:II)) - - CALL GKPPB ('grestore') - - RETURN - END - - - SUBROUTINE GKPPM (X,Y,MARKER) -C* output a marker symbol - -C* include GKS symbol definitions - INCLUDE 'gksdefs.i' - - INTEGER IX, IY, MARKER - REAL DX, DY, X, Y - CHARACTER*8 XPOS,YPOS - INTEGER LXPOS,LYPOS - - CHARACTER*3 MACRO(-20:5) - DATA MACRO / - * 'nom','npl','ftr','ftl','tud','fst',' st','fdm','ndm','fhg', - * 'nhg','fbt','nbt','fsq','nsq','ftd','ntd','ftu','ntu','fci', - * ' dt', - * ' dt',' pl','fas','nci',' dc'/ - -C* device transformation - CALL GKPDT (X,Y,DX,DY) - - IX = NINT(DX) - IY = NINT(DY) - CALL GDEC (IX,LXPOS,XPOS) - CALL GDEC (IY,LYPOS,YPOS) - - CALL GKPPB (XPOS(1:LXPOS)//' '//YPOS(1:LYPOS)// - * ' '//MACRO(MARKER)) - - RETURN - END - - - SUBROUTINE GKPCLP (CLRT) -C* set clipping path - - REAL CLRT(4) - - INTEGER I, J - REAL CX1, CY1, CX2, CY2 - INTEGER IX1, IX2, IY1, IY2 - CHARACTER*8 X1, X2, Y1, Y2 - INTEGER LX1, LX2, LY1, LY2 - - IF (CLRT(1) .LT. CLRT(2)) THEN - I = 1 - ELSE - I = 2 - END IF - IF (CLRT(3) .LT. CLRT(4)) THEN - J = 3 - ELSE - J = 4 - END IF - - CALL GKPDTR (CLRT( I),CLRT( J),CX1,CY1) - CALL GKPDTR (CLRT(3-I),CLRT(7-J),CX2,CY2) - - IX1 = INT(CX1)-2 - IY1 = INT(CY1)-2 - IX2 = NINT(CX2)+2 - IY2 = NINT(CY2)+2 - - CALL GDEC (IX1,LX1,X1) - CALL GDEC (IY1,LY1,Y1) - CALL GDEC (IX2,LX2,X2) - CALL GDEC (IY2,LY2,Y2) - - CALL GKPPB ('np '//X1(1:LX1)//' '//Y1(1:LY1)//' m '// - * X1(1:LX1)//' '//Y2(1:LY2)//' l '// - * X2(1:LX2)//' '//Y2(1:LY2)//' l '// - * X2(1:LX2)//' '//Y1(1:LY1)//' l cp clip') - - RETURN - END - - - SUBROUTINE GKPSDT (WN,VP,HEIGHT,WTYPE) -C* set up device transformation - - REAL FEPS - PARAMETER (FEPS = 1.0E-06) - - REAL WN(4),VP(4) - INTEGER HEIGHT, WTYPE - REAL MAGS, SIZEX, SIZEY - LOGICAL LANDSC - INTEGER YTRANS, LIMIT, ILIMIT - - INTEGER IX, IX1, IX2, IY, IY1, IY2, JX, JY, RX, RY - INTEGER LX1, LX2, LY1, LY2, IANGLE, NP - REAL A, B, C, D, E, F, G, H, X, XD, Y, YD - REAL MW, MH, MAGN - - CHARACTER*8 ANGLE, X1, X2, Y1, Y2 - INTEGER LANGLE - LOGICAL STROKE - CHARACTER*1 DC(-1:1,-1:1) - - SAVE - - INCLUDE 'gksdefs.i' - - DATA DC /'F', 'G', 'H', 'E', 'I', 'A', 'D', 'C', 'B'/ - - E = (VP(2)-VP(1))/(WN(2)-WN(1)) - IF (WTYPE .EQ. 92) THEN -C* 11in, 180dpi - F = (1980-1)/0.2794*600/180 - ELSE -C* 11.25in, 600pi - F = (6750-1)/0.28575 - END IF - G = (VP(4)-VP(3))/(WN(4)-WN(3)) - IF (WTYPE .EQ. 92) THEN -C* 8in, 180dpi - H = (1440-1)/0.2032*600/180 - ELSE -C* 7.75in, 600dpi - H = (4650-1)/0.19685 - END IF - - A = E*F - B = F*(VP(1)-WN(1)*E) - C = G*H - D = H*(VP(3)-WN(3)*G) - - MW = A*(WN(2)-WN(1)) - MH = C*(WN(4)-WN(3)) - HEIGHT = INT(C) - - STROKE = .FALSE. - - RETURN - - - ENTRY GKPSIZ (LANDSC, MAGS, SIZEX, SIZEY) -C* return size information - - IF (ABS(MAGS) .GT. FEPS) THEN - MAGN = 1.2**MAGS - ELSE - MAGN = 1.0 - END IF - - IF (LANDSC) THEN - SIZEX = MH*MAGN - SIZEY = MW*MAGN - ELSE - SIZEX = MW*MAGN - SIZEY = MH*MAGN - END IF - - RETURN - - - ENTRY GKPBND (WTYPE, LANDSC, MAGS, YTRANS) -C* display bounding box - - IF (ABS(MAGS) .GT. FEPS) THEN - MAGN = 1.2**MAGS - ELSE - MAGN = 1.0 - END IF - - IF (WTYPE .LT. 63) THEN - IF (MOD(WTYPE,2) .EQ. 0) THEN - IX1 = 21 - ELSE - IX1 = 18 - END IF - ELSE - IX1 = 0 - END IF - IF (WTYPE .LT. 63) THEN - IY1 = 15 - ELSE - IY1 = 0 - END IF - IF (LANDSC) THEN - IX2 = IX1+NINT(MH*72/600*MAGN) - IY2 = IY1+NINT(MW*72/600*MAGN) - YTRANS = IY2 - ELSE - IX2 = IX1+NINT(MW*72/600*MAGN) - IY2 = IY1+NINT(MH*72/600*MAGN) - YTRANS = IY1 - END IF - CALL GDEC (IX1,LX1,X1) - CALL GDEC (IY1,LY1,Y1) - CALL GDEC (IX2,LX2,X2) - CALL GDEC (IY2,LY2,Y2) - - CALL GKPPB ('%%BoundingBox: '// - * X1(1:LX1)//' '//Y1(1:LY1)//' '// - * X2(1:LX2)//' '//Y2(1:LY2)) - - RETURN - - - ENTRY GKPVEC (X,Y) -C* re-initialize vector drawing sequence - -C* device transformation - IX = NINT(A*X+B) - IY = NINT(C*Y+D) - - IF (STROKE) THEN - CALL GKPPB ('sk') - STROKE = .FALSE. - END IF - - CALL GDEC (IX,LX1,X1) - CALL GDEC (IY,LY1,Y1) - CALL GKPPB ('np '//X1(1:LX1)//' '//Y1(1:LY1)//' m') - NP = 1 - - RETURN - - - ENTRY GKPCOD (X,Y) - - JX = IX - JY = IY -C* device transformation - IX = NINT(A*X+B) - IY = NINT(C*Y+D) - - IF (NP .EQ. 1 .OR. IX .NE. JX .OR. IY .NE. JY) THEN - RX = IX-JX - RY = IY-JY - IF (ABS(RX) .GT. 1 .OR. ABS(RY) .GT. 1) THEN - CALL GDEC (RX,LX1,X1) - CALL GDEC (RY,LY1,Y1) - CALL GKPPB (X1(1:LX1)//' '//Y1(1:LY1)//' rl') - ELSE - CALL GKPPB (DC(RX,RY)) - END IF - NP = NP+1 - - IF (NP .EQ. LIMIT) THEN - CALL GKPPB ('sk') - STROKE = .FALSE. - - CALL GDEC (IX,LX1,X1) - CALL GDEC (IY,LY1,Y1) - CALL GKPPB (X1(1:LX1)//' '//Y1(1:LY1)//' m') - NP = 1 - ELSE - STROKE = .TRUE. - END IF - END IF - - RETURN - - - ENTRY GKPSK -C* stroke - - IF (STROKE) THEN - CALL GKPPB ('sk') - STROKE = .FALSE. - END IF - - RETURN - - - ENTRY GKPMOV (X,Y) -C* move to position - - IX = NINT(X) - IY = NINT(Y) - - CALL GDEC (IX,LX1,X1) - CALL GDEC (IY,LY1,Y1) - CALL GKPPB (X1(1:LX1)//' '//Y1(1:LY1)//' m') - - RETURN - - - ENTRY GKPAMT (IANGLE,X,Y) -C* rotated move - - IX = NINT(X) - IY = NINT(Y) - - CALL GDEC (IANGLE,LANGLE,ANGLE) - CALL GDEC (IX,LX1,X1) - CALL GDEC (IY,LY1,Y1) - CALL GKPPB (ANGLE(1:LANGLE)//' '// - * X1(1:LX1)//' '//Y1(1:LY1)//' am') - - RETURN - - - ENTRY GKPDT (X,Y,XD,YD) - -C* device transformation - XD = A*X+B - YD = C*Y+D - - RETURN - - - ENTRY GKPDTR (X,Y,XD,YD) - -C* device transformation - XD = A*X+B - YD = C*Y+D - - RETURN - - - ENTRY GKPLIM (ILIMIT) -C* point limit - - LIMIT = ILIMIT - - RETURN - END - - - SUBROUTINE GKPSLN (LTYPE) -C* set linetype - - INTEGER LTYPE, N - CHARACTER*30 PATTRN(-30:4) - DATA PATTRN / - * '[20 15 20 15 20 15 20 30]', '[20 15 20 15 20 30]', - * '[20 15 20 30]', '[15 10 15 10 15 10 15 30]', - * '[15 10 15 10 15 30]', '[15 10 15 30]', - * '[15 10 15 10 15 10 15 20]', '[15 10 15 10 15 20]', - * '[15 10 15 20]', '[0 10]', '[0 20]', '[0 40]', '[0 50]', - * '[0 15 0 15 0 30]', '[0 15 0 30]', '[30 15 0 15 0 15 0 15]', - * '[30 15 0 15 0 15]', '[30 15 0 15]', '[60 20 30 20]', - * '[60 20]', '[30 30]', '[30 20]', - * '[0 30 0 30 0 60]', '[0 30 0 60]', '[0 60]', '[60 60]', - * '[120 40 60 40]', '[120 40]', '[60 30 0 30 0 30 0 30]', - * '[60 30 0 30 0 30]', '[]', - * '[]', '[60 40]', '[0 30]', '[60 30 0 30]' / - - N = INDEX(PATTRN(LTYPE),']') - CALL GKPPB (PATTRN(LTYPE)(1:N)//' 0 setdash') - - IF (LTYPE .EQ. 1) THEN - CALL GKPPB ('0 setlinecap') - ELSE - CALL GKPPB ('1 setlinecap') - END IF - - RETURN - END - - - SUBROUTINE GKPSLW (WIDTH) -C* set linewidth - - REAL FEPS - PARAMETER (FEPS = 1.0E-06) - - INTEGER N - REAL WIDTH, CWIDTH - CHARACTER*12 LWIDTH - - DATA CWIDTH /0.0/ - - IF (ABS(WIDTH-CWIDTH) .GT. FEPS) THEN - CWIDTH = ABS(WIDTH) - CALL GFLT (4*CWIDTH,N,LWIDTH) - CALL GKPPB (LWIDTH(1:N)//' lw') - END IF - - RETURN - END - - - SUBROUTINE GKPSMS (SIZE) -C* set marker size scale factor - - REAL FEPS - PARAMETER (FEPS = 1.0E-06) - - INTEGER N - REAL SIZE,CSIZE - CHARACTER*12 LSIZE - - DATA CSIZE /0.0/ - - IF (ABS(SIZE-CSIZE) .GT. FEPS) THEN - CSIZE = ABS(SIZE) - CALL GFLT (CSIZE,N,LSIZE) - CALL GKPPB (LSIZE(1:N)//' ms') - END IF - - RETURN - END - - - SUBROUTINE GKPSMA (ANGLE) -C* set marker rotation angle - - REAL FEPS - PARAMETER (FEPS = 1.0E-06) - - INTEGER N - REAL ANGLE, CANGLE - CHARACTER*12 LANGLE - - DATA CANGLE /0.0/ - - IF (ABS(ANGLE-CANGLE) .GT. FEPS) THEN - CANGLE = ABS(ANGLE) - CALL GFLT (CANGLE,N,LANGLE) - CALL GKPPB (LANGLE(1:N)//' ma') - END IF - - RETURN - END - - - SUBROUTINE GKPHDR - - INTEGER NCHARS - CHARACTER BUFFER*100 - - CALL GKINFO (NCHARS, BUFFER) - - CALL GKPPB ('%!PS-Adobe-2.0 EPSF-1.2') - IF (NCHARS .GT. 0) THEN - CALL GKPPB ('%%Creator: '//BUFFER(36:NCHARS)// - * ', GLI GKS PostScript Device Handler, V4.5') - CALL GKPPB ('%%+CreationDate: '//BUFFER(1:24)) - ELSE - CALL GKPPB ( - * '%%Creator: GLI GKS PostScript Device Handler, V4.5') - END IF - CALL GKPPB ('%%+Copyright @ 1993-1995, J.Heinen') - CALL GKPPB ('%%Pages: (at end)') - - RETURN - END - - - SUBROUTINE GKPINI (WTYPE,WN,VP,HEIGHT,PAGES) -C* initialize - write PostScript prolog - - INTEGER WTYPE - REAL WN(4), VP(4) - INTEGER HEIGHT, PAGES - - REAL FEPS - PARAMETER (FEPS = 1.0E-06) - - INTEGER LPAGE, LMAG, LY - CHARACTER PAGE*8, MAG*12, X*2, Y*8 - LOGICAL LANDSC - REAL MAGS, SIZEX, SIZEY - INTEGER FORM, DPI, YTRANS - - SAVE - -C* GKS symbol definitions - INCLUDE 'gksdefs.i' -C* GKS description table - INCLUDE 'gksdescr.i' -C* GKS state list - INCLUDE 'gksstate.i' - - IF (WTYPE .EQ. 92) THEN - LANDSC = (VP(2)-VP(1) .GT. 0.2032) - ELSE - LANDSC = (VP(2)-VP(1) .GT. 0.19685) - END IF - - IF (PAGES .EQ. 0) THEN - - CALL GKMAGS (MAGS, DPI) - IF (WTYPE .EQ. 92) THEN - MAGS = ALOG(180.0 / DPI) / ALOG(1.2) - END IF - - IF (WTYPE .GE. 63) THEN - CALL GKPSIZ (LANDSC, MAGS, SIZEX, SIZEY) - IF (WTYPE .EQ. 92) THEN -C* SIXEL format - FORM = 0 - ELSE -C* GIF format - FORM = 1 - END IF - CALL DPSOP (SIZEX, SIZEY, FORM) - END IF - - CALL GKPHDR - CALL GKPBND (WTYPE, LANDSC, MAGS, YTRANS) - CALL GKPPB ('%%EndComments') - CALL GKPPB ('%%BeginProcSet GLI 4.5') - - CALL GKPPB ('save /GLI_GKS_save exch def') - CALL GKPPB ('/GLI_GKS_dict 150 dict def GLI_GKS_dict begin') - - CALL GKPPB ('/in {72 mul} def') - CALL GKPPB ('/np {newpath} def') - CALL GKPPB ('/cp {closepath} def') - CALL GKPPB ('/m {moveto} def') - CALL GKPPB ('/l {lineto} def') - CALL GKPPB ('/A {1 0 rlineto} def') - CALL GKPPB ('/B {1 1 rlineto} def') - CALL GKPPB ('/C {0 1 rlineto} def') - CALL GKPPB ('/D {-1 1 rlineto} def') - CALL GKPPB ('/E {-1 0 rlineto} def') - CALL GKPPB ('/F {-1 -1 rlineto} def') - CALL GKPPB ('/G {0 -1 rlineto} def') - CALL GKPPB ('/H {1 -1 rlineto} def') - CALL GKPPB ('/I {1 0 rlineto -1 0 rlineto} def') - CALL GKPPB ('/am {np gsave translate rotate 0 0 m} def') - CALL GKPPB ('/gr {grestore} def') - CALL GKPPB ('/rm {rmoveto} def') - CALL GKPPB ('/srm {rxy rx s mul ry s mul rm} def') - CALL GKPPB ('/rl {rlineto} def') - CALL GKPPB ('/srl {rxy rx s mul ry s mul rl} def') - CALL GKPPB ('/sk {stroke} def') - CALL GKPPB ('/csk {closepath stroke} def') - CALL GKPPB ('/fi {closepath eofill} def') - CALL GKPPB ('/sg {setgray} def') - CALL GKPPB ('/sc {setrgbcolor} def') - IF (WTYPE .GE. 63 .AND. X11) THEN - CALL GKPPB ( - * '/sp {dup [/DevicePixel 8] setcolorspace pop setcolor} def') - END IF - CALL GKPPB ('/fg {0 sg} def') - CALL GKPSBG (WTYPE) - CALL GKPPB ('/lw {setlinewidth} def') - CALL GKPPB ('/ms {/s exch def} def') - CALL GKPPB ('/ma {/a exch def} def') - CALL GKPPB ( - * '/ct {dup stringwidth pop 2 div neg 0 rmoveto show} def') - CALL GKPPB ('/rj {dup stringwidth pop neg 0 rmoveto show} def') - CALL GKPPB ('/lj {show} def') - CALL GKPPB ('/xy {/y exch def /x exch def} def') - CALL GKPPB ('/rxy {/ry exch def /rx exch def} def') - CALL GKPPB ('/sxy {gsave xy x y translate a rotate'// - * ' x neg y neg translate} def') - CALL GKPPB ('/dt {xy np fg x y s 0 360 arc fi} def') - CALL GKPPB ('/pl {sxy np x y m fg -24 0 srl 48 0 srl'// - * ' -24 0 srl 0 24 srl 0 -48 srl sk gr} def') - CALL GKPPB ('/as {np x y m 0 24 srm 14 -43.4 srl'// - * ' -36.8 26.8 srl 45.6 0 srl -36.8 -26.8 srl') - CALL GKPPB ('14 43.4 srl 14 -43.4 srl} def') - CALL GKPPB ('/fas {sxy fg as fill fg as csk gr} def') - CALL GKPPB ('/dc {sxy np x y m fg -24 24 srl 48 -48 srl'// - * ' -24 24 srl -24 -24 srl 48 48 srl') - CALL GKPPB ('sk gr} def') - CALL GKPPB ('/sq {np x y m 0 24 srm 24 0 srl 0 -48 srl'// - * ' -48 0 srl 0 48 srl 24 0 srl} def') - CALL GKPPB ('/nsq {sxy bg sq fi fg sq csk gr} def') - CALL GKPPB ('/fsq {sxy fg sq fi fg sq csk gr} def') - CALL GKPPB ('/ci {np x y 24 s mul 0 360 arc} def') - CALL GKPPB ('/nci {xy bg ci fi fg ci sk} def') - CALL GKPPB ('/fci {xy fg ci fi fg ci sk} def') - CALL GKPPB ('/tu {np x y m 0 28 srm -24 -42 srl'// - * ' 48 0 srl -24 42 srl} def') - CALL GKPPB ('/ntu {sxy bg tu fi fg tu csk gr} def') - CALL GKPPB ('/ftu {sxy fg tu fi fg tu csk gr} def') - CALL GKPPB ('/td {np x y m 0 -28 srm -24 42 srl'// - * ' 48 0 srl -24 -42 srl} def') - CALL GKPPB ('/ntd {sxy bg td fi fg td csk gr} def') - CALL GKPPB ('/ftd {sxy fg td fi fg td csk gr} def') - CALL GKPPB ('/dm {np x y m 0 24 srm -24 -24 srl'// - * ' 24 -24 srl 24 24 srl -24 24 srl} def') - CALL GKPPB ('/ndm {sxy bg dm fi fg dm csk gr} def') - CALL GKPPB ('/fdm {sxy fg dm fi fg dm csk gr} def') - CALL GKPPB ('/bt {np x y m -30 24 srl 0 -48 srl'// - * ' 60 48 srl 0 -48 srl -30 24 srl} def') - CALL GKPPB ('/nbt {sxy bg bt fi fg bt csk gr} def') - CALL GKPPB ('/fbt {sxy fg bt fi fg bt csk gr} def') - CALL GKPPB ('/hg {np x y m -24 30 srl 48 0 srl'// - * ' -48 -60 srl 48 0 srl -24 30 srl} def') - CALL GKPPB ('/nhg {sxy bg hg fi fg hg csk gr} def') - CALL GKPPB ('/fhg {sxy fg hg fi fg hg csk gr} def') - CALL GKPPB ('/st {sxy bg as fi fg as csk gr} def') - CALL GKPPB ('/fst {fas} def') - CALL GKPPB ('/tud {sxy bg tu fi bg td fi fg tu csk'// - * ' fg td csk gr} def') - CALL GKPPB ('/tl {np x y m -14 0 srm 42 -24 srl'// - * ' 0 48 srl -42 -24 srl} def') - CALL GKPPB ('/ftl {sxy fg tl fi fg tl csk gr} def') - CALL GKPPB ('/tr {np x y m 28 0 srm -42 -24 srl'// - * ' 0 48 srl 42 -24 srl} def') - CALL GKPPB ('/ftr {sxy fg tr fi fg tr csk gr} def') - CALL GKPPB ('/hpl {np x y m 0 24 srm 8 0 srl'// - * ' 0 -16 srl 16 0 srl 0 -16 srl -16 0 srl') - CALL GKPPB ('0 -16 srl -16 0 srl 0 16 srl -16 0 srl'// - * ' 0 16 srl 16 0 srl 0 16 srl 8 0 srl} def') - CALL GKPPB ('/npl {sxy bg hpl fi fg hpl csk gr} def') - CALL GKPPB ('/om {np x y m 0 24 srm 16 0 srl'// - * ' 8 -8 srl 0 -32 srl -8 -8 srl -32 0 srl') - CALL GKPPB ('-8 8 srl 0 32 srl 8 8 srl 16 0 srl} def') - CALL GKPPB ('/nom {sxy bg om fi fg om csk gr} def') - CALL GKPPB ('/pat1 {/px exch def /pa 16 array def 0 1 15'// - * ' {/py exch def /pw 2 string def') - CALL GKPPB ('pw 0 px py 2 mul 2 getinterval putinterval'// - * ' pa py pw put} for} def') - CALL GKPPB ('/pat2 {/pi exch def /cflag exch def save'// - * ' cflag 1 eq {eoclip} {clip}') - CALL GKPPB ('ifelse newpath {clippath pathbbox} stopped'// - * ' not {/ph exch def /pw exch def') - CALL GKPPB ('/py exch def /px exch def /px px 256 div'// - * ' floor 256 mul def') - CALL GKPPB ('/py py 256 div floor 256 mul def px py translate'// - * ' /pw pw px sub 256 div') - CALL GKPPB ('floor 1 add cvi def /ph ph py sub 256 div'// - * ' floor 1 add cvi def') - CALL GKPPB ('pw 256 mul ph 256 mul scale /pw pw 32 mul def'// - * ' /ph ph 32 mul def') - CALL GKPPB ('/px 0 def /py 0 def pw ph pi'// - * ' [pw neg 0 0 ph neg pw ph] {pa py get') - CALL GKPPB ('/px px 16 add def px pw ge {/px 0 def'// - * ' /py py 1 add 16 mod def} if} pi type') - CALL GKPPB ('/booleantype eq {imagemask} {image} ifelse}'// - * ' if restore} def') - CALL GKPPB ('/bp {closepath gsave} def') - CALL GKPPB ('/ep {pat1 1 1 pat2 grestore} def') - - CALL GKPPB ('/OF /findfont load def') - CALL GKPPB ('/findfont {dup GLI_GKS_dict exch known') - CALL GKPPB ('{GLI_GKS_dict exch get}') - CALL GKPPB ('if GLI_GKS_dict /OF get exec} def') - CALL GKPPB ('mark') - CALL GKPPB ('/ISOLatin1Encoding 8#000 1 8#001'// - * ' {StandardEncoding exch get} for') - CALL GKPPB ('/emdash /endash 8#004 1 8#025'// - * ' {StandardEncoding exch get} for') - CALL GKPPB ('/quotedblleft /quotedblright 8#030 1 8#054'// - * ' {StandardEncoding exch get} for') - CALL GKPPB ('/minus 8#056 1 8#217'// - * ' {StandardEncoding exch get} for') - CALL GKPPB ('/dotlessi 8#301 1 8#317'// - * ' {StandardEncoding exch get} for') - CALL GKPPB ('/space/exclamdown/cent/sterling/currency/yen'// - * '/brokenbar/section') - CALL GKPPB ('/dieresis/copyright/ordfeminine/guillemotleft'// - * '/logicalnot/hyphen/registered') - CALL GKPPB ('/macron/degree/plusminus/twosuperior'// - * '/threesuperior/acute/mu/paragraph') - CALL GKPPB ('/periodcentered/cedilla/onesuperior/ordmasculine'// - * '/guillemotright/onequarter') - CALL GKPPB ('/onehalf/threequarters/questiondown/Agrave'// - * '/Aacute/Acircumflex/Atilde') - CALL GKPPB ('/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute'// - * '/Ecircumflex/Edieresis/Igrave') - CALL GKPPB ('/Iacute/Icircumflex/Idieresis/Eth/Ntilde/Ograve'// - * '/Oacute/Ocircumflex/Otilde') - CALL GKPPB ('/Odieresis/multiply/Oslash/Ugrave/Uacute'// - * '/Ucircumflex/Udieresis/Yacute/Thorn') - CALL GKPPB ('/germandbls/agrave/aacute/acircumflex/atilde'// - * '/adieresis/aring/ae/ccedilla') - CALL GKPPB ('/egrave/eacute/ecircumflex/edieresis/igrave'// - * '/iacute/icircumflex/idieresis') - CALL GKPPB ('/eth/ntilde/ograve/oacute/ocircumflex/otilde'// - * '/odieresis/divide/oslash/ugrave') - CALL GKPPB ('/uacute/ucircumflex/udieresis/yacute/thorn'// - * '/ydieresis') - CALL GKPPB ('256 array astore def cleartomark') - CALL GKPPB ('/encodefont {findfont dup maxlength dict begin') - CALL GKPPB ('{1 index /FID ne {def} {pop pop} ifelse} forall') - CALL GKPPB ('/Encoding exch def dup') - CALL GKPPB ('/FontName exch def currentdict') - CALL GKPPB ('definefont end} def') - CALL GKPPB ('end') - - CALL GKPPB ('%%EndProcSet') - CALL GKPPB ('%%EndProlog') - - END IF - - PAGES = PAGES + 1 - CALL GDEC (PAGES,LPAGE,PAGE) - CALL GKPPB ('%%Page: '//PAGE(1:LPAGE)//' '//PAGE(1:LPAGE)) - - CALL GKPPB ('%%BeginPageSetup') - CALL GKPPB ('GLI_GKS_dict begin save /psl exch def') - - IF (WTYPE .GE. 63) THEN - CALL GKPPB ('initgraphics') - CALL GKPPB ('1 setgray clippath fill') - END IF - - IF (WTYPE .LT. 63) THEN - IF (MOD(WTYPE,2) .EQ. 0) THEN - X = '21' - ELSE - X = '18' - END IF - IF (LANDSC) THEN - CALL GDEC (YTRANS,LY,Y) - CALL GKPPB (X//' '//Y(1:LY)//' translate -90 rotate') - ELSE - CALL GKPPB (X//' 15 translate') - END IF - ELSE - IF (LANDSC) THEN - CALL GDEC (YTRANS,LY,Y) - CALL GKPPB ('0 '//Y(1:LY)//' translate -90 rotate') - END IF - ENDIF - - IF (ABS(MAGS) .GT. FEPS) THEN - CALL GFLT (1.2**MAGS,LMAG,MAG) - CALL GKPPB (MAG(1:LMAG)//' 1 in 600 div mul dup scale') - ELSE - CALL GKPPB ('1 in 600 div dup scale') - END IF - - CALL GKPSCI (-1,WTYPE) - CALL GKPSFG (-1,WTYPE) - CALL GKPPB ('0 setlinecap 1 setlinejoin') - CALL GKPSLW (-1.0) - CALL GKPSMS (-1.0) - CALL GKPPB ('0 ma') - CALL GKPSCH (-1,HEIGHT) -C* set clipping rectangle - CALL GKPCLP (WN) - CALL GKPPB ('%%EndPageSetup') - CALL GKPU - - RETURN - - - ENTRY GKPEP (PAGES) -C* end page - - CALL GDEC (PAGES,LPAGE,PAGE) - CALL GKPPB ('%%EndPage: '//PAGE(1:LPAGE)//' '//PAGE(1:LPAGE)) - CALL GKPU - - END - - - SUBROUTINE GKPICT -C* initialize color table - - INTEGER ICOLOR, RINT, GINT, BINT, WTYPE - REAL RED, GREEN, BLUE - CHARACTER*(*) SCI - INTEGER LSCI - - INTEGER COLOR, FCOL, PIXEL - REAL R(0:979), G(0:979), B(0:979) - - REAL GREY - INTEGER I, J, CI - CHARACTER*12 SR, SG, SB, PIX - INTEGER LSR, LSG, LSB, LPIX - - SAVE - -C* GKS symbol definitions - INCLUDE 'gksdefs.i' -C* GKS description table - INCLUDE 'gksdescr.i' -C* GKS state list - INCLUDE 'gksstate.i' - - DATA COLOR /1/, FCOL /1/ - - DO 1 I = 0,979 - J = I - CALL GQRGB (J,R(J),G(J),B(J)) - 1 CONTINUE - - COLOR = -1 - - RETURN - - - ENTRY GKPSCR (ICOLOR, RED, GREEN, BLUE) -C* set color representation - - IF (ICOLOR .GE. 0 .AND. ICOLOR .LT. 980) THEN - R(ICOLOR) = RED - G(ICOLOR) = GREEN - B(ICOLOR) = BLUE - END IF - - RETURN - - - ENTRY GKPSCI (ICOLOR, WTYPE) -C* set color index - - IF (ICOLOR .LT. 980) THEN - IF (ICOLOR .NE. COLOR) THEN - CI = ABS(ICOLOR) - IF (WTYPE .GE. 63 .AND. X11) THEN - CALL GQPIX (CI,PIXEL) - CALL GDEC (PIXEL,LPIX,PIX) - CALL GKPPB (PIX(1:LPIX)//' sp') - ELSE - IF (MOD(WTYPE,2) .NE. 0) THEN - GREY = 0.3*R(CI)+0.59*G(CI)+0.11*B(CI) - CALL GFLT (GREY,LSG,SG) - CALL GKPPB (SG(1:LSG)//' sg') - ELSE - CALL GFLT (R(CI),LSR,SR) - CALL GFLT (G(CI),LSG,SG) - CALL GFLT (B(CI),LSB,SB) - CALL GKPPB (SR(1:LSR)//' '//SG(1:LSG)// - * ' '//SB(1:LSB)//' sc') - END IF - END IF - COLOR = CI - END IF - END IF - - RETURN - - - ENTRY GKPSFG (ICOLOR, WTYPE) -C* set foreground color - - IF (ICOLOR .LT. 980) THEN - IF (ICOLOR .NE. FCOL) THEN - CI = ABS(ICOLOR) - IF (WTYPE .GE. 63 .AND. X11) THEN - CALL GQPIX (CI,PIXEL) - CALL GDEC (PIXEL,LPIX,PIX) - CALL GKPPB ('/fg {'//PIX(1:LPIX)//' sp} def') - ELSE - IF (MOD(WTYPE,2) .NE. 0) THEN - GREY = 0.3*R(CI)+0.59*G(CI)+0.11*B(CI) - CALL GFLT (GREY,LSG,SG) - CALL GKPPB ('/fg {'//SG(1:LSG)//' sg} def') - ELSE - CALL GFLT (R(CI),LSR,SR) - CALL GFLT (G(CI),LSG,SG) - CALL GFLT (B(CI),LSB,SB) - CALL GKPPB ('/fg {'//SR(1:LSR)//' '//SG(1:LSG)// - * ' '//SB(1:LSB)//' sc} def') - END IF - END IF - FCOL = CI - END IF - IF (ICOLOR .NE. COLOR) THEN - CI = ABS(ICOLOR) - CALL GKPPB ('fg') - COLOR = CI - END IF - END IF - - RETURN - - - ENTRY GKPSBG (WTYPE) -C* set background color - - IF (WTYPE .GE. 63 .AND. X11) THEN - CALL GQPIX (0,PIXEL) - CALL GDEC (PIXEL,LPIX,PIX) - CALL GKPPB ('/bg {'//PIX(1:LPIX)//' sp} def') - ELSE - IF (MOD(WTYPE,2) .NE. 0) THEN - GREY = 0.3*R(0)+0.59*G(0)+0.11*B(0) - CALL GFLT (GREY,LSG,SG) - CALL GKPPB ('/bg {'//SG(1:LSG)//' sg} def') - ELSE - CALL GFLT (R(0),LSR,SR) - CALL GFLT (G(0),LSG,SG) - CALL GFLT (B(0),LSB,SB) - CALL GKPPB ('/bg {'//SR(1:LSR)//' '//SG(1:LSG)// - * ' '//SB(1:LSB)//' sc} def') - END IF - END IF - - RETURN - - - ENTRY GKPQCI (ICOLOR, LSCI, SCI, WTYPE) -C* inquire color index - - IF (MOD(WTYPE,2) .EQ. 0) THEN - RINT = NINT(R(ICOLOR)*255) - GINT = NINT(G(ICOLOR)*255) - BINT = NINT(B(ICOLOR)*255) - CALL GKPHEX (RINT, SCI(1:2)) - CALL GKPHEX (GINT, SCI(3:4)) - CALL GKPHEX (BINT, SCI(5:6)) - LSCI = 6 - ELSE - GREY = 0.3*R(ICOLOR)+0.59*G(ICOLOR)+0.11*B(ICOLOR) - GINT = NINT(GREY*255) - CALL GKPHEX (GINT, SCI(1:2)) - LSCI = 2 - END IF - - RETURN - END - - - SUBROUTINE GKPHEX (I, STR) -C* convert integer to hex notation - - INTEGER I - CHARACTER*(*) STR - - CHARACTER*1 HTAB(0:15) - DATA HTAB /'0','1','2','3','4','5','6','7','8','9', - * 'A','B','C','D','E','F'/ - - STR(1:1) = HTAB(I/16) - STR(2:2) = HTAB(MOD(I,16)) - - RETURN - END - - - SUBROUTINE GKPSCO (ID,IT) -C* set up connection - - INTEGER I, L, ID, IPNTR, LPNTR - INTEGER CONID, WTYPE - - CHARACTER*(*) BUFF - CHARACTER*500 IOBUFF - CHARACTER*1 LF - - SAVE - - DATA IPNTR /0/, LPNTR /0/ - - LF = CHAR(10) - - CONID = ID - WTYPE = IT - - RETURN - - - ENTRY GKPPB (BUFF) -C* pack buffer - - L = LEN(BUFF) - - IF (BUFF(1:1) .EQ. '%') THEN - IF (LPNTR .NE. 0) THEN - IPNTR = IPNTR+1 - IOBUFF(IPNTR:IPNTR) = LF - LPNTR = 0 - END IF - - ELSE IF (L .GT. 78-LPNTR) THEN - IF (IPNTR .NE. 0) THEN - IPNTR = IPNTR+1 - IOBUFF(IPNTR:IPNTR) = LF - LPNTR = 0 - END IF - END IF - - IF (L+2 .GT. 500-IPNTR) THEN -C* xfer buffer - IF (WTYPE .GE. 63) THEN - CALL DPSWR (IPNTR,IOBUFF) - ELSE - CALL BUFOUT (CONID,IPNTR,IOBUFF) - END IF - IPNTR = 0 - END IF - - IF (LPNTR .NE. 0) THEN - IPNTR = IPNTR+1 - IOBUFF(IPNTR:IPNTR) = ' ' - LPNTR = LPNTR+1 - END IF - - DO 1 I = 1,L - IPNTR = IPNTR+1 - IOBUFF(IPNTR:IPNTR) = BUFF(I:I) - LPNTR = LPNTR+1 - 1 CONTINUE - - IF (BUFF(1:1) .EQ. '%') THEN - IPNTR = IPNTR+1 - IOBUFF(IPNTR:IPNTR) = LF - LPNTR = 0 - END IF - - RETURN - - - ENTRY GKPU -C* update - - IF (LPNTR .NE. 0) THEN - IPNTR = IPNTR+1 - IOBUFF(IPNTR:IPNTR) = LF - LPNTR = 0 - END IF - IF (WTYPE .GE. 63) THEN - CALL DPSWR (IPNTR,IOBUFF) - CALL DPSWR (1,LF) - CALL DPSFL - ELSE - CALL BUFOUT (CONID,IPNTR,IOBUFF) - END IF - IPNTR = 0 - - RETURN - END - \ No newline at end of file diff -r -N -u gks/dos/GKSDWISS.FOR gli-gks/dos/GKSDWISS.FOR --- gks/dos/GKSDWISS.FOR 2000-11-21 07:16:45.000000000 -0500 +++ gli-gks/dos/GKSDWISS.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,262 +0,0 @@ -C* -C* Copyright @ 1984 - 1995 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* - - SUBROUTINE GKDWIS (FCTID,DX,DY,DIMX,IA,LR1,R1,LR2,R2,LC,CHARS) -C* GKS Workstation Independent Segment Storage - - INTEGER LC, LR1, LR2 - INTEGER FCTID,DX,DY,DIMX,IA(*) - REAL R1(*),R2(*) - CHARACTER*(*) CHARS(*) - - SAVE - -C* include GKS symbol definitions - INCLUDE 'gksdefs.i' - -C * Workstation State List - INTEGER STATE -C connection identifier - INTEGER CONID -C segment number - INTEGER SGNUM - - CHARACTER*100 TMP - INTEGER LTMP - CHARACTER*132 STR(1) - INTEGER L, MIA, MLR1, MLR2, MLC - - GOTO (999,999, 2, 3, 4, 5,999,999,999,333, - * 333,333,333,333,333,333,333,333,333,333, - * 333,333,333,333,333,333,333,333,333,333, - * 333,333,333,333,333,333,333,333,333,333, - * 333,999,999,999,999,999,999,999,333,333, - * 333,333,333,333,333,999, 56, 57,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999) FCTID+1 - GOTO 999 - -C* open workstation - 2 CONTINUE - CALL GKTMP (LTMP, TMP) - - CONID = IA(2) - CALL GKDSC (CONID, LTMP, TMP) - - SGNUM = 0 - GOTO 999 - -C* close workstation - 3 CONTINUE - OPEN (CONID, FILE=TMP(1:LTMP), FORM='UNFORMATTED', - * STATUS='UNKNOWN') - CLOSE (CONID, STATUS='DELETE') - GOTO 999 - -C* activate workstation - 4 CONTINUE - STATE = GACTIV - GOTO 999 - -C* deactivate workstation - 5 CONTINUE - STATE = GINACT - GOTO 999 - -C* create segment - 56 CONTINUE - SGNUM = IA(1) - - OPEN (CONID, FILE=TMP(1:LTMP), FORM='UNFORMATTED', - * STATUS='UNKNOWN') - - MIA = 1 - MLR1 = 1 - MLR2 = 1 - MLC = 1 - GOTO 999 - -C* close segment - 57 CONTINUE - SGNUM = 0 - - CLOSE (CONID) - - DIMX = MIA - LR1 = MLR1 - LR2 = MLR2 - LC = MLC - GOTO 999 - - 333 CONTINUE - IF (STATE .EQ. GACTIV) THEN - IF (SGNUM .NE. 0) THEN - DO 444 L = 1,LC - STR(L) = CHARS(L) - 444 CONTINUE - MIA = MAX(MIA, DX*DY) - MLR1 = MAX(MLR1, LR1) - MLR2 = MAX(MLR2, LR2) - MLC = MAX(MLC, LC) - WRITE (CONID) SGNUM, FCTID, - * DX, DY, DIMX, (IA(L), L=1,DX*DY), - * LR1, (R1(L), L=1,LR1), LR2, (R2(L), L=1,LR2), - * LC, (STR(L), L=1,LC) - END IF - END IF - - 999 CONTINUE - - RETURN - END - - - - SUBROUTINE GKDCSG (WKID, SEGN, IA, R1, R2, CHARS) -C copy segment to workstation - - INTEGER WKID, SEGN, IA(*) - REAL R1(*), R2(*) - CHARACTER*132 CHARS(*) - - INTEGER ICONID, ILTMP - CHARACTER*(*) ITMP - - INTEGER L, LC, LR1, LR2 - INTEGER FCTID, DX, DY, DIMX - - INTEGER I, CONID, SGNUM - CHARACTER TMP*100 - INTEGER LTMP - - DATA CONID /88/ - DATA TMP /'fort.88'/ - DATA LTMP /7/ - - CALL GKDSWK (WKID) - - OPEN (CONID, FILE=TMP(1:LTMP), FORM='UNFORMATTED', - * STATUS='UNKNOWN') - REWIND CONID - - 333 CONTINUE - READ (CONID, END=999, ERR=999) SGNUM, FCTID, - * DX, DY, DIMX, (IA(L), L=1,DX*DY), - * LR1, (R1(L), L=1,LR1), LR2, (R2(L), L=1,LR2), - * LC, (CHARS(L), L=1,LC) - - IF (SEGN .EQ. 0 .OR. SGNUM .EQ. SEGN) THEN - - GOTO (333,333,333,333,333,333,333,333,333,333, - * 333,333, 12, 13, 14, 15, 16,333,333, 19, - * 20, 21,333, 23, 24, 25,333, 27, 28, 29, - * 30, 31, 32, 33, 34,333, 36, 37, 38,333, - * 333,333,333,333,333,333,333,333,333, 49, - * 50,333, 52, 53,333,333,333,333,333,333, - * 333,333,333,333,333,333,333,333,333,333, - * 333,333,333,333,333,333,333,333,333,333, - * 333,333,333,333,333,333,333,333,333,333, - * 333,333,333,333,333,333,333,333,333,333, - * 333,333,333,333,333,333,333) FCTID+1 - GOTO 333 - 12 CALL GPL (IA,R1,R2) - GOTO 333 - 13 CALL GPM (IA,R1,R2) - GOTO 333 - 14 DO 140, I = 132, 1, -1 - IF (CHARS(1)(I:I) .NE. ' ') THEN - CALL GTX (R1,R2,CHARS(1)(1:I)) - GOTO 333 - END IF - 140 CONTINUE - GOTO 333 - 15 CALL GFA (IA,R1,R2) - GOTO 333 - 16 CALL GCA (R1(1),R2(1),R1(2),R2(2),DX,DY,1,1,DIMX,DY,IA) - GOTO 333 - 19 CALL GSLN (IA) - GOTO 333 - 20 CALL GSLWSC (R1) - GOTO 333 - 21 CALL GSPLCI (IA) - GOTO 333 - 23 CALL GSMK (IA) - GOTO 333 - 24 CALL GSMKSC (R1) - GOTO 333 - 25 CALL GSPMCI (IA) - GOTO 333 - 27 CALL GSTXFP (IA(1),IA(2)) - GOTO 333 - 28 CALL GSCHXP (R1) - GOTO 333 - 29 CALL GSCHSP (R1) - GOTO 333 - 30 CALL GSTXCI (IA) - GOTO 333 - 31 CALL GSCHH (R1) - GOTO 333 - 32 CALL GSCHUP (R1,R2) - GOTO 333 - 33 CALL GSTXP (IA) - GOTO 333 - 34 CALL GSTXAL (IA(1),IA(2)) - GOTO 333 - 36 CALL GSFAIS (IA) - GOTO 333 - 37 CALL GSFASI (IA) - GOTO 333 - 38 CALL GSFACI (IA) - GOTO 333 - 49 CALL GSWN (IA,R1(1),R1(2),R2(1),R2(2)) - GOTO 333 - 50 CALL GSVP (IA,R1(1),R1(2),R2(1),R2(2)) - GOTO 333 - 52 CALL GSELNT (IA) - GOTO 333 - 53 CALL GSCLIP (IA) - GOTO 333 - - ELSE - GOTO 333 - END IF - - 999 CONTINUE - - CLOSE (CONID) - - CALL GKDSWK (0) - - RETURN - - - ENTRY GKDSC (ICONID, ILTMP, ITMP) -C set connection identifier - - CONID = ICONID - LTMP = ILTMP - TMP = ITMP - - RETURN - END - \ No newline at end of file diff -r -N -u gks/dos/GKSERROR.FOR gli-gks/dos/GKSERROR.FOR --- gks/dos/GKSERROR.FOR 2000-11-21 07:16:44.000000000 -0500 +++ gli-gks/dos/GKSERROR.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,167 +0,0 @@ -C* -C* Copyright @ 1984 - 1993 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* - - SUBROUTINE GECLKS -C emergency close GKS - - INTEGER STATE - INTEGER I, IDUM, IWKID, JERR, NMAX - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - -C first check GKS operating state - CALL GQOPS(STATE) - IF (STATE.EQ.0) GOTO 5 - -C actions necessary only when GKS open - GOTO (1,2,3,4),STATE - -C STATE=GSGOP : there are open segments -C - 4 CALL GCLSG - CONTINUE - -C STATE=GWSAC : there are active workstations. -C deactivate them - 3 CONTINUE - CALL GQACWK(1,JERR,NMAX,IWKID) - IF(NMAX.LE.0) GOTO 2 - DO 300 I=1,NMAX - CALL GQACWK(1,JERR,IDUM,IWKID) - CALL GDAWK(IWKID) -300 CONTINUE - -C STATE=GWSOP : there are open workstations. -C close them - 2 CONTINUE - CALL GQOPWK(1,JERR,NMAX,IWKID) - IF(NMAX.LE.0) GOTO 1 - DO 200 I=1,NMAX - CALL GQOPWK(1,JERR,IDUM,IWKID) - CALL GCLWK(IWKID) -200 CONTINUE - -C STATE=GGKOP : GKS open -C close it - 1 CONTINUE - CALL GCLKS - - 5 CONTINUE - - RETURN - END - - - - SUBROUTINE GERHND (ERRNO,FCTID,ERRFIL) -C error handler - - INTEGER ERRNO,FCTID,ERRFIL - - CALL GERLOG (ERRNO,FCTID,ERRFIL) - - RETURN - END - - - - SUBROUTINE GERLOG (ERRNO,FCTID,ERRFIL) -C error logging - - INTEGER ERRNO,FCTID,ERRFIL - - INTEGER BASE,STATUS - - INCLUDE 'gksdefs.i' - - CHARACTER*6 NMS(EOPKS:EACTM) - - DATA NMS(EOPKS),NMS(ECLKS),NMS(EOPWK),NMS(ECLWK),NMS(EACWK) - & /'GOPKS ','GCLKS ','GOPWK ','GCLWK ','GACWK '/ - DATA NMS(EDAWK),NMS(ECLRWK) - & /'GDAWK ','GCLRWK'/ - DATA NMS(ERSGWK),NMS(EUWK),NMS(ESDS),NMS(EMSG),NMS(EESC) - & /'GRSGWK','GUWK ','GSDS ','GMSG ','GESC '/ - DATA NMS(EPL),NMS(EPM),NMS(ETX),NMS(EFA),NMS(ECA) - & /'GPL ','GPM ','GTX ','GFA ','GCA '/ - DATA NMS(EGDP),NMS(ESPLI),NMS(ESLN),NMS(ESLWSC),NMS(ESPLCI) - & /'GGDP ','GSPLI ','GSLN ','GSLWSC','GSPLCI'/ - DATA NMS(ESPMI),NMS(ESMK),NMS(ESMKSC),NMS(ESPMCI),NMS(ESTXI) - & /'GSPMI ','GSMK ','GSMKSC','GSPMCI','GSTXI '/ - DATA NMS(ESTXFP) - & /'GSTXFP'/ - DATA NMS(ESCHXP),NMS(ESCHSP),NMS(ESTXCI),NMS(ESCHH),NMS(ESCHUP) - & /'GSCHXP','GSCHSP','GSTXCI','GSCHH ','GSCHUP'/ - DATA NMS(ESTXP),NMS(ESTXAL) - & /'GSTXP ','GSTXAL'/ - DATA NMS(ESFAI),NMS(ESFAIS),NMS(ESFASI),NMS(ESFACI),NMS(ESPA) - & /'GSFAI ','GSFAIS','GSFASI','GSFACI','GSPA '/ - DATA NMS(ESPARF),NMS(ESASF) - & /'GSPARF','GSASF '/ - DATA NMS(ESPKID),NMS(ESPLR),NMS(ESPMR),NMS(ESTXR),NMS(ESFAR) - & /'GSPKID','GSPLR ','GSPMR ','GSTXR ','GSFAR '/ - DATA NMS(ESPAR),NMS(ESCR) - & /'GSPAR ','GSCR '/ - DATA NMS(ESWN),NMS(ESVP),NMS(ESVPIP),NMS(ESELNT),NMS(ESCLIP) - & /'GSWN ','GSVP ','GSVPIP','GSELNT','GSCLIP'/ - DATA NMS(ESWKWN),NMS(ESWKVP) - & /'GSWKWN','GSWKVP'/ - DATA NMS(ECRSG),NMS(ECLSG),NMS(ERENSG),NMS(EDSG),NMS(EDSGWK) - & /'GCRSG ','GCLSG ','GRENSG','GDSG ','GDSGWK'/ - DATA NMS(EASGWK),NMS(ECSGWK) - & /'GASGWK','GCSGWK'/ - DATA NMS(EINSG),NMS(ESSGT),NMS(ESVIS),NMS(ESHLIT),NMS(ESSGP) - & /'GINSG ','GSSGT ','GSVIS ','GSHLIT','GSSGP '/ - DATA NMS(ESDTEC),NMS(EINLC) - & /'GSDTEC','GINLC '/ - DATA NMS(EINSK),NMS(EINVL),NMS(EINCH),NMS(EINPK),NMS(EINST) - & /'GINSK ','GINVL ','GINCH ','GINPK ','GINST '/ - DATA NMS(ESLCM),NMS(ESSKM) - & /'GSLCM ','GSSKM '/ - DATA NMS(ESVLM),NMS(ESCHM),NMS(ESPKM),NMS(ESSTM),NMS(ERQLC) - & /'GSVLM ','GSCHM ','GSPKM ','GSSTM ','GRQLC '/ - DATA NMS(ERQSK),NMS(ERQVL) - & /'GRQSK ','GRQVL '/ - DATA NMS(ERQCH),NMS(ERQPK),NMS(ERQST),NMS(ESMLC),NMS(ESMSK) - & /'GRQCH ','GRQPK ','GRQST ','GSMLC ','GSMSK '/ - DATA NMS(ESMVL),NMS(ESMCH) - & /'GSMVL ','GSMCH '/ - DATA NMS(ESMPK),NMS(ESMST),NMS(EWAIT),NMS(EFLUSH),NMS(EGTLC) - & /'GSMPK ','GSMST ','GWAIT ','GFLUSH','GGTLC '/ - DATA NMS(EGTSK),NMS(EGTVL) - & /'GGTSK ','GGTVL '/ - DATA NMS(EGTCH),NMS(EGTPK),NMS(EGTST),NMS(EWITM),NMS(EGTITM) - & /'GGTCH ','GGTPK ','GGTST ','GWITM ','GGTITM'/ - DATA NMS(ERDITM),NMS(EIITM) - & /'GRDITM','GIITM '/ - DATA NMS(EEVTM),NMS(EACTM) - & /'GEVTM ','GACTM '/ - - DATA BASE /140148736/ - - CALL GERSET (ERRNO,ERRFIL) - - STATUS = BASE + ERRNO*8 - CALL LIBSIG (STATUS, NMS(FCTID)(1:6)) - - RETURN - END - \ No newline at end of file Binary files gks/dos/GKSFONT.DAT and gli-gks/dos/GKSFONT.DAT differ diff -r -N -u gks/dos/GKS.FOR gli-gks/dos/GKS.FOR --- gks/dos/GKS.FOR 2000-11-21 07:16:44.000000000 -0500 +++ gli-gks/dos/GKS.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,2702 +0,0 @@ -C* -C* Copyright @ 1984 - 1995 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@FZ-juelich.de. -C* -C* -C GLIGKS V4.5 -C -C Graphic Kernel System -C ISO/DIS 7942 - -C Reentrant FORTRAN 77 Function Interface for -C GKS Version 7.4 Level 0b - - -C written by J.Heinen, FZ Juelich -C date: April 1984 - - - SUBROUTINE GOPKS (FILE, BUFFER) -C Open GKS - - INTEGER NBSP - PARAMETER (NBSP = 160) - - REAL FEPS - PARAMETER (FEPS = 1.0E-06) - - INTEGER MAXSTR - PARAMETER (MAXSTR = 255) - - INTEGER FILE, BUFFER, WKID, CONID, WTYPE, COFL, REFL, LDR - CHARACTER*(*) DATREC(LDR) - - INTEGER N, DX, DY, SCOL, SROW, NCOL, NROW, COLIA(DX,DY) - REAL PX(N), PY(N), QX, QY, RX, RY - CHARACTER*(*) CHARS - INTEGER NCHARS - - INTEGER INDEX, TYPE, FONT, PREC, PATH, ALH, ALV, STYLE - REAL WIDTH, FACTOR, SPACE, HEIGHT, UX, UY - - INTEGER FLAG(13), CI - REAL CR, CG, CB - - INTEGER TNR, CLSW - REAL XMIN, XMAX, YMIN, YMAX - - INTEGER LCDNR, SKDNR, STDNR, CHDNR - INTEGER LOSTR, STAT, NP, CHNR, DEFMOD, IRGMOD - CHARACTER*(*) STR - REAL SX(NP), SY(NP) - - INTEGER IDX, IA(4), LR1, LR2 - REAL R1(5), R2(5) - INTEGER LC, I - PARAMETER (LC=0) - CHARACTER C*1 - - INTEGER FUNID, DIMIDR, MAXODR, LENODR - CHARACTER*80 IDR(DIMIDR), ODR(MAXODR) - - INTEGER SEGN - - REAL X0, Y0, TX, TY, PHI, FX, FY, TRAN(2,3) - INTEGER ISW - - INTEGER WKIND, IPTR(2) - INTEGER MIA, MR1, MR2, MC - DOUBLE PRECISION DALIGN - - INTEGER ICONID, IWTYPE, IMASK, ITYPE, ISTYLE - LOGICAL WISS - REAL XORG, YORG, XPOINT, YPOINT, XSHIFT, YSHIFT, SINF, COSF - - LOGICAL OPENED - - CHARACTER TEXT*255 - INTEGER NTEXT - -C external functions - LOGICAL GANY, GALL - INTEGER GORD - -C * GKS Error State List -C error file - INTEGER ERRFIL -C buffers - INTEGER BUFF -C identification of the GKS procedure which caused the -C error detection - INTEGER FCTID -C error number - INTEGER ERRNO - -C GKSGRAL marker types - INTEGER GRALMK(-114:-101) - -C GKSGRAL hatch styles - INTEGER GRALHA(-106:-101) -C GDDM hatch styles - INTEGER GDDMHA(-6:-1) - -C segment attributes, GKS attributes - INTEGER SGATTR(20), GKATTR(20) - -C GKS symbol definitions - INCLUDE 'gksdefs.i' -C GKS description table - INCLUDE 'gksdescr.i' -C GKS state list - INCLUDE 'gksstate.i' - - EQUIVALENCE (DALIGN, IPTR(1)) - -C force the LINKER to search the object module for the -C block data subprogram (required for VAX FORTRAN) - EXTERNAL GKSDAT - -C backward compatibility flag for GR/GR3-Software - COMMON /GKSOPT/ GR_BC -CDEC$ PSECT /GKSOPT/ NOSHR - - SAVE - - DATA GRALMK /-20,-15,-18,-5,-17,-3,-7, - * -1,-16,-19,-14,-12,-2,-6/ - - DATA GRALHA /7,7,1,8,8,2/ - DATA GDDMHA /4,10,3,9,2,1/ - - DATA IA(4) /0/ - - - FCTID = EOPKS - - INQUIRE (UNIT=FILE, OPENED=OPENED) - IF (OPENED) THEN - ERRFIL = FILE - ELSE - ERRFIL = 2 + 100 - END IF - BUFF = BUFFER - - IF (STATE .NE. GGKCL) THEN -C GKS not in proper state. GKS must be in the state GKCL - ERRNO = 1 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE -C call the devive driver link routine - IDX = 1 - IA(1) = ERRFIL - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - -C open file which contains character fonts - CALL OPFONT(GR_BC) - - STATE = GGKOP - -C delete all workstation identifiers from the set of open -C and the set of active workstations - CALL GINI (SOPWS,MNOPWS) - NOPWS = 0 - CALL GINI (SACWS,MNACWS) - NACWS = 0 - - X11 = .FALSE. - WISS = .FALSE. - -C initialize aspect source flags - DO 1 I = 1,13 - ASF(I) = GBUNDL - 1 CONTINUE - -C set default bundle table indices - LINDEX = 1 - MINDEX = 1 - TINDEX = 1 - FINDEX = 1 - -C set default global output attributes - CHH = 0.01 - CHUP(1) = 0. - CHUP(2) = 1. - TXP = GRIGHT - TXAL(1) = GAHNOR - TXAL(2) = GAVNOR - -C set default polyline attributes - LTYPE = GLSOLI - LWIDTH = 1. - PLCOLI = 1 -C set default polymarker attributes - MTYPE = GPOINT - MSZSC = 1. - PMCOLI = 1 -C set default text attributes - TXFONT = 1 - TXPREC = GSTRP - CHXP = 1. - CHSP = 0. - TXCOLI = 1 -C set default fill area attributes - INTS = GHOLLO - STYLI = 1 - FACOLI = 1 - -C initialize normalization transformations - DO 2 CNTNR = 0,MXNTNR - LNTNR(CNTNR) = CNTNR - WINDOW(1,CNTNR) = 0. - WINDOW(2,CNTNR) = 1. - WINDOW(3,CNTNR) = 0. - WINDOW(4,CNTNR) = 1. - VIEWPT(1,CNTNR) = 0. - VIEWPT(2,CNTNR) = 1. - VIEWPT(3,CNTNR) = 0. - VIEWPT(4,CNTNR) = 1. -C set up normalization transformation - CALL GSNT (CNTNR,WINDOW(1,CNTNR),VIEWPT(1,CNTNR)) - 2 CONTINUE - CNTNR = 0 - -C set cliping indicator - CLIP = GCLIP - -C set segment transformation - MAT(1,1) = 1. - MAT(1,2) = 0. - MAT(2,1) = 0. - MAT(2,2) = 1. - MAT(1,3) = 0. - MAT(2,3) = 0. - CALL GSST (MAT) - - IA(4) = 0 - - END IF - - RETURN - - - - ENTRY GCLKS -C close GKS - - FCTID = ECLKS - IF (STATE .NE. GGKOP) THEN -C GKS not in proper state. GKS must be in the state GKOP - ERRNO = 2 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 0 - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,0,0,IA,LR1,R1,LR2,R2,LC,C) - - CALL CLFONT - STATE = GGKCL - - END IF - - RETURN - - - - ENTRY GOPWK (WKID,CONID,WTYPE) -C open workstation - - FCTID = EOPWK - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the -C states GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IMASK = WTYPE/65536 * 65536 - IWTYPE = MOD(WTYPE,65536) - IF (IWTYPE .EQ. 0) THEN -C get default workstation type - CALL GTWSTY(IWTYPE) - END IF - - IF (.NOT. GANY (LWSTY,NWSTY, IWTYPE)) THEN -C specified workstation type is invalid - ERRNO = 22 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is open - ERRNO = 24 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, 0)) THEN -C specified workstation cannot be opened - ERRNO = 26 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (IWTYPE .EQ. 5 .AND. WISS) THEN -C WISS is already open - ERRNO = 28 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - ICONID = CONID -C check file descriptor - CALL GKFD (ICONID) - -C add workstation identifier to the set of open -C workstations - CALL GADD (WKID,SOPWS,MNOPWS) - NOPWS = NOPWS + 1 - - IPTR(1) = CONID - IPTR(2) = 0 - CALL GKLTOI (CONID, IPTR(1)) - WKIND = GORD (SOPWS,MNOPWS,WKID) - SOPWS(WKIND,2) = CONID - SOPWS(WKIND,3) = IWTYPE - SOPWS(WKIND,4) = GORD (LWSTY,NWSTY,IWTYPE) - SOPWS(WKIND,5) = IPTR(1) - SOPWS(WKIND,6) = IPTR(2) - - IF (STATE .EQ. GGKOP) STATE = GWSOP - -C call the devive driver link routine - IDX = 3 - IIA(1) = WKID - IIA(2) = ICONID - IIA(3) = IMASK + IWTYPE - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IIA,LR1,R1,LR2,R2,LC,C) - IF (IIA(1) .NE. 0 .OR. IIA(2) .NE. 0) THEN - - SOPWS(WKIND,5) = IIA(1) - SOPWS(WKIND,6) = IIA(2) - - IF ((IWTYPE.GE.210 .AND. IWTYPE.LE.215) .OR. - * IWTYPE.EQ.218 .OR. - * (IWTYPE.GE.230 .AND. IWTYPE.LE.233)) THEN - X11 = .TRUE. - WKIND = GORD(LWSTY,NWSTY, IWTYPE) - GDC(1,WKIND) = R1(1) - GDC(2,WKIND) = R2(1) - GRU(1,WKIND) = INT(R1(2)) - GRU(2,WKIND) = INT(R2(2)) - ELSE IF (IWTYPE.EQ.5) THEN - WISS = .TRUE. - END IF - - ELSE - -C delete workstation identifier from the -C set of open workstations - CALL GDEL (WKID,SOPWS,MNOPWS) - NOPWS = NOPWS - 1 - - IF (GALL (SOPWS,MNOPWS, 0)) STATE = GGKOP - -C open failed - ERRNO = 905 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - END IF - END IF - END IF - END IF - END IF - END IF - END IF - - RETURN - - - - ENTRY GCLWK (WKID) -C close workstation - - FCTID = ECLWK - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (GANY (SACWS,MNACWS, WKID)) THEN -C specified workstation is active - ERRNO = 29 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 1 - IA(1) = WKID - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - WKIND = GORD (SOPWS,MNOPWS,WKID) - IWTYPE = SOPWS(WKIND,3) - - IF ((IWTYPE.GE.210 .AND. IWTYPE.LE.215) .OR. - * IWTYPE.EQ.218 .OR. - * (IWTYPE.GE.230 .AND. IWTYPE.LE.233)) THEN - X11 = .FALSE. - ELSE IF (IWTYPE.EQ.5) THEN - WISS = .FALSE. - END IF - -C delete workstation identifier from the set of open -C workstations - CALL GDEL (WKID,SOPWS,MNOPWS) - NOPWS = NOPWS - 1 - -C bump data structure - IF (WKIND .LT. MNOPWS) THEN - DO 8 I = WKIND+1,MNOPWS - SOPWS(I-1,2) = SOPWS(I,2) - SOPWS(I-1,3) = SOPWS(I,3) - SOPWS(I-1,4) = SOPWS(I,4) - SOPWS(I-1,5) = SOPWS(I,5) - SOPWS(I-1,6) = SOPWS(I,6) - 8 CONTINUE - END IF - - IF (GALL (SOPWS,MNOPWS, 0)) STATE = GGKOP - - END IF - END IF - END IF - END IF - - RETURN - - - - ENTRY GACWK (WKID) -C activate workstation - - FCTID = EACWK - IF (STATE .NE. GWSOP .AND. STATE .NE. GWSAC) THEN -C GKS not in proper state. GKS must be either in the state -C WSOP or in the state WSAC - ERRNO = 6 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (GANY (SACWS,MNACWS, WKID)) THEN -C specified workstation is active - ERRNO = 29 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C add workstation identifier to the set of active -C workstations - CALL GADD (WKID,SACWS,MNACWS) - NACWS = NACWS + 1 - - STATE = GWSAC -C call the devive driver link routine - IDX = 1 - IA(1) = WKID - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - END IF - END IF - - RETURN - - - - ENTRY GDAWK (WKID) -C deactivate workstation - - FCTID = EDAWK - IF (STATE .NE. GWSAC) THEN -C GKS not in proper state. GKS must be in the state WSAC - ERRNO = 3 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SACWS,MNACWS, WKID)) THEN -C specified workstation is not active - ERRNO = 30 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 1 - IA(1) = WKID - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - -C delete workstation identifier from the set of active -C workstations - CALL GDEL (WKID,SACWS,MNACWS) - - NACWS = NACWS - 1 - IF (NACWS .EQ. 0) STATE = GWSOP - - END IF - END IF - END IF - - RETURN - - - - ENTRY GCLRWK (WKID,COFL) -C clear workstation - - FCTID = ECLRWK - IF (STATE .NE. GWSOP .AND. STATE .NE. GWSAC) THEN -C GKS not in proper state. GKS must be either in the state -C WSOP or in the state WSAC - ERRNO = 6 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 2 - IA(1) = WKID - IA(2) = COFL - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - END IF - - RETURN - - - - ENTRY GUWK (WKID,REFL) -C update workstation - - FCTID = EUWK - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 2 - IA(1) = WKID - IA(2) = REFL - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - END IF - - RETURN - - - - ENTRY GMSG (WKID,CHARS) -C message - - FCTID = EMSG - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - NTEXT = MIN(LEN(CHARS),MAXSTR-1) - DO 3 I = 1,NTEXT - IF (CHARS(I:I) .NE. CHAR(NBSP)) THEN - TEXT(I:I) = CHARS(I:I) - ELSE - TEXT(I:I) = ' ' - END IF - 3 CONTINUE - I = NTEXT + 1 - TEXT(I:I) = CHAR(0) - -C call the devive driver link routine - IDX = 1 - IA(1) = WKID - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,1,TEXT(1:NTEXT)) - - END IF - - RETURN - - - - ENTRY GMSGS (WKID,NCHARS,CHARS) -C message (FORTRAN 77 subset) - - FCTID = EMSG - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - NTEXT = MIN(NCHARS,MAXSTR-1) - DO 4 I = 1,NTEXT - IF (CHARS(I:I) .NE. CHAR(NBSP)) THEN - TEXT(I:I) = CHARS(I:I) - ELSE - TEXT(I:I) = ' ' - END IF - 4 CONTINUE - I = NTEXT + 1 - TEXT(I:I) = CHAR(0) - -C call the devive driver link routine - IDX = 1 - IA(1) = WKID - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,1,TEXT(1:NTEXT)) - - END IF - - RETURN - - - - ENTRY GPL (N,PX,PY) -C polyline - - FCTID = EPL - IF (STATE .LT. GWSAC) THEN -C GKS not in proper state. GKS must be either in the state -C WSAC or in the state SGOP - ERRNO = 5 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - IF (N .LT. 2) THEN -C number of points is invalid - ERRNO = 100 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IDX = 1 - IA(1) = N -C call the devive driver link routine - CALL GKDDLK(FCTID,IDX,1,IDX,IA,N,PX,N,PY,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GPM (N,PX,PY) -C polymarker - - FCTID = EPM - IF (STATE .LT. GWSAC) THEN -C GKS not in proper state. GKS must be either in the state -C WSAC or in the state SGOP - ERRNO = 5 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (N .LT. 1) THEN -C number of points is invalid - ERRNO = 100 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IDX = 1 - IA(1) = N -C call the devive driver link routine - CALL GKDDLK(FCTID,IDX,1,IDX,IA,N,PX,N,PY,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GTX (QX,QY,CHARS) -C text - - FCTID = ETX - IF (STATE .LT. GWSAC) THEN -C GKS not in proper state. GKS must be either in the state -C WSAC or in the state SGOP - ERRNO = 5 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - NTEXT = MIN(LEN(CHARS),MAXSTR-1) - DO 9 I = 1,NTEXT - IF (CHARS(I:I) .NE. CHAR(NBSP)) THEN - TEXT(I:I) = CHARS(I:I) - ELSE - TEXT(I:I) = ' ' - END IF - 9 CONTINUE - I = NTEXT + 1 - TEXT(I:I) = CHAR(0) - - IDX = 0 - R1(1) = QX - R2(1) = QY -C call the devive driver link routine - CALL GKDDLK(FCTID,IDX,0,0,IA,1,R1,1,R2,1,TEXT(1:NTEXT)) - - END IF - - RETURN - - - - ENTRY GTXS (QX,QY,NCHARS,CHARS) -C text (FORTRAN 77 subset) - - FCTID = ETX - IF (STATE .LT. GWSAC) THEN -C GKS not in proper state. GKS must be either in the state -C WSAC or in the state SGOP - ERRNO = 5 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - NTEXT = MIN(NCHARS,MAXSTR-1) - DO 10 I = 1,NTEXT - IF (CHARS(I:I) .NE. CHAR(NBSP)) THEN - TEXT(I:I) = CHARS(I:I) - ELSE - TEXT(I:I) = ' ' - END IF - 10 CONTINUE - I = NTEXT + 1 - TEXT(I:I) = CHAR(0) - - IDX = 0 - R1(1) = QX - R2(1) = QY -C call the devive driver link routine - CALL GKDDLK(FCTID,IDX,0,0,IA,1,R1,1,R2,1,TEXT(1:NTEXT)) - - END IF - - RETURN - - - - ENTRY GFA (N,PX,PY) -C fill area - - FCTID = EFA - IF (STATE .LT. GWSAC) THEN -C GKS not in proper state. GKS must be either in the state -C WSAC or in the state SGOP - ERRNO = 5 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (N .LT. 3) THEN -C number of points is invalid - ERRNO = 100 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IDX = 1 - IA(1) = N -C call the devive driver link routine - CALL GKDDLK(FCTID,IDX,1,IDX,IA,N,PX,N,PY,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GCA (QX,QY,RX,RY,DX,DY,SCOL,SROW,NCOL,NROW,COLIA) -C cell array - - FCTID = ECA - IF (STATE .LT. GWSAC) THEN -C GKS not in proper state. GKS must be either in the state -C WSAC or in the state SGOP - ERRNO = 5 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (DX .LT. 1 .OR. DY .LT. 1) THEN -C dimensions of color index array are invalid - ERRNO = 84 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - R1(1) = QX - R2(1) = QY - R1(2) = RX - R2(2) = RY - CALL GKDDLK(FCTID,NCOL,NROW,DX,COLIA(SCOL,SROW), - * 2,R1,2,R2,0,C) - - END IF - END IF - - RETURN - - - - ENTRY GSASF (FLAG) -C set aspect source flags - - FCTID = ESASF - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - DO 13 I = 1,13 - ASF(I) = FLAG(I) - 13 CONTINUE - - END IF - - RETURN - - - - ENTRY GSPLI (INDEX) -C set polyline index - - FCTID = ESPLI - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (INDEX .LT. 1 .OR. INDEX .GT. 5) THEN -C Polyline index is invalid - ERRNO = 60 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - LINDEX = INDEX -C call the devive driver link routine - IDX = 1 - IA(1) = INDEX - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSLN (TYPE) -C set linetype - - FCTID = ESLN - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C this implementation supports eight linetypes -C not defined by GKS Version 7.4 - IF (TYPE .LT. -30 .OR. TYPE .EQ. 0 .OR. TYPE .GT. GLDASD) THEN -C Linetype is invalid - ERRNO = 62 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (TYPE .NE. LTYPE) THEN - - LTYPE = TYPE -C call the devive driver link routine - IDX = 1 - IA(1) = TYPE - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSLWSC (WIDTH) -C set linewidth scale factor - - FCTID = ESLWSC - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (WIDTH .NE. LWIDTH) THEN - - LWIDTH = WIDTH -C call the devive driver link routine - IDX = 0 - LR1 = 1 - R1(1) = WIDTH - LR2 = 0 - CALL GKDDLK(FCTID,IDX,0,0,IA,LR1,R1,LR2,R2,LC,C) - - END IF - - RETURN - - - - ENTRY GSPLCI (INDEX) -C set polyline color index - - FCTID = ESPLCI - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (INDEX .LT. 0) THEN -C color index is invalid - ERRNO = 65 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (INDEX .NE. PLCOLI) THEN - - PLCOLI = INDEX -C call the devive driver link routine - IDX = 1 - IA(1) = INDEX - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSPMI (INDEX) -C set polymarker index - - FCTID = ESPMI - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (INDEX .LT. 1 .OR. INDEX .GT. 5) THEN -C Polymarker index is invalid - ERRNO = 64 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - MINDEX = INDEX -C call the devive driver link routine - IDX = 1 - IA(1) = INDEX - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSMK (TYPE) -C set marker TYPE - - FCTID = ESMK - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (TYPE .GE. -114 .AND. TYPE .LE. -101) THEN - ITYPE = GRALMK(TYPE) - ELSE - ITYPE = TYPE - END IF -C this implementation supports twenty marker types -C not defined by GKS Version 7.4 - IF (ITYPE.LT.-20 .OR. ITYPE.EQ.0 .OR. ITYPE.GT.GXMARK) THEN -C marker type is invalid - ERRNO = 66 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (ITYPE .NE. MTYPE) THEN - - MTYPE = ITYPE -C call the devive driver link routine - IDX = 1 - IA(1) = ITYPE - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSMKSC (FACTOR) -C set marker size scale factor - - FCTID = ESMKSC - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (FACTOR .NE. MSZSC) THEN - - MSZSC = FACTOR -C call the devive driver link routine - IDX = 0 - LR1 = 1 - R1(1) = FACTOR - LR2 = 0 - CALL GKDDLK(FCTID,IDX,0,0,IA,LR1,R1,LR2,R2,LC,C) - - END IF - - RETURN - - - - ENTRY GSPMCI (INDEX) -C set polymarker color index - - FCTID = ESPMCI - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (INDEX .LT. 0) THEN -C color index is invalid - ERRNO = 85 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (INDEX .NE. PMCOLI) THEN - - PMCOLI = INDEX -C call the devive driver link routine - IDX = 1 - IA(1) = INDEX - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSTXI (INDEX) -C set text index - - FCTID = ESTXI - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (INDEX .LT. 1 .OR. INDEX .GT. 6) THEN -C Text index is invalid - ERRNO = 68 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - TINDEX = INDEX -C call the devive driver link routine - IDX = 1 - IA(1) = INDEX - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSTXFP (FONT,PREC) -C set text font and precision - - FCTID = ESTXFP - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (FONT .EQ. 0) THEN -C text font is invalid - ERRNO = 70 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (FONT .NE. TXFONT .OR. PREC .NE. TXPREC) THEN - - TXFONT = FONT - TXPREC = PREC -C call the devive driver link routine - IDX = 2 - IA(1) = FONT - IA(2) = PREC - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSCHXP (FACTOR) -C set character expansion factor - - FCTID = ESCHXP - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (FACTOR .LE. 0.) THEN -C character expansion factor is invalid - ERRNO = 72 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (FACTOR .NE. CHXP) THEN - - CHXP = FACTOR -C call the devive driver link routine - IDX = 0 - LR1 = 1 - R1(1) = FACTOR - LR2 = 0 - CALL GKDDLK(FCTID,IDX,0,0,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSCHSP (SPACE) -C set character spacing - - FCTID = ESCHSP - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (SPACE .NE. CHSP) THEN - - CHSP = SPACE -C call the devive driver link routine - IDX = 0 - LR1 = 1 - R1(1) = SPACE - LR2 = 0 - CALL GKDDLK(FCTID,IDX,0,0,IA,LR1,R1,LR2,R2,LC,C) - - END IF - - RETURN - - - - ENTRY GSTXCI (INDEX) -C set text color index - - FCTID = ESTXCI - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (INDEX .LT. 0) THEN -C color index is invalid - ERRNO = 85 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (INDEX .NE. TXCOLI) THEN - - TXCOLI = INDEX -C call the devive driver link routine - IDX = 1 - IA(1) = INDEX - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSCHH (HEIGHT) -C set character height - - FCTID = ESCHH - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (HEIGHT .LE. 0.) THEN -C character height is invalid - ERRNO = 73 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (HEIGHT .NE. CHH) THEN - - CHH = HEIGHT -C call the devive driver link routine - IDX = 0 - LR1 = 1 - R1(1) = HEIGHT - LR2 = 0 - CALL GKDDLK(FCTID,IDX,0,0,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSCHUP (UX,UY) -C set character up vector - - FCTID = ESCHUP - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (ABS(UX) .LE. FEPS .AND. ABS(UY) .LE. FEPS) THEN -C character up vector is invalid - ERRNO = 74 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (UX .NE. CHUP(1) .OR. UY .NE. CHUP(2)) THEN - - CHUP(1) = UX - CHUP(2) = UY -C call the devive driver link routine - IDX = 0 - LR1 = 1 - R1(1) = UX - LR2 = 1 - R2(1) = UY - CALL GKDDLK(FCTID,IDX,0,0,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSTXP (PATH) -C set text path - - FCTID = ESTXP - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (PATH .NE. TXP) THEN - - TXP = PATH -C call the devive driver link routine - IDX = 1 - IA(1) = PATH - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - - RETURN - - - - ENTRY GSTXAL (ALH,ALV) -C set text alignment - - FCTID = ESTXAL - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (ALH .NE. TXAL(1) .OR. ALV .NE. TXAL(2)) THEN - - TXAL(1) = ALH - TXAL(2) = ALV -C call the devive driver link routine - IDX = 2 - IA(1) = ALH - IA(2) = ALV - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - - RETURN - - - - ENTRY GSFAI (INDEX) -C set fill area index - - FCTID = ESFAI - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (INDEX .LT. 1 .OR. INDEX .GT. 5) THEN -C Fill area index is invalid - ERRNO = 75 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - FINDEX = INDEX -C call the devive driver link routine - IDX = 1 - IA(1) = INDEX - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSFAIS (STYLE) -C set fill area interior style - - FCTID = ESFAIS - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (STYLE .NE. INTS) THEN - - INTS = STYLE -C call the devive driver link routine - IDX = 1 - IA(1) = STYLE - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - - RETURN - - - - ENTRY GSFASI (INDEX) -C set fill area style index - - FCTID = ESFASI - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (INDEX .GE. -106 .AND. INDEX .LE. -101) THEN - ISTYLE = GRALHA(INDEX) - ELSE IF (INDEX .GE. -6 .AND. INDEX .LE. -1) THEN - ISTYLE = GDDMHA(INDEX) - ELSE - ISTYLE = INDEX - END IF - - IF (ISTYLE .LT. 0) THEN -C style index is invalid - ERRNO = 78 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (ISTYLE .NE. STYLI) THEN - - STYLI = ISTYLE -C call the devive driver link routine - IDX = 1 - IA(1) = ISTYLE - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSFACI (INDEX) -C set fill area color index - - FCTID = ESFACI - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the states -C GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (INDEX .LT. 0) THEN -C color index is invalid - ERRNO = 85 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (INDEX .NE. FACOLI) THEN - - FACOLI = INDEX -C call the devive driver link routine - IDX = 1 - IA(1) = INDEX - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSCR (WKID,CI,CR,CG,CB) -C set color representation - - FCTID = ESCR - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the -C states GKOP,WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (CI .LT. 0) THEN -C color index is invalid - ERRNO = 85 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (CR .LT. 0. OR. CR .GT. 1. .OR. - * CG .LT. 0. OR. CG .GT. 1. .OR. - * CB .LT. 0. OR. CB .GT. 1.) THEN -C color is invalid - ERRNO = 88 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 2 - IA(1) = WKID - IA(2) = CI - LR1 = 3 - R1(1) = CR - R1(2) = CG - R1(3) = CB - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - END IF - END IF - END IF - - RETURN - - - - ENTRY GSWN (TNR,XMIN,XMAX,YMIN,YMAX) -C set window - - FCTID = ESWN - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the -C states GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (TNR .LT. 1 .OR. TNR .GT. MXNTNR) THEN -C transformation number is invalid - ERRNO = 50 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (XMIN .GE. XMAX .OR. YMIN .GE. YMAX) THEN -C rectangle definition is invalid - ERRNO = 51 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - WINDOW(1,TNR) = XMIN - WINDOW(2,TNR) = XMAX - WINDOW(3,TNR) = YMIN - WINDOW(4,TNR) = YMAX -C set up normalization transformation - CALL GSNT (TNR,WINDOW(1,TNR),VIEWPT(1,TNR)) - -C call the devive driver link routine - IDX = 1 - IA(1) = TNR - LR1 = 2 - R1(1) = XMIN - R1(2) = XMAX - LR2 = 2 - R2(1) = YMIN - R2(2) = YMAX - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - END IF - - RETURN - - - - ENTRY GSVP (TNR,XMIN,XMAX,YMIN,YMAX) -C set viewport - - FCTID = ESVP - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the -C states GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (TNR .LT. 1 .OR. TNR .GT. MXNTNR) THEN -C transformation number is invalid - ERRNO = 50 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (XMIN .GE. XMAX .OR. YMIN .GE. YMAX) THEN -C rectangle definition is invalid - ERRNO = 51 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (XMIN .LT. 0. .OR. XMAX .GT. 1. .OR. - * YMIN .LT. 0. .OR. YMAX .GT. 1.) THEN -C viewport is not within the NDC unit square - ERRNO = 52 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - VIEWPT(1,TNR) = XMIN - VIEWPT(2,TNR) = XMAX - VIEWPT(3,TNR) = YMIN - VIEWPT(4,TNR) = YMAX -C set up normalization transformation - CALL GSNT (TNR,WINDOW(1,TNR),VIEWPT(1,TNR)) - -C call the devive driver link routine - IDX = 1 - IA(1) = TNR - LR1 = 2 - R1(1) = XMIN - R1(2) = XMAX - LR2 = 2 - R2(1) = YMIN - R2(2) = YMAX - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - END IF - END IF - - RETURN - - - - ENTRY GSELNT (TNR) -C select normalization transformation - - FCTID = ESELNT - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the -C states GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (TNR .LT. 0 .OR. TNR .GT. MXNTNR) THEN -C transformation number is invalid - ERRNO = 50 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (TNR .NE. CNTNR) THEN - - CNTNR = TNR -C call the devive driver link routine - IDX = 1 - IA(1) = TNR - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - - RETURN - - - - ENTRY GSCLIP (CLSW) -C set clipping indicator - - FCTID = ESCLIP - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the -C states GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE IF (CLSW .NE. CLIP) THEN - - CLIP = CLSW -C call the devive driver link routine - IDX = 1 - IA(1) = CLSW - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - - RETURN - - - - ENTRY GSWKWN (WKID,XMIN,XMAX,YMIN,YMAX) -C set workstation window - - FCTID = ESWKWN - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (XMIN .GE. XMAX .OR. YMIN .GE. YMAX) THEN -C rectangle definition is invalid - ERRNO = 51 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (XMIN .LT. 0. .OR. XMAX .GT. 1. .OR. - * YMIN .LT. 0. .OR. YMAX .GT. 1.) THEN -C workstation window is not within the NDC unit square - ERRNO = 53 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 1 - IA(1) = WKID - LR1 = 2 - R1(1) = XMIN - R1(2) = XMAX - LR2 = 2 - R2(1) = YMIN - R2(2) = YMAX - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - END IF - END IF - END IF - - RETURN - - - - ENTRY GSWKVP (WKID,XMIN,XMAX,YMIN,YMAX) -C set workstation viewport - - FCTID = ESWKVP - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (XMIN .GE. XMAX .OR. YMIN .GE. YMAX) THEN -C rectangle definition is invalid - ERRNO = 51 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 1 - IA(1) = WKID - LR1 = 2 - R1(1) = XMIN - R1(2) = XMAX - LR2 = 2 - R2(1) = YMIN - R2(2) = YMAX - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - END IF - END IF - END IF - END IF - - RETURN - - - - ENTRY GINLC (WKID,LCDNR,TNR,QX,QY,TYPE,XMIN,XMAX,YMIN,YMAX, - * LDR,DATREC) -C initialize locator - - FCTID = EINLC - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 4 - IA(1) = WKID - IA(2) = LCDNR - IA(3) = TNR - IA(4) = TYPE - LR1 = 3 - R1(1) = QX - R1(2) = XMIN - R1(3) = XMAX - LR2 = 3 - R2(1) = QY - R2(2) = YMIN - R2(3) = YMAX - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,1,DATREC(1)) - - END IF - END IF - END IF - - RETURN - - - - ENTRY GRQLC (WKID,LCDNR,STAT,TNR,QX,QY) -C request locator - - FCTID = ERQLC - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 2 - IA(1) = WKID - IA(2) = LCDNR - LR1 = 1 - LR2 = 1 - R1(1) = QX - R2(1) = QY - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - STAT = IA(1) - TNR = 0 - QX = R1(1) - QY = R2(1) - END IF - END IF - END IF - - RETURN - - - - ENTRY GRQSK (WKID,SKDNR,N,STAT,TNR,NP,SX,SY) -C request stroke - - FCTID = ERQSK - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 3 - IA(1) = WKID - IA(2) = SKDNR - IA(3) = N - LR1 = N - LR2 = N - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,SX,LR2,SY,LC,C) - STAT = IA(1) - TNR = 0 - NP = IA(3) - END IF - END IF - END IF - - RETURN - - - - ENTRY GRQST (WKID,STDNR,STAT,LOSTR,STR) -C request string - - FCTID = ERQST - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 2 - IA(1) = WKID - IA(2) = STDNR - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,1,STR) - STAT = IA(1) - LOSTR = IA(2) - END IF - END IF - END IF - - RETURN - - - - ENTRY GCRSG (SEGN) -C create segment - - FCTID = ECRSG - IF (STATE .NE. GWSAC) THEN -C GKS not in proper state. GKS must be in the state WSAC - ERRNO = 3 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 1 - IA(1) = SEGN - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - STATE = GSGOP - OPSG = SEGN - -C save segment attributes - DO 20, I = 1,20 - SGATTR(I) = GKSL(I) - 20 CONTINUE - - END IF - - RETURN - - - - ENTRY GASGWK (WKID, SEGN) -C associate segment with workstation - - ENTRY GCSGWK (WKID, SEGN) -C copy segment to workstation - - FCTID = ECSGWK - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. WISS) THEN -C WISS is not open - ERRNO = 27 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SACWS,MNACWS, WKID)) THEN -C specified workstation is not active - ERRNO = 30 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C save GKS attributes, restore segment attributes - DO 30, I = 1,20 - GKATTR(I) = GKSL(I) - GKSL(I) = SGATTR(I) - 30 CONTINUE - -C copy segment - CALL GKCSG(WKID, SEGN, MIA, MR1, MR2, MC, 0) - -C restore saved GKS attributes - DO 32, I = 1,20 - GKSL(I) = GKATTR(I) - 32 CONTINUE - - END IF - END IF - END IF - END IF - - RETURN - - - - ENTRY GRSGWK (WKID) -C redraw all segments on workstation - - FCTID = ERSGWK - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WISS) THEN - - IF (.NOT. GANY (SACWS,MNACWS, WKID)) THEN -C specified workstation is not active - ERRNO = 30 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C save GKS attributes, restore segment attributes - DO 40, I = 1,20 - GKATTR(I) = GKSL(I) - GKSL(I) = SGATTR(I) - 40 CONTINUE - -C redraw segments - CALL GKCSG(WKID, 0, MIA, MR1, MR2, MC, 1) - -C restore saved GKS attributes - DO 42, I = 1,20 - GKSL(I) = GKATTR(I) - 42 CONTINUE - - END IF - END IF - END IF - END IF - - RETURN - - - - ENTRY GCLSG -C close segment - - FCTID = ECLSG - IF (STATE .NE. GSGOP) THEN -C GKS not in proper state. GKS must be in the state SGOP - ERRNO = 4 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 0 - MIA = 0 - MR1 = 0 - MR2 = 0 - MC = 0 - CALL GKDDLK(FCTID,IDX,1,MIA,IA,MR1,R1,MR2,R2,MC,C) - - STATE = GWSAC - - END IF - - RETURN - - - - ENTRY GEVTM (X0,Y0,TX,TY,PHI,FX,FY,ISW,TRAN) -C evaluate transformation matrix - - FCTID = EEVTM - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the -C states GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (ISW .EQ. GWC) THEN - - XORG = 0 - YORG = 0 - CALL GNT(XORG,YORG,CNTNR) - - XPOINT = X0 - YPOINT = Y0 - CALL GNT(XPOINT,YPOINT,CNTNR) - - XSHIFT = TX - YSHIFT = TY - CALL GNT(XSHIFT,YSHIFT,CNTNR) - - XSHIFT = XSHIFT - XORG - YSHIFT = YSHIFT - YORG - - ELSE - - XPOINT = X0 - YPOINT = Y0 - XSHIFT = TX - YSHIFT = TY - - END IF - - COSF = COS(PHI) - SINF = SIN(PHI) - - TRAN(1,1) = FX * COSF - TRAN(1,2) = FX * SINF - TRAN(2,1) = -FY * SINF - TRAN(2,2) = FY * COSF - TRAN(1,3) = XPOINT + XSHIFT - XPOINT * TRAN(1,1) - - * YPOINT * TRAN(2,1) - TRAN(2,3) = YPOINT + YSHIFT - XPOINT * TRAN(1,2) - - * YPOINT * TRAN(2,2) - - END IF - - RETURN - - - - ENTRY GSSGT (SEGN,TRAN) -C set segment transformation - - FCTID = ESSGT - IF (STATE .LT. GGKOP) THEN -C GKS not in proper state. GKS must be in one of the -C states GKOP,WSOP,WSAC,SGOP - ERRNO = 8 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE -C set up segment transformation - MAT(1,1) = TRAN(1,1) - MAT(1,2) = TRAN(1,2) - MAT(2,1) = TRAN(2,1) - MAT(2,2) = TRAN(2,2) - MAT(1,3) = TRAN(1,3) - MAT(2,3) = TRAN(2,3) - CALL GSST (MAT) - - END IF - - RETURN - - - ENTRY GESC (FUNID, DIMIDR, IDR, MAXODR, LENODR, ODR) -C escape - - TEXT = IDR(1) - - IF (FUNID .EQ. -400) THEN -C inquire input terminator - LENODR = 1 - ODR(1) = CHAR(IA(4)) - ELSE - LENODR = 0 - END IF - - RETURN - - - ENTRY GRQCH (WKID, CHDNR, STAT, CHNR) - - IA(1) = WKID - IA(2) = CHDNR - CHNR = 0 - - RETURN - - - ENTRY GDSG (SEGN) - - IA(1) = SEGN - - RETURN - - - ENTRY GGTITM (WKID,TYPE,LENODR) - - FCTID = EGTITM - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - WKIND = GORD (SOPWS,MNOPWS,WKID) - IF (SOPWS(WKIND,3) .NE. 3) THEN -C specified workstation is not of category MI - ERRNO = 34 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 1 - IA(1) = WKID - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,LC,C) - - TYPE = IA(1) - LENODR = IA(2) - - END IF - END IF - END IF - END IF - - RETURN - - - ENTRY GRDITM (WKID,LENIDR,MAXODR,ODR) - - FCTID = ERDITM - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (WKID .LE. 0) THEN -C specified workstation identifier is invalid - ERRNO = 20 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (.NOT. GANY (SOPWS,MNOPWS, WKID)) THEN -C specified workstation is not open - ERRNO = 25 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - WKIND = GORD (SOPWS,MNOPWS,WKID) - IF (SOPWS(WKIND,3) .NE. 3) THEN -C specified workstation is not of category MI - ERRNO = 34 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 3 - IA(1) = WKID - IA(2) = LENIDR - IA(3) = MAXODR - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,MAXODR,ODR) - - END IF - END IF - END IF - END IF - - RETURN - - - ENTRY GIITM (TYPE,LENIDR,DIMIDR,IDR) - - FCTID = EIITM - IF (STATE .LT. GWSOP) THEN -C GKS not in proper state. GKS must be in one of the -C states WSOP,WSAC,SGOP - ERRNO = 7 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (TYPE .LE. 0) THEN -C item type is not a valid GKS item - ERRNO = 164 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (LENIDR .LT. 8) THEN -C item length is invalid - ERRNO = 161 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - - IF (DIMIDR .LT. 1) THEN -C metafile item is invalid - ERRNO = 163 - CALL GERHND(ERRNO,FCTID,ERRFIL) - - ELSE - -C call the devive driver link routine - IDX = 3 - IA(1) = TYPE - IA(2) = LENIDR - IA(3) = DIMIDR - LR1 = 0 - LR2 = 0 - CALL GKDDLK(FCTID,IDX,1,IDX,IA,LR1,R1,LR2,R2,DIMIDR,IDR) - - END IF - END IF - END IF - END IF - - RETURN - - - ENTRY GSDS (WKID, DEFMOD, IRGMOD) - - IA(1) = WKID - IA(2) = DEFMOD - IA(3) = IRGMOD - - RETURN - - - ENTRY GGDP - - RETURN - END - - - BLOCK DATA GKSDAT - -C GKS symbol definitions - INCLUDE 'gksdefs.i' -C GKS description table - INCLUDE 'gksdescr.i' -C GKS state list - INCLUDE 'gksstate.i' - - SAVE -C operating state value - DATA STATE /0/ -C list of available workstation types - DATA LWSTY / 200, 201, - * 204, 207, 82, 51, - * 53, 72, 16, 17, - * 61, 62, 63, 64, - * 210, 211, 212, 213, - * 214, 215, 216, 217, - * 218, - * 230, 231, 232, 233, - * 7, 8, 5, 41, - * 38, 103, 104, 92, - * 2, 3, 101, 102/ -C workstation categories - DATA WSCAT / 0, 2, - * 2, 2, 2, 0, - * 0, 2, 2, 2, - * 0, 0, 0, 0, - * 0, 2, 2, 2, - * 0, 0, 0, 0, - * 0, - * 0, 2, 2, 2, - * 4, 4, 3, 2, - * 0, 0, 0, 0, - * 4, 5, 0, 0/ -C maximum display surface size (DC) - DATA GDC / 1.0,1.0, 0.256,0.192, - * 0.256,0.192, 0.256,0.192, 0.256,0.192, 0.272,0.19, - * 0.272,0.19, 0.256,0.192, 0.24,0.144, 0.24,0.144, - * 0.28575,0.19685,0.28575,0.19685,0.28575,0.19685,0.28575,0.19685, - * 0.333,0.281, 0.333,0.281, 0.333,0.281, 0.333,0.281, - * 0.333,0.281, 0.333,0.281, 0.333,0.281, 0.333,0.281, - * 0.333,0.281, - * 0.333,0.281, 0.333,0.281, 0.333,0.281, 0.333,0.281, - * 1.0,1.0, 1.0,1.0, 1.0,1.0, 0.333,0.281, - * 0.256,0.192, 0.254,0.2032, 0.254,0.2032, 0.2794,0.2032, - * 1.0,1.0, 1.0,1.0, 0.288,0.1984, 0.288,0.1984/ -C maximum display surface size (raster units) - DATA GRU / 1012,835, 1024,768, - * 1024,768, 1024,768, 1024,768, 10870,7600, - * 10870,7600, 1024,768, 800,480, 800,480, - * 6750,4650, 6750,4650, 6750,4650, 6750,4650, - * 1024,864, 1024,864, 1024,864, 1024,864, - * 1024,864, 1024,864, 1024,864, 1024,864, - * 1024,864, - * 1024,864, 1024,864, 1024,864, 1024,864, - * 65536,65536, 65536,65536, 32767,32767, 1024,864, - * 1024,768, 720,576, 750,600, 1980,1440, - * 65536,65536, 65536,65536, 810,558, 810,558/ - - END - \ No newline at end of file diff -r -N -u gks/dos/GKSINQ.FOR gli-gks/dos/GKSINQ.FOR --- gks/dos/GKSINQ.FOR 2000-11-21 07:16:44.000000000 -0500 +++ gli-gks/dos/GKSINQ.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,680 +0,0 @@ -C* -C* Copyright @ 1984 - 1993 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* -C GKS inquiry functions -C - - SUBROUTINE GQOPS (OPSTA) -C inquire operating state value - - INTEGER NBSP - PARAMETER (NBSP = 160) - - INTEGER MAXSTR - PARAMETER (MAXSTR = 255) - - INTEGER WKID,CONID,WTYPE,WKCAT,WKSTAT,N - REAL QX,QY,RX,RY - CHARACTER*(*) CHARS - INTEGER NCHARS - - INTEGER FLAG(13),INDEX,TYPE,FONT,PREC,PATH,ALH,ALV,STYLE - REAL FACTOR,SPACE,HEIGHT,UX,UY - - INTEGER TNR,CLSW,I - REAL CLRT(4) - - REAL CPX,CPY,TRX(4),TRY(4) - INTEGER SEGN - - INTEGER OFF,ON - PARAMETER (OFF=0,ON=1) - - INTEGER OPSTA,LEV,ERRIND,NUMBER,MAXTNR - INTEGER NCOLI,COLA,NPCI - INTEGER WKIND,DCUNIT,OL,LX,LY - REAL WN(4),VP(4) - - CHARACTER TEXT*255 - INTEGER NTEXT - -C external functions - LOGICAL GANY - INTEGER GORD - -C Predefined text fonts, text precisions, fill area -C interior styles and fill area style indices - INTEGER PFONT(6), PPREC(6), PINTS(5), PSTYLI(5) - -C GKS symbol definitions - INCLUDE 'gksdefs.i' -C GKS description table - INCLUDE 'gksdescr.i' -C GKS state list - INCLUDE 'gksstate.i' - - SAVE - - DATA PFONT /1,1,1,-2,-3,-4/ - DATA PPREC /0,1,2,2,2,2/ - DATA PINTS /0,1,3,3,3/ - DATA PSTYLI /1,1,1,2,3/ - - - OPSTA = STATE - - RETURN - - - - ENTRY GQLVKS (ERRIND,LEV) -C inquire level of GKS - - LEV = LEVEL - ERRIND = OFF - - RETURN - - - - ENTRY GQEWK (N,ERRIND,NUMBER,WTYPE) -C inquire list element of available workstation types - - IF (N .LT. 1 .OR. N .GT. NWSTY) THEN - ERRIND = ON - ELSE - NUMBER = NWSTY - WTYPE = LWSTY(N) - ERRIND = OFF - END IF - - RETURN - - - - ENTRY GQMNTN (ERRIND,MAXTNR) -C inquire maximum normalization transformation number - - MAXTNR = MXNTNR - ERRIND = OFF - - RETURN - - - - ENTRY GQOPWK (N,ERRIND,OL,WKID) -C inquire set member of open workstations - - IF (N .LT. 1 .OR. N .GT. MNOPWS) THEN - ERRIND = ON - ELSE - CALL GNUM (SOPWS,MNOPWS,OL) - WKID = SOPWS(N,1) - ERRIND = OFF - END IF - - RETURN - - - - ENTRY GQACWK (N,ERRIND,OL,WKID) -C inquire set member of active workstations - - IF (N .LT. 1 .OR. N .GT. MNACWS) THEN - ERRIND = ON - ELSE - CALL GNUM (SACWS,MNACWS,OL) - WKID = SACWS(N) - ERRIND = OFF - END IF - - RETURN - - - - ENTRY GQCHH (ERRIND,HEIGHT) -C inquire character height - - HEIGHT = CHH - ERRIND = OFF - - RETURN - - - - ENTRY GQCHUP (ERRIND,UX,UY) -C inquire character up vector - - UX = CHUP(1) - UY = CHUP(2) - ERRIND = OFF - - RETURN - - - - ENTRY GQTXP (ERRIND,PATH) -C inquire text path - - PATH = TXP - ERRIND = OFF - - RETURN - - - - ENTRY GQTXAL (ERRIND,ALH,ALV) -C inquire text alignment - - ALH = TXAL(1) - ALV = TXAL(2) - ERRIND = OFF - - RETURN - - - - ENTRY GQASF (ERRIND,FLAG) -C inquire aspect source flags - - DO 1 I = 1,13 - FLAG(I) = ASF(I) - 1 CONTINUE - ERRIND = OFF - - RETURN - - - - ENTRY GQPLI (ERRIND,INDEX) -C inquire polyline index - - INDEX = LINDEX - ERRIND = OFF - - RETURN - - - - ENTRY GQLN (ERRIND,TYPE) -C inquire line type - - IF (KERNEL) THEN - IF (ASF(1) .EQ. GINDIV) THEN - TYPE = LTYPE - ELSE - TYPE = LINDEX - END IF - ELSE - TYPE = LTYPE - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQLWSC (ERRIND,FACTOR) -C inquire linewidth scale factor - - IF (KERNEL) THEN - IF (ASF(2) .EQ. GINDIV) THEN - FACTOR = LWIDTH - ELSE - FACTOR = 1.0 - END IF - ELSE - FACTOR = LWIDTH - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQPLCI (ERRIND,INDEX) -C inquire polyline color index - - IF (KERNEL) THEN - IF (ASF(3) .EQ. GINDIV) THEN - INDEX = PLCOLI - ELSE - INDEX = 1 - END IF - ELSE - INDEX = PLCOLI - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQPMI (ERRIND,INDEX) -C inquire polymarker index - - INDEX = MINDEX - ERRIND = OFF - - RETURN - - - - ENTRY GQMK (ERRIND,TYPE) -C inquire marker type - - IF (KERNEL) THEN - IF (ASF(4) .EQ. GINDIV) THEN - TYPE = MTYPE - ELSE - TYPE = MINDEX - END IF - ELSE - TYPE = MTYPE - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQMKSC (ERRIND,FACTOR) -C inquire marker size scale factor - - IF (KERNEL) THEN - IF (ASF(5) .EQ. GINDIV) THEN - FACTOR = MSZSC - ELSE - FACTOR = 1.0 - END IF - ELSE - FACTOR = MSZSC - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQPMCI (ERRIND,INDEX) -C inquire polymarker color index - - IF (KERNEL) THEN - IF (ASF(6) .EQ. GINDIV) THEN - INDEX = PMCOLI - ELSE - INDEX = 1 - END IF - ELSE - INDEX = PMCOLI - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQTXI (ERRIND,INDEX) -C inquire text index - - INDEX = TINDEX - ERRIND = OFF - - RETURN - - - - ENTRY GQTXFP (ERRIND,FONT,PREC) -C inquire text font and precision - - IF (KERNEL) THEN - IF (ASF(7) .EQ. GINDIV) THEN - FONT = TXFONT - PREC = TXPREC - ELSE - FONT = PFONT(TINDEX) - PREC = PPREC(TINDEX) - END IF - ELSE - FONT = TXFONT - PREC = TXPREC - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQCHXP (ERRIND,FACTOR) -C inquire character expansion factor - - IF (KERNEL) THEN - IF (ASF(8) .EQ. GINDIV) THEN - FACTOR = CHXP - ELSE - FACTOR = 1.0 - END IF - ELSE - FACTOR = CHXP - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQCHSP (ERRIND,SPACE) -C inquire character spacing - - IF (KERNEL) THEN - IF (ASF(9) .EQ. GINDIV) THEN - SPACE = CHSP - ELSE - SPACE = 0.0 - END IF - ELSE - SPACE = CHSP - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQTXCI (ERRIND,INDEX) -C inquire text color index - - IF (KERNEL) THEN - IF (ASF(10) .EQ. GINDIV) THEN - INDEX = TXCOLI - ELSE - INDEX = 1 - END IF - ELSE - INDEX = TXCOLI - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQFAI (ERRIND,INDEX) -C inquire fill area index - - INDEX = FINDEX - ERRIND = OFF - - RETURN - - - - ENTRY GQFAIS (ERRIND,STYLE) -C inquire fill area interior style - - IF (KERNEL) THEN - IF (ASF(11) .EQ. GINDIV) THEN - STYLE = INTS - ELSE - STYLE = PINTS(FINDEX) - END IF - ELSE - STYLE = INTS - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQFASI (ERRIND,INDEX) -C inquire fill area style index - - IF (KERNEL) THEN - IF (ASF(12) .EQ. GINDIV) THEN - INDEX = STYLI - ELSE - INDEX = PSTYLI(FINDEX) - END IF - ELSE - INDEX = STYLI - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQFACI (ERRIND,INDEX) -C inquire fill area color index - - IF (KERNEL) THEN - IF (ASF(13) .EQ. GINDIV) THEN - INDEX = FACOLI - ELSE - INDEX = 1 - END IF - ELSE - INDEX = FACOLI - END IF - ERRIND = OFF - - RETURN - - - - ENTRY GQCNTN (ERRIND,TNR) -C inquire current normalization transformation number - - TNR = CNTNR - ERRIND = OFF - - RETURN - - - - ENTRY GQNT (TNR,ERRIND,WN,VP) -C inquire normalization transformation - - IF (TNR .LT. 0 .OR. TNR .GT. MXNTNR) THEN - ERRIND = ON - ELSE - DO 2 I = 1,4 - WN(I) = WINDOW(I,TNR) - VP(I) = VIEWPT(I,TNR) - 2 CONTINUE - ERRIND = OFF - END IF - - RETURN - - - - ENTRY GQCLIP (ERRIND,CLSW,CLRT) -C inquire clipping indicator - - CLSW = CLIP - - DO 3 I = 1,4 - IF (CLSW .EQ. GCLIP) THEN - CLRT(I) = VIEWPT(I,CNTNR) - ELSE - CLRT(I) = VIEWPT(I,0) - END IF - 3 CONTINUE - - ERRIND = OFF - - RETURN - - - - ENTRY GQWKC (WKID,ERRIND,CONID,WTYPE) -C inquire workstation connection and type - - IF (.NOT. GANY(SOPWS,MNOPWS,WKID)) THEN - ERRIND = ON - ELSE - WKIND = GORD(SOPWS,MNOPWS,WKID) - CONID = SOPWS(WKIND,2) - WTYPE = SOPWS(WKIND,3) - ERRIND = OFF - END IF - - RETURN - - - - ENTRY GQWKS (WKID,ERRIND,WKSTAT) -C inquire workstation state - - IF (.NOT. GANY(SOPWS,MNOPWS,WKID)) THEN - ERRIND = ON - ELSE - IF (GANY(SACWS,MNACWS,WKID)) THEN - WKSTAT = GACTIV - ELSE - WKSTAT = GINACT - END IF - ERRIND = OFF - END IF - - RETURN - - - - ENTRY GQWKCA (WTYPE,ERRIND,WKCAT) -C inquire workstation category - - IF (.NOT. GANY(LWSTY,NWSTY,WTYPE)) THEN - ERRIND = ON - ELSE - WKIND = GORD(LWSTY,NWSTY,WTYPE) - WKCAT = WSCAT(WKIND) - ERRIND = OFF - END IF - - RETURN - - - - ENTRY GQCF (WTYPE,ERRIND,NCOLI,COLA,NPCI) -C inquire workstation category - - IF (.NOT. GANY(LWSTY,NWSTY,WTYPE)) THEN - ERRIND = ON - ELSE - NCOLI = 980 - COLA = GCOLOR - NPCI = 8 - ERRIND = OFF - END IF - - RETURN - - - - ENTRY GQDSP (WTYPE,ERRIND,DCUNIT,RX,RY,LX,LY) -C inquire display space size - ENTRY GQMDS (WTYPE,ERRIND,DCUNIT,RX,RY,LX,LY) -C inquire maximum display surface - - IF (.NOT. GANY(LWSTY,NWSTY,WTYPE)) THEN - ERRIND = ON - ELSE - WKIND = GORD(LWSTY,NWSTY,WTYPE) - DCUNIT = GMETRE - RX = GDC(1,WKIND) - RY = GDC(2,WKIND) - LX = GRU(1,WKIND) - LY = GRU(2,WKIND) - ERRIND = OFF - END IF - - RETURN - - - - ENTRY GQTXX (WKID,QX,QY,CHARS,ERRIND,CPX,CPY,TRX,TRY) -C inquire text extend - - IF (.NOT. GANY(SOPWS,MNOPWS,WKID)) THEN - ERRIND = ON - ELSE - NTEXT = MIN(LEN(CHARS),MAXSTR-1) - DO 4 I = 1,NTEXT - IF (CHARS(I:I) .NE. CHAR(NBSP)) THEN - TEXT(I:I) = CHARS(I:I) - ELSE - TEXT(I:I) = ' ' - END IF - 4 CONTINUE - I = NTEXT + 1 - TEXT(I:I) = CHAR(0) - CALL GQTEXT (QX,QY,TEXT(1:NTEXT),CPX,CPY,TRX,TRY) - ERRIND = OFF - END IF - - RETURN - - - - ENTRY GQTXXS (WKID,QX,QY,NCHARS,CHARS,ERRIND,CPX,CPY,TRX,TRY) -C inquire text extend (FORTRAN 77 subset) - - IF (.NOT. GANY(SOPWS,MNOPWS,WKID)) THEN - ERRIND = ON - ELSE - NTEXT = MIN(NCHARS,MAXSTR-1) - DO 5 I = 1,NTEXT - IF (CHARS(I:I) .NE. CHAR(NBSP)) THEN - TEXT(I:I) = CHARS(I:I) - ELSE - TEXT(I:I) = ' ' - END IF - 5 CONTINUE - I = NTEXT + 1 - TEXT(I:I) = CHAR(0) - CALL GQTEXT (QX,QY,TEXT(1:NTEXT),CPX,CPY,TRX,TRY) - ERRIND = OFF - END IF - - RETURN - - - ENTRY GQOPSG (ERRIND,SEGN) -C inquire name of open segment - - IF (STATE .EQ. GSGOP) THEN - SEGN = OPSG - ERRIND = OFF - ELSE - ERRIND = ON - END IF - - RETURN - - - ENTRY GQSGWK (WKID,N,ERRIND,OL,SEGN) - - ERRIND = ON - - RETURN - END - \ No newline at end of file diff -r -N -u gks/dos/GKSIO.FOR gli-gks/dos/GKSIO.FOR --- gks/dos/GKSIO.FOR 2000-11-21 07:16:45.000000000 -0500 +++ gli-gks/dos/GKSIO.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,615 +0,0 @@ -C* -C* Copyright @ 1984 - 1994 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* -C* FACILITY: -C* -C* Graphical Kernel System (GKS) -C* -C* ABSTRACT: -C* -C* This module contains some I/O routines for GLI GKS. -C* (Microsoft FORTRAN version) -C* -C* AUTHOR(S): -C* -C* J. Heinen -C* -C* VERSION: -C* -C* V1.0 -C* -C* - - SUBROUTINE OPFONT -C open file with character fonts - - INTEGER FONT, CH, BUFFER(256) - - INTEGER UNIT - PARAMETER (UNIT = 80) - - INTEGER HASHT(0:95) - INTEGER*1 BUF(256), BUFC(256,0:95) - - INTEGER STATUS - INTEGER MAP(24), SMAP(24), GRMAP(24), GKMAP(24), GERMAN(11) - INTEGER*1 ANSI(11), GREEK(14), GMAP(14) - - LOGICAL UMLAUT, SHARPS - INTEGER CHR, OFFSET, FN - - CHARACTER ENV*80, DRIVE(5) - INTEGER L, GKS - - SAVE - - DATA DRIVE / 'C', 'D', 'E', 'A', 'B' / - - DATA MAP / 1, 18, 1, 6, 12, 3, 8, 11, 4, 7, - * 10, 2, 13, 14, 5, 9, 15, 16, 17, 20, - * 21, 19, 22, 23 / - DATA GRMAP / 1, 12, 6, 9, 8, 11, 5, 13, 18, 17, - * 19, 1, 10, 7, 24, 1, 1, 1, 1, 1, - * 1, 1, 23, 24 / - DATA GKMAP / 1, 2, 3, 4, 5, 6, 7, 13, 11, 14, - * 12, 15, 16, 17, 18, 19, 20, 21, 1, 1, - * 1, 1, 23, 24 / - DATA SMAP / 4, 4, 4, 4, 4, 7, 7, 7, 10, 10, - * 10, 7, 7, 7, 4, 4, 7, 7, 7, 4, - * 4, 4, 4, 4 / - - DATA GERMAN / 196, 214, 220, 228, 246, 252, - * 223, 171, 187, 183, 169 / - DATA ANSI / 'A', 'O', 'U', 'a', 'o', 'u', - * 'b', '<', '>', '.', '@' / - DATA GREEK / 'j', 'o', 'q', 'u', 'v', 'w', 'y', - * 'J', 'O', 'Q', 'U', 'V', 'W', 'Y' / - DATA GMAP / ' ', 'w', ' ', 'o', 'y', 'v', 'q', - * ' ', 'W', ' ', 'O', 'Y', 'V', 'Q' / - - CALL GETENV('GLI_HOME', ENV) - IF (ENV(1:1) .EQ. ' ') ENV = 'C:\GKS\' - L = INDEX(ENV, ' ') - 1 - -$IF DEFINED(F77L3) - OPEN (UNIT=UNIT, FILE=ENV(1:L)//'GKSFONT.DAT', - * STATUS='OLD', FORM='UNFORMATTED', ACCESS='TRANSPARENT', - * IOSTAT=STATUS) - DO 15, I = 1, 5 - IF (STATUS .NE. 0) OPEN (UNIT=UNIT, - * FILE=DRIVE(I)//':\GKS\GKSFONT.DAT', STATUS='OLD', - * FORM='UNFORMATTED', ACCESS='TRANSPARENT', - * IOSTAT=STATUS) - 15 CONTINUE -$ELSE - OPEN (UNIT=UNIT, FILE=ENV(1:L)//'GKSFONT.DAT', - * STATUS='OLD', FORM='UNFORMATTED', ACCESS='DIRECT', RECL=256, - * IOSTAT=STATUS) - DO 15, I = 1, 5 - IF (STATUS .NE. 0) OPEN (UNIT=UNIT, - * FILE=DRIVE(I)//':\GKS\GKSFONT.DAT', STATUS='OLD', - * FORM='UNFORMATTED', ACCESS='DIRECT', RECL=256, - * IOSTAT=STATUS) - 15 CONTINUE -$ENDIF - - CALL GETENV ('GLIGKS', ENV) - IF (ENV .EQ. 'GKGKS') THEN - GKS = 2 - ELSE IF (ENV .EQ. 'GKSGRAL') THEN - GKS = 1 - ELSE - GKS = 0 - END IF - - DO 1, I = 1, 256 - HASHT(I) = -1 - 1 CONTINUE - - RETURN - - - ENTRY LOOKUP (FONT, CH, BUFFER) -C inquire character stroke - - CHR = CH - UMLAUT = .FALSE. - SHARPS = .FALSE. - - IF (CHR .GE. 127) THEN - DO 2, I = 1, 11 - IF (CHR. EQ. GERMAN(I)) THEN - CHR = ANSI(I) - IF (I .LE. 6) THEN - UMLAUT = .TRUE. - ELSE IF (I .EQ. 7) THEN - SHARPS = .TRUE. - END IF - END IF - 2 CONTINUE - END IF - - IF (CHR .LT. 32 .OR. CHR .GE. 127) CHR = 32 - - FN = MOD(ABS(FONT), 100) - IF (FN .EQ. 51) THEN - FN = 23 - ELSE IF (FN .GT. 23) THEN - FN = 1 - END IF - - IF (SHARPS) THEN - IF (FN .NE. 23) THEN - FN = SMAP(FN) - ELSE - CHR = 126 - END IF - ELSE IF (GKS .EQ. 1) THEN - IF (FN .EQ. 13 .OR. FN .EQ. 14) THEN - DO 3, I = 1, 14 - IF (CHR .EQ. GREEK(I)) THEN - CHR = GMAP(I) - GO TO 4 - END IF - 3 CONTINUE - 4 END IF - FN = GRMAP(FN) - ELSE IF (GKS .EQ. 2) THEN - FN = GKMAP(FN) - END IF - - CHR = CHR - ICHAR(' ') -$IF DEFINED(F77L3) - OFFSET = 256 * ((MAP(FN) - 1) * 95 + CHR) + 1 -$ELSE - OFFSET = ((MAP(FN) - 1) * 95 + CHR) + 1 -$ENDIF - IF (HASHT(CHR) .NE. OFFSET) THEN - READ (UNIT=UNIT, REC=OFFSET) BUF - DO 5, I = 1, 256 - BUFC(I, CHR) = BUF(I) - 5 CONTINUE - HASHT(CHR) = OFFSET - END IF - - DO 6, I = 1, 256 - BUFFER(I) = BUFC(I, CHR) - 6 CONTINUE - -C append umaut - IF (UMLAUT .AND. BUFFER(8) .LT. 120-20) - * BUFFER(8) = BUFFER(8) + 10 - - RETURN - - - ENTRY CLFONT -C close file with character fonts - - CLOSE (UNIT=UNIT) - - RETURN - END - - - SUBROUTINE BUFIN (CONID, STATUS, TERM, NCHARS, CHARS) - - INTEGER CONID, STATUS, TERM, NCHARS - CHARACTER*(*) CHARS - - IF (TERM .EQ. 0) THEN - READ (CONID, '(A)') CHARS(1:NCHARS) - STATUS = 1 - ELSE - STATUS = 0 - END IF - - RETURN - END - - - SUBROUTINE BUFOUT (CONID, NCHARS, CHARS) - - INTEGER CONID, NCHARS - CHARACTER*(*) CHARS - - INTEGER N - CHARACTER BUF*500, NAME*100, FMT*7 - - INQUIRE (UNIT=CONID, NAME=NAME) - IF (NAME .EQ. 'CON') THEN - FMT = '(1X, A)' - ELSE - FMT = '(A)' - END IF - - N = 0 - DO 1, I = 1, NCHARS - IF (CHARS(I:I) .EQ. CHAR(10) .OR. N .EQ. 500) THEN - IF (N .GT. 0) THEN - WRITE(CONID, FMT) BUF(1:N) - N = 0 - ELSE - WRITE(CONID, FMT) - END IF - ELSE - N = N + 1 - BUF(N:N) = CHARS(I:I) - END IF - 1 CONTINUE - - IF (N .GT. 0) WRITE(CONID, FMT) BUF(1:N) - - RETURN - END - - - SUBROUTINE BINOUT (CONID, NCHARS, CHARS) - - INTEGER CONID, NCHARS - CHARACTER*(*) CHARS - - CHARACTER NAME*100, FORM*20 - INTEGER I, J, K, L - - INQUIRE (UNIT=CONID, NAME=NAME, FORM=FORM) - CLOSE (UNIT=CONID) - -$IF DEFINED(F77L3) - OPEN (UNIT=CONID, FILE=NAME, STATUS='UNKNOWN', - * ACCESS='TRANSPARENT') -$ELSE - OPEN (UNIT=CONID, FILE=NAME, STATUS='UNKNOWN', FORM='BINARY') -$ENDIF - J = 1 - K = 0 - L = NCHARS / 8192 - DO 1, I = 1, L - K = K + 8192 - WRITE (CONID) CHARS(J:K) - J = K + 1 - 1 CONTINUE - IF (K .LT. NCHARS) WRITE (CONID) CHARS(J:NCHARS) - - RETURN - END - - - SUBROUTINE GKINFO (NCHARS, CHARS) - - INTEGER NCHARS - CHARACTER*(*) CHARS - - NCHARS = 0 - CHARS = ' ' - - RETURN - END - - - SUBROUTINE GKMAGS (MAGS, DPI) - - REAL MAGS - INTEGER DPI - - MAGS = 0.0 - DPI = 75 - - RETURN - END - - - SUBROUTINE LIBSIG (STATUS, ARG) - - INTEGER STATUS - CHARACTER*(*) ARG - INTEGER ERRNUM, ERRFIL - - INTEGER ERRLUN, ERRNO - CHARACTER*6 FCTID - - ERRNO = MOD(STATUS/8, 1024) - FCTID = ARG - - GOTO ( 1, 2, 3, 4, 5, 6, 7, 8,999,999, - * 999,999,999,999,999,999,999,999,999, 20, - * 21, 22,999, 24, 25, 26, 27, 28, 29, 30, - * 999,999,999,999,999,999,999,999,999,999, - * 999,999,999,999,999,999,999,999,999, 50, - * 51, 52, 53,999,999,999,999,999,999, 60, - * 999, 62,999, 64, 65, 66,999, 68,999, 70, - * 999, 72, 73, 74, 75,999,999, 78,999,999, - * 81,999,999, 84, 85,999,999, 88,999,999, - * 999,999,999,999,999,999,999,999,999,100), ERRNO - GOTO 999 - - 1 WRITE (ERRLUN, *) ERRNO, 'GKS not in proper state. GKS must be - * in the state GKCL', FCTID - GOTO 999 - - 2 WRITE (ERRLUN, *) ERRNO, 'GKS not in proper state. GKS must be - * in the state GKOP', FCTID - GOTO 999 - - 3 WRITE (ERRLUN, *) ERRNO, 'GKS not in proper state. GKS must be - * in the state WSAC', FCTID - GOTO 999 - - 4 WRITE (ERRLUN, *) ERRNO, 'GKS not in proper state. GKS must be - * in the state SGOP', FCTID - GOTO 999 - - 5 WRITE (ERRLUN, *) ERRNO, 'GKS not in proper state. GKS must be - * either in the state WSAC or SGOP', FCTID - GOTO 999 - - 6 WRITE (ERRLUN, *) ERRNO, 'GKS not in proper state. GKS must be - * either in the state WSOP or WSAC', FCTID - GOTO 999 - - 7 WRITE (ERRLUN, *) ERRNO, 'GKS not in proper state. GKS must be - * in one of the states GKOP,WSOP,WSAC,SGOP', FCTID - GOTO 999 - - 8 WRITE (ERRLUN, *) ERRNO, 'Specified workstation identifier is - * invalid', FCTID - GOTO 999 - - 20 WRITE (ERRLUN, *) ERRNO, 'Specified workstation identifier is - * invalid', FCTID - GOTO 999 - - 21 WRITE (ERRLUN, *) ERRNO, 'Specified connection identifier is - * invalid', FCTID - GOTO 999 - - 22 WRITE (ERRLUN, *) ERRNO, 'Specified workstation type is invalid' - * , FCTID - GOTO 999 - - 24 WRITE (ERRLUN, *) ERRNO, 'Specified workstation is open', FCTID - GOTO 999 - - 25 WRITE (ERRLUN, *) ERRNO, 'Specified workstation is not open' - * , FCTID - GOTO 999 - - 26 WRITE (ERRLUN, *) ERRNO, 'Specified workstation cannot be - * opened', FCTID - GOTO 999 - - 27 WRITE (ERRLUN, *) ERRNO, 'Workstation Independent Segment - * Storage is not open', FCTID - GOTO 999 - - 28 WRITE (ERRLUN, *) ERRNO, 'Workstation Independent Segment - * Storage is already open', FCTID - GOTO 999 - - 29 WRITE (ERRLUN, *) ERRNO, 'Specified workstation is active' - * , FCTID - GOTO 999 - - 30 WRITE (ERRLUN, *) ERRNO, 'Specified workstation is not active' - * , FCTID - GOTO 999 - - 50 WRITE (ERRLUN, *) ERRNO, 'Transformation number is invalid' - * , FCTID - GOTO 999 - - 51 WRITE (ERRLUN, *) ERRNO, 'Rectangle definition is invalid' - * , FCTID - GOTO 999 - - 52 WRITE (ERRLUN, *) ERRNO, 'Viewport is not within the NDC - * unit square', FCTID - GOTO 999 - - 53 WRITE (ERRLUN, *) ERRNO, 'Workstation window is not within - * the NDC unit square', FCTID - GOTO 999 - - 60 WRITE (ERRLUN, *) ERRNO, 'Polyline index is invalid', FCTID - GOTO 999 - - 62 WRITE (ERRLUN, *) ERRNO, 'Linetype is invalid', FCTID - GOTO 999 - - 64 WRITE (ERRLUN, *) ERRNO, 'Polymarker index is invalid', FCTID - GOTO 999 - - 65 WRITE (ERRLUN, *) ERRNO, 'Colour index is invalid', FCTID - GOTO 999 - - 66 WRITE (ERRLUN, *) ERRNO, 'Marker type is invalid', FCTID - GOTO 999 - 68 WRITE (ERRLUN, *) ERRNO, 'Text index is invalid', FCTID - GOTO 999 - - 70 WRITE (ERRLUN, *) ERRNO, 'Text font is invalid', FCTID - GOTO 999 - - 72 WRITE (ERRLUN, *) ERRNO, 'Character expansion factor is invalid' - * , FCTID - GOTO 999 - - 73 WRITE (ERRLUN, *) ERRNO, 'Character height is invalid', FCTID - GOTO 999 - - 74 WRITE (ERRLUN, *) ERRNO, 'Character up vector is invalid' - * , FCTID - GOTO 999 - - 75 WRITE (ERRLUN, *) ERRNO, 'Fill area index is invalid', FCTID - GOTO 999 - - 78 WRITE (ERRLUN, *) ERRNO, 'Style index is invalid', FCTID - GOTO 999 - - 81 WRITE (ERRLUN, *) ERRNO, 'Pattern size value is invalid', FCTID - GOTO 999 - - 84 WRITE (ERRLUN, *) ERRNO, 'Dimensions of colour index array are - * invalid', FCTID - GOTO 999 - - 85 WRITE (ERRLUN, *) ERRNO, 'Colour index is invalid', FCTID - GOTO 999 - - 88 WRITE (ERRLUN, *) ERRNO, 'Colour is invalid', FCTID - GOTO 999 - - 100 WRITE (ERRLUN, *) ERRNO, 'Number of points is invalid', FCTID - GOTO 999 - - 200 FORMAT (1X, 'GKS error ', I4, '. ', A, ' in routine ', A) - - 999 RETURN - - - ENTRY GERSET (ERRNUM, ERRFIL) - - ERRNO = ERRNUM - ERRLUN = ERRFIL - - RETURN - END - - - SUBROUTINE GKFD (CONID) - - INTEGER CONID - - IF (CONID .LT. 0) STOP 'GKS: invalid connection identifier' - - RETURN - END - - - SUBROUTINE GTWSTY (WSTYPE) - - INTEGER WSTYPE - - WSTYPE = 41 - - RETURN - END - - - SUBROUTINE GKLTOI (L, I) - - INTEGER L(2), I(2) - - I(1) = L(1) - I(2) = L(2) - - RETURN - END - - - SUBROUTINE PUTENV (STRING) -C change or add value to environment - - CHARACTER*(*) STRING, NAME, VALUE - - INTEGER MAXENV, MAXSTR - PARAMETER (MAXENV = 20, MAXSTR = 80) - - CHARACTER*80 ENV(MAXENV) - INTEGER I, J, K, N - - SAVE - - DATA N / 0 / - - I = INDEX(STRING, '=') - 1 - IF (I .GT. 0 .AND. I .LT. MAXSTR) THEN - DO 1, J = 1,N - IF (STRING(1:I) .EQ. ENV(N)(1:I)) THEN - K = J - GO TO 2 - END IF - 1 CONTINUE - IF (N .EQ. MAXENV) STOP 'GKS: environment full' - N = N + 1 - K = N - 2 ENV(K) = STRING - END IF - - RETURN - - - ENTRY GETENV (NAME, VALUE) -C get environment variable - - VALUE = ' ' - I = LEN(NAME) - IF (I .GT. 0 .AND. I .LT. MAXSTR) THEN - DO 3, J = 1,N - IF (NAME .EQ. ENV(J)(1:I)) THEN - VALUE = ENV(J)(I+2:) - GO TO 4 - END IF - 3 CONTINUE - END IF - - 4 RETURN - END - - - SUBROUTINE DPSOP (SIZEX, SIZEY, FMT) -C initiate Display PostScript environment - - REAL SIZEX, SIZEY - INTEGER FMT, NCHARS - CHARACTER*(*) CHARS - - WRITE(*, *) SIZEX, SIZEY, FMT - - STOP 'GKS: Display PostScript not supported on this system' - - RETURN - - ENTRY DPSWR (NCHARS, CHARS) - - WRITE(*, *) NCHARS, CHARS - - STOP 'GKS: Display PostScript not supported on this system' - - RETURN - - ENTRY DPSFL - - ENTRY DPSCL - - END - - - SUBROUTINE GKTMP (NCHARS, CHARS) - - INTEGER NCHARS - CHARACTER CHARS*(*) - - NCHARS = 10 - CHARS = 'GLIGKS.BIN' - - RETURN - END - \ No newline at end of file diff -r -N -u gks/dos/GKSMISC.FOR gli-gks/dos/GKSMISC.FOR --- gks/dos/GKSMISC.FOR 2000-11-21 07:16:44.000000000 -0500 +++ gli-gks/dos/GKSMISC.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,310 +0,0 @@ -C* -C* Copyright @ 1984 - 1993 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* - - INTEGER FUNCTION GORD (SET,LENGTH,ELEMNT) -C return order of an element - - INTEGER I, LENGTH - INTEGER SET(LENGTH), ELEMNT - - DO 1 I = 1,LENGTH - IF (SET(I) .EQ. ELEMNT) THEN - GORD = I - RETURN - END IF - 1 CONTINUE - - GORD = 0 - - RETURN - END - - - LOGICAL FUNCTION GANY (SET,LENGTH,ELEMNT) -C test set for an element - - INTEGER I, LENGTH - INTEGER SET(LENGTH), ELEMNT - - DO 1 I = 1,LENGTH - IF (SET(I) .EQ. ELEMNT) THEN - GANY = .TRUE. - RETURN - END IF - 1 CONTINUE - - GANY = .FALSE. - - RETURN - END - - - LOGICAL FUNCTION GALL (SET,LENGTH,ELEMNT) -C compare all elements of a set - - INTEGER I, LENGTH - INTEGER SET(LENGTH), ELEMNT - - DO 1 I = 1,LENGTH - IF (SET(I) .NE. ELEMNT) THEN - GALL = .FALSE. - RETURN - END IF - 1 CONTINUE - - GALL = .TRUE. - - RETURN - END - - - SUBROUTINE GADD (ELEMNT,SET,LENGTH) -C add an element to a set - - INTEGER I, LENGTH - INTEGER ELEMNT, SET(LENGTH) - - DO 1 I = 1,LENGTH - IF (SET(I) .EQ. 0) THEN - SET(I) = ELEMNT - RETURN - END IF - 1 CONTINUE - - RETURN - END - - - SUBROUTINE GDEL (ELEMNT,SET,LENGTH) -C delete an element from a set - - INTEGER I, J, LENGTH - INTEGER ELEMNT, SET(LENGTH) - - DO 1 I = 1,LENGTH - IF (SET(I) .EQ. ELEMNT) THEN - IF (I .LT. LENGTH) THEN - DO 2 J = I,LENGTH-1 - SET(J) = SET(J+1) - 2 CONTINUE - END IF - SET(LENGTH) = 0 - RETURN - END IF - 1 CONTINUE - - RETURN - END - - - SUBROUTINE GINI (SET,LENGTH) -C initialize set - - INTEGER I, LENGTH - INTEGER SET(LENGTH) - - DO 1 I = 1,LENGTH -C do not remove the following IF-statement; prevents compiler -C from optimizing DO-loop - IF (SET(I) .NE. 0) SET(I) = 0 - 1 CONTINUE - - RETURN - END - - - SUBROUTINE GNUM (SET,LENGTH,NUM) -C number of elements - - INTEGER I, LENGTH, NUM - INTEGER SET(LENGTH) - - NUM = 0 - DO 1 I = 1,LENGTH - IF (SET(I) .NE. 0) NUM = NUM+1 - 1 CONTINUE - - RETURN - END - - - SUBROUTINE GKQPA (PATTRN, PA) -C inquire predefined pattern array - - INTEGER PATTRN, PA(0:32) - - INTEGER I, J, PATT(0:32,0:119) - - SAVE PATT - - DATA (PATT(0, I), I = 0, 11) / 12 * 4/ - DATA (PATT(0, I), I = 12, 119) /108 * 8/ - - DATA (PATT(I, 0),I=1,4)/ 0, 0, 0, 0/ - DATA (PATT(I, 1),I=1,4)/255, 255, 187, 255/ - DATA (PATT(I, 2),I=1,4)/238, 255, 187, 255/ - DATA (PATT(I, 3),I=1,4)/187, 238, 187, 255/ - DATA (PATT(I, 4),I=1,4)/119, 221, 119, 221/ - DATA (PATT(I, 5),I=1,4)/119, 170, 119, 221/ - DATA (PATT(I, 6),I=1,4)/ 85, 170, 85, 187/ - DATA (PATT(I, 7),I=1,4)/ 85, 170, 85, 170/ - DATA (PATT(I, 8),I=1,4)/136, 85, 136, 34/ - DATA (PATT(I, 9),I=1,4)/136, 34, 136, 34/ - DATA (PATT(I, 10),I=1,4)/ 0, 68, 0, 17/ - DATA (PATT(I, 11),I=1,4)/ 0, 34, 0, 0/ - DATA (PATT(I, 12),I=1,8)/ 0, 0, 0, 0, 0, 0, 0, 0/ - DATA (PATT(I, 13),I=1,8)/128, 0, 8, 0, 128, 0, 8, 0/ - DATA (PATT(I, 14),I=1,8)/ 34, 136, 34, 136, 34, 136, 34, 136/ - DATA (PATT(I, 15),I=1,8)/ 85, 170, 85, 170, 85, 170, 85, 170/ - DATA (PATT(I, 16),I=1,8)/170, 0, 170, 0, 170, 0, 170, 0/ - DATA (PATT(I, 17),I=1,8)/ 85, 85, 85, 85, 85, 85, 85, 85/ - DATA (PATT(I, 18),I=1,8)/ 17, 34, 68, 136, 17, 34, 68, 136/ - DATA (PATT(I, 19),I=1,8)/119, 119, 119, 119, 119, 119, 119, 119/ - DATA (PATT(I, 20),I=1,8)/ 78, 207, 252, 228, 39, 63, 243, 114/ - DATA (PATT(I, 21),I=1,8)/127, 239, 253, 223, 254, 247, 191, 251/ - DATA (PATT(I, 22),I=1,8)/ 0, 119, 119, 119, 0, 119, 119, 119/ - DATA (PATT(I, 23),I=1,8)/ 0, 127, 127, 127, 0, 247, 247, 247/ - DATA (PATT(I, 24),I=1,8)/127, 255, 255, 255, 255, 255, 255, 255/ - DATA (PATT(I, 25),I=1,8)/127, 191, 223, 255, 253, 251, 247, 255/ - DATA (PATT(I, 26),I=1,8)/125, 187, 198, 187, 125, 254, 254, 254/ - DATA (PATT(I, 27),I=1,8)/ 7, 139, 221, 184, 112, 232, 221, 142/ - DATA (PATT(I, 28),I=1,8)/170, 95, 191, 191, 170, 245, 251, 251/ - DATA (PATT(I, 29),I=1,8)/223, 175, 119, 119, 119, 119, 250, 253/ - DATA (PATT(I, 30),I=1,8)/ 64, 255, 64, 64, 79, 79, 79, 79/ - DATA (PATT(I, 31),I=1,8)/127, 255, 247, 255, 127, 255, 247, 255/ - DATA (PATT(I, 32),I=1,8)/119, 255, 221, 255, 119, 255, 221, 255/ - DATA (PATT(I, 33),I=1,8)/119, 221, 119, 221, 119, 221, 119, 221/ - DATA (PATT(I, 34),I=1,8)/ 85, 255, 85, 255, 85, 255, 85, 255/ - DATA (PATT(I, 35),I=1,8)/ 0, 255, 0, 255, 0, 255, 0, 255/ - DATA (PATT(I, 36),I=1,8)/238, 221, 187, 119, 238, 221, 187, 119/ - DATA (PATT(I, 37),I=1,8)/ 0, 255, 255, 255, 0, 255, 255, 255/ - DATA (PATT(I, 38),I=1,8)/254, 253, 251, 247, 239, 223, 191, 127/ - DATA (PATT(I, 39),I=1,8)/ 85, 255, 127, 255, 119, 255, 127, 255/ - DATA (PATT(I, 40),I=1,8)/ 0, 127, 127, 127, 127, 127, 127, 127/ - DATA (PATT(I, 41),I=1,8)/247, 227, 221, 62, 127, 254, 253, 251/ - DATA (PATT(I, 42),I=1,8)/119, 235, 221, 190, 119, 255, 85, 255/ - DATA (PATT(I, 43),I=1,8)/191, 95, 255, 255, 251, 245, 255, 255/ - DATA (PATT(I, 44),I=1,8)/252, 123, 183, 207, 243, 253, 254, 254/ - DATA (PATT(I, 45),I=1,8)/127, 127, 190, 193, 247, 247, 235, 28/ - DATA (PATT(I, 46),I=1,8)/239, 223, 171, 85, 0, 253, 251, 247/ - DATA (PATT(I, 47),I=1,8)/136, 118, 112, 112, 136, 103, 7, 7/ - DATA (PATT(I, 48),I=1,8)/255, 247, 235, 213, 170, 213, 235, 247/ - DATA (PATT(I, 49),I=1,8)/255, 247, 235, 213, 170, 213, 235, 247/ - DATA (PATT(I, 50),I=1,8)/127, 255, 255, 255, 255, 255, 255, 255/ - DATA (PATT(I, 51),I=1,8)/127, 255, 255, 255, 247, 255, 255, 255/ - DATA (PATT(I, 52),I=1,8)/119, 255, 255, 255, 247, 255, 255, 255/ - DATA (PATT(I, 53),I=1,8)/119, 255, 255, 255, 119, 255, 255, 255/ - DATA (PATT(I, 54),I=1,8)/119, 255, 223, 255, 119, 255, 255, 255/ - DATA (PATT(I, 55),I=1,8)/119, 255, 223, 255, 119, 255, 253, 255/ - DATA (PATT(I, 56),I=1,8)/119, 255, 221, 255, 119, 255, 253, 255/ - DATA (PATT(I, 57),I=1,8)/119, 255, 221, 255, 119, 255, 221, 255/ - DATA (PATT(I, 58),I=1,8)/ 87, 255, 221, 255, 119, 255, 221, 255/ - DATA (PATT(I, 59),I=1,8)/ 87, 255, 221, 255, 117, 255, 221, 255/ - DATA (PATT(I, 60),I=1,8)/ 85, 255, 221, 255, 117, 255, 221, 255/ - DATA (PATT(I, 61),I=1,8)/ 85, 255, 221, 255, 85, 255, 221, 255/ - DATA (PATT(I, 62),I=1,8)/ 85, 255, 93, 255, 85, 255, 221, 255/ - DATA (PATT(I, 63),I=1,8)/ 85, 255, 93, 255, 85, 255, 213, 255/ - DATA (PATT(I, 64),I=1,8)/ 85, 255, 85, 255, 85, 255, 213, 255/ - DATA (PATT(I, 65),I=1,8)/ 85, 255, 85, 255, 85, 255, 85, 255/ - DATA (PATT(I, 66),I=1,8)/ 85, 191, 85, 255, 85, 255, 85, 255/ - DATA (PATT(I, 67),I=1,8)/ 85, 191, 85, 255, 85, 251, 85, 255/ - DATA (PATT(I, 68),I=1,8)/ 85, 187, 85, 255, 85, 251, 85, 255/ - DATA (PATT(I, 69),I=1,8)/ 85, 187, 85, 255, 85, 187, 85, 255/ - DATA (PATT(I, 70),I=1,8)/ 85, 187, 85, 239, 85, 187, 85, 255/ - DATA (PATT(I, 71),I=1,8)/ 85, 187, 85, 239, 85, 187, 85, 254/ - DATA (PATT(I, 72),I=1,8)/ 85, 187, 85, 238, 85, 187, 85, 254/ - DATA (PATT(I, 73),I=1,8)/ 85, 187, 85, 238, 85, 187, 85, 238/ - DATA (PATT(I, 74),I=1,8)/ 85, 171, 85, 238, 85, 187, 85, 238/ - DATA (PATT(I, 75),I=1,8)/ 85, 171, 85, 238, 85, 186, 85, 238/ - DATA (PATT(I, 76),I=1,8)/ 85, 170, 85, 238, 85, 186, 85, 238/ - DATA (PATT(I, 77),I=1,8)/ 85, 170, 85, 238, 85, 170, 85, 238/ - DATA (PATT(I, 78),I=1,8)/ 85, 170, 85, 174, 85, 170, 85, 238/ - DATA (PATT(I, 79),I=1,8)/ 85, 170, 85, 174, 85, 170, 85, 234/ - DATA (PATT(I, 80),I=1,8)/ 85, 170, 85, 170, 85, 170, 85, 234/ - DATA (PATT(I, 81),I=1,8)/ 85, 170, 85, 170, 85, 170, 85, 170/ - DATA (PATT(I, 82),I=1,8)/ 21, 170, 85, 170, 85, 170, 85, 170/ - DATA (PATT(I, 83),I=1,8)/ 21, 170, 85, 170, 81, 170, 85, 170/ - DATA (PATT(I, 84),I=1,8)/ 17, 170, 85, 170, 81, 170, 85, 170/ - DATA (PATT(I, 85),I=1,8)/ 17, 170, 85, 170, 17, 170, 85, 170/ - DATA (PATT(I, 86),I=1,8)/ 17, 170, 69, 170, 17, 170, 85, 170/ - DATA (PATT(I, 87),I=1,8)/ 17, 170, 69, 170, 17, 170, 84, 170/ - DATA (PATT(I, 88),I=1,8)/ 17, 170, 68, 170, 17, 170, 84, 170/ - DATA (PATT(I, 89),I=1,8)/ 17, 170, 68, 170, 17, 170, 68, 170/ - DATA (PATT(I, 90),I=1,8)/ 1, 170, 68, 170, 17, 170, 68, 170/ - DATA (PATT(I, 91),I=1,8)/ 1, 170, 68, 170, 16, 170, 68, 170/ - DATA (PATT(I, 92),I=1,8)/ 0, 170, 68, 170, 16, 170, 68, 170/ - DATA (PATT(I, 93),I=1,8)/ 0, 170, 68, 170, 0, 170, 68, 170/ - DATA (PATT(I, 94),I=1,8)/ 0, 170, 4, 170, 0, 170, 68, 170/ - DATA (PATT(I, 95),I=1,8)/ 0, 170, 4, 170, 0, 170, 64, 170/ - DATA (PATT(I, 96),I=1,8)/ 0, 170, 0, 170, 0, 170, 64, 170/ - DATA (PATT(I, 97),I=1,8)/ 0, 170, 0, 170, 0, 170, 0, 170/ - DATA (PATT(I, 98),I=1,8)/ 0, 42, 0, 170, 0, 170, 0, 170/ - DATA (PATT(I, 99),I=1,8)/ 0, 42, 0, 170, 0, 162, 0, 170/ - DATA (PATT(I,100),I=1,8)/ 0, 34, 0, 170, 0, 162, 0, 170/ - DATA (PATT(I,101),I=1,8)/ 0, 34, 0, 170, 0, 34, 0, 170/ - DATA (PATT(I,102),I=1,8)/ 0, 34, 0, 138, 0, 34, 0, 170/ - DATA (PATT(I,103),I=1,8)/ 0, 34, 0, 138, 0, 34, 0, 168/ - DATA (PATT(I,104),I=1,8)/ 0, 34, 0, 136, 0, 34, 0, 168/ - DATA (PATT(I,105),I=1,8)/ 0, 34, 0, 136, 0, 34, 0, 136/ - DATA (PATT(I,106),I=1,8)/ 0, 2, 0, 136, 0, 34, 0, 136/ - DATA (PATT(I,107),I=1,8)/ 0, 2, 0, 136, 0, 32, 0, 136/ - DATA (PATT(I,108),I=1,8)/ 0, 0, 0, 136, 0, 32, 0, 136/ - DATA (PATT(I,109),I=1,8)/119, 119, 119, 119, 119, 119, 119, 119/ - DATA (PATT(I,110),I=1,8)/ 0, 255, 255, 255, 0, 255, 255, 255/ - DATA (PATT(I,111),I=1,8)/119, 187, 221, 238, 119, 187, 221, 238/ - DATA (PATT(I,112),I=1,8)/238, 221, 187, 119, 238, 221, 187, 119/ - DATA (PATT(I,113),I=1,8)/ 0, 119, 119, 119, 0, 119, 119, 119/ - DATA (PATT(I,114),I=1,8)/126, 189, 219, 231, 231, 219, 189, 126/ - DATA (PATT(I,115),I=1,8)/247, 247, 247, 247, 247, 247, 247, 247/ - DATA (PATT(I,116),I=1,8)/255, 255, 255, 255, 0, 255, 255, 255/ - DATA (PATT(I,117),I=1,8)/127, 191, 223, 239, 247, 251, 253, 254/ - DATA (PATT(I,118),I=1,8)/254, 253, 251, 247, 239, 223, 191, 127/ - DATA (PATT(I,119),I=1,8)/247, 247, 247, 247, 0, 247, 247, 247/ - - J = PATTRN - IF (J .GT. 119) THEN - J = 119 - ELSE IF (J .LT. 0) THEN - J = 0 - END IF - - K = PATT(0,J) - DO 1, I = 0, K - PA(I) = PATT(I,J) - 1 CONTINUE - - RETURN - - - ENTRY GKSPA (PATTRN, PA) -C set pattern array - - IF (PATTRN .GE. 0 .AND. PATTRN .LE. 119) THEN - K = PA(0) - IF (K .EQ. 4 .OR. K .EQ. 8 .OR. K .EQ. 32) THEN - DO 2, I = 0, K - PATT(I,PATTRN) = PA(I) - 2 CONTINUE - END IF - END IF - - RETURN - END - \ No newline at end of file diff -r -N -u gks/dos/GKSROOT.FOR gli-gks/dos/GKSROOT.FOR --- gks/dos/GKSROOT.FOR 2000-11-21 07:16:44.000000000 -0500 +++ gli-gks/dos/GKSROOT.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,2478 +0,0 @@ -C* -C* Copyright @ 1984 - 1994 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* - - SUBROUTINE GSNT (TNR,WN,VP) -C set up normalization transformation - - INTEGER TNR - REAL WN(4),VP(4),TRAN(2,3) - REAL X, Y - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' -C include GKS description table - INCLUDE 'gksdescr.i' - - REAL A(0:MXNTNR),B(0:MXNTNR),C(0:MXNTNR),D(0:MXNTNR) - INTEGER I, J - REAL MAT(2,3), XRES, YRES - - SAVE A,B,C,D,MAT - - A(TNR) = (VP(2)-VP(1))/(WN(2)-WN(1)) - B(TNR) = VP(1)-WN(1)*A(TNR) - C(TNR) = (VP(4)-VP(3))/(WN(4)-WN(3)) - D(TNR) = VP(3)-WN(3)*C(TNR) - - RETURN - - - ENTRY GNT (X,Y,TNR) -C normalization transformation - - IF (TNR .GT. 0) THEN - X = A(TNR)*X+B(TNR) - Y = C(TNR)*Y+D(TNR) - END IF - - RETURN - - - ENTRY GDNT (X,Y,TNR) -C denormalization transformation - - X = (X-B(TNR))/A(TNR) - Y = (Y-D(TNR))/C(TNR) - - RETURN - - - ENTRY GCNT (X,Y,TNR) -C character normalization transformation - - IF (TNR .GT. 0) THEN - X = A(TNR)*X - Y = C(TNR)*Y - END IF - - RETURN - - - ENTRY GSST (TRAN) -C set up segment transformation - - DO 1, I=1,2 - DO 2, J=1,3 - MAT(I,J) = TRAN(I,J) - 2 CONTINUE - 1 CONTINUE - - RETURN - - - ENTRY GST (X,Y) -C segment transformation - - XRES = X*MAT(1,1) + Y*MAT(2,1) + MAT(1,3) - YRES = X*MAT(1,2) + Y*MAT(2,2) + MAT(2,3) - X = XRES - Y = YRES - - RETURN - - - ENTRY GCST (X,Y) -C character segment transformation - - XRES = X*MAT(1,1) + Y*MAT(2,1) - YRES = X*MAT(1,2) + Y*MAT(2,2) - X = XRES - Y = YRES - - RETURN - END - - - SUBROUTINE GSDT (WN,VP) -C set device transformation - - REAL WN(4), VP(4) - REAL CURWN(4), CURVP(4) - - INTEGER I - REAL X, X1, X2, XMAX, XMIN - REAL Y, Y1, Y2, YMAX, YMIN - - INTEGER EMPTY,LEFT,RIGHT,BOTTOM,TOP - PARAMETER (EMPTY=0,LEFT=1,RIGHT=2,BOTTOM=4,TOP=8) - - INTEGER ERRIND, CLSW, GR_BC - REAL CLRT(4) - - REAL CXL, CXR, CYB, CYT -C REAL H - REAL WINDOW(4), VIEWPT(4) - - LOGICAL VISIBL - INTEGER S,S1,S2,GCODE - - COMMON /GKSOPT/ GR_BC -CDEC$ PSECT /GKSOPT/ NOSHR - - SAVE WINDOW,VIEWPT,CXL,CXR,CYB,CYT - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - - DO 1 I = 1,4 - WINDOW(I) = WN(I) - VIEWPT(I) = VP(I) - 1 CONTINUE - -C inquire clipping indicator - CALL GQCLIP (ERRIND,CLSW,CLRT) - - IF (CLSW .EQ. GCLIP) THEN - CXL = MAX(CLRT(1),WINDOW(1)) - CXR = MIN(CLRT(2),WINDOW(2)) - CYB = MAX(CLRT(3),WINDOW(3)) - CYT = MIN(CLRT(4),WINDOW(4)) - ELSE - CXL = WINDOW(1) - CXR = WINDOW(2) - CYB = WINDOW(3) - CYT = WINDOW(4) - END IF - -C apply segment transformation - IF (GR_BC .EQ. 0) THEN - CALL GST (CXL,CYB) - CALL GST (CXR,CYT) - END IF - IF (CXL .GT. CXR) THEN - H = CXL - CXL = CXR - CXR = H - END IF - IF (CYB .GT. CYT) THEN - H = CYB - CYB = CYT - CYT = H - END IF - - RETURN - - - ENTRY GQDT (CURWN, CURVP) -C inquire device transformation - - DO 2 I = 1,4 - CURWN(I) = WINDOW(I) - CURVP(I) = VIEWPT(I) - 2 CONTINUE - - RETURN - - - ENTRY GQCLRG (XMIN,XMAX,YMIN,YMAX) -C inquire clipping region - - XMIN = CXL - XMAX = CXR - YMIN = CYB - YMAX = CYT - - RETURN - - - ENTRY GLCLIP (X1,Y1,X2,Y2,VISIBL) -C line clipping algorithm - - S1 = GCODE(X1,Y1,CXL,CXR,CYB,CYT) - S2 = GCODE(X2,Y2,CXL,CXR,CYB,CYT) - VISIBL = .TRUE. - - DO 3 I = 0,3 - - IF (S1 .EQ. EMPTY .AND. S2 .EQ. EMPTY) RETURN - - VISIBL = IAND(S1,S2) .EQ. EMPTY - IF (.NOT. VISIBL) RETURN - - S = S1 - IF (S .EQ. EMPTY) S = S2 - - IF (IAND(LEFT,S) .NE. EMPTY) THEN - Y = Y1+(Y2-Y1)*(CXL-X1)/(X2-X1) - X = CXL - ELSE - IF (IAND(RIGHT,S) .NE. EMPTY) THEN - Y = Y1+(Y2-Y1)*(CXR-X1)/(X2-X1) - X = CXR - ELSE - IF (IAND(BOTTOM,S) .NE. EMPTY) THEN - X = X1+(X2-X1)*(CYB-Y1)/(Y2-Y1) - Y = CYB - ELSE - IF (IAND(TOP,S) .NE. EMPTY) THEN - X = X1+(X2-X1)*(CYT-Y1)/(Y2-Y1) - Y = CYT - END IF - END IF - END IF - END IF - - IF (S .EQ. S1) THEN - X1 = X - Y1 = Y - S1 = GCODE(X,Y,CXL,CXR,CYB,CYT) - ELSE - X2 = X - Y2 = Y - S2 = GCODE(X,Y,CXL,CXR,CYB,CYT) - END IF - - 3 CONTINUE - - RETURN - END - - - INTEGER FUNCTION GCODE(X,Y,CXL,CXR,CYB,CYT) - - REAL CXL, CXR, CYB, CYT, X, Y - INTEGER LEFT,RIGHT,BOTTOM,TOP - PARAMETER (LEFT=1,RIGHT=2,BOTTOM=4,TOP=8) - - GCODE = 0 - IF (X .LT. CXL) THEN - GCODE = LEFT - ELSE - IF (X .GT. CXR) GCODE = RIGHT - END IF - IF (Y .LT. CYB) THEN - GCODE = GCODE+BOTTOM - ELSE - IF (Y .GT. CYT) GCODE = GCODE+TOP - END IF - - RETURN - END - - - SUBROUTINE GPOLIN (N,PX,PY,LTYPE,TNR,MOVE,DRAW) -C polyline utility - - REAL FEPS - PARAMETER (FEPS = 1.0E-06) - - INTEGER I, LTYPE, N, TNR - REAL VX, VY, X, XOLD, Y, YOLD - REAL PX(N),PY(N) - EXTERNAL MOVE,DRAW - - LOGICAL CLIP,VISIBL - REAL CXL,CXR,CYB,CYT - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - - CALL GSDASH (LTYPE) - - IF (LTYPE .NE. 0) THEN - - XOLD = PX(1) - YOLD = PY(1) - CALL GNT (XOLD,YOLD,TNR) - CALL GST (XOLD,YOLD) - CLIP = .TRUE. - -C loop to output line - DO 1 I = 2,N - X = PX(I) - Y = PY(I) - CALL GNT (X,Y,TNR) - CALL GST (X,Y) -C save virtual position - VX = X - VY = Y - CALL GLCLIP (XOLD,YOLD,X,Y,VISIBL) - -C be sure that line is visible - IF (VISIBL) THEN - IF (CLIP) THEN -C re-initialize polyline sequence - CALL MOVE (XOLD,YOLD) - CLIP = .FALSE. - - END IF - CALL DRAW (X,Y) - END IF - - CLIP = .NOT.VISIBL .OR. - * (ABS(X-VX) .GT. FEPS) .OR. (ABS(Y-VY) .GT. FEPS) - XOLD = VX - YOLD = VY - - 1 CONTINUE - - ELSE - -C inquire clipping rectangle - CALL GQCLRG (CXL,CXR,CYB,CYT) - - XOLD = PX(N) - YOLD = PY(N) - CALL GNT (XOLD,YOLD,TNR) - CALL GST (XOLD,YOLD) - CLIP = .TRUE. - -C loop to output polygon - DO 2 I = 1,N - X = PX(I) - Y = PY(I) - CALL GNT (X,Y,TNR) - CALL GST (X,Y) -C save virtual position - VX = X - VY = Y - CALL GLCLIP (XOLD,YOLD,X,Y,VISIBL) - - IF (CLIP) THEN - XOLD = MIN(MAX(XOLD,CXL),CXR) - YOLD = MIN(MAX(YOLD,CYB),CYT) - - IF (I .EQ. 1) THEN -C re-initialize polygon sequence - CALL MOVE (XOLD,YOLD) - ELSE - CALL DRAW (XOLD,YOLD) - END IF - CLIP = .FALSE. - - END IF - X = MIN(MAX(X,CXL),CXR) - Y = MIN(MAX(Y,CYB),CYT) - CALL DRAW (X,Y) - - CLIP = .NOT.VISIBL .OR. - * (ABS(X-VX) .GT. FEPS) .OR. (ABS(Y-VY) .GT. FEPS) - XOLD = VX - YOLD = VY - - 2 CONTINUE - - END IF - - RETURN - END - - - SUBROUTINE GMOVE (X,Y,MOVE) -C dashed line generator - - REAL X, Y - - EXTERNAL MOVE - - CALL GMOVTO (X,Y) - CALL MOVE (X,Y) - - RETURN - END - - - SUBROUTINE GDASH (X,Y,MOVE,DRAW) -C draw a dashed line - - REAL FEPS - PARAMETER (FEPS = 1.0E-06) - - REAL X, Y - EXTERNAL MOVE, DRAW - - REAL DIAG, DIST, DX, DY, RX, RY, SEGLEN - REAL DASH, XD, YD - INTEGER IDASH, ITEMPA, LEN, LTYPE - LOGICAL NEWSEG, DARK - -C dash table - INTEGER DTABLE(0:9,-30:4) - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - - COMMON /GKSLIN/ LTYPE, RX, RY, SEGLEN, NEWSEG -CDEC$ PSECT /GKSLIN/ NOSHR - - SAVE -C -C -8 = triple_dots -4 = long-short-dash 1 = solid -C -7 = double_dots -3 = long dash 2 = dashed -C -6 = spaced_dot -2 = dash-3-dots 3 = dotted -C -5 = spaced-dash -1 = dash-2-dots 4 = dash-dotted -C - DATA DTABLE / - * 8, 4, 2, 4, 2, 4, 2, 4, 6, 0, 6, 4, 2, 4, 2, 4, 6, 0, 0, 0, - * 4, 4, 2, 4, 6, 0, 0, 0, 0, 0, 8, 3, 2, 3, 2, 3, 2, 3, 6, 0, - * 6, 3, 2, 3, 2, 3, 6, 0, 0, 0, 4, 3, 2, 3, 6, 0, 0, 0, 0, 0, - * 8, 3, 2, 3, 2, 3, 2, 3, 4, 0, 6, 3, 2, 3, 2, 3, 4, 0, 0, 0, - * 4, 3, 2, 3, 4, 0, 0, 0, 0, 0, 2, 1, 1, 0, 0, 0, 0, 0, 0, 0, - * 2, 1, 2, 0, 0, 0, 0, 0, 0, 0, 2, 1, 6, 0, 0, 0, 0, 0, 0, 0, - * 2, 1, 8, 0, 0, 0, 0, 0, 0, 0, 6, 1, 3, 1, 3, 1, 6, 0, 0, 0, - * 4, 1, 3, 1, 6, 0, 0, 0, 0, 0, 8, 6, 2, 1, 2, 1, 2, 1, 2, 0, - * 6, 6, 2, 1, 2, 1, 2, 0, 0, 0, 4, 6, 2, 1, 2, 0, 0, 0, 0, 0, - * 4, 9, 3, 5, 3, 0, 0, 0, 0, 0, 2, 9, 3, 0, 0, 0, 0, 0, 0, 0, - * 2, 5, 5, 0, 0, 0, 0, 0, 0, 0, 2, 5, 3, 0, 0, 0, 0, 0, 0, 0, - * 6, 1, 4, 1, 4, 1, 8, 0, 0, 0, 4, 1, 4, 1, 8, 0, 0, 0, 0, 0, - * 2, 1, 1, 0, 0, 0, 0, 0, 0, 0, 2, 8, 1, 0, 0, 0, 0, 0, 0, 0, - * 4, 16, 5, 8, 5, 0, 0, 0, 0, 0, 2, 16, 5, 0, 0, 0, 0, 0, 0, 0, - * 8, 8, 4, 1, 4, 1, 4, 1, 4, 0, 6, 8, 4, 1, 4, 1, 4, 0, 0, 0, - * 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - * 2, 8, 5, 0, 0, 0, 0, 0, 0, 0, 2, 1, 2, 0, 0, 0, 0, 0, 0, 0, - * 4, 8, 4, 1, 4, 0, 0, 0, 0, 0 / - - IF (LTYPE .EQ. GLSOLI .OR. LTYPE .EQ. 0) THEN -C draw a solid line - CALL DRAW (X,Y) - - ELSE - -C draw a dashed line - LEN = DTABLE(0,LTYPE) - -C initialize variables - XD = RX - YD = RY - DX = X-XD - DY = Y-YD - DIST = SQRT(DX*DX+DY*DY) - - IF (DIST .GT. 0.) THEN - - DIAG = DIST - IF (.NOT. NEWSEG) GO TO 2 - IDASH = LEN - -C loop to output line - 1 IDASH = MOD(IDASH,LEN)+1 - 2 ITEMPA = IDASH - DASH = 0.0025*DTABLE(ITEMPA,LTYPE) - IF (ABS(SEGLEN) .LE. FEPS) SEGLEN = DASH - XD = XD+DX*SEGLEN/DIAG - YD = YD+DY*SEGLEN/DIAG - DARK = MOD(ITEMPA,2) .EQ. 1 - NEWSEG = SEGLEN .LT. DIST - -C be sure that line segment will not overshoot point - IF (NEWSEG) THEN - RX = XD - RY = YD -C see if line is a dark vector - IF (DARK) THEN - CALL DRAW (XD,YD) - ELSE - CALL MOVE (XD,YD) - END IF - -C calculate remaining distance to point - DIST = DIST-SEGLEN - SEGLEN = 0. - GO TO 1 - - ELSE - -C output remainder of line - RX = X - RY = Y -C calculate segment fragment unused - SEGLEN = SEGLEN-DIST - IF (DARK .OR. (ABS(SEGLEN) .LE. FEPS)) CALL DRAW (X,Y) - - END IF - END IF - END IF - - RETURN - END - - - SUBROUTINE GSDASH (TYPE) -C select a dash pattern - - INTEGER TYPE - REAL X, Y - - REAL RX, RY, SEGLEN - LOGICAL NEWSEG - - COMMON /GKSLIN/ LTYPE, RX, RY, SEGLEN, NEWSEG -CDEC$ PSECT /GKSLIN/ NOSHR - - SAVE - - LTYPE = TYPE - - RETURN - - - ENTRY GMOVTO (X,Y) -C re-initialize dashed line sequence - - RX = X - RY = Y - SEGLEN = 0. - NEWSEG = .TRUE. - - RETURN - END - - - SUBROUTINE GPOLMK (N,PX,PY,POLIN) -C polymarker - - INTEGER I, N - REAL PX(N),PY(N) - EXTERNAL POLIN - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - - INTEGER ERRIND,TNR,MTYPE,FONT - REAL X(2),Y(2) - - CHARACTER*1 SYMBOL(-20:5) - - DATA FONT /-22/ - DATA SYMBOL /'*','@','7','5','B','8','.','$','-','"', - * '#','%','&','3','+','6',')','4',',','2', - * ' ','I','/','1','*','0'/ - -C inquire current normalization transformation number - CALL GQCNTN (ERRIND,TNR) -C inquire marker type - CALL GQMK (ERRIND,MTYPE) - - DO 1 I = 1,N -C loop to output marker symbols - X(1) = PX(I) - Y(1) = PY(I) - - CALL GNT (X(1),Y(1),TNR) - - IF (MTYPE .EQ. GPOINT) THEN -C draw point - X(2) = X(1) - Y(2) = Y(1) - CALL POLIN (2,X,Y,GLSOLI,0) - ELSE -C draw marker symbol - switch to the software character -C generator - CALL GCHGEN (X(1),Y(1),SYMBOL(MTYPE),FONT,POLIN,POLIN, - * .TRUE.) - END IF - - 1 CONTINUE - - RETURN - END - - - SUBROUTINE GSIMPM (N,PX,PY,MARKER) -C polymarker simulation routine - - INTEGER I, N - REAL PX(N),PY(N) - EXTERNAL MARKER - - INTEGER ERRIND,TNR,MTYPE - REAL XN,YN,CXL,CXR,CYB,CYT - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - -C inquire current normalization transformation number -C and current clipping region - CALL GQCNTN (ERRIND,TNR) - CALL GQCLRG (CXL,CXR,CYB,CYT) - -C inquire marker type - CALL GQMK (ERRIND,MTYPE) - - DO 1 I = 1,N -C loop to output marker symbols - XN = PX(I) - YN = PY(I) - CALL GNT (XN,YN,TNR) - CALL GST (XN,YN) - - IF (CXL.LE.XN .AND. XN .LE.CXR .AND. - * CYB.LE.YN .AND. YN .LE.CYT) - * CALL MARKER (XN,YN,MTYPE) - - 1 CONTINUE - - RETURN - END - - - SUBROUTINE GKTEXT (PX,PY,CHARS,POLIN,FILLA,LABEL) -C text - - CHARACTER CHARS*(*) - EXTERNAL POLIN,FILLA,LABEL - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - - INTEGER IPOS - INTEGER ERRIND,TNR,FONT,PREC,ALH,ALV,PATH - INTEGER TXX,TXX1,SIZE,BOTTOM,BASE,CAP,TOP,WIDTH,SPACE - - REAL AX, AY, PX, PY, CHSP - REAL X0, XN, XNEW, XSPACE - REAL Y0, YN, YNEW, YSPACE - REAL AFAC(GAHNOR:GARITE) - INTEGER XFAC(GRIGHT:GDOWN),YFAC(GRIGHT:GDOWN) - - REAL CXL,CXR,CYB,CYT - - DATA AFAC /0.,0.,-0.5,-1./ - DATA XFAC /1,-1,0,0/ , YFAC /0,0,1,-1/ - -C inquire current normalization transformation number - CALL GQCNTN (ERRIND,TNR) - -C inquire current clipping region - CALL GQCLRG (CXL,CXR,CYB,CYT) - -C calculate text origin - X0 = PX - Y0 = PY - CALL GNT (X0,Y0,TNR) - -C inquire text font and precision - CALL GQTXFP (ERRIND,FONT,PREC) - IF (PREC .NE. GSTRKP) CALL GMAPF (FONT) - - IF (PREC .EQ. GSTRP) THEN - - CALL GST (X0,Y0) -C string precision - output hardware characters - IF (CXL.LE.X0 .AND. X0.LE.CXR .AND. - * CYB.LE.Y0 .AND. Y0.LE.CYT) CALL LABEL (X0,Y0,CHARS) - - ELSE -C draw software character - set up character -C transformation - CALL GSCT - -C compute text extent - CALL GTXE (CHARS,FONT,PREC,TXX,SIZE,BOTTOM,BASE,CAP,TOP) - -C apply character spacing - CALL GQCHSP (ERRIND,CHSP) - SPACE = NINT(CHSP*SIZE) - TXX = TXX+LEN(CHARS)*SPACE - -C set up x and y increments to align the text - CALL GQTXAL (ERRIND,ALH,ALV) - AX = 0 - IF (ALH.NE.GAHNOR) AX = AFAC(ALH)*TXX - AY = 0 - IF (ALV.EQ.GABOTT) AY = BASE-BOTTOM - IF (ALV.EQ.GAHALF) AY = -(CAP-BASE)*0.5 - IF (ALV.EQ.GACAP) AY = BASE-CAP - IF (ALV.EQ.GATOP) AY = BASE-TOP - -C fit x increment to the text path - CALL GQTXP (ERRIND,PATH) - IF (PATH .EQ. GLEFT) THEN - CALL GTXE (CHARS(1:1),FONT,PREC,TXX1,SIZE, - * BOTTOM,BASE,CAP,TOP) - AX = -AX-TXX1 - ELSE IF (PATH .EQ. GUP .OR. PATH .EQ. GDOWN) THEN - AX = AFAC(ALH)*SIZE - END IF - CALL GCT (AX,AY,SIZE) - - XN = X0+AX - YN = Y0+AY - - DO 1 IPOS = 1,LEN(CHARS) -C loop to output characters - -C compute character width - CALL GTXE (CHARS(IPOS:IPOS),FONT,PREC,WIDTH,SIZE, - * BOTTOM,BASE,CAP,TOP) - -C calculate new character cell origin - XSPACE = (WIDTH+SPACE)*XFAC(PATH) - YSPACE = (TOP-BOTTOM+SPACE)*YFAC(PATH) - CALL GCT (XSPACE,YSPACE,SIZE) - - XNEW = XN+XSPACE - YNEW = YN+YSPACE - - IF (PREC .EQ. GCHARP) THEN - - CALL GST (XN,YN) -C character precision - output hardware character - IF (CXL.LE.XN .AND. XN.LE.CXR .AND. - * CYB.LE.YN .AND. YN.LE.CYT) - * CALL LABEL (XN,YN,CHARS(IPOS:IPOS)) - - ELSE -C stroke precision - generate software character - CALL GCHGEN (XN,YN,CHARS(IPOS:IPOS),FONT,POLIN,FILLA, - * .FALSE.) - - END IF - - XN = XNEW - YN = YNEW - - 1 CONTINUE - - END IF - - RETURN - END - - - SUBROUTINE GTEXTS (PX,PY,NCHARS,CHARS,AVAIL,POLIN,FILLA,LABEL) -C text - - REAL PX, PY - INTEGER NCHARS - CHARACTER CHARS*(*) - LOGICAL AVAIL - EXTERNAL POLIN, FILLA, LABEL - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - - INTEGER IPOS - INTEGER ERRIND,TNR,FONT,PREC,ALH,ALV,PATH - INTEGER TXX,TXX1,SIZE,BOTTOM,BASE,CAP,TOP,WIDTH,SPACE - - REAL AX, AY, CHSP - REAL X0, XN, XNEW, XSPACE - REAL Y0, YN, YNEW, YSPACE - REAL AFAC(GAHNOR:GARITE) - INTEGER XFAC(GRIGHT:GDOWN),YFAC(GRIGHT:GDOWN) - - DATA AFAC /0.,0.,-0.5,-1./ - DATA XFAC /1,-1,0,0/ , YFAC /0,0,1,-1/ - -C inquire current normalization transformation number - CALL GQCNTN (ERRIND,TNR) - -C calculate text origin - X0 = PX - Y0 = PY - CALL GNT (X0,Y0,TNR) - -C inquire text font and precision - CALL GQTXFP (ERRIND,FONT,PREC) - IF (.NOT. AVAIL) THEN - IF (PREC .NE. GSTRKP) CALL GMAPF (FONT) - PREC = GSTRKP - END IF - - IF (PREC .EQ. GSTRP) THEN - - CALL GST (X0,Y0) -C string precision - output hardware characters - CALL LABEL (X0,Y0,NCHARS,CHARS) - - ELSE -C draw software character - set up character -C transformation - CALL GSCT - -C compute text extent - CALL GTXE (CHARS(1:NCHARS),FONT,PREC,TXX,SIZE, - * BOTTOM,BASE,CAP,TOP) - -C apply character spacing - CALL GQCHSP (ERRIND,CHSP) - SPACE = NINT(CHSP*SIZE) - TXX = TXX+NCHARS*SPACE - -C set up x and y increments to align the text - CALL GQTXAL (ERRIND,ALH,ALV) - AX = 0 - IF (ALH.NE.GAHNOR) AX = AFAC(ALH)*TXX - AY = 0 - IF (ALV.EQ.GABOTT) AY = BASE-BOTTOM - IF (ALV.EQ.GAHALF) AY = -(CAP-BASE)*0.5 - IF (ALV.EQ.GACAP) AY = BASE-CAP - IF (ALV.EQ.GATOP) AY = BASE-TOP - -C fit x increment to the text path - CALL GQTXP (ERRIND,PATH) - IF (PATH .EQ. GLEFT) THEN - CALL GTXE (CHARS(1:1),FONT,PREC,TXX1,SIZE, - * BOTTOM,BASE,CAP,TOP) - AX = -AX-TXX1 - ELSE IF (PATH .EQ. GUP .OR. PATH .EQ. GDOWN) THEN - AX = AFAC(ALH)*SIZE - END IF - CALL GCT (AX,AY,SIZE) - - XN = X0+AX - YN = Y0+AY - - DO 1 IPOS = 1,NCHARS -C loop to output characters - -C compute character width - CALL GTXE (CHARS(IPOS:IPOS),FONT,PREC,WIDTH,SIZE, - * BOTTOM,BASE,CAP,TOP) - -C calculate new character cell origin - XSPACE = (WIDTH+SPACE)*XFAC(PATH) - YSPACE = (TOP-BOTTOM+SPACE)*YFAC(PATH) - CALL GCT (XSPACE,YSPACE,SIZE) - - XNEW = XN+XSPACE - YNEW = YN+YSPACE - - IF (PREC .EQ. GCHARP) THEN - - CALL GST (XN,YN) -C character precision - output hardware character - CALL LABEL (XN,YN,1,CHARS(IPOS:IPOS)) - - ELSE -C stroke precision - generate software character - CALL GCHGEN (XN,YN,CHARS(IPOS:IPOS),FONT,POLIN,FILLA, - * .FALSE.) - - END IF - - XN = XNEW - YN = YNEW - - 1 CONTINUE - - END IF - - RETURN - END - - - SUBROUTINE GSIMTX (PX,PY,NCHARS,CHARS,POLIN,FILLA) -C text simulation routine - - REAL PX, PY - INTEGER NCHARS - CHARACTER CHARS*(*) - EXTERNAL POLIN,FILLA - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - - INTEGER IPOS - INTEGER ERRIND,TNR,FONT,PREC,ALH,ALV,PATH - INTEGER TXX,TXX1,SIZE,BOTTOM,BASE,CAP,TOP,WIDTH,SPACE - - REAL AX, AY, CHSP - REAL X0, XN, XNEW, XSPACE - REAL Y0, YN, YNEW, YSPACE - REAL AFAC(GAHNOR:GARITE) - INTEGER XFAC(GRIGHT:GDOWN),YFAC(GRIGHT:GDOWN) - - DATA AFAC /0.,0.,-0.5,-1./ - DATA XFAC /1,-1,0,0/ , YFAC /0,0,1,-1/ - -C inquire current normalization transformation number - CALL GQCNTN (ERRIND,TNR) - -C calculate text origin - X0 = PX - Y0 = PY - CALL GNT (X0,Y0,TNR) - -C inquire text font and precision - CALL GQTXFP (ERRIND,FONT,PREC) - IF (PREC .NE. GSTRKP) CALL GMAPF (FONT) - -C draw software character - set up character -C transformation - CALL GSCT -C compute text extent - CALL GTXE (CHARS(1:NCHARS),FONT,PREC,TXX,SIZE, - * BOTTOM,BASE,CAP,TOP) - -C apply character spacing - CALL GQCHSP (ERRIND,CHSP) - SPACE = NINT(CHSP*SIZE) - TXX = TXX+NCHARS*SPACE - -C set up x and y increments to align the text - CALL GQTXAL (ERRIND,ALH,ALV) - AX = 0 - IF (ALH.NE.GAHNOR) AX = AFAC(ALH)*TXX - AY = 0 - IF (ALV.EQ.GABOTT) AY = BASE-BOTTOM - IF (ALV.EQ.GAHALF) AY = -(CAP-BASE)*0.5 - IF (ALV.EQ.GACAP) AY = BASE-CAP - IF (ALV.EQ.GATOP) AY = BASE-TOP - -C fit x increment to the text path - CALL GQTXP (ERRIND,PATH) - IF (PATH .EQ. GLEFT) THEN - CALL GTXE (CHARS(1:1),FONT,PREC,TXX1,SIZE, - * BOTTOM,BASE,CAP,TOP) - AX = -AX-TXX1 - ELSE IF (PATH .EQ. GUP .OR. PATH .EQ. GDOWN) THEN - AX = AFAC(ALH)*SIZE - END IF - CALL GCT (AX,AY,SIZE) - - XN = X0+AX - YN = Y0+AY - - DO 1 IPOS = 1,NCHARS -C loop to output characters - -C compute character width - CALL GTXE (CHARS(IPOS:IPOS),FONT,PREC,WIDTH,SIZE, - * BOTTOM,BASE,CAP,TOP) - -C calculate new character cell origin - XSPACE = (WIDTH+SPACE)*XFAC(PATH) - YSPACE = (TOP-BOTTOM+SPACE)*YFAC(PATH) - CALL GCT (XSPACE,YSPACE,SIZE) - - XNEW = XN+XSPACE - YNEW = YN+YSPACE - -C stroke precision - generate software character - CALL GCHGEN (XN,YN,CHARS(IPOS:IPOS),FONT,POLIN,FILLA, - * .FALSE.) - - XN = XNEW - YN = YNEW - - 1 CONTINUE - - RETURN - END - - - SUBROUTINE GQTEXT (PX,PY,CHARS,QX,QY,RX,RY) -C inquire text extent - - CHARACTER CHARS*(*) - REAL RX(4),RY(4) - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - - INTEGER I, IPOS - INTEGER ERRIND,TNR,FONT,PREC,ALH,ALV,PATH - INTEGER TXX,TXX1,WIDTH,SIZE,BOTTOM,BASE,CAP,TOP,SPACE - - REAL AX, AY, CHSP, PX, PY, QX, QY, ASPACE - REAL X0, XN, XSPACE - REAL Y0, YN, YSPACE - REAL AFAC(GAHNOR:GARITE) - INTEGER XFAC(GRIGHT:GDOWN),YFAC(GRIGHT:GDOWN) - - DATA AFAC /0.,0.,-0.5,-1./ - DATA XFAC /1,-1,0,0/ , YFAC /0,0,1,-1/ - -C inquire current normalization transformation number - CALL GQCNTN (ERRIND,TNR) - -C calculate text origin - X0 = PX - Y0 = PY - CALL GNT (X0,Y0,TNR) - -C inquire text font and precision - CALL GQTXFP (ERRIND,FONT,PREC) - -C draw software character - set up character -C transformation - CALL GSCT - -C compute text extent - CALL GTXE (CHARS,FONT,PREC,TXX,SIZE,BOTTOM,BASE,CAP,TOP) - -C apply character spacing - CALL GQCHSP (ERRIND,CHSP) - SPACE = NINT(CHSP*SIZE) - TXX = TXX+LEN(CHARS)*SPACE - -C set up x and y increments to align the text - CALL GQTXAL (ERRIND,ALH,ALV) - AX = 0 - IF (ALH.NE.GAHNOR) AX = AFAC(ALH)*TXX - AY = 0 - IF (ALV.EQ.GABOTT) AY = BASE-BOTTOM - IF (ALV.EQ.GAHALF) AY = -(CAP-BASE)*0.5 - IF (ALV.EQ.GACAP) AY = BASE-CAP - IF (ALV.EQ.GATOP) AY = BASE-TOP - ASPACE = AY - -C fit x increment to the text path - CALL GQTXP (ERRIND,PATH) - IF (PATH .EQ. GLEFT) THEN - CALL GTXE (CHARS(1:1),FONT,PREC,TXX1,SIZE, - * BOTTOM,BASE,CAP,TOP) - AX = -AX-TXX1 - ELSE IF (PATH .EQ. GUP .OR. PATH .EQ. GDOWN) THEN - AX = AFAC(ALH)*SIZE - END IF - CALL GCT (AX,AY,SIZE) - - XN = X0+AX - YN = Y0+AY - RX(1) = XN - RY(1) = YN - - DO 1 IPOS = 1,LEN(CHARS) - -C compute character width - CALL GTXE (CHARS(IPOS:IPOS),FONT,PREC,WIDTH,SIZE, - * BOTTOM,BASE,CAP,TOP) - -C calculate new character cell origin - XSPACE = (WIDTH+SPACE)*XFAC(PATH) - YSPACE = (TOP-BOTTOM+SPACE)*YFAC(PATH) - CALL GCT (XSPACE,YSPACE,SIZE) - - XN = XN+XSPACE - YN = YN+YSPACE - - 1 CONTINUE - - IF ((PATH .EQ. GLEFT .OR. PATH .EQ. GRIGHT) .AND. - * ALH .EQ. GACENT) THEN - QX = X0 - ELSE IF (ALH .EQ. GARITE) THEN - QX = RX(1) - ELSE - QX = XN - END IF - IF ((PATH .EQ. GUP .OR. PATH .EQ. GDOWN) .AND. - * ALV .EQ. GAHALF) THEN - QY = Y0 - ELSE IF (ALH .EQ. GARITE) THEN - QY = RY(1) - ELSE - QY = YN - END IF - - XSPACE = 0.0 - YSPACE = -ASPACE - CALL GCT (XSPACE,YSPACE,SIZE) - QX = QX+XSPACE - QY = QY+YSPACE - - CALL GDNT (QX,QY,TNR) - - XSPACE = 0.0 - YSPACE = BOTTOM-BASE - CALL GCT (XSPACE,YSPACE,SIZE) - RX(1) = RX(1)+XSPACE - RY(1) = RY(1)+YSPACE - RX(2) = XN+XSPACE - RY(2) = YN+YSPACE - - XSPACE = 0.0 - YSPACE = TOP-BOTTOM - CALL GCT (XSPACE,YSPACE,SIZE) - RX(3) = RX(2)+XSPACE - RY(3) = RY(2)+YSPACE - RX(4) = RX(1)+XSPACE - RY(4) = RY(1)+YSPACE - - DO 2 I=1,4 - CALL GDNT (RX(I),RY(I),TNR) - 2 CONTINUE - - RETURN - END - - - SUBROUTINE GMAPF (FONT) -C map hardware text font to stroke font - - INTEGER FONT - INTEGER FAMILY, TYPE, ROMAN(4), GREEK(4) - - DATA ROMAN /3,12,16,11/ - DATA GREEK /4, 7,10, 7/ - - FONT = ABS(FONT) - - FAMILY = MOD(FONT-1,8)+1 - TYPE = MIN((FONT-1)/8+1,4) - - IF (FAMILY .NE. 7) THEN - FONT = ROMAN(TYPE) - ELSE - FONT = GREEK(TYPE) - END IF - - RETURN - END - - - SUBROUTINE GCHGEN (XORG,YORG,CHAR,FONT,POLIN,FILLA,FLAG) -C character generator - - CHARACTER CHAR - INTEGER I, IC, IX, IY, N - INTEGER FONT - EXTERNAL POLIN, FILLA - LOGICAL FLAG - - INTEGER LSIZE - REAL XORG, YORG, CHXP - REAL MSZSC - LOGICAL ITALIC - - INTEGER BUFF(256) - INTEGER LEFT,RIGHT,SIZE,BOTTOM,BASE,CAP,TOP,LENGTH,C(2,124) - EQUIVALENCE (BUFF(1),LEFT),(BUFF(2),RIGHT),(BUFF(3),SIZE) - EQUIVALENCE (BUFF(4),BOTTOM),(BUFF(5),BASE),(BUFF(6),CAP) - EQUIVALENCE (BUFF(7),TOP),(BUFF(8),LENGTH),(BUFF(9),C(1,1)) - - INTEGER XMIN,XMAX,YMIN,YMAX - REAL XSCALE,YSCALE,CENTER,HALF - - REAL XN,YN,PX(64),PY(64) - INTEGER IFONT - LOGICAL MONO - - INTEGER ERRIND - REAL WN(4),VP(4) - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - -C check for mono spaced font - IFONT = ABS(FONT)/100 - MONO = IFONT .EQ. 2 .OR. IFONT .EQ. 3 - IFONT = MOD(FONT,100) - - IC = ICHAR(CHAR) -C inquire character stroke - CALL LOOKUP (FONT,IC,BUFF(1)) - - IF (FLAG .OR. MONO) THEN - - XMIN = 127 - XMAX = 0 - YMIN = 127 - YMAX = 0 - - DO 2, I = 1,LENGTH - IX = C(1,I) - IF (IX .GT. 127) IX = IX-256 - IX = ABS(IX) - IY = C(2,I) - XMIN = MIN(XMIN,IX) - XMAX = MAX(XMAX,IX) - YMIN = MIN(YMIN,IY) - YMAX = MAX(YMAX,IY) - 2 CONTINUE - - IF (XMAX .LE. XMIN) THEN - XMIN = LEFT - XMAX = RIGHT - END IF - IF (YMAX .LE. YMIN) THEN - YMIN = BASE - YMAX = CAP - END IF - - END IF - - IF (FLAG) THEN -C inquire marker size scale factor - CALL GQMKSC (ERRIND,MSZSC) - - XSCALE = 0.001*MSZSC/(XMAX-XMIN) - YSCALE = 0.001*MSZSC/(YMAX-YMIN) - - CALL GQDT (WN,VP) -C apply device transformation - XSCALE = XSCALE*(WN(2)-WN(1))/(VP(2)-VP(1)) - YSCALE = YSCALE*(WN(4)-WN(3))/(VP(4)-VP(3)) - - CENTER = 0.5*(XMIN+XMAX) - HALF = 0.5*(YMIN+YMAX) - - ELSE -C inquire character expansion factor - CALL GQCHXP (ERRIND,CHXP) - -C check for italic character - I = ABS(FONT)/100 - ITALIC = I .EQ. 1 .OR. I .EQ. 3 - - LSIZE = SIZE - IF (MONO) CENTER = 0.5*(XMIN+XMAX) - - END IF - - N = 0 - DO 1 I = 1,LENGTH - - IX = C(1,I) - IF (IX .GT. 127) IX = IX-256 - IY = C(2,I) - - IF (IX .LT. 0) THEN - IF (N .GT. 1) THEN - IF (IFONT .EQ. -51) THEN - IF (N .GT. 2) CALL FILLA (N,PX,PY,0) - END IF - CALL POLIN (N,PX,PY,GLSOLI,0) - N = 0 - END IF - IX = -IX - END IF - - IF (FLAG) THEN -C marker transformation - XN = XSCALE*(IX-CENTER) - YN = YSCALE*(IY-HALF) - ELSE - IF (LEFT .EQ. RIGHT) IX = IX+SIZE/2 - IF (MONO) THEN - XN = IX-CENTER+SIZE*0.5 - ELSE - XN = IX-LEFT - END IF - YN = IY-BASE -C character transformation - IF (ITALIC) THEN - CALL GICT (XN,YN,LSIZE) - ELSE - CALL GCT (XN,YN,LSIZE) - END IF - END IF - - N = N+1 - PX(N) = XORG+XN - PY(N) = YORG+YN - - 1 CONTINUE - IF (N .GT. 1) THEN - IF (IFONT .EQ. -51) THEN - IF (N .GT. 2) CALL FILLA (N,PX,PY,0) - END IF - CALL POLIN (N,PX,PY,GLSOLI,0) - END IF - - RETURN - END - - - SUBROUTINE GTXE (CHARS,FONT,PREC,TXX,SIZE,BOTTOM,BASE,CAP,TOP) -C text extend - - CHARACTER CHARS*(*) - INTEGER IC, IPOS - INTEGER FONT,PREC,TXX,SIZE,BOTTOM,BASE,CAP,TOP - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - - INTEGER IFONT - LOGICAL MONO - - INTEGER BUFF(256),LEFT,RIGHT - EQUIVALENCE (BUFF(1),LEFT),(BUFF(2),RIGHT) - - TXX = 0 - - IF (PREC .NE. GSTRP) THEN - -C check for mono spaced font - IFONT = ABS(FONT)/100 - MONO = IFONT .EQ. 2 .OR. IFONT .EQ. 3 - - DO 1 IPOS = 1,LEN(CHARS) - - IC = ICHAR(CHARS(IPOS:IPOS)) -C inquire character stroke - CALL LOOKUP (FONT,IC,BUFF(1)) - - IF (MONO) THEN - TXX = TXX+21 - ELSE IF (IC .NE. 32) THEN - TXX = TXX+RIGHT-LEFT - ELSE - TXX = TXX+BUFF(3)/2 - END IF - - 1 CONTINUE - - IF (.NOT. MONO) THEN - SIZE = BUFF(3) - ELSE - SIZE = 21 - END IF - - ELSE - - DO 2 IPOS = 1,LEN(CHARS) - - IC = ICHAR(CHARS(IPOS:IPOS)) -C inquire Adobe Font Metrics information - CALL GKAFM (FONT,IC,BUFF) - - TXX = TXX+RIGHT-LEFT - - 2 CONTINUE - - SIZE = BUFF(3) - - END IF - - BOTTOM = BUFF(4) - BASE = BUFF(5) - CAP = BUFF(6) - TOP = BUFF(7) - - RETURN - END - - - SUBROUTINE GSCT -C set up character transformation - - REAL X, Y, WIDTH, HEIGHT - INTEGER SIZE - - REAL SINS, CHH, CHXP - INTEGER ERRIND, TNR, FONT, PREC - REAL XREL, YREL, CHUX, CHUY - REAL UX, UY, BX, BY - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - - SAVE - -C inquire current normalization transformation number - CALL GQCNTN (ERRIND,TNR) -C inquire character up vector - CALL GQCHUP (ERRIND,CHUX,CHUY) -C inquire character height - CALL GQCHH (ERRIND,CHH) -C inquire character expansion factor - CALL GQCHXP (ERRIND,CHXP) -C inquire text font and precision - CALL GQTXFP (ERRIND,FONT,PREC) - -C scale to normalize the up vector - SCALE = SQRT(CHUX*CHUX+CHUY*CHUY) - CHUX = CHUX/SCALE - CHUY = CHUY/SCALE - -C compute character up vector - UX = CHUX*CHH - UY = CHUY*CHH -C normalize character up vector - CALL GCNT (UX,UY,TNR) - -C compute character base vector (right angle to up vector) - BX = CHUY*CHH - BY = -CHUX*CHH -C normalize character base vector - CALL GCNT (BX,BY,TNR) - BX = BX*CHXP - BY = BY*CHXP - - SINS = 0.207912 - - RETURN - - - ENTRY GCT (X,Y,SIZE) -C character transformation - - XREL = X/SIZE - YREL = Y/SIZE - -C rotation transformation - X = BX*XREL+UX*YREL - Y = BY*XREL+UY*YREL - - RETURN - - - ENTRY GICT (X,Y,SIZE) -C italic character transformation - - XREL = X/SIZE - YREL = Y/SIZE - XREL = XREL+SINS*YREL - -C rotation transformation - X = BX*XREL+UX*YREL - Y = BY*XREL+UY*YREL - - RETURN - - - ENTRY GCHH (HEIGHT) -C inquire character height - - WIDTH = 0.0 - HEIGHT = SQRT(UX*UX+UY*UY) - CALL GCST (WIDTH, HEIGHT) - HEIGHT = SQRT(WIDTH*WIDTH+HEIGHT*HEIGHT) - - RETURN - END - - - SUBROUTINE GFILLA (N,PX,PY,TNR,POLIN,YRES) -C fill area - - INTEGER N, TNR - REAL PX(N), PY(N) - EXTERNAL POLIN - REAL YRES - - REAL D, DX, DY, INC - REAL X0, XINC, XMAX, XMIN - REAL Y0, YINC, YMAX, YMIN - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - - INTEGER ERRIND,STYLE,INDEX,HATCH - - INTEGER BORDER - DATA BORDER /0/ - -C inquire fill area interior style - CALL GQFAIS (ERRIND,STYLE) -C inquire fill area style index - CALL GQFASI (ERRIND,INDEX) - -C compute minimum and maximum values - CALL GCMIMA(N,PX,XMIN,XMAX) - CALL GCMIMA(N,PY,YMIN,YMAX) - CALL GNT(XMIN,YMIN,TNR) - CALL GNT(XMAX,YMAX,TNR) - - IF (STYLE .EQ. GHOLLO) THEN - -C draw the border - CALL POLIN (N,PX,PY,BORDER,TNR) - - ELSE IF (STYLE .EQ. GSOLID) THEN - -C solid fill area - X0 = XMIN - XINC = 0. - DX = XMAX-XMIN - Y0 = YMIN - YINC = YRES - DY = 0. - CALL GFINE (N,PX,PY,TNR,X0,XINC,DX,XMAX,Y0,YINC,DY,YMAX, - * POLIN) - - ELSE IF (STYLE .EQ. GHATCH) THEN -C hatched fill area - - HATCH = MOD(INDEX-1,6) + 1 - IF (INDEX .GT. 6) THEN - INC = 0.02 - ELSE - INC = 0.01 - END IF - - IF (HATCH .EQ. 1 .OR. HATCH .EQ. 5) THEN -C put out vertical lines - X0 = XMIN - XINC = INC - DX = 0. - Y0 = YMIN - YINC = 0. - DY = YMAX-YMIN - CALL GFINE (N,PX,PY,TNR,X0,XINC,DX,XMAX,Y0,YINC,DY,YMAX, - * POLIN) - END IF - - IF (HATCH .EQ. 2 .OR. HATCH .EQ. 5) THEN -C put out horizontal lines - X0 = XMIN - XINC = 0. - DX = XMAX-XMIN - Y0 = YMIN - YINC = INC - DY = 0. - CALL GFINE (N,PX,PY,TNR,X0,XINC,DX,XMAX,Y0,YINC,DY,YMAX, - * POLIN) - END IF - - IF (HATCH .EQ. 3 .OR. HATCH .EQ. 6) THEN -C put out 45 degree lines - D = MAX(XMAX-XMIN,YMAX-YMIN) - X0 = XMIN - XINC = 0. - DX = D - Y0 = YMIN-D - YINC = INC*SQRT(2.0) - DY = D - CALL GFINE (N,PX,PY,TNR,X0,XINC,DX,XMAX,Y0,YINC,DY,YMAX, - * POLIN) - END IF - - IF (HATCH .EQ. 4 .OR. HATCH .EQ. 6) THEN -C put out -45 degree lines - D = MAX(XMAX-XMIN,YMAX-YMIN) - X0 = XMAX - XINC = 0. - DX = -D - Y0 = YMIN-D - YINC = INC*SQRT(2.0) - DY = D - CALL GFINE (N,PX,PY,TNR,X0,XINC,DX,XMAX,Y0,YINC,DY,YMAX, - * POLIN) - END IF - - ELSE -C pattern emulation not yet implemented - draw the border - CALL POLIN (N,PX,PY,BORDER,TNR) - - END IF - - RETURN - END - - - SUBROUTINE GKSFA (N,PX,PY,TNR,POLIN,YRES) -C solid fill area - - INTEGER N - REAL PX(N),PY(N) - INTEGER TNR - EXTERNAL POLIN - REAL YRES - - REAL DX, DY - REAL X0, XINC, XMAX, XMIN - REAL Y0, YINC, YMAX, YMIN - -C compute minimum and maximum values - CALL GCMIMA(N,PX,XMIN,XMAX) - CALL GCMIMA(N,PY,YMIN,YMAX) - -C solid fill area - X0 = XMIN - XINC = 0. - DX = XMAX-XMIN - Y0 = YMIN - YINC = YRES - DY = 0. - CALL GFINE (N,PX,PY,TNR,X0,XINC,DX,XMAX,Y0,YINC,DY,YMAX,POLIN) - - RETURN - END - - - SUBROUTINE GFINE (N,PX,PY,TNR,X0,XINC,DX,XEND,Y0,YINC,DY,YEND, - * POLIN) -C fill routine - - INTEGER N - REAL PX(N),PY(N) - INTEGER TNR - REAL X0, XINC, DX, XEND, Y0, YINC, DY, YEND - EXTERNAL POLIN - - REAL FEPS - PARAMETER (FEPS = 1.0E-06) - - INTEGER I, IM1, INC, L, NI - REAL X1, X2, X3, X4, XI, EPSX - REAL Y1, Y2, Y3, Y4, YI, EPSY - - LOGICAL FLAG - REAL SX(128),SY(128) - -C include GKS symbol definitions - INCLUDE 'gksdefs.i' - - EPSX = ABS((XEND-X0)*1E-5) - EPSY = ABS((YEND-Y0)*1E-5) - - L = 0 -C next line - 1 L = L+1 - X1 = X0+L*XINC - Y1 = Y0+L*YINC - IF (X1 .GT. XEND .OR. Y1 .GT. YEND) RETURN - X2 = X1+DX - Y2 = Y1+DY - -C calculate all intersections of the line given by the points -C (x1,y1),(x2,y2) with the polygon's vertices - NI = 0 - - DO 2 I = 1,N - - IF (I .EQ. 1) THEN - IM1 = N - ELSE - IM1 = I-1 - END IF - X3 = PX(IM1) - Y3 = PY(IM1) - CALL GNT (X3,Y3,TNR) - X4 = PX(I) - Y4 = PY(I) - CALL GNT (X4,Y4,TNR) - CALL GINTS (X1,Y1,X2,Y2,X3,Y3,X4,Y4,XI,YI,FLAG) - -C check if there is an intersection - IF (FLAG) THEN -C be sure that point not outside the polygon - IF(XI.GE.MIN(X3,X4)-EPSX .AND. - * XI.LE.MAX(X3,X4)+EPSX .AND. - * YI.GE.MIN(Y3,Y4)-EPSY .AND. - * YI.LE.MAX(Y3,Y4)+EPSY) THEN - NI = NI+1 - SX(NI) = XI - SY(NI) = YI - END IF - END IF - - 2 CONTINUE - - IF (NI .GT. 0) THEN -C set sort mode - INC = MOD(L,2) -C sort on X coordinates - IF (ABS(XINC) .LE. FEPS) THEN - CALL GSORT (NI,SX,SY,INC) - ELSE -C sort on Y coordinates - CALL GSORT (NI,SY,SX,INC) - END IF - - DO 3 I = 1,NI-1,2 - CALL POLIN (2,SX(I),SY(I),GLSOLI,0) - 3 CONTINUE - - END IF - - GO TO 1 - - END - - - SUBROUTINE GCMIMA (N,P,PMIN,PMAX) -C compute minimum and maximum - - REAL P(N) - REAL PMAX, PMIN - INTEGER I, N - - PMIN = P(1) - PMAX = P(1) - DO 1 I = 2,N - PMIN = MIN(PMIN,P(I)) - PMAX = MAX(PMAX,P(I)) - 1 CONTINUE - - RETURN - END - - - SUBROUTINE GINTS (X1,Y1,X2,Y2,X3,Y3,X4,Y4,XI,YI,FLAG) -C compute intersection - - REAL FEPS - PARAMETER (FEPS = 1.0E-06) - - LOGICAL FLAG,INF1,INF2 - REAL A1, A2 - REAL X1, X2, X3, X4, XI - REAL Y1, Y2, Y3, Y4, YI - - INF1 = ABS(X1-X2) .LE. FEPS - IF (.NOT. INF1) A1 = (Y2-Y1)/(X2-X1) - INF2 = ABS(X3-X4) .LE. FEPS - IF (.NOT. INF2) A2 = (Y4-Y3)/(X4-X3) - IF (INF1) THEN - IF (INF2) THEN - FLAG = .FALSE. - ELSE - XI = X1 - YI = Y3+A2*(XI-X3) - FLAG = .TRUE. - END IF - ELSE - IF (INF2) THEN - XI = X3 - YI = Y1+A1*(XI-X1) - FLAG = .TRUE. - ELSE - FLAG = ABS(A1-A2) .GT. FEPS - IF (FLAG) THEN - XI = (Y1-Y3-A1*X1+A2*X3)/(A2-A1) - YI = Y1+A1*(XI-X1) - END IF - END IF - END IF - - RETURN - END - - - SUBROUTINE GSORT (N,X,Y,INC) -C sort - - REAL X(N),Y(N) - - REAL H - INTEGER I, J, N, INC - LOGICAL SWITCH - - DO 1 I = 1,N-1 - DO 2 J = I,N - IF (INC .EQ. 0) THEN -C sort in decreasing order - SWITCH = X(J) .LT. X(I) - ELSE -C sort in increasing order - SWITCH = X(J) .GT. X(I) - END IF - IF (SWITCH) THEN -C switch elements - H = X(I) - X(I) = X(J) - X(J) = H - H = Y(I) - Y(I) = Y(J) - Y(J) = H - END IF - 2 CONTINUE - 1 CONTINUE - - RETURN - END - - - SUBROUTINE GCELLA (XMIN, XMAX, YMIN, YMAX, NCOLS, NROWS, - * DIMX, CI, GSCI, GFA) -C cell array simulation routine - - REAL XMIN, XMAX, YMIN, YMAX - INTEGER NCOLS, NROWS, DIMX, CI(DIMX, 1) - - EXTERNAL GSCI, GFA - - INTEGER ERRIND, TNR - REAL DX, DY, X(5), Y(5) - INTEGER I, J - -C inquire current transformation number - CALL GQCNTN (ERRIND, TNR) - - DX = (XMAX - XMIN) / NCOLS - DY = (YMAX - YMIN) / NROWS - - DO 1, J = 1, NROWS - DO 2, I = 1, NCOLS - CALL GSCI (CI(I, J)) - X(1) = XMIN + (I-1) * DX - Y(1) = YMIN + (J-1) * DY - X(2) = X(1) - Y(2) = YMIN + J * DY - X(3) = XMIN + I * DX - Y(3) = Y(2) - X(4) = X(3) - Y(4) = Y(1) - X(5) = X(1) - Y(5) = Y(1) - CALL GFA (5, X, Y, TNR) - 2 CONTINUE - 1 CONTINUE - - RETURN - END - - - SUBROUTINE GDEC (IVAL, NCHARS, CHARS) -C convert an integer number to byte data - - CHARACTER*(*) CHARS - INTEGER IVAL, NCHARS - - CHARACTER DIG(20), DIGIT(0:9) - INTEGER I, VALUE, NDIG - - DATA DIGIT /'0', '1', '2', '3', '4', '5', '6', '7', '8', '9'/ - - NCHARS = 0 - IF (IVAL .LT. 0) THEN - NCHARS = 1 - CHARS(1:1) = '-' - END IF - - VALUE = ABS(IVAL) - NDIG = 0 - 1 CONTINUE - NDIG = NDIG + 1 - DIG(NDIG) = DIGIT(MOD(VALUE, 10)) - VALUE = VALUE / 10 - IF (VALUE .NE. 0) GOTO 1 - - DO 2, I = NDIG, 1, -1 - NCHARS = NCHARS + 1 - CHARS(NCHARS:NCHARS) = DIG(I) - 2 CONTINUE - - RETURN - END - - - SUBROUTINE GOCT (IVAL,CHARS) -C convert a byte to octal value - - CHARACTER*(*) CHARS - INTEGER IVAL, I, J, K, IDEC - - I = IVAL - J = 64 - DO 1 K = 1,3 - IDEC = I/J - CHARS(K:K) = CHAR(ICHAR('0')+IDEC) - I = I-IDEC*J - J = J/8 - 1 CONTINUE - - RETURN - END - - - SUBROUTINE GSTR (NCHARS,CHARS,IVAL) -C convert a string to an integer number - - INTEGER IVAL, L, NCHARS - CHARACTER*(*) CHARS - - IVAL = 0 - DO 1 L = 1,NCHARS - IF (CHARS(L:L) .GE. '0' .AND. CHARS(L:L) .LE. '9') THEN - IVAL = IVAL*10 + ICHAR(CHARS(L:L))-ICHAR('0') - ELSE - RETURN - END IF - 1 CONTINUE - - RETURN - END - - - SUBROUTINE GFLT (RVAL,NCHARS,CHARS) -C convert a real number to a string - - REAL FEPS - PARAMETER (FEPS = 1.0E-06) - - INTEGER I, J, N, IX, IEXP, ISIGN, ITSIZE - INTEGER NCHAR, NCHARS, NFACTR, IWIDTH - REAL RVAL, VALUE - CHARACTER*(*) CHARS - - INTEGER CHR(16) - PARAMETER (IWIDTH=5) - - VALUE = RVAL - NCHARS = 0 - 1 ISIGN = 0 - IEXP = 0 - IF (VALUE .LT. 0) ISIGN = 1 - IF (ABS(VALUE) .LE. FEPS) GOTO 12 - NCHAR = IWIDTH - VALUE = ABS(VALUE) -C convert number to canonical form, consisting of -C the most significant digits (up to IWIDTH of them), -C stored (in IX) as an integer less than 10^IWIDTH. -C The exponent is stored as an integer (in NFACTR) -C Note that 10^-IWIDTH is a fuzz factor, added for rounding - NFACTR = INT(ALOG10(VALUE)+10.0**(-IWIDTH))-(IWIDTH-1) -C note that 0.5 is added for rounding - IX = INT(0.5+VALUE/10.0**NFACTR) -C strip off trailing zeros - 3 IF (MOD(IX,10).NE.0) GOTO 4 - IX = IX/10 - NFACTR = NFACTR+1 - NCHAR = NCHAR -1 - GOTO 3 -C see if scientific notation necessary - 4 IF (NCHAR+IABS(NFACTR).LE.IWIDTH) GOTO 5 - IEXP = NFACTR+NCHAR-1 - N = NFACTR - NFACTR = 1-NCHAR - IF (IABS(IEXP).GT.IWIDTH-2) GOTO 5 - IEXP = 0 - NFACTR = N -C convert canonical representation into ADE format - 5 IF (ISIGN.EQ.0) GOTO 6 - NCHARS = NCHARS+1 - CHR(NCHARS) = 45 - 6 ITSIZE = NFACTR+NCHAR - J = NINT(10.0**(NCHAR-1)) - IF (ITSIZE.LE.0) GOTO 9 -C store digits - 7 IF (J.EQ.0) GOTO 11 - I = IX/J - NCHARS = NCHARS+1 - CHR(NCHARS) = 48+I - IX = IX-J*I - J = J/10 - NCHAR = NCHAR-1 - ITSIZE = ITSIZE-1 -C see if done - IF (NCHAR.LE.0.AND.ITSIZE.LE.0) GOTO 11 - IF (ITSIZE.EQ.0) GOTO 9 -C see if zero fill unnecessary - IF (NCHAR.NE.0) GOTO 7 -C insert trailing zero fill - 8 NCHARS = NCHARS+1 - CHR(NCHARS) = 48 - ITSIZE = ITSIZE-1 - IF (ITSIZE.NE.0) GOTO 8 - GOTO 11 -C insert a decimal point - 9 NCHARS = NCHARS+1 - CHR(NCHARS) = 46 - IF (ITSIZE.EQ.0) GOTO 7 -C insert leading zero fill - 10 NCHARS = NCHARS+1 - CHR(NCHARS) = 48 - ITSIZE = ITSIZE+1 - IF (ITSIZE.NE.0) GOTO 10 - GOTO 7 -C check for exponent - 11 IF (IEXP.EQ.0) GOTO 13 -C exponent required - will be converted to ADE by -C above code (pseudo-recursively) - NCHARS = NCHARS+1 - CHR(NCHARS) = 69 - VALUE = IEXP - GOTO 1 -C zero handled as a special case - 12 NCHARS = NCHARS+1 - CHR(NCHARS) = 48 - - 13 DO 14 I = 1,NCHARS - CHARS(I:I) = CHAR(CHR(I)) - 14 CONTINUE - - RETURN - END - - - SUBROUTINE GRGB (H,L,S, R,G,B) -C convert HLS to RGB values - - REAL H,L,S, R,G,B - REAL M1,M2, GVAL - - IF (L .LT. 0.5) THEN - M2 = L*(1+S) - ELSE - M2 = L+S-(L*S) - END IF - - M1 = 2*L-M2 - IF (ABS(S) .LE. 1E-10) THEN - R = 1.0 - G = 1.0 - B = 1.0 - ELSE - R = GVAL (M1, M2, H+120.0) - G = GVAL (M1, M2, H) - B = GVAL (M1, M2, H-120.0) - END IF - - RETURN - END - - - REAL FUNCTION GVAL (N1, N2, H) - - REAL N1, N2, H - REAL HUE - - HUE = H - IF (HUE .GT. 360.) HUE = HUE-360. - IF (HUE .LT. 0.) HUE = HUE+360. - - IF (HUE .LT. 60) THEN - GVAL = N1+(N2-N1)*HUE/60. - ELSE IF (HUE .LT. 180.) THEN - GVAL = N2 - ELSE IF (HUE .LT. 240.) THEN - GVAL = N1+(N2-N1)*(240.-HUE)/60. - ELSE - GVAL = N1 - END IF - - RETURN - END - - - SUBROUTINE GQRGB (COLI, R, G, B) -C inquire RGB values -C - INTEGER COLI, NUMCOL - REAL R, G, B - INTEGER PALETT(NUMCOL), CMAP(16) -C - SAVE -C - LOGICAL INIT - INTEGER I, J - REAL RGB(3,980), D, MDIST -C - DATA (RGB(I, 1),I=1,3) / 1.0000, 1.0000, 1.0000 / - DATA (RGB(I, 2),I=1,3) / 0.0000, 0.0000, 0.0000 / - DATA (RGB(I, 3),I=1,3) / 1.0000, 0.0000, 0.0000 / - DATA (RGB(I, 4),I=1,3) / 0.0000, 1.0000, 0.0000 / - DATA (RGB(I, 5),I=1,3) / 0.0000, 0.0000, 1.0000 / - DATA (RGB(I, 6),I=1,3) / 0.0000, 1.0000, 1.0000 / - DATA (RGB(I, 7),I=1,3) / 1.0000, 1.0000, 0.0000 / - DATA (RGB(I, 8),I=1,3) / 1.0000, 0.0000, 1.0000 / - DATA (RGB(I, 165),I=1,3) / 0.0980, 0.0980, 0.4392 / - DATA (RGB(I, 166),I=1,3) / 0.0000, 0.0000, 0.5020 / - DATA (RGB(I, 167),I=1,3) / 0.3922, 0.5843, 0.9294 / - DATA (RGB(I, 168),I=1,3) / 0.2824, 0.2392, 0.5451 / - DATA (RGB(I, 169),I=1,3) / 0.4157, 0.3529, 0.8039 / - DATA (RGB(I, 170),I=1,3) / 0.4824, 0.4078, 0.9333 / - DATA (RGB(I, 171),I=1,3) / 0.5176, 0.4392, 1.0000 / - DATA (RGB(I, 172),I=1,3) / 0.0000, 0.0000, 0.8039 / - DATA (RGB(I, 173),I=1,3) / 0.2549, 0.4118, 0.8824 / - DATA (RGB(I, 174),I=1,3) / 0.1176, 0.5647, 1.0000 / - DATA (RGB(I, 175),I=1,3) / 0.0000, 0.7490, 1.0000 / - DATA (RGB(I, 176),I=1,3) / 0.5294, 0.8078, 0.9216 / - DATA (RGB(I, 177),I=1,3) / 0.5294, 0.8078, 0.9804 / - DATA (RGB(I, 178),I=1,3) / 0.2745, 0.5098, 0.7059 / - DATA (RGB(I, 179),I=1,3) / 0.6902, 0.7686, 0.8706 / - DATA (RGB(I, 180),I=1,3) / 0.6784, 0.8471, 0.9020 / - DATA (RGB(I, 181),I=1,3) / 0.6902, 0.8784, 0.9020 / - DATA (RGB(I, 182),I=1,3) / 0.6863, 0.9333, 0.9333 / - DATA (RGB(I, 183),I=1,3) / 0.0000, 0.8078, 0.8196 / - DATA (RGB(I, 184),I=1,3) / 0.2824, 0.8196, 0.8000 / - DATA (RGB(I, 185),I=1,3) / 0.2510, 0.8784, 0.8157 / - DATA (RGB(I, 186),I=1,3) / 0.8784, 1.0000, 1.0000 / - DATA (RGB(I, 187),I=1,3) / 0.3725, 0.6196, 0.6275 / - DATA (RGB(I, 188),I=1,3) / 0.4000, 0.8039, 0.6667 / - DATA (RGB(I, 189),I=1,3) / 0.4980, 1.0000, 0.8314 / - DATA (RGB(I, 190),I=1,3) / 0.0000, 0.3922, 0.0000 / - DATA (RGB(I, 191),I=1,3) / 0.3333, 0.4196, 0.1843 / - DATA (RGB(I, 192),I=1,3) / 0.5608, 0.7373, 0.5608 / - DATA (RGB(I, 193),I=1,3) / 0.1804, 0.5451, 0.3412 / - DATA (RGB(I, 194),I=1,3) / 0.2353, 0.7020, 0.4431 / - DATA (RGB(I, 195),I=1,3) / 0.1255, 0.6980, 0.6667 / - DATA (RGB(I, 196),I=1,3) / 0.5961, 0.9843, 0.5961 / - DATA (RGB(I, 197),I=1,3) / 0.0000, 1.0000, 0.4980 / - DATA (RGB(I, 198),I=1,3) / 0.4863, 0.9882, 0.0000 / - DATA (RGB(I, 199),I=1,3) / 0.4980, 1.0000, 0.0000 / - DATA (RGB(I, 200),I=1,3) / 0.0000, 0.9804, 0.6039 / - DATA (RGB(I, 201),I=1,3) / 0.6784, 1.0000, 0.1843 / - DATA (RGB(I, 202),I=1,3) / 0.1961, 0.8039, 0.1961 / - DATA (RGB(I, 203),I=1,3) / 0.6039, 0.8039, 0.1961 / - DATA (RGB(I, 204),I=1,3) / 0.1333, 0.5451, 0.1333 / - DATA (RGB(I, 205),I=1,3) / 0.4196, 0.5569, 0.1373 / - DATA (RGB(I, 206),I=1,3) / 0.7412, 0.7176, 0.4196 / - DATA (RGB(I, 207),I=1,3) / 0.9412, 0.9020, 0.5490 / - DATA (RGB(I, 208),I=1,3) / 0.9333, 0.9098, 0.6667 / - DATA (RGB(I, 209),I=1,3) / 0.9804, 0.9804, 0.8235 / - DATA (RGB(I, 210),I=1,3) / 1.0000, 1.0000, 0.8784 / - DATA (RGB(I, 211),I=1,3) / 1.0000, 0.8431, 0.0000 / - DATA (RGB(I, 212),I=1,3) / 0.9333, 0.8667, 0.5098 / - DATA (RGB(I, 213),I=1,3) / 0.8549, 0.6471, 0.1255 / - DATA (RGB(I, 214),I=1,3) / 0.7216, 0.5255, 0.0431 / - DATA (RGB(I, 215),I=1,3) / 0.7373, 0.5608, 0.5608 / - DATA (RGB(I, 216),I=1,3) / 0.8039, 0.3608, 0.3608 / - DATA (RGB(I, 217),I=1,3) / 0.5451, 0.2706, 0.0745 / - DATA (RGB(I, 218),I=1,3) / 0.6275, 0.3216, 0.1765 / - DATA (RGB(I, 219),I=1,3) / 0.8039, 0.5216, 0.2471 / - DATA (RGB(I, 220),I=1,3) / 0.8706, 0.7216, 0.5294 / - DATA (RGB(I, 221),I=1,3) / 0.9608, 0.9608, 0.8627 / - DATA (RGB(I, 222),I=1,3) / 0.9608, 0.8706, 0.7020 / - DATA (RGB(I, 223),I=1,3) / 0.9569, 0.6431, 0.3765 / - DATA (RGB(I, 224),I=1,3) / 0.8235, 0.7059, 0.5490 / - DATA (RGB(I, 225),I=1,3) / 0.8235, 0.4118, 0.1176 / - DATA (RGB(I, 226),I=1,3) / 0.6980, 0.1333, 0.1333 / - DATA (RGB(I, 227),I=1,3) / 0.6471, 0.1647, 0.1647 / - DATA (RGB(I, 228),I=1,3) / 0.9137, 0.5882, 0.4784 / - DATA (RGB(I, 229),I=1,3) / 0.9804, 0.5020, 0.4471 / - DATA (RGB(I, 230),I=1,3) / 1.0000, 0.6275, 0.4784 / - DATA (RGB(I, 231),I=1,3) / 1.0000, 0.6471, 0.0000 / - DATA (RGB(I, 232),I=1,3) / 1.0000, 0.5490, 0.0000 / - DATA (RGB(I, 233),I=1,3) / 1.0000, 0.4980, 0.3137 / - DATA (RGB(I, 234),I=1,3) / 0.9412, 0.5020, 0.5020 / - DATA (RGB(I, 235),I=1,3) / 1.0000, 0.3882, 0.2784 / - DATA (RGB(I, 236),I=1,3) / 1.0000, 0.2706, 0.0000 / - DATA (RGB(I, 237),I=1,3) / 1.0000, 0.4118, 0.7059 / - DATA (RGB(I, 238),I=1,3) / 1.0000, 0.0784, 0.5765 / - DATA (RGB(I, 239),I=1,3) / 1.0000, 0.7529, 0.7961 / - DATA (RGB(I, 240),I=1,3) / 1.0000, 0.7137, 0.7569 / - DATA (RGB(I, 241),I=1,3) / 0.8588, 0.4392, 0.5765 / - DATA (RGB(I, 242),I=1,3) / 0.6902, 0.1882, 0.3765 / - DATA (RGB(I, 243),I=1,3) / 0.7804, 0.0824, 0.5216 / - DATA (RGB(I, 244),I=1,3) / 0.8157, 0.1255, 0.5647 / - DATA (RGB(I, 245),I=1,3) / 0.9333, 0.5098, 0.9333 / - DATA (RGB(I, 246),I=1,3) / 0.8667, 0.6275, 0.8667 / - DATA (RGB(I, 247),I=1,3) / 0.8549, 0.4392, 0.8392 / - DATA (RGB(I, 248),I=1,3) / 0.7294, 0.3333, 0.8275 / - DATA (RGB(I, 249),I=1,3) / 0.6000, 0.1961, 0.8000 / - DATA (RGB(I, 250),I=1,3) / 0.5804, 0.0000, 0.8275 / - DATA (RGB(I, 251),I=1,3) / 0.5412, 0.1686, 0.8863 / - DATA (RGB(I, 252),I=1,3) / 0.6275, 0.1255, 0.9412 / - DATA (RGB(I, 253),I=1,3) / 0.5765, 0.4392, 0.8588 / - DATA (RGB(I, 254),I=1,3) / 0.8471, 0.7490, 0.8471 / - DATA (RGB(I, 255),I=1,3) / 0.2500, 0.2500, 0.2500 / - DATA (RGB(I, 256),I=1,3) / 0.5000, 0.5000, 0.5000 / - DATA (RGB(I, 257),I=1,3) / 0.7500, 0.7500, 0.7500 / -C - DATA INIT / .FALSE. / -C - IF (.NOT. INIT) THEN - CALL GIRGB (RGB) - INIT = .TRUE. - END IF -C - IF (COLI .LT. 980) THEN - J=COLI+1 - R=RGB(1,J) - G=RGB(2,J) - B=RGB(3,J) - END IF -C - RETURN - - - ENTRY GSRGB (COLI, R, G, B) -C set RGB values -C - IF (.NOT. INIT) THEN - CALL GIRGB (RGB) - INIT = .TRUE. - END IF -C - IF (COLI .LT. 980) THEN - J=COLI+1 - RGB(1,J)=R - RGB(2,J)=G - RGB(3,J)=B - END IF -C - RETURN - - - ENTRY GKRMAP (COLI, R, G, B, NUMCOL, PALETT, CMAP) -C remap palette - - MDIST = 3.0 - DO 1, J = 1, NUMCOL - D = ABS(RGB(1,J)-R) + ABS(RGB(2,J)-G) + ABS(RGB(3,J)-B) - IF (D .LT. MDIST) THEN - MDIST = D - I = J - END IF - 1 CONTINUE - - IF (MDIST .LT. 3.0) CMAP(COLI + 1) = PALETT(I) - - RETURN - END - - - SUBROUTINE GQPIX (COLI, PIXEL) -C inquire pixel values -C - INTEGER COLI, PIXEL -C - INTEGER CI - INTEGER PIX(0:255) -C - DATA PIX /256*0/ -C - IF (COLI .GE. 588) THEN - CI = 80 + (COLI-588)/56 * 12 + NINT(MOD(COLI-588, 56) * - * 11.0/56.0) - ELSE IF (COLI .GE. 257) THEN - CI = 8 + NINT((COLI-257)/330.0 * (72-1)) - ELSE - CI = COLI - END IF - - IF (CI .LT. 256) THEN - PIXEL = PIX(CI) - END IF -C - RETURN - - - ENTRY GSPIX (COLI, PIXEL) -C set pixel values -C - IF (COLI .LT. 256) THEN - PIX(COLI) = PIXEL - END IF - - RETURN - END - - - SUBROUTINE GIRGB (RGB) -C initialize RGB table - - REAL RGB(3,980) - - INTEGER J - REAL H, L, S, DX1, DX2, DX22 - - DO 1 J=9,80 - H=(J-9)*360.0/72-120.0 - L=0.5 - S=0.75 - CALL GRGB (H,L,S,RGB(1,J),RGB(2,J),RGB(3,J)) - 1 CONTINUE -C - DO 2 J=81,92 - L=(4+(J-81))/15.0 - RGB(1,J) = L - RGB(2,J) = L - RGB(3,J) = L - 2 CONTINUE -C - DO 3 J=93,164 - H=INT((J-93)/12.0*60.0)-150.0 - L=(3+MOD(J-93,12))/15.0 - S=0.75 - CALL GRGB (H,L,S,RGB(1,J),RGB(2,J),RGB(3,J)) - 3 CONTINUE -C - DX1=0.0181818 - RGB(1,258)=0. - RGB(2,258)=0. - RGB(3,258)=1. - DO 10 J = 259,312 - RGB(1,J)=RGB(1,J-1) + DX1 - RGB(2,J)=0. - RGB(3,J)=1. - 10 CONTINUE - - RGB(1,313)=1. - RGB(2,313)=0. - RGB(3,313)=1. - DO 11 J = 314,367 - RGB(1,J)=1. - RGB(2,J)=0. - RGB(3,J)=RGB(3,J-1) - DX1 - 11 CONTINUE - - RGB(1,368)=1. - RGB(2,368)=0. - RGB(3,368)=0. - DO 12 J = 369,422 - RGB(1,J)=1. - RGB(2,J)=RGB(2,J-1) + DX1 - RGB(3,J)=0. - 12 CONTINUE - - RGB(1,423)=1. - RGB(2,423)=1. - RGB(3,423)=0. - DO 13 J = 424,477 - RGB(1,J)=RGB(1,J-1) - DX1 - RGB(2,J)=1. - RGB(3,J)=0. - 13 CONTINUE - - RGB(1,478)=0. - RGB(2,478)=1. - RGB(3,478)=0. - DO 14 J = 479,532 - RGB(1,J)=0. - RGB(2,J)=1. - RGB(3,J)=RGB(3,J-1) + DX1 - 14 CONTINUE - - RGB(1,533)=0. - RGB(2,533)=1. - RGB(3,533)=1. - DO 15 J = 534,588 - RGB(1,J)=0. - RGB(2,J)=1. - RGB(2,J)=RGB(2,J-1) - DX1 - RGB(3,J)=1. - 15 CONTINUE - - DX11=(1.-0.18)/55. - RGB(1,589)=0.18 - RGB(2,589)=0.18 - RGB(3,589)=0.18 - DO 16 J = 590,643 - RGB(1,J)=RGB(1,J-1) + DX11 - RGB(2,J)=RGB(2,J-1) + DX11 - RGB(3,J)=RGB(3,J-1) + DX11 - 16 CONTINUE - RGB(1,644)=1. - RGB(2,644)=1. - RGB(3,644)=1. - - DX22 = (1.-0.18)/30. - DX2 = 1./30. - RGB(1,645)=0. - RGB(2,645)=0. - RGB(3,645)=0.18 - DO 17 J = 646,672 - RGB(1,J)=RGB(1,J-1) - RGB(2,J)=RGB(2,J-1) - RGB(3,J)=RGB(3,J-1) + DX22 - 17 CONTINUE - DO 18 J = 673,700 - RGB(1,J)=RGB(1,J-1) + DX2 - RGB(2,J)=RGB(2,J-1) + DX2 - RGB(3,J)=1. - 18 CONTINUE - - RGB(1,701)=0.18 - RGB(2,701)=0. - RGB(3,701)=0.18 - DO 19 J = 702,728 - RGB(1,J)=RGB(1,J-1) + DX22 - RGB(2,J)=RGB(2,J-1) - RGB(3,J)=RGB(3,J-1) + DX22 - 19 CONTINUE - DO 20 J = 729,756 - RGB(1,J)=1. - RGB(2,J)=RGB(2,J-1) + DX2 - RGB(3,J)=1. - 20 CONTINUE - - RGB(1,757)=0.18 - RGB(2,757)=0. - RGB(3,757)=0. - DO 21 J = 758,784 - RGB(1,J)=RGB(1,J-1) + DX22 - RGB(2,J)=RGB(2,J-1) - RGB(3,J)=RGB(3,J-1) - 21 CONTINUE - DO 22 J = 785,812 - RGB(1,J)=1. - RGB(2,J)=RGB(2,J-1) + DX2 - RGB(3,J)=RGB(3,J-1) + DX2 - 22 CONTINUE - - RGB(1,813)=0.18 - RGB(2,813)=0.18 - RGB(3,813)=0. - DO 23 J = 814,840 - RGB(1,J)=RGB(1,J-1) + DX22 - RGB(2,J)=RGB(2,J-1) + DX22 - RGB(3,J)=RGB(3,J-1) - 23 CONTINUE - DO 24 J = 841,868 - RGB(1,J)=1. - RGB(2,J)=1. - RGB(3,J)=RGB(3,J-1) + DX2 - 24 CONTINUE - - RGB(1,869)=0. - RGB(2,869)=0.18 - RGB(3,869)=0. - DO 25 J = 870,896 - RGB(1,J)=RGB(1,J-1) - RGB(2,J)=RGB(2,J-1) + DX22 - RGB(3,J)=RGB(3,J-1) - 25 CONTINUE - DO 26 J = 897,924 - RGB(1,J)=RGB(1,J-1) + DX2 - RGB(2,J)=1. - RGB(3,J)=RGB(3,J-1) + DX2 - 26 CONTINUE - - RGB(1,925)=0. - RGB(2,925)=0.18 - RGB(3,925)=0.18 - DO 27 J = 926,952 - RGB(1,J)=RGB(1,J-1) - RGB(2,J)=RGB(2,J-1) + DX22 - RGB(3,J)=RGB(3,J-1) + DX22 - 27 CONTINUE - DO 28 J = 953,980 - RGB(1,J)=RGB(1,J-1) + DX2 - RGB(2,J)=1. - RGB(3,J)=1. - 28 CONTINUE - - RETURN - END - - - SUBROUTINE GKFVP (VP, XMAX, YMAX) -C fit viewport into available device space - - REAL VP(4), XMAX, YMAX - REAL RATIO, W, H - - RATIO = (VP(2)-VP(1))/(VP(4)-VP(3)) - DO 1, I = 1,2 - W = VP(2)-VP(1) - IF (W .GT. XMAX) THEN - VP(1) = 0.0 - VP(2) = XMAX - VP(4) = VP(3)+XMAX/RATIO - END IF - H = VP(4)-VP(3) - IF (H .GT. YMAX) THEN - VP(2) = VP(1)+YMAX*RATIO - VP(3) = 0.0 - VP(4) = YMAX - END IF - 1 CONTINUE - IF (VP(2) .GT. XMAX) THEN - VP(1) = XMAX-(VP(2)-VP(1)) - VP(2) = XMAX - END IF - IF (VP(4) .GT. YMAX) THEN - VP(3) = YMAX-(VP(4)-VP(3)) - VP(4) = YMAX - END IF - - RETURN - END - \ No newline at end of file diff -r -N -u gks/dos/GKSSTATE.I gli-gks/dos/GKSSTATE.I --- gks/dos/GKSSTATE.I 2000-11-21 07:16:46.000000000 -0500 +++ gli-gks/dos/GKSSTATE.I 1969-12-31 19:00:00.000000000 -0500 @@ -1,125 +0,0 @@ -C* -C* Copyright @ 1984 - 1993 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* -C* -C operating state value - INTEGER STATE - -C * GKS State List -C set of open workstations - INTEGER SOPWS(MNOPWS,6) -C number of open workstations - INTEGER NOPWS -C set of active workstations - INTEGER SACWS(MNACWS) -C number of active workstations - INTEGER NACWS -C aspect source flags - INTEGER ASF(13) -C character height - REAL CHH -C character up vector - REAL CHUP(2) -C text path - INTEGER TXP -C text alignment - INTEGER TXAL(2) -C polyline index - INTEGER LINDEX -C linetype - INTEGER LTYPE -C linewidth scale factor - REAL LWIDTH -C polyline colour index - INTEGER PLCOLI -C polymarker index - INTEGER MINDEX -C marker type - INTEGER MTYPE -C marker size and scale factor - REAL MSZSC -C polymarker colour index - INTEGER PMCOLI -C text index - INTEGER TINDEX -C text font and precision - INTEGER TXFONT,TXPREC -C character expansion factor - REAL CHXP -C character spacing - REAL CHSP -C text colour index - INTEGER TXCOLI -C fill area index - INTEGER FINDEX -C fill area interior style - INTEGER INTS -C fill area style index - INTEGER STYLI -C fill area colour index - INTEGER FACOLI -C current normalization transformation number - INTEGER CNTNR -C list of normalization transformation numbers - INTEGER LNTNR(0:MXNTNR) -C normalization transformation - REAL WINDOW(4,0:MXNTNR),VIEWPT(4,0:MXNTNR) -C clipping indicator - INTEGER CLIP -C transformation matrix - REAL MAT(2,3) -C name of open segment - INTEGER OPSG - -C * Miscellaneous stuff -C list of available workstation types - INTEGER LWSTY(NWSTY) -C workstation categories - INTEGER WSCAT(NWSTY) -C maximum display surface size (DC) - REAL GDC(2,NWSTY) -C maximum display surface size (raster units) - INTEGER GRU(2,NWSTY) -C X11 flag - LOGICAL X11 -C kernel flag - LOGICAL KERNEL - -C GKS state list structure - INTEGER GKSL(-3:118), IIA(4) - - EQUIVALENCE (IIA,GKSL(-3)) - EQUIVALENCE (LINDEX,GKSL(1)), (LTYPE,GKSL(2)), (LWIDTH,GKSL(3)) - EQUIVALENCE (PLCOLI,GKSL(4)) - EQUIVALENCE (MINDEX,GKSL(5)), (MTYPE,GKSL(6)), (MSZSC,GKSL(7)) - EQUIVALENCE (PMCOLI,GKSL(8)) - EQUIVALENCE (TINDEX,GKSL(9)), (TXFONT,GKSL(10)) - EQUIVALENCE (TXPREC,GKSL(11)), (CHXP,GKSL(12)), (CHSP,GKSL(13)) - EQUIVALENCE (TXCOLI,GKSL(14)), (CHH,GKSL(15)), (CHUP,GKSL(16)) - EQUIVALENCE (TXP,GKSL(18)), (TXAL,GKSL(19)) - EQUIVALENCE (FINDEX,GKSL(21)), (INTS,GKSL(22)), (STYLI,GKSL(23)) - EQUIVALENCE (FACOLI,GKSL(24)) - EQUIVALENCE (WINDOW,GKSL(25)), (VIEWPT,GKSL(61)) - EQUIVALENCE (CNTNR,GKSL(97)), (CLIP,GKSL(98)), (OPSG,GKSL(99)) - EQUIVALENCE (MAT,GKSL(100)), (ASF,GKSL(106)) - - COMMON /GKS/ GKSL, STATE, SOPWS, NOPWS, SACWS, NACWS, LNTNR, - * WSCAT, LWSTY, GDC, GRU, X11, KERNEL -CDEC$ PSECT /GKS/ NOSHR - - \ No newline at end of file diff -r -N -u gks/dos/GKSUNS.FOR gli-gks/dos/GKSUNS.FOR --- gks/dos/GKSUNS.FOR 2000-11-21 07:16:45.000000000 -0500 +++ gli-gks/dos/GKSUNS.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,68 +0,0 @@ -C* -C* Copyright @ 1984 - 1993 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* - - SUBROUTINE GKDTK1 (FCTID, DX, DY, DIMX, IA, LR1, R1, LR2, R2, - * LC, CHARS) - - INTEGER LC, LR1, LR2 - INTEGER FCTID, DX, DY, DIMX, IA(3) - REAL R1(3), R2(3) - CHARACTER*(*) CHARS(1) - INTEGER IPTR - - INTEGER L - - ENTRY GKDTK2 (FCTID, DX, DY, DIMX, IA, LR1, R1, LR2, R2, - * LC, CHARS) - - ENTRY GKDVT3 (FCTID, DX, DY, DIMX, IA, LR1, R1, LR2, R2, - * LC, CHARS) - - WRITE (*, *) FCTID, DX, DY, DIMX, (IA(L), L = 1, DX * DY), - * LR1, (R1(L), L = 1, LR1), LR2, (R2(L), L=1, LR2), - * LC, (CHARS(L), L = 1, LC) - - STOP 'GKS: logical device driver not supported on this system' - - RETURN - - ENTRY GKDCGM (FCTID, DX, DY, DIMX, IA, LR1, R1, LR2, R2, - * LC, CHARS, IPTR) - - ENTRY GKDMFO (FCTID, DX, DY, DIMX, IA, LR1, R1, LR2, R2, - * LC, CHARS, IPTR) - - ENTRY GKDXW (FCTID, DX, DY, DIMX, IA, LR1, R1, LR2, R2, - * LC, CHARS, IPTR) - - ENTRY GKDPDF (FCTID, DX, DY, DIMX, IA, LR1, R1, LR2, R2, - * LC, CHARS, IPTR) - - ENTRY GKDMFI (FCTID, DX, DY, DIMX, IA, LR1, R1, LR2, R2, - * LC, CHARS, IPTR) - - WRITE (*, *) FCTID, DX, DY, DIMX, (IA(L), L = 1, DX * DY), - * LR1, (R1(L), L = 1, LR1), LR2, (R2(L), L=1, LR2), - * LC, (CHARS(L), L = 1, LC), IPTR - - STOP 'GKS: logical device driver not supported on this system' - - RETURN - END - \ No newline at end of file diff -r -N -u gks/dos/GKSWISS.FOR gli-gks/dos/GKSWISS.FOR --- gks/dos/GKSWISS.FOR 2000-11-21 07:16:45.000000000 -0500 +++ gli-gks/dos/GKSWISS.FOR 1969-12-31 19:00:00.000000000 -0500 @@ -1,41 +0,0 @@ -C* -C* Copyright @ 1984 - 1993 Josef Heinen -C* -C* Permission to use, copy, and distribute this software and its -C* documentation for any purpose with or without fee is hereby granted, -C* provided that the above copyright notice appear in all copies and -C* that both that copyright notice and this permission notice appear -C* in supporting documentation. -C* -C* Permission to modify the software is granted, but not the right to -C* distribute the modified code. Modifications are to be distributed -C* as patches to released version. -C* -C* This software is provided "as is" without express or implied warranty. -C* -C* Send your comments or suggestions to -C* J.Heinen@kfa-juelich.de. -C* - - SUBROUTINE GKCSG (WKID, SEGN, LIA, LR1, LR2, LC, CLEAR) - - INTEGER WKID, SEGN, LIA, LR1, LR2, LC, CLEAR - - INTEGER MAXBUF - PARAMETER (MAXBUF = 2000) - - INTEGER IA(MAXBUF) - REAL R1(MAXBUF), R2(MAXBUF) - CHARACTER*132 CHARS(1) - - IF (LIA .LE. MAXBUF .AND. LR1 .LE. MAXBUF .AND. LR2 .LE. MAXBUF - * .AND. LC .LE. 1) THEN - IF (CLEAR .NE. 0) CALL GCLRWK (WKID, 1) - CALL GKDCSG (WKID, SEGN, IA, R1, R2, CHARS) - ELSE - STOP 'GKS: not enough segment storage' - END IF - - RETURN - END - \ No newline at end of file Binary files gks/dos/INT86.OBJ and gli-gks/dos/INT86.OBJ differ diff -r -N -u gks/dos/MAKEFILE gli-gks/dos/MAKEFILE --- gks/dos/MAKEFILE 2000-11-21 07:16:44.000000000 -0500 +++ gli-gks/dos/MAKEFILE 1969-12-31 19:00:00.000000000 -0500 @@ -1,64 +0,0 @@ -# -# Copyright @ 1984 - 1995 Josef Heinen -# -# Permission to use, copy, and distribute this software and its -# documentation for any purpose with or without fee is hereby granted, -# provided that the above copyright notice appear in all copies and -# that both that copyright notice and this permission notice appear -# in supporting documentation. -# -# Permission to modify the software is granted, but not the right to -# distribute the modified code. Modifications are to be distributed -# as patches to released version. -# -# This software is provided "as is" without express or implied warranty. -# -# Send your comments or suggestions to -# J.Heinen@kfa-juelich.de. -# - -FOR = FL -FFLAGS = /FPi /AH /Gt /nologo -AR = LIB /NOL -LINK = LINK -RM = DEL -CP = COPY -MKDIR = MKDIR -# -LIBCE = D:\C600\LIB\LLIBCE.LIB -DEV = D: - -.SUFFIXES: .obj .for - -.for.obj: - $(FOR) /c $(FFLAGS) $*.for - -all: libgks.lib demo.exe - -#INT86.OBJ: -# $(AR) $(LIBCE) *INT86; - -libgks.lib: gksio.obj gks.obj gksinq.obj gkserror.obj gksroot.obj \ - gksmisc.obj gksdidd.obj gksdps.obj gksdhpgl.obj \ - gksdpbm.obj gksdwiss.obj gkswiss.obj gksddos.obj \ - gksuns.obj gksafm.obj INT86.OBJ - -$(RM) $@ - $(AR) $@ +gksio.obj +gks.obj +gksinq.obj +gkserror.obj +gksroot.obj; - $(AR) $@ +gksmisc.obj +gksdidd.obj +gksdps.obj +gksdhpgl.obj; - $(AR) $@ +gksdpbm.obj +gksdwiss.obj +gkswiss.obj +gksddos.obj; - $(AR) $@ +gksuns.obj +gksafm.obj +INT86.OBJ; - -clean: - -$(RM) *.exe - -$(RM) *.map - -$(RM) libgks.* - -$(RM) *.obj - -demo.exe: demo.obj libgks.lib - $(LINK) demo.obj,,,libgks+GRAPHICS+LLIBFORE; - -install: all - -$(MKDIR) $(DEV)\gks - $(CP) gksfont.dat $(DEV)\gks - $(CP) libgks.lib $(DEV)\gks - \ No newline at end of file diff -r -N -u gks/dos/README gli-gks/dos/README --- gks/dos/README 2000-11-21 07:16:46.000000000 -0500 +++ gli-gks/dos/README 1969-12-31 19:00:00.000000000 -0500 @@ -1,94 +0,0 @@ - - GLIGKS V4.5.28 - ---------------------- - -This directory contains all source code and documentation associated -with the GLIGKS library. GLIGKS is a subset of the ANSI Graphical Kernel -System. This software was developed by - - Josef Heinen - Institute for Solid State Research - Forschungszentrum Juelich GmbH - - e-mail: J.Heinen@kfa-juelich.de - -The basic idea behind GLIGKS was not to have yet another GKS implementation, -but a GKS compliant subset with focus on speed, portability and ease of use. - -GLIGKS has been installed on many platforms, including: - - Cray UNICOS V9.0.2 - DEC Alpha Digital UNIX V4.0 - Red Hat Linux 5.2 (w\ gcc and g77) - DEC Mips ULTRIX V4.4 - DEC VAX OpenVMS V7.0 - HP 9000 HPUX V10.01 - IBM PC MS-DOS V6.21 (w\ Microsoft FORTRAN Version 5.1 or - Lahey FORTRAN Version 5.01) - Red Hat Linux 5.2, 6.x (w\ egcs 1.1.2) - NetBSD (w\ egcs 1.1.x) - IBM RS6000 AIX V4.1.4 - SGI Irix V5.3 - Sun SunOS V5.4 - -On Unix (MS-DOS) systems, you can compile and install this package using the -`make' (`nmake') utility. On VMS or OpenVMS systems, you should invoke the -`make.com' command file, that is part of the GLIGKS package. - - Unix: VMS or OpenVMS: MS-DOS: - - % make $ @MAKE C:\GKS> NMAKE - % make install $ @MAKE INSTALL C:\GKS> NMAKE INSTALL - -`make install' will install the package's files in `/usr/local/lib', -`sys$library' or `C:\GKS', respectively: - - Unix: VMS or OpenVMS: MS-DOS: - - /usr/local/lib/libgks.a SYS$LIBRARY:LIBGKS.OLB C:\GKS\LIBGKS.LIB - /usr/local/lib/gksfont.dat SYS$LIBRARY:GKSFONT.DAT C:\GKS\GKSFONT.DAT - -If, for any reason, you decide to move GLIGKS files to another directory, -you will have to tell GLIGKS about the new font path. - - Unix: VMS or OpenVMS: MS-DOS - - setenv GLI_HOME path define GLI_HOME dir-spec n/a -or - export GLI_HOME=path - -Before you run a GLIGKS application, you should set the `GLI_WSTYPE' -environment variable to the required GKS workstation type. With the default -setting GLIGKS will open an X display. The following example shows how to -setup GLIGKS for PostScript output. - - Unix: VMS or OpenVMS: MS-DOS - - setenv GLI_WSTYPE 61 define GLI_WSTYPE 61 n/a - -The GLIGKS logical device drivers (with their corresponding GKS workstation -types) are: - - 2 GKSM Output Metafile - 5 Workstation Independent Segment Storage (WISS) - 7, 8 CGM Binary, Clear Text (Computer Graphics Metafile) - 16, 17 DIGITAL VT330, VT340 Video Terminal - 38 DIGITAL LN03 PLUS - 41 VAX UIS - 51, 53 HP-GL Graphics Plotter - 61, 62 PostScript, Color PostScript Printer - 63, 64 Display PostScript w\ Compuserve GIF dump (b/w, color) - 72 TEK401x Series Terminal - 82 TEK42xx Series Terminal - 92 DIGITAL LJ250 Companion Color Printer - 101, 102 Portable Document Format (normal, compressed) - 104 PBM (Portable BitMap) - 201 TAB 132/15-G Terminal - 204 MONTEREY MG200 Display Terminal - 207 IBM PC - 210, 211 X Display - 214 X Display w\ Sun rle rasterfile dump - 215, 218 X Display w\ CompuServe GIF dump (87a, 89a) - 217 X Display w\ frame buffer - - \ No newline at end of file diff -r -N -u gks/gksdescr.i gli-gks/gksdescr.i --- gks/gksdescr.i 1999-07-19 11:05:00.000000000 -0400 +++ gli-gks/gksdescr.i 2010-02-13 16:14:10.229284862 -0500 @@ -24,7 +24,7 @@ PARAMETER (LEVEL=GL0B) C number of available workstation types INTEGER NWSTY - PARAMETER (NWSTY=39) + PARAMETER (NWSTY=26) C max. number of simult. open workstations INTEGER MNOPWS PARAMETER (MNOPWS=16) diff -r -N -u gks/gksdidd.f gli-gks/gksdidd.f --- gks/gksdidd.f 2007-11-23 06:23:38.000000000 -0500 +++ gli-gks/gksdidd.f 2010-02-13 16:10:25.039260589 -0500 @@ -88,10 +88,6 @@ * 204, 207, 82, 51, * 53, 72, 16, 17, * 61, 62, 63, 64, - * 210, 211, 212, 213, - * 214, 215, 216, 217, - * 218, - * 230, 231, 232, 233, * 7, 8, 5, 41, * 38, 103, 104, 92, * 2, 3, 101, 102), SOPWS(I,4) @@ -142,25 +138,6 @@ * LC,CHARS,IPTR(1)) GOTO 4000 -C* X Windows (Xlib) - 210 CONTINUE - 211 CONTINUE - 212 CONTINUE - 213 CONTINUE - 214 CONTINUE - 215 CONTINUE - 216 CONTINUE - 217 CONTINUE - 218 CONTINUE - 230 CONTINUE - 231 CONTINUE - 232 CONTINUE - 233 IPTR(1) = SOPWS(I,5) - IPTR(2) = SOPWS(I,6) - CALL GKDXW (FID,DX,DY,DIMX,IA(1),LRX,RX(1),LRY,RY(1), - * LC,CHARS,IPTR(1)) - GOTO 4000 - C* GKSM Output Metafile 2 IPTR(1) = SOPWS(I,5) IPTR(2) = SOPWS(I,6) diff -r -N -u gks/gksdx11.c gli-gks/gksdx11.c --- gks/gksdx11.c 2004-07-14 02:48:51.000000000 -0400 +++ gli-gks/gksdx11.c 1969-12-31 19:00:00.000000000 -0500 @@ -1,4580 +0,0 @@ -/* - * Copyright @ 1984 - 1996 Josef Heinen - * - * Permission to use, copy, and distribute this software and its - * documentation for any purpose with or without fee is hereby granted, - * provided that the above copyright notice appear in all copies and - * that both that copyright notice and this permission notice appear - * in supporting documentation. - * - * Permission to modify the software is granted, but not the right to - * distribute the modified code. Modifications are to be distributed - * as patches to released version. - * - * This software is provided "as is" without express or implied warranty. - * - * Send your comments or suggestions to - * J.Heinen@kfa-juelich.de. - * - * - * FACILITY: - * - * GLI GKS V4.5 - * - * ABSTRACT: - * - * This module contains a logical device driver for XWindow - * displays. - * - * AUTHOR: - * - * Josef Heinen - * - * VERSION: - * - * V1.0 - * - */ - -#include - -#include "gksdefs.h" - -#if !defined(NO_X11) - -#include -#include -#include -#include -#include - -#if !defined(VMS) && !defined(MSDOS) && !defined(_WIN32) -#include -#endif - -#ifdef __osf__ -int usleep(useconds_t); -#endif - -#include - -#ifdef XSHM -#include -#include -#endif - -#if defined(cray) || defined(__SVR4) || defined(_WIN32) -#include -#else -#include -#endif - -#include - -#include -#include -#include -#include - -#include - -#ifdef XSHM -#include -#endif - -#endif - -#ifdef VMS -#include -#endif - -#ifdef cray -#include -#endif - -#ifdef VMS -#define CHARARG(a) struct dsc$descriptor *a -#else -#ifdef cray -#define CHARARG(a) _fcd a -#else -#if defined(_WIN32) && !defined(__GNUC__) -#define CHARARG(a) char *(a), unsigned short a##_len -#else -#define CHARARG(a) char *a -#endif /* _WIN32 */ -#endif /* cray */ -#endif /* VMS */ - -#if defined(_WIN32) && !defined(__GNUC__) -#define STDCALL __stdcall -#else -#define STDCALL -#endif - -#if !defined(NO_X11) - -#include "icon.bm" - -#ifndef min -#define min(a,b) (((a)<(b)) ? (a) : (b)) -#endif -#ifndef max -#define max(a,b) (((a)>(b)) ? (a) : (b)) -#endif -#define nint(a) ((int)(a + 0.5)) - -#define WindowName "GLIgks V4.5.28" - -#define DrawBorder 0 -#define Undefined 0xffff - -#define Pi 3.141592654 - -#define MAX_TNR 9 -#define MAX_PIXMAP 512 -#define MAX_SIZE 100 - -#define PRIVATE_COLORS 8 -#define SHARED_COLORS 72 -#define CMAP_EXTENT 84 -#define MAX_COLORS 256 -#define MAX_POINTS 2048 -#define PATTERNS 120 -#define HATCH_STYLE 108 -#define MAX_COLORIND 1024 - -#define WHITE 255 -#define THRESH 127 -#define BLACK 0 -#define INITERR(X,Y) (X - (Y ? WHITE : BLACK) + (THRESH - X)/2) - -#define LEFT (1<<0) -#define RIGHT (1<<1) -#define BOTTOM (1<<2) -#define TOP (1<<3) - -#define CTRL_C 3 -#define CTRL_D 4 -#define CTRL_Z 26 - -#define WC_to_NDC(xw, yw, tnr, xn, yn) \ - xn = a[tnr] * (xw) + b[tnr]; \ - yn = c[tnr] * (yw) + d[tnr] - -#define WC_to_NDC_rel(xw, yw, tnr, xn, yn) \ - xn = a[tnr] * (xw); \ - yn = c[tnr] * (yw) - -#define NDC_to_WC(xn, yn, tnr, xw, yw) \ - xw = ((xn) - b[tnr]) / a[tnr]; \ - yw = ((yn) - d[tnr]) / c[tnr] - -#define NDC_to_DC(xn, yn, xd, yd) \ - xd = sint(p->a * (xn) + p->b + 0.5); \ - yd = sint(p->c * (yn) + p->d + 0.5) - -#define DC_to_NDC(xd, yd, xn, yn) \ - xn = ((xd) - p->b) / p->a; \ - yn = ((yd) - p->d) / p->c; - -#define CharXform(xrel, yrel, x, y) \ - x = cos_f[p->path] * (xrel) - sin_f[p->path] * (yrel); \ - y = sin_f[p->path] * (xrel) + cos_f[p->path] * (yrel); - -#define Color8Bit(c) \ - (c) >= 588 ? 80 + (c-588)/56 * 12 + nint((c-588)%56 * 11.0/56.0) : \ - (c) >= 257 ? 8 + nint((c-257)/330.0 * (72-1)) : (c) - -static char *fonts[] = { - "-%s-times-medium-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-times-medium-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-times-bold-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-times-bold-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-helvetica-medium-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-helvetica-medium-o-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-helvetica-bold-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-helvetica-bold-o-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-courier-medium-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-courier-medium-o-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-courier-bold-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-courier-bold-o-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-symbol-medium-r-normal--*-%d0-%d-%d-*-*-*-*", - "-%s-itc lubalin graph-book-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-itc lubalin graph-book-o-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-itc lubalin graph-demi-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-itc lubalin graph-demi-o-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-new century schoolbook-medium-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-new century schoolbook-medium-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-new century schoolbook-bold-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-new century schoolbook-bold-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-itc avant garde gothic-book-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-itc avant garde gothic-book-o-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-itc avant garde gothic-demi-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-itc avant garde gothic-demi-o-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-itc souvenir-light-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-itc souvenir-light-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-itc souvenir-demi-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-%s-itc souvenir-demi-i-normal--*-%d0-%d-%d-*-*-iso8859-1" - }; -static int n_font = 29; - -static char *urw_fonts[] = { - "-urw-nimbus roman no9 l-medium-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-nimbus roman no9 l-medium-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-nimbus roman no9 l-bold-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-nimbus roman no9 l-bold-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-nimbus sans l-medium-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-nimbus sans l-medium-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-nimbus sans l-bold-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-nimbus sans l-bold-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-nimbus mono l-medium-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-nimbus mono l-medium-o-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-nimbus mono l-bold-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-nimbus mono l-bold-o-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-standard symbols l-medium-r-normal--*-%d0-%d-%d-*-*-*-*", - "-urw-urw bookman l-medium-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-urw bookman l-medium-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-urw bookman l-bold-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-urw bookman l-bold-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-century schoolbook l-medium-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-century schoolbook l-medium-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-century schoolbook l-bold-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-century schoolbook l-bold-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-urw gothic l-medium-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-urw gothic l-medium-o-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-urw gothic l-semibold-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-urw gothic l-semibold-o-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-urw palladio l-medium-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-urw palladio l-medium-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-urw palladio l-bold-r-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-urw palladio l-bold-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-urw chancery l-medium-i-normal--*-%d0-%d-%d-*-*-iso8859-1", - "-urw-dingbats-medium-r-normal--*-%d0-%d-%d-*-*-*-*" - }; - -static int map[32] = { - 22, 9, 5, 14, 18, 26, 13, 1, - 24, 11, 7, 16, 20, 28, 13, 3, - 23, 10, 6, 15, 19, 27, 13, 2, - 25, 12, 8, 17, 21, 29, 13, 4 - }; - -static float capheights[29] = { - 0.72, 0.72, 0.72, 0.72, - 0.76, 0.76, 0.76, 0.76, - 0.6, 0.6, 0.6, 0.6, - 0.76, - 0.76, 0.76, 0.76, 0.76, - 0.76, 0.76, 0.76, 0.76, - 0.76, 0.76, 0.76, 0.76, - 0.76, 0.76, 0.76, 0.76 - }; - -static char patterns[PATTERNS][33]; -static Bool have_patterns = False; - -static float xfac[4] = {0, 0, -0.5, -1}; -static float yfac[6] = {0, -1.2, -1, -0.5, 0, 0.2}; - -static float sin_f[] = {0, 1, 0, -1}; -static float cos_f[] = {1, 0, -1, 0}; - -static int predef_font[] = {1, 1, 1, -2, -3, -4}; -static int predef_prec[] = {0, 1, 2, 2, 2, 2}; -static int predef_ints[] = {0, 1, 3, 3, 3}; -static int predef_styli[] = {1, 1, 1, 2, 3}; - -static XPoint *points = NULL; -static int max_points = MAX_POINTS; - -#if defined(hpux) && !defined(NAGware) -static void (*line_routine_a)(); -static void (*fill_routine_a)(); -#endif - -typedef enum { - TypeNone, TypeLocal, TypeCrosshair, TypeCross, TypeRubberband, - TypeRectangle, TypeDigital, TypeCircle} pe_type; - -typedef unsigned char byte; - -typedef struct ws_state_list_struct { - int wkid; - int gif, rf; - FILE *uil; - Bool packed_ca; - Widget widget; - int conid, wstype; - Display *dpy; - Bool new_dpy; - int fd; - Screen *screen; - Bool backing_store; - unsigned long fg, bg; - Visual *vis; - int depth; - Colormap cmap; - Window win; - Bool new_win; - Pixmap pixmap, icon_pixmap; - Bool double_buf; - int shape; - XImage *shmimage; -#ifdef XSHM - XShmSegmentInfo shminfo; -#endif - GC gc, clear, invert; - long event_mask; - Cursor cursor, textcursor; - int swidth, sheight, dpi, x, y, width, height; - float mwidth, mheight, magnification, window[4], viewport[4]; - int state, mapped; - Bool empty; - int path; - float ratio; - int cached_size; - XFontStruct *fstr[29][MAX_SIZE], *cfont; - int capheight; - Pixmap tile[MAX_COLORS][PATTERNS]; - Pixmap stipple[MAX_COLORS][PATTERNS]; - Bool ored_patterns; - XColor color[MAX_COLORS]; - unsigned long pixels[MAX_COLORS], ccolor, ncolors, pcolors, scolors; - Bool mono_flag, min_colors, dark_bg; - float red[MAX_COLORS], green[MAX_COLORS], blue[MAX_COLORS]; - float gray[MAX_COLORS]; - int ltype; - unsigned int lwidth; - float a, b, c, d; - pe_type type; - int px, py; - char *error; - int scalable_fonts; - Bool xshm, gr_bc; - Pixmap *frame; - int nframes; - } ws_state_list; - -typedef struct { - int ch; - char seq[3]; - char alt_seq[3]; - } compose_keys; - -static compose_keys key_bindings[] = { - { 34, "\" ",""}, /* quotation mark */ - { 35, "++",""}, /* number sign */ - { 39, "' ",""}, /* apostrophe */ - { 64, "AA",""}, /* commercial at */ - { 91, "((",""}, /* opening bracket */ - { 92, "//","/<"}, /* backslash */ - { 93, "))",""}, /* closing bracket */ - { 94, "^ ",""}, /* circumflex accent */ - { 96, "` ",""}, /* grave accent */ - { 123, "(-",""}, /* opining brace */ - { 124, "/^",""}, /* vertical line */ - { 125, ")-",""}, /* closing brace */ - { 126, "~ ",""}, /* tilde */ - { 160, " ", "" }, /* no break space*/ - { 161, "!!", "" }, /* inverted ! */ - { 162, "C/", "C|" }, /* cent sign */ - { 163, "L-", "L=" }, /* pound sign */ - { 164, "XO", "X0" }, /* currency sign */ - { 165, "Y-", "Y=" }, /* yen sign */ - { 166, "||", "!^" }, /* broken vertical bar */ - { 167, "SO", "S!" }, /* section sign */ - { 168, "\"\"", "" }, /* diaeresis */ - { 169, "CO", "C0" }, /* copyright sign */ - { 170, "A_", "" }, /* feminine ordinal */ - { 171, "<<", "" }, /* open angle brackets */ - { 172, "-,", "" }, /* logical not */ - { 173, "-^", "" }, /* macron */ - { 174, "RO", "" }, /* registered trademark */ - { 175, "--", "" }, /* soft (syllable) hyphen */ - { 176, "0^", "" }, /* degree sign */ - { 177, "+-", "" }, /* plus or minus sign */ - { 178, "2^", "" }, /* superscript 2 */ - { 179, "3^", "" }, /* superscript 3 */ - { 180, "''", "" }, /* acute accent */ - { 181, "/U", "" }, /* micro sign */ - { 182, "P!", "" }, /* paragraph sign */ - { 183, ".^", "" }, /* middle dot */ - { 184, ", ", "" }, /* cedilla */ - { 185, "1^", "" }, /* superscript 1 */ - { 186, "O_", "" }, /* masculine ordinal */ - { 187, ">>", "" }, /* closed angle brackets */ - { 188, "14", "" }, /* fraction one-quarter */ - { 189, "12", "" }, /* fraction one-half */ - { 190, "34", "" }, /* three quarters */ - { 191, "??", "" }, /* inverted ? */ - { 192, "`A", "" }, /* A grave */ - { 193, "'A", "" }, /* A acute */ - { 194, "^A", "" }, /* A circumflex */ - { 195, "~A", "" }, /* A tilde */ - { 196, "\"A", "" }, /* A umlaut */ - { 197, "A*", "" }, /* A ring */ - { 198, "AE", "" }, /* A E diphthong */ - { 199, "C,", "" }, /* C cedilla */ - { 200, "`E", "" }, /* E grave */ - { 201, "'E", "" }, /* E acute */ - { 202, "^E", "" }, /* E circumflex */ - { 203, "\"E", "" }, /* E umlaut */ - { 204, "`I", "" }, /* I grave */ - { 205, "'I", "" }, /* I acute */ - { 206, "^I", "" }, /* I circumflex */ - { 207, "\"I", "" }, /* I umlaut */ - { 208, "-D", "" }, /* capital Icelandic Eth */ - { 209, "~N", "" }, /* N tilde */ - { 210, "`O", "" }, /* O grave */ - { 211, "'O", "" }, /* O acute */ - { 212, "^O", "" }, /* O circumflex */ - { 213, "~O", "" }, /* O tilde */ - { 214, "\"O", "" }, /* O umlaut */ - { 215, "xx", "" }, /* multiplication sign */ - { 216, "o/", "" }, /* O slash */ - { 217, "`U", "" }, /* U grave */ - { 218, "'U", "" }, /* U acute */ - { 219, "^U", "" }, /* U circumflex */ - { 220, "\"U", "" }, /* U umlaut */ - { 221, "'Y", "" }, /* Y acute */ - { 222, "TH", "" }, /* capital Icelandic thorn */ - { 223, "ss", "" }, /* German small sharp s */ - { 224, "`a", "" }, /* a grave */ - { 225, "'a", "" }, /* a acute */ - { 226, "^a", "" }, /* a circumflex */ - { 227, "~a", "" }, /* a tilde */ - { 228, "\"a", "" }, /* a umlaut */ - { 229, "a*", "" }, /* a ring */ - { 230, "ae", "" }, /* a e diphthong */ - { 231, "c,", "" }, /* c cedilla */ - { 232, "`e", "" }, /* e grave */ - { 233, "'e", "" }, /* e acute */ - { 234, "^e", "" }, /* e circumflex */ - { 235, "\"e", "" }, /* e umlaut */ - { 236, "`i", "" }, /* i grave */ - { 237, "'i", "" }, /* i acute */ - { 238, "^i", "" }, /* i circumflex */ - { 239, "\"i", "" }, /* i umlaut */ - { 240, "-d", "" }, /* small Icelandic Eth */ - { 241, "~n", "" }, /* n tilde */ - { 242, "`o", "" }, /* o grave */ - { 243, "'o", "" }, /* o acute */ - { 244, "^o", "" }, /* o circumflex */ - { 245, "~o", "" }, /* o tilde */ - { 246, "\"o", "" }, /* o umlaut */ - { 247, "-:", "" }, /* division sign */ - { 248, "o/", "" }, /* o slash */ - { 249, "`u", "" }, /* u grave */ - { 250, "'u", "" }, /* u acute */ - { 251, "^u", "" }, /* u circumflex */ - { 252, "\"u", "" }, /* u umlaut */ - { 253, "'y", "" }, /* y acute */ - { 254, "th", "" }, /* small Icelandic thorn */ - { 255, "\"y", "" } /* y umlaut */ - }; -static int n_key = sizeof(key_bindings)/sizeof(key_bindings[0]); - -static gks_state_list *gksl; -static float a[MAX_TNR], b[MAX_TNR], c[MAX_TNR], d[MAX_TNR]; - -static ws_state_list *p; -static int error_code, request_code, function_id; - - -static -int *handler (Display *dpy, XErrorEvent *event) -{ - char str[80], request[40]; - - if (event->error_code != error_code || event->request_code != request_code) - { - XGetErrorText (dpy, event->error_code, str, sizeof(str)); - gks_fprintf (stderr, "GKS: X Protocol error detected by server: %s\n", - str); - - sprintf (request, "XRequest.%d", event->request_code); - XGetErrorDatabaseText (dpy, "", request, "unknown", str, sizeof(str)); - gks_fprintf (stderr, "Failed request major op code %d (%s)\n", - event->request_code, str); - - gks_fprintf (stderr, "Invoked from within GKS function id %d\n", - function_id); - - error_code = event->error_code; - request_code = event->request_code; - } - - return (NULL); -} - - -static -int sint (double a) -{ - if (a > 65535) - return 65535; - else if (a < -65535) - return -65535; - else - return (int)(a + 0.5); -} - - -static -void seg_xform (float *x, float *y) -{ - float xx; - - xx = *x * gksl->mat[0][0] + *y * gksl->mat[0][1] + gksl->mat[2][0]; - *y = *x * gksl->mat[1][0] + *y * gksl->mat[1][1] + gksl->mat[2][1]; - *x = xx; -} - - -static -void seg_xform_rel (float *x, float *y) -{ - float xx; - - xx = *x * gksl->mat[0][0] + *y * gksl->mat[0][1]; - *y = *x * gksl->mat[1][0] + *y * gksl->mat[1][1]; - *x = xx; -} - - -static -void set_clipping (Bool state) -{ - float clrt[4]; - int i, j; - XRectangle rt; - - if (state && gksl->clip == GCLIP) - { - memcpy(clrt, gksl->viewport[gksl->cntnr], 4*sizeof(float)); - if (p->gr_bc == 0) - { - seg_xform (&clrt[0], &clrt[2]); - seg_xform (&clrt[1], &clrt[3]); - } - i = clrt[0] < clrt[1] ? 0 : 1; - j = clrt[2] < clrt[3] ? 2 : 3; - - rt.x = (int) (p->a * clrt[i] + p->b); - rt.y = (int) (p->c * clrt[5-j] + p->d); - rt.width = (int) (p->a * (clrt[1-i]-clrt[i] )) + 2; - rt.height = (int) (p->c * (clrt[j] -clrt[5-j])) + 2; - - XSetClipRectangles (p->dpy, p->gc, 0, 0, &rt, 1, Unsorted); - } - else - XSetClipMask (p->dpy, p->gc, None); - - rt.x = 0; - rt.y = 0; - rt.width = p->width; - rt.height = p->height; - - XSetClipRectangles (p->dpy, p->invert, 0, 0, &rt, 1, Unsorted); -} - - -static -void expose_event (Widget widget, ws_state_list *p, XExposeEvent *event, - Boolean *continue_to_dispatch) - -/* - * Handle expose events - */ - -{ - if (p->pixmap) { - set_clipping (False); - XCopyArea (p->dpy, p->pixmap, p->win, p->gc, event->x, event->y, - event->width, event->height, event->x, event->y); - set_clipping (True); - } -} - - -static -Display *open_display (void) - -/* - * Open display - */ - -{ - char *env, *ep; - char s[80]; - - env = (char *) getenv ("GLI_CONID"); - if (!env) env = (char *) getenv ("GKSconid"); - - if (p->wstype == 213) - { - if (env == NULL) - { - gks_fprintf (stderr, "GKS: can't obtain widget id\n"); - return (NULL); - } - else - sscanf (env, "%ld", (long int *)&p->widget); - /* Note: may be a 64-Bit pointer */ - } - - if (p->widget == NULL) - { - if (p->wstype == 212) - { - if (env == NULL) - { - gks_fprintf (stderr, - "GKS: can't obtain pre-existing drawable\n"); - return (NULL); - } - else { - if (sscanf (env, "%d!%d", (int *)&p->dpy, (int *)&p->win) != 2) - { - ep = strchr (env, '!'); - if (ep != NULL) { - if (strncmp (++ep, "0x", 2) == 0) - sscanf (ep + 2, "%x", (int *)&p->win); - else - sscanf (ep, "%d", (int *)&p->win); - } -#ifdef _WIN32 - if (*env == ':') - sprintf (s, "localhost%s", env); - else - strcpy (s, env); -#else - strcpy (s, env); -#endif - strtok (s, "!"); - p->dpy = XOpenDisplay (s); - p->new_dpy = True; - } - } - } - else { - if (!env) env = (char *) getenv ("DISPLAY"); - if (env != NULL) - { -#ifdef _WIN32 - if (*env == ':') - sprintf (s, "localhost%s", env); - else - strcpy (s, env); -#else - strcpy (s, env); -#endif - env = s; - } - p->dpy = XOpenDisplay (env); - p->new_dpy = True; - } - - if (p->dpy == NULL) - { - if (!env) env = ""; - gks_fprintf (stderr, "GKS: can't open display on \"%s\"\n", env); - return (NULL); - } - - p->screen = XDefaultScreenOfDisplay(p->dpy); - } - else { - p->dpy = XtDisplay (p->widget); - p->new_dpy = False; - p->screen = XtScreenOfObject (p->widget); - } - - p->fd = ConnectionNumber(p->dpy); - - XSetErrorHandler ((XErrorHandler) handler); - error_code = request_code = 0; - - p->backing_store = (XDoesBackingStore(p->screen) == Always) || - ((char *) getenv ("GLI_GKS_BS") != NULL); - - p->mwidth = XWidthMMOfScreen(p->screen) * 0.001; - p->mheight = XHeightMMOfScreen(p->screen) * 0.001; - p->swidth = XWidthOfScreen(p->screen); - p->sheight = XHeightOfScreen(p->screen); - - p->magnification = 1; - - if ((env = (char *) getenv ("GLI_GKS_DPI")) != NULL) - p->dpi = atoi(env); - else - p->dpi = 75; - - p->ored_patterns = (char *) getenv("GLI_GKS_TRANSPARENT_PATTERNS") != NULL; - - return (p->dpy); -} - - -static -void set_colors (void) -{ - int i, coli; - - p->dark_bg = (char *) getenv("GLI_GKS_DARK_BG") != NULL; - - for (i=0; idark_bg) ? 1 - i : i; - GQRGB (&coli, &p->red[i], &p->green[i], &p->blue[i]); - p->gray[i] = 0.3*p->red[i] + 0.59*p->green[i] + 0.11*p->blue[i]; - } -} - - -static -void configure_colors (void) -{ - char *env; - - if ((env = (char *) getenv("GLI_GKS_CMAP_EXTENT")) != NULL) - { - if (*env) - p->scolors += atoi(env); - else - p->scolors += CMAP_EXTENT; - - if (PRIVATE_COLORS + p->scolors > MAX_COLORS) - p->scolors = MAX_COLORS; - } -} - - -static -Bool allocate_color_cells (int ncolors) -{ - static unsigned long plane_masks[] = {0}; - Bool contig; - - contig = True; - if (XAllocColorCells (p->dpy, p->cmap, contig, plane_masks, 0, p->pixels, - ncolors)) - { - p->pcolors = p->ncolors = ncolors; - return True; - } - else - return False; -} - - -static -void allocate_private_colors (void) -{ - int i; - Bool have_colors = False; - - have_colors = allocate_color_cells (PRIVATE_COLORS + p->scolors); - if (!have_colors) - have_colors = allocate_color_cells (PRIVATE_COLORS); - if (!have_colors) { - gks_fprintf (stderr, "GKS: unable to allocate private colors\n"); - return; - } - - for (i=0; incolors; i++) - { - p->color[i].pixel = p->pixels[i]; - p->color[i].flags = DoRed | DoGreen | DoBlue; - - p->color[i].red = (unsigned short)(p->red[i]*65535); - p->color[i].green = (unsigned short)(p->green[i]*65535); - p->color[i].blue = (unsigned short)(p->blue[i]*65535); - } - - XStoreColors (p->dpy, p->cmap, p->color, p->ncolors); -} - - -static -void pick_closest_colors (XColor *color, int ncolors) -{ - XColor ctab[256]; - int i, j, maxcol, closest, d, mdist; - - maxcol = XCellsOfScreen (p->screen); - maxcol = (maxcol < 256) ? maxcol : 256; - - p->error = "GKS: failed to allocate at least one pixel; use closest color"; - - for (i=0; idpy, p->cmap, ctab, maxcol); - - for (i=0; icolor[i].red = (unsigned short)(p->red[i]*65535); - p->color[i].green = (unsigned short)(p->green[i]*65535); - p->color[i].blue = (unsigned short)(p->blue[i]*65535); - - if (!XAllocColor (p->dpy, p->cmap, &p->color[i])) - { - p->color[i].pixel = 0xffff; - k++; - } - } - - if (k) { - gks_fprintf (stderr, "GKS: unable to allocate %d of %d colors\n", k, - PRIVATE_COLORS); - pick_closest_colors (p->color, PRIVATE_COLORS); - } - - p->ncolors = PRIVATE_COLORS; -} - - -/*******************************************************/ -/* 24/32-bit TrueColor display color 'allocation' code */ -/*******************************************************/ - -static -int highbit(unsigned long ul) -{ - /* returns position of highest set bit in 'ul' as an integer (0-31), - or -1 if none */ - - int i; unsigned long hb; - hb = 0x8000; hb = (hb<<16); /* hb = 0x80000000UL */ - for (i=31; ((ul & hb) == 0) && i>=0; i--, ul<<=1); - return i; -} - - -static -void alloc_color(XColor *color) -{ - unsigned long r, g, b, rmask, gmask, bmask; - int rshift, gshift, bshift; - - /* shift r,g,b so that high bit of 16-bit color specification is - * aligned with high bit of r,g,b-mask in visual, - * AND each component with its mask, - * and OR the three components together - */ - - r = color->red; g = color->green; b = color->blue; - - rmask = p->vis->red_mask; - gmask = p->vis->green_mask; - bmask = p->vis->blue_mask; - - rshift = 15 - highbit(rmask); - gshift = 15 - highbit(gmask); - bshift = 15 - highbit(bmask); - - /* shift the bits around */ - if (rshift<0) r = r << (-rshift); - else r = r >> rshift; - - if (gshift<0) g = g << (-gshift); - else g = g >> gshift; - - if (bshift<0) b = b << (-bshift); - else b = b >> bshift; - - r = r & rmask; - g = g & gmask; - b = b & bmask; - - color->pixel = r | g | b; - - /* put 'exact' colors into red,green,blue fields */ - /* shift the bits BACK to where they were, now that they've been masked */ - if (rshift<0) r = r >> (-rshift); - else r = r << rshift; - - if (gshift<0) g = g >> (-gshift); - else g = g << gshift; - - if (bshift<0) b = b >> (-bshift); - else b = b << bshift; - - color->red = r; color->green = g; color->blue = b; -} - - -static -void allocate_shared_colors (void) -{ - int i, j, k; - - j = p->ncolors; - - for (i=k=0; iscolors; i++) - { - p->color[j].red = (unsigned short)(p->red[j]*65535); - p->color[j].green = (unsigned short)(p->green[j]*65535); - p->color[j].blue = (unsigned short)(p->blue[j]*65535); - -#if defined(__cplusplus) || defined(c_plusplus) - if (p->vis->c_class == TrueColor) -#else - if (p->vis->class == TrueColor) -#endif - { - alloc_color(&p->color[j]); - } - else if (!XAllocColor (p->dpy, p->cmap, &p->color[j])) - { - p->color[j].pixel = 0xffff; - k++; - } - - p->ncolors++; - j++; - } - - if (k) - pick_closest_colors (p->color, p->ncolors); -} - - -static -void allocate_named_colors (char *rgb) -{ - int i, j, k, coli; - FILE *file; - char spec[80], *get; - Status parse; - Bool failed = False; - - if ((file = fopen (rgb, "r")) != NULL) - { - j = p->ncolors; - - for (i=k=0; iscolors; i++) - { - if ((get = fgets (spec, 80, file)) != NULL); - { - strtok (spec, "\n"); - - if ((parse = XParseColor (p->dpy, p->cmap, spec, &p->color[j])) - != 0) - { - p->red[j] = (float)p->color[j].red/65535.0; - p->green[j] = (float)p->color[j].green/65535.0; - p->blue[j] = (float)p->color[j].blue/65535.0; - p->gray[j] = 0.3*p->red[j] + 0.59*p->green[j] + - 0.11*p->blue[j]; - - coli = j; - GSRGB (&coli, &p->red[j], &p->green[j], &p->blue[j]); - } - else - failed = True; - } - - if (!get || !parse) - { - p->color[j].red = (unsigned short)(p->red[j]*65535); - p->color[j].green = (unsigned short)(p->green[j]*65535); - p->color[j].blue = (unsigned short)(p->blue[j]*65535); - } - - if (!XAllocColor (p->dpy, p->cmap, &p->color[j])) - { - p->color[j].pixel = 0xffff; - k++; - } - - p->ncolors++; - j++; - } - - if (k) - pick_closest_colors (p->color, p->ncolors); - - if (failed) - gks_fprintf (stderr, - "GKS: couldn't parse at least one color value\n"); - - fclose (file); - } - else - gks_fprintf (stderr, "GKS: can't open RGB file\n"); -} - - -static -void allocate_colors (Bool min_colors) - -/* - * Allocate colors - */ - -{ - char *rgb; - int i, pix; - XVisualInfo vinfo; - - if (min_colors) - { - if (p->widget == NULL && p->wstype != 212 && - XMatchVisualInfo(p->dpy, DefaultScreen(p->dpy), 24, TrueColor, - &vinfo) != 0) - { - p->vis = vinfo.visual; - p->depth = vinfo.depth; - p->cmap = XCreateColormap (p->dpy, RootWindow(p->dpy, vinfo.screen), - p->vis, AllocNone); - } - else - { - p->vis = XDefaultVisualOfScreen(p->screen); - p->depth = XDefaultDepthOfScreen(p->screen); - p->cmap = XDefaultColormapOfScreen(p->screen); - } - - i = p->dark_bg ? 1 : 0; - p->color[i].pixel = XWhitePixelOfScreen(p->screen); - p->color[1-i].pixel = XBlackPixelOfScreen(p->screen); - p->ncolors = 2; - - p->pcolors = 0; - } - - rgb = (char *) getenv("GLI_GKS_RGB"); - - if (rgb == NULL) - { -#if defined(__cplusplus) || defined(c_plusplus) - switch (p->vis->c_class) -#else - switch (p->vis->class) -#endif - { - case PseudoColor: - case DirectColor: - case StaticGray: - if (min_colors) - { - if (p->depth >= 4) - allocate_private_colors (); - } - else { - if (p->depth >= 8) - if (p->pcolors < PRIVATE_COLORS + p->scolors) - { - if (p->pcolors) - allocate_shared_colors (); - else - allocate_pseudo_colors (); - } - } - break; - - case StaticColor: - case TrueColor: - case GrayScale: - if (min_colors) - allocate_pseudo_colors (); - else - allocate_shared_colors (); - break; - } - } - else - { - if (min_colors) - allocate_pseudo_colors (); - else - allocate_named_colors (rgb); - } - - if (min_colors) - { - p->ccolor = Undefined; - - p->bg = p->color[0].pixel; - p->fg = p->color[1].pixel; - } - else - p->mono_flag = p->ncolors == 2; - - p->min_colors = min_colors; - - for (i=0; incolors; i++) - { - pix = p->color[i].pixel; - GSPIX (&i, &pix); - } -} - - -static -void free_colors (void) -{ - unsigned long planes = 0; - - if (p->pcolors) - { - XFreeColors (p->dpy, p->cmap, p->pixels, p->pcolors, planes); - XSync (p->dpy, False); - } -} - - -static -void create_window (int win) - -/* - * Create a window - */ - -{ - XSetWindowAttributes xswa; - XWindowAttributes xwa; - char icon_name[40]; - char *env, **argv = NULL; - int argc = 0; - XSizeHints *hints = NULL; - unsigned long valuemask; - - /* Set up the window attributes. We want to set the event mask, - * and the background pixel */ - - xswa.background_pixel = p->bg; - xswa.event_mask = StructureNotifyMask | ExposureMask; - - if (p->backing_store && ((char *) getenv ("GLI_GKS_BS") == NULL)) - xswa.backing_store = Always; - else - xswa.backing_store = NotUseful; - - xswa.colormap = p->cmap; - xswa.border_pixel = p->bg; - - if (p->widget == NULL && p->wstype != 212) - { - p->new_win = True; - - p->x = 5 + win*25; - p->y = 100 + win*25; - - if (!p->uil) - { - if ((env = (char *) getenv ("GLI_GKS_MAGSTEP")) != NULL) - p->magnification = pow(1.2, atof(env)); - - p->width = p->height = (p->dpi == 100) ? - (int)(667 * p->magnification) : (int)(500 * p->magnification); - } - else - p->width = p->height = 16; - - /* Create a window whose parent is the root window */ - - p->win = XCreateWindow (p->dpy, XRootWindowOfScreen(p->screen), - p->x, p->y, p->width, p->height, 0, p->depth, InputOutput, p->vis, - CWBackPixel | CWEventMask | CWBackingStore | CWColormap | - CWBorderPixel, &xswa); - - XSelectInput (p->dpy, p->win, xswa.event_mask); - - p->icon_pixmap = XCreatePixmapFromBitmapData (p->dpy, - XRootWindowOfScreen(p->screen), (char *) icon_bits, - icon_width, icon_height, XBlackPixelOfScreen(p->screen), - XWhitePixelOfScreen(p->screen), 1); - - if (p->conid) - sprintf (icon_name, "GKSwk %d", p->conid); - else - strcpy (icon_name, "GKSterm"); - - XSetStandardProperties (p->dpy, p->win, WindowName, icon_name, - p->icon_pixmap, argv, argc, hints); - - XStoreName (p->dpy, p->win, WindowName); - } - else - { - p->new_win = False; - - if (p->wstype != 212) - p->win = XtWindow (p->widget); - - XGetWindowAttributes (p->dpy, p->win, &xwa); - p->x = xwa.x; - p->y = xwa.y; - p->width = xwa.width; - p->height = xwa.height; - - xswa.event_mask |= (xwa.all_event_masks | ButtonPressMask); - - valuemask = CWBackingStore; - if (p->wstype != 212) - valuemask = CWBackPixel | CWEventMask | CWBackingStore | CWColormap; - - XChangeWindowAttributes (p->dpy, p->win, valuemask, &xswa); - } - - p->event_mask = xswa.event_mask; -} - - -static -void set_WM_hints (void) -{ - XSizeHints hints; - XWMHints wmhints; - - if (p->new_win) { - hints.flags = PPosition | PSize; - hints.x = p->x; - hints.y = p->y; - hints.width = p->width; - hints.height = p->height; - - XSetNormalHints (p->dpy, p->win, &hints); - - if (p->gif >= 0 || p->rf >= 0) { - wmhints.initial_state = IconicState; - wmhints.flags = StateHint; - - XSetWMHints (p->dpy, p->win, &wmhints); - } - } -} - - -static -void create_GC (void) - -/* - * Create graphics context - */ - -{ - XGCValues xgcv; - - xgcv.foreground = p->fg; - xgcv.background = p->bg; - p->gc = XCreateGC (p->dpy, p->win, GCForeground | GCBackground, &xgcv); - - p->invert = XCreateGC (p->dpy, p->win, GCForeground | GCBackground, &xgcv); - XSetFunction (p->dpy, p->invert, GXinvert); - XSetForeground (p->dpy, p->invert, p->fg ^ p->bg); - - xgcv.foreground = p->bg; - p->clear = XCreateGC (p->dpy, p->win, GCForeground | GCBackground, &xgcv); -} - - -static -void free_GC (void) - -/* - * Free graphics context - */ - -{ - XFreeGC (p->dpy, p->clear); - XFreeGC (p->dpy, p->invert); - XFreeGC (p->dpy, p->gc); -} - - -static -void create_pixmap (void) - -/* - * Create a pixmap - */ - -{ - if (!p->backing_store || p->gif >= 0 || p->rf >= 0 || p->uil || p->frame || - p->double_buf) { - p->pixmap = XCreatePixmap (p->dpy, XRootWindowOfScreen(p->screen), - p->width, p->height, p->depth); - - XFillRectangle (p->dpy, p->pixmap, p->clear, 0, 0, p->width, p->height); - } - else - p->pixmap = 0; -} - - -#ifdef XSHM - -int XShmQueryExtension (Display *); - -static -void create_shared_memory (void) - -/* - * Create X shared memory - */ - -{ - if (!p->xshm) - { - p->shmimage = NULL; - return; - } - - if (XShmQueryExtension (p->dpy)) - { - p->shmimage = XShmCreateImage (p->dpy, p->vis, p->depth, - p->mono_flag ? XYBitmap : ZPixmap, 0, &p->shminfo, - p->width, p->height); - - p->shminfo.shmid = shmget (IPC_PRIVATE, p->shmimage->bytes_per_line * - p->shmimage->height, IPC_CREAT | 0777); - if (p->shminfo.shmid >= 0) { - p->shminfo.shmaddr = (char *) shmat (p->shminfo.shmid, 0, 0); - } - - p->shminfo.readOnly = False; - XShmAttach (p->dpy, &p->shminfo); - XSync (p->dpy, False); - - shmctl (p->shminfo.shmid, IPC_RMID, 0); - p->shmimage->data = p->shminfo.shmaddr; - } - else - p->shmimage = NULL; -} - - -static -void free_shared_memory (void) - -/* - * Free X shared memory - */ - -{ - if (p->shmimage != NULL) - { - XShmDetach (p->dpy, &p->shminfo); - XDestroyImage (p->shmimage); - shmdt (p->shminfo.shmaddr); - } -} - -#endif /* XSHM */ - - -static -void initialize_arrays (void) - -/* - * Initialize the arrays - */ - -{ - register int i, j; - int pat, pa[33]; - - if (!have_patterns) { - for (i = 0; i < PATTERNS; i++) { - pat = i; - GKQPA (&pat, pa); - patterns[i][0] = (char)(*pa); - for (j = 1; j <= *pa; j++) - patterns[i][j] = (char)(~pa[j]); - } - have_patterns = True; - } - - memset((void *)p->fstr, 0, n_font * MAX_SIZE * sizeof(XFontStruct *)); - memset((void *)p->tile, 0, MAX_COLORS * PATTERNS * sizeof(Pixmap)); - memset((void *)p->stipple, 0, MAX_COLORS * PATTERNS * sizeof(Pixmap)); - - p->cached_size = 0; -} - - -static -void free_tile_patterns (int color) - -/* - * Free tile patterns - */ - -{ - int style; - - for (style=0; styletile[color][style] != 0) { - XFreePixmap (p->dpy, p->tile[color][style]); - XFreePixmap (p->dpy, p->stipple[color][style]); - p->tile[color][style] = p->stipple[color][style] = 0; - } - } -} - - -static -void create_cursor (void) - -/* - * Create cursor - */ - -{ - char *env; - unsigned int shape = 0; - - if ((env = (char *) getenv ("GLI_XC")) != NULL) - shape = atoi(env); - if (!shape) - shape = XC_draft_small; - - p->cursor = XCreateFontCursor (p->dpy, shape); - p->textcursor = XCreateFontCursor (p->dpy, XC_xterm); -} - - -static -void set_color_repr (int i, float r, float g, float b) -{ - unsigned long pixel; - XSetWindowAttributes xswa; - int pix; - - if (i < 2 && p->dark_bg) - return; - - if (i >= 8 && p->min_colors) - allocate_colors (False); - - p->red[i] = r; - p->green[i] = g; - p->blue[i] = b; - p->gray[i] = 0.3*r + 0.59*g + 0.11*b; - - if (i < 2 && p->ncolors == 2 && p->wstype != 212) - { - if (p->gray[i] > 0.5) - pixel = XWhitePixelOfScreen(p->screen); - else - pixel = XBlackPixelOfScreen(p->screen); - - if (pixel != p->color[i].pixel) { - p->color[i].pixel = pixel; - - if (i == 0) { - xswa.background_pixel = pixel; - XChangeWindowAttributes (p->dpy, p->win, CWBackPixel, &xswa); - - XSetForeground (p->dpy, p->clear, pixel); - if (p->pixmap) - XFillRectangle (p->dpy, p->pixmap, p->clear, 0, 0, - p->width, p->height); - - XClearWindow (p->dpy, p->win); - } - } - } - - else if (i <= p->ncolors) - { - p->color[i].red = (unsigned short)(r*65535); - p->color[i].green = (unsigned short)(g*65535); - p->color[i].blue = (unsigned short)(b*65535); - - if (i >= p->pcolors) - { - if (!XAllocColor (p->dpy, p->cmap, &p->color[i])) - { - p->color[i].pixel = 0xffff; - pick_closest_colors (p->color, p->ncolors); - } - } - else - { - XStoreColor (p->dpy, p->cmap, &p->color[i]); - XSync (p->dpy, False); - } - - if (i == p->ncolors) - p->ncolors++; - } - - if (i < 2) - { - p->bg = p->color[0].pixel; - p->fg = p->color[1].pixel; - XSetForeground (p->dpy, p->invert, p->fg ^ p->bg); - } - - if (i < MAX_COLORS) - { - pix = p->color[i].pixel; - GSPIX (&i, &pix); - } - - p->ccolor = Undefined; -} - - -static -void set_color (int color) -{ - int i; - - i = Color8Bit(color); - - if (i >= 8 && p->min_colors) - allocate_colors (False); - - if (i >= p->ncolors) - { - if (i >= 8) - i = 0; - else - i = 1; - } - if (i != p->ccolor) - { - XSetForeground (p->dpy, p->gc, p->color[i].pixel); - p->ccolor = i; - } -} - - -static -void set_pattern (int color, int style) -{ - unsigned int w, h; - char *pattern; - - if (color >= p->ncolors || color >= MAX_COLORS) color = 1; - if (style >= PATTERNS) style = 1; - - if (style) { - if (p->tile[color][style] == 0) { - pattern = patterns[style]; - w = h = (*pattern == 32) ? 16 : *pattern; - pattern++; - p->tile[color][style] = XCreatePixmapFromBitmapData (p->dpy, p->win, - pattern, w, h, p->color[color].pixel, p->bg, p->depth); - p->stipple[color][style] = XCreatePixmapFromBitmapData (p->dpy, - p->win, pattern, w, h, p->color[color].pixel, p->bg, 1); - } - - if (p->ored_patterns) { - XSetFillStyle(p->dpy, p->gc, FillStippled); - XSetStipple(p->dpy, p->gc, p->stipple[color][style]); - } - else { - XSetFillStyle(p->dpy, p->gc, FillTiled); - XSetTile(p->dpy, p->gc, p->tile[color][style]); - } - } - else - XSetFillStyle(p->dpy, p->gc, FillSolid); -} - - -static -void set_intensity (int color) -{ - int style; - unsigned int w, h; - char *pattern; - - if (color) { - style = (int)(9*(1-p->gray[color-PRIVATE_COLORS])) + 1; - color = 1; - set_color (color); - - if (p->tile[color][style] == 0) { - pattern = patterns[style]; - pattern = patterns[style]; - w = h = (*pattern == 32) ? 16 : *pattern; - pattern++; - p->tile[color][style] = XCreatePixmapFromBitmapData (p->dpy, p->win, - pattern, w, h, p->color[color].pixel, p->bg, p->depth); - p->stipple[color][style] = XCreatePixmapFromBitmapData (p->dpy, - p->win, pattern, w, h, p->color[color].pixel, p->bg, 1); - } - - XSetFillStyle(p->dpy, p->gc, FillTiled); - XSetTile(p->dpy, p->gc, p->tile[color][style]); - } - else - XSetFillStyle(p->dpy, p->gc, FillSolid); -} - - -static -void setup_xform (float *window, float *viewport) -{ - p->a = (p->width-1)/(window[1]-window[0]); - p->b = -window[0]*p->a; - p->c = (p->height-1)/(window[2]-window[3]); - p->d = p->height-1 - window[2]*p->c; -} - - -static -void configure_event (XConfigureEvent *event) - -/* - * Handle configure events - */ - -{ - float req_aspect_ratio, cur_aspect_ratio; - int width, height; - - if (p->widget || p->gif >= 0 || p->rf >= 0 || p->uil || p->frame) - return; - - p->x = event->x; - p->y = event->y; - if (event->width == p->width && event->height == p->height) - return; - - width = event->width; - height = event->height; - - p->viewport[0] = p->x*p->mwidth/p->swidth; - p->viewport[1] = p->viewport[0] + width*p->mwidth/p->swidth; - p->viewport[2] = (p->sheight-(p->y+height))*p->mheight/p->sheight; - p->viewport[3] = p->viewport[2] + height*p->mheight/p->sheight; - - req_aspect_ratio = (p->window[1]-p->window[0])/ - (p->window[3]-p->window[2]); - cur_aspect_ratio = (p->viewport[1]-p->viewport[0])/ - (p->viewport[3]-p->viewport[2]); - - if (cur_aspect_ratio > req_aspect_ratio) { - width = (int)(height * req_aspect_ratio); - p->viewport[1] = p->viewport[0] + (p->viewport[3]-p->viewport[2])* - req_aspect_ratio; - } - else { - height = (int)(width / req_aspect_ratio); - p->viewport[3] = p->viewport[2] + (p->viewport[1]-p->viewport[0])/ - req_aspect_ratio; - } - - if (width != p->width || height != p->height) - { - p->width = width; - p->height = height; - - if (p->pixmap) { - XFreePixmap (p->dpy, p->pixmap); - p->pixmap = XCreatePixmap (p->dpy, XRootWindowOfScreen(p->screen), - p->width, p->height, p->depth); - XFillRectangle (p->dpy, p->pixmap, p->clear, 0, 0, - p->width, p->height); - } -#ifdef XSHM - free_shared_memory (); - create_shared_memory (); -#endif - setup_xform (p->window, p->viewport); - set_clipping (True); - - GRSGWK (&p->wkid); - return; - } - else - return; -} - - -static -void handle_expose_event (ws_state_list *p) - -/* - * Handle expose events - */ - -{ - if (p->pixmap) { - set_clipping (False); - XCopyArea (p->dpy, p->pixmap, p->win, p->gc, 0, 0, p->width, p->height, - 0, 0); - set_clipping (True); - XSync (p->dpy, False); - } -} - - -static -void wait_for_expose (void) -{ - XEvent event; - - if (p->new_win) { - do - XWindowEvent (p->dpy, p->win, StructureNotifyMask, &event); - while (event.xany.type != MapNotify && - event.xany.type != ConfigureNotify); - while (XCheckTypedWindowEvent (p->dpy, p->win, Expose, &event)) - ; - } -} - - -static -void map_window (void) - -/* - * Map window - */ - -{ - /* Windows are not visible until they are mapped - map this window */ - - if (!p->mapped) { - XMapWindow (p->dpy, p->win); - p->mapped = True; - - if (p->gif < 0 && p->rf < 0) - wait_for_expose (); - - if (p->widget && !p->backing_store) - XtAddEventHandler (p->widget, ExposureMask, False, - (XtEventHandler) expose_event, p); - } -} - - -static -void unmap_window (void) - -/* - * Unmap window - */ - -{ - if (p->mapped) { - if (p->widget && !p->backing_store) - XtRemoveEventHandler (p->widget, ExposureMask, False, - (XtEventHandler) expose_event, p); - - if (!p->widget) - XUnmapWindow (p->dpy, p->win); - p->mapped = False; - } -} - - -static -void setup_norm_xform (int tnr, float *wn, float *vp) -{ - a[tnr] = (vp[1]-vp[0])/(wn[1]-wn[0]); - b[tnr] = vp[0]-wn[0]*a[tnr]; - c[tnr] = (vp[3]-vp[2])/(wn[3]-wn[2]); - d[tnr] = vp[2]-wn[2]*c[tnr]; -} - - -static -void init_norm_xform (void) -{ - int tnr; - - for (tnr=0; tnrwindow[tnr], gksl->viewport[tnr]); -} - - -static -void draw_marker (float xn, float yn, int mtype, float mscale) -{ - int r, d, x, y, i; - int pc, op; - XPoint points[13]; - float scale, xr, yr; - - static int marker[26][57] = { - {5,9,-4,7,4,7,7,4,7,-4, /* omark */ - 4,-7,-4,-7,-7,-4,-7,4, - -4,7, 3,9,-4,7,4,7,7,4, - 7,-4,4,-7,-4,-7,-7,-4, - -7,4,-4,7, 0}, - {5,13,-2,8,2,8,2,2,8,2, /* hollow plus */ - 8,-2,2,-2,2,-8,-2,-8, - -2,-2,-8,-2,-8,2,-2,2, - -2,8, 3,13,-2,8,2,8, - 2,2,8,2,8,-2,2,-2,2,-8, - -2,-8,-2,-2,-8,-2,-8,2, - -2,2,-2,8, 0}, - {4,4,-8,0,4,7,4,-7, /* solid triangle right */ - -8,0, 0}, - {4,4,8,0,-4,-7,-4,7, /* solid triangle left */ - 8,0, 0}, - {5,4,0,8,7,-4,-7,-4,0,8, /* triangle up down */ - 5,4,0,-8,-7,4,7,4,0,-8, - 3,4,0,8,7,-4,-7,-4,0,8, - 3,4,0,-8,-7,4,7,4,0,-8, - 0}, - {4,11,0,9,2,2,9,3,3,-1, /* solid star */ - 6,-8,0,-3,-6,-8,-3,-1, - -9,3,-2,2,0,9, 0}, - {5,11,0,9,2,2,9,3,3,-1, /* hollow star */ - 6,-8,0,-3,-6,-8,-3,-1, - -9,3,-2,2,0,9, - 3,11,0,9,2,2,9,3,3,-1, - 6,-8,0,-3,-6,-8,-3,-1, - -9,3,-2,2,0,9, 0}, - {4,5,0,9,9,0,0,-9,-9,0, /* solid diamond */ - 0,9, 0}, - {5,5,0,9,9,0,0,-9,-9,0, /* hollow diamond */ - 0,9, 3,5,0,9,9,0,0,-9, - -9,0,0,9, 0}, - {4,5,9,9,-9,-9,9,-9,-9,9, /* solid hourglass */ - 9,9, 0}, - {5,5,9,9,-9,-9,9,-9,-9,9, /* hollow hourglass */ - 9,9, 3,5,9,9,-9,-9,9,-9, - -9,9,9,9, 0}, - {4,5,9,9,9,-9,-9,9,-9,-9, /* solid bowtie */ - 9,9, 0}, - {5,5,9,9,9,-9,-9,9,-9,-9, /* hollow bowtie */ - 9,9, 3,5,9,9,9,-9,-9,9, - -9,-9,9,9, 0}, - {4,5,9,9,9,-9,-9,-9,-9,9, /* solid square */ - 9,9, 0}, - {5,5,9,9,9,-9,-9,-9,-9,9, /* hollow square */ - 9,9, 3,5,9,9,9,-9,-9,-9, - -9,9,9,9, 0}, - {4,4,-9,9,9,9,0,-9,-9,9, /* solid triangle down */ - 0}, - {5,4,-9,9,9,9,0,-9,-9,9, /* hollow triangle down */ - 3,4,-9,9,9,9,0,-9,-9,9, - 0}, - {4,4,0,9,9,-9,-9,-9,0,9, /* solid triangle up */ - 0}, - {5,4,0,9,9,-9,-9,-9,0,9, /* hollow triangle up */ - 3,4,0,9,9,-9,-9,-9,0,9, 0}, - {7,0,360, 0}, /* solid circle */ - {0}, /* not used */ - {1, 0}, /* dot */ - {2, 0,0,0,9, 2,0,0,9,0, /* plus */ - 2,0,0,0,-9, 2,0,0,-9,0, - 0}, - {2,0,0,0,9, 2,0,0,9,3, /* asterisk */ - 2,0,0,6,-9, 2,0,0,-6,-9, - 2,0,0,-9,3, 0}, - {8,0,360, 6,0,360, 0}, /* circle */ - {2,0,0,9,9, 2,0,0,9,-9, /* diagonal cross */ - 2,0,0,-9,-9, 2,0,0,-9,9, - 0}}; - - r = (int)(3*mscale); - d = 2*r; - scale = mscale/3.0; - - NDC_to_DC(xn, yn, x, y); - - pc = 0; - mtype = (d > 1) ? mtype + 20 : 21; - - do - { - op = marker[mtype][pc]; - switch (op) { - - case 1: /* point */ - if (p->pixmap) - XDrawPoint (p->dpy, p->pixmap, p->gc, x, y); - if (!p->double_buf) - XDrawPoint (p->dpy, p->win, p->gc, x, y); - break; - - case 2: /* line */ - for (i = 0; i < 2; i++) - { - xr = scale * marker[mtype][pc+2*i+1]; - yr = -scale * marker[mtype][pc+2*i+2]; - seg_xform_rel (&xr, &yr); - points[i].x = nint(x-xr); - points[i].y = nint(y+yr); - } - if (p->pixmap) - XDrawLines (p->dpy, p->pixmap, p->gc, points, 2, - CoordModeOrigin); - if (!p->double_buf) - XDrawLines (p->dpy, p->win, p->gc, points, 2, - CoordModeOrigin); - pc += 4; - break; - - case 3: /* polygon */ - for (i = 0; i < marker[mtype][pc+1]; i++) - { - xr = scale * marker[mtype][pc+2+2*i]; - yr = -scale * marker[mtype][pc+3+2*i]; - seg_xform_rel (&xr, &yr); - points[i].x = nint(x-xr); - points[i].y = nint(y+yr); - } - if (p->pixmap) - XDrawLines (p->dpy, p->pixmap, p->gc, points, - marker[mtype][pc+1], CoordModeOrigin); - if (!p->double_buf) - XDrawLines (p->dpy, p->win, p->gc, points, - marker[mtype][pc+1], CoordModeOrigin); - pc += 1 + 2 * marker[mtype][pc+1]; - break; - - case 4: /* filled polygon */ - for (i = 0; i < marker[mtype][pc+1]; i++) - { - xr = scale * marker[mtype][pc+2+2*i]; - yr = -scale * marker[mtype][pc+3+2*i]; - seg_xform_rel (&xr, &yr); - points[i].x = nint(x-xr); - points[i].y = nint(y+yr); - } - if (p->pixmap) - XFillPolygon (p->dpy, p->pixmap, p->gc, points, - marker[mtype][pc+1], Complex, CoordModeOrigin); - if (!p->double_buf) - XFillPolygon (p->dpy, p->win, p->gc, points, - marker[mtype][pc+1], Complex, CoordModeOrigin); - pc += 1 + 2 * marker[mtype][pc+1]; - break; - - case 5: /* hollow polygon */ - for (i = 0; i < marker[mtype][pc+1]; i++) - { - xr = scale * marker[mtype][pc+2+2*i]; - yr = -scale * marker[mtype][pc+3+2*i]; - seg_xform_rel (&xr, &yr); - points[i].x = nint(x-xr); - points[i].y = nint(y+yr); - } - if (p->pixmap) - XFillPolygon (p->dpy, p->pixmap, p->clear, points, - marker[mtype][pc+1], Complex, CoordModeOrigin); - if (!p->double_buf) - XFillPolygon (p->dpy, p->win, p->clear, points, - marker[mtype][pc+1], Complex, CoordModeOrigin); - pc += 1 + 2 * marker[mtype][pc+1]; - break; - - case 6: /* arc */ - if (p->pixmap) - XDrawArc (p->dpy, p->pixmap, p->gc, x-r, y-r, d, d, - marker[mtype][pc+1]*64, marker[mtype][pc+2]*64); - if (!p->double_buf) - XDrawArc (p->dpy, p->win, p->gc, x-r, y-r, d, d, - marker[mtype][pc+1]*64, marker[mtype][pc+2]*64); - pc += 2; - break; - - case 7: /* filled arc */ - if (p->pixmap) - XFillArc (p->dpy, p->pixmap, p->gc, x-r, y-r, d, d, - marker[mtype][pc+1]*64, marker[mtype][pc+2]*64); - if (!p->double_buf) - XFillArc (p->dpy, p->win, p->gc, x-r, y-r, d, d, - marker[mtype][pc+1]*64, marker[mtype][pc+2]*64); - pc += 2; - break; - - case 8: /* hollow arc */ - if (p->pixmap) - XFillArc (p->dpy, p->pixmap, p->clear, x-r, y-r, d, d, - marker[mtype][pc+1]*64, marker[mtype][pc+2]*64); - if (!p->double_buf) - XFillArc (p->dpy, p->win, p->clear, x-r, y-r, d, d, - marker[mtype][pc+1]*64, marker[mtype][pc+2]*64); - pc += 2; - break; - } - pc++; - } - while (op != 0); -} - - -static -void draw_points (int *n, float *px, float *py, int *tnr) -{ - register int i; - float xn, yn; - - if (*n > max_points) - { - points = (XPoint *) realloc (points, *n * sizeof(XPoint)); - max_points = *n; - } - - for (i=0; i<*n; i++) - { - WC_to_NDC(px[i], py[i], *tnr, xn, yn); - seg_xform(&xn, &yn); - NDC_to_DC(xn, yn, points[i].x, points[i].y); - } - - if (p->pixmap) - XDrawPoints (p->dpy, p->pixmap, p->gc, points, *n, CoordModeOrigin); - if (!p->double_buf) - XDrawPoints (p->dpy, p->win, p->gc, points, *n, CoordModeOrigin); -} - - -static -void marker_routine (int *n, float *px, float *py, int *tnr, int mtype, - float mscale) -{ - float clrt[4], x, y; - register int i; - register Bool draw; - - if (gksl->clip == GCLIP || mtype != GPOINT) - { - if (gksl->clip == GCLIP) - { - memcpy(clrt, gksl->viewport[gksl->cntnr], 4*sizeof(float)); - if (p->gr_bc == 0) - { - seg_xform (&clrt[0], &clrt[2]); - seg_xform (&clrt[1], &clrt[3]); - } - } - set_clipping (False); - for (i=0; i<*n; i++) - { - WC_to_NDC(px[i], py[i], *tnr, x, y); - seg_xform(&x, &y); - - if (gksl->clip == GCLIP) - draw = (x >= clrt[0] && x <= clrt[1] && y >= clrt[2] && y <= clrt[3]); - else - draw = True; - - if (draw) - draw_marker (x, y, mtype, mscale); - } - set_clipping (True); - } - else - draw_points (n, px, py, tnr); -} - - -static -void set_line_attr (int linetype, float linewidth) -{ - static char dash_list[35][10] = { - {8, 4, 2, 4, 2, 4, 2, 4, 6, 0}, - {6, 4, 2, 4, 2, 4, 6, 0, 0, 0}, - {4, 4, 2, 4, 6, 0, 0, 0, 0, 0}, - {8, 3, 2, 3, 2, 3, 2, 3, 6, 0}, - {6, 3, 2, 3, 2, 3, 6, 0, 0, 0}, - {4, 3, 2, 3, 6, 0, 0, 0, 0, 0}, - {8, 3, 2, 3, 2, 3, 2, 3, 4, 0}, - {6, 3, 2, 3, 2, 3, 4, 0, 0, 0}, - {4, 3, 2, 3, 4, 0, 0, 0, 0, 0}, - {2, 1, 1, 0, 0, 0, 0, 0, 0, 0}, - {2, 1, 2, 0, 0, 0, 0, 0, 0, 0}, - {2, 1, 6, 0, 0, 0, 0, 0, 0, 0}, - {2, 1, 8, 0, 0, 0, 0, 0, 0, 0}, - {6, 1, 3, 1, 3, 1, 6, 0, 0, 0}, - {4, 1, 3, 1, 6, 0, 0, 0, 0, 0}, - {8, 6, 2, 1, 2, 1, 2, 1, 2, 0}, - {6, 6, 2, 1, 2, 1, 2, 0, 0, 0}, - {4, 6, 2, 1, 2, 0, 0, 0, 0, 0}, - {4, 9, 3, 5, 3, 0, 0, 0, 0, 0}, - {2, 9, 3, 0, 0, 0, 0, 0, 0, 0}, - {2, 5, 5, 0, 0, 0, 0, 0, 0, 0}, - {2, 5, 3, 0, 0, 0, 0, 0, 0, 0}, - {6, 1, 4, 1, 4, 1, 8, 0, 0, 0}, - {4, 1, 4, 1, 8, 0, 0, 0, 0, 0}, - {2, 1, 1, 0, 0, 0, 0, 0, 0, 0}, - {2, 8, 1, 0, 0, 0, 0, 0, 0, 0}, - {4, 16, 5, 8, 5, 0, 0, 0, 0, 0}, - {2, 16, 5, 0, 0, 0, 0, 0, 0, 0}, - {8, 8, 4, 1, 4, 1, 4, 1, 4, 0}, - {6, 8, 4, 1, 4, 1, 4, 0, 0, 0}, - {0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, - {0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, - {2, 8, 5, 0, 0, 0, 0, 0, 0, 0}, - {2, 1, 2, 0, 0, 0, 0, 0, 0, 0}, - {4, 8, 4, 1, 4, 0, 0, 0, 0, 0}}; - - unsigned int width; - int n; - - if (linewidth > 1) - width = (unsigned int) (linewidth); - else - width = 0; - - if (linetype != p->ltype || width != p->lwidth) - { - if (linetype != GLSOLI) { - XSetLineAttributes (p->dpy, p->gc, width, LineOnOffDash, - CapNotLast, JoinRound); - n = (int) dash_list[linetype+30][0]; - XSetDashes (p->dpy, p->gc, 0, &dash_list[linetype+30][1], n); - } - else - XSetLineAttributes (p->dpy, p->gc, width, LineSolid, CapNotLast, - JoinRound); - - p->ltype = linetype; - p->lwidth = width; - } -} - - -static -int clip_code (int x, int y) -{ - register int code = 0; - - if (x < 0) - code = LEFT; - else if (x > p->width) - code = RIGHT; - - if (y < 0) - code |= BOTTOM; - else if (y > p->height) - code |= TOP; - - return code; -} - - -static -void clip_line (int *x0, int *x1, int *y0, int *y1, Bool *visible, Bool *clip) -{ - register int c, c0, c1; - register int x, y; - - c0 = clip_code (*x0, *y0); - c1 = clip_code (*x1, *y1); - - *clip = c1; - *visible = False; - - while (c0 | c1) { - if (c0 & c1) return; - c = c0 ? c0 : c1; - - if (c & LEFT) { - x = 0; - y = (int) (*y0 - (*y1-*y0) * (float) (*x0) / (*x1-*x0)); - } - else if (c & RIGHT) { - x = p->width; - y = (int) (*y0 + (*y1-*y0) * (float) (p->width-*x0) / (*x1-*x0)); - } - else if (c & BOTTOM) { - x = (int) (*x0 - (*x1-*x0) * (float) (*y0) / (*y1-*y0)); - y = 0; - } - else if (c & TOP) { - x = (int) (*x0 + (*x1-*x0) * (float) (p->height-*y0) / (*y1-*y0)); - y = p->height; - } - - if (c == c0) { - *x0 = x; - *y0 = y; - c0 = clip_code (x, y); - } - else { - *x1 = x; - *y1 = y; - c1 = clip_code (x, y); - } - } - *visible = True; -} - - -static -void line_routine (int *n, float *px, float *py, int *linetype, int *tnr) -{ - float x1, y1; - register int i, j, npoints, m; - int ix0, iy0, ix1, iy1, x, y; - Bool visible, clip; - - if (*n > max_points) - { - points = (XPoint *) realloc (points, *n * sizeof(XPoint)); - max_points = *n; - } - - WC_to_NDC(px[0], py[0], *tnr, x1, y1); - seg_xform(&x1, &y1); - NDC_to_DC(x1, y1, ix1, iy1); - - npoints = 0; - m = *linetype ? *n : *n+1; - - for (j = 1; j < m; j++) { - i = j<*n ? j : 0; - - ix0 = ix1; - iy0 = iy1; - - WC_to_NDC(px[i], py[i], *tnr, x1, y1); - seg_xform(&x1, &y1); - NDC_to_DC(x1, y1, ix1, iy1); - - x = ix1; - y = iy1; - clip_line (&ix0, &ix1, &iy0, &iy1, &visible, &clip); - - if (visible) { - if (!npoints) { - points[0].x = ix0; - points[0].y = iy0; - npoints = 1; - } - - points[npoints].x = ix1; - points[npoints].y = iy1; - npoints++; - - if (clip) { - if (p->pixmap) - XDrawLines (p->dpy, p->pixmap, p->gc, points, npoints, 0); - if (!p->double_buf) - XDrawLines (p->dpy, p->win, p->gc, points, npoints, 0); - npoints = 0; - } - - if (npoints == MAX_POINTS) { - if (p->pixmap) - XDrawLines (p->dpy, p->pixmap, p->gc, points, npoints, 0); - if (!p->double_buf) - XDrawLines (p->dpy, p->win, p->gc, points, npoints, 0); - - --npoints; - points[0].x = points[npoints].x; - points[0].y = points[npoints].y; - npoints = 1; - } - } - - ix1 = x; - iy1 = y; - } - - if (npoints > 1) { - if (p->pixmap) - XDrawLines (p->dpy, p->pixmap, p->gc, points, npoints, 0); - if (!p->double_buf) - XDrawLines (p->dpy, p->win, p->gc, points, npoints, 0); - } -} - - -static -void polyline (int *n, float *px, float *py) -{ - int ln_type, ln_color; - float ln_width; - - ln_type = gksl->asf[0] ? gksl->ltype : gksl->lindex; - ln_width = gksl->asf[1] ? gksl->lwidth : 1; - ln_color = gksl->asf[2] ? gksl->plcoli : 1; - - set_color (ln_color); - set_line_attr (ln_type, ln_width); - - line_routine (n, px, py, &ln_type, &gksl->cntnr); -} - - -static -void polymarker (int *n, float *px, float *py) -{ - int mk_type, mk_color; - float mk_size; - - mk_type = gksl->asf[3] ? gksl->mtype : gksl->mindex; - mk_size = gksl->asf[4] ? gksl->mszsc : 1; - mk_color = gksl->asf[5] ? gksl->pmcoli : 1; - - set_color (mk_color); - set_line_attr (GLSOLI, 1.0); - - marker_routine (n, px, py, &gksl->cntnr, mk_type, mk_size); -} - - -static -void fill_routine (int *n, float *px, float *py, int *tnr) -{ - float x, y; - register int i, npoints; - - if (*n > max_points) - { - points = (XPoint *) realloc (points, *n * sizeof(XPoint)); - max_points = *n; - } - - npoints = *n; - for (i=0; i<*n; i++) - { - WC_to_NDC(px[i], py[i], *tnr, x, y); - seg_xform(&x, &y); - NDC_to_DC(x, y, points[i].x, points[i].y); - } - - if (npoints > 1) - { - if (p->pixmap) - XFillPolygon (p->dpy, p->pixmap, p->gc, points, npoints, - p->shape, CoordModeOrigin); - if (!p->double_buf) - XFillPolygon (p->dpy, p->win, p->gc, points, npoints, - p->shape, CoordModeOrigin); - } -} - - -static -void fill_area (int *n, float *px, float *py) -{ - int fl_inter, fl_style, fl_color; - int ln_type; - - fl_inter = gksl->asf[10] ? gksl->ints : predef_ints[gksl->findex - 1]; - fl_style = gksl->asf[11] ? gksl->styli : predef_styli[gksl->findex - 1]; - fl_color = gksl->asf[12] ? gksl->facoli : 1; - - set_color (fl_color); - set_line_attr (GLSOLI, 1.0); - - if (fl_inter == GSOLID) { - if (fl_color < p->ncolors || fl_color >= MAX_COLORS) - fill_routine (n, px, py, &gksl->cntnr); - else if (fl_color > 7) { - set_intensity (fl_color); - fill_routine (n, px, py, &gksl->cntnr); - set_intensity (0); - } - else { - ln_type = DrawBorder; - line_routine (n, px, py, &ln_type, &gksl->cntnr); - } - } - else if (fl_inter == GPATTR || fl_inter == GHATCH) { - if (fl_inter == GHATCH) - set_pattern (fl_color, fl_style + HATCH_STYLE); - else - set_pattern (fl_color, fl_style); - fill_routine (n, px, py, &gksl->cntnr); - set_pattern (fl_color, 0); - } - else { - ln_type = DrawBorder; - line_routine (n, px, py, &ln_type, &gksl->cntnr); - } -} - - -static -void draw_string (int x, int y, int width, int height, char *chars, int nchars) -{ - Pixmap src, dest; - register XImage *from, *to; - register int descent, w, h; - register int i, j, ii, jj; - register unsigned long pixel; - - height += 8; - descent = p->cfont->descent; - - switch (p->path) { - case 0: break; - case 1: x = x-height+descent; y -= width; w = height; h = width; break; - case 2: x -= width; y -= descent; w = width; h = height; break; - case 3: x -= descent; w = height; h = width; break; - } - - if (p->path != 0) { - set_clipping (False); - - src = XCreatePixmap (p->dpy, XRootWindowOfScreen(p->screen), - width, height, p->depth); - - XFillRectangle (p->dpy, src, p->clear, 0, 0, width, height); - XDrawString (p->dpy, src, p->gc, 0, height - descent, chars, nchars); - - dest = XCreatePixmap (p->dpy, XRootWindowOfScreen(p->screen), - w, h, p->depth); - XCopyArea (p->dpy, p->double_buf ? p->pixmap : p->win, dest, p->gc, - x, y, w, h, 0, 0); - - from = XGetImage (p->dpy, src, 0, 0, width, height, AllPlanes, ZPixmap); - to = XGetImage (p->dpy, dest, 0, 0, w, h, AllPlanes, ZPixmap); - - for (i=0; ipath) { - case 1: ii = j; jj = h-i-1; break; - case 2: ii = w-i-1; jj = h-j-1; break; - case 3: ii = w-j-1; jj = i; break; - } - pixel = XGetPixel (from, i, j); - if (pixel != p->bg) - XPutPixel (to, ii, jj, pixel); - } - - set_clipping (True); - - if (p->pixmap) - XPutImage (p->dpy, p->pixmap, p->gc, to, 0, 0, x, y, w, h); - if (!p->double_buf) - XPutImage (p->dpy, p->win, p->gc, to, 0, 0, x, y, w, h); - - XDestroyImage (to); - XFreePixmap (p->dpy, dest); - XDestroyImage (from); - XFreePixmap (p->dpy, src); - } - else - { - if (p->pixmap) - XDrawString (p->dpy, p->pixmap, p->gc, x, y, chars, nchars); - if (!p->double_buf) - XDrawString (p->dpy, p->win, p->gc, x, y, chars, nchars); - } -} - - -static -void text_routine (float *x, float *y, int *nchars, -#ifdef VMS - struct dsc$descriptor *text) -#else -#ifdef cray - _fcd text) -#else - char *text) -#endif /* cray */ -#endif /* VMS */ - -{ - char *chars; - int xorg, yorg, width, height; - float xrel, yrel, ax, ay; - int tx_prec; - -#ifdef VMS - chars = text->dsc$a_pointer; - *nchars = text->dsc$w_length; -#else -#ifdef cray - chars = _fcdtocp(text); - *nchars = _fcdlen(text); -#else - chars = text; -#endif /* cray */ -#endif /* VMS */ - - NDC_to_DC(*x, *y, xorg, yorg); - - /* Compute text extent */ - - width = XTextWidth (p->cfont, chars, *nchars); - height = p->capheight; - - tx_prec = gksl->asf[6] ? gksl->txprec : predef_prec[gksl->tindex - 1]; - - if (tx_prec == GSTRP) { - - /* Align the text */ - - xrel = width * xfac[gksl->txal[0]]; - if (gksl->txal[1] != GABOTT) - yrel = height * yfac[gksl->txal[1]]; - else - yrel = p->cfont->descent; - - CharXform(xrel, yrel, ax, ay); - - xorg += (int) ax; - yorg -= (int) ay; - } - - draw_string (xorg, yorg, width, height, chars, *nchars); -} - - -static -void verify_font_capabilities(void) -{ - int font = 2, size = 32; - char fontname[256]; - - sprintf(fontname, fonts[font], "adobe", size, p->dpi, p->dpi); - p->fstr[font][size] = XLoadQueryFont(p->dpy, fontname); - - if (p->fstr[font][size] == NULL) { - sprintf(fontname, fonts[font], "urw", size, p->dpi, p->dpi); - p->fstr[font][size] = XLoadQueryFont(p->dpy, fontname); - - if (p->fstr[font][size] == NULL) { - sprintf(fontname, urw_fonts[font], size, p->dpi, p->dpi); - p->fstr[font][size] = XLoadQueryFont(p->dpy, fontname); - } - } - p->scalable_fonts = p->fstr[font][size] != NULL; -} - - -static -void set_font (int font) -{ - int family, size, angle; - char fontname[256]; - float scale, ux, uy, rad; - float width, height, capheight, points; - int fontsize; - - font = abs(font); - if (font >= 101 && font <= 129) - font -= 100; - else if (font >= 1 && font <= 32) - font = map[font-1]; - else - font = 9; - family = font-1; - - WC_to_NDC_rel(gksl->chup[0], gksl->chup[1], gksl->cntnr, ux, uy); - seg_xform_rel(&ux, &uy); - - rad = -atan2(ux,uy); - angle = (int)(rad*180/Pi + 0.5); - if (angle < 0) angle += 360; - p->path = ((angle+45) / 90) % 4; - - scale = sqrt(gksl->chup[0]*gksl->chup[0] + gksl->chup[1]*gksl->chup[1]); - ux = gksl->chup[0] / scale * gksl->chh; - uy = gksl->chup[1] / scale * gksl->chh; - WC_to_NDC_rel(ux, uy, gksl->cntnr, ux, uy); - - width = 0; - height = sqrt(ux*ux + uy*uy); - seg_xform_rel(&width, &height); - - height = sqrt(width*width + height*height); - capheight = height * (fabs(p->c) + 1); - - if (p->scalable_fonts) - points = 10 * capheight / capheights[family]; - else - points = 10 * capheight * 100.0/p->dpi; - - p->capheight = nint(capheight); - - if (p->scalable_fonts) { - size = nint(points/10); - if (size == 0) - size = 1; - p->ratio = points/(size * 10); - if (size >= MAX_SIZE) - { - fontsize = size; - size = MAX_SIZE - 1; - if (p->cached_size != fontsize) - { - p->fstr[family][size] = NULL; - p->cached_size = fontsize; - } - } - else - fontsize = size; - } - else { - if (points <= 90) { - size = 8; p->ratio = points/80; - } else if (points <= 110) { - size = 10; p->ratio = points/100; - } else if (points <= 130) { - size = 12; p->ratio = points/120; - } else if (points <= 160) { - size = 14; p->ratio = points/140; - } else if (points <= 210) { - size = 18; p->ratio = points/180; - } else { - size = 24; p->ratio = points/240; - } - fontsize = size; - } - - if (p->fstr[family][size] == NULL) { - sprintf(fontname, fonts[family], "adobe", fontsize, p->dpi, p->dpi); - p->fstr[family][size] = XLoadQueryFont(p->dpy, fontname); - - if (p->fstr[family][size] == NULL) { - sprintf(fontname, fonts[family], "urw", fontsize, p->dpi, p->dpi); - p->fstr[family][size] = XLoadQueryFont(p->dpy, fontname); - - if (p->fstr[family][size] == NULL) { - sprintf(fontname, urw_fonts[family], fontsize, p->dpi, p->dpi); - p->fstr[family][size] = XLoadQueryFont(p->dpy, fontname); - } - } - - if (p->fstr[family][size] == NULL) - { - gks_fprintf (stderr, "GKS: unable to load font %s\n", fontname); - p->fstr[family][size] = XLoadQueryFont(p->dpy, "variable"); - - if (p->fstr[family][size] == NULL) - p->fstr[family][size] = XLoadQueryFont(p->dpy, "fixed"); - } - } - - if (p->fstr[family][size] != NULL) { - p->cfont = p->fstr[family][size]; - XSetFont (p->dpy, p->gc, p->cfont->fid); - } -} - - -static -void text (float *px, float *py, int nchars, -#ifdef VMS - struct dsc$descriptor *chars) -#else -#ifdef cray - _fcd chars) -#else - char *chars) -#endif /* cray */ -#endif /* VMS */ - -{ - int tx_font, tx_prec, tx_color; - float x, y; - - tx_font = gksl->asf[6] ? gksl->txfont : predef_font[gksl->tindex - 1]; - tx_prec = gksl->asf[6] ? gksl->txprec : predef_prec[gksl->tindex - 1]; - tx_color = gksl->asf[9] ? gksl->txcoli : 1; - - if (tx_prec != GSTRKP) - set_font (tx_font); - - set_color (tx_color); - set_line_attr (GLSOLI, 1.0); - - if (tx_prec == GSTRP) - { - WC_to_NDC(*px, *py, gksl->cntnr, x, y); - seg_xform(&x, &y); - - text_routine (&x, &y, &nchars, chars); - } - else - { - unsigned short chars_len = nchars; -#if defined(hpux) && !defined(NAGware) - GSIMTX (px, py, &nchars, chars, -#if defined(__hp9000s700) || defined(__hp9000s300) - line_routine_a, fill_routine_a, chars_len); -#else - &line_routine_a, &fill_routine_a, chars_len); -#endif /* __hp9000s700 || __hp9000s300 */ -#else -#if defined(_WIN32) && !defined(__GNUC__) - GSIMTX(px, py, &nchars, chars, chars_len, line_routine, fill_routine); -#else - GSIMTX(px, py, &nchars, chars, line_routine, fill_routine, chars_len); -#endif -#endif - } -} - - -static -void update (void) -{ - if (p->state == GACTIV) - { - if (!p->widget && !p->backing_store) - { - XEvent event; - while (XPending (p->dpy)) { - XNextEvent (p->dpy, &event); - if (event.type == Expose) - expose_event (p->widget, p, (XExposeEvent *) &event, NULL); - } - } - else - XSync (p->dpy, False); - } -} - - -static -void message (int nchars, char *chars) -{ - XDrawString (p->dpy, p->win, p->invert, 10, 20, chars, nchars); -} - - -static -void open_gif (int stream) -{ - char *gif_name; - struct stat buf; - int fd; - - fd = stream > 100 ? stream - 100 : stream; - - if (isatty(fd) || fstat(fd, &buf) != 0) - { - gif_name = (char *) getenv ("GLI_GIF"); - if (!gif_name) - gif_name = "gli.gif"; - - p->gif = open (gif_name, O_CREAT | O_TRUNC | O_WRONLY, 0644); - if (p->gif < 0) - gks_fprintf (stderr, "GKS: can't open GIF file\n"); - } - else - p->gif = fd; -} - - -static -void write_gif_word (int w) -{ - byte c; - - c = (w & 0xff); - write (p->gif, &c, 1); - c = ((w >> 8) & 0xff); - write (p->gif, &c, 1); -} - - -static -void pixmap_to_gif (void) -{ - int size, besize; - byte c, r, g, b, *pix, *ppix, *beimage; - register int i, j, k, coli, mcolor; - XImage *image; - int BitsPerPixel, ColorMapSize, InitCodeSize; - unsigned long pixel; - - image = XGetImage (p->dpy, p->pixmap, 0, 0, p->width, p->height, AllPlanes, - ZPixmap); - - size = p->width * p->height; - pix = ppix = (byte *) malloc (sizeof(byte) * size); - beimage = (byte *) malloc (sizeof(byte) * size * 3 / 2); /* worst case */ - - if (pix != NULL && beimage != NULL) - { - mcolor = 0; - for (j=0; jheight; j++) { - for (i=0; iwidth; i++) { - pixel = XGetPixel (image, i, j); - coli = 0; - for (k=0; kncolors; k++) { - if (pixel == p->color[k].pixel) { - coli = k; - break; - } - } - *ppix++ = coli; - if (coli > mcolor) - mcolor = coli; - } - } - - for (BitsPerPixel = 1; BitsPerPixel < 8; BitsPerPixel++) - if ((1 << BitsPerPixel) > mcolor) break; - - /* write the GIF header */ - - write (p->gif, p->wstype == 218 ? "GIF89a" : "GIF87a", 6); - - write_gif_word (p->width); /* screen descriptor */ - write_gif_word (p->height); - - c = 0x80; /* yes, there is a color map */ - c |= (8 - 1) << 4; /* OR in the color resolution (8) */ - c |= (0) << 3; /* no, the colors are not sorted */ - c |= (BitsPerPixel - 1); /* OR in the # of bits per pixel */ - write (p->gif, &c, 1); - - c = 0x0; - write (p->gif, &c, 1); /* background color index */ - write (p->gif, &c, 1); /* pixel aspect ratio */ - - /* write colormap */ - - ColorMapSize = 1 << BitsPerPixel; - - for (i = 0; i < ColorMapSize; i++) { - r = (byte) (255 * p->red[i]); - g = (byte) (255 * p->green[i]); - b = (byte) (255 * p->blue[i]); - write (p->gif, &r, 1); - write (p->gif, &g, 1); - write (p->gif, &b, 1); - } - - /* write extension block */ - - if (p->wstype == 218) { /* transparent GIF? */ - c = 0x21; - write (p->gif, &c, 1); /* extension block ID (fixed value) */ - c = 0xf9; - write (p->gif, &c, 1); /* graphic control label (fixed) */ - c = 0x4; - write (p->gif, &c, 1); /* block size (fixed) */ - c = 0x0; /* no disposal method, no user flag */ - c |= 0x1; /* transparent color on */ - write (p->gif, &c, 1); - write_gif_word (0); /* delay time */ - c = 0x0; - write (p->gif, &c, 1); /* transparent color index = 0 */ - write (p->gif, &c, 1); /* block terminator = 0 */ - } - - /* write image block */ - - write (p->gif, ",", 1); /* image separator */ - - write_gif_word (0); /* image left offset */ - write_gif_word (0); /* image top offset */ - write_gif_word (p->width); /* image width */ - write_gif_word (p->height); /* image height */ - - c = 0x0; - write (p->gif, &c, 1); /* no interlace, sort, color table */ - - InitCodeSize = max(BitsPerPixel, 2); - gkscompress (InitCodeSize + 1, pix, size, beimage, &besize); - - c = InitCodeSize; - write (p->gif, &c, 1); - if (write (p->gif, beimage, besize) != besize) { - gks_fprintf (stderr, "GKS: can't write GIF file\n"); - perror ("write"); - } - - free (beimage); - free (pix); - } - else - gks_fprintf (stderr, "GKS: can't allocate temporary storage\n"); - - write (p->gif, "\0", 1); /* write out a zero-length packet (EOF) */ - write (p->gif, ";", 1); /* terminator */ - - XDestroyImage (image); -} - - -static -void open_rf (int stream) -{ - char *rf_name; - struct stat buf; - int fd; - - fd = stream > 100 ? stream - 100 : stream; - - if (isatty(fd) || fstat(fd, &buf) != 0) - { - rf_name = (char *) getenv ("GLI_RF"); - if (!rf_name) - rf_name = "gli.rf"; - - p->rf = open (rf_name, O_CREAT | O_TRUNC | O_WRONLY, 0644); - if (p->rf < 0) - gks_fprintf (stderr, "GKS: can't open rasterfile\n"); - } - else - p->rf = fd; -} - - -static -int compress_rle (byte *pix, int size, byte *beimage) -{ - register byte c, pc; - register int besize, count, i, j; - - besize = 0; - count = 0; - for (i = 0; i < size; ++i) - { - c = *pix++; - if (count > 0) - { - if (pc != c) - { - if (count == 1 && pc == 128) - { - beimage[besize++] = 128; - beimage[besize++] = 0; - count = 0; - } - else if (count > 2 || pc == 128) - { - beimage[besize++] = 128; - beimage[besize++] = count - 1; - beimage[besize++] = pc; - count = 0; - } - else - { - for (j = 0; j < count; ++j) - beimage[besize++] = pc; - count = 0; - } - } - } - pc = c; - ++count; - if (count == 256) - { - beimage[besize++] = 128; - beimage[besize++] = count - 1; - beimage[besize++] = c; - count = 0; - } - } - if (count > 0) - { - if (count == 1 && c == 128) - { - beimage[besize++] = 128; - beimage[besize++] = 0; - } - if (count > 2 || c == 128) - { - beimage[besize++] = 128; - beimage[besize++] = count - 1; - beimage[besize++] = c; - } - else - { - for (j = 0; j < count; ++j) - beimage[besize++] = c; - } - } - - return besize; -} - - -static -void write_rf_long (long l) -{ - byte c; - - c = ((l >> 24) & 0xff); - write (p->rf, &c, 1); - c = ((l >> 16) & 0xff); - write (p->rf, &c, 1); - c = ((l >> 8) & 0xff); - write (p->rf, &c, 1); - c = (l & 0xff); - write (p->rf, &c, 1); -} - - -#define RAS_MAGIC 0x59a66a95 -#define RT_BYTE_ENCODED 2 /* Run-length compression of bytes */ -#define RMT_EQUAL_RGB 1 - -static -void pixmap_to_rf (void) -{ - XImage *image; - int linesize, size, besize, depth = 8; - byte *pix, *ppix, *beimage; - register int i, j, k, coli; - byte rmap[255], gmap[255], bmap[255]; - unsigned long pixel; - - image = XGetImage (p->dpy, p->pixmap, 0, 0, p->width, p->height, AllPlanes, - ZPixmap); - - linesize = p->width; - if (linesize % 2) linesize++; - - size = linesize * p->height; - - pix = ppix = (byte *) malloc (sizeof(byte) * size); - beimage = (byte *) malloc (sizeof(byte) * size * 3 / 2); /* worst case */ - - if (pix != NULL && beimage != NULL) - { - for (j = 0; j < p->height; j++) { - for (i = 0; i < p->width; i++) { - pixel = XGetPixel (image, i, j); - coli = 0; - for (k = 0; k < p->ncolors; k++) { - if (pixel == p->color[k].pixel) { - coli = k; - break; - } - } - *ppix++ = coli; - } - if (linesize != p->width) - *ppix++ = 0; - } - - besize = compress_rle (pix, size, beimage); - - /* write the header */ - - write_rf_long (RAS_MAGIC); - write_rf_long (p->width); - write_rf_long (p->height); - write_rf_long (depth); - write_rf_long (besize); - write_rf_long (RT_BYTE_ENCODED); - write_rf_long (RMT_EQUAL_RGB); - write_rf_long (3 * p->ncolors); - - for (i = 0; i < p->ncolors; i++) { - rmap[i] = (byte) (255 * p->red[i]); - gmap[i] = (byte) (255 * p->green[i]); - bmap[i] = (byte) (255 * p->blue[i]); - } - - /* write the colormap */ - - write (p->rf, rmap, p->ncolors); - write (p->rf, gmap, p->ncolors); - write (p->rf, bmap, p->ncolors); - - /* write the image */ - - if (write (p->rf, beimage, besize) != besize) { - gks_fprintf (stderr, "GKS: can't write Sun rle rasterfile\n"); - perror ("write"); - } - - free (beimage); - free (pix); - } - else - gks_fprintf (stderr, "GKS: can't allocate temporary storage\n"); - - XDestroyImage (image); -} - - -#define UIL_HEADER "\ -value\n\ - white : color ('white');\n\ - black : color ('black');\n\ - red : color ('red');\n\ - green : color ('green');\n\ - blue : color ('blue');\n\ - cyan : color ('cyan');\n\ - yellow : color ('yellow');\n\ - magenta : color ('magenta');\n\ -\n\ -value\n\ - color_map : color_table (\n\ - white = '`',\n\ - black = 'd',\n\ - red = 'r',\n\ - green = 'g',\n\ - blue = 'b',\n\ - cyan = 'c',\n\ - yellow = 'y',\n\ - magenta = 'm'\n\ - );\n" - - -static -void open_uil (void) -{ - char *uil_name; - - uil_name = (char *) getenv ("GLI_UIL"); - if (!uil_name) - uil_name = "gli.uil"; - - p->uil = fopen (uil_name, "w"); - if (p->uil) - fprintf (p->uil, UIL_HEADER); - else - gks_fprintf (stderr, "GKS: can't open UIL file\n"); -} - - -static -void pixmap_to_uil (void) -{ - static char *icon_name; - XImage *image; - int i, j, k, n, pix; - unsigned long pixel; - - static char letter[] = {'`','d','r','g','b','c','y','m'}; - - icon_name = (char *) getenv ("GLI_ICON"); - if (!icon_name) - icon_name = "(unknown)"; - - image = XGetImage (p->dpy, p->pixmap, 0, 0, p->width, p->height, - AllPlanes, ZPixmap); - n = p->ncolors < PRIVATE_COLORS ? p->ncolors : PRIVATE_COLORS; - - fprintf (p->uil, "\n%s : icon (color_table = color_map", icon_name); - for (j=0; jheight; j++) { - fprintf (p->uil, ",\n '"); - for (i=0; iwidth; i++) { - pixel = XGetPixel (image, i, j); - pix = 0; - for (k=0; kcolor[k].pixel) { - pix = k; - break; - } - } - fprintf (p->uil, "%c", letter[pix]); - } - fprintf (p->uil, "'"); - } - if (fprintf (p->uil, "\n );\n") < 0) - gks_fprintf (stderr, "GKS: can't write UIL file\n"); - - XDestroyImage (image); -} - - -static -void set_frame_header (int frame) -{ - char header[32]; - - sprintf (header, "Frame #%d\n", frame); - XStoreName (p->dpy, p->win, header); -} - - -static -void pixmap_loop (void) -{ - int this_frame = 0, inc = 1; - XEvent event; - Bool run = True, step = False; - - XSelectInput (p->dpy, p->win, ButtonPressMask); - XSetClipMask (p->dpy, p->gc, None); - XSynchronize (p->dpy, True); - - /* Be sure that the window is mapped */ - - XMapWindow (p->dpy, p->win); - - for (; p->nframes > 0;) { - if (run || step) - { - XCopyArea (p->dpy, p->frame[this_frame], p->win, p->gc, 0, 0, - p->width, p->height, 0, 0); - this_frame += inc; - if (this_frame == 0 || this_frame == p->nframes-1) - inc = -inc; - step = False; - set_frame_header (this_frame); - } - - while (XPending (p->dpy)) { - XNextEvent (p->dpy, &event); - if (event.type == ButtonPress) { - if (event.xbutton.button == Button1) - run = !run; - else if (event.xbutton.button == Button2) - step = True; - else - goto stop; - } - } - } -stop: - this_frame = p->nframes; - while (this_frame--) - XFreePixmap (p->dpy, p->frame[this_frame]); - free (p->frame); - - p->pixmap = 0; -} - - - -#define COPY_BODY(type) \ - register int i, j, ix, iy, nbytes; \ - register int *ilptr, *ipptr; \ - register byte *blptr, *bpptr, *packed_colia; \ - register type *elptr, *epptr, tmp, *tmpptr; \ - type pixel[MAX_COLORIND]; \ -\ - for (i=0; imono_flag) { \ - j = Color8Bit(i); \ - pixel[i] = (type) p->color[j].pixel; \ - } \ - else \ - pixel[i] = i; \ - } \ -\ - if (p->packed_ca) \ - { \ - packed_colia = (byte *) colia; \ -\ - if (dx != dimx || w != dx || h != dy || w != bytes_per_line) \ - { \ - elptr = epptr = ba; \ -\ - for (j=0; jgray[*pix] * (WHITE - BLACK)); - pix++; - } - - /* Allocate space for error arrays */ - - error1 = (int *) calloc (w+2, sizeof(int)); - error2 = (int *) calloc (w+2, sizeof(int)); - bbuffer = mbuffer = (byte *) calloc (w*h, sizeof(byte)); - - cerr = &error1[1]; - lerr = &error2[1]; - for (error=0, i=0; i < w; ) { /* The top border */ - mvalue = 0x00; - for (j=0; (j < 8) && (i < w); j++, i++) { - graylevel = (int)ba[i] + error; - bit = graylevel > THRESH ? WHITE : BLACK; - if (bit) - mvalue |= (0x01 << j); - error = graylevel - bit; - lerr[i] = (THRESH - (int)bit) / 2; - } - *mbuffer++ = ~mvalue; - } - - /* Process the rest. 1 5 3 - * Error distribution: 7 x - */ - for (j=1; j < h; j++) { - pix = &ba[j*w]; - first = mbuffer; - for (i=0; i < w; ) { - mvalue = 0x00; - for (bit=0; (bit < 8) && (i < w); bit++, i++) { - graylevel = (int)pix[i] + (int)(lerr[i-1] + (5 * lerr[i]) + - (3 * lerr[i+1]) + (7 * cerr[i-1])) / 16; - if (graylevel > THRESH) { - mvalue |= (0x01 << bit); - cerr[i] = graylevel - WHITE; - } - else - cerr[i] = graylevel; - } - *mbuffer++ = ~mvalue; - } - cerr[-1] = INITERR((int)pix[-1], (*first & 0x01)); - - /* Swap error buffers */ - terr = error1; - error1 = error2; - error2 = terr; - cerr = &error1[1]; - lerr = &error2[1]; - } - - row_size = (w + 7) / 8; - for (j=0; j < h; j++) - for (i=0; i < w; i++) { - k = row_size*j + i/8; - if (*(bbuffer + k) & bit_flag[i % 8]) - *(ba + k) |= bit_flag[i % 8]; - else - *(ba + k) &= ~bit_flag[i % 8]; - } - - free (bbuffer); - free (error2); - free (error1); -} - - -static -void int64to32(int *a, int length) -{ - register int i; - char *from, *to; - - to = from = (char *) a; - for (i = 0; i < length; i++) - { - to[0] = from[7]; - to[1] = from[6]; - to[2] = from[5]; - to[3] = from[4]; - to += 4; - from += 8; - } -} - - -static -void int64to16(short int *a, int length) -{ - register int i; - char *from, *to; - - to = from = (char *) a; - for (i = 0; i < length; i++) - { - to[0] = from[7]; - to[1] = from[6]; - to += 2; - from += 8; - } -} - - -static -void cell_array ( - float xmin, float xmax, float ymin, float ymax, - int dx, int dy, int dimx, int *colia) -{ - XImage *image = NULL; - - float x1, y1, x2, y2; - int ix1, ix2, iy1, iy2; - int x, y, w, h, bytes_per_line, bitmap_pad, size; - byte *ba; - Bool swapx, swapy; - - WC_to_NDC(xmin, ymax, gksl->cntnr, x1, y1); - seg_xform(&x1, &y1); - NDC_to_DC(x1, y1, ix1, iy1); - - WC_to_NDC(xmax, ymin, gksl->cntnr, x2, y2); - seg_xform(&x2, &y2); - NDC_to_DC(x2, y2, ix2, iy2); - - w = abs(ix2-ix1) + 1; - h = abs(iy2-iy1) + 1; - x = min(ix1, ix2); - y = min(iy1, iy2); - -#ifdef XSHM - if (p->shmimage != NULL && w == p->width && h == p->height) - { - image = p->shmimage; - ba = (byte *) p->shminfo.shmaddr; - bytes_per_line = p->shmimage->bytes_per_line; - } -#endif - bitmap_pad = (p->depth > 16 ? 32 : (p->depth > 8 ? 16 : 8)); - if (image == NULL) - { - size = w*h * bitmap_pad/8; - if (sizeof(int) == 8) - size *= 2; - ba = (byte *) malloc (size); - bytes_per_line = w; - } - - if (ba != NULL) - { - swapx = (xmin > xmax) ? True : False; - swapy = (ymin < ymax) ? True : False; - - if (bitmap_pad == 32) - { - copy32 (dx, dy, dimx, colia, w, h, bytes_per_line, (int *) ba, - swapx, swapy); - if (sizeof(int) == 8) - int64to32 ((int *) ba, w*h); - } - else if (bitmap_pad == 16) - { - copy16 (dx, dy, dimx, colia, w, h, bytes_per_line, (short int *) ba, - swapx, swapy); - if (sizeof(short int) == 8) - int64to16 ((short int *) ba, w*h); - } - else - copy8 (dx, dy, dimx, colia, w, h, bytes_per_line, ba, - swapx, swapy); - - if (p->mono_flag) - pixmap_to_bitmap (w, h, ba); - -#ifdef XSHM - if (image != NULL) - { - XShmPutImage (p->dpy, p->win, p->gc, image, 0, 0, x, y, w, h, True); - XSync (p->dpy, False); - return; - } -#endif - image = XCreateImage (p->dpy, p->vis, p->mono_flag ? 1 : p->depth, - p->mono_flag ? XYBitmap : ZPixmap, 0, (char *) ba, w, h, - bitmap_pad, 0); - if (image) - { - if (p->pixmap) - XPutImage (p->dpy, p->pixmap, p->gc, image, 0, 0, x, y, w, h); - if (!p->double_buf) - XPutImage (p->dpy, p->win, p->gc, image, 0, 0, x, y, w, h); - XSync (p->dpy, False); - /* - * Note: `XDestroyImage' frees both the image structure and the - * data pointed to by the image structure (ba) - */ -#ifdef VMS - free (ba); -#endif - XDestroyImage (image); - } - else - gks_fprintf (stderr, "GKS: unable to create a %dx%d image\n", w, h); - } - else - gks_fprintf (stderr, "GKS: can't allocate %dx%d data array\n", w, h); -} - - - -static -void resize_window (void) -{ - int x, y, width, height, k; - Arg arg[2]; - - if (!p->uil) { - width = nint((p->viewport[1]-p->viewport[0])/ - p->mwidth*p->swidth*p->magnification); - height = nint((p->viewport[3]-p->viewport[2])/ - p->mheight*p->sheight*p->magnification); - } - else { - width = nint((p->viewport[1]-p->viewport[0])*100); - height = nint((p->viewport[3]-p->viewport[2])*100); - } - - x = 4 + nint(p->viewport[0]/p->mwidth*p->swidth); - y = p->sheight-height-4 - nint(p->viewport[2]/p->mheight*p->sheight); - - if (width != p->width || height != p->height || x != p->x || y != p->y) - { - p->x = x; - p->y = y; - p->width = width; - p->height = height; - - if (p->new_win) - { - XMoveWindow (p->dpy, p->win, p->x, p->y); - XResizeWindow (p->dpy, p->win, p->width, p->height); - } - else { - k = 0; - XtSetArg (arg[k], "width", p->width); k++; - XtSetArg (arg[k], "height", p->height); k++; - XtSetValues (p->widget, arg, k); - } - - if (p->pixmap) { - XFreePixmap (p->dpy, p->pixmap); - p->pixmap = XCreatePixmap (p->dpy, XRootWindowOfScreen(p->screen), - p->width, p->height, p->depth); - XFillRectangle (p->dpy, p->pixmap, p->clear, 0, 0, - p->width, p->height); - } -#ifdef XSHM - free_shared_memory (); - create_shared_memory (); -#endif - } -} - - -static -void display_cursor (int x, int y) -{ - int xorg, yorg, width, height; - int dx, dy, r, d; - char str[16]; - - if (x == Undefined && y == Undefined) - return; - - switch (p->type) - { - case TypeNone: - case TypeCross: - break; - - case TypeLocal: - case TypeCrosshair: - XDrawLine (p->dpy, p->win, p->invert, 0, y, p->width, y); - XDrawLine (p->dpy, p->win, p->invert, x, 0, x, p->height); - break; - - case TypeRubberband: - XDrawLine (p->dpy, p->win, p->invert, p->px, p->py, x, y); - break; - - case TypeRectangle: - xorg = min(p->px, x); - yorg = min(p->py, y); - width = abs(p->px - x); - height = abs(p->py - y); - XDrawRectangle (p->dpy, p->win, p->invert, xorg, yorg, - width, height); - break; - - case TypeDigital: - sprintf (str, "(%d %d)", x, y); - XDrawString (p->dpy, p->win, p->invert, p->px, p->py, - str, strlen(str)); - break; - - case TypeCircle: - dx = p->px - x; - dy = p->py - y; - r = (int) (sqrt((double)(dx*dx + dy*dy)) + 0.5); - d = 2*r; - if (r != 0) - XDrawArc (p->dpy, p->win, p->invert, p->px-r, p->py-r, - d, d, 0, 360*64); - break; - } -} - - -static -void get_pointer (int *n, float *x, float *y, int *state, int *term) -{ - Window focus, root_win, child_win; - XEvent event; - int np, revert, xold, yold; - KeySym keysym; - char str[10]; - int inc, xcur, ycur, xwin, ywin; - static XComposeStatus status = { NULL, 0 }; - unsigned int mask, old_mask; - int event_mask = ButtonPressMask | PointerMotionMask | KeyPressMask | - KeyReleaseMask | StructureNotifyMask | ExposureMask; - - XGetInputFocus (p->dpy, &focus, &revert); - - XDefineCursor (p->dpy, p->win, p->cursor); - XRaiseWindow (p->dpy, p->win); - - if (p->new_win) { - while (XCheckTypedWindowEvent (p->dpy, p->win, ConfigureNotify, &event)) - ; - } - - np = 0; - - xold = p->px; - yold = p->py; - old_mask = 0; - if (xold == Undefined || yold == Undefined) - { - XQueryPointer (p->dpy, p->win, &root_win, &child_win, &xcur, &ycur, - &xold, &yold, &mask); - } - display_cursor (xold, yold); - - XSelectInput (p->dpy, p->win, event_mask); - - *term = 0; - - do - { - *state = Undefined; - inc = 1; - - if (p->wstype == 212) -#ifndef _WIN32 -#ifdef __osf__ - usleep (200000); /* 200 ms */ -#else - sleep (1); -#endif -#endif - - do - { - if (p->wstype == 212) - { - while (True) - { - old_mask = mask; - XQueryPointer (p->dpy, p->win, &root_win, &child_win, - &xcur, &ycur, &xwin, &ywin, &mask); - if (xwin != xold || ywin != yold || mask != old_mask) - break; - } - - switch (mask) - { - case Button1Mask: - case Button2Mask: - event.xany.type = ButtonPress; - event.xbutton.button = (mask == Button1Mask) ? - Button1 : Button2; - event.xbutton.x = xwin; - event.xbutton.y = ywin; - break; - default: - event.xany.type = MotionNotify; - event.xmotion.x = xwin; - event.xmotion.y = ywin; - } - } - else - XWindowEvent (p->dpy, p->win, event_mask, &event); - - switch (event.xany.type) - { - case Expose: - handle_expose_event (p); - xold = yold = Undefined; - break; - - case ButtonPress: - xcur = event.xbutton.x; - ycur = event.xbutton.y; - - DC_to_NDC(xcur, ycur, *x++, *y++); - - if (event.xbutton.button == Button1) { - np++; - *state = GOK; - } - else - *state = GNONE; - break; - - case MotionNotify: - display_cursor (xold, yold); - - xcur = event.xmotion.x; - ycur = event.xmotion.y; - display_cursor (xcur, ycur); - - xold = xcur; - yold = ycur; - break; - - case KeyPress: - xcur = xold; - ycur = yold; - display_cursor (xold, yold); - - XLookupString ((XKeyEvent *) &event, str, 9, &keysym, &status); - - switch (keysym) - { - case XK_Shift_L: - case XK_Shift_R: inc = 10; break; - case XK_Left: xcur -= inc; break; - case XK_Right: xcur += inc; break; - case XK_Up: ycur -= inc; break; - case XK_Down: ycur += inc; break; - case XK_Control_L: - case XK_Control_R: - case XK_Caps_Lock: - case XK_Shift_Lock: - case XK_Meta_L: - case XK_Meta_R: - case XK_Alt_L: - case XK_Alt_R: - case XK_Multi_key: break; - - default: - if (*str != CTRL_C && *str != CTRL_D && *str != CTRL_Z) - { - DC_to_NDC(xcur, ycur, *x++, *y++); - np++; - *state = GOK; - } - else - *state = GNONE; - - *term = *str; - break; - } - - XWarpPointer (p->dpy, None, p->win, 0, 0, 0, 0, xcur, ycur); - - display_cursor (xcur, ycur); - - xold = xcur; - yold = ycur; - break; - - case KeyRelease: - XLookupString ((XKeyEvent *) &event, str, 9, &keysym, &status); - - if (keysym == XK_Shift_L || keysym == XK_Shift_R) inc = 1; - break; - - case ConfigureNotify: - p->empty = False; - configure_event ((XConfigureEvent *) &event); - if (p->empty) - xold = yold = Undefined; - - *state = Undefined; - break; - } - } - while (*state < 0); - } - while (np < *n && *state != GNONE); - - display_cursor (xold, yold); - - XSetInputFocus (p->dpy, focus, revert, CurrentTime); - XRaiseWindow (p->dpy, p->win); - - XUndefineCursor (p->dpy, p->win); - XSync (p->dpy, False); - - *n = np; - if (*n > 1) - *state = GOK; - - p->px = xcur; - p->py = ycur; -} - - -static -int lookup_string (char *str) -{ - register int i; - char s1[3], s2[3]; - - s1[0] = str[0]; s1[1] = str[1]; s1[2] = '\0'; - s2[0] = str[1]; s2[1] = str[0]; s2[2] = '\0'; - - for (i=0; idpy, p->win, p->invert, p->px, p->py, text, strlen(text)); - - if (event) { - XLookupString (event, str, 9, &keysym, &compose_status); - -#ifndef VMS - if (keysym == XK_Multi_key) - compose_status.chars_matched = 1; - - else if (keysym >= XK_space && keysym <= XK_asciitilde) - { - switch (compose_status.chars_matched) - { - case 1 : - seq[0] = (char) keysym; - compose_status.chars_matched++; - keysym = 0; - break; - - case 2 : - seq[1] = (char) keysym; - seq[2] = '\0'; - keysym = lookup_string (seq); - - default : - compose_status.chars_matched = 0; - break; - } - } -#endif - if ((keysym >= XK_space && keysym <= XK_asciitilde) || - (keysym >= XK_nobreakspace && keysym <= XK_ydiaeresis)) { - str[0] = (char) keysym; - str[1] = '\0'; - strcat (text, str); - } - - else if (keysym == XK_Delete) { - if (*text) - text[strlen(text)-1] = '\0'; - } - else if (keysym == XK_Up) - strcpy (text, recall_buffer); - - XDrawString (p->dpy, p->win, p->invert, p->px, p->py, text, - strlen(text)); - - if (keysym == XK_Return) - strcpy (recall_buffer, text); - } - else - keysym = XK_space; - - return (keysym); -} - - -static -void draw_text_box (void) - -{ - int x, y; - - x = p->px - 5; - y = p->py + 5; - - XDrawLine (p->dpy, p->win, p->invert, x, y, x, y-20); - XDrawLine (p->dpy, p->win, p->invert, x, y, x+100, y); -} - - -static -void get_string (int *n, char *chars, int *state) -{ - XEvent event; - Window focus; - int done, revert; - char text[256]; - int event_mask = ButtonPressMask | PointerMotionMask | KeyPressMask | - ExposureMask; - - XGetInputFocus (p->dpy, &focus, &revert); - - XDefineCursor (p->dpy, p->win, p->textcursor); - XRaiseWindow (p->dpy, p->win); - - draw_text_box (); - - strcpy (text, ""); - done = FALSE; - - XSelectInput(p->dpy, p->win, event_mask); - - do - { - XWindowEvent (p->dpy, p->win, event_mask, &event); - - switch (event.type) - { - case Expose: - handle_expose_event (p); - break; - - case KeyPress : - if (dispatch_character ((XKeyEvent *) &event, text) == XK_Return) { - strcpy (chars, text); - done = TRUE; - } - break; - - case ButtonPress : - if (event.xbutton.button == Button1) { - strcpy (chars, text); - done = TRUE; - } - break; - } - } - - while (!done && event.type != ButtonPress); - - *n = strlen(text); - dispatch_character (NULL, text); - - draw_text_box (); - - XSetInputFocus (p->dpy, focus, revert, CurrentTime); - XRaiseWindow (p->dpy, p->win); - - XUndefineCursor (p->dpy, p->win); - XSync (p->dpy, False); - - if (done) - *state = GOK; - else - *state = GNONE; -} - -#endif - - -#if !defined(NO_X11) - -void STDCALL GKDXW ( - int *fctid, int *dx, int *dy, int *dimx, int *ia, int *lr1, float *r1, - int *lr2, float *r2, int *lc, CHARARG(chars), ws_state_list **ptr) -{ - static int win = 0; - - p = *ptr; - - switch (function_id = *fctid) { - - case 2: -/* - * Open workstation - */ - p = (ws_state_list *) malloc (sizeof(ws_state_list)); - - p->wkid = ia[0]; - - p->packed_ca = getenv("GLI_GKS_PACKED_CELL_ARRAY") ? True : False; - p->double_buf = getenv("GLI_GKS_DOUBLE_BUF") ? True : False; - p->shape = getenv("GLI_GKS_CONVEX_SHAPE") ? Convex : Complex; - p->widget = (Widget) NULL; - p->conid = ia[1]; - p->wstype = ia[2]; - p->gif = -1; - p->rf = -1; - p->uil = NULL; - p->frame = NULL; - - switch (p->wstype) { - - case 230: - case 231: - case 232: - case 233: - p->wstype -= 20; - case 210: - case 211: - case 212: - case 213: - if ((unsigned) ia[1] >= 100 + 100) { - p->widget = (Widget) *ptr; - } - break; - - case 216: - open_uil (); - break; - - case 217: - p->frame = (Pixmap *) malloc (MAX_PIXMAP * sizeof(Pixmap)); - p->nframes = 0; - break; - } - - p->ccolor = Undefined; - p->ncolors = 0; - p->scolors = SHARED_COLORS; - - p->error = NULL; - - if (open_display () == NULL) { - free (p); - ia[0] = ia[1] = 0; - return; - } - - max_points = MAX_POINTS; - points = (XPoint *) malloc (max_points * sizeof(XPoint)); - - set_colors (); - configure_colors (); - allocate_colors (True); - - if (p->wstype == 215 || p->wstype == 218) - open_gif (p->conid); - else if (p->wstype == 214) - open_rf (p->conid); - - create_window (win); - set_WM_hints (); - create_GC (); - create_pixmap (); -#ifdef XSHM - create_shared_memory (); -#endif - initialize_arrays (); - verify_font_capabilities (); - create_cursor (); - - p->state = GINACT; - p->mapped = False; - - p->ltype = GSOLID; - p->lwidth = 0; - - /* Setup default device transformation */ - - p->window[0] = 0; p->window[1] = 1; - p->window[2] = 0; p->window[3] = 1; - - p->viewport[0] = 0; p->viewport[1] = p->mwidth*p->width/p->swidth; - p->viewport[2] = 0; p->viewport[3] = p->mheight*p->height/p->sheight; - - setup_xform (p->window, p->viewport); - - p->type = TypeLocal; - p->px = Undefined; - p->py = Undefined; - - /* Return state list address, screen width and height */ - - if (sizeof(char *) > sizeof(int)) { - long *la = (long *)ia; - *la = (long)p; - } - else - *ia = (long)p; - - r1[0] = p->mwidth; r2[0] = p->mheight; - r1[1] = p->swidth; r2[1] = p->sheight; - - p->xshm = ((char *) getenv ("GLI_GKS_XSHM") != NULL) ? True : False; - p->gr_bc = ((char *) getenv ("GR_BC") != NULL) ? True : False; - -#if defined(hpux) && !defined(NAGware) - line_routine_a = (void (*)()) line_routine; - fill_routine_a = (void (*)()) fill_routine; -#endif - - if (p->new_win) - win++; - else - XClearWindow (p->dpy, p->win); - - /* Get GKS state list address */ - - gksl = (gks_state_list *)(ia+4); - - init_norm_xform (); - set_clipping (True); - - break; - - case 3: -/* - * Close workstation - */ - if (p->gif >= 0) - pixmap_to_gif (); - else if (p->rf >= 0) - pixmap_to_rf (); - - else if (p->frame) - if (p->nframes > 1) - pixmap_loop (); - - if (p->new_win) - unmap_window (); -#ifdef XSHM - free_shared_memory (); -#endif - if (p->pixmap) - XFreePixmap (p->dpy, p->pixmap); - - free_GC (); - free_colors (); - - if (p->new_win) { - XDestroyWindow (p->dpy, p->win); - win--; - - XFreePixmap (p->dpy, p->icon_pixmap); - } - if (p->new_dpy) - XCloseDisplay (p->dpy); - - if (p->gif >= 0) - close (p->gif); - else if (p->rf >= 0) - close (p->rf); - else if (p->uil) - fclose (p->uil); - - free (points); - free (p); - break; - - case 4: -/* - * Activate workstation - */ - p->state = GACTIV; - break; - - case 5: -/* - * Deactivate workstation - */ - p->state = GINACT; - break; - - case 6: -/* - * Clear workstation - */ - if (p->uil) - pixmap_to_uil (); - - else if (p->frame) { - if (p->nframes != MAX_PIXMAP) { - p->frame[p->nframes++] = p->pixmap; - set_frame_header (p->nframes); - create_pixmap (); - } - } - - if (p->pixmap) - XFillRectangle (p->dpy, p->pixmap, p->clear, 0, 0, p->width, - p->height); - if (!p->double_buf) - XClearWindow (p->dpy, p->win); - - p->empty = True; - - if (!p->frame) - XSync (p->dpy, False); - break; - - case 8: -/* - * Update workstation - */ - if (p->double_buf && ia[1] == GPERFO) - handle_expose_event (p); - - update (); - - if (p->state == GACTIV) { - if (p->error) { - gks_fprintf (stderr, "%s\n", p->error); - p->error = NULL; - } - } - break; - - case 10: -/* - * Message - */ - if (!p->mapped) - map_window (); - - if (p->state == GACTIV) -#ifdef VMS - message (chars->dsc$w_length, chars->dsc$a_pointer); -#else -#ifdef cray - message (_fcdlen(chars), _fcdtocp(chars)); -#else - message (strlen(chars), chars); -#endif /* cray */ -#endif /* VMS */ - break; - - case 12: -/* - * Polyline - */ - if (!p->mapped) - map_window (); - - if (p->state == GACTIV) - polyline (ia, r1, r2); - break; - - case 13: -/* - * Polymarker - */ - if (!p->mapped) - map_window (); - - if (p->state == GACTIV) - polymarker (ia, r1, r2); - break; - - case 14: -/* - * Text - */ - if (!p->mapped) - map_window (); - - if (p->state == GACTIV) -#ifdef VMS - text (r1, r2, chars->dsc$w_length, chars); -#else -#ifdef cray - text (r1, r2, _fcdlen(chars), chars); -#else - text (r1, r2, strlen(chars), chars); -#endif /* cray */ -#endif /* VMS */ - break; - - case 15: -/* - * Fill Area - */ - if (!p->mapped) - map_window (); - - if (p->state == GACTIV) - fill_area (ia, r1, r2); - break; - - case 16: -/* - * Cell Array - */ - if (!p->mapped) - map_window (); - - if (p->state == GACTIV) - { - if (p->min_colors) - allocate_colors (False); - cell_array (r1[0], r1[1], r2[0], r2[1], *dx, *dy, *dimx, ia); - } - break; - - case 48: -/* - * Set color representation - */ - if (ia[1] >= 0 && ia[1] < MAX_COLORS) { - set_color_repr (ia[1], r1[0], r1[1], r1[2]); - free_tile_patterns (ia[1]); - } - break; - - case 49: -/* - * Set window - */ - setup_norm_xform (*ia, gksl->window[*ia], gksl->viewport[*ia]); - set_clipping (True); - break; - - case 50: -/* - * Set viewport - */ - setup_norm_xform (*ia, gksl->window[*ia], gksl->viewport[*ia]); - set_clipping (True); - break; - - case 52: -/* - * Select normalization transformation - */ - set_clipping (True); - break; - - case 53: -/* - * Set clipping indicator - */ - set_clipping (True); - break; - - case 54: -/* - * Set workstation window - */ - p->window[0] = r1[0]; - p->window[1] = r1[1]; - p->window[2] = r2[0]; - p->window[3] = r2[1]; - - setup_xform (p->window, p->viewport); - set_clipping (True); - break; - - case 55: -/* - * Set workstation viewport - */ - { - float max_width, max_height; - - p->viewport[0] = r1[0]; - p->viewport[1] = r1[1]; - p->viewport[2] = r2[0]; - p->viewport[3] = r2[1]; - - if (p->gif >= 0 || p->rf >= 0) { - max_width = p->mwidth / p->swidth * 1280; - max_height = p->mheight / p->sheight * 1024; - } else if (p->widget == NULL) { - max_width = p->mwidth * 0.925; - max_height = p->mheight * 0.925; - } else { - max_width = 10.0; - max_height = 10.0; - } - if (!p->uil) - GKFVP (p->viewport, &max_width, &max_height); - - resize_window (); - set_WM_hints (); - - setup_xform (p->window, p->viewport); - set_clipping (True); - break; - } - - case 69: -/* - * Initialize locator - */ - p->type = (pe_type) ia[3]; - NDC_to_DC(r1[0], r2[0], p->px, p->py); - break; - - case 81: -/* - * Request locator - */ - { - int n; - - if (!p->mapped) - map_window (); - - n = 1; - get_pointer (&n, r1, r2, &ia[0], &ia[3]); - break; - } - - case 82: -/* - * Request stroke - */ - if (!p->mapped) - map_window (); - - get_pointer (&ia[2], r1, r2, &ia[0], &ia[3]); - break; - - case 86: -/* - * Request string - */ - if (!p->mapped) - map_window (); -#ifdef VMS - get_string (&ia[1], chars->dsc$a_pointer, &ia[0]); -#else -#ifdef cray - get_string (&ia[1], _fcdtocp(chars), &ia[0]); -#else - get_string (&ia[1], chars, &ia[0]); -#endif /* cray */ -#endif /* VMS */ - break; - } -} - -#else - -void STDCALL GKDXW ( - int *fctid, int *dx, int *dy, int *dimx, int *ia, int *lr1, float *r1, - int *lr2, float *r2, int *lc, CHARARG(chars), void **ptr) -{ - if (*fctid == 2) - { - gks_fprintf (stderr, - "GKS: X11 not supported for this type of machine\n"); - ia[0] = 0; - } -} - -#endif diff -r -N -u gks/gks.exp gli-gks/gks.exp --- gks/gks.exp 1999-02-09 19:00:00.000000000 -0500 +++ gli-gks/gks.exp 1969-12-31 19:00:00.000000000 -0500 @@ -1,192 +0,0 @@ -#!/usr/local/gli/libgks.so -gactivatews -gcellarray -gclearws -gclosegks -gcloseseg -gclosews -gcopysegws -gcreateseg -gdeactivatews -gemergencyclosegks -gevaltran -gfillarea -ginqasf -ginqcharexpan -ginqcharheight -ginqcharspace -ginqcharup -ginqclip -ginqcurntrannum -ginqdisplaysize -ginqfillcolourind -ginqfillind -ginqfillintstyle -ginqfillstyle -ginqlevelgks -ginqlinecolourind -ginqlineind -ginqlinetype -ginqlinewidth -ginqmarkercolourind -ginqmarkerind -ginqmarkersize -ginqmarkertype -ginqmaxntrannum -ginqnameopenseg -ginqntran -ginqopst -ginqtextalign -ginqtextcolourind -ginqtextextent -ginqtextfontprec -ginqtextind -ginqtextpath -ginqwscategory -ginqwscf -ginqwsst -gmessage -gopengks -gopenws -gpolyline -gpolymarker -gredrawsegws -greqloc -greqstring -gselntran -gsetasf -gsetcharexpan -gsetcharheight -gsetcharspace -gsetcharup -gsetclip -gsetcolourrep -gsetfillcolourind -gsetfillind -gsetfillintstyle -gsetfillstyle -gsetlinecolourind -gsetlineind -gsetlinetype -gsetlinewidth -gsetmarkercolourind -gsetmarkerind -gsetmarkertype -gsetmarkersize -gsetsegtran -gsettextalign -gsettextcolourind -gsettextfontprec -gsettextind -gsettextpath -gsetviewport -gsetwindow -gsetwsviewport -gsetwswindow -gtext -gupdatews -gacwk -gasgwk -gca -gclks -gclrwk -gclsg -gclwk -gcrsg -gcsgwk -gdawk -gdsg -gesc -gevtm -gfa -ggdp -ginlc -gmsg -gmsgs -gopks -gopwk -gpl -gpm -grqch -grqlc -grqsk -grqst -grsgwk -gsasf -gschh -gschsp -gschup -gschxp -gsclip -gscr -gsds -gselnt -gsfaci -gsfai -gsfais -gsfasi -gsln -gslwsc -gsmk -gsmksc -gsplci -gspli -gspmci -gspmi -gssgt -gstxal -gstxci -gstxfp -gstxi -gstxp -gsvp -gswkvp -gswkwn -gswn -gtx -gtxs -guwk -gqacwk -gqasf -gqcf -gqchh -gqchsp -gqchup -gqchxp -gqclip -gqcntn -gqdsp -gqewk -gqfaci -gqfai -gqfais -gqfasi -gqln -gqlvks -gqlwsc -gqmds -gqmk -gqmksc -gqmntn -gqnt -gqops -gqopsg -gqopwk -gqplci -gqpli -gqpmci -gqpmi -gqsgwk -gqtxal -gqtxci -gqtxfp -gqtxi -gqtxp -gqtxx -gqtxxs -gqwkc -gqwkca -gqwks -geclks -gerhnd -gerlog diff -r -N -u gks/gks.f gli-gks/gks.f --- gks/gks.f 2007-11-23 06:26:00.000000000 -0500 +++ gli-gks/gks.f 2010-02-13 16:15:19.870511839 -0500 @@ -375,16 +375,7 @@ SOPWS(WKIND,5) = IIA(1) SOPWS(WKIND,6) = IIA(2) - IF ((IWTYPE.GE.210 .AND. IWTYPE.LE.215) .OR. - * IWTYPE.EQ.218 .OR. - * (IWTYPE.GE.230 .AND. IWTYPE.LE.233)) THEN - X11 = .TRUE. - WKIND = GORD(LWSTY,NWSTY, IWTYPE) - GDC(1,WKIND) = R1(1) - GDC(2,WKIND) = R2(1) - GRU(1,WKIND) = INT(R1(2)) - GRU(2,WKIND) = INT(R2(2)) - ELSE IF (IWTYPE.EQ.5) THEN + IF (IWTYPE.EQ.5) THEN WISS = .TRUE. END IF @@ -2657,10 +2648,6 @@ * 204, 207, 82, 51, * 53, 72, 16, 17, * 61, 62, 63, 64, - * 210, 211, 212, 213, - * 214, 215, 216, 217, - * 218, - * 230, 231, 232, 233, * 7, 8, 5, 41, * 38, 103, 104, 92, * 2, 3, 101, 102/ @@ -2669,10 +2656,6 @@ * 2, 2, 2, 0, * 0, 2, 2, 2, * 0, 0, 0, 0, - * 0, 2, 2, 2, - * 0, 0, 0, 0, - * 0, - * 0, 2, 2, 2, * 4, 4, 3, 2, * 0, 0, 0, 0, * 4, 5, 0, 0/ @@ -2681,10 +2664,6 @@ * 0.256,0.192, 0.256,0.192, 0.256,0.192, 0.272,0.19, * 0.272,0.19, 0.256,0.192, 0.24,0.144, 0.24,0.144, * 0.28575,0.19685,0.28575,0.19685,0.28575,0.19685,0.28575,0.19685, - * 0.333,0.281, 0.333,0.281, 0.333,0.281, 0.333,0.281, - * 0.333,0.281, 0.333,0.281, 0.333,0.281, 0.333,0.281, - * 0.333,0.281, - * 0.333,0.281, 0.333,0.281, 0.333,0.281, 0.333,0.281, * 1.0,1.0, 1.0,1.0, 1.0,1.0, 0.333,0.281, * 0.256,0.192, 0.254,0.2032, 0.254,0.2032, 0.2794,0.2032, * 1.0,1.0, 1.0,1.0, 0.288,0.1984, 0.288,0.1984/ @@ -2693,10 +2672,6 @@ * 1024,768, 1024,768, 1024,768, 10870,7600, * 10870,7600, 1024,768, 800,480, 800,480, * 6750,4650, 6750,4650, 6750,4650, 6750,4650, - * 1024,864, 1024,864, 1024,864, 1024,864, - * 1024,864, 1024,864, 1024,864, 1024,864, - * 1024,864, - * 1024,864, 1024,864, 1024,864, 1024,864, * 65536,65536, 65536,65536, 32767,32767, 1024,864, * 1024,768, 720,576, 750,600, 1980,1440, * 65536,65536, 65536,65536, 810,558, 810,558/ diff -r -N -u gks/Makefile gli-gks/Makefile --- gks/Makefile 2007-12-20 10:35:56.000000000 -0500 +++ gli-gks/Makefile 2010-02-18 10:39:08.776728007 -0500 @@ -1,144 +1,11 @@ -# -# Copyright @ 1984 - 1996 Josef Heinen -# -# Permission to use, copy, and distribute this software and its -# documentation for any purpose with or without fee is hereby granted, -# provided that the above copyright notice appear in all copies and -# that both that copyright notice and this permission notice appear -# in supporting documentation. -# -# Permission to modify the software is granted, but not the right to -# distribute the modified code. Modifications are to be distributed -# as patches to released version. -# -# This software is provided "as is" without express or implied warranty. -# -# Send your comments or suggestions to -# J.Heinen@kfa-juelich.de. -# -# - - CC = cc - CFLAGS = - F77 = f77 - F77FLAGS = - AR = ar - RM = rm - RANLIB = ranlib - SEGLD = f77 - LD = ld - LDFLAGS = - XLIBS = -lXt -lX11 - XLIBPATH = - LIBS = - INSTALL = install - DESTDIR = /usr/local/lib - COPY = mcopy -tnvm - COPYBIN = mcopy -nvm - SHLIBS = - SOFLAGS = -soname $(DESTDIR)/libgks.so - - OBJS = gksio.o gkscbnd.o gks.o gksinq.o gkserror.o gksroot.o gksmisc.o \ - gksdidd.o gksdps.o gksdtek.o gksdtek2.o gksdx11.o gksduis.o \ - gksdcgm.o gksdwiss.o gkswiss.o gksdhpgl.o gksdvt.o gksdpbm.o \ - gksdgksm.o gksdpdf.o gksforio.o gksafm.o compress.o - -.SUFFIXES: .a .o .c .f - -.c.o: - $(CC) -c $(CFLAGS) $< -.f.o: - $(F77) -c $(F77FLAGS) $< - -default: - @make mod - @make `./Config` - @chmod 444 libgks.* gksfont.dat - -mod: - @chmod 644 * - @if [ -f int86.obj ]; then chmod 444 int86.obj; else true; fi - @chmod 555 Config - @if [ -d win ]; then chmod 700 win; else true; fi - @if [ -d win ]; then chmod 644 win/*; else true; fi - @if [ -d dos ]; then chmod 700 dos; else true; fi - @if [ -d dos ]; then chmod 644 dos/*; else true; fi - -usage: @echo "Can't obtain system information."; \ -"Usage: make [aix|alpha|cray|hpux|irix|mips|pclinux|netbsd|sun]" - -aix: - @make all CFLAGS="-Daix" F77="xlf" F77FLAGS="-NQ20000" \ - RANLIB="ar ts" LD="xlf" \ - SHLIBS="libgks.so" SOFLAGS="-bM:SRE -bE:gks.exp -e gopks" -aix-nagware: - @make all CFLAGS="-DNAGware" F77="nagf95" F77FLAGS="-w=obs" \ - RANLIB="ar ts" SEGLD="nagf95" -alpha: - @make all SHLIBS="libgks.so" LD="ld -shared" \ - LIBS="-lUfor -lfor -lFutil -lots -lm -lc" -darwin: - @make all CFLAGS="-I/usr/X11R6/include" XLIBPATH="-L/usr/X11R6/lib" \ - F77="gfortran" SEGLD="gfortran" -sn1011: sn2401 -sn2401: - @make all F77="cf77" F77FLAGS="-Wf\"-a stack -o off -e v -dp\"" \ - RANLIB="ar t" -sn6308: cray -sn7024: cray -sn7104: cray -sn7119: cray -sn9612: cray -cray: - @make all F77="f90" F77FLAGS="-en -dp -O3" RANLIB="ar t" SEGLD="f90" \ - XLIBS="-lXt -lX11 -lSM -lICE" -hpux: - @make all CFLAGS="-Wp,-H200000 -I/usr/include/X11R5" \ - SEGLD="ld /lib/crt0.o" XLIBPATH="-L/usr/lib/X11R5" LIBS="-lcl -lm -lc" -hpux-nagware: - @make all CFLAGS="-Wp,-H200000 -Uhpux -I/usr/include/X11R5" \ - F77="f95" F77FLAGS="-w=obs" SEGLD="f95" XLIBPATH="-L/usr/lib/X11R5" \ - LIBS="-L/opt/fortran90/lib -lF90 -lcl -lm -lc" -irix: - @make all RANLIB="ar ts" SHLIBS="libgks.so" LD="ld -shared" -i386: pclinux -i486: pclinux -i586: pclinux -i686: pclinux -pclinux: - @make all CFLAGS="-I/usr/X11R6/include" XLIBPATH="-L/usr/X11R6/lib" \ - F77="g77" SEGLD="g77" -pclinux-pgi: - @make all CFLAGS="-I/usr/X11R6/include" XLIBPATH="-L/usr/X11R6/lib" \ - F77="pgf77" SEGLD="pgf77" -netbsd: - @make all CFLAGS="-I/usr/X11R6/include" XLIBPATH="-L/usr/X11R6/lib" -mips: - @make all -sunos: - @make all CFLAGS="-I/usr/openwin/include" RANLIB="ar ts" \ - SHLIBS="libgks.so" SOFLAGS="-G" XLIBPATH="-L/usr/openwin/lib" \ - LIBS="-lnsl" -sun4: sun -sun: - @make all CFLAGS="-I/usr/openwin/include -DBSD" LDFLAGS="-Bstatic" \ - SHLIBS="libgks.so" SOFLAGS="" XLIBPATH="-L/usr/openwin/lib" - -all: libgks.a $(SHLIBS) demo +FC=gfortran +OBJS=gksio.o gkscbnd.o gks.o gksinq.o gkserror.o gksroot.o gksmisc.o\ + gksdidd.o gksdps.o gksdtek.o gksdtek2.o gksduis.o\ + gksdcgm.o gksdwiss.o gkswiss.o gksdhpgl.o gksdvt.o gksdpbm.o\ + gksdgksm.o gksdpdf.o gksforio.o gksafm.o compress.o libgks.a: $(OBJS) $(AR) rv $@ $? - $(RANLIB) $@ -libgks.so: $(OBJS) - $(LD) -o $@ $(SOFLAGS) $(OBJS) $(LDFLAGS) \ - $(XLIBPATH) $(XLIBS) $(LIBS) - -demo: demo.o libgks.a - $(SEGLD) -o $@ demo.o libgks.a $(LDFLAGS) $(XLIBPATH) $(XLIBS) $(LIBS) - -install: - $(INSTALL) -m 644 libgks.* $(DESTDIR) - $(INSTALL) -m 644 gksfont.dat $(DESTDIR) clean: - $(RM) -f *.bak *.o libgks.* so_locations demo + $(RM) -f *.o *.a diff -r -N -u gks/win/build.bat gli-gks/win/build.bat --- gks/win/build.bat 1998-06-21 20:00:00.000000000 -0400 +++ gli-gks/win/build.bat 1969-12-31 19:00:00.000000000 -0500 @@ -1 +0,0 @@ -nmake /nologo /f makefile %1 \ No newline at end of file diff -r -N -u gks/win/gks.def gli-gks/win/gks.def --- gks/win/gks.def 2000-10-18 09:25:00.000000000 -0400 +++ gli-gks/win/gks.def 1969-12-31 19:00:00.000000000 -0500 @@ -1,106 +0,0 @@ -LIBRARY gks.dll -EXETYPE WINDOWS - -EXPORTS - _GOPKS@8 - _GCLKS@0 - _GOPWK@12 - _GRSGWK@4 - _GCLWK@4 - _GACWK@4 - _GDAWK@4 - _GCLRWK@8 - _GUWK@8 - _GECLKS@0 - _GESC@32 - _GMSG@12 - _GMSGS@16 - _GPL@12 - _GPM@12 - _GTX@16 - _GTXS@20 - _GFA@12 - _GCA@44 - _GSASF@4 - _GSPLI@4 - _GSLN@4 - _GSLWSC@4 - _GSPLCI@4 - _GSPMI@4 - _GSMK@4 - _GSMKSC@4 - _GSPMCI@4 - _GSCR@20 - _GSTXI@4 - _GSTXFP@8 - _GSCHXP@4 - _GSCHH@4 - _GSCHUP@8 - _GSTXP@4 - _GSCHSP@4 - _GSTXAL@8 - _GSTXCI@4 - _GSFAI@4 - _GSFAIS@4 - _GSFASI@4 - _GSFACI@4 - _GSWN@20 - _GSVP@20 - _GSELNT@4 - _GSCLIP@4 - _GSWKWN@20 - _GSWKVP@20 - _GCRSG@4 - _GCLSG@0 - _GDSG@4 - _GCSGWK@8 - _GASGWK@8 - _GSSGT@8 - _GSDS@12 - _GEVTM@36 - _GINLC@52 - _GRQLC@24 - _GRQSK@32 - _GRQST@24 - _GRQCH@16 - _GQOPS@4 - _GQLVKS@8 - _GQEWK@16 - _GQMNTN@8 - _GQOPWK@16 - _GQACWK@16 - _GQSGWK@20 - _GQOPSG@8 - _GQASF@8 - _GQPLI@8 - _GQLN@8 - _GQLWSC@8 - _GQPLCI@8 - _GQPMI@8 - _GQMK@8 - _GQMKSC@8 - _GQPMCI@8 - _GQTXI@8 - _GQTXFP@12 - _GQCHXP@8 - _GQCHSP@8 - _GQTXCI@8 - _GQCHH@8 - _GQCHUP@12 - _GQTXP@8 - _GQTXAL@12 - _GQFAI@8 - _GQFAIS@8 - _GQFASI@8 - _GQFACI@8 - _GQCNTN@8 - _GQNT@16 - _GQCLIP@12 - _GQWKC@16 - _GQWKS@12 - _GQWKCA@12 - _GQCF@20 - _GQTXX@40 - _GQTXXS@44 - _GQDSP@28 - _GQMDS@28 diff -r -N -u gks/win/gksdll.c gli-gks/win/gksdll.c --- gks/win/gksdll.c 1998-06-22 20:00:00.000000000 -0400 +++ gli-gks/win/gksdll.c 1969-12-31 19:00:00.000000000 -0500 @@ -1,13 +0,0 @@ -#include - -BOOL APIENTRY -DllMain(HINSTANCE hInst, DWORD reason, LPVOID reserved) -{ - return TRUE; -} - -BOOL APIENTRY -DllEntryPoint(HINSTANCE hInst, DWORD reason, LPVOID reserved) -{ - return DllMain(hInst, reason, reserved); -} \ No newline at end of file diff -r -N -u gks/win/makefile gli-gks/win/makefile --- gks/win/makefile 2000-10-18 09:19:00.000000000 -0400 +++ gli-gks/win/makefile 1969-12-31 19:00:00.000000000 -0500 @@ -1,48 +0,0 @@ -CC = CL -CFLAGS = /c /nologo /DNO_X11 /D_DLL /MT -#FC = FL32 -FC = DF -FFLAGS = /c /nologo /D_DLL /MT -AR = LIB /nologo -#LINK = LINK /nologo -LINK = LINK /nologo /entry:mainCRTStartup -DLLLFLAGS = /nodefaultlib -dll -#DLLLIBS = msfrt.lib msvcrt.lib oldnames.lib wsock32.lib advapi32.lib user32.lib gdi32.lib winspool.lib -DLLLIBS = dfordll.lib dfconsol.lib msvcrt.lib oldnames.lib kernel32.lib wsock32.lib advapi32.lib user32.lib gdi32.lib comdlg32.lib winspool.lib -DLLLINK = LINK /nologo -SRCDIR = ..\ -DESTDIR = S:\gli - -.SUFFIXES: .obj .c .f - -{$(SRCDIR)}.c.obj: - $(CC) $(CFLAGS) $< -{$(SRCDIR)}.f.obj: - $(FC) $(FFLAGS) $< - -all: gks.lib demo.exe - -gks.lib: gks.dll - -gks.dll: gksdll.obj gksio.obj gks.obj gksinq.obj gkserror.obj \ - gksroot.obj gksmisc.obj gksdidd.obj gksdps.obj \ - gksdtek.obj gksdtek2.obj gksdx11.obj gksdwin.obj \ - gksdcgm.obj gksdpbm.obj gksdwiss.obj gkswiss.obj \ - gksdhpgl.obj gksdvt.obj gksdgksm.obj gksdpdf.obj \ - gksforio.obj gksafm.obj compress.obj - $(DLLLINK) /out:$@ $** -def:gks.def $(DLLLFLAGS) $(DLLLIBS) - -demo.exe: demo.obj gks.lib - $(LINK) /out:$@ demo.obj gks.lib - -install: all - COPY gks.lib $(DESTDIR) - COPY gks.dll $(DESTDIR) - -clean: - DEL demo.exe - DEL *.lib - DEL *.exp - DEL *.dll - DEL *.obj - DEL *.bak