c    Program to demonstrate video graphics functions
c      using NDP Fortran-386 graphics extension library
c
c      MicroWay, Inc.
c      P.O. Box 79
c      Kingston, MA 02364
c      (508) 746-7341
c
c    graphic functions must be declared with the appropriate type
      include 'grex.fh'
c
c    all graphics functions return an integer value
      integer ier
c
c    declare type of a function defined in this file
      integer actual_length
c
c    indices for iterations
      integer i,j,k
c
c    video modes (a) suggested by GREX and (b) supplied by user
      integer mode,new_mode
c
c    limits of the current video device
      integer limx,limy,max_color
c
c    clip limits (initially equal to device limits)
      integer xmin,xmax,ymin,ymax
c
c    codes for hardware present in the computer
      integer video_system(4)
c
c    string for writing graphic text to screen
      character*64 string
c
c    print banner to user
      write(6,*)
      write(6,*) 'NDP Fortran-386 Graphics Extension test program'
      write(6,*)
      write(6,*) '    MicroWay, Inc.'
      write(6,*) '    P.O. Box 79'
      write(6,*) '    Kingston, MA 02364'
      write(6,*) '    (508) 746-7341'
      write(6,*)
c
c    While the user enters more video modes
c
c         get information about hardware configuration and suggested mode
           mode = video_configuration(video_system)
c
c         show user the video configuration
    1      write(6,201) ' Video system codes:',(video_system(i),i=1,4)
  201      format(a,4i4)
           write(6,201) ' Suggested graphic mode:',mode
c
c         show hardware configuration in words
           write(6,*)
           write(6,*) 'Available video systems: '
           call show_video_systems
c
c         try whatever mode the user enters
           write(6,*)
    2      write(6,101) ' Enter video mode desired '
           write(6,101) ' (press <Enter> to quit): '
  101      format(a,$)
           read(5,100) string
  100      format(a)
           L = actual_length(string)
           if(L.le.0) go to 86
           read(string,300,err=2) new_mode
  300      format(bn,i8)
c
c         try to enter the requested mode
           if (new_mode.gt.0) ier = graphics_mode(new_mode)
           if (new_mode.eq.0) go to 86
           if (new_mode.lt.0) then
                write(*,101) ' If other than 800 horizontal pixels, '
                write(*,101) ' enter horizontal pixel count: '
                read(5,100) string
                L = actual_length (string)
                if (L.le.0) then
                     limx = 800
                   else
                     read(string,300,err=2) limx
                   endif
                write(*,101) ' If other than 600 vertical pixels, '
                write(*,101) ' enter vertical pixel count: '
                read(5,100) string
                L = actual_length (string)
                if (L.le.0) then
                     limy = 600
                   else
                     read(string,300,err=2) limy
                   endif
                new_mode = super_vga(-new_mode,limx,limy)
                ier = new_mode
              endif
c
c         if unsuccessful, get another mode code from user
           if(ier.eq.0) go to 2
c
c         if successful, get device limits for future use
           ier = get_device_limits(limx,limy,max_color)
c
c         Run tests
           call test1
           call test2
           call test3
           call test4
           call test5
           call test6
           call test7
           call test8
           call test9
           call test10
           call test11
           call test12
           call test13
           call test14
           call test15
c
c         clear the screen
           ier = clear()
c
c         and return to text mode.  Parentheses are not optional here.
           ier = text_mode()
c
      go to 1
c    End-while
c
   86 stop 'Okay.'
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test1
      include 'grex.fh'
      integer new_mode,limx,limy,max_color
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 1: setting pixels
c
c    Clear the screen.  Parentheses are not optional.
      ier = clear()
c
c    use color 6 (brown or yellow, depending on contrast setting)
      ier = set_color(6)

c    repeatedly set pixels on a diagonal line
      do 10 i=1,51
           j = 100 + i-1
           k = j
           ier = set_pixel(j,k)
   10 continue
c
c    label screen
      ier = graphic_text('Test 1: setting pixels',10,limy-20,14)
c
c    prompt the user for a key
      ier = graphic_text('Press a key to continue',10,limy-10,14)
c
c    wait for a keystroke from user
      ier = pause()
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test2
      include 'grex.fh'
      integer limx,limy,max_color
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 2: drawing lines
c
c    use color 1 (blue)
      ier = set_color(1)
c
c    draw a box
      ier = move(100,100)
      ier = draw(150,100)
      ier = draw(150,150)
      ier = draw(100,150)
      ier = draw(100,100)
c
c    double the box border
      ier = move(101,101)
      ier = draw(149,101)
      ier = draw(149,149)
      ier = draw(101,149)
      ier = draw(101,101)
