DECLARE SUB fontput (z1%, y1%, in$, c%)
DECLARE SUB splash ()
DECLARE SUB gameover ()
DECLARE SUB blur (ecs1%, ey1%, ecs2%, ey2%)
DECLARE SUB Speckle (colla%)
DECLARE SUB tremor (howlong%)
DECLARE SUB options ()
DECLARE SUB Melt (howlong%)
DECLARE SUB hiscores ()
DECLARE SUB cheats ()
DECLARE SUB custom ()
DECLARE SUB newgame ()
DECLARE SUB credits ()
DECLARE SUB endprog ()
DECLARE SUB loadpal (FileName$)
DECLARE SUB writetext ()
DECLARE SUB CharPrintXY (X%, y%, Text$, Fore%, Back%, CursorPos%, ImageArray%())
DECLARE SUB mput2 (wx%, wy%, num%)
DECLARE SUB blendbox (x1%, y1%, x2%, y2%, light%)
DECLARE SUB gamemenu ()
DECLARE SUB menu ()
DECLARE SUB nextlev ()
DECLARE SUB diebitch ()
DECLARE SUB moveblood ()
DECLARE SUB collide ()
DECLARE SUB physics ()
DECLARE SUB mput (wx%, wy%, num%)
'Variable type to hold screen design item data.
TYPE DesignType
    ImageNo AS INTEGER
    xpos AS INTEGER
    ypos AS INTEGER
    DisAct AS INTEGER
END TYPE
DECLARE SUB InitPaletteData (FileName$, PaletteArray&())
DECLARE SUB InitDesignData (FileName$, DesignArray() AS DesignType)
DECLARE SUB InitImageData (FileName$, ImageArray%())
DECLARE SUB MakeImageIndex (ImageArray%(), IndexArray%())
DECLARE SUB DisplayDesign (DesignArray() AS DesignType, ImageArray%(), ImageIndex%(), ClsAction%)
DECLARE SUB ChangePalette (PaletteArray&())
DECLARE SUB WizzText (Text$, TopLine%, ImageArray%(), IndexArray%())
DECLARE FUNCTION GetDepth% (ImNo%, ImageArray%(), IndexArray%())
DECLARE FUNCTION GetWidth% (ImNo%, ImageArray%(), IndexArray%())
DECLARE SUB Cen40 (txt$, row%)
DECLARE FUNCTION ShowGIF% (file$)
DEFINT A-Z


DEFINT A-Z
'$INCLUDE: 'gslib.bi'
'$INCLUDE: 'ds4qb.bi'
DOSver! = Info.DOSver% / 100
Windows% = Info.WinMode%

result = InitDS4QB

PRINT "DIRECTSOUND FOR QUICKBASIC revision 3"
PRINT "MSDOS Version:"; DOSver!
PRINT "Windows Version:"; Windows%
PRINT "Clipboard function is available."
track1$ = "mp3\track1.mp3"
track2$ = "mp3\track2.mp3"
songplayen = 1
loadstream track1$, 1
DIM SHARED tracktime#
tracktime# = TIMER
DIM SHARED track1time%
DIM SHARED track2time%
OPEN "songtime.dat" FOR INPUT AS #6
INPUT #6, track1time%
INPUT #6, track2time%
CLOSE #6
DIM SHARED linkz$
DIM SHARED Melty(2400)
CLS
SCREEN 13
IF ShowGIF("logo.gif") THEN PRINT "Couldn't load the title gif!"
DO: LOOP UNTIL INKEY$ <> ""
COLOR 2
'player stuff
TYPE P
X AS INTEGER
y AS INTEGER
oldx AS INTEGER
oldy AS INTEGER
score AS LONG
speed AS SINGLE
inair AS INTEGER
movedo AS INTEGER
frame AS INTEGER
jumpspeed AS SINGLE
air AS INTEGER
lives AS INTEGER
END TYPE
DIM SHARED player AS P
player.lives = 15
DIM SHARED ndtime
DIM SHARED progspeed
progspeed = 2

TYPE partic
X AS INTEGER
y AS INTEGER
spd AS SINGLE
col AS INTEGER
END TYPE

TYPE pnts
kickflip AS INTEGER
indy AS INTEGER
shoveit AS INTEGER
threesixoh AS INTEGER
hardflip AS INTEGER
END TYPE

DIM SHARED addon AS pnts
addon.kickflip = 5
addon.indy = 1
addon.shoveit = 2
addon.threesixoh = 8
addon.hardflip = 16

DIM SHARED credtext$(31)
DIM SHARED nochooz%


'tile images
REDIM SHARED imgs(1 TO 48)
REDIM SHARED iindex(1 TO 48)
InitImageData "skat.put", imgs()
MakeImageIndex imgs(), iindex()

'sprite images
REDIM SHARED sk8ta(1 TO 42)
REDIM SHARED sindex(1 TO 42)
InitImageData "sprits.put", sk8ta()
MakeImageIndex sk8ta(), sindex()


'menu anim
REDIM SHARED mov(1 TO 6)
REDIM SHARED movindex(1 TO 6)
InitImageData "mov.put", mov()
MakeImageIndex mov(), movindex()

'various images
REDIM SHARED other(1 TO 6)
REDIM SHARED oindex(1 TO 6)
InitImageData "other.put", other()
MakeImageIndex other(), oindex()

'font
REDIM SHARED font1(1 TO 6)
REDIM SHARED fontindex(1 TO 6)
InitImageData "charset1.put", font1()
MakeImageIndex font1(), fontindex()


'constants
CONST KeyEsc = 1, KEYENTER = 28, KEYSPACE = 57
CONST KeyUp = 72, KeyDown = 80, KeyLeft = 75, KeyRight = 77
CONST no = 0
CONST yes = NOT no
CONST ollie = 1, kickflip = 7, one80 = 2, shoveit = 3, hardflip = 4, melon = 5, push = 6, landing = 7, crouch = 8
DIM SHARED gravity AS SINGLE
DIM SHARED friction
gravity = 9.52
friction = 10

DIM SHARED levnum
'fat-ass buffer
DIM SHARED buffer(0 TO 31999)
DIM SHARED minspeed
DIM SHARED maxspeed
maxspeed = 2
minspeed = 0
DIM SHARED fallspeed
DIM SHARED map(20, 12)
DIM SHARED tremors
GSinit
startup:
'menu
loadpal "default.pal"
menu

' palette.
loadpal "skate.pal"



OPEN linkz$ FOR INPUT AS #4
DIM SHARED numscreens
INPUT #4, numscreens
DIM SHARED possy
CLOSE #1
nextlev
	    


CLS

FOR dy% = 0 TO 12
FOR dx% = 0 TO 20
IF map(dx%, dy%) > 0 THEN
PUT (dx% * 16 - 16, dy% * 16 - 16), imgs(iindex(map(dx%, dy%))), PSET
END IF
NEXT
NEXT

playon:

DO
SELECT CASE songplayen
CASE 1: IF tracktime# + track1time% < TIMER THEN songplayen = 2: removestream: loadstream track2$, 1: tracktime# = TIMER
CASE 2: IF tracktime# + track1time% < TIMER THEN songplayen = 1: removestream: loadstream track1$, 1: tracktime# = TIMER
END SELECT
OUT (96), 157
player.oldy = player.y
k$ = INKEY$
k% = INP(96)
IF player.inair = 0 AND player.movedo <> ollie THEN
SELECT CASE k%
CASE KeyRight: player.speed = player.speed + 1: player.movedo = push
CASE KeyLeft: player.speed = player.speed - 1
CASE KeyUp: player.movedo = ollie: player.jumpspeed = (player.speed * 30)
CASE KeyUp AND player.movedo = crouch: player.movedo = ollie: player.jumpspeed = (player.speed * 35)
CASE KeyDown: player.movedo = crouch
CASE 46: cheats
END SELECT
END IF


