home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / colorize.seq < prev    next >
Encoding:
Text File  |  1991-04-26  |  3.8 KB  |  115 lines
  1. \ COLORIZE.SEQ      Color Words                 by Leon Dent
  2.  
  3. comment:
  4.  
  5.         This is a modified version of the CWORDFPC from Leon Dent.  I
  6.         have modified it after changing the F-PC kernel to allow this
  7.         to be easily installed.
  8.  
  9.                                 mods by Tom Zimmer  10/31/88
  10.  
  11. comment;
  12.  
  13. ONLY FORTH ALSO HIDDEN DEFINITIONS ALSO
  14.  
  15. LTMAGENTA VALUE COLONCOLOR        \  COLON DEFINITIONS
  16. BROWN     VALUE CONSTANTCOLOR     \  CONSTANTS
  17. YELLOW    VALUE VALUECOLOR        \  VALUES
  18. GREEN     VALUE VARIABLECOLOR     \  VARIABLES
  19. LTCYAN    VALUE DEFERCOLOR        \  DEFERED WORDS
  20. LTBLUE    VALUE CODECOLOR         \  CODE WORDS
  21. LTRED     VALUE DOESCOLOR         \  CREATE DOES> WORDS
  22. BLUE      VALUE USERBGCOLOR       \  BACKGROUND FOR USER WORDS
  23.  
  24. : CLR-COLON      COLONCOLOR     >FG >NORMBG  ;
  25. : CLR-CONSTANT   CONSTANTCOLOR  >FG >NORMBG  ;
  26. : CLR-VALUE      VALUECOLOR     >FG >NORMBG  ;
  27. : CLR-VARIABLE   VARIABLECOLOR  >FG >NORMBG  ;
  28. : CLR-UVARIABLE  VARIABLECOLOR  >FG USERBGCOLOR >BG ;
  29. : CLR-DEFER      DEFERCOLOR     >FG >NORMBG  ;
  30. : CLR-UDEFER     DEFERCOLOR     >FG USERBGCOLOR >BG ;
  31. : CLR-OTHER      DUP C@ 232 <>
  32.                  IF   CODECOLOR >FG >NORMBG
  33.                  ELSE DUP DOES? NIP      \ DROP SECOND ELEM ON STK
  34.                       IF  DOESCOLOR >FG >NORMBG
  35.                       ELSE >NORM  THEN
  36.                  THEN ;
  37.  
  38. \ end of color mods
  39.  
  40. \ TINT2.SEQ      Last part of Color Words   by Leon Dent
  41.  
  42. \ COLOR NAMES
  43. \ BLACK  BLUE  GREEN  CYAN  RED  MAGENTA BROWN  LTGRAY
  44.  
  45. \ All following, blink in Background.
  46. \ DKGRAY  LTBLUE  LTGREEN  LTCYAN  LTRED LTMAGENTA  YELLOW   WHITE
  47.  
  48. : COLOR-CLASS  0MAX MAX-CLASSES MIN EXEC:
  49.    ( 0 )     CLR-COLON           ( 1 )     CLR-CONSTANT
  50.    ( 2 )     CLR-VARIABLE        ( 3 )     CLR-UVARIABLE
  51.    ( 4 )     CLR-DEFER           ( 5 )     CLR-UDEFER
  52.    ( 6 )     CLR-VALUE           ( 7 )     CLR-OTHER   ;
  53.  
  54. FORTH DEFINITIONS
  55.  
  56. FALSE VALUE ?COLORIZE
  57.  
  58. : COLOR-INFO    ( --- )
  59.                 vmode-var @ 7 = ?exit   \ leave if monocrome
  60.                 ?colorize 0=
  61.                 if      cr ."  Type COLORIZEON to see words in COLOR" exit
  62.                 then
  63.                 attrib c@ >r cr
  64.                 clr-colon     ."  COLON "
  65.                 clr-constant  ."  CONSTANT "
  66.                 clr-value     ."  VALUE "
  67.                 clr-variable  ."  VARIABLE "
  68.                 clr-uvariable ."  USER-VARIABLE "
  69.                 cr
  70.                 clr-defer     ."  DEFERED "
  71.                 clr-udefer    ."  USER-DEFERED "
  72.                 codecolor >fg
  73.                 >NORMBG       ."  CODE "
  74.                 doescolor >fg
  75.                 >NORMBG       ."  CREATE-DOES " >norm
  76.                               ."  OTHER "
  77.                 cr
  78.                 ."  Each word type is displayed in color as shown above."
  79.                 r> attrib c! cr ;
  80.  
  81. ' COLOR-INFO IS PREWORDS
  82.  
  83. : COLORIZE  ( CFA -- )
  84.             DUP  @REL>ABS  DEFINITION-CLASS COLOR-CLASS DROP  ;
  85.  
  86.                                         \ Boot time initialization of
  87. : COLORIZE-INIT ( --- )                 \ COLORIZER by video mode
  88.                 DEFERS INITSTUFF
  89.                 vmode-var @ 7 <> =: ?COLORIZE ;
  90.  
  91. ' COLORIZE-INIT IS INITSTUFF
  92.  
  93. : C.ID          ( NFA --- )
  94.                 ?COLORIZE
  95.                 IF      SAVE> ATTRIB
  96.                         DUP NAME> COLORIZE %.ID
  97.                         RESTORE> ATTRIB
  98.                 ELSE    %.ID
  99.                 THEN    ;
  100.  
  101. ' C.ID IS .ID
  102.  
  103. : COLORIZEOFF   ( --- )
  104.                 FALSE =: ?COLORIZE ;
  105.  
  106. : COLORIZEON    ( --- )
  107.                 vmode-var @ 7 <>
  108.                 IF      ['] C.ID IS .ID
  109.                         TRUE =: ?COLORIZE
  110.                 ELSE    COLORIZEOFF
  111.                 THEN    ;
  112.  
  113. ONLY FORTH ALSO DEFINITIONS
  114.  
  115.