c
c    use color 4 (red)
      ier = set_color(4)
c
c    draw a box around the blue box
      ier = move( 99, 99)
      ier = draw(151, 99)
      ier = draw(151,151)
      ier = draw( 99,151)
      ier = draw( 99, 99)
c
c    double this box's border also
      ier = move( 98, 98)
      ier = draw(152, 98)
      ier = draw(152,152)
      ier = draw( 98,152)
      ier = draw( 98, 98)
c
c    clear text
      ier = set_color(0)
      ier = filled_rectangle(0,limy-20,limx,limy)
c
c    label screen
      ier = graphic_text('Test 2: drawing lines',10,limy-20,14)
c
c    prompt the user for a key
      ier = graphic_text('Press a key to continue',10,limy-10,14)
c
c    get another keystroke from the user
      ier = pause()
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test3
      include 'grex.fh'
      integer ix,iy,ih,iv,ier
      integer new_mode,limx,limy,max_color
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 3: circles
c
c    calculate parameters of a circle
      ix = 240
      iy = 100
      ih = 30 * aspect_ratio(new_mode)/100
      iv = 30
c
c    use color 2 (green)
      ier = set_color(2)
c
c    draw a circle
      ier = open_ellipse(ix,iy,ih,iv)
c
c    draw a filled circle nearby
      ix = ix + 2*ih
      iy = iy + iv
      ier = filled_ellipse (ix,iy,ih,iv)
c
c    clear text
      ier = set_color(0)
      ier = filled_rectangle(0,limy-20,limx,limy)
c
c    label screen
      ier = graphic_text('Test 3: circles',10,limy-20,14)
c
c    prompt the user for a key
      ier = graphic_text('Press a key to continue',10,limy-10,14)
c
c    get a key from the user
      ier = pause()
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test4
      include 'grex.fh'
      integer new_mode,limx,limy,max_color
      character buffer (4096)
      character text_buffer (4096)
      integer ix,iy,jx,jy,ier
      character*64 string
      integer L,actual_length

      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 4: saving and restoring windows
c
c    clear text
      ier = set_color(0)
      ier = filled_rectangle(0,limy-30,limx,limy)
c
c    label screen
      string = 'Test 4: Saving and restoring windows'
      ier = graphic_text(string,10,limy-30,14)
c
c    copy the box to the left of it
      ier = save_window(98,98,152,152,buffer)
      ier = restore_window(38,98,92,152,buffer)
c
c    get a key from the user
      ier = pause()
c
c    save a window in the middle of these boxes
      string = 'Saved window; press a key to restore'
      L = actual_length(string)
      ix = 19
      iy = 120
      jx = 25+8*L
      jy = 131
      ier = save_window(ix,iy,jx,jy,buffer)
      ier = set_color(0)
      ier = filled_rectangle(ix,iy,jx,jy)
      ier = set_color(11)
      ier = move(ix,iy)
      ier = draw(jx,iy)
      ier = draw(jx,jy)
      ier = draw(ix,jy)
      ier = draw(ix,iy)
      ier = graphic_text(string,ix+5,iy+2,11)
      ier = pause()
      ier = restore_window(ix,iy,jx,jy,buffer)

      string = 'Move window using arrow keys'
      ier = graphic_text (string, 10, limy-20, 14)
      string = 'Press <Enter> to begin the next test'
      ier = graphic_text (string, 10, limy-10, 14)

      string = 'Text window'
      L = actual_length (string)
      ix = 16
      iy = 120
      jx = 25+8*L
      jy = 131
      ier = save_window (ix, iy, jx, jy, buffer)
      ier = set_color (0)
      ier = filled_rectangle (ix, iy, jx, jy)
      ier = set_color (11)
      ier = move (ix,iy)
      ier = draw (jx,iy)
      ier = draw (jx,jy)
      ier = draw (ix,jy)
      ier = draw (ix,iy)
      ier = graphic_text (string, ix+5, iy+2, 11)
c
c    keep the text window in a buffer
      ier = save_window (ix, iy, jx, jy, text_buffer)

   20 key = pause()
      if (key.ne.13) then
c
c         restore the previous screen
           ier = restore_window (ix, iy, jx, jy, buffer)
c
c         adjust coordinates according to the key
           if (key.eq.-71) then
                ix = ix - 8
                iy = iy - 2
                jx = jx - 8
                jy = jy - 2
              endif
           if (key.eq.-72) then
                iy = iy - 2
                jy = jy - 2
              endif
           if (key.eq.-73) then
                ix = ix + 8
                iy = iy - 2
                jx = jx + 8
                jy = jy - 2
              endif
           if (key.eq.-75) then
                ix = ix - 8
                jx = jx - 8
              endif
           if (key.eq.-77) then
                ix = ix + 8
                jx = jx + 8
              endif
           if (key.eq.-79) then
                ix = ix - 8
                iy = iy + 2
                jx = jx - 8
                jy = jy + 2
              endif
           if (key.eq.-80) then
                iy = iy + 2
                jy = jy + 2
              endif
           if (key.eq.-81) then
                ix = ix + 8
                iy = iy + 2
                jx = jx + 8
                jy = jy + 2
              endif
