;GIF File reader and converter ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;(c) 1993 Simon Cooke ;The usual copyright applies - OKAY CHRIS???!!!!!!!!!!!! ;Time flies like an arrow.... ;Fruit-flies like a banana! ;Things to do ;=-=-=<>=-=-= ;Modify so that it can handle OTHER than just 8bit piccies ;Quantized palette relocation ;Bayer filters... ORG &8000 DUMP 1,0 lmpr: EQU &FA hmpr: EQU &FB vmpr: EQU &FC brdr: EQU &FE gif.l.off: EQU 0 ;GIF loaded at 65536 gif.l.p: EQU 3 put.off: EQU 0 ;final image stored page 13... put.p: EQU 11 scr.width: EQU 128 scr.depth: EQU 192/2 x.start: EQU 128-16 y.start: EQU 180 decode.method: EQU 3 ;For decoding methods: ;0 - monochrome ;1 - bayer dither ;2 - 1 bit guns (BRMGCYW - speccy colours) ;3 - 1 bit guns , bayer dithered... ;4 - quantized palette start: DI CALL initialise IN A,(lmpr) LD (lmpr.store),A IN A,(vmpr) LD (vmpr.store),A LD (sp.store),SP LD SP,other.stack CALL convert.gif CALL show.gif ret.to.basic: LD A,(lmpr.store) OUT (lmpr),A LD A,(vmpr.store) OUT (vmpr),A LD SP,(sp.store) okayer: LD A,&7F IN A,(&FE) RRA RRA JR C,okayer LD A,(error) OR A JR Z,palette LD L,A LD H,0 ADD HL,HL LD DE,error.table ADD HL,DE LD E,(HL) INC HL LD D,(HL) EX DE,HL CALL send.message palette: LD A,(decode.flags) OR A JR NZ,not.monoc LD HL,lum.palette JR out.pal not.monoc: LD HL,bayer.palette out.pal: PUSH HL LD DE,&55D8 LD BC,16 LDIR POP HL LD DE,&55D8+20 LD BC,16 LDIR LD BC,(return.code) ;VALUE TO RETURN TO BASIC EI RET ;Initialise routines ;-=-=-=-=-=-=-=-=-=- initialise: LD A,&FE CALL &112 LD HL,init.errors CALL send.message LD HL,gif.l.off LD A,gif.l.p LD (read.off),HL LD (read.p),A LD A,put.p LD HL,put.off LD (stash.off),HL LD (stash.p),A LD HL,scr.width LD (w.width),HL LD HL,scr.depth LD (w.depth),HL LD HL,x.start LD (w.x.off),HL LD HL,y.start LD (w.y.off),HL LD A,decode.method LD (decode.flags),A RET ;Convert GIF ;-=-=-=-=-=- convert.gif: LD HL,gif LD B,3 gif_check: ;Check for GIF header CALL read.byte XOR (HL) INC HL JR NZ,not_gif DJNZ gif_check CALL read.byte LD (gif.err.a),A SUB "0" ADD A,A ADD A,A ADD A,A ADD A,A LD E,A CALL read.byte LD (gif.err.a+1),A SUB "0" OR E LD (gif.type),A CALL read.byte LD (gif.type2),A LD (gif.err.a+2),A CP "a" JR NZ,unknown_versn LD A,(gif.type) CP &87 JR Z,id_done CP &89 JR Z,id_done unknown_versn: LD A,5 ;GIFxxx LD (error),A JR id_done not_gif: LD A,4 ;Not a GIF file LD (error),A JP ret.to.basic id_done: LD A,E LD (gif.type),A CALL read.word LD (p.width),DE CALL read.word LD (p.depth),DE CALL read.byte LD (global.flags),A CALL read.byte LD (border),A CALL read.byte ;ASPECT (ignore) LD HL,global.palette LD A,(global.flags) LD (palette.in.use),HL BIT 7,A CALL NZ,read.pal ;read in global pal ;if there is one... ;NOW read extensions... read.extension: CALL read.byte CP ";" ;END OF GIF block RET Z CP "!" ;ARBITRARY EXTENSION block JR Z,read.ext CP "," ;IMAGE block JR Z,image.ext unrec.ext: LD L,A LD H,0 LD (return.code),HL LD A,6 ;Unrecognised extension LD (error),A JP ret.to.basic ;Read arbitrary extension block read.ext: CALL read.byte CP &FE JR NZ,not.comment ;Comment extension block - raw ASCII text. ;(passed over - not acted upon in this version!) ;1st byte - field length. IF 0, end of COMMENT block ; otherwise, read FIELDLENGTH bytes and try again! comment.block: CALL read.byte ;loop counter OR A JR Z,read.extension ;end of COMMENT block LD B,A comment.loop: CALL read.byte DJNZ comment.loop JR comment.block not.comment: CP &01 JR NZ,not.ptext ;Plain-text extension block ;(again, passed over...) ;Header defining text use, then text as in COMMENT block! CALL read.long ;merely skip over header... CALL read.long CALL read.long CALL read.byte JR comment.block not.ptext: CP &F9 JR NZ,not.cblock ;GFX Control block ;(you guessed it...) CALL read.long CALL read.word JR read.extension not.cblock: CP &FF ;if not found, summat ;spooky going on... JR NZ,unrec.ext ;APPLICATION BLOCK ;Yet another one I can't be arsed reading & using... anyway, ;it's not necessary. CALL read.long CALL read.long CALL read.long JR read.extension ;IMAGE EXTENSION ;This one's one that is important... image.ext: CALL read.word LD (i.x.off),DE CALL read.word LD (i.y.off),DE CALL read.word LD (i.width),DE CALL read.word LD (i.depth),DE CALL read.byte LD (local.flags),A LD HL,local.palette LD (palette.in.use),HL LD A,(local.flags) BIT 7,A JR Z,not.local.pal CALL read.pal JR completion not.local.pal: LD HL,global.palette LD (palette.in.use),HL completion: CALL decompress ensure.loop: LD A,(field.f) CP 2 JP Z,read.extension CALL read.field JR ensure.loop ;Show GIF on-screen ;-=-=-=-=<>=-=-=-=- show.gif: LD A,(vmpr.store) AND 31 OR 32 OUT (lmpr),A LD (low.vmpr),A LD HL,put.off LD (read.off),HL LD A,put.p LD (read.p),A LD HL,&0000 LD (c.y.off),HL LD BC,(i.depth) depth.loop: PUSH BC LD HL,&0000 LD (c.x.off),HL LD BC,(i.width) width.loop: PUSH BC CALL read.byte LD (currentcode),A ;use a free variable! LD HL,(c.y.off) ;current Y position AND A LD DE,(w.y.off) ;- window y offset SBC HL,DE JP C,not.this.byte ;above window SRL H RR L LD (a.y.off),HL ;actual screen y-coord LD DE,(w.depth) AND A SBC HL,DE ;- window depth JP NC,show.no.more ;below window LD HL,(c.x.off) ;current X position AND A LD DE,(w.x.off) ;- window x offset SBC HL,DE JP C,not.this.byte ;to left of window SRL H RR L LD (a.x.off),HL ;actual screen x-coord LD DE,(w.width) AND A SBC HL,DE ;- window width JP NC,not.this.byte ;to right of window LD A,(decode.flags) OR A JR Z,mono CP 2 JP Z,speccy.col JP C,mono.bayer CP 3 JP Z,colour.bayer JP NC,quantized mono: LD A,(currentcode) LD L,A LD H,0 LD DE,(palette.in.use) INC D INC D INC D ADD HL,DE LD A,(HL) AND &F0 LD B,A RRCA RRCA RRCA RRCA LD C,A JP plot.pixel speccy.col: LD A,(currentcode) LD L,A LD H,0 LD DE,(palette.in.use) ADD HL,DE LD A,(HL) AND %10000000 RRCA RRCA ;red bit LD B,A INC H LD A,(HL) AND %10000000 RRCA RRCA ;green bit OR B LD B,A INC H LD A,(HL) AND %10000000 RRCA RRCA RRCA ;blue bit OR B LD B,A RRCA RRCA RRCA RRCA LD C,A JP plot.pixel colour.bayer: LD DE,bayer.dither LD A,(a.x.off) AND 7 LD L,A LD H,0 LD A,(a.y.off) AND 7 ADD A,A ADD A,A ADD A,A ADD A,L LD L,A ADD HL,DE LD A,(HL) LD (bayer.val),A LD B,0 LD A,(currentcode) LD L,A LD H,0 LD DE,(palette.in.use) ADD HL,DE LD A,(HL) SRL A PUSH HL LD C,A LD A,(bayer.val) CP C JR NC,no.red.bay SET 5,B no.red.bay: POP HL INC H LD A,(HL) SRL A PUSH HL LD C,A LD A,(bayer.val) CP C JR NC,no.gre.bay SET 6,B no.gre.bay: POP HL INC H LD A,(HL) SRL A PUSH HL LD C,A LD A,(bayer.val) CP C JR NC,no.blu.bay SET 4,B no.blu.bay: POP HL LD A,B RRCA RRCA RRCA RRCA LD C,A JP plot.pixel mono.bayer: LD DE,bayer.dither LD A,(a.x.off) AND 7 LD L,A LD H,0 LD A,(a.y.off) AND 7 ADD A,A ADD A,A ADD A,A ADD A,L LD L,A ADD HL,DE LD A,(HL) LD (bayer.val),A LD A,(currentcode) LD L,A LD H,0 LD DE,(palette.in.use) INC D INC D INC D ADD HL,DE LD A,(HL) SRL A SRL A LD C,A LD A,(bayer.val) CP C JR C,bayer.set LD BC,&0000 JP plot.pixel bayer.set: LD BC,&F00F JP plot.pixel quantized: LD A,(currentcode) plot.pixel: LD A,(a.y.off) LD H,A LD A,(a.x.off) LD L,A SRL H RR L JR C,odd.pixel even.pixel: LD A,(HL) AND &0F OR B LD (HL),A JR not.this.byte odd.pixel: LD A,(HL) AND &F0 OR C LD (HL),A not.this.byte: LD HL,(c.x.off) INC HL INC HL LD (c.x.off),HL POP BC DEC BC LD A,B OR C JP NZ,width.loop POP BC LD HL,(c.y.off) INC HL INC HL LD (c.y.off),HL DEC BC LD A,B OR C JP NZ,depth.loop RET show.no.more: POP BC POP BC RET ;Decompress GIF compressed using LZW compression) ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- decompress: CALL init_decomp CALL read.byte ;reads initial codesize LD (bits),A CALL shift.left LD (clearcode),HL INC HL LD (eofcode),HL INC HL LD (nextcode),HL INC A LD (codesize),A CALL shift.left LD (codesize2),HL dec_loop: CALL get.code LD (thiscode),HL LD (currentcode),HL LD DE,(eofcode) ;does THISCODE = EOFCODE? AND A SBC HL,DE RET Z ;end of image not_eof: LD DE,(thiscode) ;if THISCODE > NEXTCODE, LD HL,(nextcode) ;error has occured... AND A SBC HL,DE JR NC,not_overrun LD A,1 ;"Code overrun error in LD (error),A JP ret.to.basic ; decompaction" not_overrun: LD HL,(thiscode) ;does THISCODE = CLEARCODE? LD DE,(clearcode) SBC HL,DE JR NZ,not_clear LD HL,(clearcode) ;if so, re-init all tables INC HL INC HL LD (nextcode),HL LD A,(bits) INC A LD (codesize),A CALL shift.left LD (codesize2),HL XOR A LD (oldcode.f),A JR dec_loop ;begin loop again... not_clear: LD IX,fcodestack LD HL,(thiscode) ;does THISCODE = NEXTCODE? LD DE,(nextcode) AND A SBC HL,DE JR NZ,unpack_loop LD A,(oldcode.f) OR A JR NZ,old_flagged LD A,2 ;"Prefix error in LD (error),A JP ret.to.basic ; decompaction" old_flagged: LD A,(oldtoken) LD (IX),A INC IX LD HL,(oldcode) LD (thiscode),HL unpack_loop: LD HL,(thiscode) ;THISCODE = CLEARCODE? LD DE,(clearcode) AND A SBC HL,DE JR C,end_unpack LD HL,(thiscode) LD DE,lcodestack ADD HL,DE LD A,(HL) LD (IX),A INC IX LD HL,(thiscode) ADD HL,HL LD DE,codestack ADD HL,DE LD E,(HL) INC HL LD D,(HL) LD (thiscode),DE JR unpack_loop end_unpack: LD A,(thiscode) LD (oldtoken),A copy_pack: LD A,(thiscode) CALL put.byte PUSH IX POP DE AND A LD HL,fcodestack SBC HL,DE JR NC,end_copy DEC IX LD A,(IX) LD (thiscode),A JR copy_pack end_copy: LD A,(oldcode.f) ;does OLDCODE hold a value? OR A ;(NZ if Y, Z if N) JR Z,not_inc_next LD HL,(nextcode) ;NEXTCODE < 4096? LD DE,4096 AND A SBC HL,DE JR NC,not_inc_next LD HL,(nextcode) ADD HL,HL LD DE,codestack ADD HL,DE LD DE,(oldcode) LD (HL),E INC HL LD (HL),D LD HL,(nextcode) LD DE,lcodestack ADD HL,DE LD A,(oldtoken) LD (HL),A LD HL,(nextcode) INC HL LD (nextcode),HL LD DE,(codesize2) ;is NEXTCODE >= CODESIZE2? AND A SBC HL,DE JR C,not_inc_next LD A,(codesize) ;is CODESIZE < 12? CP 12 JR NC,not_inc_next INC A LD (codesize),A CALL shift.left LD (codesize2),HL not_inc_next: LD HL,(currentcode) LD (oldcode),HL LD A,1 LD (oldcode.f),A JP dec_loop ;Performs: 2^A ;Returns answer in HL shift.left: LD HL,1 PUSH AF shift.l.loop: OR A JR NZ,shift.l.o POP AF RET shift.l.o: ADD HL,HL DEC A JR shift.l.loop ;Gets n-bit code from data store... get.code: PUSH AF PUSH DE PUSH BC LD B,0 LD HL,&0000 code.loop: LD A,(bits.left) CP 8 JR C,not.new.byte SUB 8 LD (bits.left),A CALL read.field LD (last.read),A not.new.byte: LD A,(bits.left) INC A LD (bits.left),A DEC A EXX LD HL,bits.table LD E,A LD D,0 ADD HL,DE LD E,(HL) LD A,(last.read) AND E ;mask off bit no' (BITS.LEFT) EXX JR Z,end.code LD A,B ;LD A, EXX LD L,A LD H,0 ADD HL,HL LD DE,code.table ADD HL,DE LD A,(HL) EXX LD E,A EXX INC HL LD A,(HL) EXX LD D,A ADD HL,DE end.code: INC B LD A,(codesize) CP B JR NZ,code.loop LD (return.code),HL POP BC POP DE POP AF RET read.field: field.loop: LD A,(field.f) CP 1 JR Z,data_ready ;if 1, field has been accessd JR C,start_field ;if 0, no field currently in ;use... ;Any other value means overrun... LD A,3 ;read over length of GIF! LD (error),A JP ret.to.basic start_field: LD A,1 LD (field.f),A CALL read.byte LD (bytes.left),A data_ready: CALL read.byte LD (exitvalue),A LD A,(bytes.left) DEC A LD (bytes.left),A OR A JR NZ,exit.field CALL read.byte LD (bytes.left),A OR A LD A,2 JR Z,end.of.fields LD A,1 end.of.fields: LD (field.f),A exit.field: LD A,(exitvalue) RET ;Read long from address at READ.OFF, READ.P and increment the ;pointer... ;Goes in order (MSB>LSB): BCDE read.long: PUSH HL PUSH AF IN A,(lmpr) PUSH AF LD A,(read.p) OR 32 OUT (lmpr),A EX AF,AF' LD HL,(read.off) LD E,(HL) INC HL LD D,(HL) INC HL LD C,(HL) INC HL LD B,(HL) INC HL BIT 6,H JR Z,readhl RES 6,H LD A,(read.p) INC A AND 31 LD (read.p),A readhl: LD (read.off),HL POP AF OUT (lmpr),A POP AF POP HL RET ;Read word from address at READ.OFF, READ.P and increment the ;pointer... ;MSB>LSB: DE read.word: PUSH HL PUSH AF IN A,(lmpr) PUSH AF LD A,(read.p) OR 32 OUT (lmpr),A EX AF,AF' LD HL,(read.off) LD E,(HL) INC HL LD D,(HL) INC HL BIT 6,H JR Z,readhw RES 6,H LD A,(read.p) INC A AND 31 LD (read.p),A readhw: LD (read.off),HL POP AF OUT (lmpr),A POP AF POP HL RET ;Read byte from address at READ.OFF, READ.P and increment the ;pointer... ;CORRUPTS: AF' read.byte: ;CHECK FOR KEY LD A,&7F IN A,(&FE) RRA RRA JP NC,ret.to.basic PUSH HL LD A,R AND %00100111 OUT (brdr),A IN A,(lmpr) PUSH AF LD A,(read.p) OR 32 OUT (lmpr),A EX AF,AF' LD HL,(read.off) LD A,(HL) EX AF,AF' INC HL BIT 6,H JR Z,readhh RES 6,H LD A,(read.p) INC A AND 31 LD (read.p),A readhh: LD (read.off),HL POP AF OUT (lmpr),A XOR A OUT (brdr),A EX AF,AF' POP HL RET ;Put byte into address at STASH.OFF, STASH.P and increment the ;pointer... ;CORRUPTS: AF', (STASH.OFF,STASH.P) put.byte: PUSH AF PUSH HL EX AF,AF' IN A,(lmpr) PUSH AF LD A,(stash.p) OR 32 OUT (lmpr),A EX AF,AF' LD HL,(stash.off) LD (HL),A INC HL BIT 6,H JR Z,stashh RES 6,H LD A,(stash.p) INC A AND 31 LD (stash.p),A stashh: LD (stash.off),HL EX AF,AF' POP AF OUT (lmpr),A POP HL POP AF RET init_decomp: LD A,8 LD (bits.left),A XOR A LD (oldcode.f),A LD (field.f),A LD (bytes.left),A RET ;Prints message. Delimited by a 255 byte send.message: LD A,(HL) CP 255 RET Z RST &10 INC HL JR send.message ;Reads palette into store ;STORE=HL, bits in palette =bits 2-0 of A read.pal: PUSH BC PUSH DE AND 7 INC A EX DE,HL CALL shift.left PUSH HL POP BC EX DE,HL pal.loop: CALL read.byte ;read.r LD (HL),A INC H EXX LD L,A LD H,0 LD DE,r.lum ADD HL,DE LD B,(HL) EXX CALL read.byte ;read.g LD (HL),A INC H EXX LD L,A LD H,0 LD DE,g.lum ADD HL,DE EX AF,AF' LD A,(HL) ADD A,B LD B,A EX AF,AF' EXX CALL read.byte ;read.b LD (HL),A INC H EXX LD L,A LD H,0 LD DE,b.lum ADD HL,DE EX AF,AF' LD A,(HL) ADD A,B LD B,A EX AF,AF' EXX EXX LD A,B EXX LD (HL),A DEC H DEC H DEC H INC HL DEC BC LD A,B OR C JR NZ,pal.loop POP DE POP BC RET ;GIF Conversion data space ;~~~~~~~~~~~~~~~~~~~~~~~~~ bayer.dither: DEFB 0,32,8,40,2,34,10,42 DEFB 48,16,56,24,50,18,58,26 DEFB 12,44,4,36,14,46,6,38 DEFB 60,28,52,20,62,30,54,22 DEFB 3,35,11,43,1,33,9,41 DEFB 51,19,59,27,49,17,57,25 DEFB 15,47,7,39,13,45,5,37 DEFB 63,31,55,23,61,29,53,21 bits.table: DEFB %00000001 DEFB %00000010 DEFB %00000100 DEFB %00001000 DEFB %00010000 DEFB %00100000 DEFB %01000000 DEFB %10000000 code.table: DEFW %0000000000000001 DEFW %0000000000000010 DEFW %0000000000000100 DEFW %0000000000001000 DEFW %0000000000010000 DEFW %0000000000100000 DEFW %0000000001000000 DEFW %0000000010000000 DEFW %0000000100000000 DEFW %0000001000000000 DEFW %0000010000000000 DEFW %0000100000000000 DEFW %0001000000000000 DEFW %0010000000000000 DEFW %0100000000000000 DEFW %1000000000000000 gif: DEFM "GIF" ;RGB > Luminance conversion table grey.data: MDAT "lumen.dat" r.lum: EQU grey.data g.lum: EQU grey.data+256 b.lum: EQU grey.data+512 ;Grey-scale palette for use with luminance values lum.palette: DEFB 0,0,8,5,7,13,15,82 DEFB 112,90,120,117,119,125,127,127 ;RGB basic palette for use with BAYER dither bayer.palette: DEFB 0,17,34,17+34,68,68+17,68+34,127 DEFB 0,17,34,17+34,68,68+17,68+34,127 error.table: DEFW error0,error1,error2,error3,error4,error5 DEFW error6 init.errors: DEFB 22,0,0,255 error0: DEFM "No errors occured" DEFB 255 error1: DEFM "Code overrun error in decompaction" DEFB 255 error2: DEFM "Prefix error in decompaction" DEFB 255 error3: DEFM "Met END OF FILE while decoding!" DEFB 255 error4: DEFM "This is not a GIF file" DEFB 255 error5: DEFM "GIF" gif.err.a: DEFM "xxx" DEFM " is not a recognised version." DEFB 13 DEFM "Thus, an error may " DEFM " have occured" DEFB 255 error6: DEFM "Unrecognised extension block found!" DEFB 255 ;-=-=-=-=-=-=- ;End of saved data... rest is data space length: EQU $-start bayer.val: DEFB &00 palette.in.use:DEFW &0000 decode.flags: DEFB &00 gif.type: DEFB &00 ;either &87 or &89! gif.type2: DEFB &00 global.flags: DEFB &00 global.palette:DEFS &0400 ;R,G,B and L local.flags: DEFB &00 local.palette: DEFS &0400 w.x.off: DEFW &0000 w.y.off: DEFW &0000 w.width: DEFW &0000 w.depth: DEFW &0000 p.width: DEFW &0000 p.depth: DEFW &0000 i.width: DEFW &0000 i.depth: DEFW &0000 i.x.off: DEFW &0000 i.y.off: DEFW &0000 c.x.off: DEFW &0000 c.y.off: DEFW &0000 a.x.off: DEFW &0000 a.y.off: DEFW &0000 border: DEFB &00 lmpr.store: DEFB &00 vmpr.store: DEFB &00 sp.store: DEFW &0000 low.vmpr: DEFB &00 codestack: DEFS 8192 ;16-bit offset table lcodestack: DEFS 4096 ;16-bit offset table fcodestack: DEFS 4096 ;8-bit data table error: DEFB &00 oldcode.f: DEFB &00 bits: DEFB &00 codesize: DEFB &00 codesize2: DEFW &0000 thiscode: DEFW &0000 currentcode: DEFW &0000 clearcode: DEFW &0000 nextcode: DEFW &0000 eofcode: DEFW &0000 oldcode: DEFW &0000 oldtoken: DEFB &00 exitvalue: DEFB &00 bits.left: DEFB &00 last.read: DEFB &00 field.f: DEFB &00 bytes.left: DEFB &00 stash.off: DEFW &0000 stash.p: DEFB &00 read.off: DEFW &0000 read.p: DEFB &00 return.code: DEFW &0000 DEFS 256 other.stack: EQU $ ORG 0 DUMP gif.l.p,gif.l.off MDAT "WC350618"