home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / lines.seq < prev    next >
Text File  |  1990-10-06  |  2KB  |  51 lines
  1. \\ LINES.SEQ     A simple graphic demo, draws lines on CGA or HERCULES
  2.  
  3.   Here is an example file that will work on either CGA/EGA/VGA or HERCULES.
  4.  
  5.         Compile with the following command line:
  6.  
  7.                 TCOM LINES /OPT /NOINIT <Enter>
  8.  
  9. {
  10.  
  11. needs therc.seq
  12. needs tgraph.seq
  13.  
  14. 0 value dinc
  15. 0 value -hdots
  16. 0 value -vdots
  17.  
  18. : ?kexit        ( -- )
  19.                 key? if text-mode bye then ;
  20.  
  21. : dolines       ( -- )
  22.         vdots 0 do       0      0  -hdots           i     line  dinc +loop
  23. ?kexit  hdots 0 do       0      0  -hdots i -  -vdots     line  dinc +loop
  24. ?kexit  vdots 0 do  -hdots      0       0           i     line  dinc +loop
  25. ?kexit  hdots 0 do  -hdots      0       i      -vdots     line  dinc +loop
  26. ?kexit  vdots 0 do  -hdots -vdots       0      -vdots i - line  dinc +loop
  27. ?kexit  hdots 0 do  -hdots -vdots       i           0     line  dinc +loop
  28. ?kexit  vdots 0 do       0 -vdots  -hdots      -vdots i - line  dinc +loop
  29. ?kexit  hdots 0 do       0 -vdots  -hdots i -       0     line  dinc +loop
  30. ?kexit  COLOR @ 127 AND 1+ 15 AND 128 OR COLOR !
  31.         ;
  32.  
  33. : draw_lines    ( n1 -- )
  34.                 vdots 1- =: -vdots
  35.                 hdots 1- =: -hdots
  36.                 dup 0= if drop 16 then  =: dinc
  37.                 begin   dolines
  38.                 key? until ;
  39.  
  40. : lines         ( -- )
  41.                 graph-init
  42.                 if      320x200x4
  43.                         132 color !
  44.                 else    hercules
  45.                         132 color !
  46.                 then
  47.                 10 draw_lines
  48.                 %key drop
  49.                 text-mode ;
  50. }
  51.