c
c         don't let the text window go off the screen
           if (ix.lt.0) then
                ix = ix + 8
                jx = jx + 8
              endif
           if (iy.lt.0) then
                iy = iy + 2
                jy = jy + 2
              endif
           if (jx.gt.limx) then
                ix = ix - 8
                jx = jx - 8
              endif
           if (jy.gt.limy) then
                iy = iy - 2
                jy = jy - 2
              endif
c
c         save the screen region and emplace the text window
           ier = save_window (ix, iy, jx, jy, buffer)
           ier = restore_window (ix, iy, jx, jy, text_buffer)

           go to 20
         endif

      ier = restore_window (ix, iy, jx, jy, buffer)
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test5
      include 'grex.fh'
      integer i,j,ix,iy,ier
      integer new_mode,limx,limy,max_color
      character q,crawl
      character*64 string
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 5: cursor movement and region fill
c
c    erase the previous prompt using a black bar
      call set_color(0)
      call filled_rectangle(10,limy-30,limx,limy)
c
c    put up a new prompt
      string = 'Test 5: cursor movement and region fill'
      ier = graphic_text(string,10,limy-30,14)
      string = 'Move cursor using arrow keys'
      ier = graphic_text(string,10,limy-20,14)
      string = 'Press R to fill red, G = green, B = blue'
      ier = graphic_text(string,10,limy-10,14)
c
c    start the cursor in the center of the open green circle
      ix = 240
      iy = 100
      i = ix
      j = iy
c
c    allow the user to move the cursor around with the keyboard.
c      arrow keys move one step in the indicated direction
c      <Home>, <End>, <PgUp>, and <PgDn> move one step in each of two directions
c      <Ins> increases the size of the step by one pixel (up to 100 pixels)
c      <Del> decreases the size of the step by one pixel (down to 1 pixel)
c     return control here when user presses a key with an ASCII code
   35 q = crawl(i,j)
c
c    if the key was 'r', then begin a red fill at the cursor position
      if(q.eq.'r'.or.q.eq.'R') then
           ier = flood_fill(i,j,4,4)
           go to 35
         endif
c
c    if the key was 'g' then begin a green fill at the cursor position
      if(q.eq.'g'.or.q.eq.'G') then
           ier = flood_fill(i,j,2,2)
           go to 35
         endif
c
c    if the key was 'b' then begin a blue fill at the cursor position
      if(q.eq.'b'.or.q.eq.'B') then
           ier = flood_fill(i,j,1,1)
           go to 35
         endif
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test6
      include 'grex.fh'
      integer ier,i,j
      integer xmin,ymin,xmax,ymax
      integer new_mode,limx,limy,max_color
      character q,crawl
      character*64 string
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 6: cursor movement in a clipping window
c
c    erase the previous prompt
      ier = set_color(0)
      ier = filled_rectangle(10,limy-30,limx,limy)

c    label the next display
      string = 'Test 6: Clipping window (Quarter-screen, centered)'
      ier = graphic_text(string,10,limy-30,14)
      string = 'Move cursor using arrow keys'
      ier = graphic_text(string,10,limy-20,14)
      string = 'Press any key to continue'
      ier = graphic_text(string,10,limy-10,14)
c
c    clip outside a window one fourth the size of the screen
c      centered in the middle
      ier = set_clip_limits(limx/4,limy/4,3*limx/4,3*limy/4)
c
c    put the cursor in the middle of the clip window
      ier = get_clip_limits(xmin,ymin,xmax,ymax)
      i = (xmin + xmax)/2
      j = (ymin + ymax)/2
c
c    and move the cursor until an ASCII key is hit
      q = crawl(i,j)
c
c    to deactivate clipping, set the clip limits to current device limits
      ier = get_device_limits(limx,limy,max_color)
      ier = set_clip_limits(0,0,limx,limy)
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test7
      include 'grex.fh'
      integer i,j,k,ier
      integer xmin,ymin,xmax,ymax
      integer new_mode,limx,limy,max_color
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 7: available colors
c
c    show the user all of the colors supported in this mode
c      do this by drawing a vertical bar of each color
      ier = get_clip_limits(xmin,ymin,xmax,ymax)
      k = xmin
      do 40 i=1,max_color+1
           ier = set_color(i-1)
           j = k+1
           k = j + xmax/(max_color+1)
           ier = filled_rectangle(j,ymin,k,ymax)
   40 continue