IF player.inair = yes OR player.movedo = ollie THEN
k$ = INKEY$
k% = INP(96)
SELECT CASE k%
CASE KeyRight: player.air = melon: player.frame = 230
CASE KeyDown: player.air = kickflip: player.frame = 70
CASE KeyLeft: player.air = shoveit: player.frame = 130
CASE KeyUp AND player.air = shoveit: player.air = one80:  player.frame = 180
CASE KeyUp AND player.air = kickflip: player.air = hardflip: player.frame = 240
CASE 46: cheats
END SELECT
END IF


IF player.speed < minspeed THEN player.speed = minspeed
IF player.speed > maxspeed THEN player.speed = maxspeed


physics
collide
'move player, put skater, what a rhyme
IF player.inair = 0 AND player.movedo <> ollie THEN player.X = player.X + player.speed
 


IF player.inair = no AND player.movedo <> ollie THEN
SELECT CASE player.movedo
CASE push: player.frame = player.frame + 1: IF player.frame > 40 THEN player.frame = 10: player.movedo = 0
CASE crouch: player.frame = 410
CASE ELSE: player.frame = 10
END SELECT
ELSE
SELECT CASE player.air
CASE melon: player.frame = player.frame + .0001: player.score = player.score + addon.indy: IF player.frame >= 240 THEN player.frame = 60: player.air = 0
CASE kickflip: player.frame = player.frame + 3: player.score = player.score + addon.kickflip: IF player.frame >= 120 THEN player.frame = 60: player.air = 0
CASE shoveit: player.frame = player.frame + 2: player.score = player.score + addon.shoveit: IF player.frame >= 170 THEN player.frame = 60: player.air = 0
CASE one80: player.frame = player.frame + 2: player.score = player.score + addon.threesixoh: IF player.frame >= 220 THEN player.frame = 60: player.air = 0
CASE hardflip: player.frame = player.frame + 2: player.score = player.score + addon.hardflip: IF player.frame >= 290 THEN player.frame = 60: player.air = 0
CASE ELSE: IF player.movedo = ollie THEN player.frame = 60 ELSE player.frame = 10
END SELECT
END IF

mput player.X, player.y, (player.frame / 10)
IF tremors >= 1 THEN tremor INT(RND * 6)
IF progspeed >= 1 THEN gswait progspeed
IF player.lives < 0 THEN gameover: GOTO startup
LOOP UNTIL k% = KeyEsc
fontput 50, 92, "So, your gunna back out ha?", 4
DO: k$ = INKEY$: LOOP UNTIL LCASE$(k$) = "y" OR LCASE$(k$) = "n"
IF LCASE$(k$) = "n" THEN GOTO playon
CLOSE #4
Melt 4000
GOTO startup

REM $DYNAMIC
DEFSNG A-Z
SUB Cen40 (txt$, row%)
LOCATE row%, 19 - LEN(txt$) / 2: PRINT txt$
END SUB

REM $STATIC
DEFINT A-Z
'* CharPrintXY() subroutine:
'* Displays a text string at a graphics screen coordinate, using a character
'* set designed with PIXELplus 256. Text can be displayed using both a
'* foreground and background colour, or can be overprinted on the existing
'* screen image using the foreground colour.
'*
'* Parameters:
'*            x - Horizontal coordinate of where printing should start or:
'*                Use FROMCURSOR to use the current graphics cursor X
'*                coordinate.
'*                Use CENTRETEXT to have the text centred.
'*            y - Vertical coordinate of where printing should start or
'*                use FROMCURSOR to use the current graphics cursor Y
'*                coordinate.
'*        Text$ - The text string to be displayed.
'*         Fore - The foreground colour to display text in.
'*         Back - The background colour to display text in or use OVERPRINT
'*                to have the text overprinted on the existing screen image.
'*    CursorPos - Dictates where the graphics cursor should be left after
'*                the text has been displayed:
'*                Use NEWLINE to move the cursor to the start of a new line.
'*                Use TEXTEND to leave the cursor directly after the last
'*                character displayed.
'* ImageArray() - Image array holding the character set to be used. Each
'*                character must be an 8x8 image and be in the standard
'*                ASCII order, starting with the space character.
'*
SUB CharPrintXY (X, y, Text$, Fore, Back, CursorPos, ImageArray())

    MessLen = LEN(Text$)
    IF X = CENTRETEXT THEN
	'Find start X coordinate for centred text.
	w = MessLen * 8
	X = (320 - w) \ 2
    ELSEIF X = FROMCURSOR THEN
	'Use current X coordinate.
	X = POINT(0)
    END IF

    'Use current Y coordinate if requested.
    IF y = FROMCURSOR THEN y = POINT(1)

    'Create an 8x8 image array to build a character in.
    DIM newchar(1 TO 34)
    newchar(1) = 64: newchar(2) = 8

    'Get high byte equivalent of Fore & Back colours.
    HighFore = 0: HighBack = 0
    DEF SEG = VARSEG(HighFore)
    POKE VARPTR(HighFore) + 1, Fore
    DEF SEG = VARSEG(HighBack)
    POKE VARPTR(HighBack) + 1, Back
    DEF SEG

    IF Back = OVERPRINT THEN
	'*** Overprint text onto existing screen image ***

	'Loop to build and display each character of Text$.
	FOR j = 1 TO LEN(Text$)
	    GET (X, y)-STEP(7, 7), newchar(1)

	    BasePtr = (ASC(MID$(Text$, j, 1)) - 32) * 34

	    'Build new character image in NewChar().
	    FOR n = 3 TO 34
		PixPair = ImageArray(BasePtr + n)

		IF (PixPair AND &HFF) THEN
		    LowByte = Fore
		ELSE
		    LowByte = newchar(n) AND &HFF
		END IF

		IF (PixPair AND &HFF00) THEN
		    newchar(n) = HighFore OR LowByte
		ELSE
		    newchar(n) = (newchar(n) AND &HFF00) OR LowByte
		END IF
	    NEXT n

	    'Display the character.
	    GsSolidPUT X, y, VARSEG(buffer(0)), VARPTR(buffer(0)), VARSEG(newchar(1)), VARPTR(newchar(1))

	    'Find screen coordinates for next character.
	    IF X >= 305 THEN
		X = 0
		IF y >= 185 THEN y = 192 ELSE y = y + 8
	    ELSE
		X = X + 8
	    END IF
	NEXT j
    ELSE
	'*** Display text using foreground & background colours ***

	'Loop to build and display each character of Text$.
	FOR j = 1 TO LEN(Text$)
	    BasePtr = (ASC(MID$(Text$, j, 1)) - 32) * 34

	    'Build new character image in NewChar().
	    FOR n = 3 TO 34
		PixPair = ImageArray(BasePtr + n)

		IF (PixPair AND &HFF) THEN
		    LowByte = Fore
		ELSE
		    LowByte = Back
		END IF

		IF (PixPair AND &HFF00) THEN
		    newchar(n) = HighFore OR LowByte
		ELSE
		    newchar(n) = HighBack OR LowByte
		END IF
	    NEXT n

	    'Display the character.
	    GsSolidPUT X, y, VARSEG(buffer(0)), VARPTR(buffer(0)), VARSEG(newchar(1)), VARPTR(newchar(1))

	    'Find screen coordinates for next character.
	    IF X >= 305 THEN
		X = 0
		IF y >= 185 THEN y = 192 ELSE y = y + 8
	    ELSE
		X = X + 8
	    END IF
	NEXT j
    END IF

END SUB

