Posts: 116
Threads: 5
Joined: Jul 2004
Quote:Oops, i forgot to GET that array last time when i posted it (It was originally
in a bigger code where i tested some other routines' speed. I cut that out
from there but did not tested it in that form. Possibly you had found that out
and corrected it already, if not, here is the answer. So a
'GET (0, 0) - (319, 199), scrArr%(-2)' is missing from after the SCREEN 13
statement)
Nemesis:
I now looked in your routines really, and at my previous post i showed one
what i wrote. If you wish, i would accept a challenge that "Who can write the
better code for SCREEN 13" here, but i have no time. If i start programming
that then i will have no time to finish our project ever (I mean "our" as i
am making it in the Society, but most of the work in it is mine. So if i stop,
the whole thing is dead).
As i looked around at first glance two bugs appeared to me. One is not really
serious: the PIT chip's correct frequency is 18.21Hz, not 18.6xxx. The other is
more serious: the keyboard handler absolutely not serves it's purpose on my
computer as the keys are stucking after pressing them, and they only release
very rare.
So this callenge between us would need to keep on our ways: i will make the
PUT buffer, you will do the BSAVE / BLOAD thing, or an another way based on
it. I promise i will not use any PEEK and POKE in my routines so i will not
reproduce your codes. The project is to make an useful SCREEN 13 library.
But as i wrote above i am not sure that i can accept it as i will not have
time to work on SCREEN 13 what i currenty not use in any of my programs (I
more like SCREEN 9 because of it's high resolution, 88Hz refresh rate - yes, i
achieved it with tweaking screen ports, and of it's two pages).
Yeah, whatever, we can have a little challenge, but since you're not sure if you have the time I'll leave it up to you to start the new challenge thread. You should maybe name the challenge something like "Fastest pure QB (screen 13) blitter" or something like that. Because that's where I'm claiming to have some of the fastest code, like my sprite routine :)
And to comment on the delay routine I knew the PIT timers frequency it was a typo, thanx for catching that.
Also I left out in that same subroutine the STATIC command, in case you didn't see that add that to the code...
SUB V13hDEL (seconds!)
like this...
SUB V13hDEL (seconds!) STATIC
So if you want start a new challenge thread, if you don't casue you don't have time, that's cool too.
(I might just start the challenge myself to see what the coders around here come up with, there seems to be some brilliant minds that frequent this board, and I'm always curious to see faster methods that can benefit my current methods.)
Cya.
Posts: 116
Threads: 5
Joined: Jul 2004
Well I've decided to go ahead and start a challege thread for the
best and fastest pure QBASIC (SCREEN 13) custom sprite PUT.
I've got to make one myself though first, (actually I have a few I've made already but I have to strip them out of libraries, and other utilities and then make modifications, tweaks and some optimations.) The rules will be pretty specific, so It might be a few weeks until you'll see the challenge thread. Even if I don't win, which I probablly won't, I think it should be lots of fun and we can all learn some new tricks that coders have developed over the years. To make it more intresting, I think I'll include prizes for the top routines, but it'll depend on how many coders participate.
Let me know if any of you would be intrested, the top prize or prizes will be worth atleast 10$-20$ !!!
Oh and by the way, here is an update on my SCREEN 13 Library,
(VIDEO13h), but I'm changing the name to QFX soon.
NOTE: This isn't a public release, so please don't distribute.
Code: '''
' VIDEO13h v1.2, QuicKBDASIC 4.5; SCREEN 13 manipulation routines.
'
' (C)opyright 2004, Pure QB Innovations
'
' Email any questions, comments, or suggestions to...
' CMLAROSA24@aol.com
'
' THIS PROGRAM MAY BE DISTRIBUTED FREELY AS PUBLIC DOMAIN SOFTWARE
' AS LONG AS ANY PART OF THIS FILE IS NOT ALTERED IN ANY WAY.
' IF YOU DO WISH TO USE THESE ROUTINES IN YOUR OWN PROGRAMS
' THEN PLEASE GIVE CREDIT TO THE AUTHOR... Mario LaRosa.
'
'
''
'
'$DYNAMIC
'
DEFINT A-Z
'
TYPE REGXdata
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FL AS INTEGER
DS AS INTEGER
ES AS INTEGER
END TYPE
'
TYPE PNTdata
switch AS INTEGER
frame AS INTEGER
lb AS INTEGER
rb AS INTEGER
xx AS INTEGER
yy AS INTEGER
minXX AS INTEGER
minYY AS INTEGER
maxXX AS INTEGER
maxYY AS INTEGER
END TYPE
'
TYPE PALdata
RED AS INTEGER
GRN AS INTEGER
BLU AS INTEGER
END TYPE
'
COMMON SHARED PAL() AS PALdata
'
COMMON SHARED REGX AS REGXdata
COMMON SHARED PNT AS PNTdata
COMMON SHARED SYS&, KBD
COMMON SHARED Vtarget, VGAlo, VGAhi, V13lo, V13hi
COMMON SHARED GET13$, PUT13$
COMMON SHARED FONTScolour
COMMON SHARED clipXXleft, clipYYtop, clipXXright, clipYYbottom
'
DECLARE FUNCTION V13hKEY ()
DECLARE FUNCTION V13hLOF& (file$)
'
DECLARE SUB V13hCLS (colour)
DECLARE SUB V13hCLP (XXleft, YYtop, XXright, YYbottom)
DECLARE SUB V13hPAL (file$)
DECLARE SUB V13hBLD (ARRAY(), file$)
DECLARE SUB V13hBND (ARRAY(), file$)
DECLARE SUB V13hBSV (ARRAY(), file$)
DECLARE SUB V13hDEL (seconds!)
DECLARE SUB V13hFDE (fadeOUT, fadeINN, fadeSEC!)
DECLARE SUB V13hREC (ARRAY())
DECLARE SUB V13hPNT (ARRAY(), frame)
DECLARE SUB V13hPUT (ARRAY(), XXleft, YYtop, frame, mode$)
DECLARE SUB V13hSEE (ARRAY())
DECLARE SUB V13hSET ()
DECLARE SUB V13hTXT (ARRAY(), XXcenter, XXleft, YYtop, colour, text$)
'
DECLARE SUB INTERRUPTX (INTNUM AS INTEGER, INREG AS REGXdata, OUTREG AS REGXdata)
'
DECLARE SUB DEMO ()
'
DIM SHARED PAL(0 TO 255) AS PALdata
'
DIM SHARED VIDEO(0 TO 31999)
DIM SHARED FONTS(0 TO 3263)
DIM SHARED MOUSE(0 TO 129)
DIM SHARED KBM(0 TO 128)
DIM SHARED KBD(0 TO 128)
'
V13hSET
'
DEMO
'
'Unhook Interruput
'
DEF SEG = VARSEG(KBM(0)): CALL ABSOLUTE(3)
'
SYSTEM
'
SUB DEMO
'
' DRAW AND GET, (-3- 20*20) TILES. (DEMO)...
'
DIM TILES(0 TO 606)
V13hCLS 0
FOR x = 0 TO 40 STEP 20
col = col + 1
LINE (x, 0)-(x + 19, 19), col, BF
LINE (x, 0)-(x + 19, 19), 15, B
LINE (x + 5, 5)-(x + 14, 14), 0, BF
GET (x, 0)-(x + 19, 19), TILES(stp)
stp = stp + 202
NEXT
'
'SCROLLING FONT DEMO...
'
FOR y = (clipYYbottom + 1) TO (clipYYtop - (32 * 8)) STEP -1
V13hCLS 0
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 0), 15, "-WELCOME-"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 2), 7, "VIDEO13h v1.2, QuickBASIC 4.5,"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 4), 7, "SCREEN 13 manipulation routines."
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 8), 15, "-FEATURES-"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 10), 7, "320X200X256 resolution (VGA),"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 12), 7, "page flipping, sprite animation,"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 14), 7, "sprite clipping, font routines,"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 16), 7, "mouse and keyboard handlers."
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 18), 7, "Also supports most of QB's,"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 20), 7, "original graphic commands too!"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 24), 15, "-REQUIREMENTS-"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 26), 7, "100+ Mhz PC processor, a VGA monitor,"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 28), 7, "keyboard, mouse, and QuickBASIC v4.5"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 32), 15, "-CREDITS-"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 34), 15, "...Programmer..."
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 36), 7, "Mario LaRosa, ESmemberNEMESIS@aol.com"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 40), 15, "...Special Thanks..."
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 42), 7, "Jonathan Dale Kirwan, JonKirwan@aol.com"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 44), 7, "Quinton Roberts, Eclipzer@aol.com"
V13hTXT FONTS(), FALSE, 0, (8 * 24), 15, "(C)opyright 2004,"
V13hTXT FONTS(), FALSE, (8 * 18), (8 * 24), 12, "Pure"
V13hTXT FONTS(), FALSE, (8 * 23), (8 * 24), 10, "QB"
V13hTXT FONTS(), FALSE, (8 * 26), (8 * 24), 9, "Innovations"
V13hSEE VIDEO()
'WAIT &H3DA, 8
IF KBD(1) THEN KBD(1) = FALSE: EXIT FOR
'
NEXT
'
'FADE OUT/IN DEMO...
'
V13hFDE NOT FALSE, NOT FALSE, 1 / 32
'
'DELAY DEMO...
'
CLS
LOCATE 1, 1: PRINT "Delay 1/8 seconds..."
PRINT
DO: LOOP UNTIL TIMER <> TIMER
DO
t! = TIMER
V13hDEL 1 / 8
PRINT TIMER - t!
LOOP UNTIL KBD(1): KBD(1) = FALSE
'
CLS
LOCATE 1, 1: PRINT "Delay 1/16 seconds..."
PRINT
DO: LOOP UNTIL TIMER <> TIMER
DO
t! = TIMER
V13hDEL 1 / 16
PRINT TIMER - t!
LOOP UNTIL KBD(1): KBD(1) = FALSE
'
CLS
LOCATE 1, 1: PRINT "Delay 1/32 seconds..."
PRINT
DO: LOOP UNTIL TIMER <> TIMER
DO
t! = TIMER
V13hDEL 1 / 32
PRINT TIMER - t!
LOOP UNTIL KBD(1): KBD(1) = FALSE
'
'''
''' CLEAR SCREEN (256X) DEMO...
'''
'
DO: LOOP UNTIL TIMER <> TIMER
t! = TIMER
FOR c = 0 TO 255
V13hCLS c
V13hSEE VIDEO()
NEXT
t! = TIMER - t!
LOCATE 1, 1: PRINT "V13hCLS (256X):"; t!
DO: LOOP UNTIL KBD(1): KBD(1) = FALSE
'
'''
''' (1O,OOO) RANDOM PIXELS DEMO...
'''
V13hCLS 0
DO: LOOP UNTIL TIMER <> TIMER
t! = TIMER
FOR x = 1 TO 10000
PSET (INT(RND(1) * 319 + 1), INT(RND(1) * 199 + 1)), INT(RND(1) * 255 + 1)
NEXT
t! = TIMER - t!
V13hSEE VIDEO()
LOCATE 1, 1: PRINT "PSET (1O,OOOX):"; t!
DO: LOOP UNTIL KBD(1): KBD(1) = FALSE
'
'''
''' (1O,OOO) RANDOM LINES DEMO...
'''
'
V13hCLS 0
DO: LOOP UNTIL TIMER <> TIMER
t! = TIMER
FOR x = 1 TO 10000
x1 = INT(RND * 340) - 10: x2 = INT(RND * 340) - 10
y1 = INT(RND * 220) - 10: y2 = INT(RND * 220) - 10
LINE (x1, y1)-(x2, y2), INT(RND * 15) + 1
NEXT
t! = TIMER - t!
V13hSEE VIDEO()
LOCATE 1, 1: PRINT "LINE (1O,OOOX):"; t!
DO: LOOP UNTIL V13hKEY: : REDIM KBD(0 TO 128)
'
'''
''' (1O,OOO) RANDOM TILES DEMO...
'''
'
kind$ = "SOLID"
DO
V13hCLS 0
DO: LOOP UNTIL TIMER <> TIMER
t! = TIMER
FOR x = 1 TO 10000
xx = INT(RND(1) * 341 + -20)
yy = INT(RND(1) * 221 + -20)
frame = INT(RND(1) * 3 + 1)
V13hPUT TILES(), xx, yy, frame, kind$
NEXT
t! = TIMER - t!
V13hSEE VIDEO()
K$ = "V13hPUT " + kind$ + " (1O,OOOX):"
LOCATE 1, 1: PRINT K$; t!
DO: LOOP UNTIL KBD(1): KBD(1) = FALSE
SELECT CASE kind$
CASE "SOLID"
kind$ = "TRANSPARENT"
CASE "TRANSPARENT"
kind$ = "BEHIND"
CASE "BEHIND"
kind$ = "PSET"
CASE "PSET"
kind$ = "PRESET"
CASE "PRESET"
kind$ = "AND"
CASE "AND"
kind$ = "OR"
CASE "OR"
kind$ = "XOR"
CASE "XOR"
EXIT DO
END SELECT
LOOP
'
'''
'''KEYBOARD & SCROLLING DEMO
'''
'
t& = TIMER
DO
s = s + 1
IF ABS(TIMER - t&) >= 1 THEN FPS = s: s = 0: t& = TIMER
FOR yy = -20 TO 200 STEP 20
FOR xx = -20 TO 320 STEP 20
V13hPUT TILES(), (xx + zx), (yy + zy), 1, "PSET"
NEXT
NEXT
IF KBD(80) THEN zy = zy - 1: AU = NOT FALSE ELSE AU = FALSE
IF KBD(75) THEN zx = zx + 1: AR = NOT FALSE ELSE AR = FALSE
IF KBD(77) THEN zx = zx - 1: AL = NOT FALSE ELSE AL = FALSE
IF KBD(72) THEN zy = zy + 1: AD = NOT FALSE ELSE AD = FALSE
IF zy > 19 OR zy < -19 THEN zy = 0
IF zx > 19 OR zx < -19 THEN zx = 0
V13hTXT FONTS(), FALSE, 0, 0, 10, "FPS:" + STR$(FPS)
V13hTXT FONTS(), FALSE, 0, 16, 11, "Arrow up: " + STR$(AU)
V13hTXT FONTS(), FALSE, 0, 24, 11, "Arrow down: " + STR$(AD)
V13hTXT FONTS(), FALSE, 0, 32, 11, "Arrow right:" + STR$(AR)
V13hTXT FONTS(), FALSE, 0, 40, 11, "Arrow left: " + STR$(AL)
V13hTXT FONTS(), FALSE, 0, 56, 12, "Esc to exit."
V13hSEE VIDEO()
LOOP UNTIL KBD(1): REDIM KBD(0 TO 128)
'
EXIT SUB
'
END SUB
REM $STATIC
SUB V13hBLD (ARRAY(), file$)
'
length& = V13hLOF&(file$)
IF length& THEN
Words = (length& \ 2) - 1
REDIM ARRAY(0 TO Words)
DEF SEG = VARSEG(ARRAY(0))
BLOAD file$, 0
END IF
'
END SUB
SUB V13hBND (ARRAY(), file$)
'
length& = V13hLOF&(file$)
IF length& THEN
Words = (length& \ 2)
U = UBOUND(ARRAY)
IF U THEN
V13hBSV ARRAY(), "buffer.tmp"
REDIM ARRAY(0 TO (U + Words))
DEF SEG = VARSEG(ARRAY(0)): BLOAD "buffer.tmp", 0
KILL "buffer.tmp"
BLOAD file$, (U + 1) * 2
ELSE
REDIM ARRAY(0 TO (Words - 1))
DEF SEG = VARSEG(ARRAY(0))
BLOAD file$, 0
END IF
END IF
'
END SUB
SUB V13hBSV (ARRAY(), file$)
'
DEF SEG = VARSEG(ARRAY(0)): BSAVE file$, 0, (UBOUND(ARRAY) + 1) * 2
'
END SUB
SUB V13hCLP (XXleft, YYtop, XXright, YYbottom)
'
clipXXleft = XXleft
clipYYtop = YYtop
clipXXright = XXright
clipYYbottom = YYbottom
'
IF clipXXleft < 0 THEN clipXXleft = 0
IF clipXXright > 319 THEN clipXXright = 319
IF clipYYtop < 0 THEN clipYYtop = 0
IF clipYYbottom > 199 THEN clipYYbottom = 199
'
END SUB
SUB V13hCLS (colour)
'
IF colour THEN
LINE (clipXXleft, clipYYtop)-(clipXXright, clipYYbottom), colour, BF
ELSE
REDIM VIDEO(0 TO 31999)
END IF
'
END SUB
SUB V13hDEL (seconds!) STATIC
'
IF seconds! THEN
'
FOR inc& = 1 TO (SYS& * (seconds! * 18.6245)): NEXT
'
ELSE
'
DEF SEG = &H40
'
DO: LOOP UNTIL PEEK(&H6C) <> PEEK(&H6C)
'
t = PEEK(&H6C)
'
DO
FOR clc& = clc& TO clc& * 2: NEXT
LOOP UNTIL t <> PEEK(&H6C)
'
SYS& = clc&
'
I& = 1
'
DO
'
I& = I& * 2
d& = clc& \ I&
'
DO: LOOP UNTIL PEEK(&H6C) <> PEEK(&H6C)
'
t = PEEK(&H6C)
'
FOR inc& = 1 TO SYS&: NEXT
'
IF t <> PEEK(&H6C) THEN
'
SYS& = SYS& - d&
'
ELSE
'
SYS& = SYS& + d&
'
END IF
'
LOOP UNTIL I& >= clc&
'
END IF
'
END SUB
SUB V13hFDE (fadeOUT, fadeINN, fadeSEC!)
'
OUT &H3C8, 0
'
IF fadeOUT THEN
FOR y = 0 TO 63
FOR x = 0 TO 255
r = PAL(x).RED - y
g = PAL(x).GRN - y
B = PAL(x).BLU - y
IF r < 0 THEN r = 0
IF g < 0 THEN g = 0
IF B < 0 THEN B = 0
OUT &H3C9, r
OUT &H3C9, g
OUT &H3C9, B
NEXT
V13hDEL fadeSEC!
NEXT
END IF
'
IF fadeINN THEN
FOR y = 0 TO 63
FOR x = 0 TO 255
r = PAL(x).RED
g = PAL(x).GRN
B = PAL(x).BLU
IF y < r THEN r = y
IF y < g THEN g = y
IF y < B THEN B = y
OUT &H3C9, r
OUT &H3C9, g
OUT &H3C9, B
NEXT
V13hDEL fadeSEC!
NEXT
END IF
'
END SUB
FUNCTION V13hKEY
FOR x = 0 TO 128
IF KBD(x) THEN
V13hKEY = NOT FALSE
KBD = x
EXIT FUNCTION
END IF
NEXT
END FUNCTION
REM $DYNAMIC
FUNCTION V13hLOF& (file$)
'
FileNum = FREEFILE
OPEN file$ FOR BINARY ACCESS READ AS FileNum
V13hLOF& = LOF(FileNum) - 7
CLOSE FileNum
'
END FUNCTION
REM $STATIC
SUB V13hPAL (file$)
'
DEF SEG = VARSEG(PAL(0))
BLOAD file$, 0
OUT &H3C8, 0
FOR x = 0 TO 255
OUT &H3C9, PAL(x).RED
OUT &H3C9, PAL(x).GRN
OUT &H3C9, PAL(x).BLU
NEXT
'
END SUB
SUB V13hPNT (ARRAY(), frame)
'
IF PNT.switch THEN
REGX.AX = 3
INTERRUPTX &H33, REGX, REGX
PNT.lb = ((REGX.BX AND 1) <> 0)
PNT.rb = ((REGX.BX AND 2) <> 0)
PNT.xx = REGX.CX \ 2
PNT.yy = REGX.DX
PNT.frame = frame
IF PNT.xx < PNT.minXX THEN PNT.xx = PNT.minXX
IF PNT.xx > PNT.maxXX THEN PNT.xx = PNT.maxXX
IF PNT.yy < PNT.minYY THEN PNT.yy = PNT.minYY
IF PNT.yy > PNT.maxYY THEN PNT.yy = PNT.maxYY
'
V13hPUT ARRAY(), PNT.xx, PNT.yy, PNT.frame, "TRANSPARENT"
'
END IF
'
END SUB
SUB V13hPUT (ARRAY(), XXleft, YYtop, frame, mode$)
'
IF frame THEN
'
VIDEOseg = VARSEG(VIDEO(0))
TILESseg = VARSEG(ARRAY(0))
'
TILESwidth = ARRAY(0) \ 8
'
TH = ARRAY(1) - 1
TW = TILESwidth - 1
TP = (TILESwidth * ARRAY(1)) + 4
TF = frame - 1
TL = XXleft + TW
tt = YYtop + TH
'
'TI = (TP \ 2) * TF: IF TI > UBOUND(ARRAY) THEN EXIT SUB
'
IF XXleft < clipXXleft THEN
CLIP = NOT FALSE
XL = clipXXleft
CLIPadd = clipXXleft - XXleft
IF CLIPadd > TW THEN EXIT SUB
IF CLIPadd < 0 THEN CLIPadd = -CLIPadd
CL = CLIPadd
ELSE
XL = XXleft
END IF
'
IF TL > clipXXright THEN
CLIP = NOT FALSE
XR = clipXXright
CLIPadd = TL - clipXXright
IF CLIPadd > TW THEN EXIT SUB
ELSE
XR = TL
END IF
'
IF YYtop < clipYYtop THEN
CLIP = NOT FALSE
YT = VIDEOseg + (clipYYtop * 20)
CT = clipYYtop - YYtop
IF CT > TH THEN EXIT SUB
IF CT < 0 THEN CT = -CT
CT = CT * TILESwidth
ELSE
YT = VIDEOseg + (YYtop * 20)
END IF
'
IF tt > clipYYbottom THEN
CLIP = NOT FALSE
YB = VIDEOseg + (clipYYbottom * 20)
IF (tt - clipYYbottom) > TH THEN EXIT SUB
ELSE
YB = VIDEOseg + (tt * 20)
END IF
'
t = ((TP * TF) + (CL + CT)) + 4
'
DIM c(XL TO XR)
'
SELECT CASE mode$
'
CASE "SOLID"
'
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
POKE x, c(x)
NEXT
NEXT
'
CASE "TRANSPARENT"
'
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
IF c(x) THEN POKE x, c(x)
NEXT
NEXT
'
CASE "BEHIND"
'
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
IF PEEK(x) THEN ELSE POKE x, c(x)
NEXT
NEXT
'
CASE "PSET"
'
IF CLIP THEN
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
POKE x, c(x)
NEXT
NEXT
ELSE
PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), PSET
END IF
'
CASE "PRESET"
'
IF CLIP THEN
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
POKE x, NOT c(x)
NEXT
NEXT
ELSE
PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), PRESET
END IF
'
CASE "AND"
'
IF CLIP THEN
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
POKE x, c(x) AND PEEK(x)
NEXT
NEXT
ELSE
PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), AND
END IF
'
CASE "OR"
'
IF CLIP THEN
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
POKE x, c(x) OR PEEK(x)
NEXT
NEXT
ELSE
PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), OR
END IF
'
CASE "XOR"
'
IF CLIP THEN
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
POKE x, c(x) XOR PEEK(x)
NEXT
NEXT
ELSE
PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), XOR
END IF
'
CASE "FONT"
'
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
IF c(x) THEN POKE x, c(x) + FONTScolour
NEXT
NEXT
'
END SELECT
'
END IF
'
END SUB
SUB V13hREC (ARRAY())
'
DEF SEG = VARSEG(GET13$): CALL ABSOLUTE(ARRAY(), SADD(GET13$))
'
END SUB
SUB V13hSEE (ARRAY())
'
DEF SEG = VARSEG(GET13$): CALL ABSOLUTE(ARRAY(), SADD(PUT13$))
'
END SUB
SUB V13hSET
'
V13hDEL calibrate!
'
'386+ FAST MEMCOPY (by rick elbers)
'
GET13$ = CHR$(&H55) + CHR$(&H89) + CHR$(&HE5) + CHR$(&H1E) + CHR$(&H6)
GET13$ = GET13$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) + CHR$(&HB9) + CHR$(&H80)
GET13$ = GET13$ + CHR$(&H3E) + CHR$(&HC4) + CHR$(&H3F) + CHR$(&H31)
GET13$ = GET13$ + CHR$(&HF6) + CHR$(&HB8) + MKI$(&HA000) + CHR$(&H8E)
GET13$ = GET13$ + CHR$(&HD8) + CHR$(&HF3) + CHR$(&H66) + CHR$(&HA5)
GET13$ = GET13$ + CHR$(&H7) + CHR$(&H1F) + CHR$(&H5D) + CHR$(&HCA) + MKI$(2) 'RETF 2
V13hREC VIDEO()
PUT13$ = CHR$(&H55) + CHR$(&H89) + CHR$(&HE5) + CHR$(&H1E) + CHR$(&H6)
PUT13$ = PUT13$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) + CHR$(&HB9) + CHR$(&H80)
PUT13$ = PUT13$ + CHR$(&H3E) + CHR$(&H31) + CHR$(&HFF) + CHR$(&HB8) + MKI$(&HA000)
PUT13$ = PUT13$ + CHR$(&H8E) + CHR$(&HC0) + CHR$(&HC5) + CHR$(&H37) + CHR$(&HF3)
PUT13$ = PUT13$ + CHR$(&H66) + CHR$(&HA5) + CHR$(&H7) + CHR$(&H1F) + CHR$(&H5D)
PUT13$ = PUT13$ + CHR$(&HCA) + MKI$(2)
'
code$ = code$ + "E91D00E93C00000000000000000000000000000000000000000000000000"
code$ = code$ + "00001E31C08ED8BE24000E07BF1400FCA5A58CC38EC0BF2400B85600FAAB"
code$ = code$ + "89D8ABFB1FCB1E31C08EC0BF2400BE14000E1FFCFAA5A5FB1FCBFB9C5053"
code$ = code$ + "51521E560657E460B401A8807404B400247FD0E088C3B700B0002E031E12"
code$ = code$ + "002E8E1E100086E08907E4610C82E661247FE661B020E6205F075E1F5A59"
code$ = code$ + "5B589DCF"
DEF SEG = VARSEG(KBM(0))
FOR I = 0 TO 155
d = VAL("&h" + MID$(code$, I * 2 + 1, 2))
POKE VARPTR(KBM(0)) + I, d
NEXT I
I& = 16
N& = VARSEG(KBD(0)): l& = N& AND 255: h& = ((N& AND &HFF00) \ 256)
POKE I&, l&: POKE I& + 1, h&: I& = I& + 2
N& = VARPTR(KBD(0)): l& = N& AND 255: h& = ((N& AND &HFF00) \ 256)
POKE I&, l&: POKE I& + 1, h&: I& = I& + 2
DEF SEG = VARSEG(KBM(0)): CALL ABSOLUTE(0)
'
SCREEN 13: CLS : COLOR 255
'
'Capture current palette
'
OUT &H3C7, 0
'
FOR x = 0 TO 255
PAL(x).RED = INP(&H3C9)
PAL(x).GRN = INP(&H3C9)
PAL(x).BLU = INP(&H3C9)
NEXT
'
REG.AX = 0
INTERRUPTX &H33, REGX, REGX
IF REGX.AX THEN PNT.switch = NOT FALSE
'
'put MOUSE
'
REGX.AX = 4
REGX.CX = 0
REGX.DX = 0
INTERRUPTX &H33, REGX, REGX
'
'show MOUSE
'
REGX.AX = 1
INTERRUPTX &H33, REGX, REGX
'
'capture MOUSE
'
GET (0, 0)-(15, 15), MOUSE
'
'hide MOUSE
'
REGX.AX = 2
INTERRUPTX &H33, REGX, REGX
'
PNT.minXX = 0
PNT.minYY = 0
PNT.maxXX = 319
PNT.maxYY = 199
'
FOR x = 1 TO 32
LOCATE 1, x: PRINT CHR$(x + 31)
LOCATE 2, x: PRINT CHR$(x + 63)
LOCATE 3, x: PRINT CHR$(x + 95)
NEXT
'
FOR y = 0 TO 23 STEP 8
FOR x = 0 TO 255 STEP 8
GET (x, y)-(x + 7, y + 7), FONTS(E)
E = E + 34
NEXT
NEXT
'
CLS : PRESET (160, 100), 0
'
VIDEOseg = VARSEG(VIDEO(0))
DEF SEG : BSAVE "buffer.tmp", &H0, &HFA00
DEF SEG = VIDEOseg: BLOAD "buffer.tmp", 0
KILL "buffer.tmp"
FOR I = LBOUND(VIDEO) TO (UBOUND(VIDEO) - 1)
IF VIDEO(I) = &H7DA0 AND VIDEO(I + 1) = &HA000 THEN
Vtarget = ((I + 1) * 2)
V13lo = VIDEOseg AND &HFF
IF (VIDEOseg AND &H8000) THEN
V13hi = ((VIDEOseg AND &HFF00) \ &HFF) + &H100
ELSE
V13hi = (VIDEOseg AND &HFF00) \ &HFF
END IF
DEF SEG
VGAlo = PEEK(Vtarget): VGAhi = PEEK(Vtarget + 1)
POKE Vtarget, V13lo: POKE (Vtarget + 1), V13hi
END IF
NEXT
'
V13hCLP 0, 0, 319, 199
'
COLOR 15
'
END SUB
SUB V13hTXT (ARRAY(), XXcenter, XXleft, YYtop, colour, text$)
'
FONTwidth = ARRAY(0) \ 8
FONTScolour = -255 + colour
FONTyy = YYtop
'
TL = LEN(text$)
'
IF XXcenter THEN
CX = (clipXXleft + ((clipXXright - clipXXleft) + 1) \ 2)
xx = CX - ((TL * FONTwidth) \ 2)
ELSE
xx = XXleft
END IF
'
FOR x = 1 TO TL
frame = (ASC(MID$(text$, x, 1)) - 31)
FONTxx = xx + ((x - 1) * FONTwidth)
V13hPUT ARRAY(), FONTxx, FONTyy, frame, "FONT"
NEXT
'
END SUB
You'll notice my lib contains two ASM routines, one for GET/PUTing
the page buffer, and the other one is a multi-key routine.
I'm not the author of these routines. Credit will be given to the authors when the full (public) release is done. But it's not too hard to figure out who they are by looking through the source.
All other routines are pure QB, although I'm not too concerened about the lib being all "PURE QB" since I'll be possiblly porting it all
to ASM in the future. (Right now I just want to finish it so I can concentrate on making some games with it!)
Cya!
P.s...
Post a reply if you're intrested in the PURE QBASIC SCREEN 13 PUT CHALLENGE, I need to get a rough figure on how many coders will enter so I'll know how BIG of a prize(s) to award!
THANX
Posts: 393
Threads: 44
Joined: Mar 2004
I REALLY forgot about this... To tell the truth i had no time, and i did not look in this section since months...
I think i can not go on with this challenge as many other things came, not only QB programming. About this last if you visit our page, you may see that we are in a big work on our pure QB game, but as i said we have got many other things what we have to do.
As i can remember i developed some other things for my screen 13 routines, but i think i already lost the code. And now we have nothing to do with screen 13 (i more like 640 * 350 with 16 colors & 88Hz refresh rate  ), so this challenge seems to be over for now with you as winner.
fter 60 million years a civilization will search for a meteorite destroying most of the living creatures around this age...
There must be a better future for the Cheetahs!
http://rcs.fateback.com/
Posts: 7
Threads: 4
Joined: Dec 2004
Posts: 393
Threads: 44
Joined: Mar 2004
Wait a little, you did not win!
I found my screen 13 library and got amazed of it's speed on my P233
It is far not as complete as yours, but i think it is faster, give a try, here is the source:
Code: 'Spotted Cheetah - Hungarian Big Cat Society
'
'Pure QBasic SCREEN 13 "library"
'
'
DEFINT A-Z
DECLARE SUB S13PlotPx (X%, Y%, cl%)
DECLARE SUB S13Cls ()
DECLARE SUB S13InitBuf (XSiz%, YSiz%)
DECLARE SUB S13PutBuf (X%, Y%)
DECLARE SUB S13Rect (X1%, Y1%, WX%, WY%, cl%)
'$DYNAMIC
DIM SHARED scrArr%(-2 TO -1) '-2 and -1 for sizes
DIM SHARED xArr%(319)
DIM SHARED yArr%(199)
DIM SHARED m256arr%(255)
'$STATIC
FOR i% = 0 TO 127
m256arr%(i%) = i% * 256
m256arr%(i% + 128) = (i% - 128) * 256
NEXT i%
SCREEN 13
LOCATE 1, 1
PRINT "Speed test:"
PRINT " plotting 64000 pixels 32 times"
PRINT " with the S13PlotPx function"
PRINT
PRINT "Press any key..."
a$ = INPUT$(1)
DEF SEG = &H40
tim& = PEEK(&H6D)
tim& = tim& * 256 + PEEK(&H6C)
DEF SEG
S13InitBuf 320, 200
FOR c% = 0 TO 31
FOR i% = 0 TO 319
FOR j% = 0 TO 199
S13PlotPx i%, j%, (c% + i%) AND &HFF
NEXT j%
NEXT i%
S13PutBuf 0, 0
NEXT c%
DEF SEG = &H40
tim2& = PEEK(&H6D)
tim2& = tim2& * 256 + PEEK(&H6C)
DEF SEG
tim& = tim2& - tim&
IF tim& < 0 THEN tim& = tim& + 65536
LOCATE 1, 1
PRINT "Took"; tim&; "ticks"
PRINT "FPS:"; 1 / (tim& / 32 / 18.2)
PRINT
PRINT "Test2:"
PRINT " the same but now without S13PlotPx"
PRINT
PRINT "Press any key..."
a$ = INPUT$(1)
DEF SEG = &H40
tim& = PEEK(&H6D)
tim& = tim& * 256 + PEEK(&H6C)
DEF SEG
S13InitBuf 320, 200
FOR c% = 32 TO 63
FOR i% = 0 TO 319
FOR j% = 0 TO 199
cl% = (c% + i%) AND &HFF
arr% = xArr%(i%) + yArr%(j%)
IF 1 AND i% THEN
scrArr%(arr%) = &HFF AND scrArr%(arr%) OR m256arr%(cl%)
ELSE
scrArr%(arr%) = &HFF00 AND scrArr%(arr%) OR cl%
END IF
NEXT j%
NEXT i%
S13PutBuf 0, 0
NEXT c%
DEF SEG = &H40
tim2& = PEEK(&H6D)
tim2& = tim2& * 256 + PEEK(&H6C)
DEF SEG
tim& = tim2& - tim&
IF tim& < 0 THEN tim& = tim& + 65536
LOCATE 1, 1
PRINT "Took"; tim&; "ticks"
PRINT "FPS:"; 1 / (tim& / 32 / 18.2)
PRINT
PRINT "End of tests"
PRINT
PRINT "Press any key..."
a$ = INPUT$(1)
SUB S13Cls
tx% = scrArr%(-2)
ty% = scrArr%(-1)
ERASE scrArr%
REDIM scrArr%(-2 TO (tx% \ 16) * ty% - 1)
scrArr%(-2) = tx%
scrArr%(-1) = ty%
END SUB
SUB S13InitBuf (XSiz%, YSiz%)
FOR i% = 0 TO XSiz% - 1: xArr%(i%) = i% \ 2: NEXT i%
FOR i% = 0 TO YSiz% - 1: yArr%(i%) = i% * ((XSiz% + 1) \ 2): NEXT i%
ERASE scrArr%
REDIM scrArr%(-2 TO ((XSiz% + 1) \ 2) * YSiz% - 1)
scrArr%(-2) = ((XSiz% + 1) \ 2) * 16
scrArr%(-1) = YSiz%
END SUB
SUB S13PlotPx (X%, Y%, cl%) STATIC
arr% = xArr%(X%) + yArr%(Y%)
IF 1 AND X% THEN
scrArr%(arr%) = &HFF AND scrArr%(arr%) OR m256arr%(cl%)
ELSE
scrArr%(arr%) = &HFF00 AND scrArr%(arr%) OR cl%
END IF
END SUB
SUB S13PutBuf (X%, Y%)
PUT (X%, Y%), scrArr%(-2), PSET
END SUB
SUB S13Rect (X1%, Y1%, WX%, WY%, cl%) STATIC
IF WY% <> 0 AND WX% <> 0 THEN
IF WY% > 0 THEN yy1% = Y1%: wyy% = WY% ELSE yy1% = Y1% + WY% + 1: wyy% = -WY%
IF WX% > 0 THEN xx1% = X1%: wxx% = WX% ELSE xx1% = X1% + WX% + 1: wxx% = -WX%
eY% = yy1% + wyy% - 1
eX% = xx1% + wxx% - 1
arrInc% = scrArr%(-2) \ 16
IF (X1% AND 1) = 1 THEN
arr% = xArr%(xx1%) + yArr%(yy1%)
xx1% = xx1% + 1
FOR i% = yy1% TO eY%
scrArr%(arr%) = &HFF AND scrArr%(arr%) OR m256arr%(cl%)
arr% = arr% + arrInc%
NEXT i%
END IF
IF (eX% AND 1) = 0 THEN
arr% = xArr%(eX%) + yArr%(yy1%)
eX% = eX% - 1
FOR i% = yy1% TO eY%
scrArr%(arr%) = &HFF00 AND scrArr%(arr%) OR cl%
arr% = arr% + arrInc%
NEXT i%
END IF
arr% = xArr%(xx1%) + yArr%(yy1%)
earr% = xArr%(eX%) + yArr%(yy1%)
clt% = cl% OR m256arr%(cl%)
FOR j% = yy1% TO eY%
FOR i% = arr% TO earr%
scrArr%(i%) = clt%
NEXT i%
arr% = arr% + arrInc%
earr% = earr% + arrInc%
NEXT j%
END IF
END SUB
I do not know if that huge rectangle drawing algorithm works, as i said i had just found it before i had to leave, so i had only a little time to test it's speed.
The compiled form worked at 23FPS for me using the S13PlotPx function, and at 42FPS by building the psetting routine in the code.
Of course because of it's build it can be easily accelerated by only using a part of the screen. For example if the status bars and menus use up the half of the screen then the redrawing part will run on 84FPS.
As i can remember it ran at an acceptable speed on my 4.86 too, but i can not remember how fast was that. Possibly i will try to make it better when i get tired of coding other things. As i looked throug the code it just got in my mind that those SHARED arrays, and everything can be united in just one what may be passed as parameter to the functions so it will be possible to work with more screen pages simultaneously.
I still had a little time then so i rewritten the library's most important functions in 10 minutes:
Code: 'Spotted Cheetah - Hungarian Big Cat Society
'
'Pure QBasic SCREEN 13 "library"
'
'
DEFINT A-Z
DECLARE SUB S13PlotPx (X%, Y%, cl%, scr%(), m256%())
DECLARE SUB S13InitBuf (XSiz%, YSiz%, scr%(), m256%())
DECLARE SUB S13PutBuf (X%, Y%, scr%())
'$DYNAMIC
DIM m256arr%(255)
DIM scrarr%(0)
'$STATIC
SCREEN 13
LOCATE 1, 1
PRINT "Speed test:"
PRINT " plotting 64000 pixels 32 times"
PRINT " with the S13PlotPx function"
PRINT
PRINT "Press any key..."
a$ = INPUT$(1)
DEF SEG = &H40
tim& = PEEK(&H6D)
tim& = tim& * 256 + PEEK(&H6C)
DEF SEG
S13InitBuf 320, 200, scrarr%(), m256arr%()
FOR c% = 0 TO 31
FOR i% = 0 TO 319
FOR j% = 0 TO 199
S13PlotPx i%, j%, (c% + i%) AND &HFF, scrarr%(), m256arr%()
NEXT j%
NEXT i%
S13PutBuf 0, 0, scrarr%()
NEXT c%
DEF SEG = &H40
tim2& = PEEK(&H6D)
tim2& = tim2& * 256 + PEEK(&H6C)
DEF SEG
tim& = tim2& - tim&
IF tim& < 0 THEN tim& = tim& + 65536
LOCATE 1, 1
PRINT "Took"; tim&; "ticks"
PRINT "FPS:"; 1 / (tim& / 32 / 18.2)
PRINT
PRINT "Test2:"
PRINT " the same but now without S13PlotPx"
PRINT
PRINT "Press any key..."
a$ = INPUT$(1)
DEF SEG = &H40
tim& = PEEK(&H6D)
tim& = tim& * 256 + PEEK(&H6C)
DEF SEG
S13InitBuf 320, 200, scrarr%(), m256arr%()
FOR c% = 32 TO 63
FOR i% = 0 TO 319
FOR j% = 0 TO 199
cl% = (c% + i%) AND &HFF
arr% = scrarr%(i%) + scrarr%(j% + 320)
IF 1 AND i% THEN
scrarr%(arr%) = &HFF AND scrarr%(arr%) OR m256arr%(cl%)
ELSE
scrarr%(arr%) = &HFF00 AND scrarr%(arr%) OR cl%
END IF
NEXT j%
NEXT i%
S13PutBuf 0, 0, scrarr%()
NEXT c%
DEF SEG = &H40
tim2& = PEEK(&H6D)
tim2& = tim2& * 256 + PEEK(&H6C)
DEF SEG
tim& = tim2& - tim&
IF tim& < 0 THEN tim& = tim& + 65536
LOCATE 1, 1
PRINT "Took"; tim&; "ticks"
PRINT "FPS:"; 1 / (tim& / 32 / 18.2)
PRINT
PRINT "End of tests"
PRINT
PRINT "Press any key..."
a$ = INPUT$(1)
SUB S13InitBuf (XSiz%, YSiz%, scr%(), m256%())
ERASE scr%
REDIM scr%(((XSiz% + 1) \ 2) * YSiz% - 1 + 2 + 320 + 200)
FOR i% = 0 TO XSiz% - 1: scr%(i%) = (i% \ 2) + 522: NEXT i%
FOR i% = 0 TO YSiz% - 1: scr%(i% + 320) = i% * ((XSiz% + 1) \ 2): NEXT i%
scr%(520) = ((XSiz% + 1) \ 2) * 16
scr%(521) = YSiz%
FOR i% = 0 TO 127
m256%(i%) = i% * 256
m256%(i% + 128) = (i% - 128) * 256
NEXT i%
END SUB
SUB S13PlotPx (X%, Y%, cl%, scr%(), m256%()) STATIC
arr% = scr%(X%) + scr%(Y% + 320)
IF 1 AND X% THEN
scr%(arr%) = &HFF AND scr%(arr%) OR m256%(cl%)
ELSE
scr%(arr%) = &HFF00 AND scr%(arr%) OR cl%
END IF
END SUB
SUB S13PutBuf (X%, Y%, scr%())
PUT (X%, Y%), scr%(520), PSET
END SUB
I experienced the same speeds with it, the function form was slower with 1 FPS, but the second form was faster with 2.
It might be fast if programmed to draw H/V lines or sprites where conditional statements can be removed, so i think the pure library would produce at around 100FPS for an usual game on my computer. I think i will do it for the next time when i can visit QBN.
(Note: compile it! In the IDE it is 10 times slower as it sets up the pixels "by hand" with many QB calculations)
(BiLLaMoNsTeR: sorry, but i can not try out anything here, but i downloaded your prog. so next time)
Happy new year & challenge 
fter 60 million years a civilization will search for a meteorite destroying most of the living creatures around this age...
There must be a better future for the Cheetahs!
http://rcs.fateback.com/
Posts: 48
Threads: 2
Joined: Jan 2005
I made a game in pure QB called Spinball, ~eight years ago on a 486sx 25mhz. Can I submit that? It's like sonic...
Hey, I found an old review on the old, old (new) Enhanced Creations site! Yikes, that page is old.
http://www.geocities.com/SiliconValley/L.../games.htm
Ah, memories..
ric Carr
Posts: 393
Threads: 44
Joined: Mar 2004
First of all: the review of Barrack
(Sorry for my poor English and this strange comment: i had two weeks to write it )
In a few words:
Well done, awesome idea!
So going on with some regular review:
You will immediately notice after starting that this is not just "the same as xy". The
game what might be the closest to this is a very rare text screen old game called
xonix (NOT the hedgehog!), or Volfied. Both of them are rare, and the similarity is just
like comparing Heroes to Age of Empires. Something what was never been before!
Like in those old games you have to conquer the playfield, but now not by moving and
laying a line after you: you have to use a laser gun. This makes the whole thing
completely different as that you can not turn you have to use different strategy to get
rid of those balls. Here comes an another difference: most of them are not just bouncing
around the remaining open area. It is important to catch on with (and catch) them since
your score mostly accumulates based on how you could deal with the balls. This gameplay
makes the game completely unique: you may find old games which remind to this, but none
what is similar!
Graphic
The game not offers too much at this side. It just draws a few circles and boxes with
the standard palette on Screen 9 (This makes the circles a little strange, but they are
circles, and makes the graphic flick - free). On the other hand this is enough for the
game, and it not looks so bad as excepted as many things are well detailed and some are
animated, and due to this it not needs any external file.
Score: 5/10
Sound
As the game is just one executable, there is no music for it. On the other hand it has
many effects, but they come out from the PC speaker what can be a little annoying.
Hopefully it can be turned off, and the game remembers this. But if you connect the
speaker to your sound card somehow the effects can rise the game's value.
Score: 4/10
Handling
At unique games usually it is a big problem that the programmer do not really know how
to make it's handling. This one is the opposite of it: everything is perfectly done, it
seems to be well - tested. You control your "paddle" with the mouse what makes you able
to do everything what is needed. You will never lose just because you could not press
or move something in time! Excellent! I could not find anything negative!
Score: 10/10
Game idea
This is absolutely the highest point of the game. Of course it reminds to some games,
but they all are so rare that makes this game extremely unique. And not to mention that
the idea is not bad: The entire game speaks for itself: it can be well done!
Score: 5/5
Gameplay
Althoug you might have never seen such a game before, you can learn it in just five
minutes. You will have to walk trough the help pages which are short, and explain the
thing well (I especially liked that the ball types were shown in action). The only
problem was after i red them i assumed i know everything, but two important keys were
only in the control setup. The help said about them, but i thought that they are just
to configure on fly. The first few levels are not hard, they are just showing the
balls, each one in each level, then it becomes harder and harder, finally it will seem
to be impossible. The first move is the most difficult, without power ups on the later
levels you are dead. So this is an another challenge: using up the resources wisely.
There is another small problem around here: there are a few ball which not play their
role well (I think it is impossible to seperate the queen from so much swarm balls,
maybe only with using up all the magnets & time) , but this is a "must have" for a new
idea. They are just a little annoying, these bugs not really harm the gameplay.
Score: 8/10
Replay
At this side the game is in the group of "short, just play". No story, no characters,
just a little game with which you can spend your time. To this it is very good, on the
other hand the lack of Save makes it annoying if you get used to the game and can beat
the first levels by routine, but this will not take too much time. The better players
can get through easy levels in much shorter time, so this is not so horrible.
Score: 4/5
Pure QBasic
First of all hadn't i said that NO ASSEMBLY???!!! On the other hand the game uses ASM
for only the mouse what may be eliminated for example with my mouse routines.
Everything else is just QBasic, there is nothing in this code what may be "smelly"
except that mouse routine.
Score: 14/25
(I think i said that -10 points for loading the base library, and -1 for each
interrupt or port group used)
Speed
When there were many balls on the screen the game started to slow down on my P233. I
think the lowest configuration on which it runs acceptably is at about 150Mhz.
Score: 10/25
(As i can remember i said that if the game seems to have problems on a 300Mhz CPU then
0 points. But i forgot how the scoring was)
So finally:
Game/QB
36/50 (72%) - 24/50 (48%)
All: 60%
(Remember: this is a hard competition! This 60% means a good game! If the speed could
be increased somehow then it would get many valuable points. I think GETting & PUTting
the balls too would help a little: that many CIRCLEs are a little slow.)
(I will rewrite the scores if i find that the other games here were reviewed with
different scoring system. If you think something should not be what i gave, tell it,
and i may correct them. Of course it is not only me who can make the score here,
feel free to tell what you think. This is not just an usual competition )
(My highest score was 249290 points. It can be very hard )
What means what for me:
Graphic: The game's look. What will be somebody's opinion if she / he only see the
screenshots of the game.
Sound: The same but if the sounds were shown alone (the effect - imagine them in
anything else in their suitable place).
Handling: How easy (or hard) is to use the menu systems, but primarily how the
controlling fits (or not) to the game itself.
Game idea: If somebody just says that "i want you to program this" how you will feel
(assuming that you would like to program a similar thing).
Gameplay: How all the things above get together in the game (not scoring them again,
just what they make as feeling), and how good is the game itself.
Replay: Primarily what "replay" says: will you play it again after you played, but a
little for how many people may like the idea (who like it will play more than who not)
End of the review. If that could be scored i would give a little bonus for doing this
all in just one BAS file. On the other hand i had a little problem when i tried to
compile it with my QB4.5: id did not work. I had to dust off that thing called
"Professional Development System" (- Micro$oft) what i so hate to do it.
I still could not finish the graphic library as i much more like 16 colors in QB (I
started again a project for it: i want to write a simple big cat life simulator in
just one file in pure QBasic. I not really like messing up with those ultra complex
file formats needed by our games can be seen on our page). I finished creating a HLine
and a VLine routine for it and that first appeared to be very very fast. On my computer
it produced 180FPS while QB lines were at 101FPS when i drew 64000 pixels of 320
pixels wide lines. When i tried to fill the screen with 5 pixels wide lines i got
48FPS for my routine while QB did it at 20FPS. This may be important for a 3D engine
what needs horizontal lines to produce triangles (To produce something like what can
be seen in 16 colors at our "Future projects" page).
Here is the source without any speed testing to not fill the whole page:
(If you plan to write 100% QB 3D then you may find this valuable, but not for anything
else yet)
Code: 'Spotted Cheetah - Hungarian Big Cat Society
'
'Pure QBasic SCREEN 13 "library"
'
'
DEFINT A-Z 'Not recommended by the library
'$STATIC
DECLARE SUB S13PlotPx (x%, y%, cl%, scr%())
'Note: You should build the code directly into the program to be fast
DECLARE FUNCTION S13GetPx% (x%, y%, scr%())
'The same as above if you need many pixels
DECLARE SUB S13InitBuf (xSiz%, ySiz%, scr%())
'Initializes a scr%() screen buffer. xSiz% will be increased to a multiple
'of 2: the width of the buffer will always be even
DECLARE SUB S13PutBuf (x%, y%, scr%())
'Sends the buffer to screen
DECLARE SUB S13HLine (x1%, x2%, y%, cl%, scr%())
DECLARE SUB S13VLine (x%, y1%, y2%, cl%, scr%())
DIM SHARED m256%(255)
FUNCTION S13GetPx% (x%, y%, scr%()) STATIC
arr% = scr%(x%) + scr%(y% + 320)
IF 1 AND x% THEN
S13GetPx% = scr%(arr%) \ 256
ELSE
S13GetPx% = &HFF AND scr%(arr%)
END IF
END FUNCTION
SUB S13HLine (x1%, x2%, y%, cl%, scr%()) STATIC
IF (y% >= 0) AND (y% < scr%(521)) THEN
xs% = x1%
xf% = x2%
IF xs% > xf% THEN SWAP xs%, xf%
IF (xf% >= 0) AND (xs% < (scr%(520) \ 8)) THEN
IF xs% < 0 THEN xs% = 0
IF xf% >= scr%(520) THEN xf% = (scr%(520) \ 8) - 1
xst% = (xs% + 1) AND &HFFFE
xft% = (xf% - 1) AND &HFFFE
ars% = scr%(xst%) + scr%(y% + 320)
arf% = ars% + ((xft% - xst%) \ 2)
clt% = m256%(cl%)
IF xst% <> xs% THEN scr%(ars% - 1) = &HFF AND scr%(ars% - 1) OR clt%
IF xft% + 1 <> xf% THEN scr%(arf% + 1) = &HFF00 AND scr%(arf% + 1) OR cl%
clt% = clt% + cl%
FOR i% = ars% TO arf%
scr%(i%) = clt%
NEXT i%
END IF
END IF
END SUB
SUB S13InitBuf (xSiz%, ySiz%, scr%())
ERASE scr%
REDIM scr%(((xSiz% + 1) \ 2) * ySiz% - 1 + 2 + 320 + 200)
FOR i% = 0 TO xSiz% - 1: scr%(i%) = (i% \ 2) + 522: NEXT i%
FOR i% = 0 TO ySiz% - 1: scr%(i% + 320) = i% * ((xSiz% + 1) \ 2): NEXT i%
scr%(520) = ((xSiz% + 1) \ 2) * 16
scr%(521) = ySiz%
FOR i% = 0 TO 127
m256%(i%) = i% * 256
m256%(i% + 128) = (i% - 128) * 256
NEXT i%
END SUB
SUB S13PlotPx (x%, y%, cl%, scr%()) STATIC
arr% = scr%(x%) + scr%(y% + 320)
IF 1 AND x% THEN
scr%(arr%) = &HFF AND scr%(arr%) OR m256%(cl%)
ELSE
scr%(arr%) = &HFF00 AND scr%(arr%) OR cl%
END IF
END SUB
SUB S13PutBuf (x%, y%, scr%())
PUT (x%, y%), scr%(520), PSET
END SUB
SUB S13VLine (x%, y1%, y2%, cl%, scr%())
IF (x% >= 0) AND (x% < (scr%(520) \ 8)) THEN
ys% = y1%
yf% = y2%
IF ys% > yf% THEN SWAP ys%, yf%
IF (yf% >= 0) AND (ys% < scr%(521)) THEN
IF ys% < 0 THEN ys% = 0
IF yf% >= scr%(521) THEN yf% = scr%(521) - 1
ars% = scr%(x%) + scr%(ys% + 320)
ari% = scr%(520) \ 16 'Increase with buffer's width
arf% = scr%(x%) + scr%(yf% + 320)
IF 1 AND x% THEN
tmp% = m256%(cl%)
FOR i% = ars% TO arf% STEP ari%
scr%(i%) = &HFF AND scr%(i%) OR tmp%
NEXT i%
ELSE
FOR i% = ars% TO arf% STEP ari%
scr%(i%) = &HFF00 AND scr%(i%) OR cl%
NEXT i%
END IF
END IF
END IF
END SUB
Spinball? - i think i have some old shareware version of it: it was not bad, but that really annoyed me (and everyone within 25 metres) that i could not turn off it's PC Speaker effects. Of course you can submit if it has a new version (I hope it was made more interesting. I think the biggest drawback was that the gameplay became quite boring after a short time)
fter 60 million years a civilization will search for a meteorite destroying most of the living creatures around this age...
There must be a better future for the Cheetahs!
http://rcs.fateback.com/
Posts: 116
Threads: 5
Joined: Jul 2004
Spotted Cheetah...
Well, I did some test runs on your blitters, and I don't see why your manipulating your integers with bit shifting, etc...
Try using just plain ole' POKE/PEEK, it's faster, trust me I did some tests plus, I've tried a similar method like what your doing.
Heh, not showing off but, it's actually faster than yours, and I don't need any lookup tables, or precaclulations.
I'll post all that later but, I'm not sure this is even the proper
thread for our little SCREEN 13 discussion. ???
Hey, what I'll do is probablly start another thread and post the code there, maybe something like... Pure QB, (SCREEN 13), blitters.
I'll also post my latest build of my gfx lib, (VIDEO 13h.), it's almost
at its first public release, just need to add the scaling, rotating, and a few other misc. stuff. (This latest build features a better sprite routine, and some bugs and fixes.)
Anyways, this win/loose thing can't mean anything until we define parameters, boundries, etc, of our contest.
All youve posted, besides your last post with code, (Haven't checked it out yet), was a simple pixel plotter, and that isn't even that fast, which I mentioned up above.
I'm glad to see your involvement in this subject but, I suspoect I've alot more experience pertaining to this and I don't care to make it a contest, I just like doing what we're doing, sharing code, ideas, etc!!!
Cya in another thread, another day!
Nemesis
:::EDIT:::
Before starting any new threads I'll post the code I used to test
your pixel plotter, and my pixel ploter I made a few years back that manipulates integers and then some code that uses POKE.
See how much faster POKE works...
PROGRAM #1: Cheetah's pixel plotter using integer manipulation...
Code: '''
''' CATS13.bas
'''
DEFINT A-Z
'$DYNAMIC
DIM m256arr%(255)
DIM scrarr%(0)
'$STATIC
SCREEN 13
DEF SEG
ERASE scrarr%
REDIM scrarr%(((320 + 1) \ 2) * 200 - 1 + 2 + 320 + 200)
FOR i% = 0 TO 320 - 1: scrarr%(i%) = (i% \ 2) + 522: NEXT i%
FOR i% = 0 TO 200 - 1: scrarr%(i% + 320) = i% * ((320 + 1) \ 2): NEXT i%
scrarr%(520) = ((320 + 1) \ 2) * 16
scrarr%(521) = 200
FOR i% = 0 TO 127
m256arr%(i%) = i% * 256
m256arr%(i% + 128) = (i% - 128) * 256
NEXT i%
DO: LOOP UNTIL TIMER <> TIMER: t! = TIMER
FOR c% = 0 TO 255
FOR i% = 0 TO 319
FOR j% = 0 TO 199
arr% = scrarr%(i%) + scrarr%(j% + 320)
IF 1 AND i% THEN
scrarr%(arr%) = &HFF AND scrarr%(arr%) OR m256arr%(c%)
ELSE
scrarr%(arr%) = &HFF00 AND scrarr%(arr%) OR c%
END IF
NEXT j%
NEXT i%
PUT (X%, Y%), scrarr%(520), PSET
NEXT c%
PRINT ABS(TIMER - t!)
SLEEP
SCREEN 0: WIDTH 80: COLOR 7: CLS : SYSTEM
PROGRAM #2: Nemesis's pixel plotter using integer manipulation...
Code: '''
'''NEMS13.bas
'''
'$DYNAMIC
DEFINT A-Z
'
SCREEN 13
'
DIM SHARED VIDEO(0 TO 32001)
'
GET (0, 0)-(319, 199), VIDEO
'
DO: LOOP UNTIL TIMER <> TIMER: t! = TIMER
'
Voffstep = (VIDEO(0) \ &H10)
Voffstart = &H2
Voffend = (Voffstep * 199)
'
FOR Byte = 0 TO 255
IF Byte > &H7F THEN
nByte = (Byte - &H100) * &H100
ELSE
nByte = Byte * &H100
END IF
FOR Verticle = Voffstart TO Voffend STEP Voffstep
FOR Horizontal = 0 TO 319
i = ((Horizontal \ &H2) + Verticle)
IF (Horizontal AND &H1) THEN
VIDEO(i) = (VIDEO(i) AND &HFF) + nByte
ELSE
VIDEO(i) = VIDEO(i) - ((VIDEO(i) AND &HFF) - Byte)
END IF
NEXT
NEXT
PUT (0, 0), VIDEO, PSET
NEXT
'
PRINT ABS(TIMER - t!): SLEEP
'
SCREEN 0: WIDTH 80: COLOR 7: CLS : SYSTEM
'
PROGRAM #3: Nemesis's pixel plotter using POKE...
Code: '''
'''POKE13.bas
'''
'$DYNAMIC
DEFINT A-Z
'
SCREEN 13
'
DIM SHARED VIDEO(0 TO 32001)
'
GET (0, 0)-(319, 199), VIDEO
'
DO: LOOP UNTIL TIMER <> TIMER: t! = TIMER
'
FOR c = 0 TO 255
VS = VARSEG(VIDEO(0))
FOR y = 0 TO 199
DEF SEG = VS: VS = VS + 20
FOR x = 4 TO 323
POKE x, c
NEXT
NEXT
PUT (0, 0), VIDEO, PSET
NEXT
'
PRINT TIMER - t!: SLEEP
'
SCREEN 0: WIDTH 80: COLOR 7: CLS : SYSTEM
'
Run all three programs, you'll see POKE clearly out performs our integer manipulation techniques!
Here are some results on a 333 MHz. machine...
CATS13.bas: 26.85, 26.85, 26.86
NEMS13.bas: 25.04, 25.04, 25.04
POKE13.bas: 13.66, 13.72, 13.72
CATS13.exe: 5.48, 5.50, 5.48
NEMS13.exe: 5.27, 5.27, 5.27
POKE13.exe: 3.02, 3.02, 3.02
Cya,
Nemesis
P.S...
I'll post the latest build of VIDEO13h.bas, in another more appropriate thread sometime today/tomorrow!
Posts: 245
Threads: 48
Joined: Dec 2004
I made this game. It is ok, and is written with QB, but it does use an outside file named "Bowling.HSR" for the hiscore. There's nothing much in it, but here it is.
BOWLING
BY JOHN KREITLOW
IN ASSOCIATION WITH RADIUM-V
CREATED JANUARY 15, 2005
Code: DECLARE SUB BALLCOLOUR (COL%)
SCREEN 0
CLS
Q = 23
PINLIN4% = 1
PINLIN3% = 1
PINLIN2% = 1
HEADPIN% = 1
L1:
N% = 1
FOR I% = 1 TO 50!
LOCATE 2, 37: IF PINLIN4% = 1 THEN PRINT "O O O O" ELSE PRINT " "
LOCATE 3, 38: IF PINLIN3% = 1 THEN PRINT "O O O" ELSE PRINT " "
LOCATE 4, 39: IF PINLIN2% = 1 THEN PRINT "O O" ELSE PRINT " "
LOCATE 5, 40: IF HEADPIN% = 1 THEN PRINT "O" ELSE PRINT " "
LOCATE Q, 40: PRINT "0"
NEXT I%
I% = 0
Q = Q - 1
IF Q < 2 THEN GOTO L2
LOCATE Q + 1, 40: PRINT " "
IF Q = 5 THEN HEADPIN% = 0
IF Q = 4 THEN PINLIN2% = 0
IF Q = 3 THEN PINLIN3% = 0
IF Q = 2 THEN PINLIN4% = 0
GOTO L1
L2:
BALLCOLOUR COL%
SCREEN 0: WIDTH 80, 25
CLS
PRINT "BOWLING"
PRINT "CREATED BY JOHN KREITLOW"
PRINT "IN ASSOCIATION WITH rADIUM-V"
LOCATE 1, 12: PRINT COL%
PRINT
LOCATE 5, 18: PRINT "BASED ON ACME SOFTWARE'S `BOWLIN' FOR THE TI-83"
PRINT
LOCATE 7, 31: PRINT "PRESS SPACE TO START"
LOCATE 8, 32: PRINT "PRESS ESC TO QUIT"
LOCATE 9, 32: PRINT "âââââââââââââââââ"
LOCATE 10, 32: PRINT "â LANE RULES â"
LOCATE 11, 32: PRINT "âââââââââââââââââ"
PRINT
PRINT "STRIKE = 30 POINTS"
PRINT "SPARE = 20 POINTS"
PRINT "HIT `ENTER' AT WANTED SPACE ON THE LANE TO SELECT IT."
PRINT "SELECT DESIRED STRENGTH,INDICATED NEAR BASE OF POWER METER. CHOOSE QUICKLY,"
PRINT " BECAUSE YOU WILL MISS A TURN IF YOU TAKE TOO MUCH TIME."
OPEN "BOWLING.HSR" FOR INPUT AS #1
INPUT #1, SCORE1%
INPUT #1, NAME$
PRINT "HI-SCORE:"; SCORE1%; "BY "; NAME$
FOR I% = 1 TO 50
N$ = INKEY$
IF N$ = CHR$(32) THEN GOTO 0
IF N$ = CHR$(27) THEN GOTO GAMEND
I% = 1
NEXT I%
0 SCREEN 7
SCORE% = 0
PIN1% = 1
PIN2% = 1
PIN3% = 1
PIN4% = 1
PIN5% = 1
PIN6% = 1
PIN7% = 1
PIN8% = 1
PIN9% = 1
PIN0% = 1
FOR I% = 1 TO 20
TOP:
N% = 1
SCREEN 7
CLS
IF I% = 1 OR I% = 3 OR I% = 5 OR I% = 7 OR I% = 9 OR I% = 11 OR I% = 13 OR I% = 15 OR I% = 17 OR I% = 19 THEN FRAMEP% = 1
IF I% = 2 OR I% = 4 OR I% = 6 OR I% = 8 OR I% = 10 OR I% = 12 OR I% = 14 OR I% = 16 OR I% = 18 OR I% = 20 THEN FRAMEP% = 2
IF FRAMEP% = 1 OR PIN1% = 1 THEN PIN1% = 1: CIRCLE (70, 10), 5 ELSE IF FRAMEP% = 2 AND PIN1% = 0 THEN CIRCLE (70, 10), 5, 0
IF FRAMEP% = 1 OR PIN2% = 1 THEN PIN2% = 1: CIRCLE (110, 10), 5 ELSE IF FRAMEP% = 2 AND PIN2% = 0 THEN CIRCLE (110, 10), 5, 0
IF FRAMEP% = 1 OR PIN3% = 1 THEN PIN3% = 1: CIRCLE (150, 10), 5 ELSE IF FRAMEP% = 2 AND PIN3% = 0 THEN CIRCLE (150, 10), 5, 0
IF FRAMEP% = 1 OR PIN4% = 1 THEN PIN4% = 1: CIRCLE (190, 10), 5 ELSE IF FRAMEP% = 2 AND PIN4% = 0 THEN CIRCLE (190, 10), 5, 0
IF FRAMEP% = 1 OR PIN5% = 1 THEN PIN5% = 1: CIRCLE (90, 30), 5 ELSE IF FRAMEP% = 2 AND PIN5% = 0 THEN CIRCLE (90, 30), 5, 0
IF FRAMEP% = 1 OR PIN6% = 1 THEN PIN6% = 1: CIRCLE (130, 30), 5 ELSE IF FRAMEP% = 2 AND PIN6% = 0 THEN CIRCLE (130, 30), 5, 0
IF FRAMEP% = 1 OR PIN7% = 1 THEN PIN7% = 1: CIRCLE (170, 30), 5 ELSE IF FRAMEP% = 2 AND PIN7% = 0 THEN CIRCLE (170, 30), 5, 0
IF FRAMEP% = 1 OR PIN8% = 1 THEN PIN8% = 1: CIRCLE (110, 50), 5 ELSE IF FRAMEP% = 2 AND PIN8% = 0 THEN CIRCLE (110, 50), 5, 0
IF FRAMEP% = 1 OR PIN9% = 1 THEN PIN9% = 1: CIRCLE (150, 50), 5 ELSE IF FRAMEP% = 2 AND PIN9% = 0 THEN CIRCLE (150, 50), 5, 0
IF FRAMEP% = 1 OR PIN0% = 1 THEN PIN0% = 1: CIRCLE (130, 70), 5 ELSE IF FRAMEP% = 2 AND PIN0% = 0 THEN CIRCLE (130, 70), 5, 0
LINE (300, 10)-(310, 190), 4, BF
LINE (28, 10)-(28, 190)
LINE (222, 10)-(222, 190)
A = 40
B = 190
C = 190
D = 10
IF I% = 1 OR I% = 2 THEN FRAME% = 1
IF I% = 3 OR I% = 4 THEN FRAME% = 2
IF I% = 5 OR I% = 6 THEN FRAME% = 3
IF I% = 7 OR I% = 8 THEN FRAME% = 4
IF I% = 9 OR I% = 10 THEN FRAME% = 5
IF I% = 11 OR I% = 12 THEN FRAME% = 6
IF I% = 13 OR I% = 14 THEN FRAME% = 7
IF I% = 15 OR I% = 16 THEN FRAME% = 8
IF I% = 17 OR I% = 18 THEN FRAME% = 9
IF I% = 19 OR I% = 20 THEN FRAME% = 10
LOCATE 2, 30: PRINT "SCORE:"
LOCATE 3, 30: PRINT SCORE%
LOCATE 5, 30: PRINT "FRAME:"
LOCATE 6, 30: PRINT FRAME%
1 LINE (28, 180)-(222, 200), 0, BF
CIRCLE (A, B), 10, COL%
A = A + 1
IF A > 210 THEN GOTO 2
N$ = INKEY$
IF N$ = CHR$(13) THEN GOTO 3
IF N$ = CHR$(27) THEN GOTO GAMEND
GOTO 1
2 LINE (28, 180)-(222, 200), 0, BF
CIRCLE (A, B), 10, COL%
A = A - 1
IF A < 40 THEN GOTO 1
N$ = INKEY$
IF N$ = CHR$(13) THEN GOTO 3
IF N$ = CHR$(27) THEN GOTO GAMEND
GOTO 2
3 LINE (28, 180)-(222, 200), 0, BF
CIRCLE (A, B), 10, 0
IF A > 30 AND A < 70 THEN A = 50
IF A > 50 AND A < 90 THEN A = 70
IF A > 70 AND A < 110 THEN A = 90
IF A > 90 AND A < 130 THEN A = 110
IF A > 110 AND A < 150 THEN A = 130
IF A > 130 AND A < 170 THEN A = 150
IF A > 150 AND A < 190 THEN A = 170
IF A > 170 AND A < 210 THEN A = 190
IF A > 190 AND A < 240 THEN A = 210
CIRCLE (A, B), 10, COL%
H% = 5
SOUND 400, .5
4 FOR F% = 1 TO 3
LINE (300, C)-(310, C), 2, BF
NEXT F%
C = C - 1
D = D + 1
IF D <= 39 THEN E = 5
IF D >= 39 AND D <= 76 THEN E = 4
IF D >= 77 AND D <= 114 THEN E = 3
IF D >= 115 AND D <= 152 THEN E = 2
IF D >= 153 THEN E = 1
LOCATE 23, 35: PRINT E
IF C = 10 THEN SOUND 400, .5: LINE (300, 10)-(310, 190), 4, BF: C = 190: D = 10: H% = H% - 1
IF H% = 0 THEN GOTO TIME
N$ = INKEY$
IF N$ = CHR$(13) THEN GOTO HIT1
LOCATE 12, 15: PRINT H%
GOTO 4
HIT1:
IF D <= 39 THEN E = 5
IF D >= 39 AND D <= 76 THEN E = 4
IF D >= 77 AND D <= 114 THEN E = 3
IF D >= 115 AND D <= 152 THEN E = 2
IF D >= 153 THEN E = 1
HIT2:
FOR Z% = 1 TO E
CIRCLE (A, B), 10, COL%
CIRCLE (A, B), 10, 0
NEXT Z%
B = B - 1
IF B = -5 THEN GOTO SCORE
GOTO HIT2
SCORE:
IF A = 70 AND PIN1% = 0 THEN P = 0
IF A = 70 AND PIN1% = 1 THEN PIN1% = 0: P = 1
IF A = 90 AND FRAMEP% = 1 THEN PIN1% = 0: PIN2% = 0: PIN5% = 0: P = 3
IF A = 90 AND FRAMEP% = 2 AND PIN1% = 0 AND PIN2% = 0 AND PIN5% = 0 THEN P = 0
IF A = 90 AND FRAMEP% = 2 AND PIN1% = 0 AND PIN2% = 1 AND PIN5% = 1 THEN PIN2% = 0: PIN5% = 0: P = 2
IF A = 90 AND FRAMEP% = 2 AND PIN1% = 1 AND PIN2% = 0 AND PIN5% = 1 THEN PIN1% = 0: PIN5% = 0: P = 2
IF A = 90 AND FRAMEP% = 2 AND PIN1% = 1 AND PIN2% = 1 AND PIN5% = 1 THEN PIN1% = 0: PIN2% = 0: PIN5% = 0: P = 3
IF A = 110 AND FRAMEP% = 1 THEN PIN1% = 0: PIN2% = 0: PIN3% = 0: PIN5% = 0: PIN6% = 0: PIN8% = 0: P = 6
IF A = 110 AND FRAMEP% = 2 AND PIN8% = 0 THEN P = 0
IF A = 110 AND FRAMEP% = 2 AND PIN1% = 0 AND PIN2% = 1 AND PIN3% = 1 AND PIN5% = 1 AND PIN6% = 1 AND PIN8% = 1 THEN PIN2% = 0: PIN3% = 0: PIN5% = 0: PIN6% = 0: PIN8% = 0: P = 5
IF A = 110 AND FRAMEP% = 2 AND PIN1% = 0 AND PIN2% = 0 AND PIN5% = 0 AND PIN8% = 1 AND PIN6% = 1 AND PIN3% = 1 THEN PIN8% = 0: PIN6% = 0: PIN3% = 0: P = 3
IF A = 110 AND FRAMEP% = 2 AND PIN9% = 0 THEN PIN1% = 0: PIN5% = 0: PIN8% = 0: P = 3
IF A = 110 AND FRAMEP% = 2 AND PIN7% = 0 AND PIN9% = 1 THEN PIN8% = 0: PIN1% = 0: PIN2% = 0: PIN5% = 0: PIN6% = 0: P = 5
IF A = 130 AND FRAMEP% = 1 THEN PIN1% = 0: PIN2% = 0: PIN3% = 0: PIN4% = 0: PIN5% = 0: PIN6% = 0: PIN7% = 0: PIN8% = 0: PIN9% = 0: PIN0% = 0: I% = I% + 1: P = 30: GOTO STRIKE
IF A = 130 AND FRAMEP% = 2 THEN SCORE% = SCORE% - P: P = 20: GOTO SPARE
IF A = 150 AND FRAMEP% = 1 THEN PIN2% = 0: PIN3% = 0: PIN4% = 0: PIN6% = 0: PIN7% = 0: PIN9% = 0: P = 6
IF A = 150 AND FRAMEP% = 2 AND PIN9% = 0 THEN P = 0
IF A = 150 AND FRAMEP% = 2 AND PIN4% = 0 AND PIN2% = 1 AND PIN3% = 1 AND PIN7% = 1 AND PIN6% = 1 AND PIN9% = 1 THEN PIN9% = 0: PIN7% = 0: PIN6% = 0: PIN3% = 0: PIN2% = 0: P = 5
IF A = 150 AND FRAMEP% = 2 AND PIN4% = 0 AND PIN3% = 0 AND PIN7% = 0 AND PIN9% = 1 AND PIN6% = 1 AND PIN2% = 1 THEN PIN9% = 0: PIN6% = 0: PIN2% = 0: P = 3
IF A = 150 AND FRAMEP% = 2 AND PIN1% = 0 AND PIN2% = 0 AND PIN5% = 0 THEN PIN3% = 0: PIN4% = 0: PIN6% = 0: PIN7% = 0: PIN9% = 0: P = 5
IF A = 150 AND FRAMEP% = 2 AND PIN8% = 0 THEN PIN9% = 0: PIN7% = 0: PIN4% = 0: P = 3
IF A = 170 AND FRAMEP% = 1 THEN PIN3% = 0: PIN4% = 0: PIN7% = 0: P = 3
IF A = 170 AND FRAMEP% = 2 AND PIN7% = 0 THEN P = 0
IF A = 170 AND FRAMEP% = 2 AND PIN7% = 1 AND PIN3% = 1 AND PIN4% = 0 THEN PIN7% = 0: PIN3% = 0: P = 2
IF A = 170 AND FRAMEP% = 2 AND PIN7% = 1 AND PIN3% = 0 AND PIN4% = 1 THEN PIN7% = 0: PIN4% = 0: P = 2
IF A = 190 AND FRAMEP% = 1 THEN PIN4% = 0: P = 1
IF A = 190 AND FRAMEP% = 2 AND PIN4% = 0 THEN P = 0
IF A = 190 AND FRAMEP% = 2 AND PIN4% = 1 THEN PIN4% = 0: P = 1
IF A > 190 OR A < 70 THEN P = 0
999
SCORE% = SCORE% + P
FOR F% = 1 TO 90!
IF PIN1% = 1 THEN PIN1% = 1: CIRCLE (70, 10), 5 ELSE IF PIN1% = 0 THEN CIRCLE (70, 10), 5, 0
IF PIN2% = 1 THEN PIN2% = 1: CIRCLE (110, 10), 5 ELSE IF PIN2% = 0 THEN CIRCLE (110, 10), 5, 0
IF PIN3% = 1 THEN PIN3% = 1: CIRCLE (150, 10), 5 ELSE IF PIN3% = 0 THEN CIRCLE (150, 10), 5, 0
IF PIN4% = 1 THEN PIN4% = 1: CIRCLE (190, 10), 5 ELSE IF PIN4% = 0 THEN CIRCLE (190, 10), 5, 0
IF PIN5% = 1 THEN PIN5% = 1: CIRCLE (90, 30), 5 ELSE IF PIN5% = 0 THEN CIRCLE (90, 30), 5, 0
IF PIN6% = 1 THEN PIN6% = 1: CIRCLE (130, 30), 5 ELSE IF PIN6% = 0 THEN CIRCLE (130, 30), 5, 0
IF PIN7% = 1 THEN PIN7% = 1: CIRCLE (170, 30), 5 ELSE IF PIN7% = 0 THEN CIRCLE (170, 30), 5, 0
IF PIN8% = 1 THEN PIN8% = 1: CIRCLE (110, 50), 5 ELSE IF PIN8% = 0 THEN CIRCLE (110, 50), 5, 0
IF PIN9% = 1 THEN PIN9% = 1: CIRCLE (150, 50), 5 ELSE IF PIN9% = 0 THEN CIRCLE (150, 50), 5, 0
IF PIN0% = 1 THEN PIN0% = 1: CIRCLE (130, 70), 5 ELSE IF PIN0% = 0 THEN CIRCLE (130, 70), 5, 0
LOCATE 12, 15: PRINT "+"; P
NEXT F%
IF I% = 20 THEN GOTO GAMEOVR
NEXT I%
END
'-----------------------------------------------------------------------------
SPARE:
CLS
Y = 13
Z = 26
SPARE1:
SCREEN 7
O% = 1
LOCATE 5, 13: COLOR 7: PRINT "ââââââââââââââ"
LOCATE 6, 13: COLOR 7: PRINT "â SPARE! â"
LOCATE 7, 13: COLOR 7: PRINT "ââââââââââââââ"
LOCATE 5, Y: COLOR 4: PRINT " â"; CHR$(15)
LOCATE 7, Z: COLOR 4: PRINT CHR$(15); "â "
LOCATE 9, 13: COLOR 7: PRINT " PRESS SPACE"
Y = Y + 1
Z = Z - 1
IF Y = 25 THEN Y = 13
IF Z = 13 THEN Z = 25
FOR O% = 1 TO 500!
N$ = INKEY$
IF N$ = CHR$(32) THEN COLOR 15: CLS : SCREEN 7: GOTO 999
NEXT O%
GOTO SPARE1
GOTO 999
STRIKE:
CLS
Y = 13
Z = 26
STRIKE1:
SCREEN 7
O% = 1
LOCATE 5, 13: COLOR 7: PRINT "ââââââââââââââ"
LOCATE 6, 13: COLOR 7: PRINT "â STRIKE! â"
LOCATE 7, 13: COLOR 7: PRINT "ââââââââââââââ"
LOCATE 5, Y: COLOR 14: PRINT " â"; CHR$(15)
LOCATE 7, Z: COLOR 14: PRINT CHR$(15); "â "
LOCATE 9, 13: COLOR 7: PRINT " PRESS SPACE"
Y = Y + 1
Z = Z - 1
IF Y = 25 THEN Y = 13
IF Z = 13 THEN Z = 25
FOR O% = 1 TO 500!
N$ = INKEY$
IF N$ = CHR$(32) THEN COLOR 15: CLS : SCREEN 7: GOTO 999
NEXT O%
GOTO STRIKE1
TIME:
FOR F% = 1 TO 500!
LOCATE 13, 12: PRINT "TIME'S UP!"
NEXT F%
GOTO 999
GAMEOVR:
SCREEN 0: WIDTH 80, 25
IF SCORE% > SCORE1% THEN GOTO HISCORE
CLS
PRINT "TOTAL SCORE:"
PRINT SCORE%
PRINT
GAMEOVR0:
PRINT "CREATED BY JOHN KREITLOW"
PRINT "IN ASSOCIATION WITH RADIUM-V"
PRINT
PRINT "PLAY AGAIN?(Y/N)"
GAMEOVR1:
N$ = INKEY$
IF N$ = CHR$(89) OR N$ = CHR$(121) THEN GOTO 0
IF N$ = CHR$(78) OR N$ = CHR$(110) THEN END
GOTO GAMEOVR1
GAMEND:
CLS
SCREEN 0: WIDTH 80, 25
GOTO GAMEOVR0
END
HISCORE:
PRINT "CONGRATULATIONS! YOU BEAT THE HIGH SCORE!"
PRINT "YOU SHOULD BE ON THE HALL OF FAME."
PRINT
PRINT "OLD HISCORE:"; SCORE1%
PRINT "MADE BY:"; NAME$
PRINT
PRINT "YOUR SCORE:"; SCORE%
SCORE1% = SCORE%
CLOSE #1
OPEN "BOWLING.HSR" FOR OUTPUT AS #2
INPUT "PLEASE ENTER YOUR NAME:", NAME$
WRITE #2, SCORE%, NAME$
CLOSE
GOTO GAMEOVR0
SUB BALLCOLOUR (COL%)
CLS
SCREEN 7
N = 7
M = 5
CIRCLE (35, 10), 10, 1
CIRCLE (75, 10), 10, 2
CIRCLE (115, 10), 10, 3
CIRCLE (155, 10), 10, 4
CIRCLE (195, 10), 10, 5
CIRCLE (235, 10), 10, 12
CIRCLE (275, 10), 10, 14
LOCATE 12, 5: PRINT "PLEASE SELECT YOUR BALL COLOR."
COLOUR1:
FOR R% = 1 TO 500!
LOCATE N, M: PRINT CHR$(127)
COLOR INT(RND * 15) + 1
NEXT R%
COLOR 7
N = N - 1
IF N < 5 THEN LOCATE N + 1, M: PRINT " ": LOCATE N + 2, M: PRINT " ": N = 7
N$ = INKEY$
IF N$ = CHR$(0) + "K" THEN GOTO LEFTCOL1
IF N$ = CHR$(0) + "M" THEN GOTO RIGHTCOL1
IF N$ = CHR$(13) THEN GOTO ENTER
GOTO COLOUR1
LEFTCOL1:
LOCATE N, M: PRINT " "
LOCATE N + 1, M: PRINT " "
LOCATE N + 2, M: PRINT " "
N = 7
M = M - 5
IF M < 5 THEN M = 5
GOTO COLOUR1
RIGHTCOL1:
LOCATE N, M: PRINT " "
LOCATE N + 1, M: PRINT " "
LOCATE N + 2, M: PRINT " "
N = 7
M = M + 5
IF M > 35 THEN M = 35
GOTO COLOUR1
ENTER:
IF M = 5 THEN COL% = 1
IF M = 10 THEN COL% = 2
IF M = 15 THEN COL% = 3
IF M = 20 THEN COL% = 4
IF M = 25 THEN COL% = 5
IF M = 30 THEN COL% = 12
IF M = 35 THEN COL% = 14
END SUB
There you go. Here is the BOWLING.HSR:
That file will change as you beat the high score of 100.
Now, who wants to help compile it?
Posts: 3,522
Threads: 189
Joined: Dec 2003
What is this?, The topic of longest post? 
|