c
c    label the screen
      ier = graphic_text('Test 7: Available colors',10,limy-10,15)
c
c    and wait for keyboard input
      ier = pause()
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test8
      include 'grex.fh'
      integer new_mode,limx,limy,max_color
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 8: Line clipping
c
c    clear the screen
      ier = clear()
c
c    demonstrate line clipping
c      using color 12 (bright red)
      ier = set_color(12)
      ier = move(-100,-100)
      ier = draw( 800, 100)
      ier = draw( 300, 500)
      ier = draw(-100, 200)
c
c    label the screen
      ier = graphic_text('Test 8: Clipped lines',10,limy-10,9)
c
c    wait for keyboard input
      ier = pause()
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test9
      include 'grex.fh'
      integer new_mode,limx,limy,max_color
      integer ier,ix,iy,jx,jy,ih,iv
      character*64 string
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 9: Graphic pages
c
c    show this test only in EGA modes 14,15,16, and HGC mode
      if(graphic_page_count().gt.1) then
c
c         write something on page 0
           ier = set_active_page(0)
           ier = clear()
           call graphic_text('Test 9: Graphic pages',10,limy-30,14)
           ier = graphic_text('Page Zero',10,limy-20,10)
           string = 'Press 1 to see page one, <Enter> to continue'
           ier = graphic_text(string,10,limy-10,14)
           ier = set_color(4)
           ix = limx/2
           iy = limy/2
           iv = limy/4
           ih = iv * aspect_ratio(new_mode)/100
           ier = filled_ellipse(ix,iy,ih,iv)
c
c         write something else on page 1
           ier = set_active_page(1)
           if(ier.gt.0) ier = clear()
           call graphic_text('Test 9: Graphic pages',10,limy-30,14)
           ier = graphic_text('Page One',100,limy-20,12)
           string = 'Press 0 to see page zero, <Enter> to continue'
           ier = graphic_text(string,10,limy-10,14)
           ier = set_color(1)
           ix = limx/4
           iy = limy/4
           jx = 3*ix
           jy = 3*iy
           ier = filled_rectangle(ix,iy,jx,jy)
c
c         toggle back and forth between pages until return is hit
   50      ier = pause()
           if(ier.ne.13) then
                ier = set_display_page(ier)
                go to 50
              else
                ier = set_active_page(0)
                ier = set_display_page(0)
              endif

         else

c         inform user that only one graphic page is available in this mode
           ier = clear()
           string = 'Test 9: Graphic pages'
           ier = graphic_text(string,10,limy-30,14)
           string = 'Only one page is available in this mode'
           ier = graphic_text(string,10,limy-20,14)
           string = 'Press a key to continue'
           ier = graphic_text(string,10,limy-10,14)
           ier = pause()

         endif
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test10
      include 'grex.fh'
      integer new_mode,limx,limy,max_color
      character*64 string
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 10: graphic text
c
c    clear screen
      ier = clear()
c
c    label screen
      string = 'Test 10: Graphic text'
      ier = graphic_text(string,10,limy-30,14)
      string = 'Use <Backspace> to fix mistakes'
      ier = graphic_text(string,10,limy-20,14)
      string = 'Press <Enter> to continue.'
      ier = graphic_text(string,10,limy-10,14)
c
c    show how to do character I/O in graphics modes:
c      prompt the user and get some input
      call get_string(0,0,'Please enter your name:',string)
c      echo user's input
      call graphic_text(string,0,10,12)
c
c    wait for keyboard input
      ier = pause()
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test11
      include 'grex.fh'
      integer ix,iy,jx,jy,ier
      integer new_mode,limx,limy,max_color
      character*64 string
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 11: XOR functions

c    clear the screen
      ier = clear()

c    Label the screen
      string = 'Test 11: XOR functions'
      ier = graphic_text(string,10,limy-20,14)
      string = 'Press any key to continue'
      ier = graphic_text(string,10,limy-10,14)

c    set up a few coordinates
      ix = 0
      iy = 0
      jx = limx/2
      jy = limy/2

c    draw a bar on the screen
      ier = set_color(1)
      ier = filled_rectangle(ix,iy,jx,jy)

      ier = pause()

c    change coordinates
      ix = limx/4
      iy = limy/4
      jx = 3*ix
      jy = 3*iy

c    now draw another bar, overlapping the first, but XOR them.
      ier = set_color(2)
      ier = set_xor(1)
      ier = filled_rectangle(ix,iy,jx,jy)
      ier = set_xor(0)

      ier = pause()