'IF YOU READ THIS SUB THEN YOU ARE A CHEATING SCUM!!!!!!
SUB cheats
LOCATE 1, 1
PRINT "          "
LOCATE 1, 1
INPUT ">", cheatcode$
SELECT CASE LEFT$(LCASE$(cheatcode$), 8)
CASE "set_grav": gravity = VAL(RIGHT$(LCASE$(cheatcode$), 4))
CASE "set_mins": minspeed = VAL(RIGHT$(LCASE$(cheatcode$), 4))
CASE "set_maxs": maxspeed = VAL(RIGHT$(LCASE$(cheatcode$), 4))
CASE "next_lev": nextlev
CASE "delay_up": progspeed = progspeed + 1
CASE "delay_dn": progspeed = progspeed - 1
CASE "tremors!": tremors = 1
END SELECT
END SUB

REM $DYNAMIC
DEFSNG A-Z
FUNCTION Clipboard.Detect%

'  (c) Carl Gorringe 1/15/96
'------------------------------------------
'  Returns TRUE (-1) if Windows Clipboard
'  is Detected, else returns FALSE (0).
'------------------------------------------
'<< Done - Tested OK >>

DIM inreg AS RegType, outreg AS RegType

ClipMode% = False
WinMode% = Info.WinMode%

IF WinMode% > 1 THEN
  inreg.ax = &H1700
  CALL interrupt(&H2F, inreg, outreg)
  IF outreg.ax = &H1700 THEN
	 ClipMode% = False
  ELSE
	 ClipMode% = True
  END IF
END IF

Clipboard.Detect% = ClipMode%

END FUNCTION

SUB Clipboard.Empty (ErrCode%)

'  (c) Carl Gorringe 1/15/96
'---------------------------------------------
'  Empties the Clipboard
'  ErrCode% is the Error Code returned: 0=OK
'---------------------------------------------
'<< Done - Tested OK >>

DIM inreg AS RegType, outreg AS RegType
DIM InRegX AS RegTypeX, OutRegX AS RegTypeX

'--- Open Clipboard ---
	inreg.ax = &H1701
	CALL interrupt(&H2F, inreg, outreg)
	IF outreg.ax = 0 THEN
		ErrCode% = 1                  '<-- Clipboard is already open (error)
		EXIT SUB
	END IF

'--- Empty Clipboard ---
	inreg.ax = &H1702
	CALL interrupt(&H2F, inreg, outreg)
	IF outreg.ax = 0 THEN
		ErrCode% = 3                  '<-- Failure (error)
	END IF

'--- Close Clipboard ---
	inreg.ax = &H1708
	CALL interrupt(&H2F, inreg, outreg)
	IF outreg.ax = 0 THEN
		ErrCode% = 2                  '<-- Clipboard wont close (error)
		EXIT SUB
	END IF


END SUB

SUB Clipboard.Get (Format%, DataSeg%, DataOff%, ErrCode%)

'  (c) Carl Gorringe 1/15/96  << v1.0 >>
'---------------------------------------------
'  Gets Data from the Clipboard and stores
'  it at address DataSeg% : DataOff%
'  ErrCode% is the Error Code returned: 0=OK
'  Format% is the clipboard format number:
'         1 = Text (Windows Text)  <-- Contains garbage chars at end of text
'         2 = Bitmap Picture
'         3 = Metafile Picture
'         7 = OEM Text (DOS Text)  <-- Contains nulls at end of text
'---------------------------------------------
'<< Done - Tested OK >>

DIM inreg AS RegType, outreg AS RegType
DIM InRegX AS RegTypeX, OutRegX AS RegTypeX

'--- Open Clipboard ---
	inreg.ax = &H1701
	CALL interrupt(&H2F, inreg, outreg)
	IF outreg.ax = 0 THEN
		ErrCode% = 1                  '<-- Clipboard is already open (error)
		EXIT SUB
	END IF

'--- Get Clipboard Data ---
	InRegX.ax = &H1705
	InRegX.dx = Format%
	InRegX.es = DataSeg%
	InRegX.bx = DataOff%
	CALL interruptx(&H2F, InRegX, OutRegX)
	IF OutRegX.ax = 0 THEN
		ErrCode% = 3                  '<-- (error)
	END IF

'--- Close Clipboard ---
	inreg.ax = &H1708
	CALL interrupt(&H2F, inreg, outreg)
	IF outreg.ax = 0 THEN
		ErrCode% = 2                  '<-- Clipboard wont close (error)
		EXIT SUB
	END IF

END SUB

FUNCTION Clipboard.GetText$ (ErrCode%)

'  (c) Carl Gorringe 1/15/96  << v1.0 >>
'-----------------------------------------------------
'  Gets and Returns Text Data from the Clipboard.
'  Clipboard Format used is "OEM Text" (Format% = 7)
'  ErrCode% is the Error Code returned: 0=OK
'-----------------------------------------------------
'<< Done - Tested OK >>

ErrCode% = 0
Format% = 1       '<-- 7=OEM Text, 1=Windows Text

'--- Get Size of Clipboard ---
	Size& = Clipboard.Size&(Format%, ErrCode%)
	IF ErrCode% > 0 THEN EXIT FUNCTION
  
	IF Size& = 0 THEN
		ErrCode% = 4         '<-- Clipboard Empty!
		EXIT FUNCTION
	END IF

	IF Size& > 32000 THEN
		ErrCode% = 5         '<-- Clipboard Too Large for String Variable!
		EXIT FUNCTION
	END IF

'--- Get Text from Clipboard and Store It ---
	Temp$ = SPACE$(Size&)
	CALL Clipboard.Get(Format%, VARSEG(Temp$), SADD(Temp$), ErrCode%)
  
	IF ErrCode% = 0 THEN
		'--- Trim Ending Garbage ---
			Temp$ = LEFT$(Temp$, INSTR(Temp$, CHR$(0)) - 1)

		'--- Trim Ending CR/LF if Exists ---
			IF RIGHT$(Temp$, 2) = CHR$(13) + CHR$(10) THEN
				Temp$ = LEFT$(Temp$, LEN(Temp$) - 2)
			END IF

		Clipboard.GetText$ = Temp$
	END IF

END FUNCTION

SUB Clipboard.Put (Format%, DataSeg%, DataOff%, DataSize&, ErrCode%)

'  (c) Carl Gorringe 1/15/96  << v1.0 >>
'---------------------------------------------
'  Stores Data on to the Clipboard starting
'  from address DataSeg% : DataOff%
'    and storing DataSize& bytes.
'  ErrCode% is the Error Code returned: 0=OK
'  Format% is the clipboard format number:
'         1 = Text (Windows Text)
'         2 = Bitmap Picture
'         3 = Metafile Picture
'         7 = OEM Text (DOS Text)
'---------------------------------------------
'<< Done - Tested OK >>

DIM inreg AS RegType, outreg AS RegType
DIM InRegX AS RegTypeX, OutRegX AS RegTypeX

'--- Open Clipboard ---
	inreg.ax = &H1701
	CALL interrupt(&H2F, inreg, outreg)
	IF outreg.ax = 0 THEN
		ErrCode% = 1                  '<-- Clipboard is already open (error)
		EXIT SUB
	END IF

'--- Store Clipboard Data ---
	InRegX.ax = &H1703
	InRegX.dx = Format%
	InRegX.es = DataSeg%
	InRegX.bx = DataOff%
	IF DataSize& < 32768 THEN
		InRegX.si = 0
		InRegX.cx = DataSize&
	ELSE
		InRegX.si = (DataSize& \ 32768) * 2048   '<-- This part NOT Tested!
		InRegX.cx = DataSize& MOD 32768          '<-- but don't worry about it.
	END IF
  
	CALL interruptx(&H2F, InRegX, OutRegX)
	IF OutRegX.ax = 0 THEN
		ErrCode% = 3                  '<-- (error)
	END IF

