home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FPC225_2.ZIP / MISC.ZIP / SHAPE8.SEQ < prev   
Encoding:
Text File  |  1988-02-06  |  1.6 KB  |  63 lines
  1. \ Author:  Jack W Brown
  2. \ Date:    June 2, 1988
  3. \ Subject: 8 x k shape tables using CREATE ... DOES>
  4.  
  5. \ Extensions of the ideas presented here could be used to construct,
  6. \ diskplay, and edit character sets and shapes.
  7.  
  8.  
  9. HEX 0080 CONSTANT MASK DECIMAL
  10.  
  11. \ Display one row of the shape table as specified by  n .
  12. \ Bits are displayed starting with the highest bit so the
  13. \ table will not apear as the mirror image of the data.
  14. : 1ROW ( n  -- )
  15.         8 0 DO DUP MASK AND
  16.                IF   177 DUP EMIT EMIT    \ two characters per cell
  17.                ELSE  BL DUP EMIT EMIT    \ to give 1:1 aspect ratio.
  18.                THEN 2*
  19.             LOOP DROP ;
  20.  
  21.  
  22. \ This is the runtime routine for the new SHAPE8 object.
  23. : DRAW-SHAPE ( adr    -- )
  24.        COUNT 0 ?DO  COUNT
  25.                     CR 1ROW
  26.                LOOP DROP ;
  27.  
  28. \ This is the compile time routine for the new SHAPE8 object.
  29. \ The reason for the  DEPTH 1- ROLL is to reverse the order of
  30. \ the compiled data so the shape will not appear upside down.
  31. \ The use of DEPTH may not be the best thing here as it assumes that
  32. \ the stack is empty just before shape data is placed on the stack.
  33. : COMPILE-SHAPE ( n1 n2 ... nk    -- )
  34.         DEPTH DUP C, 0 DO DEPTH 1-  ROLL C, LOOP ;
  35.  
  36. : SHAPE8  ( n1 n2 ... nk   -- )
  37.         CREATE   COMPILE-SHAPE
  38.         DOES>    DRAW-SHAPE ;
  39.  
  40. \ Some sample shapes.
  41.  
  42. HEX
  43. CC CC 33 33 CC CC 33 33 SHAPE8 CHECK
  44.  
  45. DECIMAL
  46. 1 3 7 15 31 63 127 SHAPE8  STAIRS
  47.  
  48. 2 BASE !
  49. 00000000
  50. 00011000
  51. 00111100
  52. 01100110
  53. 11000011
  54. 01100110
  55. 00111100
  56. 00011000
  57. 00000000
  58. SHAPE8 DIAMOND
  59.  
  60. DECIMAL
  61.  
  62.  
  63.