c    Try the same operation with a line
      ix = 0
      iy = 0

      ier = set_color(4)
      ier = set_xor(1)
      ier = move(ix,iy)
      ier = draw(jx,jy)
      ier = set_xor(0)

      ier = pause()

c    Try writing some text in XOR mode also.
      ix = limx/4 - 40
      iy = limy/2 - 8

      ier = set_xor(1)
      string = 'MicroWay GREX library supports XOR'
      ier = graphic_text(string,ix,iy,15)
      ier = set_xor(0)

c    Get a key from the user before going on
      ier = pause()
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test12
      include 'grex.fh'
      integer ix,iy,jx,jy,ier
      integer new_mode,limx,limy,max_color
      character*64 string
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 12: Vertical text

c    clear the screen
      ier = clear()
c
c    Write vertical text
      ix = limx/8
      iy = 7 * limy/8

      string = 'MicroWay GREX'
      ier = vertical_text(string,ix,iy,12)
      string = 'does vertical text'
      ier = vertical_text(string,ix+10,iy,12)

c    Label the screen
      string = 'Test 12: Vertical text and magnification'
      ier = graphic_text(string,10,limy-20,14)
      string = 'Press any key to continue'
      ier = graphic_text(string,10,limy-10,14)

      call magnify_text (1,1)
      ix = 10
      iy = limy/4
      call graphic_text ('Normal graphic text',ix,iy,7)
      call magnify_text (2,1)
      iy = iy + 20
      call graphic_text ('Double-width graphic text',ix,iy,14)
      call graphic_text ('Double-width graphic text',ix+1,iy,14)
      call magnify_text (1,2)
      iy = iy + 20
      call graphic_text ('Double-height graphic text',ix,iy,14)
      call graphic_text ('Double-height graphic text',ix,iy+1,14)
      call magnify_text (2,2)
      iy = iy + 20
      call graphic_text ('Double-size graphic text',ix  ,iy  ,14)
      call graphic_text ('Double-size graphic text',ix+1,iy  ,14)
      call graphic_text ('Double-size graphic text',ix  ,iy+1,14)
      call graphic_text ('Double-size graphic text',ix+1,iy+1,14)
      iy = iy + 20
      call graphic_text ('Double-size graphic text',ix  ,iy  ,14)

      call magnify_text (1,1)
      ix = 2*limx/3
      iy = limy-10
      call vertical_text ('Normal vertical text',ix,iy,7)
      call magnify_text (2,1)
      ix = ix + 20
      call vertical_text ('Double-width vertical text',ix,iy  ,14)
      call vertical_text ('Double-width vertical text',ix,iy+1,14)
      call magnify_text (1,2)
      ix = ix + 20
      call vertical_text ('Double-height vertical text',ix  ,iy,14)
      call vertical_text ('Double-height vertical text',ix+1,iy,14)
      call magnify_text (2,2)
      ix = ix + 20
      call vertical_text ('Double-size vertical text',ix  ,iy  ,14)
      call vertical_text ('Double-size vertical text',ix+1,iy  ,14)
      call vertical_text ('Double-size vertical text',ix  ,iy+1,14)
      call vertical_text ('Double-size vertical text',ix+1,iy+1,14)
      ix = ix + 20
      call vertical_text ('Double-size vertical text',ix  ,iy  ,14)
      call magnify_text(1,1)

c    Get a key from user before going on
      ier = pause()
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test13
      include 'grex.fh'
      integer i,ix,iy,jx,jy
      integer new_mode,limx,limy,max_color
      character*64 string

c    dash patterns are 32-bit unsigned integers
      character*4 dash_pattern(16)

      new_mode = get_device_limits (limx,limy,max_color)

	dash_pattern( 1) = char(z'FF')//char(z'FF')//char(z'FF')//char(z'FF')
	dash_pattern( 2) = char(z'00')//char(z'FF')//char(z'FF')//char(z'FF')
	dash_pattern( 3) = char(z'00')//char(z'00')//char(z'FF')//char(z'FF')
	dash_pattern( 4) = char(z'00')//char(z'00')//char(z'00')//char(z'FF')
	dash_pattern( 5) = char(z'F0')//char(z'F0')//char(z'F0')//char(z'F0')
	dash_pattern( 6) = char(z'0F')//char(z'0F')//char(z'0F')//char(z'0F')
	dash_pattern( 7) = char(z'FF')//char(z'00')//char(z'FF')//char(z'00')
	dash_pattern( 8) = char(z'00')//char(z'FF')//char(z'00')//char(z'FF')
	dash_pattern( 9) = char(z'F0')//char(z'0F')//char(z'F0')//char(z'0F')
	dash_pattern(10) = char(z'F6')//char(z'F6')//char(z'F6')//char(z'F6')
	dash_pattern(11) = char(z'11')//char(z'11')//char(z'11')//char(z'11')
	dash_pattern(12) = char(z'33')//char(z'33')//char(z'33')//char(z'33')
	dash_pattern(13) = char(z'55')//char(z'55')//char(z'55')//char(z'55')
	dash_pattern(14) = char(z'77')//char(z'77')//char(z'77')//char(z'77')
	dash_pattern(15) = char(z'99')//char(z'99')//char(z'99')//char(z'99')
	dash_pattern(16) = char(z'AA')//char(z'AA')//char(z'AA')//char(z'AA')
