home *** CD-ROM | disk | FTP | other *** search
/ Falcon 030 Power 2 / F030_POWER2.iso / ST_STE / MAGS / ICTARI08.ARJ / ictari.08 / GFA / BITMAP_G.GFA (.txt) next >
GFA-BASIC Atari  |  1994-01-08  |  4KB  |  161 lines
  1. '  --------  BEGIN constants  --------
  2. no_planes|=4                  ! Number of planes (1 to 16) => Colors
  3. plane_bits|=16                ! Size of each plane (in pixel bits): 8,16,24,32
  4. s_addr%=XBIOS(2)              ! EVEN bitmap address (in bytes)      ¯ ¯¯
  5. s_leng%=32000                 ! Bitmap length (in bytes): Needed for @exist only
  6. '
  7. plane_size|=plane_bits| DIV 8
  8. block_size|=no_planes|*plane_size|
  9. total_blocks%=s_leng% DIV block_size|
  10. total_pixels%=total_blocks%*plane_bits|
  11. IF plane_size|=4
  12.   p_mask%=2^31-1
  13.   n_mask%=-2^31
  14.   plane_mask%=@sign(2^plane_bits|-1)
  15. ELSE
  16.   plane_mask%=2^plane_bits|-1
  17. ENDIF
  18. '  --------  END constants  --------
  19. '
  20. '
  21. '  --------  BEGIN main program  --------
  22. color%=3
  23. pixel%=319+199*320
  24. IF @exist(pixel%)
  25.   write_pixel(pixel%,color%)
  26.   PRINT @read_pixel(pixel%)
  27. ENDIF
  28. '
  29. pixel%=0
  30. WHILE pixel%<total_pixels%
  31.   write_pixel(pixel%,color%)
  32.   INC pixel%
  33. WEND
  34. '
  35. PRINT CHR$(7);
  36. ~INP(2)
  37. EDIT
  38. '  --------  END main program  --------
  39. '
  40. '
  41. '  --------  BEGIN utilities  --------
  42. DEFFN exist(pixel%)=pixel% DIV plane_bits|<total_blocks%
  43. ' **TRUE if pixel`s block exists, otherwise FALSE**
  44. '
  45. DEFFN block(pixel%)=pixel% DIV plane_bits|
  46. ' **Pixel`s block**
  47. '
  48. DEFFN b_addr(pixel%)=(pixel% DIV plane_bits|)*block_size|
  49. ' **(Even) address of pixel`s block**
  50. '
  51. DEFFN position(pixel%)=plane_bits|-pixel% MOD plane_bits|-1
  52. ' **Pixel`s bit(s) within block**
  53. '
  54. FUNCTION bin$(plane%)
  55.   LOCAL leng|
  56.   leng|=plane_bits|-LEN(BIN$(plane%))
  57.   RETURN STRING$(leng|,"0")+BIN$(plane%)
  58. ENDFUNC
  59. '
  60. DEFFN get_bit(data%,mask%)=(data% AND mask%) DIV mask%
  61. ' **mask% = 2^bit_to_get**
  62. '
  63. DEFFN set_bit(data%,mask%)=data% OR mask%
  64. ' **mask% = 2^bit_to_set**
  65. '
  66. DEFFN reset_bit(data%,inv_mask%)=inv_mask% XOR plane_mask% AND data%
  67. ' **inv_mask% = 2^bit_to_reset**
  68. '
  69. FUNCTION sign(long#)
  70.   IF long#>p_mask%
  71.     ADD long#,n_mask%
  72.     long#=long# OR n_mask%
  73.   ENDIF
  74.   RETURN long#
  75. ENDFUNC
  76. '
  77. '
  78. > FUNCTION read_plane(b_addr%,plane_count|)
  79.   LOCAL l_addr%,plane%
  80.   l_addr%=s_addr%+b_addr%+plane_count|*plane_size|
  81.   IF plane_size|=1
  82.     plane%=PEEK(l_addr%)
  83.   ELSE IF plane_size|=2
  84.     plane%=DPEEK(l_addr%)
  85.   ELSE IF plane_size|=3
  86.     plane%=PEEK(l_addr%)*65536+PEEK(l_addr%+1)*256+PEEK(l_addr%+2)
  87.   ELSE
  88.     plane%=LPEEK(l_addr%)
  89.   ENDIF
  90.   RETURN plane%
  91. ENDFUNC
  92. '
  93. > PROCEDURE write_plane(b_addr%,plane_count|,plane%)
  94.   LOCAL l_addr%
  95.   l_addr%=s_addr%+b_addr%+plane_count|*plane_size|
  96.   IF plane_size|=1
  97.     POKE l_addr%,plane%
  98.   ELSE IF plane_size|=2
  99.     DPOKE l_addr%,plane%
  100.   ELSE IF plane_size|=3
  101.     POKE l_addr%,plane% DIV 65536
  102.     POKE l_addr%+1,plane% DIV 256
  103.     POKE l_addr%+2,plane% MOD 256
  104.   ELSE
  105.     LPOKE l_addr%,plane%
  106.   ENDIF
  107. RETURN
  108. '
  109. > FUNCTION read_pixel(pixel%)  !--GENERIC--
  110.   LOCAL b_addr%,mask%,plane_count|,plane%,color%
  111.   b_addr%=@b_addr(pixel%)
  112.   IF plane_size|=4
  113.     mask%=@sign(2^@position(pixel%))
  114.   ELSE
  115.     mask%=2^@position(pixel%)
  116.   ENDIF
  117.   plane_count|=0
  118.   color%=0
  119.   WHILE plane_count|<no_planes|
  120.     plane%=@read_plane(b_addr%,plane_count|)
  121.     IF @get_bit(plane%,mask%)=1
  122.       color%=@set_bit(color%,2^plane_count|)
  123.     ENDIF
  124.     INC plane_count|
  125.   WEND
  126.   RETURN color%
  127. ENDFUNC
  128. '
  129. > PROCEDURE write_pixel(pixel%,color%)  !--GENERIC--
  130.   LOCAL b_addr%,mask%,plane_count|,plane%
  131.   b_addr%=@b_addr(pixel%)
  132.   IF plane_size|=4
  133.     mask%=@sign(2^@position(pixel%))
  134.   ELSE
  135.     mask%=2^@position(pixel%)
  136.   ENDIF
  137.   plane_count|=0
  138.   WHILE plane_count|<no_planes|
  139.     plane%=@read_plane(b_addr%,plane_count|)
  140.     IF @get_bit(color%,2^plane_count|)=1
  141.       plane%=@set_bit(plane%,mask%)
  142.     ELSE
  143.       plane%=@reset_bit(plane%,mask%)
  144.     ENDIF
  145.     write_plane(b_addr%,plane_count|,plane%)
  146.     INC plane_count|
  147.   WEND
  148. RETURN
  149. '
  150. '
  151. ' +----------------------------------------------------------------------------+
  152. ' |Utilities proposed as future developments:                                  |
  153. ' |~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~                                  |
  154. ' |XOR 'mode', sprite 'modes', etc [to accompany Write_plane, Write_pixel, etc]|
  155. ' |Fill(write)_block, Fill_raster [mono & color], Read_block?, Copy_raster, etc|
  156. ' + -  -  -  -  -  -  -  -  -  -  -   -  -  -  -  -  -  -  -  -  -  -  -  -  - +
  157. ' |H_line, V_line, Diagonal_line, Frame, Box, Triangle, Circle?, Text?, etc etc|
  158. ' +----------------------------------------------------------------------------+
  159. '
  160. '  --------  END utilities  --------
  161.