Qbasicnews.com

QbasicNews.Com => Challenges => Topic started by: Spotted Cheetah on March 06, 2004, 10:53:02 PM



Title: 100% QB game
Post by: Spotted Cheetah on March 06, 2004, 10:53:02 PM
I know that I am new here, but believe, or not, I had seen much. I had seen that nowadays everybody programs under QB using libraries, and libraries, and other libraries, or assembly ect. I think this is not really QBasic...

So here is the challenge: Write a 100% QB code game! You can only use the default library (qb.qlb), and FFIX if needed.

(Believe or not, mouse is possible under QB, I just wrote one. No assembly, no extra libraries, just only qb.qlb!)

To make the project harder - do the game as fast as possible! I will program mine on a 33MHz 4.86! :)

The winner will be the best game of course. You do not have to do it on 33MHz, but I think a real QB game should work on all machines over 100Mhz...


Title: 100% QB game
Post by: Plasma on March 06, 2004, 11:06:44 PM
Using the mouse is possible without using any routines in QB.QLB...


Title: 100% QB game
Post by: Diroga on March 06, 2004, 11:07:19 PM
www.geocities.com/mrynit/Block3.bas
not done yet


Title: 100% QB game
Post by: whitetiger0990 on March 06, 2004, 11:33:05 PM
http://mywebpages.comcast.net/whitetiger0990/qbasic/nmaze/nmaze.zip
this count?

(change the path IN the game file, near the begining, defualted to a:\nmaze)


Title: 100% QB game
Post by: Zack on March 07, 2004, 06:41:41 PM
When does this expire? Because I'm working on a game, Operation Pong...an RPG. No libs, not even the standard QB lib.


Title: 100% QB game
Post by: relsoft on March 08, 2004, 03:38:08 AM
Quote from: "Plasma"
Using the mouse is possible without using any routines in QB.QLB...


I saw that on neobasic. :*)  LOL

Cheeta:

http://rel.betterwebber.com/junk.php?id=8

http://rel.betterwebber.com/junk.php?id=11


Title: 100% QB game
Post by: Spotted Cheetah on March 09, 2004, 05:23:09 AM
This competition never ends :)

For example my game may be ready only to the end of summer... It needs many work. Of course I will put up demos here sooner if I can.

Now I am writing from school, so I can't wiev anything. And my computer's keyboard is gone :-?  (Why am I triing to fix it myself?? :) )
I must fix it, I can not buy a new one... It will take a while...

I was so upset because of that mouse routines because as I looked around, and searched for it, I could not find any pure QB routines. All of them worked with Assembly + the basic library! I can't guess why is this needed...

I think the basic library can be used... Otherwise we should put up here how to handle the interrupts without it. Of course handling interrupts does not mean writing an interrupt handler for example in C, and then using it in QB. Only use the interrupts what can be found on an usual DOS system (What can be found in Ralph Brown's Interrupt List).

Paths: You can use relative paths. You do not need to tell OPEN to use the file at "a:\hiscore.dat", it is just enough to say "hiscore.dat", and it will open if it executes in the directory where the file is. (This is why the program usually can't find it's files from the IDE. You should copy QB.EXE in the directory where you are developing, so the program will find them)


Of course that the competition never ends does not mean that there won't be any winner. We should rate the games, and make the results monthly (Did you understand what I told - My English is horrible, and I have no dictionary... :-? ).


Title: 100% QB game
Post by: Spotted Cheetah on March 09, 2004, 03:50:12 PM
Diroga, WhiteTiger0990, Relsoft: Now I downloaded your programs. I will test them on my 4.86 soon.


Title: 100% QB game
Post by: Spotted Cheetah on March 11, 2004, 02:18:06 PM
Relsoft: Bubble Fight's technique is very good! It made 14-16 FPS on my 33Mhz computer :)

Why are you all giving programs from the 1 hour competition here?? This is not a time race, let's make some real quality stuff.

I will put up somewhere the sprite editor what I will use to create my game soon...

I will use GET and PUT intensively on the 640*350 screen. Of course I will change the palette too to get nice colors (I know how to do it on SCREEN 9). And I am doing this all on the 33Mhz 4.86 :).


Title: 100% QB game
Post by: Agamemnus on March 11, 2004, 03:48:38 PM
Where is that pureqb mouse routine, Plasma? I can't find it anywhere...


Title: 100% QB game
Post by: Plasma on March 11, 2004, 05:12:51 PM
I posted it on NeoBasic a few months ago. It resembles SuperPut...


Title: 100% QB game
Post by: Pyrodap on March 11, 2004, 06:06:37 PM
Eh, what the hell! I'll join!

I'll start right now.


*TO THE LAB!!!*


Title: 100% QB game
Post by: Pyrodap on March 11, 2004, 09:03:08 PM
Heh... Okay, I made a  game! (It took about 4 hours...)

I used Superput, but thats not a lib so I'm safe right? Anyway, Here ya go!


(It's kind've big)

Code:
DECLARE SUB superput ()
DECLARE SUB delay (d!)
DECLARE SUB init ()
DECLARE SUB loadpaldata ()
DIM SHARED Red, Green, Blue
DIM SHARED ship(40 * 32 \ 2 + 2)
DIM SHARED ship2(40 * 32 \ 2 + 2)
DIM SHARED Ringbottom(64 * 40 \ 2 + 2)
DIM SHARED Ringtop(64 * 40 \ 2 + 2)
RANDOMIZE TIMER
       TYPE Hero
       x AS INTEGER
       y AS INTEGER
       Xspeed AS INTEGER
       Yspeed AS INTEGER
       END TYPE
DIM SHARED Hero AS Hero
       TYPE Ring
       x AS INTEGER
       y AS INTEGER
       Active AS INTEGER
       END TYPE
DIM SHARED Ring(5) AS Ring
       
        TYPE Star
        x AS INTEGER
        y AS INTEGER
        Yspeed AS INTEGER
        END TYPE
DIM SHARED Star(50) AS Star
DIM SHARED score
init
mainloop:
        timing = 60 * 60
        DO
        LOCATE 1, 1
        PRINT "SCORE: " + LTRIM$(STR$(score))
        PRINT "TIME: " + LTRIM$(STR$(timing)) + " "
        timing = timing - 1
        a$ = INKEY$
        FOR s = 1 TO 50
                PSET (Star(s).x, Star(s).y), 0
                Star(s).y = Star(s).y + Star(s).Yspeed
                IF Star(s).y > 200 THEN Star(s).y = 0: Star(s).x = INT(RND * 320)
                PSET (Star(s).x, Star(s).y), 22 + Star(s).Yspeed
        NEXT
                SELECT CASE RIGHT$(a$, 1)
                CASE "H"
                        Hero.Yspeed = Hero.Yspeed - 1
                CASE "P"
                        Hero.Yspeed = Hero.Yspeed + 1
                CASE "K"
                        Hero.Xspeed = Hero.Xspeed - 1
                CASE "M"
                        Hero.Xspeed = Hero.Xspeed + 1
                END SELECT
        IF Hero.Xspeed > 5 THEN Hero.Xspeed = 5
        IF Hero.Yspeed > 5 THEN Hero.Yspeed = 5
        IF Hero.Xspeed < -5 THEN Hero.Xspeed = -5
        IF Hero.Yspeed < -5 THEN Hero.Yspeed = -5
       
        PUT (Hero.x, Hero.y), ship2
        Hero.x = Hero.x + Hero.Xspeed
        Hero.y = Hero.y + Hero.Yspeed
        IF Hero.x < 0 THEN Hero.x = 0: Hero.Xspeed = -Hero.Xspeed
        IF Hero.y < 50 THEN Hero.y = 50: Hero.Yspeed = -Hero.Yspeed
        IF Hero.x > 320 - 40 THEN Hero.x = 320 - 40: Hero.Xspeed = -Hero.Xspeed
        IF Hero.y > 200 - 40 THEN Hero.y = 200 - 40: Hero.Yspeed = -Hero.Yspeed
                FOR r = 1 TO 5
                        Ring(r).y = Ring(r).y + 1
                        IF Ring(r).y = 200 THEN Ring(r).y = -40 - INT(RND * 320): Ring(r).x = INT(RND * 256): Ring(r).Active = 1
                        PUT (Ring(r).x, Ring(r).y), Ringbottom
                NEXT

        PUT (Hero.x, Hero.y), ship
                FOR r = 1 TO 5
                        PUT (Ring(r).x, Ring(r).y), Ringtop
        coll = 0
        IF Ring(r).Active = 1 THEN coll = coll + 1
        IF Hero.x + 40 > Ring(r).x AND Hero.x < Ring(r).x + 64 THEN coll = coll + 1
        IF Hero.y + 32 > Ring(r).y AND Hero.y < Ring(r).y - 5 THEN coll = coll + 1
        IF coll = 3 THEN
                 Ring(r).Active = 0
                 score = score + 10
        END IF
                NEXT
        delay 1
        LOOP UNTIL a$ = CHR$(27) OR timing <= 0
        CLS
        SCREEN 0
        WIDTH 80, 25
        COLOR 15
        PRINT "FINAL SCORE" + STR$(score)
        PRINT "By Pyrodap"
        PRINT "Uses SuperPut by Plasma"
0 DATA "0 0 0"
1 DATA "0 0 42"
2 DATA "0 42 0"
3 DATA "0 42 42"
4 DATA "42 0 0"
5 DATA "42 0 42"
6 DATA "42 21 0"
7 DATA "42 42 42"
8 DATA "21 21 21"
9 DATA "21 21 63"
10 DATA "21 63 21"
11 DATA "21 63 63"
12 DATA "63 21 21"
13 DATA "63 21 63"
14 DATA "63 63 21"
15 DATA "63 63 63"
16 DATA "0 0 0"
17 DATA "5 5 5"
18 DATA "8 8 8"
19 DATA "11 11 11"
20 DATA "14 14 14"
21 DATA "17 17 17"
22 DATA "20 20 20"
23 DATA "24 24 24"
24 DATA "28 28 28"
25 DATA "32 32 32"
26 DATA "36 36 36"
27 DATA "40 40 40"
28 DATA "45 45 45"
29 DATA "50 50 50"
30 DATA "56 56 56"
31 DATA "63 63 63"
32 DATA "0 0 0"
33 DATA "4 0 0"
34 DATA "8 0 0"
35 DATA "12 0 0"
36 DATA "16 0 0"
37 DATA "21 0 0"
38 DATA "25 0 0"
39 DATA "29 0 0"
40 DATA "33 0 0"
41 DATA "37 0 0"
42 DATA "42 0 0"
43 DATA "46 0 0"
44 DATA "50 0 0"
45 DATA "54 0 0"
46 DATA "58 0 0"
47 DATA "63 0 0"
48 DATA "0 0 0"
49 DATA "0 0 4"
50 DATA "0 0 8"
51 DATA "0 0 12"
52 DATA "0 0 16"
53 DATA "0 0 21"
54 DATA "0 0 25"
55 DATA "0 0 29"
56 DATA "0 0 33"
57 DATA "0 0 37"
58 DATA "0 0 42"
59 DATA "0 0 46"
60 DATA "0 0 50"
61 DATA "0 0 54"
62 DATA "0 0 58"
63 DATA "0 0 63"
64 DATA "0 0 0"
65 DATA "0 4 0"
66 DATA "0 8 0"
67 DATA "0 12 0"
68 DATA "0 16 0"
69 DATA "0 21 0"
70 DATA "0 25 0"
71 DATA "0 29 0"
72 DATA "0 33 0"
73 DATA "0 37 0"
74 DATA "0 42 0"
75 DATA "0 46 0"
76 DATA "0 50 0"
77 DATA "0 54 0"
78 DATA "0 58 0"
79 DATA "0 63 0"
80 DATA "0 0 0"
81 DATA "4 0 4"
82 DATA "8 0 8"
83 DATA "12 0 12"
84 DATA "16 0 16"
85 DATA "21 0 21"
86 DATA "25 0 25"
87 DATA "29 0 29"
88 DATA "33 0 33"
89 DATA "37 0 37"
90 DATA "42 0 42"
91 DATA "46 0 46"
92 DATA "50 0 50"
93 DATA "54 0 54"
94 DATA "58 0 58"
95 DATA "63 0 63"
96 DATA "0 0 0"
97 DATA "0 4 4"
98 DATA "0 8 8"
99 DATA "0 12 12"
100 DATA "0 16 16"
101 DATA "0 21 21"
102 DATA "0 25 25"
103 DATA "0 29 29"
104 DATA "0 33 33"
105 DATA "0 37 37"
106 DATA "0 42 42"
107 DATA "0 46 46"
108 DATA "0 50 50"
109 DATA "0 54 54"
110 DATA "0 58 58"
111 DATA "0 63 63"
112 DATA "0 0 0"
113 DATA "4 4 0"
114 DATA "8 8 0"
115 DATA "12 12 0"
116 DATA "16 16 0"
117 DATA "21 21 0"
118 DATA "25 25 0"
119 DATA "29 29 0"
120 DATA "33 33 0"
121 DATA "37 37 0"
122 DATA "42 42 0"
123 DATA "46 46 0"
124 DATA "50 50 0"
125 DATA "54 54 0"
126 DATA "58 58 0"
127 DATA "63 63 0"
128 DATA "0 0 0"
129 DATA "4 2 0"
130 DATA "8 4 0"
131 DATA "12 6 0"
132 DATA "16 8 0"
133 DATA "21 10 0"
134 DATA "25 12 0"
135 DATA "29 14 0"
136 DATA "33 17 0"
137 DATA "37 19 0"
138 DATA "42 21 0"
139 DATA "46 23 0"
140 DATA "50 25 0"
141 DATA "54 27 0"
142 DATA "58 29 0"
143 DATA "63 32 0"
144 DATA "0 0 0"
145 DATA "4 0 2"
146 DATA "8 0 4"
147 DATA "12 0 6"
148 DATA "16 0 8"
149 DATA "21 0 10"
150 DATA "25 0 12"
151 DATA "29 0 14"
152 DATA "33 0 17"
153 DATA "37 0 19"
154 DATA "42 0 21"
155 DATA "46 0 23"
156 DATA "50 0 25"
157 DATA "54 0 27"
158 DATA "58 0 29"
159 DATA "63 0 32"
160 DATA "0 0 0"
161 DATA "0 2 4"
162 DATA "0 4 8"
163 DATA "0 6 12"
164 DATA "0 8 16"
165 DATA "0 10 21"
166 DATA "0 12 25"
167 DATA "0 14 29"
168 DATA "0 17 33"
169 DATA "0 19 37"
170 DATA "0 21 42"
171 DATA "0 23 46"
172 DATA "0 25 50"
173 DATA "0 27 54"
174 DATA "0 29 58"
175 DATA "0 32 63"
176 DATA "0 0 0"
177 DATA "4 3 2"
178 DATA "8 6 4"
179 DATA "12 9 6"
180 DATA "16 12 8"
181 DATA "21 16 10"
182 DATA "25 19 12"
183 DATA "29 22 14"
184 DATA "33 25 17"
185 DATA "37 28 19"
186 DATA "42 32 21"
187 DATA "46 35 23"
188 DATA "50 38 25"
189 DATA "54 41 27"
190 DATA "58 44 29"
191 DATA "63 48 32"
192 DATA "0 0 0"
193 DATA "4 2 2"
194 DATA "8 4 4"
195 DATA "12 6 6"
196 DATA "16 8 8"
197 DATA "21 10 10"
198 DATA "25 12 12"
199 DATA "29 14 14"
200 DATA "33 17 17"
201 DATA "37 19 19"
202 DATA "42 21 21"
203 DATA "46 23 23"
204 DATA "50 25 25"
205 DATA "54 27 27"
206 DATA "58 29 29"
207 DATA "63 32 32"
208 DATA "0 0 0"
209 DATA "3 2 0"
210 DATA "6 4 0"
211 DATA "9 6 0"
212 DATA "12 8 0"
213 DATA "15 10 0"
214 DATA "18 12 0"
215 DATA "21 14 0"
216 DATA "24 17 0"
217 DATA "27 19 0"
218 DATA "30 21 0"
219 DATA "33 23 0"
220 DATA "36 25 0"
221 DATA "39 27 0"
222 DATA "42 29 0"
223 DATA "46 32 0"
224 DATA "0 0 0"
225 DATA "0 0 0"
226 DATA "0 0 0"
227 DATA "0 0 0"
228 DATA "0 0 0"
229 DATA "0 0 0"
230 DATA "0 0 0"
231 DATA "0 0 0"
232 DATA "0 0 0"
233 DATA "0 0 0"
234 DATA "0 0 0"
235 DATA "0 0 0"
236 DATA "0 0 0"
237 DATA "0 0 0"
238 DATA "0 0 0"
239 DATA "0 0 0"
240 DATA "32 0 0"
241 DATA "34 4 0"
242 DATA "36 8 0"
243 DATA "38 12 0"
244 DATA "40 16 0"
245 DATA "42 21 0"
246 DATA "44 25 0"
247 DATA "46 29 0"
248 DATA "48 33 0"
249 DATA "50 37 0"
250 DATA "52 42 0"
251 DATA "54 46 0"
252 DATA "56 50 0"
253 DATA "58 54 0"
254 DATA "60 58 0"
255 DATA "63 63 0"
ShipData:
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,16,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,16,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,16,16,16,16,0,0,0,0,0,0,0,16,16,16,16,16,16,0,0,0,0,0,0,0,16,16,16,16,0,0,0,0,0,0
DATA 0,0,0,0,0,16,17,16,0,0,0,0,0,0,0,0,16,17,17,17,17,17,17,16,0,0,0,0,0,0,0,0,16,17,16,0,0,0,0,0
DATA 0,0,0,0,16,17,17,16,0,0,0,0,0,0,0,16,17,19,19,19,19,19,19,17,16,0,0,0,0,0,0,0,16,17,17,16,0,0,0,0
DATA 0,0,16,16,17,17,16,0,0,0,0,0,0,0,0,16,17,19,22,19,19,22,19,17,16,0,0,0,0,0,0,0,0,16,17,17,16,16,0,0
DATA 0,0,16,17,19,17,16,0,0,0,0,0,0,0,0,16,17,19,19,17,17,19,19,17,16,0,0,0,0,0,0,0,0,16,17,19,17,16,0,0
DATA 0,16,17,19,19,17,16,0,0,0,0,0,0,0,0,16,17,19,17,16,16,17,19,17,16,0,0,0,0,0,0,0,0,16,17,19,19,17,16,0
DATA 0,16,17,19,19,17,16,0,0,0,0,0,0,0,0,16,17,17,16,17,17,16,17,17,16,0,0,0,0,0,0,0,0,16,17,19,19,17,16,0
DATA 16,17,19,22,19,17,16,0,0,0,0,0,0,0,0,0,16,17,16,17,17,16,17,16,0,0,0,0,0,0,0,0,0,16,17,19,22,19,17,16
DATA 16,17,19,22,22,19,17,16,0,0,0,0,0,0,0,0,0,16,16,17,17,16,16,0,0,0,0,0,0,0,0,0,16,17,19,22,22,19,17,16
DATA 16,17,19,22,22,19,17,16,0,0,0,0,0,0,0,0,0,0,16,17,17,16,0,0,0,0,0,0,0,0,0,0,16,17,19,22,22,19,17,16
DATA 16,17,19,22,26,22,19,17,16,16,0,0,0,0,0,0,0,0,16,17,17,16,0,0,0,0,0,0,0,0,16,16,17,19,22,26,22,19,17,16
DATA 16,17,19,22,26,26,22,19,17,17,16,16,0,0,0,0,0,0,16,17,17,16,0,0,0,0,0,0,16,16,17,17,19,22,26,26,22,19,17,16
DATA 16,17,19,22,26,28,26,22,19,19,17,17,16,16,16,0,0,0,16,17,17,16,0,0,0,16,16,16,17,17,19,19,22,26,28,26,22,19,17,16
DATA 0,16,17,19,22,26,28,26,22,22,19,19,17,17,17,16,16,16,16,16,16,16,16,16,16,17,17,17,19,19,22,22,26,28,26,22,19,17,16,0
DATA 0,16,17,19,22,26,28,28,26,26,22,22,19,19,19,17,17,17,17,17,17,17,17,17,17,19,19,19,22,22,26,26,28,28,26,22,19,17,16,0
DATA 0,0,16,17,19,22,26,26,28,28,26,26,22,22,22,19,19,19,19,19,19,19,19,19,19,22,22,22,26,26,28,28,26,26,22,19,17,16,0,0
DATA 0,0,16,16,17,19,22,22,26,26,28,28,26,26,26,22,22,22,22,22,22,22,22,22,22,26,26,26,28,28,26,26,22,22,19,17,16,16,0,0
DATA 0,0,0,0,16,17,19,19,22,22,26,26,26,26,28,26,26,26,26,26,26,26,26,26,26,28,26,26,26,26,22,22,19,19,17,16,0,0,0,0
DATA 0,0,0,0,0,16,17,17,19,19,22,22,22,22,26,26,26,26,26,26,26,26,26,26,26,26,22,22,22,22,19,19,17,17,16,0,0,0,0,0
DATA 0,0,0,0,0,0,16,16,17,17,19,19,19,19,22,22,22,22,22,22,22,22,22,22,22,22,19,19,19,19,17,17,16,16,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,16,16,17,17,17,17,19,19,19,19,19,19,19,19,19,19,19,19,17,17,17,17,16,16,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,16,16,16,16,17,17,17,17,17,17,17,17,17,17,17,17,16,16,16,16,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,16,16,16,16,16,16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
RingBottomData:
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 16,117,119,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,119,117,16
DATA 16,117,119,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,119,117,16
DATA 16,117,119,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,119,117,16
DATA 16,117,119,121,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,121,119,117,16
DATA 0,16,117,119,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,119,117,16,0
DATA 0,16,117,119,121,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,121,119,117,16,0
DATA 0,0,16,117,119,121,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,121,119,117,16,0,0
DATA 0,0,16,117,119,121,125,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,125,121,119,117,16,0,0
DATA 0,0,0,16,117,119,121,125,121,119,117,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,117,119,121,125,121,119,117,16,0,0,0
DATA 0,0,0,0,16,117,119,121,125,121,119,117,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,117,119,121,125,121,119,117,16,0,0,0,0
DATA 0,0,0,0,16,16,117,119,121,121,121,119,119,117,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,117,119,119,121,121,121,119,117,16,16,0,0,0,0
DATA 0,0,0,0,0,0,16,117,119,119,121,121,121,119,117,117,117,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,117,117,117,119,121,121,121,119,119,117,16,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,16,117,117,119,119,121,121,119,119,119,117,117,117,16,16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,16,16,117,117,117,119,119,119,121,121,119,119,117,117,16,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,16,16,117,117,119,119,121,121,121,119,119,119,117,117,117,117,117,16,16,16,16,16,16,16,16,16,16,16,16,16,16,117,117,117,117,117,119,119,119,121,121,121,119,119,117,117,16,16,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,16,16,117,117,119,119,121,121,121,121,119,119,119,119,119,117,117,117,117,117,117,117,117,117,117,117,117,117,117,119,119,119,119,119,121,121,121,121,119,119,117,117,16,16,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,16,16,117,117,119,119,119,119,121,121,121,121,121,119,119,119,119,119,119,119,119,119,119,119,119,119,119,121,121,121,121,121,119,119,119,119,117,117,16,16,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,117,117,117,117,119,119,119,119,121,121,121,121,121,121,121,121,121,121,121,121,121,121,121,121,119,119,119,119,117,117,117,117,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,16,117,117,117,117,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,117,117,117,117,16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,16,117,117,117,117,117,117,117,117,117,117,117,117,117,117,117,117,16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
RingTopData:
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,16,117,117,117,117,117,117,117,117,117,117,117,117,117,117,117,117,16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,16,117,117,117,117,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,117,117,117,117,16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,117,117,117,117,119,119,119,119,121,121,121,121,121,121,121,121,121,121,121,121,121,121,121,121,119,119,119,119,117,117,117,117,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,16,16,117,117,119,119,119,119,121,121,121,121,121,119,119,119,119,119,119,119,119,119,119,119,119,119,119,121,121,121,121,121,119,119,119,119,117,117,16,16,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,16,16,117,117,119,119,121,121,121,121,119,119,119,119,119,117,117,117,117,117,117,117,117,117,117,117,117,117,117,119,119,119,119,119,121,121,121,121,119,119,117,117,16,16,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,16,16,117,117,119,119,121,121,121,119,119,119,117,117,117,117,117,16,16,16,16,16,16,16,16,16,16,16,16,16,16,117,117,117,117,117,119,119,119,121,121,121,119,119,117,117,16,16,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,16,117,117,119,119,121,121,119,119,119,117,117,117,16,16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,16,16,117,117,117,119,119,119,121,121,119,119,117,117,16,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,16,117,119,119,121,121,121,119,117,117,117,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,117,117,117,119,121,121,121,119,119,117,16,0,0,0,0,0,0
DATA 0,0,0,0,16,16,117,119,121,121,121,119,119,117,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,117,119,119,121,121,121,119,117,16,16,0,0,0,0
DATA 0,0,0,0,16,117,119,121,125,121,119,117,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,117,119,121,125,121,119,117,16,0,0,0,0
DATA 0,0,0,16,117,119,121,125,121,119,117,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,117,119,121,125,121,119,117,16,0,0,0
DATA 0,0,16,117,119,121,125,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,125,121,119,117,16,0,0
DATA 0,0,16,117,119,121,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,121,119,117,16,0,0
DATA 0,16,117,119,121,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,121,119,117,16,0
DATA 0,16,117,119,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,119,117,16,0
DATA 16,117,119,121,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,121,119,117,16
DATA 16,117,119,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,119,117,16
DATA 16,117,119,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,119,117,16
DATA 16,117,119,121,119,117,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,117,119,121,119,117,16
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

SUB delay (d)
        FOR x = 1 TO d
WAIT &H3DA, 8
        NEXT
END SUB

SUB init
superput
loadpaldata
        FOR y = 1 TO 32
       FOR x = 1 TO 40
       READ col
       PSET (x, y), col
       NEXT
        NEXT
GET (0, 0)-(39, 31), ship
        RESTORE ShipData
        FOR y = 1 TO 32
       FOR x = 1 TO 40
       READ col
       IF col <> 0 THEN PSET (x, y), 16
       NEXT
        NEXT
GET (0, 0)-(39, 31), ship2
       
        FOR y = 1 TO 40
       FOR x = 1 TO 64
       READ col
       PSET (x, y), col
       NEXT
        NEXT
GET (0, 0)-(63, 39), Ringbottom
        FOR y = 1 TO 40
       FOR x = 1 TO 64
       READ col
       PSET (x, y), col
       NEXT
        NEXT
GET (0, 0)-(63, 39), Ringtop
CLS
        FOR s = 1 TO 50
                Star(s).x = INT(RND * 320)
                Star(s).y = INT(RND * 200)
                Star(s).Yspeed = INT(RND * 10) + 1
        NEXT
               
                FOR r = 1 TO 5
                        Ring(r).y = -40 - INT(RND * 320)
                        Ring(r).x = INT(RND * 256)
                        Ring(r).Active = 1
                NEXT
Hero.x = (320 \ 2) - (40 \ 2)
Hero.y = 200 - 32
END SUB

SUB loadpaldata
OUT &H3C8, 0
                        FOR t = 0 TO 255
                READ temp$
                FOR i = 1 TO LEN(temp$)
IF ASC(MID$(temp$, i, 1)) = 32 THEN
        Red$ = MID$(temp$, 1, i - 1)
        temp$ = RIGHT$(temp$, LEN(temp$) - i)
        EXIT FOR
END IF
                NEXT
             
                FOR i = 1 TO LEN(temp$)
IF ASC(MID$(temp$, i, 1)) = 32 THEN
        Blue$ = MID$(temp$, 1, i - 1)
        temp$ = RIGHT$(temp$, LEN(temp$) - i)
        EXIT FOR
END IF
                NEXT
Green$ = temp$

OUT &H3C9, VAL(Red$)
OUT &H3C9, VAL(Green$)
OUT &H3C9, VAL(Blue$)
                        NEXT t


END SUB

DEFINT A-Z
SUB superput STATIC
  IF NOT Loaded THEN
    SCREEN 13
    PSET (160, 100), 0

    DefSeg& = VARSEG(DefSeg$)
    DEF SEG = DefSeg&
    FOR i = 0 TO &H7FFC
      IF PEEK(i) = &HA0 AND PEEK(i + 1) = &H7D THEN
      IF PEEK(i + 2) = &H0 AND PEEK(i + 3) = &HA0 THEN
        VideoSegOff = i + 2
        EXIT FOR
      END IF
      END IF
    NEXT

    IF i = &H7FFD THEN
      SCREEN 0
      WIDTH 80, 25
      PRINT "SuperPut Error: Cannot find video segment offset."
      PRINT "Check to make sure you are using a compatible version of QB."
      END
    END IF
   
    PutSeg& = DefSeg& - &H400
    DO WHILE PutSeg& > 0
      DEF SEG = PutSeg&
      FOR i = 0 TO &H3FF4
        IF PEEK(i) = &HC4 AND PEEK(i + 1) = &H5E AND PEEK(i + 2) = &HA THEN
        IF PEEK(i + 3) = &H8C AND PEEK(i + 4) = &HC1 AND PEEK(i + 5) = &H41 THEN
        IF PEEK(i + 6) = &HE2 AND PEEK(i + 7) = &H5 AND PEEK(i + 8) = &H8B THEN
        IF PEEK(i + 9) = &H5E AND PEEK(i + 10) = &H8 AND PEEK(i + 11) = &HC4 THEN
        IF PEEK(i + 12) = &H1F THEN
          PutOff = i
          PutSeg& = PutSeg& - 1
          EXIT DO
        END IF
        END IF
        END IF
        END IF
        END IF
      NEXT
      PutSeg& = PutSeg& - &H3FF
    LOOP

    IF i = &H3FF5 THEN
      SCREEN 0
      WIDTH 80, 25
      PRINT "SuperPut Error: Cannot find QB's B$GPUT routine."
      PRINT "Check to make sure you are using a compatible version of QB"
      PRINT "and have compiled your program as a stand-alone EXE."
      END
    END IF
    NewPut$ = "8B1CC1EB032E891E36022E891E3C028B54022E891638022E89163E022EC706"
    NewPut$ = NewPut$ + "340200002EC7063A0200002EC706400200002EC706420200002E"
    NewPut$ = NewPut$ + "C706460200002EC7064402000083C6048B460A3D3F010F8F8C00"
    NewPut$ = NewPut$ + "3D00000F8CA6008B4E0881F9C7007F7C83F9000F8CAB0003D881"
    NewPut$ = NewPut$ + "FB3F010F8FB7002BD803D181FAC7000F8FC1002BD12E891E3602"
    NewPut$ = NewPut$ + "86E9BB40018BF92E2B1E3602C1EF0203F92E891E3A0203F8837E"
    NewPut$ = NewPut$ + "06020F84B700837E06000F84DF00837E06010F842601837E0603"
    NewPut$ = NewPut$ + "742A2E8B1E36028BCB8A04460AC07403268805474975F22E033E"
    NewPut$ = NewPut$ + "3A022E033634024A75E31F075F5E5DCA0800FC2E8B1E36028BCB"
    NewPut$ = NewPut$ + "F3A42E033E3A022E033634024A75EFEBDFF7D82BD87ED903F02E"
    NewPut$ = NewPut$ + "A334022EA3440233C0E945FFF7D92BD17EC42E890E40022E0336"
    NewPut$ = NewPut$ + "36024975F8E93FFF81EB40012E011E34022E891E4202BB40012B"
    NewPut$ = NewPut$ + "D8E935FF03CA81E9C8002BD12E8B0E3E022E890E46022E291646"
    NewPut$ = NewPut$ + "028B4E08E924FF2E033642022E8B0E36028BD94B2E2B1E44028A"
    NewPut$ = NewPut$ + "000AC07403268805474B4975F22E033E3A022E03363C024A75D8"
    NewPut$ = NewPut$ + "E951FFB940018BDA4B0FAFCB03F92E8B0E3C022E8B1E40020FAF"
    NewPut$ = NewPut$ + "CB2BF12EA13C022E8B1E46020FAFC303F02E8B0E36028A04460A"
    NewPut$ = NewPut$ + "C07403268805474975F22E2B3E360281EF40012E033634024A75"
    NewPut$ = NewPut$ + "DCE902FF2E8B0E3C028BDA0FAFCB03F14E2E8B0E3C022E8B1E40"
    NewPut$ = NewPut$ + "020FAFCB2BF12EA13C022E8B1E46020FAFC303F02E2B3644022E"
    NewPut$ = NewPut$ + "8B0E36022E2B3644028A044E0AC07403268805474975F22E033E"
    NewPut$ = NewPut$ + "3A022E2B3642024A75DBE9ABFE00000000000000000000000000"
    NewPut$ = NewPut$ + "00000000000000"
    DIM NewPut(LEN(NewPut$) / 2 - 1)
    DEF SEG = VARSEG(NewPut(0))
    FOR i = 1 TO LEN(NewPut$) STEP 2
      POKE (i - 1) / 2, VAL("&H" + MID$(NewPut$, i, 2))
    NEXT
    NewPut$ = ""
  END IF
  DEF SEG = PutSeg&
  IF PEEK(PutOff + &H1D) = &H26 THEN
    POKE PutOff + &H50, PEEK(PutOff + &H2B)
    POKE PutOff + &H51, PEEK(PutOff + &H2C)
    POKE PutOff + &H52, PEEK(PutOff + &H33)
    POKE PutOff + &H53, PEEK(PutOff + &H34)
    POKE PutOff + &H54, PEEK(PutOff + &H38)
    POKE PutOff + &H55, PEEK(PutOff + &H39)
  END IF
  POKE PutOff + &H1D, &H1E
  POKE PutOff + &H1E, &HA1
  POKE PutOff + &H1F, PEEK(PutOff + &H42)
  POKE PutOff + &H20, PEEK(PutOff + &H43)
  POKE PutOff + &H21, &H89
  POKE PutOff + &H22, &H46
  POKE PutOff + &H23, &H8
  POKE PutOff + &H24, &HA1
  POKE PutOff + &H25, PEEK(PutOff + &H54)
  POKE PutOff + &H26, PEEK(PutOff + &H55)
  POKE PutOff + &H27, &H89
  POKE PutOff + &H28, &H46
  POKE PutOff + &H29, &HA
  POKE PutOff + &H2A, &H89
  POKE PutOff + &H2B, &HDE
  POKE PutOff + &H2C, &H8C
  POKE PutOff + &H2D, &HC3
  POKE PutOff + &H2E, &H8E
  POKE PutOff + &H2F, &HDB
  POKE PutOff + &H30, &HBB
  POKE PutOff + &H31, DefSeg& AND &HFF
  POKE PutOff + &H32, (DefSeg& AND &HFF00&) \ &H100
  POKE PutOff + &H33, &H8E
  POKE PutOff + &H34, &HC3
  POKE PutOff + &H35, &H26
  POKE PutOff + &H36, &H8B
  POKE PutOff + &H37, &H1E
  POKE PutOff + &H38, VideoSegOff AND &HFF
  POKE PutOff + &H39, (VideoSegOff AND &HFF00&) \ &H100
  POKE PutOff + &H3A, &H8E
  POKE PutOff + &H3B, &HC3
  POKE PutOff + &H3C, &HEA
  POKE PutOff + &H3D, &H0
  POKE PutOff + &H3E, &H0
  POKE PutOff + &H3F, VARSEG(NewPut(0)) AND &HFF
  POKE PutOff + &H40, (VARSEG(NewPut(0)) AND &HFF00&) \ &H100

  Loaded = -1

