W.I.P., i may implement DEF SEG into -lang qb in future just for fun - even without a SINGLE user asking for that during these 3 long years.

The current SVN version is needed to compile this source.

Code: Select all

`'' peekpoke.bi`

''

'' DEF SEG + PEEK/POKE to screen hack

'' copyleft (c) Space Ghost (ps: Zorak stinks)

''

'' TODO:

'' [ ] handle plannar modes (screen 7 and 12)

'' [ ] handle multiple pages (screen 7?)

'' [ ] handle text-mode

'' [ ] handle BIOS access

'' [ ] if seg = 0, use 'fbrocks' as base

'' note: 1) this won't work with local vars because SS != DS

'' 2) -lang qb must allocate main()'s locals in DS as before so most programs will work

type fbrocks

seg as __uinteger

lastseg as __uinteger

isgfx as long

islinear as long

w as long

h as long

bpp as long

pitch as long

buffer as __byte __ptr

end type

dim shared fbrocks as fbrocks

#define def fbrocks.

'':::::

#define varseg( v ) __cuint(__culng( @v ) __shr 16)

#undef varptr

#define varptr( v ) __cuint(__culng( @v ) and &h0000FFFF&)

'':::::

__private sub fbrocks_changeSeg

'' this is safe to be done if the seg was set using varseg(), because no

'' symbol will be allocated above &hA0000000 (> 2GB)

select case fbrocks.seg

case &hA000&

__screeninfo fbrocks.w, fbrocks.h, , fbrocks.bpp, fbrocks.pitch

fbrocks.buffer = __screenptr

fbrocks.isgfx = -1

fbrocks.islinear = -1

case else

fbrocks.isgfx = 0

end select

fbrocks.lastseg = fbrocks.seg

end sub

'':::::

#undef poke

__private sub poke( byval ofs as __uinteger, byval value as integer ) static

if( fbrocks.seg <> fbrocks.lastseg ) then

fbrocks_changeSeg

end if

if( fbrocks.isgfx ) then

dim x as long, y as long

if( fbrocks.islinear ) then

x = ofs mod fbrocks.w

y = ofs \ fbrocks.w

fbrocks.buffer[y * fbrocks.pitch + x] = value

__screenunlock y, y

else

end if

else

*__cast( __byte __ptr, (fbrocks.seg __shl 16) + ofs ) = value

end if

end sub

'':::::

#undef peek

__private function peek( byval ofs as __uinteger ) as integer

if( fbrocks.seg <> fbrocks.lastseg ) then

fbrocks_changeSeg

end if

if( fbrocks.isgfx ) then

dim x as long, y as long

if( fbrocks.islinear ) then

x = ofs mod fbrocks.w

y = ofs \ fbrocks.w

peek = fbrocks.buffer[y * fbrocks.pitch + x]

else

end if

else

peek = *__cast( __byte __ptr, (fbrocks.seg __shl 16) + ofs )

end if

end function

Neat QB test, use "-lang qb -include peekpoke.bi" (without quotes) to compile:

Code: Select all

`'Raycaster 36 lines by Enthropy`

SCREEN 13

xpos = 1.5

ypos = 1.5

DEF SEG = &HA000

DIM SHARED map(9, 9) AS INTEGER, flut(200) AS SINGLE, tex(31, 31) AS INTEGER, foff(15) AS INTEGER

6 IF p% < 100 THEN READ map(p% \ 10, p% MOD 10) ELSE IF p% < 200 THEN flut(p% + 1) = 25600 / (p% - 99) ELSE IF p% < 200 + 1024 THEN tex((p% - 200) \ 32, (p% - 200) AND 31) = 16 + 16 * RND

IF p% > 1223 AND p% < 1288 THEN PALETTE p% - 1224, (p% - 1224) * (1 + 256 + 65536&) ELSE IF p% > 1223 AND p% < 1352 THEN PALETTE (p% - 1224), (p% - 1288) * 256& ELSE IF p% > 1223 AND p% < 1416 THEN PALETTE (p% - 1224), (p% - 1352) * 65536& ELSE IF p% > 1223 AND p% < 1432 THEN foff(p% - 1416) = 64 * COS(p% * 3.141593 / 8)

p% = p% + 1

1 IF p% < 215 + 1224 THEN 6 ELSE dx = COS(angle) * .05 - (x% - 160) * SIN(angle) * .05 / 160

dy = (x% - 160) * COS(angle) * .05 / 160 + SIN(angle) * .05