'--- Close Clipboard ---
	inreg.ax = &H1708
	CALL interrupt(&H2F, inreg, outreg)
	IF outreg.ax = 0 THEN
		ErrCode% = 2                  '<-- Clipboard wont close (error)
		EXIT SUB
	END IF

END SUB

SUB Clipboard.PutText (Text$, ErrCode%)
ErrCode% = 0
CALL Clipboard.Empty(ErrCode%)
IF ErrCode% <> 0 THEN
  ErrCode% = ErrCode% + 10
  EXIT SUB
END IF
Temp$ = Text$ + CHR$(0)
TempLen& = LEN(Temp$)
CALL Clipboard.Put(1, VARSEG(Temp$), SADD(Temp$), TempLen&, ErrCode%)
CALL Clipboard.Put(7, VARSEG(Temp$), SADD(Temp$), TempLen&, ErrCode%)
END SUB

FUNCTION Clipboard.Size& (Format%, ErrCode%)

'  (c) Carl Gorringe 1/15/96  << v1.0 >>
'---------------------------------------------
'  Returns the current size of the Clipboard
'  in bytes, using the specified Format%
'  ErrCode% is the Error Code returned: 0=OK
'  Format% is the clipboard format number:
'         1 = Text (Windows Text)
'         2 = Bitmap Picture
'         3 = Metafile Picture
'         7 = OEM Text (DOS Text)
'---------------------------------------------
'<< Done - Tested OK >>

DIM inreg AS RegType, outreg AS RegType
DIM InRegX AS RegTypeX, OutRegX AS RegTypeX

ErrCode% = 0

'--- Open Clipboard ---
	inreg.ax = &H1701
	CALL interrupt(&H2F, inreg, outreg)
	IF outreg.ax = 0 THEN
		ErrCode% = 1                  '<-- Clipboard is already open
		Clipboard.Size& = 0
		EXIT FUNCTION
	END IF

'--- Get Size of Clipboard in current Format ---
	inreg.ax = &H1704
	inreg.dx = Format%
	CALL interrupt(&H2F, inreg, outreg)
	ClipSize& = (outreg.dx * 16) + outreg.ax

'--- Close Clipboard ---
	inreg.ax = &H1708
	CALL interrupt(&H2F, inreg, outreg)
	IF outreg.ax = 0 THEN
		ErrCode% = 2                  '<-- Clipboard wont close
		Clipboard.Size& = 0
		EXIT FUNCTION
	END IF

Clipboard.Size& = ClipSize&

END FUNCTION

DEFINT A-Z
SUB collide
IF player.X > 295 THEN nextlev
doitagainsam:
IF POINT(player.X + 20, player.y + 27) <> 74 OR POINT(player.X, player.y + 27) <> 74 AND player.y > 0 THEN
IF player.y < 0 THEN GOTO notinair
player.inair = no
player.movedo = 0
player.air = 0
player.y = player.y - 1
ELSE
IF POINT(player.X + 1, player.y + 28) = 74 THEN player.inair = yes
END IF

col = POINT(player.X + 1, player.y + 31)
IF col > 66 AND col < 70 THEN splash: EXIT SUB

FOR ysample = 0 TO 18 STEP 3
col = POINT(player.X + 21, player.y + ysample)
IF col > 66 AND col < 70 THEN splash: EXIT SUB
IF col <> 74 AND col <> 0 AND col <> 4 AND col <> -1 AND player.X < 295 AND player.X > 25 THEN diebitch
NEXT
notinair:

END SUB

REM $STATIC
SUB credits
f% = FREEFILE
OPEN "credits.dat" FOR INPUT AS f%
FOR rcred% = 1 TO 31
INPUT #f%, credtext$(rcred%)
NEXT rcred%
CLOSE f%
CLS
FOR scroller% = 1 TO 31
GSscroll &HA000, 0, &HA000, 0, 0, -8
Cen40 credtext$(scroller%), 23
t# = TIMER
DO: LOOP WHILE t# + .3 > TIMER
NEXT scroller%

FOR scrolltherest% = 1 TO 23
GSscroll &HA000, 0, &HA000, 0, 0, -8
t# = TIMER
DO: LOOP WHILE t# + .3 > TIMER
NEXT scrolltherest%
OUT 96, 157
END SUB

SUB custom
END SUB

SUB diebitch
player.X = player.X + player.speed
FOR fram% = 30 TO 40
FOR dy% = 0 TO 12
FOR dx% = 0 TO 20
IF map(dx%, dy%) > 0 THEN
GsSolidPUT dx% * 16 - 16, dy% * 16 - 16, VARSEG(buffer(0)), VARPTR(buffer(0)), VARSEG(imgs(iindex(map(dx%, dy%)))), VARPTR(imgs(iindex(map(dx%, dy%))))
END IF
NEXT
NEXT
Gssprite player.X, player.y, VARSEG(buffer(0)), VARPTR(buffer(0)), VARSEG(sk8ta(sindex(fram%))), VARPTR(sk8ta(sindex(fram%)))
GSpcopy VARSEG(buffer(0)), VARPTR(buffer(0)), &HA000, 0
IF progspeed > 0 THEN gswait (progspeed * 3)
NEXT fram%
player.X = 1
player.y = 1
player.speed = 0
player.movedo = 0
player.air = 0
player.lives = player.lives - 1
END SUB

SUB endprog
SCREEN 0
WIDTH 80, 25
PRINT "Unloading DS4QB....Thanks Nek!"
ShutDownDs4QB
COLOR 1
PRINT "Goodbye!"
COLOR 2
PRINT "www.geocities.com/hfezz"
COLOR 1
PRINT "Go there now for more cool stuff."
PRINT ""
COLOR 3
PRINT "THIS HAS BEEN A QASIR PRODUCTION!"
SYSTEM
END SUB

SUB fontput (z1%, y1%, in$, c%)
DEF SEG = &HFFA6
o1% = z1%
FOR l% = 1 TO LEN(in$)
	l$ = MID$(in$, l%, 1)
	FOR y% = y1% TO y1% + 7
		X% = PEEK(&HE + (ASC(l$) * 8) + (y% - y1%))
		FOR z% = 0 TO 7
			IF X% AND (2 ^ (7 - z%)) THEN GSPSET z1%, y%, &HA000, 0, c%
			z1% = z1% + 1
		NEXT z%
		z1% = z1% - 8
	NEXT y%
	z1% = z1% + 8
NEXT l%
DEF SEG
END SUB

SUB gameover
Melt 8000
Speckle 74
LINE (0, 0)-(319, 199), 74, BF
GSpcopy &HA000, 0, VARSEG(buffer(0)), VARPTR(buffer(0))
OPEN "high.dat" FOR INPUT AS #14
INPUT #14, dudesname$, oldscore&
CLOSE #14
urscore& = player.score + (player.lives * 3000)
IF urscore& > oldscore& THEN
CharPrintXY 55, 96, "Yeah! You got a high score!", 40, 74, 0, font1()
ELSE
CharPrintXY 55, 96, "You suck man! Try Again!!!!", 40, 74, 0, font1(): GSpcopy VARSEG(buffer(0)), VARPTR(buffer(0)), &HA000, 0:  SLEEP: GOTO lost
END IF
GSpcopy VARSEG(buffer(0)), VARPTR(buffer(0)), &HA000, 0
SLEEP
DO
agen:
y = INT((104 - 50 + 1) * RND + 50)
X = INT((271 - 55 + 1) * RND + 55)
givet = INT(1 - (-1) + 1) * RND + (-1)
col = POINT(X, y)
IF col = 74 THEN GOTO agen
GSPSET X, y - 1, &HA000, 0, col + givet
count = count + 1
LOOP UNTIL count = 2000 OR INKEY$ = CHR$(27)
PRINT "Type yo name!"
INPUT "", dudesname$
oldscore& = urscore&
OPEN "high.dat" FOR OUTPUT AS #14
WRITE #14, dudesname$, oldscore&
CLOSE #14