END SUB

SUB SuperPutRemove STATIC
  IF PutSeg& = 0 THEN   'First time? If so, we have to find B$GPUT.
    PutSeg& = VARSEG(DefSeg$) - &H400
    DO WHILE PutSeg& > 0
      DEF SEG = PutSeg&
      FOR i = 0 TO &H3FF4
        IF PEEK(i) = &HC4 AND PEEK(i + 1) = &H5E AND PEEK(i + 2) = &HA THEN
        IF PEEK(i + 3) = &H8C AND PEEK(i + 4) = &HC1 AND PEEK(i + 5) = &H41 THEN
        IF PEEK(i + 6) = &HE2 AND PEEK(i + 7) = &H5 AND PEEK(i + 8) = &H8B THEN
        IF PEEK(i + 9) = &H5E AND PEEK(i + 10) = &H8 AND PEEK(i + 11) = &HC4 THEN
        IF PEEK(i + 12) = &H1F THEN
          PutOff = i
          PutSeg& = PutSeg& - 1
          EXIT DO
        END IF
        END IF
        END IF
        END IF
        END IF
      NEXT
      PutSeg& = PutSeg& - &H3FF
    LOOP

    IF i = &H3FF5 THEN
      SCREEN 0
      WIDTH 80, 25
      PRINT "SuperPut Error: Cannot find QB's B$GPUT routine."
      PRINT "Check to make sure you are using a compatible version of QB"
      PRINT "and have compiled your program as a stand-alone EXE."
      END
    END IF

  END IF


  DEF SEG = PutSeg&
  IF PEEK(PutOff + &H1D) = &H26 THEN EXIT SUB
  POKE PutOff + &H1D, &H26
  POKE PutOff + &H1E, &H8B
  POKE PutOff + &H1F, &H37
  POKE PutOff + &H20, &H56
  POKE PutOff + &H21, &H26
  POKE PutOff + &H22, &H8B
  POKE PutOff + &H23, &H7F
  POKE PutOff + &H24, &H2
  POKE PutOff + &H25, &H57
  POKE PutOff + &H26, &H83
  POKE PutOff + &H27, &HC3
  POKE PutOff + &H28, &H4
  POKE PutOff + &H29, &H53
  POKE PutOff + &H2A, &HE8
  POKE PutOff + &H2B, PEEK(PutOff + &H50)
  POKE PutOff + &H2C, PEEK(PutOff + &H51)
  POKE PutOff + &H2D, &H93
  POKE PutOff + &H2E, &H96
  POKE PutOff + &H2F, &H99
  POKE PutOff + &H30, &H32
  POKE PutOff + &H31, &HFF
  POKE PutOff + &H32, &HE8
  POKE PutOff + &H33, PEEK(PutOff + &H52)
  POKE PutOff + &H34, PEEK(PutOff + &H53)
  POKE PutOff + &H35, &H48
  POKE PutOff + &H36, &H8B
  POKE PutOff + &H37, &H16
  POKE PutOff + &H38, PEEK(PutOff + &H54)
  POKE PutOff + &H39, PEEK(PutOff + &H55)
  POKE PutOff + &H3A, &H3
  POKE PutOff + &H3B, &HC2
  POKE PutOff + &H3C, &H72
  POKE PutOff + &H3D, &H1B
  POKE PutOff + &H3E, &H8B
  POKE PutOff + &H3F, &HC8
  POKE PutOff + &H40, &H8B
  POKE PutOff + &H50, &H75
  POKE PutOff + &H51, &H4
  POKE PutOff + &H52, &H2B
  POKE PutOff + &H53, &HDF
  POKE PutOff + &H54, &HEB
  POKE PutOff + &H55, &H3

END SUB



Hope this is okay! (And again, sorry for the size)

btw i call it "Flyer.bas"

the object is to get through as many rings as possible in the allotted time. Uhh I know it has ALOT of data statements, the first ones are the palette and the nextones are the sprites.

controls are just arrowkeys...(and esc)


Now to get it down to 9 lines...


Title: 100% QB game
Post by: Spotted Cheetah on March 12, 2004, 05:28:30 AM
This is interesting... I think we should divide this competition into multiple parts since the code above is a very deep use of "undocumented code". I will look around in it.

So there would be the "documented class" where the programmers use only what is displayed in the help, or "easily understandable" code like using up BSAVE's fileformats and things like this. What can be explained in a few words. For example if we GET an image into an integer array, array(0) will store the X dimension, and array(1) will store the Y dimension.

The "undocumented class" will be the others like this SuperPUT routine where you are going very deep in QB. I could not find out if this contains some Assembly code for the first look, if yes, it can not be called 100% QB. But this seems to do something different...

If You are using the basic library and interrupts, You shoul describe each of them what you are using, or give a location where it is written.

FFIX can be used freely, that library's only purpose is to fix a QB bug so the games will run a bit faster if using floating point, and will not freeze the computer.


Title: 100% QB game
Post by: Spotted Cheetah on March 12, 2004, 05:32:46 AM
Yet one more: 100% QB does not mean that You must do it in a single .BAS file. You can use external files if needed. (For example some BMP pictures, or BSAVEd ones, or maps, or anything else)


Title: 100% QB game
Post by: na_th_an on March 12, 2004, 08:37:13 AM
Superput is just like another lib. An assembly coded routine which is not included with QB.

I don't understand these "lib haters", because they hate "some libs" but use another ones.


Title: 100% QB game
Post by: Plasma on March 12, 2004, 10:56:15 AM
Who hates libs?


Title: 100% QB game
Post by: na_th_an on March 12, 2004, 04:32:40 PM
Pure QBers


Title: 100% QB game
Post by: Plasma on March 12, 2004, 05:34:12 PM
And who would that be? Rel? Certainly ain't him. Anybody who's entered one of Toshi's Competitions? Probably not.

The whole "Pure QB" thing is about the challenge, not the hate of libs.


Title: 100% QB game
Post by: Pyrodap on March 12, 2004, 09:42:48 PM
I love libs...

And also, you never send anything about commenting the code. (did you?)

And ALSO, SuperPut isn't a lib! That's like saying if you copied this code:

Code:
SUB Init
SCREEN 13
CLS
PRINT "SCREEN 13 INITIALIZED!"
END SUB


Into your program saying "I used the INIT lib!!"

A lib is a file that you actually say REM $INCLUDE:'Library.bi' so that you can use different functions. All superput does is modifies QB's own put routine. You can copy the program right into QB and it works fine. (You dont even need to "QB /Lqb" it when you start QB)

But other then that, How do you like the game :D


Title: 100% QB game
Post by: na_th_an on March 12, 2004, 10:29:45 PM
Every pack of functions and subroutines is a library.

Superput is not PureQB, that's my only point.

The game was really cool :)


Title: 100% QB game
Post by: Spotted Cheetah on March 13, 2004, 03:34:21 PM
I not hate libs.

But I think if using libs QB can only be called a "code organizer" since the important things are in the libs.

QB.QLB can be used here because it is originally included in the QB4.5 package, and the first version of QB had these routines built in.

FFIX.QLB can be used because it's only a bug fix, not "extra code"

I think programming only in QB is a different art - let's do it :)


Title: 100% QB game
Post by: na_th_an on March 13, 2004, 03:54:08 PM
Okay, but you are wrong on one statement: The first version of QB did not have those routines built in.

Qbasic 1.x is not the first version of QB. Qbasic 1.x came after QB 4.5

Read more here: http://www.download-qb.com ;)

Anyhow, I think differently. To me, a QB game is a game which logic is made in QB. I just use a better PUT routine, for example. My game would run using the normal PUT which is built in, but slower. So esentially, the game is the same, but it runs faster.


Title: 100% QB game
Post by: Spotted Cheetah on March 13, 2004, 04:11:04 PM
If it works fine with pure QB code, and won't need GHzs, You can do it... This is like FFIX.

But if You can not do it without using external routines, You can not say that it is 100% QB...

I thought that the QB included in DOS was first, and only that was improved later... Thanks for the info. But anyway, interrupt handling is built in at a version of QB - so I think it can be used.


Title: 100% QB game
Post by: na_th_an on March 13, 2004, 04:15:23 PM
My principal example is my game "Jill". I coded it in pure QB, using SCREEN 7. It needed a PII 300 Mhz to go at full rate (if there weren't many sprites on screen). When I changed the game to DirectQB (changing the paging routines and the GET/PUT routines) I was able to run the game at full rate in a 486 DX2 66 Mhz, and almost a full rate in a 486 SX.


Title: 100% QB game
Post by: Spotted Cheetah on March 16, 2004, 03:33:04 PM
I think this game is okay for this challenge. P300 - not too high - but should be lower :). But anyway that's good at a QB game.

Here speed counts too :)

I will try to create a scoring system...


Title: Mmm..
Post by: Optimus on March 19, 2004, 11:22:42 AM
I try to use pure Quickbasic when it's about democoding because of the challenge. It doesn't matter for me if games are using libs, as long as they are smooth and funny to play.

I'd like to code a game in pure quickbasic, since the only thing I was doing for years is pure demofx coding and I'd like to try something diferrent now. I have no idea about good keyboard handling (instead of Inkey$, I tried to do it my own way with INP(&H60) but that wasn't working at many cases), I once used mouse (but with CALL INTERRUPT) and it's quite easier than what keyboard could be, I also don't have any idea about timers or music programming. I am wondering how easy or at least possible is to do these with pure quickbasic. I almost have an idea about Adlib music, but keyboard? It's a dream of mine now to have a working keyboard routine now, pure qb or even not!!! =)

But the gfx routines, would be a challenge to be in pure qb. I'd like to take your challenge for enough months, I am not sure about time though. It's a pitty to be working on many other things in the demoscene and not have a time to try some diferrent things I'd love to work on since ages (game, emulator, compiler coding).

Which are the best or most impressive pure quickbasic games anyways? (If there are some good enough) I don't have that much of an idea about the most famous games in the quickbasic scene. I am mostly in demos.. (But lately, enjoyed playing Monospace, Wetspot 2 and others that site suggested)


Title: 100% QB game
Post by: na_th_an on March 19, 2004, 11:52:00 AM
You can do FM music (ADLIB) easily in Pure QB. Check "TRAKKER" here: http://usuarios.lycos.es/qbsux/proggies.html to find out how.

About keyboard handling in pure QB... Yeah, it can be done also. Digging in ABC packets... Yeah:

Code:
'===========================================================================
' Subject: MULTIPLE KEYS                      Date: 03-08-97 (13:07)      
'  Author: Joe Huber, Jr.                     Code: QB, QBasic, PDS        
'  Origin: huberjjr@nicom.com               Packet: KEYBOARD.ABC
'===========================================================================
DECLARE FUNCTION MULTIKEY (KEYNUM)

'MUTIKEY FUNCTION - LETS YOU TRAP SEVERAL KEYS AT ONCE (BETTER THAN INKEY$!!)
'
'USAGE:
'  riable=MULTIKEY(KEYNUM)
'WHERE KEYNUM IS THE KEY YOU WANT TO TRAP
'  riable = 1 IF KEY IS DEPRESSED, 0 IF IT ISN'T
'
'EMAIL ME AT: huberjjr@nicom.com
'
'HAVE FUN!!!


DIM SHARED KEYS(255), SC(255), DU(255)  'ALWAYS NEED THIS!!!

CLS

X = 10: Y = 10
XX = X: YY = Y

DO

'FOR I = 1 TO 255                    '\
' TEST = MULTIKEY(I)                 ' |-TEST LOOP
' LOCATE 1, 1: PRINT TEST; I         ' |
' WHILE INKEY$ = "": WEND            ' | PRESS KEY IN QUESTION UNTIL
'  IF TEST = 1 THEN END              ' | LOOP ENDS. THE SECOND NUMBER IS THE
'NEXT I                              '/  SCAN CODE FOR MULTIKEY

RIGHT = MULTIKEY(75)    ' GET SOME KEYS' STATUSES
LEFT = MULTIKEY(77)
UP = MULTIKEY(72)
DOWN = MULTIKEY(80)
SPACE = MULTIKEY(57)
ESC = MULTIKEY(1)

IF ESC = 1 THEN END    'TEMINATE WHEN ESCAPE IS PRESSED

IF TIMELOOP = 100 THEN             'THIS MOVES YOU AROUND
 IF RIGHT = 1 THEN X = X - 1
 IF LEFT = 1 THEN X = X + 1        'THE TIMELOOP   RIABLE DELAYS
 IF UP = 1 THEN Y = Y - 1          'MOVEMENT WITHOUT SLOWING DOWN
 IF DOWN = 1 THEN Y = Y + 1        'INPUT (WITHOUT IT YOU WOULD GO
 TIMELOOP = 0                      'WAAAAYYY TOO FAST)
END IF

IF X >= 80 THEN X = 80        'KEEPS YOU FROM GOING OFF THE SCREEN AND
IF X <= 0 THEN X = 1          'MAKING AN ERROR
IF Y >= 23 THEN Y = 23
IF Y <= 0 THEN Y = 1


IF SPACE = 1 THEN                    'CHANGES YOUTR SHAPE WHEN
 LOCATE Y, X: PRINT CHR$(94)         'YOU HIT SPACE
ELSE
 LOCATE Y, X: PRINT CHR$(127)
END IF

IF XX <> X OR YY <> Y THEN           'UPDATES YOUR POSITION
 LOCATE YY, XX: PRINT " "
 LOCATE Y, X: PRINT CHR$(127)
END IF


XX = X: YY = Y                     'TELLS ME WHERE I WAS LAST

TIMELOOP = TIMELOOP + 1

LOOP                 'LOOP (DUH...) :)

'THANX TO Eric Carr FOR FIGURING OUT HOW TO TRAP SEVERAL KEYS AT ONCE
'EVERYTHING ELSE WRITTEN BY ME,              

FUNCTION MULTIKEY (KEYNUM)

 STATIC FIRSTIME

 IF FIRSTIME = 0 THEN
  FOR E = 0 TO 127              '\
  SC(E) = E: DU(E) = 1          '|
  NEXT                          '|-ERIC CARR'S CODE--------------------\
  FOR E = 128 TO 255            '|                                     |
  SC(E) = E - 128: DU(E) = 0    '|                                     |
  NEXT                          '/                                     |
  FIRSTIME = -1                 '                                      |
 END IF                         '                                      |
                                '                                      |
 I$ = INKEY$       ' So the keyb buffer don't get full     \routine/ \ |
 I = INP(&H60)     ' Get keyboard scan code from port 60h   \lines/  |-/
 OUT &H61, INP(&H61) OR &H82: OUT &H20, &H20       '         \!!!/   |
 KEYS(SC(I)) = DU(I) ' This says what keys are pressed        \!/    /

MULTIKEY = KEYS(KEYNUM)


END FUNCTION


Good luck!


Title: 100% QB game
Post by: relsoft on March 20, 2004, 06:53:01 AM
Hey!!! you came!!!! So what about "THE" site?

And how's Germany?
 :D


Title: 100% QB game
Post by: Spotted Cheetah on March 20, 2004, 02:34:06 PM
Nice codes :) But let's go back to our subject...

Finally I made the scoring system:

Usual scores:
9 points for graphic
9 points for useability (Keyboard handling, mouse ect)
9 points for sound and music
9 points for story and gameplay (Is interesting?)
5 points for challenge (How hard is the game or how can it be set)
9 points for replay (Will people play it again, or delete)

100% QB scores:
25 points for complexity
25 points for speed

Complexity:
Maximum if only using what is documented in QB
-1 if using up a memory location (like A000), or a built-in fileformat (for each one)
-1 for each port group (For example palette changing takes place on 2 ports)
-10 if using the basic library, -5 for each used interrupt
Using FFIX: You can do it freely, but the scoring will take place on the FFIXless
version of the program.
For example if you have a program using the basic library (-10) for mouse handling
(-5) and using the A000 location (-1), and uses up that the first two byte of GET
stores the X and the Y size of the image (-1), you will get 8 points.

Speed:
The program's speed without any library or assembly speedup
30 points if it runs on the original 4MHz PC
25 points if runs on my 33Mhz computer
After: -5 points for each 33Mhz until 133Mhz
(66Mhz: 20, 100Mhz: 15, 133Mhz: 10)
5 points if needs 200Mhz
0 points if needs 300Mhz or more


This is not the final. You can tell it if You think this is wrong.

On this system an empty program would get 50 points. To prevent this the two part
will be divided, and scored independently. The final score will be the double of
the worse.


Using libs - again: I am upset because of it because they can put up good games, but I can't because I program in C  :???:
This annoys me... Why they can do, but I can't ???

Of course I program in QB too... But if QB then pure QB :)


Title: relsoft
Post by: Optimus on March 25, 2004, 01:31:53 PM
Hey!

I am still too busy :(

I am either trying to study, and if I am bored, then I am coding my 1st demo for C64 instead :)

>And how's Germany?

"Cool" as usual :)

Optimus


Title: na_th_an
Post by: Optimus on March 25, 2004, 01:34:21 PM
Thanks. Keyboard handler seems to be stable enough! I'll have to check it at home oneday more thoroughly.

The adlib tracker is interesting. I think qb democoders will need a tracker and a player in the future..

Optimus


Title: 100% QB game
Post by: Spotted Cheetah on March 27, 2004, 08:23:44 PM
I had played with all of the games... Not much because I had to program (in QB :) ), but now I have got some opinions

Blocks.bas

Interesting Sokoban style game. I slowed down my 4.86 to 4.77MHz XT, and it worked (almost) fine. I did not have to wait long. So it would get 28 or 29 points for speed. (And 30 for pure QB)

Nmaze.bas

Too simple graphic. It could be improved a little (this is not the 1 hour competition). I had seen once a same style but far better game (and I played with it a lot).

Bubble Fight

Very good :) For speed it would get 23 points since it was a bit slow on my 33Mhz 4.86. It works with changing the screen page's offset, this cuts back 1 point in pure QB (29).

Flyer

Bubble Fight is better...

Cheetah Rally

Just for fun, and for once, it would get almost 0 replay value. It was written just for fun. But I think it is possible to make something very good on the text screen.

AdLib tracker

Nice graphic, and nice sounds :) But the mouse is not pure QB  :evil:
But I think it is a very good program.


Title: 100% QB game
Post by: Pyrodap on March 28, 2004, 01:29:28 AM
Quote from: "Spotted Cheetah"
Bubble Fight is better...




Although I agree, that is rather rude.
*mumbles a word that would be bleeped in reference to spotted cheetah. jk!!*


Title: 100% QB game
Post by: Sumo Jo on March 28, 2004, 01:59:42 AM
Quote from: "Pyrodap"

*mumbles a word that would be bleeped in reference to spotted cheetah. jk!!*


watch your mouth!
sucker


Title: 100% QB game
Post by: Pyrodap on March 28, 2004, 03:58:11 AM
Quote from: "sumojo"
sucker


I said I was kidding... (Though it was rude)


Title: 100% QB game
Post by: Spotted Cheetah on March 29, 2004, 01:38:20 PM
I only said what I thought after a little (as I had time) playing with the games. These are only my thoughts, others may score them differently: if You write here what you think, we can talk about it...

AND AT LAST: BE CORRECT HERE!!!
(The poor Hungarian can't talk very well, but knows more than you think. Those tiny lines are more than they look...)

This was not a "fair play"...


Title: 100% QB game
Post by: Pyrodap on March 29, 2004, 04:16:21 PM
Quote from: "I"
I said I was kidding...


Everybody was Kung Fu fighting,
Those kicks were fast as lightning
In fact it was a little bit fright'ning,
But they fought with expert timing.


Title: Try this on for size
Post by: Pc72 on March 29, 2004, 05:27:40 PM
The answer to your prayers:

http://pc72.narod.ru/_BT_v21.zip

It might be ancient, but it's 100% QB, and can even run in QBasic 1.0!!!  You better check this out... I'm serious!

Originally I developed it on a 40 MHz 486DX2 machine. And it worked quite good.


Title: 100% QB game
Post by: Plasma on March 29, 2004, 05:55:50 PM
fyi...BT.EXE in that zipfile is infected with the One Half virus...


Title: 100% QB game
Post by: wizardlife on March 30, 2004, 12:26:16 AM
This challenge came up a while ago, before the hack, and I created a sorta-fun screen 12 game that uses the mouse...

http://www.angelfire.com/wizard/pigeoncarrier/downloads/speed100.zip (right-click-save-as)

There's some nifty palette and layer stuff going on in there, for any interested parties.

EDIT: btw, not to fire off the lib-pqb debate again, but I'll just restate my opinion since everyone else did: I feel that there's nothing fundamentally wrong with using asm libs in QB, it's more just stupid. Why invest the time and bother learning UGL or Rellib calls, only to have your program bogged down by all of QB's overhead? It's like building a car without seats... some of it's there, but for the effort, why not move on to C or Pascal? There you get your fast graphics, plus you get pointers, proper memory access, proper data structures, etc... anyhow whatever.

Mike


Title: 100% QB game
Post by: adosorken on March 30, 2004, 03:24:19 AM
Heh wizardlife, what's to learn about UGL or Rellib? You use one QB lib, you used then all, with exception to UGL, in which case if you've used the GDI or DirectX, you can use UGL...virtually no learning curve for any of them. I tend to personally dislike "pure QB" challenges because they bring out all the l33t-wanabes who talk trash but maybe this one won't for once.

Spotted Cheetah, your English is perfectly understandable. It's not perfect but it's better than that of many of the United States residents here at qbasicnews.com. :)

I don't enter these compos anymore but good luck to anyone who does. And as usual...I agree with na_th_an. :D


Title: 100% QB game
Post by: Spotted Cheetah on March 30, 2004, 06:24:31 AM
Althought the problem is gone, I will write why I thought Bubble Fight better than Flight:

First of all, the ASM routines which I could not put out in the second one. Possibly if I had more time, I could do, but I was not able then.
Then the gameplay. The first thing what I noticed is that Bubble Fight's controls work well in any case, but Flight almost always beeped. And those ASM were not perfect too as it ran slower than Bubble Fight, and the speed was really various depending on the shown circles. The other thing, the spaceship. It was so dark that I could only see the bottom of it, I could only realize that it is bigger when passing in front of a circle. And to get the point, the ship had to touch the upper part of them, not the lover, or being inside it.

So that was why I wrote "Bubble Fight is better..."


I will put up a sprite editor here soon which I am using to make my new game's characters :)


I will look in the new games at weekend... So send them :)
And not only send, write your opinions on the others too. And then score them, to make this a "real" challenge :)


Title: 100% QB game
Post by: Pyrodap on March 30, 2004, 04:51:32 PM
well, although that review was probably a little influenced by this bit of tension between us, thats really all I wanted. If I don't know whats wrong with it, then how will I ever know how to make it better?


Title: BT fixed...
Post by: Pc72 on March 31, 2004, 05:28:36 PM
Yeah... There was a virus all right... I just got AVG today and it started screaming, so I scanned my important files, put them on USB-RAMs and formatted the computer.  I had to activate XP again... But the virus is gone.  At least, AVG says that...  And my web service provider didn't complain about the new file... So you can download it now. As mentioned beforte, it's a 100% QB game WITHOUT any QLBs or ASMs, and it can also run full speed in QBasic 1.1.

http://pc72.narod.ru/_BT_v21.zip


Title: 100% QB game
Post by: Spotted Cheetah on April 02, 2004, 07:28:13 PM
Pyrodrap: No tension. As I said it had gone :)

Probably You could not catch the bugs what I told about because my computer on which I am working is a more than 10 years old 4.86 with 33Mhz CPU. This may explain a few things :). The graphic: I have got an LCD screen (Yes! With the 4.86 :) ). LCD screens usually display dark colors badly so everything below 16 (Colors are 0-63 for R and G and B) will be black like the black hole on that screen.

But this does not mean that You not need to pay attention on these problems! I know that there are not too many people who still use 4.86, but there are more who use LCD screens :)


And (I forgot who wrote it) thanks for my English :)


(I will look in the games tomorrow... I am downloading them now...)


(This evil Win95 had fired me off two times in 30 minutes... ARRRGGHH!!! Here is the tension!)


Title: 100% QB game
Post by: Spotted Cheetah on April 03, 2004, 01:58:23 PM
Review for Project Speed: Microrush

First look at the source:
Project Speed in it's current form is not 100% QB. It uses ASM for
keyboard handling. Hovewer it can be cut out, and replaced to a
pure QB keyboard handler, so it can be reviewed here.

PureQB score: It uses the basic lib (-10) with the mouse interrupt
(-5), the palette - setting (-1) and the refresh rate ports (-1). I
did not count the ASM, I assumed it was cut out.
The score is: 25 - 17 = 9

Speed score: It work on 60 to 75 FPS on my 33MHz 4.86, and I could
slow it down to 20MHz without serious problems. This worths 22 points.

Total PureQB score: 8 + 22 = 30 points

Now the game:

First of all, the graphic. It is really well done. The custom fonts
are a very good idea, however they are a bit small. On the other hand
this makes the game look like using a 800 * 600 or an 1024 * 768 SVGA
mode. It uses 16 colors, but that can not be noticed during playing.
The colors were well chosen, and all the graphic was made to fit well
on these few colors. It more looks like a simple SVGA program rather
than using SCREEN 12. I am using an LCD screen, so I could not annoyed
with 60Hz blinking, but I think there would not be too many blinking
on a normal screen. The dark side of the game is it's simplicity: there
is not too much graphic in it at all.
This all makes 6 points for me.

Now let's try using the game. It is really a pleasure. The menus use
the arrow keys, the game itself combines them with the mouse. At first
this can be a bit strange, but at second it is easy. Well done!
8 points.

Now the sounds. I can not tell too much of it since I could not hear
anything. Nothing means 0 points.

The story of the game is very simple. It looks like created only to
have something as a story. On the other hand the game is an unique
idea: there are not too many games like this one. But at all this
program can not get too much for this. Like Tetris, or chess: only
for playing, not for reading. 4 points (1 / 5 for story, 3 / 4 for
idea).

However the game has not got levels, or difficulty settings, it can
be played by beginners and experts too. Different techniques requie
different skills. You can wait for those creatures on a platform to
put them out, but you can do this on fly as well. If you are able
to keep playing the second way, you will live longer, so you will
collect more points. The game's programming technique is perfect:
for example you will never fall through, or stuck in walls, and the
shoots will really go where you fired them. I think this all worths
2 / 4 (for challenge) + 5 / 5 (for technique) = 7 points.

Finally the replay value. This game is like Invaders. If you enjoyed
it, you will play when you have not got any ideas to do something
else, if not, you will delete it immediately. 2 points.

Total: 6 + 0 + 8 + 4 + 7 + 2 = 27 points.


Final score:
30 points for PureQB
27 points for the game
54% at all!


As you can see, I remade the scoring system here. The new system:
9 + 9 = 18 points for the game's look (visual + sounds)
5 + 5 + 5 + 4 + 4 = 23 points for the game itself
 (replay, story, technique, challenge, idea)
9 points for the game's useability (handling, menu systems ect.)

This way it is totally 50 points so that it can be easily converted to % value.



The other game had a serious bug: More than the half of the generated maps were impossible...

(I did not meant that it is bad at all. I only had to work on the sprite editor that I had no time for an another review)


Title: 100% QB game
Post by: Spotted Cheetah on April 03, 2004, 08:08:44 PM
Long code will come:

The sprite editor is finished :)

Code:

'QBasic Sprite Editor
'Purpose: To create and edit (max. 60*60) sprites for QB games
'Author: "Magyar Nagymacskaegylet" (Hungarian Big Cat Society)
'
'
'File formats:
'
'Ext.   Read/    Description
'       Write
'
'.QBP   RW       BSAVEd 16 color GET/PUT image
'.QBM   RW       BSAVEd Multiple Image Array (Integer array: 0: Number of
'                images, 1-(N.o.i.+1): Offsets - for integer arrays - must
'                be doubled to get byte offsets, (N.o.i.+2)-: 16 color
'                GET/PUT images
'.BAS   W        DATA statements, 0-16 each
'.BAS   W        DATA statements, palette data
'.BMP   R        16 color BitMaP
'
'
'Can be used on Screen 9 or Screen 12. It might be able to create sprites
'for Screen 7 too since the GET/PUT format is compatible, but that screen's
'points differs from both 9 and 12.


DEFINT A-Z
DECLARE SUB palset (cnum AS INTEGER, red AS INTEGER, green AS INTEGER, blue AS INTEGER)
DECLARE SUB palset9 (cnum AS INTEGER, red AS INTEGER, green AS INTEGER, blue AS INTEGER)
DECLARE SUB palsetall (scrn AS INTEGER, cnum AS INTEGER, red AS INTEGER, green AS INTEGER, blue AS INTEGER)
DECLARE FUNCTION loadBMP (x AS INTEGER, y AS INTEGER, pic AS STRING)

'$DYNAMIC
DIM pic(59, 59) AS INTEGER       'Picture data
DIM hugepic(32766) AS INTEGER    'Multiple picture file space
                                 ' Word 0: number of images
                                 ' Word 1 - Word (Word 0) + 1: image offsets
                                 ' Word (Word 0) + 2 -: GET/PUT images
DIM pcstor(2050 - 1) AS INTEGER  'Temporary image (For example to save .QBP)
DIM paldata(48 - 1)              'Palette data
DIM SHARED bmpal(48 - 1)         'Palette data for the BMP loader
DIM SHARED bmpsiz(1)             'Size data for the BMP loader
DIM basfile(20) AS STRING        'Temporary space for processing BAS files
'$STATIC
DIM a AS STRING * 1 'Keyboard input

'Standard palette
'    red,grn,blu
'Palette
DATA 0  ,0  ,0
DATA 0  ,0  ,128
DATA 0  ,128,0
DATA 0  ,128,128
DATA 128,0  ,0
DATA 128,0  ,128
DATA 160,92 ,0
DATA 192,192,192
DATA 128,128,128
DATA 0  ,0  ,255
DATA 0  ,255,0
DATA 0  ,255,255
DATA 255,0  ,0
DATA 255,0  ,255
DATA 255,255,0
DATA 255,255,255

