Posts: 3,343
Threads: 83
Joined: Mar 2003
I'm running this challenge at QBNZ (see http://qbnz.com/pages/challenges/index.html), but I've only had light interest, so I'm gonna run it here as well. You may post your entries here, I will take them and review them. Also, if people want, I'll give part of the mark for the "peoples choice" so you guys can vote for the best.
Anyway, the challenge is:
Make a "loading screen" for QBasic. You may use any hardware functions (PEEK, OUT etc) but NO LIBS. The contest finishes on the 23rd of July. Here are the rules:
* Please show somewhere on the screen some sort of loading bar/circle etc. Make a delay to show it in action. You will lose points if the loading bar is slow just because your program is slow.
* It should be in the form of a SUB, don't forget it is supposed to be able to be used in a game.
* I don't mind what screen mode you use, but more colourful entries will get more points than, say SCREEN 1 entries.
* No more than 12K uncompiled, please.
C'mon, this challenge is dead easy. The current entries should be surpassed by even the worst of you here, so get making them!
Posts: 1,166
Threads: 62
Joined: Apr 2003
I may give a stab at this, but I have to go to my 3D animation class in 10 minutes. I'll think of something while there though.
am an asshole. Get used to it.
Posts: 2,765
Threads: 138
Joined: Nov 2002
this should get me around lets say... 1 point
Code: SUB load
SCREEN 13
a = 1
w = 0
FOR i = 1 TO 40
IF a = 16 THEN a = 1
COLOR a
a = a + 1
PRINT CHR$(219);
t = TIMER
DO
IF TIMER < t THEN t = t - 86400
LOOP UNTIL TIMER - t >= w
NEXT i
END SUB
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
Posts: 3,343
Threads: 83
Joined: Mar 2003
5 points. It's quick, but extremely boring.
Posts: 1,166
Threads: 62
Joined: Apr 2003
Mine's gonna be really cool, but I haven't finished it yet :/
am an asshole. Get used to it.
Posts: 2,765
Threads: 138
Joined: Nov 2002
Quote:5 points. It's quick, but extremely boring.
Cool!
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
Posts: 1,166
Threads: 62
Joined: Apr 2003
Quote:Mine's gonna be really cool, but I haven't finished it yet :/
I had it almost done, but it was getting too... huge. I guess images in DATA statements suck. I was using pp256's save as DATA, but one image was too big and it all went to hell and.... ugh..
I guess I have to use Qbasic's default font *sigh*
am an asshole. Get used to it.
Posts: 3,343
Threads: 83
Joined: Mar 2003
Don't forget: it shouldn't take forever to load in your fonts/images (just in case you did forget).
Posts: 1,166
Threads: 62
Joined: Apr 2003
Oy, it's not exactly what I wanted, but it's good enough I guess.
I tried to make some kind of cool biohazard thingy... check it out.
Code: DEFINT A-Z
'$STATIC
DECLARE SUB FlatTri (x1%, y1%, x2%, y2%, x3%, y3%, col%)
DECLARE SUB nPrint (XX%, YY%, Text$, col%)
'$DYNAMIC
DIM SHARED buffer(32001)
'$STATIC
DIM SHARED lutsegy(199) AS LONG
CONST pi180 = 3.141592654# / 180
FOR n& = 0 TO 199
lutsegy(n&) = n& * 320 + 4
NEXT
CONST PI = 3.14151693#
DIM SHARED C!(359)
DIM SHARED s!(359)
FOR I = 0 TO 359
A! = I * PI / 180
C!(I) = COS(A!)
s!(I) = SIN(A!)
NEXT I
SCREEN 13
FOR I = 0 TO 255
OUT &H3C8, I
OUT &H3C9, (I \ 4)
OUT &H3C9, (I \ 4)
OUT &H3C9, (I \ 4)
NEXT I
buffer(0) = 2560: buffer(1) = 200
DEF SEG = VARSEG(buffer(0))
t# = TIMER
TYPE tritype
x1 AS INTEGER
y1 AS INTEGER
x2 AS INTEGER
y2 AS INTEGER
x3 AS INTEGER
y3 AS INTEGER
END TYPE
DIM tris AS tritype
tris.x1 = 0: tris.y1 = 0
tris.x2 = -10: tris.y2 = 20
tris.x3 = 10: tris.y3 = 20
DIM ang(2), xc(2), yc(2)
ang(0) = 0
ang(1) = 90
ang(2) = 270
xc(0) = 159: yc(0) = 89
xc(1) = 139: yc(1) = 109
xc(2) = 179: yc(2) = 109
ccc = 2
ccinc = 1
DO
nPrint 130, 5, "Loading...", 60
nPrint 150, 20, STR$(percent) + "%", 60
FOR X = 0 TO 2
tx2 = tris.x2 * C!(ang(X))
ty2 = tris.y2 * s!(ang(X))
tx3 = tris.x3 * C!(ang(X))
ty3 = tris.y3 * s!(ang(X))
FlatTri 159, 99, tx2 + xc(X), ty2 + yc(X), tx3 + xc(X), ty3 + yc(X), ccc
NEXT
FOR X = 0 TO 2
ang(X) = ang(X) + 1
IF ang(X) > 359 THEN ang(X) = ang(X) - 360
NEXT
PUT (0, 0), buffer, PSET
frames& = frames& + 1
IF kl = 10 THEN ccc = ccc + ccinc: percent = percent + 1
IF percent > 100 THEN EXIT DO
kl = kl + 1: IF kl > 10 THEN kl = 0
IF ccc > 62 OR ccc < 1 THEN ccinc = -ccinc
REDIM buffer(32001)
buffer(0) = 2560: buffer(1) = 200
LOOP UNTIL INKEY$ <> ""
DIM pal(255, 2)
FOR n = 0 TO 63
OUT &H3C7, n
pal(n, 0) = INP(&H3C9)
pal(n, 1) = INP(&H3C9)
pal(n, 2) = INP(&H3C9)
NEXT
FOR n = 0 TO 63
FOR m = 0 TO 255
pal(m, 0) = pal(m, 0) - 1
pal(m, 1) = pal(m, 1) - 1
pal(m, 2) = pal(m, 2) - 1
r = pal(m, 0): IF r < 0 THEN r = 0
g = pal(m, 1): IF g < 0 THEN g = 0
b = pal(m, 2): IF b < 0 THEN b = 0
OUT &H3C8, m
OUT &H3C9, r
OUT &H3C9, g
OUT &H3C9, b
NEXT
WAIT &H3DA, 8
NEXT
REDIM buffer(32001)
buffer(0) = 2560: buffer(1) = 200
nPrint 120, 5, "Loading Complete", 50
nPrint 130, 20, STR$(INT(frames& / (TIMER - t#))) + " FPS", 50
FlatTri tris.x1 + 159, tris.y1 + 89, tris.x2 + 159, tris.y2 + 89, tris.x3 + 159, tris.y3 + 89, 63
FlatTri tris.x1 + 149, tris.y1 + 109, tris.x2 + 149, tris.y2 + 109, tris.x3 + 149, tris.y3 + 109, 63
FlatTri tris.x1 + 169, tris.y1 + 109, tris.x2 + 169, tris.y2 + 109, tris.x3 + 169, tris.y3 + 109, 63
PUT (0, 0), buffer, PSET
FOR n = 0 TO 63
FOR m = 0 TO 255
pal(m, 0) = pal(m, 0) + 1
pal(m, 1) = pal(m, 1) + 1
pal(m, 2) = pal(m, 2) + 1
r = pal(m, 0): IF r < 0 THEN r = 0
g = pal(m, 1): IF g < 0 THEN g = 0
b = pal(m, 2): IF b < 0 THEN b = 0
OUT &H3C8, m
OUT &H3C9, r
OUT &H3C9, g
OUT &H3C9, b
NEXT
WAIT &H3DA, 8
NEXT
DO: LOOP UNTIL LEN(INKEY$)
SUB FlatTri (x1%, y1%, x2%, y2%, x3%, y3%, C%)
DIM addr AS LONG
IF y2 > y3 THEN SWAP x2, x3: SWAP y2, y3
IF y1 > y2 THEN SWAP x1, x2: SWAP y1, y2
IF y2 > y3 THEN SWAP x2, x3: SWAP y2, y3
IF y1 <> y3 THEN
IF x2 > x1 AND x2 > x3 THEN
s = 1
ELSEIF x2 < x1 AND x2 < x3 THEN
s = -1
ELSE
s = SGN((y3 - y1) * (x2 - x1) - (y2 - y1) * (x3 - x1))
END IF
END IF
IF s < 0 THEN
tl = x2 - x1: tr = x3 - x1
dyl = y2 - y1: dyr = y3 - y1
ELSE
tl = x3 - x1: tr = x2 - x1
dyl = y3 - y1: dyr = y2 - y1
END IF
dxl = ABS(tl): sxl = SGN(tl): el = 0
dxr = ABS(tr): sxr = SGN(tr): er = 0
XX = x1
xxx = x1
FOR scanline = y1 TO y3
IF scanline = y2 THEN
IF s < 0 THEN
dyl = y3 - y2: IF dyl = 0 THEN EXIT SUB
tl = x3 - x2
dxl = ABS(tl): sxl = SGN(tl): XX = x2
ELSE
dyr = y3 - y2: IF dyr = 0 THEN EXIT SUB
tr = x3 - x2
dxr = ABS(tr): sxr = SGN(tr): xxx = x2
END IF
END IF
addr = lutsegy(scanline)
FOR X = XX TO xxx
POKE addr + X, C%
NEXT
WHILE el < 0: el = el + dyl: XX = XX + sxl: WEND
el = el - dxl
WHILE er < 0: er = er + dyr: xxx = xxx + sxr: WEND
er = er - dxr
NEXT scanline
END SUB
SUB nPrint (XX%, YY%, Text$, col%)
X% = XX%
Y% = YY%
FOR I% = 0 TO LEN(Text$) - 1
X% = X% + 8
Offset% = 8 * ASC(MID$(Text$, I% + 1, 1)) + 14
FOR J% = 0 TO 7
DEF SEG = &HFFA6
Bit% = PEEK(Offset% + J%)
DEF SEG = VARSEG(buffer(0))
IF Bit% AND 1 THEN POKE X% + lutsegy(Y% + J%), col% + J%
IF Bit% AND 2 THEN POKE X% - 1 + lutsegy(Y% + J%), col% + J%
IF Bit% AND 4 THEN POKE X% - 2 + lutsegy(Y% + J%), col% + J%
IF Bit% AND 8 THEN POKE X% - 3 + lutsegy(Y% + J%), col% + J%
IF Bit% AND 16 THEN POKE X% - 4 + lutsegy(Y% + J%), col% + J%
IF Bit% AND 32 THEN POKE X% - 5 + lutsegy(Y% + J%), col% + J%
IF Bit% AND 64 THEN POKE X% - 6 + lutsegy(Y% + J%), col% + J%
IF Bit% AND 128 THEN POKE X% - 7 + lutsegy(Y% + J%), col% + J%
NEXT J%
NEXT I%
END SUB
I don't know why, but in the IDE, it slows down tremendously at 75%, but compiled it doesn't.
::EDIT::
Is this the first graphics challenge I've entered in? Cool.
am an asshole. Get used to it.
Posts: 2,765
Threads: 138
Joined: Nov 2002
i have ran it yet but there goes my chance
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
|