Blast The Roids [ Now Here! ]

I'm nervous to work on system level. It might not work on platforms like Puppy Linux. I think it would be worth sabotaging speed for functionality and compatibility. Here's my freegdk code so far:

Code: Select All | Copy To Clipboard

'Copyright (c) 2010 Keanen Wendler-Shaw

'Permission is hereby granted, free of charge, to any person obtaining a copy
'of this software and associated documentation files (the "Software"), to deal
'in the Software without restriction, including without limitation the rights
'to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
'copies of the Software, and to permit persons to whom the Software is
'furnished to do so, subject to the following conditions:

'The above copyright notice and this permission notice shall be included in
'all copies or substantial portions of the Software.

'THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
'IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
'FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
'AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
'LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
'OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
'THE SOFTWARE.

'The Software must retain the above copyright notice and permission notice
'until the copyright holders have declared the Software to be "public domain",
'after which any notices included in the Software may be removed.

#ifdef __FB_WIN32__
#include once "windows.bi"
#include once "win\mmsystem.bi"
#else

#endif

dim shared as string*2 closeTriggerString=chr$(255)+"k"
dim shared as ubyte escapeKeyEnabled=1
dim shared as uinteger ptr puiPixel,sgfxPointer

dim shared as integer mousex=320,mousey=240,mouseclick,screenwidth,screenheight

public sub centertext(byval textX as integer,byval textY as integer,byval textData as string)
draw string (textX-(len(textData)*4),textY-1),textData
end sub

public function controlkey() as ubyte
return multikey(&h1D)
end function

public sub disableescapekey
escapeKeyEnabled=0
end sub

public sub dot(byval x as integer,byval y as integer,byval c as uinteger=&hFFFFFF)
puiPixel=screenwidth*y+x+sgfxPointer
*puiPixel=c
end sub

public function downkey() as ubyte
return multikey(&h50)
end function

public sub enableescapekey
escapeKeyEnabled=1
end sub

public function escapekey() as ubyte
return multikey(&h01)
end function

public function leftkey() as ubyte
return multikey(&h4B)
end function

public function returnkey() as ubyte
return multikey(&h1C)
end function

public function rightkey() as ubyte
return multikey(&h4D)
end function

public sub setdisplaymode(byval sWidth as integer,byval sHeight as integer,byval sDepth as integer=32)
screenres sWidth,sHeight,sDepth,2,&h00
screenset 1,0
screenwidth=sWidth
screenheight=sHeight
sgfxPointer=screenptr()
width sWidth/8,sHeight/14
end sub

public sub soundloop(byval sound as string)
PlaySound(sound,NULL,SND_LOOP OR SND_NODEFAULT OR SND_ASYNC)
end sub

public sub soundplay(byval sound as string)
PlaySound(sound,NULL,SND_NODEFAULT OR SND_ASYNC)
end sub

public sub soundstop
PlaySound(NULL,NULL,0)
end sub

public function spacekey() as ubyte
return multikey(&h39)
end function

public sub sync
pcopy
cls 0
if multikey(&h38) and multikey(&h3E) or inkey$()=closeTriggerString then end
if escapeKeyEnabled=1 then if multikey(&h01) then end
getmouse(mousex,mousey,,mouseclick)
end sub

public sub text(byval textX as integer,byval textY as integer,byval textData as string)
draw string (textX,textY-1),textData
end sub

sub triangle(byval x1 as integer, byval y1 as integer,byval x2 as integer,byval y2 as integer,byval x3 as integer,byval y3 as integer,byval col as integer)

static as integer dx1,dy1, dx2,dy2, dx3,dy3, delta1,delta2,delta3, Lx,Rx, y, Lxo,Rxo

IF y2 < y1 THEN
SWAP y1, y2
SWAP x1, x2
END IF
IF y3 < y1 THEN
SWAP y3, y1
SWAP x3, x1
END IF

IF y3 < y2 THEN
SWAP y3, y2
SWAP x3, x2
END IF

dx1 = x2 - x1
dy1 = y2 - y1
IF dy1 <> 0 THEN
delta1 = (dx1 shl 16) \ dy1
ELSE
delta1 = 0
END IF

dx2 = x3 - x2
dy2 = y3 - y2
IF dy2 <> 0 THEN
delta2 = (dx2 shl 16) \ dy2
ELSE
delta2 = 0
END IF

dx3 = x1 - x3
dy3 = y1 - y3
IF dy3 <> 0 THEN
delta3 = (dx3 shl 16) \ dy3
ELSE
delta3 = 0
END IF

'Flat bottom
'Top part of triangle

Lx = x1 shl 16
Rx = Lx

FOR y = y1 TO y2 - 1
Lxo = Lx shr 16
Rxo = Rx shr 16
line(Lxo,y)-(Rxo,y),col
Lx = Lx + delta1
Rx = Rx + delta3
NEXT y

'Flat top
'Lower part of triangle

Lx = x2 shl 16
FOR y = y2 TO y3
Lxo = Lx shr 16
Rxo = Rx shr 16
line(Lxo,y)-(Rxo,y),col
Lx = Lx + delta2
Rx = Rx + delta3
NEXT y

end sub

public function upkey() as ubyte
return multikey(&h48)
end function