FOR i = 0 TO 47
 READ paldata(i)
NEXT i

SCREEN 9

currscr = 9 'Current screen mode
sizx = 32 'Size of image X
sizy = 32 'Size of image Y
posx = 0 'Cursor position X
posy = 0 'Cursor position Y
posf = 0 'QBM position
posc = -1 'Current picture's QBM position
post = -1 'Temporary position (If user do not want to load the QBM image)
colr = 0 'Current color
redraw = 255 'Redraw state (What to draw again - to be as fast as possible)
contdraw = 0 'Countinous drawing disabled / enabled

DO
 IF posx >= sizx THEN posx = sizx - 1 'Make correct POS after altering img
 IF posy >= sizy THEN posy = sizy - 1 'sizes by setting them or loading

 IF (redraw AND 1) = 1 THEN 'Erase everything
  LINE (0, 0)-(639, 349), 0, BF
  IF currscr = 12 THEN LINE (0, 350)-(639, 479), 0, BF
 END IF

 IF (redraw AND 2) = 2 THEN 'Draw grid
  FOR i = 0 TO sizx
   LINE (i * 5 + 10, 10)-(i * 5 + 10, sizy * 5 + 10), 1
  NEXT i
  FOR i = 0 TO sizy
   LINE (10, i * 5 + 10)-(sizx * 5 + 10, i * 5 + 10), 1
  NEXT i
  LINE (posx * 5 + 10, posy * 5 + 10)-(posx * 5 + 15, posy * 5 + 15), 2, B
 END IF

 IF (redraw AND 32) = 32 THEN 'Draw lines around current pos
  IF posx > 0 THEN LINE (posx * 5 + 5, posy * 5 + 10)-(posx * 5 + 10, posy * 5 + 15), 1, B
  IF posx < sizx - 1 THEN LINE (posx * 5 + 15, posy * 5 + 10)-(posx * 5 + 20, posy * 5 + 15), 1, B
  IF posy > 0 THEN LINE (posx * 5 + 10, posy * 5 + 5)-(posx * 5 + 15, posy * 5 + 10), 1, B
  IF posy < sizy - 1 THEN LINE (posx * 5 + 10, posy * 5 + 15)-(posx * 5 + 15, posy * 5 + 20), 1, B
  LINE (posx * 5 + 10, posy * 5 + 10)-(posx * 5 + 15, posy * 5 + 15), 2, B
 END IF

 IF (redraw AND 64) = 64 THEN 'Draw points around current pos
  IF posx > 0 THEN
   LINE (posx * 5 + 6, posy * 5 + 11)-(posx * 5 + 9, posy * 5 + 14), pic(posx - 1, posy), BF
   PSET (posx + 329, posy + 10), pic(posx - 1, posy)
  END IF
  IF posx < sizx - 1 THEN
   LINE (posx * 5 + 16, posy * 5 + 11)-(posx * 5 + 19, posy * 5 + 14), pic(posx + 1, posy), BF
   PSET (posx + 331, posy + 10), pic(posx + 1, posy)
  END IF
  IF posy > 0 THEN
   LINE (posx * 5 + 11, posy * 5 + 6)-(posx * 5 + 14, posy * 5 + 9), pic(posx, posy - 1), BF
   PSET (posx + 330, posy + 9), pic(posx, posy - 1)
  END IF
  IF posy < sizy - 1 THEN
   LINE (posx * 5 + 11, posy * 5 + 16)-(posx * 5 + 14, posy * 5 + 19), pic(posx, posy + 1), BF
   PSET (posx + 330, posy + 11), pic(posx, posy + 1)
  END IF
  LINE (posx * 5 + 11, posy * 5 + 11)-(posx * 5 + 14, posy * 5 + 14), pic(posx, posy), BF
  PSET (posx + 330, posy + 10), pic(posx, posy)
 END IF


 IF (redraw AND 4) = 4 THEN 'Draw the whole image
  FOR i = 0 TO sizx - 1
   FOR j = 0 TO sizy - 1
    LINE (i * 5 + 11, j * 5 + 11)-(i * 5 + 14, j * 5 + 14), pic(i, j), BF
    PSET (i + 330, j + 10), pic(i, j)
   NEXT j
  NEXT i
 END IF

 IF (redraw AND 8) = 8 THEN 'Draw texts & prev and next QBM if any
  COLOR 7
 
  IF posc > 0 THEN 'Previous and next image in QBM
   LOCATE 7, 43
   PRINT "Prev"
   IF currscr = 9 THEN PUT (330, 100), hugepic(hugepic(posc)), PSET
   IF currscr = 12 THEN PUT (330, 113), hugepic(hugepic(posc)), PSET
  END IF
  IF posc < hugepic(0) - 1 AND posc > 0 THEN
   LOCATE 13, 43
   PRINT "Next"
   IF currscr = 9 THEN PUT (330, 184), hugepic(hugepic(posc + 2)), PSET
   IF currscr = 12 THEN PUT (330, 210), hugepic(hugepic(posc + 2)), PSET
  END IF
 
  LOCATE 2, 50
  PRINT "8 6 2 4 -> Move cursor"
  LOCATE 3, 50
  PRINT "5 q     -> Plot pixel"
  LOCATE 4, 50
  PRINT "w 1     -> Erase pixel (col 0)"
  LOCATE 5, 50
  IF contdraw = 1 THEN COLOR 6
  PRINT "e 3     -> Draw countinously"
  COLOR 7
  LOCATE 8, 50
  PRINT "d f     -> Change x/y size"
  LOCATE 7, 50
  PRINT "a s 7 9 -> Change color"
  LOCATE 9, 50
  PRINT "p       -> Change palette"
  LOCATE 10, 50
  PRINT "o l     -> Load / save palette"
  LOCATE 12, 50
  PRINT "i k     -> Load / save picture"
  LOCATE 14, 50
  PRINT "x       -> Exit"
  LOCATE 18, 50
  PRINT "h m n b -> Move picture"
  LOCATE 19, 50
  PRINT "v c     -> Mirror x, y"
  LOCATE 21, 50
  PRINT "0       -> Multi image files..."
  LOCATE 23, 50
  PRINT "t       -> Special..."
 END IF
 COLOR 4
 LOCATE 16, 50
 PRINT "("; sizx; "/"; posx; ":"; sizy; "/"; posy; ")  "
 COLOR 7

 IF (redraw AND 16) = 16 THEN 'Draw color palette
  LINE (9, 329)-(181, 341), 0, BF
  FOR i = 0 TO 15
   LINE (i * 10 + 10, 330)-(i * 10 + 19, 339), i, BF
  NEXT i
  LINE (colr * 10 + 9, 329)-(colr * 10 + 20, 340), 3, B
 END IF



 a = LCASE$(INPUT$(1))
 redraw = 0



 SELECT CASE a
 
  CASE "8"
   IF posy > 0 THEN posy = posy - 1
   redraw = redraw OR 32
   IF contdraw = 1 THEN
    redraw = redraw OR 64
    pic(posx, posy) = colr
   END IF
 
  CASE "2"
   IF posy < sizy - 1 THEN posy = posy + 1
   redraw = redraw OR 32
   IF contdraw = 1 THEN
    redraw = redraw OR 64
    pic(posx, posy) = colr
   END IF
 
  CASE "4"
   IF posx > 0 THEN posx = posx - 1
   redraw = redraw OR 32
   IF contdraw = 1 THEN
    redraw = redraw OR 64
    pic(posx, posy) = colr
   END IF
 
  CASE "6"
   IF posx < sizx - 1 THEN posx = posx + 1
   redraw = redraw OR 32
   IF contdraw = 1 THEN
    redraw = redraw OR 64
    pic(posx, posy) = colr
   END IF
 
  CASE "5", "q"
   pic(posx, posy) = colr
   redraw = redraw OR 64
 
  CASE "w", "1"
   pic(posx, posy) = 0
   redraw = redraw OR 64
 
  CASE "e", "3"
   IF contdraw = 0 THEN contdraw = 1 ELSE contdraw = 0
   pic(posx, posy) = colr
   redraw = (redraw OR 64) OR 8
 
  CASE "a", "7"
   IF colr > 0 THEN
    colr = colr - 1
    redraw = redraw OR 16
    IF contdraw = 1 THEN
     pic(posx, posy) = colr
     redraw = redraw OR 64
    END IF
   END IF
 
  CASE "s", "9"
   IF colr < 15 THEN
    colr = colr + 1
    redraw = redraw OR 16
    IF contdraw = 1 THEN
     pic(posx, posy) = colr
     redraw = redraw OR 64
    END IF
   END IF
 
 
  CASE "d"
   redraw = 255
   COLOR 7
   LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴ż"
   LOCATE 3, 2: PRINT "ł                    ł"
   LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴Ů"
   LOCATE 3, 4
   INPUT "New X size:", s$
   IF s$ <> "" THEN
    sizx = VAL(s$)
    IF sizx < 1 THEN sizx = 1
    IF sizx > 60 THEN sizx = 60
   END IF
 
  CASE "f"
   redraw = 255
   COLOR 7
   LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴ż"
   LOCATE 3, 2: PRINT "ł                    ł"
   LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴Ů"
   LOCATE 3, 4
   INPUT "New Y size:", s$
   IF s$ <> "" THEN
    sizy = VAL(s$)
    IF sizy < 1 THEN sizy = 1
    IF sizy > 60 THEN sizy = 60
   END IF
 
 
  CASE "p"
   redraw = 255
   COLOR 7
   LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
   LOCATE 3, 2: PRINT "ł                        ł"
   LOCATE 4, 2: PRINT "ł                        ł"
   LOCATE 5, 2: PRINT "ł                        ł"
   LOCATE 6, 2: PRINT "ł                        ł"
   LOCATE 7, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
   LOCATE 3, 4: PRINT "red  :"; paldata(colr * 3)
   LOCATE 4, 4: PRINT "green:"; paldata(colr * 3 + 1)
   LOCATE 5, 4: PRINT "blue :"; paldata(colr * 3 + 2)
   FOR i = 0 TO 2
    LOCATE 6, 4
    PRINT "                       "
    LOCATE 6, 4
    IF i = 0 THEN INPUT "New RED value:", s$
    IF i = 1 THEN INPUT "New GREEN value:", s$
    IF i = 2 THEN INPUT "New BLUE value:", s$
    IF s$ <> "" THEN
     paldata(colr * 3 + i) = VAL(s$)
     IF paldata(colr * 3 + i) < 0 THEN paldata(colr * 3 + i) = 0
     IF paldata(colr * 3 + i) > 255 THEN paldata(colr * 3 + i) = 255
    END IF
   NEXT i
   palsetall currscr, colr, paldata(colr * 3), paldata(colr * 3 + 1), paldata(colr * 3 + 2)
 
 
  CASE "o"
   redraw = 255
restart1:
   COLOR 7
   LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
   LOCATE 3, 2: PRINT "ł                        ł"
   LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
   LOCATE 3, 4
   INPUT "Load *.PAL:", s$
   IF s$ <> "" THEN
    IF INSTR(s$, ".") = 0 THEN s$ = s$ + ".pal"
    DEF SEG = VARSEG(paldata(0))
    ON ERROR GOTO fileerror
    tmp = 0
    BLOAD s$, VARPTR(paldata(0))
    IF tmp = 1 THEN GOTO restart1
    ON ERROR GOTO 0
    DEF SEG
    FOR i = 0 TO 15
     palsetall currscr, i, paldata(i * 3), paldata(i * 3 + 1), paldata(i * 3 + 2)
    NEXT i
   END IF
 
 
  CASE "l"
   redraw = 255
restart2:
   COLOR 7
   LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
   LOCATE 3, 2: PRINT "ł                        ł"
   LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
   LOCATE 3, 4
   INPUT "Save *.PAL:", s$
   IF s$ <> "" THEN
    IF INSTR(s$, ".") = 0 THEN s$ = s$ + ".pal"
    DEF SEG = VARSEG(paldata(0))
    ON ERROR GOTO fileerror
    tmp = 0
    BSAVE s$, VARPTR(paldata(0)), 96
    IF tmp = 1 THEN GOTO restart2
    ON ERROR GOTO 0
    DEF SEG
   END IF
 
 
  CASE "i"
   redraw = 255
restart3:
   COLOR 7
   LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
   LOCATE 3, 2: PRINT "ł                        ł"
   LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
   LOCATE 3, 4
   INPUT "Load *.QBP:", s$
   IF s$ <> "" THEN
    IF INSTR(s$, ".") = 0 THEN s$ = s$ + ".qbp"
    DEF SEG = VARSEG(pcstor(0))
    ON ERROR GOTO fileerror
    tmp = 0
    BLOAD s$, VARPTR(pcstor(0))
    IF tmp = 1 THEN GOTO restart3
    ON ERROR GOTO 0
    DEF SEG
    PUT (330, 10), pcstor(0), PSET
    sizx = pcstor(0)
    sizy = pcstor(1)
    FOR i = 0 TO sizx - 1
     FOR j = 0 TO sizy - 1
      pic(i, j) = POINT(i + 330, j + 10)
     NEXT j
    NEXT i
    posc = -1
   END IF
 
 
  CASE "k"
   redraw = 255
restart4:
   COLOR 7
   LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
   LOCATE 3, 2: PRINT "ł                        ł"
   LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
   LOCATE 3, 4
   INPUT "Save *.QBP:", s$
   IF s$ <> "" THEN
    IF INSTR(s$, ".") = 0 THEN s$ = s$ + ".qbp"
    GET (330, 10)-(330 + sizx - 1, 10 + sizy - 1), pcstor(0)
    DEF SEG = VARSEG(pcstor(0))
    sizy2 = FIX((sizy + 7) / 8) * 8
    ON ERROR GOTO fileerror
    tmp = 0
    BSAVE s$, VARPTR(pcstor(0)), 4 + sizx * sizy2 / 2
    IF tmp = 1 THEN GOTO restart4
    ON ERROR GOTO 0
    DEF SEG
   END IF
 
 
  CASE "h"
   redraw = redraw OR 4
   FOR i = 0 TO sizx - 1
    FOR j = 1 TO sizy - 1
     pic(i, j - 1) = pic(i, j)
    NEXT j
   NEXT i
 
  CASE "m"
   redraw = redraw OR 4
   FOR i = sizx - 2 TO 0 STEP -1
    FOR j = 0 TO sizy - 1
     pic(i + 1, j) = pic(i, j)
    NEXT j
   NEXT i
 
  CASE "n"
   redraw = redraw OR 4
   FOR i = 0 TO sizx - 1
    FOR j = sizy - 2 TO 0 STEP -1
     pic(i, j + 1) = pic(i, j)
    NEXT j
   NEXT i
 
  CASE "b"
   redraw = redraw OR 4
   FOR i = 1 TO sizx - 1
    FOR j = 0 TO sizy - 1
     pic(i - 1, j) = pic(i, j)
    NEXT j
   NEXT i
 
  CASE "c"
   redraw = redraw OR 4
   FOR i = 0 TO sizx - 1
    FOR j = 0 TO FIX((sizy - 1) / 2)
     SWAP pic(i, j), pic(i, sizy - 1 - j)
    NEXT j
   NEXT i
 
  CASE "v"
   redraw = redraw OR 4
   FOR i = 0 TO FIX((sizx - 1) / 2)
    FOR j = 0 TO sizy - 1
     SWAP pic(i, j), pic(sizx - 1 - i, j)
    NEXT j
   NEXT i
 
 
 
  CASE "t"  'Special Settings & Load/Save module
 
   redraw = 255
   IF hugepic(0) = 0 THEN 'creating empty image
    hugepic(1) = 2 'final offset
   END IF
   GET (330, 10)-(330 + sizx - 1, 10 + sizy - 1), pcstor(0)
   redraw2 = 1
   DO
    IF redraw2 = 1 THEN
     COLOR 7
     LINE (0, 0)-(639, 349), 0, BF
     IF currscr = 12 THEN LINE (0, 350)-(639, 479), 0, BF
     LOCATE 2, 4
     PRINT "s   -> Screen Mode: "; currscr
     LOCATE 4, 4
     PRINT "i   -> Import BitMaP (.BMP)"
     LOCATE 6, 4
     PRINT "e   -> Erase Picture                 r   -> Erase QBM"
     LOCATE 7, 4
     PRINT "d   -> Restore basic palette"
     LOCATE 9, 4
     PRINT "n   -> Export to .BAS DATA-16"
     LOCATE 10, 4
     PRINT "p   -> Export Palette DATA"
     LOCATE 12, 4
     PRINT "c   -> Create Mask - QBM             v   -> Create Mask - QBP"
     LOCATE 14, 5
     PRINT "(Note: Color 0 transparency. The mask image must be AND - put in code)"
     LOCATE 21, 4
     PRINT "x   -> Go back to paint"
    END IF

    a = LCASE$(INPUT$(1))
    redraw2 = 0

    SELECT CASE a
   

     CASE "n"
      redraw2 = 1
restart11:
      COLOR 7
      LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
      LOCATE 3, 2: PRINT "ł                        ł"
      LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
      LOCATE 3, 4
      INPUT "Save *.BAS:", s$
      IF s$ <> "" THEN
       IF INSTR(s$, ".") = 0 THEN s$ = s$ + ".bas"
       ON ERROR GOTO fileerror
       tmp = 0
       OPEN s$ FOR APPEND AS #1
       IF tmp = 1 THEN GOTO restart11
       ON ERROR GOTO 0
       IF hugepic(0) > 0 THEN
        LOCATE 3, 4
        PRINT "Save all?  o -> OK"
        a = LCASE$(INPUT$(1))
       END IF
       PRINT #1, CHR$(13) + CHR$(10) + CHR$(13) + CHR$(10);
     
       IF a = "o" THEN
       
        FOR i1 = 0 TO hugepic(0) - 1
         PRINT #1, "'DATA - 16 image" + CHR$(13) + CHR$(10);
         PUT (330, 10), hugepic(hugepic(i1 + 1)), PSET
         FOR j = 0 TO hugepic(hugepic(i1 + 1) + 1) - 1
          PRINT #1, "DATA " + LTRIM$(RTRIM$(STR$(POINT(330, j + 10))));
          IF POINT(330, j + 10) < 10 THEN PRINT #1, " ";
          FOR i = 1 TO hugepic(hugepic(i1 + 1)) - 1
           PRINT #1, "," + LTRIM$(RTRIM$(STR$(POINT(330 + i, j + 10))));
           IF POINT(330 + i, j + 10) < 10 THEN PRINT #1, " ";
          NEXT i
          PRINT #1, CHR$(13) + CHR$(10);
         NEXT j
         PRINT #1, CHR$(13) + CHR$(10);
         COLOR 7
         LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
         LOCATE 3, 2: PRINT "ł                        ł"
         LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
         LOCATE 3, 4: PRINT FIX((i1 + 1) * 100 / (hugepic(0))); "% done"
        NEXT i1
       ELSE
       
        PRINT #1, "'DATA - 16 image" + CHR$(13) + CHR$(10);
        FOR j = 0 TO sizy - 1
         PRINT #1, "DATA " + LTRIM$(RTRIM$(STR$(pic(0, j))));
         IF pic(0, j) < 10 THEN PRINT #1, " ";
         FOR i = 1 TO sizx - 1
          PRINT #1, "," + LTRIM$(RTRIM$(STR$(pic(i, j))));
          IF pic(i, j) < 10 THEN PRINT #1, " ";
         NEXT i
         PRINT #1, CHR$(13) + CHR$(10);
        NEXT j
        PRINT #1, CHR$(13) + CHR$(10);
       END IF

       CLOSE #1
      END IF
      a = " "


     CASE "p"
      redraw2 = 1
restart13:
      COLOR 7
      LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
      LOCATE 3, 2: PRINT "ł                        ł"
      LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
      LOCATE 3, 4
      INPUT "Save *.BAS:", s$
      IF s$ <> "" THEN
       IF INSTR(s$, ".") = 0 THEN s$ = s$ + ".bas"
       ON ERROR GOTO fileerror
       tmp = 0
       OPEN s$ FOR APPEND AS #1
       IF tmp = 1 THEN GOTO restart13
       ON ERROR GOTO 0
       PRINT #1, CHR$(13) + CHR$(10) + CHR$(13) + CHR$(10);
   
       PRINT #1, "'Palette" + CHR$(13) + CHR$(10);
       FOR i = 0 TO 15
        PRINT #1, "DATA " + RTRIM$(LTRIM$(STR$(paldata(i * 3))));
        PRINT #1, "," + RTRIM$(LTRIM$(STR$(paldata(i * 3 + 1))));
        PRINT #1, "," + RTRIM$(LTRIM$(STR$(paldata(i * 3 + 2))));
        PRINT #1, CHR$(13) + CHR$(10);
       NEXT i
       PRINT #1, CHR$(13) + CHR$(10);
       CLOSE #1
      END IF



     CASE "s"
      redraw2 = 1
      IF currscr = 9 THEN currscr = 12 ELSE currscr = 9
      SCREEN currscr
      FOR i = 0 TO 15
       palsetall currscr, i, paldata(i * 3), paldata(i * 3 + 1), paldata(i * 3 + 2)
      NEXT i
   
     CASE "e"
      redraw2 = 1
      COLOR 7
      LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
      LOCATE 3, 2: PRINT "ł Are You sure?  o -> OK ł"
      LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
      a = LCASE$(INPUT$(1))
      IF a = "o" THEN
       sizx = 32
       sizy = 32
       FOR i = 0 TO 59
        FOR j = 0 TO 59
         pic(i, j) = 0
        NEXT j
       NEXT i
      END IF
      a = " "
   
     CASE "r"
      redraw2 = 1
      COLOR 7
      LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
      LOCATE 3, 2: PRINT "ł Are You sure?  o -> OK ł"
      LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
      a = LCASE$(INPUT$(1))
      IF a = "o" THEN
       hugepic(0) = 0
       hugepic(1) = 2
       posc = -1
      END IF
      a = " "
   
     CASE "d"
      redraw2 = 1
      COLOR 7
      LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
      LOCATE 3, 2: PRINT "ł Are You sure?  o -> OK ł"
      LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
      a = LCASE$(INPUT$(1))
      IF a = "o" THEN
       RESTORE
       FOR i = 0 TO 47
        READ paldata(i)
       NEXT i
       FOR i = 0 TO 15
        palsetall currscr, i, paldata(i * 3), paldata(i * 3 + 1), paldata(i * 3 + 2)
       NEXT i
      END IF
      a = " "

     CASE "v"
      redraw2 = 1
restart9:
      COLOR 7
      LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
      LOCATE 3, 2: PRINT "ł                        ł"
      LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
      LOCATE 3, 4
      INPUT "Save *.QBP:", s$
      IF s$ <> "" THEN
       IF INSTR(s$, ".") = 0 THEN s$ = s$ + ".qbp"
       FOR i = 0 TO sizx - 1
        FOR j = 0 TO sizy - 1
         IF pic(i, j) = 0 THEN PSET (i + 330, j + 10), 15 ELSE PSET (i + 330, j + 10), 0
        NEXT j
       NEXT i
       GET (330, 10)-(330 + sizx - 1, 10 + sizy - 1), pcstor(0)
       DEF SEG = VARSEG(pcstor(0))
       sizy2 = FIX((sizy + 7) / 8) * 8
       ON ERROR GOTO fileerror
       tmp = 0
       BSAVE s$, VARPTR(pcstor(0)), 4 + sizx * sizy2 / 2
       IF tmp = 1 THEN GOTO restart9
       ON ERROR GOTO 0
       DEF SEG
      END IF
   
     CASE "c"
      redraw2 = 1
restart10:
      COLOR 7
      LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
      LOCATE 3, 2: PRINT "ł                        ł"
      LOCATE 4, 2: PRINT "ł Warning! Your current  ł"
      LOCATE 5, 2: PRINT "ł  QBM will be erased!   ł"
      LOCATE 6, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
      LOCATE 3, 4
      INPUT "Save *.QBM:", s$
      IF s$ <> "" AND hugepic(0) > 0 THEN
       IF INSTR(s$, ".") = 0 THEN s$ = s$ + ".qbm"
       FOR i1 = 0 TO hugepic(0) - 1
        PUT (330, 10), hugepic(hugepic(i1 + 1)), PSET
        FOR i = 0 TO hugepic(hugepic(i1 + 1)) - 1
         FOR j = 0 TO hugepic(hugepic(i1 + 1) + 1) - 1
          IF POINT(i + 330, j + 10) = 0 THEN PSET (i + 330, j + 10), 15 ELSE PSET (i + 330, j + 10), 0
         NEXT j
        NEXT i
        GET (330, 10)-(330 + hugepic(hugepic(i1 + 1)) - 1, 10 + hugepic(hugepic(i1 + 1) + 1) - 1), hugepic(hugepic(i1 + 1))
        COLOR 7
        LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
        LOCATE 3, 2: PRINT "ł                        ł"
        LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
        LOCATE 3, 4: PRINT FIX((i1 + 1) * 100 / (hugepic(0))); "% done"
       NEXT i1
       DEF SEG = VARSEG(hugepic(0))
       imgsize = hugepic(hugepic(0) + 1)
       ON ERROR GOTO fileerror
       tmp = 0
       BSAVE s$, VARPTR(pcstor(0)), imgsize * 2
       IF tmp = 1 THEN GOTO restart10
       ON ERROR GOTO 0
       DEF SEG
      END IF

   
     CASE "i"
      redraw2 = 1
restart5:
      COLOR 7
      LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
      LOCATE 3, 2: PRINT "ł                        ł"
      LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
      LOCATE 3, 4
      INPUT "Load *.BMP:", s$
      IF s$ <> "" THEN
       IF INSTR(s$, ".") = 0 THEN s$ = s$ + ".bmp"
       ON ERROR GOTO fileerror
       tmp = 0
       OPEN s$ FOR INPUT AS #1
       IF tmp = 1 THEN GOTO restart5
       ON ERROR GOTO 0
       CLOSE #1
       tmp = loadBMP(330, 10, s$)
       IF tmp = 0 THEN
        sizx = bmpsiz(0)
        sizy = bmpsiz(1)
        FOR i = 0 TO sizx - 1
         FOR j = 0 TO sizy - 1
          pic(i, j) = POINT(i + 330, j + 10)
         NEXT j
        NEXT i
        FOR i = 0 TO 47
         paldata(i) = bmpal(i)
        NEXT i
        FOR i = 0 TO 15
         palsetall currscr, i, paldata(i * 3), paldata(i * 3 + 1), paldata(i * 3 + 2)
        NEXT i
       END IF
      END IF
      posc = -1
   
     CASE ELSE
    END SELECT
   LOOP UNTIL a = "x"
   a = " "
 


  CASE "0"  'Multiple Image Array module (.QBM)

   redraw = 255
   IF hugepic(0) = 0 THEN 'creating empty image
    hugepic(1) = 2 'final offset
   END IF
   GET (330, 10)-(330 + sizx - 1, 10 + sizy - 1), pcstor(0)
   redraw2 = 1
   post = posc

   DO
    IF redraw2 = 1 THEN
     LINE (0, 0)-(639, 349), 0, BF
     IF currscr = 12 THEN LINE (0, 350)-(639, 479), 0, BF
    END IF
    redraw2 = 0
    FOR i = posf - 3 TO posf + 3
     LINE ((i - posf + 3) * 88 + 14, 10)-((i - posf + 3) * 88 + 77, 73), 0, BF
     IF i >= 0 AND i < hugepic(0) THEN PUT ((i - posf + 3) * 88 + 16, 12), hugepic(hugepic(i + 1)), PSET
    NEXT i
    LINE (3 * 88 + 13, 9)-(3 * 88 + 79, 75), 4, B
    LINE (14, 100)-(77, 163), 0, BF
    PUT (16, 102), pcstor(0), PSET
    COLOR 7
    LOCATE 7, 22
    PRINT "4 6 -> Move around; current image:"; posf; "/"; hugepic(0); " "
    LOCATE 8, 22
    PRINT "2   -> Load image from the file"
    LOCATE 9, 22
    PRINT "8   -> Save image in front of the selected one"
    LOCATE 10, 22
    PRINT "5   -> Delete the selected image from the file"
    LOCATE 12, 22
    PRINT "7 9 -> Load / Save multi image file"
    LOCATE 14, 22
    PRINT "1   -> Load palette (if colors are not correct)"
    LOCATE 16, 22
    PRINT "3   -> Go back to paint"
    COLOR 3
    LOCATE 18, 4
    PRINT "Multiple image files have the number of the images in their first two"
    LOCATE 19, 3
    PRINT "bytes, after the offsets of the images come, two byte each. After this"
    LOCATE 20, 3
    PRINT "there is a final offset pointing after the last image, then the images"
    LOCATE 21, 3
    PRINT "saved in QBASIC get/put format come (offsets must be doubled)."
    LOCATE 22, 4
    PRINT "The *.QBM files are being BSAVEd, so You have to BLOAD them into an"
    LOCATE 23, 3
    PRINT "INTEGER array to use them."
   

    a = LCASE$(INPUT$(1))


    SELECT CASE a
   
     CASE "4"
      IF posf > 0 THEN posf = posf - 1
   
     CASE "6"
      IF posf < hugepic(0) THEN posf = posf + 1
   
     CASE "2"
      IF hugepic(0) > posf THEN
       offs = hugepic(posf + 1)
       offs2 = hugepic(posf + 2)
       FOR i = offs TO offs2 - 1
        pcstor(i - offs) = hugepic(i)
       NEXT i
       post = posf
      ELSE
       pcstor(0) = 1
       pcstor(1) = 1
       pcstor(2) = 0
      END IF
   
   
     CASE "8"
      'Creating an empty space for the new image
      sizy2 = FIX((pcstor(1) + 7) / 8) * 8
      imgsize = 4 + sizy2 * pcstor(0) 'Size of the image in bytes
      FOR i = hugepic(0) TO posf STEP -1
       'Moving image (if needed)
       IF i > posf THEN
        FOR j = hugepic(i + 1) - 1 TO hugepic(i) STEP -1
         hugepic(j + FIX(imgsize / 2)) = hugepic(j)
        NEXT j
       END IF
       IF i = hugepic(0) THEN
        tempoff = hugepic(i + 1) + FIX(imgsize / 2) + 1
        'last offset can only be saved when all of the images moved away
       ELSE
        hugepic(i + 2) = hugepic(i + 1) + FIX(imgsize / 2) 'New offsets
       END IF
      NEXT i
      'Moving all images forth to create space for the final offset
      FOR i = tempoff - 2 TO hugepic(0) + 2 STEP -1
       'moving all images one step forth to make space for the last offset
       hugepic(i + 1) = hugepic(i)
      NEXT i
      hugepic(hugepic(0) + 2) = tempoff 'Saving final offset
      FOR i = 0 TO hugepic(0)
       hugepic(i + 1) = hugepic(i + 1) + 1 'increasing all offsets
      NEXT i
      'inserting new image
      j = 0
      FOR i = hugepic(posf + 1) TO hugepic(posf + 2) - 1
       hugepic(i) = pcstor(j)
       j = j + 1
      NEXT i
      hugepic(0) = hugepic(0) + 1
   
   
     CASE "5"
      IF posf < hugepic(0) THEN 'Remove only existing images
       'Removing image data
       imgsize = hugepic(posf + 2) - hugepic(posf + 1)
       FOR i = posf + 1 TO hugepic(0)
        'Moving image
        FOR j = hugepic(i) TO hugepic(i + 1) - 1
         hugepic(j) = hugepic(j + imgsize)
        NEXT j
        hugepic(i) = hugepic(i + 1) - imgsize 'New offsets
       NEXT i
       'Moving all images back to use up the unused offset space
       FOR i = hugepic(0) + 1 TO hugepic(hugepic(0) + 1) - 1
        'moving all images one step back to use up the unused offset space
        hugepic(i) = hugepic(i + 1)
       NEXT i
       FOR i = 0 TO hugepic(0) - 2
        hugepic(i + 1) = hugepic(i + 1) - 1 'decreasing all offsets
       NEXT i
       hugepic(0) = hugepic(0) - 1
      END IF
   
   
     CASE "1"
      redraw2 = 1
restart6:
      COLOR 7
      LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
      LOCATE 3, 2: PRINT "ł                        ł"
      LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
      LOCATE 3, 4
      INPUT "Load *.PAL:", s$
      IF s$ <> "" THEN
       IF INSTR(s$, ".") = 0 THEN s$ = s$ + ".pal"
       DEF SEG = VARSEG(paldata(0))
       ON ERROR GOTO fileerror
       tmp = 0
       BLOAD s$, VARPTR(paldata(0))
       IF tmp = 1 THEN GOTO restart6
       ON ERROR GOTO 0
       DEF SEG
       FOR i = 0 TO 15
        palsetall currscr, i, paldata(i * 3), paldata(i * 3 + 1), paldata(i * 3 + 2)
       NEXT i
      END IF
   
   
     CASE "7"
      redraw2 = 1
