xLIB source

Moderator: tr1p1ea

User avatar
kv83
Maxcoderz Staff
Posts: 2735
Joined: Wed 15 Dec, 2004 7:26 pm
Location: The Hague, Netherlands
Contact:

Post by kv83 »

tr1p1ea wrote:Well, im gone for a few days and all hell breaks loose! :).

the_unknown_one ... i understand that you want to use strings? Well if that is the case then xLIB wont help you much as it doesnt use strings in any circumstance. I can still give you the source ... it is extremely messy as this project was NEVER meant to be actualy used by anyone ... i just wanted to know how ASM libs worked :). That said i still need to get onto my other PC to retrieve the source.

Kevin, i will probably turn xLIB into an app and use a parser hook, because it seems to be faster. THe only problem is that i haven never made and app or a hook before :). I doubt it would be too difficult thoug. The problem i have with this is that xLIB is only ~1KB ... i dont know what i could fill the remaining ~15KB's with ... otherwise it would be a great waste of space.
A place where you can store sprites and stuff? Don't know though whether this is possible or not... IIRC Apps can't be edited when running? :(
Image
Kozak
Maxcoderz Staff
Posts: 791
Joined: Fri 17 Dec, 2004 5:33 pm
Location: On the dark side of the moon.
Contact:

Post by Kozak »

You can fill that space with the most useless routines. MirageOS also does that I think.
"They say that sea was created by a man named Maarten Zwartbol, a long time ago...." - Duck, an old Corbin version
User avatar
Jim e
Calc King
Posts: 2457
Joined: Sun 26 Dec, 2004 5:27 am
Location: SXIOPO = Infinite lives for both players
Contact:

Post by Jim e »

Plus what about an on calc tile editor, that way tiles can be placed in programs and not waste pic space & exceed 96 tiles.

And special sprite editor, with mask built in and varible size.

plus map editor.

And how bout text compession for those RPG with lots of text, storing them again in programs.

music and music editor :P

Direct input.

Multi key test

Linking, send full varibles not just 0-255.

call labels

4 level greyscale

Filled vectors

fast biezer lines

8 way mapper

Hmmm that should fill most of the 16k. :roll:
The person who doesn't realize the superiority of the SE wrote:Nah, he has the 'one-calc-to-rule-them-all' (83)
Grrrr... :evil:
Image
User avatar
DJ_O
Calc King
Posts: 2323
Joined: Mon 20 Dec, 2004 6:47 pm
Location: Quebec (Canada)
Contact:

Post by DJ_O »

The person who doesn't realize the superiority of the SE wrote:Nah, he has the 'one-calc-to-rule-them-all' (83)
Grrrr... :evil:
:mrgreen:

We need a TI-83+ shell that emulate 83 games, that way we no longer need to port them


As for turning xLIB into a app, I am wondering if it could be possible to install xLIB hooks from a program instead of a very huge app? I mean if a game use both xLIB and omnicalc it will takes 32 KB of archive :shock:
ImageImageImageImage
User avatar
tr1p1ea
Maxcoderz Staff
Posts: 4141
Joined: Thu 16 Dec, 2004 10:06 pm
Location: I cant seem to get out of this cryogenic chamber!
Contact:

Post by tr1p1ea »

You can install hooks from a ram prog ... but it is not really recommended as you cant really garauntee where the hook routine is in memory. You could store it inside a saferam location but if a romcall or something overwrites it things could get nasty.
"My world is Black & White. But if I blink fast enough, I see it in Grayscale."
Image
Image
User avatar
DJ_O
Calc King
Posts: 2323
Joined: Mon 20 Dec, 2004 6:47 pm
Location: Quebec (Canada)
Contact:

Post by DJ_O »

So for now it should stay as a prgm. Maybe you could try to take down its size to 600 or 800 bytes and make it run faster maybe, if possible :) that way it would still be fast enough to have scrolling
ImageImageImageImage
User avatar
tr1p1ea
Maxcoderz Staff
Posts: 4141
Joined: Thu 16 Dec, 2004 10:06 pm
Location: I cant seem to get out of this cryogenic chamber!
Contact:

Post by tr1p1ea »

Well i dont really see how i would be able to bring the size down and still keep the functionality as it is all routines ... no buffers or anything are stored inside the program.

