MCOPY loadpic5.mac KEEP loadpic loadpicture START LCLA &LUP LONGA ON LONGI ON ;Handle Attribute Bits attrBank EQU $0001 fixed bank attrAddr EQU $0002 fixed address attrPage EQU $0004 page aligned attrNoSpec EQU $0008 may not use special memory attrNoCross EQU $0010 may not cross banks attrFixed EQU $4000 not movable attrLocked EQU $8000 locked *-------------------------------------------------------------- * Originally Load Super Hires Picture v1.0. * by Stephen P. Lepisto * * v 5.40 (for ShowPic v5.x) * radically modified by Dave Leffler for ShowPic NDA v2+ * * File types supported: * $c1,00 (unpacked complete image) (anything but QDII pics v5.12) * $c0,01 (packed complete image) * $c0,02 (apple-preferred) * $06 (binary file, 32K) added v2.0 * $c0,00 (paintworks format) added v2.0 * $c0,8000 (paintworks gold 640 format) added v2.1 * $f8,c323 (print shop gs color graphics) added v2.2 * $04 or $06 GIF formated pictues, requires C external routine * * Loads middle or bottom of paint picture if * Apple or Option key held down. added v4.04 * * Requires the following tools to already be started and ready: * Tool Locator * Miscellaneous Tools * Memory Manager * Integer Tools (for multiplying) * * Requires full native mode with 16 bit registers. * *-------------------------------------------------------------- * Input: * parameter table: * 0/3: pointer to where picture is to be unpacked to * 4/7: pointer to file name to load (GS/OS string) * 8/9: flag for middle or bottom of picture * * Output: * accumulator (error number) *-------------------------------------------------------------- * Calling procedure (pascal) : * * const * top = 0; { what part of picture } * middle = 40; * bottom = 80; * * type * inparm = record * Pictptr : ptr; * filename : gsosInStringptr; * bottom : integer; * end; * inparmptr = ^inparm; * function loadpic(inparmptr):integer;extern; {returns error # } * * var inprm : inparm * inptr : inparmptr; * loaded : integer; * * inptr := @inprm; * inptr.Pictptr := graphic_location; * inptr.filename := @GSOSpathname; * inptr.bottom := top; * loaded := loadpic(inptr); * *-------------------------------------------------------------- bytes_local EQU 22 # of bytes in local zero page OBJ $00 deref_ptr ds 4 work_ptr ds 4 palette_ptr ds 4 screen_ptr ds 4 scandir_ptr ds 4 OBJEND loadpict ENTRY subroutine (4:parms_table),bytes_local PHB PHK PLB LDA [parms_table] STA screen_ptr LDY #2 LDA [parms_table],y STA screen_ptr+2 iny iny LDA [parms_table],y STA pathname_ptr INY INY lda [parms_table],y sta pathname_ptr+2 iny iny lda [parms_table],y sta bottom JSR get_picture BCC L0001019 BRA L0002019 L0001019 ANOP stz error L0002019 ANOP PLB Restore user data bank return 2:error Unwind the stack shires_size dc i'$8000' screenhghth dc i'200' * Do the processing of a picture. get_picture ANOP lda $e0c025 get Apple/Option key status and #%11000000 is Apple/Option key down? ora bottom add to any parameter passed sta bottom LDA pathname_ptr LDX pathname_ptr+2 STA open_pathname STX open_pathname+2 STA in_pathname STX in_pathname+2 JSR get_info BCS L0003029 unsupported file type, don't load LDA in_eof STA read_loadsize ora in_eof+2 zero length file? skip out bne L0013029 lda #$DA08 sta error bra L0003029 because of memory manager problem L0013029 anop lda in_eof LDX in_eof+2 STX read_loadsize+2 JSR getmemory get space for picture BCS L0003029 error, not enough memory, probably JSR load_a_file load picture BCS L0004029 error in loading JSR unpack_image bcs L0004029 JSR freememory CLC indicate picture loaded and available RTS L0004029 ANOP JSR freememory L0003029 ANOP SEC indicate error in loading RTS * Get some memory to load picture into for processing. * Carry set if memory not available. getmemory ANOP pha ; Space for result _MMStartup ;get our ID pla ora #$0100 ;And create an aux ID sta my_id ; for getting memory with V0006000 EQU +(attrLocked+attrFixed)+attrNoSpec ~NEWHANDLE "read_loadsize","my_id","#V0006000","#0" bcc L0015032 sta error pla pla BRA L0005031 L0015032 anop PULLLONG "deref_ptr" LDY #2 LDA [deref_ptr],y STA work_ptr+2 STA read_loadadrs+2 LDA [deref_ptr] STA work_ptr STA read_loadadrs CLC L0005031 ANOP RTS * Free up processing memory. freememory ANOP ~DISPOSEALL "my_id" RTS * Load a file. load_a_file ANOP _OpenGS "openparms" sta error BCS L0007034 LDA open_refnum STA read_refnum STA close_refnum _ReadGS "readparms" _CloseGS "closeparms" L0007034 ANOP RTS * Get some information on requested file. * Determine what kind of picture the file is. get_info ANOP _GetFileInfoGS "infoparms" sta error BCS L1009035 L0000035 ANOP LDX in_auxtype LDA in_filetype CMP #$c0 packed image file type? BEQ L0010035 CMP #$c1 unpacked image file type? BNE L0013035 CPX #$0001 aux type for QDII picture? BEQ L0009035 CPX #$0002 aux type for 3200 picture? BEQ L0009035 bra L0014035 not a QDII or 3200 picture so good L0013035 CMP #$06 binary file type? bne L0015035 lda in_eof cmp #32768 32.5K? bne L0009037 L0014035 MOVEWORD "#0","picture_type" bra L0012035 L0015035 cmp #$f8 bne L0009036 cpx #$c323 bne L0009035 moveword "#5","picture_type" bra L0012035 L0010035 ANOP CPX #1 packed image file BNE L0011035 MOVEWORD "#1","picture_type" BRA L0012035 L0011035 ANOP CPX #2 auxtype for apple preferred? BNE L0017035 MOVEWORD "#2","picture_type" bra L0012035 L0009035 anop lda #$DA09 sta error L1009035 SEC not a recognized picture file RTS L0017035 anop cpx #0 auxtype for paintworks? bne L0016035 moveword "#3","picture_type" bra L0012035 L0016035 anop cpx #$8000 auxtype for paintworks gold 640? bne L0009035 moveword "#4","picture_type" bra L0012035 L0009036 ANOP lda in_filetype cmp #04 is textfile? bne L0009035 L0009037 anop moveword "#6","picture_type" L0012035 ANOP CLC is a recognized picture file RTS * Enter here to unpack a loaded image in the processing * memory to the target buffer. unpack_image ANOP LDA picture_type BNE L0000041 JMP type_c1_00 unpacked image L0000041 ANOP CMP #1 BNE L0001041 JMP type_c0_01 packed image L0001041 ANOP CMP #2 BNE L0002041 JMP type_c0_02 apple preferred L0002041 anop cmp #3 bne L0003041 jmp type_c0_00 paintworks L0003041 anop cmp #4 bne L0015041 jmp type_c0_8000 paintworks gold 640 L0015041 anop cmp #5 bne L0016041 jmp type_psgs L0016041 anop cmp #6 bne L0014041 jmp type_GIF L0014041 ANOP RTS * Attempt to process GIF file type_GIF anop lda #0 move scb (zeroes) ldy #0 paint screen black d00011 sta [screen_ptr],y iny iny cpy #$7e00 end of screen and scb's bne d00011 movelong "screen_ptr","parmscreen" movelong "work_ptr","parmwork" moveword "bottom","parmbottom" pushlong "#parmaddrs" jsl LOADGIF external C routine sta error beq d00012 sec rts d00012 anop clc rts parmaddrs anop record for LOADGIF parmscreen ds 4 screen pointer parmwork ds 4 data pointer parmbottom ds 2 scroll value * Process straight, unpacked image file. type_c1_00 ANOP LDY #0 L0000042 ANOP LDA [work_ptr],y STA [screen_ptr],y INY INY CPY read_sizegot BCC L0000042 rts * Process PaintWorks Gold 640 mode packed Paint file type_c0_8000 anop lda #$8080 move scb 640 mode ldy #$7d00 offset to scb c0003 sta [screen_ptr],y iny iny cpy #$7e00 bne c0003 lda read_sizegot sec sbc #$20 sta read_sizegot tay ldx #0 c0006 lda [work_ptr],y sta palettedata,x inx inx iny iny cpx #$20 bne c0006 bra finish * Process PaintWorks packed Paint file type_c0_00 anop lda #0 move scb (zeroes) ldy #$7d00 offset to scb c0001 sta [screen_ptr],y iny iny cpy #$7e00 bne c0001 ldy #0 c0002 lda [work_ptr],y sta palettedata,y iny iny cpy #$20 bne c0002 finish ldy #$7e00 ldx #0 c0005 lda palettedata,x sta [screen_ptr],y iny iny inx inx cpx #$20 bne c0005 lda work_ptr clc adc #$222 offset to packed picture sta work_ptr lda work_ptr+2 adc #0 sta work_ptr+2 lda read_sizegot adjust end of file sec sbc #$222 sta read_sizegot lda read_sizegot+2 sbc #0 sta read_sizegot+2 lda bottom and #%10000000 is it the Apple key? beq c0007 movelong "screen_ptr","pictadrs" movelong "#196*160","pictsize" jsr L0000043 adc work_ptr sta work_ptr lda work_ptr+2 adc #0 sta work_ptr+2 bra c0008 c0007 lda bottom and #%01000000 is it the Option key? beq c0008 movelong "screen_ptr","pictadrs" movelong "#100*160","pictsize" jsr L0000043 adc work_ptr sta work_ptr lda work_ptr+2 adc #0 sta work_ptr+2 c0008 movelong "screen_ptr","pictadrs" movelong "#$7D00","pictsize" bra L0000043 * Process straight, packed image file. type_c0_01 ANOP MOVELONG "screen_ptr","pictadrs" MOVELONG "shires_size","pictsize" L0000043 ANOP ~UNPACKBYTES "work_ptr","read_sizegot","#pictadrs","#pictsize" PLA CLC RTS * Process apple preferred image file. type_c0_02 ANOP jsr whitescreen for small APF clip art JSR findmainblock BCC L0008045 RTS carry set, no main block L0008045 ANOP LDA #160 STA bytesperline stz scanline_ndx2 lda #2 sta scandir_index2 movelong "screen_ptr","screen_ptr2" LDY #13 number of palettes LDA [work_ptr],y STA num_palettes LDA work_ptr CLC ADC #15 STA palette_ptr LDA work_ptr+2 ADC #0 STA palette_ptr+2 ~MULTIPLY "num_palettes","#32" PLA CLC ADC palette_ptr STA work_ptr PLA ADC palette_ptr+2 STA work_ptr+2 LDY #0 LDA [work_ptr],y TAX stx screenhghth2 CMP #201 ;screen height + 1 BCC L0000045 ;less than 201 lines lda bottom and #%11000000 ;is it the Option or Apple key? beq L100044 ;they want the top ; lda screenhghth2 txa sec sbc #200 ;get whats left of picture sta screenhghth3 lda bottom and #%01000000 ;is it the Option key? bne L100046 lda screenhghth3 cmp #201 blt L0000045 ;normal APF picture bra L100044 ;don't process more than 400 lines L100046 lda screenhghth3 lsr a ;divide it by two to get middle bra L0000045 L100044 LDA screenhghth ;get top 200 lines L0000045 ANOP STA num_scanlines LDA work_ptr CLC ADC #2 skip numscanlines word STA work_ptr LDA work_ptr+2 ADC #0 STA work_ptr+2 PHA PHA PHX PUSHWORD "#4" _MULTIPLY PLA CLC ADC work_ptr STA packdata_ptr point to image data PLA ADC work_ptr+2 STA packdata_ptr+2 MOVELONG "work_ptr","scandir_ptr" JSR unpackdata JSR set_SCBs lda bottom and #%11000000 ;is it the Option or Apple key? beq L100047 ;they want the top lda screenhghth2 CMP #201 ;screen height + 1 Blt L100047 ;less than 201 lines lda #200 ;get rest of picture STA num_scanlines movelong "screen_ptr2","screen_ptr" JSR unpackdata JSR set_SCBs L100047 JSR processpalettes CLC indicate successful unpacking RTS * Find a block with the title MAIN. * Carry set if block not found else carry clear. findmainblock ANOP LDA read_loadsize \ CLC \ ADC work_ptr \ STA fm_endptr > make a pointer to end of file +1 LDA read_loadsize+2 / ADC work_ptr+2 / STA fm_endptr+2 / L0008047 ANOP SHORT LDY #4 LDA [work_ptr],y CMP main_name BNE L0015047 name length doesn't match LDX #0 L0000047 ANOP INY LDA [work_ptr],y CMP main_name+1,x BNE L0015047 block name doesn't match INX CPX main_name BCC L0000047 LONG CLC found it RTS L0015047 ANOP LONG LDY #2 \ LDA [work_ptr],y \ TAX \ LDA [work_ptr] \ CLC > move to start of ADC work_ptr > next block STA work_ptr / TXA / ADC work_ptr+2 / STA work_ptr+2 / LDA work_ptr CMP fm_endptr LDA work_ptr+2 SBC fm_endptr+2 BCC L0008047 haven't reached end of file yet L0016047 ANOP SEC indicate MAIN block not found lda #$DA0B sta error RTS main_name STR 'MAIN' name of block to look for * Process all palettes in the MAIN block. What it does is to * copy all the palettes, if any, to the end of the unpacked image. processpalettes ANOP LDX num_palettes BEQ L0005050 LDY #0 L0000050 ANOP MOVEWORD "#32","pp_cntr" L0001050 ANOP LDA [palette_ptr],y STA [screen_ptr],y INY INY DEC pp_cntr BNE L0001050 DEX BNE L0000050 L0005050 ANOP RTS * Unpack the image data. unpackdata ANOP MOVEWORD "shires_size","pictsize" MOVEWORD "#0","pictsize+2" MOVEWORD "num_scanlines","un_numlines" LDA scanline_ndx2 STA scanline_ndx L0000052 ANOP MOVELONG "screen_ptr","pictadrs" PHA result space PUSHLONG "packdata_ptr" where data is coming from LDY scanline_ndx LDA [work_ptr],y PHA # of bytes to unpack PUSHLONG "#pictadrs" where unpacked data is to go PUSHLONG "#pictsize" overall size of unpacked picture _UNPACKBYTES PLA CLC ADC packdata_ptr STA packdata_ptr LDA packdata_ptr+2 ADC #0 STA packdata_ptr+2 LDA scanline_ndx CLC move to next entry in scanline table ADC #4 STA scanline_ndx LDA screen_ptr CLC ADC bytesperline STA screen_ptr LDA screen_ptr+2 ADC #0 STA screen_ptr+2 LDA pictsize BEQ L0002052 DEC un_numlines BNE L0000052 L0002052 ANOP moveword "scanline_ndx","scanline_ndx2" ;update index RTS * Establish the Scanline Control Bytes based on the MasterMode byte * stored in the header of the file. Will use up to 256 bytes, less * if the num_scanlines is less. set_SCBs ANOP MOVEWORD "#0","scb_index" MOVEWORD "scandir_index2","scandir_index" SHORT "a_reg" LDX num_scanlines CPX #257 BCC L0000054 LDX #256 L0000054 ANOP LDY scandir_index LDA [scandir_ptr],y INY INY INY INY STY scandir_index LDY scb_index STA [screen_ptr],y INC scb_index DEX BNE L0000054 LONG "a_reg" LDA screen_ptr CLC ADC #256 STA screen_ptr LDA screen_ptr+2 ADC #0 STA screen_ptr+2 add 256 to screen_ptr L0005054 ANOP moveword "scandir_index","scandir_index2" RTS * Process Print Shop GS Color Graphics * Below is the standard 320 mode palette pspalette dc h'00 00 77 07 41 08 2c 07 0f 00 80 00 70 0f 00 0d' dc h'a9 0f f0 0f e0 00 df 04 af 0d 8f 07 cc 0c ff 0f' colorchg dc h'0f 09 07 06 04 0a 03 00' yellow equ 1 type_psgs anop jsr start_psgs longa off d0007 lda curclrh asl a set high color nibble asl a asl a asl a sta curclrl and save it d0005 jsr break_psgs breakout bits and move to picture * finished with a raw byte so increment counters and continue inc col lda #11 cmp col was that the last column? bne d0005 stz col inc row lda picoffset adjust picoffset to next row clc adc #$74 start on next screen row sta picoffset lda picoffset+1 adc #0 sta picoffset+1 lda #52 cmp row was that the last row? bne d0005 stz row inc picno d0013 ldy #0 reset picoffset to beginning sty picoffset asl curclrh set to next color bit lda #3 cmp picno was that the last picture? bne d0007 long M set accumulator back to 16 bits rts whitescreen lda #$ffff clear screen to white ldy #$0 d0001 sta [screen_ptr],y iny iny cpy #$7d00 bne d0001 rts * Startup PrintShop graphics area start_psgs anop jsr whitescreen set it to white lda #$00 set palette # to zero and scb to 320 d0002 sta [screen_ptr],y iny iny cpy #$7e00 bne d0002 tax d0003 lda pspalette,x set our palette sta [screen_ptr],y inx inx iny iny cpx #$20 bne d0003 * background, scb, and palette done, let's do the work short M best to use 8 bit accumulator stz col start with column zero stz row start with row zero stz picno start with picture # zero ldx #0 stx picoffset start with beginning of picture stx rawoffset start with beginning of data lda #yellow start with first color sta curclrh set as current color rts * get raw data and break out bits break_psgs ldy rawoffset save our index into raw lda [work_ptr],y sta currbyte save work byte ldx #7 d0004 lda currbyte lsr a move bit into carry sta currbyte save for later bcs itsaone stz broke,x no pixel there bra checkx itsaone lda #1 pixel there sta broke,x checkx dex cpx #$ffff bne d0004 iny sty rawoffset save our index into raw * convert broke bits into bytes for transfer to picture inx back to zero ldy #0 d0010 lda #0 sta broken,y zero out work area (white) lda broke,x get broken bits beq clear lda curclrl has color so transfer it sta broken,y clear inx lda broke,x get second bit beq clear1 lda broken,y ora curclrh has color so transfer it sta broken,y clear1 iny inx cpx #8 8 bits to a byte bne d0010 * move broken picture bytes to picture area ldy picoffset bring back picture index ldx #0 d0006 lda picno check for first picture? bne d0008 lda broken,x set background color to first color sta [screen_ptr],y put in picture as first color bra d0012 don't change color yet ; picture already started but not finished this is second color d0008 lda [screen_ptr],y add to color already there ora broken,x sta [screen_ptr],y and save it back ; convert broken picture bytes to correct colors if this is third color lda picno check for last picture? cmp #2 bne d0012 lda #0 zero out 16 bit accumulator xba high word lda [screen_ptr],y get picture byte sty picoffset we need both indexes for this sta broken,x store for work and #$0f we only want lo nibble now tay use it as offset into table lda colorchg,y get correct color sta convrt save it lda broken,x get second nibble lsr a bring it low lsr a lsr a lsr a tay use it as offset into table lda colorchg,y get correct color asl a bring it high asl a asl a asl a ora convrt add to what was saved ldy picoffset get our index back sta [screen_ptr],y save it back to picture d0012 iny inx cpx #4 more of bytes left? bne d0006 4 pixels per 8 bits sty picoffset save index into picture rts pathname_ptr ds 4 num_palettes ds 2 error ds 2 bottom ds 2 picture_type ds 2 0=unpacked, 1=packed, 2=apple preferred * 3=paintworks, 4=paintworks gold 640 * 5=print shop gs my_id ds 2 fm_endptr ds 4 broke ds 8 holds broken bytes broken ds 4 holds converted bytes convrt ds 1 holds color corrected bytes currbyte ds 1 temp for breakout curclrl ds 1 hold current color low curclrh ds 1 hold current color high picoffset ds 2 holds current offset into picture rawoffset ds 2 holds current offset into raw picno ds 1 holds picture number row ds 1 current psgs data byte row col ds 1 current psgs data byte col pp_cntr ds 2 un_numlines ds 2 screenhghth2 ds 2 screenhghth3 ds 2 scb_index ds 2 scandir_index ds 2 scandir_index2 ds 2 screen_ptr2 ds 4 scanline_ndx ds 2 scanline_ndx2 ds 2 num_scanlines ds 2 bytesperline ds 2 pictadrs ds 4 pictsize ds 4 packdata_ptr ds 4 *-------------------------------------------------------------- * This is all the data needed to load the background picture. openparms ANOP open_count dc i'13' open_refnum ds 2 reference number (Result) open_pathname ds 4 Pathname pointer open_request ds 2 open_resnum ds 2 open_access ds 2 open_filetype ds 2 open_auxtype ds 4 open_storage ds 2 open_create ds 8 open_Mod ds 8 open_options ds 4 open_eof ds 4 open_blocksused ds 4 readparms ANOP read_count dc i'5' read_refnum ds 2 read_loadadrs ds 4 read_loadsize ds 4 Request count read_sizegot ds 4 Transfer count (Result) read_cache dc i'1' infoparms ANOP info_count dc i'10' in_pathname ds 4 in_access ds 2 in_filetype ds 2 in_auxtype ds 4 in_storetype ds 2 in_createdate ds 8 in_modedate ds 8 in_options ds 4 in_eof ds 4 in_blocksused ds 4 closeparms anop close_count dc i'1' close_refnum ds 2 palettedata ds 32 END