lost:
LINE (0, 0)-(319, 199), 74, BF
GSpcopy &HA000, 0, VARSEG(buffer(0)), VARPTR(buffer(0))
CharPrintXY -1, 88, dudesname$, 4, 74, 0, font1()
CharPrintXY -1, 96, STR$(oldscore&), 1, 74, 0, font1()
GSpcopy VARSEG(buffer(0)), VARPTR(buffer(0)), &HA000, 0
SLEEP
CLS
Gsboxf VARSEG(buffer(0)), VARPTR(buffer(0)), 0, 0, 319, 199, 0

player.score = 0
levnum = 0
player.lives = 9
END SUB

REM $DYNAMIC
'* GetDepth() function:
'* Returns the depth (in pixels) of any image contained in an image array.
'*
'* Parameters:
'*         ImNo - The number of the image to return the depth of.
'* ImageArray() - Image array that contains the image.
'* IndexArray() - Index array for the images in ImageArray().
'*
FUNCTION GetDepth (ImNo, ImageArray(), IndexArray())

    GetDepth = ImageArray(IndexArray(ImNo) + 1)

END FUNCTION

'* GetWidth() function:
'* Returns the width (in pixels) of any image contained in an image array.
'*
'* Parameters:
'*         ImNo - The number of the image to return the width of.
'* ImageArray() - Image array that contains the image.
'* IndexArray() - Index array for the images in ImageArray().
'*
FUNCTION GetWidth (ImNo, ImageArray(), IndexArray())

    GetWidth = ImageArray(IndexArray(ImNo)) \ 8

END FUNCTION

REM $STATIC
SUB hiscores
OPEN "high.dat" FOR INPUT AS #14
INPUT #14, dudesname$, oldscore&
CLOSE #14
CharPrintXY -1, 88, dudesname$, 4, 74, 0, font1()
CharPrintXY -1, 96, STR$(oldscore&), 1, 74, 0, font1()
GSpcopy VARSEG(buffer(0)), VARPTR(buffer(0)), &HA000, 0
SLEEP
CLS

END SUB

REM $DYNAMIC
DEFSNG A-Z
FUNCTION Info.DOSver%

'  (c) Carl Gorringe 1/15/96
'--------------------------------------
'  Returns the DOS version times 100.
'  To get decimal representation,
'  devide the number returned by 100.
'--------------------------------------
'<< Done - Tested OK >>

DIM inreg AS RegType, outreg AS RegType

inreg.ax = &H3306
CALL interrupt(&H21, inreg, outreg)
DOSver% = ((outreg.bx AND 255) * 100) + (outreg.bx \ 256)
IF DOSver% = 0 THEN
  inreg.ax = &H3000
  CALL interrupt(&H21, inreg, outreg)
  DOSver% = ((outreg.ax AND 255) * 100) + (outreg.ax \ 256)
END IF

Info.DOSver% = DOSver%

END FUNCTION

FUNCTION Info.WinMode%

'  (c) Carl Gorringe 1/15/96
'-------------------------------------------------------------
'  Returns the current Windows Mode:
'    0 = Windows not detected
'    1 = Real mode detected (Win 3.0 and earlier only)
'    2 = Standard mode detected. (Win 3.11 and earlier only)
'    3 = 386 enhanced mode detected.
'-------------------------------------------------------------
'<< Done - Tested OK >>

DIM inreg AS RegType, outreg AS RegType

DOSver% = Info.DOSver%

IF DOSver% >= 300 THEN
  inreg.ax = &H160A
  CALL interrupt(&H2F, inreg, outreg)
  IF outreg.ax <> 0 THEN
	 WinMode% = 0
  ELSE
	 WinMode% = outreg.cx
  END IF
END IF

Info.WinMode% = WinMode%

END FUNCTION

DEFINT A-Z
'* InitDesignData() subroutine:
'* Initializes a DesignType array with screen design data - this must be done
'* before displaying a screen design using the DisplayDesign() routine. The
'* calling value of FileName$ dictates whether the data should be read
'* directly from a screen design file or from DATA statements (see below).
'*
'* Parameters:
'*     FileName$ - The name of the screen design file to load. This must
'*                 include the path to the file if it does not reside in the
'*                 current directory. If FileName$ is an empty string (""),
'*                 screen design data is read from DATA statements.
'* DesignArray() - Dynamic, DesignType array to hold the screen design data.
'*
'* Note: Before calling InitDesignData() to initialize a screen design from
'*       DATA statements, use an appropriate RESTORE statement to ensure the
'*       correct DATA statements are read.
'*
SUB InitDesignData (FileName$, DesignArray() AS DesignType)

    IF FileName$ <> "" THEN
	'***** Read screen design data from file *****

	'Establish size of DesignType array required.
	FileNo = FREEFILE
	OPEN FileName$ FOR BINARY AS #FileNo
	ItemCount = (LOF(FileNo) - 7) \ 8
	CLOSE #FileNo
	REDIM DesignArray(0 TO ItemCount) AS DesignType

	'Load screen design data directly into array memory.
	DEF SEG = VARSEG(DesignArray(0))
	BLOAD FileName$, 0
	DEF SEG
    ELSE
	'***** Read screen design data from DATA statements *****

	'Establish size of DesignType array required.
	READ ItemCount
	REDIM DesignArray(0 TO ItemCount) AS DesignType

	'READ screen design DATA into array.
	FOR n = 1 TO ItemCount
	    READ ImageNo, xpos, ypos, DisAct
	    DesignArray(n).ImageNo = ImageNo
	    DesignArray(n).xpos = xpos
	    DesignArray(n).ypos = ypos
	    DesignArray(n).DisAct = DisAct
	NEXT n
    END IF

END SUB

REM $STATIC
FUNCTION InitDS4QB
ClipExist% = Clipboard.Detect%
IF ClipExist% = False THEN
  PRINT "Clipboard not available"
  END
END IF
SHELL "start /m ds4qb.exe"
END FUNCTION

REM $DYNAMIC
'* InitImageData() subroutine:
'* Initializes an integer array with image data - this must be done before
'* displaying an image using the PUT(graphics) statement. The calling value
'* of FileName$ dictates whether the data should be read directly from an
'* image file or from DATA statements (see below).
'*
'* Parameters:
'*    FileName$ - The name of the image file to load. This must include the
'*                path to the file if it does not reside in the current
'*                directory. If FileName$ is an empty string (""), image
'*                data is read from DATA statements.
'* ImageArray() - Dynamic, integer array to hold the image data.
'*
'* Note: Before calling InitImageData() to initialize images from DATA
'*       statements, use an appropriate RESTORE statement to ensure the
'*       correct DATA statements are read.
'*
SUB InitImageData (FileName$, ImageArray())

    IF FileName$ <> "" THEN
	'***** Read image data from file *****

	'Establish size of integer array required.
	FileNo = FREEFILE
	OPEN FileName$ FOR BINARY AS #FileNo
	Ints = (LOF(FileNo) - 7) \ 2
	CLOSE #FileNo
	REDIM ImageArray(1 TO Ints)

	'Load image data directly into array memory.
	DEF SEG = VARSEG(ImageArray(1))
	BLOAD FileName$, 0
	DEF SEG
    ELSE
	'***** Read image data from DATA statements *****

	'Establish size of integer array required.
	READ IntCount
	REDIM ImageArray(1 TO IntCount)

	'READ image DATA into array.
	FOR n = 1 TO IntCount
	    READ X
	    ImageArray(n) = X
	NEXT n
    END IF