Plus if i make it take advantage of hooks, it will use a parser hook which will of course render Omnicalc unusable.
"My world is Black & White. But if I blink fast enough, I see it in Grayscale."
Image
Image
User avatar
dysfunction
Calc Master
Posts: 1454
Joined: Wed 22 Dec, 2004 3:07 am
Location: Through the Aura

Post by dysfunction »

I might be ok with that anyways... I'm still hoping i can make Ender's Game for 83 and 83+ (I assume it wouldnt be too hard for you to port xlib to 83 regular considering thats what you have?) although I could do far better graphics in cutscenes and otherwise by using Omnicalc.
Image


"You're very clever, young man, but it's turtles all the way down!"
Kozak
Maxcoderz Staff
Posts: 791
Joined: Fri 17 Dec, 2004 5:33 pm
Location: On the dark side of the moon.
Contact:

Post by Kozak »

Well why will one need OmniCalc when finished, xLIB will have all it's functionality right?
"They say that sea was created by a man named Maarten Zwartbol, a long time ago...." - Duck, an old Corbin version
User avatar
DJ_O
Calc King
Posts: 2323
Joined: Mon 20 Dec, 2004 6:47 pm
Location: Quebec (Canada)
Contact:

Post by DJ_O »

Omnicalc can display 50 sprite/seconds while all other asm lib running with the Asm( command can only display 10/seconds . Also Omnicalc can display sprites of any size from anywhere on a picture, which cannot be done by any other sprite routine. Plus it can do grayscale
ImageImageImageImage
User avatar
Jim e
Calc King
Posts: 2457
Joined: Sun 26 Dec, 2004 5:27 am
Location: SXIOPO = Infinite lives for both players
Contact:

Post by Jim e »

Still if tr1p makes it into an app, he can change things to be even faster than omincalc.
Image
User avatar
DJ_O
Calc King
Posts: 2323
Joined: Mon 20 Dec, 2004 6:47 pm
Location: Quebec (Canada)
Contact:

Post by DJ_O »

yes. He should look at omnicalc source to see if MV use a faster sprite routine
ImageImageImageImage
User avatar
tr1p1ea
Maxcoderz Staff
Posts: 4141
Joined: Thu 16 Dec, 2004 10:06 pm
Location: I cant seem to get out of this cryogenic chamber!
Contact:

Post by tr1p1ea »

I will post the source here in the next few days ok :).
"My world is Black & White. But if I blink fast enough, I see it in Grayscale."
Image
Image
User avatar
tr1p1ea
Maxcoderz Staff
Posts: 4141
Joined: Thu 16 Dec, 2004 10:06 pm
Location: I cant seem to get out of this cryogenic chamber!
Contact:

Post by tr1p1ea »

OK, just like i promised here is the source. Please note that it is fairly messy and there is a LOT of room for improvment. This *was* only a stuff-around project that was never ment to evolve into anything you know :).

Code: Select all

;-----------------------------------
; xLIB - v0.3 tr1p1ea
;-----------------------------------

.nolist
#define end .end
#define END .end
#define equ .equ
#define EQU .equ

#include "ti83plus.inc"
#define ProgStart $9D95
.list

.org ProgStart - 2
.db t2ByteTok, tAsmCmp 

start_of_program:
	bcall(_RclAns)			; recall Ans
	ld hl,1				; 1st element in Real List
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; returns a as LSByte

	or a
	jp z,APD				; 0 = Enable/Disale APD
	cp 1
	jp z,ClearScreen			; 1 = Clear the Screen
	cp 2
	jp z,SetupSprites			; 2 = Setup Sprite Data
	cp 3
	jp z,DrawSprite			; 3 = Draw a Sprite
	cp 4
	jp z,DrawMap			; 4 = Draw a TileMap
	cp 5
	jp z,UpdateLCD			; 5 = Update the LCD

	jp Quit				; return to tios if anything else