c
c Test 13: dashed lines

c    erase previous screen
      ier = clear()

c    Label the screen
      string = 'Test 13: dashed lines'
      ier = graphic_text(string,10,limy-20,14)
      string = 'Press any key to begin next test'
      ier = graphic_text(string,10,limy-10,14)

      ix = 0
      iy = 0

      DO i=1,16
           call move (ix,iy)
           call set_color (i)
           call set_dash (dash_pattern(i))
           jx = limx
           jy = i*limy/8
           call draw (jx,jy)
      EndDO

      call set_dash (-1)

c    Get a key from user before going on
      ier = pause()
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test14
      include 'grex.fh'
      integer ier,ix,iy,jx,jy,key,j
      integer new_mode,limx,limy,max_color
      character*64 string
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 14: define_color

c    erase previous screen
      ier = clear()

c    Label the screen
      string = 'Test 14: define_color function'
      ier = graphic_text(string,10,limy-20,14)
      string = 'Press <Esc> to begin next test'
      ier = graphic_text(string,10,limy-10,14)

      if(new_mode.eq.64.or.max_color.gt.15) then
           ier = set_color(0)
           ier = filled_rectangle(10,limy-10,limx,limy)
           string = 'Not supported in this mode'
           ier = graphic_text(string,10,limy-10,14)
           ier = pause()
           go to 66
         endif

c    Draw a bar in the center of the screen in color 1
      ix = limx/4
      iy = limy/4
      jx = 3 * ix
      jy = 3 * iy

      call set_color(1)
      call filled_rectangle(ix,iy,jx,jy)

c    Prompt user to enter a new value for color 1
      iy = jy+3
      call graphic_text('Enter new color code: ',ix,iy,15)
   60 ix = limx/4 + 23 * 8

c    Get a number from user.  Allow user to backspace.
c      Ignore non-numbers.
      j = 0
      string = ' '
   65 key = pause()
      if(key.eq.27) go to 66
           if(key.ne.13.and.key.ne.10) then
           if(key.eq.8) then
                if(j.gt.0) then
                     ix = ix - 8
                     call set_xor(1)
                     call graphic_text(string(j:j),ix,iy,12)
                     call set_xor(0)
                     string(j:j) = ' '
                     j = j-1
                   endif
              else
                if(key.ge.48.and.key.le.57) then
                     if(j.lt.8) then
                          j = j+1
                          string(j:j) = char(key)
                          call graphic_text(string(j:j),ix,iy,12)
                          ix = ix+8
                        endif
                   endif
              endif
           go to 65
         else
c         read the number that was entered
           read(string,303) new_color
  303      format(BN,I8)
c         change color 1 to the new value
           ier = define_color(1,new_color)
c         erase the number that was entered
           ix = limx/4 + 23 * 8
           call set_xor(1)
           call graphic_text(string,ix,iy,12)
           call set_xor(0)
           string = ' '
           j = 0
           go to 65
         endif

   66 continue
c
      return
      end

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      subroutine test15
      include 'grex.fh'
      integer ier,key,i,j,k
      integer ix,iy,jx,jy
      integer new_mode,limx,limy,max_color
      character*64 string
      integer L,actual_length
      integer new_color
      integer ip(17)
      character pal(17)
      new_mode = get_device_limits (limx,limy,max_color)
c
c Test 15: set_palette function

c    clear screen
      ier = clear()

c    this test is not relevant to HGC and MCGA users
      if(new_mode.eq.64.or.max_color.gt.15) then
           string = 'set_palette not supported in this mode.'
           ier = graphic_text(string,10,limy-10,14)
           ier = pause()
           go to 75
         endif

c    draw a bunch of bars on the screen
   70 ix = limx/5
      iy = limy/5
      jx = 4 * ix
      jy = 4 * iy - 10

c    make each bar a different color
      k = ix
      do 71 i=1,max_color+1
           ier = set_color(i-1)
           j = k+1
           k = j + (jx-ix)/(max_color+1)
           ier = filled_rectangle(j,iy,k,jy)
   71 continue