restart7:
      COLOR 7
      LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
      LOCATE 3, 2: PRINT "ł                        ł"
      LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
      LOCATE 3, 4
      INPUT "Load *.QBM:", s$
      IF s$ <> "" THEN
       IF INSTR(s$, ".") = 0 THEN s$ = s$ + ".qbm"
       DEF SEG = VARSEG(hugepic(0))
       ON ERROR GOTO fileerror
       tmp = 0
       BLOAD s$, VARPTR(hugepic(0))
       IF tmp = 1 THEN GOTO restart7
       ON ERROR GOTO 0
       DEF SEG
      END IF
   
   
     CASE "9"
      redraw2 = 1
restart8:
      COLOR 7
      LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
      LOCATE 3, 2: PRINT "ł                        ł"
      LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
      LOCATE 3, 4
      INPUT "Save *.QBM:", s$
      IF s$ <> "" THEN
       IF INSTR(s$, ".") = 0 THEN s$ = s$ + ".qbm"
       DEF SEG = VARSEG(hugepic(0))
       imgsize = hugepic(hugepic(0) + 1)
       ON ERROR GOTO fileerror
       tmp = 0
       BSAVE s$, VARPTR(hugepic(0)), imgsize * 2
       IF tmp = 1 THEN GOTO restart8
       ON ERROR GOTO 0
       DEF SEG
      END IF
   
   
     CASE "3"
      redraw2 = 1
      COLOR 7
      LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴ż"
      LOCATE 3, 2: PRINT "ł Load image?  o -> OK  n -> NOT ł"
      LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴Ů"
      a = LCASE$(INPUT$(1))
      IF a = "o" THEN
       posc = post
       PUT (330, 10), pcstor(0), PSET
       sizx = pcstor(0)
       sizy = pcstor(1)
       FOR i = 0 TO sizx - 1
        FOR j = 0 TO sizy - 1
         pic(i, j) = POINT(i + 330, j + 10)
        NEXT j
       NEXT i
      END IF
      IF a = "o" OR a = "n" THEN a = "3" ELSE a = ""
   
     CASE ELSE
    END SELECT
   LOOP UNTIL a = "3"
 


  CASE "x"
   redraw = 255
   COLOR 7
   LOCATE 2, 2: PRINT "旼컴컴컴컴컴컴컴컴컴컴컴ż"
   LOCATE 3, 2: PRINT "ł Are You sure?  o -> OK ł"
   LOCATE 4, 2: PRINT "Ŕ컴컴컴컴컴컴컴컴컴컴컴컴Ů"
   a = LCASE$(INPUT$(1))
   IF a = "o" THEN a = "x" ELSE a = ""

  CASE ELSE 'Case Else for QB4.0 compatibility
 END SELECT
LOOP UNTIL a = "x"



SCREEN 0

CLS
COLOR 2
LOCATE 2, 2
PRINT "Thank You for using this program"
COLOR 6
LOCATE 5, 50
PRINT "    Magyar Nagymacskaegylet"
LOCATE 6, 50
PRINT "(Hungarian Big Cat Society)"
LOCATE 8, 1
COLOR 7


SYSTEM


'If bad file name

fileerror:
LOCATE 3, 4
PRINT "Bad file name          "
a = INPUT$(1)
tmp = 1
RESUME NEXT

FUNCTION loadBMP (x AS INTEGER, y AS INTEGER, pic AS STRING)

DIM a AS STRING * 1
DIM r AS STRING * 1
DIM g AS STRING * 1
DIM b AS STRING * 1

notbmp = 0

OPEN pic FOR BINARY AS #1

'Header check
SEEK #1, 1
GET #1, , a
GET #1, , b
IF a + b <> "BM" THEN notbmp = 1 'Invalid header

'Size check - not processing over 60*60
SEEK #1, 19 'X size
GET #1, , a
GET #1, , r
GET #1, , g
GET #1, , b
IF ASC(b) > 0 OR ASC(g) > 0 OR ASC(r) > 0 OR ASC(a) > 60 THEN
 notbmp = 2 'Too big X
ELSE
 sizx = ASC(a) + ASC(r) * 256 'Counting size X
 bmpsiz(0) = sizx
END IF
SEEK #1, 23 'Y size
GET #1, , a
GET #1, , r
GET #1, , g
GET #1, , b
IF ASC(b) > 0 OR ASC(g) > 0 OR ASC(r) > 0 OR ASC(a) > 60 THEN
 notbmp = 2 'Too big Y
ELSE
 sizy = ASC(a) + ASC(r) * 256 'Counting size Y
 bmpsiz(1) = sizy
END IF

SEEK #1, 29 'Bits per pixel
GET #1, , a
IF ASC(a) <> 4 THEN notbmp = 3 'Not a 4 bit image

SEEK #1, 31 'Compression
GET #1, , a
IF ASC(a) > 0 THEN notbmp = 4 'Compressed image

IF notbmp = 0 THEN

 SEEK #1, 55

 FOR i = 0 TO 15
  GET #1, , b
  GET #1, , g
  GET #1, , r
  GET #1, , a
  bmpal(i * 3 + 0) = ASC(r)
  bmpal(i * 3 + 1) = ASC(g)
  bmpal(i * 3 + 2) = ASC(b)
 NEXT i

 SEEK #1, 119 'Displaying image

 sizx = FIX((sizx + 7) / 8) * 8
  'There are unused pixels at the end of BMP lines what must be read

 FOR i = sizy - 1 TO 0 STEP -1
  FOR j = 0 TO sizx - 1 STEP 2
   GET #1, , a
   PSET (j + x, i + y), (FIX(ASC(a) / 16))
   PSET (j + x + 1, i + y), (ASC(a) - FIX(ASC(a) / 16) * 16)
  NEXT j
 NEXT i

END IF

CLOSE #1

loadBMP = notbmp

END FUNCTION

SUB palset (cnum AS INTEGER, red AS INTEGER, green AS INTEGER, blue AS INTEGER)
 OUT &H3C8, cnum
 OUT &H3C9, FIX(red / 4)
 OUT &H3C9, FIX(green / 4)
 OUT &H3C9, FIX(blue / 4)
END SUB

SUB palset9 (cnum AS INTEGER, red AS INTEGER, green AS INTEGER, blue AS INTEGER)
 cnum2 = cnum
 IF cnum = 6 THEN cnum2 = 20
 IF cnum > 7 THEN cnum2 = cnum + 48
 palset cnum2, red, green, blue
END SUB

SUB palsetall (scrn AS INTEGER, cnum AS INTEGER, red AS INTEGER, green AS INTEGER, blue AS INTEGER)
 IF scrn = 9 THEN palset9 cnum, red, green, blue ELSE palset cnum, red, green, blue
END SUB




This one would get 24 points for Pure QB (it uses palette - changing), and 20 to 22 for speed. It worked fine on my computer.


Title: BT update
Post by: Pc72 on April 04, 2004, 05:35:21 PM
BT is getting a bit old now... Heck, it's been over 2 years now. But that doesn't stop me from digging up some past! :D

I have upgraded the BT game to version 1.3, [the FINAL version,] which has some very nifty new features.  Read[ME.TXT] for what they are... :)

And by the way:   :-? Only 5.7% of the generated levels are impossible.  I've noted that since I first wrote the routine, and calculated that percentage after I saw  :o your post...  In average I've played a [generated] level every second day. *shrugs* After all, I made the game to be fun :D *scratches head*

By the way [again]: Cool code! *points at sprite editor*


Title: 100% QB game
Post by: Spotted Cheetah on April 05, 2004, 01:25:05 PM
Then i think your game does not like me  :-?

The first level was impossible, so i restarted. Then i could play until i reached level 4, but then the game thought it was enough for me, and did not generate anything what was able to pass. I tried it four times then i gave up...


Title: 100% QB game
Post by: Spotted Cheetah on April 10, 2004, 01:04:09 PM
Now i put away programming for a short time to review
Building Trouble.

(I am started programming my game 2 days before. Now i
think i am done with the basics of the graphic engine:
i think it is a very good one in the pure QB world -
but everyone thinks this on his games, not? :) )

So lets start with it.

First of all, the PureQB score. There is absolutely
nothing more than QB in this game's code, so it can
get 25 points. There is an interesting thing in the
game: the sprites are included in the source in GET /
PUT format as LONG arrays. This must have made with
a special QB drawing program what could output in that
style (I would never type those tons of numbers...).
BT.EXE can work without any external files, this way
everything is included in that one file.

The game worked on it's top speed until i slowed down
my machine to 15Mhz, but it was still playable on 8Mhz
too. This worth 22 points.

So the technical part of it is almost perfect:
25 + 22 = 47 points :)


Now the game itself.

The graphic of the game takes place on the popular
320 * 200 mode with 256 colors. It not uses the A000
memory area, just oly the built - in GET and PUT
routines of QB. This way the gameplay is a bit
flickery in some cases since the game not looks at
the VGA ports before updating the screen. On the other
hand it is a very good thing at speed that it only
redraws the areas of the playfield when they are really
needed to redraw. But sometimes it forgets to do this,
and some parts of the sprites are being left on the
screen... It makes the dark side darker that the sprites
are not transparent: they have got a black background
what deletes everything behind them. On the other hand
they look better than an usual middle class QB game's
sprites, and they are really moving.
Finally it can get 4 points out of 9.

Now the game's useability. It is working. Or not. The
game uses the keyboard port to get the states of the
arrow keys what may work, or may not. I have not got
Windows XP, but i think it will not run on it. At all
controlling is not bad, rather outdated. Someone who is
familiar with typing may welcome this way, but if does
not know where that stupid key is then he is lost. On
the other hand playing the game is easy (if the keys
are working), everyone should be able to handle that
five keys what are needed.
For handling this game gets 6 points.

It is a good thing to have a game with sounds. Many
programmer here forgets to add sound to their games.
This one as most of the other pureQB games use the PC
speaker to generate some tones. There are some intro
musics which are good, and a few sound effects in the
game. They can be turned off from the main menu, then
the game remembers this setting what is a good point.
On the other hand if the music is on, the intro make
us waiting for some seconds before we can use the menus.
At all for the sound this game can get 4 points (/9).

This game was not designed for the story. In this case
it is like Project Speed: Microrush, this game was
written only to play too. It has got an Arabic theme as
we have to get back our oil from the bad mans (Kuwait?
Iran?) At all, it can get the same score as Microrush:
1 points.

The game's idea can not said to be unique since there are
many other games where we have to work with bombs. On the
other hand they are almost always topdown - view, but in
this game the gravity counts (things are falling down from
the top). It can get 2 points for this.

At the challenge side it is not really good. Since half of
the maps are generated impossible (I played it much,
believe or not, it is true), the author built in a restart
function what can be used any time if you are running out
of time or having any other problems. And those maps are
completely random so it can happen that only 1 bad guy is
lingering on the map, but opposite to this it is possible
to be attacked by a 10 man army on the first level. The
programming technique of this game really hurts... The only
positive thing of it that nobody can fall through walls, and
the bombs always blow up what is next to them.
So 1 point for challenge, and 1 point for technique.

Finally the replay value. If you can get used to restart
when you get an impossible map, it can be played as much
like Tetris. 2 points.

Finally: 4 + 6 + 4 + 1 + 2 + 1 + 1 + 2 = 21 points

So the scores:
47 points for PureQB
21 points for the game

Final score: 42%

This game if it's bugs had fixed would have been a very nice
demonstration of PureQB coding.

I got 42100 points in Microrush. Hard game :)


I think my sprite editor still leaves some garbage in QBMs...


Title: 100% QB game
Post by: Spotted Cheetah on April 10, 2004, 04:43:39 PM
I finally fixed all bugs in my sprite editor. It can be downloaded from QBasicForAll (http://www.qb4all.com) from the Graphic section.


Title: 100% QB game
Post by: relsoft on April 10, 2004, 11:45:19 PM
Long arrays are compatible with GET/PUT.

Even fixed length strings.  
:*)

Nice Editor.


Title: 100% QB game
Post by: Spotted Cheetah on April 12, 2004, 07:36:32 PM
Thanks :)

I think INTEGER arrays are the best to do this. This way the first two elements of the array are the X and Y size, and the pixels - who cares. That format is hard to find out (I could not do that yet), and i do not think that it can be useful to decrypt it...
An other advantage of INTEGER arrays is that they can have 32766 elements maximally (at about 64Kb), and this is almost the largest number what can be stored in an INTEGER (For QBM offsets).
So QBMs can be maximally 64Kb in size, but I think it is not really needed to store more since a DOS program can maximally have at about 400Kb in the memory.

I had already started to create a game based on sprites made in this editor, but i will only show it if i make it playable (if i will have a demo).


Title: 100% QB game
Post by: na_th_an on April 12, 2004, 08:22:48 PM
A DOS program can have 640 Kb of memory if there is enough free memory.

Understanding the GET/PUT compatible format is very useful, for example for pixel perfect collisions on a tiled background. Anyhow, there is nothing to decrypt. In SCREEN 13, you have two bytes for the width*8, then two bytes for the height, and then the bitmap at one pixel per byte ordered from top to botom, from left to right.

And there is always needed to store more :D the 640 Kb barrier can be surpased using EMS or XMS for data (up to 64 Mb using XMS 2.0) and overlays for code (up to 16 Megs of code using the LINK.EXE which came with PDS 7 and newer versions).


Title: 100% QB game
Post by: Spotted Cheetah on April 12, 2004, 08:37:35 PM
I will show you that a good game can be written within the 640Kb limits. But writing a good game is a long process... I started it, and i know that i will be able to finish. But it is a hard work...

640Kb free - this will never happen. Where to store the interrupt vector table then? :)
An usual well - configured DOS system has at about 550Kb of free memory. But it is better to not allocate more than 400Kb.

The GET/PUT format is not so easy in 16 color screens. It is a complex thing. And as i wrote my sprite editor for these modes, i will program my game in them too (I will do it in SCREEN 9).


Title: 100% QB game
Post by: na_th_an on April 12, 2004, 08:51:14 PM
I know you can code a good game in the 640 Kb limits. My favourite game ever is an Atari VCS game called circus that takes 4 Kb. But IMHO, not using all the potential a platform provides (I say platform: 16 bits MSDOS, which is the platform QB games run on, not machine: 32 or 64 bits PC running any OS, which has really more potential ;)) is silly. If you have it, get it. Self imposed limits are good if you are trying to challenge yourself, but don't say things so absolute like "but I think it is not really needed to store more". Bill Gates said something similar and then he had to eat his words :P.

And I had 601 Kb of free memory in MSDOS ;) You have to love configuring it manually after running MEMMAKER.

Why isn't good to allocate more than 400 Kb? MSDOS is a monolitic, monouser, monotasked OS. You can take all the memory if you want. No background processes.

Yeah, the format can be a little bit more tricky in 16 colours, but I can give you code if you need it.


Title: 100% QB game
Post by: Spotted Cheetah on April 12, 2004, 09:08:47 PM
In reality I have got 570Kb memory, but i can not get more. I think i have got too many drivers (I need an unusual mouse driver, a CD-ROM driver for a CD-ROM from 1992, some sound card drivers, and these were only the biggest space - eaters).

I said the 400Kb limit since an usual (badly configured - not mine :) ) DOS system sometimes have only 500 or 450Kb free, and if someone runs DOS from WIN95, it gives only approximately 450Kb. I tested it, and I never could reach more than 550Kb there. But usually it is less. And I don't want to make everyone hacking into his / her OS before playing my game :)

Challenging myself - it is true, and false. If i think "No limit", then i can think about Need For Speed 7 for example. I do not think QB will reach that level ever. If i make limits, it is easier to create something can be called "excellent"  :wink:

(And not to mention that i have got 33Mhz in my computer on which i am programming)


Title: 100% QB game
Post by: na_th_an on April 12, 2004, 09:19:07 PM
You have a point... but think that 90% of people will have to hack'n'configure their computers to play QB (and MSDOS, in general) games :P. (And note my "stress" on "Platform". Need for speed 7 is not for the 16 bits MSDOS platform ;)).

Btw, you can get rid of your sound card drivers. In 99% of cases all you need (in MSDOS) is a BLASTER variable. As fot the CDROM, it usually fits well in HMA. Just to help you improve your system :)


Title: 100% QB game
Post by: Spotted Cheetah on April 13, 2004, 01:37:19 PM
HMA is full. UMB has 18Kb free, but nothing wants to load there...
My sound card is an unusual one, so i think it needs those drivers, and they sound good. I do not think i will cut them off, maybe only if i will have not enough memory...

I loved old games in the past too when i was not able to configure my MS - DOS well, just double - clicked it in W95. And i think the game will fit well on that 400Kb. I use really small files for graphic :)
(4 times smaller than simply loading 16 color DATA into INTEGER arrays. I am BLOADing the graphic created in my sprite editor).


Title: 100% QB game
Post by: Spotted Cheetah on April 13, 2004, 03:10:26 PM
I just tried some things out on the 4.86. If i can live without EMS, i have got 595Kb. This is not 601Kb only because i can not live without Hungarian keyboard (Keyboard can not be loaded in UMB). In this case i have got 49Kb free in the UMB.

(I counted in Kb here, not 1000 bytes. So that 595Kb means approximately 609000 byte.)


I know only one game what needs this "magical" 601Kb of memory: Wolf from Sanctuary Woods (If i wrote well) with sound and music. I could not make it running (to hear it's music) in the past when I configured my files (without EMS) on a boot disk. I did not cut off the hungarian keyboard (keyb.com), and 595Kb was not enough  :-?

I think we can allocate up to 500Kb in "extreme situations". This will be OK on at about 95% of the DOS (emulated) systems (i think). And we can go up to 550Kb if we write the program for people who knows a few things about DOS. But i do not think that a programmer should allocate more.

That 400Kb is the "healthy maximum".

(And what about real DOS systems? Where the EXE itself is in the base memory? I heard that when EMS is available the EXE is being placed there. So the 400Kb is only the memory limit, with an average 50Kb to 100Kb EXE it will eat up 450Kb to 500Kb in reality. So i do not think that you can "allocate" that 601Kb ever. You may have 600Kb allocated, but then what your 1Kb EXE can do?)


Title: 100% QB game
Post by: na_th_an on April 13, 2004, 05:34:04 PM
Portions of the EXE code can be placed in the EMS, but by any means it can be ran from there. EMS is for data. The IP register just points to base memory, hence the EXEcutable instructions must reside in the first 640 Kb. You can place EXE code in the EMS using overlays (LINK.EXE in PDS does this) but when the modules in EMS have to be ran they are loaded in the first 640 Kb.

I had such a big amount of free memory 'cause I liked good ol' japanese games :P and they were such memory hogs :D


Title: 100% QB game
Post by: Plasma on April 13, 2004, 05:54:56 PM
In real mode, you can run code from anywhere in the first 1088K of memory (1 MB + 64K HMA). This includes EMS when the pages are mapped to the pageframe.


Title: 100% QB game
Post by: na_th_an on April 13, 2004, 08:01:23 PM
Yeah, sorry for the inconsistence, I mean that only can be executed what can be pointed by CS:IP.


Title: 100% QB game
Post by: Spotted Cheetah on April 15, 2004, 01:18:14 PM
I could reach 619Kb (633600 bytes) with my DOS :)
BUFFERS=1, STACKS=0,0, no Hungarian keyboard, but everything other was loaded (into UMB). These are not the best idea for copying files, ect., but it works... I found an other nice trick to increase memory: some program can be loaded high! For example when i called LH NC, Norton Commander consumed a healthy 0 bytes from the main memory :). On the other hand QB.EXE will only load 240 bytes of itself into the UMB when we try to call this way. This trick can not be used with programs compiled in QB to place their EXE in UMB because then the free UMB will be the total memory (For example LH freememo, which is 16Kb in size and contain a PRINT FRE(-1) instruction reported 24Kb free memory when loaded into UMB).

I think BUFFERS has not got too much affect on system performance. Possibly because i am using SmartDrive what uses XMS for the same thing what is BUFFERS for. So i set it to 15, and got 610Kb of memory in "normal mode" (Everything what i need is loaded).

Finally i could start Wolf with music... But only PC speaker... My sound card is a so unique type that it freezed everything other and only let the game run in MPU - 401 mode where it did not made any sound... But the effects worked in Sound Blaster mode. Everyone can imagine what a silly thing is when it is raining what can be heard from the two speakers and the same time some tones come out from (somewhere under the table) the PC speaker too...

(To tell the truth my PC Speaker is not under the table, only the computer is there. The speaker is a third box in front of my screen - made by Spotted Cheetah :) )

You know much about DOS :)
The thing i wrote here was typed on my 486 (where i have not got Internet), and the copy+pasted here (Hungary and Internet... ARRGGHH!). Had You ever tried out that LH thing? It looks useful... But not for QBasic. I tried it with Commander Keen: it worked. Maybe i will try it with some other games too. I think it is only QB which language can not execute programs this way.


Title: 100% QB game
Post by: na_th_an on April 15, 2004, 01:48:00 PM
LH attempts to load high. It can take parameters for you to tell you where to locate stuff. Have you tried MEMMAKER? It calculates those parameters for you.

But pretty much mem you freed :) I think you can enable the keyboard driver.

And if I were you I'd go and buy a good ole ISA Sound Blaster 16 for $1.


Title: 100% QB game
Post by: Spotted Cheetah on April 16, 2004, 01:07:50 PM
(This competition turned into a "Who can have more from 640Kb" race... But it is interesting too :) )

Now after i spent hours on hand - configuring, and once i ran Memmaker, i have got 595Kb (602Kb without Hungarian keyboard) with EMS. On the UMB side only 3Kb is free: there was nothing what i could place there...
Without EMS i have got 619Kb in conventional, and 42Kb free memory in UMB. Note that these all are the configurations what I AM REALLY USING, not something what i just created for competition. It is 622Kb what i could get out of my DOS when i disabled everything what may consume conventional memory (Buffers=1, Stacks=0,0 ect.).


Memmaker made only a big mess :). After to have the bests, i had to reconfigure those sizes. This was how i could reach these values :)


And to keep something from the original subject: I am working... Now i could make two sprites running around on a colorful background which produced 18FPS on everything higher than 20Mhz :)


And if You told about it - why anybody need splitted EXEs loading partially into EMS? If an EXE itself is larger than 150 or 200Kb, you can imagine how much memory would it need... So i think DOS 16 can be left in its 1088Kb of memory, and if someone needs more (memory than that limit), then may split his or her EXE into overlays and use EMS or XMS. I think it is a silly thing to have a huge EXE somewhere in the EMS memory while it works just only in the 640Kb conventional memory...


Title: 100% QB game
Post by: Spotted Cheetah on April 19, 2004, 02:09:32 PM
I had found a nice trick for accurate timing in pureQB :)
It uses up the Play statement (without anything can be heard), i think it would be the most useful for someone who wants to add real (SoundBlaster) music for his or her QB game. Of course this way long PC speaker background musics can be played too. Or if someone needs more ticks than 18 per second :)

Code:

ON PLAY(1) GOSUB newplay
PLAY ON

PLAY "MBL16N0"

a = 0
DO
LOCATE 1, 1
PRINT a
LOOP UNTIL INKEY$ = CHR$(27)

PLAY OFF

END

newplay:
PLAY "MBL16N0"
IF a < 20000 THEN a = a + 1
RETURN


In the same time i found a worse thing too. The usage of the basic library disables upper memory, and if i load NC high, then the compiled program which uses mouse (or EMS, or anything what needs that library) freezes the computer on exit. I think i will have to find out how to control the mouse through ports if i want to prevent this (It is interesting that UMB will not be completely disabled, only the communication with this area. The drivers loaded there will keep working, but i can no longer get any information on the state of that memory).

Microsoft Qbasic: "Lightpen is popular, but who has got mouse?"

It is a bit annoying that they wrote handlers for joystick, for lightpen (and some poor things for keyboard), but nothing for mouse...

I had already found the mouse related things (and a lot of keyboard stuff) in my copy of Ralph Brown's list (I am talking about ports here, not interrupts. That one is much easyer, but impossible in pureQB), but that is so concise that i could not well understand it yet. I may have to find some tutorials on that.


Title: Integrated LONG arrays
Post by: Pc72 on April 30, 2004, 08:13:29 AM
Regarding the included LONG arrays in BT... If anybody's interested; I made them using GSU.  I drew the gfx with PCIE and used GSU to convert them to code. Both PCIE and GSU are developed by myself...  But were not pretty popular... (I really don't know why...I still use them!!!) And as far as I remember, they can be downloaded on my old page.  If not, then you can pm me and I will send them by email.


Title: 100% QB game
Post by: Spotted Cheetah on April 30, 2004, 09:02:58 PM
So you made something like my sprite editor, and created your code with it :)
It would be an another competition to find out what is the sortest thing to store data in the exe. This would be strings on the first thought, but what if we need to use ", or the code 13 string (a part of ENTER) ect... My DATA stuff is not the best, but it is readable. I think your way is one of the shortests.

I think your program is a good idea, and most of it is well - made. I think you should fix some parts of it (and use my code to create better PC speaker musics). If you do this, i think this game will be a very nice pureQB thing :)
And remove those INP60s. That can freeze some computers since it is not an "offical" keyboard handling. I am talking about that the keyboard must be accessed only when it has data for the system. And this can not be done in pureQB since the keyboard interrupt takes all of those datas.


Title: 100% QB game
Post by: Spotted Cheetah on May 15, 2004, 01:39:06 PM
If anyone still looks at this topic:

I worked on the sprite editor, now it can handle 2, 16, and 256 color BMP files, and can apply the currently used palette on them (it will do this with 2 and 256 color images, at 16 colors you still can use it's own colors). Now it is able to save in 16 color BMP files too.

You can download it from qb4all, from the Graphic section, if you are interested.


Title: 100% QB game
Post by: mddwebboy on June 06, 2004, 01:41:09 PM
Hello. I am kinda new to this whole QBASIC thingy. :)  I know a fair bit about QBASIC, and I have made a few games. here is my newest one.... I hope it qualifies!


[EFINT A-Z
DECLARE SUB mouse (cx, dx, bx)
DECLARE SUB mousepointer (SW)
DIM SHARED a(9)                 'Set up array for code
DEF SEG = VARSEG(a(0))          'Get array segment (nnnn:    )
                                 '    (two 8 bit)
    FOR i = 0 TO 17                 'length of DATA to
       READ r                       'read
       POKE VARPTR(a(0)) + i, r     'into array/2 (nnnn:iiii) (one 8 bit)
    NEXT i                          'until 17

'**************************** Machine Code *********************************

DATA &HB8,&H00,&H00   :   ' mov  AX,[n]       [Swap code-(L),(H)] in AX
DATA &H55             :   ' push BP           Save BP
DATA &H8B,&HEC        :   ' mov  BP,SP        Get BP to c Seg
DATA &HCD,&H33        :   ' int  33           Interrupt 33
DATA &H92             :   ' xchg AX,[reg]     [Swap code-reg] in AX
DATA &H8B,&H5E,&H06   :   ' mov  BX,[BP+6]    Point to (variable)
DATA &H89,&H07        :   ' mov  [BX],AX      Put AX in (variable)
DATA &H5D             :   ' pop  BP           Restore BP
DATA &HCA,&H02,&H00   :   ' ret  2            Far return

SCREEN 13
'****************************** Mouse set up ******************************
           
                CALL mousepointer(0)      'Reset mouse and
                CALL mousepointer(1)      'turn pointer off
                CALL mousepointer(3)      'Get coordinates

'****************************** P R O G R A M ******************************

DIM ship(100, 100)
DIM c!(360), s!(360)

FOR i = 1 TO 360
c!(i) = COS(i * 3.14 / 180)
s!(i) = SIN(i * 3.14 / 180)
NEXT

cx = 160
cy = 100

SCREEN 13

FOR yer = 1 TO 15
FOR xer = 1 TO 30
READ ship(xer, yer)
NEXT xer
NEXT yer

DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,3,1,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,3,1,3,3,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,3,1,3,3,3,3,3,3,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0
DATA 0,0,0,0,1,1,1,24,25,25,25,25,26,26,26,26,27,27,28,28,29,29,30,1,1,1,0,0,0,0
DATA 0,0,0,1,23,23,24,24,25,25,25,26,26,26,26,27,27,27,28,28,28,29,29,29,30,30,1,0,0,0
DATA 0,3,1,3,1,1,3,1,1,3,1,1,1,1,3,1,1,1,1,3,1,1,3,1,1,3,1,3,1,0
DATA 3,1,3,1,1,3,1,1,1,3,1,1,1,1,3,1,1,1,1,3,1,1,1,3,1,1,3,1,3,1
DATA 0,1,1,1,22,22,23,23,24,24,24,25,25,25,26,26,26,27,27,27,28,28,28,29,29,29,1,1,1,0
DATA 0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0
DATA 0,0,0,0,0,0,0,1,21,21,22,22,23,23,23,23,24,24,25,25,26,27,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0,0

x = 100
y = 100

angle = 1

DO
Key$ = INKEY$
CALL mouse(cx, dx, bx)

IF angle < 1 THEN angle = 359
IF angle > 359 THEN angle = 1

FOR yer = 1 TO 15
FOR xer = 1 TO 30
xx = (xer - 15) * c!(angle) + (yer - 7.5) * s!(angle)
yy = (yer - 7.5) * c!(angle) - (xer - 15) * s!(angle)
PSET ((xx + x), (yy + y)), ship(xer, yer)
NEXT xer
NEXT yer

LOOP UNTIL Key$ = "q"


'-------------------| THE END (Cut here)|----------------------------------

SUB mouse (cx, dx, bx)
         
           POKE VARPTR(a(4)), &H92           'Swap code,Get CX setup
          CALL absolute(cx, VARPTR(a(0)))     'Run Code
            '  cx = cx / 8                     'Adjust 25x80
           POKE VARPTR(a(4)), &H91           'Swap code,Get DX setup
          CALL absolute(dx, VARPTR(a(0)))     'Run Code
              dx = dx / 2                     'Adjust 25x80
           POKE VARPTR(a(4)), &H93           'Swap code,Get BX setup
          CALL absolute(bx, VARPTR(a(0)))     'Run Code

                                   'Note :
                                   'Remove the /8
                                   'for graphics modes.

END SUB

SUB mousepointer (SW)
         
           POKE VARPTR(a(0)) + 1, SW         'Swap code,Set AX = (SW)
          CALL absolute(c, VARPTR(a(0)))     'Run Code

                                          'Note:
                                             'SW = 0-reset
                                             'SW = 1-on
                                             'SW = 2-off
                                             'SW = 3-coordinates


END SUB

][/code]


Title: 100% QB game
Post by: mddwebboy on June 06, 2004, 01:46:54 PM
sorry about that. the other one is my first version. it only has a little rotating ship. this one is controlled by the mouse. I hope you like it. move the mouse to tip the ship, and press the left mouse button to go in that direction, and go higher. the right mouse button controls the beam.

If you hit a guy, they turn red and you cannot get them. if you get them with the beam, they turn green. if you hit a building, you die. oh, and the game over message is screwed up. :oops:


Code:
DEFINT A-Z
DECLARE SUB mouse (cx, dx, bx)
DECLARE SUB mousepointer (SW)
DIM SHARED a(9)                 'Set up array for code
DEF SEG = VARSEG(a(0))          'Get array segment (nnnn:    )
                                 '    (two 8 bit)
    FOR i = 0 TO 17                 'length of DATA to
       READ r                       'read
       POKE VARPTR(a(0)) + i, r     'into array/2 (nnnn:iiii) (one 8 bit)
    NEXT i                          'until 17

'**************************** Machine Code *********************************

DATA &HB8,&H00,&H00   :   ' mov  AX,[n]       [Swap code-(L),(H)] in AX
DATA &H55             :   ' push BP           Save BP
DATA &H8B,&HEC        :   ' mov  BP,SP        Get BP to c Seg
DATA &HCD,&H33        :   ' int  33           Interrupt 33
DATA &H92             :   ' xchg AX,[reg]     [Swap code-reg] in AX
DATA &H8B,&H5E,&H06   :   ' mov  BX,[BP+6]    Point to (variable)
DATA &H89,&H07        :   ' mov  [BX],AX      Put AX in (variable)
DATA &H5D             :   ' pop  BP           Restore BP
DATA &HCA,&H02,&H00   :   ' ret  2            Far return

SCREEN 13
'****************************** Mouse set up ******************************
           
                CALL mousepointer(0)      'Reset mouse and
                CALL mousepointer(1)      'turn pointer off
                CALL mousepointer(3)      'Get coordinates

'****************************** P R O G R A M ******************************

DIM guy(100, 100)
DIM ship(100, 100)
DIM c!(360), s!(360)
DIM px(1000)
DIM py(1000)
DIM b(100, 100)

FOR i = 1 TO 360
c!(i) = COS(i * 3.14 / 180)
s!(i) = SIN(i * 3.14 / 180)
NEXT

cx = 160
cy = 100