END SUB

'* InitPaletteData() subroutine:
'* Initializes a long integer array with palette colour data - this must be
'* done before changing palettes with the PALETTE USING statement. The
'* calling value of FileName$ dictates whether the data should be read
'* directly from a palette file or from DATA statements (see below).
'*
'* Parameters:
'*       FileName$ - The name of the palette file to load. This must include
'*                   the path to the file if it does not reside in the
'*                   current directory. If FileName$ is an empty string (""),
'*                   palette data is read from DATA statements.
'* PaletteArray&() - Dynamic, long integer array to hold palette data.
'*
'* Note: Before calling InitPaletteData() to initialize a palette from DATA
'*       statements, use an appropriate RESTORE statement to ensure the
'*       correct DATA statements are read.
'*
SUB InitPaletteData (FileName$, PaletteArray&())

    'Size array to hold all 256 colours.
    REDIM PaletteArray&(0 TO 255)

    IF FileName$ <> "" THEN
	'*** Read palette data from file ***
	FileNo = FREEFILE
	OPEN FileName$ FOR BINARY AS #FileNo
	FOR n = 0 TO 255
	    GET #FileNo, , colour&
	    PaletteArray&(n) = colour&
	NEXT n
	CLOSE #FileNo
    ELSE
	'*** Read palette data from DATA statements ***
	FOR n = 0 TO 255
	    READ colour&
	    PaletteArray&(n) = colour&
	NEXT n
    END IF

END SUB

REM $STATIC
SUB LoadModule (ModuleName AS STRING, Repeat AS INTEGER)
DS4QBbuffer = "DS4QBLOADMOD" + ModuleName + "|" + LTRIM$(RTRIM$(STR$(Repeat)))
CALL Clipboard.PutText(DS4QBbuffer, ErrCode%)
END SUB

SUB loadpal (FileName$)
DIM pal(512)
DEF SEG = VARSEG(pal(0))
BLOAD FileName$, 0
i = 0
FOR c = 0 TO 255
  OUT &H3C8, c
  OUT &H3C9, PEEK(i)
  OUT &H3C9, PEEK(i + 1)
  OUT &H3C9, PEEK(i + 2)
  i = i + 4
NEXT
DEF SEG

END SUB

SUB LoadSamples (SampleName AS STRING)
DS4QBbuffer = "DS4QBLOADSAMPLES" + SampleName + "|"
CALL Clipboard.PutText(DS4QBbuffer, ErrCode%)
END SUB

SUB loadstream (FileName AS STRING, Repeat AS INTEGER)
DS4QBbuffer = "DS4QBLOADSTREAM" + FileName + "|" + LTRIM$(RTRIM$(STR$(Repeat)))
CALL Clipboard.PutText(DS4QBbuffer, ErrCode%)
END SUB

REM $DYNAMIC
'* MakeImageIndex() subroutine:
'* Constructs an image position index for the images held in an image array.
'*
'* Parameters:
'* ImageArray() - Dynamic, integer array holding images to be indexed.
'* IndexArray() - Dynamic, integer array to hold the index for images in
'*                ImageArray().
'*
SUB MakeImageIndex (ImageArray(), IndexArray())

    'The index will initially be built in a temporary array, allowing
    'for the maximum 1000 images per file.
    DIM Temp(1 TO 1000)
    Ptr& = 1: IndexNo = 1: LastInt = UBOUND(ImageArray)
    DO
	Temp(IndexNo) = Ptr&
	IndexNo = IndexNo + 1

	'Evaluate descriptor of currently referenced image to
	'calculate the beginning of the next image.
	X& = (ImageArray(Ptr&) \ 8) * (ImageArray(Ptr& + 1)) + 4
	IF X& MOD 2 THEN X& = X& + 1
	Ptr& = Ptr& + (X& \ 2)
    LOOP WHILE Ptr& < LastInt

    LastImage = IndexNo - 1

    'Copy the image index values into the actual index array.
    REDIM IndexArray(1 TO LastImage)
    FOR n = 1 TO LastImage
	IndexArray(n) = Temp(n)
    NEXT n

END SUB

REM $STATIC
SUB Melt (howlong%)
FOR i = 1 TO howlong%
  X = INT(RND * 271)
  y = INT(RND * 150)
  GET (X, y)-(X + 48, y + 48), Melty
  GsSolidPUT X, y + 1, &HA000, 0, VARSEG(Melty(0)), VARPTR(Melty(0))
IF INKEY$ <> "" THEN EXIT SUB
NEXT i

END SUB

SUB menu
redo:
DEF SEG = &HA000
BLOAD "menu.gfx", 0
DEF SEG
pointer = 1
ypos = 35
kup$ = CHR$(0) + CHR$(72)
kdown$ = CHR$(0) + CHR$(80)
frame = 1
chosen = 0
DO
LINE (80, ypos)-(96, ypos + 16), 47, BF
k$ = INKEY$
SELECT CASE k$
CASE kup$: IF pointer > 1 THEN pointer = pointer - 1: frame = frame + 1: ypos = ypos - 11
CASE kdown$: IF pointer < 7 THEN pointer = pointer + 1: frame = frame + 1: ypos = ypos + 11
CASE " ": chosen = pointer
END SELECT
IF frame > 4 THEN frame = 1
IF chosen <> 0 THEN
'check which oppo has been selected
SELECT CASE chosen
CASE 1: Melt 9000: newgame: IF nochooz <> 1 THEN CLS : EXIT SUB:  ELSE GOTO redo
CASE 2: hiscores
CASE 3: SHELL "leved.exe"
CASE 4: SCREEN 0: WIDTH 80, 25: SHELL "readfile skatey.txt": SCREEN 13
CASE 5: Speckle 0: options: GOTO redo
CASE 6: Speckle 0: credits
CASE 7: endprog
END SELECT
GOTO redo
END IF
GsSolidPUT 80, ypos, &HA000, 0, VARSEG(other(oindex(frame))), VARPTR(other(oindex(frame)))
gswait 1
LOOP
END SUB

REM $DYNAMIC
SUB mput (wx, wy, num)
FOR dy% = 0 TO 12
FOR dx% = 0 TO 20
IF map(dx%, dy%) > 0 THEN
GsSolidPUT dx% * 16 - 16, dy% * 16 - 16, VARSEG(buffer(0)), VARPTR(buffer(0)), VARSEG(imgs(iindex(map(dx%, dy%)))), VARPTR(imgs(iindex(map(dx%, dy%))))
END IF
NEXT
NEXT
CharPrintXY 1, 1, STR$(player.score), 4, 74, 0, font1()
writetext
Gssprite wx, wy, VARSEG(buffer(0)), VARPTR(buffer(0)), VARSEG(sk8ta(sindex(num))), VARPTR(sk8ta(sindex(num)))
GSpcopy VARSEG(buffer(0)), VARPTR(buffer(0)), &HA000, 0
END SUB