c    Put palette numbers on left margin
      ix = 10
      do 72 i=1,17
           ip(i) = 0
           iy = 10 * i
           write(string,304) i-1
  304      format(i2)
           call graphic_text(string(1:2),ix,iy,11)
   72 continue

c    Let the user know what to do
      ier = set_xor(1)
      string = 'Test 15: set_palette function'
      ier = graphic_text (string,60,limy-50,14)
      string = 'Select a new color value for each palette register.'
      ier = graphic_text (string,60,limy-40,14)
      string = 'Use <Backspace> to fix errors, press <Enter> to move'
      ier = graphic_text (string,60,limy-30,14)
      L = actual_length(string)
      string = ' to next value.'
      ier = graphic_text (string,60+8*L,limy-30,14)
      string = 'The new palette will be set after you finish the list.'
      ier = graphic_text (string,60,limy-20,14)
      string = '>> Press <Esc> to move on to next test'
      ier = graphic_text (string,60,limy-10,14)
      ier = set_xor(0)

c    set (ix,iy) to write text next to the top number (0).
      i = 1
      iy = 10
   73 ix = 35
      ier = set_xor(1)
      ier = graphic_text (char(16),0,iy,12)
      ier = set_xor(0)

c    Get a number from the user.  Allow backspacing over mistakes.
c    Ignore letters and spaces.
      j = 0
      string = ' '
   74 key = pause()
      if(key.eq.27) go to 75
      if(key.ne.13.and.key.ne.10) then
           if(key.eq.8) then
                if(j.gt.0) then
                     ix = ix - 8
                     call set_xor(1)
                     call graphic_text(string(j:j),ix,iy,12)
                     call set_xor(0)
                     string(j:j) = ' '
                     j = j-1
                   endif
              else
                if(key.ge.48.and.key.le.57) then
                     if(j.lt.8) then
                          j = j+1
                          string(j:j) = char(key)
                          call graphic_text(string(j:j),ix,iy,12)
                          ix = ix+8
                        endif
                   endif
              endif
           go to 74
         else
c         read the number
           read(string,301) new_color
  301      format(BN,I8)
c         set the array element corresponding to this color
           pal(i) = char(new_color)
           iy = iy + 10
           i = i+1
c         if  seventeen numbers have been entered, use them to set palette
           if(i.gt.17) then
                ier = set_palette(pal)
                key = pause()
                if(key.eq.27) go to 75
                call clear()
                go to 70
              endif
           ier = set_xor(1)
           ier = graphic_text (char(16),0,iy-10,12)
           ier = set_xor(0)
           go to 73
         endif

   75 continue
c
      return
      end

C-------------------------------------------------------------------------

      integer function actual_length (s)
      character*(*) s
      j = 1 + len(s)
    1 j = j-1
      if(j.le.0) go to 2
      if(s(j:j).eq.' ') go to 1
    2 actual_length = j
      return
      end

C-------------------------------------------------------------------------

      subroutine show_video_systems
      integer video_system(4),video_configuration,mode,card,crt

      mode = video_configuration(video_system)

      card = video_system(1)
      crt = video_system(2)

      if(card.eq.0) then
           write(6,*) ' No video adapter present'
           go to 86
         endif

      write(6,101) ' Active: '

      if(card.eq. 1) write(6,101) 'MDA: Monochrome Display Adapter'
      if(card.eq. 2) write(6,101) 'CGA: Color Graphics Adapter'
      if(card.eq. 3) write(6,101) 'EGA: Enhanced Graphics Adapter'
      if(card.eq. 4) write(6,101) 'MCGA: Multi Color Gate Array'
      if(card.eq. 5) write(6,101) 'VGA: Video Graphics Array'
      if(card.eq.64) write(6,101) 'HGC: Hercules Graphics Card'
  101 format(1x,a,$)
      if(crt.eq.1) write(6,*) ' with MDA-compatible monochrome display'
      if(crt.eq.2) write(6,*) ' with CGA-compatible color display'
      if(crt.eq.3) write(6,*) ' with EGA-compatible color display'
      if(crt.eq.4) write(6,*) ' with PS/2-compatible monochrome display'
      if(crt.eq.5) write(6,*) ' with PS/2-compatible color display'

      card = video_system(3)
      crt = video_system(4)

      write(6,101) ' Inactive: '

      if(card.eq.0) write(6,*) 'Not installed.'

      if(card.eq. 1) write(6,101) 'MDA: Monochrome Display Adapter'
      if(card.eq. 2) write(6,101) 'CGA: Color Graphics Adapter'
      if(card.eq. 3) write(6,101) 'EGA: Enhanced Graphics Adapter'
      if(card.eq. 4) write(6,101) 'MCGA: Multi Color Gate Array'
      if(card.eq. 5) write(6,101) 'VGA: Video Graphics Array'
      if(card.eq.64) write(6,101) 'HGC: Hercules Graphics Card'

      if(crt.eq.1) write(6,*) ' with MDA-compatible monochrome display'
      if(crt.eq.2) write(6,*) ' with CGA-compatible color display'
      if(crt.eq.3) write(6,*) ' with EGA-compatible color display'
      if(crt.eq.4) write(6,*) ' with PS/2-compatible monochrome display'
      if(crt.eq.5) write(6,*) ' with PS/2-compatible color display'

   86 return
      end