SCREEN 13

FOR yer = 1 TO 15
FOR xer = 1 TO 30
READ ship(xer, yer)
NEXT xer
NEXT yer

DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,3,1,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,3,1,3,3,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,3,1,3,3,3,3,3,3,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0
DATA 0,0,0,0,1,1,1,24,25,25,25,25,26,26,26,26,27,27,28,28,29,29,30,1,1,1,0,0,0,0
DATA 0,0,0,1,23,23,24,24,25,25,25,26,26,26,26,27,27,27,28,28,28,29,29,29,30,30,1,0,0,0
DATA 0,3,1,3,1,1,3,1,1,3,1,1,1,1,3,1,1,1,1,3,1,1,3,1,1,3,1,3,1,0
DATA 3,1,3,1,1,3,1,1,1,3,1,1,1,1,3,1,1,1,1,3,1,1,1,3,1,1,3,1,3,1
DATA 0,1,1,1,22,22,23,23,24,24,24,25,25,25,26,26,26,27,27,27,28,28,28,29,29,29,1,1,1,0
DATA 0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0
DATA 0,0,0,0,0,0,0,1,21,21,22,22,23,23,23,23,24,24,25,25,26,27,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0,0

FOR yer = 1 TO 12
FOR xer = 1 TO 7
READ guy(xer, yer)
NEXT xer
NEXT yer

DATA 0,0,6,6,6,0,0
DATA 0,0,14,14,14,0,0
DATA 0,0,14,4,14,0,0
DATA 3,2,2,2,2,2,3
DATA 3,2,2,2,2,2,3
DATA 3,2,2,2,2,2,3
DATA 0,3,3,3,3,3,0
DATA 0,3,3,3,3,3,0
DATA 0,3,3,0,3,3,0
DATA 0,3,3,0,3,3,0
DATA 0,6,6,0,6,6,0
DATA 6,6,6,0,6,6,6

FOR yer = 0 TO 9
FOR xer = 0 TO 16
READ b(xer, yer)
FOR xe = 1 TO 20
FOR ye = 1 TO 20
PSET ((xe + (20 * xer)), (ye + (20 * yer))), b(xer, yer)
NEXT ye
NEXT xe
NEXT xer
NEXT yer

DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0
DATA 0,0,0,4,4,0,0,0,0,0,0,0,0,1,0,0,0
DATA 0,0,0,6,6,0,0,0,0,0,0,0,0,1,0,0,0
DATA 0,0,0,6,6,0,0,0,2,0,2,0,0,1,1,0,0
DATA 0,0,6,6,6,6,0,0,1,0,1,0,0,1,1,1,1
DATA 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6

pnum = 3

FOR rer = 1 TO pnum
READ px(rer)
READ py(rer)
NEXT rer

DATA 1,168
DATA 135,168
DATA 302,148

x = 160
y = 70

angle = 1

DO
Key$ = INKEY$
CALL mouse(cx, dx, bx)

FOR rer = 1 TO pnum
IF (guy$(rer) <> "") THEN Key$ = "q" ELSE Key$ = INKEY$
NEXT rer

LOCATE 1, 1: PRINT Key$

IF (Key$ = "q") THEN
IF (guy$(rer) = "G") THEN
LOCATE 5, 15: PRINT "Game Over"
LOCATE 6, 16: PRINT "You Win"
ELSE
LOCATE 5, 15: PRINT "Game Over"
LOCATE 6, 15: PRINT "You loose"
END IF
END IF

FOR rer = 1 TO pnum
FOR yer = 1 TO 12
FOR xer = 1 TO 7
PSET (px(rer) + xer, py(rer) + yer), 0
NEXT xer
NEXT yer
FOR yer = 1 TO 12
FOR xer = 1 TO 7
IF (guy$(rer) <> "N" AND guy$(rer) <> "G") THEN
PSET (px(rer) + xer, py(rer) + yer), guy(xer, yer)
ELSEIF (guy$(rer) = "N") THEN
PSET (px(rer) + xer, py(rer) + yer), 4
ELSEIF (guy$(rer) = "G") THEN
PSET (px(rer) + xer, py(rer) + yer), 2
END IF
NEXT xer
NEXT yer
IF (px(rer) >= (x - 10) AND px(rer) <= (x + 10)) THEN
IF (las$ <> "Y") THEN
IF (py(rer) >= (y - 7) AND py(rer) <= (y + 7)) THEN
guy$(rer) = "N"
END IF
ELSE
IF (guy$(rer) <> "N") THEN
guy$(rer) = "G"
END IF
END IF
END IF
NEXT rer

FOR yer = 1 TO 15
FOR xer = 1 TO 30
xx = (xer - 15) * c!(angle) + (yer - 7.5) * s!(angle)
yy = (yer - 7.5) * c!(angle) - (xer - 15) * s!(angle)
PSET ((xx + x), (yy + y)), 0
NEXT xer
NEXT yer

IF (dx < 160) THEN
angle = (160 - dx) / 3
ELSEIF (dx > 160) THEN
angle = 360 - (dx - 160) / 3
END IF

IF (bx = 2) THEN
las$ = "Y"
IF (x > 2 OR x < -2) THEN
xs = xs / 3
END IF
LINE (x - 5, y)-((x + 5), 200), 0, BF
LINE (x - 2, y)-((x + 2), 200), 14, BF
END IF

IF (las$ = "Y") THEN
IF (x > 2 OR x < -2) THEN
xs = xs / 3
END IF
LINE (x - 5, y)-((x + 5), 200), 0, BF
LINE (x - 2, (y + 8))-((x + 2), 200), 14, BF
END IF

IF (bx <> 2 AND las$ = "Y") THEN
las$ = "N"
LINE (x - 5, y)-((x + 5), 200), 0, BF
LINE (x - 2, y)-((x + 2), 200), 0, BF
END IF

tr = tr + 1

IF (tr >= 15) THEN
tr = 0
IF (bx = 1) THEN
IF (dx < 160) THEN
xs = xs + (dx - 160) / 60
ELSEIF (dx > 160) THEN
xs = xs - (160 - dx) / 60
END IF
END IF
END IF

t = t + 1

IF (t >= 15) THEN
t = 0
IF (bx = 1) THEN
ys = ys - 1
END IF
END IF

at = at + 1
aat = aat + 1

IF (at >= 40) THEN
at = 0
ys = ys + 1
END IF

IF (aat >= 20) THEN
aat = 0
y = y + ys
x = x + xs
colr = (INT(RND * 16))
END IF

IF angle < 1 THEN angle = 359
IF angle > 359 THEN angle = 1

IF (b((x / 20), (y / 20)) <> 0) THEN
Key$ = "q"
END IF

FOR yer = 1 TO 15
FOR xer = 1 TO 30
xx = (xer - 15) * c!(angle) + (yer - 7.5) * s!(angle)
yy = (yer - 7.5) * c!(angle) - (xer - 15) * s!(angle)
ya = ship(xer, yer)
IF (ya = 3 AND bx = 2) THEN
PSET ((xx + x), (yy + y)), colr
ELSE
PSET ((xx + x), (yy + y)), ship(xer, yer)
END IF
NEXT xer
NEXT yer

LOOP UNTIL Key$ = "q"


'-------------------| THE END (Cut here)|----------------------------------

SUB mouse (cx, dx, bx)
         
           POKE VARPTR(a(4)), &H92           'Swap code,Get CX setup
          CALL absolute(cx, VARPTR(a(0)))     'Run Code
            '  cx = cx / 8                     'Adjust 25x80
           POKE VARPTR(a(4)), &H91           'Swap code,Get DX setup
          CALL absolute(dx, VARPTR(a(0)))     'Run Code
              dx = dx / 2                     'Adjust 25x80
           POKE VARPTR(a(4)), &H93           'Swap code,Get BX setup
          CALL absolute(bx, VARPTR(a(0)))     'Run Code

                                   'Note :
                                   'Remove the /8
                                   'for graphics modes.

END SUB

SUB mousepointer (SW)
         
           POKE VARPTR(a(0)) + 1, SW         'Swap code,Set AX = (SW)
          CALL absolute(c, VARPTR(a(0)))     'Run Code

                                          'Note:
                                             'SW = 0-reset
                                             'SW = 1-on
                                             'SW = 2-off
                                             'SW = 3-coordinates


END SUB

 
[/code]


Title: 100% QB game
Post by: whitetiger0990 on June 06, 2004, 02:09:01 PM
er... whats that code supposed to do? for me it made a mouse and an inferno beep from hell that didn't stop... even when i closed qbasic. I had to restart the computer o.o;;


Title: 100% QB game
Post by: mddwebboy on June 10, 2004, 08:06:55 PM
I tested that a ton on my computer. I may have messed it up when I copied and pasted.  :cry:  Sorry about yur computer. I got the mouse code from the tutorials here. refer to whoever made those.


Title: 100% QB game
Post by: Nemesis on July 30, 2004, 02:05:49 AM
Quote from: "Spotted Cheetah"
If it works fine with pure QB code, and won't need GHzs, You can do it... This is like FFIX.

But if You can not do it without using external routines, You can not say that it is 100% QB...

I thought that the QB included in DOS was first, and only that was improved later... Thanks for the info. But anyway, interrupt handling is built in at a version of QB - so I think it can be used.


Ummm...
A .qlb (QuickBASIC4.5 library) can be coded with pure QB,
just because it's a library doesn't mean it wasn't coded in pure QB.
(In my opinion a pure QB program can be anything programed in QB, a .QLb, an .EXE or a .BAS which doesn't use any ASM calls, or uses any other languages called from QB, eg... CALL ABSOLUTE.
Also QB.QLB is legal in my opinion too.)

Anyways, one day if I happen to run across this challenge thread and have finished a GREAT pure QB game, I'll upload it.
But for now I've only been messing around with pure QB coded tools to help make pure QB games, like grahic libs, key handlers, fast bit operations, ect...

Here's a pure QB library soon will be a .QLB  library for screen 13.
I'm currently working on v1.2, which isn't finished yet, I've still yet to add a few things like translucency, palette manipulation, rotozoomers, etc... and maybe some 3-D routines too.
VIDEO13h v1.2 also uses a routine similar to SUPERPUT, so the library can use fast PUT/GET and all of QB's original graphic commands for screen 13.
Plus it has some custom PUT routines too. (Very fast for PUREQB)
Check it out...


 
Code:

'''
' VIDEO13h v1.2, Pure QuickBASIC 4.5; SCREEN 13 manipulation routines.
'
' (C)opyright 2004, Pure QB Innovations
'
' Email any questions, comments, or suggestions to...
'  ESmemberNEMESIS@aol.com
'
' Visit the Pure QB Innovations web site at...
'  http://members.aol.com/esmembernemesis/index.htm
'
' 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&
COMMON SHARED Vtarget, VGAlo, VGAhi, V13lo, V13hi
COMMON SHARED FONTScolour
COMMON SHARED clipXXleft, clipYYtop, clipXXright, clipYYbottom
'
DECLARE SUB DEMO ()
'
DECLARE SUB INTERRUPTX (INTNUM AS INTEGER, INREG AS REGXdata, OUTREG AS REGXdata)
'
DECLARE SUB V13hCLS (colour)
DECLARE SUB V13hCLP (XXleft, YYtop, XXright, YYbottom)
DECLARE SUB V13hPAL (file$)
DECLARE SUB V13hBLD (ARRAY(), file$)
DECLARE SUB V13hBSV (ARRAY(), file$)
DECLARE SUB V13hDEL (seconds!)
DECLARE SUB V13hFDE (fadeOUT, fadeINN, fadeSEC!)
DECLARE SUB V13hKEY ()
DECLARE SUB V13hPAN (direction, increment, wrap)
DECLARE SUB V13hPNT (ARRAY(), frame)
DECLARE SUB V13hPUT (ARRAY(), XXleft, YYtop, frame, mode$)
DECLARE SUB V13hSEE ()
DECLARE SUB V13hSET ()
DECLARE SUB V13hTXT (ARRAY(), XXcenter, XXleft, YYtop, colour, text$)
'
DECLARE FUNCTION V13hLOF& (file$)
'
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 BOARD(0 TO 127)
 '
 V13hSET
 '
 DEMO
 '
 KILL "video.tmp"
 '
 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
 '
 'GOTO PAN
 '
 'SCROLLING FONT DEMO...
 '
 FOR y = (clipYYbottom + 1) TO (clipYYtop - (34 * 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, pure 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 and mouse, QuickBASIC v4.5,"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 30), 7, "and a disk cache active."
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 34), 15, "-CREDITS-"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 36), 15, "...Programmer..."
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 38), 7, "Mario LaRosa, ESmemberNEMESIS@aol.com"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 42), 15, "...Special Thanks..."
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 44), 7, "Jonathan Dale Kirwan, JonKirwan@aol.com"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 46), 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
  '
  'WAIT &H3DA, 8
  '
  IF LEN(INKEY$) THEN EXIT FOR
 NEXT
 SLEEP
 '
 'FADE OUT/IN DEMO...
 '
 '
 V13hFDE NOT FALSE, NOT FALSE, 1 / 32
 '
 'DELAY (1/2 SECONDS) DEMO...
 '
 DO: LOOP UNTIL TIMER <> TIMER
 DO
  t! = TIMER
  V13hDEL 1 / 2
  PRINT TIMER - t!
 LOOP UNTIL LEN(INKEY$)
 '
 '''
 ''' CLEAR SCREEN (256X) DEMO...
 '''
 '
 t! = TIMER
 FOR c = 0 TO 255
  V13hCLS c
  V13hSEE
 NEXT
 LOCATE 1, 1: PRINT "CLS, (256X):"; TIMER - t!
 SLEEP
 '
 '''
 ''' (1O,OOO) RANDOM PIXELS DEMO...
 '''
 V13hCLS 0
 t! = TIMER
 FOR x = 1 TO 10000
  PSET (INT(RND(1) * 319 + 1), INT(RND(1) * 199 + 1)), INT(RND(1) * 255 + 1)
 NEXT
 V13hSEE
 LOCATE 1, 1: PRINT "PSET, (1O,OOOX):"; TIMER - t!
 SLEEP
 '
 '''
 ''' (1O,OOO) RANDOM LINES DEMO...
 '''
 '
 V13hCLS 0
 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
 V13hSEE
 LOCATE 1, 1: PRINT "LINE, (1O,OOOX):"; TIMER - t!
 SLEEP
 '
 '''
 ''' (1,OOO) RANDOM TILES DEMO...
 '''
 '
 kind$ = "TRANSPARENT"
 DO
  V13hCLS 0
  t! = TIMER
  FOR t = 1 TO 1000
   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
  V13hSEE
  k$ = "PUT " + kind$ + ", (1,OOOX):"
  LOCATE 1, 1: PRINT k$; TIMER - t!
  SLEEP
  SELECT CASE kind$
   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
 '
'PAN:
 '
 '''
 '''PANNING SETUP...
 '''
 '
 'FOR c = 1 TO 2
 ' IF c = 2 THEN V13hCLP 30, 20, 289, 179
 ' FOR yy = 0 TO 180 STEP 20
 '  FOR xx = -20 TO 300 STEP 20
 '   V13hPUT TILES(), xx, yy, c, "PSET"
 '  NEXT
 ' NEXT
 ' V13hPUT TILES(), 150, 90, c + 1, "TRANSPARENT"
 ' V13hSEE
 'NEXT
 '
 'V13hCLP 0, 0, 319, 199
 '
 '''
 '''KEYBOARD (ARROWS) DEMO
 '''
 '
 CLS
 DO
  V13hKEY
  LOCATE 1, 1: PRINT "Arrow up:    "; BOARD(72); "   "
  LOCATE 2, 1: PRINT "Arrow down:  "; BOARD(80); "   "
  LOCATE 3, 1: PRINT "Arrow right: "; BOARD(77); "   "
  LOCATE 4, 1: PRINT "Arrow left:  "; BOARD(75); "   "
  LOCATE 6, 1: PRINT "Esc to exit."
 LOOP UNTIL BOARD(1)
 '
 '''
 '''KEYBOARD & PANNING DEMO
 '''
 '
 'DO
  'V13hKEY
  'IF BOARD(80) THEN V13hPAN 8, 1, NOT FALSE
  'IF BOARD(75) THEN V13hPAN 6, 1, NOT FALSE
  'IF BOARD(77) THEN V13hPAN 4, 1, NOT FALSE
  'IF BOARD(72) THEN V13hPAN 2, 1, NOT FALSE
  'V13hTXT FONTS(), FALSE, 0, 0, 15, "Arrow up:    " + STR$(BOARD(80))
  'V13hTXT FONTS(), FALSE, 0, 8, 15, "Arrow down:  " + STR$(BOARD(72))
  'V13hTXT FONTS(), FALSE, 0, 16, 15, "Arrow right: " + STR$(BOARD(75))
  'V13hTXT FONTS(), FALSE, 0, 24, 15, "Arrow left:  " + STR$(BOARD(77))
  'V13hSEE
  'V13hCLS 0
 'LOOP UNTIL BOARD(1)
 '
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 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!)
 '
 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

SUB V13hKEY STATIC
 '
 I = INP(&H60)
 IF (I AND &H80) THEN
  BOARD(I XOR &H80) = FALSE
 ELSE
  BOARD(I) = NOT FALSE
 END IF
 DEF SEG = &H40: POKE &H1C, PEEK(&H1A)
 '
END SUB

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 V13hPAN (direction, increment, wrap)
 '
 incw1 = increment - 1
 DIM bufferX(0 TO incw1, clipXXleft TO clipXXright) AS INTEGER
 DIM bufferY(0 TO incw1, clipYYtop TO clipYYbottom) AS INTEGER
 segVIDEO = VARSEG(VIDEO(0))
 SELECT CASE direction
  CASE 1
   IF wrap THEN
    FOR z = 0 TO incw1
     DEF SEG = segVIDEO + ((clipYYbottom - z) * 20)
     FOR x = clipXXleft TO clipXXright
      bufferX(z, x) = PEEK(x)
     NEXT
    NEXT
    FOR z = 0 TO incw1
     FOR y = clipYYtop TO clipYYbottom
      DEF SEG = segVIDEO + (y * 20)
      bufferY(z, y) = PEEK(clipXXleft + z)
     NEXT
    NEXT
   END IF
   inc1 = clipYYbottom - increment
   inc2 = clipXXleft + increment
   inc3 = 319 * increment
   FOR y = inc1 TO clipYYtop STEP -1
    DEF SEG = segVIDEO + (y * 20)
    FOR x = inc2 TO clipXXright
     POKE (x + inc3), PEEK(x)
    NEXT
   NEXT
   IF wrap THEN
    FOR z = 0 TO incw1
     incw2 = incw1 - z
     DEF SEG = segVIDEO + ((clipYYtop + z) * 20)
     FOR x = clipXXleft TO (clipXXright - increment)
      POKE x, bufferX(incw2, (x + increment))
     NEXT
     ninc = clipXXleft
     FOR x = (clipXXright - incw1) TO clipXXright
      POKE x, bufferX(incw2, ninc)
      ninc = ninc + 1
     NEXT
    NEXT
    FOR z = 0 TO incw1
     inc1 = (clipXXright - incw1) + z
     FOR y = (clipYYtop + increment) TO clipYYbottom
      DEF SEG = segVIDEO + (y * 20)
      POKE inc1, bufferY(z, (y - increment))
     NEXT
    NEXT
   END IF
  CASE 2
   IF wrap THEN
    FOR y = 0 TO incw1
     DEF SEG = segVIDEO + ((clipYYbottom - y) * 20)
     FOR x = clipXXleft TO clipXXright
      bufferX(y, x) = PEEK(x)
     NEXT
    NEXT
   END IF
   inc1 = clipYYbottom - increment
   inc2 = 320 * increment
   FOR y = inc1 TO clipYYtop STEP -1
    DEF SEG = segVIDEO + (y * 20)
    FOR x = clipXXleft TO clipXXright
     POKE (x + inc2), PEEK(x)
    NEXT
   NEXT
   IF wrap THEN
    FOR y = 0 TO incw1
     incw2 = incw1 - y
     DEF SEG = segVIDEO + ((clipYYtop + y) * 20)
     FOR x = clipXXleft TO clipXXright
      POKE x, bufferX(incw2, x)
     NEXT
    NEXT
   END IF
  CASE 3
   IF wrap THEN
    FOR z = 0 TO incw1
     DEF SEG = segVIDEO + ((clipYYbottom - z) * 20)
     FOR x = clipXXleft TO clipXXright
      bufferX(z, x) = PEEK(x)
     NEXT
    NEXT
    FOR z = 0 TO incw1
     inc1 = clipXXright - z
     FOR y = clipYYtop TO clipYYbottom
      DEF SEG = segVIDEO + (y * 20)
      bufferY(z, y) = PEEK(inc1)
     NEXT
    NEXT
   END IF
   inc1 = clipYYbottom - increment
   inc2 = clipXXright - increment
   inc3 = 321 * increment
   FOR y = inc1 TO clipYYtop STEP -1
    DEF SEG = segVIDEO + (y * 20)
    FOR x = inc2 TO clipXXleft STEP -1
     POKE (x + inc3), PEEK(x)
    NEXT
   NEXT
   IF wrap THEN
    FOR z = 0 TO incw1
     incw2 = incw1 - z
     DEF SEG = segVIDEO + ((clipYYtop + z) * 20)
     FOR x = (clipXXleft + increment) TO clipXXright
      POKE x, bufferX(incw2, (x - increment))
     NEXT
     ninc = clipXXright - incw1
     FOR x = clipXXleft TO clipXXleft + incw1
      POKE x, bufferX(incw2, ninc)
      ninc = ninc + 1
     NEXT
    NEXT
    FOR z = 0 TO incw1
     inc1 = (clipXXleft + incw1) - z
     FOR y = (clipYYtop + increment) TO clipYYbottom
      DEF SEG = segVIDEO + (y * 20)
      POKE inc1, bufferY(z, (y - increment))
     NEXT
    NEXT
   END IF
  CASE 4
   IF wrap THEN
    FOR y = clipYYtop TO clipYYbottom
     DEF SEG = segVIDEO + (y * 20)
     FOR x = 0 TO incw1
      bufferY(x, y) = PEEK(clipXXleft + x)
     NEXT
    NEXT
    END IF
   inc1 = clipXXright - increment
   FOR y = clipYYtop TO clipYYbottom
    DEF SEG = segVIDEO + (y * 20)
    FOR x = clipXXleft TO inc1
     POKE x, PEEK(x + increment)
    NEXT
   NEXT
   IF wrap THEN
    FOR y = clipYYtop TO clipYYbottom
     DEF SEG = segVIDEO + (y * 20)
     inc1 = (clipXXright - incw1)
     FOR x = 0 TO incw1
      POKE inc1 + x, bufferY(x, y)
     NEXT
    NEXT
   END IF
  CASE 6
   IF wrap THEN
    FOR y = clipYYtop TO clipYYbottom
     DEF SEG = segVIDEO + (y * 20)
     inc1 = (clipXXright - incw1)
     FOR x = 0 TO incw1
      bufferY(x, y) = PEEK(inc1 + x)
     NEXT
    NEXT
   END IF
   inc1 = clipXXleft + increment
   FOR y = clipYYtop TO clipYYbottom
    DEF SEG = segVIDEO + (y * 20)
    FOR x = clipXXright TO inc1 STEP -1
     POKE x, PEEK(x - increment)
    NEXT
   NEXT
   IF wrap THEN
    FOR y = clipYYtop TO clipYYbottom
     DEF SEG = segVIDEO + (y * 20)
     FOR x = 0 TO incw1
      POKE (clipXXleft + x), bufferY(x, y)
     NEXT
    NEXT
   END IF
  CASE 7
   IF wrap THEN
    FOR z = 0 TO incw1
     DEF SEG = segVIDEO + ((clipYYtop + z) * 20)
     FOR x = clipXXleft TO clipXXright
      bufferX(z, x) = PEEK(x)
     NEXT
    NEXT
    FOR z = 0 TO incw1
     FOR y = clipYYtop TO clipYYbottom
      DEF SEG = segVIDEO + (y * 20)
      bufferY(z, y) = PEEK(clipXXleft + z)
     NEXT
    NEXT
   END IF
   inc1 = clipYYbottom - increment
   inc2 = clipXXright - increment
   inc3 = (321 * increment)
   FOR y = clipYYtop TO inc1
    DEF SEG = segVIDEO + (y * 20)
    FOR x = clipXXleft TO inc2
     POKE x, PEEK(x + inc3)
    NEXT
   NEXT
   IF wrap THEN
    FOR z = 0 TO incw1
     incw2 = incw1 - z
     DEF SEG = segVIDEO + ((clipYYbottom - z) * 20)
     FOR x = clipXXleft TO (clipXXright - increment)
      POKE x, bufferX(incw2, (x + increment))
     NEXT
     ninc = 0
     FOR x = (clipXXright - incw1) TO clipXXright
      POKE x, bufferX(incw2, (clipXXleft + ninc))
      ninc = ninc + 1
     NEXT
    NEXT
    FOR z = 0 TO incw1
     inc1 = (clipXXright - incw1) + z
     FOR y = clipYYtop TO (clipYYbottom - increment)
      DEF SEG = segVIDEO + (y * 20)
      POKE inc1, bufferY(z, (y + increment))
     NEXT
    NEXT
   END IF
  CASE 8
   IF wrap THEN
    FOR y = 0 TO incw1
     DEF SEG = segVIDEO + ((clipYYtop + y) * 20)
     FOR x = clipXXleft TO clipXXright
      bufferX(y, x) = PEEK(x)
     NEXT
    NEXT
   END IF
   inc1 = clipYYbottom - increment
   inc2 = 320 * increment
   FOR y = clipYYtop TO inc1
    DEF SEG = segVIDEO + (y * 20)
    FOR x = clipXXleft TO clipXXright
     POKE x, PEEK(x + inc2)
    NEXT
   NEXT
   IF wrap THEN
    FOR y = incw1 TO 0 STEP -1
     incw2 = incw1 - y
     DEF SEG = segVIDEO + ((clipYYbottom - y) * 20)
     FOR x = clipXXleft TO clipXXright
      POKE x, bufferX(incw2, x)
     NEXT
    NEXT
   END IF
   '
  CASE 9
   '
   IF wrap THEN
    FOR z = 0 TO incw1
     DEF SEG = segVIDEO + ((clipYYtop + z) * 20)
     FOR x = clipXXleft TO clipXXright
      bufferX(z, x) = PEEK(x)
     NEXT
    NEXT
    FOR z = 0 TO incw1
     inc1 = (clipXXright - z)
     FOR y = clipYYtop TO clipYYbottom
      DEF SEG = segVIDEO + (y * 20)
      bufferY(z, y) = PEEK(inc1)
     NEXT
    NEXT
   END IF
   inc1 = clipYYbottom - increment
   inc2 = clipXXleft + increment
   inc3 = (319 * increment)
   FOR y = clipYYtop TO inc1
    DEF SEG = segVIDEO + (y * 20)
    FOR x = clipXXright TO inc2 STEP -1
     POKE x, PEEK(x + inc3)
    NEXT
   NEXT
   IF wrap THEN
    FOR z = 0 TO incw1
     incw2 = incw1 - z
     DEF SEG = segVIDEO + ((clipYYbottom - z) * 20)
     FOR x = (clipXXleft + increment) TO clipXXright
      POKE x, bufferX(incw2, (x - increment))
     NEXT
     ninc = incw1
     FOR x = clipXXleft TO clipXXleft + incw1
      POKE x, bufferX(incw2, (clipXXright - ninc))
      ninc = ninc - 1
     NEXT
    NEXT
    FOR z = 0 TO incw1
     inc1 = (clipXXleft + incw1) - z
     FOR y = clipYYtop TO (clipYYbottom - increment)
      DEF SEG = segVIDEO + (y * 20)
      POKE inc1, bufferY(z, (y + increment))
     NEXT
    NEXT
   END IF
 END SELECT
 '

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 V13hSEE
 '
 DEF SEG = VARSEG(VIDEO(0)): BSAVE "video.tmp", 0, &HFA00
 DEF SEG = &HA000: BLOAD "video.tmp", 0
 '
END SUB

SUB V13hSET
 '
 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 "video.tmp", &H0, &HFA00
 DEF SEG = VIDEOseg: BLOAD "video.tmp", 0
 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
 '
 V13hDEL calibrate!
 '
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



Please don't distribute this program, I need to finish it first ;)

P.s...
let me know what you think, my goal here is to create the fastest pure QB screen 13 library on the internet!

Cya.


Title: 100% QB game
Post by: relsoft on July 30, 2004, 06:03:23 AM
Cool Lib. :*).

http://rel.betterwebber.com/junk.php?id=4


Title: 100% QB game
Post by: na_th_an on July 30, 2004, 09:28:01 AM
If you wanna this to be the fastest PQB lib, I suggest you to remove the disk usage for buffering.


Title: 100% QB game
Post by: Plasma on July 30, 2004, 09:51:07 AM
Nice, but if something is copyrighted it cannot be public domain. You'll have to choose one or the other.


Title: 100% QB game
Post by: Nemesis on July 30, 2004, 11:56:49 AM
THANX for trying the lib everyone, note that it's content is pretty bare compared to most of the current libs available, but I'm working on it :)
And Relsoft, I've seen your QBlib and it's very nice, with lots of routines, and pretty fast too!

Quote from: "na_th_an"
If you wanna this to be the fastest PQB lib, I suggest you to remove the disk usage for buffering.


Yeah, I was thinking using the HD for the buffering (copying the VIDEO buffer to the VGA) might pose some problems, but on the systems I tested it on, using that method as opposed to blasting it using PUT was faster. So I might include an option allowing the user to choose the  method he/she prefers.
(Thanx for pointing that out!)

Cya.


Title: 100% QB game
Post by: Spotted Cheetah on July 30, 2004, 02:15:42 PM
(I am still here :) - but that hellish Hungarian interned supporter put out my last chance to visit the Web frequently... :( )

I will test that Screen 13 lib on my 30Mhz 4.86 - will it be better than my fastest routines? I tried many things, but i never could reach something what was able to handle graphic fast enough to make smooth animation...

I am now working on a very big project, but i do not think that i will be able to finish it since i possibly lose all my free times when i will go to university - and possibly the possibility of working on any computer... I will try everything to keep on since i went too far already. For example i was able to create a very good - looking pseudo - 3D engine with filled triangles on Screen 9 what was able to display at about 100 triangles per clock tick on a 120 * 640 area of the screen what was a really good (looking) result... I will only put up that (with source of course) when the thing is 100% finished...


Title: 100% QB game
Post by: Spotted Cheetah on July 31, 2004, 01:59:11 PM
That SCREEN 13 library was slow like a slug on my computer and driven my HDD mad :( You have to work on it more...

First of all, as everyone said: forget that HDD thing! For loading you can use it, since then the disk cache does the dirty job (even on my old computer), but when saving it always uses the disk to not lose data. On the other hand you should think about it when only loading too since PEEKing a byte from memory is always much faster than doing the same thing from a file. But for example PEEKing 8 bytes or more is slower if you get them from the file in one chunk (a$ = STRING$ (8, 0): GET #1, , a$).

There was a game here what made the SCREEN 13 thing perfectly, but a bit not "fair" since it rewrote some parts of QB: Bubble Fight. The "unfair" thing was that it found the space where QB stores the segment of the video memory (Without ASM, only PEEKs and POKEs), and changed it when it was necessary to make page flipping. It produced 15 FPS on my computer.

There is a trick what i consider "fair" since it can be get from QB's help and a little of thinking (And NC's HEX wiever & some BSAVEd files, for example the pictures from QBPDraw). This is the "BLOAD cheat": You can load any file with it fast as the lightning if you know what is the header what you need to attach to the file. From the help it can be found out that BSAVEd files contain their original segment & offset and their size. This is 6 bytes. The actual header is 7 bytes, after viewing some QBP and QBM files (The output of QBPDraw) i could describe it completely: Starts with CHR$(253), then Segment, then Offset, and at last Size (Then i wrote an add - on to QBPDraw what can create a four letter custom header for the BSAVEd files using the not really needed Segment & Offset values :) ). So the cheat: open the file, and read it's first 7 bytes into the destination array. Then replace those 7 bytes to the appropriate BSAVE header (You only need to set the size: LOF(file)-7). After close it, and BLOAD starting at the array's 8th byte. When it is done, You can reopen it, and write back it's original first 7 bytes from the destination array.
Run it with a larger file (>5000 bytes), and you will be surprised :)
The main advantage of it is that you can load the file to any array this way fast, you won't need strings.

My other way of optimization is to cut out everything what is not really necessary. I wrote "pseudo - 3D" before since i originally started by writing a full engine, but the project i am working on did not need it. Many parts of the 3D could be pre - calculated, so i did them to make it faster. I could reach this way that i can put virtually unlimited number of triangles on the screen, only their size count (I tried it with an object with at about 50 small triangles, and there was no noticeable speed - loss. Only the number of graphic operations count).

