I froggin love it @__@
This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.
Show posts Menu
#ifndef scrap
#define scrap 8000h
.echo "Warning, 'scrap' not defined, defining scrap=8000h"
#endif
#ifndef SMC
arraybase= scrap
arraylen = scrap+2
#endif
heapflags= 33
curchild = 0
heapsort:
; HL points to the array data
; BC is the size of the array. NOT GREATER THAN 32767
; IX points to the routine that compares the values
#ifdef fast
call heapify
ld hl,(arraylen)
#else
push bc
call heapify
pop hl
#endif
_:
dec hl
ld (arraylen),hl
#ifndef fast
push hl
#endif
ld de,(arraybase)
add hl,hl
inc de
add hl,de
#ifdef fast
ld a,(de)
ldd
inc hl
ld (hl),a
dec hl
ld a,(de)
ldd
inc hl
ld (hl),a
#else
call swap
#endif
ld bc,1
call propogate
#ifdef fast
ld hl,(arraylen)
#else
pop hl
#endif
ld a,h
or l
jr nz,-_
ret
heapify:
;Inputs:
; HL points to the array data
; BC is the size of the array. NOT GREATER THAN 32767
; IX points to the routine that compares the values
ld (arraybase),hl
ld (arraylen),bc
srl b
rr c
_:
push bc
call propogate
pop bc
dec bc
ld a,b
or c
jr nz,-_
ret
propogate:
;BC-1 is the parent index
;2BC is the child1 index
res curchild,(iy+heapflags)
proppost:
sla c
rl b
ld d,b
ld e,c
#ifdef SMC
arraylen=$+1
ld hl,0
#else
ld hl,(arraylen)
#endif
sbc hl,de
add hl,de
ret c ;no children
;compare the two children
#ifdef SMC
arraybase=$+1
ld hl,0
#else
ld hl,(arraybase)
#endif
add hl,de
add hl,de
inc hl
ld d,(hl)
dec hl
ld e,(hl)
dec hl
push hl
ld a,(hl)
dec hl
ld l,(hl)
ld h,a
;HL holds the value of child0
;DE holds the value of child1
jr z,+_
call callix
jr nc,+_
ex de,hl
pop de
inc de
inc de
set curchild,(iy+heapflags)
push de
_:
;{stack} points to the child
;HL is the value of the child
;BC points to the parent
;now compare the child and parent
ex de,hl
ld hl,(arraybase)
add hl,bc
push hl
dec hl
ld a,(hl)
dec hl
ld l,(hl)
ld h,a
call callix
pop hl
pop de
ret nc
dec hl
call swap
;values swapped, now set parent=child
;BC is the index of child1
bit curchild,(iy+heapflags)
jp z,proppost
inc bc
jp propogate
swap:
;HL points to the top of one word
;DE points to the top of another
;Must preserve BC
#ifdef fast
ld a,(de)
ldd
inc hl
ld (hl),a
dec hl
ld a,(de)
ldd
inc hl
ld (hl),a
inc c
inc bc
#else
call +_
_:
ld a,(de)
ldd
inc hl
ld (hl),a
dec hl
inc bc
#endif
ret
callix:
jp (ix)
{1,-1
sum(L1Ans)sum(L2Ans->A
L1(1)L2(1->B
sum(L1)sum(L2->C
.5(C-A
{B,Ans,Ans+A-B->L1
0->C
L1e-5->L1 ;engineering E
For(K,1,3
C+L1(k->L1(K
e-5int(Ans->C
End
C->L1(4
e5fPart(L1->L1
def sqr3(a,b,c):
d=a+b+c #roughly 75% of cases exceed the original bit-width
d*=d
e=a-b+c #roughly 1/6 of the time this will exceed the original bit-width. However, whenever this exceeds the bit-width, then d also exceeds it.
e*=e
d=(d+e)/2
e=d-e
f=(a+b-c)*(a-b-c) #it is never the case that both multiplicands exceed their original word width, but about 1/3 of the time, one of them exceeds it (~2/3 of the time, neither exceed).
b*=(a-c) #neither multiplicand exceeds the original bit-width (though the second operand may become negative).
b+=b
a*=a
e=(e+b)/2
b=e-b
d=(d-f)/2
f+=d-a
return [a,e,d,b,f]
StorePic
While getKey(15)=0
L3->W
For(Z,L6,L6+767)
{Z} or {W}->{Z}
W+1->W
End
L6->Z+12->W
For(K,0,755)
rand or rand or rand or {W}->{Z}
W+1->W
Z+1->Z
End
DispGraph
End
#include "header.z80"
cx = vars
cy = vars+4
delta= vars+8
zx = vars+12
zy = vars+16
zx2 = vars+20
zy2 = vars+24
x = vars+28
y = vars+29
bufptr=vars+30
mask = vars+32
lcd_y= vars+33
tmp = vars+34
gbuf = 9340h
maxiter=16
start:
in a,(2)
add a,a
sbc a,a
and 3
out (20h),a
call init ;initialize keyboard, LCD, variables
forx:
ld a,64 ;set Y counter to 64
ld (y),a
ffmov(cy_init,cy)
ffmov(delta_init,delta)
fory:
in a,(1) ;poll the keyboard for [Clear]
and 40h
ret z
in a,(4) ;poll for [ON]
and 8
ret z
ffmov(cx,zx)
ffmov(cy,zy)
fmul(zx,zx,zx2)
fmul(zy,zy,zy2)
ld a,maxiter
jp endwhile
startwhile:
fmul(zx,zy,zy)
ld hl,zy+3 ;multiply zy by 2 by incrementing the exponent. No worries of overflow, so we can do this cheaply
inc (hl)
fadd(cy,zy,zy)
fsub(zx2,zy2,zx)
fadd(cx,zx,zx)
fmul(zx,zx,zx2)
fmul(zy,zy,zy2)
endwhile:
dec a
jr z,plotcalc
fadd(zx2,zy2,tmp)
;fcmp(tmp,four)
ld h,a
ld a,(tmp+3) ;check if tmp>=4. This happens if and only if the exponent of tmp is 82h or higher.
cp 82h
ld a,h
jr c,startwhile
plotcalc:
or a ;plot the pixel if counter reached zero
ld a,(mask)
ld hl,(bufptr)
jr nz,$+5
or (hl)
jr $+4
cpl
and (hl)
ld (hl),a
out (17),a
ld de,12
add hl,de
ld (bufptr),hl
fadd(cy,delta,cy)
ld hl,y
dec (hl)
jp nz,fory
fadd(cx,delta,cx)
ld hl,(bufptr)
ld a,(mask)
dec h
dec h
dec h
rrca
ld (mask),a
jr nc,+_
inc l
ld a,(lcd_y)
inc a
out (16),a
cp 2Ch
ld (lcd_y),a
_:
ld (bufptr),hl
ld hl,x
dec (hl)
jp nz,forx
ret
init:
di
ld a,80h ;Program the LCD to move the index to the top
out (16),a
;ld a,80h ;load the mask for the pixel data. Commented since 'a' is already 80h
ld (mask),a
ld hl,gbuf ;load the ptr to the actual pixel data
ld (bufptr),hl
ld a,96 ;set X counter
ld (x),a
ld hl,(cx_init) \ ld (cx),hl ;load the starting value for cx
ld hl,(cx_init+2) \ ld (cx+2),hl
ld a,$FD ;Program the keyboard to only poll for keys in the [Enter] through [Clear] range
out (1),a
ld a,20h
ld (lcd_y),a
out(16),a
xor a
ld hl,gbuf
ld (hl),a
ld de,gbuf+1
ld bc,767
ldir
ret
cx_init:
.db $00,$00,$80,$81 ;-2.0
; .db $00,$00,$80,$80 ;-1.0
; .db $51,$D6,$56,$7E ;.41960384
; .db $00,$00,$A0,$80 ;-1.25
cy_init:
; .db $00,$00,$80,$81 ;-2.0
.db $00,$00,$80,$80 ;-1.0
; .db $7C,$AA,$48,$7D ;.19596284
; .db $00,$00,$80,$7E ;-.25
;48aa7C
delta_init:
; .db $00,$00,$00,$7C ;.0625
.db $00,$00,$00,$7B ;.03125
; .db $1b,$29,$1d,$73 ;.00007494
; .db $00,$00,$00,$79 ;1/128
.echo "Size: ",$-$9D95," bytes"
Page created in 0.104 seconds with 31 queries.