home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l291 / 6.ddi / SCRTXWIN.FO$ / SCRTXWIN.bin
Encoding:
Text File  |  1990-12-11  |  3.0 KB  |  117 lines
  1. C  This program displays text in text windows and then
  2. C  scrolls, inserts, and deletes lines.
  3.  
  4.        INCLUDE 'FGRAPH.FI'
  5.        INCLUDE 'FGRAPH.FD'
  6.  
  7.        INTEGER*2 row, rowsset
  8.        CHARACTER string*9
  9.        RECORD /rccoord/ oldpos
  10.  
  11. C  Set up screen for scrolling and put text window around scroll area
  12.  
  13.        row = 25
  14.        rowsset = settextrows( row )
  15.        CALL clearscreen( $GCLEARSCREEN )
  16.  
  17.        DO row = 1, 24
  18.          string = 'Line     '
  19.          CALL settextposition( row, 1, oldpos )
  20.          WRITE( string(8:9), '(I2)' ) row
  21.          CALL outtext( string )
  22.        END DO
  23.  
  24.        READ( *, * )   ! Wait for the ENTER key
  25.        CALL settextwindow( 1, 1, 25, 10 )
  26.  
  27. C  Delete some lines
  28.  
  29.        CALL settextposition( 11, 1, oldpos )
  30.        DO row = 12, 20
  31.          CALL deleteline()
  32.        END DO
  33.  
  34.        CALL status( 'Deleted 8 lines' )
  35.  
  36. C  Insert some lines
  37.  
  38.        CALL settextposition( 5, 1, oldpos )
  39.        DO row = 1, 6
  40.          CALL insertline()
  41.        END DO
  42.  
  43.        CALL status( 'Inserted 5 lines' )
  44.  
  45. C  Scroll up and down
  46.  
  47.        CALL scrolltextwindow( -7 )
  48.        CALL status( 'Scrolled down 7 lines' )
  49.        CALL scrolltextwindow( 5 )
  50.        CALL status( 'Scrolled up 5 lines' )
  51.  
  52. C End the program
  53.  
  54.        !  CALL setvideomode( $DEFAULTMODE )
  55.        END
  56.  
  57. C
  58. C  Subroutine Definitions
  59. C
  60.  
  61. C  Delete lines by scrolling them off the top of the current
  62. C  text window. Save and restore original window
  63.  
  64.        SUBROUTINE deleteline()
  65.  
  66.        INCLUDE 'FGRAPH.FD'
  67.  
  68.        INTEGER*2          top, left, bottom, right
  69.        RECORD / rccoord / rc
  70.  
  71.        CALL gettextwindow( top, left, bottom, right )
  72.        CALL gettextposition( rc )
  73.        CALL settextwindow( rc.row, left, bottom, right )
  74.        CALL scrolltextwindow( $GSCROLLUP )
  75.        CALL settextwindow( top, left, bottom, right )
  76.        CALL settextposition( rc.row, rc.col, rc )
  77.        
  78.        END
  79.  
  80. C  Insert lines by scrolling in blank lines from the top of the
  81. C  current text window. Save and restore original window.
  82.  
  83.        SUBROUTINE insertline()
  84.  
  85.        INCLUDE 'FGRAPH.FD'
  86.  
  87.        INTEGER*2          top, left, bottom, right
  88.        RECORD / rccoord / rc
  89.  
  90.        CALL gettextwindow( top, left, bottom, right )
  91.        CALL gettextposition( rc )
  92.        CALL settextwindow( rc.row, left, bottom, right )
  93.        CALL scrolltextwindow( $GSCROLLDOWN )
  94.        CALL settextwindow( top, left, bottom, right )
  95.        CALL settextposition( rc.row, rc.col, rc )
  96.        
  97.        END
  98.  
  99. C  Display and clear status line in its own window
  100.  
  101.        SUBROUTINE status( text )
  102.  
  103.        INCLUDE 'FGRAPH.FD'
  104.  
  105.        CHARACTER*(*)      text
  106.        INTEGER*2          top, left, bottom, right
  107.  
  108.        CALL gettextwindow( top, left, bottom, right )
  109.        CALL settextwindow( 1, 50, 2, 80 )
  110.        CALL outtext( text )
  111.        READ( *, * )   ! Wait for ENTER key
  112.        CALL clearscreen( $GWINDOW )
  113.        CALL settextwindow( top, left, bottom, right )
  114.  
  115.        END
  116.        
  117.