home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / p1_6bs.seq < prev    next >
Text File  |  1990-03-28  |  5KB  |  114 lines
  1. \ Comp 462
  2. \ Balraj Sidhu   Set: 14D4
  3. \ Date: March 26, 1990
  4. \ Problem 1.6
  5.  
  6. \ BANNER.SEQ    Compliments of F83X   mod to sequential by Tom Zimmer
  7.  
  8. CREATE CHAR-MATRIX              \ build the character generator
  9. HEX (  ) 00 C, 00 C, 00 C, 00 C, 00 C, 00 C, 00 C, 00 C,
  10.     ( !) 20 C, 20 C, 20 C, 20 C, 20 C, 00 C, 20 C, 00 C,
  11.     ( ") 50 C, 50 C, 50 C, 00 C, 00 C, 00 C, 00 C, 00 C,
  12.     ( #) 50 C, 50 C, F8 C, 50 C, F8 C, 50 C, 50 C, 00 C,
  13.     ( $) 20 C, 78 C, A0 C, 70 C, 28 C, F0 C, 20 C, 00 C,
  14.     ( %) C0 C, C8 C, 10 C, 20 C, 40 C, 98 C, 18 C, 00 C,
  15.     ( &) 40 C, A0 C, A0 C, 40 C, A8 C, 90 C, 68 C, 00 C,
  16.     ( ') 30 C, 30 C, 10 C, 20 C, 00 C, 00 C, 00 C, 00 C,
  17.     ( () 20 C, 40 C, 80 C, 80 C, 80 C, 40 C, 20 C, 00 C,
  18.     (  ) 20 C, 10 C, 08 C, 08 C, 08 C, 10 C, 20 C, 00 C,
  19.     ( *) 20 C, a8 C, 70 C, 20 C, 70 C, a8 C, 20 C, 00 C,
  20.     ( +) 00 C, 20 C, 20 C, 70 C, 20 C, 20 C, 00 C, 00 C,
  21.     ( ,) 00 C, 00 C, 00 C, 30 C, 30 C, 10 C, 20 C, 00 C,
  22.     ( -) 00 C, 00 C, 00 C, 70 C, 00 C, 00 C, 00 C, 00 C,
  23.     ( .) 00 C, 00 C, 00 C, 00 C, 00 C, 30 C, 30 C, 00 C,
  24.     ( /) 00 C, 08 C, 10 C, 20 C, 40 C, 80 C, 00 C, 00 C,
  25.     ( 0) 70 C, 88 C, 98 C, A8 C, C8 C, 88 C, 70 C, 00 C,
  26.     ( 1) 20 C, 60 C, 20 C, 20 C, 20 C, 20 C, 70 C, 00 C,
  27.     ( 2) 70 C, 88 C, 08 C, 30 C, 40 C, 80 C, F8 C, 00 C,
  28.     ( 3) F8 C, 10 C, 20 C, 30 C, 08 C, 88 C, 70 C, 00 C,
  29.     ( 4) 10 C, 30 C, 50 C, 90 C, F8 C, 10 C, 10 C, 00 C,
  30.     ( 5) F8 C, 80 C, F0 C, 08 C, 08 C, 88 C, 70 C, 00 C,
  31.     ( 6) 38 C, 40 C, 80 C, F0 C, 88 C, 88 C, 70 C, 00 C,
  32.     ( 7) F8 C, 08 C, 10 C, 20 C, 40 C, 40 C, 40 C, 00 C,
  33.     ( 8) 70 C, 88 C, 88 C, 70 C, 88 C, 88 C, 70 C, 00 C,
  34.     ( 9) 70 C, 88 C, 88 C, 78 C, 08 C, 10 C, E0 C, 00 C,
  35.     ( :) 00 C, 60 C, 60 C, 00 C, 60 C, 60 C, 00 C, 00 C,
  36.     ( ;) 00 C, 60 C, 60 C, 00 C, 60 C, 60 C, 40 C, 00 C,
  37.     ( <) 10 C, 20 C, 40 C, 80 C, 40 C, 20 C, 10 C, 00 C,
  38.     ( =) 00 C, 00 C, F8 C, 00 C, F8 C, 00 C, 00 C, 00 C,
  39.     ( >) 40 C, 20 C, 10 C, 08 C, 10 C, 20 C, 40 C, 00 C,
  40.     ( ?) 70 C, 88 C, 10 C, 20 C, 20 C, 00 C, 20 C, 00 C,
  41.     ( @) 70 C, 88 C, A8 C, B8 C, B0 C, 80 C, 78 C, 00 C,
  42.     ( A) 20 C, 70 C, 88 C, 88 C, F8 C, 88 C, 88 C, 00 C,
  43.     ( B) F0 C, 88 C, 88 C, F0 C, 88 C, 88 C, F0 C, 00 C,
  44.     ( C) 70 C, 88 C, 80 C, 80 C, 80 C, 88 C, 70 C, 00 C,
  45.     ( D) F0 C, 48 C, 48 C, 48 C, 48 C, 48 C, F0 C, 00 C,
  46.     ( E) F8 C, 80 C, 80 C, F0 C, 80 C, 80 C, F8 C, 00 C,
  47.     ( F) F8 C, 80 C, 80 C, F0 C, 80 C, 80 C, 80 C, 00 C,
  48.     ( G) 78 C, 80 C, 80 C, 80 C, 98 C, 88 C, 78 C, 00 C,
  49.     ( H) 88 C, 88 C, 88 C, F8 C, 88 C, 88 C, 88 C, 00 C,
  50.     ( I) 70 C, 20 C, 20 C, 20 C, 20 C, 20 C, 70 C, 00 C,
  51.     ( J) 08 C, 08 C, 08 C, 08 C, 08 C, 88 C, 78 C, 00 C,
  52.     ( K) 88 C, 90 C, A0 C, C0 C, A0 C, 90 C, 88 C, 00 C,
  53.     ( L) 80 C, 80 C, 80 C, 80 C, 80 C, 80 C, F8 C, 00 C,
  54.     ( M) 88 C, D8 C, A8 C, A8 C, 88 C, 88 C, 88 C, 00 C,
  55.     ( N) 88 C, 88 C, C8 C, A8 C, 98 C, 88 C, 88 C, 00 C,
  56.     ( O) 70 C, 88 C, 88 C, 88 C, 88 C, 88 C, 70 C, 00 C,
  57.     ( P) F0 C, 88 C, 88 C, F0 C, 80 C, 80 C, 80 C, 00 C,
  58.     ( Q) 70 C, 88 C, 88 C, 88 C, A8 C, 90 C, 68 C, 00 C,
  59.     ( R) F0 C, 88 C, 88 C, F0 C, A0 C, 90 C, 88 C, 00 C,
  60.     ( S) 70 C, 88 C, 80 C, 70 C, 08 C, 88 C, 70 C, 00 C,
  61.     ( T) F8 C, 20 C, 20 C, 20 C, 20 C, 20 C, 20 C, 00 C,
  62.     ( U) 88 C, 88 C, 88 C, 88 C, 88 C, 88 C, 70 C, 00 C,
  63.     ( V) 88 C, 88 C, 88 C, 88 C, 88 C, 50 C, 20 C, 00 C,
  64.     ( W) 88 C, 88 C, 88 C, A8 C, A8 C, D8 C, 88 C, 00 C,
  65.     ( X) 88 C, 88 C, 50 C, 20 C, 50 C, 88 C, 88 C, 00 C,
  66.     ( Y) 88 C, 88 C, 50 C, 20 C, 20 C, 20 C, 20 C, 00 C,
  67.     ( Z) F8 C, 08 C, 10 C, 20 C, 40 C, 80 C, F8 C, 00 C,
  68.     ( [) 78 C, 40 C, 40 C, 40 C, 40 C, 40 C, 78 C, 00 C,
  69.     ( \) 00 C, 80 C, 40 C, 20 C, 10 C, 08 C, 00 C, 00 C,
  70.     ( ]) F0 C, 10 C, 10 C, 10 C, 10 C, 10 C, F0 C, 00 C,
  71.     ( ^) 00 C, 00 C, 20 C, 50 C, 88 C, 00 C, 00 C, 00 C,
  72.     ( _) 00 C, 00 C, 00 C, 00 C, 00 C, 00 C, 00 C, F8 C,
  73.  
  74. DECIMAL
  75.  
  76. CREATE BITS     ( --- a1 )
  77.                 128 C, 64 C, 32 C, 16 C, 8 C, 4 C, 2 C, 1 C,
  78.  
  79. : BIT           ( N1 --- F1 )
  80.                 BITS + C@ AND 0= 1+ ;
  81.  
  82.  
  83.  
  84. : LC>UC         ( c -- )
  85.                 DUP 96 128 WITHIN   32 AND - ;
  86.  
  87. : BANNER        ( a n -- )
  88.                 BOUNDS   8 0
  89.                 DO      CR      2DUP
  90.                        ?DO      I C@    127 AND LC>UC   32 -
  91.                                 8*      CHAR-MATRIX +   J + C@
  92.                                 7 0
  93.                                 DO      DUP I BIT
  94.                                         IF      177
  95.                                         ELSE    BL
  96.                                         THEN    EMIT
  97.                                 LOOP DROP
  98.                         LOOP
  99.                 LOOP    2DROP ;
  100.  
  101. : DEMO          ( --- )         \ print demonstration message
  102.                 DARK CR
  103.                 " WELCOME"      BANNER
  104.                 " TO F-PC"      BANNER
  105.                 2 SECONDS
  106.                 DARK CR
  107.                 " BANNER"       BANNER
  108.                 " PROGRAM"      BANNER
  109.                 " FROM F83X"    BANNER ;
  110. DEMO
  111.  
  112.  
  113.  
  114.