home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / hello.seq < prev    next >
Encoding:
Text File  |  1991-04-08  |  2.2 KB  |  61 lines
  1. \ HELLO.SEQ     Contains the sign on word for Forth.
  2.  
  3. only forth also definitions hidden also
  4.  
  5. : <.HELLO>      ( --- )
  6.                 blinkoff
  7. ." \d\n\n\n\s34\r  F-PC  \n"
  8. ." \n\t┌───────────────────────────────────────────────────────────▄"
  9. ." \n\t│ 80x8x Forth ─── Version:" >attrib3 .fpcver# >norm
  10.                                                 ." \0 Date:"
  11.         decimal     cdate 2@ form-date  count type
  12.         ."   Time:" ctime 2@ drop dtbuf off   build-hm
  13.                                   dtbuf count type decimal    ."   █"
  14. ." \n\t├───────────────────────────────────────────────────────────█"
  15. ." \n\t│ Based on F83 by           ── Henry Laxen, Michael Perry,  █"
  16. ." \n\t│ F-PC by                   ── Tom Zimmer & Robert L. Smith █"
  17. ." \n\t└▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█\n"
  18. ." \n\n\s13" >ATTRIB1 .FREE >NORM
  19. ." \n\n\s18\1 Bewildered?   Press: \r F1 \1 for assistance "
  20. ." \n\n\t\t\1 Press \r ESC \1 to toggle the menubar on or off. "
  21.         CR      ;
  22.  
  23. : .FILE         ( --- )
  24.                 .seqhandle ."  of " seqhandle ENDFILE D. ." bytes" ;
  25.  
  26. : <.CURFILE>    ( --- )
  27.                 CR TAB ." Current File = " seqhandle >HNDLE @ -1 <>
  28.                 IF      .FILE
  29.                 ELSE    ." \1 No file Open "
  30.                 THEN    CR ;
  31.  
  32. DEFER .HELLO    ' <.HELLO>      IS .HELLO
  33. DEFER .CURFILE  ' <.CURFILE>    IS .CURFILE
  34.  
  35. : HELLO         ( --- )
  36.                 SP0 @  'TIB !
  37.                 >IN     OFF
  38.                 SPAN    OFF
  39.                 #TIB    OFF
  40.                 LOADING OFF
  41. \u NOSETCUR     NOSETCUR OFF
  42.                 ONLY FORTH ALSO DEFINITIONS
  43.                 DEFAULTSTATE
  44.                 DEFAULT
  45.                 >in @ bl word swap >in ! c@ 0=
  46.                 if      .hello
  47.                         .curfile
  48.                 then    interpret ;
  49.  
  50. ' HELLO IS BOOT
  51.  
  52. : MARK          ( -- )
  53.                 CREATE YHERE ,
  54.                 XHERE PARAGRAPH +       \ absolute paragraph of new def
  55.                 DUP XDPSEG !            \ set new XHERE segment
  56.                 xseg @ - ,
  57.                 DOES> DUP 2+ dup @ +XSEG xdpseg ! xdp off
  58.                 2+ SWAP @
  59.                 (FRGET)  FORTH DEFINITIONS  ;
  60.  
  61.