**************************************************************** * Code Taken from 3200 Demo #1 * by Jonah Stich * (c)opyright 1990 * Bad Luck Software * * I spent a lot of time on my 3200 color routines. I can now use them in any * program I want, but I don't have the time or the desire to write ALL of the * possible 3200 color programs. Therefore, I'm distributing this source in the * hopes that others will put it to good use in their programs. At this time, * GS users can't be stingy about their code. Programmers sharing info, * techniques, and yes, even code is one of the things that'll keep the GS * alive. You are free to use this code wherever you want, for whatever * purpose you desire. All I ask is that if you use it in a program that you * distribute, please give me credit for the 3200 color routines somewhere in * the about box, documentation, etc. * * If you have any questions, you can reach me at one of my many on-line EMail * addresses: * * America OnLine: ShanoJ * GEnie: J.STICH1 * InterNet: jonah@crl.ucsd.edu * PHS BBS [(609) 924-7168;1200;Sept-June ONLY]: Jonah Stich, User #1 * * * Modified by Dave Leffler for ShowPic NDA v5.x+ version 5.40 * to display 3200 color pictures as a subroutine * Will also display French 3200 color APP pictures * It's passed a record of a pathname pointer and * a timer value. It returns an error number. * *-------------------------------------------------------------- * Calling procedure (pascal): * * type * inparm = record * Pictptr : ptr; * value : integer; * end; * inparmptr = ^inparm; * function Load3200(parmptr:inparmptr):integer;extern; {returns error #} * * var inprm : inparm; * inptr : inparmptr; * error : integer; * * inptr := @imprm; * inptr.Pictptr := @gsosInString; * inptr.value := delay; * error := Load3200(inptr); * **************************************************************** KEEP Load3200 mcopy Load3200.mac ;................................................................ TRUE gequ 1 FALSE gequ 0 SHADOW gequ $E0C035 AUXREG gequ $E0C068 KEYBD gequ $E0C000 KEYCLR gequ $E0C010 VERTCNT gequ $E0C02E SCREEN gequ $E12000 SSCREEN gequ $012000 SCBs gequ $E19D00 GRAPHICS gequ $E0C029 MOUSE gequ $E0C024 TempHandle gequ 0 TempPtr gequ 4 ShadowHandle gequ 8 PicHandle gequ 12 PicPtr gequ 16 ;................................................................ load3200pic START using FileData LCLA &LUP LONGA ON LONGI ON bytes_local EQU 30 # of bytes in local zero page load3200 ENTRY subroutine (4:parms_table),bytes_local PHB PHK PLB LDA [parms_table] STA oPathname LDY #2 LDA [parms_table],y sta oPathname+2 iny iny lda [parms_table],y sta timer jsr ShowIt ;do the main program BCC L0001019 BRA L0002019 L0001019 ANOP stz error32 L0002019 ANOP PLB Restore user data bank return 2:error32 Unwind the stack end ;................................................................ ShowIt Start using FileData using ShowData lda SHADOW ;Save it early sta OldShadow _OpenGS openParams ;Open the file BCC L0015030 sta error32 BRL daveError no ID tags available so no loading allowed L0015030 anop lda ORefNum ;Transfer out refNum sta RRefNum sta CRefNum pha ; Space for result _MMStartup ;get our ID pla ora #$0200 ;And create an aux ID sta my_id ; for getting memory with pushlong #0 ;Get a block of memeory to load the pushlong Length ; file into pushword my_id pushword #$C008 this is for the file pushlong #0 _NewHandle BCC L0015032 sta error32 pulllong TempHandle ;And get rid of it's pointer BRL daveError1 no ID tags available so no loading allowed L0015032 anop sta error32 pulllong TempHandle ;And store it's ptr at both ldy #2 ;FilePtr & PicPtr lda [TempHandle],y sta FilePtr+2 sta PicPtr+2 lda [TempHandle] sta FilePtr sta PicPtr lda Length ;Transfer the length to the read length sta RLength lda Length+2 sta RLength+2 _ReadGS readParams ;Read the file BCC L0015033 sta error32 BRL daveError2 no ID tags available so no loading allowed L0015033 anop _CloseGS closeParams ;And then close it lda #32 ;Now, the palettes are stored backwards sta XEnd ;by palette, with color $0F of palette ldx #0 ;$0F stored first, followed by color $0E lda [PicPtr] cmp #$D0C1 ;reverse "AP" bne BrooksFormat ldy #2 lda [PicPtr],y cmp #$00D0 ;reverse null "P" bne BrooksFormat lda #1 sta app ldy #30+4 ; first palette after header bra nextPal BrooksFormat anop stz app ldy #$7D00+30 ;of palette $0F, etc. This little nextPal lda [PicPtr],y ;routine reverses the palettes, to make sta SSCREEN,x ;it easier to show the picture. inx inx dey dey cpx XEnd bne nextPal lda XEnd clc adc #32 sta XEnd tya clc adc #64 tay cpx #6400 bne nextPal phd ;We need to disable EVERYTHING, so here _GetIRQEnable ;we see what's enabled pullword IRQEnable ldx #0 ;and then we loop through and disable nextDis lda IRQEnable ;them all! and Masks,x beq skip lda Disables,x phx pha _IntSource plx skip inx inx cpx #14 bne nextDis shortm ;Linearize the graphic screen lda GRAPHICS sta OldGraphics ;save original lda #$41 sta GRAPHICS longm lda app beq BrooksPicture clc lda FilePtr adc #$1904 ;skip header and color tables sta FilePtr lda FilePtr+2 adc #0 sta FilePtr+2 MOVELONG "#$E12000","pictadrs" MOVELONG "#$7D00","pictsize" ~UNPACKBYTES "FilePtr","Length","#pictadrs","#pictsize" PLA bra continue BrooksPicture anop ldx #$7D00-2 ;Move the picture onto the screen ldy #$7D00-2 nextPic lda [PicPtr],y sta SCREEN,x dey dey dex dex bpl nextPic Continue anop shortm ;Now set the SCB's up like this: lda #$0F ;F,E,D,C,B,A,9,8,7,6,5,4,3,2,1,0,F,E... ldx #0 nextSCB sta SCBs,x dec a and #$0F inx cpx #200 bne nextSCB shortm ;Show the screen lda #$C1 sta GRAPHICS again php sei ;lock out interrupts phd ;save the old direct page longm tsc ;get the old stack and save it sta OldStack shortm lda SHADOW ;Turn on SHR shadowing and #$F7 sta SHADOW lda AUXREG ;and map the stack and dp into bank $01 sta OldAuxReg ;save original ora #$30 sta AUXREG copy palette.asm ;This code pushes the palettes lda SHADOW ;Unmap the stack and direct page and ora #$08 ;turn shadowing off sta SHADOW lda AUXREG and #$CF sta AUXREG longm lda OldStack ;switch the old stack back in tcs pld ;and the old direct page plp shortm lda KEYBD ;see if a key has been pressed or the bmi done ;mouse button clicked lda MOUSE lda MOUSE bpl done longm ;timer routine lda >timer dec a ;countdown sta >timer beq done ;timed out? ; shortm jmp again done anop longm ldx #0 ;Turn everthing back on nextEnab lda IRQEnable and Masks,x beq skip1 lda Enables,x phx pha _IntSource plx skip1 inx inx cpx #14 bne nextEnab clc jsr freememory shortm lda OldGraphics ;restore all the old settings sta GRAPHICS lda OldAuxReg sta AUXREG lda OldShadow sta SHADOW longm rts ;and exit! freememory ANOP ;get rid of all OUR memory ~DISPOSEALL "My_ID" RTS daveError2 anop jsr freememory daveError1 anop _CloseGS closeParams ;And then close it daveError anop sec ;let'em know we had a problem rts End ;................................................................ ShowData Data Masks dc i'1,2,4,16,32,64,128' Enables dc i'14,12,10,6,4,2,0' Disables dc i'15,13,11,7,5,3,1' IRQEnable ds 2 My_ID ds 2 OldStack ds 2 OldGraphics ds 2 OldAuxReg ds 2 OldShadow ds 2 End ;................................................................ FileData Data timer ds 2 error32 ds 2 app ds 2 pictadrs ds 4 pictsize ds 4 openParams anop dc i'12' ORefNum ds 2 oPathname ds 4 dc i'3' dc i'0' ds 2 ds 2 ds 4 ds 2 ds 8 ds 8 dc i4'0' Length ds 4 readParams anop dc i'4' RRefNum ds 2 FilePtr ds 4 RLength ds 4 ds 4 closeParams anop dc i'1' CRefNum ds 2 XEnd ds 2 End