;-----------------------------------
; APD - Enable/Disable APD
;-----------------------------------
; syntax - {0,APD_Var:Asm(prgmXLIB	; 0 = Disable, 1 = Enable
;
APD:
	bcall(_RclAns)			; recall Ans
	ld hl,2				; 2nd element in Real List (APD Q)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	
	or a
	jp nz,EnableAPD
DisableAPD:
	bcall(_DisableAPD)
	jp Quit
EnableAPD:
	bcall(_EnableAPD)
	jp Quit

;-----------------------------------
; ClearScreen - Clears the Screen
;-----------------------------------
; syntax - {1:Asm(prgmXLIB
;
ClearScreen:
	bcall(_grBufClr)
	bcall(_clrLCDFull)
	jp Quit				; return to tios

;-----------------------------------
; SetupSprites - Setup Sprite Data
;-----------------------------------
; syntax - {2,GFXPage:Asm(prgmXLIB
;
SetupSprites:
	bcall(_RclAns)			; recall Ans
	ld hl,2				; 2nd element in Real List (Xpos)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (GFX_Page_var),a		; store GFX Page var

	ld hl,SpriteBuffer1
	ld de,SpriteBuffer1
	ld (hl),0
	ld bc,768
	ldir					; clear temp sprite area
	ld hl,SpriteBuffer2
	ld de,SpriteBuffer2
	ld (hl),0
	ld bc,768
	ldir					; clear temp sprite area

	ld hl,PicName			; pict name
	bcall(_Mov9toOP1)			; pict name to op1
	bcall(_FindSym)			; look it up - returns de as pointer to data (must be in ram)
	ret c					; return if not found
	ld a,b
	or a
	ret nz				; return if archived

load_data:
	inc de
	inc de				; skip length bytes

	ex de,hl
	push hl
	call GetSpriteBuffer
	push hl
	pop ix
	pop hl
	ld bc,0
SetupLoop:
	push hl
	push bc

	ld de,12
	ld b,8
Copy_l:
	ld a,(hl)
	ld (ix),a
	add hl,de
	inc ix
	djnz Copy_l

	pop bc
	pop hl
	inc hl
	inc c
	ld a,c
	cp 12
	jp nz,SetupLoop
	dec hl
	ld de,(12*8)-11
	add hl,de
	ld c,0
	ld a,8
	add a,b
	ld b,a
	cp 64
	jp nz,SetupLoop
	jp Quit				; return to tios

;-----------------------------------
; DrawSprite - Draws a Sprite
;-----------------------------------
; syntax - {3,X,Y,SpriteNumber,GFX_Page,Clipped/Aligned,UpdateLCD:Asm(prgmXLIB
;
DrawSprite:
	xor a
	ld (SprRoutine_Flag),a
	inc a
	ld (Spr_Type),a

	bcall(_RclAns)			; recall Ans
	ld hl,2				; 2nd element in Real List (Xpos)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	push af				; save x
	bcall(_RclAns)			; recall Ans
	ld hl,3				; 3rd element in Real List (Ypos)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	push af				; save y
	bcall(_RclAns)			; recall Ans
	ld hl,4				; 4th element in Real List (SprNum)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	push af
	bcall(_RclAns)			; recall Ans
	ld hl,5				; 5th element in Real List (SprNum)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (GFX_Page_var),a	
	bcall(_RclAns)			; recall Ans
	ld hl,6				; 6th element in Real List (Sprite Routine)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (SprRoutine_Flag),a
	bcall(_RclAns)			; recall Ans
	ld hl,7				; 6th element in Real List (UpdateLCD Q)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (UpdateLCD_Q),a
	pop af
	ld l,a				; sprite number
	ld h,0				; clear upper byte
	add hl,hl				; x 2
	add hl,hl				; x 4
	add hl,hl				; x 8
	push hl				; de = sprite data
	call GetSpriteBuffer
	push hl
	pop de
	pop hl
	add hl,de				; hl points to correst sprite
	ld de,TempSprite+1		; temporary sprite
	ld bc,8				; number of bytes to copy
	ldir					; copy
	pop af				; restore y-coord
	ld c,a				; sprite y-coord
	pop af				; restore x-coord
	ld b,a				; sprite x-coord
	ld hl,TempSprite+1		; sprite data
	ld a,(SprRoutine_Flag)
	or a
	jr z,ClippedSprite
	call PutAlignedSprite
	jr SprSelEnd
ClippedSprite:
	call PutSprite			; draw sprite to gBuf
SprSelEnd:
	ld a,(UpdateLCD_Q)
	or a
	call nz,FastCopy			; copy to lcd
	jp Quit				; return to tios

;-----------------------------------
; DrawMap - Draws a TileMap
;-----------------------------------
; syntax - {4,X_Offsett,Y_Offsett,MapWidth,MapHeight,ScreenStartX,ScreenEndX,ScreenStartY,ScreenEndY,GFX_Page,Tile_Type,UpdateLCD:Asm(prgmXLIB
;
DrawMap
	bcall(_RclAns)			; recall Ans
	ld hl,2				; 2nd element in Real List (Xpos)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (MapX_O),a			; map x offsett
	bcall(_RclAns)			; recall Ans
	ld hl,3				; 3rd element in Real List (Ypos)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (MapY_O),a			; map y offsett
	bcall(_RclAns)			; recall Ans
	ld hl,4				; 4th element in Real List (MapWidth)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (MapWidth),a			; map width
	bcall(_RclAns)			; recall Ans
	ld hl,5				; 5th element in Real List (MapHeight)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (MapHeight),a			; map width
	bcall(_RclAns)			; recall Ans
	ld hl,6				; 5th element in Real List (ScreenStartX)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (ScreenStartX),a
	bcall(_RclAns)			; recall Ans
	ld hl,7				; 5th element in Real List (ScreenEndX)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	dec a
	ld (ScreenEndX),a
	bcall(_RclAns)			; recall Ans
	ld hl,8				; 5th element in Real List (ScreenStartY)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (ScreenStartY),a
	bcall(_RclAns)			; recall Ans
	ld hl,9				; 5th element in Real List (ScreenEndY)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	dec a
	ld (ScreenEndY),a
	bcall(_RclAns)			; recall Ans
	ld hl,10				; 5th element in Real List (GFX Page)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (GFX_Page_var),a
	bcall(_RclAns)			; recall Ans
	ld hl,11				; 5th element in Real List (Sprite Type)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (Spr_Type),a
	bcall(_RclAns)			; recall Ans
	ld hl,12				; 5th element in Real List (UpdateLCD Q)
	bcall(_GetLtoOp1)			; get element
	bcall(_ConvOp1)			; convert to de
	ld (UpdateLCD_Q),a

	ld hl,MatAName			; matrice name
	bcall(_Mov9toOP1)			; matrice name to op1
	bcall(_FindSym)			; look it up - returns de as pointer to data (must be in ram)
	ret c					; return if not found
	ld a,b
	or a
	ret nz				; return if archived

	call TileMap

	ld a,(UpdateLCD_Q)
	or a
	call nz,FastCopy			; copy to lcd
	jp Quit				; return to tios

;-----------------------------------
; Routines
;-----------------------------------
;
;-----------------------------------
; TileMap
;-----------------------------------
TileMap:
	;ld a,(MapX_O)
	;add a,12
	;ld c,a
	;ld a,(MapWidth)
	;or a
	;sub c
	;ret c
	;ld a,(MapY_O)
	;add a,8
	;ld b,a
	;ld a,(MapHeight)
	;or a
	;sub b
	;ret c

	ld a,(MapX_O)
	inc a
	ld c,a
	ld a,(MapY_O)
	inc a
	ld b,a				; bc = row, col
DrawMapLoop:
	push de				; save matrice data pointer
	push bc				; save current element
	bcall(_getMToOP1)			; get element bc
	bcall(_ConvOP1)			; cenvert to de
	pop bc				; restore current element
	ld l,e
	ld h,0				; hl = current tile number
	add hl,hl
	add hl,hl
	add hl,hl				; hl = tile * 8
	push hl				; de = sprite data
	call GetSpriteBuffer
	push hl
	pop de
	pop hl
	add hl,de				; offsett with tiledata
	push bc				; save current element
	ld a,(MapY_O)
	inc a
	ld e,a
	ld a,b
	sub e
	add a,a
	add a,a
	add a,a
	ld e,a
	ld a,(MapX_O)
	inc a
	ld d,a
	ld a,c
	sub d
	add a,a
	add a,a
	add a,a				; b = (x - 1) * 8
	ld b,a
	ld c,e				; c = (y - 1) * 8
	ld a,(ScreenStartX)
	add a,a
	add a,a
	add a,a
	add a,b
	ld b,a
	ld a,(ScreenStartY)
	add a,a
	add a,a
	add a,a
	add a,c
	ld c,a
	call PutAlignedSprite
	pop bc				; restore current element
	pop de				; restore matrice data pointer
	inc c					; increase to next element
	ld a,(MapX_O)
	inc a
	push af
	ld a,(ScreenEndX)
	ld h,a
	ld a,(ScreenStartX)
	ld l,a
	ld a,11
	sub h
	add a,l
	ld l,a
	ld a,12
	sub l
	inc a
	ld l,a
	pop af
	add a,l
	sub c
	or a					; test for end of row
	jp nz,DrawMapLoop			; continue until row is drawn
	ld a,(MapX_O)
	inc a
	ld c,a
	inc b					; reset to start of next row
	ld a,(MapY_O)
	inc a
	push af
	ld a,(ScreenEndY)
	ld h,a
	ld a,(ScreenStartY)
	ld l,a
	ld a,7
	sub h
	add a,l
	ld l,a
	ld a,8
	sub l
	inc a
	ld l,a
	pop af
	add a,l
	sub b					; test if all rows are drawn
	jp nz,DrawMapLoop			; loop until all rows are drawn
	ret

;-----------------------------------
; PutSprite
;-----------------------------------
PutSprite:
;----------------------------------------------------------------------------
;[ PutSprClpXOR ] [ABCDEFIX]                      [ 139 bytes ] [ CrASH_Man ]
;----------------------------------------------------------------------------
; Draws a sprite using only XOR data, with clipping
;
; parameters: HL -> sprite, (B,C) = coordinates
; returns:    Puts sprite in GRAPH_MEM
;
DefaultXSpriteHeight = 8	; This is the default for the sprite height

PutSprClpXOR:   XOR  A
__XChange_1:    LD   DE, DefaultXSpriteHeight     ; D = 0, E = Height

                OR   C                            ; If C < 0
                JP   M, _SCX_NoBotClp             ; No bottom clip.

                LD   A, $3F                       ; Is C is offscreen?
                SUB  C
                RET  C

__XChange_2:    CP   DefaultXSpriteHeight-1       ; If C + 7 < 64
                JR   NC, _SCX_NoVertClp           ; No vertical clip.
                INC  A
                LD   E, A
                JR   _SCX_NoVertClp               ; Height = 64 - C

_SCX_NoBotClp:
__XChange_3:    CP   -(DefaultXSpriteHeight-1)    ; Is C is offscreen?
                RET  C

                ADD  A, E                         ; Find how many lines
                LD   C, A                         ; to actually draw
                SUB  E

                NEG
                LD   E, A
                ADD  HL, DE                       ; Move HL down
                LD   E, C                         ; by -C lines
                LD   C, D

_SCX_NoVertClp: PUSH HL                           ; IX -> Sprite
                POP  IX

                LD   A, $77                       ; OP code for
                LD   (_SCX_OPchg_1), A            ;   LD   (HL), A
                LD   (_SCX_OPchg_2), A

                XOR  A                            ; Is B > 0?
                OR   B
                JP   M, _SCX_NoRightClp

                CP   89                           ; Is B < 89?
                JR   C, _SCX_ClpDone
                CP   96
                RET  NC

                LD   HL, _SCX_OPchg_1             ; Modify LD to NOP
                JR   _SCX_ClpModify

_SCX_NoRightClp:CP   -7                           ; Is B is offscreen?
                RET  C

                LD   HL, _SCX_OPchg_2             ; Modify LD to NOP
_SCX_ClpModify: LD   (HL), D

_SCX_ClpDone:   LD   B, D
                LD   H, B
                LD   L, C
                ADD  HL, BC                       ; HL = Y * 12
                ADD  HL, BC
                ADD  HL, HL
                ADD  HL, HL

                LD   C, A                         ; HL = Y*12 + X/8
                SRA  C
                SRA  C
                SRA  C
                INC  C

                ADD  HL, BC
                LD   BC, PlotsScreen
                ADD  HL, BC

                LD   B, E                         ; B = number of rows

                CPL
                AND  %00000111                    ; find number of
                LD   E, A                         ; instructions to jump
                ADD  A, E
                ADD  A, E
                LD   (_SCX_OPchg_3 + 1), A        ; 3 * (7 - number)

                LD   DE, 13

_SCX_LineLoop:  LD   C, (IX)
                XOR  A
_SCX_OPchg_3:   JR   _SCX_OPchg_3                 ; modify

                RR   C
                RRA
                RR   C
                RRA
                RR   C
                RRA
                RR   C
                RRA
                RR   C
                RRA
                RR   C
                RRA
                RR   C
                RRA

                XOR  (HL)                         ; XOR with background
_SCX_OPchg_1:   LD   (HL), A                      ; Write
                DEC  HL                           ; HL -> next 8 pixels

                LD   A, C
                XOR  (HL)                         ; XOR with background
_SCX_OPchg_2:   LD   (HL), A                      ; Write
                ADD  HL, DE                       ; HL -> next row

                INC  IX                           ; Increment to next data
                DJNZ _SCX_LineLoop
                RET

;----------------------------------------
; PUTALIGNEDSPRITE
; Draw an Aligned Sprite to PlotsScreen
; HL = Sprite_Pointer
; b = X
; c = Y
;----------------------------------------
PutAlignedSprite:
	bit 7,b
	ret nz
	or a
	ld a,b
	cp 96
	ret nc
	bit 7,c
	ret nz
	or a
	ld a,c
	cp 64
	ret nc

	push hl
	pop ix
	ld a,b
	ld h,0
	ld d,h
	ld e,c
	ld l,c
	add hl,hl
	add hl,de
	add hl,hl
	add hl,hl
	ld e,a
	srl e
	srl e
	srl e
	add hl,de
	ex de,hl
	ld hl,PlotsScreen
	add hl,de
	ld de,12
	ld b,8

	ld a,(Spr_Type)
	or a
	jp z,sLD
	cp 1
	jp z,sOR
	cp 2
	jp z,sXOR
sLD:
	ld a,(ix)
	ld (hl),a
	add hl,de
	inc ix
	djnz sLD
	ret
sOR:
	ld a,(ix)
	or (hl)
	ld (hl),a
	add hl,de
	inc ix
	djnz sOR
	ret
sXOR:
	ld a,(ix)
	xor (hl)
	ld (hl),a
	add hl,de
	inc ix
	djnz sXOR
	ret

;-----------------------------------
; UpdateLCD - Updates the LCD
;-----------------------------------
; syntax - {5:Asm(prgmXLIB
;
UpdateLCD:
	call FastCopy
	jp Quit

;-----------------------------------
; FastCopy
;-----------------------------------
;-----> Copy the gbuf to the screen (fast)
;Input:	nothing
;Output:graph buffer is copied to the screen
FastCopy:
	di
	ld	a,$80				; 7
	out	($10),a				; 11
	ld	hl,PlotsScreen-12-(-(12*64)+1)		; 10
	ld	a,$20				; 7
	ld	c,a				; 4
	inc	hl				; 6 waste
	dec	hl				; 6 waste
fastCopyAgain:
	ld	b,64				; 7
	inc	c				; 4
	ld	de,-(12*64)+1			; 10
	out	($10),a				; 11
	add	hl,de				; 11
	ld	de,10				; 10
fastCopyLoop:
	add	hl,de				; 11
	inc	hl				; 6 waste
	inc	hl				; 6 waste
	inc	de				; 6
	ld	a,(hl)				; 7
	out	($11),a				; 11
	dec	de				; 6
	djnz	fastCopyLoop			; 13/8
	ld	a,c				; 4
	cp	$2B+1				; 7
	jr	nz,fastCopyAgain		; 10/1
	ei
	ret					; 10
; Critical timings:
;	command->command: 65
;	command->value  : 68
;	value  ->value  : 66
;	value  ->command: 67

;-----------------------------------
; GetSpriteBuffer
;-----------------------------------
GetSpriteBuffer:
	push af
	ld a,(GFX_Page_var)
	or a
	jp nz,retSpriteBuffer2
retSpriteBuffer1:
	ld hl,SpriteBuffer1
	pop af
	ret
retSpriteBuffer2:
	ld hl,SpriteBuffer2
	pop af
	ret

;-----------------------------------
; End of Routines
;-----------------------------------

Quit:
	ret

PicName:
	.db PictObj,tVarPict,tPic0,0,0
MatAname:
	.DB MatObj,tVarMat,tMatA,0

TempSprite:
	.db 8,0,0,0,0,0,0,0,0

SprRoutine_Flag:
	.db 0

MapWidth:
	.db 0
MapHeight:
	.db 0
MapX_O:
	.db 0
MapY_O:
	.db 0
ScreenStartX:
	.db 0
ScreenEndX:
	.db 0
ScreenStartY:
	.db 0
ScreenEndY:
	.db 0

Spr_Type:
	.db 0

GFX_Page_var:
	.db 0

UpdateLCD_Q:
	.db 0

SpriteBuffer1 = $9872
SpriteBuffer2 = $86EC

.end
.END
"My world is Black & White. But if I blink fast enough, I see it in Grayscale."
Image
Image
the_unknown_one
Calc Master
Posts: 1089
Joined: Fri 17 Dec, 2004 9:53 am

lol

Post by the_unknown_one »

Wow thats a load of code, i'm sure i can do lots with this! Thanks man, i'll put u in credits for sure! ;)
Post Reply