SUBROUTINE PWRZS (X,Y,Z,ID,N,ISIZE,LIN3,ITOP,ICNT) C C C +-----------------------------------------------------------------+ C | | C | Copyright (C) 1986 by UCAR | C | University Corporation for Atmospheric Research | C | All Rights Reserved | C | | C | NCARGRAPHICS Version 1.00 | C | | C +-----------------------------------------------------------------+ C C C C LATEST REVISION JULY, 1984 C C PURPOSE PWRZS IS A CHARACTER PLOTTING ROUTINE FOR C PLOTTING CHARACTERS IN THREE-SPACE WHEN USING C SRFACE. FOR A LARGE CLASS OF C POSSIBLE POSITIONS, THE HIDDEN CHARACTER C PROBLEM IS SOLVED. C C C C USAGE CALL PWRZS (X,Y,Z,ID,N,ISIZE,LINE,ITOP,ICNT) C USE CALL PWRZS AFTER CALLING C SRFACE AND BEFORE CALLING FRAME C NOTE: SRFACE WILL HAVE TO BE CHANGED C TO SUPPRESS THE FRAME CALL. SEE IFR C IN SRFACE INTERNAL PARAMETERS. C C ARGUMENTS C C ON INPUT X,Y,Z C POSITIONING COORDINATES FOR THE CHARACTERS C TO BE DRAWN. THESE ARE FLOATING POINT C NUMBERS IN THE SAME THREE-SPACE AS USED IN C SRFACE. C C ID C CHARACTER STRING TO BE DRAWN C C N C THE NUMBER OF CHARACTERS IN ID C C ISIZE C SIZE OF THE CHARACTER C . IF BETWEEN 0 AND 3 THE FACTOR IS 1., 1.5, C 2., OR 3. TIMES A STANDARD WIDTH EQUAL C TO 1/128TH OF THE SCREEN WIDTH. C . IF GREATER THAN 3 IT IS THE CHARACTER C WIDTH IN PLOTTER ADDRESS UNITS. C C LINE C THE DIRECTION IN WHICH THE CHARACTERS ARE TO C BE WRITTEN. C 1 = +X -1 = -X C 2 = +Y -2 = -Y C 3 = +Z -3 = -Z C C ITOP C THE DIRECTION FROM THE CENTER OF THE FIRST C CHARACTER TO THE TOP OF THE FIRST C CHARACTER. NOTE THAT LINE CANNOT C EQUAL ITOP EVEN IN ABSOLUTE VALUE. C C ICNT C CENTERING OPTION. C -1 (X,Y,Z) IS THE CENTER OF THE LEFT EDGE OF C THE FIRST CHARACTER. C 0 (X,Y,Z) IS THE CENTER OF THE ENTIRE C STRING. C 1 (X,Y,Z) IS THE CENTER OF THE RIGHT EDGE C OF THE LAST CHARACTER. C C ON OUTPUT ALL ARGUMENTS ARE UNCHANGED. C C NOTE THE HIDDEN CHARACTER PROBLEM IS SOLVED C CORRECTLY FOR CHARACTERS NEAR (BUT NOT INSIDE) C THE THREE-SPACE OBJECT. C C ENTRY POINTS PWRZS, INITZS, PWRZOS, PWRZGS C C COMMON BLOCKS PWRZ1S,PWRZ2S C C I/O PLOTS CHARACTER(S) C C PRECISION SINGLE C C REQUIRED LIBRARY SRFACE C ROUTINES C C LANGUAGE FORTRAN C C HISTORY IMPLEMENTED FOR USE WITH SRFACE. C C C C C*********************************************************************** C SAVE CHARACTER*(*) ID CHARACTER*1 JCHAR(46) ,KCHAR DIMENSION INDEX(46) ,KX(494) ,KY(494) DIMENSION VWPRT(4) ,WNDW(4) LOGICAL LENTRY c +NOAO: common block added for user control of viewport common /noaovp/ vpx1, vpx2, vpy1, vpy2 c -NOAO C C C THE FOLLOWING DATA STATEMENTS ASSOCIATE EACH CHARACTER WITH ITS C DIGITIZATION. THAT IS, THE DIGITIZATION FOR THE CHARACTER A STARTS C AT KX(1) AND KY(1), WHILE B STARTS AT KX(13) AND KY(13), AND SO ON. C DATA JCHAR( 1),INDEX( 1)/'A', 1/ DATA JCHAR( 2),INDEX( 2)/'B', 13/ DATA JCHAR( 3),INDEX( 3)/'C', 28/ DATA JCHAR( 4),INDEX( 4)/'D', 40/ DATA JCHAR( 5),INDEX( 5)/'E', 49/ DATA JCHAR( 6),INDEX( 6)/'F', 60/ DATA JCHAR( 7),INDEX( 7)/'G', 68/ DATA JCHAR( 8),INDEX( 8)/'H', 82/ DATA JCHAR( 9),INDEX( 9)/'I', 92/ DATA JCHAR(10),INDEX(10)/'J',104/ DATA JCHAR(11),INDEX(11)/'K',113/ DATA JCHAR(12),INDEX(12)/'L',123/ DATA JCHAR(13),INDEX(13)/'M',130/ DATA JCHAR(14),INDEX(14)/'N',137/ DATA JCHAR(15),INDEX(15)/'O',143/ DATA JCHAR(16),INDEX(16)/'P',157/ DATA JCHAR(17),INDEX(17)/'Q',166/ DATA JCHAR(18),INDEX(18)/'R',182/ DATA JCHAR(19),INDEX(19)/'S',194/ DATA JCHAR(20),INDEX(20)/'T',210/ DATA JCHAR(21),INDEX(21)/'U',219/ DATA JCHAR(22),INDEX(22)/'V',229/ DATA JCHAR(23),INDEX(23)/'W',236/ DATA JCHAR(24),INDEX(24)/'X',245/ DATA JCHAR(25),INDEX(25)/'Y',252/ DATA JCHAR(26),INDEX(26)/'Z',262/ DATA JCHAR(27),INDEX(27)/'0',273/ DATA JCHAR(28),INDEX(28)/'1',286/ DATA JCHAR(29),INDEX(29)/'2',296/ DATA JCHAR(30),INDEX(30)/'3',308/ DATA JCHAR(31),INDEX(31)/'4',326/ DATA JCHAR(32),INDEX(32)/'5',339/ DATA JCHAR(33),INDEX(33)/'6',352/ DATA JCHAR(34),INDEX(34)/'7',368/ DATA JCHAR(35),INDEX(35)/'8',378/ DATA JCHAR(36),INDEX(36)/'9',398/ DATA JCHAR(37),INDEX(37)/'+',414/ DATA JCHAR(38),INDEX(38)/'-',423/ DATA JCHAR(39),INDEX(39)/'*',429/ DATA JCHAR(40),INDEX(40)/'/',444/ DATA JCHAR(41),INDEX(41)/'(',448/ DATA JCHAR(42),INDEX(42)/')',456/ DATA JCHAR(43),INDEX(43)/'=',464/ DATA JCHAR(44),INDEX(44)/' ',473/ DATA JCHAR(45),INDEX(45)/',',476/ DATA JCHAR(46),INDEX(46)/'.',486/ C C THE FOLLOWING DATA STATEMENTS CONTAIN THE DIGITIZATIONS OF THE C CHARACTERS. THE CHARACTERS ARE DIGITIZED ON A BOX 6 UNITS WIDE AND C 7 UNITS TALL. THIS INCLUDES 2 UNITS OF WHITE SPACE TO THE RIGHT OF C EACH CHARACTER. IF KX=7, KY IS A FLAG -- KY=0 MEANS THE FOLLOWING C KX AND KY ARE A PEN UP MOVE (ALL OTHERS ARE PEN DOWN MOVES), AND C KY=7 MEANS THAT THE END OF THE DIGITIZATION FOR A PARTICULAR CHARAC- C TER HAS BEEN REACHED. C c None of the following are used anywere. c DATA WIDE,HIGH,WHITE/6.,7.,2./ C DATA KX( 1),KX( 2),KX( 3),KX( 4),KX( 5),KX( 6)/0,4,7,0,0,1/ DATA KY( 1),KY( 2),KY( 3),KY( 4),KY( 5),KY( 6)/3,3,0,3,6,7/ DATA KX( 7),KX( 8),KX( 9),KX( 10),KX( 11),KX( 12)/3,4,4,7,6,7/ DATA KY( 7),KY( 8),KY( 9),KY( 10),KY( 11),KY( 12)/7,6,0,0,0,7/ DATA KX( 13),KX( 14),KX( 15),KX( 16),KX( 17),KX( 18)/0,3,4,4,3,0/ DATA KY( 13),KY( 14),KY( 15),KY( 16),KY( 17),KY( 18)/7,7,6,5,4,4/ DATA KX( 19),KX( 20),KX( 21),KX( 22),KX( 23),KX( 24)/7,3,4,4,3,0/ DATA KY( 19),KY( 20),KY( 21),KY( 22),KY( 23),KY( 24)/0,4,3,1,0,0/ DATA KX( 25),KX( 26),KX( 27),KX( 28),KX( 29),KX( 30)/7,6,7,7,4,3/ DATA KY( 25),KY( 26),KY( 27),KY( 28),KY( 29),KY( 30)/0,0,7,0,6,7/ DATA KX( 31),KX( 32),KX( 33),KX( 34),KX( 35),KX( 36)/1,0,0,1,3,4/ DATA KY( 31),KY( 32),KY( 33),KY( 34),KY( 35),KY( 36)/7,6,1,0,0,1/ DATA KX( 37),KX( 38),KX( 39),KX( 40),KX( 41),KX( 42)/7,6,7,0,3,4/ DATA KY( 37),KY( 38),KY( 39),KY( 40),KY( 41),KY( 42)/0,0,7,7,7,6/ DATA KX( 43),KX( 44),KX( 45),KX( 46),KX( 47),KX( 48)/4,3,0,7,6,7/ DATA KY( 43),KY( 44),KY( 45),KY( 46),KY( 47),KY( 48)/1,0,0,0,0,7/ DATA KX( 49),KX( 50),KX( 51),KX( 52),KX( 53),KX( 54)/0,4,7,3,0,7/ DATA KY( 49),KY( 50),KY( 51),KY( 52),KY( 53),KY( 54)/7,7,0,4,4,0/ DATA KX( 55),KX( 56),KX( 57),KX( 58),KX( 59),KX( 60)/0,4,7,6,7,0/ DATA KY( 55),KY( 56),KY( 57),KY( 58),KY( 59),KY( 60)/0,0,0,0,7,7/ DATA KX( 61),KX( 62),KX( 63),KX( 64),KX( 65),KX( 66)/4,7,0,3,7,6/ DATA KY( 61),KY( 62),KY( 63),KY( 64),KY( 65),KY( 66)/7,0,4,4,0,0/ DATA KX( 67),KX( 68),KX( 69),KX( 70),KX( 71),KX( 72)/7,7,4,3,1,0/ DATA KY( 67),KY( 68),KY( 69),KY( 70),KY( 71),KY( 72)/7,0,6,7,7,6/ DATA KX( 73),KX( 74),KX( 75),KX( 76),KX( 77),KX( 78)/0,1,3,4,4,3/ DATA KY( 73),KY( 74),KY( 75),KY( 76),KY( 77),KY( 78)/1,0,0,1,3,3/ DATA KX( 79),KX( 80),KX( 81),KX( 82),KX( 83),KX( 84)/7,6,7,0,7,0/ DATA KY( 79),KY( 80),KY( 81),KY( 82),KY( 83),KY( 84)/0,0,7,7,0,4/ DATA KX( 85),KX( 86),KX( 87),KX( 88),KX( 89),KX( 90)/4,7,4,4,7,6/ DATA KY( 85),KY( 86),KY( 87),KY( 88),KY( 89),KY( 90)/4,0,7,0,0,0/ DATA KX( 91),KX( 92),KX( 93),KX( 94),KX( 95),KX( 96)/7,7,1,3,7,2/ DATA KY( 91),KY( 92),KY( 93),KY( 94),KY( 95),KY( 96)/7,0,7,7,0,7/ DATA KX( 97),KX( 98),KX( 99),KX(100),KX(101),KX(102)/2,7,1,3,7,6/ DATA KY( 97),KY( 98),KY( 99),KY(100),KY(101),KY(102)/0,0,0,0,0,0/ DATA KX(103),KX(104),KX(105),KX(106),KX(107),KX(108)/7,7,0,1,3,4/ DATA KY(103),KY(104),KY(105),KY(106),KY(107),KY(108)/7,0,1,0,0,1/ DATA KX(109),KX(110),KX(111),KX(112),KX(113),KX(114)/4,7,6,7,0,7/ DATA KY(109),KY(110),KY(111),KY(112),KY(113),KY(114)/7,0,0,7,7,0/ DATA KX(115),KX(116),KX(117),KX(118),KX(119),KX(120)/0,4,7,2,4,7/ DATA KY(115),KY(116),KY(117),KY(118),KY(119),KY(120)/3,7,0,5,0,0/ DATA KX(121),KX(122),KX(123),KX(124),KX(125),KX(126)/6,7,7,0,0,4/ DATA KY(121),KY(122),KY(123),KY(124),KY(125),KY(126)/0,7,0,7,0,0/ DATA KX(127),KX(128),KX(129),KX(130),KX(131),KX(132)/7,6,7,0,2,4/ DATA KY(127),KY(128),KY(129),KY(130),KY(131),KY(132)/0,0,7,7,3,7/ DATA KX(133),KX(134),KX(135),KX(136),KX(137),KX(138)/4,7,6,7,0,4/ DATA KY(133),KY(134),KY(135),KY(136),KY(137),KY(138)/0,0,0,7,7,0/ DATA KX(139),KX(140),KX(141),KX(142),KX(143),KX(144)/4,7,6,7,4,7/ DATA KY(139),KY(140),KY(141),KY(142),KY(143),KY(144)/7,0,0,7,7,0/ DATA KX(145),KX(146),KX(147),KX(148),KX(149),KX(150)/4,4,3,1,0,0/ DATA KY(145),KY(146),KY(147),KY(148),KY(149),KY(150)/1,6,7,7,6,1/ DATA KX(151),KX(152),KX(153),KX(154),KX(155),KX(156)/1,3,4,7,6,7/ DATA KY(151),KY(152),KY(153),KY(154),KY(155),KY(156)/0,0,1,0,0,7/ DATA KX(157),KX(158),KX(159),KX(160),KX(161),KX(162)/0,3,4,4,3,0/ DATA KY(157),KY(158),KY(159),KY(160),KY(161),KY(162)/7,7,6,5,4,4/ DATA KX(163),KX(164),KX(165),KX(166),KX(167),KX(168)/7,6,7,7,0,0/ DATA KY(163),KY(164),KY(165),KY(166),KY(167),KY(168)/0,0,7,0,1,6/ DATA KX(169),KX(170),KX(171),KX(172),KX(173),KX(174)/1,3,4,4,3,1/ DATA KY(169),KY(170),KY(171),KY(172),KY(173),KY(174)/7,7,6,1,0,0/ DATA KX(175),KX(176),KX(177),KX(178),KX(179),KX(180)/0,7,2,4,7,6/ DATA KY(175),KY(176),KY(177),KY(178),KY(179),KY(180)/1,0,2,0,0,0/ DATA KX(181),KX(182),KX(183),KX(184),KX(185),KX(186)/7,0,3,4,4,3/ DATA KY(181),KY(182),KY(183),KY(184),KY(185),KY(186)/7,7,7,6,5,4/ DATA KX(187),KX(188),KX(189),KX(190),KX(191),KX(192)/0,7,2,4,7,6/ DATA KY(187),KY(188),KY(189),KY(190),KY(191),KY(192)/4,0,4,0,0,0/ DATA KX(193),KX(194),KX(195),KX(196),KX(197),KX(198)/7,7,0,1,3,4/ DATA KY(193),KY(194),KY(195),KY(196),KY(197),KY(198)/7,0,1,0,0,1/ DATA KX(199),KX(200),KX(201),KX(202),KX(203),KX(204)/4,3,1,0,0,1/ DATA KY(199),KY(200),KY(201),KY(202),KY(203),KY(204)/3,4,4,5,6,7/ DATA KX(205),KX(206),KX(207),KX(208),KX(209),KX(210)/3,4,7,6,7,7/ DATA KY(205),KY(206),KY(207),KY(208),KY(209),KY(210)/7,6,0,0,7,0/ DATA KX(211),KX(212),KX(213),KX(214),KX(215),KX(216)/0,4,7,2,2,7/ DATA KY(211),KY(212),KY(213),KY(214),KY(215),KY(216)/7,7,0,7,0,0/ DATA KX(217),KX(218),KX(219),KX(220),KX(221),KX(222)/6,7,7,0,0,1/ DATA KY(217),KY(218),KY(219),KY(220),KY(221),KY(222)/0,7,0,7,1,0/ DATA KX(223),KX(224),KX(225),KX(226),KX(227),KX(228)/3,4,4,7,6,7/ DATA KY(223),KY(224),KY(225),KY(226),KY(227),KY(228)/0,1,7,0,0,7/ DATA KX(229),KX(230),KX(231),KX(232),KX(233),KX(234)/7,0,2,4,7,6/ DATA KY(229),KY(230),KY(231),KY(232),KY(233),KY(234)/0,7,0,7,0,0/ DATA KX(235),KX(236),KX(237),KX(238),KX(239),KX(240)/7,7,0,0,2,4/ DATA KY(235),KY(236),KY(237),KY(238),KY(239),KY(240)/7,0,7,0,4,0/ DATA KX(241),KX(242),KX(243),KX(244),KX(245),KX(246)/4,7,6,7,4,7/ DATA KY(241),KY(242),KY(243),KY(244),KY(245),KY(246)/7,0,0,7,7,0/ DATA KX(247),KX(248),KX(249),KX(250),KX(251),KX(252)/0,4,7,6,7,7/ DATA KY(247),KY(248),KY(249),KY(250),KY(251),KY(252)/7,0,0,0,7,0/ DATA KX(253),KX(254),KX(255),KX(256),KX(257),KX(258)/0,2,4,7,2,2/ DATA KY(253),KY(254),KY(255),KY(256),KY(257),KY(258)/7,4,7,0,4,0/ DATA KX(259),KX(260),KX(261),KX(262),KX(263),KX(264)/7,6,7,7,3,1/ DATA KY(259),KY(260),KY(261),KY(262),KY(263),KY(264)/0,0,7,0,4,4/ DATA KX(265),KX(266),KX(267),KX(268),KX(269),KX(270)/7,0,4,0,4,7/ DATA KY(265),KY(266),KY(267),KY(268),KY(269),KY(270)/0,7,7,0,0,0/ DATA KX(271),KX(272),KX(273),KX(274),KX(275),KX(276)/6,7,7,4,3,1/ DATA KY(271),KY(272),KY(273),KY(274),KY(275),KY(276)/0,7,0,1,0,0/ DATA KX(277),KX(278),KX(279),KX(280),KX(281),KX(282)/0,0,1,3,4,4/ DATA KY(277),KY(278),KY(279),KY(280),KY(281),KY(282)/1,6,7,7,6,1/ DATA KX(283),KX(284),KX(285),KX(286),KX(287),KX(288)/7,6,7,7,1,2/ DATA KY(283),KY(284),KY(285),KY(286),KY(287),KY(288)/0,0,7,0,6,7/ DATA KX(289),KX(290),KX(291),KX(292),KX(293),KX(294)/2,7,1,3,7,6/ DATA KY(289),KY(290),KY(291),KY(292),KY(293),KY(294)/0,0,0,0,0,0/ DATA KX(295),KX(296),KX(297),KX(298),KX(299),KX(300)/7,7,0,1,3,4/ DATA KY(295),KY(296),KY(297),KY(298),KY(299),KY(300)/7,0,6,7,7,6/ DATA KX(301),KX(302),KX(303),KX(304),KX(305),KX(306)/4,0,0,4,7,6/ DATA KY(301),KY(302),KY(303),KY(304),KY(305),KY(306)/5,1,0,0,0,0/ DATA KX(307),KX(308),KX(309),KX(310),KX(311),KX(312)/7,7,0,1,3,4/ DATA KY(307),KY(308),KY(309),KY(310),KY(311),KY(312)/7,0,6,7,7,6/ DATA KX(313),KX(314),KX(315),KX(316),KX(317),KX(318)/4,3,1,7,3,4/ DATA KY(313),KY(314),KY(315),KY(316),KY(317),KY(318)/5,4,4,0,4,3/ DATA KX(319),KX(320),KX(321),KX(322),KX(323),KX(324)/4,3,1,0,7,6/ DATA KY(319),KY(320),KY(321),KY(322),KY(323),KY(324)/1,0,0,1,0,0/ DATA KX(325),KX(326),KX(327),KX(328),KX(329),KX(330)/7,7,3,3,2,0/ DATA KY(325),KY(326),KY(327),KY(328),KY(329),KY(330)/7,0,0,7,7,4/ DATA KX(331),KX(332),KX(333),KX(334),KX(335),KX(336)/0,4,7,2,4,7/ DATA KY(331),KY(332),KY(333),KY(334),KY(335),KY(336)/3,3,0,0,0,0/ DATA KX(337),KX(338),KX(339),KX(340),KX(341),KX(342)/6,7,7,0,1,3/ DATA KY(337),KY(338),KY(339),KY(340),KY(341),KY(342)/0,7,0,1,0,0/ DATA KX(343),KX(344),KX(345),KX(346),KX(347),KX(348)/4,4,3,0,0,4/ DATA KY(343),KY(344),KY(345),KY(346),KY(347),KY(348)/1,3,4,4,7,7/ DATA KX(349),KX(350),KX(351),KX(352),KX(353),KX(354)/7,6,7,7,4,3/ DATA KY(349),KY(350),KY(351),KY(352),KY(353),KY(354)/0,0,7,0,6,7/ DATA KX(355),KX(356),KX(357),KX(358),KX(359),KX(360)/1,0,0,1,3,4/ DATA KY(355),KY(356),KY(357),KY(358),KY(359),KY(360)/7,6,1,0,0,1/ DATA KX(361),KX(362),KX(363),KX(364),KX(365),KX(366)/4,3,1,0,7,6/ DATA KY(361),KY(362),KY(363),KY(364),KY(365),KY(366)/3,4,4,3,0,0/ DATA KX(367),KX(368),KX(369),KX(370),KX(371),KX(372)/7,7,0,0,4,4/ DATA KY(367),KY(368),KY(369),KY(370),KY(371),KY(372)/7,0,6,7,7,6/ DATA KX(373),KX(374),KX(375),KX(376),KX(377),KX(378)/2,2,7,6,7,7/ DATA KY(373),KY(374),KY(375),KY(376),KY(377),KY(378)/1,0,0,0,7,0/ DATA KX(379),KX(380),KX(381),KX(382),KX(383),KX(384)/1,0,0,1,3,4/ DATA KY(379),KY(380),KY(381),KY(382),KY(383),KY(384)/4,5,6,7,7,6/ DATA KX(385),KX(386),KX(387),KX(388),KX(389),KX(390)/4,3,1,0,0,1/ DATA KY(385),KY(386),KY(387),KY(388),KY(389),KY(390)/5,4,4,3,1,0/ DATA KX(391),KX(392),KX(393),KX(394),KX(395),KX(396)/3,4,4,3,7,6/ DATA KY(391),KY(392),KY(393),KY(394),KY(395),KY(396)/0,1,3,4,0,0/ DATA KX(397),KX(398),KX(399),KX(400),KX(401),KX(402)/7,7,0,1,3,4/ DATA KY(397),KY(398),KY(399),KY(400),KY(401),KY(402)/7,0,1,0,0,1/ DATA KX(403),KX(404),KX(405),KX(406),KX(407),KX(408)/4,3,1,0,0,1/ DATA KY(403),KY(404),KY(405),KY(406),KY(407),KY(408)/6,7,7,6,4,3/ DATA KX(409),KX(410),KX(411),KX(412),KX(413),KX(414)/3,4,7,6,7,7/ DATA KY(409),KY(410),KY(411),KY(412),KY(413),KY(414)/3,4,0,0,7,0/ DATA KX(415),KX(416),KX(417),KX(418),KX(419),KX(420)/0,4,7,2,2,7/ DATA KY(415),KY(416),KY(417),KY(418),KY(419),KY(420)/3,3,0,5,1,0/ DATA KX(421),KX(422),KX(423),KX(424),KX(425),KX(426)/6,7,7,0,4,7/ DATA KY(421),KY(422),KY(423),KY(424),KY(425),KY(426)/0,7,0,3,3,0/ DATA KX(427),KX(428),KX(429),KX(430),KX(431),KX(432)/6,7,7,0,4,7/ DATA KY(427),KY(428),KY(429),KY(430),KY(431),KY(432)/0,7,0,1,5,0/ DATA KX(433),KX(434),KX(435),KX(436),KX(437),KX(438)/2,2,7,4,0,7/ DATA KY(433),KY(434),KY(435),KY(436),KY(437),KY(438)/5,1,0,3,3,0/ DATA KX(439),KX(440),KX(441),KX(442),KX(443),KX(444)/0,4,7,6,7,4/ DATA KY(439),KY(440),KY(441),KY(442),KY(443),KY(444)/5,1,0,0,7,7/ DATA KX(445),KX(446),KX(447),KX(448),KX(449),KX(450)/7,6,7,7,3,2/ DATA KY(445),KY(446),KY(447),KY(448),KY(449),KY(450)/0,0,7,1,7,6/ DATA KX(451),KX(452),KX(453),KX(454),KX(455),KX(456)/2,3,7,6,7,7/ DATA KY(451),KY(452),KY(453),KY(454),KY(455),KY(456)/1,0,0,0,7,0/ DATA KX(457),KX(458),KX(459),KX(460),KX(461),KX(462)/1,2,2,1,7,6/ DATA KY(457),KY(458),KY(459),KY(460),KY(461),KY(462)/7,6,1,0,0,0/ DATA KX(463),KX(464),KX(465),KX(466),KX(467),KX(468)/7,7,4,0,7,0/ DATA KY(463),KY(464),KY(465),KY(466),KY(467),KY(468)/7,0,5,5,0,2/ DATA KX(469),KX(470),KX(471),KX(472),KX(473),KX(474)/4,7,6,7,7,6/ DATA KY(469),KY(470),KY(471),KY(472),KY(473),KY(474)/2,0,0,7,0,0/ DATA KX(475),KX(476),KX(477),KX(478),KX(479),KX(480)/7,7,1,2,2,1/ DATA KY(475),KY(476),KY(477),KY(478),KY(479),KY(480)/7,0,0,1,2,2/ DATA KX(481),KX(482),KX(483),KX(484),KX(485),KX(486)/1,2,7,6,7,7/ DATA KY(481),KY(482),KY(483),KY(484),KY(485),KY(486)/1,1,0,0,7,0/ DATA KX(487),KX(488),KX(489),KX(490),KX(491),KX(492)/2,1,1,2,2,7/ DATA KY(487),KY(488),KY(489),KY(490),KY(491),KY(492)/0,0,1,1,0,0/ DATA KX(493),KX(494) /6,7 / DATA KY(493),KY(494) /0,7 / C C NSIZE IS THE LENGTH OF JCHAR AND INDEX. C LNGTH IS THE LENGTH OF KX AND KY. C LENTRY TELLS IF THIS IS THE FIRTST CALL TO PWRZS. C DATA NSIZE/46/ c Variable LNGTH never used. c DATA LNGTH/494/ DATA LENTRY/.FALSE./ DATA ITHETA/0/ DATA IDUM1,IDUM2,IDUM3/1,1,1/ C C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR C CALL Q8QST4 ('GRAPHX','PWRZS','PWRZS','VERSION 1') C C INQUIRE CURRENT NORMALIZATION TRANS NUMBER C CALL GQCNTN (IERR,NTORIG) C C SAVE NORMALIZATION TRANS 1 AND LOG SCALING FLAG C CALL GQNT (1,IERR,WNDW,VWPRT) CALL GETUSV('LS',IOLLS) C C DEFINE NORMALIZATION TRANS 1 FOR USE WITH DRAWS C c +NOAO: device viewport now user controlled through common noaovp call set (vpx1, vpx2, vpy1, vpy2, 1., 1024., 1., 1024., 1) c CALL SET(0.0,1.0,0.0,1.0,1.0,1024.0,1.0,1024.0,1) c-NOAO C C SEE IF THIS IS THE FIRST CALL TO PWRZS C IF (LENTRY) GO TO 103 C C MARK THAT FUTURE CALLS NEED NOT DO THIS CODE. C LENTRY = .TRUE. C C RECORD THE LOCATION OF THE BLANK SO IT CAN BE USED FOR UNKNOWN C CHARACTERS. C IBLKPT = INDEX(44) C C CHANGE EACH CHARACTER IN THE TABLE TO RIGHT JUSTIFIED, ZERO FILLED. C C C SORT JCHAR MAINTAINING THE RELATIONSHIP BETWEEN JCHAR AND INDEX. C (THAT IS, IF JCHAR(I)='B', THEN INDEX(I)=13 FROM THE ABOVE DATA STMT.) C THIS WILL ENABLE CHARACTERS TO BE QUICKLY FOUND IN ALL SUBSEQUENT C CALLS TO PWRZS. C CALL PWRZOS (JCHAR,INDEX,NSIZE) C C ALL ONE-TIME INITIALIZATION NOW FINISHED. C 103 CONTINUE C NN = N IF (NN .LE. 0) RETURN FNNM1 = NN-1 JCNT = ICNT C C PUT RELATIVE SIZE IN Q, ADJUST FOR CURRENT PLOTTER RESOLUTION C CALL GETUSV ('XF',LX) SCALE = 2.**(LX-10) IF (ISIZE .EQ. 0) Q = 1.3334*SCALE IF (ISIZE .EQ. 1) Q = 2.*SCALE IF (ISIZE .EQ. 2) Q = 2.6667*SCALE IF (ISIZE .EQ. 3) Q = 4.*SCALE IF (ISIZE .GT. 3) Q = FLOAT(ISIZE)/(6.) C C PUT ANGLE IN RADIANS IN T. C T = FLOAT(ITHETA)*1.5708 104 CONTINUE C C CALCULATE COMBINED TRANSFORMATION C CT = Q*COS(T) ST = Q*SIN(T) C C FIND CRT COORDINATES OF CENTER. C LINEI = LIN3 CALL INTZS (X,Y,Z,LINEI,ITOP) IF (LINEI .EQ. 0) RETURN IX = 0 IY = 0 XC = IX YC = IY C C CORRECT FOR CHARACTER DATA BEING LOWER-LEFT-HAND POSITIONED. C XC = XC-2.*CT+3.5*ST YC = YC-2.*ST-3.5*CT C C CORRECT FOR CENTERING IF TURNED ON. C JCNT = MAX0(-1,MIN0(1,JCNT))+2 GO TO (108,107,109),JCNT 107 XC = XC-CT*FNNM1*3. YC = YC-ST*FNNM1*3. GO TO 110 108 XC = XC+CT*2. YC = YC+ST*2. GO TO 110 109 XC = XC-CT*2. YC = YC-ST*2. XC = XC-CT*FNNM1*6. YC = YC-ST*FNNM1*6. 110 CALL INITZS (IFIX(XC),IFIX(YC),1,IDUM1,IDUM2,2) CALL INITZS (IFIX(XC+CT*6.*FNNM1),IFIX(YC+ST*6.*FNNM1),2,IDUM1, + IDUM2,2) CALL INITZS (IFIX(XC),IFIX(YC),IDUM1,IDUM2,IDUM3,3) DO 114 K=1,NN XB = XC YB = YC IP = 1 C C EXTRACT CHARACTER NUMBER K FROM THE STRING. C KCHAR = ID(K:K) C C FIND THE TABLE ENTRY. C CALL PWRZGS (KCHAR,JCHAR,INDEX,NSIZE,IPOINT) IF (IPOINT .EQ. -1) IPOINT = IBLKPT C C ALWAYS LESS THAN 20 INSTRUCTIONS. C DO 113 L=1,20 ISUB = IPOINT+L-1 NX = KX(ISUB) FNX = NX NY = KY(ISUB) FNY = NY C C TEST FOR OP-CODE OR DX AND DY. C IF (NX .NE. 7) GO TO 111 C C OP-CODE C IP = 0 IF (NY-7) 113,114,113 C C DX AND DY C 111 XC = XB+FNX*CT-FNY*ST YC = YB+FNX*ST+FNY*CT C C CALL DESIRED PLOTTING ROUTINE. DETERMINED BY OP-CODES. C IF (IP .NE. 0) GO TO 112 CALL INITZS (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,3) IP = 1 GO TO 113 112 CALL INITZS (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,4) 113 CONTINUE 114 CONTINUE C C FLUSH PLOTIT BUFFER C CALL PLOTIT(0,0,0) C C RESTORE NORMALIZATION TRANS 1 AND LOG SCALING C CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4), + WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS) CALL GSELNT (NTORIG) RETURN END SUBROUTINE INTZS (XX,YY,ZZ,LIN3,ITOP) C C FORCE STORAGE OF X, Y, AND Z INTO COMMON BLOCK C COMMON /PWRZ2S/ X, Y, Z DATA IDUMX,IDUMY,IDUMZ /0, 0, 0/ X = XX Y = YY Z = ZZ CALL INITZS (IDUMX,IDUMY,IDUMZ,LIN3,ITOP,1) RETURN END SUBROUTINE INITZS (IX,IY,IZ,LIN3,ITOP,IENT) C SAVE COMMON /PWRZ1S/ XXMIN ,XXMAX ,YYMIN ,YYMAX , + ZZMIN ,ZZMAX ,DELCRT,EYEX , + EYEY ,EYEZ C COMMON /PWRZ2S/ X ,Y ,Z c +NOAO: common block added to allow user control of device viewport. common /noaovp/ vpx1, vpx2, vpy1, vpy2 c -NOAO FX(R) = R+FACTX*FLOAT(IX) FY(R) = R+FACTY*FLOAT(IY) C C C DETERMINE INITZS,VISSET,FRSTZ OR VECTZ CALL C GO TO (1000,2000,3000,4000),IENT 1000 LIN = MAX0(1,MIN0(3,IABS(LIN3))) ITO = MAX0(1,MIN0(3,IABS(ITOP))) C C SET UP SCALING CONSTANTS C DELMAX = AMAX1(XXMAX-XXMIN,YYMAX-YYMIN,ZZMAX-ZZMIN) FACTOR = DELMAX/DELCRT FACTX = SIGN(FACTOR,FLOAT(LIN3)) FACTY = SIGN(FACTOR,FLOAT(ITOP)) C C SET UP FOR PROPER PLANE C JUMP1 = LIN+(ITO-1)*3 GO TO (108,101,102,103,108,104,105,106,108),JUMP1 101 ASSIGN 111 TO JUMP GO TO 107 102 ASSIGN 112 TO JUMP GO TO 107 103 ASSIGN 113 TO JUMP GO TO 107 104 ASSIGN 114 TO JUMP GO TO 107 105 ASSIGN 115 TO JUMP GO TO 107 106 ASSIGN 116 TO JUMP 107 RETURN 108 CALL SETER ('INITZS - LINE OR ITOP IMPROPER IN PWRZS CALL' ,1,1) LIN3 = 0 RETURN C C **************************** ENTRY VISSET **************************** C ENTRY VISSET (IX,IY,IZ) C C C VISSET IS CALLED ONCE FOR EACH END OF THE CHARACTER STRING C 2000 IVIS = -1 ITEMP = 0 GO TO 110 C C SEE IF THIS END COULD BE BEHIND THE OBJECT C 109 IF (EYEX.GT.XXMAX .AND. XX.GT.XXMAX) ITEMP = ITEMP+1 IF (EYEY.GT.YYMAX .AND. YY.GT.YYMAX) ITEMP = ITEMP+1 IF (EYEZ.GT.ZZMAX .AND. ZZ.GT.ZZMAX) ITEMP = ITEMP+1 IF (EYEX.LT.XXMIN .AND. XX.LT.XXMIN) ITEMP = ITEMP+1 IF (EYEY.LT.YYMIN .AND. YY.LT.YYMIN) ITEMP = ITEMP+1 IF (EYEZ.LT.ZZMIN .AND. ZZ.LT.ZZMIN) ITEMP = ITEMP+1 IF (IZ .EQ. 1) IVISS = ITEMP C C IF EITHER END CHARACTER COULD BE HIDDEN, TEST ALL LINE SEGMENTS. C IF (IZ .EQ. 2) IVIS = MIN0(IVISS,ITEMP) RETURN C C **************************** ENTRY FRSTZ ***************************** C ENTRY FRSTZ (IX,IY) C 3000 IFRST = 1 GO TO 110 C C **************************** ENTRY VECTZ ***************************** C ENTRY VECTZ (IX,IY) C 4000 IFRST = 0 C C PICK CORRECT 3-SPACE PLANE TO DRAW IN C 110 GO TO JUMP,(111,112,113,114,115,116) 111 XX = FY(X) YY = FX(Y) ZZ = Z GO TO 117 112 XX = FY(X) YY = Y ZZ = FX(Z) GO TO 117 113 XX = FX(X) YY = FY(Y) ZZ = Z GO TO 117 114 XX = X YY = FY(Y) ZZ = FX(Z) GO TO 117 115 XX = FX(X) YY = Y ZZ = FY(Z) GO TO 117 116 XX = X YY = FX(Y) ZZ = FY(Z) C C TRANSLATE TO 2-SPACE C 117 CALL TRN32S (XX,YY,ZZ,XT,YT,DUMMY,1) IF (IVIS) 109,121,118 118 IF (IFRST) 119,120,119 C C IF IN FRONT, DRAW IN ANY CASE. C c +NOAO: Remove the assumption that window coordinates 1-1024 map to the c full plotter metacode range 1-32768 c 119 zzxmc = (32768./1023.) * (vpx2 - vpx1) * (xt-1.) + (vpx1 * 32768.) zzymc = (32768./1023.) * (vpy2 - vpy1) * (yt-1.) + (vpy1 * 32768.) call plotit (ifix(zzxmc), ifix(zzymc), 0) c 119 CALL PLOTIT (32*IFIX(XT),32*IFIX(YT),0) RETURN c 120 zzxmc = (32768./1023.) * (vpx2 - vpx1) * (xt-1.) + (vpx1 * 32768.) zzymc = (32768./1023.) * (vpy2 - vpy1) * (yt-1.) + (vpy1 * 32768.) call plotit (ifix(zzxmc), ifix(zzymc), 1) c 120 CALL PLOTIT (32*IFIX(XT),32*IFIX(YT),1) c -NOAO RETURN 121 IF (IFRST) 122,123,122 122 IX1 = XT IY1 = YT RETURN 123 IX2 = XT IY2 = YT C C IF COULD BE HIDDEN, USE HIDDEN LINE PLOTTING ENTRY IN SRFACE C CALL DRAWS (IX1,IY1,IX2,IY2,1,0) IX1 = IX2 IY1 = IY2 RETURN END SUBROUTINE PWRZOS (JCHAR,INDEX,NSIZE) C C THIS ROUTINE SORTS JCHAR WHICH IS NSIZE IN LENGTH. THE RELATIONSHIP C BETWEEN JCHAR AND INDEX IS MAINTAINED. A BUBBLE SORT IS USED. C JCHAR IS SORTED IN ASCENDING ORDER. C SAVE CHARACTER*1 JCHAR(NSIZE) ,JTEMP ,KTEMP DIMENSION INDEX(NSIZE) LOGICAL LDONE C ISTART = 1 ISTOP = NSIZE ISTEP = 1 C C AT MOST NSIZE PASSES ARE NEEDED. C DO 104 NPASS=1,NSIZE LDONE = .TRUE. I = ISTART 101 ISUB = I+ISTEP IF (ISTEP*(ICHAR(JCHAR(I))-ICHAR(JCHAR(ISUB)))) 103,103,102 C C THEY NEED TO BE SWITCHED. C 102 LDONE = .FALSE. JTEMP = JCHAR(I) KTEMP = JCHAR(ISUB) JCHAR(I) = KTEMP JCHAR(ISUB) = JTEMP ITEMP = INDEX(I) INDEX(I) = INDEX(ISUB) INDEX(ISUB) = ITEMP C C THEY DO NOT NEED TO BE SWITCHED. C 103 I = I+ISTEP IF (I .NE. ISTOP) GO TO 101 C C IF NONE WERE SWITCHED DURING THIS PASS, WE CAN QUIT. C IF (LDONE) RETURN C C SET UP FOR THE NEXT PASS IN THE OTHER DIRECTION. C ISTEP = -ISTEP ITEMP = ISTART ISTART = ISTOP+ISTEP ISTOP = ITEMP 104 CONTINUE RETURN END SUBROUTINE PWRZGS (KCHAR,JCHAR,INDEX,NSIZE,IPOINT) C C THIS ROUTINE FINDS WHERE KCHAR IS IN JCHAR AND RETURNS THE CORRES- C PONDING INDEX IN IPOINT. BINARY HALVING IS USED. C SAVE CHARACTER*1 JCHAR(NSIZE) ,KCHAR DIMENSION INDEX(NSIZE) C C IT IS ASSUMED THAT JCHAR IS LESS THAT 2**9 IN LENGTH, SO IF KCHAR IS C NOT FOUND IN 10 STEPS, THE SEARCH IS STOPPED. C KOUNT = 0 IBOT = 1 ITOP = NSIZE I = ITOP GO TO 102 101 I = (IBOT+ITOP)/2 KOUNT = KOUNT+1 IF (KOUNT .GT. 10) GO TO 106 102 IF (ICHAR(JCHAR(I))-ICHAR(KCHAR)) 103,105,104 103 IBOT = I GO TO 101 104 ITOP = I GO TO 101 105 IPOINT = INDEX(I) RETURN C C IPOINT=-1 MEANS THAT KCHAR WAS NOT IN THE TABLE. C 106 IPOINT = -1 RETURN C C C C REVISION HISTORY---------- C C MARCH 1980 FIRST ADDED TO ULIB AS A SEPARATE FILE TO BE C USED IN CONJUNCTION WITH THE ULIB ROUTINE C SRFACE C C JULY 1984 CONVERTED TO GKS AND FORTRAN 77 C------------------------------------------------------------------ END