REM $STATIC
SUB newgame
player.y = 1
player.X = 1
player.score = 0
reddo:
DEF SEG = &HA000
BLOAD "newgame.gfx", 0
DEF SEG
pointer = 1
ypos = 35
kup$ = CHR$(0) + CHR$(72)
kdown$ = CHR$(0) + CHR$(80)
frame = 1
chosen = 0
DO
LINE (80, ypos)-(96, ypos + 16), 47, BF
k$ = INKEY$
SELECT CASE k$
CASE kup$: IF pointer > 1 THEN pointer = pointer - 1: frame = frame + 1: ypos = ypos - 11
CASE kdown$: IF pointer < 3 THEN pointer = pointer + 1: frame = frame + 1: ypos = ypos + 11
CASE " ": chosen = pointer
END SELECT
IF frame > 4 THEN frame = 1
IF chosen <> 0 THEN
'check which oppo has been selected
SELECT CASE chosen
CASE 1: nochooz = 0: linkz$ = "gamedat.lk": Speckle 0: EXIT SUB
CASE 2: nochooz = 0: custom
CASE 3: nochooz = 1: EXIT SUB
END SELECT
GOTO reddo
END IF
GsSolidPUT 80, ypos, &HA000, 0, VARSEG(other(oindex(frame))), VARPTR(other(oindex(frame)))
gswait 1
LOOP

END SUB

SUB nextlev
levnum = levnum + 1
IF levnum > numscreens THEN
gameover
player.y = 1
player.X = 1
player.score = 0
levnum = 0
EXIT SUB
END IF

INPUT #4, leveler$
player.X = 1
OPEN leveler$ FOR INPUT AS #1
FOR wy = 0 TO 12
FOR eg = 0 TO 20
INPUT #1, map(eg, wy)
NEXT
NEXT
CLOSE #1
END SUB

SUB options
CLS
INPUT "Program slowdown?", progspeed
Melt 2000
DO UNTIL LCASE$(melton$) = "y" OR LCASE$(melton$) = "n": INPUT "Melt Effect (y/n) ", melton$: LOOP
Melt 2000
END SUB

REM $DYNAMIC
SUB physics

IF player.movedo = ollie THEN
player.y = player.y - (player.jumpspeed / gravity)
player.jumpspeed = player.jumpspeed - 1.5
player.speed = player.speed - .005
player.X = player.X + player.speed
GOTO nono
END IF

IF player.inair = yes THEN
player.y = player.y + (gravity / 10)
player.speed = player.speed - .005
player.X = player.X + player.speed
ELSE
player.speed = player.speed - .001
END IF

nono:
END SUB

REM $STATIC
SUB PlayCD (Track AS INTEGER, Repeat AS INTEGER)
tracky$ = LTRIM$(RTRIM$(STR$(Track)))
IF LEN(tracky$) = 1 THEN tracky$ = "0" + tracky$
DS4QBbuffer = "DS4QBPLAYCD" + tracky$ + "|" + LTRIM$(RTRIM$(STR$(Repeat)))
CALL Clipboard.PutText(DS4QBbuffer, ErrCode%)
END SUB

SUB PlaySample (SampleNumber AS INTEGER)
OUT &H0, SampleNumber
END SUB

SUB RemoveModule
DS4QBbuffer = "DS4QBREMOVEMODULE|"
CALL Clipboard.PutText(DS4QBbuffer, ErrCode%)
END SUB

SUB RemoveSamples
DS4QBbuffer = "DS4QBREMOVESAMPLES|"
CALL Clipboard.PutText(DS4QBbuffer, ErrCode%)
END SUB

SUB removestream
DS4QBbuffer = "DS4QBREMOVESTREAM|"
CALL Clipboard.PutText(DS4QBbuffer, ErrCode%)
END SUB

FUNCTION ShowGIF (file$)
'Prefix() and Suffix() hold the LZW phrase dictionary.
'OutStack() is used as a decoding stack.
'ShiftOut() as a power of two table used to quickly retrieve the LZW
'multibit codes.
DIM Prefix(4095), Suffix(4095), OutStack(4095), ShiftOut(8)

'The following line is for the QB environment(slow).
DIM YBase AS LONG, Powersof2(11) AS LONG, WorkCode AS LONG
'For a little more speed, unremark the next line and remark the one
'above, before you compile... You'll get an overflow error if the
'following line is used in the QB environment, so change it back.
'DIM YBase AS INTEGER, Powersof2(11) AS INTEGER, WorkCode AS INTEGER

'Precalculate power of two tables for fast shifts.
FOR a = 0 TO 8: ShiftOut(8 - a) = 2 ^ a: NEXT
FOR a = 0 TO 11: Powersof2(a) = 2 ^ a: NEXT

f = FREEFILE
OPEN file$ FOR BINARY AS #f
IF LOF(f) = 0 THEN CLOSE #f: KILL file$: ShowGIF = 1: EXIT FUNCTION

'Check to see if GIF file. Ignore GIF version number.
a$ = "      ": GET #f, , a$
IF LEFT$(a$, 3) <> "GIF" THEN CLOSE #f: ShowGIF = 1: EXIT FUNCTION

'Get logical screen's X and Y resolution.
GET #f, , TotalX: GET #f, , TotalY: GOSUB GetByte
'Calculate number of colors and find out if a global palette exists.
NumColors = 2 ^ ((a AND 7) + 1): NoPalette = (a AND 128) = 0
'Retrieve background color.
GOSUB GetByte: Background = a

'Get aspect ratio and ignore it.
GOSUB GetByte

'Retrieve global palette if it exists.
IF NoPalette = 0 THEN P$ = SPACE$(NumColors * 3): GET #f, , P$

DO 'Image decode loop

'Skip by any GIF extensions.
'(With a few modifications this code could also fetch comments.)
DO
    'Skip by any zeros at end of image (why must I do this? the
    'GIF spec never mentioned it)
    DO
	IF EOF(f) THEN GOTO AllDone 'if at end of file, exit
	GOSUB GetByte
    LOOP WHILE a = 0           'loop while byte fetched is zero

    SELECT CASE a
    CASE 44  'We've found an image descriptor!
	EXIT DO
    CASE 59  'GIF trailer, stop decoding.
	GOTO AllDone
    CASE IS <> 33
	CLOSE #f: ShowGIF = 1: EXIT FUNCTION
    END SELECT
    'Skip by blocked extension data.
    GOSUB GetByte
    DO: GOSUB GetByte: a$ = SPACE$(a): GET #f, , a$: LOOP UNTIL a = 0
LOOP
'Get image's start coordinates and size.
GET #f, , XStart: GET #f, , YStart: GET #f, , XLength: GET #f, , YLength
XEnd = XStart + XLength: YEnd = YStart + YLength

'Check for local colormap, and fetch it if it exists.
GOSUB GetByte
IF (a AND 128) THEN
    NoPalette = 0
    NumColors = 2 ^ ((a AND 7) + 1)
    P$ = SPACE$(NumColors * 3): GET #f, , P$
END IF

'Check for interlaced image.
Interlaced = (a AND 64) > 0: PassNumber = 0: PassStep = 8

'Get LZW starting code size.
GOSUB GetByte

'Calculate clear code, end of stream code, and first free LZW code.
ClearCode = 2 ^ a
EOSCode = ClearCode + 1
FirstCode = ClearCode + 2: NextCode = FirstCode
StartCodeSize = a + 1: CodeSize = StartCodeSize

'Find maximum code for the current code size.
StartMaxCode = 2 ^ (a + 1) - 1: MaxCode = StartMaxCode

BitsIn = 0: BlockSize = 0: BlockPointer = 1

X = XStart: y = YStart: YBase = y * 320&

DEF SEG = &HA000

'Set palette, if there was one.
IF NoPalette = 0 THEN
    'Use OUTs for speed.
    OUT &H3C8, 0
    FOR a = 1 TO NumColors * 3: OUT &H3C9, ASC(MID$(P$, a, 1)) \ 4: NEXT
END IF