And finally: to make subs and functions :) Careful design can reduce the code size dramatically since there are many things in a program what are being done similary. But avoid them at speed - critical parts: at those codes calling subs can make the thing slow, not to mention that you will not see the code in one piece what makes optimization impossible.

I only noticed a few months before that QB has an integer divison operand. Very useful at speed. I am telling about it since i think it was not only me who did not know it since i had seen tons of FIX (a / 2) or INT (b / 5) style codes in many programs. Integer divison is the same as INT (a / b), but without floating point. You can make real rounding too (if you not need to be very accurate) by this scheme: (a + b \ 2) \ b


Why i am not posting anything on my project? This is because i do not want to create something like an unfinished Titanic: Everybody can see the code, and that it would be a great thing if it was finished - but it is not. Just a skew of a huge ship, but useless... The other thing is that coding is not the most important part of it: it will (and not only "will", it has already) huge amounts of unique graphic, and style (And i am planning to write music for it too but then i will have to create a sequencer since i could not find any what fit my needs and it's output format was documented somewhere). Because of this nobody would be able to finish it, since my style is mine, it can not be reproduced (I am not meaning here that i am perfect, but nobody knows how i am planned the things, and i think nobody can make graphics, sounds, and style "compatible" with mine, so it is impossible to finish this project without me. And every programmer has his or her own style: if anybody plans to write something really unique, then only he or she can make it finished even if there are many other people helping him or her...)


Back to the Screen 13 library: That keyboard handling is not really good. Once i tried a code working the same way on a computer equipped with Windows XP, it ran, but at exit the OS completely went mad that the only way to stop it was to pull the plug... That method has a bug: the keyboard only sends data when it sends a sign first that it has data what starts Interrupt 9. So at every manual call to Port H60 is a fault: the keyboard is not ready to send the data then. The only way of making a real multikey routine is to reprogram Interrupt 9 what is impossible in pure QBasic (without ASM). The only way to make multikey feeling is to use CTRL, ALT and SHIFT keys (These six keys can be accessed completely independently by reading the appropriate memory locations). This is possible with INSert, Caps Lock, Scroll Lock, and Num Lock too, but using these keys is not a really good idea...


(Note: i pre - wrote this in Notepad, so if anybody had replied to the subject before me, or i am not repliing to something, i am sorry... I have no time to read the topic when i am online)


Title: 100% QB game
Post by: Plasma on July 31, 2004, 09:21:43 PM
If SetVideoSeg is "unfair" then reading the keyboard with INP(&H60) and changing the DAC with OUT &H3C8/9 are also "unfair." :P

Actually, I'd like to know what your definition of "fair" is...


Title: 100% QB game
Post by: na_th_an on July 31, 2004, 11:46:30 PM
Sure. Just look at the code of setvideoseg. It's pureQB.


Title: 100% QB game
Post by: Spotted Cheetah on August 01, 2004, 04:09:18 PM
Fair, and not fair...

I only told that i think the Bubble Fight way is not really "fair" in my
opinion, but it is acceptable. I consider hacking in QB not really fair
since there are no documentations on it, only who deassembled QB can do this
(Microsoft never gives it's source codes to the public...). On the other
hand i not really looked around in Bubble Fight, i do not know exactly how
it does the thing, so i may not be 100% correct (but as the problem rised i
will study it).

The ports are legal since there are tons of documentation on them, so
everybody can deal with them. For example a very good source is Ralph Brown's
Interrupt List (I look up everything from there if i need). And QBasic has
functions to handle them.

Assembly is not permitted since it is an other language. If somebody writes
QB, not write tons of ASM and say that it is a QB code... If somebody
includes his or her own ASM, it is a very good thing, but a different "art".

The case of libraries, or third - party ASM is different. Then who uses that
up, usually not know anything of their work, just call those subs, and wonder
on the result. This is the worst since they use up other people's work
without knowing anything of them. I do not really like those programmers who
say "look, i wrote a real 3D game", but just fed X, Y and Z with the
appropriate function without knowing anything of 3D's real structure.


The case of INP &H60 is different. It is not "not fair", it is a fault. For
example i originally had a keyboard which started a horrible beep when
feeding it with this. And the Win XP which completely went mad after running
a program using this style of keyboard handling. It is NOT programmed in the
keyboard to send data when it does not send the signal "i have got data". So
it is not "not fair", it is "illegal function call", and the "compiler should
stop". On the other hand you can use it, but keep in mind that it can result
unpredictable things on certain configurations...


Title: 100% QB game
Post by: relsoft on August 02, 2004, 12:52:30 AM
Could make bubble fight in screen 7 and it would look the same. :*)
But SetVideoSeg is a lot easier to use at that time and no one mentioned it being illegal. :*)


Title: 100% QB game
Post by: Z!re on August 02, 2004, 07:48:55 AM
Cheetah, the keyboard starts to beep because you don't clear the keyboard buffer if using INP 60...

Adding an inkey$ solves the problem.


INP 60 is not a bug, or a faulty port, it's the keyboard port, and as such you can read it.


QB has peek and poke commands, as well as out and inp... why would it be cheating using them?


Although, SuperPut contains ASM routines, already compiled, which is copied into QB's memory. So, in effect, SuperPut could be considered a cheat.


Title: 100% QB game
Post by: Plasma on August 02, 2004, 09:33:21 AM
No compiler was used in the creation of SuperPut. :P


Title: 100% QB game
Post by: na_th_an on August 02, 2004, 10:10:09 AM
Everything that just uses QB commands is PQB. And as Z!re said, POKE, PEEK, INP and OUT are QB commands and functions.

Anyhow the concept of "cheating" when coding is a nonsense to me, 'cause this is not some kind of honour game. This is coding. Making a program that does something. It's very odd that some people think that some ways to get that simple objective are "unfair". Really, really odd.


Title: 100% QB game
Post by: Spotted Cheetah on August 02, 2004, 03:52:42 PM
Do not think that i am so fool that i forgot to INKEY$ with using PORT &H60. The keyboard
did the beeping when it ran in INP &H60, at any program, not only mine. THE KEYBOARD IS NOT
PROGRAMMED TO SEND DATA WHEN IT DOES NOT SEND THE SIGNAL THAT IT HAS DATA!!! Consider that
an "undocumented feature". On some configurations it will work, on some others, it won't.
WinXP (and i think Linux too, but it will not freeze) is very sensible on ports, you can
not read or write what you think. Be careful with that INP &H60!
(To tell the truth, i "forgot" INKEY$, when i tried to program that way, but i catched the
memory locations of the keyboard buffer, and set everything to serve me. It works on my
current computer as all of the other INP &H60 based programs)

Fair and not fair... I consider something fair when there is documentation on it. If
RelSoft describes it completely why(!, not only "how"), and how it work, the thing becomes
"fair". But until not giving that, or just give to "change these bytes, and be happy", it
is something like Forma 1 where everybody tries to hide his technology. This competition
needs to have programs with completely documented code (or codes where all of the
documentation needed can be found at common places, for example QB's help, or Ralph Brown's
Interrupt List) so that we can check if it is really pure QB. If we would let programs
with parts what nobody can describe correctly, then we can not make sure that the thing
really fits here, so the programmers would only need to write a huge mess what nobody can
decode, so it will be ok...
If somebody just changes some bytes randomly, and then "oops, this changed the video
offset", so he or she writes a code based on it, then i think it is not acceptable. If
somebody writes something then he or she have to know what it does. If not, then it is
irresponsibility. For example what if he or she found a setting specific to his video -
card, but an other system it would result an error, and blows up the CPU ??? (I do not
think that Bubble Fight was made based on this, but the working of QBasic is not a really
common thing. If using up such things then a documentation should be inserted, or a
location from where it can be downloaded.)


Title: 100% QB game
Post by: na_th_an on August 02, 2004, 04:21:07 PM
I bet Plasma didn't discover it but worked on it. The IBM PC is very well documented. SetVideoSeg just fools QB so it thinks that the video segment is somewhere else. Only that it is not in the QB help.

The dirty rectangles technique using an array of changes and GET/PUT is not in the QB help as well, but it is really useful. Is that unfair?

I can understand when people just use the QB commands for the challenge, but not using some techniques is out of my understanding. Mostly when those techniques are done using PQB.

If you have a very old and slow machine, you should work using the fastest techniques. The good thing about QB being almost 20 years old is that it has been hacked here and there and there is an almost complete understanding of how it works. We have a collection of hacks and techniques that help us making better games. The faster the better. Maybe you don't need it to show two balls in a black background, but if you can get that speed, you can use the extra time to add effects, scrolling or even sound.

I coded one of my games in SCREEN 7 and I couldn't make it work at full rate in my 233 Mhz computer. The uber optimized algorithms couldn't go faster having the weight of the megaslow QB graphics routines. When I reach to this point, I realize what I have to replace: the bottle neck. I think it is better to have a good game, not a good PQB algo. You can't play with the algo ;)


Title: 100% QB game
Post by: Plasma on August 02, 2004, 10:02:13 PM
SetVideoSeg simply changes the variable where QB stores the active video segment. Previously, this was not documented anywhere, however, the heavily-documented source (http://home.carolina.rr.com/davs/codepost/archives/VIDEOSEG.BAS) has been available for anybody to use since day 1. As you can see, it does not 'randomly change bytes' and I guarantee it will not blow up your CPU.


Title: 100% QB game
Post by: relsoft on August 03, 2004, 01:00:23 AM
In essence FFIX is a lot more unfair than SetVideoSeg because FFIX changes a code(INT 3dh) while SetvideoSeg just changes a variable. :*)


Title: 100% QB game
Post by: KiZ on August 03, 2004, 07:33:57 AM
But remember, FFIX really isnt unfair, because it is just fixing a bug that should never have been there in the first place. I would still consider a program that uses FFIX to be PureQB.


Title: 100% QB game
Post by: relsoft on August 03, 2004, 11:24:44 PM
Quote from: "dark_prevail"
But remember, FFIX really isnt unfair, because it is just fixing a bug that should never have been there in the first place. I would still consider a program that uses FFIX to be PureQB.


Following your line of reasoning, I would consider using SetVideoSeg as not cheating(SuperPUT would) as it's also a fix.  QB's programmers could have done it when they made the compiler.  But they didn't as they didn't use Fwait in place of 3dh. :*)


Title: 100% QB game
Post by: na_th_an on August 04, 2004, 08:57:06 AM
Exactly. FFIX is the same thing as SETVIDEOSEG: Both are patching QB in one way or another.


Title: 100% QB game
Post by: Nemesis on August 04, 2004, 11:44:27 AM
Spotted Cheetah...
>>That SCREEN 13 library was slow like a slug on my computer and driven my HDD mad  You have to work on it more...<<

It was slow probablly because you said you were testing it on a 33 MHZ. machine, which will run slow with pratically any pure QB proggies. As for your HD going mad, you might not of had a disk cache active, that would be the only thing I could think of that would cause the HD to react like that. But you seem skilled enough with computers that you would've already known this was the problem, so I don't know.

>>First of all, as everyone said: forget that HDD thing! For loading you can use it, since then the disk cache does the dirty job (even on my old computer), but when saving it always uses the disk to not lose data.<<
 
Yeah, liike I mentioned in a previous post I might change this method to a PUT type method for copying the video buffer.
But like I also said, with all the machines I tried it on, the BLOAD/BSAVE method with a disk cache active was faster than using PUT.

>>On the other hand you should think about it when only loading too since PEEKing a byte from memory is always much faster than doing the same thing from a file. But for example PEEKing 8 bytes or more is slower if you get them from the file in one chunk (a$ = STRING$ (8, 0): GET #1, , a$).>>

Actually using bit logic is faster than peek!


>>There was a game here what made the SCREEN 13 thing perfectly, but a bit not "fair" since it rewrote some parts of QB: Bubble Fight. The "unfair" thing was that it found the space where QB stores the segment of the video memory (Without ASM, only PEEKs and POKEs), and changed it when it was necessary to make page flipping. It produced 15 FPS on my computer.<<

Yeah no one is going to completely agree what is fair and what is not fair. In a early post I listed a few things that I think is fair for labeling something pure QB, and SETVIDESEG seems fair to me.
Though I discovered SETVIDEOSEGMENT on my own by messing around with a program I wrote called FIP, which stood for File Info Pointer. It basically scanned memory until it found the bytes ''File_in'' or something like that, and would record the offset. Besides finding where QB stored it's graphics output address I've found various other goodies like where DEF SEG was and where to find current drive letters, files and their directories, and even the command line. Which everyone already knows anyways :)

But to get back to my lib, Cheetah, you make it sound like it's real slow which upsets me a bit, since I'd like to get a name out for it being one of the fastest pure QB libs out there. It uses alot of optimizing techniques that I think you  overlooked, for instance,
in the sprite routine notice there is no LONG& integer calculations, also notice how I've took all the major calculations out of the deepest loops including DEF SEG which most routines don't do. all that together with trying to make it some what effecient too.
(I mean anyone could make it faster by unrolling loops, and converting the bytes to integers as LUTs, etc...but like I said I wanted to make the lib effecient too!)

So, anyways just check out the sprite blitting routine and try a different method of blasting the buffer if the current method isn't working well for your computer.
(You'll realize the speed my lib actually posseses :)

CYA.


Title: 100% QB game
Post by: Spotted Cheetah on August 04, 2004, 01:09:02 PM
What a huge mess was risen on this fair and unfair thing! But i started it, i must put
everything in order then...

There is a big problem with defining the Pure - QB thing. Programmers are so tricky that
they can cheat with almost everything...
For example if Pure QB would mean "codes without Call Absolute". Then i would write an
interrupt handler in ASM (it would be possible as i know how to write ASM), POKE it to an
empty memory location, and point a free interrupt vector to that. Bingo, and no Call
Absolute...

Then the definition of Pure QB in my opinion:
Codes without Call Absolute, but everything else is useable. The other restriction is
that the programmer must not execute data moved with any QB command (I think this last
is enough then, since then what to Call Absolute? :) ).

This definition makes Bubble Fight's technique legal. I only do not really liked it, and
considered it a bit unfair since it works with a little of "guessing". For example what
if an other sequence accidentally holds that four bytes too? Then bye - bye, hit
CTRLALTDEL, or Reset if it overwrites some system area...

When using "guessing" (into an unknown area like the computer's memory, not for examlpe
into the program's data files where the programmer is sure about what he or she can
except there) the programmer should call the user first so that they can prevent
failures, or fix it themselves if it occured (for example when autodetecting a sound
card it is possible that the program runs into a port what serves different purpose
freezing the computer. If it happens, and the user knows what is his or her sound - card
address, then fixing is possible if the autodetection can be cancelled). In the case of
Bubble Fight this way of fixup impossible, so if it fails on somebody's computer, then
there is no way to play with it.

FFIX, and speed - ups like that are legal as long as the code works well without them.
But these speed - ups should be cutted out for the competition. I let FFIX because it is
just a DECLARE SUB FFIX: FFIX statement pair, what can be easily cut out to test the
code's pure - QB speed. On the other hand i use fixed - point values at speed - critical
parts in my codes, so FFIX has not really got any affect on my programs' speed.

Cutting out these speed - ups are essential to this competition, since then it would be
possible that somebody just fails because he or she never heard about FFIX or something
else...

I think QB is not as slow as everybody thinks. For example my pseudo - 3D engine ran
nicely at somewhere between 14 and 20 FPS even running it with Windows playing MIDIs in
the background. This can not be called "slow" (I tried it with turning off Turbo too
when my computer ran at 11Mhz. It produced 6 to 9 FPS what is still acceptable. For
example Groov Buggies with wire - 3D ran at the same speed on a P233). If somebody finds
the things what QB can do fastly (For example the BLOAD cheat) then nobody will be able
to tell that the compiled program was created in QB (unless saying it). If the game we
are writing (in the Society which i told about before) will be finished ever, you will
see what i mentioned. Believe me, we are really working on it, but it is such a big
project that it is possible that we will only finish it in 2005. Or 2006 or later if
everything will go so bad as we currently can predict :(. At about three quarter of the
main technical part is ready already, so the speed is sure. But that will not only be
technique... Wait for it, we are working...


Title: 100% QB game
Post by: Z!re on August 04, 2004, 02:22:47 PM
Cheetah.. About QB being slow, I agree with you, it's actually pretty fast (On todays machines that is!)

That said, it's slower then many other programming languages.

I'm half working on my RPG project at the moment, and the world map is huge, 256 areas, each area is 320x200 tiles, each tile is 64x64 pixels.

No loading time betveen areas, and I mean none.. 30-40 FPS, at all times, even with 4 animated sprites running on screen.

Only "cheat" would be SuperPut (SetVideoSeg)

(I'm not in this challenge no)


But still, you started the challenge, and you make the rules.

Here's a suggestion: Add a rule, saying that the programmer cannot use other peoples code.

And not alter or manipulate QB's code in any way, the programs should be pure QB, without any fix.

That means sluggy GET/PUT routines, slow gfx aso...


Title: 100% QB game
Post by: na_th_an on August 04, 2004, 05:01:00 PM
Quote from: "Spotted Cheetah"
For example what
if an other sequence accidentally holds that four bytes too? Then bye - bye, hit
CTRLALTDEL, or Reset if it overwrites some system area...
Quote


There is just 1 chance among 4Gb (over 4,000,000,000) that such a thing happens. And if this happens, there is even a smaller chance that this is a piece of code (the bytes translated to opcodes, taking in account the possible shifts, don't make any sense, so they won't ever belong to executing code (which is supposed to be correct 'cause it's running)). Also, this pokes in the 1st half of the QB segment, so no system area damaged.

SETVIDEOSEG is not harmful in any way.

Games using just PQB without this kind of alterations are whether slow or ugly. If you use double buffering you have to use your own PUT/GET routines, which will be slow as hell for sure. No matter how much you optimize: they will be slow as hell. 'cause QB is slow as hell. If you want to use the built-in GET/PUT routines then you won't be able to make a double buffer in SCREEN 13 thus your program will look flickery and ugly.


Title: 100% QB game
Post by: Z!re on August 04, 2004, 05:57:04 PM
Nath, doesent the windows DOS VM protect the memory?

So, for example, you can't trash other programs etc from inside a QB program using POKE...


Or is it just me living in my own happy, perfect, world of no bugs/errors :roll:


Title: 100% QB game
Post by: relsoft on August 05, 2004, 01:52:00 AM
Spotted Chetaah:

Want me to make Bubble fight run on the same system at 40 FPS w/o SetVidoSeg and no ASM?  I can do it if you want. :*)

1.  The collision detection could be made a lil simpler and faster by not using SQR
2.  I could use the "dirty rectangle animation" Nath was taking about.
3.  And the biggest bottleneck? It uses the FPU.  I could convert all the vector stuff in Fixpoint math and it would run wild on the same system. :*)


Title: 100% QB game
Post by: Spotted Cheetah on August 05, 2004, 01:08:41 PM
Nemesis:

I did not want to exasperate you, but when somebody downloads something "fast", then he
not except that fastness to be 2 - 4 FPS with hearing annoying HDD sounds from under the
table all the time. Especially when this person had already tried many things to achieve
the same.

I will remake that then. The way i worked was to create a GET / PUT buffer, and alter
that as fast as possible. As i can remember i got something around 5FPS with that code
modifiing all pixels of the screen.

At the optimization side i had tried more things than what you can imagine :)
For example it appeared me that constant * variable is at about 1.1 times faster than
variable * constant. Would you ever try that if i do not tell? Of course i not only make
such silly things, i always look around in everything.


I now remade that way of PSETting, and i got 5.6 FPS with it. Here is the code:
(I woke up at four o'clock in the morning as i could not sleep, so do not ask what was
in me when i had written this code :) )

Code:

DEFINT A-Z


'$DYNAMIC
DIM scrArr%(-2 TO 31999)
'$STATIC
DIM SHARED xArr%(319)
DIM SHARED yArr%(199)
DIM SHARED m256Arr%(255)

FOR i% = 0 TO 319: xArr%(i%) = i% \ 2: NEXT i%
FOR i% = 0 TO 199: yArr%(i%) = i% * 160: NEXT i%
FOR i% = 0 TO 127
 m256Arr%(i%) = i% * 256
 m256Arr%(i% + 128) = (i% - 128) * 256
NEXT i%


SCREEN 13


FOR j% = 0 TO 319
 FOR k% = 0 TO 199
  arr% = xArr%(j%) + yArr%(k%)
  IF 1 AND j% THEN
   scrArr%(arr%) = &HFF AND scrArr%(arr%) OR m256Arr%(&HFF AND j% AND k%)
  ELSE
   scrArr%(arr%) = &HFF00 AND scrArr%(arr%) OR (&HFF AND j% AND k%)
  END IF
 NEXT k%
NEXT j%
PUT (0, 0), scrArr%(-2), PSET



(Usual PSET runs at 1.7 FPS, POKEing at 2.5 FPS on my computer)

It will be very - very slow in the IDE, but works compiled. I left the two FORs in their
usual form to test it like real PSETting where we tell the routines X, Y and Color (I
made a sub - calling form where you can call a sub with X and Y and Color, but it
produced only 2FPS. It is better to include the code as PSETting).

It is the slowest way to put pixels. Horizontal lines would be much faster (after
reworking the code of course), and putting object won't be slow too if it is enough for
the programmer to use only every second pixel of X as start point. Not to mention that
this way is 100% filcker - free.




I do not like that HDD stuff too because i think it is not really good to that poor HDD
to work all the time. Remember that it is mechanic so it has not got unlimited lifetime.
When writing data it has to move it's heads all the time what may shorten it's life. The
best is to use the memory as long as it can be used, and only start 'annoying' that HDD
when it is full so the data can not be written anywhere else. And not to mention that
you not only drive the HDD mad but the user too who have to listen it all the time (and
possibly exits to Windows, and tries to find "what the hell is working in the
background again", but nothing does).



(Sorry for these late replies and that it looks like i am not reading the topic, just
throwing things on it, but i have no time. When i go online, i always download the topic,
and post the reply to the state i downloaded at last time :( )


Title: 100% QB game
Post by: Nemesis on August 05, 2004, 03:53:41 PM
Cheetah the code you posted gave me errors, but to me it
looks like you were simply manipulating words in the buffers
array which isn't going to be much faster, if even faster, than
just using good ole POKE/PEEK.
Now you keep talking about my code driving your HD crazy
but I already mentioned to you about using a cache.
When a cache is active you HD doesn't need to access
it's hardware every frame, instead it uses cached RAM
so you shouldn't have those problems when one is present.
Since your using such old hardware this might be your main
problem when running my code. I think it's time you did a little,
umm, upgrading there guy!
Anyways you still ramble about how you got this fast, optimized
QB code but I still haven't seen it. (Not being rude, just stating the facts.)
But to give you a better understanding of the kind of optimations
I made when I coded my library I decided to post this little demonstration...

Code:

DEFINT A-Z
SCREEN 13
DO: LOOP UNTIL TIMER <> TIMER: t! = TIMER
DEF SEG = &HA000
FOR c = 0 TO 255
 FOR y = 0 TO 199
  FOR x = 0 TO 319
   POKE 320& * y + x, c
  NEXT
 NEXT
NEXT
LOCATE 1, 1: PRINT TIMER - t!
SLEEP
'
DO: LOOP UNTIL TIMER <> TIMER: t! = TIMER
FOR c = 0 TO 255
 FOR y = 0 TO 199
  DEF SEG = &HA000 + (y * 20)
  FOR x = 0 TO 319
   POKE x, c
  NEXT
 NEXT
NEXT
LOCATE 1, 1: PRINT TIMER - t!
SLEEP
'
SYSTEM
'


This snippet above shows an optimization technique I used in my pure QB lib that elliminates the LONG& calculations when accessing the screen buffer. (Although the snippet doesn't use a screen buffer, but it's all the same type of blitting technique.)
When compiled it shows some dramatic speed increases!
Now I'm not acting like I invented the wheel here, or expecting to win a nobel prize, but it's just one of the ways I discovered how to squeeze just a little more speed outa poor QB.

Cya.


Title: 100% QB game
Post by: Z!re on August 05, 2004, 05:02:27 PM
Nemesis, your code doesent make my HD go mad, but it's still slow.

I tried it on an older computer (In a library, a 133MHz 16MB RAM, and 5400RPM 3GB Disk)

It went nuts... Constant HD reading.


But the weird part is, it was almost as fast as on this computer, where it did use buffering.


And it's always a bad habit to use the disk as a buffer, even if it's fast. for reasons Cheetah already said, it shortens it's life to be read from and too all the time.

Even if it uses the buffer, it still has to read it every time it's changed, and write it too.

The buffer doesent help much there.


Title: 100% QB game
Post by: Plasma on August 05, 2004, 07:50:29 PM
Quote from: "Nemesis"
But to give you a better understanding of the kind of optimations
I made when I coded my library I decided to post this little demonstration...

Code:

DEFINT A-Z
SCREEN 13
DO: LOOP UNTIL TIMER <> TIMER: t! = TIMER
DEF SEG = &HA000
FOR c = 0 TO 255
 FOR y = 0 TO 199
  FOR x = 0 TO 319
   POKE 320& * y + x, c
  NEXT
 NEXT
NEXT
LOCATE 1, 1: PRINT TIMER - t!
SLEEP
'
DO: LOOP UNTIL TIMER <> TIMER: t! = TIMER
FOR c = 0 TO 255
 FOR y = 0 TO 199
  DEF SEG = &HA000 + (y * 20)
  FOR x = 0 TO 319
   POKE x, c
  NEXT
 NEXT
NEXT
LOCATE 1, 1: PRINT TIMER - t!
SLEEP
'
SYSTEM
'


This snippet above shows an optimization technique I used in my pure QB lib that elliminates the LONG& calculations when accessing the screen buffer. (Although the snippet doesn't use a screen buffer, but it's all the same type of blitting technique.)
When compiled it shows some dramatic speed increases!
Now I'm not acting like I invented the wheel here, or expecting to win a nobel prize, but it's just one of the ways I discovered how to squeeze just a little more speed outa poor QB.

Cya.


It's significantly faster because you're only multiplying once per scanline, instead of every pixel. A fair comparison would look like this:

Code:

DEFINT A-Z
SCREEN 13
DO: LOOP UNTIL TIMER <> TIMER: t! = TIMER
DEF SEG = &HA000
FOR c = 0 TO 255
 FOR y = 0 TO 199
  offset& = 320& * y
  FOR x = 0 TO 319
   POKE offset& + x, c
  NEXT
 NEXT
NEXT
LOCATE 1, 1: PRINT TIMER - t!
SLEEP
'
DO: LOOP UNTIL TIMER <> TIMER: t! = TIMER
FOR c = 0 TO 255
 FOR y = 0 TO 199
  DEF SEG = &HA000 + (y * 20)
  FOR x = 0 TO 319
   POKE x, c
  NEXT
 NEXT
NEXT
LOCATE 1, 1: PRINT TIMER - t!
SLEEP
'
SYSTEM


At which point you'll see the flaw in your test method: They're both about the same speed, because you're hitting the ceiling for video memory access. For a more accurate test you need to use system memory. (And a more accurate timer wouldn't hurt, either.)

As a side note, you actually don't need any multiplication at all, if you're just filling the screen:

Code:
DEF SEG = &HA000
FOR c = 0 TO 255
 offset& = 0
 FOR y = 0 TO 199
  FOR x = 0 TO 319
   POKE offset& + x, c
  NEXT
  offset& = offset& + 320
 NEXT
NEXT


or with your method:

Code:
FOR c = 0 TO 255
 offset = 0
 FOR y = 0 TO 199
  DEF SEG = &HA000 + offset
  FOR x = 0 TO 319
   POKE x, c
  NEXT
  offset = offset + 20
 NEXT
NEXT


Furthermore, if your program is compiled, you can take advantage of unsigned integers:

Code:
DEF SEG = &HA000
FOR c = 0 TO 255
 FOR y = 0 TO 199
  offset = 320 * y
  FOR x = 0 TO 319
   POKE offset + x, c
  NEXT
 NEXT
NEXT


or optimized:

Code:
DEF SEG = &HA000
FOR c = 0 TO 255
 offset = 0
 FOR y = 0 TO 199
  FOR x = 0 TO 319
   POKE offset + x, c
  NEXT
  offset = offset + 320
 NEXT
NEXT


Title: 100% QB game
Post by: Nemesis on August 06, 2004, 12:48:13 AM
Quote

At which point you'll see the flaw in your test method: They're both about the same speed, because you're hitting the ceiling for video memory access.


Oh shoot, I forgot to optimize the first test by moving the
calculation out of the second loop, sorry :(
(Plasma, thanx for catching that.)
Though not much faster, but faster, my method of switching the segment every scan-line still has a speed improvement over using
LONG& calculation which was what I was trying to convey.

Since it seems using my libs method of copying the screen buffer
to the video has unpredictable results with varying machines,
I've decided to go ahead and make some adjustments to the code
to be able to use PUT instead for that task. (The most common method.)

Also, Plasma, I already knew about using integers with compiled code will work for calculations >32767, but a good (real good)
programmer told me once it wasn't a good idea because it could
have unpredictable results and it wasn't the intention of the compilers creators. I suppose it was one of the many things MS, overlooked?

Cya.


Title: 100% QB game
Post by: Plasma on August 06, 2004, 10:19:05 AM
Well sometimes bugs do turn into features. :) I don't think IBM ever intended there to be a Mode X when they released the VGA, but it works all the same.

I've never had any problems using unsigned integers...if you're concerned, you could always run some tests yourself.


Title: 100% QB game
Post by: adosorken on August 06, 2004, 12:20:41 PM
Quote from: "Nemesis"
Also, Plasma, I already knew about using integers with compiled code will work for calculations >32767, but a good (real good) programmer told me once it wasn't a good idea because it could
have unpredictable results and it wasn't the intention of the compilers creators. I suppose it was one of the many things MS, overlooked?

There is no risk in using integers to perform calculations in which the results will need all 16 bits of the integer type. Whoever told you that probably screwed something up one day and developed some crazy fear of the BC integer bug. :D


Title: 100% QB game
Post by: Spotted Cheetah on August 06, 2004, 01:09:08 PM
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).


Title: 100% QB game
Post by: Nemesis on August 09, 2004, 05:27:31 PM
Quote from: "Spotted Cheetah"
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.


Title: 100% QB game
Post by: Nemesis on August 16, 2004, 03:38:47 AM
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


Title: 100% QB game
Post by: Spotted Cheetah on December 18, 2004, 09:41:46 PM
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.


Title: 100% QB game
Post by: BiLLaMoNsTeR on December 30, 2004, 10:02:55 PM
http://billamonster.aspfreeserver.com/programs.html#barrack


Title: 100% QB game
Post by: Spotted Cheetah on December 31, 2004, 05:59:32 PM
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 ;)


Title: 100% QB game
Post by: The Car on January 05, 2005, 04:00:13 PM
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/Lakes/7303/games.htm

Ah, memories..


Title: 100% QB game
Post by: Spotted Cheetah on January 14, 2005, 08:15:19 PM
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)


Title: 100% QB game
Post by: Nemesis on January 18, 2005, 01:50:23 AM
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!


Title: 100% QB game
Post by: j2krei08 on January 19, 2005, 05:12:36 PM
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:

Code:
100,"John Kreitlow"

That file will change as you beat the high score of 100.

Now, who wants to help compile it?


Title: 100% QB game
Post by: Z!re on January 19, 2005, 08:08:56 PM
What is this?, The topic of longest post?  :D


Title: 100% QBasic 1.0
Post by: Mac on January 20, 2005, 11:35:05 AM
http://www.network54.com/Forum/273951

Don't laugh. It's harder than you think!

But not impossible. I've reached Guru level before (and lost it - back to Master)

Mac


Title: 100% QB game
Post by: Z!re on January 20, 2005, 03:20:13 PM
Mac, wtf are you talking about?


http://forum.qbasicnews.com/viewtopic.php?t=8021


Title: To John KREITLOW
Post by: Mac on January 23, 2005, 01:41:08 PM
John,

Nice program, but it doesn't seem to work on faster computers.

I put in some WAIT &H3DA, 8, 8: : WAIT &H3DA, 8
to slow things down.

Also fixed the program so it can cope with lack of the hiscore file

Got a hiscore of 280. The changes are posted in the QBasic Forum Challenges subforum.

Mac

http://www.network54.com/Forum/message?forumid=202193&messageid=1106492553


Title: 100% QB game
Post by: Spotted Cheetah on January 28, 2005, 08:19:06 PM
Nemesis:

For pixel plotting i believe that POKEing is faster. But i think in a 3D engine nothing can beat my HLine routine in pure QB. In optimal case it updates 2 pixels in just one instruction while your code always need to call two functions to achieve the same! So i think both of us did not win... :) Use everything in it's proper place...