IF dx < -.0001 THEN nextxt = -(xpos - INT(xpos)) / dx ELSE IF dx > .0001 THEN nextxt = (1 - xpos + INT(xpos)) / dx ELSE IF dx = 0 THEN nextxt = 10000

IF dx < -.0001 THEN dxt = -1 / dx ELSE IF dx > .0001 THEN dxt = 1 / dx ELSE IF dx = 0 THEN dxt = 10000

IF dy < -.0001 THEN nextyt = -(ypos - INT(ypos)) / dy ELSE IF dy > .0001 THEN nextyt = (1 - ypos + INT(ypos)) / dy ELSE IF dy = 0 THEN nextyt = 10000

IF dy < -.0001 THEN dyt = -1 / dy ELSE IF dy > .0001 THEN dyt = 1 / dy ELSE IF dy = 0 THEN dyt = 10000

xm% = INT(xpos)

ym% = INT(ypos)

2 IF nextxt < nextyt THEN t = nextxt ELSE t = nextyt

IF nextxt < nextyt THEN xm% = xm% + SGN(dx) ELSE ym% = ym% + SGN(dy)

IF nextxt < nextyt THEN nextxt = nextxt + dxt ELSE nextyt = nextyt + dyt

IF (map(ym%, xm%) = 0 AND t < 256) OR t < .1 THEN GOTO 2 ELSE tx% = ((xpos + ypos + t * (dx + dy)) * 32) AND 31

foff2% = foff(f% AND 15)

d1% = 99 - INT((800 + foff2%) / t)

d2% = 102 + INT((800 - foff2%) / t)

calc = (25600 - 32 * foff2%)

4 IF y% < d1% THEN POKE p& + x%, 128 + tex((xpos + dx * flut(200 - y%)) AND 31, (ypos + dy * flut(200 - y%)) AND 31) ELSE IF y% < d2% THEN POKE p& + x%, tex(((32 * (y% - d1%)) \ (d2% - d1%)), tx%) ELSE POKE p& + x%, 64 + tex((xpos * 32 + dx * calc / (y% - 99)) AND 31, (ypos * 32 + dy * calc / (y% - 99)) AND 31)

p& = (p& + 320) MOD 64000

y% = (y% + 1) MOD 200

IF y% > 0 THEN 4 ELSE x% = (x% + 1) MOD 320

3 IF x% > 0 THEN 1 ELSE a$ = INKEY$

IF a$ = "" THEN 3 ELSE angle = angle + ((a$ = CHR$(0) + "K") - (a$ = CHR$(0) + "M")) * .1

xpos2 = ((a$ = CHR$(0) + "H") - (a$ = CHR$(0) + "P")) * COS(angle) * .05

ypos2 = ((a$ = CHR$(0) + "H") - (a$ = CHR$(0) + "P")) * SIN(angle) * .05

IF map(INT(ypos - .05), INT(xpos - xpos2 - xpos2 - .05)) = 0 AND map(INT(ypos - .05), INT(xpos - xpos2 - xpos2 + .05)) = 0 AND map(INT(ypos + .05), INT(xpos - xpos2 - xpos2 - .05)) = 0 AND map(INT(ypos + .05), INT(xpos - xpos2 - xpos2 + .05)) = 0 THEN xpos = xpos - xpos2

IF map(INT(ypos - ypos2 - ypos2 - .05), INT(xpos - .05)) = 0 AND map(INT(ypos - ypos2 - ypos2 + .05), INT(xpos - .05)) = 0 AND map(INT(ypos - ypos2 - ypos2 - .05), INT(xpos + .05)) = 0 AND map(INT(ypos - ypos2 - ypos2 + .05), INT(xpos + .05)) = 0 THEN ypos = ypos - ypos2

f% = f% + (a$ = CHR$(0) + "H") - (a$ = CHR$(0) + "P")

IF a$ <> CHR$(27) THEN GOTO 1

'' data's rewritten to not screw with the forum formatting

DATA 7,8,7,8,7,8,7,8,7,8,7,0,0,0,0,0,0

data 0,0,8,8,0,9,1,0,2,10,2,0,7,7

data 0,1,9,0,0,0,10,0,8,8,0,0,0,0

data 0,0,0,0,7,7,0,3,11,3,11,0,0

data 0,8,8,0,11,0,0,3,0,0,0,7

data 7,0,3,0,0,11,0,0,0,8,8,0

data 0,0,0,0,0,0,0,7,8,7,8,7,8,7,8,7,8,8