C-------------------------------------------------------------------------

      character function crawl(x,y)
      include 'grex.fh'
      integer xmin,ymin,xmax,ymax
      integer k,j,x,y,step
      character q,nul,cv*13
      ier = get_clip_limits(xmin,ymin,xmax,ymax)
      ix = xmax - 98
      jx = xmax - 2
      iy = ymax - 10
      jy = ymax - 2
      nul = char(0)
      step = 4
   10 ier = move_cursor(x,y)
      j = get_pixel(x,y)
      write(cv,301) x,y,j,nul
  301 format(3i4,a)
      call set_color(0)
      call filled_rectangle(ix,iy,jx,jy)
      call graphic_text(cv,ix,iy,9)
      k = pause()
      if(k.lt.0) then
           k = -k
           if(k.eq.83) step = step-1
           if(k.eq.82) step = step+1
           step = max0(step,1)
           step = min0(step,100)
           if(k.lt.71.or.k.gt.81) go to 10
           if(k.eq.71.or.k.eq.72.or.k.eq.73) y = y - step
           if(k.eq.79.or.k.eq.80.or.k.eq.81) y = y + step
           if(k.eq.71.or.k.eq.75.or.k.eq.79) x = x - step
           if(k.eq.73.or.k.eq.77.or.k.eq.81) x = x + step
           if(x.lt.xmin) x = xmax + x - xmin + 1
           if(y.lt.ymin) y = ymax + y - ymin + 1
           if(x.gt.xmax) x = xmax - x + xmin + 1
           if(y.gt.ymax) y = ymax - y + ymin + 1
           go to 10
         endif
      crawl = char(k)
      ier = move_cursor(-1,-1)
      call set_color(0)
      call filled_rectangle(ix,iy,jx,jy)
      return
      end

C-------------------------------------------------------------------------

      integer function get_string(x,y,prompt,string)
c
c    Routine to get a string from the user interactively, displaying
c      the results on screen, and allowing the user to backspace over
c      mistakes.  Return or line feed terminate the procedure.
c
      integer x,y
      integer ix,iy,key,ic,ier
      integer xmin,ymin,xmax,ymax
      character*(*) prompt,string
      character nul
      include 'grex.fh'
c
c    nul value
      nul = char(0)
c
c    write prompt to screen
      ix = x
      iy = y
      call graphic_text(prompt,ix,iy,14)
c
c    find last nonblank character in prompt
      j = 1 + len(prompt)
    1 j = j-1
      if(j.le.0) go to 2
      if(prompt(j:j).eq.' '.or.prompt(j:j).eq.nul) go to 1
    2 j = max0(j,0)
c
c    adjust ix to describe position of the last nonblank character in prompt
      ix = ix + j*8
c
c    add one extra space
      ix = ix + 8
c
c    compare ix with clip limits; clip to within limits
      call get_clip_limits(xmin,ymin,xmax,ymax)
      ix = min0(ix,xmax)
c
c    initialize string and set up a character counter
      string = ' '
      ic = 0
c
c    While the user has not entered a return or a line feed
c      get a key from user
    5 key = pause()
      if(key.le.0) go to 5
      if(key.eq.13) go to 86
      if(key.eq.10) go to 86
      if(key.eq.8) then

c         erase a character only if one is there to erase
           if(ic.gt.0) then
c              adjust character position pointer
                ix = ix - 8
c              erase character from screen using xor function
                call set_xor(1)
                call graphic_text(string(ic:ic),ix,iy,10)
                call set_xor(0)
c              remove character from string
                string(ic:ic) = ' '
                ic = ic-1
              endif

         else

c         write character on screen
           call graphic_text(char(key),ix,iy,10)
c         advance to next position
           ix = ix + 8
c         store character in string
           ic = ic+1
c           if there is room
           ic = min0(ic,len(string))
c           otherwise replace last character of string
           string(ic:ic) = char(key)

         endif

      go to 5
c    End-while

   86 return
      end
