home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FPC225_2.ZIP / MISC.ZIP / SHAPE16.SEQ < prev    next >
Encoding:
Text File  |  1988-02-06  |  1.8 KB  |  73 lines
  1. \ Author:  Jack W Brown
  2. \ Date:    June 2, 1988
  3. \ Subject: 16 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. \ 16 X n Shape tables.
  10.  
  11.   HEX  8000 CONSTANT MASK DECIMAL
  12.  
  13. \ Display one row of the shape table as specified by  n .
  14. \ Bits are displayed starting with the highest bit so the
  15. \ table will not apear as the mirror image of the data.
  16. : 1ROW ( n  -- )
  17.         16 0 DO DUP MASK AND
  18.                IF   177 DUP EMIT EMIT
  19.                ELSE  BL DUP EMIT EMIT
  20.                THEN 2*
  21.             LOOP DROP ;
  22.  
  23. \ Like COUNT except it fetches a word and increments the
  24. \ address by 2.
  25. : WCOUNT  ( adr   adr+2  n )
  26.        DUP 2+ SWAP @ ;
  27.  
  28.  
  29. \ This is the runtime routine for the new SHAPE16 object.
  30. : DRAW-SHAPE ( adr    -- )
  31.        WCOUNT 0 ?DO  WCOUNT
  32.                      CR 1ROW
  33.                 LOOP DROP ;
  34.  
  35. \ This is the compile time routine for the new SHAPE16 object.
  36. \ The reason for the  DEPTH 1- ROLL is to reverse the order of
  37. \ the compiled data so the shape will not appear upside down.
  38. \ The use of DEPTH may not be the best thing here as it assumes that
  39. \ the stack is empty just before shape data is placed on the stack.
  40. : COMPILE-SHAPE ( n1 n2 ... nk    -- )
  41.         DEPTH DUP , 0 DO DEPTH 1-  ROLL , LOOP  ;
  42.  
  43. : SHAPE16  ( n1 n2 ... nk   -- )
  44.         CREATE   COMPILE-SHAPE
  45.         DOES>    DRAW-SHAPE ;
  46.  
  47. HEX
  48. CCCC CCCC 3333 3333 CCCC CCCC 3333 3333
  49. CCCC CCCC 3333 3333 CCCC CCCC 3333 3333 SHAPE16 CHECK
  50. DECIMAL
  51.  
  52. 1 3 7 15 31 63 127  SHAPE16  STAIRS
  53.  
  54. 2 BASE !
  55.  
  56. 1111111111111111
  57. 0000000000000000
  58. 0001100011000011
  59. 0011110001100110
  60. 0110011000111100
  61. 1100001100011000
  62. 0110011000111100
  63. 0011110001100110
  64. 0001100011000011
  65. 0000000000000000
  66. 1111111111111111
  67.  
  68. SHAPE16 DIAMONDX
  69.  
  70. DECIMAL
  71.  
  72.  
  73.