At sprite drawing if the programmer can solve that his sprites will always start at odd locations, my code will be faster again. Simply executing less QB statements. Possibly HLine can be boosted too with some bit manipulation mechanisms to use LONGs for the screen page array, but it might only help if using many larger triangles.

I think i will do some speed tests too, but as i said i am focusing on 16 color screens, i only use screen 13 for just this challenge.

The other programs: I will look in them when i will have time. I still think that Barrack is a very good idea :)


Title: 100% QB game
Post by: Nemesis on February 02, 2005, 12:02:52 AM
Quote

For pixel plotting i believe that POKEing is faster. But i think in a 3D engine nothing can beat my HLine routine in pure QB. In optimal case it updates 2 pixels in just one instruction while your code always need to call two functions to achieve the same! So i think both of us did not win...


Well, like I mentioned in my last post, we can't determine winners
or loosers if we don't even know what the competition is  :wink:
Anyways, I'll check out your HLINE routine but, I'm not convinced,
YET  :D Now about updating 2 pixels in just one instruction, ummm... where is this code? Maybe you're refering to updating 2 pixels per call to a subroutine??? If this is the case then maybe I should post a sprite routine I made a while ago which does just that...(blits more than 1 pixel per call).

Quote

At sprite drawing if the programmer can solve that his sprites will always start at odd locations, my code will be faster again.


Sure but, probablly wouldn't be very pratical unless it was something you're specifically using for your own projects.
Heh, I can make a similar routine myself in about 5 min.
just blit whole integers  :roll:

Quote

HLine can be boosted too with some bit manipulation mechanisms to use LONGs for the screen page array, but it might only help if using many larger triangles.


Yeah, actually using LONG integer manipulation, something I've already mucked with is pretty fast. It's a bit more complicated though. (Give it a shot though, I'd like to see what you come up with!)

Quote

I think i will do some speed tests too, but as i said i am focusing on 16 color screens, i only use screen 13 for just this challenge.


Well since we're talking about transfering, moving, blitting, whatever... data, than these routines can be used in any screen resolution. (With of course minor modifications.)

So, anyways dude, I'm not trying too be an arse or anything but,
until I see some hard proof...  :barf:  :rotfl:

J/K

Hey, we should chat sometime.... you got AIM?
Maybe just E-mail would be cool too.
I'd like to discuss some more stuff with you, exchange ideas, etc...

Cya!

Nemesis


Title: 100% QB game
Post by: barok on February 02, 2005, 12:29:54 AM
Nemesis:  You ARE competitive, are you?  Your really sure and are trying your best that you have the BEST put routine out there, aren'tcha?  ;)  First me, now Spotted Cheetah.  Keep this up, and i may have to go and rewrite my blitter and make it faster. ;)  

Still, i'll do a few tests for you two.  :D


Title: 100% QB game
Post by: Nemesis on February 02, 2005, 04:40:50 AM
Quote from: "barok"
Nemesis:  You ARE competitive, are you?  Your really sure and are trying your best that you have the BEST put routine out there, aren'tcha?  ;)  First me, now Spotted Cheetah.  Keep this up, and i may have to go and rewrite my blitter and make it faster. ;)  

Still, i'll do a few tests for you to.  :D


Heh... I've always been competitive my whole life, usually physical
type things but, yes very competitive  :king:
Best PUT routine out there? Naww, Ive seen alot better but,
as far as pure QB, I'd say it's probablly one of the fastest around though, you or I could make it faster. I kinda leaned towards making it not only fast but flexible, which usually sacrafices speed but, it makes for a more rounded routine. As of now, it really dosen't even have that many features yet. (I'll be adding more features here and there, I'm in no hurry though.)
Basically the PUT routine is part of my screen 13 gfx lib, which I'll use to make a few games that I have planned. I just started adding the rotozooming features for it, and as soon as I finish that
(really busy with other stuff at this time though), I'll release it to the public just so perhaps someone can learn from it or whatever.
Anyways, as far as it being one of the fastest pure QB put routines on the net, I'd say yes, (as far as what I've seen), but ofcourse, who's really writing QB PUT rutines anymore? It's like so obsolete, if I were to brag about it I'd be the biggest laughing stck on these forums  :rotfl:
I suppose I'll post the latest build later tonight so you and Cheetah can check it out, and if anyone makes a faster one then cool, I'd love to see it. If that were the case though, don't think you got me beat cause I'd tweak, optimize, or whatever, my routine and make it even faster  :D  :)  :lol:

Laters.

Nemesis


Title: 100% QB game
Post by: Nemesis on February 02, 2005, 11:19:54 AM
Alright... here's my screen 13 lib, VIDEO13h v1.5...

Please don't distribute since this is not the official public release  :lol:

Feel free to beta this version, and this should be my last non-public release, so I suspect version 1.6 will be the official public release  8) And it will include all source, ofcourse, and also a .QLB version too!

Anyways check out the PUT routine which still doesn't include roto-zooming but, I did optimize it a bit, and it should be able to handle those large sprites, up to 320X200 in size even.
I also squashed some minor bugs here and there, so check it out!!!

Let me know what you think, and if you want to talk  :barf:
about it and tell me something like this should've been released like 5+ yrs. ago, then go ahead, let it out  :cry:
(Then in another 5 years when I finish some games with it you can
appologize, hehhh!!!)

Cya!

Nemesis

:::EDIT #1:::

Code:


'''
' VIDEO13h v1.5, QuicKBASIC 4.5; SCREEN 13 manipulation routines.
'
' (C)opyright 2005, Pure QB Innovations
'
' Email any questions, comments, or suggestions to...
'  Nemesis2473@yahoo.com
'
' THIS PROGRAM IS BEING RELEASED AS FREEWARE SOFTWARE AND MAY BE DISTRIBUTED
' FREELY AS LONG AS ANY PART OF THIS FILE IS NOT ALTERED IN ANY WAY.
' THE AUTHOR OF THIS PROGRAM IS BY NO MEANS RESPONSIBLE FOR ANY DAMMAGES
' THAT HAVE EITHER OCCURED OR MAY OCCUR WHILE USING ANY PART OF THIS PROGRAM.
' 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 PUTcolour, PUTscale, PUTrotate
COMMON SHARED WXL, WYT, WXR, WYB
COMMON SHARED SYS&
'
DECLARE FUNCTION V13hKEY (scan)
DECLARE FUNCTION V13hLOF& (FILE$)
'
DECLARE SUB INTERRUPTX (INTNUM AS INTEGER, INREG AS REGXdata, OUTREG AS REGXdata)
'
DECLARE SUB V13hCLS (colour)
DECLARE SUB V13hWIN (xxLEFT, yyTOP, xxRIGHT, yyBOTTOM)
DECLARE SUB V13hCPY (Tsegm&, Toffs, Dsegm&, Doffs, BYTES&, Blits$)
DECLARE SUB V13hGRD (colour, gradient)
DECLARE SUB V13hPAL (FILE$)
DECLARE SUB V13hBLN (FILE$)
DECLARE SUB V13hBLD (ARRAY(), FILE$)
DECLARE SUB V13hBND (ARRAY(), FILE$)
DECLARE SUB V13hBSV (ARRAY(), FILE$)
DECLARE SUB V13hDLY (seconds!)
DECLARE SUB V13hFDE (fadeOUT, fadeINN, fadeSEC!)
DECLARE SUB V13hPNT (ARRAY(), FRAME, colour, SKIN$)
DECLARE SUB V13hPUT (ARRAY(), xxLEFT, yyTOP, FRAME, SKIN$)
DECLARE SUB V13hSEE ()
DECLARE SUB V13hSET ()
DECLARE SUB V13hTXT (ARRAY(), XXcenter, xxLEFT, yyTOP, colour, text$, SKIN$)
'
DECLARE SUB DEMO ()
'
DIM SHARED PAL(255) AS PALdata
'
DIM SHARED BLN&(255)
'
DIM SHARED VIDEO(32007)
DIM SHARED BLEND(16447)
DIM SHARED FONTS(3263)
DIM SHARED MOUSE(129)
DIM SHARED MASK(129)
DIM SHARED BOARD(127)
 '
 V13hSET
 '
 DEMO
 '
 SYSTEM
 '

REM $STATIC
SUB DEMO
 '
 'DRAW AND GET, (-1- 64*64) TILE. (DEMO)...
 '
 DIM BALL(2049)
 FOR S = 31 TO 1 STEP -1
  CIRCLE (32, 32), S, 31 - S \ 2
  PAINT (32, 32), 31 - S \ 2
 NEXT S
 GET (0, 0)-(63, 63), BALL(0)
 '
 CLS
 '
 ' DRAW AND GET, (-3- 20*20) TILES. (DEMO)...
 '
 DIM TILES(605)
 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
 '
 'Scaling test demo...
 '
 'CLS
 'PUTscale = 25
 'V13hPUT TILES(), 0, 0, 1, "SCALE"
 '
 'Gradient search test demo...
 '
 'CLS
 'FOR c = 1 TO 15
 ' FOR x = 0 TO 0
 '  V13hGRD c, x
 '  LINE (20, x)-(120, x)
 '  V13hSEE
 '  SLEEP
 ' NEXT
 'NEXT
 '
 'SCROLLING FONT DEMO...
 '
 FOR y = (WYB + 1) TO (WYT - (32 * 8)) STEP -1
  V13hCLS 0
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 0), 15, "-WELCOME-", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 2), 7, "VIDEO13h v1.5, (Pure QB v4.5),", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 4), 7, "SCREEN 13; manipulation routines.", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 8), 15, "-FEATURES-", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 10), 7, "320X200X256 resolution (VGA),", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 12), 7, "page/sprite/font buffering,", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 14), 7, "mouse/keyboard handlers,", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 16), 7, "file i/o, and memory routines.", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 18), 7, "All while still supporting QB's", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 20), 7, "original graphical commands too!", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 24), 15, "-REQUIREMENTS-", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 26), 7, "100+ Mhz PC processor, VGA monitor,", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 28), 7, "keyboard or mouse, and QuickBASIC v4.5", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 32), 15, "-CREDITS-", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 34), 15, "...Programmer...", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 36), 7, "Nemesis@qbasicnews.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 40), 15, "...Special Thanks...", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 42), 7, "Jonkirwan@aol.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 44), 7, "Eclipzer@aol.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 46), 7, "KingJayIII@aol.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 48), 7, "Barok@qbasicnews.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 50), 7, "Spotted Cheetah@qbasicnews.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 52), 7, "Adigun A. Polack@qbasicnews.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 54), 7, "na_th_an@qbasicnews.com", "TRANSPARENT"
  V13hTXT FONTS(), FALSE, 0, (8 * 24), 15, "(C)opyright 2005,", "BLEND"
  V13hTXT FONTS(), FALSE, (8 * 18), (8 * 24), 12, "Pure", "BLEND"
  V13hTXT FONTS(), FALSE, (8 * 23), (8 * 24), 10, "QB", "BLEND"
  V13hTXT FONTS(), FALSE, (8 * 26), (8 * 24), 9, "Innovations", "BLEND"
  V13hSEE
  'WAIT &H3DA, 8
  IF LEN(INKEY$) THEN EXIT FOR
  '
 NEXT
 '
 'FADE OUT/IN DEMO...
 '
 V13hFDE NOT FALSE, NOT FALSE, 1 / 32
 '
 DO: LOOP UNTIL LEN(INKEY$)
 '
 '''
 '''MOUSE MASKING DEMO...
 '''
 '
 DO
  '
  V13hPNT MOUSE(), 1, 15, "MASK"
  '
  V13hSEE
  '
  V13hPUT MASK(), PNT.xx, PNT.yy, PNT.FRAME, "PSET"
  '
 LOOP UNTIL LEN(INKEY$)
 '
 '''
 '''NO-MASK MOUSE DEMO...
 '''
 '
 DO
  '
  V13hCLS 0
  '
  V13hTXT FONTS(), NOT FALSE, 0, 14, 2, "PNT.xx = " + STR$(PNT.xx), "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, 22, 2, "PNT.yy = " + STR$(PNT.yy), "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, 169, 4, "PNT.lb = " + STR$(PNT.LB), "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, 177, 4, "PNT.rb = " + STR$(PNT.rb), "TRANSPARENT"
  '
  V13hPNT MOUSE(), 1, 15, "TRANSPARENT"
  '
  V13hSEE
  '
 LOOP UNTIL LEN(INKEY$)
 '
 'DELAY DEMO...
 '
 CLS
 LOCATE 1, 1: PRINT "V13hDLY 1/4 seconds..."
 PRINT
 DO: LOOP UNTIL TIMER <> TIMER
 DO
  t! = TIMER
  V13hDLY 1 / 4
  PRINT TIMER - t!
 LOOP UNTIL LEN(INKEY$)
 '
 CLS
 LOCATE 1, 1: PRINT "V13hDLY 1/8 seconds..."
 PRINT
 DO: LOOP UNTIL TIMER <> TIMER
 DO
  t! = TIMER
  V13hDLY 1 / 8
  PRINT TIMER - t!
 LOOP UNTIL LEN(INKEY$)
 '
 CLS
 LOCATE 1, 1: PRINT "V13hDLY 1/32 seconds..."
 PRINT
 DO: LOOP UNTIL TIMER <> TIMER
 DO
  t! = TIMER
  V13hDLY 1 / 32
  PRINT TIMER - t!
 LOOP UNTIL LEN(INKEY$)
 '
 '''
 ''' CLEAR SCREEN (256X) DEMO...
 '''
 '
 DO: LOOP UNTIL TIMER <> TIMER
 t! = TIMER
 FOR c = 0 TO 255
  V13hCLS c
  V13hSEE
 NEXT
 t! = TIMER - t!
 LOCATE 1, 1: PRINT "V13hCLS (256X):"; t!
 DO: LOOP UNTIL LEN(INKEY$)
 '
 '''
 ''' MEMORY COPY DEMO...
 '''
 '
 DO: LOOP UNTIL TIMER <> TIMER
 FOR y = 0 TO 255
  IF y > 127 THEN
   z = ((-256 + y) * 256) + y
  ELSE
   z = (y * 256) + y
  END IF
  FOR x = 8 TO 32007
   VIDEO(x) = z
  NEXT
  c! = TIMER
  V13hCPY VARSEG(VIDEO(0)), 16, &HA000, 0, 64000, "SOLID"
  t! = t! + ABS(TIMER - c!)
 NEXT
 B& = (y - 1) * 64000
 CLS : COLOR 7
 PRINT B&; "bytes in..."; t!; "sec."
 PRINT
 PRINT "That was SOLID copy, which copies data"
 PRINT "from one point in memory to another."
 PRINT "TRANSPARENT copy, copies data from"
 PRINT "one point in memory to another,"
 PRINT "except for all 0 (null bytes)."
 DO: LOOP UNTIL LEN(INKEY$)
 '
 '''
 ''' (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
 LOCATE 1, 1: PRINT "PSET (1O,OOOX):"; t!
 DO: LOOP UNTIL LEN(INKEY$)
 '
 '''
 ''' (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
 LOCATE 1, 1: PRINT "LINE (1O,OOOX):"; t!
 DO: LOOP UNTIL LEN(INKEY$)
 '
 '''
 ''' (1O,OOO) RANDOM TILES DEMO...
 '''
 '
 kind$ = "ANDXOR"
 DO
  V13hCLS 0
  DO: LOOP UNTIL TIMER <> TIMER
  t! = TIMER
  FOR x = 1 TO 2500
   xx = -63 + INT(RND(1) * 383 + 1)
   yy = -63 + INT(RND(1) * 263 + 1)
   V13hPUT BALL(), xx, yy, 1, kind$
   '
   '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
  K$ = "V13hPUT " + kind$ + " (2,5OOX):"
  LOCATE 1, 1: PRINT K$; t!
  DO: LOOP UNTIL LEN(INKEY$)
  SELECT CASE kind$
   CASE "ANDXOR"
    kind$ = "TRANSPARENT"
   CASE "TRANSPARENT"
    kind$ = "BLEND"
   CASE "BLEND"
    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
   CASE ELSE
  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
  '
  V13hPUT TILES(), 149, 89, 2, "TRANSPARENT"
  '
  IF V13hKEY(80) THEN ZY = ZY - 1: AD = NOT FALSE ELSE AD = FALSE
  IF V13hKEY(75) THEN ZX = ZX + 1: AL = NOT FALSE ELSE AL = FALSE
  IF V13hKEY(77) THEN ZX = ZX - 1: AR = NOT FALSE ELSE AR = FALSE
  IF V13hKEY(72) THEN ZY = ZY + 1: AU = NOT FALSE ELSE AU = 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), "TRANSPARENT"
  V13hTXT FONTS(), FALSE, 0, 16, 11, "Arrow up:   " + STR$(AU), "TRANSPARENT"
  V13hTXT FONTS(), FALSE, 0, 24, 11, "Arrow down: " + STR$(AD), "TRANSPARENT"
  V13hTXT FONTS(), FALSE, 0, 32, 11, "Arrow right:" + STR$(AR), "TRANSPARENT"
  V13hTXT FONTS(), FALSE, 0, 40, 11, "Arrow left: " + STR$(AL), "TRANSPARENT"
  V13hTXT FONTS(), FALSE, 0, 56, 12, "Esc to exit.", "TRANSPARENT"
  V13hSEE
 LOOP UNTIL INKEY$ = CHR$(27)
 '
 EXIT SUB
'
END SUB

SUB V13hBLD (ARRAY(), FILE$)
 '
 LENGTH& = V13hLOF&(FILE$)
 IF LENGTH& THEN
  Words = ((LENGTH& + 1) \ 2) - 1
  REDIM ARRAY(Words)
  DEF SEG = VARSEG(ARRAY(0))
  BLOAD FILE$, 0
 END IF
 '
END SUB

