home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_4.ZIP / TCOMSAMP.ZIP / BANNER.SEQ < prev    next >
Encoding:
Text File  |  1990-07-24  |  5.8 KB  |  120 lines
  1. \ BANNER.SEQ    Compliments of F83X   mod to sequential by Tom Zimmer
  2.  
  3. TABLE CHAR-MATRIX              \ build the character generator
  4.     (  ) $00 C, $00 C, $00 C, $00 C, $00 C, $00 C, $00 C, $00 C,
  5.     ( !) $20 C, $20 C, $20 C, $20 C, $20 C, $00 C, $20 C, $00 C,
  6.     ( ") $50 C, $50 C, $50 C, $00 C, $00 C, $00 C, $00 C, $00 C,
  7.     ( #) $50 C, $50 C, $F8 C, $50 C, $F8 C, $50 C, $50 C, $00 C,
  8.     ( $) $20 C, $78 C, $A0 C, $70 C, $28 C, $F0 C, $20 C, $00 C,
  9.     ( %) $C0 C, $C8 C, $10 C, $20 C, $40 C, $98 C, $18 C, $00 C,
  10.     ( &) $40 C, $A0 C, $A0 C, $40 C, $A8 C, $90 C, $68 C, $00 C,
  11.     ( ') $30 C, $30 C, $10 C, $20 C, $00 C, $00 C, $00 C, $00 C,
  12.     ( () $20 C, $40 C, $80 C, $80 C, $80 C, $40 C, $20 C, $00 C,
  13.     (  ) $20 C, $10 C, $08 C, $08 C, $08 C, $10 C, $20 C, $00 C,
  14.     ( *) $20 C, $a8 C, $70 C, $20 C, $70 C, $a8 C, $20 C, $00 C,
  15.     ( +) $00 C, $20 C, $20 C, $70 C, $20 C, $20 C, $00 C, $00 C,
  16.     ( ,) $00 C, $00 C, $00 C, $30 C, $30 C, $10 C, $20 C, $00 C,
  17.     ( -) $00 C, $00 C, $00 C, $70 C, $00 C, $00 C, $00 C, $00 C,
  18.     ( .) $00 C, $00 C, $00 C, $00 C, $00 C, $30 C, $30 C, $00 C,
  19.     ( /) $00 C, $08 C, $10 C, $20 C, $40 C, $80 C, $00 C, $00 C,
  20.     ( 0) $70 C, $88 C, $98 C, $A8 C, $C8 C, $88 C, $70 C, $00 C,
  21.     ( 1) $20 C, $60 C, $20 C, $20 C, $20 C, $20 C, $70 C, $00 C,
  22.     ( 2) $70 C, $88 C, $08 C, $30 C, $40 C, $80 C, $F8 C, $00 C,
  23.     ( 3) $F8 C, $10 C, $20 C, $30 C, $08 C, $88 C, $70 C, $00 C,
  24.     ( 4) $10 C, $30 C, $50 C, $90 C, $F8 C, $10 C, $10 C, $00 C,
  25.     ( 5) $F8 C, $80 C, $F0 C, $08 C, $08 C, $88 C, $70 C, $00 C,
  26.     ( 6) $38 C, $40 C, $80 C, $F0 C, $88 C, $88 C, $70 C, $00 C,
  27.     ( 7) $F8 C, $08 C, $10 C, $20 C, $40 C, $40 C, $40 C, $00 C,
  28.     ( 8) $70 C, $88 C, $88 C, $70 C, $88 C, $88 C, $70 C, $00 C,
  29.     ( 9) $70 C, $88 C, $88 C, $78 C, $08 C, $10 C, $E0 C, $00 C,
  30.     ( :) $00 C, $60 C, $60 C, $00 C, $60 C, $60 C, $00 C, $00 C,
  31.     ( ;) $00 C, $60 C, $60 C, $00 C, $60 C, $60 C, $40 C, $00 C,
  32.     ( <) $10 C, $20 C, $40 C, $80 C, $40 C, $20 C, $10 C, $00 C,
  33.     ( =) $00 C, $00 C, $F8 C, $00 C, $F8 C, $00 C, $00 C, $00 C,
  34.     ( >) $40 C, $20 C, $10 C, $08 C, $10 C, $20 C, $40 C, $00 C,
  35.     ( ?) $70 C, $88 C, $10 C, $20 C, $20 C, $00 C, $20 C, $00 C,
  36.     ( @) $70 C, $88 C, $A8 C, $B8 C, $B0 C, $80 C, $78 C, $00 C,
  37.     ( A) $20 C, $70 C, $88 C, $88 C, $F8 C, $88 C, $88 C, $00 C,
  38.     ( B) $F0 C, $88 C, $88 C, $F0 C, $88 C, $88 C, $F0 C, $00 C,
  39.     ( C) $70 C, $88 C, $80 C, $80 C, $80 C, $88 C, $70 C, $00 C,
  40.     ( D) $F0 C, $48 C, $48 C, $48 C, $48 C, $48 C, $F0 C, $00 C,
  41.     ( E) $F8 C, $80 C, $80 C, $F0 C, $80 C, $80 C, $F8 C, $00 C,
  42.     ( F) $F8 C, $80 C, $80 C, $F0 C, $80 C, $80 C, $80 C, $00 C,
  43.     ( G) $78 C, $80 C, $80 C, $80 C, $98 C, $88 C, $78 C, $00 C,
  44.     ( H) $88 C, $88 C, $88 C, $F8 C, $88 C, $88 C, $88 C, $00 C,
  45.     ( I) $70 C, $20 C, $20 C, $20 C, $20 C, $20 C, $70 C, $00 C,
  46.     ( J) $08 C, $08 C, $08 C, $08 C, $08 C, $88 C, $78 C, $00 C,
  47.     ( K) $88 C, $90 C, $A0 C, $C0 C, $A0 C, $90 C, $88 C, $00 C,
  48.     ( L) $80 C, $80 C, $80 C, $80 C, $80 C, $80 C, $F8 C, $00 C,
  49.     ( M) $88 C, $D8 C, $A8 C, $A8 C, $88 C, $88 C, $88 C, $00 C,
  50.     ( N) $88 C, $88 C, $C8 C, $A8 C, $98 C, $88 C, $88 C, $00 C,
  51.     ( O) $70 C, $88 C, $88 C, $88 C, $88 C, $88 C, $70 C, $00 C,
  52.     ( P) $F0 C, $88 C, $88 C, $F0 C, $80 C, $80 C, $80 C, $00 C,
  53.     ( Q) $70 C, $88 C, $88 C, $88 C, $A8 C, $90 C, $68 C, $00 C,
  54.     ( R) $F0 C, $88 C, $88 C, $F0 C, $A0 C, $90 C, $88 C, $00 C,
  55.     ( S) $70 C, $88 C, $80 C, $70 C, $08 C, $88 C, $70 C, $00 C,
  56.     ( T) $F8 C, $20 C, $20 C, $20 C, $20 C, $20 C, $20 C, $00 C,
  57.     ( U) $88 C, $88 C, $88 C, $88 C, $88 C, $88 C, $70 C, $00 C,
  58.     ( V) $88 C, $88 C, $88 C, $88 C, $88 C, $50 C, $20 C, $00 C,
  59.     ( W) $88 C, $88 C, $88 C, $A8 C, $A8 C, $D8 C, $88 C, $00 C,
  60.     ( X) $88 C, $88 C, $50 C, $20 C, $50 C, $88 C, $88 C, $00 C,
  61.     ( Y) $88 C, $88 C, $50 C, $20 C, $20 C, $20 C, $20 C, $00 C,
  62.     ( Z) $F8 C, $08 C, $10 C, $20 C, $40 C, $80 C, $F8 C, $00 C,
  63.     ( [) $78 C, $40 C, $40 C, $40 C, $40 C, $40 C, $78 C, $00 C,
  64.     ( \) $00 C, $80 C, $40 C, $20 C, $10 C, $08 C, $00 C, $00 C,
  65.     ( ]) $F0 C, $10 C, $10 C, $10 C, $10 C, $10 C, $F0 C, $00 C,
  66.     ( ^) $00 C, $00 C, $20 C, $50 C, $88 C, $00 C, $00 C, $00 C,
  67.     ( _) $00 C, $00 C, $00 C, $00 C, $00 C, $00 C, $00 C, $F8 C,
  68. END-TABLE
  69.  
  70.  
  71. TABLE BITS      ( --- a1 )
  72.                 128 C, 64 C, 32 C, 16 C, 8 C, 4 C, 2 C, 1 C,
  73. END-TABLE
  74.  
  75. : BIT           ( N1 --- F1 )
  76.                 BITS + C@ AND 0= 1+ ;
  77.  
  78. : LC>UC         ( c -- )
  79.                 DUP 96 128 WITHIN   32 AND - ;
  80.  
  81. : BCHAR         ( c1 -- )
  82.                 7 0
  83.                 DO      DUP I BIT
  84.                         IF      ASCII #
  85.                         ELSE    BL
  86.                         THEN    EMIT
  87.                 LOOP    DROP ;
  88.  
  89. : BANNER        ( a n -- )
  90.                 BOUNDS   8 0
  91.                 DO      CR      2DUP
  92.                        ?DO      I C@    127 AND LC>UC   32 -
  93.                                 8*      CHAR-MATRIX +   J + C@
  94.                                 BCHAR
  95.                         LOOP
  96.                 LOOP    2DROP ;
  97.  
  98. : DEMO          ( --- )         \ print demonstration message
  99.                 DARK
  100.                 400 FUDGE !
  101.                 BEGIN   KEY? ?EXIT CR
  102.                         "   WELCOME"    BANNER
  103.                         "   TO F-PC"    BANNER
  104.                         2 SECONDS
  105.                         KEY? ?EXIT CR
  106.                         "    BANNER"    BANNER
  107.                         "   PROGRAM"    BANNER
  108.                         "  FROM F83X"   BANNER
  109.                         2 SECONDS
  110.                 AGAIN ;
  111.  
  112. ?DEFINIT 0= #IF         \ if the /NOINIT option enabled, then include this
  113.  
  114. : remain        ( -- )
  115.                 DOSIO_INIT                      \ init EMIT, TYPE & SPACES
  116.                 demo ;
  117.  
  118. #THEN
  119.  
  120.