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