home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / tcom96 / samples / dispcode.seq < prev    next >
Encoding:
Text File  |  1991-03-21  |  6.0 KB  |  202 lines
  1. \  code for driving a LCD
  2. \       Specific numbers are for 480 by 128 pixels on 4 parallel bits.
  3.  
  4.  
  5. code bitmasks          \ this is how the 4 bits are wired up
  6.         $10  c,  $80 c,  $40 c,  $20 c,
  7.         1    c,    2 c,    4 c,    8 c,
  8.         $0EF c, $07F c, $0BF c, $0DF c,
  9.         $0FE c, $0FD c, $0FB c, $0F7 c,
  10.         end-code
  11.  
  12. fload chartbl   \ 8x8 pixel character table
  13.  
  14. code dxy_addr ( x y -- [bitmask] addr )  \ point to byte and bit for x,y
  15.  
  16.         cmp     ttos # 128
  17.         0>= if                  \ wrap around for y > 127
  18.                 clrb    w1
  19.                 ldb     w0 ttos
  20.                 divub   w0 # 128
  21.                 ldb     ttos w1         \ y mod 128
  22.                 clrb    ttosh
  23.           then
  24.  
  25.         ld      w0 [] psp
  26.         cmp     w0 # 480
  27.         0>= if                  \ wrap around for x > 479
  28.                 clr     w2
  29.                 divu    w0 # 480
  30.                 ld      w0 w2           \ x mod 480
  31.                 st      w0 [] psp
  32.           then
  33.  
  34.         ld      w2 # DBUF       \ start of display buffer
  35.         cmp     w0 # 240
  36.         0< if   inc     w2      \ odd address for x < 240
  37.          else   sub     w0 # 240        \ now have (x mod 240)
  38.          then
  39.  
  40.         ldb     w1 # 239
  41.         subb    w1  w0          \ 239 - ( x mod 240 )
  42.         shrb    w1 # 1
  43.         andb    w1 # $0FE       \   /4  *2
  44.         ldb     w0 w1
  45.         clrb    w1
  46.         add     w2  w0          \ add to address
  47.  
  48.         ldb     w0 ttos
  49.         incb    w0
  50.         andb    w0 # $3F
  51.         ldb     w1 # 63         \ 63 - ( [y+1] mod 64 )
  52.         subb    w1  w0
  53.         ldb     w0 # 120
  54.         mulub   w0  w1          \  * 120
  55.         add     w2  w0          \ add to address
  56.                         \ now the address to return is in w2
  57.  
  58.         shr     ttos # 4
  59.         and     ttos # 4        \ 4 * y/64
  60.         ld      w0 [] psp
  61.         and     w0 # 3          \ x mod 4
  62.         add     w0 ttos
  63.         add     w0 # bitmasks
  64.         st      w0 [] psp       \ return [bitmask] next-on-stack
  65.  
  66.         ld      ttos  w2        \ return display address in top-of-stack
  67.         ret
  68.  
  69.         end-code
  70.  
  71. \ Note that the following code can be used from hilevel
  72. \ ( because of the "code" name ), or called directly from a code
  73. \ difinition ( because of the "label" name ).
  74. \ Note that the "label" and "code" lines must stay together.
  75.  
  76. code  dLPLOT-lab ( x y -- ) \ set color of pixel at x,y
  77.         end-code
  78. code dLPLOT ( x y -- ) \ set color of pixel at x,y
  79.         call    dxy_addr
  80.         ldb     w2 [] ttos      \ get display byte
  81.         ld      w0 [] psp       \ address of bitmask
  82.         bitset tcolor 7 if  orb     w2 [] w0
  83.                       else  andb    w2 [I] 8 w0    \ change the bit
  84.                       then
  85.         stb     w2 [] ttos      \ store the changed display byte
  86.         add     psp # 2
  87.         load_ttos               \ pop two off stack
  88.         ret
  89.         end-code
  90.  
  91. code dLPOINT ( x y -- n1 )   \ Get status of pixel at x,y
  92.         call    dxy_addr
  93.         ld      w0 [] psp       \ address of bitmask is next-on-stack
  94.         ldb     w0 [] w0        \ now get bitmask in w0
  95.         andb    w0 [] ttos      \ now and with display byte
  96.         add     psp # 2         \ pop one off stack
  97.         ld      ttos w0
  98.         ret
  99.         end-code
  100.  
  101. code L-emit ( c -- )   \ display character c
  102.     push    tcolor
  103.     sub     psp # 2             \ make room for x on stack
  104.     shl     ttos # 3
  105.     add     ttos # tchartbl     \ point to character in table
  106.  
  107.     ldb     w2 # 8
  108.     begin
  109.         ld      w0 [] sp    \ get saved color
  110.         push    ttos
  111.         ldb     tcolor [] ttos              \ get a byte from the table
  112.         bitclear w0 7 if  not tcolor  then  \ invert if dark
  113.         ldb     w3 # 8
  114.         begin
  115.             push    w2
  116.             ld      ttos # 8
  117.             subb    ttos w3
  118.             add     ttos tlcdx
  119.             st      ttos [] psp     \ pixel x
  120.             ldb     ttos # 8
  121.             subb    ttos w2
  122.             add     ttos tlcdy      \ pixel y
  123.             call    dlplot-lab
  124.             sub     psp # 4     \ ( dlplot popped 2 off the stack )
  125.             pop     w2
  126.             shl     tcolor # 1
  127.             dec0= w3 until
  128.         pop     ttos
  129.         inc     ttos
  130.         dec0= w2 until
  131.  
  132.     add     tlcdx # 8
  133.     cmp     tlcdx # 480
  134.     0>= if
  135.             add     tlcdy # 8
  136.             clr     tlcdx
  137.             cmp     tlcdy # 128
  138.             0>= if  clr tlcdy    then
  139.       then
  140.     add     psp # 2
  141.     ld      ttos []+ psp        \ pop one off stack
  142.     pop tcolor
  143.     ret
  144.     end-code
  145.  
  146. : dark ( -- ) \ clear the screen to all dark
  147.         DBUF
  148.         ROWS ROW_WORDS * 2*  $FF fill  ;
  149.  
  150. : light ( -- ) \ clear the screen to all white
  151.         DBUF
  152.         ROWS ROW_WORDS * 2*  erase  ;
  153.  
  154. : testemit ( -- ) \ test the LCD emit by filling the screen with text
  155.         light           \ clear the screen
  156.         0 tlcdx !       \ start at top left corner
  157.         0 tlcdy !
  158.         480 8 /         \ for the whole screen...
  159.         128 8 / *
  160.         0 do    i 127 and l-emit        \ emit incrementing characters
  161.                 loop
  162.         ;
  163.  
  164. ' l-emit alias emit
  165.  
  166. : at  ( x y -- )   \  place characters at x,y
  167.         8 * tlcdy !
  168.         8 * tlcdx !  ;
  169.  
  170.  
  171. comment:
  172.  
  173. code JUMPTABLE
  174.         0 , 0 , 0 , 0 ,  0 , 0 , 0 , 0 ,
  175.         0 , 0 , 0 , 0 ,  0 , 0 , 0 , 0 ,
  176.         end-code
  177.  
  178. dlplot-LAB  $100 - $1000 +  jumptable t!
  179. T['] dlpoint jumptable 2+ t!
  180. ' l-emit  jumptable 4 + t!
  181. ' dark    jumptable 6 + t!
  182. ' light   jumptable 8 + t!
  183.  
  184. : lemit ( c -- )
  185.         tcolor @
  186.         swap  8 *  tchartbl +
  187.         8 0 do  dup @
  188.                 2 pick  0= if  not  then
  189.                 8 0 do  dup tcolor !
  190.                         i tlcdx @ +  over  lplot
  191.                         2*
  192.                         loop
  193.                 drop 1+
  194.                 loop
  195.         drop
  196.         tlcdx @ 8 +
  197.         dup 480 >= if  drop 0  tlcdy 8 +!  then
  198.         tlcdx !
  199.         tcolor !  ;
  200. comment;
  201.  
  202.