'Decode LZW data stream to screen.
DO
    r$ = INKEY$
    IF r$ = CHR$(27) THEN ShowGIF = 0: EXIT FUNCTION
    'Retrieve one LZW code.
    GOSUB GetCode
    'Is it an end of stream code?
    IF Code <> EOSCode THEN
	'Is it a clear code? (The clear code resets the sliding
	'dictionary - it *should* be the first LZW code present in
	'the data stream.)
	IF Code = ClearCode THEN
	    NextCode = FirstCode
	    CodeSize = StartCodeSize
	    MaxCode = StartMaxCode
	    DO: GOSUB GetCode: LOOP WHILE Code = ClearCode
	    IF Code = EOSCode THEN GOTO ImageDone
	    LastCode = Code: LastPixel = Code
	    IF X < 320 AND y < 200 THEN POKE X + YBase, LastPixel
	    X = X + 1: IF X = XEnd THEN GOSUB NextScanLine
	ELSE
	    CurCode = Code: StackPointer = 0

	    'Have we entered this code into the dictionary yet?
	    IF Code >= NextCode THEN
		IF Code > NextCode THEN GOTO AllDone 'Bad GIF if this happens.
	       'mimick last code if we haven't entered the requested
	       'code into the dictionary yet
		CurCode = LastCode
		OutStack(StackPointer) = LastPixel
		StackPointer = StackPointer + 1
	    END IF

	    'Recursively get each character of the string.
	    'Since we get the characters in reverse, "push" them
	    'onto a stack so we can "pop" them off later.
	    'Hint: There is another, much faster way to accomplish
	    'this that doesn't involve a decoding stack at all...
	    DO WHILE CurCode >= FirstCode
		OutStack(StackPointer) = Suffix(CurCode)
		StackPointer = StackPointer + 1
		CurCode = Prefix(CurCode)
	    LOOP

	    LastPixel = CurCode
	    IF X < 320 AND y < 200 THEN POKE X + YBase, LastPixel
	    X = X + 1: IF X = XEnd THEN GOSUB NextScanLine

	    '"Pop" each character onto the display.
	    FOR a = StackPointer - 1 TO 0 STEP -1
		IF X < 320 AND y < 200 THEN POKE X + YBase, OutStack(a)
		X = X + 1: IF X = XEnd THEN GOSUB NextScanLine
	    NEXT

	    'Can we put this new string into our dictionary? (Some GIF
	    'encoders will wait a bit when the dictionary is full
	    'before sending a clear code- this increases compression
	    'because the dictionary's contents are thrown away less
	    'often.)
	    IF NextCode < 4096 THEN
		'Store new string in the dictionary for later use.
		Prefix(NextCode) = LastCode
		Suffix(NextCode) = LastPixel
		NextCode = NextCode + 1
		'Time to increase the LZW code size?
		IF (NextCode > MaxCode) AND (CodeSize < 12) THEN
		    CodeSize = CodeSize + 1
		    MaxCode = MaxCode * 2 + 1
		END IF
	    END IF
	    LastCode = Code
	END IF
    END IF
LOOP UNTIL Code = EOSCode
ImageDone:

LOOP

AllDone:
ShowGIF = 0: EXIT FUNCTION

'Slowly reads one byte from the GIF file...
GetByte: a$ = " ": GET #f, , a$: a = ASC(a$): RETURN

'Moves down one scanline. If the GIF is interlaced, then the number
'of scanlines skipped is based on the current pass.
NextScanLine:
    IF Interlaced THEN
	y = y + PassStep
	IF y >= YEnd THEN
	    PassNumber = PassNumber + 1
	    SELECT CASE PassNumber
	    CASE 1: y = 4: PassStep = 8
	    CASE 2: y = 2: PassStep = 4
	    CASE 3: y = 1: PassStep = 2
	    END SELECT
	END IF
    ELSE
	y = y + 1
    END IF
    X = XStart: YBase = y * 320&
RETURN

'Reads a multibit code from the data stream.
GetCode:
    WorkCode = LastChar \ ShiftOut(BitsIn)
  'Loop while more bits are needed.
    DO WHILE CodeSize > BitsIn
'Reads a byte from the LZW data stream. Since the data stream is
'blocked, a check is performed for the end of the current block
'before each byte is fetched.
	IF BlockPointer > BlockSize THEN
	  'Retrieve block's length
	    GOSUB GetByte: BlockSize = a
	    a$ = SPACE$(BlockSize): GET #f, , a$
	    BlockPointer = 1
	END IF
      'Yuck, ASC() and MID$() aren't that fast.
	LastChar = ASC(MID$(a$, BlockPointer, 1))
	BlockPointer = BlockPointer + 1
      'Append 8 more bits to the input buffer
	WorkCode = WorkCode OR LastChar * Powersof2(BitsIn)
	BitsIn = BitsIn + 8
    LOOP
  'Take away x number of bits.
    BitsIn = BitsIn - CodeSize
  'Return code to caller.
    Code = WorkCode AND MaxCode
RETURN

CLOSE #f
END FUNCTION

SUB ShutDownDs4QB
DS4QBbuffer = "DS4QBSHUTDOWN|"
CALL Clipboard.PutText(DS4QBbuffer, ErrCode%)
END SUB

SUB Speckle (colla)
FOR y = 0 TO 199 STEP 2
FOR X = 0 TO 319 STEP 2
PSET (X, y), colla
IF INKEY$ <> "" THEN EXIT SUB
NEXT
NEXT
FOR y = 199 TO 1 STEP -2
FOR X = 319 TO 1 STEP -2
PSET (X, y), colla
IF INKEY$ <> "" THEN EXIT SUB
NEXT
NEXT
FOR X = 319 TO 0 STEP -1
FOR y = 199 TO 0 STEP -1
PSET (X, y), colla
IF INKEY$ <> "" THEN EXIT SUB
NEXT
NEXT

END SUB

SUB splash
DIM partics(300) AS partic
FOR c% = 0 TO 300
partics(c%).X = player.X + INT(RND * 20)
partics(c%).y = player.y + 28
partics(c%).col = INT(RND * 4) + 66
partics(c%).spd = -8
NEXT c%
t# = TIMER
DO UNTIL k$ <> "" AND t# + 5 < TIMER
k$ = INKEY$
FOR dy% = 0 TO 12
FOR dx% = 0 TO 20
IF map(dx%, dy%) > 0 THEN
GsSolidPUT dx% * 16 - 16, dy% * 16 - 16, VARSEG(buffer(0)), VARPTR(buffer(0)), VARSEG(imgs(iindex(map(dx%, dy%)))), VARPTR(imgs(iindex(map(dx%, dy%))))
END IF
NEXT
NEXT
FOR d% = 0 TO 300
partics(d%).spd = partics(d%).spd + RND
partics(d%).X = partics(d%).X + INT(RND * 3)
partics(d%).y = partics(d%).y + partics(d%).spd
IF partics(d%).y < 190 AND partics(d%).X < 310 THEN GSPSET partics(d%).X, partics(d%).y, VARSEG(buffer(0)), VARPTR(buffer(0)), partics(d%).col
NEXT d%
GSpcopy VARSEG(buffer(0)), VARPTR(buffer(0)), &HA000, 0
IF progspeed > 0 THEN gswait progspeed
LOOP
player.X = 1
player.y = 1
player.speed = 0
player.movedo = 0
player.air = 0
player.lives = player.lives - 1
END SUB

SUB tremor (howlong%)
FOR i = 1 TO howlong%
  X = INT(RND * 271)
  y = INT(RND * 150)
  dir = INT(RND * 2)
  IF dir = 1 THEN dir = 1:  ELSE dir = -1
  GET (X, y)-(X + 48, y + 48), Melty
  GsSolidPUT X, y + dir, &HA000, 0, VARSEG(Melty(0)), VARPTR(Melty(0))
IF INKEY$ <> "" THEN EXIT SUB
NEXT i
END SUB

SUB writetext
END SUB

