home *** CD-ROM | disk | FTP | other *** search
/ gondwana.ecr.mu.oz.au/pub/ / Graphics.tar / Graphics / VOGLE.ZIP / VOGLE / SRC / MSFORT / FORT.FOR < prev    next >
Encoding:
Text File  |  2000-02-11  |  8.5 KB  |  389 lines
  1. c
  2. c  Fortran Test of Microsoft C interfaces
  3. c
  4.       program fort
  5.       character *100 s
  6.       real a(4, 4)
  7.       real w(4, 4)
  8.       real b(3, 4)
  9.       real c(3, 6)
  10.       real d(2, 6)
  11.       
  12.       integer getkey, locator, slocator, genobj, getopenobj, getstring
  13.       integer backbuffer, getdepth
  14.       logical isobj
  15.  
  16.       data a/0.0, 1.0, 2.0, 3.0,
  17.      +       4.0, 5.0, 6.0, 7.0,
  18.      +       8.0, 9.0, 10.0, 11.0,
  19.      +       12.0, 13.0, 14.0, 15.0/
  20.  
  21.       data b/100.0, 200.0, 300.0,
  22.      +       400.0, 500.0, 600.0,
  23.      +       700.0, 800.0, 900.0,
  24.      +       1000.0, 1100.0, 1200.0/
  25.  
  26.       data c/50.0, 60.0, 70.0,
  27.      +       80.0, 90.0, 100.0,
  28.      +       110.0, 120.0, 130.0, 
  29.      +       140.0, 150.0, 160.0,
  30.      +       170.0, 180.0, 190.0,
  31.      +       200.0, 210.0, 220.0/
  32.  
  33.  
  34.       data d/50.0, 60.00,
  35.      +       80.0, 90.0,
  36.      +       110.0, 120.0, 
  37.      +       140.0, 150.0,
  38.      +       170.0, 180.0,
  39.      +       200.0, 210.0/
  40.  
  41.     data s/'A Sample String'/
  42.  
  43.     print*,'Calling vinit'
  44.     call vinit(s)
  45.  
  46.     print*,'Calling vexit'
  47.     call vexit
  48.  
  49.     print*,'Calling voutput'
  50.     call voutput(s)
  51.  
  52.     print*,'Calling vnewdev'
  53.     call vnewdev(s)
  54.  
  55.     print*,'Calling vgetdev'
  56.     call vgetdev(s)
  57.     print*,'vgetdev returns: ', s
  58.  
  59.     print*,'Calling clear'
  60.     call clear
  61.  
  62.     print*,'Calling color(7)'
  63.     call color(7)
  64.  
  65.     print*,'Calling mapcolor(1, 2, 3, 4)'
  66.     call mapcolor(1, 2, 3, 4)
  67.  
  68.     print*,'Calling clipping(.true.)'
  69.     call clipping(.true.)
  70.  
  71.     print*,'calling getkey()'
  72.     print*,'getkey returns: ',getkey()
  73.  
  74.     print*,'calling getdepth()'
  75.     print*,'getdepth returns: ',getdepth()
  76.  
  77.     print*,'calling locator()'
  78.     print*,'locator returns: ',locator(x, y), x, y
  79.  
  80.     print*,'calling slocator()'
  81.     print*,'slocator returns: ',slocator(x, y), x, y
  82.  
  83.     print*,'Calling viewport(10.0, 11.0, 12.0, 13.0)'
  84.     call viewport(10.0, 11.0, 12.0, 13.0)
  85.  
  86.     print*,'Calling getviewport(a1, a2, a3, a4)'
  87.     call getviewport(a1, a2, a3, a4)
  88.     print*,'getviewport returns: ', a1, a2, a3, a4
  89.  
  90.     print*,'Calling pushviewport'
  91.     call pushviewport
  92.  
  93.     print*,'Calling popviewport'
  94.     call popviewport
  95.  
  96.     print*,'Calling pushattributes'
  97.     call pushattributes
  98.  
  99.     print*,'Calling popattributes'
  100.     call popattributes
  101.  
  102.     print*,'Calling ortho(20.0, 30.0, 40.0, 50.0, 60.0, 70.0)'
  103.     call ortho(20.0, 30.0, 40.0, 50.0, 60.0, 70.0)
  104.  
  105.     print*,'Calling ortho2(40.0, 50.0, 60.0, 70.0)'
  106.     call ortho2(40.0, 50.0, 60.0, 70.0)
  107.  
  108.     print*,'Calling perspective(140.0, 150.0, 160.0, 170.0)'
  109.     call perspective(140.0, 150.0, 160.0, 170.0)
  110.  
  111.     print*,'Calling window(20.0, 30.0, 40.0, 50.0, 60.0, 70.0)'
  112.     call window(20.0, 30.0, 40.0, 50.0, 60.0, 70.0)
  113.  
  114.     print*,'Calling pushmatrix'
  115.     call pushmatrix
  116.  
  117.     print*,'Calling popmatrix'
  118.     call popmatrix
  119.  
  120.     print*,'Calling polarview(240.0, 250.0, 260.0, 270.0)'
  121.     call polarview(240.0, 250.0, 260.0, 270.0)
  122.  
  123.     print*,'Calling lookat(20.0, 30.0, 40.0, 50.0, 60.0, 70.0, 80.0)'
  124.     call lookat(20.0, 30.0, 40.0, 50.0, 60.0, 70.0, 80.0)
  125.  
  126.     print*,'Calling move(23.0, 24.0, 25.0)'
  127.     call move(23.0, 24.0, 25.0)
  128.  
  129.     print*,'Calling rmove(230.0, 240.0, 250.0)'
  130.     call rmove(230.0, 240.0, 250.0)
  131.  
  132.     print*,'Calling move2(240.0, 250.0)'
  133.     call move2(240.0, 250.0)
  134.  
  135.     print*,'Calling rmove2(40.0, 50.0)'
  136.     call rmove2(40.0, 50.0)
  137.  
  138.     print*,'Calling smove2(540.0, 550.0)'
  139.     call smove2(540.0, 550.0)
  140.  
  141.     print*,'Calling rsmove2(1540.0, 1550.0)'
  142.     call rsmove2(1540.0, 1550.0)
  143.  
  144.     print*,'Calling draw(23.0, 24.0, 25.0)'
  145.     call draw(23.0, 24.0, 25.0)
  146.  
  147.     print*,'Calling rdraw(230.0, 240.0, 250.0)'
  148.     call rdraw(230.0, 240.0, 250.0)
  149.  
  150.     print*,'Calling draw2(240.0, 250.0)'
  151.     call draw2(240.0, 250.0)
  152.  
  153.     print*,'Calling rdraw2(40.0, 50.0)'
  154.     call rdraw2(40.0, 50.0)
  155.  
  156.     print*,'Calling sdraw2(540.0, 550.0)'
  157.     call sdraw2(540.0, 550.0)
  158.  
  159.     print*,'Calling rsdraw2(1540.0, 1550.0)'
  160.     call rsdraw2(1540.0, 1550.0)
  161.  
  162.     print*,'Calling arcprecision(44)'
  163.     call arcprecision(44)
  164.  
  165.     print*,'Calling arc(1.0, 2.0, 3.0, 4.0, 5.0)'
  166.     call arc(1.0, 2.0, 3.0, 4.0, 5.0)
  167.  
  168.     print*,'Calling sector(11.0, 12.0, 13.0, 14.0, 15.0)'
  169.     call sector(11.0, 12.0, 13.0, 14.0, 15.0)
  170.  
  171.     print*,'Calling circle(11.0, 12.0, 13.0)'
  172.     call circle(11.0, 12.0, 13.0)
  173.  
  174.     print*,'Calling curvebasis(a)'
  175.     call prinm(4, 4, a)
  176.     call curvebasis(a)
  177.  
  178.     print*,'Calling curveprecision(45)'
  179.     call curveprecision(45)
  180.  
  181.     print*,'Calling rcurve(a)'
  182.     call prinm(4, 4, a)
  183.     call rcurve(a)
  184.     
  185.     print*,'Calling curve(b)'
  186.     call prinm(3, 4, b)
  187.     call curve(b)
  188.     
  189.     print*,'Calling curven(6, c)'
  190.     call prinm(3, 6, c)
  191.     call curven(6, c)
  192.     
  193.     print*,'Calling rect(10.0, 11.0, 12.0, 13.0)'
  194.     call rect(10.0, 11.0, 12.0, 13.0)
  195.  
  196.     print*,'Calling polyfill(.false.)'
  197.     call polyfill(.false.)
  198.  
  199.     print*,'Calling polyhatch(.true.)'
  200.     call polyhatch(.true.)
  201.  
  202.     print*,'Calling hatchang(45.0)'
  203.     call hatchang(45.0)
  204.  
  205.     print*,'Calling hatchpitch(5.0)'
  206.     call hatchpitch(5.0)
  207.  
  208.     print*,'Calling poly(6, c)'
  209.     call prinm(3, 6, c)
  210.     call poly(6, c)
  211.  
  212.     print*,'Calling poly2(6, d)'
  213.     call prinm(2, 6, d)
  214.     call poly2(6, c)
  215.  
  216.     print*,'Calling makepoly()'
  217.        call makepoly
  218.     
  219.     print*,'Calling closepoly()'
  220.        call closepoly
  221.  
  222.     print*,'Calling font(s)'
  223.     call font(s)
  224.  
  225.     print*,'Calling numchars()'
  226.     print*,'Numchars returns: ', numchars()
  227.  
  228.     print*,'Calling textsize(3.0, 4.5)'
  229.     call textsize(3.0, 4.5)
  230.  
  231.     print*,'Calling textang(33.3)'
  232.     call textang(33.3)
  233.  
  234.     print*,'Calling fixedwidth(2)'
  235.     call fixedwidth(2)
  236.  
  237.     print*,'Calling centertext(2)'
  238.     call centertext(2)
  239.  
  240.     print*,'Calling getcharsize(''A'', x, y)'
  241.     call getcharsize('A', x, y)
  242.     print*,'x = ', x, ' y = ',y
  243.  
  244.     print*,'Calling getfontsize(x, y)'
  245.     call getfontsize(x, y)
  246.     print*,'x = ', x, ' y = ',y
  247.  
  248.     print*,'Calling drawchar(''K'')'
  249.     call drawchar('K')
  250.  
  251.     print*,'Calling drawstr(''Hello'')'
  252.     call drawstr('Hello')
  253.  
  254.     print*,'Calling strlength(s)'
  255.     print*,'strlength returns: ',strlength(s)
  256.  
  257.     print*,'Calling boxtext(1.0, 2.0, 3.0, 4.0, s)'
  258.     call boxtext(1.0, 2.0, 3.0, 4.0, s)
  259.  
  260.     print*,'Calling boxfit(22.3, 44.5, 11)'
  261.     call boxfit(22.3, 44.5, 11)
  262.  
  263.     print*,'Calling translate(0.5, 0.6, 0.7)'
  264.     call translate(0.5, 0.6, 0.7)
  265.  
  266.     print*,'Calling scale(0.5, 0.6, 0.7)'
  267.     call scale(0.5, 0.6, 0.7)
  268.  
  269.     print*,'Calling rotate(22.4, ''x'')'
  270.     call rotate(22.4, 'x')
  271.  
  272.     print*,'Calling patchbasis(a, a)'
  273.     call prinm(4, 4, a)
  274.     call patchbasis(a, a)
  275.  
  276.     print*,'calling patchprecision(34, 45)'
  277.     call patchprecision(34, 45)
  278.  
  279.     print*,'calling patchcurves(134, 415)'
  280.     call patchcurves(134, 415)
  281.  
  282.     print*,'calling rpatch(a, a, a, a)'
  283.     call rpatch(a, a, a, a)
  284.  
  285.     print*,'calling patch(a, a, a)'
  286.     call patch(a, a, a)
  287.  
  288.     print*,'calling point(500.0, 600.0, 700.0)'
  289.     call point(500.0, 600.0, 700.0)
  290.  
  291.     print*,'calling point2(500.0, 600.0)'
  292.     call point2(500.0, 600.0)
  293.  
  294.     print*,'Calling makeobj(3)'
  295.     call makeobj(3)
  296.  
  297.     print*,'Calling closeobj()'
  298.     call closeobj
  299.  
  300.     print*,'Calling genobj()'
  301.     print*,'genobj returns: ', genobj()
  302.  
  303.     print*,'calling getopenobj()'
  304.     print*,'getopenobj returns: ', getopenobj()
  305.     
  306.     print*,'Calling callobj(23)'
  307.     call callobj(23)
  308.  
  309.     print*,'calling isobj(5)'
  310.     print*,'isobj returns: ',isobj(5)
  311.  
  312.     print*,'Calling loadobj(8, s)'
  313.     call loadobj(8, s)
  314.  
  315.     print*,'Calling saveobj(9, s)'
  316.     call saveobj(9, s)
  317.  
  318.     print*,'Calling getgp(x, y, z)'
  319.     call getgp(x, y, z)
  320.     print*,'x = ', x, ' y = ', y, ' z = ', z
  321.  
  322.     print*,'Calling getgp2(x, y)'
  323.     call getgp2(x, y)
  324.     print*,'x = ', x, ' y = ', y
  325.  
  326.     print*,'Calling sgetgp2(x, y)'
  327.     call sgetgp2(x, y)
  328.     print*,'x = ', x, ' y = ', y
  329.  
  330.     print*,'Calling getmatrix(w)'
  331.     call getmatrix(w)
  332.     call prinm(4, 4, w)
  333.  
  334.     print*,'Calling multmatrix(a)'
  335.     call multmatrix(a)
  336.  
  337.     print*,'Calling loadmatrix(a)'
  338.     call loadmatrix(a)
  339.  
  340.     print*,'Calling getstring(3, s)'
  341.     print*,'getstring(3, s) returns: ',
  342.      +  getstring(3, s), s
  343.  
  344.     print*,'Calling getaspect()'
  345.     print*,'getaspect returns: ',
  346.      +  getaspect()
  347.  
  348.     print*,'Calling getfactors(x, y)'
  349.     call getfactors(x, y)
  350.     print*,'getfactors returns: ',x, y
  351.  
  352.     print*,'Calling getdisplaysize(x, y)'
  353.     call getdisplaysize(x, y)
  354.     print*,'getdisplaysize returns: ',x, y
  355.  
  356.     print*,'Calling backbuffer: ', backbuffer()
  357.  
  358.     print*,'Calling frontbuffer'
  359.     call frontbuffer
  360.  
  361.     print*,'Calling swapbuffers'
  362.     call swapbuffers
  363.  
  364.     print*, 'Calling up(1.3, 2.3, 3.3)'
  365.     call up(1.3, 2.3, 3.3)
  366.  
  367.     print*,'Calling prefsize(200, 200)'
  368.     call prefsize(200, 200)
  369.  
  370.     print*,'Calling prefposition(20, 30)'
  371.     call prefposition(20, 30)
  372.  
  373.     print*,'Calling backface(.true.)'
  374.     call backface(.true.)
  375.  
  376.     print*,'Calling backfacedir(1)'
  377.     call backfacedir(1)
  378.     
  379.     
  380.     end
  381.  
  382.     subroutine prinm(n, m, a)
  383.         real a(n, m)
  384.         do 10 i = 1, n
  385.         print*,(a(i,j), j = 1, m)
  386. 10      continue
  387.         end
  388.  
  389.