( ; This program parses and shows bmp. ; Only 32-bit RGB format is supported at the moment. ; ; To run it: ; cat pika-rgb32.bmp | crsn bmp-parser.csn (def HUGEPIXELS 1) (ld r0 @cin_r)(cmp r0 'B' (ne? (fault "Bad magic"))) (ld r1 @cin_r)(cmp r1 'M' (ne? (fault "Bad magic"))) (ldn _ @cin_r 8) (sym datastart r6) (call rd4) (ld datastart res0) (sym hlen r7) (call rd4) (ld hlen res0) (sym w r8) (sym h r9) (call rd4) (ld w res0) (call rd4) (ld h res0) (ldn _ @cin_r 2) ; planes (sym bits r10) (call rd2) (ld bits res0) (call rd4) (tst res0 (nz? (fault "Compression not implemented"))) (ldn _ @cin_r 12) ; image size + resolutions (sym usedcolors r11) (call rd4) (ld usedcolors res0) (ldn _ @cin_r 4) ; read to the end of the 40-byte header (cmp bits 32 (ne? (fault "Only 32-bit supported now"))) ; Skip the palette if any (ld r0 datastart) (sub r0 54) ; Discard bytes until the start of image data. This contains the palette! ; TODO load to a buffer when indexed BMP support is added (ldn _ @cin_r r0) (sym x r4) (sym y r5) (sym dy r12) (ld x 0)(ld y h)(ld dy -1)(dec y) ; test if height is negative (and r0 h 0x8000_0000 (nz? (se32 h) ; sign extend to u64 (mul h -1) (ld dy 1) ; going downward (ld y 0) (dec y) )) (ld r0 w)(ld r1 h) (tst HUGEPIXELS (z? (j :nohuge1))) (mul r0 8)(mul r1 8)(sub r1 8) (:nohuge1) (sc-init r0 r1) ; Here comes the parsing (:nx) (call rd4) (tst HUGEPIXELS (z? (sc-px x y res0)) (nz? (call bigpixel x y res0))) (add x 1) (cmp x w (ne? (j :nx))) (ld x 0) (add y dy (z? (j :end))) (cmp y h (eq? (j :end))) (j :nx) (:end) (sc-blit) (:endl) (sc-poll) (mslp 10) (j :endl) (proc bigpixel x y rgb (ld r4 x)(ld r1 y)(sub r1 1) (mul r4 8)(mul r1 8) (ld r2 r4)(add r2 8) (ld r3 r1)(add r3 8) (ld r0 r4) (:nx) (sc-px r0 r1 rgb) (add r0 1) (cmp r0 r2 (ne? (j :nx))) (ld r0 r4) (add r1 1) (cmp r1 r3 (eq? (ret))) (j :nx) ) (proc rd4 ; Read 4 bytes as little endian (ld8 r0 @cin_r) (ld8/8 r0 @cin_r) (ld8/16 r0 @cin_r) (ld8/24 r0 @cin_r) (ret r0) ) (proc rd2 ; Read 2 bytes as little endian (ld8 r0 @cin_r) (ld8/8 r0 @cin_r) (ret r0) ) )