******************************************************************************* * * * DEGAS Elite Fast Picture Loader * * * * A GEM desk accessory by Charles F. Johnson * * * * Intended to be used with the DEGAS Elite drawing program, which must be * * named "DEGELITE.PRG". Loads DE compressed pictures much faster than DE * * itself; also loads TINY format compressed pictures. * * * ******************************************************************************* * ----------------------------------- * Last revision: 07/24/87 20:42:16 * ----------------------------------- .text move.l #ustack,sp Install my stack ap_init: clr.l ap1rsv appl_init clr.l ap2rsv clr.l ap3rsv clr.l ap4rsv move.l #a_init,aespb bsr aes move.w intout,ap_id move.l #m_reg,aespb menu_register move.w intout,intin move.l #accmsg,addrin bsr aes move.w intout,menuid move.w #4,-(sp) Get resolution trap #14 addq.l #2,sp move.w d0,res And save it move.w #$19,-(sp) Get current drive trap #1 addq.l #2,sp add.b #65,d0 move.l #degdir,a3 move.l #tnydir,a4 move.b d0,(a3)+ move.b d0,(a4)+ move.l #degext,a0 move.l #tnyext,a1 move.w #7,d5 cpydir: move.b (a0)+,(a3)+ Copy the default paths into the move.b (a1)+,(a4)+ directory areas dbf d5,cpydir cmp.w #2,res High res? bne quest No, skip move.b #'3',degdir+7 Set DEGAS directory to "PI3" bra search quest: tst res Low res? bne quest2 move.b #'1',degdir+7 bra search quest2: move.b #'2',degdir+7 search: move.l #$A000,a5 This section searches for the fsel_input s_1: move.l #itmtxt,a4 text "ITEM SELECTOR", then searches move.l #12,d5 backwards for the pointer to this text s_2: move.b (a5),d0 in the fsel object tree. New string cmp.b (a4),d0 addresses can be poked into this location. beq s_3 addq.l #1,a5 bra s_2 s_3: move.l a5,a0 s_4: cmp.b (a5)+,(a4)+ bne s_1 dbf d5,s_4 move.l a0,d0 move.l a0,iasav move.l a0,d1 bclr #0,d1 move.l d1,a0 s_5: subq.l #2,a0 move.l (a0),d1 cmp.l d1,d0 bne s_5 move.l a0,itmadr move.w 8(a0),ilensv Save original string length evntms: move.l #e_mesg,aespb evnt_mesag (All we want is an AC_OPEN) move.l #mspipe,addrin Pass address of message pipe bsr aes cmp.w #40,mspipe Is this an AC_OPEN message? bne evntms No, go back move.w mspipe+8,d0 Is it for this accessory? cmp.w menuid,d0 bne evntms No, go back move.w #$19,-(sp) Get current drive trap #1 addq.l #2,sp move.w d0,curdrv Save it move.w #0,-(sp) Get current pathname move.l #curpth,-(sp) move.w #$47,-(sp) trap #1 addq.l #8,sp move.l #a_find,aespb Let's see if DEGAS Elite is present move.l #dename,addrin bsr aes tst intout Is it in the vicinity? bpl cont1 bail: move.l #no_degas,a5 move.w #1,d5 bsr alert bra ex4 cont1: move.w intout,de_id move.l #mspipe,a5 move.w #$DE00,(a5) move.w ap_id,2(a5) clr.w 4(a5) move.l #a_writ,aespb Request screen addresses from DE move.w de_id,intin move.w #16,intin+2 move.l #mspipe,addrin bsr aes cont2: move.l #e_mult,aespb Wait for a response move.l #intin,a0 move.w #$30,(a0) move.w #2000,28(a0) clr.w 30(a0) move.l #mspipe,addrin bsr aes btst.b #5,intout+1 Timer event? bne bail Yes, DE ain't really here! cmp.w #$DE80,mspipe Is it the proper response? bne bail move.l mspipe+6,pointr Save pointer to array of pointers move.l #mspipe,a5 move.w #$DE01,(a5) move.w ap_id,2(a5) clr.w 4(a5) move.l #a_writ,aespb Get index to current screen move.w de_id,intin move.w #16,intin+2 move.l #mspipe,addrin bsr aes move.l #e_mesg,aespb Wait for the index move.l #mspipe,addrin bsr aes cmp.w #$DE81,mspipe bne bail moveq #0,d0 move.w mspipe+6,d0 Get index to d0 move.l #index,a0 move #7,d1 clr.w d2 ckindx: cmp.b (a0)+,d0 beq ckind2 addq.w #1,d2 dbf d1,ckindx ckind2: add.b #49,d2 move.b d2,wsnum lsl #2,d0 Multiply by 4 (longword indexing) move.l pointr,a0 add.l d0,a0 move.l (a0),screen Save address of current screen move.l pointr,a0 move.l 20(a0),ctlbuf move.l 20(a0),datbuf add.l #10680,datbuf tst res bne not_lo move.l #lo_title,a5 bra do_ttl not_lo: move.l #mh_title,a5 do_ttl: move.w #3,d5 bsr alert cmp.w #3,intout beq ex4 move.w intout,selobj cmp.w #1,selobj DEGAS picture? bne ckpic1 move.l #degdir,diradr Set directory area move.l #dfile,filadr Set filename area move.l #i_deg,txtadr Set text address move.w #id_len,itmlen And text length bra do_wnd ckpic1: move.l #tnydir,diradr If it isn't a Tiny picture here, we're in move.l #tfile,filadr big trouble move.l #i_tny,txtadr move.w #it_len,itmlen do_wnd: move.l #w_get,aespb move.l #intin,a5 clr.w (a5) move.w #4,2(a5) bsr aes move.l intout+2,wx move.l intout+6,ww move.l #w_crea,aespb clr.w (a5) move.l wx,2(a5) move.l ww,6(a5) bsr aes tst intout bpl op_wnd move.l #w_errmsg,a5 move #1,d5 bsr alert bra ex4 op_wnd: move.w intout,whandl move.l #w_open,aespb move.w whandl,(a5) move.l wx,2(a5) move.l ww,6(a5) bsr aes fsel: move.l itmadr,a0 Change the "ITEM SELECTOR" text to something move.l txtadr,(a0) a bit more meaningful move.w itmlen,8(a0) or.w #1,-2(a0) move.l #f_sel,aespb Let's call fsel_input with opcode 90 move.l diradr,addrin move.l filadr,addrin+4 bsr aes move.l itmadr,a0 Restore the fsel text line move.l iasav,(a0) and.w #$FE,-2(a0) move.w ilensv,8(a0) ckfil: move.l filadr,a0 tst.b (a0) Is there a filename here? beq ex3 cmp.w #1,intout+2 OK button? bne ex3 move.l #warnin,a5 move.w #1,d5 bsr alert cmp.w #1,intout bne ex3 clr.w d0 Set current drive from output of move.l diradr,a0 fsel routine move.b (a0),d0 sub.b #65,d0 move.w d0,-(sp) move.w #$0E,-(sp) trap #1 addq.l #4,sp move.l diradr,a0 addq.l #2,a0 Also set pathname from fsel move.l #pathnm,a1 move.l #63,d5 pathlp: tst.b (a0) beq plx1 move.b (a0)+,(a1)+ dbf d5,pathlp plx1: move.l #63,d5 plp2: cmp.b #"\",-(a1) beq plx2 dbf d5,plp2 plx2: addq.l #1,a1 clr.b (a1) pea pathnm move.w #$3B,-(sp) trap #1 addq.l #6,sp clr.w -(sp) How about if we open the chosen file? move.l filadr,-(sp) move.w #$3D,-(sp) trap #1 addq.l #8,sp tst.w d0 Error? bmi ex3 File not found! move.w d0,handle Save file handle goshow: cmp.w #1,selobj Was it DEGAS? bne gosh1 No, skip bsr degas Show it already! bra exit And bail gosh1: bsr do_tiny The only thing left exit: ex3: move.l #w_clos,aespb move.w whandl,intin bsr aes move.l #w_del,aespb bsr aes ex4: move.w curdrv,-(sp) Reset current drive and pathname move.w #$0E,-(sp) trap #1 addq.l #4,sp move.l #curpth,-(sp) move.w #$3B,-(sp) trap #1 addq.l #6,sp bra evntms Go back and wait for another message! * Subroutines * DEGAS pictures degas: move.l #picrez,a5 Get resolution move.l #2,d5 Word bsr readfl move.w picrez,d0 Check possible resolution values move.l #d_legal,a5 move.w #5,d5 cklegl: cmp.w (a5)+,d0 beq dres0 It's a real DE picture dbf d5,cklegl bra bad1 If we get here, this ain't no DE picture! dres0: move.b picrez+1,d0 Do the resolutions match? cmp.b res+1,d0 bne resend No, let's end this charade deg1: bsr getcol Get color palette from file deg2: btst #7,picrez Compressed picture (high bit set)? bne deg3 Yes, skip ahead move.l screen,a5 Read picture data to screen memory move.l #32000,d5 bsr readfl bra do_rts deg3: move.l ctlbuf,a5 Read picture data and animation tables move.l #32000,d5 bsr readfl move.l ctlbuf,a5 Pointer to picture data move.l screen,a4 Pointer to screen tst.b picrez+1 Low res? bne ckmed move.l #3,d5 d5 = nplanes (# of color planes) move.l #199,d4 d4 = scanlines (# of scan lines) move.l #160,d3 d3 = nbytes (# of bytes per line) move.l #6,d2 d2 = offset (Offset to next word in plane) bra deg_d1 ckmed: cmp.b #1,picrez+1 Medium res? bne ckhigh move.l #1,d5 move.l #199,d4 move.l #160,d3 move.l #2,d2 bra deg_d1 ckhigh: move.l #0,d5 Gotta be high res here or something's move.l #399,d4 seriously wrong move.l #80,d3 move.l #0,d2 deg_d1: move.w d5,nplane Save number of color planes deg_decomp: clr.l d1 d1 = sc_ix (scan line index) dd_2: clr.l d0 move.b (a5)+,d0 Get a control byte bmi d_repeat dd_3: move.l a4,a3 Screen pointer add.l d1,a3 Add index move.b (a5)+,(a3) Move byte to screen addq.l #1,d1 Increment index btst #0,d1 Index even? bne dd_4 No, skip add.l d2,d1 Increment to next word in this plane dd_4: dbf d0,dd_3 bra scanend d_repeat: neg.b d0 Complement the count value move.b (a5)+,d6 Get data byte to d6 dd_5: move.l a4,a3 Pointer to screen memory add.l d1,a3 Add index move.b d6,(a3) Store byte to screen addq.l #1,d1 Increment index btst #0,d1 Index even (done a word)? bne dd_6 No, skip add.l d2,d1 Set to next word in the plane dd_6: dbf d0,dd_5 Do the rest scanend: cmp.l d3,d1 Index less than number of bytes per line? blt dd_2 Yes, branch back sub.l d3,d1 Subtract # of bytes, then add 2 to add.l #2,d1 point to beginning of next plane dbf d5,dd_2 Count planes move.w nplane,d5 Reset plane counter add.l d3,a4 Increment screen pointer to next scan line dbf d4,deg_decomp Count scan lines bra do_rts And skip ahead * TINY pictures do_tiny: move.l #picrez,a5 Once again, the resolution is first move.l #1,d5 But this time, it's a byte bsr readfl cmp.b #3,picrez Greater than 2? (Indicates rotation info) blt do_t2 No, skip sub.b #3,picrez Subtract 3 for real resolution move.l #cycle,a5 Read 4 bytes of rotation info move.l #4,d5 bsr readfl do_t2: move.b picrez,picrez+1 Let's make this byte value into a word clr.b picrez move.w picrez,d0 cmp.w res,d0 Make sure our resolutions match beq do_col resend: move.l #wrong,a5 goalrt: move.w #1,d5 bsr alert bra do_rt2 do_col: bsr getcol move.l #ctlcnt,a5 Get the number of control bytes move.l #2,d5 Word value bsr readfl move.l #datcnt,a5 Get the number of data words move.l #2,d5 Word value bsr readfl cmp #10667,ctlcnt Make sure the file's OK bhi bad1 cmp #16000,datcnt bls do_t3 bad1: move.l #badfil,a5 This file stinks! bra goalrt do_t3: move.l ctlbuf,a5 Read in the control bytes clr.l d5 move.w ctlcnt,d5 bsr readfl move.l d0,actctl Save number of bytes actually read lsl datcnt Multiply by 2 to get number of data bytes move.l datbuf,a5 Read in the data words clr.l d5 move.w datcnt,d5 bsr readfl move.l d0,actdat Save number actually read clr.l d5 move.w ctlcnt,d5 Did we read as many bytes as we were cmp.l actctl,d5 supposed to? bne bad1 No, what a screwed-up file this is! move.w datcnt,d5 cmp.l actdat,d5 bne bad1 bsr decompress Go decompress it do_rts: bsr rescol do_rt2: move.w handle,-(sp) Close the file and return move.w #$3E,-(sp) trap #1 addq.l #4,sp rts * The Tiny decompression routine decompress: clr.l d0 d0 = index into screen memory move.l screen,a0 a0 -> start of screen memory move.w ctlcnt,d1 Get number of control bytes subq.w #1,d1 Subtract one for dbf move.l ctlbuf,a1 a1 -> control buffer move.l datbuf,a2 a2 -> data buffer decom1: clr.w d3 Make sure the high byte is clean move.b (a1)+,d3 Get a byte of control data tst.b d3 Is it less than zero? bpl decom2 No, skip neg.b d3 Complement it (My, you look nice!) bsr unique This is the count of unique data bra next next? decom2: tst.b d3 Is it zero? beq decom3 Yes, skip ahead cmp.b #1,d3 Is it one? bne decom4 No, skip over decom3: move.b (a1)+,d4 If it's zero or one, the next two bytes lsl.w #8,d4 are the count move.b (a1)+,d4 subq.w #2,d1 Adjust the counter exg d4,d3 Exchange 'em tst.b d4 Was the control byte zero? bne dc3_1 No, skip bsr repeat Zero means repeating data bra next dc3_1: bsr unique One means unique data bra next decom4: bsr repeat If we get here, d3 is a simple repeat count next: dbf d1,decom1 Count down and loop rts unique: subq.w #1,d3 Adjust count for dbf u1: move.w (a2)+,d5 Read unique words from data area bsr toscreen and put 'em on screen dbf d3,u1 Count down and loop rts Done repeat: subq.w #1,d3 Adjust count move.w (a2)+,d5 Get the repeating data word rpt1: bsr toscreen And put it on screen dbf d3,rpt1 Count down and loop rts toscreen: move.w d0,d4 Get index offset lsl d4 Multiply by 2 (we're dealing with words here!) move.w d5,0(a0,d4) Put the data on screen add.w #80,d0 Increment the index cmp #15999,d0 At bottom of this column? ble to_rts No, skip sub #15996,d0 Set index back to top +1 line cmp #79,d0 At end of row? ble to_rts No, skip sub #79,d0 Back to start of next row to_rts: rts rescol: cmp.w #$005,colors+4 DEGAS Elite has a bug! It doesn't like bne resc1 getting a palette-change message with the move.w #$015,colors+4 value $005 in color register 2!!! resc1: move.l #mspipe,a5 move.w #$DE04,(a5) move.w ap_id,2(a5) move.w #32,4(a5) move.w #1,6(a5) move.l #a_writ,aespb move.w de_id,intin move.w #48,intin+2 move.l #mspipe,addrin bra aes getcol: move.l #colors,a5 Get the color palette move.l #32,d5 * Read a file * Enter with: a5= address of buffer * d5= number of bytes to read readfl: move.l a5,-(sp) move.l d5,-(sp) move.w handle,-(sp) move.w #$3F,-(sp) trap #1 add.l #12,sp tst.l d0 rts * form_alert * Enter with a5= address of definition string * d5= number of default box alert: move.l a5,addrin Set address of string move.w d5,intin Set default box move.l #f_alrt,aespb Display alert box aes: move.l #aespb,d1 The subroutine that calls the AES move.l #$c8,d0 trap #2 rts .data .even aespb: dc.l contrl,global,intin,intout,addrin,addrout .even ds.w 1 dc.l itmtxt * Dummy pointer (safety factor for fsel search) itmtxt: dc.b 'ITEM SELECTOR',0 accmsg: dc.b ' DE Fast Loader',0 dename: dc.b 'DEGELITE',0 no_degas: dc.b '[3][ The DEGAS Elite Fast Loader |' dc.b " only works while DEGAS Elite|" dc.b " is running. I've searched,|" dc.b " but I can't find it!| " dc.b '][ Cancel ]' lo_title: dc.b '[0][ | DEGAS Elite Fast Loader |' dc.b ' -----------------------|' dc.b 189,' 1987 Charles F. Johnson| ' dc.b '][ DEGAS |Tiny|Exit]' mh_title: dc.b '[0][ DEGAS Elite Fast Loader |' dc.b ' -----------------------|' dc.b ' ',189,' 1987 Charles F. Johnson| ' dc.b '][ DEGAS |Tiny|Cancel]' w_errmsg: dc.b '[3][ A highly unlikely error |' dc.b ' has just occurred.| ][ Sheesh! ]' warnin: dc.b '[2][This will replace workscreen|#' wsnum: dc.b ' and change the current|' dc.b 'color palette...continue?| ]' dc.b '[ Yes |No]' badfil: dc.b '[3][This file has an incorrect |format!| ][ Sorry! ]' wrong: dc.b "[3][This picture's in the wrong |resolution!| ][ Sorry! ]" i_deg: dc.b ' Which DEGAS picture? ' id_dum: dc.b 0 id_len = (id_dum-i_deg)*8 i_tny: dc.b ' Which TINY picture? ' it_dum: dc.b 0 it_len = (it_dum-i_tny)*8 degext: dc.b ':\*.P??',0 tnyext: dc.b ':\*.TNY',0 index: dc.b 1,2,7,8,9,10,11,12 .even a_init: dc.w 10,0,1,0,0 a_writ: dc.w 12,2,1,1,0 a_find: dc.w 13,0,1,1,0 e_mesg: dc.w 23,0,1,1,0 e_mult: dc.w 25,16,7,1,0 m_reg: dc.w 35,1,1,1,0 f_alrt: dc.w 52,1,1,1,0 f_sel: dc.w 90,0,2,2,0 w_crea: dc.w 100,5,1,0,0 w_open: dc.w 101,5,5,0,0 w_clos: dc.w 102,1,1,0,0 w_del: dc.w 103,1,1,0,0 w_get: dc.w 104,2,5,0,0 d_legal: dc.w $8000,$8001,$8002,$0000,$0001,$0002 .bss .even pointr: ds.l 1 screen: ds.l 1 ctlbuf: ds.l 1 datbuf: ds.l 1 itmadr: ds.l 1 iasav: ds.l 1 txtadr: ds.l 1 diradr: ds.l 1 filadr: ds.l 1 de_id: ds.w 1 itmlen: ds.w 1 ilensv: ds.w 1 curdrv: ds.w 1 handle: ds.w 1 res: ds.w 1 menuid: ds.w 1 selobj: ds.w 1 ap_id: ds.w 1 wx: ds.w 1 wy: ds.w 1 ww: ds.w 1 wh: ds.w 1 whandl: ds.w 1 nplane: ds.w 1 picrez: ds.w 1 cycle: ds.l 1 ctlcnt: ds.w 1 datcnt: ds.w 1 actctl: ds.l 1 actdat: ds.l 1 contrl: ds.w 12 intin: ds.w 128 intout: ds.w 128 global: apvrsn: ds.w 1 apcont: ds.w 1 apid: ds.w 1 apprvt: ds.l 1 apptre: ds.l 1 ap1rsv: ds.l 1 ap2rsv: ds.l 1 ap3rsv: ds.l 1 ap4rsv: ds.l 1 addrin: ds.w 128 addrout:ds.w 128 mspipe: ds.b 16 colors: ds.w 16 dfile: ds.b 16 tfile: ds.b 16 degdir: ds.b 64 tnydir: ds.b 64 pathnm: ds.b 64 curpth: ds.b 64 ds.l 300 ustack: ds.l 1 ds.w 10 .end