home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / SAVESCR.SEQ < prev    next >
Encoding:
Text File  |  1989-09-21  |  3.3 KB  |  93 lines
  1. \ SAVESCR.SEQ   Routine to save and restore screen.     by Tom Zimmer
  2.  
  3. decimal
  4.  
  5.    0 value svseg                \ screen save segment
  6.    4 value svmax                \ maximum number of screens to save
  7. 4000 value svsize               \ size of each screen
  8.    0 value svtotal              \ total of saved screens
  9.  
  10. : svinit        ( --- )         \ screen save initialization
  11.                 defers initstuff
  12.                 off> svseg
  13.                 rows cols 2* * =: svsize        \ set save size per screen
  14.                 65535. svsize um/mod nip        \ maximum number of screens
  15.                 1- svmax min =: svmax           \ limit svsize to < 64k
  16.                 svsize svmax * =: svtotal       \ adjust total arraysize
  17.                 svmax 1+ svsize * paragraph alloc 8 =   \ allocate the space
  18.                 if      2drop cr
  19.                         ." Could not allocate memory for Screen save routine."
  20.                 else     nip =: svseg
  21.                 then    ;
  22.  
  23. ' svinit is initstuff
  24.  
  25. \ nestable save and restore up to SVMAX times.
  26.  
  27. : savescr       ( --- )
  28.                 svseg 0= ?exit
  29.                 svseg 0 2dup svsize + svtotal cmovel>   \ Make a hole in buf
  30.                 blank.color
  31.                 video-seg @ 0 svseg 0 svsize cmovel       \ & save screen in it.
  32.                 show.color ;
  33.  
  34. : restscr       ( --- )
  35.                 svseg 0= ?exit
  36.                 blank.color
  37.                 svseg 0 video-seg @ 0 svsize cmovel     \ Restore screen &
  38.                 show.color
  39.                 svseg svsize over 0 svtotal cmovel ;    \ compress buffer.
  40.  
  41. : recoverscr    ( --- )                                 \ get a copy of the
  42.                 svseg 0= ?exit                          \ last saved screen
  43.                 blank.color
  44.                 svseg 0 video-seg @ 0 svsize cmovel     \ Restore screen
  45.                 show.color ;
  46.  
  47. : recoverline   ( n1 --- )                          \ get a copy of line n1
  48.                 svseg 0= if drop exit then          \ from last saved screen
  49.                 dup 0 rows 1- between
  50.                 if      cols 2* * >r
  51.                         blank.color
  52.                                                         \ Restore line n1
  53.                         svseg r@ video-seg @ r> cols 2* cmovel
  54.                         show.color
  55.                 else    drop
  56.                 then    ;
  57.  
  58. comment:
  59.  
  60. \ This commented out section of code saves and restores the screen on entry
  61. \ and exit from F-PC. It is not being compiled at the present time because
  62. \ I do not like the effect.
  63.  
  64. 2variable entry-curpos
  65.  
  66. 0 24 entry-curpos 2!                    \ initialize to bottom of screen
  67.  
  68. : entry-save    ( --- )                 \ save screen on entering F-PC
  69.                 defers initstuff
  70.                 #out @ #line @ entry-curpos 2!
  71.                 savescr ;
  72.  
  73. ' entry-save is initstuff
  74.  
  75. : exit-restore  ( --- )                 \ and restore screen on leaving F-PC
  76.                 defers byefunc
  77.                 restscr
  78.                 entry-curpos 2@ at ;
  79.  
  80. ' exit-restore is byefunc
  81.  
  82. comment;
  83.  
  84. \ Do we need screen blanking for out COLOR display, here are the words to
  85. \ select blanking or non-blanking.
  86.  
  87. : blankon       ( --- )
  88.                 blanking on ;
  89.  
  90. : blankoff      ( --- )
  91.                 blanking off ;
  92.  
  93.