SUB V13hBLN (FILE$)
 '
 DEF SEG = VARSEG(BLEND(0))
 '
 IF V13hLOF&(FILE$) > 0 THEN
  BLOAD FILE$, 0
 ELSE
  FOR P = 0 TO 254
   FOR B = P TO 255
    '
    max = 11907
    '
    rt = (PAL(P).Red + PAL(B).Red) \ 2
    gt = (PAL(P).Grn + PAL(B).Grn) \ 2
    BT = (PAL(P).Blu + PAL(B).Blu) \ 2
    '
    FOR c = 0 TO 255
     rd = rt - PAL(c).Red
     gd = gt - PAL(c).Grn
     BD = BT - PAL(c).Blu
     v = (rd * rd) + (gd * gd) + (BD * BD)
     IF v < max THEN
      max = v
      tag = c
      IF v THEN  ELSE EXIT FOR
     END IF
    NEXT
    POKE incb&, tag
    incb& = incb& + 1
   NEXT
  NEXT
  '
  BSAVE FILE$, 0, (incb& + 1)
  '
 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(U + Words)
   DEF SEG = VARSEG(ARRAY(0)): BLOAD "buffer.tmp", 0
   KILL "buffer.tmp"
   BLOAD FILE$, (U + 1) * 2
  ELSE
   REDIM ARRAY(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 V13hCLS (colour)
 '
 LINE (WXL, WYT)-(WXR, WYB), colour, BF
 '
END SUB

SUB V13hCPY (Tsegm&, Toffs, Dsegm&, Doffs, BYTES&, Blits$)
'
TS& = Tsegm&
DS& = Dsegm&
'
DIM BT(&HF)
DIM BD(&HF)
'
FOR x = &H0 TO &HF
 BT(x) = (x + Toffs)
 BD(x) = (x + Doffs)
NEXT
'
SELECT CASE Blits$
 '
 CASE "SOLID"
  '
  FOR x = &H1 TO (BYTES& \ &H10)
   DEF SEG = TS&
   '
tBF: BF = PEEK(BT(&HF))
tBE: BE = PEEK(BT(&HE))
tBD: BD = PEEK(BT(&HD))
tBC: BC = PEEK(BT(&HC))
tBB: BB = PEEK(BT(&HB))
tBA: BA = PEEK(BT(&HA))
tB9: B9 = PEEK(BT(&H9))
tB8: B8 = PEEK(BT(&H8))
tB7: B7 = PEEK(BT(&H7))
tB6: B6 = PEEK(BT(&H6))
tB5: B5 = PEEK(BT(&H5))
tB4: B4 = PEEK(BT(&H4))
tB3: B3 = PEEK(BT(&H3))
tB2: B2 = PEEK(BT(&H2))
tB1: B1 = PEEK(BT(&H1))
tB0: B0 = PEEK(BT(&H0))
   '
   IF GSR THEN RETURN
   '
   DEF SEG = DS&
   '
dBF: POKE BD(&HF), BF
dBE: POKE BD(&HE), BE
dBD: POKE BD(&HD), BD
dBC: POKE BD(&HC), BC
dBB: POKE BD(&HB), BB
dBA: POKE BD(&HA), BA
dB9: POKE BD(&H9), B9
dB8: POKE BD(&H8), B8
dB7: POKE BD(&H7), B7
dB6: POKE BD(&H6), B6
dB5: POKE BD(&H5), B5
dB4: POKE BD(&H4), B4
dB3: POKE BD(&H3), B3
dB2: POKE BD(&H2), B2
dB1: POKE BD(&H1), B1
dB0: POKE BD(&H0), B0
   '
   IF GSR THEN RETURN
   '
   TS& = TS& + &H1
   DS& = DS& + &H1
  NEXT
  '
  GSR = NOT FALSE
  '
  SELECT CASE (BYTES& MOD &H10)
   CASE &H1
    DEF SEG = TS&
    GOSUB tB0
    DEF SEG = DS&
    GOSUB dB0
   CASE &H2
    DEF SEG = TS&
    GOSUB tB1
    DEF SEG = DS&
    GOSUB dB1
   CASE &H3
    DEF SEG = TS&
    GOSUB tB2
    DEF SEG = DS&
    GOSUB dB2
   CASE &H4
    DEF SEG = TS&
    GOSUB tB3
    DEF SEG = DS&
    GOSUB dB3
   CASE &H5
    DEF SEG = TS&
    GOSUB tB4
    DEF SEG = DS&
    GOSUB dB4
   CASE &H6
    DEF SEG = TS&
    GOSUB tB5
    DEF SEG = DS&
    GOSUB dB5
   CASE &H7
    DEF SEG = TS&
    GOSUB tB6
    DEF SEG = DS&
    GOSUB dB6
   CASE &H8
    DEF SEG = TS&
    GOSUB tB7
    DEF SEG = DS&
    GOSUB dB7
   CASE &H9
    DEF SEG = TS&
    GOSUB tB8
    DEF SEG = DS&
    GOSUB dB8
   CASE &HA
    DEF SEG = TS&
    GOSUB tB9
    DEF SEG = DS&
    GOSUB dB9
   CASE &HB
    DEF SEG = TS&
    GOSUB tBA
    DEF SEG = DS&
    GOSUB dBA
   CASE &HC
    DEF SEG = TS&
    GOSUB tBB
    DEF SEG = DS&
    GOSUB dBB
   CASE &HD
    DEF SEG = TS&
    GOSUB tBC
    DEF SEG = DS&
    GOSUB dBC
   CASE &HE
    DEF SEG = TS&
    GOSUB tBD
    DEF SEG = DS&
    GOSUB dBD
   CASE &HF
    DEF SEG = TS&
    GOSUB tBE
    DEF SEG = DS&
    GOSUB dBE
  END SELECT
  '
 CASE "TRANSPARENT"
  '
  FOR x = &H1 TO (BYTES& \ &H10)
   DEF SEG = TS&
   '
   BF = PEEK(BT(&HF))
   BE = PEEK(BT(&HE))
   BD = PEEK(BT(&HD))
   BC = PEEK(BT(&HC))
   BB = PEEK(BT(&HB))
   BA = PEEK(BT(&HA))
   B9 = PEEK(BT(&H9))
   B8 = PEEK(BT(&H8))
   B7 = PEEK(BT(&H7))
   B6 = PEEK(BT(&H6))
   B5 = PEEK(BT(&H5))
   B4 = PEEK(BT(&H4))
   B3 = PEEK(BT(&H3))
   B2 = PEEK(BT(&H2))
   B1 = PEEK(BT(&H1))
   B0 = PEEK(BT(&H0))
   '
   DEF SEG = DS&
   '
dTF: IF BF THEN POKE BD(&HF), BF
dTE: IF BE THEN POKE BD(&HE), BE
dTD: IF BD THEN POKE BD(&HD), BD
dTC: IF BC THEN POKE BD(&HC), BC
dTB: IF BB THEN POKE BD(&HB), BB
dTA: IF BA THEN POKE BD(&HA), BA
dT9: IF B9 THEN POKE BD(&H9), B9
dT8: IF B8 THEN POKE BD(&H8), B8
dT7: IF B7 THEN POKE BD(&H7), B7
dT6: IF B6 THEN POKE BD(&H6), B6
dT5: IF B5 THEN POKE BD(&H5), B5
dT4: IF B4 THEN POKE BD(&H4), B4
dT3: IF B3 THEN POKE BD(&H3), B3
dT2: IF B2 THEN POKE BD(&H2), B2
dT1: IF B1 THEN POKE BD(&H1), B1
dT0: IF B0 THEN POKE BD(&H0), B0
   '
   IF GSR THEN RETURN
   '
   TS& = TS& + &H1
   DS& = DS& + &H1
   '
  NEXT
  '
  GSR = NOT FALSE
  '
  SELECT CASE (BYTES& MOD &H10)
   CASE &H1
    DEF SEG = TS&
    GOSUB tB0
    DEF SEG = DS&
    GOSUB dT0
   CASE &H2
    DEF SEG = TS&
    GOSUB tB1
    DEF SEG = DS&
    GOSUB dT1
   CASE &H3
    DEF SEG = TS&
    GOSUB tB2
    DEF SEG = DS&
    GOSUB dT2
   CASE &H4
    DEF SEG = TS&
    GOSUB tB3
    DEF SEG = DS&
    GOSUB dT3
   CASE &H5
    DEF SEG = TS&
    GOSUB tB4
    DEF SEG = DS&
    GOSUB dT4
   CASE &H6
    DEF SEG = TS&
    GOSUB tB5
    DEF SEG = DS&
    GOSUB dT5
   CASE &H7
    DEF SEG = TS&
    GOSUB tB6
    DEF SEG = DS&
    GOSUB dT6
   CASE &H8
    DEF SEG = TS&
    GOSUB tB7
    DEF SEG = DS&
    GOSUB dT7
   CASE &H9
    DEF SEG = TS&
    GOSUB tB8
    DEF SEG = DS&
    GOSUB dT8
   CASE &HA
    DEF SEG = TS&
    GOSUB tB9
    DEF SEG = DS&
    GOSUB dT9
   CASE &HB
    DEF SEG = TS&
    GOSUB tBA
    DEF SEG = DS&
    GOSUB dTA
   CASE &HC
    DEF SEG = TS&
    GOSUB tBB
    DEF SEG = DS&
    GOSUB dTB
   CASE &HD
    DEF SEG = TS&
    GOSUB tBC
    DEF SEG = DS&
    GOSUB dTC
   CASE &HE
    DEF SEG = TS&
    GOSUB tBD
    DEF SEG = DS&
    GOSUB dTD
   CASE &HF
    DEF SEG = TS&
    GOSUB tBE
    DEF SEG = DS&
    GOSUB dTE
  END SELECT
  '
END SELECT
'
END SUB

SUB V13hDLY (seconds!) STATIC
 '
 IF seconds! THEN
  FOR inc& = 1 TO (SYS& * (seconds! * 18.2065)): 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
   IF fadeSEC! <> 0 THEN V13hDLY 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
   IF faseSEC! <> 0 THEN V13hDLY fadeSEC!
  NEXT
 END IF
 '
END SUB

SUB V13hGRD (colour, gradient)
 '
 RGB = colour
 GSG = 15 + gradient
 '
 DEF SEG = VARSEG(BLEND(0))
 '
 IF RGB > GSG THEN
  GSC = PEEK(BLN&(GSG) + (RGB - GSG))
 ELSE
  GSC = PEEK(BLN&(RGB) + (GSG - RGB))
 END IF
 '
 COLOR GSC
 '
END SUB

FUNCTION V13hKEY (scan)
 '
 DEF SEG = &H0
 POKE &H41C, PEEK(&H41A)
 POKE &H417, 0
 '
 I = INP(&H60)
 '
 IF (I AND &H80) THEN
  BOARD(I XOR &H80) = FALSE
 ELSE
  BOARD(I) = NOT FALSE
 END IF
 '
 IF BOARD(scan) THEN
  V13hKEY = NOT FALSE
 ELSE
  V13hKEY = FALSE
 END IF
 '
END FUNCTION

FUNCTION V13hLOF& (FILE$)
 '
 FileNum = FREEFILE
 OPEN FILE$ FOR BINARY ACCESS READ AS FileNum
  V13hLOF& = LOF(FileNum) - 7
 CLOSE FileNum
 '
END FUNCTION

SUB V13hPAL (FILE$)
 '
 DEF SEG = VARSEG(PAL(0))
 '
 IF V13hLOF&(FILE$) > 0 THEN
  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
 ELSE
  OUT &H3C7, 0
  FOR x = 0 TO 255
   PAL(x).Red = INP(&H3C9)
   PAL(x).Grn = INP(&H3C9)
   PAL(x).Blu = INP(&H3C9)
  NEXT
  BSAVE FILE$, 0, 1536
 END IF
 '
END SUB

SUB V13hPNT (ARRAY(), FRAME, colour, SKIN$)
 '
 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
  '
  IF SKIN$ = "MASK" THEN
   '
   TEXTURE$ = "TRANSPARENT"
   '
   MR = (PNT.xx + MOUSE(0) \ 8) - 1
   MB = (PNT.yy + MOUSE(1)) - 1
   '
   IF MR > 319 THEN MR = 319
   IF MB > 199 THEN MB = 199
   '
   GET (PNT.xx, PNT.yy)-(MR, MB), MASK
   '
  ELSE
   '
   TEXTURE$ = SKIN$
   '
  END IF
  '
  PUTcolour = -1 + colour
  '
  V13hPUT ARRAY(), PNT.xx, PNT.yy, PNT.FRAME, TEXTURE$
  '
  PUTcolour = FALSE
  '
 END IF
 '
END SUB

SUB V13hPUT (ARRAY(), xxLEFT, yyTOP, FRAME, SKIN$)
 '
 IF FRAME THEN
  '
  segVIDEO& = 1& + VARSEG(VIDEO(0))
  segARRAY& = VARSEG(ARRAY(0))
  '
  TW = ARRAY(0) \ 8
  TH = ARRAY(1)
  TP& = TW * TH
  TI = ((5 + TP&) \ 2) * (FRAME - 1)
  '
  XR = (xxLEFT + TW) - 1
  YB = (yyTOP + TH) - 1
  '
  IF xxLEFT < WXL THEN
   IF XR < WXL THEN EXIT SUB
   CLIP = NOT FALSE
   LD = (WXL - xxLEFT): XD = LD
   XL = WXL
  ELSE
   XL = xxLEFT
  END IF
  '
  IF yyTOP < WYT THEN
   IF YB < WYT THEN EXIT SUB
   CLIP = NOT FALSE
   YD = WYT - yyTOP
   YT = WYT
  ELSE
   YT = yyTOP
  END IF
  '
  IF XR > WXR THEN
   IF XL > WXR THEN EXIT SUB
   CLIP = NOT FALSE
   XD = XD + (XR - WXR)
   XR = WXR
  END IF
  '
  IF YB > WYB THEN
   IF YT > WYB THEN EXIT SUB
   CLIP = NOT FALSE
   YB = WYB
  END IF
  '
  AB& = (4 + (TI * 2&)) + ((YD * TW) + LD)
  '
  DIM AC(XL TO XR)
  '
  SELECT CASE SKIN$
   '
   CASE "ANDXOR"
    '
    B = TW - XD
    R = TW - DR
    '
    DIM BT(&H0 TO &HF)
    DIM BD(&H0 TO &HF)
    '
    FOR x = &H0 TO &HF
     BD(x) = (x + XL)
    NEXT
    '
    FOR VY = (YT * 20) TO (YB * 20) STEP 20
     '
     TS& = segARRAY&
     DS& = segVIDEO& + VY
     '
     FOR x = &H0 TO &HF
      BT(x) = (x + AB&)
     NEXT
     '
     GSR = FALSE
     '
     FOR x = &H1 TO (B \ &H10)
      '
      DEF SEG = TS&
      '
aBF:  BF = PEEK(BT(&HF))
aBE:  BE = PEEK(BT(&HE))
aBD:  BD = PEEK(BT(&HD))
aBC:  BC = PEEK(BT(&HC))
aBB:  BB = PEEK(BT(&HB))
aBA:  BA = PEEK(BT(&HA))
aB9:  B9 = PEEK(BT(&H9))
aB8:  B8 = PEEK(BT(&H8))
aB7:  B7 = PEEK(BT(&H7))
aB6:  B6 = PEEK(BT(&H6))
aB5:  B5 = PEEK(BT(&H5))
aB4:  B4 = PEEK(BT(&H4))
aB3:  B3 = PEEK(BT(&H3))
aB2:  B2 = PEEK(BT(&H2))
aB1:  B1 = PEEK(BT(&H1))
aB0:  B0 = PEEK(BT(&H0))
      '
      IF GSR THEN RETURN
      '
      DEF SEG = DS&
      '
aTF:  IF BF THEN POKE BD(&HF), BF + PUTcolour
aTE:  IF BE THEN POKE BD(&HE), BE + PUTcolour
aTD:  IF BD THEN POKE BD(&HD), BD + PUTcolour
aTC:  IF BC THEN POKE BD(&HC), BC + PUTcolour
aTB:  IF BB THEN POKE BD(&HB), BB + PUTcolour
aTA:  IF BA THEN POKE BD(&HA), BA + PUTcolour
aT9:  IF B9 THEN POKE BD(&H9), B9 + PUTcolour
aT8:  IF B8 THEN POKE BD(&H8), B8 + PUTcolour
aT7:  IF B7 THEN POKE BD(&H7), B7 + PUTcolour
aT6:  IF B6 THEN POKE BD(&H6), B6 + PUTcolour
aT5:  IF B5 THEN POKE BD(&H5), B5 + PUTcolour
aT4:  IF B4 THEN POKE BD(&H4), B4 + PUTcolour
aT3:  IF B3 THEN POKE BD(&H3), B3 + PUTcolour
aT2:  IF B2 THEN POKE BD(&H2), B2 + PUTcolour
aT1:  IF B1 THEN POKE BD(&H1), B1 + PUTcolour
aT0:  IF B0 THEN POKE BD(&H0), B0 + PUTcolour
      '
      IF GSR THEN RETURN
      '
      TS& = TS& + &H1
      DS& = DS& + &H1
      '
     NEXT
     '
     GSR = NOT FALSE
     '
     SELECT CASE (B MOD &H10)
      CASE &H1
       DEF SEG = TS&
       GOSUB aB0
       DEF SEG = DS&
       GOSUB aT0
      CASE &H2
       DEF SEG = TS&
       GOSUB aB1
       DEF SEG = DS&
       GOSUB aT1
      CASE &H3
       DEF SEG = TS&
       GOSUB aB2
       DEF SEG = DS&
       GOSUB aT2
      CASE &H4
       DEF SEG = TS&
       GOSUB aB3
       DEF SEG = DS&
       GOSUB aT3
      CASE &H5
       DEF SEG = TS&
       GOSUB aB4
       DEF SEG = DS&
       GOSUB aT4
      CASE &H6
       DEF SEG = TS&
       GOSUB aB5
       DEF SEG = DS&
       GOSUB aT5
      CASE &H7
       DEF SEG = TS&
       GOSUB aB6
       DEF SEG = DS&
       GOSUB aT6
      CASE &H8
       DEF SEG = TS&
       GOSUB aB7
       DEF SEG = DS&
       GOSUB aT7
      CASE &H9
       DEF SEG = TS&
       GOSUB aB8
       DEF SEG = DS&
       GOSUB aT8
      CASE &HA
       DEF SEG = TS&
       GOSUB aB9
       DEF SEG = DS&
       GOSUB aT9
      CASE &HB
       DEF SEG = TS&
       GOSUB aBA
       DEF SEG = DS&
       GOSUB aTA
      CASE &HC
       DEF SEG = TS&
       GOSUB aBB
       DEF SEG = DS&
       GOSUB aTB
      CASE &HD
       DEF SEG = TS&
       GOSUB aBC
       DEF SEG = DS&
       GOSUB aTC
      CASE &HE
       DEF SEG = TS&
       GOSUB aBD
       DEF SEG = DS&
       GOSUB aTD
      CASE &HF
       DEF SEG = TS&
       GOSUB aBE
       DEF SEG = DS&
       GOSUB aTE
     END SELECT
     '
     AB& = AB& + R
     '
    NEXT
   '
   CASE "TRANSPARENT"
    '
    FOR VY = (YT * 20) TO (YB * 20) STEP 20
     DEF SEG = segARRAY&
     FOR HX = XL TO XR
      AC(HX) = PEEK(AB&)
      AB& = AB& + 1
     NEXT
     AB& = AB& + XD
     DEF SEG = segVIDEO& + VY
     IF PUTcolour THEN
      FOR HX = XL TO XR
       IF AC(HX) THEN POKE HX, AC(HX) + PUTcolour
      NEXT
     ELSE
      FOR HX = XL TO XR
       IF AC(HX) THEN POKE HX, AC(HX)
      NEXT
     END IF
    NEXT
    '
   CASE "BLEND"
    '
    segBLEND& = VARSEG(BLEND(0))
    '
    FOR VY = (YT * 20) TO (YB * 20) STEP 20
     DEF SEG = segARRAY&
     FOR HX = XL TO XR
      AC(HX) = PEEK(AB&)
      AB& = AB& + 1
     NEXT
     AB& = AB& + XD
     DEF SEG = segVIDEO& + VY
     FOR HX = XL TO XR
      IF AC(HX) THEN
       IF PUTcolour THEN AC(HX) = AC(HX) + PUTcolour
       VC = PEEK(HX)
       DEF SEG = segBLEND&
       IF VC > AC(HX) THEN
        BC = PEEK(BLN&(AC(HX)) + (VC - AC(HX)))
       ELSE
        BC = PEEK(BLN&(VC) + (AC(HX) - VC))
       END IF
       DEF SEG = segVIDEO& + VY
       POKE HX, BC
      END IF
     NEXT
    NEXT
    '
   CASE "BEHIND"
    '
    FOR VY = (YT * 20) TO (YB * 20) STEP 20
     DEF SEG = segARRAY&
     FOR HX = XL TO XR
      AC(HX) = PEEK(AB&)
      AB& = AB& + 1
     NEXT
     AB& = AB& + XD
     DEF SEG = segVIDEO& + VY
     IF PUTcolour THEN
      FOR HX = XL TO XR
       IF PEEK(HX) THEN  ELSE POKE HX, AC(HX) + PUTcolour
      NEXT
     ELSE
      FOR HX = XL TO XR
       IF PEEK(HX) THEN  ELSE POKE HX, AC(HX)
      NEXT
     END IF
    NEXT
   '
   CASE "SCALE"
    '
    'SW = (TW * PUTscale) \ 100
    'SH = (TH * PUTscale) \ 100
    'DW = TW - SW
    'DH = TH - SH
    '
    'PRINT "TW: "; TW
    'PRINT "TH: "; TH
    'PRINT "SW: "; SW
    'PRINT "SH: "; SH
    'PRINT "DW: "; DW
    'PRINT "DH: "; DH
    '
    'SLEEP: STOP
    '
   CASE "PSET"
    '
    IF CLIP THEN
     '
     FOR VY = (YT * 20) TO (YB * 20) STEP 20
      DEF SEG = segARRAY&
      FOR HX = XL TO XR
       AC(HX) = PEEK(AB&)
       AB& = AB& + 1
      NEXT
      AB& = AB& + XD
      DEF SEG = segVIDEO& + VY
      FOR HX = XL TO XR
       POKE HX, AC(HX)
      NEXT
     NEXT
    ELSE
     PUT (xxLEFT, yyTOP), ARRAY(TI), PSET
    END IF
    '
   CASE "PRESET"
    '
    IF CLIP THEN
     '
     FOR VY = (YT * 20) TO (YB * 20) STEP 20
      DEF SEG = segARRAY&
      FOR HX = XL TO XR
       AC(HX) = PEEK(AB&)
       AB& = AB& + 1
      NEXT
      AB& = AB& + XD
      DEF SEG = segVIDEO& + VY
      FOR HX = XL TO XR
       POKE HX, NOT AC(HX)
      NEXT
     NEXT
    ELSE
     PUT (xxLEFT, yyTOP), ARRAY(TI), PRESET
    END IF
    '
   CASE "AND"
    '
    IF CLIP THEN
     '
     FOR VY = (YT * 20) TO (YB * 20) STEP 20
      DEF SEG = segARRAY&
      FOR HX = XL TO XR
       AC(HX) = PEEK(AB&)
       AB& = AB& + 1
      NEXT
      AB& = AB& + XD
      DEF SEG = segVIDEO& + VY
      FOR HX = XL TO XR
       POKE HX, AC(HX) AND PEEK(HX)
      NEXT
     NEXT
    ELSE
     PUT (xxLEFT, yyTOP), ARRAY(TI), AND
    END IF
    '
   CASE "OR"
    '
    IF CLIP THEN
     '
     FOR VY = (YT * 20) TO (YB * 20) STEP 20
      DEF SEG = segARRAY&
      FOR HX = XL TO XR
       AC(HX) = PEEK(AB&)
       AB& = AB& + 1
      NEXT
      AB& = AB& + XD
      DEF SEG = segVIDEO& + VY
      FOR HX = XL TO XR
       POKE HX, AC(HX) OR PEEK(HX)
      NEXT
     NEXT
    ELSE
     PUT (xxLEFT, yyTOP), ARRAY(TI), OR
    END IF
    '
   CASE "XOR"
    '
    IF CLIP THEN
     '
     FOR VY = (YT * 20) TO (YB * 20) STEP 20
      DEF SEG = segARRAY&
      FOR HX = XL TO XR
       AC(HX) = PEEK(AB&)
       AB& = AB& + 1
      NEXT
      AB& = AB& + XD
      DEF SEG = segVIDEO& + VY
      FOR HX = XL TO XR
       POKE HX, AC(HX) XOR PEEK(HX)
      NEXT
     NEXT
    ELSE
     PUT (xxLEFT, yyTOP), ARRAY(TI), XOR
    END IF
    '
  END SELECT
  '
 END IF
 '
END SUB

SUB V13hSEE
 '
 DEF SEG
 POKE VIDEO(0), VIDEO(2)
 POKE VIDEO(1), VIDEO(3)
 PUT (0, 0), VIDEO(6), PSET
 POKE VIDEO(0), VIDEO(4)
 POKE VIDEO(1), VIDEO(5)
 '
END SUB

SUB V13hSET
 '
 SCREEN 13: CLS
 '
 FOR x = 0 TO 254
  BLN&(x + 1) = (BLN&(x) + (256 - x))
 NEXT
 '
 V13hPAL "palette.pal"
 V13hBLN "palette.bln"
 '
 REGX.AX = 0: INTERRUPTX &H33, REGX, REGX  'check mouse
 IF REGX.AX THEN
  PNT.switch = NOT FALSE
  REGX.AX = 1: INTERRUPTX &H33, REGX, REGX 'show mouse
  REGX.AX = 4: INTERRUPTX &H33, REGX, REGX 'put mouse
  GET (1, 1)-(16, 16), MOUSE               'get mouse
  REGX.AX = 2: INTERRUPTX &H33, REGX, REGX 'hide mouse
  DEF SEG = VARSEG(MOUSE(0))               'color mouse
  FOR x = 4 TO 258
   IF PEEK(x) = 15 THEN
    POKE x, 1
    IF PEEK(x - 1) THEN  ELSE POKE x, 250  'shade mouse
   END IF
  NEXT
  PNT.minXX = 0                            'bound mouse
  PNT.minYY = 0
  PNT.maxXX = 319
  PNT.maxYY = 199
 END IF
 '
 COLOR 1
 '
 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
 VIDEOseg& = 1 + VARSEG(VIDEO(0))
 DEF SEG : BSAVE "buffer.tmp", &H0, &HFA00
 DEF SEG = VIDEOseg&: BLOAD "buffer.tmp", 0
 KILL "buffer.tmp"
 FOR I = 8 TO 32007 - 1
  IF VIDEO(I) = &H7DA0 AND VIDEO(I + 1) = &HA000 THEN
   VIDEO(0) = ((I + 1) * 2) - 16
   VIDEO(1) = VIDEO(0) + 1
   VIDEO(4) = VIDEOseg& AND &HFF
   IF (VIDEOseg& AND &H8000) THEN
    VIDEO(5) = ((VIDEOseg& AND &HFF00) \ &HFF) + &H100
   ELSE
    VIDEO(5) = (VIDEOseg& AND &HFF00) \ &HFF
   END IF
   DEF SEG
   VIDEO(2) = PEEK(VIDEO(0)): VIDEO(3) = PEEK(VIDEO(1))
   POKE VIDEO(0), VIDEO(4): POKE VIDEO(1), VIDEO(5)
   EXIT FOR
  END IF
 NEXT
 '
 VIDEO(6) = 2560
 VIDEO(7) = 200
 '
 V13hWIN 0, 0, 319, 199
 V13hDLY calibrate!
 V13hCLS 0
 COLOR 15
 '
END SUB

SUB V13hTXT (ARRAY(), XXcenter, xxLEFT, yyTOP, colour, text$, SKIN$)
 '
 FONTwidth = ARRAY(0) \ 8
 PUTcolour = -1 + colour
 FONTyy = yyTOP
 '
 TL = LEN(text$)
 '
 IF XXcenter THEN
  cx = (WXL + ((WXR - WXL) + 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, SKIN$
 NEXT
 '
 PUTcolour = FALSE
 '
END SUB

SUB V13hWIN (xxLEFT, yyTOP, xxRIGHT, yyBOTTOM)
 '
 WXL = xxLEFT
 WYT = yyTOP
 WXR = xxRIGHT
 WYB = yyBOTTOM
 '
 IF WXL < 0 THEN WXL = 0
 IF WXR > 319 THEN WXR = 319
 IF WYT < 0 THEN WYT = 0
 IF WYB > 199 THEN WYB = 199
 '
END SUB



Title: 100% QB game
Post by: barok on February 02, 2005, 11:30:08 AM
hmm... competitive physically, huh?  I'll have to take you up on your challenge someday.  Some ice hockey, maybe? :)  

Maybe you, I and Cheetah should work on this lib together.  It'd be done way faster, and of course since we all have (or had) a desire for fast pure qb, i think it'd work. :D  

A rotozooming sprite routine?  Why not just make two seperate routines?  One for rotating, and one for zooming.  If someone wants rotozooming, they can combine those routines to make it.  It'd save space, for sure.

Btw, two things...  

1. Can your routine put a sprite that's inside a PUT array that has like 5 sprites already inside it?

2. your buffer goes to 32007.  Do you do this in case you want to use setvideoseg someday?


Title: 100% QB game
Post by: Nemesis on February 02, 2005, 01:53:17 PM
Quote from: "barok"
hmm... competitive physically, huh?  I'll have to take you up on your challenge someday.  Some ice hockey, maybe? :)

Ice hockey? Nah, I'd get creamed  :o

How about track? (100 meter dash in 10.6, 24' 2'' long jump)
Maybe some football? (Can't remember my time in the 40 though.)
Basketball? (Shots not always acurate, but can dunk on regulation rim, plus have great D!!!)
MMA? Ummm, I won't go there...but...(look for Mario LaRosa)...
http://www.team-roc.com/events/fkf2000.html
http://www.team-roc.com/events/evt02.html
(Was robbed with a DQ in that title fight. Clearly knocked the guy out though.)
http://martialartsradio.com/home.htm
My last fight... sucked, fight was stopped prematurely  :cry:
The guy didn't even leave a mark on me, the sold out crowd booed and were very dissapointed.  :roll: Oh well, I'm still ranked #2 light heavy weight... (Check out the Kick Down rankings, light heavy weight division)
Currently I'm inactive but, I will get back into it some day.
I actually had one pro fight in N.C, which I won with rear-naked-choke! in round 2. (I want to get back into it but, unfortunatelly there's very little money in it. Maybe 1K to 5K a fight, but you can easily spend that in the ER, or on a insurance policy.)


Anyways, back to my true love... COMPUTERS  :bounce:

Quote

Maybe you, I and Cheetah should work on this lib together.  It'd be done way faster, and of course since we all have (or had) a desire for fast pure qb, i think it'd work. :D

Sure why not, shoot me an E-mail!
Quote

A rotozooming sprite routine?  Why not just make two seperate routines?  One for rotating, and one for zooming.  If someone wants rotozooming, they can combine those routines to make it.  It'd save space, for sure.

Ummm, I was thinking just the opposite that it would save space just to have it combined all in one routine, and use a few variables
that the user can set for the scaling and zooming amounts.

Quote

Btw, two things...  

1. Can your routine put a sprite that's inside a PUT array that has like 5 sprites already inside it?

2. your buffer goes to 32007.  Do you do this in case you want to use setvideoseg someday?


1. Not directly but, adding this feature wouldn't be any problem at all, or the user could PUT the sprites, and then capture it. (Would be kinda sloppy though.)

2. Well I've used my own setvideoseg routine for some time now.
Was suprised when I seen Plasmas version, heh, mine is similar and is generally the same concept but, my code and approach is slightly different than SETVIDEOSEG. (Before I knew any ASM, I'd do silly things like scan memory and look for ways I could actually manipulate QB itself. Actually found some really cool things... (Man, those sure were the good 'ole days  :))

Cya later!

Nemesis


Title: 100% QB game
Post by: na_th_an on February 02, 2005, 03:19:03 PM
Nemesis, your code would be even faster if you replace every GOSUB by the actual subroutine they are calling in the Put sub. GOSUB takes time ;)


Title: 100% QB game
Post by: Nemesis on February 02, 2005, 10:15:08 PM
Quote from: "na_th_an"
Nemesis, your code would be even faster if you replace every GOSUB by the actual subroutine they are calling in the Put sub. GOSUB takes time ;)


Sorry na_th_an, I wasn't aware of any GOSUBS in the PUT subroutine. Maybe you were thinking something different than what
you worte/posted?

Glad to see you took the time to look at my lib.

To let you know, there are many things that could be done to increase the speed but, I'm not going to spend the time to incorporate these things currently. I might decide to one of these days though  :wink:
Feel free to post any suggestions, if I use your idea, Ill add you to the credits, yipeeee!!!!  :bounce:

Umm... bye.

Nemesis


Title: 100% QB game
Post by: na_th_an on February 03, 2005, 05:45:46 AM
I meant this:

Code:
[...]
  CASE &H1
    DEF SEG = TS&
    GOSUB tB0
    DEF SEG = DS&
    GOSUB dB0
[...]


I dunno where it belongs. I suggest to paste the actual code instead of the GOSUBs. You gain the time took by four jumps.


Title: 100% QB game
Post by: Nemesis on February 04, 2005, 12:08:34 PM
Quote from: "na_th_an"
I meant this:

Code:
[...]
  CASE &H1
    DEF SEG = TS&
    GOSUB tB0
    DEF SEG = DS&
    GOSUB dB0
[...]


I dunno where it belongs. I suggest to paste the actual code instead of the GOSUBs. You gain the time took by four jumps.


True na_th_an, it would be faster but, I'm not sure if
you are fully aware of the actual structure of this routine.
The GOSUB you are refering to is only called once if the
number of bytes it's transfering is not a multiple of 16.
IF it's a multiple of 16 then there's no execution of this
part of the routine. Also, if I were too, (hard code sort of speaking)
the actual routine it calls via. GOSUB then I would be using
precious string space which is probablly one of QB's biggest
limitation. This lib is geared towards speed but, it also focuses
on preserving memory, and other important aspects needed when
using a limited language such as QB :)
 
eg #1:(Taking out the GOSUBS)...
 
Code:

  '
  SELECT CASE (BYTES& MOD &H10)
   CASE &H1
    DEF SEG = TS&
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H0), b0
   CASE &H2
    DEF SEG = TS&
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H3
    DEF SEG = TS&
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H4
    DEF SEG = TS&
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H5
    DEF SEG = TS&
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H6
    DEF SEG = TS&
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H7
    DEF SEG = TS&
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H8
    DEF SEG = TS&
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H9
    DEF SEG = TS&
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &HA
    DEF SEG = TS&
    b9 = PEEK(bt(&H9))
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H9), b9
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &HB
    DEF SEG = TS&
    ba = PEEK(bt(&HA))
    b9 = PEEK(bt(&H9))
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&HA), ba
    POKE bd(&H9), b9
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &HC
    DEF SEG = TS&
    bb = PEEK(bt(&HB))
    ba = PEEK(bt(&HA))
    b9 = PEEK(bt(&H9))
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&HB), bb
    POKE bd(&HA), ba
    POKE bd(&H9), b9
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &HD
    DEF SEG = TS&
    bc = PEEK(bt(&HC))
    bb = PEEK(bt(&HB))
    ba = PEEK(bt(&HA))
    b9 = PEEK(bt(&H9))
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&HC), bc
    POKE bd(&HB), bb
    POKE bd(&HA), ba
    POKE bd(&H9), b9
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &HE
    DEF SEG = TS&
    bd = PEEK(bt(&HD))
    bc = PEEK(bt(&HC))
    bb = PEEK(bt(&HB))
    ba = PEEK(bt(&HA))
    b9 = PEEK(bt(&H9))
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&HD), bd
    POKE bd(&HC), bc
    POKE bd(&HB), bb
    POKE bd(&HA), ba
    POKE bd(&H9), b9
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &HF
    DEF SEG = TS&
    be = PEEK(bt(&HE))
    bd = PEEK(bt(&HD))
    bc = PEEK(bt(&HC))
    bb = PEEK(bt(&HB))
    ba = PEEK(bt(&HA))
    b9 = PEEK(bt(&H9))
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&HF), bf
    POKE bd(&HE), be
    POKE bd(&HD), bd
    POKE bd(&HC), bc
    POKE bd(&HB), bb
    POKE bd(&HA), ba
    POKE bd(&H9), b9
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
  END SELECT
  '
 


eg #2:The current structure...
 
Code:

  '
  SELECT CASE (BYTES& MOD &H10)
   CASE &H1
    DEF SEG = TS&
    GOSUB tB0
    DEF SEG = DS&
    GOSUB dB0
   CASE &H2
    DEF SEG = TS&
    GOSUB tB1
    DEF SEG = DS&
    GOSUB dB1
   CASE &H3
    DEF SEG = TS&
    GOSUB tB2
    DEF SEG = DS&
    GOSUB dB2
   CASE &H4
    DEF SEG = TS&
    GOSUB tB3
    DEF SEG = DS&
    GOSUB dB3
   CASE &H5
    DEF SEG = TS&
    GOSUB tB4
    DEF SEG = DS&
    GOSUB dB4
   CASE &H6
    DEF SEG = TS&
    GOSUB tB5
    DEF SEG = DS&
    GOSUB dB5
   CASE &H7
    DEF SEG = TS&
    GOSUB tB6
    DEF SEG = DS&
    GOSUB dB6
   CASE &H8
    DEF SEG = TS&
    GOSUB tB7
    DEF SEG = DS&
    GOSUB dB7
   CASE &H9
    DEF SEG = TS&
    GOSUB tB8
    DEF SEG = DS&
    GOSUB dB8
   CASE &HA
    DEF SEG = TS&
    GOSUB tB9
    DEF SEG = DS&
    GOSUB dB9
   CASE &HB
    DEF SEG = TS&
    GOSUB tBA
    DEF SEG = DS&
    GOSUB dBA
   CASE &HC
    DEF SEG = TS&
    GOSUB tBB
    DEF SEG = DS&
    GOSUB dBB
   CASE &HD
    DEF SEG = TS&
    GOSUB tBC
    DEF SEG = DS&
    GOSUB dBC
   CASE &HE
    DEF SEG = TS&
    GOSUB tBD
    DEF SEG = DS&
    GOSUB dBD
   CASE &HF
    DEF SEG = TS&
    GOSUB tBE
    DEF SEG = DS&
    GOSUB dBE
   END SELECT
tBF: BF = PEEK(bt(&HF))
tBE: BE = PEEK(bt(&HE))
tBD: bd = PEEK(bt(&HD))
tBC: BC = PEEK(bt(&HC))
tBB: bb = PEEK(bt(&HB))
tBA: BA = PEEK(bt(&HA))
tB9: b9 = PEEK(bt(&H9))
tB8: b8 = PEEK(bt(&H8))
tB7: b7 = PEEK(bt(&H7))
tB6: b6 = PEEK(bt(&H6))
tB5: b5 = PEEK(bt(&H5))
tB4: b4 = PEEK(bt(&H4))
tB3: b3 = PEEK(bt(&H3))
tB2: B2 = PEEK(bt(&H2))
tB1: B1 = PEEK(bt(&H1))
tB0: B0 = PEEK(bt(&H0))
     '
     RETURN
     '
dBF: POKE bd(&HF), BF
dBE: POKE bd(&HE), BE
dBD: POKE bd(&HD), bd
dBC: POKE bd(&HC), BC
dBB: POKE bd(&HB), bb
dBA: POKE bd(&HA), BA
dB9: POKE bd(&H9), b9
dB8: POKE bd(&H8), b8
dB7: POKE bd(&H7), b7
dB6: POKE bd(&H6), b6
dB5: POKE bd(&H5), b5
dB4: POKE bd(&H4), b4
dB3: POKE bd(&H3), b3
dB2: POKE bd(&H2), B2
dB1: POKE bd(&H1), B1
dB0: POKE bd(&H0), B0
     '
     RETURN
     '


Cya,

Nemesis


Title: 100% QB game
Post by: Z!re on February 04, 2005, 12:30:00 PM
Use real SUBS/FUNCTIONS.

Works just fine, although it doesent really matter that much.


Title: 100% QB game
Post by: na_th_an on February 04, 2005, 03:09:42 PM
Quote from: "Z!re"
Use real SUBS/FUNCTIONS.

Works just fine, although it doesent really matter that much.


GOSUB stores 4 bytes on stack, performs a jump. That's two integer PUSHes and a JMP. RETURN retrieves those 4 bytes from stack, and then performs a jump. That's two integer POPs and a JMP. That takes time. If you paste the code directly, you save that time.

Real SUBs FUNCTIONs take even more time, as parameters also have to be pushed/popped into the stack.


Title: 100% QB game
Post by: Z!re on February 04, 2005, 08:31:39 PM
I know, for time critical you should always unroll, and call as few procs as possible.

Longer code is a cosmetic thing, doesent really matter to the compiler (unless QB, which chokes ofcourse)


Title: 100% QB game
Post by: Nemesis on February 06, 2005, 08:12:43 PM
Well I decided to optimize my V13hCPY subroutine a bit.
Taking into consideration to what na_th_an suggested to increase
the speed of this routine, and still keeping the routine at a favorable size to save memory. So, it was slightly faster and only slightly larger so it worked out well. I also whipped up a similar V13hCPY routine to work as a PUT routine. This routine amazingly is as fast as a QB's PUT (X,Y), 0,OR (Called through the V13hPUT subroutine as "ANDXOR"....
Check out in my previous posts for the source code of the whole lib! (The new improved routines will be included with my newest edit of the post containing the source code!)

Cya,

Nemesis


Title: 100% QB game
Post by: na_th_an on February 07, 2005, 05:38:49 AM
I don't understand why you say that changing the  GOSUBs by the actual routine replicated 1000 times takes more memory. It takes less: you are not pushing anything to the stack.


Title: 100% QB game
Post by: Nemesis on February 07, 2005, 12:25:50 PM
Quote
I don't understand why you say that changing the GOSUBs by the actual routine replicated 1000 times takes more memory. It takes less: you are not pushing anything to the stack.


na_th_an...

(More $pace) = (more memory), period!

Nemesis


P.s...

na_th_an, if you just track the logic of my routine then you might get a better understanding for my reasoning of not unrolling these frequently accessed routines.(Or just review my previous posts where I discussed my reasoning.) And also, what's the point in using subroutines, functions, No GOTO's  :lol: , basic structured coding ethics, etc... I might as well just use another language if
I'm not going to utilize some of the better ascpects of the language I'm using.
 [/quote]


Title: 100% QB game
Post by: na_th_an on February 07, 2005, 12:30:41 PM
What you have to save is data memory, not code memory. You have plenty of such.

Anyways, it was just a hint to make your engine faster. You may take it or not.


Title: 100% QB game
Post by: Nemesis on February 07, 2005, 12:56:41 PM
Quote
Anyways, it was just a hint to make your engine faster. You may take it or not.


Heh, obviously you don't comprehend all that you read... J/K  :lol:

READ MY POSTS!!! I DID CONSIDER IT!
(Actually I reconsidered...(Sting space was more of an issue than speed in this case, but ultimately when reconsidered, I used both
mine and yours ideas... SEE THE CREDITS!)
See, I always code in a matter that will utilize the best optimizations where and when needed, so you can have many optimization options at times. When you take all these ptimizations and weigh their total benifits towards what your routines main goal is then you might end up doing something similar to what I did here.

Bye.

Nemesis


Title: 100% QB game
Post by: Spotted Cheetah on February 11, 2005, 08:14:29 PM
WHOA! What happened here while i was away! :)

(Sorry, i can visit the Web only 2 times in a month...)

I will download these and take a look at it. Now i had not got enough time to read it: it is after midnight, and Internet is not cheap...

(I just had seen one from Nemesis: Chain4 256 color modes are completely different from usual 16 color modes. They need a really different technique)

So now only what i wrote in Notepad (based on what i had seen here 2 weeks ago...):


Quote

Nemesis:

You was really right with POKE. It was strange for me that i got at around
110FPS with it since i was given up SCREEN 13 in QB far away in the past
exactly because i could not write a fast POKE based pixel - plotter for it
(On the same computer on wich i tested now). But it is true too that my
HLine sub runs nearly two times faster in ideal situations so to fill large
areas (what is needed many times) it is much better to use my HLine instead
of anything else (If the programmer wants to clear a memory page, not the
screen itself).

Now i think the best solution is to merge our libraries, and create a long
integer based memory page on which pixel plotting goes with POKE, but
filling certain areas being wider than 20 pixels goes with my HLine sub.
It would be not easy to create a similar thing for LONGs to HLine, and due
to many calculations it might lose some speed: i can not say anything about
this since i did not try it yet. But if it can be well written i except at
about three to four times greater speed than usual POKE when clearing the
entire memory page (On the other hand just for clearing it not too much is
needed: just a FOR cycle what runs from the start to the end. But many
times some big solid shapes like rectangles are needed what is only
possible with building up from a similar algorithm to HLine).

To create a HLine for long integer array i has got some ideas already since
i wrote a sub what achieved the same for 16 color screens. I did that
because it really annoyed me that QB is so slow with that, so i tried to
outperform it by creating a sub what does not need to access the VGA ports:
instead it just drew on the currently set page so i could collect some
lines before sending them to the VGA in one cycle. I failed with it yet
since the drawing algorithm was much slower so the overall speed was around
the same as usual QB lines.


Title: 100% QB game
Post by: Spotted Cheetah on February 12, 2005, 02:46:16 PM
I red what you all wrote here: it is really true that pure QB SCREEN13 libraries are out of date as the whole thing. I always would like to program retro in real mode using C or sometimes assembler, but that would have not been understood by anybody... Or i simply would not be able to post and talk about or compete with those sources anywhere as nobody is really interested in them. So QBasic. Here i got annoyed that everyone programs in QB, but they actually use tons of ASM or other languages, and just merge the results with QB. This is why i like to write here: if QB, do it perfectly without messing with anything else! :)

SCREEN 13 library: my comcept was to write a small library what supports only the most important features of graphic. I think more is not really important since it would just waste the code space for most of the programmers who not really need the extended features. And usually who gets a lib not tries to cut it in parts when she or he not needs some, just gets annoyed if the program won't compile because of it's size. In my opinion "most important" is a pixel plotter, a screen clearer, a PUT routine supporting transparency, and a fast hline sub to build up filled rectangles or triangles for 3D from it. Of course this all on one, or more not visible pages which can be sent to the screen when drawing is finished on them.


Title: 100% QB game
Post by: ThaMariuZ on February 14, 2005, 08:13:07 PM
heya,

hmm, since i'm finishing my ninjanight game at the moment i guess  it'd be a good opportunity to post the pure qb demo of the game here:

http://people.freenet.de/mariuz/junk/demo.rar

the complete game will also be mostly pure qb.

cheers


Title: 100% QB game
Post by: Spotted Cheetah on February 26, 2005, 05:06:40 AM
If you were waiting for me, and for new ideas for Screen 13, sorry: it appeared that because of certain reasons i have no time to program in QBasic for a while. But i do not want to leave you and the challenge here with this: if you want, take a look at the QB screen modes topic in "QB in general" (It has some crappy name what i can not remember now). There ask Adigun (Our web page completely broke because of our only computer from which we could update it not works) for my newest program, and you will see the subject of a new competition :)

(I told this especially to Nemesis: you would certainly be interested)


Title: 100% QB game
Post by: BastetFurry on February 26, 2005, 06:41:25 AM
Hmm... unrolling code...
Shouldnt the compiler do that for you?

So if i have a sub that is a one-liner, the compiler should put the one-liner in case of the CALL.
Ok, on today computers it dont matter, because most opcodes are executed parralel. So i can push something on the stack and at the same time set the CPU-ProgrammCounter to a new point in address space.