home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / tsavescr.seq < prev    next >
Encoding:
Text File  |  1989-11-17  |  2.0 KB  |  53 lines
  1. \ SAVESCR.SEQ   Routine to save and restore screen.     by Tom Zimmer
  2.  
  3. FORTH DECIMAL TARGET >LIBRARY           \ A Library file
  4.  
  5. 0 value cur_svseg                       \ segment of previous saved screen
  6. 0 value svsize                          \ size of screen in bytes
  7.  
  8. : new_svseg     ( --- seg )             \ Get a segment to save screen in
  9.                 rows cols 2* * dup =: svsize    \ size of screen
  10.                 2+ paragraph alloc 8 =          \ allocate the space
  11.                 if      2drop
  12.                         at? 0 0 at
  13.                         ." Failed to allocate memory for screen save! "
  14.                         beep
  15.                         at 0
  16.                 else    nip
  17.                 then    ;
  18.  
  19. \ nestable save and restore up to memory allowable times
  20.  
  21. : savescr       ( --- )
  22.                 new_svseg ?dup 0= ?exit                 \ leave if failed
  23.                 cur_svseg over 0 !L                     \ save prev in cur
  24.                 dup =: cur_svseg                        \ set current
  25.                 video-seg @ 0 rot 2 svsize cmovel ;     \ save the screen
  26.  
  27.  
  28. : restscr       ( --- )
  29.                 cur_svseg 0= ?exit
  30.                 cur_svseg 2 video-seg @ 0 svsize cmovel \ Restore screen
  31.                 cur_svseg dup 0 @L =: cur_svseg
  32.                 dealloc
  33.                 if      at? 0 0 at
  34.                         ." Failed to de-allocate memory from screen save! "
  35.                         beep
  36.                         at
  37.                 then    ;
  38.  
  39. : recoverscr    ( --- )         \ get a copy of the current saved screen
  40.                 cur_svseg 0= ?exit
  41.                 cur_svseg 2 video-seg @ 0 svsize cmovel ;
  42.  
  43. : recoverline   ( n1 --- )      \ get a copy of line n1 from saved screen
  44.                 cur_svseg 0= if drop exit then
  45.                 dup 0 rows 1- between
  46.                 if      cols 2* * >r            \ Restore line n1
  47.                         cur_svseg r@ 2+ video-seg @ r> cols 2* cmovel
  48.                 else    drop
  49.                 then    ;
  50.  
  51. FORTH TARGET >TARGET
  52.  
  53.